X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Ftest%2Fhanoi.lisp;h=e2eb0fa00854dd3732496ca02e210feb8d142fc5;hb=441056b01abcf9287f61f425cf29fc4b1603c619;hp=387e696ae55de1df681ce3ff0bc1bac8ed66e92b;hpb=8406ddf8f0bd5453d6213973daed35991f80972a;p=fw%2Faltos diff --git a/src/test/hanoi.lisp b/src/test/hanoi.lisp index 387e696a..e2eb0fa0 100644 --- a/src/test/hanoi.lisp +++ b/src/test/hanoi.lisp @@ -14,15 +14,14 @@ ; General Public License for more details. ; - -; ANSI control sequences + ; ANSI control sequences (defun move-to (col row) - (patom "\033[" row ";" col "H" nil) + (patom "\033[" row ";" col "H") ) (defun clear () - (patom "\033[2J" nil) + (patom "\033[2J") ) (defun display-string (x y str) @@ -30,55 +29,51 @@ (patom str) ) -; Here's the pieces to display + ; Here's the pieces to display (setq stack '(" * " " *** " " ***** " " ******* " " ********* " "***********")) -; -; Here's all of the stacks of pieces -; This is generated when the program is run -; + ; Here's all of the stacks of pieces + ; This is generated when the program is run + (setq stacks nil) -; Display one stack, clearing any -; space above it + ; 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)) - ) - ) + (cond (stack + (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) - ) - ) + (t + (display-string x y " ") + (display-stack x (1+ y) (1- clear) stack) + ) ) ) -; Position of the top of the stack on the screen -; Shorter stacks start further down the screen + ; 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 + ; Display all of the stacks, 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))) - ) + (cond (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 + ; Display all of the stacks, then move the cursor + ; out of the way and flush the output (defun display () (display-stacks 0 top stacks) @@ -86,9 +81,9 @@ (flush) ) -; Reset stacks to the starting state, with -; all of the pieces in the first stack and the -; other two empty + ; 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)) @@ -96,8 +91,8 @@ (length stack) ) -; more functions which could usefully -; be in the rom image + ; more functions which could usefully + ; be in the rom image (defun min (a b) (cond ((< a b) a) @@ -105,8 +100,8 @@ ) ) -; Replace a stack in the list of stacks -; with a new value + ; Replace a stack in the list of stacks + ; with a new value (defun replace (list pos member) (cond ((= pos 0) (cons member (cdr list))) @@ -114,8 +109,10 @@ ) ) -; Move a piece from the top of one stack -; to the top of another + ; Move a piece from the top of one stack + ; to the top of another + +(setq move-delay 100) (defun move-piece (from to) (let ((from-stack (nth stacks from)) @@ -126,7 +123,7 @@ (setq stacks (replace stacks from from-stack)) (setq stacks (replace stacks to to-stack)) (display) - (delay 100) + (delay move-delay) ) ) @@ -134,27 +131,25 @@ (defun _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) - ) + (_hanoi (1- n) from use to) + (_hanoi 1 from to use) + (_hanoi (1- n) use to from) ) ) ) -; A pretty interface which -; resets the state of the game, -; clears the screen and runs -; the program + ; 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) + (move-to 0 23) + t )