From 6cbfd6331287827fc14791e387c48e97656445c1 Mon Sep 17 00:00:00 2001 From: Ekaitz Zarraga Date: Mon, 15 Jan 2024 19:19:57 +0100 Subject: world: start with world-dependent things: ui --- world/ui.scm | 44 ++++++++++++++++++++++++++++++++++++++++++++ world/ui.sld | 10 ++++++++++ 2 files changed, 54 insertions(+) create mode 100644 world/ui.scm create mode 100644 world/ui.sld 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;f being and 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")) -- cgit v1.2.3