summaryrefslogtreecommitdiff
path: root/src/test/hanoi.lisp
blob: 0c4bfca5cfb077b4f5d69ca6133bac8312d0c06a (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
120
121
(defun move-to (col row)
  (patom "\033[" row ";" col "H" nil)
  )

(defun clear ()
  (patom "\033[2J" nil)
  )

(setq stack '("*" "**" "***" "****" "*****" "******" "*******"))

(setq top (+ (length stack) 3))

(setq stacks nil)

(defun display-string (x y str)
  (move-to x y)
  (patom str)
  )

(defun display-stack (x y clear stack)
  (cond ((= 0 clear)
	 (cond (stack (progn
			(display-string x y (car stack))
			(display-stack x (1+ y) 0 (cdr stack))
			)
		      )
	       )
	 )
	(t (progn
	     (display-string x y "          ")
	     (display-stack x (1+ y) (1- clear) stack)
	     )
	   )
	)
  )

(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
		  (display-stack x 0 (stack-pos y (car stacks)) (car stacks))
		  (display-stacks (+ x 20) y (cdr stacks)))
		)
	)
  )

(defun display ()
  (display-stacks 0 top 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)
  )