simple backend: ANSI colors, cursor positioning, bold — no longer a no-op
- draw-text: uses cursor-move-escape, sgr-fg/sgr-bg, sgr-attr for bold/italic/underline/reverse/dim/blink (was: just dumped string) - draw-rect: fills with background color (was: complete no-op) - draw-link: forwards to draw-text with fg/bg (was: ignored them) - draw-ellipsis: uses positioned draw-text (was: newline+space) - Added end-sync with finish-output (was: missing, output never flushed)
This commit is contained in:
@@ -21,6 +21,9 @@
|
|||||||
(defmethod resume-backend ((b simple-backend))
|
(defmethod resume-backend ((b simple-backend))
|
||||||
(values))
|
(values))
|
||||||
|
|
||||||
|
(defmethod end-sync ((b simple-backend))
|
||||||
|
(finish-output (backend-output-stream b)))
|
||||||
|
|
||||||
(defmethod backend-size ((b simple-backend))
|
(defmethod backend-size ((b simple-backend))
|
||||||
;; Try ioctl on fd 0 (stdin), then stdout, then /dev/tty, then 80x24.
|
;; Try ioctl on fd 0 (stdin), then stdout, then /dev/tty, then 80x24.
|
||||||
;; Use multiple-value-bind/values to preserve both cols and rows
|
;; Use multiple-value-bind/values to preserve both cols and rows
|
||||||
@@ -79,8 +82,18 @@
|
|||||||
(defmethod draw-text ((b simple-backend) x y string fg bg
|
(defmethod draw-text ((b simple-backend) x y string fg bg
|
||||||
&key bold italic underline reverse dim blink
|
&key bold italic underline reverse dim blink
|
||||||
&allow-other-keys)
|
&allow-other-keys)
|
||||||
(declare (ignore x y fg bg bold italic underline reverse dim blink))
|
(let* ((style-reset (format nil "~C[22;23;24;25;27m" #\Esc))
|
||||||
(backend-write b string))
|
(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
|
||||||
|
style-reset)))
|
||||||
|
(backend-write b (apply #'concatenate 'string parts))))
|
||||||
|
|
||||||
(defun %simple-border-char (pos)
|
(defun %simple-border-char (pos)
|
||||||
"Return ASCII border character at POS.
|
"Return ASCII border character at POS.
|
||||||
@@ -142,19 +155,22 @@ POS is :top-left, :top-right, :bottom-left, :bottom-right,
|
|||||||
|
|
||||||
(defmethod draw-rect ((b simple-backend) x y width height
|
(defmethod draw-rect ((b simple-backend) x y width height
|
||||||
&key bg)
|
&key bg)
|
||||||
(declare (ignore x y width height bg))
|
(let* ((bg-esc (sgr-bg bg))
|
||||||
;; On simple backend, background fill is a no-op
|
(style-reset (format nil "~C[22;23;24;25;27m" #\Esc))
|
||||||
(values))
|
(line (concatenate 'string
|
||||||
|
bg-esc
|
||||||
|
(make-string width :initial-element #\Space)
|
||||||
|
style-reset (string #\Newline))))
|
||||||
|
(loop :for row :from 0 :below height :do
|
||||||
|
(backend-write b (cursor-move-escape x (+ y row)))
|
||||||
|
(backend-write b line))))
|
||||||
|
|
||||||
(defmethod draw-link ((b simple-backend) x y string url
|
(defmethod draw-link ((b simple-backend) x y string url
|
||||||
&key fg bg)
|
&key fg bg)
|
||||||
(declare (ignore url fg bg))
|
(declare (ignore url))
|
||||||
(draw-text b x y string nil nil))
|
(draw-text b x y string fg bg))
|
||||||
|
|
||||||
(defmethod draw-ellipsis ((b simple-backend) x y width
|
(defmethod draw-ellipsis ((b simple-backend) x y width
|
||||||
&key fg bg)
|
&key fg bg)
|
||||||
(declare (ignore width fg bg))
|
(declare (ignore width))
|
||||||
;; Position using newlines+spaces (simple-backend pattern)
|
(draw-text b x y "..." fg bg))
|
||||||
(dotimes (row y) (backend-write b (string #\Newline)))
|
|
||||||
(backend-write b (make-string x :initial-element #\Space))
|
|
||||||
(backend-write b "..."))
|
|
||||||
|
|||||||
Reference in New Issue
Block a user