fix: add draw-text method for raw 2D arrays
Application code (passepartout TUI) calls draw-text with a framebuffer (2D array) as the first argument, but draw-text only had methods for framebuffer-backend CLOS instances. Added a method on array that sets cells directly on the framebuffer array, matching make-framebuffer's return type.
This commit is contained in:
@@ -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)
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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."
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user