(in-package :cl-tty.backend)

(defun hex-to-rgb (hex)
  "Parse a hex color string like \"#FFD700\" into (values r g b).
  Also handles 3-digit hex like \"#F00\" (expands to \"#FF0000\")."
  (let ((clean (string-trim '(#\# #\Space) hex)))
    (if (= (length clean) 3)
        ;; Expand 3-digit: #F00 -> #FF0000
        (let* ((r (parse-integer (subseq clean 0 1) :radix 16 :junk-allowed t))
               (g (parse-integer (subseq clean 1 2) :radix 16 :junk-allowed t))
               (b (parse-integer (subseq clean 2 3) :radix 16 :junk-allowed t)))
          (values (+ r (* r 16)) (+ g (* g 16)) (+ b (* b 16))))
        (values (parse-integer (subseq clean 0 2) :radix 16 :junk-allowed t)
                (parse-integer (subseq clean 2 4) :radix 16 :junk-allowed t)
                (parse-integer (subseq clean 4 6) :radix 16 :junk-allowed t)))))

(defparameter *named-colors*
  '((:black . 0) (:red . 1) (:green . 2) (:yellow . 3)
    (:blue . 4) (:magenta . 5) (:cyan . 6) (:white . 7)))

(defvar *theme-colors* (make-hash-table :test 'eq)
  "Hash table mapping theme keywords to hex color strings.
Populated by the theme system's load-preset.  Checked by sgr-fg/sgr-bg
as a fallback when a keyword is not in *named-colors*.")

(defun sgr-fg (color)
  "Return SGR foreground escape for COLOR."
  (if (null color) ""
      (cond ((and (stringp color) (char= (char color 0) #\#))
             (multiple-value-bind (r g b) (hex-to-rgb color)
               (format nil "~C[38;2;~d;~d;~dm" #\Esc r g b)))
            ((keywordp color)
             (let ((index (cdr (assoc color *named-colors*))))
               (if index
                   (format nil "~C[~dm" #\Esc (+ 30 index))
                   (let ((hex (gethash color *theme-colors*)))
                     (if hex
                         (multiple-value-bind (r g b) (hex-to-rgb hex)
                           (format nil "~C[38;2;~d;~d;~dm" #\Esc r g b))
                         "")))))
            (t ""))))

(defun sgr-bg (color)
  "Return SGR background escape for COLOR."
  (if (null color) ""
      (cond ((and (stringp color) (char= (char color 0) #\#))
             (multiple-value-bind (r g b) (hex-to-rgb color)
               (format nil "~C[48;2;~d;~d;~dm" #\Esc r g b)))
            ((keywordp color)
             (let ((index (cdr (assoc color *named-colors*))))
               (if index
                   (format nil "~C[~dm" #\Esc (+ 40 index))
                   (let ((hex (gethash color *theme-colors*)))
                     (if hex
                         (multiple-value-bind (r g b) (hex-to-rgb hex)
                           (format nil "~C[48;2;~d;~d;~dm" #\Esc r g b))
                         "")))))
            (t ""))))

(defparameter *sgr-attr-codes*
  '((:bold . 1) (:dim . 2) (:italic . 3) (:underline . 4)
    (:blink . 5) (:reverse . 7) (:reset . 0)))

(defun sgr-attr (attr)
  "Return SGR attribute escape for ATTR keyword."
  (let ((code (cdr (assoc attr *sgr-attr-codes*))))
    (if code
        (format nil "~C[~dm" #\Esc code)
        "")))

(defun cursor-move-escape (x y)
  "Return CSI escape to move cursor to (x, y), 1-indexed."
  (format nil "~C[~d;~dH" #\Esc (1+ y) (1+ x)))

(defun cursor-style-escape (shape blink)
  "Return DECSTR escape for cursor shape."
  (let* ((base (case shape
                 (:block 2) (:underline 4) (:bar 6)
                 (t 2)))
         (code (if blink (1+ base) base)))
    (format nil "~C[~d q" #\Esc code)))

(defun decicm-begin ()
  "Return escape to enable synchronized updates."
  (format nil "~C[?2026h" #\Esc))

(defun decicm-end ()
  "Return escape to disable synchronized updates."
  (format nil "~C[?2026l" #\Esc))

(defun osc8-link (url text)
  "Wrap TEXT in an OSC 8 hyperlink to URL."
  (format nil "~C]8;;~A~C\\~A~C]8;;~C\\"
          #\Esc url #\Esc text #\Esc #\Esc))

(defparameter *border-chars*
  '(((:single :top-left) . "┌") ((:single :top-right) . "┐")
    ((:single :bottom-left) . "└") ((:single :bottom-right) . "┘")
    ((:single :horizontal) . "─") ((:single :vertical) . "│")
    ((:double :top-left) . "╔") ((:double :top-right) . "╗")
    ((:double :bottom-left) . "╚") ((:double :bottom-right) . "╝")
    ((:double :horizontal) . "═") ((:double :vertical) . "║")
    ((:rounded :top-left) . "╭") ((:rounded :top-right) . "╮")
    ((:rounded :bottom-left) . "╰") ((:rounded :bottom-right) . "╯")
    ((:rounded :horizontal) . "─") ((:rounded :vertical) . "│")))

(defun border-char (style pos)
  "Return the Unicode box-drawing character for STYLE at POS."
  (let ((char (cdr (assoc (list style pos) *border-chars* :test #'equal))))
    (or char (if (member pos '(:horizontal :vertical))
                 (case pos (:horizontal "─") (:vertical "│"))
                 "+"))))

(defclass modern-backend (backend)
  ((output-stream :initform *standard-output*
                  :initarg :output-stream
                  :accessor backend-output-stream)
   (in-sync-p :initform nil :accessor in-sync-p)))

(defun make-modern-backend (&key color-palette output-stream)
  (declare (ignore color-palette))
  (make-instance 'modern-backend :output-stream (or output-stream *standard-output*)))

(defmethod initialize-backend ((b modern-backend))
  (backend-write b (format nil "~C[?1049h" #\Esc))  ; alt screen
  (backend-write b (format nil "~C[?1000h" #\Esc))  ; mouse basic
  (backend-write b (format nil "~C[?1002h" #\Esc))  ; mouse drag
  (backend-write b (format nil "~C[?1006h" #\Esc))  ; SGR mouse
  (backend-write b (format nil "~C[?2004h" #\Esc))  ; bracketed paste
  ;; Kitty keyboard protocol disabled — converts all keys to CSI u-sequences
  ;; which the TUI's key mapping doesn't handle for Ctrl+letter combos.
  ;; (backend-write b (format nil "~C[?u" #\Esc))
  (cursor-hide b)
  (finish-output (backend-output-stream b))
  b)

(defmethod shutdown-backend ((b modern-backend))
  (cursor-show b)
  ;; (backend-write b (format nil "~C[?u" #\Esc))  ; disabled — never enabled
  (backend-write b (format nil "~C[?2004l" #\Esc))
  (backend-write b (format nil "~C[?1006l" #\Esc))
  (backend-write b (format nil "~C[?1002l" #\Esc))
  (backend-write b (format nil "~C[?1000l" #\Esc))
  (backend-write b (format nil "~C[?1049l" #\Esc))  ; normal screen
  (finish-output (backend-output-stream b))
  (values))

(defmethod suspend-backend ((b modern-backend))
  (cursor-show b)
  (backend-write b (format nil "~C[?1049l" #\Esc))  ; normal screen
  (cursor-move b 0 0)
  (finish-output (backend-output-stream b))
  (values))

(defmethod resume-backend ((b modern-backend))
  (backend-write b (format nil "~C[?1049h" #\Esc))  ; alt screen
  (backend-write b (format nil "~C[?1000h" #\Esc))  ; mouse basic
  (backend-write b (format nil "~C[?1002h" #\Esc))  ; mouse drag
  (backend-write b (format nil "~C[?1006h" #\Esc))  ; SGR mouse
  (backend-write b (format nil "~C[?2004h" #\Esc))  ; bracketed paste
  ;; (backend-write b (format nil "~C[?u" #\Esc))    ; kitty keyboard — disabled
  (cursor-hide b)
  (finish-output (backend-output-stream b))
  (values))

(defmethod backend-size ((b modern-backend))
  (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))))
      ;; $COLUMNS/$LINES fallback — some systems don't update the
      ;; TTY size via ioctl on stdout's fd.
      (ignore-errors
        (let* ((cstr (sb-ext:posix-getenv "COLUMNS"))
               (rstr (sb-ext:posix-getenv "LINES"))
               (cols (when cstr (parse-integer cstr :junk-allowed t)))
               (rows (when rstr (parse-integer rstr :junk-allowed t))))
          (when (and cols rows (> cols 0) (> rows 0))
            (values cols rows))))
      (values 80 24)))

(defmethod backend-write ((b modern-backend) string)
  (let ((stream (backend-output-stream b)))
    (write-string string stream)
    (finish-output stream)
    (length string)))

(defmethod capable-p ((b modern-backend) feature)
  (member feature '(:truecolor :osc8 :sync :mouse
                    :bracketed-paste :cursor-style
                    :kitty-keyboard)))

(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))
                    (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)
  (let* ((s (or style :single))
         (tl (border-char s :top-left))
         (tr (border-char s :top-right))
         (bl (border-char s :bottom-left))
         (br (border-char s :bottom-right))
         (h  (border-char s :horizontal))
         (v  (border-char s :vertical))
         (fg-esc (sgr-fg fg))
         (bg-esc (sgr-bg bg))
         (reset (sgr-attr :reset))
         (inner-width (- width 2))
         (hc (char h 0))
         (top (if (and title (plusp (length title)))
                  (let* ((align (or title-align :left))
                         (max-tlen (- inner-width 2))
                         (tlen (min (length title) max-tlen))
                         (trunc-title (subseq title 0 tlen)))
                    (ecase align
                      (:left
                       (let ((right-hyphens (- inner-width tlen 2)))
                         (concatenate 'string
                           fg-esc bg-esc tl (string #\Space)
                           trunc-title (string #\Space)
                           (make-string (max 0 right-hyphens) :initial-element hc)
                           tr reset (string #\Newline))))
                      (:center
                       (let* ((total-pad (- inner-width tlen))
                              (left-pad (floor total-pad 2))
                              (right-pad (- total-pad left-pad)))
                         (concatenate 'string
                           fg-esc bg-esc tl
                           (make-string left-pad :initial-element hc)
                           trunc-title
                           (make-string right-pad :initial-element hc)
                           tr reset (string #\Newline))))))
                  (concatenate 'string
                    fg-esc bg-esc tl
                    (make-string inner-width :initial-element hc)
                    tr reset (string #\Newline))))
         (mid (concatenate 'string
                fg-esc bg-esc v
                (make-string inner-width :initial-element #\Space)
                v reset (string #\Newline)))
         (bot (concatenate 'string
                fg-esc bg-esc bl
                (make-string inner-width :initial-element hc)
                br reset)))
    (backend-write b top)
    (loop repeat (- height 2) do (backend-write b mid))
    (backend-write b bot)))

(defmethod draw-rect ((b modern-backend) x y width height &key bg)
  (let* ((bg-esc (sgr-bg bg))
         (reset (sgr-attr :reset))
         (line (concatenate 'string
                 bg-esc
                 (make-string width :initial-element #\Space)
                 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 modern-backend) x y string url
                      &key fg bg)
  (let ((parts (list (cursor-move-escape x y)
                     (sgr-fg fg) (sgr-bg bg)
                     (osc8-link url string)
                     (sgr-attr :reset))))
    (backend-write b (apply #'concatenate 'string parts))))

(defmethod draw-ellipsis ((b modern-backend) x y width
                          &key fg bg)
  (declare (ignore width))
  (let ((dots "..."))
    (draw-text b x y dots fg bg)))

(defmethod cursor-move ((b modern-backend) x y)
  (backend-write b (cursor-move-escape x y)))

(defmethod cursor-hide ((b modern-backend))
  (backend-write b (format nil "~C[?25l" #\Esc)))

(defmethod cursor-show ((b modern-backend))
  (backend-write b (format nil "~C[?25h" #\Esc)))

(defmethod cursor-style ((b modern-backend) shape &key blink)
  (backend-write b (cursor-style-escape shape blink)))

(defmethod enable-mouse ((b modern-backend))
  (backend-write b (format nil "~C[?1000h" #\Esc))
  (backend-write b (format nil "~C[?1002h" #\Esc))
  (backend-write b (format nil "~C[?1006h" #\Esc))
  (finish-output (backend-output-stream b)))

(defmethod enable-bracketed-paste ((b modern-backend))
  (backend-write b (format nil "~C[?2004h" #\Esc))
  (finish-output (backend-output-stream b)))

(defmethod begin-sync ((b modern-backend))
  (setf (in-sync-p b) t)
  (backend-write b (decicm-begin)))

(defmethod end-sync ((b modern-backend))
  (setf (in-sync-p b) nil)
  (backend-write b (decicm-end))
  (finish-output (backend-output-stream b)))