(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 (pos) "Return ASCII border character 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)) (let ((h (%simple-border-char :horizontal)) (v (%simple-border-char :vertical)) (tl (%simple-border-char :top-left)) (tr (%simple-border-char :top-right)) (bl (%simple-border-char :bottom-left)) (br (%simple-border-char :bottom-right))) ;; Position cursor with newlines and spaces (no escape sequences) (dotimes (row y) (backend-write b (string #\Newline))) ;; Top edge with optional title (backend-write b (make-string x :initial-element #\space)) (backend-write b (string tl)) (if (and title (plusp (length title))) (let* ((align (or title-align :left)) (inner-width (- width 2)) (max-tlen (- inner-width 2)) (tlen (min (length title) max-tlen)) (trunc-title (subseq title 0 tlen))) (ecase align (:left (backend-write b (string #\Space)) (backend-write b trunc-title) (backend-write b (string #\Space)) (backend-write b (make-string (- inner-width tlen 2) :initial-element h))) (:center (let* ((total-pad (- inner-width tlen)) (left-pad (floor total-pad 2)) (right-pad (- total-pad left-pad))) (backend-write b (make-string left-pad :initial-element h)) (backend-write b trunc-title) (backend-write b (make-string right-pad :initial-element h)))))) (backend-write b (make-string (- width 2) :initial-element h))) (backend-write b (string tr)) ;; Sides (loop for i from 1 below (1- height) do (backend-write b (string #\Newline)) (backend-write b (make-string x :initial-element #\space)) (backend-write b (string v)) (backend-write b (make-string (- width 2) :initial-element #\space)) (backend-write b (string v))) ;; Bottom edge (backend-write b (string #\Newline)) (backend-write b (make-string x :initial-element #\space)) (backend-write b (string bl)) (backend-write b (make-string (- width 2) :initial-element h)) (backend-write b (string br)))) (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 "..."))