Re: Create a textbox in Lisp

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