Function: hanoi-internal
hanoi-internal is a byte-compiled function defined in hanoi.el.gz.
Signature
(hanoi-internal NRINGS BITS START-TIME)
Documentation
Towers of Hanoi internal interface. Use NRINGS rings.
Start after n steps, where BITS is a big-endian list of the bits of n. BITS must be of length nrings. Start at START-TIME.
Source Code
;; Defined in /usr/src/emacs/lisp/play/hanoi.el.gz
(defun hanoi-internal (nrings bits start-time)
"Towers of Hanoi internal interface. Use NRINGS rings.
Start after n steps, where BITS is a big-endian list of the bits of n.
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*
(;; This line can cause Emacs to crash if you ask for too
;; many rings. If you uncomment it, on most systems you
;; can get 10,000+ rings.
;;(max-lisp-eval-depth (max max-lisp-eval-depth (+ nrings 20)))
(vert (not hanoi-horizontal-flag))
(pole-width (length (format "%d" (max 0 (1- nrings)))))
(pole-char (if vert ?\| ?\-))
(base-char (if vert ?\= ?\|))
(base-len (max (+ 8 (* pole-width 3))
(1- (if vert (window-width) (window-height)))))
(max-ring-diameter (/ (- base-len 2) 3))
(pole1-coord (/ max-ring-diameter 2))
(pole2-coord (/ base-len 2))
(pole3-coord (- base-len (/ (1+ max-ring-diameter) 2)))
(pole-coords (list pole1-coord pole2-coord pole3-coord))
;; Number of lines displayed below the bottom-most rings.
(base-lines
(min 3 (max 0 (- (1- (if vert (window-height) (window-width)))
(+ 2 nrings)))))
;; These variables will be set according to hanoi-horizontal-flag:
;; line-offset is the number of characters per line in the buffer.
line-offset
;; fly-row-start is the buffer position of the leftmost or
;; uppermost position in the fly row.
fly-row-start
;; Adding fly-step to a buffer position moves you one step
;; along the fly row in the direction from pole1 to pole2.
fly-step
;; Adding baseward-step to a buffer position moves you one step
;; toward the base.
baseward-step
)
(setq buffer-read-only nil)
(erase-buffer)
(setq truncate-lines t)
(if hanoi-horizontal-flag
(progn
(setq line-offset (+ base-lines nrings 3))
(setq fly-row-start (1- line-offset))
(setq fly-step line-offset)
(setq baseward-step -1)
(cl-loop repeat base-len do
(unless (zerop base-lines)
(insert-char ?\ (1- base-lines))
(insert base-char)
(hanoi-put-face (1- (point)) (point) hanoi-base-face))
(insert-char ?\ (+ 2 nrings))
(insert ?\n))
(delete-char -1)
(dolist (coord pole-coords)
(cl-loop for row from (- coord (/ pole-width 2))
for start = (+ (* row line-offset) base-lines 1)
repeat pole-width do
(subst-char-in-region start (+ start nrings 1)
?\ pole-char)
(hanoi-put-face start (+ start nrings 1)
hanoi-pole-face))))
;; vertical
(setq line-offset (1+ base-len))
(setq fly-step 1)
(setq baseward-step line-offset)
(let ((extra-lines (- (1- (window-height)) (+ nrings 2) base-lines)))
(insert-char ?\n (max 0 extra-lines))
(setq fly-row-start (point))
(insert-char ?\ base-len)
(insert ?\n)
(cl-loop repeat (1+ nrings)
with pole-line =
(cl-loop with line = (make-string base-len ?\ )
for coord in pole-coords
for start = (- coord (/ pole-width 2))
for end = (+ start pole-width) do
(hanoi-put-face start end hanoi-pole-face line)
(cl-loop for i from start below end do
(aset line i pole-char))
finally return line)
do (insert pole-line ?\n))
(insert-char base-char base-len)
(hanoi-put-face (- (point) base-len) (point) hanoi-base-face)
(set-window-start (selected-window)
(1+ (* baseward-step
(max 0 (- extra-lines)))))))
(let
(;; each pole is a pair of buffer positions:
;; the car is the position of the top ring currently on the pole,
;; (or the base of the pole if it is empty).
;; the cdr is in the fly-row just above the pole.
(poles
(cl-loop for coord in pole-coords
for fly-pos = (+ fly-row-start (* fly-step coord))
for base = (+ fly-pos (* baseward-step (+ 2 nrings)))
collect (cons base fly-pos)))
;; compute the string for each ring and make the list of
;; ring pairs. Each ring pair is initially (str . diameter).
;; Once placed in buffer it is changed to (center-pos . diameter).
(rings
(cl-loop
;; radii are measured from the edge of the pole out.
;; So diameter = 2 * radius + pole-width. When
;; there's room, we make each ring's radius =
;; pole-number + 1. If there isn't room, we step
;; evenly from the max radius down to 1.
with max-radius = (min nrings
(/ (- max-ring-diameter pole-width) 2))
for n from (1- nrings) downto 0
for radius = (1+ (/ (* n max-radius) nrings))
for diameter = (+ pole-width (* 2 radius))
with format-str = (format "%%0%dd" pole-width)
for str = (concat (if vert "<" "^")
(make-string (1- radius) (if vert ?\- ?\|))
(format format-str n)
(make-string (1- radius) (if vert ?\- ?\|))
(if vert ">" "v"))
for face =
(if (oddp n)
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.
(line-number-mode nil) (column-number-mode nil))
;; do it!
(hanoi-n bits rings (nth 0 poles) (nth 1 poles) (nth 2 poles)
start-time))
(message "Done"))
(setq buffer-read-only t)
(force-mode-line-update)))