annotate lisp/play/hanoi.el @ 5200:1006461bf759

(do-install): Use umask 022 in copying etc and lisp dirs.
author Richard M. Stallman <rms@gnu.org>
date Sat, 27 Nov 1993 09:19:39 +0000
parents ac159693513e
children ba3fe06d55eb
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
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
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
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
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
42 ;;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
43 ;;; hanoi-topos - direct cursor addressing
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
44 ;;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
45 (defun hanoi-topos (row col)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
46 (goto-line row)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
47 (beginning-of-line)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
48 (forward-char col))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
49
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
50 ;;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
51 ;;; hanoi - user callable Towers of Hanoi
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
52 ;;;
258
1e0bc00dca7a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 53
diff changeset
53 ;;;###autoload
53
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
54 (defun hanoi (nrings)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
55 "Towers of Hanoi diversion. Argument is number of rings."
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
56 (interactive
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
57 (list (if (null current-prefix-arg)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
58 3
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
59 (prefix-numeric-value current-prefix-arg))))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
60 (if (<= nrings 0) (error "Negative number of rings"))
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 (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
62 fly-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
63 (window-height (window-height (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
64 (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
65
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
66 ;; This is the unit of spacing to use between poles. It
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
67 ;; must be even. We round down, since rounding up might
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
68 ;; cause us to draw off the edge of the 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
69 (pole-spacing (logand (/ window-width 6) (lognot 1))))
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
70 (let (
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
71 ;; The poles are (1+ NRINGS) rows high; we also want an
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
72 ;; empty row at the top for the flying rings, a base, and a
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
73 ;; blank line underneath that.
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
74 (h (+ nrings 4))
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
75
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
76 ;; If we have NRINGS rings, we label them with the numbers 0
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
77 ;; through NRINGS-1. The width of ring i is 2i+3; it pokes
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
78 ;; out i spaces on either side of the pole. Rather than
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 2307
diff changeset
79 ;; checking if the window is wide enough to accommodate this,
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
80 ;; we make sure pole-spacing is large enough, since that
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
81 ;; works even when we have decremented pole-spacing to make
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
82 ;; it even.
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
83 (w (1+ nrings)))
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
84 (if (not (and (>= window-height h)
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
85 (> pole-spacing w)))
53
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
86 (progn
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
87 (delete-other-windows)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
88 (if (not (and (>= (setq window-height
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
89 (window-height (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
90 h)
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
91 (> (setq pole-spacing
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
92 (logand (/ window-width 6) (lognot 1)))
a5eec33a8f44 Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu)
Jim Blandy <jimb@redhat.com>
parents: 845
diff changeset
93 w)))
53
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
94 (error "Screen is too small (need at least %dx%d)" w h))))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
95 (setq floor-row (if (> (- window-height 3) h)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
96 (- window-height 3) window-height)))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
97 (let ((fly-row (- floor-row nrings 1))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
98 ;; pole: column . fill height
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
99 (pole-1 (cons pole-spacing floor-row))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
100 (pole-2 (cons (* 3 pole-spacing) floor-row))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
101 (pole-3 (cons (* 5 pole-spacing) floor-row))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
102 (rings (make-vector nrings nil)))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
103 ;; construct the ring list
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
104 (let ((i 0))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
105 (while (< i nrings)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
106 ;; ring: [pole-number string empty-string]
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
107 (aset rings i (vector nil
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
108 (make-string (+ i i 3) (+ ?0 i))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
109 (make-string (+ i i 3) ?\ )))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
110 (setq i (1+ i))))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
111 ;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
112 ;; init the screen
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
113 ;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
114 (switch-to-buffer "*Hanoi*")
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
115 (setq buffer-read-only nil)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
116 (buffer-disable-undo (current-buffer))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
117 (erase-buffer)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
118 (let ((i 0))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
119 (while (< i floor-row)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
120 (setq i (1+ i))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
121 (insert-char ?\ (1- window-width))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
122 (insert ?\n)))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
123 (insert-char ?= (1- window-width))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
124
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
125 (let ((n 1))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
126 (while (< n 6)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
127 (hanoi-topos fly-row (* n pole-spacing))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
128 (setq n (+ n 2))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
129 (let ((i fly-row))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
130 (while (< i floor-row)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
131 (setq i (1+ i))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
132 (next-line 1)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
133 (insert ?\|)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
134 (delete-char 1)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
135 (backward-char 1)))))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
136 ;(sit-for 0)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
137 ;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
138 ;; now draw the rings in their initial positions
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
139 ;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
140 (let ((i 0)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
141 ring)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
142 (while (< i nrings)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
143 (setq ring (aref rings (- nrings 1 i)))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
144 (aset ring 0 (- floor-row i))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
145 (hanoi-topos (cdr pole-1)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
146 (- (car pole-1) (- nrings i)))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
147 (hanoi-draw-ring ring t nil)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
148 (setcdr pole-1 (1- (cdr pole-1)))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
149 (setq i (1+ i))))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
150 (setq buffer-read-only t)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
151 (sit-for 0)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
152 ;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
153 ;; do it!
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
154 ;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
155 (hanoi0 (1- nrings) pole-1 pole-2 pole-3)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
156 (goto-char (point-min))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
157 (message "Done")
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
158 (setq buffer-read-only t)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
159 (set-buffer-modified-p (buffer-modified-p))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
160 (sit-for 0))))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
161
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
162 ;;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
163 ;;; hanoi0 - work horse of hanoi
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
164 ;;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
165 (defun hanoi0 (n from to work)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
166 (cond ((input-pending-p)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
167 (signal 'quit (list "I can tell you've had enough")))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
168 ((< n 0))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
169 (t
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
170 (hanoi0 (1- n) from work to)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
171 (hanoi-move-ring n from to)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
172 (hanoi0 (1- n) work to from))))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
173
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
174 ;;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
175 ;;; hanoi-move-ring - move ring 'n' from 'from' to 'to'
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
176 ;;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
177 ;;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
178 (defun hanoi-move-ring (n from to)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
179 (let ((ring (aref rings n)) ; ring <- ring: (ring# . row)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
180 (buffer-read-only nil))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
181 (let ((row (aref ring 0)) ; row <- row ring is on
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
182 (col (- (car from) n 1)) ; col <- left edge of ring
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
183 (dst-col (- (car to) n 1)) ; dst-col <- dest col for left edge
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
184 (dst-row (cdr to))) ; dst-row <- dest row for ring
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
185 (hanoi-topos row col)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
186 (while (> row fly-row) ; move up to the fly row
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
187 (hanoi-draw-ring ring nil t) ; blank out ring
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
188 (previous-line 1) ; move up a line
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
189 (hanoi-draw-ring ring t nil) ; redraw
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
190 (sit-for 0)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
191 (setq row (1- row)))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
192 (setcdr from (1+ (cdr from))) ; adjust top row
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
193 ;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
194 ;; fly the ring over to the right pole
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
195 ;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
196 (while (not (equal dst-col col))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
197 (cond ((> dst-col col) ; dst-col > col: right shift
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
198 (end-of-line 1)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
199 (delete-backward-char 2)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
200 (beginning-of-line 1)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
201 (insert ?\ ?\ )
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
202 (sit-for 0)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
203 (setq col (1+ (1+ col))))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
204 ((< dst-col col) ; dst-col < col: left shift
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
205 (beginning-of-line 1)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
206 (delete-char 2)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
207 (end-of-line 1)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
208 (insert ?\ ?\ )
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
209 (sit-for 0)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
210 (setq col (1- (1- col))))))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
211 ;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
212 ;; let the ring float down
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
213 ;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
214 (hanoi-topos fly-row dst-col)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
215 (while (< row dst-row) ; move down to the dest row
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
216 (hanoi-draw-ring ring nil (> row fly-row)) ; blank out ring
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
217 (next-line 1) ; move down a line
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
218 (hanoi-draw-ring ring t nil) ; redraw ring
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
219 (sit-for 0)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
220 (setq row (1+ row)))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
221 (aset ring 0 dst-row)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
222 (setcdr to (1- (cdr to)))))) ; adjust top row
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
223
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
224 ;;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
225 ;;; draw-ring - draw the ring at point, leave point unchanged
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
226 ;;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
227 ;;; Input:
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
228 ;;; ring
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
229 ;;; f1 - flag: t -> draw, nil -> erase
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
230 ;;; f2 - flag: t -> erasing and need to draw ?\|
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
231 ;;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
232 (defun hanoi-draw-ring (ring f1 f2)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
233 (save-excursion
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
234 (let* ((string (if f1 (aref ring 1) (aref ring 2)))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
235 (len (length string)))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
236 (delete-char len)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
237 (insert string)
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
238 (if f2
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
239 (progn
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
240 (backward-char (/ (+ len 1) 2))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
241 (delete-char 1) (insert ?\|))))))
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
242
4031
ac159693513e Add (provide 'hanoi).
Roland McGrath <roland@gnu.org>
parents: 3591
diff changeset
243 (provide 'hanoi)
ac159693513e Add (provide 'hanoi).
Roland McGrath <roland@gnu.org>
parents: 3591
diff changeset
244
ac159693513e Add (provide 'hanoi).
Roland McGrath <roland@gnu.org>
parents: 3591
diff changeset
245 ;;; hanoi.el ends here