home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / mutt / ganoi.mut < prev    next >
Lisp/Scheme  |  1988-09-15  |  2KB  |  85 lines
  1. ; ganoi.mut : Good ol towers of hanoi done "graphically"
  2. ; Usage:
  3. ;      (hanoi <n>)
  4. ;          <n> - an integer number of discs
  5.  
  6. (defun 
  7.   hanoi MAIN
  8.   {
  9.     (int DISKS)
  10.     (if (or (> (DISKS (atoi(ask "DISKS (max 9) = "))) 9) (< DISKS 1))
  11.     {(msg "Bogus number of disks")(done)})
  12.     (set-up DISKS)
  13.     (transfer 0 1 2 DISKS)
  14.     (buffer-modified -1 FALSE)(msg "done.")
  15.   }
  16.   transfer (from to via)(int n)
  17.   {
  18.     (if (== n 1)(move-disk from to)
  19.     {
  20.       (transfer from via to (- n 1))
  21.       (move-disk from to)
  22.       (transfer via to from (- n 1))
  23.     })
  24.   }
  25. )
  26.  
  27. (array int Pegs 3 20)    ; (Pegs n 0) ==> count
  28. (defun set-up (int disks)
  29. {
  30.   (int n)
  31.  
  32.   (Pegs 0 0 disks)(Pegs 1 0 (Pegs 2 0 0))
  33.   (n 1)(while (<= n disks){(Pegs 0 n (- disks n -1))(+= n 1)})
  34.   (switch-to-buffer "HANOI")
  35.   (beginning-of-buffer)(set-mark)(end-of-buffer)(erase-region)
  36.   (insert-text
  37. "              A                        B                        C")
  38.   (newline)(n 10)
  39.   (while (>= (n (- n 1)) 0)
  40.   {
  41.     (insert-text
  42. "              |                        |                        |        ")
  43.     (newline)
  44.   })
  45.     (insert-text
  46. "     ====================     ====================     ====================")
  47.   (n 1)
  48.   (while 
  49.     {(put-a-disk (Pegs 0 n)(Pegs 0 n) n 0)
  50.     (<= (+= n 1) disks)}
  51.     {})
  52. })
  53.  
  54. (defun
  55.   move-disk (int from to)
  56.   {
  57.     (int a b d)
  58. ;(msg "move-disk: " (arg 0) " " (arg 1) " " (Pegs 0 0) " " (Pegs 1 0) " " (Pegs 2 0))(getchar)
  59.     (a (Pegs from 0))(b (+ (Pegs to 0) 1)) (d (Pegs from a))
  60.     (Pegs from 0 (- a 1))(Pegs to b d)(Pegs to 0 b)
  61.     (put-a-disk " "  d a from)(put-a-disk d d b to)
  62.   }
  63.   post (int n)
  64.   {
  65.     (switch n
  66.       0 15
  67.       1 40
  68.       2 65
  69.     )
  70.   }
  71.   move-to (int row col) { (goto-line row)(current-column col) }
  72.   put-a-disk    ; input: disk character, number of characters, row, post
  73.     (dchar)(int dn drow dpost)
  74.   {
  75.     (int row col n)
  76. ;(msg "put-a-disk \""(arg 0)"\" "(arg 1)" "(arg 2)" "(arg 3))(getchar)
  77.     (row (- 12 drow))(col (post dpost))
  78.     (n (+ (* 2 dn) 1))
  79.     (move-to row (- col (/ n 2)))
  80.     (while (<= 0 (n (- n 1))){(insert-text dchar)(delete-character)})
  81.     (move-to row col)(delete-character)(insert-text "|")
  82.     (update)
  83.   }
  84. )
  85.