altos/lisp: Improve hanoi demo
authorKeith Packard <keithp@keithp.com>
Tue, 15 Nov 2016 05:27:41 +0000 (21:27 -0800)
committerKeith Packard <keithp@keithp.com>
Mon, 20 Feb 2017 19:16:51 +0000 (11:16 -0800)
Repaint in place, without first clearing. This makes the updates a lot
clealyer looking.

Signed-off-by: Keith Packard <keithp@keithp.com>
src/test/hanoi.lisp

index 2b614829a8f85ec6ce3e844b022fccc76b4dd11e..0c4bfca5cfb077b4f5d69ca6133bac8312d0c06a 100644 (file)
@@ -8,6 +8,8 @@
 
 (setq stack '("*" "**" "***" "****" "*****" "******" "*******"))
 
+(setq top (+ (length stack) 3))
+
 (setq stacks nil)
 
 (defun display-string (x y str)
   (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)
+            )
+          )
        )
   )
 
 
 (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)
   )