;;; lichess-game.el --- Game stream/debug utilities for Lichess -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2025-2026  Alexandr Timchenko
;; URL: https://github.com/tmythicator/Lichess.el
;; Package-Requires: ((emacs "27.1"))
;; SPDX-License-Identifier: GPL-3.0-or-later
;; See LICENSE for details.
;;
;;; Commentary:
;; Minimal game streaming/debug using NDJSON:
;; - M-x lichess-game-watch         -> watch a game with live board and history navigation
;; - M-x lichess-game-play          -> play/watch your own game (Real-time)
;; - M-x lichess-game-stream-debug  -> pretty-print /api/stream/game/{id}
;; - M-x lichess-game-stream-stop   -> close the current stream
;;
;; Note: Use `lichess-game-play' for zero-latency updates on your own games.
;;
;;; Code:

(require 'lichess-core)
(require 'lichess-util)
(require 'lichess-api)
(require 'lichess-fen)
(require 'lichess-board)
(require 'lichess-announce)
(require 'text-property-search)

(defvar lichess-game--stream nil
  "Current `lichess-http-stream' for a game NDJSON, or nil when not running.")

(defun lichess-game--stream-buffer-name (id)
  "Return buffer name for game ID."
  (format "*Lichess Game Stream: %s*" id))

(defvar-local lichess-game--state nil
  "Buffer-local `lichess-game` struct containing all game state.")

(defvar-local lichess-game--last-announced-idx -1
  "Move index that was last announced to prevents duplicates.")

