about summary refs log tree commit diff stats
path: root/045closure_name.cc
blob: 83fbeede661a4955f0692dd2e44c02ec620112f2 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
//: Writing to a literal (not computed) address of 0 in a recipe chains two
//: spaces together. When a variable has a property of /space:1, it looks up
//: the variable in the chained/surrounding space. /space:2 looks up the
//: surrounding space of the surrounding space, etc.

:(scenario closure)
recipe main [
  default-space:address:array:location <- new location:type, 30:literal
  1:address:array:location/names:init-counter <- init-counter
#?   $print [AAAAAAAAAAAAAAAA]
#?   $print 1:address:array:location
  2:integer/raw <- increment-counter 1:address:array:location/names:init-counter
  3:integer/raw <- increment-counter 1:address:array:location/names:init-counter
]

recipe init-counter [
  default-space:address:array:location <- new location:type, 30:literal
  x:integer <- copy 23:literal
  y:integer <- copy 3:literal  # variable that will be incremented
  reply default-space:address:array:location
]

recipe increment-counter [
  default-space:address:array:location <- new space:literal, 30:literal
  0:address:array:location/names:init-counter <- next-ingredient  # outer space must be created by 'init-counter' above
  y:integer/space:1 <- add y:integer/space:1, 1:literal  # increment
  y:integer <- copy 234:literal  # dummy
  reply y:integer/space:1
]

+name: recipe increment-counter is surrounded by init-counter
+mem: storing 5 in location 3

//: To make this work, compute the recipe that provides names for the
//: surrounding space of each recipe. This must happen before transform_names.

:(before "End Globals")
map<recipe_number, recipe_number> Surrounding_space;

:(after "int main")
  Transform.push_back(collect_surrounding_spaces);

:(code)
void collect_surrounding_spaces(const recipe_number r) {
  for (index_t i = 0; i < Recipe[r].steps.size(); ++i) {
    const instruction& inst = Recipe[r].steps.at(i);
    if (inst.is_label) continue;
    for (index_t j = 0; j < inst.products.size(); ++j) {
      if (isa_literal(inst.products.at(j))) continue;
      if (inst.products.at(j).name != "0") continue;
      if (inst.products.at(j).types.size() != 3
          || inst.products.at(j).types.at(0) != Type_number["address"]
          || inst.products.at(j).types.at(1) != Type_number["array"]
          || inst.products.at(j).types.at(2) != Type_number["location"]) {
        raise << "slot 0 should always have type address:array:location, but is " << inst.products.at(j).to_string() << '\n';
        continue;
      }
      vector<string> s = property(inst.products.at(j), "names");
      if (s.empty())
        raise << "slot 0 requires a /names property in recipe " << Recipe[r].name << die();
      if (s.size() > 1) raise << "slot 0 should have a single value in /names, got " << inst.products.at(j).to_string() << '\n';
      string surrounding_recipe_name = s.at(0);
      if (Surrounding_space.find(r) != Surrounding_space.end()
          && Surrounding_space[r] != Recipe_number[surrounding_recipe_name]) {
        raise << "recipe " << Recipe[r].name << " can have only one 'surrounding' recipe but has " << Recipe[Surrounding_space[r]].name << " and " << surrounding_recipe_name << '\n';
        continue;
      }
      trace("name") << "recipe " << Recipe[r].name << " is surrounded by " << surrounding_recipe_name;
      Surrounding_space[r] = Recipe_number[surrounding_recipe_name];
    }
  }
}

//: Once surrounding spaces are available, transform_names uses them to handle
//: /space properties.

:(replace{} "index_t lookup_name(const reagent& r, const recipe_number default_recipe)")
index_t lookup_name(const reagent& x, const recipe_number default_recipe) {
//?   cout << "AAA " << default_recipe << " " << Recipe[default_recipe].name << '\n'; //? 2
//?   cout << "AAA " << x.to_string() << '\n'; //? 1
  if (!has_property(x, "space")) {
    if (Name[default_recipe].empty()) raise << "name not found: " << x.name << '\n' << die();
    return Name[default_recipe][x.name];
  }
  vector<string> p = property(x, "space");
  if (p.size() != 1) raise << "/space property should have exactly one (non-negative integer) value\n";
  int n = to_int(p.at(0));
  assert(n >= 0);
  recipe_number surrounding_recipe = lookup_surrounding_recipe(default_recipe, n);
  set<recipe_number> done;
  vector<recipe_number> path;
  return lookup_name(x, surrounding_recipe, done, path);
}

// If the recipe we need to lookup this name in doesn't have names done yet,
// recursively call transform_names on it.
index_t lookup_name(const reagent& x, const recipe_number r, set<recipe_number>& done, vector<recipe_number>& path) {
  if (!Name[r].empty()) return Name[r][x.name];
  if (done.find(r) != done.end()) {
    raise << "can't compute address of " << x.to_string() << " because ";
    for (index_t i = 1; i < path.size(); ++i) {
      raise << path.at(i-1) << " requires computing names of " << path.at(i) << '\n';
    }
    raise << path.at(path.size()-1) << " requires computing names of " << r << "..ad infinitum\n" << die();
    return 0;
  }
  done.insert(r);
  path.push_back(r);
  transform_names(r);  // Not passing 'done' through. Might this somehow cause an infinite loop?
  assert(!Name[r].empty());
  return Name[r][x.name];
}

recipe_number lookup_surrounding_recipe(const recipe_number r, index_t n) {
  if (n == 0) return r;
  if (Surrounding_space.find(r) == Surrounding_space.end()) {
    raise << "don't know surrounding recipe of " << Recipe[r].name << '\n';
    return 0;
  }
  assert(Surrounding_space[r]);
  return lookup_surrounding_recipe(Surrounding_space[r], n-1);
}

//: weaken use-before-set warnings just a tad
:(replace{} "bool already_transformed(const reagent& r, const map<string, index_t>& names)")
bool already_transformed(const reagent& r, const map<string, index_t>& names) {
  if (has_property(r, "space")) {
    vector<string> p = property(r, "space");
    assert(p.size() == 1);
    if (p.at(0) != "0") return true;
  }
  return names.find(r.name) != names.end();
}
/span> 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 ]