path: root/071print.mu

# Wrappers around print primitives that take a 'screen' object and are thus
# easier to test.

container screen [
  num-rows:number
  num-columns:number
  cursor-row:number
  cursor-column:number
  data:address:array:screen-cell
]

container screen-cell [
  contents:character
  color:number
]

recipe new-fake-screen [
  local-scope
  result:address:screen <- new screen:type
  width:address:number <- get-address *result, num-columns:offset
  *width <- next-ingredient
  height:address:number <- get-address *result, num-rows:offset
  *height <- next-ingredient
  row:address:number <- get-address *result, cursor-row:offset
  *row <- copy 0
  column:address:number <- get-address *result, cursor-column:offset
  *column <- copy 0
  bufsize:number <- multiply *width, *height
  buf:address:address:array:screen-cell <- get-address *result, data:offset
  *buf <- new screen-cell:type, bufsize
  clear-screen result
  reply result
]

recipe clear-screen [
  local-scope
  sc:address:screen <- next-ingredient
  # if x exists
  {
    break-unless sc
    # clear fake screen
    buf:address:array:screen-cell <- get *sc, data:offset
    max:number <- length *buf
    i:number <- copy 0
    {
      done?:boolean <- greater-or-equal i, max
      break-if done?
      curr:address:screen-cell <- index-address *buf, i
      curr-content:address:character <- get-address *curr, contents:offset
      *curr-content <- copy [ ]
      curr-color:address:character <- get-address *curr, color:offset
      *curr-color <- copy 7/white
      i <- add i, 1
      loop
    }
    # reset cursor
    x:address:number <- get-address *sc, cursor-row:offset
    *x <- copy 0
    x <- get-address *sc, cursor-column:offset
    *x <- copy 0
    reply sc/same-as-ingredient:0
  }
  # otherwise, real screen
  clear-display
  reply sc/same-as-ingredient:0
]

recipe fake-screen-is-empty? [
  local-scope
  sc:address:screen <- next-ingredient
  reply-unless sc, 1/true
  buf:address:array:screen-cell <- get *sc, data:offset
  i:number <- copy 0
  len:number <- length *buf
  {
    done?:boolean <- greater-or-equal i, len
    break-if done?
    curr:screen-cell <- index *buf, i
    curr-contents:character <- get curr, contents:offset
    i <- add i, 1
    loop-unless curr-contents
    # not 0
    reply 0/false
  }
  reply 1/true
]

recipe print-character [
  local-scope
  sc:address:screen <- next-ingredient
  c:character <- next-ingredient
  color:number, color-found?:boolean <- next-ingredient
  {
    # default color to white
    break-if color-found?
    color <- copy 7/white
  }
  bg-color:number, bg-color-found?:boolean <- next-ingredient
  {
    # default bg-color to black
    break-if bg-color-found?
    bg-color <- copy 0/black
  }
#?   trace [app], [print character] #? 1
  {
    # if x exists
    # (handle special cases exactly like in the real screen)
    break-unless sc
    width:number <- get *sc, num-columns:offset
    height:number <- get *sc, num-rows:offset
    # if cursor is out of bounds, silently exit
    row:address:number <- get-address *sc, cursor-row:offset
    legal?:boolean <- greater-or-equal *row, 0
    reply-unless legal?, sc
    legal? <- lesser-than *row, height
    reply-unless legal?, sc
    column:address:number <- get-address *sc, cursor-column:offset
    legal? <- greater-or-equal *column, 0
    reply-unless legal?, sc
    legal? <- lesser-than *column, width
    reply-unless legal?, sc
    # special-case: newline
    {
      newline?:boolean <- equal c, 10/newline
#?       $print c, [ ], newline?, 10/newline
      break-unless newline?
      {
        # unless cursor is already at bottom
        bottom:number <- subtract height, 1
        at-bottom?:boolean <- greater-or-equal *row, bottom
        break-if at-bottom?
        # move it to the next row
        *column <- copy 0
        *row <- add *row, 1
      }
      reply sc/same-as-ingredient:0
    }
    # save character in fake screen
    index:number <- multiply *row, width
    index <- add index, *column
    buf:address:array:screen-cell <- get *sc, data:offset
    len:number <- length *buf
    # special-case: backspace
    {
      backspace?:boolean <- equal c, 8
      break-unless backspace?
      {
        # unless cursor is already at left margin
        at-left?:boolean <- lesser-or-equal *column, 0
        break-if at-left?
        # clear previous location
        *column <- subtract *column, 1
        index <- subtract index, 1
        cursor:address:screen-cell <- index-address *buf, index
        cursor-contents:address:character <- get-address *cursor, contents:offset
        *cursor-contents <- copy 32/space
        cursor-color:address:number <- get-address *cursor, color:offset
        *cursor-color <- copy 7/white
      }
      reply sc/same-as-ingredient:0
    }
#?     $print [saving character ], c, [ to fake screen ], cursor, 10/newline
    cursor:address:screen-cell <- index-address *buf, index
    cursor-contents:address:character <- get-address *cursor, contents:offset
    *cursor-contents <- copy c
    cursor-color:address:number <- get-address *cursor, color:offset
    *cursor-color <- copy color
    # increment column unless it's already all the way to the right
    {
      right:number <- subtract width, 1
      at-right?:boolean <- greater-or-equal *column, right
      break-if at-right?
      *column <- add *column, 1
    }
    reply sc/same-as-ingredient:0
  }
  # otherwise, real screen
  print-character-to-display c, color, bg-color
  reply sc/same-as-ingredient:0
]

