home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
me34exe.zip
/
mutt
/
package
/
ganoi.mut
< prev
next >
Wrap
Lisp/Scheme
|
1995-01-14
|
2KB
|
92 lines
;; ganoi.mut : Good ol towers of hanoi done "graphically"
;; Usage:
;; (hanoi <n>)
;; <n> - an integer number of discs
;; C Durland Public Domain
(include me.mh)
(defun
hanoi MAIN
{
(int DISKS)
(if (or (> (DISKS (convert-to NUMBER (ask "DISKS (max 9) = "))) 9)
(< DISKS 1))
{ (msg "Bogus number of disks")(done) })
(set-up DISKS)
(transfer 0 1 2 DISKS)
(buffer-modified -1 FALSE)
(msg "done.")
}
transfer (from to via)(int n)
{
(if (== n 1)(move-disk from to)
{
(transfer from via to (- n 1))
(move-disk from to)
(transfer via to from (- n 1))
})
}
)
(array int Pegs 3 20) ; (Pegs n 0) ==> count
(defun set-up (int disks)
{
(int n)
(Pegs 0 0 disks)(Pegs 1 0 (Pegs 2 0 0))
(n 1)(while (<= n disks){(Pegs 0 n (- disks n -1))(+= n 1)})
(switch-to-buffer "HANOI")
(clear-buffer)
(insert-text
" A B C")
(newline)(n 10)
(while (>= (n (- n 1)) 0)
{
(insert-text
" | | | ")
(newline)
})
(insert-text
" ==================== ==================== ====================")
(n 1)
(while
{
(put-a-disk (Pegs 0 n)(Pegs 0 n) n 0)
(<= (+= n 1) disks)
} ())
})
(defun
move-disk (int from to)
{
(int a b d)
;(msg "move-disk: " (arg 0) " " (arg 1) " " (Pegs 0 0) " " (Pegs 1 0) " " (Pegs 2 0))(getchar)
(a (Pegs from 0))(b (+ (Pegs to 0) 1)) (d (Pegs from a))
(Pegs from 0 (- a 1))(Pegs to b d)(Pegs to 0 b)
(put-a-disk " " d a from)(put-a-disk d d b to)
}
post (int n)
{
(switch n
0 15
1 40
2 65
)
}
move-to (int row col) { (goto-line row)(current-column col) }
put-a-disk ; input: disk character, number of characters, row, post
(dchar)(int dn drow dpost)
{
(int row col n)
;(msg "put-a-disk \""(arg 0)"\" "(arg 1)" "(arg 2)" "(arg 3))(getchar)
(row (- 12 drow))(col (post dpost))
(n (+ (* 2 dn) 1))
(move-to row (- col (/ n 2)))
(while (<= 0 (n (- n 1))){(insert-text dchar)(delete-character)})
(move-to row col)(delete-character)(insert-text "|")
(update)
}
)