1 # Wrappers for real screen primitives that can be passed a fake screen.
   2 # The tests here have been painstakingly validated against a real terminal
   3 # emulator. I believe functionality here is broadly portable across terminal
   4 # emulators.
   5 #
   6 # Remember: fake screen co-ordinates are 1-based, just like in real terminal
   7 # emulators.
   8 
   9 type screen {
  10   num-rows: int
  11   num-cols: int
  12   data: (handle array screen-cell)
  13   top-index: int  # 0-indexed
  14   cursor-row: int  # 1-indexed
  15   cursor-col: int  # 1-indexed
  16   cursor-hide?: boolean
  17   curr-attributes: screen-cell
  18 }
  19 
  20 type screen-cell {
  21   data: code-point-utf8
  22   color: int
  23   background-color: int
  24   bold?: boolean
  25   underline?: boolean
  26   reverse?: boolean
  27   blink?: boolean
  28 }
  29 
  30 fn initialize-screen screen: (addr screen), nrows: int, ncols: int {
  31   var screen-addr/esi: (addr screen) <- copy screen
  32   var tmp/eax: int <- copy 0
  33   var dest/edi: (addr int) <- copy 0
  34   # screen->num-rows = nrows
  35   dest <- get screen-addr, num-rows
  36   tmp <- copy nrows
  37   copy-to *dest, tmp
  38   # screen->num-cols = ncols
  39   dest <- get screen-addr, num-cols
  40   tmp <- copy ncols
  41   copy-to *dest, tmp
  42   # screen->data = new screen-cell[nrows*ncols]
  43   {
  44     var data-addr/edi: (addr handle array screen-cell) <- get screen-addr, data
  45     tmp <- multiply nrows
  46     populate data-addr, tmp
  47   }
  48   # screen->cursor-row = 1
  49   dest <- get screen-addr, cursor-row
  50   copy-to *dest, 1
  51   # screen->cursor-col = 1
  52   dest <- get screen-addr, cursor-col
  53   copy-to *dest, 1
  54   # screen->curr-attributes->background-color = 7  (simulate light background)
  55   var tmp2/eax: (addr screen-cell) <- get screen-addr, curr-attributes
  56   dest <- get tmp2, background-color
  57   copy-to *dest, 7
  58 }
  59 
  60 fn screen-size screen: (addr screen) -> _/eax: int, _/ecx: int {
  61   var nrows/eax: int <- copy 0
  62   var ncols/ecx: int <- copy 0
  63   compare screen, 0
  64   {
  65     break-if-!=
  66     nrows, ncols <- real-screen-size
  67     return nrows, ncols
  68   }
  69   # fake screen
  70   var screen-addr/esi: (addr screen) <- copy screen
  71   var tmp/edx: (addr int) <- get screen-addr, num-rows
  72   nrows <- copy *tmp
  73   tmp <- get screen-addr, num-cols
  74   ncols <- copy *tmp
  75   return nrows, ncols
  76 }
  77 
  78 fn clear-screen screen: (addr screen) {
  79   compare screen, 0
  80   {
  81     break-if-!=
  82     clear-real-screen
  83     return
  84   }
  85   # fake screen
  86   var space/edi: code-point-utf8 <- copy 0x20
  87   move-cursor screen, 1, 1
  88   var screen-addr/esi: (addr screen) <- copy screen
  89   var i/eax: int <- copy 1
  90   var nrows/ecx: (addr int) <- get screen-addr, num-rows
  91   {
  92     compare i, *nrows
  93     break-if->
  94     var j/edx: int <- copy 1
  95     var ncols/ebx: (addr int) <- get screen-addr, num-cols
  96     {
  97       compare j, *ncols
  98       break-if->
  99       print-code-point-utf8 screen, space
 100       j <- increment
 101       loop
 102     }
 103     i <- increment
 104     loop
 105   }
 106   move-cursor screen, 1, 1
 107 }
 108 
 109 fn move-cursor screen: (addr screen), row: int, column: int {
 110   compare screen, 0
 111   {
 112     break-if-!=
 113     move-cursor-on-real-screen row, column
 114     return
 115   }
 116   # fake screen
 117   var screen-addr/esi: (addr screen) <- copy screen
 118   # row < 0 is ignored
 119   {
 120     compare row, 0
 121     break-if->=
 122     return
 123   }
 124   # row = 0 is treated same as 1
 125   {
 126     compare row, 0
 127     break-if-!=
 128     copy-to row, 1
 129   }
 130   # row > num-rows saturates to num-rows
 131   {
 132     var nrows-addr/eax: (addr int) <- get screen-addr, num-rows
 133     var nrows/eax: int <- copy *nrows-addr
 134     compare row, nrows
 135     break-if-<=
 136     copy-to row, nrows
 137   }
 138   # column < 0 is ignored
 139   {
 140     compare column, 0
 141     break-if->=
 142     return
 143   }
 144   # column = 0 is treated same as 1
 145   {
 146     compare column, 0
 147     break-if-!=
 148     copy-to column, 1
 149   }
 150   # column > num-cols saturates to num-cols+1 (so wrapping to next row)
 151   {
 152     var ncols-addr/eax: (addr int) <- get screen-addr, num-cols
 153     var ncols/eax: int <- copy *ncols-addr
 154     compare column, ncols
 155     break-if-<=
 156     copy-to column, ncols
 157     increment column
 158   }
 159   # screen->cursor-row = row
 160   var dest/edi: (addr int) <- get screen-addr, cursor-row
 161   var src/eax: int <- copy row
 162   copy-to *dest, src
 163   # screen->cursor-col = column
 164   dest <- get screen-addr, cursor-col
 165   src <- copy column
 166   copy-to *dest, src
 167 }
 168 
 169 fn print-string screen: (addr screen), s: (addr array byte) {
 170   compare screen, 0
 171   {
 172     break-if-!=
 173     print-string-to-real-screen s
 174     return
 175   }
 176   # fake screen
 177   var stream-storage: (stream byte 0x100)
 178   var stream/esi: (addr stream byte) <- address stream-storage
 179   write stream, s
 180   print-stream screen, stream
 181 }
 182 
 183 fn print-stream _screen: (addr screen), s: (addr stream byte) {
 184   var screen/edi: (addr screen) <- copy _screen
 185   {
 186     var done?/eax: boolean <- stream-empty? s
 187     compare done?, 0
 188     break-if-!=
 189     var g/eax: code-point-utf8 <- read-code-point-utf8 s
 190     print-code-point-utf8 screen, g
 191     loop
 192   }
 193 }
 194 
 195 fn print-array-of-ints-in-decimal screen: (addr screen), _a: (addr array int) {
 196   var a/esi: (addr array int) <- copy _a
 197   var max/ecx: int <- length a
 198   var i/eax: int <- copy 0
 199   {
 200     compare i, max
 201     break-if->=
 202     {
 203       compare i, 0
 204       break-if-=
 205       print-string screen, " "
 206     }
 207     var x/ecx: (addr int) <- index a, i
 208     print-int32-decimal screen, *x
 209     i <- increment
 210     loop
 211   }
 212 }
 213 
 214 fn print-code-point-utf8 screen: (addr screen), c: code-point-utf8 {
 215   compare screen, 0
 216   {
 217     break-if-!=
 218     print-code-point-utf8-to-real-screen c
 219     return
 220   }
 221   # fake screen
 222   var screen-addr/esi: (addr screen) <- copy screen
 223   var cursor-col-addr/edx: (addr int) <- get screen-addr, cursor-col
 224   # adjust cursor if necessary
 225   # to avoid premature scrolling it's important to do this lazily, at the last possible time
 226   {
 227     # next row
 228     var num-cols-addr/ecx: (addr int) <- get screen-addr, num-cols
 229     var num-cols/ecx: int <- copy *num-cols-addr
 230     compare *cursor-col-addr, num-cols
 231     break-if-<=
 232     copy-to *cursor-col-addr, 1
 233     var cursor-row-addr/ebx: (addr int) <- get screen-addr, cursor-row
 234     increment *cursor-row-addr
 235     # scroll
 236     var num-rows-addr/eax: (addr int) <- get screen-addr, num-rows
 237     var num-rows/eax: int <- copy *num-rows-addr
 238     compare *cursor-row-addr, num-rows
 239     break-if-<=
 240     copy-to *cursor-row-addr, num-rows
 241     # if (top-index > data size) top-index = 0, otherwise top-index += num-cols
 242     $print-code-point-utf8:perform-scroll: {
 243       var top-index-addr/ebx: (addr int) <- get screen-addr, top-index
 244       var data-ah/eax: (addr handle array screen-cell) <- get screen-addr, data
 245       var data/eax: (addr array screen-cell) <- lookup *data-ah
 246       var max-index/edi: int <- length data
 247       compare *top-index-addr, max-index
 248       {
 249         break-if->=
 250         add-to *top-index-addr, num-cols
 251         break $print-code-point-utf8:perform-scroll
 252       }
 253       {
 254         break-if-<
 255         copy-to *top-index-addr, 0
 256       }
 257     }
 258   }
 259   var idx/ecx: int <- current-screen-cell-index screen-addr
 260 #?   print-string-to-real-screen "printing code-point-utf8 at screen index "
 261 #?   print-int32-hex-to-real-screen idx
 262 #?   print-string-to-real-screen ": "
 263   var data-ah/eax: (addr handle array screen-cell) <- get screen-addr, data
 264   var data/eax: (addr array screen-cell) <- lookup *data-ah
 265   var offset/ecx: (offset screen-cell) <- compute-offset data, idx
 266   var dest-cell/ecx: (addr screen-cell) <- index data, offset
 267   var src-cell/eax: (addr screen-cell) <- get screen-addr, curr-attributes
 268   copy-object src-cell, dest-cell
 269   var dest/eax: (addr code-point-utf8) <- get dest-cell, data
 270   var c2/ecx: code-point-utf8 <- copy c
 271 #?   print-code-point-utf8-to-real-screen c2
 272 #?   print-string-to-real-screen "\n"
 273   copy-to *dest, c2
 274   increment *cursor-col-addr
 275 }
 276 
 277 fn current-screen-cell-index screen-on-stack: (addr screen) -> _/ecx: int {
 278   var screen/esi: (addr screen) <- copy screen-on-stack
 279   var cursor-row-addr/ecx: (addr int) <- get screen, cursor-row
 280   var cursor-col-addr/eax: (addr int) <- get screen, cursor-col
 281   var result/ecx: int <- screen-cell-index screen, *cursor-row-addr, *cursor-col-addr
 282   return result
 283 }
 284 
 285 fn screen-cell-index screen-on-stack: (addr screen), row: int, col: int -> _/ecx: int {
 286   var screen/esi: (addr screen) <- copy screen-on-stack
 287   var num-cols-addr/eax: (addr int) <- get screen, num-cols
 288   var num-cols/eax: int <- copy *num-cols-addr
 289   var result/ecx: int <- copy row
 290   result <- subtract 1
 291   result <- multiply num-cols
 292   result <- add col
 293   result <- subtract 1
 294   # result = (result + top-index) % data length
 295   var top-index-addr/eax: (addr int) <- get screen, top-index
 296   result <- add *top-index-addr
 297   var data-ah/eax: (addr handle array screen-cell) <- get screen, data
 298   var data/eax: (addr array screen-cell) <- lookup *data-ah
 299   var max-index/eax: int <- length data
 300   compare result, max-index
 301   {
 302     break-if-<
 303     result <- subtract max-index
 304   }
 305   return result
 306 }
 307 
 308 fn screen-code-point-utf8-at screen-on-stack: (addr screen), row: int, col: int -> _/eax: code-point-utf8 {
 309   var screen-addr/esi: (addr screen) <- copy screen-on-stack
 310   var idx/ecx: int <- screen-cell-index screen-addr, row, col
 311   var result/eax: code-point-utf8 <- screen-code-point-utf8-at-idx screen-addr, idx
 312   return result
 313 }
 314 
 315 fn screen-code-point-utf8-at-idx screen-on-stack: (addr screen), idx-on-stack: int -> _/eax: code-point-utf8 {
 316   var screen-addr/esi: (addr screen) <- copy screen-on-stack
 317   var data-ah/eax: (addr handle array screen-cell) <- get screen-addr, data
 318   var data/eax: (addr array screen-cell) <- lookup *data-ah
 319   var idx/ecx: int <- copy idx-on-stack
 320   var offset/ecx: (offset screen-cell) <- compute-offset data, idx
 321   var cell/eax: (addr screen-cell) <- index data, offset
 322   var src/eax: (addr code-point-utf8) <- get cell, data
 323   return *src
 324 }
 325 
 326 fn screen-color-at screen-on-stack: (addr screen), row: int, col: int -> _/eax: int {
 327   var screen-addr/esi: (addr screen) <- copy screen-on-stack
 328   var idx/ecx: int <- screen-cell-index screen-addr, row, col
 329   var result/eax: int <- screen-color-at-idx screen-addr, idx
 330   return result
 331 }
 332 
 333 fn screen-color-at-idx screen-on-stack: (addr screen), idx-on-stack: int -> _/eax: int {
 334   var screen-addr/esi: (addr screen) <- copy screen-on-stack
 335   var data-ah/eax: (addr handle array screen-cell) <- get screen-addr, data
 336   var data/eax: (addr array screen-cell) <- lookup *data-ah
 337   var idx/ecx: int <- copy idx-on-stack
 338   var offset/ecx: (offset screen-cell) <- compute-offset data, idx
 339   var cell/eax: (addr screen-cell) <- index data, offset
 340   var src/eax: (addr int) <- get cell, color
 341   var result/eax: int <- copy *src
 342   return result
 343 }
 344 
 345 fn screen-background-color-at screen-on-stack: (addr screen), row: int, col: int -> _/eax: int {
 346   var screen-addr/esi: (addr screen) <- copy screen-on-stack
 347   var idx/ecx: int <- screen-cell-index screen-addr, row, col
 348   var result/eax: int <- screen-background-color-at-idx screen-addr, idx
 349   return result
 350 }
 351 
 352 fn screen-background-color-at-idx screen-on-stack: (addr screen), idx-on-stack: int -> _/eax: int {
 353   var screen-addr/esi: (addr screen) <- copy screen-on-stack
 354   var data-ah/eax: (addr handle array screen-cell) <- get screen-addr, data
 355   var data/eax: (addr array screen-cell) <- lookup *data-ah
 356   var idx/ecx: int <- copy idx-on-stack
 357   var offset/ecx: (offset screen-cell) <- compute-offset data, idx
 358   var cell/eax: (addr screen-cell) <- index data, offset
 359   var src/eax: (addr int) <- get cell, background-color
 360   return *src
 361 }
 362 
 363 fn screen-bold-at? screen-on-stack: (addr screen), row: int, col: int -> _/eax: boolean {
 364   var screen-addr/esi: (addr screen) <- copy screen-on-stack
 365   var idx/ecx: int <- screen-cell-index screen-addr, row, col
 366   var result/eax: boolean <- screen-bold-at-idx? screen-addr, idx
 367   return result
 368 }
 369 
 370 fn screen-bold-at-idx? screen-on-stack: (addr screen), idx-on-stack: int -> _/eax: boolean {
 371   var screen-addr/esi: (addr screen) <- copy screen-on-stack
 372   var data-ah/eax: (addr handle array screen-cell) <- get screen-addr, data
 373   var data/eax: (addr array screen-cell) <- lookup *data-ah
 374   var idx/ecx: int <- copy idx-on-stack
 375   var offset/ecx: (offset screen-cell) <- compute-offset data, idx
 376   var cell/eax: (addr screen-cell) <- index data, offset
 377   var src/eax: (addr boolean) <- get cell, bold?
 378   return *src
 379 }
 380 
 381 fn screen-underline-at? screen-on-stack: (addr screen), row: int, col: int -> _/eax: boolean {
 382   var screen-addr/esi: (addr screen) <- copy screen-on-stack
 383   var idx/ecx: int <- screen-cell-index screen-addr, row, col
 384   var result/eax: boolean <- screen-underline-at-idx? screen-addr, idx
 385   return result
 386 }
 387 
 388 fn screen-underline-at-idx? screen-on-stack: (addr screen), idx-on-stack: int -> _/eax: boolean {
 389   var screen-addr/esi: (addr screen) <- copy screen-on-stack
 390   var data-ah/eax: (addr handle array screen-cell) <- get screen-addr, data
 391   var data/eax: (addr array screen-cell) <- lookup *data-ah
 392   var idx/ecx: int <- copy idx-on-stack
 393   var offset/ecx: (offset screen-cell) <- compute-offset data, idx
 394   var cell/eax: (addr screen-cell) <- index data, offset
 395   var src/eax: (addr boolean) <- get cell, underline?
 396   return *src
 397 }
 398 
 399 fn screen-reverse-at? screen-on-stack: (addr screen), row: int, col: int -> _/eax: boolean {
 400   var screen-addr/esi: (addr screen) <- copy screen-on-stack
 401   var idx/ecx: int <- screen-cell-index screen-addr, row, col
 402   var result/eax: boolean <- screen-reverse-at-idx? screen-addr, idx
 403   return result
 404 }
 405 
 406 fn screen-reverse-at-idx? screen-on-stack: (addr screen), idx-on-stack: int -> _/eax: boolean {
 407   var screen-addr/esi: (addr screen) <- copy screen-on-stack
 408   var data-ah/eax: (addr handle array screen-cell) <- get screen-addr, data
 409   var data/eax: (addr array screen-cell) <- lookup *data-ah
 410   var idx/ecx: int <- copy idx-on-stack
 411   var offset/ecx: (offset screen-cell) <- compute-offset data, idx
 412   var cell/eax: (addr screen-cell) <- index data, offset
 413   var src/eax: (addr boolean) <- get cell, reverse?
 414   return *src
 415 }
 416 
 417 fn screen-blink-at? screen-on-stack: (addr screen), row: int, col: int -> _/eax: boolean {
 418   var screen-addr/esi: (addr screen) <- copy screen-on-stack
 419   var idx/ecx: int <- screen-cell-index screen-addr, row, col
 420   var result/eax: boolean <- screen-blink-at-idx? screen-addr, idx
 421   return result
 422 }
 423 
 424 fn screen-blink-at-idx? screen-on-stack: (addr screen), idx-on-stack: int -> _/eax: boolean {
 425   var screen-addr/esi: (addr screen) <- copy screen-on-stack
 426   var data-ah/eax: (addr handle array screen-cell) <- get screen-addr, data
 427   var data/eax: (addr array screen-cell) <- lookup *data-ah
 428   var idx/ecx: int <- copy idx-on-stack
 429   var offset/ecx: (offset screen-cell) <- compute-offset data, idx
 430   var cell/eax: (addr screen-cell) <- index data, offset
 431   var src/eax: (addr boolean) <- get cell, blink?
 432   return *src
 433 }
 434 
 435 fn print-code-point screen: (addr screen), c: code-point {
 436   var g/eax: code-point-utf8 <- to-utf8 c
 437   print-code-point-utf8 screen, g
 438 }
 439 
 440 fn print-int32-hex screen: (addr screen), n: int {
 441   compare screen, 0
 442   {
 443     break-if-!=
 444     print-int32-hex-to-real-screen n
 445     return
 446   }
 447   # fake screen
 448   var s2: (stream byte 0x100)
 449   var s2-addr/esi: (addr stream byte) <- address s2
 450   write-int32-hex s2-addr, n
 451   var screen-addr/edi: (addr screen) <- copy screen
 452   {
 453     var done?/eax: boolean <- stream-empty? s2-addr
 454     compare done?, 0
 455     break-if-!=
 456     var g/eax: code-point-utf8 <- read-code-point-utf8 s2-addr
 457     print-code-point-utf8 screen, g
 458     loop
 459   }
 460 }
 461 
 462 fn print-int32-hex-bits screen: (addr screen), n: int, bits: int {
 463   compare screen, 0
 464   {
 465     break-if-!=
 466     print-int32-hex-bits-to-real-screen n, bits
 467     return
 468   }
 469   # fake screen
 470   var s2: (stream byte 0x100)
 471   var s2-addr/esi: (addr stream byte) <- address s2
 472   write-int32-hex-bits s2-addr, n, bits
 473   var screen-addr/edi: (addr screen) <- copy screen
 474   {
 475     var done?/eax: boolean <- stream-empty? s2-addr
 476     compare done?, 0
 477     break-if-!=
 478     var g/eax: code-point-utf8 <- read-code-point-utf8 s2-addr
 479     print-code-point-utf8 screen, g
 480     loop
 481   }
 482 }
 483 
 484 fn print-int32-decimal screen: (addr screen), n: int {
 485   compare screen, 0
 486   {
 487     break-if-!=
 488     print-int32-decimal-to-real-screen n
 489     return
 490   }
 491   # fake screen
 492   var s2: (stream byte 0x100)
 493   var s2-addr/esi: (addr stream byte) <- address s2
 494   write-int32-decimal s2-addr, n
 495   var screen-addr/edi: (addr screen) <- copy screen
 496   {
 497     var done?/eax: boolean <- stream-empty? s2-addr
 498     compare done?, 0
 499     break-if-!=
 500     var g/eax: code-point-utf8 <- read-code-point-utf8 s2-addr
 501     print-code-point-utf8 screen, g
 502     loop
 503   }
 504 }
 505 
 506 fn reset-formatting screen: (addr screen) {
 507   compare screen, 0
 508   {
 509     break-if-!=
 510     reset-formatting-on-real-screen
 511     return
 512   }
 513   # fake screen
 514   var screen-addr/esi: (addr screen) <- copy screen
 515   var dest/ecx: (addr screen-cell) <- get screen-addr, curr-attributes
 516   var default-cell: screen-cell
 517   var bg/eax: (addr int) <- get default-cell, background-color
 518   copy-to *bg, 7
 519   var default-cell-addr/eax: (addr screen-cell) <- address default-cell
 520   copy-object default-cell-addr, dest
 521 }
 522 
 523 fn start-color screen: (addr screen), fg: int, bg: int {
 524   compare screen, 0
 525   {
 526     break-if-!=
 527     start-color-on-real-screen fg, bg
 528     return
 529   }
 530   # fake screen
 531   var screen-addr/esi: (addr screen) <- copy screen
 532   var attr/ecx: (addr screen-cell) <- get screen-addr, curr-attributes
 533   var dest/edx: (addr int) <- get attr, color
 534   var src/eax: int <- copy fg
 535   copy-to *dest, src
 536   var dest/edx: (addr int) <- get attr, background-color
 537   var src/eax: int <- copy bg
 538   copy-to *dest, src
 539 }
 540 
 541 fn start-bold screen: (addr screen) {
 542   compare screen, 0
 543   {
 544     break-if-!=
 545     start-bold-on-real-screen
 546     return
 547   }
 548   # fake screen
 549   var screen-addr/esi: (addr screen) <- copy screen
 550   var attr/ecx: (addr screen-cell) <- get screen-addr, curr-attributes
 551   var dest/edx: (addr boolean) <- get attr, bold?
 552   copy-to *dest, 1
 553 }
 554 
 555 fn start-underline screen: (addr screen) {
 556   compare screen, 0
 557   {
 558     break-if-!=
 559     start-underline-on-real-screen
 560     return
 561   }
 562   # fake screen
 563   var screen-addr/esi: (addr screen) <- copy screen
 564   var attr/ecx: (addr screen-cell) <- get screen-addr, curr-attributes
 565   var dest/edx: (addr boolean) <- get attr, underline?
 566   copy-to *dest, 1
 567 }
 568 
 569 fn start-reverse-video screen: (addr screen) {
 570   compare screen, 0
 571   {
 572     break-if-!=
 573     start-reverse-video-on-real-screen
 574     return
 575   }
 576   # fake screen
 577   var screen-addr/esi: (addr screen) <- copy screen
 578   var attr/ecx: (addr screen-cell) <- get screen-addr, curr-attributes
 579   var dest/edx: (addr boolean) <- get attr, reverse?
 580   copy-to *dest, 1
 581 }
 582 
 583 fn start-blinking screen: (addr screen) {
 584   compare screen, 0
 585   {
 586     break-if-!=
 587     start-blinking-on-real-screen
 588     return
 589   }
 590   # fake screen
 591   var screen-addr/esi: (addr screen) <- copy screen
 592   var attr/ecx: (addr screen-cell) <- get screen-addr, curr-attributes
 593   var dest/edx: (addr boolean) <- get attr, blink?
 594   copy-to *dest, 1
 595 }
 596 
 597 fn hide-cursor screen: (addr screen) {
 598   compare screen, 0
 599   {
 600     break-if-!=
 601     hide-cursor-on-real-screen
 602     return
 603   }
 604   # fake screen
 605   var screen-addr/esi: (addr screen) <- copy screen
 606   var hide?/ecx: (addr boolean) <- get screen-addr, cursor-hide?
 607   copy-to *hide?, 1
 608 }
 609 
 610 fn show-cursor screen: (addr screen) {
 611   compare screen, 0
 612   {
 613     break-if-!=
 614     show-cursor-on-real-screen
 615     return
 616   }
 617   # fake screen
 618   var screen-addr/esi: (addr screen) <- copy screen
 619   var hide?/ecx: (addr boolean) <- get screen-addr, cursor-hide?
 620   copy-to *hide?, 0
 621 }
 622 
 623 # validate data on screen regardless of attributes (color, bold, etc.)
 624 # Mu doesn't have multi-line strings, so we provide functions for rows or portions of rows.
 625 # Tab characters (that translate into multiple screen cells) not supported.
 626 
 627 fn check-screen-row screen: (addr screen), row-idx: int, expected: (addr array byte), msg: (addr array byte) {
 628   check-screen-row-from screen, row-idx, 1, expected, msg
 629 }
 630 
 631 fn check-screen-row-from screen-on-stack: (addr screen), row-idx: int, col-idx: int, expected: (addr array byte), msg: (addr array byte) {
 632   var screen/esi: (addr screen) <- copy screen-on-stack
 633   var idx/ecx: int <- screen-cell-index screen, row-idx, col-idx
 634   # compare 'expected' with the screen contents starting at 'idx', code-point-utf8 by code-point-utf8
 635   var e: (stream byte 0x100)
 636   var e-addr/edx: (addr stream byte) <- address e
 637   write e-addr, expected
 638   {
 639     var done?/eax: boolean <- stream-empty? e-addr
 640     compare done?, 0
 641     break-if-!=
 642     var _g/eax: code-point-utf8 <- screen-code-point-utf8-at-idx screen, idx
 643     var g/ebx: code-point-utf8 <- copy _g
 644     var expected-code-point-utf8/eax: code-point-utf8 <- read-code-point-utf8 e-addr
 645     # compare code-point-utf8s
 646     $check-screen-row-from:compare-code-point-utf8s: {
 647       # if expected-code-point-utf8 is space, null code-point-utf8 is also ok
 648       {
 649         compare expected-code-point-utf8, 0x20
 650         break-if-!=
 651         compare g, 0
 652         break-if-= $check-screen-row-from:compare-code-point-utf8s
 653       }
 654       # if (g == expected-code-point-utf8) print "."
 655       compare g, expected-code-point-utf8
 656       {
 657         break-if-!=
 658         print-string-to-real-screen "."
 659         break $check-screen-row-from:compare-code-point-utf8s
 660       }
 661       # otherwise print an error
 662       print-string-to-real-screen msg
 663       print-string-to-real-screen ": expected '"
 664       print-code-point-utf8-to-real-screen expected-code-point-utf8
 665       print-string-to-real-screen "' at ("
 666       print-int32-hex-to-real-screen row-idx
 667       print-string-to-real-screen ", "
 668       print-int32-hex-to-real-screen col-idx
 669       print-string-to-real-screen ") but observed '"
 670       print-code-point-utf8-to-real-screen g
 671       print-string-to-real-screen "'\n"
 672     }
 673     idx <- increment
 674     increment col-idx
 675     loop
 676   }
 677 }
 678 
 679 # various variants by screen-cell attribute; spaces in the 'expected' data should not match the attribute
 680 
 681 fn check-screen-row-in-color screen: (addr screen), fg: int, row-idx: int, expected: (addr array byte), msg: (addr array byte) {
 682   check-screen-row-in-color-from screen, fg, row-idx, 1, expected, msg
 683 }
 684 
 685 fn check-screen-row-in-color-from screen-on-stack: (addr screen), fg: int, row-idx: int, col-idx: int, expected: (addr array byte), msg: (addr array byte) {
 686   var screen/esi: (addr screen) <- copy screen-on-stack
 687   var idx/ecx: int <- screen-cell-index screen, row-idx, col-idx
 688   # compare 'expected' with the screen contents starting at 'idx', code-point-utf8 by code-point-utf8
 689   var e: (stream byte 0x100)
 690   var e-addr/edx: (addr stream byte) <- address e
 691   write e-addr, expected
 692   {
 693     var done?/eax: boolean <- stream-empty? e-addr
 694     compare done?, 0
 695     break-if-!=
 696     var _g/eax: code-point-utf8 <- screen-code-point-utf8-at-idx screen, idx
 697     var g/ebx: code-point-utf8 <- copy _g
 698     var _expected-code-point-utf8/eax: code-point-utf8 <- read-code-point-utf8 e-addr
 699     var expected-code-point-utf8/edi: code-point-utf8 <- copy _expected-code-point-utf8
 700     $check-screen-row-in-color-from:compare-cells: {
 701       # if expected-code-point-utf8 is space, null code-point-utf8 is also ok
 702       {
 703         compare expected-code-point-utf8, 0x20
 704         break-if-!=
 705         compare g, 0
 706         break-if-= $check-screen-row-in-color-from:compare-cells
 707       }
 708       # if expected-code-point-utf8 is space, a different color is ok
 709       {
 710         compare expected-code-point-utf8, 0x20
 711         break-if-!=
 712         var color/eax: int <- screen-color-at-idx screen, idx
 713         compare color, fg
 714         break-if-!= $check-screen-row-in-color-from:compare-cells
 715       }
 716       # compare code-point-utf8s
 717       $check-screen-row-in-color-from:compare-code-point-utf8s: {
 718         # if (g == expected-code-point-utf8) print "."
 719         compare g, expected-code-point-utf8
 720         {
 721           break-if-!=
 722           print-string-to-real-screen "."
 723           break $check-screen-row-in-color-from:compare-code-point-utf8s
 724         }
 725         # otherwise print an error
 726         print-string-to-real-screen msg
 727         print-string-to-real-screen ": expected '"
 728         print-code-point-utf8-to-real-screen expected-code-point-utf8
 729         print-string-to-real-screen "' at ("
 730         print-int32-hex-to-real-screen row-idx
 731         print-string-to-real-screen ", "
 732         print-int32-hex-to-real-screen col-idx
 733         print-string-to-real-screen ") but observed '"
 734         print-code-point-utf8-to-real-screen g
 735         print-string-to-real-screen "'\n"
 736       }
 737       $check-screen-row-in-color-from:compare-colors: {
 738         var color/eax: int <- screen-color-at-idx screen, idx
 739         compare fg, color
 740         {
 741           break-if-!=
 742           print-string-to-real-screen "."
 743           break $check-screen-row-in-color-from:compare-colors
 744         }
 745         # otherwise print an error
 746         print-string-to-real-screen msg
 747         print-string-to-real-screen ": expected '"
 748         print-code-point-utf8-to-real-screen expected-code-point-utf8
 749         print-string-to-real-screen "' at ("
 750         print-int32-hex-to-real-screen row-idx
 751         print-string-to-real-screen ", "
 752         print-int32-hex-to-real-screen col-idx
 753         print-string-to-real-screen ") in color "
 754         print-int32-hex-to-real-screen fg
 755         print-string-to-real-screen " but observed color "
 756         print-int32-hex-to-real-screen color
 757         print-string-to-real-screen "\n"
 758       }
 759     }
 760     idx <- increment
 761     increment col-idx
 762     loop
 763   }
 764 }
 765 
 766 # background color is visible even for spaces, so 'expected' behaves as an array of booleans.
 767 # non-space = given background must match; space = background must not match
 768 fn check-screen-row-in-background-color screen: (addr screen), bg: int, row-idx: int, expected: (addr array byte), msg: (addr array byte) {
 769   check-screen-row-in-background-color-from screen, bg, row-idx, 1, expected, msg
 770 }
 771 
 772 fn check-screen-row-in-background-color-from screen-on-stack: (addr screen), bg: int, row-idx: int, col-idx: int, expected: (addr array byte), msg: (addr array byte) {
 773   var screen/esi: (addr screen) <- copy screen-on-stack
 774   var idx/ecx: int <- screen-cell-index screen, row-idx, col-idx
 775   # compare 'expected' with the screen contents starting at 'idx', code-point-utf8 by code-point-utf8
 776   var e: (stream byte 0x100)
 777   var e-addr/edx: (addr stream byte) <- address e
 778   write e-addr, expected
 779   {
 780     var done?/eax: boolean <- stream-empty? e-addr
 781     compare done?, 0
 782     break-if-!=
 783     var _g/eax: code-point-utf8 <- screen-code-point-utf8-at-idx screen, idx
 784     var g/ebx: code-point-utf8 <- copy _g
 785     var _expected-code-point-utf8/eax: code-point-utf8 <- read-code-point-utf8 e-addr
 786     var expected-code-point-utf8/edx: code-point-utf8 <- copy _expected-code-point-utf8
 787     $check-screen-row-in-background-color-from:compare-cells: {
 788       # if expected-code-point-utf8 is space, null code-point-utf8 is also ok
 789       {
 790         compare expected-code-point-utf8, 0x20
 791         break-if-!=
 792         compare g, 0
 793         break-if-= $check-screen-row-in-background-color-from:compare-cells
 794       }
 795       # if expected-code-point-utf8 is space, a different color is ok
 796       {
 797         compare expected-code-point-utf8, 0x20
 798         break-if-!=
 799         var color/eax: int <- screen-background-color-at-idx screen, idx
 800         compare color, bg
 801         break-if-!= $check-screen-row-in-background-color-from:compare-cells
 802       }
 803       # compare code-point-utf8s
 804       $check-screen-row-in-background-color-from:compare-code-point-utf8s: {
 805         # if (g == expected-code-point-utf8) print "."
 806         compare g, expected-code-point-utf8
 807         {
 808           break-if-!=
 809           print-string-to-real-screen "."
 810           break $check-screen-row-in-background-color-from:compare-code-point-utf8s
 811         }
 812         # otherwise print an error
 813         print-string-to-real-screen msg
 814         print-string-to-real-screen ": expected '"
 815         print-code-point-utf8-to-real-screen expected-code-point-utf8
 816         print-string-to-real-screen "' at ("
 817         print-int32-hex-to-real-screen row-idx
 818         print-string-to-real-screen ", "
 819         print-int32-hex-to-real-screen col-idx
 820         print-string-to-real-screen ") but observed '"
 821         print-code-point-utf8-to-real-screen g
 822         print-string-to-real-screen "'\n"
 823       }
 824       $check-screen-row-in-background-color-from:compare-colors: {
 825         var color/eax: int <- screen-background-color-at-idx screen, idx
 826         compare bg, color
 827         {
 828           break-if-!=
 829           print-string-to-real-screen "."
 830           break $check-screen-row-in-background-color-from:compare-colors
 831         }
 832         # otherwise print an error
 833         print-string-to-real-screen msg
 834         print-string-to-real-screen ": expected '"
 835         print-code-point-utf8-to-real-screen expected-code-point-utf8
 836         print-string-to-real-screen "' at ("
 837         print-int32-hex-to-real-screen row-idx
 838         print-string-to-real-screen ", "
 839         print-int32-hex-to-real-screen col-idx
 840         print-string-to-real-screen ") in background color "
 841         print-int32-hex-to-real-screen bg
 842         print-string-to-real-screen " but observed color "
 843         print-int32-hex-to-real-screen color
 844         print-string-to-real-screen "\n"
 845       }
 846     }
 847     idx <- increment
 848     increment col-idx
 849     loop
 850   }
 851 }
 852 
 853 fn check-screen-row-in-bold screen: (addr screen), row-idx: int, expected: (addr array byte), msg: (addr array byte) {
 854   check-screen-row-in-bold-from screen, row-idx, 1, expected, msg
 855 }
 856 
 857 fn check-screen-row-in-bold-from screen-on-stack: (addr screen), row-idx: int, col-idx: int, expected: (addr array byte), msg: (addr array byte) {
 858   var screen/esi: (addr screen) <- copy screen-on-stack
 859   var idx/ecx: int <- screen-cell-index screen, row-idx, col-idx
 860   # compare 'expected' with the screen contents starting at 'idx', code-point-utf8 by code-point-utf8
 861   var e: (stream byte 0x100)
 862   var e-addr/edx: (addr stream byte) <- address e
 863   write e-addr, expected
 864   {
 865     var done?/eax: boolean <- stream-empty? e-addr
 866     compare done?, 0
 867     break-if-!=
 868     var _g/eax: code-point-utf8 <- screen-code-point-utf8-at-idx screen, idx
 869     var g/ebx: code-point-utf8 <- copy _g
 870     var _expected-code-point-utf8/eax: code-point-utf8 <- read-code-point-utf8 e-addr
 871     var expected-code-point-utf8/edx: code-point-utf8 <- copy _expected-code-point-utf8
 872     $check-screen-row-in-bold-from:compare-cells: {
 873       # if expected-code-point-utf8 is space, null code-point-utf8 is also ok
 874       {
 875         compare expected-code-point-utf8, 0x20
 876         break-if-!=
 877         compare g, 0
 878         break-if-= $check-screen-row-in-bold-from:compare-cells
 879       }
 880       # if expected-code-point-utf8 is space, non-bold is ok
 881       {
 882         compare expected-code-point-utf8, 0x20
 883         break-if-!=
 884         var bold?/eax: boolean <- screen-bold-at-idx? screen, idx
 885         compare bold?, 1
 886         break-if-!= $check-screen-row-in-bold-from:compare-cells
 887       }
 888       # compare code-point-utf8s
 889       $check-screen-row-in-bold-from:compare-code-point-utf8s: {
 890         # if (g == expected-code-point-utf8) print "."
 891         compare g, expected-code-point-utf8
 892         {
 893           break-if-!=
 894           print-string-to-real-screen "."
 895           break $check-screen-row-in-bold-from:compare-code-point-utf8s
 896         }
 897         # otherwise print an error
 898         print-string-to-real-screen msg
 899         print-string-to-real-screen ": expected '"
 900         print-code-point-utf8-to-real-screen expected-code-point-utf8
 901         print-string-to-real-screen "' at ("
 902         print-int32-hex-to-real-screen row-idx
 903         print-string-to-real-screen ", "
 904         print-int32-hex-to-real-screen col-idx
 905         print-string-to-real-screen ") but observed '"
 906         print-code-point-utf8-to-real-screen g
 907         print-string-to-real-screen "'\n"
 908       }
 909       $check-screen-row-in-bold-from:compare-bold: {
 910         var bold?/eax: boolean <- screen-bold-at-idx? screen, idx
 911         compare bold?, 1
 912         {
 913           break-if-!=
 914           print-string-to-real-screen "."
 915           break $check-screen-row-in-bold-from:compare-bold
 916         }
 917         # otherwise print an error
 918         print-string-to-real-screen msg
 919         print-string-to-real-screen ": expected '"
 920         print-code-point-utf8-to-real-screen expected-code-point-utf8
 921         print-string-to-real-screen "' at ("
 922         print-int32-hex-to-real-screen row-idx
 923         print-string-to-real-screen ", "
 924         print-int32-hex-to-real-screen col-idx
 925         print-string-to-real-screen ") to be in bold\n"
 926       }
 927     }
 928     idx <- increment
 929     increment col-idx
 930     loop
 931   }
 932 }
 933 
 934 fn check-screen-row-in-underline screen: (addr screen), row-idx: int, expected: (addr array byte), msg: (addr array byte) {
 935   check-screen-row-in-underline-from screen, row-idx, 1, expected, msg
 936 }
 937 
 938 fn check-screen-row-in-underline-from screen-on-stack: (addr screen), row-idx: int, col-idx: int, expected: (addr array byte), msg: (addr array byte) {
 939   var screen/esi: (addr screen) <- copy screen-on-stack
 940   var idx/ecx: int <- screen-cell-index screen, row-idx, col-idx
 941   # compare 'expected' with the screen contents starting at 'idx', code-point-utf8 by code-point-utf8
 942   var e: (stream byte 0x100)
 943   var e-addr/edx: (addr stream byte) <- address e
 944   write e-addr, expected
 945   {
 946     var done?/eax: boolean <- stream-empty? e-addr
 947     compare done?, 0
 948     break-if-!=
 949     var _g/eax: code-point-utf8 <- screen-code-point-utf8-at-idx screen, idx
 950     var g/ebx: code-point-utf8 <- copy _g
 951     var _expected-code-point-utf8/eax: code-point-utf8 <- read-code-point-utf8 e-addr
 952     var expected-code-point-utf8/edx: code-point-utf8 <- copy _expected-code-point-utf8
 953     $check-screen-row-in-underline-from:compare-cells: {
 954       # if expected-code-point-utf8 is space, null code-point-utf8 is also ok
 955       {
 956         compare expected-code-point-utf8, 0x20
 957         break-if-!=
 958         compare g, 0
 959         break-if-= $check-screen-row-in-underline-from:compare-cells
 960       }
 961       # if expected-code-point-utf8 is space, non-underline is ok
 962       {
 963         compare expected-code-point-utf8, 0x20
 964         break-if-!=
 965         var underline?/eax: boolean <- screen-underline-at-idx? screen, idx
 966         compare underline?, 1
 967         break-if-!= $check-screen-row-in-underline-from:compare-cells
 968       }
 969       # compare code-point-utf8s
 970       $check-screen-row-in-underline-from:compare-code-point-utf8s: {
 971         # if (g == expected-code-point-utf8) print "."
 972         compare g, expected-code-point-utf8
 973         {
 974           break-if-!=
 975           print-string-to-real-screen "."
 976           break $check-screen-row-in-underline-from:compare-code-point-utf8s
 977         }
 978         # otherwise print an error
 979         print-string-to-real-screen msg
 980         print-string-to-real-screen ": expected '"
 981         print-code-point-utf8-to-real-screen expected-code-point-utf8
 982         print-string-to-real-screen "' at ("
 983         print-int32-hex-to-real-screen row-idx
 984         print-string-to-real-screen ", "
 985         print-int32-hex-to-real-screen col-idx
 986         print-string-to-real-screen ") but observed '"
 987         print-code-point-utf8-to-real-screen g
 988         print-string-to-real-screen "'\n"
 989       }
 990       $check-screen-row-in-underline-from:compare-underline: {
 991         var underline?/eax: boolean <- screen-underline-at-idx? screen, idx
 992         compare underline?, 1
 993         {
 994           break-if-!=
 995           print-string-to-real-screen "."
 996           break $check-screen-row-in-underline-from:compare-underline
 997         }
 998         # otherwise print an error
 999         print-string-to-real-screen msg
1000         print-string-to-real-screen ": expected '"
1001         print-code-point-utf8-to-real-screen expected-code-point-utf8
1002         print-string-to-real-screen "' at ("
1003         print-int32-hex-to-real-screen row-idx
1004         print-string-to-real-screen ", "
1005         print-int32-hex-to-real-screen col-idx
1006         print-string-to-real-screen ") to be underlined\n"
1007       }
1008     }
1009     idx <- increment
1010     increment col-idx
1011     loop
1012   }
1013 }
1014 
1015 fn check-screen-row-in-reverse screen: (addr screen), row-idx: int, expected: (addr array byte), msg: (addr array byte) {
1016   check-screen-row-in-reverse-from screen, row-idx, 1, expected, msg
1017 }
1018 
1019 fn check-screen-row-in-reverse-from screen-on-stack: (addr screen), row-idx: int, col-idx: int, expected: (addr array byte), msg: (addr array byte) {
1020   var screen/esi: (addr screen) <- copy screen-on-stack
1021   var idx/ecx: int <- screen-cell-index screen, row-idx, col-idx
1022   # compare 'expected' with the screen contents starting at 'idx', code-point-utf8 by code-point-utf8
1023   var e: (stream byte 0x100)
1024   var e-addr/edx: (addr stream byte) <- address e
1025   write e-addr, expected
1026   {
1027     var done?/eax: boolean <- stream-empty? e-addr
1028     compare done?, 0
1029     break-if-!=
1030     var _g/eax: code-point-utf8 <- screen-code-point-utf8-at-idx screen, idx
1031     var g/ebx: code-point-utf8 <- copy _g
1032     var _expected-code-point-utf8/eax: code-point-utf8 <- read-code-point-utf8 e-addr
1033     var expected-code-point-utf8/edx: code-point-utf8 <- copy _expected-code-point-utf8
1034     $check-screen-row-in-reverse-from:compare-cells: {
1035       # if expected-code-point-utf8 is space, null code-point-utf8 is also ok
1036       {
1037         compare expected-code-point-utf8, 0x20
1038         break-if-!=
1039         compare g, 0
1040         break-if-= $check-screen-row-in-reverse-from:compare-cells
1041       }
1042       # if expected-code-point-utf8 is space, non-reverse is ok
1043       {
1044         compare expected-code-point-utf8, 0x20
1045         break-if-!=
1046         var reverse?/eax: boolean <- screen-reverse-at-idx? screen, idx
1047         compare reverse?, 1
1048         break-if-!= $check-screen-row-in-reverse-from:compare-cells
1049       }
1050       # compare code-point-utf8s
1051       $check-screen-row-in-reverse-from:compare-code-point-utf8s: {
1052         # if (g == expected-code-point-utf8) print "."
1053         compare g, expected-code-point-utf8
1054         {
1055           break-if-!=
1056           print-string-to-real-screen "."
1057           break $check-screen-row-in-reverse-from:compare-code-point-utf8s
1058         }
1059         # otherwise print an error
1060         print-string-to-real-screen msg
1061         print-string-to-real-screen ": expected '"
1062         print-code-point-utf8-to-real-screen expected-code-point-utf8
1063         print-string-to-real-screen "' at ("
1064         print-int32-hex-to-real-screen row-idx
1065         print-string-to-real-screen ", "
1066         print-int32-hex-to-real-screen col-idx
1067         print-string-to-real-screen ") but observed '"
1068         print-code-point-utf8-to-real-screen g
1069         print-string-to-real-screen "'\n"
1070       }
1071       $check-screen-row-in-reverse-from:compare-reverse: {
1072         var reverse?/eax: boolean <- screen-reverse-at-idx? screen, idx
1073         compare reverse?, 1
1074         {
1075           break-if-!=
1076           print-string-to-real-screen "."
1077           break $check-screen-row-in-reverse-from:compare-reverse
1078         }
1079         # otherwise print an error
1080         print-string-to-real-screen msg
1081         print-string-to-real-screen ": expected '"
1082         print-code-point-utf8-to-real-screen expected-code-point-utf8
1083         print-string-to-real-screen "' at ("
1084         print-int32-hex-to-real-screen row-idx
1085         print-string-to-real-screen ", "
1086         print-int32-hex-to-real-screen col-idx
1087         print-string-to-real-screen ") to be in reverse-video\n"
1088       }
1089     }
1090     idx <- increment
1091     increment col-idx
1092     loop
1093   }
1094 }
1095 
1096 fn check-screen-row-in-blinking screen: (addr screen), row-idx: int, expected: (addr array byte), msg: (addr array byte) {
1097   check-screen-row-in-blinking-from screen, row-idx, 1, expected, msg
1098 }
1099 
1100 fn check-screen-row-in-blinking-from screen-on-stack: (addr screen), row-idx: int, col-idx: int, expected: (addr array byte), msg: (addr array byte) {
1101   var screen/esi: (addr screen) <- copy screen-on-stack
1102   var idx/ecx: int <- screen-cell-index screen, row-idx, col-idx
1103   # compare 'expected' with the screen contents starting at 'idx', code-point-utf8 by code-point-utf8
1104   var e: (stream byte 0x100)
1105   var e-addr/edx: (addr stream byte) <- address e
1106   write e-addr, expected
1107   {
1108     var done?/eax: boolean <- stream-empty? e-addr
1109     compare done?, 0
1110     break-if-!=
1111     var _g/eax: code-point-utf8 <- screen-code-point-utf8-at-idx screen, idx
1112     var g/ebx: code-point-utf8 <- copy _g
1113     var _expected-code-point-utf8/eax: code-point-utf8 <- read-code-point-utf8 e-addr
1114     var expected-code-point-utf8/edx: code-point-utf8 <- copy _expected-code-point-utf8
1115     $check-screen-row-in-blinking-from:compare-cells: {
1116       # if expected-code-point-utf8 is space, null code-point-utf8 is also ok
1117       {
1118         compare expected-code-point-utf8, 0x20
1119         break-if-!=
1120         compare g, 0
1121         break-if-= $check-screen-row-in-blinking-from:compare-cells
1122       }
1123       # if expected-code-point-utf8 is space, non-blinking is ok
1124       {
1125         compare expected-code-point-utf8, 0x20
1126         break-if-!=
1127         var blinking?/eax: boolean <- screen-blink-at-idx? screen, idx
1128         compare blinking?, 1
1129         break-if-!= $check-screen-row-in-blinking-from:compare-cells
1130       }
1131       # compare code-point-utf8s
1132       $check-screen-row-in-blinking-from:compare-code-point-utf8s: {
1133         # if (g == expected-code-point-utf8) print "."
1134         compare g, expected-code-point-utf8
1135         {
1136           break-if-!=
1137           print-string-to-real-screen "."
1138           break $check-screen-row-in-blinking-from:compare-code-point-utf8s
1139         }
1140         # otherwise print an error
1141         print-string-to-real-screen msg
1142         print-string-to-real-screen ": expected '"
1143         print-code-point-utf8-to-real-screen expected-code-point-utf8
1144         print-string-to-real-screen "' at ("
1145         print-int32-hex-to-real-screen row-idx
1146         print-string-to-real-screen ", "
1147         print-int32-hex-to-real-screen col-idx
1148         print-string-to-real-screen ") but observed '"
1149         print-code-point-utf8-to-real-screen g
1150         print-string-to-real-screen "'\n"
1151       }
1152       $check-screen-row-in-blinking-from:compare-blinking: {
1153         var blinking?/eax: boolean <- screen-blink-at-idx? screen, idx
1154         compare blinking?, 1
1155         {
1156           break-if-!=
1157           print-string-to-real-screen "."
1158           break $check-screen-row-in-blinking-from:compare-blinking
1159         }
1160         # otherwise print an error
1161         print-string-to-real-screen msg
1162         print-string-to-real-screen ": expected '"
1163         print-code-point-utf8-to-real-screen expected-code-point-utf8
1164         print-string-to-real-screen "' at ("
1165         print-int32-hex-to-real-screen row-idx
1166         print-string-to-real-screen ", "
1167         print-int32-hex-to-real-screen col-idx
1168         print-string-to-real-screen ") to be blinking\n"
1169       }
1170     }
1171     idx <- increment
1172     increment col-idx
1173 
1174     loop
1175   }
1176 }
1177 
1178 fn test-print-single-code-point-utf8 {
1179   var screen-on-stack: screen
1180   var screen/esi: (addr screen) <- address screen-on-stack
1181   initialize-screen screen, 5/rows, 4/cols
1182   var c/eax: code-point-utf8 <- copy 0x61/a
1183   print-code-point-utf8 screen, c
1184   check-screen-row screen, 1/row, "a", "F - test-print-single-code-point-utf8"  # top-left corner of the screen
1185 }
1186 
1187 fn test-print-multiple-code-point-utf8s {
1188   var screen-on-stack: screen
1189   var screen/esi: (addr screen) <- address screen-on-stack
1190   initialize-screen screen, 5/rows, 4/cols
1191   print-string screen, "Hello, 世界"
1192   check-screen-row screen, 1/row, "Hello, 世界", "F - test-print-multiple-code-point-utf8s"
1193 }
1194 
1195 fn test-move-cursor {
1196   var screen-on-stack: screen
1197   var screen/esi: (addr screen) <- address screen-on-stack
1198   initialize-screen screen, 5/rows, 4/cols
1199   move-cursor screen, 1, 4
1200   var c/eax: code-point-utf8 <- copy 0x61/a
1201   print-code-point-utf8 screen, c
1202   check-screen-row screen, 1/row, "   a", "F - test-move-cursor"  # top row
1203 }
1204 
1205 fn test-move-cursor-zeroes {
1206   var screen-on-stack: screen
1207   var screen/esi: (addr screen) <- address screen-on-stack
1208   initialize-screen screen, 5/rows, 4/cols
1209   move-cursor screen, 0, 0
1210   var c/eax: code-point-utf8 <- copy 0x61/a
1211   print-code-point-utf8 screen, c
1212   check-screen-row screen, 1/row, "a", "F - test-move-cursor-zeroes"  # top-left corner of the screen
1213 }
1214 
1215 fn test-move-cursor-zero-row {
1216   var screen-on-stack: screen
1217   var screen/esi: (addr screen) <- address screen-on-stack
1218   initialize-screen screen, 5/rows, 4/cols
1219   move-cursor screen, 0, 2
1220   var c/eax: code-point-utf8 <- copy 0x61/a
1221   print-code-point-utf8 screen, c
1222   check-screen-row screen, 1/row, " a", "F - test-move-cursor-zero-row"  # top row
1223 }
1224 
1225 fn test-move-cursor-zero-column {
1226   var screen-on-stack: screen
1227   var screen/esi: (addr screen) <- address screen-on-stack
1228   initialize-screen screen, 5/rows, 4/cols
1229   move-cursor screen, 4, 0
1230   var c/eax: code-point-utf8 <- copy 0x61/a
1231   print-code-point-utf8 screen, c
1232   check-screen-row screen, 4/row, "a", "F - test-move-cursor-zero-column"
1233 }
1234 
1235 fn test-move-cursor-negative-row {
1236   var screen-on-stack: screen
1237   var screen/esi: (addr screen) <- address screen-on-stack
1238   initialize-screen screen, 5, 3
1239   move-cursor screen, -1/row, 2/col
1240   var c/eax: code-point-utf8 <- copy 0x61/a
1241   print-code-point-utf8 screen, c
1242   # no move
1243   check-screen-row screen, 1/row, "a", "F - test-move-cursor-negative-row"
1244 }
1245 
1246 fn test-move-cursor-negative-column {
1247   var screen-on-stack: screen
1248   var screen/esi: (addr screen) <- address screen-on-stack
1249   initialize-screen screen, 5, 3
1250   move-cursor screen, 2/row, -1/col
1251   var c/eax: code-point-utf8 <- copy 0x61/a
1252   print-code-point-utf8 screen, c
1253   # no move
1254   check-screen-row screen, 1/row, "a", "F - test-move-cursor-negative-column"
1255 }
1256 
1257 fn test-move-cursor-column-too-large {
1258   var screen-on-stack: screen
1259   var screen/esi: (addr screen) <- address screen-on-stack
1260   initialize-screen screen, 5/rows, 3/cols
1261   move-cursor screen, 1/row, 4/col
1262   var c/eax: code-point-utf8 <- copy 0x61/a
1263   print-code-point-utf8 screen, c
1264   # top row is empty
1265   check-screen-row screen, 1/row, "   ", "F - test-move-cursor-column-too-large"
1266   # character shows up on next row
1267   check-screen-row screen, 2/row, "a", "F - test-move-cursor-column-too-large"
1268 }
1269 
1270 fn test-move-cursor-column-too-large-saturates {
1271   var screen-on-stack: screen
1272   var screen/esi: (addr screen) <- address screen-on-stack
1273   initialize-screen screen, 5/rows, 3/cols
1274   move-cursor screen, 1/row, 6/col
1275   var c/eax: code-point-utf8 <- copy 0x61/a
1276   print-code-point-utf8 screen, c
1277   # top row is empty
1278   check-screen-row screen, 1/row, "   ", "F - test-move-cursor-column-too-large-saturates"  # top-left corner of the screen
1279   # character shows up at the start of next row
1280   check-screen-row screen, 2/row, "a", "F - test-move-cursor-column-too-large-saturates"  # top-left corner of the screen
1281 }
1282 
1283 fn test-move-cursor-row-too-large {
1284   var screen-on-stack: screen
1285   var screen/esi: (addr screen) <- address screen-on-stack
1286   initialize-screen screen, 5/rows, 3/cols
1287   move-cursor screen, 6/row, 2/col
1288   var c/eax: code-point-utf8 <- copy 0x61/a
1289   print-code-point-utf8 screen, c
1290   # bottom row shows the character
1291   check-screen-row screen, 5/row, " a", "F - test-move-cursor-row-too-large"
1292 }
1293 
1294 fn test-move-cursor-row-too-large-saturates {
1295   var screen-on-stack: screen
1296   var screen/esi: (addr screen) <- address screen-on-stack
1297   initialize-screen screen, 5/rows, 3/cols
1298   move-cursor screen, 9/row, 2/col
1299   var c/eax: code-point-utf8 <- copy 0x61/a
1300   print-code-point-utf8 screen, c
1301   # bottom row shows the character
1302   check-screen-row screen, 5/row, " a", "F - test-move-cursor-row-too-large-saturates"
1303 }
1304 
1305 fn test-check-screen-row-from {
1306   var screen-on-stack: screen
1307   var screen/esi: (addr screen) <- address screen-on-stack
1308   initialize-screen screen, 5/rows, 4/cols
1309   move-cursor screen, 1, 4
1310   var c/eax: code-point-utf8 <- copy 0x61/a
1311   print-code-point-utf8 screen, c
1312   check-screen-row screen, 1/row, "   a", "F - test-check-screen-row-from/baseline"
1313   check-screen-row-from screen, 1/row, 4/col, "a", "F - test-check-screen-row-from"
1314 }
1315 
1316 fn test-print-string-overflows-to-next-row {
1317   var screen-on-stack: screen
1318   var screen/esi: (addr screen) <- address screen-on-stack
1319   initialize-screen screen, 5/rows, 4/cols
1320   print-string screen, "abcdefg"
1321   check-screen-row screen, 1/row, "abcd", "F - test-print-string-overflows-to-next-row"
1322   check-screen-row screen, 2/row, "efg", "F - test-print-string-overflows-to-next-row"
1323 }
1324 
1325 fn test-check-screen-scrolls-on-overflow {
1326   var screen-on-stack: screen
1327   var screen/esi: (addr screen) <- address screen-on-stack
1328   initialize-screen screen, 5/rows, 4/cols
1329   # single character starting at bottom right
1330   move-cursor screen, 5/rows, 4/cols
1331   var c/eax: code-point-utf8 <- copy 0x61/a
1332   print-code-point-utf8 screen, c
1333   check-screen-row-from screen, 5/row, 4/col, "a", "F - test-check-screen-scrolls-on-overflow/baseline"  # bottom-right corner of the screen
1334   # multiple characters starting at bottom right
1335   move-cursor screen, 5, 4
1336   print-string screen, "ab"
1337   # screen scrolled up one row
1338 #?   check-screen-row screen, 1/row, "    ", "F - test-check-screen-scrolls-on-overflow/x1"
1339 #?   check-screen-row screen, 2/row, "    ", "F - test-check-screen-scrolls-on-overflow/x2"
1340 #?   check-screen-row screen, 3/row, "    ", "F - test-check-screen-scrolls-on-overflow/x3"
1341 #?   check-screen-row screen, 4/row, "   a", "F - test-check-screen-scrolls-on-overflow/x4"
1342 #?   check-screen-row screen, 5/row, "b   ", "F - test-check-screen-scrolls-on-overflow/x5"
1343   check-screen-row-from screen, 4/row, 4/col, "a", "F - test-check-screen-scrolls-on-overflow/1"
1344   check-screen-row-from screen, 5/row, 1/col, "b", "F - test-check-screen-scrolls-on-overflow/2"
1345 }
1346 
1347 fn test-check-screen-color {
1348   var screen-on-stack: screen
1349   var screen/esi: (addr screen) <- address screen-on-stack
1350   initialize-screen screen, 5/rows, 4/cols
1351   var c/eax: code-point-utf8 <- copy 0x61/a
1352   print-code-point-utf8 screen, c
1353   start-color screen, 1/fg, 0/bg
1354   c <- copy 0x62/b
1355   print-code-point-utf8 screen, c
1356   start-color screen, 0/fg, 7/bg
1357   c <- copy 0x63/c
1358   print-code-point-utf8 screen, c
1359   check-screen-row-in-color screen, 0/fg, 1/row, "a c", "F - test-check-screen-color"
1360 }
1361 
1362 fn test-check-screen-background-color {
1363   var screen-on-stack: screen
1364   var screen/esi: (addr screen) <- address screen-on-stack
1365   initialize-screen screen, 5/rows, 4/cols
1366   var c/eax: code-point-utf8 <- copy 0x61/a
1367   print-code-point-utf8 screen, c
1368   start-color screen, 0/fg, 1/bg
1369   c <- copy 0x62/b
1370   print-code-point-utf8 screen, c
1371   start-color screen, 0/fg, 7/bg
1372   c <- copy 0x63/c
1373   print-code-point-utf8 screen, c
1374   check-screen-row-in-background-color screen, 7/bg, 1/row, "a c", "F - test-check-screen-background-color"
1375 }
1376 
1377 fn test-check-screen-bold {
1378   var screen-on-stack: screen
1379   var screen/esi: (addr screen) <- address screen-on-stack
1380   initialize-screen screen, 5/rows, 4/cols
1381   start-bold screen
1382   var c/eax: code-point-utf8 <- copy 0x61/a
1383   print-code-point-utf8 screen, c
1384   reset-formatting screen
1385   c <- copy 0x62/b
1386   print-code-point-utf8 screen, c
1387   start-bold screen
1388   c <- copy 0x63/c
1389   print-code-point-utf8 screen, c
1390   check-screen-row-in-bold screen, 1/row, "a c", "F - test-check-screen-bold"
1391 }
1392 
1393 fn test-check-screen-underline {
1394   var screen-on-stack: screen
1395   var screen/esi: (addr screen) <- address screen-on-stack
1396   initialize-screen screen, 5/rows, 4/cols
1397   start-underline screen
1398   var c/eax: code-point-utf8 <- copy 0x61/a
1399   print-code-point-utf8 screen, c
1400   reset-formatting screen
1401   c <- copy 0x62/b
1402   print-code-point-utf8 screen, c
1403   start-underline screen
1404   c <- copy 0x63/c
1405   print-code-point-utf8 screen, c
1406   check-screen-row-in-underline screen, 1/row, "a c", "F - test-check-screen-underline"
1407 }
1408 
1409 fn test-check-screen-reverse {
1410   var screen-on-stack: screen
1411   var screen/esi: (addr screen) <- address screen-on-stack
1412   initialize-screen screen, 5/rows, 4/cols
1413   start-reverse-video screen
1414   var c/eax: code-point-utf8 <- copy 0x61/a
1415   print-code-point-utf8 screen, c
1416   reset-formatting screen
1417   c <- copy 0x62/b
1418   print-code-point-utf8 screen, c
1419   start-reverse-video screen
1420   c <- copy 0x63/c
1421   print-code-point-utf8 screen, c
1422   check-screen-row-in-reverse screen, 1/row, "a c", "F - test-check-screen-reverse"
1423 }
1424 
1425 fn test-check-screen-blinking {
1426   var screen-on-stack: screen
1427   var screen/esi: (addr screen) <- address screen-on-stack
1428   initialize-screen screen, 5/rows, 4/cols
1429   start-blinking screen
1430   var c/eax: code-point-utf8 <- copy 0x61/a
1431   print-code-point-utf8 screen, c
1432   reset-formatting screen
1433   c <- copy 0x62/b
1434   print-code-point-utf8 screen, c
1435   start-blinking screen
1436   c <- copy 0x63/c
1437   print-code-point-utf8 screen, c
1438   check-screen-row-in-blinking screen, 1/row, "a c", "F - test-check-screen-blinking"
1439 }
1440 
1441 #? fn main -> _/ebx: int {
1442 #? #?   test-check-screen-color
1443 #?   run-tests
1444 #?   return 0
1445 #? }