scenario print-character-at-top-left [
  run [
#?     $start-tracing #? 3
    1:address:screen <- new-fake-screen 3/width, 2/height
    1:address:screen <- print-character 1:address:screen, 97  # 'a'
    2:address:array:screen-cell <- get *1:address:screen, data:offset
    3:array:screen-cell <- copy *2:address:array:screen-cell
  ]
  memory-should-contain [
    3 <- 6  # width*height
    4 <- 97  # 'a'
    5 <- 7  # white
    6 <- 0
  ]
]

scenario print-character-color [
  run [
    1:address:screen <- new-fake-screen 3/width, 2/height
    1:address:screen <- print-character 1:address:screen, 97/a, 1/red
    2:address:array:screen-cell <- get *1:address:screen, data:offset
    3:array:screen-cell <- copy *2:address:array:screen-cell
  ]
  memory-should-contain [
    3 <- 6  # width*height
    4 <- 97  # 'a'
    5 <- 1  # red
    6 <- 0
  ]
]

scenario print-backspace-character [
  run [
#?     $start-tracing #? 3
    1:address:screen <- new-fake-screen 3/width, 2/height
    1:address:screen <- print-character 1:address:screen, 97  # 'a'
    1:address:screen <- print-character 1:address:screen, 8  # backspace
    2:number <- get *1:address:screen, cursor-column:offset
    3:address:array:screen-cell <- get *1:address:screen, data:offset
    4:array:screen-cell <- copy *3:address:array:screen-cell
  ]
  memory-should-contain [
    2 <- 0  # cursor column
    4 <- 6  # width*height
    5 <- 32  # space, not 'a'
    6 <- 7  # white
    7 <- 0
  ]
]

scenario print-extra-backspace-character [
  run [
    1:address:screen <- new-fake-screen 3/width, 2/height
    1:address:screen <- print-character 1:address:screen, 97  # 'a'
    1:address:screen <- print-character 1:address:screen, 8  # backspace
    1:address:screen <- print-character 1:address:screen, 8  # backspace
    2:number <- get *1:address:screen, cursor-column:offset
    3:address:array:screen-cell <- get *1:address:screen, data:offset
    4:array:screen-cell <- copy *3:address:array:screen-cell
  ]
  memory-should-contain [
    2 <- 0  # cursor column
    4 <- 6  # width*height
    5 <- 32  # space, not 'a'
    6 <- 7  # white
    7 <- 0
  ]
]

