# 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 ]