tui: add CPU/MEM/GPU bars to sidebar and status line
ober
cbe94ee0a65865b2df33e05a99fe5102cceebb24
--- a/build-binary.ss +++ b/build-binary.ss @@ -306,6 +306,7 @@ "std/os/platform" "std/os/path" "std/os/shell" + "std/os/sysmon" "std/text/json" "std/text/glob" "std/net/tcp" --- a/src/jcode/ui/tui-sidebar.ss +++ b/src/jcode/ui/tui-sidebar.ss @@ -13,7 +13,8 @@ (import :jcode/ui/tui-ffi :jerboa/core :jerboa/runtime - :jcode/ui/tui-theme) + :jcode/ui/tui-theme + :std/os/sysmon) ;; ---- Sidebar state ---- @@ -31,7 +32,7 @@ ;; ---- Rendering ---- -(def (render-sidebar! sidebar x y width height) +(def (render-sidebar! sidebar sysmon x y width height) "Render the sidebar at (x, y) with given width and height." (let ((bg (face-bg-attr 'sidebar-bg)) (fg (face-fg-attr 'sidebar-item)) @@ -71,7 +72,11 @@ ;; Connections section (let ((row (+ row 1))) (let ((row (render-section! "Connections" cx row cw max-row tfg tbg))) - (render-connections! sidebar cx row cw max-row fg bg))))))))))))))) + (let ((row (render-connections! sidebar cx row cw max-row fg bg))) + ;; System section + (let ((row (+ row 1))) + (let ((row (render-section! "System" cx row cw max-row tfg tbg))) + (render-system! sysmon cx row cw max-row fg bg)))))))))))))))))) (def (render-section! title x row width max-row tfg tbg) (when (< row max-row) @@ -142,5 +147,67 @@ mcp)) (when (and (sidebar-state-lsp sidebar) (< row max-row)) (tb-print! x row fg bg - (string-append "LSP: " (sidebar-state-lsp sidebar)))) - row)) + (string-append "LSP: " (sidebar-state-lsp sidebar))) + (set! row (+ row 1)))) + row) + +;; ---- System utilization (CPU/MEM/GPU bars) ---- + +(def (render-system! sysmon x row width max-row fg bg) + (cond + ((not sysmon) row) + ((>= row max-row) row) + (#t + (render-bar! x row width "CPU" (sysmon-cpu-percent sysmon) fg bg) + (set! row (+ row 1)) + (when (< row max-row) + (render-bar! x row width "MEM" (sysmon-mem-percent sysmon) fg bg) + (set! row (+ row 1))) + (when (< row max-row) + (render-bar! x row width "GPU" (sysmon-gpu-percent sysmon) fg bg) + (set! row (+ row 1))) + row))) + +(def (render-bar! x y total-width label pct fg bg) + ;; Format: "CPU " + filled-blocks + empty-blocks + " 100%" + ;; 4 varies varies 5 + (let* ((label-w 4) + (pct-w 5) + (bar-w (max 1 (- total-width label-w pct-w))) + (filled (if pct + (max 0 (min bar-w (exact (round (* bar-w (/ pct 100.0)))))) + 0)) + (empty (- bar-w filled)) + (fill-face (cond ((not pct) 'horizontal-rule) + ((>= pct 85) 'error) + (#t 'tool-name))) + (label-padded (pad-right (truncate-string label 3) 4)) + (pct-str (format-pct pct))) + (tb-print! x y fg bg label-padded) + (when (> filled 0) + (tb-print! (+ x label-w) y (face-fg-attr fill-face) bg + (make-string filled #\█))) + (when (> empty 0) + (tb-print! (+ x label-w filled) y (face-fg-attr 'horizontal-rule) bg + (make-string empty #\░))) + (tb-print! (+ x label-w bar-w) y fg bg pct-str))) + +(def (truncate-string s n) + (if (> (string-length s) n) + (substring s 0 n) + s)) + +(def (pad-right s width) + (let ((slen (string-length s))) + (if (>= slen width) + s + (string-append s (make-string (- width slen) #\space))))) + +(def (format-pct pct) + (cond + ((not pct) " N/A") + (#t (let ((p (exact (round (max 0.0 (min 100.0 pct)))))) + (cond + ((>= p 100) " 100%") + ((>= p 10) (string-append " " (number->string p) "%")) + (#t (string-append " " (number->string p) "%"))))))) --- a/src/jcode/ui/tui-status.ss +++ b/src/jcode/ui/tui-status.ss @@ -7,9 +7,10 @@ :jerboa/core :jerboa/runtime :jcode/ui/tui-ffi - :jcode/ui/tui-theme) + :jcode/ui/tui-theme + :std/os/sysmon) -(def (render-status-bar! x y width provider model tokens-in tokens-out cost cwd mode) +(def (render-status-bar! x y width provider model tokens-in tokens-out cost cwd mode sysmon) "Render the status bar at row y across width columns." (let ((bg (face-bg-attr 'status-bar)) (fg (face-fg-attr 'status-bar))) @@ -19,20 +20,22 @@ (tb-change-cell! col y (char->integer #\space) fg bg) (loop (+ col 1)))) - ;; Left side: mode │ provider │ model │ tokens │ cost + ;; Left side: mode │ provider │ model │ tokens │ cost │ sys (let* ((prov-str (or provider "?")) (model-str (model-short-name (or model "?"))) (tok-str (format "~a/~a" (format-count tokens-in) (format-count tokens-out))) (cost-str (if (> cost 0) (format "$~a" (format-cost cost)) "")) (mode-str (if (eq? mode 'plan) "PLAN" "BUILD")) (mode-face (if (eq? mode 'plan) 'status-mode-plan 'status-mode-build)) + (sys-str (if (and sysmon (>= width 90)) (sysmon-summary sysmon) "")) (left-parts (filter (lambda (p) (not (string-empty? (car p)))) (list (cons mode-str mode-face) (cons prov-str 'status-provider) (cons model-str 'status-model) (cons tok-str 'status-tokens) - (cons cost-str 'status-cost))))) + (cons cost-str 'status-cost) + (cons sys-str 'status-dim))))) (let lloop ((parts left-parts) (col (+ x 1))) (when (pair? parts) (let* ((part (car parts)) @@ -82,3 +85,21 @@ (if (> (string-length p) max-len) (string-append "…" (substring p (- (string-length p) (- max-len 1)) (string-length p))) p)))) + +(def (sysmon-summary sysmon) + (let ((cpu (sysmon-cpu-percent sysmon)) + (mem (sysmon-mem-percent sysmon)) + (gpu (sysmon-gpu-percent sysmon))) + (string-append + "CPU " (status-pct cpu) + " MEM " (status-pct mem) + (if gpu (string-append " GPU " (status-pct gpu)) "")))) + +(def (status-pct pct) + (cond + ((not pct) " N/A") + (#t (let ((p (exact (round (max 0.0 (min 100.0 pct)))))) + (cond + ((>= p 100) "100%") + ((>= p 10) (string-append " " (number->string p) "%")) + (#t (string-append " " (number->string p) "%"))))))) --- a/src/jcode/ui/tui.ss +++ b/src/jcode/ui/tui.ss @@ -35,6 +35,7 @@ :jcode/mcp/client :jcode/tool/lsp :jcode/core/plugin + :std/os/sysmon :jerboa/core :jerboa/runtime) @@ -124,29 +125,33 @@ cost ;; accumulated cost sidebar ;; sidebar-state dialog ;; #f or active dialog - tool-counts) ;; hash-table: name → count + tool-counts ;; hash-table: name → count + sysmon) ;; system utilization sampler transparent: #t) (def (make-fresh-state w h) - (make-app-state - w h - (>= w 100) ;; sidebar visible if wide enough - 24 ;; sidebar width - 1 ;; input height - 0 ;; scroll offset - '() ;; messages - (make-fresh-input) - #f ;; session-id - #f ;; agent-busy? - "" ;; stream-buf - #t ;; dirty - #f ;; quit - 0 ;; tick - 0 0 ;; tokens - 0.0 ;; cost - (make-fresh-sidebar) - #f ;; dialog - (make-hash-table))) + (let ((mon (make-sysmon))) + (sysmon-update! mon) ;; seed counters; first read is meaningful + (make-app-state + w h + (>= w 100) ;; sidebar visible if wide enough + 24 ;; sidebar width + 1 ;; input height + 0 ;; scroll offset + '() ;; messages + (make-fresh-input) + #f ;; session-id + #f ;; agent-busy? + "" ;; stream-buf + #t ;; dirty + #f ;; quit + 0 ;; tick + 0 0 ;; tokens + 0.0 ;; cost + (make-fresh-sidebar) + #f ;; dialog + (make-hash-table) + mon))) ;; ---- Layout calculations ---- @@ -264,6 +269,13 @@ ;; Advance tick for animations (app-state-tick-set! state (+ (app-state-tick state) 1)) + ;; Sample system utilization roughly every second (event poll is 50ms) + (when (zero? (modulo (app-state-tick state) 20)) + (let ((mon (app-state-sysmon state))) + (when mon + (try (sysmon-update! mon) (catch (e) (void))) + (app-state-dirty?-set! state #t)))) + ;; Drain pending events from agent worker thread and apply them. ;; All state mutation happens here, on the main thread, not from ;; the spawned worker — this prevents races on Chez hash tables. @@ -1029,11 +1041,13 @@ (app-state-tokens-out state) (app-state-cost state) (current-directory) - (current-mode)) + (current-mode) + (app-state-sysmon state)) ;; Sidebar (when (app-state-sidebar-visible? state) (render-sidebar! (app-state-sidebar state) + (app-state-sysmon state) (sidebar-x state) 0 (app-state-sidebar-width state) (- (app-state-height state) 1))) ;; don't overlap status bar