diff --git a/org/backend-protocol.org b/org/backend-protocol.org index 98e737c..3fbb0a9 100644 --- a/org/backend-protocol.org +++ b/org/backend-protocol.org @@ -850,8 +850,9 @@ This means simple backends are always a "scroll and dump" mode — no cursor positioning, no escape sequences. #+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp -(defmethod draw-text ((b simple-backend) x y string fg bg - &key bold italic underline reverse dim blink) + (defmethod draw-text ((b simple-backend) x y string fg bg + &key bold italic underline reverse dim blink + &allow-other-keys) (declare (ignore x y fg bg bold italic underline reverse dim blink)) (backend-write b string)) #+END_SRC diff --git a/org/framebuffer.org b/org/framebuffer.org index b56c920..1296526 100644 --- a/org/framebuffer.org +++ b/org/framebuffer.org @@ -356,9 +356,32 @@ does not need (e.g., reverse, dim, blink). do (%set-cell fb (+ x i) y (char string i) :fg fg :bg bg :bold bold :italic italic :underline underline - :link-url link-url))) + :link-url link-url))) #+END_SRC +*** draw-text (raw array) + +Direct rendering onto a raw 2D framebuffer array (the type returned by +~make-framebuffer~). This lets application code call ~draw-text~ directly on a +framebuffer without wrapping it in a ~framebuffer-backend~. + +#+begin_src lisp :tangle ../src/rendering/framebuffer.lisp +(defmethod draw-text ((fb array) x y string fg bg + &key bold italic underline reverse dim blink + &allow-other-keys) + (declare (ignore reverse dim blink)) + (let ((h (array-dimension fb 0)) + (w (array-dimension fb 1))) + (loop for i from 0 below (length string) + for cx from x + while (< cx w) + when (and (< y h) (>= cx 0) (>= y 0)) + do (setf (aref fb y cx) + (make-cell :char (char string i) + :fg fg :bg bg + :bold bold :italic italic :underline underline))))) +#+end_src + *** draw-rect Fill a rectangular region with space characters and an optional background diff --git a/org/modern-backend.org b/org/modern-backend.org index 3645c45..e0a7eaf 100644 --- a/org/modern-backend.org +++ b/org/modern-backend.org @@ -652,16 +652,18 @@ compatibility across SBCL versions. Returns (values cols rows). #+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp (defmethod backend-size ((b modern-backend)) - (let* ((+tiocgwinsz+ 21523) ; 0x5413 on Linux - (winsize (sb-alien:make-alien sb-alien:unsigned-short 4))) - (unwind-protect - (progn - (sb-unix:unix-ioctl (sb-sys:fd-stream-fd (backend-output-stream b)) - +tiocgwinsz+ - (sb-alien:alien-sap winsize)) - (values (sb-alien:deref winsize 1) ;; cols - (sb-alien:deref winsize 0))) ;; rows - (sb-alien:free-alien winsize)))) + (or (ignore-errors + (let* ((+tiocgwinsz+ 21523) ; 0x5413 on Linux + (winsize (sb-alien:make-alien sb-alien:unsigned-short 4))) + (unwind-protect + (progn + (sb-unix:unix-ioctl (sb-sys:fd-stream-fd (backend-output-stream b)) + +tiocgwinsz+ + (sb-alien:alien-sap winsize)) + (values (sb-alien:deref winsize 1) ;; cols + (sb-alien:deref winsize 0))) ;; rows + (sb-alien:free-alien winsize)))) + (values 80 24))) #+END_SRC ** Capability query and write @@ -703,8 +705,9 @@ calls --- one =backend-write= per draw operation --- by packing everything into one buffer. #+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp -(defmethod draw-text ((b modern-backend) x y string fg bg - &key bold italic underline reverse dim blink) + (defmethod draw-text ((b modern-backend) x y string fg bg + &key bold italic underline reverse dim blink + &allow-other-keys) (let ((parts (list (cursor-move-escape x y) (sgr-fg fg) (sgr-bg bg) (when bold (sgr-attr :bold)) diff --git a/org/text-input.org b/org/text-input.org index 708a95b..7d15408 100644 --- a/org/text-input.org +++ b/org/text-input.org @@ -772,10 +772,12 @@ portability. #+BEGIN_SRC lisp :tangle ../src/components/input.lisp (defun %raw-mode-on () - (uiop:run-program '("stty" "raw" "-echo" "-echoe" "-echok" "-onlcr") :output nil :error-output nil)) + (uiop:run-program '("stty" "raw" "-echo" "-echoe" "-echok" "-onlcr") + :output nil :error-output nil :ignore-error-status t)) (defun %raw-mode-off () - (uiop:run-program '("stty" "sane") :output nil :error-output nil)) + (uiop:run-program '("stty" "sane") + :output nil :error-output nil :ignore-error-status t)) (defmacro with-raw-terminal (&body body) "Execute BODY with the terminal in raw mode." diff --git a/src/backend/modern.lisp b/src/backend/modern.lisp index eb75f96..7ec33b7 100644 --- a/src/backend/modern.lisp +++ b/src/backend/modern.lisp @@ -162,16 +162,18 @@ as a fallback when a keyword is not in *named-colors*.") (values)) (defmethod backend-size ((b modern-backend)) - (let* ((+tiocgwinsz+ 21523) ; 0x5413 on Linux - (winsize (sb-alien:make-alien sb-alien:unsigned-short 4))) - (unwind-protect - (progn - (sb-unix:unix-ioctl (sb-sys:fd-stream-fd (backend-output-stream b)) - +tiocgwinsz+ - (sb-alien:alien-sap winsize)) - (values (sb-alien:deref winsize 1) ;; cols - (sb-alien:deref winsize 0))) ;; rows - (sb-alien:free-alien winsize)))) + (or (ignore-errors + (let* ((+tiocgwinsz+ 21523) ; 0x5413 on Linux + (winsize (sb-alien:make-alien sb-alien:unsigned-short 4))) + (unwind-protect + (progn + (sb-unix:unix-ioctl (sb-sys:fd-stream-fd (backend-output-stream b)) + +tiocgwinsz+ + (sb-alien:alien-sap winsize)) + (values (sb-alien:deref winsize 1) ;; cols + (sb-alien:deref winsize 0))) ;; rows + (sb-alien:free-alien winsize)))) + (values 80 24))) (defmethod backend-write ((b modern-backend) string) (let ((stream (backend-output-stream b))) @@ -185,18 +187,19 @@ as a fallback when a keyword is not in *named-colors*.") :kitty-keyboard))) (defmethod draw-text ((b modern-backend) x y string fg bg - &key bold italic underline reverse dim blink) - (let ((parts (list (cursor-move-escape x y) - (sgr-fg fg) (sgr-bg bg) - (when bold (sgr-attr :bold)) - (when italic (sgr-attr :italic)) - (when underline (sgr-attr :underline)) - (when reverse (sgr-attr :reverse)) - (when dim (sgr-attr :dim)) - (when blink (sgr-attr :blink)) - string - (sgr-attr :reset)))) - (backend-write b (apply #'concatenate 'string parts)))) + &key bold italic underline reverse dim blink + &allow-other-keys) + (let ((parts (list (cursor-move-escape x y) + (sgr-fg fg) (sgr-bg bg) + (when bold (sgr-attr :bold)) + (when italic (sgr-attr :italic)) + (when underline (sgr-attr :underline)) + (when reverse (sgr-attr :reverse)) + (when dim (sgr-attr :dim)) + (when blink (sgr-attr :blink)) + string + (sgr-attr :reset)))) + (backend-write b (apply #'concatenate 'string parts)))) (defmethod draw-border ((b modern-backend) x y width height &key style fg bg title title-align) diff --git a/src/backend/simple.lisp b/src/backend/simple.lisp index 94a8ecc..9833cea 100644 --- a/src/backend/simple.lisp +++ b/src/backend/simple.lisp @@ -32,9 +32,10 @@ (length string))) (defmethod draw-text ((b simple-backend) x y string fg bg - &key bold italic underline reverse dim blink) - (declare (ignore x y fg bg bold italic underline reverse dim blink)) - (backend-write b string)) + &key bold italic underline reverse dim blink + &allow-other-keys) + (declare (ignore x y fg bg bold italic underline reverse dim blink)) + (backend-write b string)) (defun %simple-border-char (pos) "Return ASCII border character at POS. diff --git a/src/components/input.lisp b/src/components/input.lisp index 131de2a..5caeb0b 100644 --- a/src/components/input.lisp +++ b/src/components/input.lisp @@ -228,10 +228,12 @@ Returns a mouse-event struct." (setf *terminal-resized-p* t)))) (defun %raw-mode-on () - (uiop:run-program '("stty" "raw" "-echo" "-echoe" "-echok" "-onlcr") :output nil :error-output nil)) + (uiop:run-program '("stty" "raw" "-echo" "-echoe" "-echok" "-onlcr") + :output nil :error-output nil :ignore-error-status t)) (defun %raw-mode-off () - (uiop:run-program '("stty" "sane") :output nil :error-output nil)) + (uiop:run-program '("stty" "sane") + :output nil :error-output nil :ignore-error-status t)) (defmacro with-raw-terminal (&body body) "Execute BODY with the terminal in raw mode." diff --git a/src/rendering/framebuffer.lisp b/src/rendering/framebuffer.lisp index 6af4243..a4541a1 100644 --- a/src/rendering/framebuffer.lisp +++ b/src/rendering/framebuffer.lisp @@ -76,7 +76,22 @@ do (%set-cell fb (+ x i) y (char string i) :fg fg :bg bg :bold bold :italic italic :underline underline - :link-url link-url))) + :link-url link-url))) + +(defmethod draw-text ((fb array) x y string fg bg + &key bold italic underline reverse dim blink + &allow-other-keys) + (declare (ignore reverse dim blink)) + (let ((h (array-dimension fb 0)) + (w (array-dimension fb 1))) + (loop for i from 0 below (length string) + for cx from x + while (< cx w) + when (and (< y h) (>= cx 0) (>= y 0)) + do (setf (aref fb y cx) + (make-cell :char (char string i) + :fg fg :bg bg + :bold bold :italic italic :underline underline))))) (defmethod draw-rect ((fb framebuffer-backend) x y w h &key bg) (dotimes (row h)