1 #!/home/keithp/bin/ao-scheme
5 ; Copyright © 2016 Keith Packard <keithp@keithp.com>
7 ; This program is free software; you can redistribute it and/or modify
8 ; it under the terms of the GNU General Public License as published by
9 ; the Free Software Foundation, either version 2 of the License, or
10 ; (at your option) any later version.
12 ; This program is distributed in the hope that it will be useful, but
13 ; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ; General Public License for more details.
18 ; ANSI control sequences
20 (define (move-to col row)
21 (for-each display (list "\033[" row ";" col "H"))
28 (define (display-string x y str)
33 (define (make-piece num max)
34 ; A piece for position 'num'
35 ; is num + 1 + num stars
36 ; centered in a field of max *
37 ; 2 + 1 characters with spaces
38 ; on either side. This way,
39 ; every piece is the same
40 ; number of characters
44 (+ c (chars (- n 1) c))
47 (+ (chars (- max num 1) " ")
48 (chars (+ (* num 2) 1) "*")
49 (chars (- max num 1) " ")
53 (define (make-pieces max)
54 ; Make a list of numbers from 0 to max-1
55 (define (nums cur max)
57 (cons cur (nums (+ cur 1) max))
60 ; Create a list of pieces
62 (map (lambda (x) (make-piece x max)) (nums 0 max))
65 ; Here's all of the towers of pieces
66 ; This is generated when the program is run
70 ; position of the bottom of
71 ; the stacks set at runtime
75 (define move-delay 25)
77 ; Display one tower, clearing any
80 (define (display-tower x y clear tower)
82 (cond ((not (null? tower))
83 (display-string x y (car tower))
84 (display-tower x (+ y 1) 0 (cdr tower))
89 (display-string x y " ")
90 (display-tower x (+ y 1) (- clear 1) tower)
95 ; Position of the top of the tower on the screen
96 ; Shorter towers start further down the screen
98 (define (tower-pos tower)
99 (- bottom-y (length tower))
102 ; Display all of the towers, spaced 20 columns apart
104 (define (display-towers x towers)
105 (cond ((not (null? towers))
106 (display-tower x 0 (tower-pos (car towers)) (car towers))
107 (display-towers (+ x 20) (cdr towers)))
111 ; Display all of the towers, then move the cursor
112 ; out of the way and flush the output
114 (define (display-hanoi)
115 (display-towers left-x towers)
121 ; Reset towers to the starting state, with
122 ; all of the pieces in the first tower and the
125 (define (reset-towers len)
126 (set! towers (list (make-pieces len) () ()))
127 (set! bottom-y (+ len 3))
130 ; Move a piece from the top of one tower
131 ; to the top of another
133 (define (move-piece from to)
135 ; references to the cons holding the two towers
137 (define from-tower (list-tail towers from))
138 (define to-tower (list-tail towers to))
140 ; stick the car of from-tower onto to-tower
142 (set-car! to-tower (cons (caar from-tower) (car to-tower)))
144 ; remove the car of from-tower
146 (set-car! from-tower (cdar from-tower))
149 ; The implementation of the game
151 (define (_hanoi n from to use)
157 (_hanoi (- n 1) from use to)
158 (_hanoi 1 from to use)
159 (_hanoi (- n 1) use to from)
164 ; A pretty interface which
165 ; resets the state of the game,
166 ; clears the screen and runs
177 (unless (null? (command-line)) (hanoi 6))