811d51a4f2
Rename: cl-tty avoids naming collision with Quicklisp's cl-tui (naryl/cl-tui, a cl-charms-based ncurses library). Our project is pure escape-sequence CL. v0.9.0 adds: - Dialog base class: modal overlay with backdrop, centered panel, size variants (:small/:medium/:large), stack-based management - Dialog subclasses: alert, confirm, select-dialog, prompt-dialog - Toast notifications: transient, top-right corner, auto-dismiss, colored variants (info/success/warning/error) - 78 tests total, 100% passing ASDF: read-time package references (+fiveam:+) replaced with find-symbol so .asd loads without FiveAM pre-loaded
70 lines
2.3 KiB
Common Lisp
70 lines
2.3 KiB
Common Lisp
(in-package :cl-tty.backend)
|
|
|
|
(defclass simple-backend (backend)
|
|
((output-stream :initform *standard-output*
|
|
:initarg :output-stream
|
|
:accessor backend-output-stream)))
|
|
|
|
(defun make-simple-backend (&key output-stream)
|
|
(make-instance 'simple-backend
|
|
:output-stream (or output-stream *standard-output*)))
|
|
|
|
(defmethod initialize-backend ((b simple-backend))
|
|
b)
|
|
|
|
(defmethod shutdown-backend ((b simple-backend))
|
|
(values))
|
|
|
|
(defmethod backend-size ((b simple-backend))
|
|
;; Try ioctl, fall back to 80x24
|
|
(values 80 24))
|
|
|
|
(defmethod backend-write ((b simple-backend) string)
|
|
(let ((stream (backend-output-stream b)))
|
|
(write-string string stream)
|
|
(finish-output stream)
|
|
(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))
|
|
|
|
(defun %simple-border-char (edge-style pos)
|
|
"Return ASCII border character for EDGE-STYLE at POS.
|
|
POS is :top-left, :top-right, :bottom-left, :bottom-right,
|
|
:horizontal, or :vertical."
|
|
(case pos
|
|
((:top-left :top-right :bottom-left :bottom-right) #\+)
|
|
(:horizontal #\-)
|
|
(:vertical #\|)))
|
|
|
|
(defmethod draw-border ((b simple-backend) x y width height
|
|
&key style fg bg title title-align)
|
|
(declare (ignore style fg bg title title-align))
|
|
(let ((h (%simple-border-char nil :horizontal))
|
|
(v (%simple-border-char nil :vertical)))
|
|
;; Top edge
|
|
(backend-write b (format nil "~%~v@{~a~:*~}" width h))
|
|
;; Sides
|
|
(loop for i from 1 below (1- height)
|
|
do (backend-write b (format nil "~%|~v@{~a~:*~}|" (- width 2) #\space)))
|
|
;; Bottom edge
|
|
(backend-write b (format nil "~%~v@{~a~:*~}" width h))))
|
|
|
|
(defmethod draw-rect ((b simple-backend) x y width height
|
|
&key bg)
|
|
(declare (ignore x y width height bg))
|
|
;; On simple backend, background fill is a no-op
|
|
(values))
|
|
|
|
(defmethod draw-link ((b simple-backend) x y string url
|
|
&key fg bg)
|
|
(declare (ignore url fg bg))
|
|
(draw-text b x y string nil nil))
|
|
|
|
(defmethod draw-ellipsis ((b simple-backend) x y width
|
|
&key fg bg)
|
|
(declare (ignore x y width fg bg))
|
|
(backend-write b "..."))
|