Commit | Line | Data |
---|---|---|
1a06eabd ER |
1 | ;;; hanoi.el --- towers of hanoi in GNUmacs |
2 | ||
fc68affa ER |
3 | ;; Author: Damon Anton Permezel |
4 | ;; Maintainer: FSF | |
fc68affa ER |
5 | ;; Keywords: games |
6 | ||
80a677d9 | 7 | ; Author (a) 1985, Damon Anton Permezel |
2f4b997c RS |
8 | ; This is in the public domain |
9 | ; since he distributed it without copyright notice in 1985. | |
80a677d9 | 10 | |
e41b2db1 ER |
11 | ;;; Commentary: |
12 | ||
13 | ;; Solves the Towers of Hanoi puzzle while-U-wait. | |
14 | ;; | |
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. | |
19 | ;; | |
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. | |
23 | ;; | |
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. | |
27 | ;; | |
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... | |
39 | ||
fc68affa ER |
40 | ;;; Code: |
41 | ||
80a677d9 JA |
42 | ;;; |
43 | ;;; hanoi-topos - direct cursor addressing | |
44 | ;;; | |
45 | (defun hanoi-topos (row col) | |
46 | (goto-line row) | |
47 | (beginning-of-line) | |
48 | (forward-char col)) | |
49 | ||
50 | ;;; | |
51 | ;;; hanoi - user callable Towers of Hanoi | |
52 | ;;; | |
f9f9507e | 53 | ;;;###autoload |
80a677d9 JA |
54 | (defun hanoi (nrings) |
55 | "Towers of Hanoi diversion. Argument is number of rings." | |
56 | (interactive | |
57 | (list (if (null current-prefix-arg) | |
58 | 3 | |
59 | (prefix-numeric-value current-prefix-arg)))) | |
60 | (if (<= nrings 0) (error "Negative number of rings")) | |
84df0b37 JB |
61 | (let* (floor-row |
62 | fly-row | |
63 | (window-height (window-height (selected-window))) | |
64 | (window-width (window-width (selected-window))) | |
65 | ||
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)))) | |
70 | (let ( | |
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. | |
74 | (h (+ nrings 4)) | |
75 | ||
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 | |
eb8c3be9 | 79 | ;; checking if the window is wide enough to accommodate this, |
84df0b37 JB |
80 | ;; we make sure pole-spacing is large enough, since that |
81 | ;; works even when we have decremented pole-spacing to make | |
82 | ;; it even. | |
83 | (w (1+ nrings))) | |
84 | (if (not (and (>= window-height h) | |
85 | (> pole-spacing w))) | |
80a677d9 JA |
86 | (progn |
87 | (delete-other-windows) | |
88 | (if (not (and (>= (setq window-height | |
84df0b37 JB |
89 | (window-height (selected-window))) |
90 | h) | |
91 | (> (setq pole-spacing | |
92 | (logand (/ window-width 6) (lognot 1))) | |
93 | w))) | |
80a677d9 | 94 | (error "Screen is too small (need at least %dx%d)" w h)))) |
80a677d9 JA |
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 | |
104 | (let ((i 0)) | |
105 | (while (< i nrings) | |
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) ?\ ))) | |
110 | (setq i (1+ i)))) | |
111 | ;; | |
112 | ;; init the screen | |
113 | ;; | |
114 | (switch-to-buffer "*Hanoi*") | |
115 | (setq buffer-read-only nil) | |
116 | (buffer-disable-undo (current-buffer)) | |
117 | (erase-buffer) | |
118 | (let ((i 0)) | |
119 | (while (< i floor-row) | |
120 | (setq i (1+ i)) | |
121 | (insert-char ?\ (1- window-width)) | |
122 | (insert ?\n))) | |
123 | (insert-char ?= (1- window-width)) | |
124 | ||
125 | (let ((n 1)) | |
126 | (while (< n 6) | |
127 | (hanoi-topos fly-row (* n pole-spacing)) | |
128 | (setq n (+ n 2)) | |
129 | (let ((i fly-row)) | |
130 | (while (< i floor-row) | |
131 | (setq i (1+ i)) | |
132 | (next-line 1) | |
133 | (insert ?\|) | |
134 | (delete-char 1) | |
135 | (backward-char 1))))) | |
136 | ;(sit-for 0) | |
137 | ;; | |
138 | ;; now draw the rings in their initial positions | |
139 | ;; | |
140 | (let ((i 0) | |
141 | ring) | |
142 | (while (< i nrings) | |
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))) | |
149 | (setq i (1+ i)))) | |
150 | (setq buffer-read-only t) | |
151 | (sit-for 0) | |
152 | ;; | |
153 | ;; do it! | |
154 | ;; | |
155 | (hanoi0 (1- nrings) pole-1 pole-2 pole-3) | |
156 | (goto-char (point-min)) | |
157 | (message "Done") | |
158 | (setq buffer-read-only t) | |
433c31eb | 159 | (force-mode-line-update) |
80a677d9 JA |
160 | (sit-for 0)))) |
161 | ||
162 | ;;; | |
163 | ;;; hanoi0 - work horse of hanoi | |
164 | ;;; | |
165 | (defun hanoi0 (n from to work) | |
166 | (cond ((input-pending-p) | |
167 | (signal 'quit (list "I can tell you've had enough"))) | |
168 | ((< n 0)) | |
169 | (t | |
170 | (hanoi0 (1- n) from work to) | |
171 | (hanoi-move-ring n from to) | |
172 | (hanoi0 (1- n) work to from)))) | |
173 | ||
174 | ;;; | |
175 | ;;; hanoi-move-ring - move ring 'n' from 'from' to 'to' | |
176 | ;;; | |
177 | ;;; | |
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 | |
190 | (sit-for 0) | |
191 | (setq row (1- row))) | |
192 | (setcdr from (1+ (cdr from))) ; adjust top row | |
193 | ;; | |
194 | ;; fly the ring over to the right pole | |
195 | ;; | |
196 | (while (not (equal dst-col col)) | |
197 | (cond ((> dst-col col) ; dst-col > col: right shift | |
198 | (end-of-line 1) | |
199 | (delete-backward-char 2) | |
200 | (beginning-of-line 1) | |
201 | (insert ?\ ?\ ) | |
202 | (sit-for 0) | |
203 | (setq col (1+ (1+ col)))) | |
204 | ((< dst-col col) ; dst-col < col: left shift | |
205 | (beginning-of-line 1) | |
206 | (delete-char 2) | |
207 | (end-of-line 1) | |
208 | (insert ?\ ?\ ) | |
209 | (sit-for 0) | |
210 | (setq col (1- (1- col)))))) | |
211 | ;; | |
212 | ;; let the ring float down | |
213 | ;; | |
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 | |
219 | (sit-for 0) | |
220 | (setq row (1+ row))) | |
221 | (aset ring 0 dst-row) | |
222 | (setcdr to (1- (cdr to)))))) ; adjust top row | |
223 | ||
224 | ;;; | |
225 | ;;; draw-ring - draw the ring at point, leave point unchanged | |
226 | ;;; | |
227 | ;;; Input: | |
228 | ;;; ring | |
229 | ;;; f1 - flag: t -> draw, nil -> erase | |
230 | ;;; f2 - flag: t -> erasing and need to draw ?\| | |
231 | ;;; | |
232 | (defun hanoi-draw-ring (ring f1 f2) | |
233 | (save-excursion | |
234 | (let* ((string (if f1 (aref ring 1) (aref ring 2))) | |
235 | (len (length string))) | |
236 | (delete-char len) | |
237 | (insert string) | |
238 | (if f2 | |
239 | (progn | |
240 | (backward-char (/ (+ len 1) 2)) | |
241 | (delete-char 1) (insert ?\|)))))) | |
242 | ||
62daf326 RM |
243 | (provide 'hanoi) |
244 | ||
245 | ;;; hanoi.el ends here |