Commit735b0df1Recorded26 Feb 2026Repositorysigil-tui

Add layout, components, input, and main module for sigil-tui

Message

Layout algorithm divides screen rectangles via horizontal/vertical splits, panels, and leaf widgets. Components render each widget type into the character grid. Input module provides Emacs-style text editing. Main tui module ties everything into a run loop with double-buffered grid diffing.

Changed
 src/sigil/tui.sgl            | 170 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/sigil/tui/components.sgl | 218 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/sigil/tui/event.sgl      |   1 +
 src/sigil/tui/input.sgl      | 161 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/sigil/tui/layout.sgl     | 150 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 test/test-input.sgl          | 102 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 test/test-layout.sgl         |  68 +++++++++++++++++++++++++++++++++++++++++++++++++++
 7 files changed, 870 insertions(+)
Diff
src/sigil/tui.sgladded
@@ -0,0 +1,170 @@
+1
;;; (sigil tui) - Terminal UI toolkit main module
+2
;;;
+3
;;; Ties together terminal control, event parsing, grid rendering,
+4
;;; layout, and components into a main loop.
+5
;;;
+6
;;; ```scheme
+7
;;; (import (sigil tui))
+8
;;;
+9
;;; (tui-run
+10
;;; (lambda (state)
+11
;;; (vertical-split 0.9
+12
;;; (panel "Hello" (text-block '(("Welcome to TUI!"))))
+13
;;; (status-bar "ready" "" "Ctrl-Q quit")))
+14
;;; initial-state: my-state
+15
;;; on-event: (lambda (state event) state)
+16
;;; fps: 30)
+17
;;; ```
+18
+19
(define-library (sigil tui)
+20
(import (sigil core)
+21
(sigil math)
+22
(sigil io)
+23
(sigil socket)
+24
(sigil terminal)
+25
(sigil tui terminal)
+26
(sigil tui event)
+27
(sigil tui grid)
+28
(sigil tui layout)
+29
(sigil tui components)
+30
(sigil tui input))
+31
+32
;; Re-export everything needed to build TUI apps
+33
(export
+34
;; Main loop
+35
tui-run
+36
+37
;; Terminal control (from tui terminal)
+38
with-terminal
+39
alternate-screen-on alternate-screen-off
+40
enable-mouse-tracking disable-mouse-tracking
+41
terminal-columns terminal-rows
+42
+43
;; Events (from tui event)
+44
make-parser-state parse-input
+45
key-event? mouse-event? resize-event?
+46
key-event-key key-event-modifier
+47
mouse-event-type mouse-event-col mouse-event-row
+48
+49
;; Grid (from tui grid)
+50
make-grid grid-width grid-height
+51
grid-ref grid-set! grid-clear! grid-write-string!
+52
grid-fill-rect! grid-diff grid-copy
+53
make-cell default-cell cell-char cell-fg cell-bg cell-attrs cell=?
+54
color-256 color-rgb
+55
color-default color-black color-red color-green color-yellow
+56
color-blue color-magenta color-cyan color-white
+57
color-bright-black color-bright-red color-bright-green color-bright-yellow
+58
color-bright-blue color-bright-magenta color-bright-cyan color-bright-white
+59
attr-none attr-bold attr-dim attr-italic
+60
attr-underline attr-inverse attr-strikethrough
+61
+62
;; Layout (from tui layout)
+63
horizontal-split vertical-split
+64
panel text-block selectable-list scrollable
+65
status-bar text-input-widget filler
+66
layout-tree
+67
+68
;; Components (from tui components)
+69
render-commands
+70
+71
;; Input (from tui input)
+72
make-input-state input-value input-cursor
+73
input-set-value! input-set-cursor! input-handle-key input-clear!)
+74
+75
(begin
+76
+77
;; Get an option from a keyword argument list
+78
(define (get-option opts key default)
+79
(cond
+80
((null? opts) default)
+81
((null? (cdr opts)) default)
+82
((eq? (car opts) key) (cadr opts))
+83
(else (get-option (cddr opts) key default))))
+84
+85
;; Process a list of events through the on-event handler
+86
(define (process-events state events on-event)
+87
(if (or (null? events) (not on-event))
+88
state
+89
(let ((new-state (on-event state (car events))))
+90
(if (eq? new-state 'quit)
+91
'quit
+92
(process-events new-state (cdr events) on-event)))))
+93
+94
;; Single frame: render, diff, write, wait for input, recurse
+95
(define (run-frame render on-event state parser prev curr
+96
cols rows frame-ms)
+97
;; Handle resize
+98
(let* ((resize-info (if (signal-pending? 'winch)
+99
(terminal-size)
+100
#f))
+101
(cols (if resize-info (car resize-info) cols))
+102
(rows (if resize-info (cdr resize-info) rows))
+103
(prev (if resize-info (make-grid cols rows) prev))
+104
(curr (if resize-info (make-grid cols rows) curr)))
+105
(when resize-info
+106
(terminal-write-raw "\x1b;[2J"))
+107
+108
;; Handle interrupt
+109
(if (signal-pending? 'int)
+110
state
+111
(begin
+112
;; Render current frame
+113
(grid-clear! curr)
+114
(let* ((tree (render state))
+115
(commands (layout-tree tree 0 0 cols rows)))
+116
(render-commands curr commands))
+117
+118
;; Diff and write
+119
(let ((diff-str (grid-diff prev curr)))
+120
(when (> (string-length diff-str) 0)
+121
(terminal-write-raw diff-str)))
+122
+123
;; Swap buffers
+124
(let* ((new-prev (grid-copy curr))
+125
;; Wait for input with frame timeout
+126
(ready (fd-select (list 0) '() frame-ms)))
+127
(if (and ready (pair? (car ready)))
+128
;; Input available
+129
(let ((raw (terminal-read-raw 256)))
+130
(if raw
+131
(let ((new-state (process-events
+132
state
+133
(parse-input parser raw)
+134
on-event)))
+135
(if (eq? new-state 'quit)
+136
new-state
+137
(run-frame render on-event new-state parser
+138
new-prev curr cols rows frame-ms)))
+139
(run-frame render on-event state parser
+140
new-prev curr cols rows frame-ms)))
+141
;; Timeout - redraw next frame
+142
(run-frame render on-event state parser
+143
new-prev curr cols rows frame-ms)))))))
+144
+145
;;; Run a TUI application.
+146
;;;
+147
;;; render: (state) -> UI tree (layout description)
+148
;;; initial-state: starting application state
+149
;;; on-event: (state event) -> new-state (or 'quit to exit)
+150
;;; fps: target frames per second (default 30)
+151
(define (tui-run render . options)
+152
(: procedure? any? ... -> any?)
+153
(let ((initial-state (get-option options 'initial-state: #f))
+154
(on-event (get-option options 'on-event: #f))
+155
(fps (get-option options 'fps: 30)))
+156
(with-terminal
+157
(lambda ()
+158
(set-signal-handler! 'winch)
+159
(set-signal-handler! 'int)
+160
(enable-mouse-tracking)
+161
(let* ((size (terminal-size))
+162
(cols (car size))
+163
(rows (cdr size))
+164
(frame-ms (exact (floor (/ 1000 fps)))))
+165
(run-frame render on-event
+166
initial-state
+167
(make-parser-state)
+168
(make-grid cols rows)
+169
(make-grid cols rows)
+170
cols rows frame-ms))))))))
src/sigil/tui/components.sgladded
@@ -0,0 +1,218 @@
+1
;;; (sigil tui components) - Component rendering into grid
+2
;;;
+3
;;; Renders layout commands produced by (sigil tui layout) into a
+4
;;; character grid. Each component type draws its content at the
+5
;;; allocated rectangle.
+6
+7
(define-library (sigil tui components)
+8
(import (sigil core)
+9
(scheme cxr)
+10
(sigil string)
+11
(sigil math)
+12
(sigil tui grid))
+13
+14
(export render-commands)
+15
+16
(begin
+17
+18
;; ============================================================
+19
;; Box-drawing characters
+20
;; ============================================================
+21
+22
(define box-h #\x2500) ;; ─
+23
(define box-v #\x2502) ;; │
+24
(define box-tl #\x250C) ;; ┌
+25
(define box-tr #\x2510) ;; ┐
+26
(define box-bl #\x2514) ;; └
+27
(define box-br #\x2518) ;; ┘
+28
+29
;; ============================================================
+30
;; Component renderers
+31
;; ============================================================
+32
+33
;; Render a panel border with optional title
+34
(define (render-panel grid x y w h title)
+35
(when (and (> w 0) (> h 0))
+36
;; Top border
+37
(grid-set! grid x y (make-cell box-tl color-default color-default attr-none))
+38
(let loop ((c (+ x 1)))
+39
(when (< c (+ x w -1))
+40
(grid-set! grid c y (make-cell box-h color-default color-default attr-none))
+41
(loop (+ c 1))))
+42
(when (> w 1)
+43
(grid-set! grid (+ x w -1) y (make-cell box-tr color-default color-default attr-none)))
+44
+45
;; Title (centered in top border)
+46
(when (and title (> (string-length title) 0) (> w 4))
+47
(let* ((tlen (string-length title))
+48
(max-title (- w 4))
+49
(display-title (if (> tlen max-title)
+50
(substring title 0 max-title)
+51
title))
+52
(dlen (string-length display-title))
+53
(start (+ x 2)))
+54
(grid-set! grid (- start 1) y
+55
(make-cell #\space color-default color-default attr-none))
+56
(let loop ((i 0))
+57
(when (< i dlen)
+58
(grid-set! grid (+ start i) y
+59
(make-cell (string-ref display-title i)
+60
color-default color-default attr-bold))
+61
(loop (+ i 1))))
+62
(grid-set! grid (+ start dlen) y
+63
(make-cell #\space color-default color-default attr-none))))
+64
+65
;; Side borders
+66
(let loop ((r (+ y 1)))
+67
(when (< r (+ y h -1))
+68
(grid-set! grid x r (make-cell box-v color-default color-default attr-none))
+69
(when (> w 1)
+70
(grid-set! grid (+ x w -1) r (make-cell box-v color-default color-default attr-none)))
+71
(loop (+ r 1))))
+72
+73
;; Bottom border
+74
(when (> h 1)
+75
(grid-set! grid x (+ y h -1) (make-cell box-bl color-default color-default attr-none))
+76
(let loop ((c (+ x 1)))
+77
(when (< c (+ x w -1))
+78
(grid-set! grid c (+ y h -1) (make-cell box-h color-default color-default attr-none))
+79
(loop (+ c 1))))
+80
(when (> w 1)
+81
(grid-set! grid (+ x w -1) (+ y h -1)
+82
(make-cell box-br color-default color-default attr-none))))))
+83
+84
;; Render text lines
+85
;; Each line is (string fg bg attrs) or just a string
+86
(define (render-text grid x y w h lines)
+87
(let loop ((row 0) (remaining lines))
+88
(when (and (< row h) (pair? remaining))
+89
(let ((line (car remaining)))
+90
(if (pair? line)
+91
(let ((str (car line))
+92
(fg (cadr line))
+93
(bg (caddr line))
+94
(attrs (cadddr line)))
+95
(grid-write-string! grid x (+ y row) str fg bg attrs))
+96
;; Plain string
+97
(grid-write-string! grid x (+ y row) line color-default color-default attr-none)))
+98
(loop (+ row 1) (cdr remaining)))))
+99
+100
;; Render a selectable list with highlight
+101
(define (render-select-list grid x y w h items selected)
+102
(let* ((count (length items))
+103
;; Scroll to keep selected visible
+104
(scroll (if (< selected h) 0
+105
(min (- count h) (max 0 (- selected (quotient h 2)))))))
+106
(let loop ((row 0) (idx scroll))
+107
(when (and (< row h) (< idx count))
+108
(let* ((item (list-ref items idx))
+109
(str (if (pair? item) (car item) item))
+110
(base-fg (if (pair? item) (cadr item) color-default))
+111
(base-bg (if (pair? item) (caddr item) color-default))
+112
(base-attrs (if (pair? item) (cadddr item) attr-none))
+113
(is-selected (= idx selected))
+114
(fg (if is-selected base-bg base-fg))
+115
(bg (if is-selected
+116
(if (= base-fg color-default) color-white base-fg)
+117
base-bg))
+118
(attrs (if is-selected
+119
(bitwise-ior base-attrs attr-inverse)
+120
base-attrs))
+121
;; Pad or truncate to width
+122
(slen (string-length str))
+123
(display-str (if (> slen w) (substring str 0 w) str)))
+124
;; Write the string
+125
(grid-write-string! grid x (+ y row) display-str fg bg attrs)
+126
;; Fill remaining width for selected item
+127
(when is-selected
+128
(let pad ((c (+ x slen)))
+129
(when (< c (+ x w))
+130
(grid-set! grid c (+ y row)
+131
(make-cell #\space fg bg attrs))
+132
(pad (+ c 1))))))
+133
(loop (+ row 1) (+ idx 1))))))
+134
+135
;; Render scrollable content
+136
(define (render-scrollable grid x y w h child offset)
+137
;; child is a text-block description (text lines)
+138
(when (eq? (car child) 'text)
+139
(let* ((all-lines (cadr child))
+140
(visible (list-tail-safe all-lines offset)))
+141
(render-text grid x y w h visible))))
+142
+143
;; Safe list-tail that returns '() if index exceeds list
+144
(define (list-tail-safe lst n)
+145
(if (or (<= n 0) (null? lst))
+146
lst
+147
(list-tail-safe (cdr lst) (- n 1))))
+148
+149
;; Render status bar (inverse colors, full width)
+150
(define (render-status-bar grid x y w h left center right)
+151
(when (> h 0)
+152
;; Fill entire row with inverse
+153
(let loop ((c x))
+154
(when (< c (+ x w))
+155
(grid-set! grid c y (make-cell #\space color-default color-default attr-inverse))
+156
(loop (+ c 1))))
+157
;; Left text
+158
(grid-write-string! grid x y left color-default color-default attr-inverse)
+159
;; Center text
+160
(let ((cstart (+ x (max 0 (quotient (- w (string-length center)) 2)))))
+161
(grid-write-string! grid cstart y center color-default color-default attr-inverse))
+162
;; Right text
+163
(let ((rstart (+ x (max 0 (- w (string-length right))))))
+164
(grid-write-string! grid rstart y right color-default color-default attr-inverse))))
+165
+166
;; Render text input
+167
(define (render-text-input grid x y w h prompt value cursor)
+168
(when (> h 0)
+169
(let* ((plen (string-length prompt))
+170
(available (- w plen))
+171
(vlen (string-length value))
+172
;; Scroll input if cursor is past visible area
+173
(scroll (max 0 (- cursor (- available 1))))
+174
(visible-val (if (> vlen scroll)
+175
(let ((end (min vlen (+ scroll available))))
+176
(substring value scroll end))
+177
"")))
+178
;; Write prompt
+179
(grid-write-string! grid x y prompt color-cyan color-default attr-bold)
+180
;; Write visible value
+181
(grid-write-string! grid (+ x plen) y visible-val
+182
color-default color-default attr-none)
+183
;; Clear remaining space
+184
(let loop ((c (+ x plen (string-length visible-val))))
+185
(when (< c (+ x w))
+186
(grid-set! grid c y (make-cell #\space color-default color-default attr-none))
+187
(loop (+ c 1)))))))
+188
+189
;; ============================================================
+190
;; Main render dispatcher
+191
;; ============================================================
+192
+193
;;; Render a list of layout commands into a grid.
+194
(define (render-commands grid commands)
+195
(: vector? list? -> void?)
+196
(for-each
+197
(lambda (cmd)
+198
(let* ((type (car cmd))
+199
(x (cadr cmd))
+200
(y (caddr cmd))
+201
(w (cadddr cmd))
+202
(tail (cdr (cdddr cmd)))
+203
(h (car tail))
+204
(rest (cdr tail)))
+205
(case type
+206
((render-panel)
+207
(render-panel grid x y w h (car rest)))
+208
((render-text)
+209
(render-text grid x y w h (car rest)))
+210
((render-select-list)
+211
(render-select-list grid x y w h (car rest) (cadr rest)))
+212
((render-scrollable)
+213
(render-scrollable grid x y w h (car rest) (cadr rest)))
+214
((render-status-bar)
+215
(render-status-bar grid x y w h (car rest) (cadr rest) (caddr rest)))
+216
((render-text-input)
+217
(render-text-input grid x y w h (car rest) (cadr rest) (caddr rest))))))
+218
commands))))
src/sigil/tui/event.sglmodified
@@ -17,6 +17,7 @@
17
18
(define-library (sigil tui event)
19
(import (sigil core)
+20
(scheme cxr)
21
(sigil string)
22
(sigil math))
23
src/sigil/tui/input.sgladded
@@ -0,0 +1,161 @@
+1
;;; (sigil tui input) - Text input widget
+2
;;;
+3
;;; Mutable input state with Emacs-style keybindings for single-line
+4
;;; text editing. Handles cursor movement, deletion, and text insertion.
+5
+6
(define-library (sigil tui input)
+7
(import (sigil core)
+8
(sigil string)
+9
(sigil tui event))
+10
+11
(export make-input-state
+12
input-value
+13
input-cursor
+14
input-set-value!
+15
input-set-cursor!
+16
input-handle-key
+17
input-clear!)
+18
+19
(begin
+20
+21
;; Input state: #(value cursor)
+22
;; value is a string, cursor is an integer position
+23
+24
;;; Create a new input state with empty value.
+25
(define (make-input-state)
+26
(: -> vector?)
+27
(vector "" 0))
+28
+29
;;; Get the current input value.
+30
(define (input-value state)
+31
(: vector? -> string?)
+32
(vector-ref state 0))
+33
+34
;;; Get the current cursor position.
+35
(define (input-cursor state)
+36
(: vector? -> integer?)
+37
(vector-ref state 1))
+38
+39
;;; Set the input value.
+40
(define (input-set-value! state val)
+41
(: vector? string? -> void?)
+42
(vector-set! state 0 val))
+43
+44
;;; Set the cursor position.
+45
(define (input-set-cursor! state pos)
+46
(: vector? integer? -> void?)
+47
(vector-set! state 1 pos))
+48
+49
;;; Clear the input.
+50
(define (input-clear! state)
+51
(: vector? -> void?)
+52
(vector-set! state 0 "")
+53
(vector-set! state 1 0))
+54
+55
;; ============================================================
+56
;; Key handling
+57
;; ============================================================
+58
+59
;;; Handle a key event, returning a symbol or #f.
+60
;;;
+61
;;; Returns 'submit when Enter is pressed, #f otherwise.
+62
;;; Modifies the input state in place.
+63
(define (input-handle-key state event)
+64
(: vector? list? -> any?)
+65
(let ((key (key-event-key event))
+66
(mod (key-event-modifier event))
+67
(val (input-value state))
+68
(pos (input-cursor state)))
+69
(cond
+70
;; Enter → submit
+71
((eq? key 'enter)
+72
'submit)
+73
+74
;; Regular character insertion
+75
((and (char? key) (not mod))
+76
(let ((new-val (string-append (substring val 0 pos)
+77
(string key)
+78
(substring val pos (string-length val)))))
+79
(input-set-value! state new-val)
+80
(input-set-cursor! state (+ pos 1))
+81
#f))
+82
+83
;; Backspace — delete char before cursor
+84
((eq? key 'backspace)
+85
(when (> pos 0)
+86
(input-set-value! state
+87
(string-append (substring val 0 (- pos 1))
+88
(substring val pos (string-length val))))
+89
(input-set-cursor! state (- pos 1)))
+90
#f)
+91
+92
;; Delete — delete char at cursor
+93
((eq? key 'delete)
+94
(when (< pos (string-length val))
+95
(input-set-value! state
+96
(string-append (substring val 0 pos)
+97
(substring val (+ pos 1) (string-length val)))))
+98
#f)
+99
+100
;; Left arrow — move cursor left
+101
((eq? key 'left)
+102
(when (> pos 0)
+103
(input-set-cursor! state (- pos 1)))
+104
#f)
+105
+106
;; Right arrow — move cursor right
+107
((eq? key 'right)
+108
(when (< pos (string-length val))
+109
(input-set-cursor! state (+ pos 1)))
+110
#f)
+111
+112
;; Home / Ctrl-A — beginning of line
+113
((or (eq? key 'home)
+114
(and (eqv? key #\a) (eq? mod 'ctrl)))
+115
(input-set-cursor! state 0)
+116
#f)
+117
+118
;; End / Ctrl-E — end of line
+119
((or (eq? key 'end)
+120
(and (eqv? key #\e) (eq? mod 'ctrl)))
+121
(input-set-cursor! state (string-length val))
+122
#f)
+123
+124
;; Ctrl-K — kill forward (delete from cursor to end)
+125
((and (eqv? key #\k) (eq? mod 'ctrl))
+126
(input-set-value! state (substring val 0 pos))
+127
#f)
+128
+129
;; Ctrl-U — kill backward (delete from start to cursor)
+130
((and (eqv? key #\u) (eq? mod 'ctrl))
+131
(input-set-value! state (substring val pos (string-length val)))
+132
(input-set-cursor! state 0)
+133
#f)
+134
+135
;; Ctrl-W — kill word backward
+136
((and (eqv? key #\w) (eq? mod 'ctrl))
+137
(let ((word-start (find-word-boundary-back val pos)))
+138
(input-set-value! state
+139
(string-append (substring val 0 word-start)
+140
(substring val pos (string-length val))))
+141
(input-set-cursor! state word-start))
+142
#f)
+143
+144
(else #f))))
+145
+146
;; Find the start of the previous word (for Ctrl-W)
+147
(define (find-word-boundary-back str pos)
+148
(if (<= pos 0) 0
+149
;; Skip trailing spaces
+150
(let skip-spaces ((i (- pos 1)))
+151
(cond
+152
((<= i 0) 0)
+153
((char=? (string-ref str i) #\space)
+154
(skip-spaces (- i 1)))
+155
(else
+156
;; Skip word chars
+157
(let skip-word ((i i))
+158
(cond
+159
((<= i 0) 0)
+160
((char=? (string-ref str i) #\space) (+ i 1))
+161
(else (skip-word (- i 1))))))))))))
src/sigil/tui/layout.sgladded
@@ -0,0 +1,150 @@
+1
;;; (sigil tui layout) - Layout algorithm for TUI components
+2
;;;
+3
;;; UI descriptions are tagged lists returned by constructor functions.
+4
;;; The layout algorithm recursively divides available rectangles and
+5
;;; produces a flat list of render commands: (render-type x y w h ...)
+6
;;;
+7
;;; ```scheme
+8
;;; (vertical-split 0.3
+9
;;; (panel "Roster" (selectable-list contacts selected))
+10
;;; (panel "Chat" (text messages)))
+11
;;; ```
+12
+13
(define-library (sigil tui layout)
+14
(import (sigil core)
+15
(scheme cxr)
+16
(sigil math))
+17
+18
(export horizontal-split
+19
vertical-split
+20
panel
+21
text-block
+22
selectable-list
+23
scrollable
+24
status-bar
+25
text-input-widget
+26
filler
+27
layout-tree)
+28
+29
(begin
+30
+31
;; ============================================================
+32
;; UI description constructors
+33
;; ============================================================
+34
+35
;;; Split space horizontally (side by side) at the given ratio.
+36
;;; ratio is the fraction of width for the left child (0.0-1.0).
+37
(define (horizontal-split ratio left right)
+38
(: number? list? list? -> list?)
+39
(list 'hsplit ratio left right))
+40
+41
;;; Split space vertically (top/bottom) at the given ratio.
+42
;;; ratio is the fraction of height for the top child (0.0-1.0).
+43
(define (vertical-split ratio top bottom)
+44
(: number? list? list? -> list?)
+45
(list 'vsplit ratio top bottom))
+46
+47
;;; A bordered panel with an optional title. Insets child by 1 on all sides.
+48
(define (panel title child)
+49
(: string? list? -> list?)
+50
(list 'panel title child))
+51
+52
;;; A block of text lines with style.
+53
;;; lines is a list of (string fg bg attrs) tuples.
+54
(define (text-block lines)
+55
(: list? -> list?)
+56
(list 'text lines))
+57
+58
;;; A selectable list of items with a highlight index.
+59
;;; items is a list of (string fg bg attrs) tuples.
+60
(define (selectable-list items selected)
+61
(: list? integer? -> list?)
+62
(list 'select-list items selected))
+63
+64
;;; A scrollable view with a scroll offset.
+65
;;; child is a text-block or similar content widget.
+66
(define (scrollable child offset)
+67
(: list? integer? -> list?)
+68
(list 'scrollable child offset))
+69
+70
;;; A status bar with left, center, and right text.
+71
(define (status-bar left center right)
+72
(: string? string? string? -> list?)
+73
(list 'status-bar left center right))
+74
+75
;;; A text input widget showing the current input state.
+76
;;; prompt is the prompt string, value is current text,
+77
;;; cursor is cursor position in value.
+78
(define (text-input-widget prompt value cursor)
+79
(: string? string? integer? -> list?)
+80
(list 'text-input prompt value cursor))
+81
+82
;;; An empty filler that takes up space.
+83
(define (filler)
+84
(: -> list?)
+85
(list 'filler))
+86
+87
;; ============================================================
+88
;; Layout algorithm
+89
;; ============================================================
+90
+91
;;; Lay out a UI tree into a flat list of render commands.
+92
;;;
+93
;;; Each render command is (type x y w h ...extra-data).
+94
;;; The renderer processes these sequentially to draw into the grid.
+95
(define (layout-tree tree x y w h)
+96
(: list? integer? integer? integer? integer? -> list?)
+97
(if (or (<= w 0) (<= h 0))
+98
'()
+99
(let ((type (car tree)))
+100
(case type
+101
((hsplit)
+102
(let* ((ratio (cadr tree))
+103
(left-child (caddr tree))
+104
(right-child (cadddr tree))
+105
(left-w (max 1 (exact (floor (* w ratio)))))
+106
(right-w (- w left-w)))
+107
(append (layout-tree left-child x y left-w h)
+108
(layout-tree right-child (+ x left-w) y right-w h))))
+109
+110
((vsplit)
+111
(let* ((ratio (cadr tree))
+112
(top-child (caddr tree))
+113
(bottom-child (cadddr tree))
+114
(top-h (max 1 (exact (floor (* h ratio)))))
+115
(bottom-h (- h top-h)))
+116
(append (layout-tree top-child x y w top-h)
+117
(layout-tree bottom-child x (+ y top-h) w bottom-h))))
+118
+119
((panel)
+120
(let ((title (cadr tree))
+121
(child (caddr tree)))
+122
(if (or (< w 3) (< h 3))
+123
;; Too small for a panel — just render the border
+124
(list (list 'render-panel x y w h title))
+125
(cons (list 'render-panel x y w h title)
+126
(layout-tree child (+ x 1) (+ y 1) (- w 2) (- h 2))))))
+127
+128
((text)
+129
(list (list 'render-text x y w h (cadr tree))))
+130
+131
((select-list)
+132
(list (list 'render-select-list x y w h (cadr tree) (caddr tree))))
+133
+134
((scrollable)
+135
(let* ((child (cadr tree))
+136
(offset (caddr tree)))
+137
(list (list 'render-scrollable x y w h child offset))))
+138
+139
((status-bar)
+140
(list (list 'render-status-bar x y w h
+141
(cadr tree) (caddr tree) (cadddr tree))))
+142
+143
((text-input)
+144
(list (list 'render-text-input x y w h
+145
(cadr tree) (caddr tree) (cadddr tree))))
+146
+147
((filler)
+148
'())
+149
+150
(else '())))))))
test/test-input.sgladded
@@ -0,0 +1,102 @@
+1
(import (sigil test)
+2
(sigil tui event)
+3
(sigil tui input))
+4
+5
(test-group "text input"
+6
+7
(test-group "basic operations"
+8
(test "initial state is empty"
+9
(let ((state (make-input-state)))
+10
(assert-equal "" (input-value state))
+11
(assert-equal 0 (input-cursor state))))
+12
+13
(test "type characters"
+14
(let ((state (make-input-state)))
+15
(input-handle-key state '(key #\h))
+16
(input-handle-key state '(key #\i))
+17
(assert-equal "hi" (input-value state))
+18
(assert-equal 2 (input-cursor state))))
+19
+20
(test "enter returns submit"
+21
(let ((state (make-input-state)))
+22
(input-handle-key state '(key #\h))
+23
(assert-equal 'submit (input-handle-key state '(key enter))))))
+24
+25
(test-group "deletion"
+26
(test "backspace"
+27
(let ((state (make-input-state)))
+28
(input-handle-key state '(key #\a))
+29
(input-handle-key state '(key #\b))
+30
(input-handle-key state '(key #\c))
+31
(input-handle-key state '(key backspace))
+32
(assert-equal "ab" (input-value state))
+33
(assert-equal 2 (input-cursor state))))
+34
+35
(test "delete"
+36
(let ((state (make-input-state)))
+37
(input-handle-key state '(key #\a))
+38
(input-handle-key state '(key #\b))
+39
(input-handle-key state '(key left))
+40
(input-handle-key state '(key delete))
+41
(assert-equal "a" (input-value state))
+42
(assert-equal 1 (input-cursor state)))))
+43
+44
(test-group "cursor movement"
+45
(test "left and right arrows"
+46
(let ((state (make-input-state)))
+47
(input-handle-key state '(key #\a))
+48
(input-handle-key state '(key #\b))
+49
(input-handle-key state '(key left))
+50
(assert-equal 1 (input-cursor state))
+51
(input-handle-key state '(key right))
+52
(assert-equal 2 (input-cursor state))))
+53
+54
(test "left at start stays at 0"
+55
(let ((state (make-input-state)))
+56
(input-handle-key state '(key left))
+57
(assert-equal 0 (input-cursor state))))
+58
+59
(test "Ctrl-A goes to beginning"
+60
(let ((state (make-input-state)))
+61
(input-handle-key state '(key #\h))
+62
(input-handle-key state '(key #\i))
+63
(input-handle-key state '(key #\a ctrl))
+64
(assert-equal 0 (input-cursor state))))
+65
+66
(test "Ctrl-E goes to end"
+67
(let ((state (make-input-state)))
+68
(input-handle-key state '(key #\h))
+69
(input-handle-key state '(key #\i))
+70
(input-handle-key state '(key #\a ctrl))
+71
(input-handle-key state '(key #\e ctrl))
+72
(assert-equal 2 (input-cursor state)))))
+73
+74
(test-group "kill operations"
+75
(test "Ctrl-K kills forward"
+76
(let ((state (make-input-state)))
+77
(input-handle-key state '(key #\a))
+78
(input-handle-key state '(key #\b))
+79
(input-handle-key state '(key #\c))
+80
(input-handle-key state '(key #\a ctrl)) ;; go to start
+81
(input-handle-key state '(key right)) ;; move to pos 1
+82
(input-handle-key state '(key #\k ctrl))
+83
(assert-equal "a" (input-value state))
+84
(assert-equal 1 (input-cursor state))))
+85
+86
(test "Ctrl-U kills backward"
+87
(let ((state (make-input-state)))
+88
(input-handle-key state '(key #\a))
+89
(input-handle-key state '(key #\b))
+90
(input-handle-key state '(key #\c))
+91
(input-handle-key state '(key #\u ctrl))
+92
(assert-equal "" (input-value state))
+93
(assert-equal 0 (input-cursor state)))))
+94
+95
(test-group "clear"
+96
(test "input-clear! resets everything"
+97
(let ((state (make-input-state)))
+98
(input-handle-key state '(key #\x))
+99
(input-handle-key state '(key #\y))
+100
(input-clear! state)
+101
(assert-equal "" (input-value state))
+102
(assert-equal 0 (input-cursor state))))))
test/test-layout.sgladded
@@ -0,0 +1,68 @@
+1
(import (sigil test)
+2
(sigil tui layout))
+3
+4
(test-group "layout"
+5
+6
(test-group "horizontal split"
+7
(test "splits width by ratio"
+8
(let* ((tree (horizontal-split 0.5
+9
(filler) (filler)))
+10
(cmds (layout-tree tree 0 0 80 24)))
+11
;; Should produce no render commands (fillers are empty)
+12
(assert-equal 0 (length cmds))))
+13
+14
(test "split with panels"
+15
(let* ((tree (horizontal-split 0.25
+16
(panel "Left" (filler))
+17
(panel "Right" (filler))))
+18
(cmds (layout-tree tree 0 0 80 24)))
+19
;; Should produce 2 panel render commands
+20
(assert-equal 2 (length cmds))
+21
;; First panel gets 20 cols (25% of 80)
+22
(let ((left-cmd (car cmds)))
+23
(assert-equal 'render-panel (car left-cmd))
+24
(assert-equal 0 (cadr left-cmd)) ;; x
+25
(assert-equal 20 (cadddr left-cmd))) ;; w
+26
;; Second panel gets remaining 60 cols
+27
(let ((right-cmd (cadr cmds)))
+28
(assert-equal 20 (cadr right-cmd)) ;; x
+29
(assert-equal 60 (cadddr right-cmd)))))) ;; w
+30
+31
(test-group "vertical split"
+32
(test "splits height by ratio"
+33
(let* ((tree (vertical-split 0.5
+34
(panel "Top" (filler))
+35
(panel "Bottom" (filler))))
+36
(cmds (layout-tree tree 0 0 80 24)))
+37
(assert-equal 2 (length cmds))
+38
;; First panel gets 12 rows
+39
(let ((top-cmd (car cmds)))
+40
(assert-equal 'render-panel (car top-cmd))))))
+41
+42
(test-group "panel"
+43
(test "panel with text child"
+44
(let* ((tree (panel "Test" (text-block '(("Hello")))))
+45
(cmds (layout-tree tree 0 0 40 10)))
+46
;; Panel + text inside
+47
(assert-equal 2 (length cmds))
+48
(assert-equal 'render-panel (car (car cmds)))
+49
(assert-equal 'render-text (car (cadr cmds)))
+50
;; Text is inset by 1
+51
(assert-equal 1 (cadr (cadr cmds))) ;; x=1
+52
(assert-equal 1 (caddr (cadr cmds)))))) ;; y=1
+53
+54
(test-group "status bar"
+55
(test "status bar layout"
+56
(let* ((tree (status-bar "left" "center" "right"))
+57
(cmds (layout-tree tree 0 0 80 1)))
+58
(assert-equal 1 (length cmds))
+59
(assert-equal 'render-status-bar (car (car cmds))))))
+60
+61
(test-group "zero dimensions"
+62
(test "zero width produces no commands"
+63
(let ((cmds (layout-tree (panel "X" (filler)) 0 0 0 10)))
+64
(assert-equal 0 (length cmds))))
+65
+66
(test "zero height produces no commands"
+67
(let ((cmds (layout-tree (panel "X" (filler)) 0 0 10 0)))
+68
(assert-equal 0 (length cmds))))))