about summary refs log blame commit diff stats
path: root/prototypes/tile/7.mu
blob: 3cec67b67188ce13755db8004dbaace7a1799794 (plain) (tree)
1
2
3
4
5
6




                                              
                                         



















































































































































































































































































                                                                                                          
# rendering trees of arbitrary depth
#
# To run (on Linux and x86):
#   $ git clone https://github.com/akkartik/mu
#   $ cd mu
#   $ ./translate_mu prototypes/tile/7.mu
#   $ ./a.elf
#
# Every time you press a key, the root node gains another child. Press ctrl-c
# to exit.
#
# The rendering is still simple-minded. Children and siblings render in the
# same direction. And this interacts poorly with the depth computation, which
# only considers children. So unlike the previous prototype which splits the
# same screen width between more and more boxes, here the boxes grow to the
# right.

# To run unit tests:
#   $ ./a.elf test
fn main args-on-stack: (addr array (addr array byte)) -> exit-status/ebx: int {
  var args/eax: (addr array (addr array byte)) <- copy args-on-stack
  var tmp/ecx: int <- length args
  $main-body: {
    # if (len(args) > 1 && args[1] == "test") run-tests()
    compare tmp, 1
    {
      break-if-<=
      # if (args[1] == "test") run-tests()
      var tmp2/ecx: (addr addr array byte) <- index args, 1
      var tmp3/eax: boolean <- string-equal? *tmp2, "test"
      compare tmp3, 0
      {
        break-if-=
        run-tests
        exit-status <- copy 0  # TODO: get at Num-test-failures somehow
      }
      break $main-body
    }
    # otherwise operate interactively
    exit-status <- interactive
  }
}

# - interactive loop

type cell {
  val: int  # single chars only for now
  parent: (handle cell)
  first-child: (handle cell)
  next-sibling: (handle cell)
  prev-sibling: (handle cell)
}

fn interactive -> exit-status/ebx: int {
  var root-handle: (handle cell)
  var root/esi: (addr handle cell) <- address root-handle
  allocate root
  var cursor/edi: (addr handle cell) <- copy root
  enable-keyboard-immediate-mode
  var root-addr/eax: (addr cell) <- lookup *root
  render root-addr
$main:loop: {
    # process key
    {
      var c/eax: byte <- read-key
      compare c, 4  # ctrl-d
      break-if-= $main:loop
      process c, root, cursor
    }
    # render tree
    root-addr <- lookup root-handle
    render root-addr
    loop
  }
  clear-screen
  enable-keyboard-type-mode
  exit-status <- copy 0
}

#######################################################
# Tree mutations
#######################################################

fn process c: byte, root: (addr handle cell), cursor: (addr handle cell) {
  var c1/ecx: (addr handle cell) <- copy cursor
  var c2/eax: (addr cell) <- lookup *c1
  create-child c2
}

fn create-child node: (addr cell) {
  var n/ecx: (addr cell) <- copy node
  var child/esi: (addr handle cell) <- get n, first-child
  {
    var tmp/eax: (addr cell) <- lookup *child
    compare tmp, 0
    break-if-=
    child <- get tmp, next-sibling
    loop
  }
  allocate child
}

#######################################################
# Tree drawing
#######################################################

fn render root: (addr cell) {
  clear-screen
  var depth/eax: int <- tree-depth root
  var viewport-width/ecx: int <- copy 0x64  # col2
  viewport-width <- subtract 5  # col1
  var column-width/eax: int <- try-divide viewport-width, depth
  render-tree root, column-width, 5, 5, 0x20, 0x64
}

