Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/eXene/examples/add/calc.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/examples/add/calc.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* calc.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 AT&T Research.
4 :     *)
5 :    
6 :     signature CALC =
7 :     sig
8 :     structure W : WIDGET
9 :    
10 :     datatype answer = Right | Wrong
11 :     datatype difficulty = Single | Easy | Medium | Hard
12 :     datatype function = Add | Subtract | Multiply
13 :     val functionList : (function * bool) list
14 :     val funcString : function -> string
15 :    
16 :     type calc
17 :    
18 :     val mkCalc : W.root -> calc
19 :     val startGame : calc -> (difficulty * function) -> unit
20 :     val reset : calc -> unit
21 :     val widgetOf : calc -> W.widget
22 :     val eventOf : calc -> answer CML.event
23 :    
24 :     end
25 :    
26 :     structure Calc : CALC =
27 :     struct
28 :     structure W = Widget
29 :    
30 :     open Geometry W Box
31 :    
32 :     fun windowOf w = let
33 :     val winv = SyncVar.iVar ()
34 :     val rf = realizeFn w
35 :     fun rfn (arg as {win,...}) = (SyncVar.iPut(winv,win); rf arg)
36 :     val w' = mkWidget{
37 :     root= rootOf w,
38 :     boundsOf= boundsFn w,
39 :     realize= rfn
40 :     }
41 :     in
42 :     (w',winv)
43 :     end
44 :    
45 :     val fontname =
46 :     "-b&h-lucidatypewriter-bold-r-normal-sans-24-240-75-75-m-140-iso8859-1"
47 :     (* "-sony-fixed-medium-r-normal--24-170-100-100-c-120-iso8859-1" *)
48 :    
49 :     datatype answer = Right | Wrong
50 :     datatype difficulty = Single | Easy | Medium | Hard
51 :     fun diffString Easy = "Easy"
52 :     | diffString Medium = "Medium"
53 :     | diffString Hard = "Hard"
54 :     | diffString Single = "Single"
55 :     datatype function = Add | Subtract | Multiply
56 :     fun funcString Add = " +"
57 :     | funcString Subtract = " -"
58 :     | funcString Multiply = " x"
59 :     fun funcOp Add = Int.+
60 :     | funcOp Subtract = Int.-
61 :     | funcOp Multiply = Int.*
62 :     val functionList = [(Add,true), (Subtract,false), (Multiply,false)]
63 :    
64 :     datatype rqst = Start of (difficulty * function) | Reset
65 :    
66 :     datatype calc = CALC of {
67 :     widget : widget,
68 :     reqChan : rqst CML.chan,
69 :     answerEvt : answer CML.event
70 :     }
71 :    
72 :     fun fixVert w = let
73 :     val SIZE{ht,...} = natSize w
74 :     val ydim = fixDim ht
75 :     fun bndfn bounds_of = let
76 :     val {x_dim,y_dim} = bounds_of ()
77 :     in
78 :     {x_dim=x_dim,y_dim=ydim}
79 :     end
80 :     in
81 :     Shape.mkShape {
82 :     widget=w,
83 :     bounds_fn = bndfn,
84 :     resize_fn = fn _ => true
85 :     }
86 :     end
87 :    
88 :     fun getSeed () = Time.toReal(Time.now())
89 :    
90 :     fun genVals (random,d) = let
91 :     val maxrange =
92 :     case d of
93 :     Single => 9
94 :     | Easy => 99
95 :     | Medium => 999
96 :     | Hard => 9999
97 :    
98 :     fun gen () = let
99 :     val v1 = Rand.range (1,maxrange) (random())
100 :     val v2 = Rand.range (1,maxrange) (random())
101 :     in
102 :     if v1 < v2 then (v2,v1) else (v1, v2)
103 :     end
104 :     in
105 :     gen
106 :     end
107 :    
108 :     fun doInput (kbd,label,anschan) = let
109 :     open Interact
110 :     val lookup = lookupString defaultTranslation
111 :     fun isErase c = c = #"\^H"
112 :     fun isNewline c = (c = #"\^M") orelse (c = #"\^J")
113 :    
114 :     fun addDigit (c,s) = let
115 :     val s' = String.str c ^ s
116 :     in
117 :     Label.setLabel label (Label.Text s');
118 :     s'
119 :     end
120 :    
121 :     fun erase "" = ""
122 :     | erase s = let
123 :     val s' = substring(s,1,size s - 1)
124 :     in
125 :     Label.setLabel label (Label.Text s'); s'
126 :     end
127 :    
128 :     val (kbdevt,_) = CML.sync kbd
129 :     fun restart cv = let
130 :     fun handleKbd(KEY_Press key,s) = (let
131 :     val c = String.sub(lookup key, 0)
132 :     in
133 :     if isErase c then erase s
134 :     else if isNewline c andalso size s > 0 then (
135 :     (SyncVar.iPut(cv, valOf(Int.fromString s)))
136 :     handle _ => SyncVar.iPut(cv,0);
137 :     initLoop())
138 :     else if Char.isDigit c then addDigit(c,s)
139 :     else s
140 :     end handle _ => s)
141 :    
142 :     | handleKbd(_,s) = s
143 :    
144 :     fun loop s =
145 :     CML.select[
146 :     CML.wrap(CML.recvEvt anschan, restart),
147 :     CML.wrap(kbdevt, fn k => loop(handleKbd(msgBodyOf k,s)))
148 :     ]
149 :     in
150 :     Label.setLabel label (Label.Text "");
151 :     loop ""
152 :     end
153 :    
154 :     and initLoop () =
155 :     CML.select[
156 :     CML.wrap(CML.recvEvt anschan, restart),
157 :     CML.wrap(kbdevt, fn _ => initLoop())
158 :     ]
159 :     in
160 :     initLoop ();
161 :     ()
162 :     end
163 :    
164 :     fun mkCalc root = let
165 :     val reqChan = CML.channel ()
166 :     val answerChan = CML.channel ()
167 :     val ansChan = CML.channel ()
168 :     val seed = getSeed ()
169 :     val random = Rand.mkRandom seed
170 :     val ansbox = Answer.mkAnswer (root,fontname)
171 :     val val1 = Label.mkLabel root {
172 :     align = HRight,
173 :     font = SOME fontname,
174 :     label = "",
175 :     foregrnd = NONE,
176 :     backgrnd = NONE
177 :     }
178 :     val val2 = Label.mkLabel root {
179 :     align = HRight,
180 :     font = SOME fontname,
181 :     label = "",
182 :     foregrnd = NONE,
183 :     backgrnd = NONE
184 :     }
185 :     val sign = Label.mkLabel root {
186 :     align = HRight,
187 :     font = SOME fontname,
188 :     label = " ",
189 :     foregrnd = NONE,
190 :     backgrnd = NONE
191 :     }
192 :     val answer = Label.mkLabel root {
193 :     align = HRight,
194 :     font = SOME fontname,
195 :     label = "",
196 :     foregrnd = NONE,
197 :     backgrnd = NONE
198 :     }
199 :     val layout = mkLayout root (HzCenter[
200 :     Glue{nat=10,min=10,max=SOME 20},
201 :     VtCenter [
202 :     WBox (fixVert (Label.widgetOf val1)),
203 :     HzCenter[
204 :     WBox (Shape.mkRigid (Label.widgetOf sign)),
205 :     WBox (fixVert (Label.widgetOf val2))
206 :     ],
207 :     Box.WBox (Divider.mkHorzDivider root {color=NONE,width=2}),
208 :     WBox (fixVert (Label.widgetOf answer))
209 :     ],
210 :     Glue{nat=10,min=10,max=SOME 20}
211 :     ])
212 :     val (layout,kbd) = filterKey (widgetOf layout)
213 :     val (layout,win) = windowOf layout
214 :    
215 :     fun resetAns ans = CML.send(ansChan, ans)
216 :    
217 :     fun fire NONE = ()
218 :     | fire (SOME cv) = SyncVar.iPut(cv,())
219 :    
220 :     val dbtm = Answer.dbtm
221 :     val trace = TraceCML.trace
222 :    
223 :     fun startGame (d,f) = let
224 :     val getVals = genVals (random,d)
225 :     val evalFn = funcOp f
226 :     val signString = funcString f
227 :     fun doReq (Start d) = startGame d
228 :     | doReq Reset = calc NONE
229 :     fun round () = let
230 :     val (v1,v2) = getVals ()
231 :     val ansv = SyncVar.iVar ()
232 :     val ans = evalFn(v1,v2)
233 :     fun chk v =
234 :     if ans = v then (CML.send(answerChan,Right);round ())
235 :     else let
236 :     val w = SyncVar.iGet win
237 :     val _ = trace(dbtm,fn () => ["calc show answer\n"])
238 :     val av = Answer.showAnswer(ansbox,w,v1,v2,signString,ans)
239 :     in
240 :     trace(dbtm,fn () => ["answer up\n"]);
241 :     CML.send(answerChan,Wrong);
242 :     calc (SOME av)
243 :     end
244 :     in
245 :     Label.setLabel val1 (Label.Text(Int.toString v1));
246 :     Label.setLabel val2 (Label.Text(Int.toString v2));
247 :     resetAns ansv;
248 :     CML.select [
249 :     CML.wrap(CML.recvEvt reqChan, doReq),
250 :     CML.wrap(SyncVar.iGetEvt ansv, chk)
251 :     ]
252 :     end
253 :     in
254 :     Label.setLabel sign (Label.Text signString);
255 :     round ()
256 :     end
257 :    
258 :     and calc cvo = let
259 :     fun loop () =
260 :     case CML.recv reqChan of
261 :     Start d => (trace(dbtm,fn () => ["fire cv\n"]);fire cvo; startGame d)
262 :     | Reset => loop ()
263 :     in
264 :     Label.setLabel val1 (Label.Text "");
265 :     Label.setLabel val2 (Label.Text "");
266 :     Label.setLabel answer (Label.Text "");
267 :     loop ()
268 :     end
269 :     in
270 :     (* TraceCML.traceOn Answer.dbtm; *)
271 :     CML.spawn (fn () => doInput(kbd,answer,ansChan));
272 :     CML.spawn (fn () => calc NONE);
273 :     CALC{
274 :     widget = layout,
275 :     reqChan = reqChan,
276 :     answerEvt = CML.recvEvt answerChan
277 :     }
278 :     end
279 :    
280 :     fun startGame (CALC{reqChan,...}) d = CML.send(reqChan,Start d)
281 :     fun reset (CALC{reqChan,...}) = CML.send(reqChan,Reset)
282 :     fun widgetOf (CALC{widget,...}) = widget
283 :     fun eventOf (CALC{answerEvt,...}) = answerEvt
284 :    
285 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0