diff options
Diffstat (limited to 'src/scheme/test/hanoi.scheme')
| -rw-r--r-- | src/scheme/test/hanoi.scheme | 174 | 
1 files changed, 0 insertions, 174 deletions
| diff --git a/src/scheme/test/hanoi.scheme b/src/scheme/test/hanoi.scheme deleted file mode 100644 index c4ae7378..00000000 --- a/src/scheme/test/hanoi.scheme +++ /dev/null @@ -1,174 +0,0 @@ -; -; 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 - -(define (move-to col row) -  (for-each display (list "\033[" row ";" col "H")) -  ) - -(define (clear) -  (display "\033[2J") -  ) - -(define (display-string x y str) -  (move-to x y) -  (display str) -  ) - -(define (make-piece num max) -					; A piece for position 'num' -					; is num + 1 + num stars -					; centered in a field of max * -					; 2 + 1 characters with spaces -					; on either side. This way, -					; every piece is the same -					; number of characters - -  (define (chars n c) -    (if (zero? n) "" -      (+ c (chars (- n 1) c)) -      ) -    ) -  (+ (chars (- max num 1) " ") -     (chars (+ (* num 2) 1) "*") -     (chars (- max num 1) " ") -     ) -  ) - -(define (make-pieces max) -					; Make a list of numbers from 0 to max-1 -  (define (nums cur max) -    (if (= cur max) () -      (cons cur (nums (+ cur 1) max)) -      ) -    ) -					; Create a list of pieces - -  (map (lambda (x) (make-piece x max)) (nums 0 max)) -  ) - -					; Here's all of the towers of pieces -					; This is generated when the program is run - -(define towers ()) - -					; position of the bottom of -					; the stacks set at runtime -(define bottom-y 0) -(define left-x 0) - -(define move-delay 25) - -					; Display one tower, clearing any -					; space above it - -(define (display-tower x y clear tower) -  (cond ((= 0 clear) -	 (cond ((not (null? tower)) -		(display-string x y (car tower)) -		(display-tower x (+ y 1) 0 (cdr tower)) -		) -	       ) -	 ) -	(else  -	 (display-string x y "                    ") -	 (display-tower x (+ y 1) (- clear 1) tower) -	 ) -	) -  ) - -					; Position of the top of the tower on the screen -					; Shorter towers start further down the screen - -(define (tower-pos tower) -  (- bottom-y (length tower)) -  ) - -					; Display all of the towers, spaced 20 columns apart - -(define (display-towers x towers) -  (cond ((not (null? towers)) -	 (display-tower x 0 (tower-pos (car towers)) (car towers)) -	 (display-towers (+ x 20) (cdr towers))) -	) -  ) - -					; Display all of the towers, then move the cursor -					; out of the way and flush the output - -(define (display-hanoi) -  (display-towers left-x towers) -  (move-to 1 23) -  (flush-output) -  (delay move-delay) -  ) - -					; Reset towers to the starting state, with -					; all of the pieces in the first tower and the -					; other two empty - -(define (reset-towers len) -  (set! towers (list (make-pieces len) () ())) -  (set! bottom-y (+ len 3)) -  ) - -					; Move a piece from the top of one tower -					; to the top of another - -(define (move-piece from to) - -					; references to the cons holding the two towers - -  (define from-tower (list-tail towers from)) -  (define to-tower (list-tail towers to)) - -					; stick the car of from-tower onto to-tower - -  (set-car! to-tower (cons (caar from-tower) (car to-tower))) - -					; remove the car of from-tower - -  (set-car! from-tower (cdar from-tower)) -  ) - -					; The implementation of the game - -(define (_hanoi n from to use) -  (cond ((= 1 n) -	 (move-piece from to) -	 (display-hanoi) -	 ) -	(else -	 (_hanoi (- n 1) from use to) -	 (_hanoi 1 from to use) -	 (_hanoi (- n 1) use to from) -	 ) -	) -  ) - -					; A pretty interface which -					; resets the state of the game, -					; clears the screen and runs -					; the program - -(define (hanoi len) -  (reset-towers len) -  (clear) -  (display-hanoi) -  (_hanoi len 0 1 2) -  #t -  ) | 
