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

diff --git a/src/test/hanoi.lisp b/src/test/hanoi.lisp
index 2b614829..d8ff2c86 100644
--- a/src/test/hanoi.lisp
+++ b/src/test/hanoi.lisp
@@ -1,3 +1,21 @@
+;
+; Towers of Hanoi
+;
+; Copyright © 2016 Keith Packard <keithp@keithp.com>
+;
+; This program is free software; you can redistribute it and/or modify
+; it under the terms of the GNU General Public License as published by
+; the Free Software Foundation, either version 2 of the License, or
+; (at your option) any later version.
+;
+; This program is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+; General Public License for more details.
+;
+
+					; ANSI control sequences
+
 (defun move-to (col row)
   (patom "\033[" row ";" col "H" nil)
   )
@@ -6,76 +24,87 @@
   (patom "\033[2J" nil)
   )
 
-(setq stack '("*" "**" "***" "****" "*****" "******" "*******"))
-
-(setq stacks nil)
-
 (defun display-string (x y str)
   (move-to x y)
   (patom str)
   )
 
-(defun display-stack (x y stack)
-  (cond (stack (progn
-		 (display-string x y (car stack))
-		 (display-stack x (1+ y) (cdr stack)))))
-  )
+					; Here's the pieces to display
+
+(setq stack '("     *     " "    ***    " "   *****   " "  *******  " " ********* " "***********"))
+
+					; Here's all of the stacks of pieces
+					; This is generated when the program is run
 
-(defun clear-stack (x y)
-  (cond ((> y 0) (progn
-		   (move-to x y)
-		   (patom "            ")
-		   (clear-stack x (1- y))
-		   )
+(setq stacks nil)
+
+					; Display one stack, clearing any
+					; space above it
+
+(defun display-stack (x y clear stack)
+  (cond ((= 0 clear)
+	 (cond (stack (progn
+			(display-string x y (car stack))
+			(display-stack x (1+ y) 0 (cdr stack))
+			)
+		      )
+	       )
 	 )
+	(t (progn
+	     (display-string x y "                    ")
+	     (display-stack x (1+ y) (1- clear) stack)
+	     )
+	   )
 	)
   )
 
-(defun length (list)
-  (cond (list (1+ (length (cdr list))))
-	(0)
-	)
-  )
+					; Position of the top of the stack on the screen
+					; Shorter stacks start further down the screen
 
 (defun stack-pos (y stack)
   (- y (length stack))
   )
 
+					; Display all of the stacks, spaced 20 columns apart
+
 (defun display-stacks (x y stacks)
   (cond (stacks (progn
-		  (clear-stack x 20)
-		  (display-stack x (stack-pos y (car stacks)) (car stacks))
+		  (display-stack x 0 (stack-pos y (car stacks)) (car stacks))
 		  (display-stacks (+ x 20) y (cdr stacks)))
 		)
 	)
   )
 
+					; Display all of the stacks, then move the cursor
+					; out of the way and flush the output
+
 (defun display ()
-  (display-stacks 0 20 stacks)
+  (display-stacks 0 top stacks)
   (move-to 1 21)
   (flush)
   )
 
-(defun length (l)
-  (cond (l (1+ (length (cdr l)))) (0))
-  )
+					; Reset stacks to the starting state, with
+					; all of the pieces in the first stack 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)
 	)
   )
 
-(defun nth (list n)
-  (cond ((= n 0) (car list))
-	((nth (cdr list) (1- n)))
-	)
-  )
+					; Replace a stack in the list of stacks
+					; with a new value
 
 (defun replace (list pos member)
   (cond ((= pos 0) (cons member (cdr list)))
@@ -83,6 +112,9 @@
 	)
   )
 
+					; Move a piece from the top of one stack
+					; to the top of another
+
 (defun move-piece (from to)
   (let ((from-stack (nth stacks from))
 	(to-stack (nth stacks to))
@@ -96,6 +128,8 @@
     )
   )
 
+; The implementation of the game
+
 (defun _hanoi (n from to use)
   (cond ((= 1 n)
 	 (progn
@@ -112,8 +146,25 @@
 	)
   )
 
+					; A pretty interface which
+					; resets the state of the game,
+					; clears the screen and runs
+					; the program
+
 (defun hanoi ()
   (setq len (reset-stacks))
   (clear)
   (_hanoi len 0 1 2)
+  )
+
+					; Run many in a row to time them
+
+(defun hanois(n)
+  (cond ((> n 0)
+	 (progn
+	   (hanoi)
+	   (hanois (1- n))
+	   )
+	 )
+	)
   )