summaryrefslogtreecommitdiff
path: root/world/ui.scm
blob: 4fa8b6525900e2659734e67d99ce1494d357e77f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
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))