blob: 2b614829a8f85ec6ce3e844b022fccc76b4dd11e (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
(defun move-to (col row)
(patom "\033[" row ";" col "H" nil)
)
(defun clear ()
(patom "\033[2J" nil)
)
(setq stack '("*" "**" "***" "****" "*****" "******" "*******"))
(setq stacks nil)
(defun display-string (x y str)
(move-to x y)
(patom str)
)
(defun display-stack (x y stack)
(cond (stack (progn
(display-string x y (car stack))
(display-stack x (1+ y) (cdr stack)))))
)
(defun clear-stack (x y)
(cond ((> y 0) (progn
(move-to x y)
(patom " ")
(clear-stack x (1- y))
)
)
)
)
(defun length (list)
(cond (list (1+ (length (cdr list))))
(0)
)
)
(defun stack-pos (y stack)
(- y (length stack))
)
(defun display-stacks (x y stacks)
(cond (stacks (progn
(clear-stack x 20)
(display-stack x (stack-pos y (car stacks)) (car stacks))
(display-stacks (+ x 20) y (cdr stacks)))
)
)
)
(defun display ()
(display-stacks 0 20 stacks)
(move-to 1 21)
(flush)
)
(defun length (l)
(cond (l (1+ (length (cdr l)))) (0))
)
(defun reset-stacks ()
(setq stacks (list stack nil nil))
(length stack)
)
(defun min (a b)
(cond ((< a b) a)
(b)
)
)
(defun nth (list n)
(cond ((= n 0) (car list))
((nth (cdr list) (1- n)))
)
)
(defun replace (list pos member)
(cond ((= pos 0) (cons member (cdr list)))
((cons (car list) (replace (cdr list) (1- pos) member)))
)
)
(defun move-piece (from to)
(let ((from-stack (nth stacks from))
(to-stack (nth stacks to))
(piece (car from-stack)))
(setq from-stack (cdr from-stack))
(setq to-stack (cons piece to-stack))
(setq stacks (replace stacks from from-stack))
(setq stacks (replace stacks to to-stack))
(display)
(delay 100)
)
)
(defun _hanoi (n from to use)
(cond ((= 1 n)
(progn
(move-piece from to)
nil)
)
(t
(progn
(_hanoi (1- n) from use to)
(_hanoi 1 from to use)
(_hanoi (1- n) use to from)
)
)
)
)
(defun hanoi ()
(setq len (reset-stacks))
(clear)
(_hanoi len 0 1 2)
)
|
