4 ; Copyright © 2016 Keith Packard <keithp@keithp.com>
6 ; This program is free software; you can redistribute it and/or modify
7 ; it under the terms of the GNU General Public License as published by
8 ; the Free Software Foundation, either version 2 of the License, or
9 ; (at your option) any later version.
11 ; This program is distributed in the hope that it will be useful, but
12 ; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ; General Public License for more details.
17 ; ANSI control sequences
19 (define (move-to col row)
20 (for-each display (list "\033[" row ";" col "H"))
27 (define (display-string x y str)
32 (define (make-piece num max)
33 ; A piece for position 'num'
34 ; is num + 1 + num stars
35 ; centered in a field of max *
36 ; 2 + 1 characters with spaces
37 ; on either side. This way,
38 ; every piece is the same
39 ; number of characters
43 (+ c (chars (- n 1) c))
46 (+ (chars (- max num 1) " ")
47 (chars (+ (* num 2) 1) "*")
48 (chars (- max num 1) " ")
52 (define (make-pieces max)
53 ; Make a list of numbers from 0 to max-1
54 (define (nums cur max)
56 (cons cur (nums (+ cur 1) max))
59 ; Create a list of pieces
61 (map (lambda (x) (make-piece x max)) (nums 0 max))
64 ; Here's all of the towers of pieces
65 ; This is generated when the program is run
69 ; position of the bottom of
70 ; the stacks set at runtime
74 (define move-delay 25)
76 ; Display one tower, clearing any
79 (define (display-tower x y clear tower)
81 (cond ((not (null? tower))
82 (display-string x y (car tower))
83 (display-tower x (+ y 1) 0 (cdr tower))
88 (display-string x y " ")
89 (display-tower x (+ y 1) (- clear 1) tower)
94 ; Position of the top of the tower on the screen
95 ; Shorter towers start further down the screen
97 (define (tower-pos tower)
98 (- bottom-y (length tower))
101 ; Display all of the towers, spaced 20 columns apart
103 (define (display-towers x towers)
104 (cond ((not (null? towers))
105 (display-tower x 0 (tower-pos (car towers)) (car towers))
106 (display-towers (+ x 20) (cdr towers)))
110 ; Display all of the towers, then move the cursor
111 ; out of the way and flush the output
113 (define (display-hanoi)
114 (display-towers left-x towers)
120 ; Reset towers to the starting state, with
121 ; all of the pieces in the first tower and the
124 (define (reset-towers len)
125 (set! towers (list (make-pieces len) () ()))
126 (set! bottom-y (+ len 3))
129 ; Move a piece from the top of one tower
130 ; to the top of another
132 (define (move-piece from to)
134 ; references to the cons holding the two towers
136 (define from-tower (list-tail towers from))
137 (define to-tower (list-tail towers to))
139 ; stick the car of from-tower onto to-tower
141 (set-car! to-tower (cons (caar from-tower) (car to-tower)))
143 ; remove the car of from-tower
145 (set-car! from-tower (cdar from-tower))
148 ; The implementation of the game
150 (define (_hanoi n from to use)
156 (_hanoi (- n 1) from use to)
157 (_hanoi 1 from to use)
158 (_hanoi (- n 1) use to from)
163 ; A pretty interface which
164 ; resets the state of the game,
165 ; clears the screen and runs