scenario print-at-right-margin [
  run [
    1:address:screen <- new-fake-screen 2/width, 2/height
    1:address:screen <- print-character 1:address:screen, 97  # 'a'
    1:address:screen <- print-character 1:address:screen, 98  # 'b'
    1:address:screen <- print-character 1:address:screen, 99  # 'c'
    2:number <- get *1:address:screen, cursor-column:offset
    3:address:array:screen-cell <- get *1:address:screen, data:offset
    4:array:screen-cell <- copy *3:address:array:screen-cell
  ]
  memory-should-contain [
    2 <- 1  # cursor column
    4 <- 4  # width*height
    5 <- 97  # 'a'
    6 <- 7  # white
    7 <- 99  # 'c' over 'b'
    8 <- 7  # white
    9 <- 0
  ]
]

scenario print-newline-character [
  run [
#?     $start-tracing #? 3
    1:address:screen <- new-fake-screen 3/width, 2/height
    1:address:screen <- print-character 1:address:screen, 97  # 'a'
    1:address:screen <- print-character 1:address:screen, 10/newline
    2:number <- get *1:address:screen, cursor-row:offset
    3:number <- get *1:address:screen, cursor-column:offset
    4:address:array:screen-cell <- get *1:address:screen, data:offset
    5:array:screen-cell <- copy *4:address:array:screen-cell
  ]
  memory-should-contain [
    2 <- 1  # cursor row
    3 <- 0  # cursor column
    5 <- 6  # width*height
    6 <- 97  # 'a'
    7 <- 7  # white
    8 <- 0
  ]
]

scenario print-newline-at-bottom-line [
  run [
    1:address:screen <- new-fake-screen 3/width, 2/height
    1:address:screen <- print-character 1:address:screen, 10/newline
    1:address:screen <- print-character 1:address:screen, 10/newline
    1:address:screen <- print-character 1:address:screen, 10/newline
    2:number <- get *1:address:screen, cursor-row:offset
    3:number <- get *1:address:screen, cursor-column:offset
  ]
  memory-should-contain [
    2 <- 1  # cursor row
    3 <- 0  # cursor column
  ]
]

scenario print-at-bottom-right [
  run [
    1:address:screen <- new-fake-screen 2/width, 2/height
    1:address:screen <- print-character 1:address:screen, 10/newline
    1:address:screen <- print-character 1:address:screen, 97  # 'a'
    1:address:screen <- print-character 1:address:screen, 98  # 'b'
    1:address:screen <- print-character 1:address:screen, 99  # 'c'
    1:address:screen <- print-character 1:address:screen, 10/newline
    1:address:screen <- print-character 1:address:screen, 100  # 'd'
    2:number <- get *1:address:screen, cursor-row:offset
    3:number <- get *1:address:screen, cursor-column:offset
    4:address:array:screen-cell <- get *1:address:screen, data:offset
    5:array:screen-cell <- copy *4:address:array:screen-cell
  ]
  memory-should-contain [
    2 <- 1  # cursor row
    3 <- 1  # cursor column
    5 <- 4  # width*height
    6 <- 0  # unused
    7 <- 7  # white
    8 <- 0  # unused
    9 <- 7  # white
    10 <- 97 # 'a'
    11 <- 7  # white
    12 <- 100  # 'd' over 'b' and 'c' and newline
    13 <- 7  # white
    14 <- 0
  ]
]

recipe clear-line [
  local-scope
  sc:address:screen <- next-ingredient
  # if x exists, clear line in fake screen
  {
    break-unless sc
    width:number <- get *sc, num-columns:offset
    column:address:number <- get-address *sc, cursor-column:offset
    original-column:number <- copy *column
    # space over the entire line
#?     $start-tracing #? 1
    {
#?       $print *column, 10/newline
      right:number <- subtract width, 1
      done?:boolean <- greater-or-equal *column, right
      break-if done?
      print-character sc, [ ]  # implicitly updates 'column'
      loop
    }
    # now back to where the cursor was
    *column <- copy original-column
    reply sc/same-as-ingredient:0
  }
  # otherwise, real screen
  clear-line-on-display
  reply sc/same-as-ingredient:0
]

