From 13a4d451b903d08e52005bcf531efa8de351bf2b Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Mon, 14 Nov 2016 21:27:41 -0800 Subject: [PATCH] altos/lisp: Improve hanoi demo Repaint in place, without first clearing. This makes the updates a lot clealyer looking. Signed-off-by: Keith Packard --- src/test/hanoi.lisp | 32 +++++++++++++++++--------------- 1 file 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) ) -- 2.30.2