Mu - 081print.mu

  1 # Wrappers around print primitives that take a 'screen' object and are thus
  2 # easier to test.
  3 #
  4 # Screen objects are intended to exactly mimic the behavior of traditional
  5 # terminals. Moving a cursor too far right wraps it to the next line,
  6 # scrolling if necessary. The details are subtle:
  7 #
  8 # a) Rows can take unbounded values. When printing, large values for the row
  9 # saturate to the bottom row (because scrolling).
 10 #
 11 # b) If you print to a square (row, right) on the right margin, the cursor
 12 # position depends on whether 'row' is in range. If it is, the new cursor
 13 # position is (row+1, 0). If it isn't, the new cursor position is (row, 0).
 14 pre { line-height: 125%; }
td.linenos .normal { color: inherit; background-color: transparent; padding-left: 5px; padding-right: 5px; }
span.linenos { color: inherit; background-color: transparent; padding-left: 5px; padding-right: 5px; }
td.linenos .special { color: #000000; background-color: #ffffc0; padding-left: 5px; padding-right: 5px; }
span.linenos.special { color: #000000; background-color: #ffffc0; padding-left: 5px; padding-right: 5px; }
.highlight .hll { background-color: #ffffcc }
.highlight .c { color: #888888 } /* Comment */
.highlight .err { color: #a61717; background-color: #e3d2d2 } /* Error */
.highlight .k { color: #008800; font-weight: bold } /* Keyword */
.highlight .ch { color: #888888 } /* Comment.Hashbang */
.highlight .cm { color: #888888 } /* Comment.Multiline */
.highlight .cp { color: #cc0000; font-weight: bold } /* Comment.Preproc */
.highlight .cpf { color: #888888 } /* Comment.PreprocFile */
.highlight .c1 { color: #888888 } /* Comment.Single */
.highlight .cs { color: #cc0000; font-weight: bold; background-color: #fff0f0 } /* Comment.Special */
.highlight .gd { color: #000000; background-color: #ffdddd } /* Generic.Deleted */
.highlight .ge { font-style: italic } /* Generic.Emph */
.highlight .ges { font-weight: bold; font-style: italic } /* Generic.EmphStrong */
.highlight .gr { color: #aa0000 } /* Generic.Error */
.highlight .gh { color: #333333 } /* Generic.Heading */
.highlight .gi { color: #000000; background-color: #ddffdd } /* Generic.Inserted */
.highlight .go { color: #888888 } /* Generic.Output */
.highlight .gp { color: #555555 } /* Generic.Prompt */
.highlight .gs { font-weight: bold } /* Generic.Strong */
.highlight .gu { color: #666666 } /* Generic.Subheading */
.highlight .gt { color: #aa0000 } /* Generic.Traceback */
.highlight .kc { color: #008800; font-weight: bold } /* Keyword.Constant */
.highlight .kd { color: #008800; font-weight: bold } /* Keyword.Declaration */
.highlight .kn { color: #008800; font-weight: bold } /* Keyword.Namespace */
.highlight .kp { color: #008800 } /* Keyword.Pseudo */
.highlight .kr { color: #008800; font-weight: bold } /* Keyword.Reserved */
.highlight .kt { color: #888888; font-weight: bold } /* Keyword.Type */
.highlight .m { color: #0000DD; font-weight: bold } /* Literal.Number */
.highlight .s { color: #dd2200; background-color: #fff0f0 } /* Literal.String */
.highlight .na { color: #336699 } /* Name.Attribute */
.highlight .nb { color: #003388 } /* Name.Builtin */
.highlight .nc { color: #bb0066; font-weight: bold } /* Name.Class */
.highlight .no { color: #003366; font-weight: bold } /* Name.Constant */
.highlight .nd { color: #555555 } /* Name.Decorator */
.highlight .ne { color: #bb0066; font-weight: bold } /* Name.Exception */
.highlight .nf { color: #0066bb; font-weight: bold } /* Name.Function */
.highlight .nl { color: #336699; font-style: italic } /* Name.Label */
.highlight .nn { color: #bb0066; font-weight: bold } /* Name.Namespace */
.highlight .py { color: #336699; font-weight: bold } /* Name.Property */
.highlight .nt { color: #bb0066; font-weight: bold } /* Name.Tag */
.highlight .nv { color: #336699 } /* Name.Variable */
.highlight .ow { color: #008800 } /* Operator.Word */
.highlight .w { color: #bbbbbb } /* Text.Whitespace */
.highlight .mb { color: #0000DD; font-weight: bold } /* Literal.Number.Bin */
.highlight .mf { color: #0000DD; font-weight: bold } /* Literal.Number.Float */
.highlight .mh { color: #0000DD; font-weight: bold } /* Literal.Number.Hex */
.highlight .mi { color: #0000DD; font-weight: bold } /* Literal.Number.Integer */
.highlight .mo { color: #0000DD; font-weight: bold } /* Literal.Number.Oct */
.highlight .sa { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Affix */
.highlight .sb { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Backtick */
.highlight .sc { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Char */
.highlight .dl { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Delimiter */
.highlight .sd { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Doc */
.highlight .s2 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Double */
.highlight .se { color: #0044dd; background-color: #fff0f0 } /* Literal.String.Escape */
.highlight .sh { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Heredoc */
.highlight .si { color: #3333bb; background-color: #fff0f0 } /* Literal.String.Interpol */
.highlight .sx { color: #22bb22; background-color: #f0fff0 } /* Literal.String.Other */
.highlight .sr { color: #008800; background-color: #fff0ff } /* Literal.String.Regex */
.highlight .s1 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Single */
.highlight .ss { color: #aa6600; background-color: #fff0f0 } /* Literal.String.Symbol */
.highlight .bp { color: #003388 } /* Name.Builtin.Pseudo */
.highlight .fm { color: #0066bb; font-weight: bold } /* Name.Function.Magic */
.highlight .vc { color: #336699 } /* Name.Variable.Class */
.highlight .vg { color: #dd7700 } /* Name.Variable.Global */
.highlight .vi { color: #3333bb } /* Name.Variable.Instance */
.highlight .vm { color: #336699 } /* Name.Variable.Magic */
.highlight .il { color: #0000DD; font-weight: bold } /* Literal.Number.Integer.Long */discard """
  output: "hello"
"""

import UpperCased

# stress normalization rules:
echo Upper_Cased.str

70 *screen <- put *screen, cursor-column:offset, 0 71 *screen <- put *screen, top-idx:offset, 0 72 ] 73 74 def fake-screen-is-empty? screen:&:screen -> result:bool [ 75 local-scope 76 load-inputs 77 #? stash [fake-screen-is-empty?] 78 return-unless screen, true # do nothing for real screens 79 buf:&:@:screen-cell <- get *screen, data:offset 80 i:num <- copy 0 81 len:num <- length *buf 82 { 83 done?:bool <- greater-or-equal i, len 84 break-if done? 85 curr:screen-cell <- index *buf, i 86 curr-contents:char <- get curr, contents:offset 87 i <- add i, 1 88 loop-unless curr-contents 89 # not 0 90 return false 91 } 92 return true 93 ] 94 95 def print screen:&:screen, c:char -> screen:&:screen [ 96 local-scope 97 load-inputs 98 color:num, color-found?:bool <- next-input 99 { 100 # default color to white 101 break-if color-found? 102 color <- copy 7/white 103 } 104 bg-color:num, bg-color-found?:bool <- next-input 105 { 106 # default bg-color to black 107 break-if bg-color-found? 108 bg-color <- copy 0/black 109 } 110 c2:num <- character-to-code c 111 trace 90, [print-character], c2 112 { 113 # real screen 114 break-if screen 115 print-character-to-display c, color, bg-color 116 return 117 } 118 # fake screen 119 # (handle special cases exactly like in the real screen) 120 width:num <- get *screen, num-columns:offset 121 height:num <- get *screen, num-rows:offset 122 capacity:num <- multiply width, height 123 row:num <- get *screen, cursor-row:offset 124 column:num <- get *screen, cursor-column:offset 125 buf:&:@:screen-cell <- get *screen, data:offset 126 # some potentially slow sanity checks for preconditions { 127 # eliminate fractions from column and row 128 row <- round row 129 column <- round column 130 # if cursor is past left margin (error), reset to left margin 131 { 132 too-far-left?:bool <- lesser-than column, 0 133 break-unless too-far-left? 134 column <- copy 0 135 *screen <- put *screen, cursor-column:offset, column 136 } 137 # if cursor is at or past right margin, wrap 138 { 139 at-right?:bool <- greater-or-equal column, width 140 break-unless at-right? 141 column <- copy 0 142 *screen <- put *screen, cursor-column:offset, column 143 row <- add row, 1 144 *screen <- put *screen, cursor-row:offset, row 145 } 146 # } 147 # if there's a pending scroll, perform it 148 { 149 pending-scroll?:bool <- get *screen, pending-scroll?:offset 150 break-unless pending-scroll? 151 #? stash [scroll] 152 scroll-fake-screen screen 153 *screen <- put *screen, pending-scroll?:offset, false 154 } 155 #? $print [print-character (], row, [, ], column, [): ], c, 10/newline 156 # special-case: newline 157 { 158 newline?:bool <- equal c, 10/newline 159 break-unless newline? 160 cursor-down-on-fake-screen screen # doesn't modify column 161 return 162 } 163 # special-case: linefeed 164 { 165 linefeed?:bool <- equal c, 13/linefeed 166 break-unless linefeed? 167 *screen <- put *screen, cursor-column:offset, 0 168 return 169 } 170 # special-case: backspace 171 # moves cursor left but does not erase 172 { 173 backspace?:bool <- equal c, 8/backspace 174 break-unless backspace? 175 { 176 break-unless column 177 column <- subtract column, 1 178 *screen <- put *screen, cursor-column:offset, column 179 } 180 return 181 } 182 # save character in fake screen 183 top-idx:num <- get *screen, top-idx:offset 184 index:num <- data-index row, column, width, height, top-idx 185 cursor:screen-cell <- merge c, color 186 *buf <- put-index *buf, index, cursor 187 # move cursor to next character, wrapping as necessary 188 # however, don't scroll just yet 189 column <- add column, 1 190 { 191 past-right?:bool <- greater-or-equal column, width 192 break-unless past-right? 193 column <- copy 0 194 row <- add row, 1 195 past-bottom?:bool <- greater-or-equal row, height 196 break-unless past-bottom? 197 # queue up a scroll 198 #? stash [pending scroll] 199 *screen <- put *screen, pending-scroll?:offset, true 200 row <- subtract row, 1 # update cursor as if scroll already happened 201 } 202 *screen <- put *screen, cursor-row:offset, row 203 *screen <- put *screen, cursor-column:offset, column 204 ] 205 206 def cursor-down-on-fake-screen screen:&:screen -> screen:&:screen [ 207 local-scope 208 load-inputs 209 #? stash [cursor-down] 210 row:num <- get *screen, cursor-row:offset 211 height:num <- get *screen, num-rows:offset 212 bottom:num <- subtract height, 1 213 at-bottom?:bool <- greater-or-equal row, bottom 214 { 215 break-if at-bottom? 216 row <- add row, 1 217 *screen <- put *screen, cursor-row:offset, row 218 } 219 { 220 break-unless at-bottom? 221 scroll-fake-screen screen # does not modify row 222 } 223 ] 224 225 def scroll-fake-screen screen:&:screen -> screen:&:screen [ 226 local-scope 227 load-inputs 228 #? stash [scroll-fake-screen] 229 width:num <- get *screen, num-columns:offset 230 height:num <- get *screen, num-rows:offset 231 buf:&:@:screen-cell <- get *screen, data:offset 232 # clear top line and 'rotate' it to the bottom 233 top-idx:num <- get *screen, top-idx:offset # 0 <= top-idx < len(buf) 234 next-top-idx:num <- add top-idx, width # 0 <= next-top-idx <= len(buf) 235 empty-cell:screen-cell <- merge 0/empty, 7/white 236 { 237 done?:bool <- greater-or-equal top-idx, next-top-idx 238 break-if done? 239 put-index *buf, top-idx, empty-cell 240 top-idx <- add top-idx, 1 241 # no modulo; top-idx is always a multiple of width, 242 # so it can never wrap around inside this loop 243 loop 244 } 245 # top-idx now same as next-top-idx; wrap around if necessary 246 capacity:num <- multiply width, height 247 _, top-idx <- divide-with-remainder, top-idx, capacity 248 *screen <- put *screen, top-idx:offset, top-idx 249 ] 250 251 # translate from screen (row, column) coordinates to an index into data 252 # while accounting for scrolling (sliding top-idx) 253 def data-index row:num, column:num, width:num, height:num, top-idx:num -> result:num [ 254 local-scope 255 load-inputs 256 { 257 overflow?:bool <- greater-or-equal row, height 258 break-unless overflow? 259 row <- subtract height, 1 260 } 261 result <- multiply width, row 262 result <- add result, column, top-idx 263 capacity:num <- multiply width, height 264 _, result <- divide-with-remainder result, capacity 265 ] 266 267 scenario print-character-at-top-left [ 268 local-scope 269 fake-screen:&:screen <- new-fake-screen 3/width, 2/height 270 run [ 271 a:char <- copy 97/a 272 fake-screen <- print fake-screen, a:char 273 cell:&:@:screen-cell <- get *fake-screen, data:offset 274 1:@:screen-cell/raw <- copy *cell 275 ] 276 memory-should-contain [ 277 1 <- 6 # width*height 278 2 <- 97 # 'a' 279 3 <- 7 # white 280 # rest of screen is empty 281 4 <- 0 282 ] 283 ] 284 285 scenario print-character-at-fractional-coordinate [ 286 local-scope 287 fake-screen:&:screen <- new-fake-screen 3/width, 2/height 288 a:char <- copy 97/a 289 run [ 290 move-cursor fake-screen, 0.5, 0 291 fake-screen <- print fake-screen, a:char 292 cell:&:@:screen-cell <- get *fake-screen, data:offset 293 1:@:screen-cell/raw <- copy *cell 294 ] 295 memory-should-contain [ 296 1 <- 6 # width*height 297 2 <- 97 # 'a' 298 3 <- 7 # white 299 # rest of screen is empty 300 4 <- 0 301 ] 302 ] 303 304 scenario print-character-in-color [ 305 local-scope 306 fake-screen:&:screen <- new-fake-screen 3/width, 2/height 307 run [ 308 a:char <- copy 97/a 309 fake-screen <- print fake-screen, a:char, 1/red 310 cell:&:@:screen-cell <- get *fake-screen, data:offset 311 1:@:screen-cell/raw <- copy *cell 312 ] 313 memory-should-contain [ 314 1 <- 6 # width*height 315 2 <- 97 # 'a' 316 3 <- 1 # red 317 # rest of screen is empty 318 4 <- 0 319 ] 320 ] 321 322 scenario print-backspace-character [ 323 local-scope 324 fake-screen:&:screen <- new-fake-screen 3/width, 2/height 325 a:char <- copy 97/a 326 fake-screen <- print fake-screen, a 327 run [ 328 backspace:char <- copy 8/backspace 329 fake-screen <- print fake-screen, backspace 330 10:num/raw <- get *fake-screen, cursor-column:offset 331 cell:&:@:screen-cell <- get *fake-screen, data:offset 332 11:@:screen-cell/raw <- copy *cell 333 ] 334 memory-should-contain [ 335 10 <- 0 # cursor column 336 11 <- 6 # width*height 337 12 <- 97 # still 'a' 338 13 <- 7 # white 339 # rest of screen is empty 340 14 <- 0 341 ] 342 ] 343 344 scenario print-extra-backspace-character [ 345 local-scope 346 fake-screen:&:screen <- new-fake-screen 3/width, 2/height 347 a:char <- copy 97/a 348 fake-screen <- print fake-screen, a 349 run [ 350 backspace:char <- copy 8/backspace 351 fake-screen <- print fake-screen, backspace 352 fake-screen <- print fake-screen, backspace # cursor already at left margin 353 1:num/raw <- get *fake-screen, cursor-column:offset 354 cell:&:@:screen-cell <- get *fake-screen, data:offset 355 3:@:screen-cell/raw <- copy *cell 356 ] 357 memory-should-contain [ 358 1 <- 0 # cursor column 359 3 <- 6 # width*height 360 4 <- 97 # still 'a' 361 5 <- 7 # white 362 # rest of screen is empty 363 6 <- 0 364 ] 365 ] 366 367 scenario print-character-at-right-margin [ 368 # fill top row of screen with text 369 local-scope 370 fake-screen:&:screen <- new-fake-screen 2/width, 2/height 371 a:char <- copy 97/a 372 fake-screen <- print fake-screen, a 373 b:char <- copy 98/b 374 fake-screen <- print fake-screen, b 375 run [ 376 # cursor now at next row 377 c:char <- copy 99/c 378 fake-screen <- print fake-screen, c 379 10:num/raw <- get *fake-screen, cursor-row:offset 380 11:num/raw <- get *fake-screen, cursor-column:offset 381 cell:&:@:screen-cell <- get *fake-screen, data:offset 382 12:@:screen-cell/raw <- copy *cell 383 ] 384 memory-should-contain [ 385 10 <- 1 # cursor row 386 11 <- 1 # cursor column 387 12 <- 4 # width*height 388 13 <- 97 # 'a' 389 14 <- 7 # white 390 15 <- 98 # 'b' 391 16 <- 7 # white 392 17 <- 99 # 'c' 393 18 <- 7 # white 394 19 <- 0 # ' ' 395 20 <- 7 # white 396 ] 397 ] 398 399 scenario print-newline-character [ 400 local-scope 401 fake-screen:&:screen <- new-fake-screen 3/width, 2/height 402 a:char <- copy 97/a 403 fake-screen <- print fake-screen, a 404 run [ 405 newline:char <- copy 10/newline 406 fake-screen <- print fake-screen, newline 407 10:num/raw <- get *fake-screen, cursor-row:offset 408 11:num/raw <- get *fake-screen, cursor-column:offset 409 cell:&:@:screen-cell <- get *fake-screen, data:offset 410 12:@:screen-cell/raw <- copy *cell 411 ] 412 memory-should-contain [ 413 10 <- 1 # cursor row 414 11 <- 1 # cursor column 415 12 <- 6 # width*height 416 13 <- 97 # 'a' 417 14 <- 7 # white 418 # rest of screen is empty 419 15 <- 0 420 ] 421 ] 422 423 scenario print-newline-at-bottom-line [ 424 local-scope 425 fake-screen:&:screen <- new-fake-screen 3/width, 2/height 426 newline:char <- copy 10/newline 427 fake-screen <- print fake-screen, newline 428 fake-screen <- print fake-screen, newline 429 run [ 430 # cursor now at bottom of screen 431 fake-screen <- print fake-screen, newline 432 10:num/raw <- get *fake-screen, cursor-row:offset 433 11:num/raw <- get *fake-screen, cursor-column:offset 434 ] 435 # doesn't move further down 436 memory-should-contain [ 437 10 <- 1 # cursor row 438 11 <- 0 # cursor column 439 ] 440 ] 441 442 scenario print-character-at-bottom-right [ 443 local-scope 444 fake-screen:&:screen <- new-fake-screen 2/width, 2/height 445 a:char <- copy 97/a 446 fake-screen <- print fake-screen, a 447 b:char <- copy 98/b 448 fake-screen <- print fake-screen, b 449 c:char <- copy 99/c 450 fake-screen <- print fake-screen, c 451 run [ 452 # cursor now at bottom right 453 d:char <- copy 100/d 454 fake-screen <- print fake-screen, d 455 10:num/raw <- get *fake-screen, cursor-row:offset 456 11:num/raw <- get *fake-screen, cursor-column:offset 457 12:num/raw <- get *fake-screen, top-idx:offset 458 13:bool/raw <- get *fake-screen, pending-scroll?:offset 459 cell:&:@:screen-cell <- get *fake-screen, data:offset 460 20:@:screen-cell/raw <- copy *cell 461 ] 462 # cursor column wraps but the screen doesn't scroll yet 463 memory-should-contain [ 464 10 <- 1 # cursor row 465 11 <- 0 # cursor column -- outside screen 466 12 <- 0 # top-idx -- not yet scrolled 467 13 <- 1 # pending-scroll? 468 20 <- 4 # screen size (width*height) 469 21 <- 97 # 'a' 470 22 <- 7 # white 471 23 <- 98 # 'b' 472 24 <- 7 # white 473 25 <- 99 # 'c' 474 26 <- 7 # white 475 27 <- 100 # 'd' 476 28 <- 7 # white 477 ] 478 run [ 479 e:char <- copy 101/e 480 print fake-screen, e 481 10:num/raw <- get *fake-screen, cursor-row:offset 482 11:num/raw <- get *fake-screen, cursor-column:offset 483 12:num/raw <- get *fake-screen, top-idx:offset 484 cell:&:@:screen-cell <- get *fake-screen, data:offset 485 20:@:screen-cell/raw <- copy *cell 486 ] 487 memory-should-contain [ 488 # text scrolls by 1, we lose the top line 489 10 <- 1 # cursor row 490 11 <- 1 # cursor column -- wrapped 491 12 <- 2 # top-idx -- scrolled 492 20 <- 4 # screen size (width*height) 493 # screen now checked in rotated order 494 25 <- 99 # 'c' 495 26 <- 7 # white 496 27 <- 100 # 'd' 497 28 <- 7 # white 498 # screen wraps; bottom line is cleared of old contents 499 21 <- 101 # 'e' 500 22 <- 7 # white 501 23 <- 0 # unused 502 24 <- 7 # white 503 ] 504 ] 505 506 # even though our screen supports scrolling, some apps may want to avoid 507 # scrolling 508 # these helpers help check for scrolling at development time 509 def save-top-idx screen:&:screen -> result:num [ 510 local-scope 511 load-inputs 512 return-unless screen, 0 # check is only for fake screens 513 result <- get *screen, top-idx:offset 514 ] 515 def assert-no-scroll screen:&:screen, old-top-idx:num [ 516 local-scope 517 load-inputs 518 return-unless screen 519 new-top-idx:num <- get *screen, top-idx:offset 520 no-scroll?:bool <- equal old-top-idx, new-top-idx 521 assert no-scroll?, [render should never use screen's scrolling capabilities] 522 ] 523 524 def clear-line screen:&:screen -> screen:&:screen [ 525 local-scope 526 load-inputs 527 #? stash [clear-line] 528 space:char <- copy 0/nul 529 { 530 break-if screen 531 # real screen 532 clear-line-on-display 533 return 534 } 535 # fake screen 536 width:num <- get *screen, num-columns:offset 537 column:num <- get *screen, cursor-column:offset 538 original-column:num <- copy column 539 # space over the entire line 540 { 541 right:num <- subtract width, 1 542 done?:bool <- greater-or-equal column, right 543 break-if done? 544 print screen, space 545 column <- add column, 1 546 loop 547 } 548 # now back to where the cursor was 549 *screen <- put *screen, cursor-column:offset, original-column 550 ] 551 552 # only for non-scrolling apps 553 def clear-line-until screen:&:screen, right:num/inclusive -> screen:&:screen [ 554 local-scope 555 load-inputs 556 row:num, column:num <- cursor-position screen 557 #? stash [clear-line-until] row column 558 height:num <- screen-height screen 559 past-bottom?:bool <- greater-or-equal row, height 560 return-if past-bottom? 561 space:char <- copy 32/space 562 bg-color:num, bg-color-found?:bool <- next-input 563 { 564 # default bg-color to black 565 break-if bg-color-found? 566 bg-color <- copy 0/black 567 } 568 { 569 done?:bool <- greater-than column, right 570 break-if done? 571 screen <- print screen, space, 7/white, bg-color # foreground color is mostly unused except if the cursor shows up at this cell 572 column <- add column, 1 573 loop 574 } 575 ] 576 577 def cursor-position screen:&:screen -> row:num, column:num [ 578 local-scope 579 load-inputs 580 { 581 break-if screen 582 # real screen 583 row, column <- cursor-position-on-display 584 return 585 } 586 # fake screen 587 row:num <- get *screen, cursor-row:offset 588 column:num <- get *screen, cursor-column:offset 589 ] 590 591 def move-cursor screen:&:screen, new-row:num, new-column:num -> screen:&:screen [ 592 local-scope 593 load-inputs 594 #? stash [move-cursor] new-row new-column 595 { 596 break-if screen 597 # real screen 598 move-cursor-on-display new-row, new-column 599 return 600 } 601 # fake screen 602 *screen <- put *screen, cursor-row:offset, new-row 603 *screen <- put *screen, cursor-column:offset, new-column 604 # if cursor column is within bounds, reset 'pending-scroll?' 605 { 606 width:num <- get *screen, num-columns:offset 607 scroll?:bool <- greater-or-equal new-column, width 608 break-if scroll? 609 #? stash [resetting pending-scroll?] 610 *screen <- put *screen, pending-scroll?:offset, false 611 } 612 ] 613 614 scenario clear-line-erases-printed-characters [ 615 local-scope 616 fake-screen:&:screen <- new-fake-screen 3/width, 2/height 617 # print a character 618 a:char <- copy 97/a 619 fake-screen <- print fake-screen, a 620 # move cursor to start of line 621 fake-screen <- move-cursor fake-screen, 0/row, 0/column 622 run [ 623 fake-screen <- clear-line fake-screen 624 cell:&:@:screen-cell <- get *fake-screen, data:offset 625 10:@:screen-cell/raw <- copy *cell 626 ] 627 # screen should be blank 628 memory-should-contain [ 629 10 <- 6 # width*height 630 11 <- 0 631 12 <- 7 632 13 <- 0 633 14 <- 7 634 15 <- 0 635 16 <- 7 636 17 <- 0 637 18 <- 7 638 19 <- 0 639 20 <- 7 640 21 <- 0 641 22 <- 7 642 ] 643 ] 644 645 def cursor-down screen:&:screen -> screen:&:screen [ 646 local-scope 647 load-inputs 648 #? stash [cursor-down] 649 { 650 break-if screen 651 # real screen 652 move-cursor-down-on-display 653 return 654 } 655 # fake screen 656 cursor-down-on-fake-screen screen 657 ] 658 659 scenario cursor-down-scrolls [ 660 local-scope 661 fake-screen:&:screen <- new-fake-screen 3/width, 2/height 662 # print something to screen and scroll 663 run [ 664 print fake-screen, [abc] 665 cursor-to-next-line fake-screen 666 cursor-to-next-line fake-screen 667 data:&:@:screen-cell <- get *fake-screen, data:offset 668 10:@:screen-cell/raw <- copy *data 669 ] 670 # screen is now blank 671 memory-should-contain [ 672 10 <- 6 # width*height 673 11 <- 0 674 12 <- 7 # white 675 13 <- 0 676 14 <- 7 # white 677 15 <- 0 678 16 <- 7 # white 679 17 <- 0 680 18 <- 7 # white 681 19 <- 0 682 20 <- 7 # white 683 21 <- 0 684 22 <- 7 # white 685 ] 686 ] 687 688 def cursor-up screen:&:screen -> screen:&:screen [ 689 local-scope 690 load-inputs 691 #? stash [cursor-up] 692 { 693 break-if screen 694 # real screen 695 move-cursor-up-on-display 696 return 697 } 698 # fake screen 699 row:num <- get *screen, cursor-row:offset 700 at-top?:bool <- lesser-or-equal row, 0 701 return-if at-top? 702 row <- subtract row, 1 703 *screen <- put *screen, cursor-row:offset, row 704 ] 705 706 def cursor-right screen:&:screen -> screen:&:screen [ 707 local-scope 708 load-inputs 709 #? stash [cursor-right] 710 { 711 break-if screen 712 # real screen 713 move-cursor-right-on-display 714 return 715 } 716 # fake screen 717 width:num <- get *screen, num-columns:offset 718 column:num <- get *screen, cursor-column:offset 719 max:num <- subtract width, 1 720 at-bottom?:bool <- greater-or-equal column, max 721 return-if at-bottom? 722 column <- add column, 1 723 *screen <- put *screen, cursor-column:offset, column 724 ] 725 726 def cursor-left screen:&:screen -> screen:&:screen [ 727 local-scope 728 load-inputs 729 #? stash [cursor-left] 730 { 731 break-if screen 732 # real screen 733 move-cursor-left-on-display 734 return 735 } 736 # fake screen 737 column:num <- get *screen, cursor-column:offset 738 at-top?:bool <- lesser-or-equal column, 0 739 return-if at-top? 740 column <- subtract column, 1 741 *screen <- put *screen, cursor-column:offset, column 742 ] 743 744 def cursor-to-start-of-line screen:&:screen -> screen:&:screen [ 745 local-scope 746 load-inputs 747 #? stash [cursor-to-start-of-line] 748 row:num <- cursor-position screen 749 screen <- move-cursor screen, row, 0/column 750 ] 751 752 def cursor-to-next-line screen:&:screen -> screen:&:screen [ 753 local-scope 754 load-inputs 755 #? stash [cursor-to-next-line] 756 screen <- cursor-down screen 757 screen <- cursor-to-start-of-line screen 758 ] 759 760 def move-cursor-to-column screen:&:screen, column:num -> screen:&:screen [ 761 local-scope 762 load-inputs 763 row:num, _ <- cursor-position screen 764 #? stash [move-cursor-to-column] row 765 move-cursor screen, row, column 766 ] 767 768 def screen-width screen:&:screen -> width:num [ 769 local-scope 770 load-inputs 771 #? stash [screen-width] 772 { 773 break-unless screen 774 # fake screen 775 width <- get *screen, num-columns:offset 776 return 777 } 778 # real screen 779 width <- display-width 780 ] 781 782 def screen-height screen:&:screen -> height:num [ 783 local-scope 784 load-inputs 785 #? stash [screen-height] 786 { 787 break-unless screen 788 # fake screen 789 height <- get *screen, num-rows:offset 790 return 791 } 792 # real screen 793 height <- display-height 794 ] 795 796 def print screen:&:screen, s:text -> screen:&:screen [ 797 local-scope 798 load-inputs 799 color:num, color-found?:bool <- next-input 800 { 801 # default color to white 802 break-if color-found? 803 color <- copy 7/white 804 } 805 bg-color:num, bg-color-found?:bool <- next-input 806 { 807 # default bg-color to black 808 break-if bg-color-found? 809 bg-color <- copy 0/black 810 } 811 len:num <- length *s 812 i:num <- copy 0 813 { 814 done?:bool <- greater-or-equal i, len 815 break-if done? 816 c:char <- index *s, i 817 print screen, c, color, bg-color 818 i <- add i, 1 819 loop 820 } 821 ] 822 823 scenario print-text-wraps-past-right-margin [ 824 local-scope 825 fake-screen:&:screen <- new-fake-screen 3/width, 2/height 826 run [ 827 fake-screen <- print fake-screen, [abcd] 828 5:num/raw <- get *fake-screen, cursor-row:offset 829 6:num/raw <- get *fake-screen, cursor-column:offset 830 7:num/raw <- get *fake-screen, top-idx:offset 831 cell:&:@:screen-cell <- get *fake-screen, data:offset 832 10:@:screen-cell/raw <- copy *cell 833 ] 834 memory-should-contain [ 835 5 <- 1 # cursor-row 836 6 <- 1 # cursor-column 837 7 <- 0 # top-idx 838 10 <- 6 # width*height 839 11 <- 97 # 'a' 840 12 <- 7 # white 841 13 <- 98 # 'b' 842 14 <- 7 # white 843 15 <- 99 # 'c' 844 16 <- 7 # white 845 17 <- 100 # 'd' 846 18 <- 7 # white 847 # rest of screen is empty 848 19 <- 0 849 ] 850 ] 851 852 def print screen:&:screen, n:num -> screen:&:screen [ 853 local-scope 854 load-inputs 855 color:num, color-found?:bool <- next-input 856 { 857 # default color to white 858 break-if color-found? 859 color <- copy 7/white 860 } 861 bg-color:num, bg-color-found?:bool <- next-input 862 { 863 # default bg-color to black 864 break-if bg-color-found? 865 bg-color <- copy 0/black 866 } 867 # todo: other bases besides decimal 868 s:text <- to-text n 869 screen <- print screen, s, color, bg-color 870 ] 871 872 def print screen:&:screen, n:bool -> screen:&:screen [ 873 local-scope 874 load-inputs 875 color:num, color-found?:bool <- next-input 876 { 877 # default color to white 878 break-if color-found? 879 color <- copy 7/white 880 } 881 bg-color:num, bg-color-found?:bool <- next-input 882 { 883 # default bg-color to black 884 break-if bg-color-found? 885 bg-color <- copy 0/black 886 } 887 { 888 break-if n 889 screen <- print screen, [false], color, bg-color 890 } 891 { 892 break-unless n 893 screen <- print screen, [true], color, bg-color 894 } 895 ] 896 897 def print screen:&:screen, n:&:_elem -> screen:&:screen [ 898 local-scope 899 load-inputs 900 color:num, color-found?:bool <- next-input 901 { 902 # default color to white 903 break-if color-found? 904 color <- copy 7/white 905 } 906 bg-color:num, bg-color-found?:bool <- next-input 907 { 908 # default bg-color to black 909 break-if bg-color-found? 910 bg-color <- copy 0/black 911 } 912 n2:num <- deaddress n 913 screen <- print screen, n2, color, bg-color 914 ]