about summary refs log blame commit diff stats
path: root/archive/1.vm/081print.mu
blob: 98ea0f216d4d6462a1cf5dd2e30827a057595cc3 (plain) (tree)
1
2
3
4
5
6
7
8
9
10
11
12
13
14

                                                                           











                                                                            

                  



                   
                                                       
                      

                                                                         


                       
               
           

 
                                                     
             
             
                           



                                                          
                              
                                                       
                                                                                                                   
                               

 
                                                     
             
             
                         
   


                   
          
   














                                                 
                                           

 
                                                          
             
             
                                  
                                                           
                                                 

                        
   
                                         

                                     
                                                   

                             
           
                
   
             

 
                                                      
             

                                            

                            

                         
   
                                                  
   
                               

                            
   
                               
                                 
   








                                                          
                                        
                                           
                                                 



                                                           
                        






                                                               
                                              
   
                                                    





                                                        

                                           
   


                                                               
                             
                                                         
   
                                                                          



                                        







                                                              

          
                           
                                        
   
                                           
                           
     
                         
                                  
                                                          
     
          
   


                                                             

                                       

                                                        
                         








                                                      
                                                        


                                                                         




                                                                   
             
                        



                                                 
   






                                                    
   

 

                                                           
             
                               





                                                                         
                                                  


















                                                                                      
             




                                                  





                                                     
                                      

                                                           
       

                                            

                                                         
   
                         




                             


   


















                                                           
                                   

                                                           
       

                                                   

                                                         

                         




                             


   
                                    



                                                           
       
                                      
                                               
                                                        

                                                         

                         

                            
                         


                             


   
                                          



                                                           
       
                                      
                                               
                                                                                
                                                       

                                                         

                         

                           
                        


                             


   
                                          






                                                           
       
                            
                       
                                       

                                                        
                                                         
                                      

                         










                            


   
                                  



                                                           
       
                                   
                                             

                                                        

                                                         

                         
                         
                            




                             


   
                                       




                                                           
       
                                    
                                             

                                                        
   
                             
                         

                            


   
                                          

                                                           





                                     
       
                                
                        
                                       

                                                        
                                                  
                                                           

                                                         
   
                                                         
                         
                         
                                              
                                          
                              

                                         
                    
                   
                    
                  
                    
                    
                    
   























                                                          
                    







                                                                        
             




                                                           
             


                                                   
                                                                              

 
                                                   
             
             
                       
                          
   


                         
          
   














                                                               

 
                             
                                                                              
             
             
                                               
                                        


                                                   
                             
                                                  





                               
                                            






                                                                                                                                    
                                                            
             
             
   


                                             
          
   


                                                 

 
                                                                                 
             
             
                                           
   


                                              
          
   


                                                          




                                                              
                                        
                                                         
   

 
                                               






                                                           
       
                                         

                                                         

                          
                         










                           

           


   
                                                    
             
             
                        
   


                               
          
   
               





























                                                           

 
                                                  
             
             
                      
   


                             
          
   





                                                

 
                                                     
             
             
                         
   


                                
          
   







                                                      

 
                                                    
             
             
                        
   


                               
          
   





                                                      
 
 
                                                                
             
             
                                    
                                   
                                             

 
                                                            
             
             
                                

                                          

 
                                                                          
             
             
                                      
                                      


                                 
                                               
             
             
                         
   
                       
                 
                                            
          
   
               
                        

 
                                                 
             
             
                          
   
                       
                 
                                          
          
   
               
                          

 
                                                      
             

                                            

                            

                         
   
                                                  
   
                               

                            
   

                      
   
                                         
                  
                         
                                    
                 

        

 
                                             

                                                           
       
                                            


                                                       

                                                         

                         


                           




                           
                   
                    

                    
                             
           


   
                                                     
             

                                            

                            

                         
   
                                                  
   
                               

                            
   
                                     
                     
                                            
 
 

                                                      

                                            




                            
                                                  




                               







                                                    

 
                                                         
             

                                            




                            
                                                  




                               
                       
                                             
 
