1 ;;; hanoi.el --- towers of hanoi in GNUmacs
3 ;; Author: Damon Anton Permezel
7 ; Author (a) 1985, Damon Anton Permezel
8 ; This is in the public domain
9 ; since he distributed it without copyright notice in 1985.
13 ;; Solves the Towers of Hanoi puzzle while-U-wait.
15 ;; The puzzle: Start with N rings, decreasing in sizes from bottom to
16 ;; top, stacked around a post. There are two other posts. Your mission,
17 ;; should you choose to accept it, is to shift the pile, stacked in its
18 ;; original order, to another post.
20 ;; The challenge is to do it in the fewest possible moves. Each move
21 ;; shifts one ring to a different post. But there's a rule; you can
22 ;; only stack a ring on top of a larger one.
24 ;; The simplest nontrivial version of this puzzle is N = 3. Solution
25 ;; time rises as 2**N, and programs to solve it have long been considered
26 ;; classic introductory exercises in the use of recursion.
28 ;; The puzzle is called `Towers of Hanoi' because an early popular
29 ;; presentation wove a fanciful legend around it. According to this
30 ;; myth (uttered long before the Vietnam War), there is a Buddhist
31 ;; monastery at Hanoi which contains a large room with three time-worn
32 ;; posts in it surrounded by 21 golden discs. Monks, acting out the
33 ;; command of an ancient prophecy, have been moving these disks, in
34 ;; accordance with the rules of the puzzle, once every day since the
35 ;; monastery was founded over a thousand years ago. They are said
36 ;; believe that when the last move of the puzzle is completed, the
37 ;; world will end in a clap of thunder. Fortunately, they are nowhere
38 ;; even close to being done...
43 ;;; hanoi-topos - direct cursor addressing
45 (defun hanoi-topos (row col
)
51 ;;; hanoi - user callable Towers of Hanoi
55 "Towers of Hanoi diversion. Argument is number of rings."
57 (list (if (null current-prefix-arg
)
59 (prefix-numeric-value current-prefix-arg
))))
60 (if (<= nrings
0) (error "Negative number of rings"))
63 (window-height (window-height (selected-window)))
64 (window-width (window-width (selected-window)))
66 ;; This is the unit of spacing to use between poles. It
67 ;; must be even. We round down, since rounding up might
68 ;; cause us to draw off the edge of the window.
69 (pole-spacing (logand (/ window-width
6) (lognot 1))))
71 ;; The poles are (1+ NRINGS) rows high; we also want an
72 ;; empty row at the top for the flying rings, a base, and a
73 ;; blank line underneath that.
76 ;; If we have NRINGS rings, we label them with the numbers 0
77 ;; through NRINGS-1. The width of ring i is 2i+3; it pokes
78 ;; out i spaces on either side of the pole. Rather than
79 ;; checking if the window is wide enough to accommodate this,
80 ;; we make sure pole-spacing is large enough, since that
81 ;; works even when we have decremented pole-spacing to make
84 (if (not (and (>= window-height h
)
87 (delete-other-windows)
88 (if (not (and (>= (setq window-height
89 (window-height (selected-window)))
92 (logand (/ window-width
6) (lognot 1)))
94 (error "Screen is too small (need at least %dx%d)" w h
))))
95 (setq floor-row
(if (> (- window-height
3) h
)
96 (- window-height
3) window-height
)))
97 (let ((fly-row (- floor-row nrings
1))
98 ;; pole: column . fill height
99 (pole-1 (cons pole-spacing floor-row
))
100 (pole-2 (cons (* 3 pole-spacing
) floor-row
))
101 (pole-3 (cons (* 5 pole-spacing
) floor-row
))
102 (rings (make-vector nrings nil
)))
103 ;; construct the ring list
106 ;; ring: [pole-number string empty-string]
107 (aset rings i
(vector nil
108 (make-string (+ i i
3) (+ ?
0 i
))
109 (make-string (+ i i
3) ?\
)))
114 (switch-to-buffer "*Hanoi*")
115 (setq buffer-read-only nil
)
116 (buffer-disable-undo (current-buffer))
119 (while (< i floor-row
)
121 (insert-char ?\
(1- window-width
))
123 (insert-char ?
= (1- window-width
))
127 (hanoi-topos fly-row
(* n pole-spacing
))
130 (while (< i floor-row
)
135 (backward-char 1)))))
138 ;; now draw the rings in their initial positions
143 (setq ring
(aref rings
(- nrings
1 i
)))
144 (aset ring
0 (- floor-row i
))
145 (hanoi-topos (cdr pole-1
)
146 (- (car pole-1
) (- nrings i
)))
147 (hanoi-draw-ring ring t nil
)
148 (setcdr pole-1
(1- (cdr pole-1
)))
150 (setq buffer-read-only t
)
155 (hanoi0 (1- nrings
) pole-1 pole-2 pole-3
)
156 (goto-char (point-min))
158 (setq buffer-read-only t
)
159 (set-buffer-modified-p (buffer-modified-p))
163 ;;; hanoi0 - work horse of hanoi
165 (defun hanoi0 (n from to work
)
166 (cond ((input-pending-p)
167 (signal 'quit
(list "I can tell you've had enough")))
170 (hanoi0 (1- n
) from work to
)
171 (hanoi-move-ring n from to
)
172 (hanoi0 (1- n
) work to from
))))
175 ;;; hanoi-move-ring - move ring 'n' from 'from' to 'to'
178 (defun hanoi-move-ring (n from to
)
179 (let ((ring (aref rings n
)) ; ring <- ring: (ring# . row)
180 (buffer-read-only nil
))
181 (let ((row (aref ring
0)) ; row <- row ring is on
182 (col (- (car from
) n
1)) ; col <- left edge of ring
183 (dst-col (- (car to
) n
1)) ; dst-col <- dest col for left edge
184 (dst-row (cdr to
))) ; dst-row <- dest row for ring
185 (hanoi-topos row col
)
186 (while (> row fly-row
) ; move up to the fly row
187 (hanoi-draw-ring ring nil t
) ; blank out ring
188 (previous-line 1) ; move up a line
189 (hanoi-draw-ring ring t nil
) ; redraw
192 (setcdr from
(1+ (cdr from
))) ; adjust top row
194 ;; fly the ring over to the right pole
196 (while (not (equal dst-col col
))
197 (cond ((> dst-col col
) ; dst-col > col: right shift
199 (delete-backward-char 2)
200 (beginning-of-line 1)
203 (setq col
(1+ (1+ col
))))
204 ((< dst-col col
) ; dst-col < col: left shift
205 (beginning-of-line 1)
210 (setq col
(1- (1- col
))))))
212 ;; let the ring float down
214 (hanoi-topos fly-row dst-col
)
215 (while (< row dst-row
) ; move down to the dest row
216 (hanoi-draw-ring ring nil
(> row fly-row
)) ; blank out ring
217 (next-line 1) ; move down a line
218 (hanoi-draw-ring ring t nil
) ; redraw ring
221 (aset ring
0 dst-row
)
222 (setcdr to
(1- (cdr to
)))))) ; adjust top row
225 ;;; draw-ring - draw the ring at point, leave point unchanged
229 ;;; f1 - flag: t -> draw, nil -> erase
230 ;;; f2 - flag: t -> erasing and need to draw ?\|
232 (defun hanoi-draw-ring (ring f1 f2
)
234 (let* ((string (if f1
(aref ring
1) (aref ring
2)))
235 (len (length string
)))
240 (backward-char (/ (+ len
1) 2))
241 (delete-char 1) (insert ?\|
))))))
245 ;;; hanoi.el ends here