Shell wrapper for terminal raw mode, demo no longer sets raw mode
Added ./demo shell script that sets raw mode via stty before running the Lisp demo and restores it on exit (including SIGINT/SIGTERM). demo.lisp no longer attempts to set raw mode from inside SBCL — terminal raw mode is the shell's responsibility. This avoids the recurring problem of sb-ext:run-program + stty not being able to access the controlling terminal from inside sbcl --script.
This commit is contained in:
101
demo.lisp
101
demo.lisp
@@ -124,60 +124,55 @@
|
||||
t)))
|
||||
|
||||
(defun run-demo ()
|
||||
(let ((saved (ignore-errors (set-raw-mode))))
|
||||
(unless saved
|
||||
(format *error-output* "~&ERROR: Cannot set terminal to raw mode.~%")
|
||||
(format *error-output* " Make sure you are in a real terminal (not a pipe/redirect).~%")
|
||||
(format *error-output* " Try: sbcl --script demo.lisp~%")
|
||||
(return-from run-demo))
|
||||
"Run the demo. Assumes raw terminal mode is already set by the
|
||||
shell wrapper (./demo) or by running:
|
||||
stty raw -echo -isig -icanon min 1 time 0
|
||||
sbcl --script demo.lisp"
|
||||
(init-app-state)
|
||||
(let* ((backend (detect-backend))
|
||||
(w 80) (h 24))
|
||||
(declare (ignore h))
|
||||
(initialize-backend backend)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(init-app-state)
|
||||
(let* ((backend (detect-backend))
|
||||
(w 80) (h 24))
|
||||
(initialize-backend backend)
|
||||
(unwind-protect
|
||||
(loop while (getf *app* :running)
|
||||
do
|
||||
(backend-clear backend)
|
||||
;; Title bar
|
||||
(draw-border backend 2 1 (- w 4) 3 :style :double :title " cl-tty v0.15.0 ")
|
||||
(draw-text backend 4 2 "arrows/tab: tabs type: test input mouse: test SGR q/esc: quit"
|
||||
:bright-white nil)
|
||||
;; Tab bar
|
||||
(loop for (label . idx) in '((" Home " . 0) (" Widgets " . 1) (" Console " . 2))
|
||||
for x-pos = 4 then (+ x-pos label-len 2)
|
||||
for label-len = (length label)
|
||||
do (let ((active (eql idx (getf *app* :tab))))
|
||||
(if active
|
||||
(draw-text backend x-pos 4 label :bright-white :accent :bold t)
|
||||
(draw-text backend x-pos 4 label :text-muted nil))))
|
||||
;; Content area
|
||||
(case (getf *app* :tab)
|
||||
(0 (render-tab-home backend 4 6 72 20))
|
||||
(1 (render-tab-widgets backend 4 6 72 24
|
||||
(getf *app* :input)
|
||||
(getf *app* :textarea)))
|
||||
(2 (render-tab-console backend 4 6 72 16)))
|
||||
;; Mouse cursor indicator
|
||||
(let ((mx (getf *app* :mouse-x))
|
||||
(my (getf *app* :mouse-y)))
|
||||
(when (and (>= mx 0) (>= my 0))
|
||||
(draw-text backend mx my "@" :bright-cyan nil)))
|
||||
;; Status bar
|
||||
(draw-rect backend 2 23 (- w 4) 1 :bg :blue)
|
||||
(draw-text backend 4 23
|
||||
(format nil " Tab ~d/3 | ~d events "
|
||||
(1+ (getf *app* :tab)) (length *log*))
|
||||
:bright-white :blue :bold t)
|
||||
(finish-output *standard-output*)
|
||||
;; Read event — blocks until a key or mouse event arrives
|
||||
(let ((event (read-event backend)))
|
||||
(when event
|
||||
(handle-event event))))
|
||||
(shutdown-backend backend))))
|
||||
(when saved
|
||||
(restore-terminal-state saved)))))
|
||||
(loop while (getf *app* :running)
|
||||
do
|
||||
(backend-clear backend)
|
||||
;; Title bar
|
||||
(draw-border backend 2 1 (- w 4) 3 :style :double :title " cl-tty v0.15.0 ")
|
||||
(draw-text backend 4 2 "arrows/tab: tabs type: test input mouse: test SGR q/esc: quit"
|
||||
:bright-white nil)
|
||||
;; Tab bar
|
||||
(loop for (label . idx) in '((" Home " . 0) (" Widgets " . 1) (" Console " . 2))
|
||||
for x-pos = 4 then (+ x-pos label-len 2)
|
||||
for label-len = (length label)
|
||||
do (let ((active (eql idx (getf *app* :tab))))
|
||||
(if active
|
||||
(draw-text backend x-pos 4 label :bright-white :accent :bold t)
|
||||
(draw-text backend x-pos 4 label :text-muted nil))))
|
||||
;; Content area
|
||||
(case (getf *app* :tab)
|
||||
(0 (render-tab-home backend 4 6 72 20))
|
||||
(1 (render-tab-widgets backend 4 6 72 24
|
||||
(getf *app* :input)
|
||||
(getf *app* :textarea)))
|
||||
(2 (render-tab-console backend 4 6 72 16)))
|
||||
;; Mouse cursor indicator
|
||||
(let ((mx (getf *app* :mouse-x))
|
||||
(my (getf *app* :mouse-y)))
|
||||
(when (and (>= mx 0) (>= my 0))
|
||||
(draw-text backend mx my "@" :bright-cyan nil)))
|
||||
;; Status bar
|
||||
(draw-rect backend 2 23 (- w 4) 1 :bg :blue)
|
||||
(draw-text backend 4 23
|
||||
(format nil " Tab ~d/3 | ~d events "
|
||||
(1+ (getf *app* :tab)) (length *log*))
|
||||
:bright-white :blue :bold t)
|
||||
(finish-output *standard-output*)
|
||||
;; Read event — blocks until a key or mouse event arrives
|
||||
(let ((event (read-event backend)))
|
||||
(when event
|
||||
(handle-event event))))
|
||||
(shutdown-backend backend))))
|
||||
|
||||
(run-demo)
|
||||
(uiop:quit 0)
|
||||
|
||||
Reference in New Issue
Block a user