https://github.com/akkartik/mu/blob/master/081print.mu

      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, false/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, 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 false
     91   }
     92   return 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, 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, 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:bool/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, 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   {
    888     break-if n
    889     screen <- print screen, [false], color, bg-color
    890   }
    891   {
    892     break-unless n
    893     screen <- print screen, [true], color, bg-color
    894   }
    895 ]
    896
    897 def print screen:&:screen, n:&:_elem -> screen:&:screen [
    898   local-scope
    899   load-inputs
    900   color:num, color-found?:bool <- next-input
    901   {
    902     # default color to white
    903     break-if color-found?
    904     color <- copy 7/white
    905   }
    906   bg-color:num, bg-color-found?:bool <- next-input
    907   {
    908     # default bg-color to black
    909     break-if bg-color-found?
    910     bg-color <- copy 0/black
    911   }
    912   n2:num <- deaddress n
    913   screen <- print screen, n2, color, bg-color
    914 ]