diff options
| author | Keith Packard <keithp@keithp.com> | 2017-12-05 10:38:14 -0800 | 
|---|---|---|
| committer | Keith Packard <keithp@keithp.com> | 2017-12-05 10:40:12 -0800 | 
| commit | bd7a19a86f6d4fe19c7e72904e9b8ac0f2081ff7 (patch) | |
| tree | 0797b4cf2828d0ba810d043d9eb8f969aa4d5450 /src/test/hanoi.lisp | |
| parent | 195cbeec19a6a44f309a9040d727d37fe4e2ec97 (diff) | |
altos/scheme: Move scheme test program to scheme sub-directory
Keeps it away from the usual test setup
Signed-off-by: Keith Packard <keithp@keithp.com>
Diffstat (limited to 'src/test/hanoi.lisp')
| -rw-r--r-- | src/test/hanoi.lisp | 151 | 
1 files changed, 0 insertions, 151 deletions
| diff --git a/src/test/hanoi.lisp b/src/test/hanoi.lisp deleted file mode 100644 index 4afde883..00000000 --- a/src/test/hanoi.lisp +++ /dev/null @@ -1,151 +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) -  ) - -					; 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- x) (- x 1)) -(define (one+ x) (+ x 1)) -					; 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 (one+ y) 0 (cdr tower)) -		) -	       ) -	 ) -	(else  -	 (display-string x y "                   ") -	 (display-tower x (one+ y) (one- clear) tower) -	 ) -	) -  ) - -					; Position of the top of the tower on the screen -					; Shorter towers start further down the screen - -(define (tower-pos y tower) -  (- y (length tower)) -  ) - -					; Display all of the towers, spaced 20 columns apart - -(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))) -	) -  ) - -(define top 0) -					; Display all of the towers, then move the cursor -					; out of the way and flush the output - -(define (display-hanoi) -  (display-towers 0 top towers) -  (move-to 1 21) -  (flush-output) -  ) - -					; Reset towers to the starting state, with -					; all of the pieces in the first tower and the -					; other two empty - -(define (reset-towers) -  (set! towers (list tower () ())) -  (set! top (+ (length tower) 3)) -  (length tower) -  ) - -					; Replace a tower in the list of towers -					; with a new value - -(define (replace list pos member) -  (cond ((= pos 0) (cons member (cdr list))) -	(else (cons (car list) (replace (cdr list) (one- pos) member))) -	) -  ) - -					; 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 - -(define (_hanoi 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) -  (let ((len (reset-towers))) -    (clear) -    (_hanoi len 0 1 2) -    (move-to 0 23) -    #t -    ) -  ) -  ) | 
