XPost: comp.lang.scheme

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 ...))]))

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)