(in-package #:cl-tty.input)

;;; ---------------------------------------------------------------------------
;;; Utility: split-string (avoids external dependency)
;;; ---------------------------------------------------------------------------
(defun %split-string (string separator)
  "Split STRING at each occurrence of SEPARATOR. Returns list of strings."
  (loop with start = 0
        for pos = (position separator string :start start)
        collect (subseq string start pos)
        while pos
        do (setf start (1+ pos))))

;;; ---------------------------------------------------------------------------
;;; Global variables for rendering pipeline (set by application)
;;; ---------------------------------------------------------------------------
(defvar *current-backend* nil
  "The active backend used for rendering.")
(defvar *current-theme* nil
  "The active theme used for semantic color resolution.")

;;; ---------------------------------------------------------------------------
;;; Key event struct
;;; ---------------------------------------------------------------------------
(defstruct key-event
  (key nil :type (or keyword null))
  (ctrl nil :type boolean)
  (alt nil :type boolean)
  (shift nil :type boolean)
  (code nil :type (or fixnum null))
  (raw nil :type (or string null))
  (text nil :type (or string null)))

;;; ---------------------------------------------------------------------------
;;; Mouse event struct
;;; ---------------------------------------------------------------------------
(defstruct mouse-event
  (type nil :type (or keyword null))
  (button nil :type (or keyword nil))
  (x 0 :type fixnum)
  (y 0 :type fixnum)
  (raw nil :type (or string null)))

;;; ---------------------------------------------------------------------------
;;; Terminal raw mode (stty on /dev/tty — portable across Unices)
;;; ---------------------------------------------------------------------------
(defun stty-run (args)
  "Run stty with ARGS. Returns stdout as string."
  (with-output-to-string (s)
    (sb-ext:run-program "/bin/sh"
                        (list "-c" (format nil "stty ~{~a~^ ~} < /dev/tty"
                                           (mapcar #'princ-to-string args)))
                        :output s :wait t)))

(defun save-terminal-state ()
  "Save current terminal settings via stty -g. Returns a string."
  (let ((s (string-trim '(#\Newline #\Space) (stty-run '("-g")))))
    (when (zerop (length s))
      (error "stty -g failed — not running in a real terminal"))
    s))

(defun set-raw-mode ()
  "Put terminal in raw mode via stty. Returns the saved state string."
  (let ((saved (save-terminal-state)))
    (stty-run '("raw" "-echo" "-isig" "-icanon" "min" "1" "time" "0"))
    saved))

(defun restore-terminal-state (saved)
  "Restore saved terminal state (a string from stty -g, or nil)."
  (when (and saved (plusp (length saved)))
    (stty-run (list saved))))

(defmacro with-raw-terminal (&body body)
  (let ((saved (gensym "SAVED")))
    `(let ((,saved (save-terminal-state)))
       (set-raw-mode)
       (unwind-protect
            (progn ,@body)
         (restore-terminal-state ,saved)))))

;;; ---------------------------------------------------------------------------
;;; Low-level byte reading
;;; ---------------------------------------------------------------------------
(defun read-raw-byte (&key timeout)
  (flet ((read-one ()
           (let ((buf (make-array 1 :element-type '(unsigned-byte 8))))
             ;; Use sb-sys:with-pinned-objects so sb-posix:read can access the buffer
             (sb-sys:with-pinned-objects (buf)
               (let ((n (sb-posix:read 0 (sb-sys:vector-sap buf) 1)))
                 (when (plusp n)
                   (return-from read-raw-byte (aref buf 0))))))))
    (if timeout
        (let ((deadline (+ (get-universal-time) timeout)))
          (loop while (< (get-universal-time) deadline)
                do (handler-case
                       (read-one)
                     (sb-posix:syscall-error ()
                       (return-from read-raw-byte nil)))
                   (sleep 0.01))
          nil)
        (handler-case
            (read-one)
          (sb-posix:syscall-error (e)
            (format *error-output* "read error: ~A~%" e)
            nil)))))

;;; ---------------------------------------------------------------------------
;;; CSI parameter parser
;;; ---------------------------------------------------------------------------
(defun parse-csi-params ()
  (let ((params '())
        (raw (make-array 0 :element-type '(unsigned-byte 8)
                           :fill-pointer 0 :adjustable t))
        (current 0))
    (loop
      (let ((b (read-raw-byte)))
        (unless b (return (values nil nil nil)))
        (vector-push-extend b raw)
        (cond
          ((and (>= b #x30) (<= b #x3f))
           (if (char= (code-char b) #\;)
               (progn (push current params) (setf current 0))
               ;; Non-digit parameter characters (< = > ?) start a new param at zero
               (if (member b '(#x3c #x3d #x3e #x3f) :test #'=)
                   (setf current 0)
                   (setf current (+ (* current 10) (- b #x30))))))
          ((and (>= b #x20) (<= b #x2f))
           nil)
          ((and (>= b #x40) (<= b #x7e))
           (push current params)
           (return (values (nreverse params) b
                           (map 'string #'code-char raw))))
          (t
           (return (values nil nil nil))))))))

;;; ---------------------------------------------------------------------------
;;; Key event tables
;;; ---------------------------------------------------------------------------
(defparameter *csi-key-table*
  '((#\A . :up) (#\B . :down) (#\C . :right) (#\D . :left)
    (#\F . :end) (#\H . :home)
    (#\P . :f1) (#\Q . :f2) (#\R . :f3) (#\S . :f4)
    (#\Z . :tab)))

(defparameter *csi-tilde-table*
  '((1 . :home) (2 . :insert) (3 . :delete)
    (4 . :end) (5 . :page-up) (6 . :page-down)
    (7 . :home) (8 . :end)
    (11 . :f1) (12 . :f2) (13 . :f3) (14 . :f4)
    (15 . :f5) (17 . :f6) (18 . :f7) (19 . :f8)
    (20 . :f9) (21 . :f10) (23 . :f11) (24 . :f12)))

;;; ---------------------------------------------------------------------------
;;; SGR mouse parser
;;; ---------------------------------------------------------------------------
(defun parse-sgr-mouse (raw)
  (let* ((start (position #\< raw))
         (end (position #\m raw :from-end t))
         (end2 (position #\M raw :from-end t))
         (final (if end end end2))
         (releasep (char= (char raw (1- (length raw))) #\m)))
    (when (and start final (> final start))
      (let* ((nums (mapcar #'parse-integer
                           (%split-string (subseq raw (1+ start) final) #\;)))
             (code (first nums))
             (x    (or (second nums) 0))
             (y    (or (third nums) 0))
             (button (logand code #x03))
             (mod    (logand code #x1c))
             (motion (logand code #x20))
             (wheel  (logand code #x40)))
        (declare (ignore mod))
        (make-mouse-event
         :type (cond (releasep :release)
                     (motion :drag)
                     (t :press))
         :button (cond (wheel (if (zerop (logand code #x01))
                                  :wheel-up :wheel-down))
                       ((= button 0) :left)
                       ((= button 1) :middle)
                       ((= button 2) :right)
                       (t :none))
         :x x :y y :raw raw)))))

;;; ---------------------------------------------------------------------------
;;; Escape sequence reader
;;; ---------------------------------------------------------------------------
(defun %read-escape-sequence ()
  (let ((b (read-raw-byte)))
    (unless b
      (return-from %read-escape-sequence
        (make-key-event :key :escape :raw (string #\Esc))))
    (case b
      ;; SS3: ESC O X
      (#x4f
       (let ((b2 (read-raw-byte)))
         (if b2
             (let ((key (cdr (assoc (code-char b2)
                                    '((#\P . :f1) (#\Q . :f2)
                                      (#\R . :f3) (#\S . :f4))))))
               (make-key-event :key (or key :unknown)
                               :raw (format nil "~C~C~C" #\Esc #\O (code-char b2))))
             (make-key-event :key :escape :raw (string #\Esc)))))
      ;; CSI: ESC [ ...
      (#x5b
       (multiple-value-bind (params final-byte raw) (parse-csi-params)
         (if (null final-byte)
             (make-key-event :key :escape :raw (string #\Esc))
             ;; SGR mouse: ESC [ < ... m/M
             (if (and raw (plusp (length raw)) (char= (char raw 0) #\<))
                 (or (parse-sgr-mouse raw)
                     (make-key-event :key :unknown :raw raw))
                 (if (and (char= (code-char final-byte) #\M)
                      (>= (length params) 3))
                 (let* ((p0 (first params)))
                   (if (zerop (logand p0 #x40))
                       (let* ((x (second params))
                              (y (third params))
                              (button (logand p0 #x03))
                              (motion (logand p0 #x20))
                              (release (= button 3)))
                         (make-mouse-event
                          :type (cond (release :release)
                                      (motion :drag)
                                      (t :press))
                          :button (let ((b button)) (cond ((= b 0) :left) ((= b 1) :middle) ((= b 2) :right) (t :none)))
                          :x x :y y :raw (format nil "~C[<~d;~d;~d~C" #\Esc p0 x y (code-char final-byte))))
                       (let* ((tilde-p (char= (code-char final-byte) #\~))
                              (param (or p0 0))
                              (key (if tilde-p
                                       (cdr (assoc param *csi-tilde-table*))
                                       (cdr (assoc (code-char final-byte) *csi-key-table*))))
                              (modifier (when (> (length params) 1) (second params))))
                         (let ((ctrl nil) (alt nil) (shift nil))
                           (when modifier
                             (setf shift (logtest modifier 1)
                                   alt   (logtest modifier 2)
                                   ctrl  (logtest modifier 4)))
                           (make-key-event :key (or key :unknown)
                                           :ctrl ctrl :alt alt :shift shift
                                           :raw (format nil "~C[~d~C" #\Esc param (code-char final-byte))))))
                 (let* ((tilde-p (char= (code-char final-byte) #\~))
                        (param (or (first params) 0))
                        (key (if tilde-p
                                 (cdr (assoc param *csi-tilde-table*))
                                 (cdr (assoc (code-char final-byte) *csi-key-table*))))
                        (modifier (when (> (length params) 1) (second params))))
                   (let ((ctrl nil) (alt nil) (shift nil))
                     (when modifier
                       (setf shift (logtest modifier 1)
                             alt   (logtest modifier 2)
                             ctrl  (logtest modifier 4)))
                     (make-key-event :key (or key :unknown)
                                     :ctrl ctrl :alt alt :shift shift
                                     :raw (format nil "~C[~d~C" #\Esc param (code-char final-byte)))))))))))
      ;; ESC ESC
      (#x1b
       (make-key-event :key :escape :alt t :raw "\\e\\e"))
      ;; ESC + printable = Alt+key
      (t
       (let ((ch (code-char b)))
         (if (and (>= b #x20) (<= b #x7e))
             (make-key-event :key (intern (string (string-upcase ch)) :keyword)
                             :alt t
                             :raw (format nil "~C~C" #\Esc ch))
             (make-key-event :key :unknown
                             :raw (format nil "~C~C" #\Esc ch))))))))

;;; ---------------------------------------------------------------------------
;;; Top-level event reader
;;; ---------------------------------------------------------------------------
(defun %read-event (&key timeout)
  (let ((b (read-raw-byte :timeout timeout)))
    (unless b
      (return-from %read-event nil))
    (cond
      ((= b #x1b)
       (%read-escape-sequence))
      ((= b #x09)
       (make-key-event :key :tab :code #x09))
      ((= b #x0a)
       (make-key-event :key :enter :code #x0a))
      ((= b #x0d)
       (make-key-event :key :enter :code #x0d))
      ((or (= b #x7f) (= b #x08))
       (make-key-event :key :backspace :code b))
      ((and (>= b #x01) (<= b #x1a))
       (let ((key (intern (string-upcase (string (code-char (+ b #x60)))) :keyword)))
         (make-key-event :key key :ctrl t :code b)))
      ((= b #x1c) (make-key-event :key :backslash :ctrl t :code b))
      ((= b #x1d) (make-key-event :key :rbracket :ctrl t :code b))
      ((= b #x1e) (make-key-event :key :caret :ctrl t :code b))
      ((= b #x1f) (make-key-event :key :underscore :ctrl t :code b))
      ((and (>= b #x20) (<= b #x7e))
       (let ((ch (code-char b)))
         (make-key-event :key (intern (string (string-upcase ch)) :keyword)
                         :code b)))
      (t
       (make-key-event :key :unknown :code b :raw (string (code-char b)))))))

;;; ---------------------------------------------------------------------------
;;; Backend integration
;;; ---------------------------------------------------------------------------
(defmethod read-event ((b cl-tty.backend:backend) &key timeout)
  (declare (ignore b))
  (when (probe-file "/dev/stdin")
    (%read-event :timeout timeout)))