; General Public License for more details.
;
+ ; ANSI control sequences
-; ANSI control sequences
-
-(defun move-to (col row)
- (patom "\033[" row ";" col "H" nil)
+(define (move-to col row)
+ (for-each display (list "\033[" row ";" col "H"))
)
-(defun clear ()
- (patom "\033[2J" nil)
+(define (clear)
+ (display "\033[2J")
)
-(defun display-string (x y str)
+(define (display-string x y str)
(move-to x y)
- (patom str)
+ (display str)
)
-; Here's the pieces to display
+ ; Here's the pieces to display
-(setq stack '("*" "**" "***" "****" "*****" "******" "*******"))
+(define tower '(" * " " *** " " ***** " " ******* " " ********* " "***********"))
-(setq top (+ (length stack) 3))
+ ; Here's all of the towers 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)
+(define towers ())
-; Display one stack, clearing any
-; space above it
+(define (one- x) (- x 1))
+(define (one+ x) (+ x 1))
+ ; Display one tower, clearing any
+ ; space above it
-(defun display-stack (x y clear stack)
+(define (display-tower x y clear tower)
(cond ((= 0 clear)
- (cond (stack (progn
- (display-string x y (car stack))
- (display-stack x (1+ y) 0 (cdr stack))
- )
- )
+ (cond ((not (null? tower))
+ (display-string x y (car tower))
+ (display-tower x (one+ y) 0 (cdr tower))
+ )
)
)
- (t (progn
- (display-string x y " ")
- (display-stack x (1+ y) (1- clear) stack)
- )
- )
- )
- )
-
-; This should probably be included in the rom image...
-
-(defun length (list)
- (cond (list (1+ (length (cdr list))))
- (0)
+ (else
+ (display-string x y " ")
+ (display-tower x (one+ y) (one- clear) tower)
+ )
)
)
-; Position of the top of the stack on the screen
-; Shorter stacks start further down the screen
+ ; Position of the top of the tower on the screen
+ ; Shorter towers start further down the screen
-(defun stack-pos (y stack)
- (- y (length stack))
+(define (tower-pos y tower)
+ (- y (length tower))
)
-; Display all of the stacks, spaced 20 columns apart
+ ; Display all of the towers, 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)))
- )
+(define (display-towers x y towers)
+ (cond ((not (null? towers))
+ (display-tower x 0 (tower-pos y (car towers)) (car towers))
+ (display-towers (+ x 20) y (cdr towers)))
)
)
-; Display all of the stacks, then move the cursor
-; out of the way and flush the output
+(define top 0)
+ ; Display all of the towers, then move the cursor
+ ; out of the way and flush the output
-(defun display ()
- (display-stacks 0 top stacks)
+(define (display-hanoi)
+ (display-towers 0 top towers)
(move-to 1 21)
- (flush)
+ (flush-output)
)
-; Reset stacks to the starting state, with
-; all of the pieces in the first stack and the
-; other two empty
+ ; Reset towers to the starting state, with
+ ; all of the pieces in the first tower and the
+ ; other two empty
-(defun reset-stacks ()
- (setq stacks (list stack nil nil))
- (length stack)
+(define (reset-towers)
+ (set! towers (list tower () ()))
+ (set! top (+ (length tower) 3))
+ (length tower)
)
-; more functions which could usefully
-; be in the rom image
+ ; Replace a tower in the list of towers
+ ; with a new value
-(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)
+(define (replace list pos member)
(cond ((= pos 0) (cons member (cdr list)))
- ((cons (car list) (replace (cdr list) (1- pos) member)))
+ (else (cons (car list) (replace (cdr list) (one- pos) member)))
)
)
-; 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))
- (piece (car from-stack)))
- (setq from-stack (cdr from-stack))
- (setq to-stack (cons piece to-stack))
- (setq stacks (replace stacks from from-stack))
- (setq stacks (replace stacks to to-stack))
- (display)
- (delay 100)
+ ; Move a piece from the top of one tower
+ ; to the top of another
+
+(define move-delay 10)
+
+(define (move-piece from to)
+ (let* ((from-tower (list-ref towers from))
+ (to-tower (list-ref towers to))
+ (piece (car from-tower)))
+ (set! from-tower (cdr from-tower))
+ (set! to-tower (cons piece to-tower))
+ (set! towers (replace towers from from-tower))
+ (set! towers (replace towers to to-tower))
+ (display-hanoi)
+ (delay move-delay)
)
)
; The implementation of the game
-(defun _hanoi (n from to use)
+(define (_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)
- )
+ (else
+ (_hanoi (one- n) from use to)
+ (_hanoi 1 from to use)
+ (_hanoi (one- n) use to from)
)
)
)
-; 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)
+ ; A pretty interface which
+ ; resets the state of the game,
+ ; clears the screen and runs
+ ; the program
+
+(define (hanoi)
+ (let ((len (reset-towers)))
+ (clear)
+ (_hanoi len 0 1 2)
+ (move-to 0 23)
+ #t
+ )
+ )
)