world: start with world-dependent things: ui

2 files changed, 54 insertions, 0 deletions

diff --git a/world/ui.scm b/world/ui.scm
new file mode 100644
index 0000000..4fa8b65
--- /dev/null
+++ b/world/ui.scm
@@ -0,0 +1,44 @@
+;; https://invisible-island.net/xterm/ctlseqs/ctlseqs.html
+
+;; Clear the screen better:
+;; https://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-The-Alternate-Screen-Buffer
+
+(define csi-lead "\x1b[")
+
+(define (str-csi . args)
+  (apply string-append csi-lead args))
+
+(define (csi-command! . args)
+  (write-string (apply str-csi args))
+  (flush-output-port))
+
+; These are xterm things, but they are widely adopted
+(define (enable-alternate-buffer!)
+  (csi-command! "?1049h"))
+(define (disable-alternate-buffer!)
+  (csi-command! "?1049l"))
+
+(define (erase-screen!) (csi-command! "2J"))
+
+(define (move-cursor! x y)
+  "Also valid with CSI<L>;<C>f being <L> and <C> line number and column
+  number respectively"
+  (csi-command! (number->string y) ";" (number->string x) "H"))
+
+
+(define (echo-char)
+  (define table (make-piece-table "hola"))
+  (display "HELO")
+  (enable-alternate-buffer!)
+  (let loop ((char (read-char)))
+    (cond
+      ((char=? #\q char) #f)
+      (else (piece-table-insert! table 4 "hola" 'normal)
+            (move-cursor! 0 0)
+            (erase-screen!)
+            (write-string (piece-table->string table))
+            (loop (read-char)))))
+  (disable-alternate-buffer!))
+
+(define (start arguments)
+  (with-raw-io (current-input-port) echo-char))
diff --git a/world/ui.sld b/world/ui.sld
new file mode 100644
index 0000000..3a4ae56
--- /dev/null
+++ b/world/ui.sld
@@ -0,0 +1,10 @@
+(define-library (world ui)
+  (import (scheme base)
+          (par piece-table))
+  (cond-expand
+    (chibi (import (scheme small)
+                   (chibi stty)))
+    (guile (import (nothing)))) ; we fail now, but in the future i can build
+                                ; a simple wrapper around termios
+  (export start)
+  (include "ui.scm"))