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 -> _/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   var result/eax: int <- copy -1
176   {
177     compare row, 1
178     break-if-<
179     compare col, 1
180     break-if-<
181     var nrows-addr/ecx: (addr int) <- get self, nrows
182     var nrows/ecx: int <- copy *nrows-addr
183     compare row, nrows
184     break-if->
185     var ncols-addr/ecx: (addr int) <- get self, ncols
186     var ncols/ecx: int <- copy *ncols-addr
187     compare col, ncols
188     break-if->
189   #?   print-string-to-real-screen "!\n"
190     result <- copy row
191     result <- subtract 1
192     result <- multiply ncols
193     result <- add col
194     result <- subtract 1
195   }
196   return result
197 }
198 
199 fn screen-row-to-surface _self: (addr surface), screen-row: int -> _/ecx: int {
200   var self/esi: (addr surface) <- copy _self
201   var result/ecx: int <- copy screen-row
202   var tmp/eax: (addr int) <- get self, pin-row
203   result <- add *tmp
204   tmp <- get self, pin-screen-row
205   result <- subtract *tmp
206   return result
207 }
208 
209 fn max _a: int, b: int -> _/eax: int {
210   var a/eax: int <- copy _a
211   compare a, b
212   {
213     break-if->
214     return b
215   }
216   return a
217 }
218 
219 fn min _a: int, b: int -> _/eax: int {
220   var a/eax: int <- copy _a
221   compare a, b
222   {
223     break-if->
224     return a
225   }
226   return b
227 }
228 
229 fn screen-col-to-surface _self: (addr surface), screen-col: int -> _/edx: int {
230   var self/esi: (addr surface) <- copy _self
231   var result/edx: int <- copy screen-col
232   var tmp/eax: (addr int) <- get self, pin-col
233   result <- add *tmp
234   tmp <- get self, pin-screen-col
235   result <- subtract *tmp
236   return result
237 }
238 
239 fn surface-row-to-screen _self: (addr surface), row: int -> _/ecx: int {
240   var self/esi: (addr surface) <- copy _self
241   var result/ecx: int <- copy row
242   var tmp/eax: (addr int) <- get self, pin-screen-row
243   result <- add *tmp
244   tmp <- get self, pin-row
245   result <- subtract *tmp
246   return result
247 }
248 
249 fn surface-col-to-screen _self: (addr surface), col: int -> _/edx: int {
250   var self/esi: (addr surface) <- copy _self
251   var result/edx: int <- copy col
252   var tmp/eax: (addr int) <- get self, pin-screen-col
253   result <- add *tmp
254   tmp <- get self, pin-col
255   result <- subtract *tmp
256   return result
257 }
258 
259 # assumes last line doesn't end in '\n'
260 fn num-lines in: (addr array byte) -> _/ecx: int {
261   var s: (stream byte 0x100)
262   var s-addr/esi: (addr stream byte) <- address s
263   write s-addr, in
264   var result/ecx: int <- copy 1
265   {
266     var done?/eax: boolean <- stream-empty? s-addr
267     compare done?, 0  # false
268     break-if-!=
269     var g/eax: grapheme <- read-grapheme s-addr
270     compare g, 0xa  # newline
271     loop-if-!=
272     result <- increment
273     loop
274   }
275   return result
276 }
277 
278 fn first-line-length in: (addr array byte) -> _/edx: int {
279   var s: (stream byte 0x100)
280   var s-addr/esi: (addr stream byte) <- address s
281   write s-addr, in
282   var result/edx: int <- copy 0
283   {
284     var done?/eax: boolean <- stream-empty? s-addr
285     compare done?, 0  # false
286     break-if-!=
287     var g/eax: grapheme <- read-grapheme s-addr
288     compare g, 0xa  # newline
289     break-if-=
290     result <- increment
291     loop
292   }
293   return result
294 }
295 
296 fn fill-in _out: (addr array screen-cell), in: (addr array byte) {
297   var s: (stream byte 0x100)
298   var out/edi: (addr array screen-cell) <- copy _out
299   var s-addr/esi: (addr stream byte) <- address s
300   write s-addr, in
301   var idx/ecx: int <- copy 0
302   {
303     var done?/eax: boolean <- stream-empty? s-addr
304     compare done?, 0  # false
305     break-if-!=
306     var g/eax: grapheme <- read-grapheme s-addr
307     compare g, 0xa  # newline
308     loop-if-=
309     var offset/edx: (offset screen-cell) <- compute-offset out, idx
310     var dest/edx: (addr screen-cell) <- index out, offset
311     var dest2/edx: (addr grapheme) <- get dest, data
312     copy-to *dest2, g
313     idx <- increment
314     loop
315   }
316 }
317 
318 # pin (1, 1) to (1, 1) on screen
319 fn test-surface-pin-at-origin {
320   var s: surface
321   var s-addr/esi: (addr surface) <- address s
322   # surface contents are a fixed grid with 8 rows and 6 columns
323   # (strip vowels second time around to break vertical alignment of letters)
324   initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz"
325   pin-surface-at s-addr, 1, 1  # surface row and column
326   pin-surface-to s-addr, 1, 1  # screen row and column
327   render-surface s-addr
328   var screen-ah/eax: (addr handle screen) <- get s-addr, screen
329   var screen-addr/eax: (addr screen) <- lookup *screen-ah
330   check-screen-row screen-addr, 1, "abcd", "F - test-surface-pin-at-origin"
331   check-screen-row screen-addr, 2, "ghij", "F - test-surface-pin-at-origin"
332   check-screen-row screen-addr, 3, "mnop", "F - test-surface-pin-at-origin"
333 }
334 
335 # pin (1, 1) to (2, 1) on screen; screen goes past edge of the universe
336 fn test-surface-pin-2 {
337   var s: surface
338   var s-addr/esi: (addr surface) <- address s
339   # surface contents are a fixed grid with 8 rows and 6 columns
340   # (strip vowels second time around to break vertical alignment of letters)
341   initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz"
342   pin-surface-at s-addr, 1, 1  # surface row and column
343   pin-surface-to s-addr, 2, 1  # screen row and column
344   render-surface s-addr
345   var screen-ah/eax: (addr handle screen) <- get s-addr, screen
346   var screen-addr/eax: (addr screen) <- lookup *screen-ah
347   # surface edge reached (should seldom happen in the app)
348   check-screen-row screen-addr, 1, "    ", "F - test-surface-pin-2"
349   check-screen-row screen-addr, 2, "abcd", "F - test-surface-pin-2"
350   check-screen-row screen-addr, 3, "ghij", "F - test-surface-pin-2"
351 }
352 
353 # pin (2, 1) to (1, 1) on screen
354 fn test-surface-pin-3 {
355   var s: surface
356   var s-addr/esi: (addr surface) <- address s
357   # surface contents are a fixed grid with 8 rows and 6 columns
358   # (strip vowels second time around to break vertical alignment of letters)
359   initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz"
360   pin-surface-at s-addr, 2, 1  # surface row and column
361   pin-surface-to s-addr, 1, 1  # screen row and column
362   render-surface s-addr
363   var screen-ah/eax: (addr handle screen) <- get s-addr, screen
364   var screen-addr/eax: (addr screen) <- lookup *screen-ah
365   check-screen-row screen-addr, 1, "ghij", "F - test-surface-pin-3"
366   check-screen-row screen-addr, 2, "mnop", "F - test-surface-pin-3"
367   check-screen-row screen-addr, 3, "stuv", "F - test-surface-pin-3"
368 }
369 
370 # pin (1, 1) to (1, 2) on screen; screen goes past edge of the universe
371 fn test-surface-pin-4 {
372   var s: surface
373   var s-addr/esi: (addr surface) <- address s
374   # surface contents are a fixed grid with 8 rows and 6 columns
375   # (strip vowels second time around to break vertical alignment of letters)
376   initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz"
377   pin-surface-at s-addr, 1, 1  # surface row and column
378   pin-surface-to s-addr, 1, 2  # screen row and column
379   render-surface s-addr
380   var screen-ah/eax: (addr handle screen) <- get s-addr, screen
381   var screen-addr/eax: (addr screen) <- lookup *screen-ah
382   # surface edge reached (should seldom happen in the app)
383   check-screen-row screen-addr, 1, " abc", "F - test-surface-pin-4"
384   check-screen-row screen-addr, 2, " ghi", "F - test-surface-pin-4"
385   check-screen-row screen-addr, 3, " mno", "F - test-surface-pin-4"
386 }
387 
388 # pin (1, 2) to (1, 1) on screen
389 fn test-surface-pin-5 {
390   var s: surface
391   var s-addr/esi: (addr surface) <- address s
392   # surface contents are a fixed grid with 8 rows and 6 columns
393   # (strip vowels second time around to break vertical alignment of letters)
394   initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz"
395   pin-surface-at s-addr, 1, 2  # surface row and column
396   pin-surface-to s-addr, 1, 1  # screen row and column
397   render-surface s-addr
398   var screen-ah/eax: (addr handle screen) <- get s-addr, screen
399   var screen-addr/eax: (addr screen) <- lookup *screen-ah
400   check-screen-row screen-addr, 1, "bcde", "F - test-surface-pin-5"
401   check-screen-row screen-addr, 2, "hijk", "F - test-surface-pin-5"
402   check-screen-row screen-addr, 3, "nopq", "F - test-surface-pin-5"
403 }
404 
405 fn initialize-surface-with-fake-screen _self: (addr surface), nrows: int, ncols: int, in: (addr array byte) {
406   var self/esi: (addr surface) <- copy _self
407   # fill in screen
408   var screen-ah/eax: (addr handle screen) <- get self, screen
409   allocate screen-ah
410   var screen-addr/eax: (addr screen) <- lookup *screen-ah
411   initialize-screen screen-addr, nrows, ncols
412   # fill in everything else
413   initialize-surface-with self, in
414 }