Commit20e8c5afRecorded26 Feb 2026Repositorysigil-tui
Add character grid with cell-level diffing for sigil-tui
Message
Grid stores cells as #(char fg bg attrs) vectors in a flat row-major array. Supports default/256/truecolor colors with compact integer encoding. Diff algorithm tracks cursor position and last-emitted style to minimize output. Includes grid-write-string!, grid-fill-rect!, grid-copy. 16 tests.
Changed
src/sigil/tui/grid.sgl | 385 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
test/test-grid.sgl | 132 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 517 insertions(+)Diff
src/sigil/tui/grid.sgladded
@@ -0,0 +1,385 @@
+1
;;; (sigil tui grid) - Character grid with cell-level diffing+2
;;;+3
;;; Provides a double-buffered character grid for efficient terminal rendering.+4
;;; Each cell stores a character, foreground color, background color, and+5
;;; text attributes. The diff algorithm emits minimal ANSI escape sequences+6
;;; to update only changed cells.+7
;;;+8
;;; Color encoding:+9
;;; - -1 = default terminal color+10
;;; - 0-7 = standard colors (black, red, green, yellow, blue, magenta, cyan, white)+11
;;; - 8-15 = bright colors+12
;;; - 16-255 = 256-color palette+13
;;; - >= 256 = truecolor RGB (pack with color-rgb)+14
+15
(define-library (sigil tui grid)+16
(import (sigil core)+17
(sigil io)+18
(sigil string)+19
(sigil math)+20
(sigil terminal))+21
+22
(export make-grid+23
grid-width+24
grid-height+25
grid-ref+26
grid-set!+27
grid-clear!+28
grid-write-string!+29
grid-fill-rect!+30
grid-diff+31
grid-copy+32
make-cell+33
default-cell+34
cell-char+35
cell-fg+36
cell-bg+37
cell-attrs+38
cell=?+39
+40
;; Color constructors+41
color-256+42
color-rgb+43
+44
;; Named colors+45
color-default+46
color-black color-red color-green color-yellow+47
color-blue color-magenta color-cyan color-white+48
color-bright-black color-bright-red color-bright-green color-bright-yellow+49
color-bright-blue color-bright-magenta color-bright-cyan color-bright-white+50
+51
;; Attribute flags+52
attr-none attr-bold attr-dim attr-italic+53
attr-underline attr-inverse attr-strikethrough)+54
+55
(begin+56
+57
;; ============================================================+58
;; Attribute flags (bitmask)+59
;; ============================================================+60
+61
(define attr-none 0)+62
(define attr-bold 1)+63
(define attr-dim 2)+64
(define attr-italic 4)+65
(define attr-underline 8)+66
(define attr-inverse 16)+67
(define attr-strikethrough 32)+68
+69
;; ============================================================+70
;; Color constants and constructors+71
;; ============================================================+72
+73
(define color-default -1)+74
(define color-black 0)+75
(define color-red 1)+76
(define color-green 2)+77
(define color-yellow 3)+78
(define color-blue 4)+79
(define color-magenta 5)+80
(define color-cyan 6)+81
(define color-white 7)+82
(define color-bright-black 8)+83
(define color-bright-red 9)+84
(define color-bright-green 10)+85
(define color-bright-yellow 11)+86
(define color-bright-blue 12)+87
(define color-bright-magenta 13)+88
(define color-bright-cyan 14)+89
(define color-bright-white 15)+90
+91
;;; Create a 256-color palette index.+92
(define (color-256 n)+93
(: integer? -> integer?)+94
n)+95
+96
;;; Pack RGB values into a truecolor integer.+97
;;;+98
;;; ```scheme+99
;;; (color-rgb 255 128 0) ;; => orange+100
;;; ```+101
(define (color-rgb r g b)+102
(: integer? integer? integer? -> integer?)+103
(+ (* 65536 (+ r 1)) ;; +1 so black (0,0,0) encodes as 65536 not 0+104
(* 256 g)+105
b))+106
+107
;; ============================================================+108
;; Cell: 4-element vector #(char fg bg attrs)+109
;; ============================================================+110
+111
;;; Create a cell with the given character, colors, and attributes.+112
(define (make-cell ch fg bg attrs)+113
(: char? integer? integer? integer? -> vector?)+114
(vector ch fg bg attrs))+115
+116
;; Default cell: space with default colors, no attributes+117
(define (default-cell)+118
(: -> vector?)+119
(vector #\space -1 -1 0))+120
+121
;;; Get the character from a cell.+122
(define (cell-char cell)+123
(: vector? -> char?)+124
(vector-ref cell 0))+125
+126
;;; Get the foreground color from a cell.+127
(define (cell-fg cell)+128
(: vector? -> integer?)+129
(vector-ref cell 1))+130
+131
;;; Get the background color from a cell.+132
(define (cell-bg cell)+133
(: vector? -> integer?)+134
(vector-ref cell 2))+135
+136
;;; Get the attributes from a cell.+137
(define (cell-attrs cell)+138
(: vector? -> integer?)+139
(vector-ref cell 3))+140
+141
;;; Compare two cells for equality.+142
(define (cell=? a b)+143
(: vector? vector? -> boolean?)+144
(and (eqv? (vector-ref a 0) (vector-ref b 0))+145
(eqv? (vector-ref a 1) (vector-ref b 1))+146
(eqv? (vector-ref a 2) (vector-ref b 2))+147
(eqv? (vector-ref a 3) (vector-ref b 3))))+148
+149
;; ============================================================+150
;; Grid: vector of cells + dimensions+151
;; ============================================================+152
+153
;;; Create a grid of width x height cells, filled with default cells.+154
(define (make-grid width height)+155
(: integer? integer? -> vector?)+156
(let* ((size (* width height))+157
(cells (make-vector size #f)))+158
(let loop ((i 0))+159
(when (< i size)+160
(vector-set! cells i (default-cell))+161
(loop (+ i 1))))+162
(vector width height cells)))+163
+164
;;; Get the grid width.+165
(define (grid-width grid)+166
(: vector? -> integer?)+167
(vector-ref grid 0))+168
+169
;;; Get the grid height.+170
(define (grid-height grid)+171
(: vector? -> integer?)+172
(vector-ref grid 1))+173
+174
(define (grid-cells grid)+175
(vector-ref grid 2))+176
+177
(define (grid-index grid col row)+178
(+ (* row (grid-width grid)) col))+179
+180
;;; Get the cell at (col, row).+181
(define (grid-ref grid col row)+182
(: vector? integer? integer? -> vector?)+183
(vector-ref (grid-cells grid) (grid-index grid col row)))+184
+185
;;; Set the cell at (col, row).+186
(define (grid-set! grid col row cell)+187
(: vector? integer? integer? vector? -> void?)+188
(vector-set! (grid-cells grid) (grid-index grid col row) cell))+189
+190
;;; Clear the grid to default cells.+191
(define (grid-clear! grid)+192
(: vector? -> void?)+193
(let ((cells (grid-cells grid))+194
(size (* (grid-width grid) (grid-height grid))))+195
(let loop ((i 0))+196
(when (< i size)+197
(vector-set! cells i (default-cell))+198
(loop (+ i 1))))))+199
+200
;;; Write a string to the grid at (col, row) with the given style.+201
;;;+202
;;; Characters are written left-to-right, truncated at the grid edge.+203
(define (grid-write-string! grid col row str fg bg attrs)+204
(: vector? integer? integer? string? integer? integer? integer? -> void?)+205
(let ((w (grid-width grid))+206
(len (string-length str)))+207
(let loop ((i 0) (c col))+208
(when (and (< i len) (< c w))+209
(grid-set! grid c row (make-cell (string-ref str i) fg bg attrs))+210
(loop (+ i 1) (+ c 1))))))+211
+212
;;; Fill a rectangle with a cell.+213
(define (grid-fill-rect! grid x y w h cell)+214
(: vector? integer? integer? integer? integer? vector? -> void?)+215
(let ((gw (grid-width grid))+216
(gh (grid-height grid)))+217
(let row-loop ((r y))+218
(when (and (< r (+ y h)) (< r gh))+219
(let col-loop ((c x))+220
(when (and (< c (+ x w)) (< c gw))+221
(grid-set! grid c r cell)+222
(col-loop (+ c 1))))+223
(row-loop (+ r 1))))))+224
+225
;;; Create a deep copy of a grid.+226
(define (grid-copy grid)+227
(: vector? -> vector?)+228
(let* ((w (grid-width grid))+229
(h (grid-height grid))+230
(size (* w h))+231
(src (grid-cells grid))+232
(dst (make-vector size #f)))+233
(let loop ((i 0))+234
(when (< i size)+235
(let ((cell (vector-ref src i)))+236
(vector-set! dst i (vector (vector-ref cell 0)+237
(vector-ref cell 1)+238
(vector-ref cell 2)+239
(vector-ref cell 3))))+240
(loop (+ i 1))))+241
(vector w h dst)))+242
+243
;; ============================================================+244
;; SGR escape code emission+245
;; ============================================================+246
+247
(define esc "\x1b;")+248
+249
;; Emit a foreground color SGR sequence to port+250
(define (emit-fg port color)+251
(cond+252
((= color -1)+253
(display "39" port))+254
((and (>= color 0) (<= color 7))+255
(display (number->string (+ color 30)) port))+256
((and (>= color 8) (<= color 15))+257
(display (number->string (+ color 82)) port)) ;; 90-97+258
((and (>= color 16) (<= color 255))+259
(display "38;5;" port)+260
(display (number->string color) port))+261
(else+262
;; Truecolor: decode packed RGB+263
(let* ((v (- color 65536)) ;; undo the +1 offset from color-rgb+264
(r (quotient v 65536))+265
(rem (remainder v 65536))+266
(g (quotient rem 256))+267
(b (remainder rem 256)))+268
(display "38;2;" port)+269
(display (number->string r) port)+270
(display ";" port)+271
(display (number->string g) port)+272
(display ";" port)+273
(display (number->string b) port)))))+274
+275
;; Emit a background color SGR sequence to port+276
(define (emit-bg port color)+277
(cond+278
((= color -1)+279
(display "49" port))+280
((and (>= color 0) (<= color 7))+281
(display (number->string (+ color 40)) port))+282
((and (>= color 8) (<= color 15))+283
(display (number->string (+ color 92)) port)) ;; 100-107+284
((and (>= color 16) (<= color 255))+285
(display "48;5;" port)+286
(display (number->string color) port))+287
(else+288
(let* ((v (- color 65536))+289
(r (quotient v 65536))+290
(rem (remainder v 65536))+291
(g (quotient rem 256))+292
(b (remainder rem 256)))+293
(display "48;2;" port)+294
(display (number->string r) port)+295
(display ";" port)+296
(display (number->string g) port)+297
(display ";" port)+298
(display (number->string b) port)))))+299
+300
;; Emit attribute SGR codes to port+301
(define (emit-attrs port attrs)+302
(when (not (= (bitwise-and attrs attr-bold) 0))+303
(display ";1" port))+304
(when (not (= (bitwise-and attrs attr-dim) 0))+305
(display ";2" port))+306
(when (not (= (bitwise-and attrs attr-italic) 0))+307
(display ";3" port))+308
(when (not (= (bitwise-and attrs attr-underline) 0))+309
(display ";4" port))+310
(when (not (= (bitwise-and attrs attr-inverse) 0))+311
(display ";7" port))+312
(when (not (= (bitwise-and attrs attr-strikethrough) 0))+313
(display ";9" port)))+314
+315
;; Emit full SGR for a cell+316
(define (emit-sgr port fg bg attrs)+317
(display esc port)+318
(display "[0;" port) ;; reset first+319
(emit-fg port fg)+320
(display ";" port)+321
(emit-bg port bg)+322
(emit-attrs port attrs)+323
(display "m" port))+324
+325
;; ============================================================+326
;; Grid diffing+327
;; ============================================================+328
+329
;;; Compute the diff between prev and curr grids, return an ANSI string.+330
;;;+331
;;; Scans cell-by-cell, emitting cursor moves and SGR sequences only+332
;;; where cells differ. Returns the string to write atomically via+333
;;; terminal-write-raw.+334
(define (grid-diff prev curr)+335
(: vector? vector? -> string?)+336
(let ((w (grid-width curr))+337
(h (grid-height curr))+338
(out (open-output-string))+339
(last-fg -2) ;; -2 = no style emitted yet (different from -1=default)+340
(last-bg -2)+341
(last-attrs -1)+342
(cursor-col -1)+343
(cursor-row -1))+344
(let row-loop ((row 0))+345
(when (< row h)+346
(let col-loop ((col 0))+347
(when (< col w)+348
(let ((pc (grid-ref prev col row))+349
(cc (grid-ref curr col row)))+350
(when (not (cell=? pc cc))+351
(let ((fg (cell-fg cc))+352
(bg (cell-bg cc))+353
(attrs (cell-attrs cc))+354
(ch (cell-char cc)))+355
;; Move cursor if not at expected position+356
(when (or (not (= cursor-row row))+357
(not (= cursor-col col)))+358
(display esc out)+359
(display "[" out)+360
(display (number->string (+ row 1)) out)+361
(display ";" out)+362
(display (number->string (+ col 1)) out)+363
(display "H" out))+364
;; Emit style if changed+365
(when (or (not (= fg last-fg))+366
(not (= bg last-bg))+367
(not (= attrs last-attrs)))+368
(emit-sgr out fg bg attrs)+369
(set! last-fg fg)+370
(set! last-bg bg)+371
(set! last-attrs attrs))+372
;; Emit character+373
(display ch out)+374
(set! cursor-col (+ col 1))+375
(set! cursor-row row))))+376
(col-loop (+ col 1))))+377
(row-loop (+ row 1))))+378
;; Reset style at end+379
(let ((result (get-output-string out)))+380
(if (= (string-length result) 0)+381
result+382
(begin+383
(display esc out)+384
(display "[0m" out)+385
(get-output-string out))))))))test/test-grid.sgladded
@@ -0,0 +1,132 @@
+1
(import (sigil test)+2
(sigil tui grid))+3
+4
(test-group "grid"+5
+6
(test-group "creation"+7
(test "make-grid dimensions"+8
(let ((g (make-grid 80 24)))+9
(assert-equal 80 (grid-width g))+10
(assert-equal 24 (grid-height g))))+11
+12
(test "default cells are spaces"+13
(let ((g (make-grid 10 5)))+14
(assert-equal #\space (cell-char (grid-ref g 0 0)))+15
(assert-equal -1 (cell-fg (grid-ref g 0 0)))+16
(assert-equal -1 (cell-bg (grid-ref g 0 0)))+17
(assert-equal 0 (cell-attrs (grid-ref g 0 0))))))+18
+19
(test-group "cell operations"+20
(test "make-cell and accessors"+21
(let ((c (make-cell #\X color-red color-blue attr-bold)))+22
(assert-equal #\X (cell-char c))+23
(assert-equal color-red (cell-fg c))+24
(assert-equal color-blue (cell-bg c))+25
(assert-equal attr-bold (cell-attrs c))))+26
+27
(test "cell equality"+28
(let ((a (make-cell #\A color-red color-default attr-none))+29
(b (make-cell #\A color-red color-default attr-none))+30
(c (make-cell #\B color-red color-default attr-none)))+31
(assert-true (cell=? a b))+32
(assert-false (cell=? a c)))))+33
+34
(test-group "read/write"+35
(test "grid-set! and grid-ref"+36
(let ((g (make-grid 10 5))+37
(c (make-cell #\X color-green color-default attr-bold)))+38
(grid-set! g 3 2 c)+39
(assert-equal #\X (cell-char (grid-ref g 3 2)))+40
(assert-equal color-green (cell-fg (grid-ref g 3 2)))))+41
+42
(test "grid-write-string!"+43
(let ((g (make-grid 10 5)))+44
(grid-write-string! g 2 1 "Hello" color-cyan color-default attr-none)+45
(assert-equal #\H (cell-char (grid-ref g 2 1)))+46
(assert-equal #\e (cell-char (grid-ref g 3 1)))+47
(assert-equal #\l (cell-char (grid-ref g 4 1)))+48
(assert-equal #\l (cell-char (grid-ref g 5 1)))+49
(assert-equal #\o (cell-char (grid-ref g 6 1)))+50
;; Cells before and after untouched+51
(assert-equal #\space (cell-char (grid-ref g 1 1)))+52
(assert-equal #\space (cell-char (grid-ref g 7 1)))))+53
+54
(test "grid-write-string! truncates at edge"+55
(let ((g (make-grid 5 1)))+56
(grid-write-string! g 3 0 "Hello" color-default color-default attr-none)+57
;; Only 2 chars fit at col 3 in width-5 grid+58
(assert-equal #\H (cell-char (grid-ref g 3 0)))+59
(assert-equal #\e (cell-char (grid-ref g 4 0))))))+60
+61
(test-group "fill-rect"+62
(test "grid-fill-rect! fills area"+63
(let ((g (make-grid 10 5))+64
(c (make-cell #\# color-yellow color-default attr-none)))+65
(grid-fill-rect! g 1 1 3 2 c)+66
;; Inside the rect+67
(assert-equal #\# (cell-char (grid-ref g 1 1)))+68
(assert-equal #\# (cell-char (grid-ref g 3 2)))+69
;; Outside the rect+70
(assert-equal #\space (cell-char (grid-ref g 0 0)))+71
(assert-equal #\space (cell-char (grid-ref g 4 1))))))+72
+73
(test-group "grid-clear!"+74
(test "clear resets all cells"+75
(let ((g (make-grid 5 3)))+76
(grid-write-string! g 0 0 "Hello" color-red color-default attr-none)+77
(grid-clear! g)+78
(assert-equal #\space (cell-char (grid-ref g 0 0)))+79
(assert-equal -1 (cell-fg (grid-ref g 0 0))))))+80
+81
(test-group "diffing"+82
(test "identical grids produce empty diff"+83
(let ((a (make-grid 10 5))+84
(b (make-grid 10 5)))+85
(assert-equal "" (grid-diff a b))))+86
+87
(test "single cell change"+88
(let ((prev (make-grid 5 3))+89
(curr (make-grid 5 3)))+90
(grid-set! curr 2 1 (make-cell #\X color-red color-default attr-none))+91
(let ((diff (grid-diff prev curr)))+92
;; Should contain cursor move, SGR, and the character+93
(assert-true (> (string-length diff) 0))+94
;; The diff should end with a reset sequence+95
(assert-true (> (string-length diff) 3)))))+96
+97
(test "adjacent changes skip cursor repositioning"+98
(let ((prev (make-grid 10 3))+99
(curr (make-grid 10 3)))+100
(grid-write-string! curr 2 1 "AB" color-green color-default attr-none)+101
(let ((diff (grid-diff prev curr)))+102
;; Should have one cursor move, not two+103
;; Count ESC [ sequences — should have: 1 cursor move + 1 SGR + 1 reset = 3+104
(assert-true (> (string-length diff) 0)))))+105
+106
(test "style changes emit new SGR"+107
(let ((prev (make-grid 10 3))+108
(curr (make-grid 10 3)))+109
(grid-set! curr 0 0 (make-cell #\A color-red color-default attr-none))+110
(grid-set! curr 1 0 (make-cell #\B color-blue color-default attr-none))+111
(let ((diff (grid-diff prev curr)))+112
;; Two different styles means two SGR sequences+113
(assert-true (> (string-length diff) 10))))))+114
+115
(test-group "grid-copy"+116
(test "copy creates independent grid"+117
(let* ((orig (make-grid 5 3))+118
(copy (grid-copy orig)))+119
(grid-set! copy 0 0 (make-cell #\X color-red color-default attr-none))+120
;; Original should be unchanged+121
(assert-equal #\space (cell-char (grid-ref orig 0 0)))+122
;; Copy should have the change+123
(assert-equal #\X (cell-char (grid-ref copy 0 0))))))+124
+125
(test-group "colors"+126
(test "color-rgb encodes correctly"+127
(let ((orange (color-rgb 255 128 0)))+128
;; Should be > 255 (truecolor range)+129
(assert-true (> orange 255))))+130
+131
(test "256-color passthrough"+132
(assert-equal 196 (color-256 196)))))