recipe cursor-position [
  local-scope
  sc:address:screen <- next-ingredient
  # if x exists, lookup cursor in fake screen
  {
    break-unless sc
    row:number <- get *sc, cursor-row:offset
    column:number <- get *sc, cursor-column:offset
    reply row, column, sc/same-as-ingredient:0
  }
  row, column <- cursor-position-on-display
  reply row, column, sc/same-as-ingredient:0
]

recipe move-cursor [
  local-scope
  sc:address:screen <- next-ingredient
  new-row:number <- next-ingredient
  new-column:number <- next-ingredient
  # if x exists, move cursor in fake screen
  {
    break-unless sc
    row:address:number <- get-address *sc, cursor-row:offset
    *row <- copy new-row
    column:address:number <- get-address *sc, cursor-column:offset
    *column <- copy new-column
    reply sc/same-as-ingredient:0
  }
  # otherwise, real screen
  move-cursor-on-display new-row, new-column
  reply sc/same-as-ingredient:0
]

scenario clear-line-erases-printed-characters [
  run [
#?     $start-tracing #? 4
    1:address:screen <- new-fake-screen 3/width, 2/height
    # print a character
    1:address:screen <- print-character 1:address:screen, 97  # 'a'
    # move cursor to start of line
    1:address:screen <- move-cursor 1:address:screen, 0/row, 0/column
    # clear line
    1:address:screen <- clear-line 1:address:screen
    2:address:array:screen-cell <- get *1:address:screen, data:offset
    3:array:screen-cell <- copy *2:address:array:screen-cell
  ]
  # screen should be blank
  memory-should-contain [
    3 <- 6  # width*height
    4 <- 0
    5 <- 7
    6 <- 0
    7 <- 7
    8 <- 0
    9 <- 7
    10 <- 0
    11 <- 7
    12 <- 0
    13 <- 7
    14 <- 0
    15 <- 7
  ]
]

recipe cursor-down [
  local-scope
  sc:address:screen <- next-ingredient
  # if x exists, move cursor in fake screen
  {
    break-unless sc
    {
      # if row < height-1
      height:number <- get *sc, num-rows:offset
      row:address:number <- get-address *sc, cursor-row:offset
      max:number <- subtract height, 1
      at-bottom?:boolean <- greater-or-equal *row, max
      break-if at-bottom?
      # row = row+1
      *row <- add *row, 1
    }
    reply sc/same-as-ingredient:0
  }
  # otherwise, real screen
  move-cursor-down-on-display
  reply sc/same-as-ingredient:0
]

recipe cursor-up [
  local-scope
  sc:address:screen <- next-ingredient
  # if x exists, move cursor in fake screen
  {
    break-unless sc
    {
      # if row > 0
      row:address:number <- get-address *sc, cursor-row:offset
      at-top?:boolean <- lesser-or-equal *row, 0
      break-if at-top?
      # row = row-1
      *row <- subtract *row, 1
    }
    reply sc/same-as-ingredient:0
  }
  # otherwise, real screen
  move-cursor-up-on-display
  reply sc/same-as-ingredient:0
]

recipe cursor-right [
  local-scope
  sc:address:screen <- next-ingredient
  # if x exists, move cursor in fake screen
  {
    break-unless sc
    {
      # if column < width-1
      width:number <- get *sc, num-columns:offset
      column:address:number <- get-address *sc, cursor-column:offset
      max:number <- subtract width, 1
      at-bottom?:boolean <- greater-or-equal *column, max
      break-if at-bottom?
      # column = column+1
      *column <- add *column, 1
    }
    reply sc/same-as-ingredient:0
  }
  # otherwise, real screen
  move-cursor-right-on-display
  reply sc/same-as-ingredient:0
]

recipe cursor-left [
  local-scope
  sc:address:screen <- next-ingredient
  # if x exists, move cursor in fake screen
  {
    break-unless sc
    {
      # if column > 0
      column:address:number <- get-address *sc, cursor-column:offset
      at-top?:boolean <- lesser-or-equal *column, 0
      break-if at-top?
      # column = column-1
      *column <- subtract *column, 1
    }
    reply sc/same-as-ingredient:0
  }
  # otherwise, real screen
  move-cursor-left-on-display
  reply sc/same-as-ingredient:0
]

