-
Notifications
You must be signed in to change notification settings - Fork 1
/
vend.lsp
134 lines (114 loc) · 4.75 KB
/
vend.lsp
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
122
123
124
125
126
127
128
129
130
131
132
(let (
(vmId "vm")
(vm (object ("g2d.jlambda.Attributable")))
(frame (object ("javax.swing.JFrame" "Prancing Pony II")))
(apples (object ("javax.swing.JLabel")))
(cakes (object ("javax.swing.JLabel")))
(dollars (object ("javax.swing.JLabel")))
(quarters (object ("javax.swing.JLabel")))
(status (object ("javax.swing.JLabel" "Deficit: 0.0")))
(menu (object ("javax.swing.JMenuBar")))
(credit (object ("javax.swing.JMenu" "Insert Money")))
(debit (object ("javax.swing.JMenu" "Buy Item")))
(dollar (object ("javax.swing.JMenuItem" "$")))
(quarter (object ("javax.swing.JMenuItem" "$/4")))
(change (object ("javax.swing.JMenuItem" "qqqq->$")))
(apple (object ("javax.swing.JMenuItem" "Apple")))
(cake (object ("javax.swing.JMenuItem" "Cake")))
;;closures to be installed as ActionListener's
(dollarClosure (lambda (self e)
(invoke java.lang.System.err "println" "\nadded $")
(apply vendDebit (float 1))
;; (sinvoke "g2d.util.ActorMsg" "send" "maude" vmId "applyrulesc vm vm add-$")
(sinvoke "g2d.util.ActorMsg" "send" "maude" vmId
(concat "vend" " " "add-$"))
(apply vendStatus)
))
(quarterClosure (lambda (self e)
(invoke java.lang.System.err "println" "\nadded $/4")
(apply vendDebit (float 0.25))
;; (sinvoke "g2d.util.ActorMsg" "send" "maude" vmId "applyrulesc vm vm add-q")
(sinvoke "g2d.util.ActorMsg" "send" "maude" vmId
(concat "vend" " " "add-q"))
(apply vendStatus)
))
(changeClosure (lambda (self e)
(invoke java.lang.System.err "println" "\naqqqq->$")
(sinvoke "g2d.util.ActorMsg" "send" "maude" vmId
(concat "vend" " " "change"))
))
(appleClosure (lambda (self e)
(invoke java.lang.System.err "println" "\nbought apple")
;; (sinvoke "g2d.util.ActorMsg" "send" "maude" vmId "applyrulesc vm vm buy-a")
(sinvoke "g2d.util.ActorMsg" "send" "maude" vmId
(concat "vend" " " "buy-a"))
))
(cakeClosure (lambda (self e)
(invoke java.lang.System.err "println" "\nbought cake")
;; (sinvoke "g2d.util.ActorMsg" "send" "maude" vmId "applyrulesc vm vm buy-c")
(sinvoke "g2d.util.ActorMsg" "send" "maude" vmId
(concat "vend" " " "buy-c"))
)) ; cakeClosure
) ;; letbindings
;;setup the frame
(invoke frame "setLayout" (object ("java.awt.GridLayout" (int 5) (int 1))))
(invoke frame "add" apples)
(invoke frame "add" cakes)
(invoke frame "add" dollars)
(invoke frame "add" quarters)
(invoke frame "add" status)
;; installing the closures as ActionListener's
(invoke dollar "addActionListener"
(object ("g2d.closure.ClosureActionListener" dollarClosure)))
(invoke quarter "addActionListener"
(object ("g2d.closure.ClosureActionListener" quarterClosure)))
(invoke change "addActionListener"
(object ("g2d.closure.ClosureActionListener" changeClosure)))
(invoke apple "addActionListener"
(object ("g2d.closure.ClosureActionListener" appleClosure)))
(invoke cake "addActionListener"
(object ("g2d.closure.ClosureActionListener" cakeClosure)))
(invoke credit "add" dollar)
(invoke credit "add" quarter)
(invoke credit "add" change)
(invoke debit "add" apple)
(invoke debit "add" cake)
(invoke menu "add" credit)
(invoke menu "add" debit)
(invoke frame "setJMenuBar" menu)
(invoke vm "setUID" vmId)
(setAttr vm
"GUInterface"
(lambda (d q a c)
(seq
(invoke java.lang.System.err "println" (concat "d = " d))
(invoke apples "setText" (apply makeLabel "Apples: " "A " a))
(invoke cakes "setText" (apply makeLabel "Cakes: " "C " c))
(invoke dollars "setText" (apply makeLabel "Dollars: " "$ " d))
(invoke quarters "setText" (apply makeLabel "Quarters: " "q " q))
(apply vendStatus))))
(define vendUpdate (vname d q a c)
(apply (getAttr (fetch vname) "GUInterface" (object null)) d q a c))
(define vendDebit (amount)
(let ((vend (fetch vmId)))
(setAttr vend "deficit" (+ (getAttr vend "deficit" (float 0)) amount))))
(define vendStatus ()
(let ((vend (fetch vmId))
(tally (getAttr vend "deficit" (float 0)))
(tstring (concat "Deficit: " tally)))
(seq
(invoke status "setText" tstring)
)
)
)
(define makeLabelAux (ch num result)
(if (= num (int 0))
result
(apply makeLabelAux ch (- num (int 1)) (concat result " " ch))))
(define makeLabel (prefix ch num)
(concat prefix (apply makeLabelAux ch num "")))
(setAttr vm "deficit" (float 0))
(apply vendUpdate vmId (int 0) (int 0) (int 0) (int 0))
(invoke frame "setSize" (int 300) (int 200))
(invoke frame "setVisible" (boolean true))
)