-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathmggen.lisp
72 lines (67 loc) · 2.2 KB
/
mggen.lisp
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
;; MagiStack has general access to any stack element, but the
;; functionality is not readily exposed. So that's what I'm doing
;; here.
;; (cp from-bottom)
;; (mv from-bottom)
(defun translate-command (cmd)
(etypecase cmd
(string cmd)
(symbol (string cmd))
(list (ecase (first cmd)
(cp (let ((idx (second cmd)))
(apply #'concatenate 'string
(append
(loop repeat idx collect ";")
'("~:")
(loop repeat idx collect ";\\")
'("~;")))))
(mv (let ((idx (second cmd)))
(apply #'concatenate 'string
(append
(loop repeat idx collect ";")
'("~")
(loop repeat idx collect ";\\")
'("~;")))))
(block (translate-commands (rest cmd)))))))
(defun translate-commands (cmds)
(apply #'concatenate 'string
(loop for cmd in cmds
collect (translate-command cmd))))
(format t "~A~%"
(let ((x1 '(cp 2))
(y1 '(cp 3))
(x2 '(cp 4))
(y2 '(cp 5))
(x3 '(cp 6))
(y3 '(cp 7))
(tri '(cp 8))
(u '(cp 9))
(v '(cp 10))
(w '(cp 11)))
(translate-commands
`("0 0"
"|"
(block
"^^^^^^"
,y2 ,y3 - ,x1 ,x3 - * ,x3 ,x2 - ,y1 ,y3 - * +
,y2 ,y3 - "0" ,x3 - * ,x3 ,x2 - "0" ,y3 - * +
,y3 ,y1 - "0" ,x3 - * ,x1 ,x3 - "0" ,y3 - * +
,tri ,u - ,v -
"0" ,tri "0\\`" - "2" * "1" +
":" (mv 8) "*\\"
":" (mv 8) "*\\"
":" (mv 8) "*\\"
":" (mv 8) "*\\"
"$"
"0" ,u "`!"
,u ,tri "`!*"
"0" ,v "`!*"
,v ,tri "`!*"
"0" ,w "`!*"
,w ,tri "`!*"
"~;+~"
"$$$$$$$$$$"
"1+"
":91+::**\\`")
"1=<"
"$.91+,"))))