1 type environment {
  2   globals: global-table
  3   sandbox: sandbox
  4   partial-function-name: (handle gap-buffer)
  5   cursor-in-globals?: boolean
  6   cursor-in-function-modal?: boolean
  7 }
  8 
  9 fn initialize-environment _self: (addr environment) {
 10   var self/esi: (addr environment) <- copy _self
 11   var globals/eax: (addr global-table) <- get self, globals
 12   initialize-globals globals
 13   var sandbox/eax: (addr sandbox) <- get self, sandbox
 14   initialize-sandbox sandbox, 1/with-screen
 15   var partial-function-name-ah/eax: (addr handle gap-buffer) <- get self, partial-function-name
 16   allocate partial-function-name-ah
 17   var partial-function-name/eax: (addr gap-buffer) <- lookup *partial-function-name-ah
 18   initialize-gap-buffer partial-function-name, 0x40/function-name-capacity
 19 }
 20 
 21 fn render-environment screen: (addr screen), _self: (addr environment) {
 22   # globals layout: 1 char padding, 41 code, 1 padding, 41 code, 1 padding =  85
 23   # sandbox layout: 1 padding, 41 code, 1 padding                          =  43
 24   #                                                                  total = 128 chars
 25   var self/esi: (addr environment) <- copy _self
 26   var cursor-in-globals-a/eax: (addr boolean) <- get self, cursor-in-globals?
 27   var cursor-in-globals?/eax: boolean <- copy *cursor-in-globals-a
 28   var globals/ecx: (addr global-table) <- get self, globals
 29   render-globals screen, globals, cursor-in-globals?
 30   var sandbox/edx: (addr sandbox) <- get self, sandbox
 31   var cursor-in-sandbox?/ebx: boolean <- copy 1/true
 32   cursor-in-sandbox? <- subtract cursor-in-globals?
 33   render-sandbox screen, sandbox, 0x55/sandbox-left-margin, 0/sandbox-top-margin, 0x80/screen-width, 0x2f/screen-height-without-menu, cursor-in-sandbox?
 34   # modal if necessary
 35   {
 36     var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
 37     compare *cursor-in-function-modal-a, 0/false
 38     break-if-=
 39     render-function-modal screen, self
 40     render-function-modal-menu screen, self
 41     return
 42   }
 43   # render menu
 44   {
 45     var cursor-in-globals?/eax: (addr boolean) <- get self, cursor-in-globals?
 46     compare *cursor-in-globals?, 0/false
 47     break-if-=
 48     render-globals-menu screen, globals
 49     return
 50   }
 51   render-sandbox-menu screen, sandbox
 52 }
 53 
 54 fn edit-environment _self: (addr environment), key: grapheme, data-disk: (addr disk) {
 55   var self/esi: (addr environment) <- copy _self
 56   var globals/edi: (addr global-table) <- get self, globals
 57   var sandbox/ecx: (addr sandbox) <- get self, sandbox
 58   # ctrl-r
 59   # Assumption: 'real-screen' and 'real-keyboard' are 0
 60   {
 61     compare key, 0x12/ctrl-r
 62     break-if-!=
 63     var tmp/eax: (addr handle cell) <- copy 0
 64     var nil: (handle cell)
 65     tmp <- address nil
 66     allocate-pair tmp
 67     # (main real-screen real-keyboard)
 68     var real-keyboard: (handle cell)
 69     tmp <- address real-keyboard
 70     allocate-keyboard tmp
 71     # args = cons(real-keyboard, nil)
 72     var args: (handle cell)
 73     tmp <- address args
 74     new-pair tmp, real-keyboard, nil
 75     #
 76     var real-screen: (handle cell)
 77     tmp <- address real-screen
 78     allocate-screen tmp
 79     #  args = cons(real-screen, args)
 80     tmp <- address args
 81     new-pair tmp, real-screen, *tmp
 82     #
 83     var main: (handle cell)
 84     tmp <- address main
 85     new-symbol tmp, "main"
 86     # args = cons(main, args)
 87     tmp <- address args
 88     new-pair tmp, main, *tmp
 89     # clear real screen
 90     clear-screen 0/screen
 91     set-cursor-position 0/screen, 0, 0
 92     # run
 93     var out: (handle cell)
 94     var out-ah/ecx: (addr handle cell) <- address out
 95     var trace-storage: trace
 96     var trace/ebx: (addr trace) <- address trace-storage
 97     initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 98     evaluate tmp, out-ah, nil, globals, trace, 0/no-fake-screen, 0/no-fake-keyboard, 0/call-number
 99     # wait for a keypress
100     {
101       var tmp/eax: byte <- read-key 0/keyboard
102       compare tmp, 0
103       loop-if-=
104     }
105     #
106     return
107   }
108   # ctrl-s: send multiple places
109   {
110     compare key, 0x13/ctrl-s
111     break-if-!=
112     {
113       # cursor in function modal? do nothing
114       var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
115       compare *cursor-in-function-modal-a, 0/false
116       break-if-!=
117       {
118         # cursor in globals? update current definition
119         var cursor-in-globals-a/edx: (addr boolean) <- get self, cursor-in-globals?
120         compare *cursor-in-globals-a, 0/false
121         break-if-=
122         edit-globals globals, key
123       }
124       # update sandbox whether the cursor is in globals or sandbox
125       edit-sandbox sandbox, key, globals, data-disk, 1/tweak-real-screen
126     }
127     return
128   }
129   # ctrl-g: go to a function (or the repl)
130   {
131     compare key, 7/ctrl-g
132     break-if-!=
133     var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
134     compare *cursor-in-function-modal-a, 0/false
135     break-if-!=
136     # look for a word to prepopulate the modal
137     var current-word-storage: (stream byte 0x40)
138     var current-word/edi: (addr stream byte) <- address current-word-storage
139     word-at-cursor self, current-word
140     var partial-function-name-ah/eax: (addr handle gap-buffer) <- get self, partial-function-name
141     var partial-function-name/eax: (addr gap-buffer) <- lookup *partial-function-name-ah
142     clear-gap-buffer partial-function-name
143     load-gap-buffer-from-stream partial-function-name, current-word
144     # enable the modal
145     var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
146     copy-to *cursor-in-function-modal-a, 1/true
147     return
148   }
149   # dispatch to function modal if necessary
150   {
151     var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
152     compare *cursor-in-function-modal-a, 0/false
153     break-if-=
154     # nested events for modal dialog
155     # ignore spaces
156     {
157       compare key, 0x20/space
158       break-if-!=
159       return
160     }
161     # esc = exit modal dialog
162     {
163       compare key, 0x1b/escape
164       break-if-!=
165       var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
166       copy-to *cursor-in-function-modal-a, 0/false
167       return
168     }
169     # enter = switch to function name and exit modal dialog
170     {
171       compare key, 0xa/newline
172       break-if-!=
173       var cursor-in-globals-a/edx: (addr boolean) <- get self, cursor-in-globals?
174       copy-to *cursor-in-globals-a, 1/true
175       var partial-function-name-ah/eax: (addr handle gap-buffer) <- get self, partial-function-name
176       var partial-function-name/eax: (addr gap-buffer) <- lookup *partial-function-name-ah
177       {
178         {
179           var empty?/eax: boolean <- gap-buffer-empty? partial-function-name
180           compare empty?, 0/false
181         }
182         break-if-!=
183         set-global-cursor-index globals, partial-function-name
184       }
185       var cursor-in-globals-a/ecx: (addr boolean) <- get self, cursor-in-globals?
186       copy-to *cursor-in-globals-a, 1/true
187       {
188         var empty?/eax: boolean <- gap-buffer-empty? partial-function-name
189         compare empty?, 0/false
190         break-if-=
191         copy-to *cursor-in-globals-a, 0/false
192       }
193       clear-gap-buffer partial-function-name
194       var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
195       copy-to *cursor-in-function-modal-a, 0/false
196       return
197     }
198     # otherwise process like a regular gap-buffer
199     var partial-function-name-ah/eax: (addr handle gap-buffer) <- get self, partial-function-name
200     var partial-function-name/eax: (addr gap-buffer) <- lookup *partial-function-name-ah
201     edit-gap-buffer partial-function-name, key
202     return
203   }
204   # dispatch the key to either sandbox or globals
205   {
206     var cursor-in-globals-a/eax: (addr boolean) <- get self, cursor-in-globals?
207     compare *cursor-in-globals-a, 0/false
208     break-if-=
209     edit-globals globals, key
210     return
211   }
212   edit-sandbox sandbox, key, globals, data-disk, 1/tweak-real-screen
213 }
214 
215 fn word-at-cursor _self: (addr environment), out: (addr stream byte) {
216   var self/esi: (addr environment) <- copy _self
217   var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
218   compare *cursor-in-function-modal-a, 0/false
219   {
220     break-if-=
221     # cursor in function modal
222     return
223   }
224   var cursor-in-globals-a/edx: (addr boolean) <- get self, cursor-in-globals?
225   compare *cursor-in-globals-a, 0/false
226   {
227     break-if-=
228     # cursor in some function editor
229     var globals/eax: (addr global-table) <- get self, globals
230     var cursor-index-addr/ecx: (addr int) <- get globals, cursor-index
231     var cursor-index/ecx: int <- copy *cursor-index-addr
232     var globals-data-ah/eax: (addr handle array global) <- get globals, data
233     var globals-data/eax: (addr array global) <- lookup *globals-data-ah
234     var cursor-offset/ecx: (offset global) <- compute-offset globals-data, cursor-index
235     var curr-global/eax: (addr global) <- index globals-data, cursor-offset
236     var curr-global-data-ah/eax: (addr handle gap-buffer) <- get curr-global, input
237     var curr-global-data/eax: (addr gap-buffer) <- lookup *curr-global-data-ah
238     word-at-gap curr-global-data, out
239     return
240   }
241   # cursor in sandbox
242   var sandbox/ecx: (addr sandbox) <- get self, sandbox
243   var sandbox-data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
244   var sandbox-data/eax: (addr gap-buffer) <- lookup *sandbox-data-ah
245   word-at-gap sandbox-data, out
246 }
247 
248 fn render-function-modal screen: (addr screen), _self: (addr environment) {
249   var self/esi: (addr environment) <- copy _self
250   var width/eax: int <- copy 0
251   var height/ecx: int <- copy 0
252   width, height <- screen-size screen
253   # xmin = max(0, width/2 - 0x20)
254   var xmin: int
255   var tmp/edx: int <- copy width
256   tmp <- shift-right 1
257   tmp <- subtract 0x20/half-function-name-capacity
258   {
259     compare tmp, 0
260     break-if->=
261     tmp <- copy 0
262   }
263   copy-to xmin, tmp
264   # xmax = min(width, width/2 + 0x20)
265   var xmax: int
266   tmp <- copy width
267   tmp <- shift-right 1
268   tmp <- add 0x20/half-function-name-capacity
269   {
270     compare tmp, width
271     break-if-<=
272     tmp <- copy width
273   }
274   copy-to xmax, tmp
275   # ymin = height/2 - 2
276   var ymin: int
277   tmp <- copy height
278   tmp <- shift-right 1
279   tmp <- subtract 2
280   copy-to ymin, tmp
281   # ymax = height/2 + 1
282   var ymax: int
283   tmp <- add 3
284   copy-to ymax, tmp
285   #
286   clear-rect screen, xmin, ymin, xmax, ymax, 0xf/bg=modal
287   add-to xmin, 4
288   set-cursor-position screen, xmin, ymin
289   draw-text-rightward-from-cursor screen, "go to function (or leave blank to go to REPL)", xmax, 8/fg=dark-grey, 0xf/bg=modal
290   var partial-function-name-ah/eax: (addr handle gap-buffer) <- get self, partial-function-name
291   var _partial-function-name/eax: (addr gap-buffer) <- lookup *partial-function-name-ah
292   var partial-function-name/edx: (addr gap-buffer) <- copy _partial-function-name
293   subtract-from xmin, 4
294   add-to ymin 2
295   var dummy/eax: int <- copy 0
296   var dummy2/ecx: int <- copy 0
297   dummy, dummy2 <- render-gap-buffer-wrapping-right-then-down screen, partial-function-name, xmin, ymin, xmax, ymax, 1/always-render-cursor, 0/fg=black, 0xf/bg=modal
298 }
299 
300 fn render-function-modal-menu screen: (addr screen), _self: (addr environment) {
301   var self/esi: (addr environment) <- copy _self
302   var _width/eax: int <- copy 0
303   var height/ecx: int <- copy 0
304   _width, height <- screen-size screen
305   var width/edx: int <- copy _width
306   var y/ecx: int <- copy height
307   y <- decrement
308   var height/ebx: int <- copy y
309   height <- increment
310   clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg
311   set-cursor-position screen, 0/x, y
312   draw-text-rightward-from-cursor screen, " ^r ", width, 0/fg, 0x5c/bg=menu-highlight
313   draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0xc5/bg=blue-bg
314   draw-text-rightward-from-cursor screen, " enter ", width, 0/fg, 0x5c/bg=menu-highlight
315   draw-text-rightward-from-cursor screen, " submit  ", width, 7/fg, 0xc5/bg=blue-bg
316   draw-text-rightward-from-cursor screen, " esc ", width, 0/fg, 0x5c/bg=menu-highlight
317   draw-text-rightward-from-cursor screen, " cancel  ", width, 7/fg, 0xc5/bg=blue-bg
318   draw-text-rightward-from-cursor screen, " ^a ", width, 0/fg, 0x5c/bg=menu-highlight
319   draw-text-rightward-from-cursor screen, " <<  ", width, 7/fg, 0xc5/bg=blue-bg
320   draw-text-rightward-from-cursor screen, " ^b ", width, 0/fg, 0x5c/bg=menu-highlight
321   draw-text-rightward-from-cursor screen, " <word  ", width, 7/fg, 0xc5/bg=blue-bg
322   draw-text-rightward-from-cursor screen, " ^f ", width, 0/fg, 0x5c/bg=menu-highlight
323   draw-text-rightward-from-cursor screen, " word>  ", width, 7/fg, 0xc5/bg=blue-bg
324   draw-text-rightward-from-cursor screen, " ^e ", width, 0/fg, 0x5c/bg=menu-highlight
325   draw-text-rightward-from-cursor screen, " >>  ", width, 7/fg, 0xc5/bg=blue-bg
326 }
327 
328 # Gotcha: some saved state may not load.
329 fn load-state _self: (addr environment), data-disk: (addr disk) {
330   var self/esi: (addr environment) <- copy _self
331   # data-disk -> stream
332   var s-storage: (stream byte 0x1000)  # space for 8/sectors
333   var s/ebx: (addr stream byte) <- address s-storage
334   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sectors from data disk", 3/fg, 0/bg
335   move-cursor-to-left-margin-of-next-line 0/screen
336   load-sectors data-disk, 0/lba, 8/sectors, s
337 #?   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, s, 7/fg, 0xc5/bg=blue-bg
338   # stream -> gap-buffer (HACK: we temporarily cannibalize the sandbox's gap-buffer)
339   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "parsing", 3/fg, 0/bg
340   move-cursor-to-left-margin-of-next-line 0/screen
341   var sandbox/eax: (addr sandbox) <- get self, sandbox
342   var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
343   var data/eax: (addr gap-buffer) <- lookup *data-ah
344   load-gap-buffer-from-stream data, s
345   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "  into gap buffer", 3/fg, 0/bg
346   move-cursor-to-left-margin-of-next-line 0/screen
347   clear-stream s
348   # read: gap-buffer -> cell
349   var initial-root-storage: (handle cell)
350   var initial-root/ecx: (addr handle cell) <- address initial-root-storage
351   var trace-storage: trace
352   var trace/edi: (addr trace) <- address trace-storage
353   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
354   read-cell data, initial-root, trace
355   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "  into s-expressions", 3/fg, 0/bg
356   move-cursor-to-left-margin-of-next-line 0/screen
357   clear-gap-buffer data
358   #
359   {
360     var initial-root-addr/eax: (addr cell) <- lookup *initial-root
361     compare initial-root-addr, 0
362     break-if-!=
363     return
364   }
365   # load globals from assoc(initial-root, 'globals)
366   var globals-literal-storage: (handle cell)
367   var globals-literal-ah/eax: (addr handle cell) <- address globals-literal-storage
368   new-symbol globals-literal-ah, "globals"
369   var globals-literal/eax: (addr cell) <- lookup *globals-literal-ah
370   var globals-cell-storage: (handle cell)
371   var globals-cell-ah/edx: (addr handle cell) <- address globals-cell-storage
372   clear-trace trace
373   lookup-symbol globals-literal, globals-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard
374   var globals-cell/eax: (addr cell) <- lookup *globals-cell-ah
375   {
376     compare globals-cell, 0
377     break-if-=
378     var globals/eax: (addr global-table) <- get self, globals
379     load-globals globals-cell-ah, globals
380   }
381   # sandbox = assoc(initial-root, 'sandbox)
382   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sandbox", 3/fg, 0/bg
383   var sandbox-literal-storage: (handle cell)
384   var sandbox-literal-ah/eax: (addr handle cell) <- address sandbox-literal-storage
385   new-symbol sandbox-literal-ah, "sandbox"
386   var sandbox-literal/eax: (addr cell) <- lookup *sandbox-literal-ah
387   var sandbox-cell-storage: (handle cell)
388   var sandbox-cell-ah/edx: (addr handle cell) <- address sandbox-cell-storage
389   clear-trace trace
390   lookup-symbol sandbox-literal, sandbox-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard
391   var sandbox-cell/eax: (addr cell) <- lookup *sandbox-cell-ah
392   {
393     compare sandbox-cell, 0
394     break-if-=
395     # print: cell -> stream
396     clear-trace trace
397     print-cell sandbox-cell-ah, s, trace
398     # stream -> gap-buffer
399     var sandbox/eax: (addr sandbox) <- get self, sandbox
400     var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
401     var data/eax: (addr gap-buffer) <- lookup *data-ah
402     load-gap-buffer-from-stream data, s
403   }
404 }
405 
406 # Save state as an alist of alists:
407 #   ((globals . ((a . (fn ...))
408 #                ...))
409 #    (sandbox . ...))
410 fn store-state data-disk: (addr disk), sandbox: (addr sandbox), globals: (addr global-table) {
411   compare data-disk, 0/no-disk
412   {
413     break-if-!=
414     return
415   }
416   var stream-storage: (stream byte 0x1000)  # space enough for 8/sectors
417   var stream/edi: (addr stream byte) <- address stream-storage
418   write stream, "(\n"
419   write-globals stream, globals
420   write-sandbox stream, sandbox
421   write stream, ")\n"
422   store-sectors data-disk, 0/lba, 8/sectors, stream
423 }