X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Ftest%2Fhanoi.lisp;h=02e168768cd4894038c65596ba9c21615acfb4af;hb=5f9f97cc2d43936d1941da3a9a130c279bc70b99;hp=0c4bfca5cfb077b4f5d69ca6133bac8312d0c06a;hpb=13a4d451b903d08e52005bcf531efa8de351bf2b;p=fw%2Faltos diff --git a/src/test/hanoi.lisp b/src/test/hanoi.lisp index 0c4bfca5..02e16876 100644 --- a/src/test/hanoi.lisp +++ b/src/test/hanoi.lisp @@ -1,121 +1,163 @@ -(defun move-to (col row) - (patom "\033[" row ";" col "H" nil) +; +; Towers of Hanoi +; +; Copyright © 2016 Keith Packard +; +; 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 + +(define move-to (lambda (col row) + (for-each display (list "\033[" row ";" col "H")) + ) + ) + +(define clear (lambda () + (display "\033[2J") + ) ) -(defun clear () - (patom "\033[2J" nil) +(define display-string (lambda (x y str) + (move-to x y) + (display str) + ) ) -(setq stack '("*" "**" "***" "****" "*****" "******" "*******")) + ; Here's the pieces to display -(setq top (+ (length stack) 3)) +(define tower '(" * " " *** " " ***** " " ******* " " ********* " "***********")) -(setq stacks nil) + ; Here's all of the towers of pieces + ; This is generated when the program is run -(defun display-string (x y str) - (move-to x y) - (patom str) - ) +(define towers ()) + +(define one- (lambda (x) (- x 1))) +(define one+ (lambda (x) (+ x 1))) + ; Display one tower, 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)) +(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) - ) - ) - ) ) -(defun length (list) - (cond (list (1+ (length (cdr list)))) - (0) - ) - ) + ; 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)) + ) ) -(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))) - ) - ) - ) + ; Display all of the towers, spaced 20 columns apart -(defun display () - (display-stacks 0 top stacks) - (move-to 1 21) - (flush) +(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))) + ) + ) ) -(defun length (l) - (cond (l (1+ (length (cdr l)))) (0)) - ) +(define top 0) + ; Display all of the towers, then move the cursor + ; out of the way and flush the output -(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) + ) ) -(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) + ) ) -(defun replace (list pos member) - (cond ((= pos 0) (cons member (cdr list))) - ((cons (car list) (replace (cdr list) (1- pos) member))) - ) - ) + ; Replace a tower in the list of towers + ; with a new value -(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) - ) +(define replace (lambda (list pos member) + (cond ((= pos 0) (cons member (cdr list))) + ((cons (car list) (replace (cdr list) (one- pos) member))) + ) + ) ) -(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) - ) - ) - ) + ; 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) + ) + ) ) -(defun hanoi () - (setq len (reset-stacks)) - (clear) - (_hanoi len 0 1 2) +; The implementation of the game + +(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 + +(define hanoi (lambda () + (let ((len)) + (set! len (reset-towers)) + (clear) + (_hanoi len 0 1 2) + (move-to 0 23) + #t + ) + ) )