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-inputs
 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-inputs
 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-inputs
 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-inputs
 98   color:num, color-found?:bool <- next-input
 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-input
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-inputs
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-inputs
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-inputs
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-inputs
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-inputs
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-inputs
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-inputs
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-input
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-inputs
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-inputs
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-inputs
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-inputs
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-inputs
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-inputs
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-inputs
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-inputs
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-inputs
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-inputs
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-inputs
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-inputs
799   color:num, color-found?:bool <- next-input
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-input
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-inputs
855   color:num, color-found?:bool <- next-input
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-input
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-inputs
875   color:num, color-found?:bool <- next-input
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-input
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-inputs
894   color:num, color-found?:bool <- next-input
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-input
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 ]