fn render-tree c: (addr cell), column-width: int, row-min: int, col-min: int, row-max: int, col-max: int {
  var root-max/ecx: int <- copy col-min
  root-max <- add column-width
  draw-box row-min, col-min, row-max, root-max
  var c2/eax: (addr cell) <- copy c
  # render child if possible
  {
    var child/edx: (addr handle cell) <- get c2, first-child
    var child-addr/eax: (addr cell) <- lookup *child
    {
      compare child-addr, 0
      break-if-=
      increment row-min
      decrement row-max
      render-tree child-addr, column-width, row-min, root-max, row-max, col-max
    }
  }
  # otherwise render sibling if possible (in the same column)
  {
    var sib/edx: (addr handle cell) <- get c2, next-sibling
    var sib-addr/eax: (addr cell) <- lookup *sib
    {
      compare sib-addr, 0
      break-if-=
      increment row-min
      decrement row-max
      render-tree sib-addr, column-width, row-min, root-max, row-max, col-max
    }
  }
}

fn tree-depth node-on-stack: (addr cell) -> result/eax: int {
  var tmp-result/edi: int <- copy 0
  var node/eax: (addr cell) <- copy node-on-stack
  var child/ecx: (addr handle cell) <- get node, first-child
  var child-addr/eax: (addr cell) <- lookup *child
  {
    compare child-addr, 0
    break-if-=
    {
      var tmp/eax: int <- tree-depth child-addr
      compare tmp, tmp-result
      break-if-<=
      tmp-result <- copy tmp
    }
    child <- get child-addr, next-sibling
    child-addr <- lookup *child
    loop
  }
  result <- copy tmp-result
  result <- increment
}

fn draw-box row1: int, col1: int, row2: int, col2: int {
  draw-horizontal-line row1, col1, col2
  draw-vertical-line row1, row2, col1
  draw-horizontal-line row2, col1, col2
  draw-vertical-line row1, row2, col2
}

fn draw-horizontal-line row: int, col1: int, col2: int {
  var col/eax: int <- copy col1
  move-cursor-on-screen row, col
  {
    compare col, col2
    break-if->=
    print-string-to-screen "-"
    col <- increment
    loop
  }
}

fn draw-vertical-line row1: int, row2: int, col: int {
  var row/eax: int <- copy row1
  {
    compare row, row2
    break-if->=
    move-cursor-on-screen row, col
    print-string-to-screen "|"
    row <- increment
    loop
  }
}

# slow, iterative divide instruction
# preconditions: _nr >= 0, _dr > 0
fn try-divide _nr: int, _dr: int -> result/eax: int {
  # x = next power-of-2 multiple of _dr after _nr
  var x/ecx: int <- copy 1
  {
#?     print-int32-hex-to-screen x
#?     print-string-to-screen "\n"
    var tmp/edx: int <- copy _dr
    tmp <- multiply x
    compare tmp, _nr
    break-if->
    x <- shift-left 1
    loop
  }
#?   print-string-to-screen "--\n"
  # min, max = x/2, x
  var max/ecx: int <- copy x
  var min/edx: int <- copy max
  min <- shift-right 1
  # narrow down result between min and max
  var i/eax: int <- copy min
  {
#?     print-int32-hex-to-screen i
#?     print-string-to-screen "\n"
    var foo/ebx: int <- copy _dr
    foo <- multiply i
    compare foo, _nr
    break-if->
    i <- increment
    loop
  }
  result <- copy i
  result <- decrement
#?   print-string-to-screen "=> "
#?   print-int32-hex-to-screen result
#?   print-string-to-screen "\n"
}

fn test-try-divide-1 {
  var result/eax: int <- try-divide 0, 2
  check-ints-equal result, 0, "F - try-divide-1\n"
}

fn test-try-divide-2 {
  var result/eax: int <- try-divide 1, 2
  check-ints-equal result, 0, "F - try-divide-2\n"
}

fn test-try-divide-3 {
  var result/eax: int <- try-divide 2, 2
  check-ints-equal result, 1, "F - try-divide-3\n"
}

fn test-try-divide-4 {
  var result/eax: int <- try-divide 4, 2
  check-ints-equal result, 2, "F - try-divide-4\n"
}

fn test-try-divide-5 {
  var result/eax: int <- try-divide 6, 2
  check-ints-equal result, 3, "F - try-divide-5\n"
}

