## handling events from the keyboard, mouse, touch screen, ...

# temporary main: interactive editor
# hit ctrl-c to exit
def! main text:text [
  local-scope
  load-ingredients
  open-console
  editor:address:editor-data <- new-editor text, 0/screen, 5/left, 45/right
  editor-event-loop 0/screen, 0/console, editor
  close-console
]

def editor-event-loop screen:address:screen, console:address:console, editor:address:editor-data -> screen:address:screen, console:address:console, editor:address:editor-data [
  local-scope
  load-ingredients
  {
    # looping over each (keyboard or touch) event as it occurs
    +next-event
    cursor-row:number <- get *editor, cursor-row:offset
    cursor-column:number <- get *editor, cursor-column:offset
    screen <- move-cursor screen, cursor-row, cursor-column
    e:event, console:address:console, found?:boolean, quit?:boolean <- read-event console
    loop-unless found?
    break-if quit?  # only in tests
    trace 10, [app], [next-event]
    # 'touch' event
    t:touch-event, is-touch?:boolean <- maybe-convert e, touch:variant
    {
      break-unless is-touch?
      move-cursor-in-editor screen, editor, t
      loop +next-event:label
    }
    # keyboard events
    {
      break-if is-touch?
      screen, editor, go-render?:boolean <- handle-keyboard-event screen, editor, e
      {
        break-unless go-render?
        screen <- editor-render screen, editor
      }
    }
    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 */
# Testable primitives for writing text to screen.
# (Mu doesn't yet have testable primitives for graphics.)
#
# Unlike the top-level, this text mode has no scrolling.

# coordinates here don't match top-level
# Here we're consistent with graphics mode. Top-level is consistent with
# terminal emulators.
type screen {
  width: int
  height: int
  data: (handle array screen-cell)
  cursor-x: int
  cursor-y: int
}

type screen-cell {
  data: grapheme
  color: int
  background-color: int
}

fn initialize-screen screen: (addr screen), width: int, height: int {
  var screen-addr/esi: (addr screen) <- copy screen
  var tmp/eax: int <- copy 0
  var dest/edi: (addr int) <- copy 0
  # screen->width = width
  dest <- get screen-addr, width
  tmp <- copy width
  copy-to *dest, tmp
  # screen->height = height
  dest <- get screen-addr, height
  tmp <- copy height
  copy-to *dest, tmp
  # screen->data = new screen-cell[width*height]
  {
    var data-addr/edi: (addr handle array screen-cell) <- get screen-addr, data
    tmp <- multiply width
    populate data-addr, tmp
  }
  # screen->cursor-x = 0
  dest <- get screen-addr, cursor-x
  copy-to *dest, 0
  # screen->cursor-y = 0
  dest <- get screen-addr, cursor-y
  copy-to *dest, 0
}

# in graphemes
fn screen-size screen: (addr screen) -> _/eax: int, _/ecx: int {
  var width/eax: int <- copy 0
  var height/ecx: int <- copy 0
  compare screen, 0
  {
    break-if-!=
    return 0x80/128, 0x30/48
  }
  # fake screen
  var screen-addr/esi: (addr screen) <- copy screen
  var tmp/edx: (addr int) <- get screen-addr, width
  width <- copy *tmp
  tmp <- get screen-addr, height
  height <- copy *tmp
  return width, height
}

# testable screen primitive
fn draw-grapheme screen: (addr screen), g: grapheme, x: int, y: int, color: int, background-color: int {
  {
    compare screen, 0
    break-if-!=
    draw-grapheme-on-real-screen g, x, y, color, background-color
    return
  }
  # fake screen
  var screen-addr/esi: (addr screen) <- copy screen
  var idx/ecx: int <- screen-cell-index screen-addr, x, y
  var data-ah/eax: (addr handle array screen-cell) <- get screen-addr, data
  var data/eax: (addr array screen-cell) <- lookup *data-ah
  var offset/ecx: (offset screen-cell) <- compute-offset data, idx
  var dest-cell/ecx: (addr screen-cell) <- index data, offset
  var dest-grapheme/eax: (addr grapheme) <- get dest-cell, data
  var g2/edx: grapheme <- copy g
  copy-to *dest-grapheme, g2
  var dest-color/eax: (addr int) <- get dest-cell, color
  var src-color/edx: int <- copy color
  copy-to *dest-color, src-color
  dest-color <- get dest-cell, background-color
  src-color <- copy background-color
  copy-to *dest-color, src-color
}

# we can't really render non-ASCII yet, but when we do we'll be ready
fn draw-code-point screen: (addr screen), c: code-point, x: int, y: int, color: int, background-color: int {
  var g/eax: grapheme <- copy c
  draw-grapheme screen, g, x, y, color, background-color
}

# not really needed for a real screen, though it shouldn't do any harm
fn screen-cell-index screen-on-stack: (addr screen), x: int, y: int -> _/ecx: int {
  var screen/esi: (addr screen) <- copy screen-on-stack
  # only one bounds check isn't automatically handled
  {
    var xmax/eax: (addr int) <- get screen, width
    var xcurr/ecx: int <- copy x
    compare xcurr, *xmax
    break-if-<
    abort "tried to print out of screen bounds"
  }
  var width-addr/eax: (addr int) <- get screen, width
  var result/ecx: int <- copy y
  result <- multiply *width-addr
  result <- add x
  return result
}

fn cursor-position screen: (addr screen) -> _/eax: int, _/ecx: int {
  {
    compare screen, 0
    break-if-!=
    var x/eax: int <- copy 0
    var y/ecx: int <- copy 0
    x, y <- cursor-position-on-real-screen
    return x, y
  }
  # fake screen
  var screen-addr/esi: (addr screen) <- copy screen
  var cursor-x-addr/eax: (addr int) <- get screen-addr, cursor-x
  var cursor-y-addr/ecx: (addr int) <- get screen-addr, cursor-y
  return *cursor-x-addr, *cursor-y-addr
}

fn set-cursor-position screen: (addr screen), x: int, y: int {
  {
    compare screen, 0
    break-if-!=
    set-cursor-position-on-real-screen x, y
    return
  }
  # fake screen
  var screen-addr/esi: (addr screen) <- copy screen
  # ignore x < 0
  {
    compare x, 0
    break-if->=
    return
  }
  # ignore x >= width
  {
    var width-addr/eax: (addr int) <- get screen-addr, width
    var width/eax: int <- copy *width-addr
    compare x, width
    break-if-<=
    return
  }
  # ignore y < 0
  {
    compare y, 0
    break-if->=
    return
  }
  # ignore y >= height
  {
    var height-addr/eax: (addr int) <- get screen-addr, height
    var height/eax: int <- copy *height-addr
    compare y, height
    break-if-<
    return
  }
  # screen->cursor-x = x
  var dest/edi: (addr int) <- get screen-addr, cursor-x
  var src/eax: int <- copy x
  copy-to *dest, src
  # screen->cursor-y = y
  dest <- get screen-addr, cursor-y
  src <- copy y
  copy-to *dest, src
}

fn draw-cursor screen: (addr screen), g: grapheme {
  {
    compare screen, 0
    break-if-!=
    draw-cursor-on-real-screen g
    return
  }
  # fake screen
  var cursor-x/eax: int <- copy 0
  var cursor-y/ecx: int <- copy 0
  cursor-x, cursor-y <- cursor-position screen
  draw-grapheme screen, g, cursor-x, cursor-y, 0/fg, 7/bg
}

fn clear-screen screen: (addr screen) {
  {
    compare screen, 0
    break-if-!=
    clear-real-screen
    return
  }
  # fake screen
  set-cursor-position screen, 0, 0
  var screen-addr/esi: (addr screen) <- copy screen
  var y/eax: int <- copy 0
  var height/ecx: (addr int) <- get screen-addr, height
  {
    compare y, *height
    break-if->=
    var x/edx: int <- copy 0
    var width/ebx: (addr int) <- get screen-addr, width
    {
      compare x, *width
      break-if->=
      draw-code-point screen, 0x20/space, x, y, 0/fg=black, 0/bg=black
      x <- increment
      loop
    }
    y <- increment
    loop
  }
  set-cursor-position screen, 0, 0
}

fn clear-rect screen: (addr screen), xmin: int, ymin: int, xmax: int, ymax: int, background-color: int {
  {
    compare screen, 0
    break-if-!=
    clear-rect-on-real-screen xmin, ymin, xmax, ymax, background-color
    return
  }
  # fake screen
  set-cursor-position screen, 0, 0
  var screen-addr/esi: (addr screen) <- copy screen
  var y/eax: int <- copy ymin
  var ymax/ecx: int <- copy ymax
  {
    compare y, ymax
    break-if->=
    var x/edx: int <- copy xmin
    var xmax/ebx: int <- copy xmax
    {
      compare x, xmax
      break-if->=
      draw-code-point screen, 0x20/space, x, y, 0/fg, background-color
      x <- increment
      loop
    }
    y <- increment
    loop
  }
  set-cursor-position screen, 0, 0
}

# there's no grapheme that guarantees to cover every pixel, so we'll bump down
# to pixels for a real screen
fn clear-real-screen {
  var y/eax: int <- copy 0
  {
    compare y, 0x300/screen-height=768
    break-if->=
    var x/edx: int <- copy 0
    {
      compare x, 0x400/screen-width=1024
      break-if->=
      pixel-on-real-screen x, y, 0/color=black
      x <- increment
      loop
    }
    y <- increment
    loop
  }
}

fn clear-rect-on-real-screen xmin: int, ymin: int, xmax: int, ymax: int, background-color: int {
  var y/eax: int <- copy ymin
  y <- shift-left 4/log-font-height
  var ymax/ecx: int <- copy ymax
  ymax <- shift-left 4/log-font-height
  {
    compare y, ymax
    break-if->=
    var x/edx: int <- copy xmin
    x <- shift-left 3/log-font-width
    var xmax/ebx: int <- copy xmax
    xmax <- shift-left 3/log-font-width
    {
      compare x, xmax
      break-if->=
      pixel-on-real-screen x, y, background-color
      x <- increment
      loop
    }
    y <- increment
    loop
  }
}

fn screen-grapheme-at screen-on-stack: (addr screen), x: int, y: int -> _/eax: grapheme {
  var screen-addr/esi: (addr screen) <- copy screen-on-stack
  var idx/ecx: int <- screen-cell-index screen-addr, x, y
  var result/eax: grapheme <- screen-grapheme-at-idx screen-addr, idx
  return result
}

fn screen-grapheme-at-idx screen-on-stack: (addr screen), idx-on-stack: int -> _/eax: grapheme {
  var screen-addr/esi: (addr screen) <- copy screen-on-stack
  var data-ah/eax: (addr handle array screen-cell) <- get screen-addr, data
  var data/eax: (addr array screen-cell) <- lookup *data-ah
  var idx/ecx: int <- copy idx-on-stack
  var offset/ecx: (offset screen-cell) <- compute-offset data, idx
  var cell/eax: (addr screen-cell) <- index data, offset
  var src/eax: (addr grapheme) <- get cell, data
  return *src
}

fn screen-color-at screen-on-stack: (addr screen), x: int, y: int -> _/eax: int {
  var screen-addr/esi: (addr screen) <- copy screen-on-stack
  var idx/ecx: int <- screen-cell-index screen-addr, x, y
  var result/eax: int <- screen-color-at-idx screen-addr, idx
  return result
}

fn screen-color-at-idx screen-on-stack: (addr screen), idx-on-stack: int -> _/eax: int {
  var screen-addr/esi: (addr screen) <- copy screen-on-stack
  var data-ah/eax: (addr handle array screen-cell) <- get screen-addr, data
  var data/eax: (addr array screen-cell) <- lookup *data-ah
  var idx/ecx: int <- copy idx-on-stack
  var offset/ecx: (offset screen-cell) <- compute-offset data, idx
  var cell/eax: (addr screen-cell) <- index data, offset
  var src/eax: (addr int) <- get cell, color
  var result/eax: int <- copy *src
  return result
}

fn screen-background-color-at screen-on-stack: (addr screen), x: int, y: int -> _/eax: int {
  var screen-addr/esi: (addr screen) <- copy screen-on-stack
  var idx/ecx: int <- screen-cell-index screen-addr, x, y
  var result/eax: int <- screen-background-color-at-idx screen-addr, idx
  return result
}

fn screen-background-color-at-idx screen-on-stack: (addr screen), idx-on-stack: int -> _/eax: int {
  var screen-addr/esi: (addr screen) <- copy screen-on-stack
  var data-ah/eax: (addr handle array screen-cell) <- get screen-addr, data
  var data/eax: (addr array screen-cell) <- lookup *data-ah
  var idx/ecx: int <- copy idx-on-stack
  var offset/ecx: (offset screen-cell) <- compute-offset data, idx
  var cell/eax: (addr screen-cell) <- index data, offset
  var src/eax: (addr int) <- get cell, background-color
  var result/eax: int <- copy *src
  return result
}