From 1afc02113ae7a088bf1a02ef423fcd875292c6c2 Mon Sep 17 00:00:00 2001
From: "Kartik K. Agaram" <vc@akkartik.com>
Date: Sat, 10 Apr 2021 22:28:24 -0700
Subject: shell: fake keyboard

---
 shell/cell.mu    | 13 +++++++++++++
 shell/global.mu  | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 shell/sandbox.mu |  2 +-
 3 files changed, 71 insertions(+), 2 deletions(-)

(limited to 'shell')

diff --git a/shell/cell.mu b/shell/cell.mu
index 85596d64..7d04e5db 100644
--- a/shell/cell.mu
+++ b/shell/cell.mu
@@ -169,3 +169,16 @@ fn new-keyboard _out: (addr handle cell), capacity: int {
   var dest-addr/eax: (addr gap-buffer) <- lookup *dest-ah
   initialize-gap-buffer dest-addr, capacity
 }
+
+fn rewind-keyboard-cell _self-ah: (addr handle cell) {
+  var self-ah/eax: (addr handle cell) <- copy _self-ah
+  var self/eax: (addr cell) <- lookup *self-ah
+  compare self, 0
+  {
+    break-if-!=
+    return
+  }
+  var keyboard-ah/eax: (addr handle gap-buffer) <- get self, keyboard-data
+  var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
+  rewind-gap-buffer keyboard
+}
diff --git a/shell/global.mu b/shell/global.mu
index f5d513c5..22b38764 100644
--- a/shell/global.mu
+++ b/shell/global.mu
@@ -22,6 +22,7 @@ fn initialize-globals _self: (addr global-table) {
   append-primitive self, "cons"
   append-primitive self, "="
   append-primitive self, "print"
+  append-primitive self, "key"
 }
 
 fn render-globals screen: (addr screen), _self: (addr global-table), xmin: int, ymin: int, xmax: int, ymax: int {
@@ -293,6 +294,13 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand
     apply-print args-ah, out, env-h, trace
     return
   }
+  {
+    var wait-for-key?/eax: boolean <- string-equal? f-name, "key"
+    compare wait-for-key?, 0/false
+    break-if-=
+    apply-wait-for-key args-ah, out, env-h, trace
+    return
+  }
   abort "unknown primitive function"
 }
 
@@ -647,7 +655,7 @@ fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), env-h: (ha
   compare empty-args?, 0/false
   {
     break-if-=
-    error trace, "cons needs 2 args but got 0"
+    error trace, "print needs 2 args but got 0"
     return
   }
   # screen = args->left
@@ -675,3 +683,51 @@ fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), env-h: (ha
   # return what was printed
   copy-object second-ah, out
 }
+
+fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) {
+  trace-text trace, "eval", "apply key"
+  var args-ah/eax: (addr handle cell) <- copy _args-ah
+  var _args/eax: (addr cell) <- lookup *args-ah
+  var args/esi: (addr cell) <- copy _args
+  var _env/eax: (addr cell) <- lookup env-h
+  var env/edi: (addr cell) <- copy _env
+  # TODO: check that args is a pair
+  var empty-args?/eax: boolean <- nil? args
+  compare empty-args?, 0/false
+  {
+    break-if-=
+    error trace, "key needs 1 arg but got 0"
+    return
+  }
+  # keyboard = args->left
+  var first-ah/eax: (addr handle cell) <- get args, left
+  var first/eax: (addr cell) <- lookup *first-ah
+  var first-type/ecx: (addr int) <- get first, type
+  compare *first-type, 6/keyboard
+  {
+    break-if-=
+    error trace, "first arg for 'key' is not a keyboard"
+    return
+  }
+  var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data
+  var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
+  var keyboard/ecx: (addr gap-buffer) <- copy _keyboard
+  var result/eax: int <- wait-for-key keyboard
+  # return key typed
+  new-integer out, result
+}
+
+fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int {
+  # if keyboard is 0, use real keyboard
+  {
+    compare keyboard, 0/real-keyboard
+    break-if-!=
+    var key/eax: byte <- read-key 0/real-keyboard
+    var result/eax: int <- copy key
+    return result
+  }
+  # otherwise read from fake keyboard
+  var g/eax: grapheme <- read-from-gap-buffer keyboard
+  var result/eax: int <- copy g
+  return result
+}
diff --git a/shell/sandbox.mu b/shell/sandbox.mu
index 53b98844..ad51df8f 100644
--- a/shell/sandbox.mu
+++ b/shell/sandbox.mu
@@ -489,7 +489,7 @@ fn edit-sandbox _self: (addr sandbox), key: byte, globals: (addr global-table),
     var screen-cell/eax: (addr handle cell) <- get self, screen-var
     clear-screen-cell screen-cell
     var keyboard-cell/esi: (addr handle cell) <- get self, keyboard-var
-    # don't clear
+    rewind-keyboard-cell keyboard-cell  # don't clear keys from before
     run data, value, globals, trace, screen-cell, keyboard-cell
     return
   }
-- 
cgit 1.4.1-2-gfad0