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   var self/esi: (addr surface) <- copy _self
104   var row/ecx: int <- screen-row-to-surface self, screen-row
105   var col/edx: int <- screen-col-to-surface self, screen-col
106   var data-ah/edi: (addr handle array screen-cell) <- get self, data
107   var _data-addr/eax: (addr array screen-cell) <- lookup *data-ah
108   var data-addr/edi: (addr array screen-cell) <- copy _data-addr
109   var idx/eax: int <- surface-screen-cell-index self, row, col
110   # if out of bounds, print ' '
111   compare idx, 0
112   {
113     break-if->=
114     var space/ecx: code-point-utf8 <- copy 0x20
115     var screen-ah/edi: (addr handle screen) <- get self, screen
116     var screen/eax: (addr screen) <- lookup *screen-ah
117     print-code-point-utf8 screen, space
118     return
119   }
120   # otherwise print the appropriate screen-cell
121   var offset/ecx: (offset screen-cell) <- compute-offset data-addr, idx
122   var src/ecx: (addr screen-cell) <- index data-addr, offset
123   var screen-ah/edi: (addr handle screen) <- get self, screen
124   var screen/eax: (addr screen) <- lookup *screen-ah
125   print-screen-cell screen, src
126 }
127 
128 # print a cell with all its formatting at the cursor location
129 fn print-screen-cell screen: (addr screen), _cell: (addr screen-cell) {
130   var cell/esi: (addr screen-cell) <- copy _cell
131   reset-formatting screen
132   var fg/eax: (addr int) <- get cell, color
133   var bg/ecx: (addr int) <- get cell, background-color
134   start-color screen, *fg, *bg
135   var tmp/eax: (addr boolean) <- get cell, bold?
136   {
137     compare *tmp, 0
138     break-if-=
139     start-bold screen
140   }
141   {
142     tmp <- get cell, underline?
143     compare *tmp, 0
144     break-if-=
145     start-underline screen
146   }
147   {
148     tmp <- get cell, reverse?
149     compare *tmp, 0
150     break-if-=
151     start-reverse-video screen
152   }
153   {
154     tmp <- get cell, blink?
155     compare *tmp, 0
156     break-if-=
157     start-blinking screen
158   }
159   var g/eax: (addr code-point-utf8) <- get cell, data
160   print-code-point-utf8 screen, *g
161 #?   var g2/eax: code-point-utf8 <- copy *g
162 #?   var g3/eax: int <- copy g2
163 #?   print-int32-hex-to-real-screen g3
164 #?   print-string-to-real-screen "\n"
165 }
166 
167 fn surface-screen-cell-index _self: (addr surface), row: int, col: int -> _/eax: int {
168   var self/esi: (addr surface) <- copy _self
169 #?   print-int32-hex-to-real-screen row
170 #?   print-string-to-real-screen ", "
171 #?   print-int32-hex-to-real-screen col
172 #?   print-string-to-real-screen "\n"
173   var result/eax: int <- copy -1
174   {
175     compare row, 1
176     break-if-<
177     compare col, 1
178     break-if-<
179     var nrows-addr/ecx: (addr int) <- get self, nrows
180     var nrows/ecx: int <- copy *nrows-addr
181     compare row, nrows
182     break-if->
183     var ncols-addr/ecx: (addr int) <- get self, ncols
184     var ncols/ecx: int <- copy *ncols-addr
185     compare col, ncols
186     break-if->
187   #?   print-string-to-real-screen "!\n"
188     result <- copy row
189     result <- subtract 1
190     result <- multiply ncols
191     result <- add col
192     result <- subtract 1
193   }
194   return result
195 }
196 
197 fn screen-row-to-surface _self: (addr surface), screen-row: int -> _/ecx: int {
198   var self/esi: (addr surface) <- copy _self
199   var result/ecx: int <- copy screen-row
200   var tmp/eax: (addr int) <- get self, pin-row
201   result <- add *tmp
202   tmp <- get self, pin-screen-row
203   result <- subtract *tmp
204   return result
205 }
206 
207 fn max _a: int, b: int -> _/eax: int {
208   var a/eax: int <- copy _a
209   compare a, b
210   {
211     break-if->
212     return b
213   }
214   return a
215 }
216 
217 fn min _a: int, b: int -> _/eax: int {
218   var a/eax: int <- copy _a
219   compare a, b
220   {
221     break-if->
222     return a
223   }
224   return b
225 }
226 
227 fn screen-col-to-surface _self: (addr surface), screen-col: int -> _/edx: int {
228   var self/esi: (addr surface) <- copy _self
229   var result/edx: int <- copy screen-col
230   var tmp/eax: (addr int) <- get self, pin-col
231   result <- add *tmp
232   tmp <- get self, pin-screen-col
233   result <- subtract *tmp
234   return result
235 }
236 
237 fn surface-row-to-screen _self: (addr surface), row: int -> _/ecx: int {
238   var self/esi: (addr surface) <- copy _self
239   var result/ecx: int <- copy row
240   var tmp/eax: (addr int) <- get self, pin-screen-row
241   result <- add *tmp
242   tmp <- get self, pin-row
243   result <- subtract *tmp
244   return result
245 }
246 
247 fn surface-col-to-screen _self: (addr surface), col: int -> _/edx: int {
248   var self/esi: (addr surface) <- copy _self
249   var result/edx: int <- copy col
250   var tmp/eax: (addr int) <- get self, pin-screen-col
251   result <- add *tmp
252   tmp <- get self, pin-col
253   result <- subtract *tmp
254   return result
255 }
256 
257 # assumes last line doesn't end in '\n'
258 fn num-lines in: (addr array byte) -> _/ecx: int {
259   var s: (stream byte 0x100)
260   var s-addr/esi: (addr stream byte) <- address s
261   write s-addr, in
262   var result/ecx: int <- copy 1
263   {
264     var done?/eax: boolean <- stream-empty? s-addr
265     compare done?, 0/false
266     break-if-!=
267     var g/eax: code-point-utf8 <- read-code-point-utf8 s-addr
268     compare g, 0xa/newline
269     loop-if-!=
270     result <- increment
271     loop
272   }
273   return result
274 }
275 
276 fn first-line-length in: (addr array byte) -> _/edx: int {
277   var s: (stream byte 0x100)
278   var s-addr/esi: (addr stream byte) <- address s
279   write s-addr, in
280   var result/edx: int <- copy 0
281   {
282     var done?/eax: boolean <- stream-empty? s-addr
283     compare done?, 0/false
284     break-if-!=
285     var g/eax: code-point-utf8 <- read-code-point-utf8 s-addr
286     compare g, 0xa/newline
287     break-if-=
288     result <- increment
289     loop
290   }
291   return result
292 }
293 
294 fn fill-in _out: (addr array screen-cell), in: (addr array byte) {
295   var s: (stream byte 0x100)
296   var out/edi: (addr array screen-cell) <- copy _out
297   var s-addr/esi: (addr stream byte) <- address s
298   write s-addr, in
299   var idx/ecx: int <- copy 0
300   {
301     var done?/eax: boolean <- stream-empty? s-addr
302     compare done?, 0/false
303     break-if-!=
304     var g/eax: code-point-utf8 <- read-code-point-utf8 s-addr
305     compare g, 0xa/newline
306     loop-if-=
307     var offset/edx: (offset screen-cell) <- compute-offset out, idx
308     var dest/edx: (addr screen-cell) <- index out, offset
309     var dest2/edx: (addr code-point-utf8) <- get dest, data
310     copy-to *dest2, g
311     idx <- increment
312     loop
313   }
314 }
315 
316 # pin (1, 1) to (1, 1) on screen
317 fn test-surface-pin-at-origin {
318   var s: surface
319   var s-addr/esi: (addr surface) <- address s
320   # surface contents are a fixed grid with 8 rows and 6 columns
321   # (strip vowels second time around to break vertical alignment of letters)
322   initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz"
323   pin-surface-at s-addr, 1, 1  # surface row and column
324   pin-surface-to s-addr, 1, 1  # screen row and column
325   render-surface s-addr
326   var screen-ah/eax: (addr handle screen) <- get s-addr, screen
327   var screen-addr/eax: (addr screen) <- lookup *screen-ah
328   check-screen-row screen-addr, 1, "abcd", "F - test-surface-pin-at-origin"
329   check-screen-row screen-addr, 2, "ghij", "F - test-surface-pin-at-origin"
330   check-screen-row screen-addr, 3, "mnop", "F - test-surface-pin-at-origin"
331 }
332 
333 # pin (1, 1) to (2, 1) on screen; screen goes past edge of the universe
334 fn test-surface-pin-2 {
335   var s: surface
336   var s-addr/esi: (addr surface) <- address s
337   # surface contents are a fixed grid with 8 rows and 6 columns
338   # (strip vowels second time around to break vertical alignment of letters)
339   initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz"
340   pin-surface-at s-addr, 1, 1  # surface row and column
341   pin-surface-to s-addr, 2, 1  # screen row and column
342   render-surface s-addr
343   var screen-ah/eax: (addr handle screen) <- get s-addr, screen
344   var screen-addr/eax: (addr screen) <- lookup *screen-ah
345   # surface edge reached (should seldom happen in the app)
346   check-screen-row screen-addr, 1, "    ", "F - test-surface-pin-2"
347   check-screen-row screen-addr, 2, "abcd", "F - test-surface-pin-2"
348   check-screen-row screen-addr, 3, "ghij", "F - test-surface-pin-2"
349 }
350 
351 # pin (2, 1) to (1, 1) on screen
352 fn test-surface-pin-3 {
353   var s: surface
354   var s-addr/esi: (addr surface) <- address s
355   # surface contents are a fixed grid with 8 rows and 6 columns
356   # (strip vowels second time around to break vertical alignment of letters)
357   initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz"
358   pin-surface-at s-addr, 2, 1  # surface row and column
359   pin-surface-to s-addr, 1, 1  # screen row and column
360   render-surface s-addr
361   var screen-ah/eax: (addr handle screen) <- get s-addr, screen
362   var screen-addr/eax: (addr screen) <- lookup *screen-ah
363   check-screen-row screen-addr, 1, "ghij", "F - test-surface-pin-3"
364   check-screen-row screen-addr, 2, "mnop", "F - test-surface-pin-3"
365   check-screen-row screen-addr, 3, "stuv", "F - test-surface-pin-3"
366 }
367 
368 # pin (1, 1) to (1, 2) on screen; screen goes past edge of the universe
369 fn test-surface-pin-4 {
370   var s: surface
371   var s-addr/esi: (addr surface) <- address s
372   # surface contents are a fixed grid with 8 rows and 6 columns
373   # (strip vowels second time around to break vertical alignment of letters)
374   initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz"
375   pin-surface-at s-addr, 1, 1  # surface row and column
376   pin-surface-to s-addr, 1, 2  # screen row and column
377   render-surface s-addr
378   var screen-ah/eax: (addr handle screen) <- get s-addr, screen
379   var screen-addr/eax: (addr screen) <- lookup *screen-ah
380   # surface edge reached (should seldom happen in the app)
381   check-screen-row screen-addr, 1, " abc", "F - test-surface-pin-4"
382   check-screen-row screen-addr, 2, " ghi", "F - test-surface-pin-4"
383   check-screen-row screen-addr, 3, " mno", "F - test-surface-pin-4"
384 }
385 
386 # pin (1, 2) to (1, 1) on screen
387 fn test-surface-pin-5 {
388   var s: surface
389   var s-addr/esi: (addr surface) <- address s
390   # surface contents are a fixed grid with 8 rows and 6 columns
391   # (strip vowels second time around to break vertical alignment of letters)
392   initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz"
393   pin-surface-at s-addr, 1, 2  # surface row and column
394   pin-surface-to s-addr, 1, 1  # screen row and column
395   render-surface s-addr
396   var screen-ah/eax: (addr handle screen) <- get s-addr, screen
397   var screen-addr/eax: (addr screen) <- lookup *screen-ah
398   check-screen-row screen-addr, 1, "bcde", "F - test-surface-pin-5"
399   check-screen-row screen-addr, 2, "hijk", "F - test-surface-pin-5"
400   check-screen-row screen-addr, 3, "nopq", "F - test-surface-pin-5"
401 }
402 
403 fn initialize-surface-with-fake-screen _self: (addr surface), nrows: int, ncols: int, in: (addr array byte) {
404   var self/esi: (addr surface) <- copy _self
405   # fill in screen
406   var screen-ah/eax: (addr handle screen) <- get self, screen
407   allocate screen-ah
408   var screen-addr/eax: (addr screen) <- lookup *screen-ah
409   initialize-screen screen-addr, nrows, ncols
410   # fill in everything else
411   initialize-surface-with self, in
412 }