1 # A surface is a large 2-D grid that you can only see a subset of through the
  2 # screen.
  3 # Imagine a pin going through both surface and screen. As we update the
  4 # surface contents, the pinned point stays fixed, providing a sense of
  5 # stability.
  6 
  7 type surface {
  8   screen: (handle screen)
  9   data: (handle array screen-cell)
 10   nrows: int
 11   ncols: int
 12   screen-nrows: int
 13   screen-ncols: int
 14   pin-row: int  # 1-indexed
 15   pin-col: int  # 1-indexed
 16   pin-screen-row: int  # 1-indexed
 17   pin-screen-col: int  # 1-indexed
 18 }
 19 
 20 # intended mostly for tests; could be slow
 21 fn initialize-surface-with _self: (addr surface), in: (addr array byte) {
 22   var self/esi: (addr surface) <- copy _self
 23   # fill in nrows, ncols
 24   var nrows/ecx: int <- num-lines in
 25   var dest/eax: (addr int) <- get self, nrows
 26   copy-to *dest, nrows
 27   var ncols/edx: int <- first-line-length in  # assume all lines are the same length
 28   dest <- get self, ncols
 29   copy-to *dest, ncols
 30   # fill in data
 31   var len/ecx: int <- copy nrows
 32   len <- multiply ncols
 33   var out/edi: (addr surface) <- copy _self
 34   var data/eax: (addr handle array screen-cell) <- get out, data
 35   populate data, len
 36   var data-addr/eax: (addr array screen-cell) <- lookup *data
 37   fill-in data-addr, in
 38   # fill in screen-nrows, screen-ncols
 39   {
 40     var screen-ah/eax: (addr handle screen) <- get self, screen
 41     var _screen-addr/eax: (addr screen) <- lookup *screen-ah
 42     var screen-addr/edi: (addr screen) <- copy _screen-addr
 43     var nrows/eax: int <- copy 0
 44     var ncols/ecx: int <- copy 0
 45     nrows, ncols <- screen-size screen-addr
 46     var dest/edi: (addr int) <- get self, screen-nrows
 47     copy-to *dest, nrows
 48     dest <- get self, screen-ncols
 49     copy-to *dest, ncols
 50   }
 51 }
 52 
 53 fn pin-surface-at _self: (addr surface), r: int, c: int {
 54   var self/esi: (addr surface) <- copy _self
 55   var dest/ecx: (addr int) <- get self, pin-row
 56   var tmp/eax: int <- copy r
 57   copy-to *dest, tmp
 58   dest <- get self, pin-col
 59   tmp <- copy c
 60   copy-to *dest, tmp
 61 }
 62 
 63 fn pin-surface-to _self: (addr surface), sr: int, sc: int {
 64   var self/esi: (addr surface) <- copy _self
 65   var dest/ecx: (addr int) <- get self, pin-screen-row
 66   var tmp/eax: int <- copy sr
 67   copy-to *dest, tmp
 68   dest <- get self, pin-screen-col
 69   tmp <- copy sc
 70   copy-to *dest, tmp
 71 }
 72 
 73 fn render-surface _self: (addr surface) {
 74 #?   print-string-to-real-screen "render-surface\n"
 75   var self/esi: (addr surface) <- copy _self
 76   # clear screen
 77   var screen-ah/eax: (addr handle screen) <- get self, screen
 78   var screen/eax: (addr screen) <- lookup *screen-ah
 79   clear-screen screen
 80   #
 81   var nrows/edx: (addr int) <- get self, screen-nrows
 82   var ncols/ebx: (addr int) <- get self, screen-ncols
 83   var screen-row/ecx: int <- copy 1
 84   {
 85     compare screen-row, *nrows
 86     break-if->
 87     var screen-col/eax: int <- copy 1
 88     {
 89       compare screen-col, *ncols
 90       break-if->
 91 #?       print-string-to-real-screen "X"
 92       print-surface-cell-at self, screen-row, screen-col
 93       screen-col <- increment
 94       loop
 95     }
 96 #?     print-string-to-real-screen "\n"
 97     screen-row <- increment
 98     loop
 99   }
100 }
101 
102 fn print-surface-cell-at _self: (addr surface), screen-row: int, screen-col: int {
103 $print-surface-cell-at:body: {
104   var self/esi: (addr surface) <- copy _self
105   var row/ecx: int <- screen-row-to-surface self, screen-row
106   var col/edx: int <- screen-col-to-surface self, screen-col
107   var data-ah/edi: (addr handle array screen-cell) <- get self, data
108   var _data-addr/eax: (addr array screen-cell) <- lookup *data-ah
109   var data-addr/edi: (addr array screen-cell) <- copy _data-addr
110   var idx/eax: int <- surface-screen-cell-index self, row, col
111   # if out of bounds, print ' '
112   compare idx, 0
113   {
114     break-if->=
115     var space/ecx: grapheme <- copy 0x20
116     var screen-ah/edi: (addr handle screen) <- get self, screen
117     var screen/eax: (addr screen) <- lookup *screen-ah
118     print-grapheme screen, space
119     break $print-surface-cell-at:body
120   }
121   # otherwise print the appropriate screen-cell
122   var offset/ecx: (offset screen-cell) <- compute-offset data-addr, idx
123   var src/ecx: (addr screen-cell) <- index data-addr, offset
124   var screen-ah/edi: (addr handle screen) <- get self, screen
125   var screen/eax: (addr screen) <- lookup *screen-ah
126   print-screen-cell screen, src
127 }
128 }
129 
130 # print a cell with all its formatting at the cursor location
131 fn print-screen-cell screen: (addr screen), _cell: (addr screen-cell) {
132   var cell/esi: (addr screen-cell) <- copy _cell
133   reset-formatting screen
134   var fg/eax: (addr int) <- get cell, color
135   var bg/ecx: (addr int) <- get cell, background-color
136   start-color screen, *fg, *bg
137   var tmp/eax: (addr boolean) <- get cell, bold?
138   {
139     compare *tmp, 0
140     break-if-=
141     start-bold screen
142   }
143   {
144     tmp <- get cell, underline?
145     compare *tmp, 0
146     break-if-=
147     start-underline screen
148   }
149   {
150     tmp <- get cell, reverse?
151     compare *tmp, 0
152     break-if-=
153     start-reverse-video screen
154   }
155   {
156     tmp <- get cell, blink?
157     compare *tmp, 0
158     break-if-=
159     start-blinking screen
160   }
161   var g/eax: (addr grapheme) <- get cell, data
162   print-grapheme screen, *g
163 #?   var g2/eax: grapheme <- copy *g
164 #?   var g3/eax: int <- copy g2
165 #?   print-int32-hex-to-real-screen g3
166 #?   print-string-to-real-screen "\n"
167 }
168 
169 fn surface-screen-cell-index _self: (addr surface), row: int, col: int -> result/eax: int {
170   var self/esi: (addr surface) <- copy _self
171 #?   print-int32-hex-to-real-screen row
172 #?   print-string-to-real-screen ", "
173 #?   print-int32-hex-to-real-screen col
174 #?   print-string-to-real-screen "\n"
175   result <- copy -1
176   compare row, 1
177   break-if-<
178   compare col, 1
179   break-if-<
180   var nrows-addr/ecx: (addr int) <- get self, nrows
181   var nrows/ecx: int <- copy *nrows-addr
182   compare row, nrows
183   break-if->
184   var ncols-addr/ecx: (addr int) <- get self, ncols
185   var ncols/ecx: int <- copy *ncols-addr
186   compare col, ncols
187   break-if->
188 #?   print-string-to-real-screen "!\n"
189   result <- copy row
190   result <- subtract 1
191   result <- multiply ncols
192   result <- add col
193   result <- subtract 1
194 }
195 
196 fn screen-row-to-surface _self: (addr surface), screen-row: int -> result/ecx: int {
197   var self/esi: (addr surface) <- copy _self
198   result <- copy screen-row
199   var tmp/eax: (addr int) <- get self, pin-row
200   result <- add *tmp
201   tmp <- get self, pin-screen-row
202   result <- subtract *tmp
203 }
204 
205 fn max a: int, b: int -> result/eax: int {
206 $max:body: {
207   var a2/eax: int <- copy a
208   compare a2, b
209   {
210     break-if->
211     result <- copy b
212     break $max:body
213   }
214   {
215     break-if-<=
216     result <- copy a2
217   }
218 }
219 }
220 
221 fn min a: int, b: int -> result/eax: int {
222 $min:body: {
223   var a2/eax: int <- copy a
224   compare a2, b
225   {
226     break-if->
227     result <- copy a2
228     break $min:body
229   }
230   {
231     break-if-<=
232     result <- copy b
233   }
234 }
235 }
236 
237 fn screen-col-to-surface _self: (addr surface), screen-col: int -> result/edx: int {
238   var self/esi: (addr surface) <- copy _self
239   result <- copy screen-col
240   var tmp/eax: (addr int) <- get self, pin-col
241   result <- add *tmp
242   tmp <- get self, pin-screen-col
243   result <- subtract *tmp
244 }
245 
246 fn surface-row-to-screen _self: (addr surface), row: int -> result/ecx: int {
247   var self/esi: (addr surface) <- copy _self
248   result <- copy row
249   var tmp/eax: (addr int) <- get self, pin-screen-row
250   result <- add *tmp
251   tmp <- get self, pin-row
252   result <- subtract *tmp
253 }
254 
255 fn surface-col-to-screen _self: (addr surface), col: int -> result/edx: int {
256   var self/esi: (addr surface) <- copy _self
257   result <- copy col
258   var tmp/eax: (addr int) <- get self, pin-screen-col
259   result <- add *tmp
260   tmp <- get self, pin-col
261   result <- subtract *tmp
262 }
263 
264 # assumes last line doesn't end in '\n'
265 fn num-lines in: (addr array byte) -> result/ecx: int {
266   var s: (stream byte 0x100)
267   var s-addr/esi: (addr stream byte) <- address s
268   write s-addr, in
269   result <- copy 1
270   {
271     var done?/eax: boolean <- stream-empty? s-addr
272     compare done?, 0  # false
273     break-if-!=
274     var g/eax: grapheme <- read-grapheme s-addr
275     compare g, 0xa  # newline
276     loop-if-!=
277     result <- increment
278     loop
279   }
280 }
281 
282 fn first-line-length in: (addr array byte) -> result/edx: int {
283   var s: (stream byte 0x100)
284   var s-addr/esi: (addr stream byte) <- address s
285   write s-addr, in
286   result <- copy 0
287   {
288     var done?/eax: boolean <- stream-empty? s-addr
289     compare done?, 0  # false
290     break-if-!=
291     var g/eax: grapheme <- read-grapheme s-addr
292     compare g, 0xa  # newline
293     break-if-=
294     result <- increment
295     loop
296   }
297 }
298 
299 fn fill-in _out: (addr array screen-cell), in: (addr array byte) {
300   var s: (stream byte 0x100)
301   var out/edi: (addr array screen-cell) <- copy _out
302   var s-addr/esi: (addr stream byte) <- address s
303   write s-addr, in
304   var idx/ecx: int <- copy 0
305   {
306     var done?/eax: boolean <- stream-empty? s-addr
307     compare done?, 0  # false
308     break-if-!=
309     var g/eax: grapheme <- read-grapheme s-addr
310     compare g, 0xa  # newline
311     loop-if-=
312     var offset/edx: (offset screen-cell) <- compute-offset out, idx
313     var dest/edx: (addr screen-cell) <- index out, offset
314     var dest2/edx: (addr grapheme) <- get dest, data
315     copy-to *dest2, g
316     idx <- increment
317     loop
318   }
319 }
320 
321 # pin (1, 1) to (1, 1) on screen
322 fn test-surface-pin-at-origin {
323   var s: surface
324   var s-addr/esi: (addr surface) <- address s
325   # surface contents are a fixed grid with 8 rows and 6 columns
326   # (strip vowels second time around to break vertical alignment of letters)
327   initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz"
328   pin-surface-at s-addr, 1, 1  # surface row and column
329   pin-surface-to s-addr, 1, 1  # screen row and column
330   render-surface s-addr
331   var screen-ah/eax: (addr handle screen) <- get s-addr, screen
332   var screen-addr/eax: (addr screen) <- lookup *screen-ah
333   check-screen-row screen-addr, 1, "abcd", "F - test-surface-pin-at-origin"
334   check-screen-row screen-addr, 2, "ghij", "F - test-surface-pin-at-origin"
335   check-screen-row screen-addr, 3, "mnop", "F - test-surface-pin-at-origin"
336 }
337 
338 # pin (1, 1) to (2, 1) on screen; screen goes past edge of the universe
339 fn test-surface-pin-2 {
340   var s: surface
341   var s-addr/esi: (addr surface) <- address s
342   # surface contents are a fixed grid with 8 rows and 6 columns
343   # (strip vowels second time around to break vertical alignment of letters)
344   initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz"
345   pin-surface-at s-addr, 1, 1  # surface row and column
346   pin-surface-to s-addr, 2, 1  # screen row and column
347   render-surface s-addr
348   var screen-ah/eax: (addr handle screen) <- get s-addr, screen
349   var screen-addr/eax: (addr screen) <- lookup *screen-ah
350   # surface edge reached (should seldom happen in the app)
351   check-screen-row screen-addr, 1, "    ", "F - test-surface-pin-2"
352   check-screen-row screen-addr, 2, "abcd", "F - test-surface-pin-2"
353   check-screen-row screen-addr, 3, "ghij", "F - test-surface-pin-2"
354 }
355 
356 # pin (2, 1) to (1, 1) on screen
357 fn test-surface-pin-3 {
358   var s: surface
359   var s-addr/esi: (addr surface) <- address s
360   # surface contents are a fixed grid with 8 rows and 6 columns
361   # (strip vowels second time around to break vertical alignment of letters)
362   initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz"
363   pin-surface-at s-addr, 2, 1  # surface row and column
364   pin-surface-to s-addr, 1, 1  # screen row and column
365   render-surface s-addr
366   var screen-ah/eax: (addr handle screen) <- get s-addr, screen
367   var screen-addr/eax: (addr screen) <- lookup *screen-ah
368   check-screen-row screen-addr, 1, "ghij", "F - test-surface-pin-3"
369   check-screen-row screen-addr, 2, "mnop", "F - test-surface-pin-3"
370   check-screen-row screen-addr, 3, "stuv", "F - test-surface-pin-3"
371 }
372 
373 # pin (1, 1) to (1, 2) on screen; screen goes past edge of the universe
374 fn test-surface-pin-4 {
375   var s: surface
376   var s-addr/esi: (addr surface) <- address s
377   # surface contents are a fixed grid with 8 rows and 6 columns
378   # (strip vowels second time around to break vertical alignment of letters)
379   initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz"
380   pin-surface-at s-addr, 1, 1  # surface row and column
381   pin-surface-to s-addr, 1, 2  # screen row and column
382   render-surface s-addr
383   var screen-ah/eax: (addr handle screen) <- get s-addr, screen
384   var screen-addr/eax: (addr screen) <- lookup *screen-ah
385   # surface edge reached (should seldom happen in the app)
386   check-screen-row screen-addr, 1, " abc", "F - test-surface-pin-4"
387   check-screen-row screen-addr, 2, " ghi", "F - test-surface-pin-4"
388   check-screen-row screen-addr, 3, " mno", "F - test-surface-pin-4"
389 }
390 
391 # pin (1, 2) to (1, 1) on screen
392 fn test-surface-pin-5 {
393   var s: surface
394   var s-addr/esi: (addr surface) <- address s
395   # surface contents are a fixed grid with 8 rows and 6 columns
396   # (strip vowels second time around to break vertical alignment of letters)
397   initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz"
398   pin-surface-at s-addr, 1, 2  # surface row and column
399   pin-surface-to s-addr, 1, 1  # screen row and column
400   render-surface s-addr
401   var screen-ah/eax: (addr handle screen) <- get s-addr, screen
402   var screen-addr/eax: (addr screen) <- lookup *screen-ah
403   check-screen-row screen-addr, 1, "bcde", "F - test-surface-pin-5"
404   check-screen-row screen-addr, 2, "hijk", "F - test-surface-pin-5"
405   check-screen-row screen-addr, 3, "nopq", "F - test-surface-pin-5"
406 }
407 
408 fn initialize-surface-with-fake-screen _self: (addr surface), nrows: int, ncols: int, in: (addr array byte) {
409   var self/esi: (addr surface) <- copy _self
410   # fill in screen
411   var screen-ah/eax: (addr handle screen) <- get self, screen
412   allocate screen-ah
413   var screen-addr/eax: (addr screen) <- lookup *screen-ah
414   initialize-screen screen-addr, nrows, ncols
415   # fill in everything else
416   initialize-surface-with self, in
417 }