Mercurial > emacs
annotate lisp/play/hanoi.el @ 15314:796d825f4444
(reset_modifiers): Only clear a modifier if the modifier key has been
detected to have been released since Emacs lost focus.
(win32_wnd_proc): Have Windows translate VK_NUMLOCK and VK_SCROLL key
downs; don't reset the modifier state when Emacs loses focus.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sat, 01 Jun 1996 12:19:27 +0000 |
parents | ca1ee2b8394e |
children | 9f7a9dceb11b |
rev | line source |
---|---|
660
08eb386dd0f3
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
1 ;;; hanoi.el --- towers of hanoi in GNUmacs |
08eb386dd0f3
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
2 |
793
6fb68a1460a6
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
3 ;; Author: Damon Anton Permezel |
6fb68a1460a6
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
4 ;; Maintainer: FSF |
6fb68a1460a6
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
5 ;; Keywords: games |
6fb68a1460a6
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
6 |
53 | 7 ; Author (a) 1985, Damon Anton Permezel |
663
3587b3dfac25
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
8 ; This is in the public domain |
3587b3dfac25
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
9 ; since he distributed it without copyright notice in 1985. |
53 | 10 |
2307
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
11 ;;; Commentary: |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
12 |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
13 ;; Solves the Towers of Hanoi puzzle while-U-wait. |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
14 ;; |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
15 ;; The puzzle: Start with N rings, decreasing in sizes from bottom to |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
16 ;; top, stacked around a post. There are two other posts. Your mission, |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
17 ;; should you choose to accept it, is to shift the pile, stacked in its |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
18 ;; original order, to another post. |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
19 ;; |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
20 ;; The challenge is to do it in the fewest possible moves. Each move |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
21 ;; shifts one ring to a different post. But there's a rule; you can |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
22 ;; only stack a ring on top of a larger one. |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
23 ;; |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
24 ;; The simplest nontrivial version of this puzzle is N = 3. Solution |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
25 ;; time rises as 2**N, and programs to solve it have long been considered |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
26 ;; classic introductory exercises in the use of recursion. |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
27 ;; |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
28 ;; The puzzle is called `Towers of Hanoi' because an early popular |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
29 ;; presentation wove a fanciful legend around it. According to this |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
30 ;; myth (uttered long before the Vietnam War), there is a Buddhist |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
31 ;; monastery at Hanoi which contains a large room with three time-worn |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
32 ;; posts in it surrounded by 21 golden discs. Monks, acting out the |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
33 ;; command of an ancient prophecy, have been moving these disks, in |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
34 ;; accordance with the rules of the puzzle, once every day since the |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
35 ;; monastery was founded over a thousand years ago. They are said |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
36 ;; believe that when the last move of the puzzle is completed, the |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
37 ;; world will end in a clap of thunder. Fortunately, they are nowhere |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
38 ;; even close to being done... |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1663
diff
changeset
|
39 |
793
6fb68a1460a6
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
40 ;;; Code: |
6fb68a1460a6
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
41 |
53 | 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 ;;; | |
258 | 53 ;;;###autoload |
53 | 54 (defun hanoi (nrings) |
55 "Towers of Hanoi diversion. Argument is number of rings." | |
14570
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
56 (interactive "p") |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
57 (if (<= nrings 1) (setq nrings 7)) |
1663
a5eec33a8f44
Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents:
845
diff
changeset
|
58 (let* (floor-row |
a5eec33a8f44
Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents:
845
diff
changeset
|
59 fly-row |
14570
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
60 (window-height (1- (window-height (selected-window)))) |
1663
a5eec33a8f44
Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents:
845
diff
changeset
|
61 (window-width (window-width (selected-window))) |
a5eec33a8f44
Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents:
845
diff
changeset
|
62 |
14570
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
63 ;; This is half the spacing to use between poles. |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
64 (pole-spacing (/ window-width 6))) |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
65 (if (not (and (> window-height (1+ nrings)) |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
66 (> pole-spacing nrings))) |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
67 (progn |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
68 (delete-other-windows) |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
69 (if (not (and (> (setq window-height |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
70 (1- (window-height (selected-window)))) |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
71 (1+ nrings)) |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
72 (> (setq pole-spacing (/ window-width 6)) |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
73 nrings))) |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
74 (error "Window is too small (need at least %dx%d)" |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
75 (* 6 (1+ nrings)) (+ 2 nrings))))) |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
76 (setq floor-row (if (> (- window-height 3) (1+ nrings)) |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
77 (- window-height 3) window-height)) |
53 | 78 (let ((fly-row (- floor-row nrings 1)) |
79 ;; pole: column . fill height | |
14570
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
80 (pole-1 (cons (1- pole-spacing) floor-row)) |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
81 (pole-2 (cons (1- (* 3 pole-spacing)) floor-row)) |
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
82 (pole-3 (cons (1- (* 5 pole-spacing)) floor-row)) |
53 | 83 (rings (make-vector nrings nil))) |
84 ;; construct the ring list | |
85 (let ((i 0)) | |
86 (while (< i nrings) | |
87 ;; ring: [pole-number string empty-string] | |
88 (aset rings i (vector nil | |
14570
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
89 (make-string (+ i i 3) (+ ?0 (% i 10))) |
53 | 90 (make-string (+ i i 3) ?\ ))) |
91 (setq i (1+ i)))) | |
92 ;; | |
93 ;; init the screen | |
94 ;; | |
95 (switch-to-buffer "*Hanoi*") | |
96 (setq buffer-read-only nil) | |
97 (buffer-disable-undo (current-buffer)) | |
98 (erase-buffer) | |
99 (let ((i 0)) | |
100 (while (< i floor-row) | |
101 (setq i (1+ i)) | |
102 (insert-char ?\ (1- window-width)) | |
103 (insert ?\n))) | |
104 (insert-char ?= (1- window-width)) | |
105 | |
106 (let ((n 1)) | |
107 (while (< n 6) | |
14570
ca1ee2b8394e
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
14564
diff
changeset
|
108 (hanoi-topos fly-row (1- (* n pole-spacing))) |
53 | 109 (setq n (+ n 2)) |
110 (let ((i fly-row)) | |
111 (while (< i floor-row) | |
112 (setq i (1+ i)) | |
113 (next-line 1) | |
114 (insert ?\|) | |
115 (delete-char 1) | |
116 (backward-char 1))))) | |
117 ;(sit-for 0) | |
118 ;; | |
119 ;; now draw the rings in their initial positions | |
120 ;; | |
121 (let ((i 0) | |
122 ring) | |
123 (while (< i nrings) | |
124 (setq ring (aref rings (- nrings 1 i))) | |
125 (aset ring 0 (- floor-row i)) | |
126 (hanoi-topos (cdr pole-1) | |
127 (- (car pole-1) (- nrings i))) | |
128 (hanoi-draw-ring ring t nil) | |
129 (setcdr pole-1 (1- (cdr pole-1))) | |
130 (setq i (1+ i)))) | |
131 (setq buffer-read-only t) | |
132 (sit-for 0) | |
14564
7932e133a44b
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
11582
diff
changeset
|
133 ;; Disable display of line and column numbers, for speed. |
7932e133a44b
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
11582
diff
changeset
|
134 (let ((line-number-mode nil) |
7932e133a44b
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
11582
diff
changeset
|
135 (column-number-mode nil)) |
7932e133a44b
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
11582
diff
changeset
|
136 ;; do it! |
7932e133a44b
(hanoi): Don't show line and column numbers.
Karl Heuer <kwzh@gnu.org>
parents:
11582
diff
changeset
|
137 (hanoi0 (1- nrings) pole-1 pole-2 pole-3)) |
53 | 138 (goto-char (point-min)) |
139 (message "Done") | |
140 (setq buffer-read-only t) | |
11582
ba3fe06d55eb
(hanoi): Use force-mode-line-update.
Karl Heuer <kwzh@gnu.org>
parents:
4031
diff
changeset
|
141 (force-mode-line-update) |
53 | 142 (sit-for 0)))) |
143 | |
144 ;;; | |
145 ;;; hanoi0 - work horse of hanoi | |
146 ;;; | |
147 (defun hanoi0 (n from to work) | |
148 (cond ((input-pending-p) | |
149 (signal 'quit (list "I can tell you've had enough"))) | |
150 ((< n 0)) | |
151 (t | |
152 (hanoi0 (1- n) from work to) | |
153 (hanoi-move-ring n from to) | |
154 (hanoi0 (1- n) work to from)))) | |
155 | |
156 ;;; | |
157 ;;; hanoi-move-ring - move ring 'n' from 'from' to 'to' | |
158 ;;; | |
159 ;;; | |
160 (defun hanoi-move-ring (n from to) | |
161 (let ((ring (aref rings n)) ; ring <- ring: (ring# . row) | |
162 (buffer-read-only nil)) | |
163 (let ((row (aref ring 0)) ; row <- row ring is on | |
164 (col (- (car from) n 1)) ; col <- left edge of ring | |
165 (dst-col (- (car to) n 1)) ; dst-col <- dest col for left edge | |
166 (dst-row (cdr to))) ; dst-row <- dest row for ring | |
167 (hanoi-topos row col) | |
168 (while (> row fly-row) ; move up to the fly row | |
169 (hanoi-draw-ring ring nil t) ; blank out ring | |
170 (previous-line 1) ; move up a line | |
171 (hanoi-draw-ring ring t nil) ; redraw | |
172 (sit-for 0) | |
173 (setq row (1- row))) | |
174 (setcdr from (1+ (cdr from))) ; adjust top row | |
175 ;; | |
176 ;; fly the ring over to the right pole | |
177 ;; | |
178 (while (not (equal dst-col col)) | |
179 (cond ((> dst-col col) ; dst-col > col: right shift | |
180 (end-of-line 1) | |
181 (delete-backward-char 2) | |
182 (beginning-of-line 1) | |
183 (insert ?\ ?\ ) | |
184 (sit-for 0) | |
185 (setq col (1+ (1+ col)))) | |
186 ((< dst-col col) ; dst-col < col: left shift | |
187 (beginning-of-line 1) | |
188 (delete-char 2) | |
189 (end-of-line 1) | |
190 (insert ?\ ?\ ) | |
191 (sit-for 0) | |
192 (setq col (1- (1- col)))))) | |
193 ;; | |
194 ;; let the ring float down | |
195 ;; | |
196 (hanoi-topos fly-row dst-col) | |
197 (while (< row dst-row) ; move down to the dest row | |
198 (hanoi-draw-ring ring nil (> row fly-row)) ; blank out ring | |
199 (next-line 1) ; move down a line | |
200 (hanoi-draw-ring ring t nil) ; redraw ring | |
201 (sit-for 0) | |
202 (setq row (1+ row))) | |
203 (aset ring 0 dst-row) | |
204 (setcdr to (1- (cdr to)))))) ; adjust top row | |
205 | |
206 ;;; | |
207 ;;; draw-ring - draw the ring at point, leave point unchanged | |
208 ;;; | |
209 ;;; Input: | |
210 ;;; ring | |
211 ;;; f1 - flag: t -> draw, nil -> erase | |
212 ;;; f2 - flag: t -> erasing and need to draw ?\| | |
213 ;;; | |
214 (defun hanoi-draw-ring (ring f1 f2) | |
215 (save-excursion | |
216 (let* ((string (if f1 (aref ring 1) (aref ring 2))) | |
217 (len (length string))) | |
218 (delete-char len) | |
219 (insert string) | |
220 (if f2 | |
221 (progn | |
222 (backward-char (/ (+ len 1) 2)) | |
223 (delete-char 1) (insert ?\|)))))) | |
224 | |
4031 | 225 (provide 'hanoi) |
226 | |
227 ;;; hanoi.el ends here |