diff options
| author | Keith Packard <keithp@keithp.com> | 2016-11-14 21:27:41 -0800 | 
|---|---|---|
| committer | Keith Packard <keithp@keithp.com> | 2017-02-20 11:16:51 -0800 | 
| commit | 13a4d451b903d08e52005bcf531efa8de351bf2b (patch) | |
| tree | 09db485d048612c703f5cded31893a0c075db41a /src | |
| parent | 74ff0c6fd6c41cdaa054dcdb3d05c7d333bc24ff (diff) | |
altos/lisp: Improve hanoi demo
Repaint in place, without first clearing. This makes the updates a lot
clealyer looking.
Signed-off-by: Keith Packard <keithp@keithp.com>
Diffstat (limited to 'src')
| -rw-r--r-- | src/test/hanoi.lisp | 32 | 
1 files changed, 17 insertions, 15 deletions
| diff --git a/src/test/hanoi.lisp b/src/test/hanoi.lisp index 2b614829..0c4bfca5 100644 --- a/src/test/hanoi.lisp +++ b/src/test/hanoi.lisp @@ -8,6 +8,8 @@  (setq stack '("*" "**" "***" "****" "*****" "******" "*******")) +(setq top (+ (length stack) 3)) +  (setq stacks nil)  (defun display-string (x y str) @@ -15,19 +17,20 @@    (patom str)    ) -(defun display-stack (x y stack) -  (cond (stack (progn -		 (display-string x y (car stack)) -		 (display-stack x (1+ y) (cdr stack))))) -  ) - -(defun clear-stack (x y) -  (cond ((> y 0) (progn -		   (move-to x y) -		   (patom "            ") -		   (clear-stack x (1- y)) -		   ) +(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) +	     ) +	   )  	)    ) @@ -43,15 +46,14 @@  (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)))  		)  	)    )  (defun display () -  (display-stacks 0 20 stacks) +  (display-stacks 0 top stacks)    (move-to 1 21)    (flush)    ) | 
