Commite5a7eadeRecorded1 Mar 2026Repositorysigil-tui-demo

Add sigil-tui-demo package with chat demo application

Message

A chat client simulation that exercises all TUI components: panels, selectable lists, text input, scrollable content, and status bar. Uses a main export as the bundle entry point with guard-based error handling for clean error display.

Changed
 package.sgl            |  18 +++++++++++
 src/sigil/tui/demo.sgl | 290 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 308 insertions(+)
Diff
package.sgladded
@@ -0,0 +1,18 @@
+1
;;; sigil-tui-demo - Demo TUI application showcasing sigil-tui features
+2
;;;
+3
;;; A chat client simulation exercising all TUI components: panels,
+4
;;; selectable lists, text input, scrollable content, and status bar.
+5
+6
(package
+7
name: "sigil-tui-demo"
+8
version: "0.7.0"
+9
description: "Demo TUI application for sigil-tui"
+10
url: "https://codeberg.org/sigil/sigil"
+11
license: "BSD-3-Clause"
+12
authors: (list "David Wilson <[email protected]>")
+13
+14
entry: '(sigil tui demo)
+15
+16
dependencies: (list
+17
(from-workspace name: "sigil-stdlib")
+18
(from-workspace name: "sigil-tui")))
src/sigil/tui/demo.sgladded
@@ -0,0 +1,290 @@
+1
;;; (sigil tui demo) - Chat demo exercising all sigil-tui components
+2
;;;
+3
;;; Run with:
+4
;;; ./build/dev/bin/sigil run sigil-tui-demo
+5
+6
(define-library (sigil tui demo)
+7
(import (sigil core)
+8
(sigil struct)
+9
(sigil math)
+10
(sigil time)
+11
(sigil error)
+12
(sigil tui))
+13
+14
(export run-demo main)
+15
+16
(begin
+17
+18
;; ============================================================
+19
;; Data model
+20
;; ============================================================
+21
+22
(define-struct contact
+23
(name default: "")
+24
(online? default: #f)
+25
(group? default: #f))
+26
+27
(define-struct message
+28
(sender default: "")
+29
(text default: "")
+30
(timestamp default: 0))
+31
+32
;; Application state
+33
(define-struct app-state
+34
(contacts default: '() mutable: #t)
+35
(selected default: 0 mutable: #t)
+36
(conversations default: '() mutable: #t)
+37
(input default: #f mutable: #t)
+38
(mode default: 'roster mutable: #t)
+39
(scroll-offset default: 0 mutable: #t)
+40
(last-tick default: 0 mutable: #t)
+41
(sim-counter default: 0 mutable: #t))
+42
+43
;; ============================================================
+44
;; Helpers
+45
;; ============================================================
+46
+47
(define (format-time ts)
+48
(let* ((total (exact (floor ts)))
+49
(hours (modulo (quotient total 3600) 24))
+50
(mins (modulo (quotient total 60) 60))
+51
(h-str (if (< hours 10)
+52
(string-append "0" (number->string hours))
+53
(number->string hours)))
+54
(m-str (if (< mins 10)
+55
(string-append "0" (number->string mins))
+56
(number->string mins))))
+57
(string-append h-str ":" m-str)))
+58
+59
(define (get-conversation state name)
+60
(let ((entry (assoc name (app-state-conversations state))))
+61
(if entry (cdr entry) '())))
+62
+63
(define (add-message! state contact-name sender text)
+64
(let* ((msg (message sender: sender
+65
text: text
+66
timestamp: (current-second)))
+67
(convs (app-state-conversations state))
+68
(entry (assoc contact-name convs))
+69
(msgs (if entry (cdr entry) '()))
+70
(new-msgs (append msgs (list msg))))
+71
(if entry
+72
(set-cdr! entry new-msgs)
+73
(set-app-state-conversations! state
+74
(cons (cons contact-name new-msgs) convs)))))
+75
+76
(define (selected-contact state)
+77
(let ((contacts (app-state-contacts state))
+78
(idx (app-state-selected state)))
+79
(if (< idx (length contacts))
+80
(list-ref contacts idx)
+81
#f)))
+82
+83
;; ============================================================
+84
;; Simulated incoming messages
+85
;; ============================================================
+86
+87
(define *sim-messages*
+88
'(("alice" "Hey, how's it going?")
+89
("alice" "Working on anything fun?")
+90
("bob" "Did you see the game last night?")
+91
("alice" "I just finished the new TUI library!")
+92
("#general" "Welcome to #general!")
+93
("bob" "Let me know when you're free")
+94
("#general" "Anyone working on something cool?")
+95
("alice" "The grid diffing is so fast")
+96
("bob" "Pizza for lunch?")
+97
("#general" "Reminder: standup at 10am")))
+98
+99
(define (maybe-simulate-message! state)
+100
(let ((now (current-second))
+101
(last (app-state-last-tick state)))
+102
(when (> (- now last) 3.0)
+103
(set-app-state-last-tick! state now)
+104
(let* ((idx (modulo (app-state-sim-counter state)
+105
(length *sim-messages*)))
+106
(entry (list-ref *sim-messages* idx))
+107
(contact-name (car entry))
+108
(text (cadr entry))
+109
(sender (if (and (> (string-length contact-name) 0)
+110
(char=? (string-ref contact-name 0) #\#))
+111
"someone"
+112
contact-name)))
+113
(add-message! state contact-name sender text)
+114
(set-app-state-sim-counter! state
+115
(+ 1 (app-state-sim-counter state)))))))
+116
+117
;; ============================================================
+118
;; UI rendering
+119
;; ============================================================
+120
+121
(define (render-roster state)
+122
(let* ((contacts (app-state-contacts state))
+123
(items (map (lambda (c)
+124
(let* ((dot (if (contact-online? c) "● " "○ "))
+125
(name (contact-name c))
+126
(label (string-append dot name))
+127
(fg (if (contact-online? c)
+128
color-green
+129
color-bright-black))
+130
(bg color-default))
+131
(list label fg bg attr-none)))
+132
contacts)))
+133
(selectable-list items (app-state-selected state))))
+134
+135
(define (render-chat-messages state contact-name)
+136
(let* ((msgs (get-conversation state contact-name))
+137
(lines (map (lambda (m)
+138
(let* ((time-str (format-time (message-timestamp m)))
+139
(sender (message-sender m))
+140
(text (message-text m))
+141
(line (string-append
+142
"[" time-str "] "
+143
sender ": " text)))
+144
(if (string=? sender "you")
+145
(list line color-cyan color-default attr-none)
+146
(list line color-default color-default attr-none))))
+147
msgs)))
+148
(if (null? lines)
+149
(text-block (list (list "No messages yet."
+150
color-bright-black color-default attr-italic)))
+151
(text-block lines))))
+152
+153
(define (render-app state)
+154
(let* ((contact (selected-contact state))
+155
(contact-name (if contact (contact-name contact) ""))
+156
(chat-title (string-append "Chat: " contact-name))
+157
(input-st (app-state-input state))
+158
(prompt (string-append contact-name "> "))
+159
(status-contact (if contact
+160
(string-append contact-name
+161
(if (contact-online? contact)
+162
" (online)"
+163
" (offline)"))
+164
""))
+165
(mode-str (if (eq? (app-state-mode state) 'roster)
+166
"[roster]"
+167
"[chat]"))
+168
(status-right (string-append mode-str " Ctrl-Q quit")))
+169
(vertical-split 0.92
+170
(horizontal-split 0.25
+171
(panel "Roster" (render-roster state))
+172
(vertical-split 0.88
+173
(panel chat-title
+174
(render-chat-messages state contact-name))
+175
(panel ""
+176
(text-input-widget prompt
+177
(input-value input-st)
+178
(input-cursor input-st)))))
+179
(status-bar "chat-demo" status-contact status-right))))
+180
+181
;; ============================================================
+182
;; Event handling
+183
;; ============================================================
+184
+185
(define (handle-event state event)
+186
(maybe-simulate-message! state)
+187
+188
(cond
+189
;; Quit
+190
((and (key-event? event)
+191
(equal? event '(key #\q ctrl)))
+192
'quit)
+193
+194
;; Tab to switch focus mode
+195
((and (key-event? event)
+196
(equal? event '(key tab)))
+197
(set-app-state-mode! state
+198
(if (eq? (app-state-mode state) 'roster) 'chat 'roster))
+199
state)
+200
+201
;; Roster mode keys
+202
((eq? (app-state-mode state) 'roster)
+203
(handle-roster-event state event))
+204
+205
;; Chat mode keys
+206
((eq? (app-state-mode state) 'chat)
+207
(handle-chat-event state event))
+208
+209
(else state)))
+210
+211
(define (handle-roster-event state event)
+212
(cond
+213
((and (key-event? event)
+214
(equal? event '(key up)))
+215
(let ((sel (app-state-selected state)))
+216
(when (> sel 0)
+217
(set-app-state-selected! state (- sel 1))))
+218
state)
+219
+220
((and (key-event? event)
+221
(equal? event '(key down)))
+222
(let ((sel (app-state-selected state))
+223
(max-idx (- (length (app-state-contacts state)) 1)))
+224
(when (< sel max-idx)
+225
(set-app-state-selected! state (+ sel 1))))
+226
state)
+227
+228
;; Enter or right arrow switches to chat
+229
((and (key-event? event)
+230
(or (equal? event '(key enter))
+231
(equal? event '(key right))))
+232
(set-app-state-mode! state 'chat)
+233
state)
+234
+235
(else state)))
+236
+237
(define (handle-chat-event state event)
+238
(cond
+239
;; Left arrow goes back to roster
+240
((and (key-event? event)
+241
(equal? event '(key left)))
+242
(set-app-state-mode! state 'roster)
+243
state)
+244
+245
;; Pass key events to input
+246
((key-event? event)
+247
(let ((result (input-handle-key (app-state-input state) event)))
+248
(when (eq? result 'submit)
+249
(let* ((contact (selected-contact state))
+250
(text (input-value (app-state-input state))))
+251
(when (and contact (> (string-length text) 0))
+252
(add-message! state (contact-name contact) "you" text)
+253
(input-clear! (app-state-input state))))))
+254
state)
+255
+256
(else state)))
+257
+258
;; ============================================================
+259
;; Main
+260
;; ============================================================
+261
+262
(define (make-initial-state)
+263
(let ((state (app-state
+264
contacts: (list
+265
(contact name: "alice" online?: #t)
+266
(contact name: "bob" online?: #f)
+267
(contact name: "#general" online?: #t group?: #t)
+268
(contact name: "#random" online?: #f group?: #t))
+269
input: (make-input-state)
+270
last-tick: (current-second))))
+271
;; Seed some initial messages
+272
(add-message! state "alice" "alice" "Hey, welcome to the chat!")
+273
(add-message! state "alice" "you" "Thanks! Testing the TUI.")
+274
(add-message! state "#general" "admin" "Welcome to #general")
+275
state))
+276
+277
;;; Run the chat demo application.
+278
(define (run-demo)
+279
(tui-run
+280
render-app
+281
initial-state: (make-initial-state)
+282
on-event: handle-event
+283
fps: 30))
+284
+285
(define (main)
+286
(guard (exn (#t
+287
(display (format-exception exn) (current-error-port))
+288
(newline (current-error-port))
+289
(exit 1)))
+290
(run-demo)))))