+;
+; Towers of Hanoi
+;
+; Copyright © 2016 Keith Packard <keithp@keithp.com>
+;
+; This program is free software; you can redistribute it and/or modify
+; it under the terms of the GNU General Public License as published by
+; the Free Software Foundation, either version 2 of the License, or
+; (at your option) any later version.
+;
+; This program is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+; General Public License for more details.
+;
+
+
+; ANSI control sequences
+
(defun move-to (col row)
(patom "\033[" row ";" col "H" nil)
)
(patom "\033[2J" nil)
)
-(defun test ()
- (clear)
- (move-to 30 12)
- (patom "hello, world")
- (move-to 0 19)
- )
-
-(setq stack '("*" "**" "***" "****" "*****" "******" "*******"))
-
-(setq stacks nil)
-
(defun display-string (x y str)
- (move-to x y)
(move-to x y)
(patom str)
)
-(defun display-stack (x y stack)
- (cond (stack (progn
- (display-string x y (car stack))
- (display-stack x (1+ y) (cdr stack)))))
- )
+; Here's the pieces to display
+
+(setq stack '(" * " " *** " " ***** " " ******* " " ********* " "***********"))
-(defun clear-stack (x y)
- (cond ((> y 0) (progn
- (move-to x y)
- (patom " ")
- (clear-stack x (1- y))
- )
+;
+; 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
+
+(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 length (list)
- (cond (list (1+ (length (cdr list))))
- (0)
- )
- )
+; 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
+
(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)))
)
)
)
+; Display all of the stacks, then move the cursor
+; out of the way and flush the output
+
(defun display ()
- (display-stacks 0 20 stacks)
+ (display-stacks 0 top stacks)
(move-to 1 21)
(flush)
)
-(defun length (l)
- (cond (l (1+ (length (cdr l)))) (0))
- )
+; 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))
+ (setq top (+ (length stack) 3))
(length stack)
)
+; more functions which could usefully
+; be in the rom image
+
(defun min (a b)
(cond ((< a b) a)
(b)
)
)
-(defun nth (list n)
- (cond ((= n 0) (car list))
- ((nth (cdr list) (1- n)))
- )
- )
+; 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
+
(defun move-piece (from to)
(let ((from-stack (nth stacks from))
(to-stack (nth stacks to))
(setq stacks (replace stacks from from-stack))
(setq stacks (replace stacks to to-stack))
(display)
- (delay 100)
+; (delay 100)
)
)
+; The implementation of the game
+
(defun _hanoi (n from to use)
(cond ((= 1 n)
(progn
)
)
+; 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)
)
-(hanoi)
+(defun hanois(n)
+ (while (> n 0)
+ (progn
+ (hanoi)
+ (setq l (1- l))
+ )
+ )
+ )