Gordons Projects

--> Projects Top-Level GIT

Initial commit into GIT
[cesil] / cesil.rtb
1 //
2 // CESIL Interperter
3 //  Computer Education in Schools Instructional Language
4 //
5 //  With an xmas tree and user-programmable fairy lights
6 //    Gordon Henderson, November 2012
7 //    https://projects.drogon.net/
8 //
9 stackSize = 64
10 mxProgSize = 256
11 DIM fx(4, 8), fy(4, 8), fairyColours(4, 8)
12 DIM cesil$(mxProgSize)
13 DIM labels$(mxProgSize), operators$(mxProgSize), operands$(mxProgSize)
14 DIM vars(64), subStack(stackSize)
15 NUMFORMAT (8, 0)
16 error$ = ""
17 label$ = ""
18 operator$ = ""
19 operand$ = ""
20 tree = FALSE
21 //
22 CLS 
23 PRINT 
24 PRINT "CESIL: Computer Education in Schools Instructional Language"
25 PRINT "==========================================================="
26 PRINT 
27 CYCLE 
28   PRINT 
29   INPUT "Program to load: ", prog$
30   if len (prog$) = 0 then break
31   PROC loadProgram(prog$ + ".csl")
32   IF numLines = 0 THEN 
33     PRINT "Program load failed"
34     CONTINUE 
35   ENDIF 
36   //
37   CYCLE 
38     PROC runCESIL
39     PRINT "Run Again? ";  
40     CYCLE 
41       k$ = GET$
42     REPEAT UNTIL k$ = "y" OR k$ = "Y" OR k$ = "n" OR k$ = "N"
43     IF k$ = "n" OR k$ = "N" THEN 
44       PRINT "No."
45       BREAK 
46     ELSE 
47       PRINT "Yes"
48     ENDIF 
49   REPEAT 
50 REPEAT 
51 print
52 print "+++OUT OF CHEESE ERROR. STOP."
53 END 
54 //
55 // loadProgram
56 //    Read in a program from disk
57 //
58 DEF PROC loadProgram(file$)
59 LOCAL handle, ln$
60 //
61 error$ = ""
62 numLines = 0
63 //
64 handle = OPENIN (file$)
65 IF handle = -1 THEN ENDPROC 
66 //
67 WHILE  NOT EOF (handle) CYCLE 
68   numLines = numLines + 1
69   INPUT# handle, ln$
70   ln$ = FN upperCase(ln$)
71   cesil$(numLines) = ln$
72   IF LEN (ln$) = 0 OR LEFT$ (ln$, 1) = "#" THEN 
73     labels$(numLines) = ""
74     operators$(numLines) = ""
75     operands$(numLines) = ""
76     CONTINUE 
77   ENDIF 
78   PROC splitLine(ln$)
79   IF error$ <> "" THEN 
80     PRINT "Program LOAD fail at line ";  numLines;  ": ";  error$
81     PRINT "[";  numLines;  "] ";  cesil$(numLines)
82     BREAK 
83   ENDIF 
84   labels$(numLines) = label$
85   operators$(numLines) = operator$
86   operands$(numLines) = operand$
87 REPEAT 
88 CLOSE (handle)
89 ENDPROC 
90 //
91 // runCESIL:
92 //    Run A CESIL program
93 //
94 DEF PROC runCESIL
95 LOCAL i, p
96 LOCAL x, key$
97 LOCAL acc, pc, row, col, halt
98 acc = 0
99 pc = 0
100 row = 0
101 col = 0
102 stackPtr = 0
103 pc = 1
104 sStep = FALSE
105 halt = FALSE
106 //
107 CYCLE 
108   //
109   // Space to pause, Q to quit
110   //
111   x = INKEY
112   IF x = ASC ("q") OR x = ASC ("Q") THEN BREAK 
113   //
114   IF x = ASC (" ") OR sStep THEN 
115     key$ = GET$
116     IF key$ = "q" OR key$ = "Q" THEN BREAK 
117     IF key$ = " " THEN 
118       sStep = TRUE
119     ELSE 
120       sStep = FALSE
121     ENDIF 
122   ENDIF 
123   //
124   IF pc > numLines THEN 
125     PRINT "Unnexpected end of program"
126     BREAK 
127   ENDIF 
128   //
129   operator$ = operators$(pc)
130   IF operator$ = "" THEN 
131     pc = pc + 1
132     CONTINUE 
133   ENDIF 
134   operand$ = operands$(pc)
135   //
136   SWITCH (operator$)
137     CASE "LOAD"
138       acc = FN eval(operand$)
139       pc = pc + 1
140     ENDCASE 
141     //
142     CASE "STORE"
143       PROC store(operand$, acc)
144       pc = pc + 1
145     ENDCASE 
146     //
147     CASE "JUMP"
148       pc = FN findLabel(operand$)
149     ENDCASE 
150     //
151     CASE "JINEG"
152       IF acc < 0 THEN 
153         pc = FN findLabel(operand$)
154       ELSE 
155         pc = pc + 1
156       ENDIF 
157     ENDCASE 
158     //
159     CASE "JIZERO"
160       IF acc = 0 THEN 
161         pc = FN findLabel(operand$)
162       ELSE 
163         pc = pc + 1
164       ENDIF 
165     ENDCASE 
166     //
167     CASE "ADD"
168       acc = acc + FN eval(operand$)
169       pc = pc + 1
170     ENDCASE 
171     //
172     CASE "SUB"
173       acc = acc - FN eval(operand$)
174       pc = pc + 1
175     ENDCASE 
176     //
177     CASE "MUL"
178       acc = acc * FN eval(operand$)
179       pc = pc + 1
180     ENDCASE 
181     //
182     CASE "DIV"
183       acc = INT (acc / FN eval(operand$))
184       pc = pc + 1
185     ENDCASE 
186     //
187     CASE "HALT"
188       halt = TRUE
189     ENDCASE 
190     //
191     CASE "JSR"
192       IF stackPtr = stackSize THEN 
193         error$ = "Too many JSRs"
194       ELSE 
195         subStack(stackPtr) = pc
196         stackPtr = stackPtr + 1
197         pc = FN findLabel(operand$)
198       ENDIF 
199     ENDCASE 
200     //
201     CASE "RET"
202       IF stackPtr = 0 THEN 
203         error$ = "RET without JSR"
204       ELSE 
205         stackPtr = stackPtr - 1
206         pc = subStack(stackPtr) + 1
207       ENDIF 
208     ENDCASE 
209     //
210     CASE "PRINT"
211       PRINT operand$;  
212       pc = pc + 1
213     ENDCASE 
214     //
215     CASE "OUT"
216       PRINT acc;  
217       pc = pc + 1
218     ENDCASE 
219     //
220     CASE "LINE"
221       PRINT 
222       pc = pc + 1
223     ENDCASE 
224     //
225     CASE "IN"
226       INPUT in$
227       acc = VAL (in$)
228       pc = pc + 1
229     ENDCASE 
230     //
231     // Extensions
232     //
233     CASE "WAIT"
234       t = FN eval(operand$)
235       IF t <> -1 THEN 
236         PROC updateFairies
237         UPDATE 
238         WAIT (t / 100)
239       ENDIF 
240       pc = pc + 1
241     ENDCASE 
242     //
243     CASE "TREE"
244       HGR 
245       PROC setupTree
246       PROC updateFairies
247       UPDATE 
248       pc = pc + 1
249     ENDCASE 
250     //
251     CASE "ROW"
252       row = acc
253       pc = pc + 1
254     ENDCASE 
255     //
256     CASE "COL"
257       col = acc
258       pc = pc + 1
259     ENDCASE 
260     //
261     CASE "COLOUR"
262       fairyColours(row, col) = acc & 15
263       pc = pc + 1
264     ENDCASE 
265     //
266     DEFAULT 
267       error$ = "Undefined Operator"
268     ENDCASE 
269   ENDSWITCH 
270   //
271   IF error$ <> "" THEN 
272     PRINT "Error at line ";  pc;  ": ";  error$
273     BREAK 
274   ENDIF 
275   //
276   IF halt THEN BREAK 
277   //
278 REPEAT 
279 //
280 ENDPROC 
281 //
282 // eval:
283 //    Return the number that the operand represents.
284 //    It's either a literal number, or a variable
285 //
286 DEF FN eval(operand$)
287 LOCAL x$
288 IF LEN (operand$) = 0 THEN 
289   error$ = "Missing operand"
290    = -1
291 ENDIF 
292 //
293 x$ = LEFT$ (operand$, 1)
294 IF x$ = "-" OR (x$ >= "0" AND x$  <= "9") THEN 
295    = VAL (operand$)
296 ENDIF 
297  = vars(operand$)
298 //
299 // store:
300 //    Store the ACC in memory
301 //
302 DEF PROC store(operand$, acc)
303 vars(operand$) = acc
304 ENDPROC 
305 //
306 // findLabel:
307 //    Search the program for a label target
308 //
309 DEF FN findLabel(label$)
310 LOCAL i
311 FOR i = 1 TO numLines CYCLE 
312   IF labels$(i) = label$ THEN BREAK 
313 REPEAT 
314 IF i > numLines THEN 
315   error$ = "Label <" + label$ + "> not found"
316    = -1
317 ELSE 
318    = i
319 ENDIF
320 //
321 // dumpProg
322 //    Debugging
323 //
324 DEF PROC dumpProg
325 LOCAL i
326 FOR i = 1 TO numLines CYCLE 
327   PRINT i;  ": ";  
328   PROC pStr(labels$(i) + ":", 16)
329   PROC pStr(operators$(i), 8)
330   PROC pStr(operands$(i), 8)
331   PRINT 
332 REPEAT 
333 ENDPROC 
334 //
335 DEF PROC pStr(s$, w)
336 LOCAL i
337 PRINT s$;  
338 FOR i = 1 TO LEN (s$) - w CYCLE 
339   PRINT " ";  
340 REPEAT 
341 ENDPROC 
342 //
343 // splitLine:
344 //    Split a line into its 3 components:
345 //      label, operator, operand
346 //
347 DEF PROC splitLine(progl$)
348 LOCAL x$, sPtr
349 label$ = ""
350 operator$ = ""
351 operand$ = ""
352 //
353 // Check for a label
354 //
355 sPtr = 0
356 x$ = LEFT$ (progl$, 1)
357 IF  NOT (x$ = " " OR x$ = CHR$ (9)) THEN  // No Label
358   FOR sPtr = 0 TO LEN (progl$) - 1 CYCLE 
359     x$ = MID$ (progl$, sPtr, 1)
360     IF x$ = ":" THEN BREAK 
361     label$ = label$ + x$
362   REPEAT 
363   IF x$ <> ":" THEN 
364     error$ = "Invalid label"
365     ENDPROC 
366   ENDIF 
367 ENDIF 
368 //
369 // Check for an operator
370 //
371 progl$ = FN trim(RIGHT$ (progl$, LEN (progl$) - sPtr - 1))
372 IF LEN (progl$) = 0 THEN ENDPROC 
373 IF LEFT$ (progl$, 1) = "#" THEN ENDPROC 
374 //
375 FOR sPtr = 0 TO LEN (progl$) - 1 CYCLE 
376   x$ = MID$ (progl$, sPtr, 1)
377   IF x$ = " " OR x$ = CHR$ (9) THEN BREAK 
378   operator$ = operator$ + x$
379 REPEAT 
380 //
381 // Check for operand
382 //
383 progl$ = FN trim(RIGHT$ (progl$, LEN (progl$) - sPtr - 1))
384 IF LEN (progl$) = 0 THEN ENDPROC 
385 IF LEFT$ (progl$, 1) = "#" THEN ENDPROC 
386 IF LEFT$ (progl$, 1) = CHR$ (34) THEN  // Double quote
387   FOR sPtr = 1 TO LEN (progl$) - 1 CYCLE 
388     x$ = MID$ (progl$, sPtr, 1)
389     IF x$ = CHR$ (34) THEN BREAK 
390     operand$ = operand$ + x$
391   REPEAT 
392 ELSE 
393   FOR sPtr = 0 TO LEN (progl$) - 1 CYCLE 
394     x$ = MID$ (progl$, sPtr, 1)
395     IF x$ = " " OR x$ = CHR$ (9) THEN BREAK 
396     operand$ = operand$ + x$
397   REPEAT 
398 ENDIF 
399 //
400 ENDPROC 
401 //
402 //
403 // FN upperCase:
404 //    Translate a line of text into upper case
405 //
406 DEF FN upperCase(mixed$)
407 LOCAL t$, i
408 IF LEN (mixed$) = 0 THEN  = mixed$
409 t$ = ""
410 FOR i = 0 TO LEN (mixed$) - 1 CYCLE 
411   x$ = MID$ (mixed$, i, 1)
412   IF ASC (x$) >= 96 THEN x$ = CHR$ (ASC (x$) - 32) // ASCII FTW...
413   t$ = t$ + x$
414 REPEAT 
415  = t$
416 //
417 // trim:
418 //    Remove leading spaces (recursively)
419 //
420 DEF FN trim(ln$)
421 IF LEN (ln$) = 0 THEN  = ln$
422 IF LEFT$ (ln$, 1) = " " OR LEFT$ (ln$, 1) = CHR$ (9) THEN 
423    = FN trim(RIGHT$ (ln$, LEN (ln$) - 1))
424 ELSE 
425    = ln$
426 ENDIF 
427 //
428 //
429 // setupTree:
430 //    Draw the tree and initialise the fairy lights to all on, white (silver)
431 //
432 DEF PROC setupTree
433 LOCAL pass, i, x, y
434 LOCAL row, fairy
435 LOCAL foo()
436 LOCAL xx(), yy()
437 //
438 RESTORE
439 DIM xx(32), yy(32)
440 xmul = GWIDTH / 32
441 ymul = GHEIGHT / 24
442 //
443 // Draw the Pot and Tree
444 //
445 FOR pass = 1 TO 3 CYCLE 
446   i = 0
447   CYCLE 
448     READ x, y
449     IF x = -1 THEN BREAK 
450     xx(i) = x
451     yy(i) = y
452     i = i + 1
453   REPEAT 
454   PROC treePlotter(pass, i)
455 REPEAT 
456 //
457 // Put up the fairy lights
458 //
459 FOR row = 0 TO 3 CYCLE 
460   FOR fairy = 0 TO 3 CYCLE 
461     READ x, y
462     fx(row, 3 - fairy) = x * xmul
463     fx(row, 4 + fairy) = (32 - x) * xmul
464     fy(row, 3 - fairy) = y * ymul
465     fy(row, 4 + fairy) = y * ymul
466     fairyColours(row, 3 - fairy) = White
467     fairyColours(row, 4 + fairy) = White
468   REPEAT 
469 REPEAT 
470 READ x, y
471 fairyX = x * xmul
472 fairyY = y * ymul
473 tree = TRUE
474 ENDPROC 
475 //
476 // treePlotter:
477 //    Pick the colour and plot the data for bits of our
478 //    tree. We cycle through the arrays one way then
479 //    the other to make up a polygon which the system
480 //    will then fill for us...
481 //
482 DEF PROC treePlotter(pass, num)
483 LOCAL i
484 //
485 SWITCH (pass)
486   CASE 1
487     COLOUR = Maroon
488   ENDCASE 
489   CASE 2
490     COLOUR = Green
491   ENDCASE 
492   CASE 3
493     rgbCOLOUR (255, 215, 0) // Gold (ish) star
494   ENDCASE 
495 ENDSWITCH 
496 //
497 PolyStart 
498 FOR i = 0 TO num - 1 CYCLE 
499   PolyPlot (xx(i) * xmul, yy(i) * ymul)
500 REPEAT 
501 FOR i = num - 2 TO 0 STEP -1 CYCLE 
502   PolyPlot ((32 - xx(i)) * xmul, yy(i) * ymul)
503 REPEAT 
504 PolyEnd 
505 ENDPROC 
506 //
507 //
508 // updateFairies
509 //    Display the lights in their colours
510 //
511 DEF PROC updateFairies
512 LOCAL row, col
513 IF  NOT tree THEN ENDPROC 
514 FOR row = 0 TO 3 CYCLE 
515   FOR col = 0 TO 7 CYCLE 
516     COLOUR = fairyColours(row, col)
517     CIRCLE (fx(row, col), fy(row, col), xmul / 4, 1)
518   REPEAT 
519 REPEAT 
520 //CIRCLE (fairyX, fairyY, xmul / 2, 1)
521 ENDPROC 
522 //
523 // Data for the tree, etc.
524 //    It was originally drawn on a squared paper grid of 32 by 24. This
525 //    scales into a 640x480 screen OK. If anyone wants to supply finer
526 //    data then please do so - just check the scaling factors used above.
527 //    also note that the data just represents the left-side of the tree,
528 //    as it's symetrical, we can deduce the other side...
529 //
530 // Tree Pot Data
531 //
532 DATA 14, 0, 14, 1, 13, 3, 16, 3
533 DATA -1, -1
534 //
535 // Tree Branches data
536 //
537 DATA 15, 3, 15, 6, 12, 6, 6, 5, 4, 4, 9, 9, 12, 10, 15, 10
538 DATA 15, 11, 14, 11, 7, 10, 8, 11, 14, 15, 15, 15
539 DATA 15, 16, 14, 16, 9, 14, 12, 17, 14, 19, 15, 19
540 DATA 15, 20, 14, 20, 10, 18, 13, 21, 16, 22
541 DATA -1, -1
542 //
543 // The 'Star'
544 //
545 DATA 16, 22, 14.5, 21, 15.5, 22, 14.5, 22, 15.5, 22.5, 16, 24
546 DATA -1, -1
547 //
548 // Fairy Light Data
549 //
550 DATA 14, 8, 11, 7, 7, 6, 4, 4
551 DATA 14, 13, 12, 12, 10, 11, 7, 10
552 DATA 15, 17.5, 13, 17, 12, 16, 9, 14
553 DATA 15, 21, 13, 20, 11.5, 19, 10, 18
554 DATA 16, 23