; Author (a) 1985, Damon Anton Permezel
; This is in the public domain
-; since he distributed it without copyright notice in 1985.
+; since he distributed it in 1985 without copyright notice.
+;; This file is part of GNU Emacs.
;
; Support for horizontal poles, large numbers of rings, real-time,
; faces, defcustom, and Towers of Unix added in 1999 by Alakazam
:group 'games)
(defcustom hanoi-horizontal-flag nil
- "*If non-nil, hanoi poles are oriented horizontally."
+ "If non-nil, hanoi poles are oriented horizontally."
:group 'hanoi :type 'boolean)
(defcustom hanoi-move-period 1.0
- "*Time, in seconds, for each pole-to-pole move of a ring.
+ "Time, in seconds, for each pole-to-pole move of a ring.
If nil, move rings as fast as possible while displaying all
intermediate positions."
:group 'hanoi :type '(restricted-sexp :match-alternatives (numberp 'nil)))
(defcustom hanoi-use-faces nil
- "*If nil, all hanoi-*-face variables are ignored."
+ "If nil, all hanoi-*-face variables are ignored."
:group 'hanoi :type 'boolean)
(defcustom hanoi-pole-face 'highlight
- "*Face for poles. Ignored if hanoi-use-faces is nil."
+ "Face for poles. Ignored if hanoi-use-faces is nil."
:group 'hanoi :type 'face)
(defcustom hanoi-base-face 'highlight
- "*Face for base. Ignored if hanoi-use-faces is nil."
+ "Face for base. Ignored if hanoi-use-faces is nil."
:group 'hanoi :type 'face)
(defcustom hanoi-even-ring-face 'region
- "*Face for even-numbered rings. Ignored if hanoi-use-faces is nil."
+ "Face for even-numbered rings. Ignored if hanoi-use-faces is nil."
:group 'hanoi :type 'face)
(defcustom hanoi-odd-ring-face 'secondary-selection
- "*Face for odd-numbered rings. Ignored if hanoi-use-faces is nil."
+ "Face for odd-numbered rings. Ignored if hanoi-use-faces is nil."
:group 'hanoi :type 'face)
;;;
;;;###autoload
(defun hanoi (nrings)
- "Towers of Hanoi diversion. Use NRINGS rings."
+ "Towers of Hanoi diversion. Use NRINGS rings."
(interactive
(list (if (null current-prefix-arg)
3
(prefix-numeric-value current-prefix-arg))))
(if (< nrings 0)
(error "Negative number of rings"))
- (hanoi-internal nrings (make-list nrings 0) (hanoi-current-time-float)))
+ (hanoi-internal nrings (make-list nrings 0) (float-time)))
;;;###autoload
(defun hanoi-unix ()
Repent before ring 31 moves."
(interactive)
- (let* ((start (ftruncate (hanoi-current-time-float)))
+ (let* ((start (ftruncate (float-time)))
(bits (loop repeat 32
for x = (/ start (expt 2.0 31)) then (* x 2.0)
collect (truncate (mod x 2.0))))
;;;###autoload
(defun hanoi-unix-64 ()
- "Like hanoi-unix, but pretend to have a 64-bit clock.
-This is, necessarily (as of emacs 20.3), a crock. When the
+ "Like hanoi-unix, but pretend to have a 64-bit clock.
+This is, necessarily (as of Emacs 20.3), a crock. When the
current-time interface is made s2G-compliant, hanoi.el will need
to be updated."
(interactive)
- (let* ((start (ftruncate (hanoi-current-time-float)))
+ (let* ((start (ftruncate (float-time)))
(bits (loop repeat 64
for x = (/ start (expt 2.0 63)) then (* x 2.0)
collect (truncate (mod x 2.0))))
BITS must be of length nrings. Start at START-TIME."
(switch-to-buffer "*Hanoi*")
(buffer-disable-undo (current-buffer))
+ (setq show-trailing-whitespace nil)
(unwind-protect
(let*
- (;; These lines can cause emacs to crash if you ask for too
+ (;; These lines can cause Emacs to crash if you ask for too
;; many rings. If you uncomment them, on most systems you
;; can get 10,000+ rings.
;;(max-specpdl-size (max max-specpdl-size (* nrings 15)))
(make-string (1- radius) (if vert ?\- ?\|))
(if vert ">" "v"))
for face =
- (if (oddp n) hanoi-odd-ring-face hanoi-even-ring-face)
+ (if (eq (logand n 1) 1) ; oddp would require cl at runtime
+ hanoi-odd-ring-face hanoi-even-ring-face)
do (hanoi-put-face 0 (length str) face str)
collect (cons str diameter)))
;; Disable display of line and column numbers, for speed.
(setq buffer-read-only t)
(force-mode-line-update)))
-(defun hanoi-current-time-float ()
- "Return values from current-time combined into a single float."
- (destructuring-bind (high low micros) (current-time)
- (+ (* high 65536.0) low (/ micros 1000000.0))))
-
(defun hanoi-put-face (start end value &optional object)
"If hanoi-use-faces is non-nil, call put-text-property for face property."
(if hanoi-use-faces
(fly-steps (abs (/ (- (cdr to) (cdr from)) fly-step)))
(directed-fly-step (/ (- (cdr to) (cdr from)) fly-steps))
(baseward-steps (/ (- (car to) (cdr to)) baseward-step))
- (total-steps (+ flyward-steps fly-steps baseward-steps))
;; A step is a character cell. A tick is a time-unit. To
;; make horizontal and vertical motion appear roughly the
;; same speed, we allow one tick per horizontal step and two
(/ (- tick flyward-ticks fly-ticks)
ticks-per-pole-step))))))))
(if hanoi-move-period
- (loop for elapsed = (- (hanoi-current-time-float) start-time)
+ (loop for elapsed = (- (float-time) start-time)
while (< elapsed hanoi-move-period)
with tick-period = (/ (float hanoi-move-period) total-ticks)
for tick = (ceiling (/ elapsed tick-period)) do
;; update display and pause, quitting with a pithy comment if the user
;; hits a key.
(defun hanoi-sit-for (seconds)
- (sit-for seconds)
- (if (input-pending-p)
- (signal 'quit '("I can tell you've had enough"))))
+ (unless (sit-for seconds)
+ (signal 'quit '("I can tell you've had enough"))))
;; move ring to a given buffer position and update ring's car.
(defun hanoi-ring-to-pos (ring pos)