(defvar lichess-game-buffer-mode-map
  (let ((m (make-sparse-keymap)))
    (define-key m (kbd "q") #'lichess-game-stream-stop)
    (define-key m (kbd "p") #'lichess-game-history-previous)
    (define-key m (kbd "n") #'lichess-game-history-next)
    (define-key m (kbd "v") #'lichess-game-set-perspective)
    (define-key m (kbd "l") #'lichess-game-evaluate-history)
    (define-key m (kbd "m") #'lichess-game-move)
    (define-key m (kbd "R") #'lichess-game-resign)
    (define-key m (kbd "D") #'lichess-game-draw)
    (define-key m (kbd "K") #'lichess-game-castle-kingside)
    (define-key m (kbd "Q") #'lichess-game-castle-queenside)
    (define-key m [mouse-1] #'lichess-game-mouse-handler)
    m))

(define-derived-mode
 lichess-game-buffer-mode
 lichess-core-mode
 "Lichess-Game"
 "Major mode for live Lichess game buffers."
 (setq truncate-lines t))

(defun lichess-game-render ()
  "Render the complete game view for the current game state.

Draws the header, board, evaluation bar (if available), and footer info.
All parameters are derived from the buffer-local `lichess-game--state'."
  (when-let* ((state lichess-game--state)
              (idx (plist-get state :current-idx))
              (hist (plist-get state :fen-history)))
    (let* ((fen (aref hist idx))
           (eval-str (gethash idx (plist-get state :eval-cache)))
           (pos
            (ignore-errors
              (lichess-fen-parse fen)))
           (perspective (plist-get state :perspective))
           (eval-label
            (cond
             ((stringp eval-str)
              (format " | Eval: %s" eval-str))
             ((eq eval-str :pending)
              " | Eval: ...")
             (t
              "")))
           (result (lichess-game--format-result state))
           (pos-info
            (format "Position %d/%d%s%s"
                    (1+ idx) (length hist) eval-label
                    (if result
                        (concat "\n" result)
                      "")))
           (highlights
            (when-let ((sq (plist-get state :selected-square)))
              (list sq)))
           ;; Construct Preamble: Names, Clocks, Result
           (header-parts (lichess-game--format-header state))
           (preamble (car header-parts))
           (postamble (cdr header-parts)))
      (when pos
        (let ((inhibit-read-only t))
          (plist-put pos :eval eval-str)
          (plist-put pos :info pos-info)
          (lichess-board-render-to-buffer
           pos perspective highlights preamble postamble)

          ;; Insert Control Buttons
          (lichess-game--insert-controls state))

        ;; Update Sidebar if it exists
        (let ((side-buf
               (get-buffer
                (lichess-game--sidebar-buffer-name
                 (plist-get state :id)))))
          (when (buffer-live-p side-buf)
            (lichess-game-render-sidebar (current-buffer))))

        ;; Accessibility: Announce move
        (when (and idx
                   (/= idx (or lichess-game--last-announced-idx -1)))
          (setq-local lichess-game--last-announced-idx idx)
          (lichess-announce-game-move
           (plist-get state :moves-str) idx (plist-get pos :stm)))))))

(defun lichess-game-history-previous ()
  "Move to the previous position in game history."
  (interactive)
  (when-let* ((state lichess-game--state)
              (idx (plist-get state :current-idx))
              (hist (plist-get state :fen-history)))
    (when (> idx 0)
      (plist-put state :live-mode nil)
      (plist-put state :current-idx (1- idx))
      (lichess-game-render))))

(defun lichess-game-history-next ()
  "Move to the next position in game history."
  (interactive)
  (when-let* ((state lichess-game--state)
              (idx (plist-get state :current-idx))
              (hist (plist-get state :fen-history)))
    (when (< idx (1- (length hist)))
      (plist-put state :current-idx (1+ idx))
      (when (= (plist-get state :current-idx) (1- (length hist)))
        (plist-put state :live-mode t))
      (lichess-game-render))))

(defun lichess-game--extract-fen (obj)
  "Extract FEN from an NDJSON event (from OBJ.fen or OBJ.state.fen)."
  (or (lichess-util--aget obj 'fen)
      (let ((st (lichess-util--aget obj 'state)))
        (and (consp st) (lichess-util--aget st 'fen)))))


(defun lichess-game--fen-history-vpush (fen)
  "Append FEN to the `lichess-game--fen-history' via STATE.
Handles stream replays by resetting history if a move regression is detected
immediately after the initial summary state."
  (when-let* ((state lichess-game--state)
              (hist (plist-get state :fen-history)))
    (let* ((len (length hist))
           (last (and (> len 0) (aref hist (1- len)))))
      ;; Detect Replay: If history has 1 item (Summary) and new FEN is earlier, reset.
      (when (and (= len 1) last)
        (let ((last-fm (lichess-fen--fullmove last))
              (new-fm (lichess-fen--fullmove fen)))
          (when (< new-fm last-fm)
            (setf hist (vector))
            (plist-put state :fen-history hist))))

      (unless (and last (string= last fen))
        (plist-put state :fen-history (vconcat hist (vector fen)))))))

(defun lichess-game-create (&rest args)
  "Create a new game state plist with default values, overridden by ARGS."
  (let
      ((defaults
        (list
         :id nil ;; String: Game ID (or nil)
         :variant nil ;; Alist: Variant info ((key . "standard") ...)
         :initial-fen nil ;; String: Initial FEN
         :initial-pos nil ;; Plist: Parsed initial position (lichess-pos)
         :white nil ;; Alist: White player info
         :black nil ;; Alist: Black player info
         :my-color nil ;; Symbol: 'white, 'black, or nil (spectator)
         :fen-history (make-vector 0 t) ;; Vector: History of FEN strings
         :moves-str nil ;; String: Space-separated moves
         :eval-cache (make-hash-table) ;; Hash: Local evaluation cache
         :current-idx -1 ;; Integer: Current index in fen-history
         :live-mode t ;; Boolean: t if following live game updates
         :perspective 'white ;; Symbol: 'white or 'black board orientation
         :speed nil ;; String: Game speed class (e.g. "blitz")
         :status nil ;; String: Game status (e.g. "started", "mate")
         :selected-square nil ;; Symbol: Currently selected square (e.g. 'e4)
         :winner nil ;; Symbol: 'white, 'black, or nil
         :white-clock "--:--" ;; String: Formatted white clock time
         :black-clock "--:--" ;; String: Formatted black clock time
         :white-time-ms nil ;; Number: White time in milliseconds
         :black-time-ms nil ;; Number: Black time in milliseconds
         :last-update-time nil ;; Number: Timestamp (float-time) of last update
         :timer nil))) ;; Timer: Active timer object for polling/tick
    ;; Apply overrides
    (while args
      (let ((key (pop args))
            (val (pop args)))
        (plist-put defaults key val)))
    defaults))

(defun lichess-game--reset-local-vars ()
  "Reset buffer-local state variables for a new game."
  (setq-local lichess-game--state (lichess-game-create)))

(defun lichess-game--format-time (millis)
  "Format MILLIS (number) into MM:SS string."
  (if (numberp millis)
      (let* ((ms (round millis))
             (secs (/ ms 1000))
             (m (/ secs 60))
             (s (% secs 60)))
        (format "%02d:%02d" m s))
    "--:--"))

(defun lichess-game--tick (buf)
  "Timer callback to update clocks in BUF."
  (when (buffer-live-p buf)
    (with-current-buffer buf
      (when-let* ((state lichess-game--state)
                  (live (plist-get state :live-mode))
                  (last-t (plist-get state :last-update-time))
                  (w-ms (plist-get state :white-time-ms))
                  (b-ms (plist-get state :black-time-ms)))

        ;; Determine who is moving
        (let* ((hist (plist-get state :fen-history))
               (idx (or (plist-get state :current-idx) -1))
               (fen
                (if (and (>= idx 0) (< idx (length hist)))
                    (aref hist idx)
                  nil))
               (stm (and fen (lichess-fen--stm fen)))
               (now (float-time))
               (elapsed-ms (* (- now last-t) 1000)))

          ;; Only tick if we are at the latest position (live mode) and game is likely active
          (when (and live stm)
            (let ((new-w w-ms)
                  (new-b b-ms))
              (if (eq stm 'w)
                  (setq new-w (max 0 (- w-ms elapsed-ms)))
                (setq new-b (max 0 (- b-ms elapsed-ms))))

              (plist-put
               state
               :white-clock (lichess-game--format-time new-w))
              (plist-put
               state
               :black-clock (lichess-game--format-time new-b))

              ;; Optimization: Try to update clock in-place to avoid flickering
              (let ((updated-w
                     (lichess-game--update-clock-in-place
                      'white (plist-get state :white-clock)))
                    (updated-b
                     (lichess-game--update-clock-in-place
                      'black (plist-get state :black-clock))))
                ;; If in-place update failed (e.g. text props lost), do full render
                (unless (and updated-w updated-b)
                  (lichess-game-render))))))))))

(defun lichess-game--update-clock-in-place (side new-text)
  "Update the clock text for SIDE (`white' or `black')
to NEW-TEXT in current buffer.
Returns t if successful, nil otherwise."
  (save-excursion
    (goto-char (point-min))
    (let ((found
           (text-property-search-forward 'lichess-clock side t)))
      (if found
          (let ((inhibit-read-only t))
            (delete-region
             (prop-match-beginning found) (prop-match-end found))
            (insert
             (propertize new-text 'lichess-clock side 'face 'bold))
            t)
        nil))))

(defun lichess-game--start-timer (buf)
  "Start the clock ticker for BUF."
  (with-current-buffer buf
    (when lichess-game--state
      (lichess-game--stop-timer buf)
      (plist-put
       lichess-game--state
       :timer (run-at-time 1.0 1.0 #'lichess-game--tick buf)))))

(defun lichess-game--stop-timer (&optional buf)
  "Stop the clock ticker for BUF (defaults to current)."
  (let ((b (or buf (current-buffer))))
    (when (buffer-live-p b)
      (with-current-buffer b
        (when (and lichess-game--state
                   (plist-get lichess-game--state :timer))
          (cancel-timer (plist-get lichess-game--state :timer))
          (plist-put lichess-game--state :timer nil))))))

(defun lichess-game--stream-on-open (id buf msg-prefix _proc _buf)
  "Callback for NDJSON stream open.
ID is the game, BUF is the buffer, MSG-PREFIX for status."
  (lichess-core-with-buf
   buf
   (unless (derived-mode-p 'lichess-game-buffer-mode)
     (lichess-game-buffer-mode))
   (lichess-game--reset-local-vars)
   (plist-put lichess-game--state :id id)
   (erase-buffer)
   (insert (format "%s %s…\n" msg-prefix id))
   (lichess-game--start-timer buf)))

(defun lichess-game--stream-on-event (buf obj)
  "Callback for spectator NDJSON stream events (contain FEN).
BUF is the target buffer, OBJ is the parsed JSON event."
  (lichess-core-with-buf
   buf
   (let*
       ((fen (lichess-game--extract-fen obj))
        (state-obj (or (lichess-util--aget obj 'state) obj))
        (moves (lichess-util--aget state-obj 'moves))
        (players (or (lichess-util--aget obj 'players) obj))
        (white (lichess-util--aget players 'white))
        (black (lichess-util--aget players 'black))
        (state lichess-game--state)
        ;; Capture live mode BEFORE status update (which might clear it)
        (was-live (plist-get state :live-mode)))

     ;; [FIX] Update Moves (Incremental from 'lm')
     (when-let ((lm (lichess-util--aget obj 'lm)))
       (let ((current (or (plist-get state :moves-str) "")))
         (plist-put
          state
          :moves-str
          (if (string-empty-p current)
              lm
            (concat current " " lm)))))

     ;; Update names if found (usually in the first message)
     (when (or white black)
       (plist-put state :white white)
       (plist-put state :black black)
       (lichess-game--insert-preamble buf white black))

     ;; Update Status/Winner
     (lichess-game--update-status state obj buf)

     ;; Update Moves
     (when moves
       (plist-put state :moves-str moves))

     ;; Update Clocks
     (lichess-game--update-clocks state obj)

     (plist-put state :last-update-time (float-time))

     ;; Render FEN or Status
     (if fen
         (progn
           (lichess-game--fen-history-vpush fen)
           ;; If we were live, or still are, update index to follow game.
           ;; If game just ended, was-live is true, live-mode is false.
           (when (or was-live (plist-get state :live-mode))
             (plist-put
              state
              :current-idx (1- (length (plist-get state :fen-history))))
             (lichess-game-render)))
       ;; If no FEN (e.g. termination event), render if status changed
       (when (lichess-util--aget obj 'status)
         (lichess-game-render))))))

(defun lichess-game--board-on-event (buf obj)
  "Callback for Board API stream events.
BUF is the target buffer, OBJ is the parsed JSON event."
  (lichess-core-with-buf
   buf
   (let* ((type (lichess-util--aget obj 'type))
          (state-obj (or (lichess-util--aget obj 'state) obj))
          (moves (lichess-util--aget state-obj 'moves))
          (white (lichess-util--aget obj 'white))
          (black (lichess-util--aget obj 'black))
          (state lichess-game--state))

     ;; Update Clocks
     (lichess-game--update-clocks state obj)
     (plist-put state :last-update-time (float-time))

     (when moves
       (plist-put state :moves-str moves))

     ;; Update Status/Winner
     (lichess-game--update-status state state-obj buf)

     ;; 1. Handle game setup
     (when (string= type "gameFull")
       (let*
           ((ifen
             (or (lichess-util--aget obj 'initialFen) "startpos"))
            (ipos (lichess-fen-parse ifen))

            (variant
             (lichess-util--aget
              (lichess-util--aget obj 'variant) 'key))

            (w-id (lichess-util--aget white 'id))
            (b-id (lichess-util--aget black 'id))
            ;; Determine my color by matching username/ID
            (curr-user
             (and (boundp 'lichess-username) lichess-username))
            (am-white
             (or (and curr-user
                      (lichess-util--aget white 'name)
                      (string-match-p
                       curr-user
                       (or (lichess-util--aget white 'name) "")))
                 (and w-id curr-user (string= w-id curr-user))))
            (am-black
             (or (and curr-user
                      (lichess-util--aget black 'name)
                      (string-match-p
                       curr-user
                       (or (lichess-util--aget black 'name) "")))
                 (and b-id curr-user (string= b-id curr-user))))
            (my-col
             (cond
              (am-white
               'white)
              (am-black
               'black)
              ;; Fallback for AI games: if one side is AI, we are the other
              ((lichess-util--aget white 'aiLevel)
               'black)
              ((lichess-util--aget black 'aiLevel)
               'white)
              (t
               nil))))

         (plist-put state :initial-pos ipos)
         (plist-put state :variant variant)
         (plist-put state :white white)
         (plist-put state :black black)
         (plist-put state :my-color my-col)
         (when my-col
           (plist-put state :perspective my-col))
         (plist-put state :id (lichess-util--aget obj 'id))
         (lichess-game--insert-preamble buf white black
                                        variant
                                        my-col)))

     ;; 2. Reconstruct FEN / Check Status
     (if (lichess-util--aget state-obj 'moves)
         (when-let ((ipos (plist-get state :initial-pos)))
           (let* ((current-pos (lichess-fen-apply-moves ipos moves))
                  (current-fen (lichess-fen-pos->fen current-pos)))
             (lichess-game--fen-history-vpush current-fen)
             (plist-put
              state
              :current-idx (1- (length (plist-get state :fen-history))))
             (lichess-game-render)))
       ;; No moves, but status update?
       (when (lichess-util--aget state-obj 'status)
         (lichess-game-render))))))

(defun lichess-game--stream-on-close (buf msg-prefix _proc msg)
  "Callback for NDJSON stream close.
BUF, MSG-PREFIX, and MSG describe the event."
  (when (buffer-live-p buf)
    (lichess-game--stop-timer buf)
    (lichess-core-with-buf
     buf (goto-char (point-max))
     (insert
      (format
       "\n[%s] — %s disconnected: %s\n"
       (format-time-string "%T") msg-prefix (string-trim msg))))))

;;;###autoload
(defun lichess-game-watch (id)
  "Watch a Lichess game by ID with a real-time board display and history."
  (interactive "sLichess game ID to watch: ")
  (let* ((buf-name (lichess-game--stream-buffer-name id))
         (buf (get-buffer-create buf-name)))
    (lichess-game-stream-stop)

    (setq lichess-game--stream
          (lichess-api-stream-game
           id
           :buffer-name (buffer-name buf)
           :on-open
           (apply-partially #'lichess-game--stream-on-open
                            id buf "Connecting to game (Spectator)")
           :on-event
           (apply-partially #'lichess-game--stream-on-event buf)
           :on-close
           (apply-partially #'lichess-game--stream-on-close
                            buf "Stream")))
    (pop-to-buffer buf)))

;;;###autoload
(defun lichess-game-play (id)
  "Watch a game you are playing using the Board API for zero-delay update.
This uses /api/board/game/stream/{ID} which has no delay."
  (interactive "sGame ID: ")
  (let* ((buf-name (lichess-game--stream-buffer-name id))
         (buf (get-buffer-create buf-name)))
    (lichess-game-stream-stop)
    (setq lichess-game--stream
          (lichess-api-stream-game-board
           id
           :buffer-name (buffer-name buf)
           :on-open
           (apply-partially #'lichess-game--stream-on-open
                            id buf "Connecting to your game")
           :on-event
           (apply-partially #'lichess-game--board-on-event buf)
           :on-close
           (apply-partially #'lichess-game--stream-on-close
                            buf "Zero-delay stream")))
    (pop-to-buffer buf)))

;;;###autoload
(defun lichess-game-evaluate-history ()
  "Fetch cloud evaluations for all positions in the current game history."
  (interactive)
  (let ((game-buf (current-buffer))
        (state lichess-game--state))
    (when state
      (let ((hist (plist-get state :fen-history)))
        (message "Batch fetching evaluations for %d moves..."
                 (length hist))
        (lichess-announce-event
         (format "Fetching evaluations for %d moves" (length hist)))
        (dotimes (i (length hist))
          (let ((cached-eval
                 (gethash i (plist-get state :eval-cache))))
            (when (or (null cached-eval)
                      (and (stringp cached-eval)
                           (or (string-empty-p cached-eval)
                               (string= cached-eval "..."))))
              (let* ((fen (aref hist i))
                     (pos
                      (ignore-errors
                        (lichess-fen-parse fen))))
                (when pos
                  (puthash i :pending (plist-get state :eval-cache))
                  (lichess-util-fetch-evaluation
                   fen
                   (lambda (eval-str)
                     (lichess-core-with-buf
                      game-buf
                      (puthash
                       i eval-str (plist-get state :eval-cache))
                      (when (= i (plist-get state :current-idx))
                        (lichess-game-render))))))))))))))

;;;###autoload
(defun lichess-game-set-perspective ()
  "Set the board perspective for the current game buffer."
  (interactive)
  (when-let* ((state lichess-game--state)
              (idx (plist-get state :current-idx))
              (hist (plist-get state :fen-history)))
    (let* ((choices '("auto" "white" "black"))
           (new-persp-str
            (completing-read "Set perspective: " choices
                             nil
                             t
                             nil
                             nil
                             "auto"))
           (new-persp (intern new-persp-str)))
      (plist-put state :perspective new-persp)
      (lichess-announce-event
       (format "Perspective set to %s" new-persp-str))
      (when idx
        (lichess-core-with-buf
         (current-buffer) (lichess-game-render))))))

(defun lichess-game-flip-board ()
  "Toggle the board perspective between white and black."
  (interactive)
  (when-let* ((state lichess-game--state))
    (let* ((current (or (plist-get state :perspective) 'white))
           (new-persp
            (if (eq current 'white)
                'black
              'white)))
      (plist-put state :perspective new-persp)
      (lichess-announce-event
       (format "Board flipped to %s" new-persp))
      (lichess-game-render))))

;;;###autoload
(defun lichess-game-stream-stop ()
  "Stop the current Lichess NDJSON game stream (if any)."
  (interactive)
  (if lichess-game--stream
      (progn
        (lichess-http-ndjson-close lichess-game--stream)
        (setq lichess-game--stream nil)
        (message "Lichess NDJSON stream stopped.")
        (lichess-announce-event "NDJSON stream stopped"))
    (message "No active Lichess NDJSON stream.")))

;;;###autoload
(defun lichess-game-move (move)
  "Make a move in the current game.
MOVE should be in UCI format (e.g., e2e4)."
  (interactive "sMove (UCI, e.g. e2e4): ")
  (unless (and lichess-game--state
               (plist-get lichess-game--state :id))
    (error "No game ID found for this buffer"))
  (let ((game-id (plist-get lichess-game--state :id)))
    (message "Sending move %s for game %s..." move game-id)
    (lichess-api-board-move
     game-id move
     (lambda (res)
       (if (lichess-http-result-success res)
           (message "Move %s sent successfully" move)
         (let* ((err (lichess-http-result-error res))
                (status (car err))
                (json (cdr err)))
           (message "Error sending move: %d %s"
                    status
                    (or (lichess-util--aget json 'error) ""))))))))

;;;###autoload
(defun lichess-game-resign ()
  "Resign the current game."
  (interactive)
  (unless (and lichess-game--state
               (plist-get lichess-game--state :id))
    (error "No game ID found for this buffer"))
  (when (yes-or-no-p "Really resign this game? ")
    (let ((game-id (plist-get lichess-game--state :id)))
      (message "Resigning game %s..." game-id)
      (lichess-api-board-resign
       game-id
       (lambda (res)
         (if (lichess-http-result-success res)
             (let ((msg "Game resign event sent"))
               (message msg)
               (lichess-announce-event msg))
           (let* ((err (lichess-http-result-error res))
                  (status (car err))
                  (json (cdr err)))
             (message "Error resigning: %d %s"
                      status
                      (or (lichess-util--aget json 'error) "")))))))))

;;;###autoload
(defun lichess-game-draw ()
  "Propose or accept a draw in the current game."
  (interactive)
  (unless (and lichess-game--state
               (plist-get lichess-game--state :id))
    (error "No game ID found for this buffer"))
  (when (yes-or-no-p "Offer/Accept draw? ")
    (let ((game-id (plist-get lichess-game--state :id)))
      (message "Sending draw request for game %s..." game-id)
      (lichess-api-board-draw
       game-id 'yes
       (lambda (res)
         (if (lichess-http-result-success res)
             (let ((msg "Draw request sent"))
               (message msg)
               (lichess-announce-event msg))
           (let* ((err (lichess-http-result-error res))
                  (status (car err))
                  (json (cdr err)))
             (message "Error with draw request: %d %s"
                      status
                      (or (lichess-util--aget json 'error) "")))))))))

(defun lichess-game--get-castling-move (color side)
  "Return UCI castling move string for COLOR and SIDE."
  (when-let* ((state lichess-game--state)
              (variant (or (plist-get state :variant) "standard"))
              (initial-pos (plist-get state :initial-pos)))
    (let ((is-960 (string= variant "chess960"))
          (row
           (if (eq color 'white)
               7
             0)))

      (if (not is-960)
          ;; Standard Chess
          (pcase (cons color side)
            (`(white . kingside) "e1g1")
            (`(white . queenside) "e1c1")
            (`(black . kingside) "e8g8")
            (`(black . queenside) "e8c8"))

        ;; Chess960 Logic
        (when-let* ((board (plist-get initial-pos :board))
                    (row-vec (aref board row))
                    (king-col
                     (cl-position
                      (if (eq color 'white)
                          ?K
                        ?k)
                      row-vec))
                    (rook-col
                     (if (eq side 'kingside)
                         ;; Find rightmost rook
                         (cl-position
                          (if (eq color 'white)
                              ?R
                            ?r)
                          row-vec
                          :from-end t)
                       ;; Find leftmost rook
                       (cl-position
                        (if (eq color 'white)
                            ?R
                          ?r)
                        row-vec))))
          (let ((k-sq (format "%c%d" (+ ?a king-col) (- 8 row)))
                (r-sq (format "%c%d" (+ ?a rook-col) (- 8 row))))
            (concat k-sq r-sq)))))))

(defun lichess-game--do-castle (side)
  "Perform castling for SIDE (symbols `kingside' or `queenside')."
  (unless (and lichess-game--state
               (plist-get lichess-game--state :id))
    (error "No game ID"))
  (let* ((state lichess-game--state)
         (hist (plist-get state :fen-history))
         (last-fen
          (and (> (length hist) 0) (aref hist (1- (length hist)))))
         (pos (and last-fen (lichess-fen-parse last-fen)))
         (my-color (plist-get state :my-color))
         (turn (and pos (plist-get pos :stm)))
         (fen-color
          (if (eq turn 'w)
              'white
            'black))
         (color (or my-color fen-color))
         (move (lichess-game--get-castling-move color side)))

    (message
     "[DEBUG] castle: my-color=%S turn=%S fen-color=%S final-color=%S move=%S"
     my-color turn fen-color color move)

    (if move
        (if (and my-color (not (eq my-color fen-color)))
            (message "It is not your turn! (You are %s, turn is %s)"
                     my-color
                     fen-color)
          (lichess-game-move move))
      (message "Cannot determine castling move."))))

;;;###autoload
(defun lichess-game-castle-kingside ()
  "Castle Kingside (O-O)."
  (interactive)
  (lichess-announce-event "Kingside castle requested")
  (lichess-game--do-castle 'kingside))

;;;###autoload
(defun lichess-game-castle-queenside ()
  "Castle Queenside (O-O-O)."
  (interactive)
  (lichess-announce-event "Queenside castle requested")
  (lichess-game--do-castle 'queenside))


;;; Sidebar / PGN

(defun lichess-game--sidebar-buffer-name (id)
  (format "*Lichess Sidebar: %s*" id))

(defvar-local lichess-game--main-buffer nil
  "Pointer to the main game buffer.")

(define-derived-mode
 lichess-game-sidebar-mode
 special-mode
 "Lichess-Sidebar"
 "Mode for Lichess sidebar."
 (setq truncate-lines t))

(defun lichess-game-set-index (idx)
  "Set current history index to IDX."
  (interactive "nIndex: ")
  (when-let* ((state lichess-game--state)
              (hist (plist-get state :fen-history)))
    (when (and (>= idx 0) (< idx (length hist)))
      (plist-put state :live-mode (= idx (1- (length hist))))
      (plist-put state :current-idx idx)
      (lichess-game-render))))

(defun lichess-game--insert-pgn (state game-buf)
  "Insert clickable PGN into current buffer for STATE and GAME-BUF."
  (let* ((moves-str (or (plist-get state :moves-str) ""))
         (moves (split-string moves-str " " t))
         (curr-idx (or (plist-get state :current-idx) -1))
         ;; curr-idx 0 = startpos. 1 = after move 0.
         (highlight-idx (1- curr-idx)))
    (dotimes (i (length moves))
      (let* ((move (nth i moves))
             (move-num (1+ (/ i 2)))
             (is-white (= (% i 2) 0))
             (is-highlight (= i highlight-idx)))
        (when is-white
          (insert (format "%3d. " move-num)))

        (insert-button
         (if (string-match-p "\\`[a-z][0-9][a-z][0-9]\\'" move)
             ;; Simple formatting: e2e4 -> e2-e4 (make it slightly wider)
             ;; Or just use raw UCI. Converting to SAN is hard without logic.
             ;; Let's try a very basic 'Dest' extraction if pawn-like or 'PieceDest'
             ;; But without knowing piece type, we can't do SAN.
             ;; Just show UCI for now.
             move
           move)
         'action
         (lambda (_)
           (when (buffer-live-p game-buf)
             (with-current-buffer game-buf
               (lichess-game-set-index (1+ i)))))
         'face
         (if is-highlight
             'highlight
           'link)
         'follow-link
         t)

        (insert " ")
        (unless is-white
          (insert "\n"))))))

(defun lichess-game-render-sidebar (game-buf)
  "Render the sidebar for GAME-BUF."
  (when (buffer-live-p game-buf)
    (with-current-buffer game-buf
      (when-let* ((state lichess-game--state)
                  (id (plist-get state :id)))
        (let ((side-buf
               (get-buffer-create
                (lichess-game--sidebar-buffer-name id))))
          (with-current-buffer side-buf
            (unless (derived-mode-p 'lichess-game-sidebar-mode)
              (lichess-game-sidebar-mode))
            (setq lichess-game--main-buffer game-buf)
            (let ((inhibit-read-only t))
              (erase-buffer)
              (insert (propertize "Moves:\n\n" 'face 'bold))
              (lichess-game--insert-pgn state game-buf)
              ;; PGN at bottom? Or top?
              ;; Usually list grows down.
              ;; Insert chat placeholder
              (insert
               "\n\n"
               (propertize "Chat:" 'face 'bold)
               "\n(Not implemented yet)"))))))))

(defun lichess-game-toggle-sidebar ()
  "Toggle the sidebar for the current game."
  (interactive)
  (unless (derived-mode-p 'lichess-game-buffer-mode)
    (error "Not in a Lichess game buffer"))
  (when-let* ((state lichess-game--state)
              (id (plist-get state :id)))
    (let* ((side-name (lichess-game--sidebar-buffer-name id))
           (side-win (get-buffer-window side-name)))
      (if side-win
          (delete-window side-win)
        ;; Create/Split
        (lichess-game-render-sidebar (current-buffer))
        (let ((win (split-window-right 50))) ;; 50 columns
          (set-window-buffer win side-name)
          ;; Also force render to ensure sync
          (lichess-game-render))))))


(defun lichess-game-handle-click (coord)
  "Handle a click on COORD (symbol like `e4') in the current game."
  (when-let* ((state lichess-game--state)
              (selected (plist-get state :selected-square)))
    (cond
     ;; 1. Clicked the same square -> Deselect
     ((eq coord selected)
      (plist-put state :selected-square nil)
      (lichess-game-render))

     ;; 2. Clicked a different square -> Attempt Move
     (t
      (let* ((move-str (format "%s%s" selected coord)))
        (plist-put state :selected-square nil)
        (lichess-game-render)
        (lichess-game-move move-str)))))

  ;; If nothing selected, select the clicked square
  (unless (and lichess-game--state
               (plist-get lichess-game--state :selected-square))
    (when lichess-game--state
      (plist-put lichess-game--state :selected-square coord)
      (lichess-game-render))))

(defun lichess-game-mouse-handler (event)
  "Handle mouse clicks on the board.
EVENT is the mouse event."
  (interactive "e")
  (let*
      ((posn (event-start event))
       (obj (posn-object posn))
       (xy (posn-object-x-y posn)) ;; (x . y) relative to object (image)
       (col-row
        (when (imagep obj)
          ;; GUI (SVG image)
          (let*
              ((x (car xy))
               (y (cdr xy))
               (sq-size 45) ;; hardcoded for now, matches lichess-board-gui
               (c (floor (/ x sq-size)))
               (r (floor (/ y sq-size))))
            (cons c r))))) ;; (col . row) 0-7

    (when col-row
      (let* ((c (car col-row))
             (r (cdr col-row))
             (state lichess-game--state)
             (persp (or (plist-get state :perspective) 'white))
             ;; Adjust for perspective
             ;; If black perspective, board is flipped.
             ;; Visually (0,0) is top-left.
             ;; White persp: (0,0) is a8. r=0->8. c=0->a. Correct?
             ;; No, standard: r=0 is rank 8. c=0 is file a.
             ;; lichess-board-gui: (x=0,y=0) -> (col=0, row=0) -> a8.
             ;; White persp: r=0 is rank 8.
             ;; Black persp: r=0 is rank 1.

             (final-c
              (if (eq persp 'black)
                  (- 7 c)
                c))
             (final-r
              (if (eq persp 'black)
                  (- 7 r)
                r))

             (file (+ ?a final-c))
             (rank (- 8 final-r))
             (coord-sym (intern (format "%c%d" file rank))))

        (lichess-game-handle-click coord-sym)))))

(defun lichess-game--update-status (state obj buf)
  "Update game status and winner from OBJ into STATE.
Stop the clock in BUF if the game ended."
  (let* ((raw-status (lichess-util--aget obj 'status))
         (status
          (if (listp raw-status)
              (lichess-util--aget raw-status 'name)
            raw-status))
         (winner (lichess-util--aget obj 'winner)))
    (when status
      (plist-put state :status status))
    (when winner
      ;; 'winner' in JSON is usually "white" or "black" string
      (plist-put
       state
       :winner
       (if (stringp winner)
           (intern winner)
         winner)))

    ;; Stop clock if game ended
    (when (and status (not (string= status "started")))
      (plist-put state :live-mode nil)
      (lichess-game--stop-timer buf)
      (let ((winner-name
             (cond
              ((stringp winner)
               winner)
              ((and winner (symbolp winner))
               (symbol-name winner))
              (t
               nil))))
        (lichess-announce-event
         (format "Game %s. %s"
                 status
                 (if winner-name
                     (format "%s won" (capitalize winner-name))
                   "")))))))

(defun lichess-game--update-clocks (state obj)
  "Update clock times in STATE from OBJ.
Handles various formats: `wc' (seconds), `clock.white' (ms),
or `state.wtime' (ms)."
  (let* ((wc (lichess-util--aget obj 'wc))
         (bc (lichess-util--aget obj 'bc))
         (clock (lichess-util--aget obj 'clock))
         (cw (lichess-util--aget clock 'white))
         (cb (lichess-util--aget clock 'black))
         (st (or (lichess-util--aget obj 'state) obj))
         (sw (lichess-util--aget st 'wtime))
         (sb (lichess-util--aget st 'btime))

         (final-w
          (cond
           (wc
            (* wc 1000))
           (cw
            cw)
           (sw
            sw)))
         (final-b
          (cond
           (bc
            (* bc 1000))
           (cb
            cb)
           (sb
            sb))))

    (when (numberp final-w)
      (plist-put
       state
       :white-clock (lichess-game--format-time final-w))
      (plist-put state :white-time-ms final-w))
    (when (numberp final-b)
      (plist-put
       state
       :black-clock (lichess-game--format-time final-b))
      (plist-put state :black-time-ms final-b))))

(defun lichess-game--format-result (state)
  "Format the game result string from STATE for the footer."
  (let* ((status (plist-get state :status))
         (winner (plist-get state :winner))
         (score
          (cond
           ((eq winner 'white)
            "1-0")
           ((eq winner 'black)
            "0-1")
           ((member status '("draw" "stalemate"))
            "1/2-1/2")
           (t
            nil))))
    (when (and score
               (member
                status
                '("mate" "resign" "outoftime" "draw" "stalemate")))
      (let ((winner-text
             (cond
              ((eq winner 'white)
               "White is victorious")
              ((eq winner 'black)
               "Black is victorious")
              (t
               "Game Drawn"))))
        (propertize (format "%s • %s (%s)" winner-text score status)
                    'face
                    'success)))))

(defun lichess-game--format-header (state)
  "Format the game header strings (names, clocks) from STATE.
Returns a cons cell (TOP . BOTTOM) based on board perspective."
  (let* ((w-name (lichess-util-fmt-user-obj (plist-get state :white)))
         (b-name (lichess-util-fmt-user-obj (plist-get state :black)))
         (idx (plist-get state :current-idx))
         (hist (plist-get state :fen-history))
         (fen
          (if (and idx (>= idx 0) (< idx (length hist)))
              (aref hist idx)
            nil))
         (pos (and fen (lichess-fen-parse fen)))
         (mat-diff (and pos (lichess-fen-material-diff pos)))
         (mat-strings
          (and mat-diff (lichess-fen-format-material mat-diff)))
         (w-mat
          (if mat-strings
              (car mat-strings)
            ""))
         (b-mat
          (if mat-strings
              (cdr mat-strings)
            ""))
         (w-clock-str
          (propertize (or (plist-get state :white-clock) "--:--")
                      'lichess-clock 'white 'face 'bold))
         (b-clock-str
          (propertize (or (plist-get state :black-clock) "--:--")
                      'lichess-clock 'black 'face 'bold))
         (perspective (plist-get state :perspective))
         (white-line (format "%s%s  %s" w-name w-mat w-clock-str))
         (black-line (format "%s%s  %s" b-name b-mat b-clock-str)))
    (if (eq perspective 'black)
        (cons
         (propertize white-line 'face 'italic)
         (propertize black-line 'face 'bold))
      (cons
       (propertize black-line 'face 'italic)
       (propertize white-line 'face 'bold)))))

(defun lichess-game--insert-controls (state)
  "Insert game control buttons into the current buffer for STATE."
  (goto-char (point-max))
  (insert "\n\n")
  (insert-button "[Flip Board]"
                 'action
                 (lambda (_) (lichess-game-flip-board)))
  (insert "  ")
  (when (plist-get state :my-color)
    (insert-button "[Resign]"
                   'action
                   (lambda (_) (lichess-game-resign)))
    (insert "  ")
    (insert-button "[Draw]" 'action (lambda (_) (lichess-game-draw)))
    (insert "  "))
  (insert-button "[Side]"
                 'action
                 (lambda (_) (lichess-game-toggle-sidebar))))

(defun lichess-game--insert-preamble
    (buf white black &optional variant my-color)
  "Insert the game preamble into BUF.
WHITE and BLACK are player objects.
VARIANT is the game variant string (optional).
MY-COLOR is the user's color (`white', `black', or nil) (optional)."
  (lichess-core-with-buf
   buf
   (let ((w-name (lichess-util-fmt-user-obj white))
         (b-name (lichess-util-fmt-user-obj black)))
     (goto-char (point-max))
     (if variant
         (insert
          (format
           "\nGame (Board API): %s (W) vs %s (B) [%s] (You: %s)\n"
           w-name b-name variant (or my-color "Spectator")))
       (insert
        (format "\nWatching: %s (W) vs %s (B)\n" w-name b-name))))))

(provide 'lichess-game)
;;; lichess-game.el ends here
