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 (lambda (col row)
20 (for-each display (list "\033[" row ";" col "H"))
24 (define clear (lambda ()
29 (define display-string (lambda (x y str)
35 ; Here's the pieces to display
37 (define tower '(" * " " *** " " ***** " " ******* " " ********* " "***********"))
39 ; Here's all of the towers of pieces
40 ; This is generated when the program is run
44 (define 1- (lambda (x) (- x 1)))
45 ; Display one tower, clearing any
48 (define display-tower (lambda (x y clear tower)
50 (cond ((not (null? tower))
51 (display-string x y (car tower))
52 (display-tower x (1+ y) 0 (cdr tower))
57 (display-string x y " ")
58 (display-tower x (1+ y) (1- clear) tower)
64 ; Position of the top of the tower on the screen
65 ; Shorter towers start further down the screen
67 (define tower-pos (lambda (y tower)
72 ; Display all of the towers, spaced 20 columns apart
74 (define display-towers (lambda (x y towers)
75 (cond ((not (null? towers))
76 (display-tower x 0 (tower-pos y (car towers)) (car towers))
77 (display-towers (+ x 20) y (cdr towers)))
83 ; Display all of the towers, then move the cursor
84 ; out of the way and flush the output
86 (define display-hanoi (lambda ()
87 (display-towers 0 top towers)
93 ; Reset towers to the starting state, with
94 ; all of the pieces in the first tower and the
97 (define reset-towers (lambda ()
98 (set! towers (list tower () ()))
99 (set! top (+ (length tower) 3))
104 ; Replace a tower in the list of towers
107 (define replace (lambda (list pos member)
108 (cond ((= pos 0) (cons member (cdr list)))
109 ((cons (car list) (replace (cdr list) (1- pos) member)))
114 ; Move a piece from the top of one tower
115 ; to the top of another
117 (define move-delay 10)
119 (define move-piece (lambda (from to)
120 (let* ((from-tower (list-ref towers from))
121 (to-tower (list-ref towers to))
122 (piece (car from-tower)))
123 (set! from-tower (cdr from-tower))
124 (set! to-tower (cons piece to-tower))
125 (set! towers (replace towers from from-tower))
126 (set! towers (replace towers to to-tower))
133 ; The implementation of the game
135 (define _hanoi (lambda (n from to use)
140 (_hanoi (1- n) from use to)
141 (_hanoi 1 from to use)
142 (_hanoi (1- n) use to from)
148 ; A pretty interface which
149 ; resets the state of the game,
150 ; clears the screen and runs
153 (define hanoi (lambda ()
155 (set! len (reset-towers))