summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKeith Packard <keithp@keithp.com>2016-11-14 21:27:41 -0800
committerKeith Packard <keithp@keithp.com>2016-11-17 22:18:39 -0800
commit421a4128a9bfb879202f211a1173622a4a9063cf (patch)
treea552d296a1d9f41287d977113a0f32f4448a3b67
parent9636ac0294540a0a778d8fc996a6d17c0d04d367 (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>
-rw-r--r--src/test/hanoi.lisp32
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)
)