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 ; Here's the pieces to display
34 (define tower '(" * " " *** " " ***** " " ******* " " ********* " "***********"))
36 ; Here's all of the towers of pieces
37 ; This is generated when the program is run
41 (define (one- x) (- x 1))
42 (define (one+ x) (+ x 1))
43 ; Display one tower, clearing any
46 (define (display-tower x y clear tower)
48 (cond ((not (null? tower))
49 (display-string x y (car tower))
50 (display-tower x (one+ y) 0 (cdr tower))
55 (display-string x y " ")
56 (display-tower x (one+ y) (one- clear) tower)
61 ; Position of the top of the tower on the screen
62 ; Shorter towers start further down the screen
64 (define (tower-pos y tower)
68 ; Display all of the towers, spaced 20 columns apart
70 (define (display-towers x y towers)
71 (cond ((not (null? towers))
72 (display-tower x 0 (tower-pos y (car towers)) (car towers))
73 (display-towers (+ x 20) y (cdr towers)))
78 ; Display all of the towers, then move the cursor
79 ; out of the way and flush the output
81 (define (display-hanoi)
82 (display-towers 0 top towers)
87 ; Reset towers to the starting state, with
88 ; all of the pieces in the first tower and the
91 (define (reset-towers)
92 (set! towers (list tower () ()))
93 (set! top (+ (length tower) 3))
97 ; Replace a tower in the list of towers
100 (define (replace list pos member)
101 (cond ((= pos 0) (cons member (cdr list)))
102 (else (cons (car list) (replace (cdr list) (one- pos) member)))
106 ; Move a piece from the top of one tower
107 ; to the top of another
109 (define move-delay 10)
111 (define (move-piece from to)
112 (let* ((from-tower (list-ref towers from))
113 (to-tower (list-ref towers to))
114 (piece (car from-tower)))
115 (set! from-tower (cdr from-tower))
116 (set! to-tower (cons piece to-tower))
117 (set! towers (replace towers from from-tower))
118 (set! towers (replace towers to to-tower))
124 ; The implementation of the game
126 (define (_hanoi n from to use)
131 (_hanoi (one- n) from use to)
132 (_hanoi 1 from to use)
133 (_hanoi (one- n) use to from)
138 ; A pretty interface which
139 ; resets the state of the game,
140 ; clears the screen and runs
144 (let ((len (reset-towers)))