Function: hanoi-ring-to-pos

hanoi-ring-to-pos is a byte-compiled function defined in hanoi.el.gz.

Signature

(hanoi-ring-to-pos RING POS)

Source Code

;; Defined in /usr/src/emacs/lisp/play/hanoi.el.gz
;; move ring to a given buffer position and update ring's car.
(defun hanoi-ring-to-pos (ring pos)
  (unless (= (car ring) pos)
    (let* ((start (- (car ring) (* (/ (cdr ring) 2) fly-step)))
	   (new-start (- pos (- (car ring) start))))
      (if hanoi-horizontal-flag
	  (cl-loop for i below (cdr ring)
                   for j = (if (< new-start start) i (- (cdr ring) i 1))
                   for old-pos = (+ start (* j fly-step))
                   for new-pos = (+ new-start (* j fly-step)) do
                   (transpose-regions old-pos (1+ old-pos)
                                      new-pos (1+ new-pos)))
	(let ((end (+ start (cdr ring)))
	      (new-end (+ new-start (cdr ring))))
	  (if (< (abs (- new-start start)) (- end start))
	      ;; Overlap.  Adjust bounds
	      (if (< start new-start)
		  (setq new-start end)
		(setq new-end start)))
	  (transpose-regions start end new-start new-end t))))
    ;; If moved on or off a pole, redraw pole chars.
    (unless (eq (hanoi-pos-on-tower-p (car ring)) (hanoi-pos-on-tower-p pos))
      (let* ((pole-start (- (car ring) (* fly-step (/ pole-width 2))))
	     (pole-end (+ pole-start (* fly-step pole-width)))
	     (on-pole (hanoi-pos-on-tower-p (car ring)))
	     (new-char (if on-pole pole-char ?\ ))
	     (curr-char (if on-pole ?\  pole-char))
	     (face (if on-pole hanoi-pole-face nil)))
	(if hanoi-horizontal-flag
	    (cl-loop for pos from pole-start below pole-end by line-offset do
                     (subst-char-in-region pos (1+ pos) curr-char new-char)
                     (hanoi-put-face pos (1+ pos) face))
	  (subst-char-in-region pole-start pole-end curr-char new-char)
	  (hanoi-put-face pole-start pole-end face))))
    (setcar ring pos))
  (hanoi-goto-char pos))