1 # Wrappers around print primitives that take a 'screen' object and are thus
  2 # easier to test.
  3 #
  4 # Screen objects are intended to exactly mimic the behavior of traditional
  5 # terminals. Moving a cursor too far right wraps it to the next line,
  6 # scrolling if necessary. The details are subtle:
  7 #
  8 # a) Rows can take unbounded values. When printing, large values for the row
  9 # saturate to the bottom row (because scrolling).
 10 #
 11 # b) If you print to a square (row, right) on the right margin, the cursor
 12 # position depends on whether 'row' is in range. If it is, the new cursor
 13 # position is (row+1, 0). If it isn't, the new cursor position is (row, 0).
 14 # Because scrolling.
 15 
 16 container screen [
 17   num-rows:num
 18   num-columns:num
 19   cursor-row:num
 20   cursor-column:num
 21   data:&:@:screen-cell  # capacity num-rows*num-columns
 22   pending-scroll?:bool
 23   top-idx:num  # index inside data that corresponds to top-left of screen
 24   ¦ ¦ ¦ ¦ ¦ ¦ ¦# modified on scroll, wrapping around to the top of data
 25 ]
 26 
 27 container screen-cell [
 28   contents:char
 29   color:num
 30 ]
 31 
 32 def new-fake-screen w:num, h:num -> result:&:screen [
 33   local-scope
 34   load-ingredients
 35   result <- new screen:type
 36   non-zero-width?:bool <- greater-than w, 0
 37   assert non-zero-width?, [screen can't have zero width]
 38   non-zero-height?:bool <- greater-than h, 0
 39   assert non-zero-height?, [screen can't have zero height]
 40   bufsize:num <- multiply w, h
 41   data:&:@:screen-cell <- new screen-cell:type, bufsize
 42   *result <- merge h/num-rows, w/num-columns, 0/cursor-row, 0/cursor-column, data, 0/pending-scroll?, 0/top-idx
 43   result <- clear-screen result
 44 ]
 45 
 46 def clear-screen screen:&:screen -> screen:&:screen [
 47   local-scope
 48   load-ingredients
 49 #?   stash [clear-screen]
 50   {
 51   ¦ break-if screen
 52   ¦ # real screen
 53   ¦ clear-display
 54   ¦ return
 55   }
 56   # fake screen
 57   buf:&:@:screen-cell <- get *screen, data:offset
 58   max:num <- length *buf
 59   i:num <- copy 0
 60   {
 61   ¦ done?:bool <- greater-or-equal i, max
 62   ¦ break-if done?
 63   ¦ curr:screen-cell <- merge 0/empty, 7/white
 64   ¦ *buf <- put-index *buf, i, curr
 65   ¦ i <- add i, 1
 66   ¦ loop
 67   }
 68   # reset cursor
 69   *screen <- put *screen, cursor-row:offset, 0
 70   *screen <- put *screen, cursor-column:offset, 0
 71   *screen <- put *screen, top-idx:offset, 0
 72 ]
 73 
 74 def fake-screen-is-empty? screen:&:screen -> result:bool [
 75   local-scope
 76   load-ingredients
 77 #?   stash [fake-screen-is-empty?]
 78   return-unless screen, 1/true  # do nothing for real screens
 79   buf:&:@:screen-cell <- get *screen, data:offset
 80   i:num <- copy 0
 81   len:num <- length *buf
 82   {
 83   ¦ done?:bool <- greater-or-equal i, len
 84   ¦ break-if done?
 85   ¦ curr:screen-cell <- index *buf, i
 86   ¦ curr-contents:char <- get curr, contents:offset
 87   ¦ i <- add i, 1
 88   ¦ loop-unless curr-contents
 89   ¦ # not 0
 90   ¦ return 0/false
 91   }
 92   return 1/true
 93 ]
 94 
 95 def print screen:&:screen, c:char -> screen:&:screen [
 96   local-scope
 97   load-ingredients
 98   color:num, color-found?:bool <- next-ingredient
 99   {
100   ¦ # default color to white
101   ¦ break-if color-found?
102   ¦ color <- copy 7/white
103   }
104   bg-color:num, bg-color-found?:bool <- next-ingredient
105   {
106   ¦ # default bg-color to black
107   ¦ break-if bg-color-found?
108   ¦ bg-color <- copy 0/black
109   }
110   c2:num <- character-to-code c
111   trace 90, [print-character], c2
112   {
113   ¦ # real screen
114   ¦ break-if screen
115   ¦ print-character-to-display c, color, bg-color
116   ¦ return
117   }
118   # fake screen
119   # (handle special cases exactly like in the real screen)
120   width:num <- get *screen, num-columns:offset
121   height:num <- get *screen, num-rows:offset
122   capacity:num <- multiply width, height
123   row:num <- get *screen, cursor-row:offset
124   column:num <- get *screen, cursor-column:offset
125   buf:&:@:screen-cell <- get *screen, data:offset
126   # some potentially slow sanity checks for preconditions {
127   # eliminate fractions from column and row
128   row <- round row
129   column <- round column
130   # if cursor is past left margin (error), reset to left margin
131   {
132   ¦ too-far-left?:bool <- lesser-than column, 0
133   ¦ break-unless too-far-left?
134   ¦ column <- copy 0
135   ¦ *screen <- put *screen, cursor-column:offset, column
136   }
137   # if cursor is at or past right margin, wrap
138   {
139   ¦ at-right?:bool <- greater-or-equal column, width
140   ¦ break-unless at-right?
141   ¦ column <- copy 0
142   ¦ *screen <- put *screen, cursor-column:offset, column
143   ¦ row <- add row, 1
144   ¦ *screen <- put *screen, cursor-row:offset, row
145   }
146   # }
147   # if there's a pending scroll, perform it
148   {
149   ¦ pending-scroll?:bool <- get *screen, pending-scroll?:offset
150   ¦ break-unless pending-scroll?
151 #?     stash [scroll]
152   ¦ scroll-fake-screen screen
153   ¦ *screen <- put *screen, pending-scroll?:offset, 0/false
154   }
155 #?     $print [print-character (], row, [, ], column, [): ], c, 10/newline
156   # special-case: newline
157   {
158   ¦ newline?:bool <- equal c, 10/newline
159   ¦ break-unless newline?
160   ¦ cursor-down-on-fake-screen screen  # doesn't modify column
161   ¦ return
162   }
163   # special-case: linefeed
164   {
165   ¦ linefeed?:bool <- equal c, 13/linefeed
166   ¦ break-unless linefeed?
167   ¦ *screen <- put *screen, cursor-column:offset, 0
168   ¦ return
169   }
170   # special-case: backspace
171   # moves cursor left but does not erase
172   {
173   ¦ backspace?:bool <- equal c, 8/backspace
174   ¦ break-unless backspace?
175   ¦ {
176   ¦ ¦ break-unless column
177   ¦ ¦ column <- subtract column, 1
178   ¦ ¦ *screen <- put *screen, cursor-column:offset, column
179   ¦ }
180   ¦ return
181   }
182   # save character in fake screen
183   top-idx:num <- get *screen, top-idx:offset
184   index:num <- data-index row, column, width, height, top-idx
185   cursor:screen-cell <- merge c, color
186   *buf <- put-index *buf, index, cursor
187   # move cursor to next character, wrapping as necessary
188   # however, don't scroll just yet
189   column <- add column, 1
190   {
191   ¦ past-right?:bool <- greater-or-equal column, width
192   ¦ break-unless past-right?
193   ¦ column <- copy 0
194   ¦ row <- add row, 1
195   ¦ past-bottom?:bool <- greater-or-equal row, height
196   ¦ break-unless past-bottom?
197   ¦ # queue up a scroll
198 #?     stash [pending scroll]
199   ¦ *screen <- put *screen, pending-scroll?:offset, 1/true
200   ¦ row <- subtract row, 1  # update cursor as if scroll already happened
201   }
202   *screen <- put *screen, cursor-row:offset, row
203   *screen <- put *screen, cursor-column:offset, column
204 ]
205 
206 def cursor-down-on-fake-screen screen:&:screen -> screen:&:screen [
207   local-scope
208   load-ingredients
209 #?   stash [cursor-down]
210   row:num <- get *screen, cursor-row:offset
211   height:num <- get *screen, num-rows:offset
212   bottom:num <- subtract height, 1
213   at-bottom?:bool <- greater-or-equal row, bottom
214   {
215   ¦ break-if at-bottom?
216   ¦ row <- add row, 1
217   ¦ *screen <- put *screen, cursor-row:offset, row
218   }
219   {
220   ¦ break-unless at-bottom?
221   ¦ scroll-fake-screen screen  # does not modify row
222   }
223 ]
224 
225 def scroll-fake-screen screen:&:screen -> screen:&:screen [
226   local-scope
227   load-ingredients
228 #?   stash [scroll-fake-screen]
229   width:num <- get *screen, num-columns:offset
230   height:num <- get *screen, num-rows:offset
231   buf:&:@:screen-cell <- get *screen, data:offset
232   # clear top line and 'rotate' it to the bottom
233   top-idx:num <- get *screen, top-idx:offset  # 0 <= top-idx < len(buf)
234   next-top-idx:num <- add top-idx, width  # 0 <= next-top-idx <= len(buf)
235   empty-cell:screen-cell <- merge 0/empty, 7/white
236   {
237   ¦ done?:bool <- greater-or-equal top-idx, next-top-idx
238   ¦ break-if done?
239   ¦ put-index *buf, top-idx, empty-cell
240   ¦ top-idx <- add top-idx, 1
241   ¦ # no modulo; top-idx is always a multiple of width,
242   ¦ # so it can never wrap around inside this loop
243   ¦ loop
244   }
245   # top-idx now same as next-top-idx; wrap around if necessary
246   capacity:num <- multiply width, height
247   _, top-idx <- divide-with-remainder, top-idx, capacity
248   *screen <- put *screen, top-idx:offset, top-idx
249 ]
250 
251 # translate from screen (row, column) coordinates to an index into data
252 # while accounting for scrolling (sliding top-idx)
253 def data-index row:num, column:num, width:num, height:num, top-idx:num -> result:num [
254   local-scope
255   load-ingredients
256   {
257   ¦ overflow?:bool <- greater-or-equal row, height
258   ¦ break-unless overflow?
259   ¦ row <- subtract height, 1
260   }
261   result <- multiply width, row
262   result <- add result, column, top-idx
263   capacity:num <- multiply width, height
264   _, result <- divide-with-remainder result, capacity
265 ]
266 
267 scenario print-character-at-top-left [
268   local-scope
269   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
270   run [
271   ¦ a:char <- copy 97/a
272   ¦ fake-screen <- print fake-screen, a:char
273   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
274   ¦ 1:@:screen-cell/raw <- copy *cell
275   ]
276   memory-should-contain [
277   ¦ 1 <- 6  # width*height
278   ¦ 2 <- 97  # 'a'
279   ¦ 3 <- 7  # white
280   ¦ # rest of screen is empty
281   ¦ 4 <- 0
282   ]
283 ]
284 
285 scenario print-character-at-fractional-coordinate [
286   local-scope
287   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
288   a:char <- copy 97/a
289   run [
290   ¦ move-cursor fake-screen, 0.5, 0
291   ¦ fake-screen <- print fake-screen, a:char
292   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
293   ¦ 1:@:screen-cell/raw <- copy *cell
294   ]
295   memory-should-contain [
296   ¦ 1 <- 6  # width*height
297   ¦ 2 <- 97  # 'a'
298   ¦ 3 <- 7  # white
299   ¦ # rest of screen is empty
300   ¦ 4 <- 0
301   ]
302 ]
303 
304 scenario print-character-in-color [
305   local-scope
306   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
307   run [
308   ¦ a:char <- copy 97/a
309   ¦ fake-screen <- print fake-screen, a:char, 1/red
310   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
311   ¦ 1:@:screen-cell/raw <- copy *cell
312   ]
313   memory-should-contain [
314   ¦ 1 <- 6  # width*height
315   ¦ 2 <- 97  # 'a'
316   ¦ 3 <- 1  # red
317   ¦ # rest of screen is empty
318   ¦ 4 <- 0
319   ]
320 ]
321 
322 scenario print-backspace-character [
323   local-scope
324   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
325   a:char <- copy 97/a
326   fake-screen <- print fake-screen, a
327   run [
328   ¦ backspace:char <- copy 8/backspace
329   ¦ fake-screen <- print fake-screen, backspace
330   ¦ 10:num/raw <- get *fake-screen, cursor-column:offset
331   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
332   ¦ 11:@:screen-cell/raw <- copy *cell
333   ]
334   memory-should-contain [
335   ¦ 10 <- 0  # cursor column
336   ¦ 11 <- 6  # width*height
337   ¦ 12 <- 97  # still 'a'
338   ¦ 13 <- 7  # white
339   ¦ # rest of screen is empty
340   ¦ 14 <- 0
341   ]
342 ]
343 
344 scenario print-extra-backspace-character [
345   local-scope
346   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
347   a:char <- copy 97/a
348   fake-screen <- print fake-screen, a
349   run [
350   ¦ backspace:char <- copy 8/backspace
351   ¦ fake-screen <- print fake-screen, backspace
352   ¦ fake-screen <- print fake-screen, backspace  # cursor already at left margin
353   ¦ 1:num/raw <- get *fake-screen, cursor-column:offset
354   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
355   ¦ 3:@:screen-cell/raw <- copy *cell
356   ]
357   memory-should-contain [
358   ¦ 1 <- 0  # cursor column
359   ¦ 3 <- 6  # width*height
360   ¦ 4 <- 97  # still 'a'
361   ¦ 5 <- 7  # white
362   ¦ # rest of screen is empty
363   ¦ 6 <- 0
364   ]
365 ]
366 
367 scenario print-character-at-right-margin [
368   # fill top row of screen with text
369   local-scope
370   fake-screen:&:screen <- new-fake-screen 2/width, 2/height
371   a:char <- copy 97/a
372   fake-screen <- print fake-screen, a
373   b:char <- copy 98/b
374   fake-screen <- print fake-screen, b
375   run [
376   ¦ # cursor now at next row
377   ¦ c:char <- copy 99/c
378   ¦ fake-screen <- print fake-screen, c
379   ¦ 10:num/raw <- get *fake-screen, cursor-row:offset
380   ¦ 11:num/raw <- get *fake-screen, cursor-column:offset
381   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
382   ¦ 12:@:screen-cell/raw <- copy *cell
383   ]
384   memory-should-contain [
385   ¦ 10 <- 1  # cursor row
386   ¦ 11 <- 1  # cursor column
387   ¦ 12 <- 4  # width*height
388   ¦ 13 <- 97  # 'a'
389   ¦ 14 <- 7  # white
390   ¦ 15 <- 98  # 'b'
391   ¦ 16 <- 7  # white
392   ¦ 17 <- 99  # 'c'
393   ¦ 18 <- 7  # white
394   ¦ 19 <- 0  # ' '
395   ¦ 20 <- 7  # white
396   ]
397 ]
398 
399 scenario print-newline-character [
400   local-scope
401   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
402   a:char <- copy 97/a
403   fake-screen <- print fake-screen, a
404   run [
405   ¦ newline:char <- copy 10/newline
406   ¦ fake-screen <- print fake-screen, newline
407   ¦ 10:num/raw <- get *fake-screen, cursor-row:offset
408   ¦ 11:num/raw <- get *fake-screen, cursor-column:offset
409   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
410   ¦ 12:@:screen-cell/raw <- copy *cell
411   ]
412   memory-should-contain [
413   ¦ 10 <- 1  # cursor row
414   ¦ 11 <- 1  # cursor column
415   ¦ 12 <- 6  # width*height
416   ¦ 13 <- 97  # 'a'
417   ¦ 14 <- 7  # white
418   ¦ # rest of screen is empty
419   ¦ 15 <- 0
420   ]
421 ]
422 
423 scenario print-newline-at-bottom-line [
424   local-scope
425   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
426   newline:char <- copy 10/newline
427   fake-screen <- print fake-screen, newline
428   fake-screen <- print fake-screen, newline
429   run [
430   ¦ # cursor now at bottom of screen
431   ¦ fake-screen <- print fake-screen, newline
432   ¦ 10:num/raw <- get *fake-screen, cursor-row:offset
433   ¦ 11:num/raw <- get *fake-screen, cursor-column:offset
434   ]
435   # doesn't move further down
436   memory-should-contain [
437   ¦ 10 <- 1  # cursor row
438   ¦ 11 <- 0  # cursor column
439   ]
440 ]
441 
442 scenario print-character-at-bottom-right [
443   local-scope
444   fake-screen:&:screen <- new-fake-screen 2/width, 2/height
445   a:char <- copy 97/a
446   fake-screen <- print fake-screen, a
447   b:char <- copy 98/b
448   fake-screen <- print fake-screen, b
449   c:char <- copy 99/c
450   fake-screen <- print fake-screen, c
451   run [
452   ¦ # cursor now at bottom right
453   ¦ d:char <- copy 100/d
454   ¦ fake-screen <- print fake-screen, d
455   ¦ 10:num/raw <- get *fake-screen, cursor-row:offset
456   ¦ 11:num/raw <- get *fake-screen, cursor-column:offset
457   ¦ 12:num/raw <- get *fake-screen, top-idx:offset
458   ¦ 13:num/raw <- get *fake-screen, pending-scroll?:offset
459   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
460   ¦ 20:@:screen-cell/raw <- copy *cell
461   ]
462   # cursor column wraps but the screen doesn't scroll yet
463   memory-should-contain [
464   ¦ 10 <- 1  # cursor row
465   ¦ 11 <- 0  # cursor column -- outside screen
466   ¦ 12 <- 0  # top-idx -- not yet scrolled
467   ¦ 13 <- 1  # pending-scroll?
468   ¦ 20 <- 4  # screen size (width*height)
469   ¦ 21 <- 97  # 'a'
470   ¦ 22 <- 7  # white
471   ¦ 23 <- 98  # 'b'
472   ¦ 24 <- 7  # white
473   ¦ 25 <- 99 # 'c'
474   ¦ 26 <- 7  # white
475   ¦ 27 <- 100  # 'd'
476   ¦ 28 <- 7  # white
477   ]
478   run [
479   ¦ e:char <- copy 101/e
480   ¦ print fake-screen, e
481   ¦ 10:num/raw <- get *fake-screen, cursor-row:offset
482   ¦ 11:num/raw <- get *fake-screen, cursor-column:offset
483   ¦ 12:num/raw <- get *fake-screen, top-idx:offset
484   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
485   ¦ 20:@:screen-cell/raw <- copy *cell
486   ]
487   memory-should-contain [
488   ¦ # text scrolls by 1, we lose the top line
489   ¦ 10 <- 1  # cursor row
490   ¦ 11 <- 1  # cursor column -- wrapped
491   ¦ 12 <- 2  # top-idx -- scrolled
492   ¦ 20 <- 4  # screen size (width*height)
493   ¦ # screen now checked in rotated order
494   ¦ 25 <- 99 # 'c'
495   ¦ 26 <- 7  # white
496   ¦ 27 <- 100  # 'd'
497   ¦ 28 <- 7  # white
498   ¦ # screen wraps; bottom line is cleared of old contents
499   ¦ 21 <- 101  # 'e'
500   ¦ 22 <- 7  # white
501   ¦ 23 <- 0  # unused
502   ¦ 24 <- 7  # white
503   ]
504 ]
505 
506 # even though our screen supports scrolling, some apps may want to avoid
507 # scrolling
508 # these helpers help check for scrolling at development time
509 def save-top-idx screen:&:screen -> result:num [
510   local-scope
511   load-ingredients
512   return-unless screen, 0  # check is only for fake screens
513   result <- get *screen, top-idx:offset
514 ]
515 def assert-no-scroll screen:&:screen, old-top-idx:num [
516   local-scope
517   load-ingredients
518   return-unless screen
519   new-top-idx:num <- get *screen, top-idx:offset
520   no-scroll?:bool <- equal old-top-idx, new-top-idx
521   assert no-scroll?, [render should never use screen's scrolling capabilities]
522 ]
523 
524 def clear-line screen:&:screen -> screen:&:screen [
525   local-scope
526   load-ingredients
527 #?   stash [clear-line]
528   space:char <- copy 0/nul
529   {
530   ¦ break-if screen
531   ¦ # real screen
532   ¦ clear-line-on-display
533   ¦ return
534   }
535   # fake screen
536   width:num <- get *screen, num-columns:offset
537   column:num <- get *screen, cursor-column:offset
538   original-column:num <- copy column
539   # space over the entire line
540   {
541   ¦ right:num <- subtract width, 1
542   ¦ done?:bool <- greater-or-equal column, right
543   ¦ break-if done?
544   ¦ print screen, space
545   ¦ column <- add column, 1
546   ¦ loop
547   }
548   # now back to where the cursor was
549   *screen <- put *screen, cursor-column:offset, original-column
550 ]
551 
552 # only for non-scrolling apps
553 def clear-line-until screen:&:screen, right:num/inclusive -> screen:&:screen [
554   local-scope
555   load-ingredients
556   row:num, column:num <- cursor-position screen
557 #?   stash [clear-line-until] row column
558   height:num <- screen-height screen
559   past-bottom?:bool <- greater-or-equal row, height
560   return-if past-bottom?
561   space:char <- copy 32/space
562   bg-color:num, bg-color-found?:bool <- next-ingredient
563   {
564   ¦ # default bg-color to black
565   ¦ break-if bg-color-found?
566   ¦ bg-color <- copy 0/black
567   }
568   {
569   ¦ done?:bool <- greater-than column, right
570   ¦ break-if done?
571   ¦ screen <- print screen, space, 7/white, bg-color  # foreground color is mostly unused except if the cursor shows up at this cell
572   ¦ column <- add column, 1
573   ¦ loop
574   }
575 ]
576 
577 def cursor-position screen:&:screen -> row:num, column:num [
578   local-scope
579   load-ingredients
580   {
581   ¦ break-if screen
582   ¦ # real screen
583   ¦ row, column <- cursor-position-on-display
584   ¦ return
585   }
586   # fake screen
587   row:num <- get *screen, cursor-row:offset
588   column:num <- get *screen, cursor-column:offset
589 ]
590 
591 def move-cursor screen:&:screen, new-row:num, new-column:num -> screen:&:screen [
592   local-scope
593   load-ingredients
594 #?   stash [move-cursor] new-row new-column
595   {
596   ¦ break-if screen
597   ¦ # real screen
598   ¦ move-cursor-on-display new-row, new-column
599   ¦ return
600   }
601   # fake screen
602   *screen <- put *screen, cursor-row:offset, new-row
603   *screen <- put *screen, cursor-column:offset, new-column
604   # if cursor column is within bounds, reset 'pending-scroll?'
605   {
606   ¦ width:num <- get *screen, num-columns:offset
607   ¦ scroll?:bool <- greater-or-equal new-column, width
608   ¦ break-if scroll?
609 #?     stash [resetting pending-scroll?]
610   ¦ *screen <- put *screen, pending-scroll?:offset, 0/false
611   }
612 ]
613 
614 scenario clear-line-erases-printed-characters [
615   local-scope
616   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
617   # print a character
618   a:char <- copy 97/a
619   fake-screen <- print fake-screen, a
620   # move cursor to start of line
621   fake-screen <- move-cursor fake-screen, 0/row, 0/column
622   run [
623   ¦ fake-screen <- clear-line fake-screen
624   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
625   ¦ 10:@:screen-cell/raw <- copy *cell
626   ]
627   # screen should be blank
628   memory-should-contain [
629   ¦ 10 <- 6  # width*height
630   ¦ 11 <- 0
631   ¦ 12 <- 7
632   ¦ 13 <- 0
633   ¦ 14 <- 7
634   ¦ 15 <- 0
635   ¦ 16 <- 7
636   ¦ 17 <- 0
637   ¦ 18 <- 7
638   ¦ 19 <- 0
639   ¦ 20 <- 7
640   ¦ 21 <- 0
641   ¦ 22 <- 7
642   ]
643 ]
644 
645 def cursor-down screen:&:screen -> screen:&:screen [
646   local-scope
647   load-ingredients
648 #?   stash [cursor-down]
649   {
650   ¦ break-if screen
651   ¦ # real screen
652   ¦ move-cursor-down-on-display
653   ¦ return
654   }
655   # fake screen
656   cursor-down-on-fake-screen screen
657 ]
658 
659 scenario cursor-down-scrolls [
660   local-scope
661   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
662   # print something to screen and scroll
663   run [
664   ¦ print fake-screen, [abc]
665   ¦ cursor-to-next-line fake-screen
666   ¦ cursor-to-next-line fake-screen
667   ¦ data:&:@:screen-cell <- get *fake-screen, data:offset
668   ¦ 10:@:screen-cell/raw <- copy *data
669   ]
670   # screen is now blank
671   memory-should-contain [
672   ¦ 10 <- 6  # width*height
673   ¦ 11 <- 0
674   ¦ 12 <- 7  # white
675   ¦ 13 <- 0
676   ¦ 14 <- 7  # white
677   ¦ 15 <- 0
678   ¦ 16 <- 7  # white
679   ¦ 17 <- 0
680   ¦ 18 <- 7  # white
681   ¦ 19 <- 0
682   ¦ 20 <- 7  # white
683   ¦ 21 <- 0
684   ¦ 22 <- 7  # white
685   ]
686 ]
687 
688 def cursor-up screen:&:screen -> screen:&:screen [
689   local-scope
690   load-ingredients
691 #?   stash [cursor-up]
692   {
693   ¦ break-if screen
694   ¦ # real screen
695   ¦ move-cursor-up-on-display
696   ¦ return
697   }
698   # fake screen
699   row:num <- get *screen, cursor-row:offset
700   at-top?:bool <- lesser-or-equal row, 0
701   return-if at-top?
702   row <- subtract row, 1
703   *screen <- put *screen, cursor-row:offset, row
704 ]
705 
706 def cursor-right screen:&:screen -> screen:&:screen [
707   local-scope
708   load-ingredients
709 #?   stash [cursor-right]
710   {
711   ¦ break-if screen
712   ¦ # real screen
713   ¦ move-cursor-right-on-display
714   ¦ return
715   }
716   # fake screen
717   width:num <- get *screen, num-columns:offset
718   column:num <- get *screen, cursor-column:offset
719   max:num <- subtract width, 1
720   at-bottom?:bool <- greater-or-equal column, max
721   return-if at-bottom?
722   column <- add column, 1
723   *screen <- put *screen, cursor-column:offset, column
724 ]
725 
726 def cursor-left screen:&:screen -> screen:&:screen [
727   local-scope
728   load-ingredients
729 #?   stash [cursor-left]
730   {
731   ¦ break-if screen
732   ¦ # real screen
733   ¦ move-cursor-left-on-display
734   ¦ return
735   }
736   # fake screen
737   column:num <- get *screen, cursor-column:offset
738   at-top?:bool <- lesser-or-equal column, 0
739   return-if at-top?
740   column <- subtract column, 1
741   *screen <- put *screen, cursor-column:offset, column
742 ]
743 
744 def cursor-to-start-of-line screen:&:screen -> screen:&:screen [
745   local-scope
746   load-ingredients
747 #?   stash [cursor-to-start-of-line]
748   row:num <- cursor-position screen
749   screen <- move-cursor screen, row, 0/column
750 ]
751 
752 def cursor-to-next-line screen:&:screen -> screen:&:screen [
753   local-scope
754   load-ingredients
755 #?   stash [cursor-to-next-line]
756   screen <- cursor-down screen
757   screen <- cursor-to-start-of-line screen
758 ]
759 
760 def move-cursor-to-column screen:&:screen, column:num -> screen:&:screen [
761   local-scope
762   load-ingredients
763   row:num, _ <- cursor-position screen
764 #?   stash [move-cursor-to-column] row
765   move-cursor screen, row, column
766 ]
767 
768 def screen-width screen:&:screen -> width:num [
769   local-scope
770   load-ingredients
771 #?   stash [screen-width]
772   {
773   ¦ break-unless screen
774   ¦ # fake screen
775   ¦ width <- get *screen, num-columns:offset
776   ¦ return
777   }
778   # real screen
779   width <- display-width
780 ]
781 
782 def screen-height screen:&:screen -> height:num [
783   local-scope
784   load-ingredients
785 #?   stash [screen-height]
786   {
787   ¦ break-unless screen
788   ¦ # fake screen
789   ¦ height <- get *screen, num-rows:offset
790   ¦ return
791   }
792   # real screen
793   height <- display-height
794 ]
795 
796 def print screen:&:screen, s:text -> screen:&:screen [
797   local-scope
798   load-ingredients
799   color:num, color-found?:bool <- next-ingredient
800   {
801   ¦ # default color to white
802   ¦ break-if color-found?
803   ¦ color <- copy 7/white
804   }
805   bg-color:num, bg-color-found?:bool <- next-ingredient
806   {
807   ¦ # default bg-color to black
808   ¦ break-if bg-color-found?
809   ¦ bg-color <- copy 0/black
810   }
811   len:num <- length *s
812   i:num <- copy 0
813   {
814   ¦ done?:bool <- greater-or-equal i, len
815   ¦ break-if done?
816   ¦ c:char <- index *s, i
817   ¦ print screen, c, color, bg-color
818   ¦ i <- add i, 1
819   ¦ loop
820   }
821 ]
822 
823 scenario print-text-wraps-past-right-margin [
824   local-scope
825   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
826   run [
827   ¦ fake-screen <- print fake-screen, [abcd]
828   ¦ 5:num/raw <- get *fake-screen, cursor-row:offset
829   ¦ 6:num/raw <- get *fake-screen, cursor-column:offset
830   ¦ 7:num/raw <- get *fake-screen, top-idx:offset
831   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
832   ¦ 10:@:screen-cell/raw <- copy *cell
833   ]
834   memory-should-contain [
835   ¦ 5 <- 1  # cursor-row
836   ¦ 6 <- 1  # cursor-column
837   ¦ 7 <- 0  # top-idx
838   ¦ 10 <- 6  # width*height
839   ¦ 11 <- 97  # 'a'
840   ¦ 12 <- 7  # white
841   ¦ 13 <- 98  # 'b'
842   ¦ 14 <- 7  # white
843   ¦ 15 <- 99  # 'c'
844   ¦ 16 <- 7  # white
845   ¦ 17 <- 100  # 'd'
846   ¦ 18 <- 7  # white
847   ¦ # rest of screen is empty
848   ¦ 19 <- 0
849   ]
850 ]
851 
852 def print screen:&:screen, n:num -> screen:&:screen [
853   local-scope
854   load-ingredients
855   color:num, color-found?:bool <- next-ingredient
856   {
857   ¦ # default color to white
858   ¦ break-if color-found?
859   ¦ color <- copy 7/white
860   }
861   bg-color:num, bg-color-found?:bool <- next-ingredient
862   {
863   ¦ # default bg-color to black
864   ¦ break-if bg-color-found?
865   ¦ bg-color <- copy 0/black
866   }
867   # todo: other bases besides decimal
868   s:text <- to-text n
869   screen <- print screen, s, color, bg-color
870 ]
871 
872 def print screen:&:screen, n:bool -> screen:&:screen [
873   local-scope
874   load-ingredients
875   color:num, color-found?:bool <- next-ingredient
876   {
877   ¦ # default color to white
878   ¦ break-if color-found?
879   ¦ color <- copy 7/white
880   }
881   bg-color:num, bg-color-found?:bool <- next-ingredient
882   {
883   ¦ # default bg-color to black
884   ¦ break-if bg-color-found?
885   ¦ bg-color <- copy 0/black
886   }
887   n2:num <- copy n
888   screen <- print screen, n2, color, bg-color
889 ]
890 
891 def print screen:&:screen, n:&:_elem -> screen:&:screen [
892   local-scope
893   load-ingredients
894   color:num, color-found?:bool <- next-ingredient
895   {
896   ¦ # default color to white
897   ¦ break-if color-found?
898   ¦ color <- copy 7/white
899   }
900   bg-color:num, bg-color-found?:bool <- next-ingredient
901   {
902   ¦ # default bg-color to black
903   ¦ break-if bg-color-found?
904   ¦ bg-color <- copy 0/black
905   }
906   n2:num <- copy n
907   screen <- print screen, n2, color, bg-color
908 ]