; 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)
(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)
(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))
(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)
)
)
-; 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)))
)
)
-; 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))
(setq stacks (replace stacks from from-stack))
(setq stacks (replace stacks to to-stack))
(display)
-; (delay 100)
+ (delay move-delay)
)
)
(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)
- )
-
-(defun hanois(n)
- (while (> n 0)
- (progn
- (hanoi)
- (setq l (1- l))
- )
- )
+ (move-to 0 23)
+ t
)