X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Ftest%2Fhanoi.lisp;h=4afde8833b77bc4e1fa4f4c59a80e4ff926ad3e1;hb=c31744299e5a4342bbe26d3735ee2d8f09192ae9;hp=d8ff2c86583220d3efbef3bc8856e87942cc50b2;hpb=d37945f1404043e6bd287ce7ad7a57bc3289609b;p=fw%2Faltos

diff --git a/src/test/hanoi.lisp b/src/test/hanoi.lisp
index d8ff2c86..4afde883 100644
--- a/src/test/hanoi.lisp
+++ b/src/test/hanoi.lisp
@@ -16,132 +16,121 @@
 
 					; ANSI control sequences
 
-(defun move-to (col row)
-  (patom "\033[" row ";" col "H" nil)
+(define (move-to col row)
+  (for-each display (list "\033[" row ";" col "H"))
   )
 
-(defun clear ()
-  (patom "\033[2J" nil)
+(define (clear)
+  (display "\033[2J")
   )
 
-(defun display-string (x y str)
+(define (display-string x y str)
   (move-to x y)
-  (patom str)
+  (display str)
   )
 
 					; Here's the pieces to display
 
-(setq stack '("     *     " "    ***    " "   *****   " "  *******  " " ********* " "***********"))
+(define tower '("     *     " "    ***    " "   *****   " "  *******  " " ********* " "***********"))
 
-					; Here's all of the stacks of pieces
+					; Here's all of the towers of pieces
 					; This is generated when the program is run
 
-(setq stacks nil)
+(define towers ())
 
-					; Display one stack, clearing any
+(define (one- x) (- x 1))
+(define (one+ x) (+ x 1))
+					; Display one tower, clearing any
 					; space above it
 
-(defun display-stack (x y clear stack)
+(define (display-tower x y clear tower)
   (cond ((= 0 clear)
-	 (cond (stack (progn
-			(display-string x y (car stack))
-			(display-stack x (1+ y) 0 (cdr stack))
-			)
-		      )
+	 (cond ((not (null? tower))
+		(display-string x y (car tower))
+		(display-tower x (one+ y) 0 (cdr tower))
+		)
 	       )
 	 )
-	(t (progn
-	     (display-string x y "                    ")
-	     (display-stack x (1+ y) (1- clear) stack)
-	     )
-	   )
+	(else 
+	 (display-string x y "                   ")
+	 (display-tower x (one+ y) (one- clear) tower)
+	 )
 	)
   )
 
-					; Position of the top of the stack on the screen
-					; Shorter stacks start further down the screen
+					; Position of the top of the tower on the screen
+					; Shorter towers start further down the screen
 
-(defun stack-pos (y stack)
-  (- y (length stack))
+(define (tower-pos y tower)
+  (- y (length tower))
   )
 
-					; Display all of the stacks, spaced 20 columns apart
+					; Display all of the towers, spaced 20 columns apart
 
-(defun display-stacks (x y stacks)
-  (cond (stacks (progn
-		  (display-stack x 0 (stack-pos y (car stacks)) (car stacks))
-		  (display-stacks (+ x 20) y (cdr stacks)))
-		)
+(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)))
 	)
   )
 
-					; Display all of the stacks, then move the cursor
+(define top 0)
+					; Display all of the towers, then move the cursor
 					; out of the way and flush the output
 
-(defun display ()
-  (display-stacks 0 top stacks)
+(define (display-hanoi)
+  (display-towers 0 top towers)
   (move-to 1 21)
-  (flush)
+  (flush-output)
   )
 
-					; Reset stacks to the starting state, with
-					; all of the pieces in the first stack and the
+					; Reset towers to the starting state, with
+					; all of the pieces in the first tower and the
 					; other two empty
 
-(defun reset-stacks ()
-  (setq stacks (list stack nil nil))
-  (setq top (+ (length stack) 3))
-  (length stack)
-  )
-
-					; more functions which could usefully
-					; be in the rom image
-
-(defun min (a b)
-  (cond ((< a b) a)
-	(b)
-	)
+(define (reset-towers)
+  (set! towers (list tower () ()))
+  (set! top (+ (length tower) 3))
+  (length tower)
   )
 
-					; Replace a stack in the list of stacks
+					; Replace a tower in the list of towers
 					; with a new value
 
-(defun replace (list pos member)
+(define (replace list pos member)
   (cond ((= pos 0) (cons member (cdr list)))
-	((cons (car list) (replace (cdr list) (1- pos) member)))
+	(else (cons (car list) (replace (cdr list) (one- pos) member)))
 	)
   )
 
-					; Move a piece from the top of one stack
+					; Move a piece from the top of one tower
 					; to the top of another
 
-(defun move-piece (from to)
-  (let ((from-stack (nth stacks from))
-	(to-stack (nth stacks to))
-	(piece (car from-stack)))
-    (setq from-stack (cdr from-stack))
-    (setq to-stack (cons piece to-stack))
-    (setq stacks (replace stacks from from-stack))
-    (setq stacks (replace stacks to to-stack))
-    (display)
-    (delay 100)
+(define move-delay 10)
+
+(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
 
-(defun _hanoi (n from to use)
+(define (_hanoi n from to use)
   (cond ((= 1 n)
-	 (progn
-	  (move-piece from to)
-	  nil)
+	 (move-piece from to)
 	 )
-	(t
-	 (progn
-	  (_hanoi (1- n) from use to)
-	  (_hanoi 1 from to use)
-	  (_hanoi (1- n) use to from)
-	  )
+	(else
+	 (_hanoi (one- n) from use to)
+	 (_hanoi 1 from to use)
+	 (_hanoi (one- n) use to from)
 	 )
 	)
   )
@@ -151,20 +140,12 @@
 					; clears the screen and runs
 					; the program
 
-(defun hanoi ()
-  (setq len (reset-stacks))
-  (clear)
-  (_hanoi len 0 1 2)
+(define (hanoi)
+  (let ((len (reset-towers)))
+    (clear)
+    (_hanoi len 0 1 2)
+    (move-to 0 23)
+    #t
+    )
   )
-
-					; Run many in a row to time them
-
-(defun hanois(n)
-  (cond ((> n 0)
-	 (progn
-	   (hanoi)
-	   (hanois (1- n))
-	   )
-	 )
-	)
   )