fn test-try-divide-6 {
  var result/eax: int <- try-divide 9, 3
  check-ints-equal result, 3, "F - try-divide-6\n"
}

fn test-try-divide-7 {
  var result/eax: int <- try-divide 0xc, 4
  check-ints-equal result, 3, "F - try-divide-7\n"
}

fn test-try-divide-8 {
  var result/eax: int <- try-divide 0x1b, 3  # 27/3
  check-ints-equal result, 9, "F - try-divide-8\n"
}

fn test-try-divide-9 {
  var result/eax: int <- try-divide 0x1c, 3  # 28/3
  check-ints-equal result, 9, "F - try-divide-9\n"
}
lass="w"> var prev-word/eax: (addr word) <- lookup *prev-word-ah compare prev-word, 0 break-if-= #? print-string 0, "jump before caller\n" copy-object prev-word-ah, cursor-word-ah cursor-to-end prev-word var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path decrement-final-element cursor-call-path } break $process:body } # otherwise, move to end of previous word var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev var prev-word/eax: (addr word) <- lookup *prev-word-ah { compare prev-word, 0 break-if-= #? print-string 0, "previous word\n" copy-object prev-word-ah, cursor-word-ah cursor-to-end prev-word var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path decrement-final-element cursor-call-path } break $process:body } compare key, 0x435b1b # right-arrow $process:key-right-arrow: { break-if-!= # if not at end, move right within current word var at-end?/eax: boolean <- cursor-at-end? cursor-word compare at-end?, 0 # false { break-if-= #? print-string 0, "a\n" cursor-right cursor-word break $process:body } # if at final word, look for a caller to jump to { var next-word-ah/edx: (addr handle word) <- get cursor-word, next var next-word/eax: (addr word) <- lookup *next-word-ah compare next-word, 0 break-if-!= var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah var next-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah compare next-cursor-element, 0 break-if-= copy-object next-cursor-element-ah, cursor-call-path-ah break $process:body } # otherwise, move to the next word var next-word-ah/edx: (addr handle word) <- get cursor-word, next var next-word/eax: (addr word) <- lookup *next-word-ah { compare next-word, 0 break-if-= #? print-string 0, "b\n" cursor-to-start next-word # . . cursor-word now out of date var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path increment-final-element cursor-call-path # Is the new cursor word expanded? If so, it's a function call. Add a # new level to the cursor-call-path for the call's body. { #? print-string 0, "c\n" var expanded-words/eax: (addr handle call-path) <- get sandbox, expanded-words var curr-word-is-expanded?/eax: boolean <- find-in-call-path expanded-words, cursor-call-path compare curr-word-is-expanded?, 0 # false break-if-= push-to-call-path-element cursor-call-path, 0 #? print-string 0, "d\n" break $process:body } } break $process:body } compare key, 0xa # enter { break-if-!= # toggle display of subsidiary stack toggle-cursor-word sandbox break $process:body } # if call, break var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah var next-cursor-element-ah/eax: (addr handle call-path-element) <- get cursor-call-path, next var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah compare next-cursor-element, 0 break-if-!= $process:body # - remaining keys only work at the top row outside any function calls compare key, 0x7f # del (backspace on Macs) { break-if-!= # if not at start of some word, delete grapheme before cursor within current word var at-start?/eax: boolean <- cursor-at-start? cursor-word compare at-start?, 0 # false { break-if-= delete-before-cursor cursor-word break $process:body } # otherwise delete current word and move to end of prev word var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev var prev-word/eax: (addr word) <- lookup *prev-word-ah { compare prev-word, 0 break-if-= cursor-to-end prev-word delete-next prev-word var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path decrement-final-element cursor-call-path } break $process:body } compare key, 0x20 # space { break-if-!= # insert new word append-word cursor-word-ah var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path increment-final-element cursor-call-path break $process:body } # otherwise insert key within current word var g/edx: grapheme <- copy key var print?/eax: boolean <- real-grapheme? key { compare print?, 0 # false break-if-= add-grapheme-to-word cursor-word, g break $process:body } # silently ignore other hotkeys } } fn get-cursor-word _sandbox: (addr sandbox), functions: (addr handle function), out: (addr handle word) { var sandbox/esi: (addr sandbox) <- copy _sandbox var cursor-call-path/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path var line/ecx: (addr handle line) <- get sandbox, data #? { #? print-string 0, "B: line starts with " #? var line-ah/eax: (addr handle line) <- get sandbox, data #? var line/eax: (addr line) <- lookup *line-ah #? var first-word-ah/eax: (addr handle word) <- get line, data #? var curr-word/eax: (addr word) <- lookup *first-word-ah #? print-word 0, curr-word #? print-string 0, "\n" #? } get-word-from-path line, functions, cursor-call-path, out #? { #? print-string 0, "Y: line starts with " #? var line-ah/eax: (addr handle line) <- get sandbox, data #? var line/eax: (addr line) <- lookup *line-ah #? var first-word-ah/eax: (addr handle word) <- get line, data #? var curr-word/eax: (addr word) <- lookup *first-word-ah #? print-word 0, curr-word #? print-string 0, "\n" #? } } fn get-word-from-path _line: (addr handle line), functions: (addr handle function), _path-ah: (addr handle call-path-element), out: (addr handle word) { # var tmp = line # if (path->next) # get-word-from-path(line, functions, path->next, out) # tmp = function-body(functions, out) # word-index(tmp, path->index-in-body, out) #? print-string 0, "C\n" var tmp: (handle line) { var tmp-ah/eax: (addr handle line) <- address tmp copy-object _line, tmp-ah } var path-ah/eax: (addr handle call-path-element) <- copy _path-ah var _path/eax: (addr call-path-element) <- lookup *path-ah var path/ecx: (addr call-path-element) <- copy _path var next-ah/edx: (addr handle call-path-element) <- get path, next var next/eax: (addr call-path-element) <- lookup *next-ah { compare next, 0 break-if-= get-word-from-path _line, functions, next-ah, out #? { #? print-string 0, "D: line starts with " #? var line/eax: (addr line) <- lookup *line-ah #? var words/eax: (addr handle word) <- get line, data #? var curr-word/eax: (addr word) <- lookup *words #? print-word 0, curr-word #? print-string 0, "\n" #? } var tmp-ah/eax: (addr handle line) <- address tmp function-body functions, out, tmp-ah #? { #? print-string 0, "G: line starts with " #? var line/eax: (addr line) <- lookup *line-ah #? var words/eax: (addr handle word) <- get line, data #? var curr-word/eax: (addr word) <- lookup *words #? print-word 0, curr-word #? print-string 0, "\n" #? } # TODO: support multiple levels } var n/ecx: (addr int) <- get path, index-in-body var line/eax: (addr line) <- lookup tmp var words/eax: (addr handle word) <- get line, data #? { #? print-string 0, "M: line starts with " #? var curr-word/eax: (addr word) <- lookup *words #? print-word 0, curr-word #? print-string 0, "\n" #? } word-index words, *n, out #? { #? print-string 0, "P: line starts with " #? var curr-word/eax: (addr word) <- lookup *words #? print-word 0, curr-word #? print-string 0, "\n" #? } #? print-string 0, "X\n" } fn word-index _words: (addr handle word), _n: int, out: (addr handle word) { $word-index:body: { var n/ecx: int <- copy _n { compare n, 0 break-if-!= copy-object _words, out break $word-index:body } var words-ah/eax: (addr handle word) <- copy _words var words/eax: (addr word) <- lookup *words-ah var next/eax: (addr handle word) <- get words, next n <- decrement word-index next, n, out } } fn toggle-cursor-word _sandbox: (addr sandbox) { $toggle-cursor-word:body: { var sandbox/esi: (addr sandbox) <- copy _sandbox var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path var already-expanded?/eax: boolean <- find-in-call-path expanded-words, cursor-call-path compare already-expanded?, 0 # false { break-if-!= # if not already-expanded, insert insert-in-call-path expanded-words cursor-call-path break $toggle-cursor-word:body } { break-if-= # otherwise delete delete-in-call-path expanded-words cursor-call-path } } } fn evaluate-environment _env: (addr environment), stack: (addr value-stack) { var env/esi: (addr environment) <- copy _env # functions var functions/edx: (addr handle function) <- get env, functions # line var sandbox-ah/esi: (addr handle sandbox) <- get env, sandboxes var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah var line-ah/eax: (addr handle line) <- get sandbox, data var _line/eax: (addr line) <- lookup *line-ah var line/esi: (addr line) <- copy _line evaluate functions, 0, line, 0, stack } fn render _env: (addr environment) { var env/esi: (addr environment) <- copy _env clear-canvas env # screen var screen-ah/eax: (addr handle screen) <- get env, screen var _screen/eax: (addr screen) <- lookup *screen-ah var screen/edi: (addr screen) <- copy _screen # repl-col var _repl-col/eax: (addr int) <- get env, code-separator-col var repl-col/ecx: int <- copy *_repl-col repl-col <- add 2 # repl-margin-left # functions var functions/edx: (addr handle function) <- get env, functions # sandbox var sandbox-ah/eax: (addr handle sandbox) <- get env, sandboxes var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah #? { #? var line-ah/eax: (addr handle line) <- get sandbox, data #? var line/eax: (addr line) <- lookup *line-ah #? var first-word-ah/eax: (addr handle word) <- get line, data #? var curr-word/eax: (addr word) <- lookup *first-word-ah #? print-word 0, curr-word #? print-string 0, "\n" #? } render-sandbox screen, functions, 0, sandbox, 3, repl-col } fn render-sandbox screen: (addr screen), functions: (addr handle function), bindings: (addr table), _sandbox: (addr sandbox), top-row: int, left-col: int { var sandbox/esi: (addr sandbox) <- copy _sandbox # expanded-words var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words # line var line-ah/eax: (addr handle line) <- get sandbox, data var _line/eax: (addr line) <- lookup *line-ah var line/ecx: (addr line) <- copy _line # cursor-word var cursor-word-storage: (handle word) var cursor-word-ah/eax: (addr handle word) <- address cursor-word-storage get-cursor-word sandbox, functions, cursor-word-ah var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah var cursor-word/ebx: (addr word) <- copy _cursor-word # cursor-col var cursor-col: int var cursor-col-a/edx: (addr int) <- address cursor-col # cursor-call-path var cursor-call-path: (addr handle call-path-element) { var src/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path copy-to cursor-call-path, src } # var curr-path-storage: (handle call-path-element) var curr-path/esi: (addr handle call-path-element) <- address curr-path-storage allocate curr-path # leak #? print-string 0, "==\n" var dummy/ecx: int <- render-line screen, functions, 0, line, expanded-words, 3, left-col, curr-path, cursor-word, cursor-call-path, cursor-col-a # input-row=3 var cursor-row/eax: int <- call-depth-at-cursor _sandbox move-cursor screen, cursor-row, cursor-col } fn call-depth-at-cursor _sandbox: (addr sandbox) -> result/eax: int { var sandbox/esi: (addr sandbox) <- copy _sandbox var cursor-call-path/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path result <- call-path-element-length cursor-call-path result <- add 2 # input-row-1 } fn call-path-element-length _x: (addr handle call-path-element) -> result/eax: int { var curr-ah/ecx: (addr handle call-path-element) <- copy _x var out/edi: int <- copy 0 { var curr/eax: (addr call-path-element) <- lookup *curr-ah compare curr, 0 break-if-= curr-ah <- get curr, next out <- increment loop } result <- copy out } # Render the line of words in line, along with the state of the stack under each word. # Also render any expanded function calls using recursive calls. # # Along the way, compute the column the cursor should be positioned at (cursor-col-a). fn render-line screen: (addr screen), functions: (addr handle function), bindings: (addr table), _line: (addr line), expanded-words: (addr handle call-path), top-row: int, left-col: int, curr-path: (addr handle call-path-element), cursor-word: (addr word), cursor-call-path: (addr handle call-path-element), cursor-col-a: (addr int) -> right-col/ecx: int { #? print-string 0, "--\n" # curr-word var line/esi: (addr line) <- copy _line var first-word-ah/eax: (addr handle word) <- get line, data var curr-word/eax: (addr word) <- lookup *first-word-ah # # loop-carried dependency var curr-col/ecx: int <- copy left-col # { compare curr-word, 0 break-if-= #? print-word 0, curr-word #? print-string 0, "\n" #? { #? var dummy/eax: grapheme <- read-key-from-real-keyboard #? } # if necessary, first render columns for subsidiary stack $render-line:subsidiary: { { # can't expand subsidiary stacks for now compare bindings, 0 break-if-!= $render-line:subsidiary # var display-subsidiary-stack?/eax: boolean <- find-in-call-path expanded-words, curr-path compare display-subsidiary-stack?, 0 # false break-if-= $render-line:subsidiary } # does function exist? var callee/edi: (addr function) <- copy 0 { var curr-stream-storage: (stream byte 0x10) var curr-stream/esi: (addr stream byte) <- address curr-stream-storage emit-word curr-word, curr-stream var callee-h: (handle function) var callee-ah/eax: (addr handle function) <- address callee-h find-function functions, curr-stream, callee-ah var _callee/eax: (addr function) <- lookup *callee-ah callee <- copy _callee compare callee, 0 break-if-= $render-line:subsidiary } move-cursor screen, top-row, curr-col print-word screen, curr-word { var word-len/eax: int <- word-length curr-word curr-col <- add word-len curr-col <- add 2 increment top-row } # obtain stack at call site var stack-storage: value-stack var stack/edx: (addr value-stack) <- address stack-storage initialize-value-stack stack, 0x10 { var prev-word-ah/eax: (addr handle word) <- get curr-word, prev var prev-word/eax: (addr word) <- lookup *prev-word-ah compare prev-word, 0 break-if-= evaluate functions, bindings, line, prev-word, stack } # construct new bindings var callee-bindings-storage: table var callee-bindings/esi: (addr table) <- address callee-bindings-storage initialize-table callee-bindings, 0x10 bind-args callee, stack, callee-bindings # obtain body var callee-body-ah/eax: (addr handle line) <- get callee, body var callee-body/eax: (addr line) <- lookup *callee-body-ah # - render subsidiary stack push-to-call-path-element curr-path, 0 # leak curr-col <- render-line screen, functions, callee-bindings, callee-body, 0, top-row, curr-col, curr-path, cursor-word, cursor-call-path, cursor-col-a drop-from-call-path-element curr-path # move-cursor screen, top-row, curr-col print-code-point screen, 0x21d7 # # curr-col <- add 2 decrement top-row } # debug info: print word index #? decrement top-row #? move-cursor screen, top-row, curr-col #? start-color screen, 8, 7 #? { #? var word-index-val/eax: int <- final-element-value word-index #? print-int32-hex-bits screen, word-index-val, 4 #? } #? reset-formatting screen #? increment top-row # render main column var old-col/edx: int <- copy curr-col curr-col <- render-column screen, functions, bindings, line, curr-word, top-row, curr-col # cache cursor column if necessary $render-line:cache-cursor-column: { { var found?/eax: boolean <- call-path-element-match? curr-path, cursor-call-path compare found?, 0 # false break-if-= $render-line:cache-cursor-column } var dest/edi: (addr int) <- copy cursor-col-a copy-to *dest, old-col var cursor-index-in-word/eax: int <- cursor-index curr-word add-to *dest, cursor-index-in-word } # loop update var next-word-ah/edx: (addr handle word) <- get curr-word, next curr-word <- lookup *next-word-ah increment-final-element curr-path loop } right-col <- copy curr-col } # Render: # - starting at top-row, left-col: final-word # - starting somewhere below at left-col: the stack result from interpreting first-world to final-word (inclusive) # # Return the farthest column written. fn render-column screen: (addr screen), functions: (addr handle function), bindings: (addr table), scratch: (addr line), final-word: (addr word), top-row: int, left-col: int -> right-col/ecx: int { var max-width/ecx: int <- copy 0 { # indent stack var indented-col/ebx: int <- copy left-col indented-col <- add 1 # margin-right - 2 for padding spaces # compute stack var stack: value-stack var stack-addr/edi: (addr value-stack) <- address stack initialize-value-stack stack-addr, 0x10 # max-words evaluate functions, bindings, scratch, final-word, stack-addr # render stack var curr-row/edx: int <- copy top-row curr-row <- add 3 # stack-margin-top var _max-width/eax: int <- value-stack-max-width stack-addr var max-width/esi: int <- copy _max-width var i/eax: int <- value-stack-length stack-addr { compare i, 0 break-if-<= move-cursor screen, curr-row, indented-col { var val/eax: int <- pop-int-from-value-stack stack-addr render-integer screen, val, max-width var size/eax: int <- decimal-size val compare size, max-width break-if-<= max-width <- copy size } curr-row <- increment i <- decrement loop } } # render word, initialize result reset-formatting screen move-cursor screen, top-row, left-col print-word screen, final-word { var size/eax: int <- word-length final-word compare size, max-width break-if-<= max-width <- copy size } # post-process right-col right-col <- copy max-width right-col <- add left-col right-col <- add 3 # margin-right } # synaesthesia fn render-integer screen: (addr screen), val: int, max-width: int { var bg/eax: int <- hash-color val var fg/ecx: int <- copy 7 { compare bg, 2 break-if-!= fg <- copy 0 } { compare bg, 3 break-if-!= fg <- copy 0 } { compare bg, 6 break-if-!= fg <- copy 0 } start-color screen, fg, bg print-grapheme screen, 0x20 # space print-int32-decimal-right-justified screen, val, max-width print-grapheme screen, 0x20 # space } fn hash-color val: int -> result/eax: int { result <- try-modulo val, 7 # assumes that 7 is always the background color } fn clear-canvas _env: (addr environment) { var env/esi: (addr environment) <- copy _env var screen-ah/edi: (addr handle screen) <- get env, screen var _screen/eax: (addr screen) <- lookup *screen-ah var screen/edi: (addr screen) <- copy _screen clear-screen screen var nrows/eax: (addr int) <- get env, nrows var _repl-col/ecx: (addr int) <- get env, code-separator-col var repl-col/ecx: int <- copy *_repl-col draw-vertical-line screen, 1, *nrows, repl-col move-cursor screen, 3, 2 print-string screen, "x 2* = x 2 *" move-cursor screen, 4, 2 print-string screen, "x 1+ = x 1 +" move-cursor screen, 5, 2 print-string screen, "x 2+ = x 1+ 1+" } fn real-grapheme? g: grapheme -> result/eax: boolean { $real-grapheme?:body: { # if g == newline return true compare g, 0xa { break-if-!= result <- copy 1 # true break $real-grapheme?:body } # if g == tab return true compare g, 9 { break-if-!= result <- copy 1 # true break $real-grapheme?:body } # if g < 32 return false compare g, 0x20 { break-if->= result <- copy 0 # false break $real-grapheme?:body } # if g <= 255 return true compare g, 0xff { break-if-> result <- copy 1 # true break $real-grapheme?:body } # if (g&0xff == Esc) it's an escape sequence and-with g, 0xff compare g, 0x1b # Esc { break-if-!= result <- copy 0 # false break $real-grapheme?:body } # otherwise return true result <- copy 1 # true } }