|
0
|
1 ;;; hanoi.el --- towers of hanoi in GNUmacs
|
|
|
2
|
|
|
3 ;; Author: Damon Anton Permezel
|
|
|
4 ;; Maintainer: FSF
|
|
|
5 ;; Keywords: games
|
|
|
6
|
|
|
7 ; Author (a) 1985, Damon Anton Permezel
|
|
|
8 ; This is in the public domain
|
|
|
9 ; since he distributed it without copyright notice in 1985.
|
|
|
10
|
|
72
|
11 ;; This file is part of XEmacs.
|
|
|
12
|
|
|
13 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
14 ;; under the terms of the GNU General Public License as published by
|
|
|
15 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
16 ;; any later version.
|
|
|
17
|
|
|
18 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
21 ;; General Public License for more details.
|
|
|
22
|
|
|
23 ;; You should have received a copy of the GNU General Public License
|
|
|
24 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
25 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
26 ;; 02111-1307, USA.
|
|
|
27
|
|
|
28 ;;; Synched up with: FSF 19.34.
|
|
0
|
29
|
|
|
30 ;;; Commentary:
|
|
|
31
|
|
|
32 ;; Solves the Towers of Hanoi puzzle while-U-wait.
|
|
|
33 ;;
|
|
|
34 ;; The puzzle: Start with N rings, decreasing in sizes from bottom to
|
|
|
35 ;; top, stacked around a post. There are two other posts. Your mission,
|
|
|
36 ;; should you choose to accept it, is to shift the pile, stacked in its
|
|
|
37 ;; original order, to another post.
|
|
|
38 ;;
|
|
|
39 ;; The challenge is to do it in the fewest possible moves. Each move
|
|
|
40 ;; shifts one ring to a different post. But there's a rule; you can
|
|
|
41 ;; only stack a ring on top of a larger one.
|
|
|
42 ;;
|
|
|
43 ;; The simplest nontrivial version of this puzzle is N = 3. Solution
|
|
|
44 ;; time rises as 2**N, and programs to solve it have long been considered
|
|
|
45 ;; classic introductory exercises in the use of recursion.
|
|
|
46 ;;
|
|
|
47 ;; The puzzle is called `Towers of Hanoi' because an early popular
|
|
|
48 ;; presentation wove a fanciful legend around it. According to this
|
|
|
49 ;; myth (uttered long before the Vietnam War), there is a Buddhist
|
|
|
50 ;; monastery at Hanoi which contains a large room with three time-worn
|
|
|
51 ;; posts in it surrounded by 21 golden discs. Monks, acting out the
|
|
|
52 ;; command of an ancient prophecy, have been moving these disks, in
|
|
|
53 ;; accordance with the rules of the puzzle, once every day since the
|
|
|
54 ;; monastery was founded over a thousand years ago. They are said
|
|
|
55 ;; believe that when the last move of the puzzle is completed, the
|
|
|
56 ;; world will end in a clap of thunder. Fortunately, they are nowhere
|
|
|
57 ;; even close to being done...
|
|
|
58
|
|
|
59 ;;; Code:
|
|
|
60
|
|
|
61 ;;;
|
|
|
62 ;;; hanoi-topos - direct cursor addressing
|
|
|
63 ;;;
|
|
|
64 (defun hanoi-topos (row col)
|
|
|
65 (goto-line row)
|
|
|
66 (beginning-of-line)
|
|
|
67 (forward-char col))
|
|
|
68
|
|
|
69 ;;;
|
|
|
70 ;;; hanoi - user callable Towers of Hanoi
|
|
|
71 ;;;
|
|
|
72 ;;;###autoload
|
|
|
73 (defun hanoi (nrings)
|
|
|
74 "Towers of Hanoi diversion. Argument is number of rings."
|
|
|
75 (interactive
|
|
|
76 (list (if (null current-prefix-arg)
|
|
72
|
77 3
|
|
|
78 (prefix-numeric-value current-prefix-arg))))
|
|
0
|
79 (if (<= nrings 0) (error "Negative number of rings"))
|
|
|
80 (let* (floor-row
|
|
|
81 fly-row
|
|
72
|
82 (window-height (1- (window-height (selected-window))))
|
|
0
|
83 (window-width (window-width (selected-window)))
|
|
|
84
|
|
72
|
85 ;; This is half the spacing to use between poles.
|
|
|
86 (pole-spacing (/ window-width 6)))
|
|
|
87 (if (not (and (> window-height (1+ nrings))
|
|
|
88 (> pole-spacing nrings)))
|
|
|
89 (progn
|
|
|
90 (delete-other-windows)
|
|
|
91 (if (not (and (> (setq window-height
|
|
|
92 (1- (window-height (selected-window))))
|
|
|
93 (1+ nrings))
|
|
|
94 (> (setq pole-spacing (/ window-width 6))
|
|
|
95 nrings)))
|
|
|
96 (error "Window is too small (need at least %dx%d)"
|
|
|
97 (* 6 (1+ nrings)) (+ 2 nrings)))))
|
|
|
98 (setq floor-row (if (> (- window-height 3) (1+ nrings))
|
|
|
99 (- window-height 3) window-height))
|
|
0
|
100 (let ((fly-row (- floor-row nrings 1))
|
|
|
101 ;; pole: column . fill height
|
|
72
|
102 (pole-1 (cons (1- pole-spacing) floor-row))
|
|
|
103 (pole-2 (cons (1- (* 3 pole-spacing)) floor-row))
|
|
|
104 (pole-3 (cons (1- (* 5 pole-spacing)) floor-row))
|
|
0
|
105 (rings (make-vector nrings nil)))
|
|
|
106 ;; construct the ring list
|
|
|
107 (let ((i 0))
|
|
|
108 (while (< i nrings)
|
|
|
109 ;; ring: [pole-number string empty-string]
|
|
|
110 (aset rings i (vector nil
|
|
72
|
111 (make-string (+ i i 3) (+ ?0 (% i 10)))
|
|
0
|
112 (make-string (+ i i 3) ?\ )))
|
|
|
113 (setq i (1+ i))))
|
|
|
114 ;;
|
|
|
115 ;; init the screen
|
|
|
116 ;;
|
|
|
117 (switch-to-buffer "*Hanoi*")
|
|
|
118 (setq buffer-read-only nil)
|
|
|
119 (buffer-disable-undo (current-buffer))
|
|
|
120 (erase-buffer)
|
|
|
121 (let ((i 0))
|
|
|
122 (while (< i floor-row)
|
|
|
123 (setq i (1+ i))
|
|
|
124 (insert-char ?\ (1- window-width))
|
|
|
125 (insert ?\n)))
|
|
|
126 (insert-char ?= (1- window-width))
|
|
|
127
|
|
|
128 (let ((n 1))
|
|
|
129 (while (< n 6)
|
|
72
|
130 (hanoi-topos fly-row (1- (* n pole-spacing)))
|
|
0
|
131 (setq n (+ n 2))
|
|
|
132 (let ((i fly-row))
|
|
|
133 (while (< i floor-row)
|
|
|
134 (setq i (1+ i))
|
|
|
135 (next-line 1)
|
|
|
136 (insert ?\|)
|
|
|
137 (delete-char 1)
|
|
|
138 (backward-char 1)))))
|
|
|
139 ;(sit-for 0)
|
|
|
140 ;;
|
|
|
141 ;; now draw the rings in their initial positions
|
|
|
142 ;;
|
|
|
143 (let ((i 0)
|
|
|
144 ring)
|
|
|
145 (while (< i nrings)
|
|
|
146 (setq ring (aref rings (- nrings 1 i)))
|
|
|
147 (aset ring 0 (- floor-row i))
|
|
|
148 (hanoi-topos (cdr pole-1)
|
|
|
149 (- (car pole-1) (- nrings i)))
|
|
|
150 (hanoi-draw-ring ring t nil)
|
|
|
151 (setcdr pole-1 (1- (cdr pole-1)))
|
|
|
152 (setq i (1+ i))))
|
|
|
153 (setq buffer-read-only t)
|
|
|
154 (sit-for 0)
|
|
72
|
155 ;; Disable display of line and column numbers, for speed.
|
|
|
156 (let ((line-number-mode nil)
|
|
|
157 (column-number-mode nil))
|
|
|
158 ;; do it!
|
|
|
159 (hanoi0 (1- nrings) pole-1 pole-2 pole-3))
|
|
0
|
160 (goto-char (point-min))
|
|
|
161 (message "Done")
|
|
|
162 (setq buffer-read-only t)
|
|
|
163 (force-mode-line-update)
|
|
|
164 (sit-for 0))))
|
|
|
165
|
|
|
166 ;;;
|
|
|
167 ;;; hanoi0 - work horse of hanoi
|
|
|
168 ;;;
|
|
|
169 (defun hanoi0 (n from to work)
|
|
|
170 (cond ((input-pending-p)
|
|
|
171 (signal 'quit (list "I can tell you've had enough")))
|
|
|
172 ((< n 0))
|
|
|
173 (t
|
|
|
174 (hanoi0 (1- n) from work to)
|
|
|
175 (hanoi-move-ring n from to)
|
|
|
176 (hanoi0 (1- n) work to from))))
|
|
|
177
|
|
|
178 ;;;
|
|
|
179 ;;; hanoi-move-ring - move ring 'n' from 'from' to 'to'
|
|
|
180 ;;;
|
|
|
181 ;;;
|
|
|
182 (defun hanoi-move-ring (n from to)
|
|
|
183 (let ((ring (aref rings n)) ; ring <- ring: (ring# . row)
|
|
|
184 (buffer-read-only nil))
|
|
|
185 (let ((row (aref ring 0)) ; row <- row ring is on
|
|
|
186 (col (- (car from) n 1)) ; col <- left edge of ring
|
|
|
187 (dst-col (- (car to) n 1)) ; dst-col <- dest col for left edge
|
|
|
188 (dst-row (cdr to))) ; dst-row <- dest row for ring
|
|
|
189 (hanoi-topos row col)
|
|
|
190 (while (> row fly-row) ; move up to the fly row
|
|
|
191 (hanoi-draw-ring ring nil t) ; blank out ring
|
|
|
192 (previous-line 1) ; move up a line
|
|
|
193 (hanoi-draw-ring ring t nil) ; redraw
|
|
|
194 (sit-for 0)
|
|
|
195 (setq row (1- row)))
|
|
|
196 (setcdr from (1+ (cdr from))) ; adjust top row
|
|
|
197 ;;
|
|
|
198 ;; fly the ring over to the right pole
|
|
|
199 ;;
|
|
|
200 (while (not (equal dst-col col))
|
|
|
201 (cond ((> dst-col col) ; dst-col > col: right shift
|
|
|
202 (end-of-line 1)
|
|
|
203 (delete-backward-char 2)
|
|
|
204 (beginning-of-line 1)
|
|
|
205 (insert ?\ ?\ )
|
|
|
206 (sit-for 0)
|
|
|
207 (setq col (1+ (1+ col))))
|
|
|
208 ((< dst-col col) ; dst-col < col: left shift
|
|
|
209 (beginning-of-line 1)
|
|
|
210 (delete-char 2)
|
|
|
211 (end-of-line 1)
|
|
|
212 (insert ?\ ?\ )
|
|
|
213 (sit-for 0)
|
|
|
214 (setq col (1- (1- col))))))
|
|
|
215 ;;
|
|
|
216 ;; let the ring float down
|
|
|
217 ;;
|
|
|
218 (hanoi-topos fly-row dst-col)
|
|
|
219 (while (< row dst-row) ; move down to the dest row
|
|
|
220 (hanoi-draw-ring ring nil (> row fly-row)) ; blank out ring
|
|
|
221 (next-line 1) ; move down a line
|
|
|
222 (hanoi-draw-ring ring t nil) ; redraw ring
|
|
|
223 (sit-for 0)
|
|
|
224 (setq row (1+ row)))
|
|
|
225 (aset ring 0 dst-row)
|
|
|
226 (setcdr to (1- (cdr to)))))) ; adjust top row
|
|
|
227
|
|
|
228 ;;;
|
|
|
229 ;;; draw-ring - draw the ring at point, leave point unchanged
|
|
|
230 ;;;
|
|
|
231 ;;; Input:
|
|
|
232 ;;; ring
|
|
|
233 ;;; f1 - flag: t -> draw, nil -> erase
|
|
|
234 ;;; f2 - flag: t -> erasing and need to draw ?\|
|
|
|
235 ;;;
|
|
|
236 (defun hanoi-draw-ring (ring f1 f2)
|
|
|
237 (save-excursion
|
|
|
238 (let* ((string (if f1 (aref ring 1) (aref ring 2)))
|
|
|
239 (len (length string)))
|
|
|
240 (delete-char len)
|
|
|
241 (insert string)
|
|
|
242 (if f2
|
|
|
243 (progn
|
|
|
244 (backward-char (/ (+ len 1) 2))
|
|
|
245 (delete-char 1) (insert ?\|))))))
|
|
|
246
|
|
|
247 (provide 'hanoi)
|
|
|
248
|
|
|
249 ;;; hanoi.el ends here
|