# Wrappers around print primitives that take a 'screen' object and are thus
# easier to test.
#
# Screen objects are intended to exactly mimic the behavior of traditional
# terminals. Moving a cursor too far right wraps it to the next line,
# scrolling if necessary. The details are subtle:
#
# a) Rows can take unbounded values. When printing, large values for the row
# saturate to the bottom row (because scrolling).
#
# b) If you print to a square (row, right) on the right margin, the cursor
# position depends on whether 'row' is in range. If it is, the new cursor
# position is (row+1, 0). If it isn't, the new cursor position is (row, 0).
# Because scrolling.

container screen [
  num-rows:num
  num-columns:num
  cursor-row:num
  cursor-column:num
  data:&:@:screen-cell  # capacity num-rows*num-columns
  pending-scroll?:bool
  top-idx:num  # index inside data that corresponds to top-left of screen
               # modified on scroll, wrapping around to the top of data
]

container screen-cell [
  contents:char
  color:num
]

def new-fake-screen w:num, h:num -> result:&:screen [
  local-scope
  load-inputs
  result <- new screen:type
  non-zero-width?:bool <- greater-than w, 0
  assert non-zero-width?, [screen can't have zero width]
  non-zero-height?:bool <- greater-than h, 0
  assert non-zero-height?, [screen can't have zero height]
  bufsize:num <- multiply w, h
  data:&:@:screen-cell <- new screen-cell:type, bufsize
  *result <- merge h/num-rows, w/num-columns, 0/cursor-row, 0/cursor-column, data, false/pending-scroll?, 0/top-idx
  result <- clear-screen result
]

def clear-screen screen:&:screen -> screen:&:screen [
  local-scope
  load-inputs
#?   stash [clear-screen]
  {
    break-if screen
    # real screen
    clear-display
    return
  }
  # fake screen
  buf:&:@:screen-cell <- get *screen, data:offset
  max:num <- length *buf
  i:num <- copy 0
  {
    done?:bool <- greater-or-equal i, max
    break-if done?
    curr:screen-cell <- merge 0/empty, 7/white
    *buf <- put-index *buf, i, curr
    i <- add i, 1
    loop
  }
  # reset cursor
  *screen <- put *screen, cursor-row:offset, 0
  *screen <- put *screen, cursor-column:offset, 0
  *screen <- put *screen, top-idx:offset, 0
]

def fake-screen-is-empty? screen:&:screen -> result:bool [
  local-scope
  load-inputs
#?   stash [fake-screen-is-empty?]
  return-unless screen, true  # do nothing for real screens
  buf:&:@:screen-cell <- get *screen, data:offset
  i:num <- copy 0
  len:num <- length *buf
  {
    done?:bool <- greater-or-equal i, len
    break-if done?
    curr:screen-cell <- index *buf, i
    curr-contents:char <- get curr, contents:offset
    i <- add i, 1
    loop-unless curr-contents
    # not 0
    return false
  }
  return true
]

def print screen:&:screen, c:char -> screen:&:screen [
  local-scope
  load-inputs
  color:num, color-found?:bool <- next-input
  {
    # default color to white
    break-if color-found?
    color <- copy 7/white
  }
  bg-color:num, bg-color-found?:bool <- next-input
  {
    # default bg-color to black
    break-if bg-color-found?
    bg-color <- copy 0/black
  }
  c2:num <- character-to-code c
  trace 90, [print-character], c2
  {
    # real screen
    break-if screen
    print-character-to-display c, color, bg-color
    return
  }
  # fake screen
  # (handle special cases exactly like in the real screen)
  width:num <- get *screen, num-columns:offset
  height:num <- get *screen, num-rows:offset
  capacity:num <- multiply width, height
  row:num <- get *screen, cursor-row:offset
  column:num <- get *screen, cursor-column:offset
  buf:&:@:screen-cell <- get *screen, data:offset
  # some potentially slow sanity checks for preconditions {
  # eliminate fractions from column and row
  row <- round row
  column <- round column
  # if cursor is past left margin (error), reset to left margin
  {
    too-far-left?:bool <- lesser-than column, 0
    break-unless too-far-left?
    column <- copy 0
    *screen <- put *screen, cursor-column:offset, column
  }
  # if cursor is at or past right margin, wrap
  {
    at-right?:bool <- greater-or-equal column, width
    break-unless at-right?
    column <- copy 0
    *screen <- put *screen, cursor-column:offset, column
    row <- add row, 1
    *screen <- put *screen, cursor-row:offset, row
  }
  # }
  # if there's a pending scroll, perform it
  {
    pending-scroll?:bool <- get *screen, pending-scroll?:offset
    break-unless pending-scroll?
#?     stash [scroll]
    scroll-fake-screen screen
    *screen <- put *screen, pending-scroll?:offset, false
  }
#?     $print [print-character (], row, [, ], column, [): ], c, 10/newline
  # special-case: newline
  {
    newline?:bool <- equal c, 10/newline
    break-unless newline?
    cursor-down-on-fake-screen screen  # doesn't modify column
    return
  }
  # special-case: linefeed
  {
    linefeed?:bool <- equal c, 13/linefeed
    break-unless linefeed?
    *screen <- put *screen, cursor-column:offset, 0
    return
  }
  # special-case: backspace
  # moves cursor left but does not erase
  {
    backspace?:bool <- equal c, 8/backspace
    break-unless backspace?
    {
      break-unless column
      column <- subtract column, 1
      *screen <- put *screen, cursor-column:offset, column
    }
    return
  }
  # save character in fake screen
  top-idx:num <- get *screen, top-idx:offset
  index:num <- data-index row, column, width, height, top-idx
  cursor:screen-cell <- merge c, color
  *buf <- put-index *buf, index, cursor
  # move cursor to next character, wrapping as necessary
  # however, don't scroll just yet
  column <- add column, 1
  {
    past-right?:bool <- greater-or-equal column, width
    break-unless past-right?
    column <- copy 0
    row <- add row, 1
    past-bottom?:bool <- greater-or-equal row, height
    break-unless past-bottom?
    # queue up a scroll
#?     stash [pending scroll]
    *screen <- put *screen, pending-scroll?:offset, true
    row <- subtract row, 1  # update cursor as if scroll already happened
  }
  *screen <- put *screen, cursor-row:offset, row
  *screen <- put *screen, cursor-column:offset, column
]

def cursor-down-on-fake-screen screen:&:screen -> screen:&:screen [
  local-scope
  load-inputs
#?   stash [cursor-down]
  row:num <- get *screen, cursor-row:offset
  height:num <- get *screen, num-rows:offset
  bottom:num <- subtract height, 1
  at-bottom?:bool <- greater-or-equal row, bottom
  {
    break-if at-bottom?
    row <- add row, 1
    *screen <- put *screen, cursor-row:offset, row
  }
  {
    break-unless at-bottom?
    scroll-fake-screen screen  # does not modify row
  }
]

def scroll-fake-screen screen:&:screen -> screen:&:screen [
  local-scope
  load-inputs
#?   stash [scroll-fake-screen]
  width:num <- get *screen, num-columns:offset
  height:num <- get *screen, num-rows:offset
  buf:&:@:screen-cell <- get *screen, data:offset
  # clear top line and 'rotate' it to the bottom
  top-idx:num <- get *screen, top-idx:offset  # 0 <= top-idx < len(buf)
  next-top-idx:num <- add top-idx, width  # 0 <= next-top-idx <= len(buf)
  empty-cell:screen-cell <- merge 0/empty, 7/white
  {
    done?:bool <- greater-or-equal top-idx, next-top-idx
    break-if done?
    put-index *buf, top-idx, empty-cell
    top-idx <- add top-idx, 1
    # no modulo; top-idx is always a multiple of width,
    # so it can never wrap around inside this loop
    loop
  }
  # top-idx now same as next-top-idx; wrap around if necessary
  capacity:num <- multiply width, height
  _, top-idx <- divide-with-remainder, top-idx, capacity
  *screen <- put *screen, top-idx:offset, top-idx
]

# translate from screen (row, column) coordinates to an index into data
# while accounting for scrolling (sliding top-idx)
def data-index row:num, column:num, width:num, height:num, top-idx:num -> result:num [
  local-scope
  load-inputs
  {
    overflow?:bool <- greater-or-equal row, height
    break-unless overflow?
    row <- subtract height, 1
  }
  result <- multiply width, row
  result <- add result, column, top-idx
  capacity:num <- multiply width, height
  _, result <- divide-with-remainder result, capacity
]

scenario print-character-at-top-left [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  run [
    a:char <- copy 97/a
    fake-screen <- print fake-screen, a:char
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    1:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    1 <- 6  # width*height
    2 <- 97  # 'a'
    3 <- 7  # white
    # rest of screen is empty
    4 <- 0
  ]
]

scenario print-character-at-fractional-coordinate [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  a:char <- copy 97/a
  run [
    move-cursor fake-screen, 0.5, 0
    fake-screen <- print fake-screen, a:char
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    1:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    1 <- 6  # width*height
    2 <- 97  # 'a'
    3 <- 7  # white
    # rest of screen is empty
    4 <- 0
  ]
]

scenario print-character-in-color [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  run [
    a:char <- copy 97/a
    fake-screen <- print fake-screen, a:char, 1/red
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    1:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    1 <- 6  # width*height
    2 <- 97  # 'a'
    3 <- 1  # red
    # rest of screen is empty
    4 <- 0
  ]
]

scenario print-backspace-character [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  a:char <- copy 97/a
  fake-screen <- print fake-screen, a
  run [
    backspace:char <- copy 8/backspace
    fake-screen <- print fake-screen, backspace
    10:num/raw <- get *fake-screen, cursor-column:offset
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    11:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    10 <- 0  # cursor column
    11 <- 6  # width*height
    12 <- 97  # still 'a'
    13 <- 7  # white
    # rest of screen is empty
    14 <- 0
  ]
]

scenario print-extra-backspace-character [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  a:char <- copy 97/a
  fake-screen <- print fake-screen, a
  run [
    backspace:char <- copy 8/backspace
    fake-screen <- print fake-screen, backspace
    fake-screen <- print fake-screen, backspace  # cursor already at left margin
    1:num/raw <- get *fake-screen, cursor-column:offset
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    3:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    1 <- 0  # cursor column
    3 <- 6  # width*height
    4 <- 97  # still 'a'
    5 <- 7  # white
    # rest of screen is empty
    6 <- 0
  ]
]

scenario print-character-at-right-margin [
  # fill top row of screen with text
  local-scope
  fake-screen:&:screen <- new-fake-screen 2/width, 2/height
  a:char <- copy 97/a
  fake-screen <- print fake-screen, a
  b:char <- copy 98/b
  fake-screen <- print fake-screen, b
  run [
    # cursor now at next row
    c:char <- copy 99/c
    fake-screen <- print fake-screen, c
    10:num/raw <- get *fake-screen, cursor-row:offset
    11:num/raw <- get *fake-screen, cursor-column:offset
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    12:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    10 <- 1  # cursor row
    11 <- 1  # cursor column
    12 <- 4  # width*height
    13 <- 97  # 'a'
    14 <- 7  # white
    15 <- 98  # 'b'
    16 <- 7  # white
    17 <- 99  # 'c'
    18 <- 7  # white
    19 <- 0  # ' '
    20 <- 7  # white
  ]
]

scenario print-newline-character [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  a:char <- copy 97/a
  fake-screen <- print fake-screen, a
  run [
    newline:char <- copy 10/newline
    fake-screen <- print fake-screen, newline
    10:num/raw <- get *fake-screen, cursor-row:offset
    11:num/raw <- get *fake-screen, cursor-column:offset
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    12:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    10 <- 1  # cursor row
    11 <- 1  # cursor column
    12 <- 6  # width*height
    13 <- 97  # 'a'
    14 <- 7  # white
    # rest of screen is empty
    15 <- 0
  ]
]

scenario print-newline-at-bottom-line [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  newline:char <- copy 10/newline
  fake-screen <- print fake-screen, newline
  fake-screen <- print fake-screen, newline
  run [
    # cursor now at bottom of screen
    fake-screen <- print fake-screen, newline
    10:num/raw <- get *fake-screen, cursor-row:offset
    11:num/raw <- get *fake-screen, cursor-column:offset
  ]
  # doesn't move further down
  memory-should-contain [
    10 <- 1  # cursor row
    11 <- 0  # cursor column
  ]
]

scenario print-character-at-bottom-right [
  local-scope
  fake-screen:&:screen <- new-fake-screen 2/width, 2/height
  a:char <- copy 97/a
  fake-screen <- print fake-screen, a
  b:char <- copy 98/b
  fake-screen <- print fake-screen, b
  c:char <- copy 99/c
  fake-screen <- print fake-screen, c
  run [
    # cursor now at bottom right
    d:char <- copy 100/d
    fake-screen <- print fake-screen, d
    10:num/raw <- get *fake-screen, cursor-row:offset
    11:num/raw <- get *fake-screen, cursor-column:offset
    12:num/raw <- get *fake-screen, top-idx:offset
    13:bool/raw <- get *fake-screen, pending-scroll?:offset
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    20:@:screen-cell/raw <- copy *cell
  ]
  # cursor column wraps but the screen doesn't scroll yet
  memory-should-contain [
    10 <- 1  # cursor row
    11 <- 0  # cursor column -- outside screen
    12 <- 0  # top-idx -- not yet scrolled
    13 <- 1  # pending-scroll?
    20 <- 4  # screen size (width*height)
    21 <- 97  # 'a'
    22 <- 7  # white
    23 <- 98  # 'b'
    24 <- 7  # white
    25 <- 99 # 'c'
    26 <- 7  # white
    27 <- 100  # 'd'
    28 <- 7  # white
  ]
  run [
    e:char <- copy 101/e
    print fake-screen, e
    10:num/raw <- get *fake-screen, cursor-row:offset
    11:num/raw <- get *fake-screen, cursor-column:offset
    12:num/raw <- get *fake-screen, top-idx:offset
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    20:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    # text scrolls by 1, we lose the top line
    10 <- 1  # cursor row
    11 <- 1  # cursor column -- wrapped
    12 <- 2  # top-idx -- scrolled
    20 <- 4  # screen size (width*height)
    # screen now checked in rotated order
    25 <- 99 # 'c'
    26 <- 7  # white
    27 <- 100  # 'd'
    28 <- 7  # white
    # screen wraps; bottom line is cleared of old contents
    21 <- 101  # 'e'
    22 <- 7  # white
    23 <- 0  # unused
    24 <- 7  # white
  ]
]

# even though our screen supports scrolling, some apps may want to avoid
# scrolling
# these helpers help check for scrolling at development time
def save-top-idx screen:&:screen -> result:num [
  local-scope
  load-inputs
  return-unless screen, 0  # check is only for fake screens
  result <- get *screen, top-idx:offset
]
def assert-no-scroll screen:&:screen, old-top-idx:num [
  local-scope
  load-inputs
  return-unless screen
  new-top-idx:num <- get *screen, top-idx:offset
  no-scroll?:bool <- equal old-top-idx, new-top-idx
  assert no-scroll?, [render should never use screen's scrolling capabilities]
]

def clear-line screen:&:screen -> screen:&:screen [
  local-scope
  load-inputs
#?   stash [clear-line]
  space:char <- copy 0/nul
  {
    break-if screen
    # real screen
    clear-line-on-display
    return
  }
  # fake screen
  width:num <- get *screen, num-columns:offset
  column:num <- get *screen, cursor-column:offset
  original-column:num <- copy column
  # space over the entire line
  {
    right:num <- subtract width, 1
    done?:bool <- greater-or-equal column, right
    break-if done?
    print screen, space
    column <- add column, 1
    loop
  }
  # now back to where the cursor was
  *screen <- put *screen, cursor-column:offset, original-column
]

# only for non-scrolling apps
def clear-line-until screen:&:screen, right:num/inclusive -> screen:&:screen [
  local-scope
  load-inputs
  row:num, column:num <- cursor-position screen
#?   stash [clear-line-until] row column
  height:num <- screen-height screen
  past-bottom?:bool <- greater-or-equal row, height
  return-if past-bottom?
  space:char <- copy 32/space
  bg-color:num, bg-color-found?:bool <- next-input
  {
    # default bg-color to black
    break-if bg-color-found?
    bg-color <- copy 0/black
  }
  {
    done?:bool <- greater-than column, right
    break-if done?
    screen <- print screen, space, 7/white, bg-color  # foreground color is mostly unused except if the cursor shows up at this cell
    column <- add column, 1
    loop
  }
]

def cursor-position screen:&:screen -> row:num, column:num [
  local-scope
  load-inputs
  {
    break-if screen
    # real screen
    row, column <- cursor-position-on-display
    return
  }
  # fake screen
  row:num <- get *screen, cursor-row:offset
  column:num <- get *screen, cursor-column:offset
]

def move-cursor screen:&:screen, new-row:num, new-column:num -> screen:&:screen [
  local-scope
  load-inputs
#?   stash [move-cursor] new-row new-column
  {
    break-if screen
    # real screen
    move-cursor-on-display new-row, new-column
    return
  }
  # fake screen
  *screen <- put *screen, cursor-row:offset, new-row
  *screen <- put *screen, cursor-column:offset, new-column
  # if cursor column is within bounds, reset 'pending-scroll?'
  {
    width:num <- get *screen, num-columns:offset
    scroll?:bool <- greater-or-equal new-column, width
    break-if scroll?
#?     stash [resetting pending-scroll?]
    *screen <- put *screen, pending-scroll?:offset, false
  }
]

scenario clear-line-erases-printed-characters [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  # print a character
  a:char <- copy 97/a
  fake-screen <- print fake-screen, a
  # move cursor to start of line
  fake-screen <- move-cursor fake-screen, 0/row, 0/column
  run [
    fake-screen <- clear-line fake-screen
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    10:@:screen-cell/raw <- copy *cell
  ]
  # screen should be blank
  memory-should-contain [
    10 <- 6  # width*height
    11 <- 0
    12 <- 7
    13 <- 0
    14 <- 7
    15 <- 0
    16 <- 7
    17 <- 0
    18 <- 7
    19 <- 0
    20 <- 7
    21 <- 0
    22 <- 7
  ]
]

def cursor-down screen:&:screen -> screen:&:screen [
  local-scope
  load-inputs
#?   stash [cursor-down]
  {
    break-if screen
    # real screen
    move-cursor-down-on-display
    return
  }
  # fake screen
  cursor-down-on-fake-screen screen
]

scenario cursor-down-scrolls [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  # print something to screen and scroll
  run [
    print fake-screen, [abc]
    cursor-to-next-line fake-screen
    cursor-to-next-line fake-screen
    data:&:@:screen-cell <- get *fake-screen, data:offset
    10:@:screen-cell/raw <- copy *data
  ]
  # screen is now blank
  memory-should-contain [
    10 <- 6  # width*height
    11 <- 0
    12 <- 7  # white
    13 <- 0
    14 <- 7  # white
    15 <- 0
    16 <- 7  # white
    17 <- 0
    18 <- 7  # white
    19 <- 0
    20 <- 7  # white
    21 <- 0
    22 <- 7  # white
  ]
]

def cursor-up screen:&:screen -> screen:&:screen [
  local-scope
  load-inputs
#?   stash [cursor-up]
  {
    break-if screen
    # real screen
    move-cursor-up-on-display
    return
  }
  # fake screen
  row:num <- get *screen, cursor-row:offset
  at-top?:bool <- lesser-or-equal row, 0
  return-if at-top?
  row <- subtract row, 1
  *screen <- put *screen, cursor-row:offset, row
]

def cursor-right screen:&:screen -> screen:&:screen [
  local-scope
  load-inputs
#?   stash [cursor-right]
  {
    break-if screen
    # real screen
    move-cursor-right-on-display
    return
  }
  # fake screen
  width:num <- get *screen, num-columns:offset
  column:num <- get *screen, cursor-column:offset
  max:num <- subtract width, 1
  at-bottom?:bool <- greater-or-equal column, max
  return-if at-bottom?
  column <- add column, 1
  *screen <- put *screen, cursor-column:offset, column
]

def cursor-left screen:&:screen -> screen:&:screen [
  local-scope
  load-inputs
#?   stash [cursor-left]
  {
    break-if screen
    # real screen
    move-cursor-left-on-display
    return
  }
  # fake screen
  column:num <- get *screen, cursor-column:offset
  at-top?:bool <- lesser-or-equal column, 0
  return-if at-top?
  column <- subtract column, 1
  *screen <- put *screen, cursor-column:offset, column
]

def cursor-to-start-of-line screen:&:screen -> screen:&:screen [
  local-scope
  load-inputs
#?   stash [cursor-to-start-of-line]
  row:num <- cursor-position screen
  screen <- move-cursor screen, row, 0/column
]

def cursor-to-next-line screen:&:screen -> screen:&:screen [
  local-scope
  load-inputs
#?   stash [cursor-to-next-line]
  screen <- cursor-down screen
  screen <- cursor-to-start-of-line screen
]

def move-cursor-to-column screen:&:screen, column:num -> screen:&:screen [
  local-scope
  load-inputs
  row:num, _ <- cursor-position screen
#?   stash [move-cursor-to-column] row
  move-cursor screen, row, column
]

def screen-width screen:&:screen -> width:num [
  local-scope
  load-inputs
#?   stash [screen-width]
  {
    break-unless screen
    # fake screen
    width <- get *screen, num-columns:offset
    return
  }
  # real screen
  width <- display-width
]

def screen-height screen:&:screen -> height:num [
  local-scope
  load-inputs
#?   stash [screen-height]
  {
    break-unless screen
    # fake screen
    height <- get *screen, num-rows:offset
    return
  }
  # real screen
  height <- display-height
]

def print screen:&:screen, s:text -> screen:&:screen [
  local-scope
  load-inputs
  color:num, color-found?:bool <- next-input
  {
    # default color to white
    break-if color-found?
    color <- copy 7/white
  }
  bg-color:num, bg-color-found?:bool <- next-input
  {
    # default bg-color to black
    break-if bg-color-found?
    bg-color <- copy 0/black
  }
  len:num <- length *s
  i:num <- copy 0
  {
    done?:bool <- greater-or-equal i, len
    break-if done?
    c:char <- index *s, i
    print screen, c, color, bg-color
    i <- add i, 1
    loop
  }
]

scenario print-text-wraps-past-right-margin [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  run [
    fake-screen <- print fake-screen, [abcd]
    5:num/raw <- get *fake-screen, cursor-row:offset
    6:num/raw <- get *fake-screen, cursor-column:offset
    7:num/raw <- get *fake-screen, top-idx:offset
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    10:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    5 <- 1  # cursor-row
    6 <- 1  # cursor-column
    7 <- 0  # top-idx
    10 <- 6  # width*height
    11 <- 97  # 'a'
    12 <- 7  # white
    13 <- 98  # 'b'
    14 <- 7  # white
    15 <- 99  # 'c'
    16 <- 7  # white
    17 <- 100  # 'd'
    18 <- 7  # white
    # rest of screen is empty
    19 <- 0
  ]
]

def print screen:&:screen, n:num -> screen:&:screen [
  local-scope
  load-inputs
  color:num, color-found?:bool <- next-input
  {
    # default color to white
    break-if color-found?
    color <- copy 7/white
  }
  bg-color:num, bg-color-found?:bool <- next-input
  {
    # default bg-color to black
    break-if bg-color-found?
    bg-color <- copy 0/black
  }
  # todo: other bases besides decimal
  s:text <- to-text n
  screen <- print screen, s, color, bg-color
]

def print screen:&:screen, n:bool -> screen:&:screen [
  local-scope
  load-inputs
  color:num, color-found?:bool <- next-input
  {
    # default color to white
    break-if color-found?
    color <- copy 7/white
  }
  bg-color:num, bg-color-found?:bool <- next-input
  {
    # default bg-color to black
    break-if bg-color-found?
    bg-color <- copy 0/black
  }
  {
    break-if n
    screen <- print screen, [false], color, bg-color
  }
  {
    break-unless n
    screen <- print screen, [true], color, bg-color
  }
]

def print screen:&:screen, n:&:_elem -> screen:&:screen [
  local-scope
  load-inputs
  color:num, color-found?:bool <- next-input
  {
    # default color to white
    break-if color-found?
    color <- copy 7/white
  }
  bg-color:num, bg-color-found?:bool <- next-input
  {
    # default bg-color to black
    break-if bg-color-found?
    bg-color <- copy 0/black
  }
  n2:num <- deaddress n
  screen <- print screen, n2, color, bg-color
]