diff options
| -rw-r--r-- | world/tty-commands.scm | 33 | ||||
| -rw-r--r-- | world/tty-commands.sld | 7 | ||||
| -rw-r--r-- | world/ui.scm | 36 | ||||
| -rw-r--r-- | world/ui.sld | 10 |
4 files changed, 51 insertions, 35 deletions
diff --git a/world/tty-commands.scm b/world/tty-commands.scm new file mode 100644 index 0000000..90d896e --- /dev/null +++ b/world/tty-commands.scm @@ -0,0 +1,33 @@ +;; 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. In ttys, cursor starts at 1,1" + (csi-command! (number->string (+ y 1)) ";" (number->string (+ 1 x)) "H")) + +(define (ui-initialize!) + (enable-alternate-buffer!) + (move-cursor! 0 0)) + +(define (ui-deinitialize!) + (disable-alternate-buffer!)) diff --git a/world/tty-commands.sld b/world/tty-commands.sld new file mode 100644 index 0000000..503b6bb --- /dev/null +++ b/world/tty-commands.sld @@ -0,0 +1,7 @@ +(define-library (world tty-commands) + (import (scheme base)) + (export ui-initialize! + ui-deinitialize! + move-cursor! + erase-screen!) + (include "tty-commands.scm")) diff --git a/world/ui.scm b/world/ui.scm index 4fa8b65..40d4e69 100644 --- a/world/ui.scm +++ b/world/ui.scm @@ -1,44 +1,20 @@ -;; 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!) + (ui-initialize!) (let loop ((char (read-char))) + (move-cursor! 0 0) (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!)) + (ui-deinitialize!)) (define (start arguments) (with-raw-io (current-input-port) echo-char)) + +;; Extend `with-raw-io` with the initialization functions and just move to a +;; `with-tui` function that calls the provided thunk in the proper mode diff --git a/world/ui.sld b/world/ui.sld index 3a4ae56..1f2eda9 100644 --- a/world/ui.sld +++ b/world/ui.sld @@ -1,10 +1,10 @@ (define-library (world ui) (import (scheme base) - (par piece-table)) + (world tty-commands) + (par piece-table)) ;; Remove the piece table from here later, and move to main (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 + (chibi (import (chibi stty))) + (guile (import ()))) ; we fail now, but in the future i can build + ; a simple wrapper around termios (export start) (include "ui.scm")) |