X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Ftest%2Fhanoi.lisp;h=02e168768cd4894038c65596ba9c21615acfb4af;hb=5f9f97cc2d43936d1941da3a9a130c279bc70b99;hp=66a8d04bc6b4dbbec4757bf7e59722424ec1e5be;hpb=994adc7a47cbf3cbf6041eca7430273f8018de08;p=fw%2Faltos diff --git a/src/test/hanoi.lisp b/src/test/hanoi.lisp index 66a8d04b..02e16876 100644 --- a/src/test/hanoi.lisp +++ b/src/test/hanoi.lisp @@ -14,154 +14,150 @@ ; 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 (lambda (col row) + (for-each display (list "\033[" row ";" col "H")) + ) ) -(defun clear () - (patom "\033[2J" nil) +(define clear (lambda () + (display "\033[2J") + ) ) -(defun display-string (x y str) - (move-to x y) - (patom str) +(define display-string (lambda (x y str) + (move-to x y) + (display str) + ) ) -; Here's the pieces to display - -(setq stack '("*" "**" "***" "****" "*****" "******" "*******")) - -(setq top (+ (length stack) 3)) - -; -; 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)) + ; Here's the pieces to display + +(define tower '(" * " " *** " " ***** " " ******* " " ********* " "***********")) + + ; Here's all of the towers of pieces + ; This is generated when the program is run + +(define towers ()) + +(define one- (lambda (x) (- x 1))) +(define one+ (lambda (x) (+ x 1))) + ; Display one tower, clearing any + ; space above it + +(define display-tower (lambda (x y clear tower) + (cond ((= 0 clear) + (cond ((not (null? tower)) + (display-string x y (car tower)) + (display-tower x (one+ y) 0 (cdr tower)) + ) + ) + ) + (else + (display-string x y " ") + (display-tower x (one+ y) (one- clear) tower) + ) + ) ) - ) - ) - ) - (t (progn - (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 tower on the screen + ; Shorter towers start further down the screen -(defun stack-pos (y stack) - (- y (length stack)) +(define tower-pos (lambda (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 (lambda (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) - (move-to 1 21) - (flush) - ) - -; 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) +(define display-hanoi (lambda () + (display-towers 0 top towers) + (move-to 1 21) + (flush-output) + ) ) -; more functions which could usefully -; be in the rom image - -(defun min (a b) - (cond ((< a b) a) - (b) - ) - ) + ; Reset towers to the starting state, with + ; all of the pieces in the first tower and the + ; other two empty -(defun nth (list n) - (cond ((= n 0) (car list)) - ((nth (cdr list) (1- n))) - ) +(define reset-towers (lambda () + (set! towers (list tower () ())) + (set! top (+ (length tower) 3)) + (length tower) + ) ) -; Replace a stack in the list of stacks -; with a new value + ; Replace a tower in the list of towers + ; with a new value -(defun replace (list pos member) - (cond ((= pos 0) (cons member (cdr list))) - ((cons (car list) (replace (cdr list) (1- pos) member))) - ) +(define replace (lambda (list pos member) + (cond ((= pos 0) (cons member (cdr list))) + ((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 (lambda (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) - (cond ((= 1 n) - (progn - (move-piece from to) - nil) - ) - (t - (progn - (_hanoi (1- n) from use to) - (_hanoi 1 from to use) - (_hanoi (1- n) use to from) - ) - ) - ) +(define _hanoi (lambda (n from to use) + (cond ((= 1 n) + (move-piece from to) + ) + (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 (lambda () + (let ((len)) + (set! len (reset-towers)) + (clear) + (_hanoi len 0 1 2) + (move-to 0 23) + #t + ) + ) )