annotate lisp/play/hanoi.el @ 29191:3977c8167022

(handle_invisible_prop): Don't try to skip over invisible text if end of text is already reached.
author Gerd Moellmann <gerd@gnu.org>
date Thu, 25 May 2000 15:53:05 +0000
parents d28d789a8521
children 253f761ad37b
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
25259
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
1 ;;; hanoi.el --- towers of hanoi in Emacs
660
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.
25259
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
10 ;
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
11 ; Support for horizontal poles, large numbers of rings, real-time,
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
12 ; faces, defcustom, and Towers of Unix added in 1999 by Alakazam
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
13 ; Petrofsky <Alakazam@Petrofsky.Berkeley.CA.US>.
53
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
14
2307
10e417efb12a Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 1663
diff changeset
15 ;;; Commentary:
10e417efb12a Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 1663
diff changeset
16
10e417efb12a Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 1663
diff changeset
17 ;; 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
18 ;;
10e417efb12a Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 1663
diff changeset
19 ;; 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
20 ;; 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
21 ;; 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
22 ;; original order, to another post.
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 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
25 ;; 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
26 ;; 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
27 ;;
10e417efb12a Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 1663
diff changeset
28 ;; 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
29 ;; 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
30 ;; 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
31 ;;
10e417efb12a Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 1663
diff changeset
32 ;; 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
33 ;; 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
34 ;; 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
35 ;; 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
36 ;; 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
37 ;; 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
38 ;; accordance with the rules of the puzzle, once every day since the
25259
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
39 ;; monastery was founded over a thousand years ago. They are said to
2307
10e417efb12a Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 1663
diff changeset
40 ;; 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
41 ;; 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
42 ;; even close to being done...
25259
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
43 ;;
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
44 ;; 1999 addition: The `Towers of Unix' command (hanoi-unix) stems from
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
45 ;; the never-disproven legend of a Eunuch monastery at Princeton that
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
46 ;; contains a large air-conditioned room with three time-worn posts in
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
47 ;; it surrounded by 32 silicon discs. Nimble monks, acting out the
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
48 ;; command of an ancient prophecy, have been moving these disks, in
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
49 ;; accordance with the rules of the puzzle, once every second since
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
50 ;; the monastery was founded almost a billion seconds ago. They are
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
51 ;; said to believe that when the last move of the puzzle is completed,
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
52 ;; the world will reboot in a clap of thunder. Actually, because the
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
53 ;; bottom disc is blocked by the "Do not feed the monks" sign, it is
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
54 ;; believed the End will come at the time that disc is to be moved...
2307
10e417efb12a Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 1663
diff changeset
55
793
6fb68a1460a6 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 663
diff changeset
56 ;;; Code:
6fb68a1460a6 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 663
diff changeset
57
25259
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
58 (eval-when-compile
25329
dca526aca149 Declare dynamic vars.
Dave Love <fx@gnu.org>
parents: 25259
diff changeset
59 (require 'cl)
dca526aca149 Declare dynamic vars.
Dave Love <fx@gnu.org>
parents: 25259
diff changeset
60 ;; dynamic bondage:
dca526aca149 Declare dynamic vars.
Dave Love <fx@gnu.org>
parents: 25259
diff changeset
61 (defvar baseward-step)
dca526aca149 Declare dynamic vars.
Dave Love <fx@gnu.org>
parents: 25259
diff changeset
62 (defvar fly-step)
dca526aca149 Declare dynamic vars.
Dave Love <fx@gnu.org>
parents: 25259
diff changeset
63 (defvar fly-row-start)
dca526aca149 Declare dynamic vars.
Dave Love <fx@gnu.org>
parents: 25259
diff changeset
64 (defvar pole-width)
dca526aca149 Declare dynamic vars.
Dave Love <fx@gnu.org>
parents: 25259
diff changeset
65 (defvar pole-char)
dca526aca149 Declare dynamic vars.
Dave Love <fx@gnu.org>
parents: 25259
diff changeset
66 (defvar line-offset))
25259
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
67
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
68 (defgroup hanoi nil
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
69 "The Towers of Hanoi."
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
70 :group 'games)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
71
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
72 (defcustom hanoi-horizontal-flag nil
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
73 "*If non-nil, hanoi poles are oriented horizontally."
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
74 :group 'hanoi :type 'boolean)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
75
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
76 (defcustom hanoi-move-period 1.0
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
77 "*Time, in seconds, for each pole-to-pole move of a ring.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
78 If nil, move rings as fast as possible while displaying all
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
79 intermediate positions."
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
80 :group 'hanoi :type '(restricted-sexp :match-alternatives (numberp 'nil)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
81
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
82 (defcustom hanoi-use-faces nil
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
83 "*If nil, all hanoi-*-face variables are ignored."
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
84 :group 'hanoi :type 'boolean)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
85
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
86 (defcustom hanoi-pole-face 'highlight
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
87 "*Face for poles. Ignored if hanoi-use-faces is nil."
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
88 :group 'hanoi :type 'face)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
89
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
90 (defcustom hanoi-base-face 'highlight
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
91 "*Face for base. Ignored if hanoi-use-faces is nil."
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
92 :group 'hanoi :type 'face)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
93
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
94 (defcustom hanoi-even-ring-face 'region
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
95 "*Face for even-numbered rings. Ignored if hanoi-use-faces is nil."
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
96 :group 'hanoi :type 'face)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
97
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
98 (defcustom hanoi-odd-ring-face 'secondary-selection
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
99 "*Face for odd-numbered rings. Ignored if hanoi-use-faces is nil."
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
100 :group 'hanoi :type 'face)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
101
53
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
102
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
103 ;;;
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
104 ;;; hanoi - user callable Towers of Hanoi
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
105 ;;;
258
1e0bc00dca7a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 53
diff changeset
106 ;;;###autoload
53
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
107 (defun hanoi (nrings)
25259
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
108 "Towers of Hanoi diversion. Use NRINGS rings."
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
109 (interactive
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
110 (list (if (null current-prefix-arg)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
111 3
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
112 (prefix-numeric-value current-prefix-arg))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
113 (if (< nrings 0)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
114 (error "Negative number of rings"))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
115 (hanoi-internal nrings (make-list nrings 0) (hanoi-current-time-float)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
116
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
117 ;;;###autoload
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
118 (defun hanoi-unix ()
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
119 "Towers of Hanoi, UNIX doomsday version.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
120 Displays 32-ring towers that have been progressing at one move per
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
121 second since 1970-01-01 00:00:00 GMT.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
122
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
123 Repent before ring 31 moves."
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
124 (interactive)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
125 (let* ((start (ftruncate (hanoi-current-time-float)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
126 (bits (loop repeat 32
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
127 for x = (/ start (expt 2.0 31)) then (* x 2.0)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
128 collect (truncate (mod x 2.0))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
129 (hanoi-move-period 1.0))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
130 (hanoi-internal 32 bits start)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
131
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
132 ;;;###autoload
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
133 (defun hanoi-unix-64 ()
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
134 "Like hanoi-unix, but pretend to have a 64-bit clock.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
135 This is, necessarily (as of emacs 20.3), a crock. When the
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
136 current-time interface is made s2G-compliant, hanoi.el will need
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
137 to be updated."
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
138 (interactive)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
139 (let* ((start (ftruncate (hanoi-current-time-float)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
140 (bits (loop repeat 64
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
141 for x = (/ start (expt 2.0 63)) then (* x 2.0)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
142 collect (truncate (mod x 2.0))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
143 (hanoi-move-period 1.0))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
144 (hanoi-internal 64 bits start)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
145
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
146 (defun hanoi-internal (nrings bits start-time)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
147 "Towers of Hanoi internal interface. Use NRINGS rings.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
148 Start after n steps, where BITS is a big-endian list of the bits of n.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
149 BITS must be of length nrings. Start at START-TIME."
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
150 (switch-to-buffer "*Hanoi*")
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
151 (buffer-disable-undo (current-buffer))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
152 (unwind-protect
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
153 (let*
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
154 (;; These lines can cause emacs to crash if you ask for too
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
155 ;; many rings. If you uncomment them, on most systems you
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
156 ;; can get 10,000+ rings.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
157 ;;(max-specpdl-size (max max-specpdl-size (* nrings 15)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
158 ;;(max-lisp-eval-depth (max max-lisp-eval-depth (+ nrings 20)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
159 (vert (not hanoi-horizontal-flag))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
160 (pole-width (length (format "%d" (max 0 (1- nrings)))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
161 (pole-char (if vert ?\| ?\-))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
162 (base-char (if vert ?\= ?\|))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
163 (base-len (max (+ 8 (* pole-width 3))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
164 (1- (if vert (window-width) (window-height)))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
165 (max-ring-diameter (/ (- base-len 2) 3))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
166 (pole1-coord (/ max-ring-diameter 2))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
167 (pole2-coord (/ base-len 2))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
168 (pole3-coord (- base-len (/ (1+ max-ring-diameter) 2)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
169 (pole-coords (list pole1-coord pole2-coord pole3-coord))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
170 ;; Number of lines displayed below the bottom-most rings.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
171 (base-lines
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
172 (min 3 (max 0 (- (1- (if vert (window-height) (window-width)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
173 (+ 2 nrings)))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
174
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
175 ;; These variables will be set according to hanoi-horizontal-flag:
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
176
25259
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
177 ;; line-offset is the number of characters per line in the buffer.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
178 line-offset
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
179 ;; fly-row-start is the buffer position of the leftmost or
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
180 ;; uppermost position in the fly row.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
181 fly-row-start
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
182 ;; Adding fly-step to a buffer position moves you one step
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
183 ;; along the fly row in the direction from pole1 to pole2.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
184 fly-step
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
185 ;; Adding baseward-step to a buffer position moves you one step
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
186 ;; toward the base.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
187 baseward-step
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
188 )
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
189 (setq buffer-read-only nil)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
190 (erase-buffer)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
191 (setq truncate-lines t)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
192 (if hanoi-horizontal-flag
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
193 (progn
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
194 (setq line-offset (+ base-lines nrings 3))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
195 (setq fly-row-start (1- line-offset))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
196 (setq fly-step line-offset)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
197 (setq baseward-step -1)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
198 (loop repeat base-len do
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
199 (unless (zerop base-lines)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
200 (insert-char ?\ (1- base-lines))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
201 (insert base-char)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
202 (hanoi-put-face (1- (point)) (point) hanoi-base-face))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
203 (insert-char ?\ (+ 2 nrings))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
204 (insert ?\n))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
205 (delete-char -1)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
206 (loop for coord in pole-coords do
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
207 (loop for row from (- coord (/ pole-width 2))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
208 for start = (+ (* row line-offset) base-lines 1)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
209 repeat pole-width do
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
210 (subst-char-in-region start (+ start nrings 1)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
211 ?\ pole-char)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
212 (hanoi-put-face start (+ start nrings 1)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
213 hanoi-pole-face))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
214 ;; vertical
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
215 (setq line-offset (1+ base-len))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
216 (setq fly-step 1)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
217 (setq baseward-step line-offset)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
218 (let ((extra-lines (- (1- (window-height)) (+ nrings 2) base-lines)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
219 (insert-char ?\n (max 0 extra-lines))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
220 (setq fly-row-start (point))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
221 (insert-char ?\ base-len)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
222 (insert ?\n)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
223 (loop repeat (1+ nrings)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
224 with pole-line =
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
225 (loop with line = (make-string base-len ?\ )
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
226 for coord in pole-coords
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
227 for start = (- coord (/ pole-width 2))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
228 for end = (+ start pole-width) do
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
229 (hanoi-put-face start end hanoi-pole-face line)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
230 (loop for i from start below end do
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
231 (aset line i pole-char))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
232 finally return line)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
233 do (insert pole-line ?\n))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
234 (insert-char base-char base-len)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
235 (hanoi-put-face (- (point) base-len) (point) hanoi-base-face)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
236 (set-window-start (selected-window)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
237 (1+ (* baseward-step
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
238 (max 0 (- extra-lines)))))))
53
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
239
25259
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
240 (let
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
241 (;; each pole is a pair of buffer positions:
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
242 ;; the car is the position of the top ring currently on the pole,
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
243 ;; (or the base of the pole if it is empty).
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
244 ;; the cdr is in the fly-row just above the pole.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
245 (poles (loop for coord in pole-coords
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
246 for fly-pos = (+ fly-row-start (* fly-step coord))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
247 for base = (+ fly-pos (* baseward-step (+ 2 nrings)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
248 collect (cons base fly-pos)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
249 ;; compute the string for each ring and make the list of
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
250 ;; ring pairs. Each ring pair is initially (str . diameter).
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
251 ;; Once placed in buffer it is changed to (center-pos . diameter).
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
252 (rings
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
253 (loop
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
254 ;; radii are measured from the edge of the pole out.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
255 ;; So diameter = 2 * radius + pole-width. When
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
256 ;; there's room, we make each ring's radius =
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
257 ;; pole-number + 1. If there isn't room, we step
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
258 ;; evenly from the max radius down to 1.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
259 with max-radius = (min nrings
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
260 (/ (- max-ring-diameter pole-width) 2))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
261 for n from (1- nrings) downto 0
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
262 for radius = (1+ (/ (* n max-radius) nrings))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
263 for diameter = (+ pole-width (* 2 radius))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
264 with format-str = (format "%%0%dd" pole-width)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
265 for str = (concat (if vert "<" "^")
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
266 (make-string (1- radius) (if vert ?\- ?\|))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
267 (format format-str n)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
268 (make-string (1- radius) (if vert ?\- ?\|))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
269 (if vert ">" "v"))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
270 for face =
28091
d28d789a8521 (hanoi-internal): Don't use oddp.
Dave Love <fx@gnu.org>
parents: 25329
diff changeset
271 (if (eq (logand n 1) 1) ; oddp would require cl at runtime
d28d789a8521 (hanoi-internal): Don't use oddp.
Dave Love <fx@gnu.org>
parents: 25329
diff changeset
272 hanoi-odd-ring-face hanoi-even-ring-face)
25259
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
273 do (hanoi-put-face 0 (length str) face str)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
274 collect (cons str diameter)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
275 ;; Disable display of line and column numbers, for speed.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
276 (line-number-mode nil) (column-number-mode nil))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
277 ;; do it!
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
278 (hanoi-n bits rings (car poles) (cadr poles) (caddr poles)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
279 start-time))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
280 (message "Done"))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
281 (setq buffer-read-only t)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
282 (force-mode-line-update)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
283
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
284 (defun hanoi-current-time-float ()
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
285 "Return values from current-time combined into a single float."
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
286 (destructuring-bind (high low micros) (current-time)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
287 (+ (* high 65536.0) low (/ micros 1000000.0))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
288
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
289 (defun hanoi-put-face (start end value &optional object)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
290 "If hanoi-use-faces is non-nil, call put-text-property for face property."
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
291 (if hanoi-use-faces
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
292 (put-text-property start end 'face value object)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
293
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
294
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
295 ;;; Functions with a start-time argument (hanoi-0, hanoi-n, and
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
296 ;;; hanoi-move-ring) start working at start-time and return the ending
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
297 ;;; time. If hanoi-move-period is nil, start-time is ignored and the
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
298 ;;; return value is junk.
53
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
299
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
300 ;;;
25259
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
301 ;;; hanoi-0 - work horse of hanoi
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
302 (defun hanoi-0 (rings from to work start-time)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
303 (if (null rings)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
304 start-time
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
305 (hanoi-0 (cdr rings) work to from
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
306 (hanoi-move-ring (car rings) from to
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
307 (hanoi-0 (cdr rings) from work to start-time)))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
308
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
309 ;; start after n moves, where BITS is a big-endian list of the bits of n.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
310 ;; BITS must be of same length as rings.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
311 (defun hanoi-n (bits rings from to work start-time)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
312 (cond ((null rings)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
313 ;; All rings have been placed in starting positions. Update display.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
314 (hanoi-sit-for 0)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
315 start-time)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
316 ((zerop (car bits))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
317 (hanoi-insert-ring (car rings) from)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
318 (hanoi-0 (cdr rings) work to from
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
319 (hanoi-move-ring (car rings) from to
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
320 (hanoi-n (cdr bits) (cdr rings) from work to
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
321 start-time))))
53
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
322 (t
25259
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
323 (hanoi-insert-ring (car rings) to)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
324 (hanoi-n (cdr bits) (cdr rings) work to from start-time))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
325
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
326 ;; put never-before-placed RING on POLE and update their cars.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
327 (defun hanoi-insert-ring (ring pole)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
328 (decf (car pole) baseward-step)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
329 (let ((str (car ring))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
330 (start (- (car pole) (* (/ (cdr ring) 2) fly-step))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
331 (setcar ring (car pole))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
332 (loop for pos upfrom start by fly-step
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
333 for i below (cdr ring) do
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
334 (subst-char-in-region pos (1+ pos) (char-after pos) (aref str i))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
335 (set-text-properties pos (1+ pos) (text-properties-at i str)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
336 (hanoi-goto-char (car pole))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
337
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
338 ;; like goto-char, but if position is outside the window, then move to
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
339 ;; corresponding position in the first row displayed.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
340 (defun hanoi-goto-char (pos)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
341 (goto-char (if (or hanoi-horizontal-flag (<= (window-start) pos))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
342 pos
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
343 (+ (window-start) (% (- pos fly-row-start) baseward-step)))))
53
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
344
25259
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
345 ;; do one pole-to-pole move and update the ring and pole pairs.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
346 (defun hanoi-move-ring (ring from to start-time)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
347 (incf (car from) baseward-step)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
348 (decf (car to) baseward-step)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
349 (let* ;; We move flywards-steps steps up the pole to the fly row,
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
350 ;; then fly fly-steps steps across the fly row, then go
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
351 ;; baseward-steps steps down the new pole.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
352 ((flyward-steps (/ (- (car ring) (cdr from)) baseward-step))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
353 (fly-steps (abs (/ (- (cdr to) (cdr from)) fly-step)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
354 (directed-fly-step (/ (- (cdr to) (cdr from)) fly-steps))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
355 (baseward-steps (/ (- (car to) (cdr to)) baseward-step))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
356 (total-steps (+ flyward-steps fly-steps baseward-steps))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
357 ;; A step is a character cell. A tick is a time-unit. To
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
358 ;; make horizontal and vertical motion appear roughly the
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
359 ;; same speed, we allow one tick per horizontal step and two
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
360 ;; ticks per vertical step.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
361 (ticks-per-pole-step (if hanoi-horizontal-flag 1 2))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
362 (ticks-per-fly-step (if hanoi-horizontal-flag 2 1))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
363 (flyward-ticks (* ticks-per-pole-step flyward-steps))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
364 (fly-ticks (* ticks-per-fly-step fly-steps))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
365 (baseward-ticks (* ticks-per-pole-step baseward-steps))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
366 (total-ticks (+ flyward-ticks fly-ticks baseward-ticks))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
367 (tick-to-pos
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
368 ;; Return the buffer position of the ring after TICK ticks.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
369 (lambda (tick)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
370 (cond
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
371 ((<= tick flyward-ticks)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
372 (+ (cdr from)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
373 (* baseward-step
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
374 (- flyward-steps (/ tick ticks-per-pole-step)))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
375 ((<= tick (+ flyward-ticks fly-ticks))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
376 (+ (cdr from)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
377 (* directed-fly-step
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
378 (/ (- tick flyward-ticks) ticks-per-fly-step))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
379 (t
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
380 (+ (cdr to)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
381 (* baseward-step
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
382 (/ (- tick flyward-ticks fly-ticks)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
383 ticks-per-pole-step))))))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
384 (if hanoi-move-period
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
385 (loop for elapsed = (- (hanoi-current-time-float) start-time)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
386 while (< elapsed hanoi-move-period)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
387 with tick-period = (/ (float hanoi-move-period) total-ticks)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
388 for tick = (ceiling (/ elapsed tick-period)) do
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
389 (hanoi-ring-to-pos ring (funcall tick-to-pos tick))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
390 (hanoi-sit-for (- (* tick tick-period) elapsed)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
391 (loop for tick from 1 to total-ticks by 2 do
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
392 (hanoi-ring-to-pos ring (funcall tick-to-pos tick))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
393 (hanoi-sit-for 0)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
394 ;; Always make last move to keep pole and ring data consistent
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
395 (hanoi-ring-to-pos ring (car to))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
396 (if hanoi-move-period (+ start-time hanoi-move-period))))
53
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
397
25259
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
398 ;; update display and pause, quitting with a pithy comment if the user
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
399 ;; hits a key.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
400 (defun hanoi-sit-for (seconds)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
401 (sit-for seconds)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
402 (if (input-pending-p)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
403 (signal 'quit '("I can tell you've had enough"))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
404
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
405 ;; move ring to a given buffer position and update ring's car.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
406 (defun hanoi-ring-to-pos (ring pos)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
407 (unless (= (car ring) pos)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
408 (let* ((start (- (car ring) (* (/ (cdr ring) 2) fly-step)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
409 (new-start (- pos (- (car ring) start))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
410 (if hanoi-horizontal-flag
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
411 (loop for i below (cdr ring)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
412 for j = (if (< new-start start) i (- (cdr ring) i 1))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
413 for old-pos = (+ start (* j fly-step))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
414 for new-pos = (+ new-start (* j fly-step)) do
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
415 (transpose-regions old-pos (1+ old-pos) new-pos (1+ new-pos)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
416 (let ((end (+ start (cdr ring)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
417 (new-end (+ new-start (cdr ring))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
418 (if (< (abs (- new-start start)) (- end start))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
419 ;; Overlap. Adjust bounds
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
420 (if (< start new-start)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
421 (setq new-start end)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
422 (setq new-end start)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
423 (transpose-regions start end new-start new-end t))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
424 ;; If moved on or off a pole, redraw pole chars.
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
425 (unless (eq (hanoi-pos-on-tower-p (car ring)) (hanoi-pos-on-tower-p pos))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
426 (let* ((pole-start (- (car ring) (* fly-step (/ pole-width 2))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
427 (pole-end (+ pole-start (* fly-step pole-width)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
428 (on-pole (hanoi-pos-on-tower-p (car ring)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
429 (new-char (if on-pole pole-char ?\ ))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
430 (curr-char (if on-pole ?\ pole-char))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
431 (face (if on-pole hanoi-pole-face nil)))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
432 (if hanoi-horizontal-flag
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
433 (loop for pos from pole-start below pole-end by line-offset do
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
434 (subst-char-in-region pos (1+ pos) curr-char new-char)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
435 (hanoi-put-face pos (1+ pos) face))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
436 (subst-char-in-region pole-start pole-end curr-char new-char)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
437 (hanoi-put-face pole-start pole-end face))))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
438 (setcar ring pos))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
439 (hanoi-goto-char pos))
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
440
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
441 ;; Check if a buffer position lies on a tower (vis. in the fly row).
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
442 (defun hanoi-pos-on-tower-p (pos)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
443 (if hanoi-horizontal-flag
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
444 (/= (% pos fly-step) fly-row-start)
9f7a9dceb11b Mostly rewritten. Customized. To support an s2G
Karl Heuer <kwzh@gnu.org>
parents: 14570
diff changeset
445 (>= pos (+ fly-row-start baseward-step))))
53
a8efef5eb891 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
446
4031
ac159693513e Add (provide 'hanoi).
Roland McGrath <roland@gnu.org>
parents: 3591
diff changeset
447 (provide 'hanoi)
ac159693513e Add (provide 'hanoi).
Roland McGrath <roland@gnu.org>
parents: 3591
diff changeset
448
ac159693513e Add (provide 'hanoi).
Roland McGrath <roland@gnu.org>
parents: 3591
diff changeset
449 ;;; hanoi.el ends here