Path: ...!news.nobody.at!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail From: "B. Pym" Newsgroups: comp.lang.lisp,comp.lang.scheme Subject: Re: Create a textbox in Lisp Date: Thu, 12 Sep 2024 06:05:08 -0000 (UTC) Organization: A noiseless patient Spider Lines: 72 Message-ID: MIME-Version: 1.0 Content-Type: text/plain; charset=iso-8859-1 Injection-Date: Thu, 12 Sep 2024 08:05:09 +0200 (CEST) Injection-Info: dont-email.me; posting-host="15295cbec5a95e756a39a07bb6746ed8"; logging-data="131035"; mail-complaints-to="abuse@eternal-september.org"; posting-account="U2FsdGVkX18RKgOqmt/Y3N0/tgSQZWbZ" User-Agent: XanaNews/1.18.1.6 Cancel-Lock: sha1:2Z5rjOwt7zXc9IAg18kSvgNcL7Y= Bytes: 3165 Pascal J. Bourguignon wrote: > > I want to create a text box on a page that > > says "Lisp is a powerful language". It > > should look like this : > > > > > > ---------------------------------- > > | | > > | Lisp is a powerful language | > > | | > > | | > > ---------------------------------- > > > cl-user> (let ((message "Lisp is a powerful language")) > (format t "+--~V,,,'-<~>--+~%~:*| ~V<~> |~%| ~A > |~%~0@*| ~V<~> |~%~:*| ~V<~> |~%~:*+--~V,,,'-<~>--+~%" > (length message) message)) > +-------------------------------+ > | | > | Lisp is a powerful language | > | | > | | > +-------------------------------+ Gauche Scheme (use gauche.collection) (define (cntr str len fill wrap) (while (< (size-of str) len) (set! str (string-append fill str fill))) (string-append wrap (substring str 0 len) wrap)) (define (box . xs) (let@ (w (+ 4 (apply max (map size-of xs))) rule (cntr "" w "-" "+")) (print rule) (dolist (s `("" ,@xs "")) (print (cntr s w " " "|"))) (print rule))) (box "CL is not Lisp." "As Graham said," "it's not Lisp that sucks," "but CL.") +-----------------------------+ | | | CL is not Lisp. | | As Graham said, | | it's not Lisp that sucks, | | but CL. | | | +-----------------------------+ Given: (define-syntax let@-aux (syntax-rules () [(let@-aux (0 var ...) (pairs ...) stuff) (let@-aux () (pairs ... (var 0) ...) stuff)] [(let@-aux ('() var ...) (pairs ...) stuff) (let@-aux () (pairs ... (var '()) ...) stuff)] [(let@-aux (var val more ...) (pairs ...) stuff) (let@-aux (more ...) (pairs ... (var val)) stuff)] [(let@-aux (var) pairs stuff) (let@-aux (var '()) pairs stuff)] [(let@-aux () ((var val) ...) (stuff ...)) (let* ((var val) ...) stuff ...)])) (define-syntax let@ (syntax-rules () [(let@ things stuff ...) (let@-aux things () (stuff ...))]))