recipe cursor-to-start-of-line [
  local-scope
  sc:address:screen <- next-ingredient
  row:number, _, sc <- cursor-position sc
  column:number <- copy 0
  sc <- move-cursor sc, row, column
  reply sc/same-as-ingredient:0
]

recipe cursor-to-next-line [
  local-scope
  screen:address <- next-ingredient
  screen <- cursor-down screen
  screen <- cursor-to-start-of-line screen
  reply screen/same-as-ingredient:0
]

recipe screen-width [
  local-scope
  sc:address:screen <- next-ingredient
  # if x exists, move cursor in fake screen
  {
    break-unless sc
    width:number <- get *sc, num-columns:offset
    reply width
  }
  # otherwise, real screen
  width:number <- display-width
  reply width
]

recipe screen-height [
  local-scope
  sc:address:screen <- next-ingredient
  # if x exists, move cursor in fake screen
  {
    break-unless sc
    height:number <- get *sc, num-rows:offset
    reply height
  }
  # otherwise, real screen
  height:number <- display-height
  reply height
]

recipe hide-cursor [
  local-scope
  screen:address <- next-ingredient
  # if x exists (not real display), do nothing
  {
    break-unless screen
    reply screen
  }
  # otherwise, real screen
  hide-cursor-on-display
  reply screen
]

recipe show-cursor [
  local-scope
  screen:address <- next-ingredient
  # if x exists (not real display), do nothing
  {
    break-unless screen
    reply screen
  }
  # otherwise, real screen
  show-cursor-on-display
  reply screen
]

recipe hide-screen [
  local-scope
  screen:address <- next-ingredient
  # if x exists (not real display), do nothing
  {
    break-unless screen
    reply screen
  }
  # otherwise, real screen
  hide-display
  reply screen
]

recipe show-screen [
  local-scope
  screen:address <- next-ingredient
  # if x exists (not real display), do nothing
  {
    break-unless screen
    reply screen
  }
  # otherwise, real screen
  show-display
  reply screen
]

recipe print-string [
  local-scope
  screen:address <- next-ingredient
  s:address:array:character <- next-ingredient
  color:number, color-found?:boolean <- next-ingredient
  {
    # default color to white
    break-if color-found?
    color <- copy 7/white
  }
  bg-color:number, bg-color-found?:boolean <- next-ingredient
  {
    # default bg-color to black
    break-if bg-color-found?
    bg-color <- copy 0/black
  }
  len:number <- length *s
  i:number <- copy 0
  {
    done?:boolean <- greater-or-equal i, len
    break-if done?
    c:character <- index *s, i
    print-character screen, c, color, bg-color
    i <- add i, 1
    loop
  }
  reply screen/same-as-ingredient:0
]

scenario print-string-stops-at-right-margin [
  run [
    1:address:screen <- new-fake-screen 3/width, 2/height
    2:address:array:character <- new [abcd]
    1:address:screen <- print-string 1:address:screen, 2:address:array:character
    3:address:array:screen-cell <- get *1:address:screen, data:offset
    4:array:screen-cell <- copy *3:address:array:screen-cell
  ]
  memory-should-contain [
    4 <- 6  # width*height
    5 <- 97  # 'a'
    6 <- 7  # white
    7 <- 98  # 'b'
    8 <- 7  # white
    9 <- 100  # 'd' overwrites 'c'
    10 <- 7  # white
    11 <- 0  # unused
  ]
]

recipe print-integer [
  local-scope
  screen:address <- next-ingredient
  n:number <- next-ingredient
  color:number, color-found?:boolean <- next-ingredient
  {
    # default color to white
    break-if color-found?
    color <- copy 7/white
  }
  bg-color:number, bg-color-found?:boolean <- next-ingredient
  {
    # default bg-color to black
    break-if bg-color-found?
    bg-color <- copy 0/black
  }
  # todo: other bases besides decimal
  s:address:array:character <- integer-to-decimal-string n
  print-string screen, s, color, bg-color
  reply screen/same-as-ingredient:0
]