Hanoi Tower puzzle in MIT Scheme（ハノイの塔）

Showed my children the Hanoi-tower which comes along with an excellent editor called Xyzzy.
But the movement is so fast that it did not make sense to them.
So I tried to write a version of the puzzle to show the move of every step clearly.

周末给孩子看Xyzzy自带的Hanoi-tower。但是由于速度比较快，根本看不清
每一步的细节，只能看到开始和结束的状态。于是还是决定自己动手写一个。

週末にXyzzyのハノイの塔を子供達に見せたが、スピードが早く、開始と終了の
状態しか見えなかった。自分で動きはっきり見えるバージョンを書こうと思った。

Result of the program（実行結果）

Source code:
(define (hanoi-iter n start destination intermediate)
  (newline)
  (let ((dat (list start destination intermediate)))
    (map
     (lambda (x)
       (newline)
       (display x))
     (format-merged-columns
      (list (cdr (assoc 'destination dat))
     (cdr (assoc 'intermediate dat))
     (cdr (assoc 'start dat)))
      n (+ (* n 2) 1))))
    (define (iter m s g t)
      (cond ((= m 0)
       (newline)
       (let ((dat (list s g t)))
        (map
  (lambda (x)
    (newline)
    (display x))
  (format-merged-columns
   (list (cdr (assoc 'destination dat))
         (cdr (assoc 'intermediate dat))
         (cdr (assoc 'start dat)))
   n (+ (* n 2) 1)))))
      ((= m 1)
      (set! g (cons (car g) (cons (cadr s) (cdr g))))
      (set! s (cons (car s) (cddr s)))
      (iter (- m 1) s g t))
     (else
      (iter (- m 1) s t g)
      (set! t (cons (car t)
      (append (list-head (cdr s) (- m 1)) (cdr t))))
      (set! s (cons (car s) (list-tail (cdr s) (- m 1))))
      (iter 1 s g t)
      (set! g (cons (car g)
      (cons (cadr s) (cdr g))))
      (set! s (cons (car s) (cddr s)))
      (iter (- m 1) t g s))))

    (iter n start destination intermediate))

(define (hanoi n)
  (let loop ((m n) (start '()))
    (if (= m 0)
 (hanoi-iter n (cons 'start start) (cons 'destination '()) (cons 'intermediate '()))
 (let ((k (- m 1)))
   (loop k (cons k start))))))

(define (format-merged-columns columns height width)
  (map
   (lambda (merged-plates)
     (reduce string-append ""
     ;(car
;       (map
;        (lambda (plate)
;  (reduce string-append "" plate))
      merged-plates))
   (merge-columns columns height width)))

(define (merge-columns columns height width)
  (if (null? columns)
      (make-list height)
      (map append
    (adjust-column (car columns) height width)
    (merge-columns (cdr columns) height width))))

   
(define (adjust-column column height width)
  (let ((col-len (length column))
 (half-pad-seq
  (make-list (/ (- width 1) 2) " ")))
    (let ((pad-elms
    (make-list (- height col-len)
        (append
         half-pad-seq
         (cons "|" half-pad-seq)))))
      (append pad-elms
     (let loop ((plates column))
       (if (null? plates)
    '()
    (cons (adjust-plate (car plates) width)
   (loop (cdr plates)))))))))

(define (adjust-plate plate-number format-length)
  (let ((len (+ (* plate-number 2) 1)))
    (let ((mid-part
    (make-list len (number->string plate-number))))
      (let ((remain-half-len
      (/ (- format-length (length mid-part)) 2)))
 (let ((remain-half
        (make-list remain-half-len " ")))
   (append remain-half
    (append mid-part
     remain-half)))))))