altos/lisp: split set/def. Add def support to lambdas
[fw/altos] / src / test / hanoi.lisp
index 02e168768cd4894038c65596ba9c21615acfb4af..4afde8833b77bc4e1fa4f4c59a80e4ff926ad3e1 100644 (file)
 
                                        ; ANSI control sequences
 
-(define move-to (lambda (col row)
-                 (for-each display (list "\033[" row ";" col "H"))
-                 )
+(define (move-to col row)
+  (for-each display (list "\033[" row ";" col "H"))
   )
 
-(define clear (lambda ()
-               (display "\033[2J")
-               )
+(define (clear)
+  (display "\033[2J")
   )
 
-(define display-string (lambda (x y str)
-                        (move-to x y)
-                        (display str)
-                        )
+(define (display-string x y str)
+  (move-to x y)
+  (display str)
   )
 
                                        ; Here's the pieces to display
 
 (define towers ())
 
-(define one- (lambda (x) (- x 1)))
-(define one+ (lambda (x) (+ x 1)))
+(define (one- x) (- x 1))
+(define (one+ x) (+ x 1))
                                        ; Display one tower, clearing any
                                        ; space above it
 
-(define display-tower (lambda (x y clear tower)
-                       (cond ((= 0 clear)
-                              (cond ((not (null? tower))
-                                     (display-string x y (car tower))
-                                     (display-tower x (one+ y) 0 (cdr tower))
-                                     )
-                                    )
-                              )
-                             (else 
-                              (display-string x y "                   ")
-                              (display-tower x (one+ y) (one- clear) tower)
-                              )
-                             )
-                       )
+(define (display-tower x y clear tower)
+  (cond ((= 0 clear)
+        (cond ((not (null? tower))
+               (display-string x y (car tower))
+               (display-tower x (one+ y) 0 (cdr tower))
+               )
+              )
+        )
+       (else 
+        (display-string x y "                   ")
+        (display-tower x (one+ y) (one- clear) tower)
+        )
+       )
   )
 
                                        ; Position of the top of the tower on the screen
                                        ; Shorter towers start further down the screen
 
-(define tower-pos (lambda (y tower)
-                   (- y (length tower))
-                   )
+(define (tower-pos y tower)
+  (- y (length tower))
   )
 
                                        ; Display all of the towers, spaced 20 columns apart
 
-(define display-towers (lambda (x y towers)
-                        (cond ((not (null? towers))
-                               (display-tower x 0 (tower-pos y (car towers)) (car towers))
-                               (display-towers (+ x 20) y (cdr towers)))
-                              )
-                        )
+(define (display-towers x y towers)
+  (cond ((not (null? towers))
+        (display-tower x 0 (tower-pos y (car towers)) (car towers))
+        (display-towers (+ x 20) y (cdr towers)))
+       )
   )
 
 (define top 0)
                                        ; Display all of the towers, then move the cursor
                                        ; out of the way and flush the output
 
-(define display-hanoi (lambda ()
-                       (display-towers 0 top towers)
-                       (move-to 1 21)
-                       (flush-output)
-                       )
+(define (display-hanoi)
+  (display-towers 0 top towers)
+  (move-to 1 21)
+  (flush-output)
   )
 
                                        ; Reset towers to the starting state, with
                                        ; all of the pieces in the first tower and the
                                        ; other two empty
 
-(define reset-towers (lambda ()
-                      (set! towers (list tower () ()))
-                      (set! top (+ (length tower) 3))
-                      (length tower)
-                      )
+(define (reset-towers)
+  (set! towers (list tower () ()))
+  (set! top (+ (length tower) 3))
+  (length tower)
   )
 
                                        ; Replace a tower in the list of towers
                                        ; with a new value
 
-(define replace (lambda (list pos member)
-                 (cond ((= pos 0) (cons member (cdr list)))
-                       ((cons (car list) (replace (cdr list) (one- pos) member)))
-                       )
-                 )
+(define (replace list pos member)
+  (cond ((= pos 0) (cons member (cdr list)))
+       (else (cons (car list) (replace (cdr list) (one- pos) member)))
+       )
   )
 
                                        ; Move a piece from the top of one tower
 
 (define move-delay 10)
 
-(define move-piece (lambda (from to)
-                    (let* ((from-tower (list-ref towers from))
-                          (to-tower (list-ref towers to))
-                          (piece (car from-tower)))
-                      (set! from-tower (cdr from-tower))
-                      (set! to-tower (cons piece to-tower))
-                      (set! towers (replace towers from from-tower))
-                      (set! towers (replace towers to to-tower))
-                      (display-hanoi)
-                      (delay move-delay)
-                      )
-                    )
+(define (move-piece from to)
+  (let* ((from-tower (list-ref towers from))
+        (to-tower (list-ref towers to))
+        (piece (car from-tower)))
+    (set! from-tower (cdr from-tower))
+    (set! to-tower (cons piece to-tower))
+    (set! towers (replace towers from from-tower))
+    (set! towers (replace towers to to-tower))
+    (display-hanoi)
+    (delay move-delay)
+    )
   )
 
 ; The implementation of the game
 
-(define _hanoi (lambda (n from to use)
-                (cond ((= 1 n)
-                       (move-piece from to)
-                       )
-                      (else
-                       (_hanoi (one- n) from use to)
-                       (_hanoi 1 from to use)
-                       (_hanoi (one- n) use to from)
-                       )
-                      )
-                )
+(define (_hanoi n from to use)
+  (cond ((= 1 n)
+        (move-piece from to)
+        )
+       (else
+        (_hanoi (one- n) from use to)
+        (_hanoi 1 from to use)
+        (_hanoi (one- n) use to from)
+        )
+       )
   )
 
                                        ; A pretty interface which
                                        ; clears the screen and runs
                                        ; the program
 
-(define hanoi (lambda ()
-               (let ((len))
-                 (set! len (reset-towers))
-                 (clear)
-                 (_hanoi len 0 1 2)
-                 (move-to 0 23)
-                 #t
-                 )
-               )
+(define (hanoi)
+  (let ((len (reset-towers)))
+    (clear)
+    (_hanoi len 0 1 2)
+    (move-to 0 23)
+    #t
+    )
+  )
   )