;;; gdscript-debug.el --- Debugger for Godot  -*- lexical-binding: t; -*-

;; Copyright (C) 2020-2026 GDQuest and contributors

;; Author: Josef Vlach <vlach.josef@gmail.com>
;; Maintainer: Josef Vlach <vlach.josef@gmail.com>
;;             Jen-Chieh Shen <jcs090218@gmail.com>

;; This file is not part of GNU Emacs

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; For a full copy of the GNU General Public License
;; see <https://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Inspired by gdb-mi.
;;

;;; Code:

(require 'bindat)
(require 'generator)
(require 'server)

(require 'gdscript-customization)
(require 'gdscript-utils)

(eval-when-compile
  (require 'subr-x))

(declare-function do-applescript "")

(declare-function gdscript-debug--hydra/body nil "ext:gdscript-hydra.el")

(defcustom gdscript-debug-emacs-executable "Emacs"
  "The name of Emacs application. Used for focusing Emacs
when breakpoint is encountered in Godot."
  :type 'string
  :group 'gdscript)

;; Overlay arrow markers
(defvar gdscript-debug--thread-position nil)

(defvar gdscript-debug--boolean-bindat-spec
  '((:boolean-data u32r)))

(defvar gdscript-debug--integer-bindat-spec
  `((:data u32r)
    (:integer-data eval (- (logand last ,(lognot (ash 1 31)))
                           (logand last ,(ash 1 31))))))

(defvar gdscript-debug--integer-64-bindat-spec
  `((:data-a u32r)
    (:data-b u32r)
    (:data eval (let ((a (bindat-get-field struct :data-a))
                      (b (bindat-get-field struct :data-b)))
                  (logior (ash b 32) a)))
    (:integer-data eval (let ((a (bindat-get-field struct :data)))
                          (- (logand a ,(lognot (ash 1 63))) (logand a ,(ash 1 63)))))))

;; Credit goes to https://github.com/skeeto/bitpack/blob/master/bitpack.el
(defsubst gdscript-debug--load-f32 (b0 b1 b2 b3)
  (let* ((negp (= #x80 (logand b0 #x80)))
         (exp (logand (logior (ash b0 1) (ash b1 -7)) #xff))
         (mantissa (logior #x800000
                           (ash (logand #x7f b1) 16)
                           (ash b2 8)
                           b3))
         (result (cond ((= #xff exp)
                        (if (= #x800000 mantissa)
                            1.0e+INF
                          0.0e+NaN))
                       ((= #x0 exp b1 b2 b3) 0.0)
                       (t (ldexp (ldexp mantissa -24) (- exp 126))))))
    (if negp
        (- result)
      result)))

(defsubst gdscript-debug--load-f64 (b0 b1 b2 b3 b4 b5 b6 b7)
  (let* ((negp (= #x80 (logand b0 #x80)))
         (exp (logand (logior (ash b0 4) (ash b1 -4)) #x7ff))
         (mantissa (logior #x10000000000000
                           (ash (logand #xf b1) 48)
                           (ash b2 40)
                           (ash b3 32)
                           (ash b4 24)
                           (ash b5 16)
                           (ash b6  8)
                           b7))
         (result (if (= #x7ff exp)
                     (if (= #x10000000000000 mantissa)
                         1.0e+INF
                       0.0e+NaN)
                   (ldexp (ldexp mantissa -53) (- exp 1022)))))
    (if negp
        (- result)
      result)))

(defsubst gdscript-debug--to-symbol (symbol-name &optional suffix)
  (intern (concat (symbol-name symbol-name) suffix)))

(defmacro gdscript-debug--capture-float-spec (symbol-name)
  (let ((symbol (gdscript-debug--to-symbol symbol-name)))
    `(quote ((:vect vec 4 byte)
             (,symbol eval (let ((alist (reverse (append (bindat-get-field struct :vect) nil))))
                             (apply 'gdscript-debug--load-f32 alist)))))))

(defvar gdscript-debug--float-bindat-spec
  '((:vect vec 4 byte)
    (:float-value eval (let ((alist (reverse (append (bindat-get-field struct :vect) nil))))
                         (apply 'gdscript-debug--load-f32 alist)))))

(defvar gdscript-debug--float-64-bindat-spec
  '((:vect vec 8 byte)
    (:float-value eval (let ((alist (reverse (append (bindat-get-field struct :vect) nil))))
                         (apply 'gdscript-debug--load-f64 alist)))))

(defvar gdscript-debug--string-bindat-spec
  '((:data-length u32r)
    (:string-data str (:data-length))
    (align 4)))

(defvar gdscript-debug--string-z-bindat-spec
  '((:data-length u32r)
    (:string-data strz (:data-length))
    (align 4)))

(defvar gdscript-debug--vector2-bindat-spec
  `(,@(gdscript-debug--capture-float-spec :x)
    ,@(gdscript-debug--capture-float-spec :y)))

(defvar gdscript-debug--rect2-bindat-spec
  `(,@(gdscript-debug--capture-float-spec :x-coordinate)
    ,@(gdscript-debug--capture-float-spec :y-coordinate)
    ,@(gdscript-debug--capture-float-spec :x-size)
    ,@(gdscript-debug--capture-float-spec :y-size)))

(defvar gdscript-debug--vector3-bindat-spec
  `(,@(gdscript-debug--capture-float-spec :x)
    ,@(gdscript-debug--capture-float-spec :y)
    ,@(gdscript-debug--capture-float-spec :z)))

(defvar gdscript-debug--transform2d-bindat-spec
  `(,@(gdscript-debug--capture-float-spec :xx)
    ,@(gdscript-debug--capture-float-spec :xy)
    ,@(gdscript-debug--capture-float-spec :yx)
    ,@(gdscript-debug--capture-float-spec :yy)
    ,@(gdscript-debug--capture-float-spec :x-origin)
    ,@(gdscript-debug--capture-float-spec :y-origin)))

(defvar gdscript-debug--dictionary-bindat-spec
  '((:data u32r)
    (:shared   eval (logand (bindat-get-field struct :data) #x80000000))
    (:elements eval (logand (bindat-get-field struct :data) #x7fffffff))
    (:dictionary-length eval (* 2 last))
    (:items repeat (:dictionary-length) (struct gdscript-godot-data-bindat-spec))))

(defvar gdscript-debug--array-bindat-spec
  '((:data u32r)
    (:shared       eval (logand (bindat-get-field struct :data) #x80000000))
    (:array-length eval (logand (bindat-get-field struct :data) #x7fffffff))
    (:items repeat (:array-length) (struct gdscript-godot-data-bindat-spec))))

(defvar gdscript-debug--pool-byte-array-bindat-spec
  '((:array-length u32r)
    (:items vec (:array-length) byte)
    (align 4)))

(defvar gdscript-debug--pool-int-array-bindat-spec
  '((:array-length u32r)
    (:items repeat (:array-length) (struct gdscript-debug--integer-bindat-spec))))

(defvar gdscript-debug--pool-real-array-bindat-spec
  '((:array-length u32r)
    (:items repeat (:array-length) (struct gdscript-debug--float-bindat-spec))))

(defvar gdscript-debug--pool-string-array-bindat-spec
  '((:array-length u32r)
    (:items repeat (:array-length) (struct gdscript-debug--string-z-bindat-spec))))

(defvar gdscript-debug--pool-vector2-array-bindat-spec
  '((:array-length u32r)
    (:items repeat (:array-length) (struct gdscript-debug--vector2-bindat-spec))))

(defvar gdscript-debug--pool-vector3-array-bindat-spec
  '((:array-length u32r)
    (:items repeat (:array-length) (struct gdscript-debug--vector3-bindat-spec))))

(defvar gdscript-debug--pool-color-array-bindat-spec
  '((:array-length u32r)
    (:items repeat (:array-length) (struct gdscript-debug--color-bindat-spec))))

(defvar gdscript-debug--plane-bindat-spec
  `(,@(gdscript-debug--capture-float-spec :normal-x)
    ,@(gdscript-debug--capture-float-spec :normal-y)
    ,@(gdscript-debug--capture-float-spec :normal-z)
    ,@(gdscript-debug--capture-float-spec :distance)))

(defvar gdscript-debug--quat-bindat-spec
  `(,@(gdscript-debug--capture-float-spec :x-imaginary)
    ,@(gdscript-debug--capture-float-spec :y-imaginary)
    ,@(gdscript-debug--capture-float-spec :z-imaginary)
    ,@(gdscript-debug--capture-float-spec :real-w)))

(defvar gdscript-debug--aabb-bindat-spec
  `(,@(gdscript-debug--capture-float-spec :x-coordinate)
    ,@(gdscript-debug--capture-float-spec :y-coordinate)
    ,@(gdscript-debug--capture-float-spec :z-coordinate)
    ,@(gdscript-debug--capture-float-spec :x-size)
    ,@(gdscript-debug--capture-float-spec :y-size)
    ,@(gdscript-debug--capture-float-spec :z-size)))

(defvar gdscript-debug--basis-bindat-spec
  `(,@(gdscript-debug--capture-float-spec :xx)
    ,@(gdscript-debug--capture-float-spec :xy)
    ,@(gdscript-debug--capture-float-spec :xz)
    ,@(gdscript-debug--capture-float-spec :yx)
    ,@(gdscript-debug--capture-float-spec :yy)
    ,@(gdscript-debug--capture-float-spec :yz)
    ,@(gdscript-debug--capture-float-spec :zx)
    ,@(gdscript-debug--capture-float-spec :zy)
    ,@(gdscript-debug--capture-float-spec :zz)))

(defvar gdscript-debug--transform-bindat-spec
  `(,@(gdscript-debug--capture-float-spec :xx)
    ,@(gdscript-debug--capture-float-spec :xy)
    ,@(gdscript-debug--capture-float-spec :xz)
    ,@(gdscript-debug--capture-float-spec :yx)
    ,@(gdscript-debug--capture-float-spec :yy)
    ,@(gdscript-debug--capture-float-spec :yz)
    ,@(gdscript-debug--capture-float-spec :zx)
    ,@(gdscript-debug--capture-float-spec :zy)
    ,@(gdscript-debug--capture-float-spec :zz)
    ,@(gdscript-debug--capture-float-spec :x-origin)
    ,@(gdscript-debug--capture-float-spec :y-origin)
    ,@(gdscript-debug--capture-float-spec :z-origin)))

(defvar gdscript-debug--color-bindat-spec
  `(,@(gdscript-debug--capture-float-spec :red)
    ,@(gdscript-debug--capture-float-spec :green)
    ,@(gdscript-debug--capture-float-spec :blue)
    ,@(gdscript-debug--capture-float-spec :alpha)))

(defvar gdscript-debug--node-path-bindat-spec
  '((:data-length u32r)
    (:new-format eval (logand (bindat-get-field struct :data-length) #x80000000))
    (:name-count eval (logand (bindat-get-field struct :data-length) #x7FFFFFFF))
    (:subname-count u32r)
    (:flags u32r)
    (:absolute eval (not (eq 0 (logand (bindat-get-field struct :flags) #x1))))
    (:names repeat (:name-count) (struct gdscript-debug--string-bindat-spec))
    (:subnames repeat (:subname-count) (struct gdscript-debug--string-bindat-spec))))

(defvar gdscript-debug--rid-bindat-spec nil) ;; unsupported

(defvar gdscript-debug--object-as-id-bindat-spec
  '((:object-as-id-a u32r)
    (:object-as-id-b u32r)
    (:long eval (let ((a (bindat-get-field struct :object-as-id-a))
                      (b (bindat-get-field struct :object-as-id-b)))
                  (logior (ash b 32) a)))))

(defconst gdscript-debug--encode-mask #xff)
(defconst gdscript-debug--encode-flag-64 (ash 1 16))

(defvar gdscript-godot-data-bindat-spec
  '((:type-data    u32r)
    (:type         eval (logand last gdscript-debug--encode-mask))
    (:flag-64      eval (logand (bindat-get-field struct :type-data) gdscript-debug--encode-flag-64))
    (:object-as-id eval (logand (bindat-get-field struct :type-data) gdscript-debug--encode-flag-64))
    (union (:type)
           (0 nil)
           (1 (struct gdscript-debug--boolean-bindat-spec))
           ((eval (and (eq 2 tag) (equal 0 (bindat-get-field struct :flag-64)))) (struct gdscript-debug--integer-bindat-spec))
           (2 (struct gdscript-debug--integer-64-bindat-spec))
           ((eval (and (eq 3 tag) (equal 0 (bindat-get-field struct :flag-64)))) (struct gdscript-debug--float-bindat-spec))
           (3 (struct gdscript-debug--float-64-bindat-spec))
           (4 (struct gdscript-debug--string-bindat-spec))
           (5 (struct gdscript-debug--vector2-bindat-spec))
           (6 (struct gdscript-debug--rect2-bindat-spec))
           (7 (struct gdscript-debug--vector3-bindat-spec))
           (8 (struct gdscript-debug--transform2d-bindat-spec))
           (9 (struct gdscript-debug--plane-bindat-spec))
           (10 (struct gdscript-debug--quat-bindat-spec))
           (11 (struct gdscript-debug--aabb-bindat-spec))
           (12 (struct gdscript-debug--basis-bindat-spec))
           (13 (struct gdscript-debug--transform-bindat-spec))
           (14 (struct gdscript-debug--color-bindat-spec))
           (15 (struct gdscript-debug--node-path-bindat-spec))
           (16 (struct gdscript-debug--rid-bindat-spec))
           ((eval (and (eq 17 tag) (equal 0 (bindat-get-field struct :object-as-id)))) (error "[ObjectId] Not implemented yet"))
           (17 (struct gdscript-debug--object-as-id-bindat-spec))
           (18 (struct gdscript-debug--dictionary-bindat-spec))
           (19 (struct gdscript-debug--array-bindat-spec))
           (20 (struct gdscript-debug--pool-byte-array-bindat-spec))
           (21 (struct gdscript-debug--pool-int-array-bindat-spec))
           (22 (struct gdscript-debug--pool-real-array-bindat-spec))
           (23 (struct gdscript-debug--pool-string-array-bindat-spec))
           (24 (struct gdscript-debug--pool-vector2-array-bindat-spec))
           (25 (struct gdscript-debug--pool-vector3-array-bindat-spec))
           (26 (struct gdscript-debug--pool-color-array-bindat-spec))
           (t (eval (error "Unknown type: %s" tag))))))

(defvar gdscript-debug--previous-packet-data nil)
(defvar gdscript-debug--data-needed nil)
(defvar gdscript-debug--offset 0)
(defvar gdscript-debug--packet-length-bindat-spec '((:packet-length u32r)))

(defun gdscript-debug--current-packet (content offset)
  (bindat-unpack gdscript-debug--packet-length-bindat-spec content offset))

(defun gdscript-debug--process-packet (content offset)
  (bindat-unpack gdscript-godot-data-bindat-spec content offset))

(iter-defun gdscript-debug--command-iter ()
  (setq gdscript-debug--data-needed
        (catch 'not-enough-data-to-process-packed
          (while (< gdscript-debug--offset (length gdscript-debug--previous-packet-data))
            (let* ((content gdscript-debug--previous-packet-data)
                   (content-length (length content))
                   (packet-length-data (gdscript-debug--current-packet content gdscript-debug--offset))
                   (packet-length (bindat-get-field packet-length-data :packet-length))
                   (next-packet-offset (+ 4 gdscript-debug--offset packet-length)))
              (if (<= next-packet-offset content-length)
                  (let ((packet-data (gdscript-debug--process-packet content (+ 4 gdscript-debug--offset))))
                    (setq gdscript-debug--offset next-packet-offset)
                    (iter-yield packet-data))
                (throw 'not-enough-data-to-process-packed next-packet-offset))))))
  (setq gdscript-debug--offset 0))

(defsubst gdscript-debug--get-boolean (struct-data)
  (bindat-get-field struct-data :boolean-data))

(defsubst gdscript-debug--get-integer (struct-data)
  (bindat-get-field struct-data :integer-data))

(defsubst gdscript-debug--get-float (struct-data)
  (bindat-get-field struct-data :float-value))

(defsubst gdscript-debug--get-string (struct-data)
  (bindat-get-field struct-data :string-data))

(defsubst gdscript-debug--get-array (struct-data)
  (bindat-get-field struct-data :items))

(defsubst gdscript-debug--to-plane (struct)
  (let ((normal-x (bindat-get-field struct :normal-x))
        (normal-y (bindat-get-field struct :normal-y))
        (normal-z (bindat-get-field struct :normal-z))
        (distance (bindat-get-field struct :distance)))
    (gdscript-plane-create
     :normal (gdscript-vector3-create
              :x normal-x
              :y normal-y
              :z normal-z)
     :distance distance)))

(defsubst gdscript-debug--to-quat (struct)
  (let ((x-imaginary (bindat-get-field struct :x-imaginary))
        (y-imaginary (bindat-get-field struct :y-imaginary))
        (z-imaginary (bindat-get-field struct :z-imaginary))
        (real-w (bindat-get-field struct :real-w)))
    (gdscript-quat-create
     :x-imaginary x-imaginary
     :y-imaginary y-imaginary
     :z-imaginary z-imaginary
     :real-w real-w)))

(defsubst gdscript-debug--to-aabb (struct)
  (let ((x-coordinate (bindat-get-field struct :x-coordinate))
        (y-coordinate (bindat-get-field struct :y-coordinate))
        (z-coordinate (bindat-get-field struct :z-coordinate))
        (x-size (bindat-get-field struct :x-size))
        (y-size (bindat-get-field struct :y-size))
        (z-size (bindat-get-field struct :z-size)))
    (gdscript-aabb-create
     :position (gdscript-vector3-create
                :x x-coordinate
                :y y-coordinate
                :z z-coordinate)
     :size (gdscript-vector3-create
            :x x-size
            :y y-size
            :z z-size))))

(defsubst gdscript-debug--to-basis (struct)
  (let ((xx (bindat-get-field struct :xx))
        (xy (bindat-get-field struct :xy))
        (xz (bindat-get-field struct :xz))
        (yx (bindat-get-field struct :yx))
        (yy (bindat-get-field struct :yy))
        (yz (bindat-get-field struct :yz))
        (zx (bindat-get-field struct :zx))
        (zy (bindat-get-field struct :zy))
        (zz (bindat-get-field struct :zz)))
    (gdscript-basis-create
     :x (gdscript-vector3-create :x xx :y xy :z xz)
     :y (gdscript-vector3-create :x yx :y yy :z yz)
     :z (gdscript-vector3-create :x zx :y zy :z zz))))

(defsubst gdscript-debug--to-transform (struct)
  (let ((basis (gdscript-debug--to-basis struct))
        (x-origin (bindat-get-field struct :x-origin))
        (y-origin (bindat-get-field struct :y-origin))
        (z-origin (bindat-get-field struct :z-origin)))
    (gdscript-transform-create
     :basis basis
     :origin (gdscript-vector3-create
              :x x-origin
              :y y-origin
              :z z-origin))))

(defsubst gdscript-debug--to-color (struct)
  (let ((red (bindat-get-field struct :red))
        (green (bindat-get-field struct :green))
        (blue (bindat-get-field struct :blue))
        (alpha (bindat-get-field struct :alpha)))
    (gdscript-color-create :red red :green green :blue blue :alpha alpha)))

(defsubst gdscript-debug--to-node-path (struct)
  (let ((names (mapcar 'gdscript-debug--to-string (bindat-get-field struct :names)))
        (subnames (mapcar 'gdscript-debug--to-string (bindat-get-field struct :subnames)))
        (absolute (bindat-get-field struct :absolute)))
    (gdscript-node-path-create :names names :subnames subnames :absolute (gdscript-bool-create :value absolute))))

(defsubst gdscript-debug--to-rid (_struct-data)
  (gdscript-rid-create))

(defsubst gdscript-debug--to-vector2 (struct-data)
  (let ((x (bindat-get-field struct-data :x))
        (y (bindat-get-field struct-data :y)))
    (gdscript-vector2-create :x x :y y)))

(defsubst gdscript-debug--to-rect2 (struct)
  (let ((x-coordinate (bindat-get-field struct :x-coordinate))
        (y-coordinate (bindat-get-field struct :y-coordinate))
        (x-size (bindat-get-field struct :x-size))
        (y-size (bindat-get-field struct :y-size)))
    (gdscript-rect2-create
     :coordinate (gdscript-vector2-create :x x-coordinate :y y-coordinate)
     :size (gdscript-vector2-create :x x-size :y y-size))))

(defsubst gdscript-debug--to-vector3 (struct-data)
  (let ((x (bindat-get-field struct-data :x))
        (y (bindat-get-field struct-data :y))
        (z (bindat-get-field struct-data :z)))
    (gdscript-vector3-create :x x :y y :z z)))

(defsubst gdscript-debug--to-transform2d (struct-data)
  (let ((xx (bindat-get-field struct-data :xx))
        (xy (bindat-get-field struct-data :xy))
        (yx (bindat-get-field struct-data :yx))
        (yy (bindat-get-field struct-data :yy))
        (x-origin (bindat-get-field struct-data :x-origin))
        (y-origin (bindat-get-field struct-data :y-origin)))
    (gdscript-transform2d-create
     :x (gdscript-vector2-create :x xx :y xy)
     :y (gdscript-vector2-create :x yx :y yy)
     :origin (gdscript-vector2-create :x x-origin :y y-origin))))

(defsubst gdscript-debug--to-null (_struct-data)
  (gdscript-null-create))

(defsubst gdscript-debug--to-boolean (struct-data)
  (gdscript-bool-create :value (if (eq 1 (gdscript-debug--get-boolean struct-data))
                                   t
                                 nil)))

(defsubst gdscript-debug--shared-to-boolean (shared)
  (gdscript-bool-create :value (if (eq 0 shared) nil t)))

(defsubst gdscript-debug--to-integer (struct-data)
  (gdscript-integer-create :value (gdscript-debug--get-integer struct-data)))

(defsubst gdscript-debug--to-float (struct-data)
  (gdscript-float-create :value (gdscript-debug--get-float struct-data)))

(defsubst gdscript-debug--to-string (struct-data)
  (gdscript-string-create :value (gdscript-debug--get-string struct-data)))

(defsubst gdscript-debug--to-object-id (struct-data)
  (gdscript-object-id-create :value (bindat-get-field struct-data :long)))

(defsubst gdscript-debug--to-dictionary (struct-data)
  (let* ((shared (bindat-get-field struct-data :shared))
         (items (bindat-get-field struct-data :items)))
    (gdscript-dictionary-create :shared (gdscript-debug--shared-to-boolean shared) :elements (gdscript-debug--to-dic items))))

(defun gdscript-debug--to-dic (xs)
  (cl-loop for (key value) on xs by 'cddr
           collect (gdscript-debug--from-key-value key value)))

(defsubst gdscript-debug--to-array (struct-data)
  (let ((shared (bindat-get-field struct-data :shared))
        (items (bindat-get-field struct-data :items)))
    (gdscript-array-create :shared (gdscript-debug--shared-to-boolean shared) :elements (mapcar 'gdscript-debug--from-variant items))))

(defsubst gdscript-debug--to-pool-byte-array (struct-data)
  (let ((items (bindat-get-field struct-data :items)))
    (gdscript-pool-byte-array-create :elements items)))

(defsubst gdscript-debug--to-pool-int-array (struct-data)
  (let ((items (bindat-get-field struct-data :items)))
    (gdscript-pool-int-array-create :elements (mapcar 'gdscript-debug--to-integer items))))

(defsubst gdscript-debug--to-pool-real-array (struct-data)
  (let ((items (bindat-get-field struct-data :items)))
    (gdscript-pool-real-array-create :elements (mapcar 'gdscript-debug--to-float items))))

(defsubst gdscript-debug--to-pool-string-array (struct-data)
  (let ((items (bindat-get-field struct-data :items)))
    (gdscript-pool-string-array-create :elements (mapcar 'gdscript-debug--to-string items))))

(defsubst gdscript-debug--to-pool-vector2-array (struct-data)
  (let ((items (bindat-get-field struct-data :items)))
    (gdscript-pool-vector2-array-create :elements (mapcar 'gdscript-debug--to-vector2 items))))

(defsubst gdscript-debug--to-pool-vector3-array (struct-data)
  (let ((items (bindat-get-field struct-data :items)))
    (gdscript-pool-vector3-array-create :elements (mapcar 'gdscript-debug--to-vector3 items))))

(defsubst gdscript-debug--to-pool-color-array (struct-data)
  (let ((items (bindat-get-field struct-data :items)))
    (gdscript-pool-color-array-create :elements (mapcar 'gdscript-debug--to-color items))))

(defun gdscript-debug--from-key-value (key value)
  (let* ((var-name (gdscript-debug--from-variant key))
         (var-val (gdscript-debug--from-variant value)))
    `(,var-name . ,var-val)))

(defun gdscript-debug--from-variant (struct)
  (let ((type (bindat-get-field struct :type))
        (object-as-id (bindat-get-field struct :object-as-id)))
    (pcase type
      (0 (gdscript-debug--to-null struct))
      (1 (gdscript-debug--to-boolean struct))
      (2 (gdscript-debug--to-integer struct))
      (3 (gdscript-debug--to-float struct))
      (4 (gdscript-debug--to-string struct))
      (5 (gdscript-debug--to-vector2 struct))
      (6 (gdscript-debug--to-rect2 struct))
      (7 (gdscript-debug--to-vector3 struct))
      (8 (gdscript-debug--to-transform2d struct))
      (9 (gdscript-debug--to-plane struct))
      (10 (gdscript-debug--to-quat struct))
      (11 (gdscript-debug--to-aabb struct))
      (12 (gdscript-debug--to-basis struct))
      (13 (gdscript-debug--to-transform struct))
      (14 (gdscript-debug--to-color struct))
      (15 (gdscript-debug--to-node-path struct))
      (16 (gdscript-debug--to-rid struct))
      (17 (if (eq 0 object-as-id) (error "TODO object as not ID")
            (gdscript-debug--to-object-id struct)))
      (18 (gdscript-debug--to-dictionary struct))
      (19 (gdscript-debug--to-array struct))
      (20 (gdscript-debug--to-pool-byte-array struct))
      (21 (gdscript-debug--to-pool-int-array struct))
      (22 (gdscript-debug--to-pool-real-array struct))
      (23 (gdscript-debug--to-pool-string-array struct))
      (24 (gdscript-debug--to-pool-vector2-array struct))
      (25 (gdscript-debug--to-pool-vector3-array struct))
      (26 (gdscript-debug--to-pool-color-array struct))
      (_ (error "[gdscript-debug--from-variant] Unknown type %s" type)))))

(defun gdscript-debug--to-stack-dump (stack-data level)
  (pcase stack-data
    (`(,_file-key, file-value, _line-key, line-value, _function-key, function-value, _id-key, _id-value)
     (gdscript-stack-dump-create
      :file (gdscript-debug--get-string file-value)
      :line (gdscript-debug--get-integer line-value)
      :function-name (gdscript-debug--get-string function-value)
      :level level))))

(defun gdscript-debug-error-pretty (output-error)
  (format "%s:%s %s - %s (%s) - %s"
          (gdscript-string->value (gdscript-output-error->source-file output-error))
          (gdscript-integer->value (gdscript-output-error->source-line output-error))
          (gdscript-string->value (gdscript-output-error->source-func output-error))
          (gdscript-string->value (gdscript-output-error->error output-error))
          (gdscript-string->value (gdscript-output-error->error-descr output-error))
          (gdscript-output-error->callstack output-error)))

(defun gdscript-debug--to-output-error (error-data stack-infos)
  (pcase error-data
    (`(,hr, min, sec, msec, source-func, source-file, source-line, error-msg, error-descr, warning)
     (gdscript-output-error-create
      :hr (gdscript-debug--to-integer hr)
      :min (gdscript-debug--to-integer min)
      :sec (gdscript-debug--to-integer sec)
      :msec (gdscript-debug--to-integer msec)
      :source-file (gdscript-debug--to-string source-file)
      :source-func (gdscript-debug--to-string source-func)
      :source-line (gdscript-debug--to-integer source-line)
      :error (gdscript-debug--to-string error-msg)
      :error-descr (gdscript-debug--to-string error-descr)
      :warning (gdscript-debug--to-boolean warning)
      :callstack stack-infos))))

(defun gdscript-debug--error-callstack (iter)
  (let ((file (bindat-get-field (iter-next iter) :string-data))
        (func (bindat-get-field (iter-next iter) :string-data))
        (line (bindat-get-field (iter-next iter) :integer-data)))
    (sgdscript-tack-info-create :file file :func func :line line)))

(defun gdscript-debug--mk-error (iter)
  (let ((_callstack-size (bindat-get-field (iter-next iter) :integer-data))
        (error-data (bindat-get-field (iter-next iter) :items))
        (error-callstack-size (bindat-get-field (iter-next iter) :integer-data)))
    (let ((stack-infos))
      (dotimes (_i (/ error-callstack-size 3))
        (push (gdscript-debug--error-callstack iter) stack-infos))
      (gdscript-debug--to-output-error error-data (reverse stack-infos)))))

(defun gdscript-debug--mk-performance (iter)
  (let ((_skip-this (iter-next iter))
        (performance-data (bindat-get-field (iter-next iter) :items)))
    `(command "performace" performance-data ,performance-data)))

(defun gdscript-debug--read-var-names (iter count)
  (let ((variables))
    (dotimes (_i count)
      (let* ((var-name (bindat-get-field (iter-next iter) :string-data))
             (var-value (iter-next iter))
             (var-val (gdscript-debug--from-variant var-value)))
        (push `(,var-name . ,var-val) variables)))
    (reverse variables)))

(defun gdscript-debug--mk-stack-frame-vars (iter)
  (let* ((_total-size (gdscript-debug--get-integer (iter-next iter)))
         (locals-size (gdscript-debug--get-integer (iter-next iter)))
         (locals (gdscript-debug--read-var-names iter locals-size))
         (members-size (gdscript-debug--get-integer (iter-next iter)))
         (members (gdscript-debug--read-var-names iter members-size))
         (globals-size (gdscript-debug--get-integer (iter-next iter)))
         (globals (gdscript-debug--read-var-names iter globals-size)))
    (gdscript-stack-frame-vars-create :locals locals :members members :globals globals)))

(defun gdscript-debug--to-property-info (properties)
  (let ((property-info))
    (dolist (property properties)
      (cond ((eq 6 (bindat-get-field property :array-length))
             (let* ((data (bindat-get-field property :items))
                    (name (bindat-get-field (car data) :string-data))
                    (type (bindat-get-field (nth 1 data) :integer-data))
                    (hint (bindat-get-field (nth 2 data) :integer-data))
                    (hint-string (bindat-get-field (nth 3 data) :string-data))
                    (usage (bindat-get-field (nth 4 data) :integer-data))
                    (variant (gdscript-debug--from-variant (nth 5 data)))
                    (new-prop (gdscript-property-info-create
                               :name name
                               :type type
                               :hint hint
                               :hint-string hint-string
                               :usage usage
                               :variant variant)))
               (push new-prop property-info)))
            (t (message "Ignoring property %s" property))))
    (reverse property-info)))

(defun gdscript-debug--get-children (iter)
  (let ((child-count (gdscript-debug--get-integer (iter-next iter)))
        (node-name (gdscript-debug--get-string (iter-next iter)))
        (node-class (gdscript-debug--get-string (iter-next iter)))
        (instance-id (gdscript-debug--get-integer (iter-next iter))))
    (let ((children))
      (dotimes (_i child-count)
        (push (gdscript-debug--get-children iter) children))
      (gdscript-scene-tree-level-edge-create :item (gdscript-scene-tree-node-create
                                                    :node-name node-name
                                                    :node-class node-class
                                                    :instance-id instance-id)
                                             :children children))))

(cl-defstruct (gdscript-scene-tree-level-edge (:constructor gdscript-scene-tree-level-edge-create)
                                              (:copier nil)
                                              (:conc-name gdscript-scene-tree-level-edge->))
  item children)

(cl-defstruct (gdscript-scene-tree-node (:constructor gdscript-scene-tree-node-create)
                                        (:copier nil)
                                        (:conc-name gdscript-scene-tree-node->))
  node-name node-class instance-id)

(defun gdscript-debug--mk-scene-tree (iter)
  (let ((_array-size (gdscript-debug--get-integer (iter-next iter))))
    (gdscript-debug--get-children iter)))

(defun gdscript-debug--mk-inspect-object (iter)
  (let ((_three (gdscript-debug--get-integer (iter-next iter)))
        (object-id (gdscript-debug--get-integer (iter-next iter)))
        (class (gdscript-debug--get-string (iter-next iter)))
        (properties (gdscript-debug--get-array (iter-next iter))))
    (gdscript-inspect-object-create :object-id object-id :class class :properties (gdscript-debug--to-property-info properties))))

(defun gdscript-debug--mk-stack-dump (iter)
  (let ((stack-level-count (gdscript-debug--get-integer (iter-next iter)))
        (outputs))
    (dotimes (level stack-level-count)
      (let ((stack-data (bindat-get-field (iter-next iter) :items)))
        (push (gdscript-debug--to-stack-dump stack-data level) outputs)))
    (reverse outputs)))

(defun gdscript-debug--mk-output (iter)
  (let ((output-count (bindat-get-field (iter-next iter) :integer-data))
        (outputs))
    (dotimes (_i output-count)
      (let* ((data (iter-next iter))
             (output (bindat-get-field data :items 0 :string-data)))
        (setq outputs (cons output outputs))))
    `(command "output" outputs, outputs)))

(defun gdscript-debug--mk-debug-enter (iter)
  (let ((_skip-this (iter-next iter))
        (can-continue (bindat-get-field (iter-next iter) :boolean-data))
        (reason (bindat-get-field (iter-next iter) :string-data)))
    (gdscript-debug-enter-create :can-continue can-continue :reason reason)))

(defun gdscript-debug--mk-debug-exit (iter)
  (let ((_skip-this (iter-next iter)))
    '(command "debug_exit")))

(defun gdscript-debug--line-posns (line)
  "Return a pair of LINE beginning and end positions."
  (let ((offset (1+ (- line (line-number-at-pos)))))
    (cons
     (line-beginning-position offset)
     (line-end-position offset))))

(defsubst gdscript-debug--drop-res (file-path)
  (substring file-path (length "res://")))

(defun gdscript-debug--on-stack-dump (stack-dump project-root)
  (let* ((file (gdscript-stack-dump->file stack-dump))
         (line (gdscript-stack-dump->line stack-dump))
         (full-file-path (concat project-root (gdscript-debug--drop-res file))))
    (if (not project-root)
        (error "Project for file %s not found" file)
      (with-current-buffer (find-file-noselect full-file-path)
        (let* ((posns (gdscript-debug--line-posns line))
               (start-posn (car posns)))
          (set-marker gdscript-debug--thread-position start-posn)
          (goto-char gdscript-debug--thread-position)
          (current-buffer))))))

(defmacro gdscript-debug--command-handler (&rest body)
  `(progn
     ,@body
     (setq gdscript-debug--previous-packet-data
           (substring gdscript-debug--previous-packet-data gdscript-debug--offset (length gdscript-debug--previous-packet-data)))
     (setq gdscript-debug--offset 0)))

(defun gdscript-debug--switch-to-emacs ()
  (do-applescript (format "tell application \"%s\" to activate" gdscript-debug-emacs-executable)))

(defun gdscript-debug--handle-server-reply (process content)
  "Gets invoked whenever the server sends data to the client."
  (setq gdscript-debug--previous-packet-data (concat gdscript-debug--previous-packet-data content))
  (when (or (null gdscript-debug--data-needed)
            (<= gdscript-debug--data-needed (length gdscript-debug--previous-packet-data)))
    (condition-case _x
        (let ((iter (gdscript-debug--command-iter)))
          (while t
            (let* ((next-data (iter-next iter))
                   (str (bindat-get-field next-data :string-data)))
              (pcase str
                ("debug_enter"
                 (gdscript-debug--command-handler
                  ;;(message "Received 'debug_enter' command")
                  (let ((cmd (gdscript-debug--mk-debug-enter iter)))
                    (setq gdscript-debug--debug-enter cmd)
                    (gdscript-debug-get-stack-dump))))
                ("debug_exit"
                 (gdscript-debug--command-handler
                  ;;(message "Received 'debug_exit' command")
                  (gdscript-debug--mk-debug-exit iter)))
                ("output"
                 (gdscript-debug--command-handler
                  ;;(message "Received 'output' command")
                  (gdscript-debug--mk-output iter)))
                ("error"
                 (gdscript-debug--command-handler
                  ;;(message "Received 'error' command")
                  (let ((cmd (gdscript-debug--mk-error iter)))
                    (message "%s" (gdscript-debug-error-pretty cmd)))))
                ("performance"
                 (gdscript-debug--command-handler
                  ;;(message "Received 'performance' command")
                  (gdscript-debug--mk-performance iter)))
                ("stack_dump"
                 (gdscript-debug--command-handler
                  ;;(message "Received 'stack_dump' command")
                  (let ((cmd (gdscript-debug--mk-stack-dump iter))
                        (project-root (process-get process 'project)))
                    (pcase (gdscript-debug-enter->reason gdscript-debug--debug-enter)
                      ("Breakpoint"
                       (gdscript-debug--refresh-stack-dump-buffer cmd project-root)
                       (setq gdscript-debug--stack-dump (cons cmd project-root))
                       (let ((top-stack-dump (car cmd)))
                         (setq gdscript-debug--selected-stack-dump top-stack-dump)
                         (gdscript-debug--on-stack-dump top-stack-dump project-root)
                         (gdscript-debug-get-stack-frame-vars (gdscript-stack-dump->level top-stack-dump)))
                       (gdscript-debug-hydra))
                      (other
                       (select-window (display-buffer (gdscript-debug--on-stack-dump (car cmd) project-root)))
                       (message "%s" other)))
                    (run-at-time "0.25 sec" nil #'gdscript-debug--switch-to-emacs))))
                ("stack_frame_vars"
                 (gdscript-debug--command-handler
                  ;;(message "Received 'stack_frame_vars' command")
                  (let ((cmd (gdscript-debug--mk-stack-frame-vars iter)))
                    (setq gdscript-debug--stack-frame-vars cmd
                          gdscript-debug--inspected-objects (make-hash-table)
                          gdscript-debug--object-ids-to-fetch nil
                          gdscript-debug-state nil)
                    (gdscript-debug--construct-stack-var-buffer cmd)
                    (let* ((self (cdar (gdscript-stack-frame-vars->members cmd)))
                           (object-id (gdscript-object-id->value self)))
                      (setq gdscript-debug--current-self object-id
                            gdscript-debug--inspector-focused-object-id object-id)
                      (if (and gdscript-debug--pinned-object-id
                               (not (eq gdscript-debug--current-self gdscript-debug--pinned-object-id)))
                          (progn
                            (gdscript-debug-inspect-object gdscript-debug--pinned-object-id)
                            (gdscript-debug-inspect-object gdscript-debug--current-self)
                            (setq gdscript-debug-state :expect-two))
                        (gdscript-debug-inspect-object gdscript-debug--current-self)
                        (setq gdscript-debug--inspector-focused-object-id gdscript-debug--current-self
                              gdscript-debug-state :expect-one)))))
                 (gdscript-debug-windows))
                ("message:inspect_object"
                 (gdscript-debug--command-handler
                  ;;(message "Received 'message:inspect_object' command")
                  (let* ((cmd (gdscript-debug--mk-inspect-object iter))
                         (object-id (gdscript-inspect-object->object-id cmd)))
                    (puthash object-id cmd gdscript-debug--inspected-objects)
                    (cond ((eq gdscript-debug-state :fetching)
                           (setq gdscript-debug--object-ids-to-fetch (delete (gdscript-object-id-create :value object-id) gdscript-debug--object-ids-to-fetch))
                           (when (null gdscript-debug--object-ids-to-fetch)
                             (setq gdscript-debug-state nil)
                             (gdscript-debug--construct-stack-var-buffer gdscript-debug--stack-frame-vars)
                             (gdscript-debug--refresh-inspector-buffer gdscript-debug--inspector-focused-object-id)))
                          ((eq gdscript-debug-state :refresh-inspector)
                           (setq gdscript-debug-state nil)
                           (gdscript-debug--refresh-inspector-buffer object-id))
                          ((and
                            (eq gdscript-debug-state :expect-two)
                            (eq object-id gdscript-debug--pinned-object-id))
                           (setq gdscript-debug-state :expect-one))
                          ((and
                            (eq gdscript-debug-state :expect-two)
                            (eq object-id gdscript-debug--current-self))
                           ;; Expected `gdscript-debug--pinned-object-id' but got `gdscript-debug--current-self'
                           ;; instead. That means `gdscript-debug--pinned-object-id' doesn't exists anymore.
                           (setq gdscript-debug--pinned-object-id nil
                                 gdscript-debug--inspector-stack nil
                                 gdscript-debug-state nil)
                           (gdscript-debug--refresh-inspector-buffer object-id))
                          ((eq gdscript-debug-state :expect-one)
                           (setq gdscript-debug-state nil
                                 gdscript-debug--inspector-stack nil)
                           (gdscript-debug--refresh-inspector-buffer (if gdscript-debug--pinned-object-id
                                                                         gdscript-debug--pinned-object-id
                                                                       object-id)))))))
                ("message:scene_tree"
                 (gdscript-debug--command-handler
                  (let* ((cmd (gdscript-debug--mk-scene-tree iter)))
                    (gdscript-debug--refresh-scene-tree-buffer cmd)
                    (gdscript-debug-display-scene-tree-buffer))))
                (_ (error "Unknown command %s" str))))))
      ;;(iter-end-of-sequence (message "No more packets to process %s" x))
      (iter-end-of-sequence nil))))

(defun gdscript-debug-pin-inspected-object-id ()
  (interactive)
  (setq gdscript-debug--pinned-object-id gdscript-debug--inspector-focused-object-id)
  (gdscript-debug--refresh-inspector-buffer gdscript-debug--pinned-object-id))

(defun gdscript-debug-pin-current-self ()
  (interactive)
  (setq gdscript-debug--pinned-object-id gdscript-debug--current-self
        gdscript-debug--inspector-stack nil)
  (gdscript-debug--refresh-inspector-buffer gdscript-debug--pinned-object-id))

(defun gdscript-debug-unpin ()
  (interactive)
  (setq gdscript-debug--pinned-object-id nil
        gdscript-debug--inspector-stack nil)
  (gdscript-debug--refresh-inspector-buffer gdscript-debug--current-self))

(defun gdscript-debug-fetch-object-ids-detail ()
  (interactive)
  (setq gdscript-debug-state :fetching)
  (mapc #'gdscript-debug-inspect-object (mapcar #'gdscript-object-id->value gdscript-debug--object-ids-to-fetch)))

(defvar gdscript-debug--debug-enter nil
  "Stores last received `debug_enter' command data.")
(defvar gdscript-debug--stack-frame-vars nil
  "Stores last received `stack_frame_vars' command data.")
(defvar gdscript-debug--inspector-focused-object-id nil
  "Stores `object-id' to display in * Inspector * buffer.")
(defvar gdscript-debug--pinned-object-id nil
  "Stores pinned `object-id' to display in * Inspector * buffer.
Pinned `object-id' is explicitely controlled by user.")
(defvar gdscript-debug--stack-dump nil
  "Stores last received `stack_dump' command data.")
(defvar gdscript-debug--selected-stack-dump nil
  "Stores selected `stack-dump' data.")
(defvar gdscript-debug--current-self nil
  "Stores selected `stack-dump' data.")
(defvar gdscript-debug--inspected-objects (make-hash-table)
  "Mapping from `object-id' to `inspect-object' struct")
(defvar gdscript-debug-state nil)
(defvar gdscript-debug--object-ids-to-fetch nil
  "List of all object-id to fetch on demand")
(defvar gdscript-debug--multiline-on (make-hash-table :test #'equal)
  "Stores mapping from (`buffer' . `property-name') to bool indicating that `property-name'
in buffer `buffer' should be rendered multiline.")
(defvar gdscript-debug--inspector-stack nil
  "A stack of inspected objects for breadcrumb rendering.")

(defun gdscript-debug--construct-stack-var-buffer (stack-frame-vars)
  (let ((table (gdscript-debug-table-create)))
    (gdscript-debug--table-add-row table (list "Locals:" "" "") nil)
    (gdscript-debug--add-stack-var-to-table table (gdscript-stack-frame-vars->locals stack-frame-vars))
    (gdscript-debug--table-add-row table (list "Members:" "" "") nil)
    (gdscript-debug--add-stack-var-to-table table (gdscript-stack-frame-vars->members stack-frame-vars))
    (gdscript-debug--table-add-row table (list "Globals:" "" "") nil)
    (gdscript-debug--add-stack-var-to-table table (gdscript-stack-frame-vars->globals stack-frame-vars))
    (with-current-buffer (gdscript-debug--get-stack-frame-vars-buffer)
      (let ((inhibit-read-only t)
            (point (point)))
        (setq header-line-format
              (format "Stack frame vars - %s:%s %s"
                      (gdscript-stack-dump->file gdscript-debug--selected-stack-dump)
                      (gdscript-stack-dump->line gdscript-debug--selected-stack-dump)
                      (gdscript-stack-dump->function-name gdscript-debug--selected-stack-dump)))
        (erase-buffer)
        (insert (gdscript-debug--table-string table " "))
        ;; Keep point in `stack-frame-vars-buffer' as close as possible to previous state
        (goto-char point)
        (set-window-point (get-buffer-window (current-buffer)) (line-beginning-position))))))

(defun gdscript-debug--add-stack-var-to-table (table items)
  (dolist (item items)
    (pcase-let* ((`(,variable . ,variant) item)
                 (print-data (gdscript-debug--pure-stringify variant variable 'stack-frame-vars-buffer)))
      (gdscript-debug--table-add-row
       table
       (list
        (gdscript-debug-variable-face variable)
        (gdscript-print-data->type-name print-data)
        (gdscript-print-data->string-repr print-data))
       (append
        (list 'property-name variable)
        (cond ((gdscript-object-id-p variant)
               (list 'object-id (gdscript-object-id->value variant))))))
      (when (gdscript-object-id-p variant)
        (unless (gethash (gdscript-object-id->value variant) gdscript-debug--inspected-objects)
          (push variant gdscript-debug--object-ids-to-fetch))))))

(defun gdscript-debug--refresh-inspector-buffer (object-id)
  (when-let* ((inspect-object (gethash object-id gdscript-debug--inspected-objects))
              (table (gdscript-debug-table-create)))
    (dolist (property (gdscript-inspect-object->properties inspect-object))
      (let* ((variant (gdscript-property-info->variant property))
             (usage (gdscript-property-info->usage property))
             (_hint (gdscript-property-info->hint property))
             (name (gdscript-property-info->name property))
             (print-data (gdscript-debug--pure-stringify variant name 'inspector-buffer)))
        (when-let ((variant (gdscript-property-info->variant property))
                   (is-object-id (gdscript-object-id-p variant)))
          (unless (gethash (gdscript-object-id->value variant) gdscript-debug--inspected-objects)
            (push variant gdscript-debug--object-ids-to-fetch)))
        (gdscript-debug--table-add-row
         table
         (cond ((eq 256 (logand 256 usage))
                (list
                 (propertize name 'font-lock-face 'bold)
                 ""
                 ""))
               (t (list
                   ;;(concat (format "[%s]" usage) (format "[%s] " hint) name)
                   name
                   (gdscript-print-data->type-name print-data)
                   (gdscript-print-data->string-repr print-data))))
         (append
          (list 'property-name name)
          (cond ((equal name "Node/path")
                 (list 'node-path (substring-no-properties (gdscript-print-data->string-repr print-data)) 'keymap gdscript-debug--show-in-scene-tree-map))
                ((gdscript-object-id-p variant)
                 (list 'object-id (gdscript-object-id->value variant)))
                (t nil))))))
    (delete-dups gdscript-debug--object-ids-to-fetch)
    (with-current-buffer (gdscript-debug--get-inspector-buffer)
      (let ((inhibit-read-only t)
            (class (gdscript-inspect-object->class inspect-object))
            (object-id (gdscript-inspect-object->object-id inspect-object))
            (inspector-stack-car (car gdscript-debug--inspector-stack)))
        (setq header-line-format
              (if gdscript-debug--pinned-object-id
                  (format "Inspector - Pinned: %s" gdscript-debug--pinned-object-id)
                "Inspector"))
        (unless (and
                 inspector-stack-car
                 (equal class     (gdscript-debug-breadcrumb-entry->class inspector-stack-car))
                 (equal object-id (gdscript-debug-breadcrumb-entry->object-id inspector-stack-car)))
          ;; Add new entry to the stack only when it differs from the tip (car)
          ;; to preserve `gdscript-debug-breadcrumb-entry->point' of the tip
          (push (gdscript-debug-breadcrumb-entry-create :class class :object-id object-id :point (point)) gdscript-debug--inspector-stack))
        (erase-buffer)
        (insert (gdscript-debug--inspector-bread-crumb))
        (insert "\n")
        (insert (gdscript-debug--table-string table " "))
        (goto-char (point-min))
        (gdscript-debug--display-buffer (current-buffer))))))

(defun gdscript-debug--show-in-scene-tree ()
  (interactive)
  (if-let* ((node-path (get-text-property (point) 'node-path)))
      (gdscript-debug--jump-to-node-path node-path)
    (message "Not recognized as node-path line")))

(defun gdscript-debug--jump-to-node-path (node-path)
  (with-current-buffer (gdscript-debug--get-scene-tree-buffer)
    (if (equal node-path "/root")
        (let ((window (display-buffer (current-buffer) '((display-buffer-same-window)))))
          (set-window-point window 1))
      (let ((change-pos 1))
        (while change-pos
          (setq change-pos (next-single-property-change change-pos 'node-path))
          (if change-pos
              (if (equal (get-text-property change-pos 'node-path) node-path)
                  (let ((window (display-buffer (current-buffer) '((display-buffer-same-window)))))
                    (set-window-point window change-pos)
                    (setq change-pos nil))
                (setq change-pos (1+ change-pos)))
            (setq gdscript-debug--after-refresh-function (lambda () (gdscript-debug--jump-to-node-path node-path)))
            (gdscript-debug-request-scene-tree)))))))

(defvar gdscript-debug--show-in-scene-tree-map
  (let ((map (make-sparse-keymap)))
    (define-key map [remap gdscript-debug-inspect-object-id] 'gdscript-debug--show-in-scene-tree)
    map)
  "Keymap for `Node/path' in `Inspector' buffer.")

(defun gdscript-debug--inspector-bread-crumb ()
  (mapconcat (lambda (breadcrumb-entry)
               (propertize (format "%s: %s"
                                   (gdscript-debug-breadcrumb-entry->class breadcrumb-entry)
                                   (gdscript-debug-breadcrumb-entry->object-id breadcrumb-entry))
                           'font-lock-face 'bold))
             (reverse gdscript-debug--inspector-stack)
             " > "))

(defun gdscript-debug--table-string (table &optional sep)
  "Return TABLE as a string with columns separated with SEP."
  (let ((column-sizes (gdscript-debug-table->column-sizes table)))
    (mapconcat
     'identity
     (cl-mapcar
      (lambda (row properties)
        (apply 'propertize
               (mapconcat 'identity
                          (cl-mapcar (lambda (s x) (gdscript-debug-pad-string s x))
                                     row column-sizes)
                          sep)
               properties))
      (gdscript-debug-table->rows table)
      (gdscript-debug-table->row-properties table))
     "\n")))

(defun gdscript-debug-pad-string (string padding)
  (format (concat "%" (number-to-string padding) "s") string))

(defun gdscript-debug--pure-stringify (variant property-name buffer-type &optional inline-only)
  (gdscript-debug--to-print-data
   (cond ((gdscript-null-p variant)
          (list
           (gdscript-debug--builtin-face "null")))
         ((gdscript-bool-p variant)
          (list
           (gdscript-debug--builtin-face "bool")
           (gdscript-debug--gdscript-bool-to-string variant)))
         ((gdscript-integer-p variant)
          (list
           (gdscript-debug--builtin-face "int")
           (number-to-string (gdscript-integer->value variant))))
         ((gdscript-float-p variant)
          (list
           (gdscript-debug--builtin-face "float")
           (number-to-string (gdscript-float->value variant))))
         ((gdscript-string-p variant)
          (list
           (gdscript-debug-type-face "String")
           (gdscript-debug--string-face (gdscript-string->value variant))))
         ((gdscript-vector2-p variant)
          (list
           (gdscript-debug-type-face "Vector2")
           (gdscript-debug--vector2-to-string variant)))
         ((gdscript-rect2-p variant)
          (list
           (gdscript-debug-type-face "Rect2")
           (concat (gdscript-debug--vector2-to-string (gdscript-rect2->coordinate variant)) " " (gdscript-debug--vector2-to-string (gdscript-rect2->size variant)))))
         ((gdscript-vector3-p variant)
          (list
           (gdscript-debug-type-face "Vector3")
           (gdscript-debug--vector3-to-string variant)))
         ((gdscript-transform2d-p variant)
          (list
           (gdscript-debug-type-face "Transform2D")
           (mapconcat #'gdscript-debug--vector2-to-string (list (gdscript-transform2d->x variant) (gdscript-transform2d->y variant) (gdscript-transform2d->origin variant)) " ")))
         ((gdscript-plane-p variant)
          (list
           (gdscript-debug-type-face "Plane")
           (concat (gdscript-debug--vector3-to-string (gdscript-plane->normal variant)) " " (number-to-string (gdscript-plane->distance variant)))))
         ((gdscript-quat-p variant)
          (list
           (gdscript-debug-type-face "Quat")
           (mapconcat #'number-to-string (list (gdscript-quat->x-imaginary variant) (gdscript-quat->y-imaginary variant) (gdscript-quat->z-imaginary variant) (gdscript-quat->real-w variant)) " ")))
         ((gdscript-aabb-p variant)
          (list
           (gdscript-debug-type-face "AABB")
           (mapconcat #'gdscript-debug--vector3-to-string (list (gdscript-aabb->position variant) (gdscript-aabb->size variant)) " ")))
         ((gdscript-basis-p variant)
          (list
           (gdscript-debug-type-face "Basis")
           (gdscript-debug--basis-to-string variant)))
         ((gdscript-transform-p variant)
          (list
           (gdscript-debug-type-face "Transform")
           (concat (gdscript-debug--basis-to-string (gdscript-transform->basis variant)) " " (gdscript-debug--vector3-to-string (gdscript-transform->origin variant)))))
         ((gdscript-color-p variant)
          (list
           (gdscript-debug-type-face "Color")
           (gdscript-debug--color-to-string variant)))
         ((gdscript-node-path-p variant)
          (list
           (gdscript-debug-type-face "NodePath")
           (gdscript-debug--constant-face (concat (when (gdscript-bool->value (gdscript-node-path->absolute variant)) "/") (mapconcat #'gdscript-string->value (gdscript-node-path->names variant) "/") (when-let* ((subnames (gdscript-node-path->subnames variant))) (concat ":" (mapconcat #'gdscript-string->value subnames ":")))))))
         ((gdscript-rid-p variant)
          (list
           (gdscript-debug-type-face "RID")))
         ((gdscript-object-id-p variant)
          (let* ((object-id (gdscript-object-id->value variant))
                 (object-id-data (gethash object-id gdscript-debug--inspected-objects)))
            (list
             (if object-id-data (gdscript-debug-type-face (gdscript-inspect-object->class object-id-data)) "ObjectID")
             (concat (gdscript-debug--comment-face (format "ObjectID: %s" (number-to-string object-id)))
                     (when object-id-data
                       (let* ((property (car (gdscript-inspect-object->properties object-id-data)))
                              (name (gdscript-property-info->name property)))
                         (when (equal name "Node/path")
                           (concat " " (gdscript-print-data->string-repr (gdscript-debug--pure-stringify (gdscript-property-info->variant property) property-name buffer-type t))))))))))
         ((gdscript-dictionary-p variant)
          (list
           (gdscript-debug-type-face "Dictionary")
           (gdscript-debug--dictionary-inline-string variant property-name buffer-type)
           (gdscript-debug--dictionary-multiline-string variant property-name buffer-type)))
         ((gdscript-array-p variant)
          (list
           (gdscript-debug-type-face "Array")
           (concat "[" (mapconcat (lambda (element) (gdscript-print-data->string-repr (gdscript-debug--pure-stringify element property-name buffer-type t))) (gdscript-array->elements variant) ", ") "]")
           (concat "[" (mapconcat (lambda (element) (gdscript-print-data->string-repr (gdscript-debug--pure-stringify element property-name buffer-type t))) (gdscript-array->elements variant) ", ") "]")))
         ((gdscript-pool-byte-array-p variant)
          (list
           (gdscript-debug-type-face "PoolByteArray")
           (concat "[" (mapconcat #'number-to-string (gdscript-pool-byte-array->elements variant) " ") "]")
           (concat "[" (mapconcat #'number-to-string (gdscript-pool-byte-array->elements variant) " ") "]")))
         ((gdscript-pool-int-array-p variant)
          (list
           (gdscript-debug-type-face "PoolIntArray")
           (concat "[" (mapconcat (lambda (int) (number-to-string (gdscript-integer->value int))) (gdscript-pool-int-array->elements variant) " ") "]")
           (concat "[" (mapconcat (lambda (int) (number-to-string (gdscript-integer->value int))) (gdscript-pool-int-array->elements variant) " ") "]")))
         ((gdscript-pool-real-array-p variant)
          (list
           (gdscript-debug-type-face "PoolRealArray")
           (gdscript-debug--pool-real-array-inline-string variant)
           (gdscript-debug--pool-real-array-multiline-string variant)))
         ((gdscript-pool-string-array-p variant)
          (list
           (gdscript-debug-type-face "PoolStringArray")
           (gdscript-debug--pool-string-array-inline-string variant)
           (gdscript-debug--pool-string-array-multiline-string variant)))
         ((gdscript-pool-vector2-array-p variant)
          (list
           (gdscript-debug-type-face "PoolVector2Array")
           (gdscript-debug--pool-vector2-array-inline-string variant)
           (gdscript-debug--pool-vector2-array-multiline-string variant)))
         ((gdscript-pool-vector3-array-p variant)
          (list
           (gdscript-debug-type-face "PoolVector3Array")
           (gdscript-debug--pool-vector3-array-inline-string variant)
           (gdscript-debug--pool-vector3-array-multiline-string variant)))
         ((gdscript-pool-color-array-p variant)
          (list
           (gdscript-debug-type-face "PoolColorArray")
           (gdscript-debug--pool-color-array-inline-string variant)
           (gdscript-debug--pool-color-array-multiline-string variant)))
         (t (error "[gdscript-debug--pure-stringify] Invalid type %s" variant)))
   property-name
   buffer-type
   inline-only))

(defun gdscript-debug--initial-inline-visibility (string init)
  (propertize string 'invisible init 'inline t))

(defun gdscript-debug--initial-multiline-visibility (string init)
  (propertize string 'invisible init 'multiline t))

(defun gdscript-debug--dictionary-inline-string (is-object-id property-name buffer-type)
  (concat "{" (mapconcat (lambda (key-value)
                           (gdscript-debug--key-value-to-string key-value property-name buffer-type)) (gdscript-dictionary->elements is-object-id) ", ") "}"))

(defun gdscript-debug--dictionary-multiline-string (dictionary property-name buffer-type)
  (let ((table (gdscript-debug-table-create)))
    (dolist (element (gdscript-dictionary->elements dictionary))
      (pcase-let ((`(,key . ,value) element))
        (gdscript-debug--table-add-row
         table
         (list
          (concat "  "(gdscript-print-data->string-repr (gdscript-debug--pure-stringify key property-name buffer-type t)) ":")
          (gdscript-print-data->string-repr (gdscript-debug--pure-stringify value property-name buffer-type t)))
         (cond ((gdscript-object-id-p value)
                (list 'object-id (gdscript-object-id->value value)))
               (t nil)))))
    (concat "{\n" (gdscript-debug--table-string table " ") "\n}")))

(defun gdscript-debug--pool-real-array-inline-string (is-object-id)
  (concat "[" (mapconcat (lambda (real) (number-to-string (gdscript-float->value real))) (gdscript-pool-real-array->elements is-object-id) " ") "]"))

(defun gdscript-debug--pool-real-array-multiline-string (is-object-id)
  (concat "[\n" (mapconcat (lambda (real) (concat "  " (number-to-string (gdscript-float->value real)) "\n")) (gdscript-pool-real-array->elements is-object-id) "") "]"))

(defun gdscript-debug--pool-string-array-inline-string (is-object-id)
  (concat "[" (mapconcat (lambda (o)
                           (gdscript-debug--string-face (gdscript-string->value o))) (gdscript-pool-string-array->elements is-object-id) " ") "]"))

(defun gdscript-debug--pool-string-array-multiline-string (is-object-id)
  (concat "[\n" (mapconcat (lambda (o)
                             (concat "  " (gdscript-debug--string-face (gdscript-string->value o)) "\n")) (gdscript-pool-string-array->elements is-object-id) "") "]"))

(defun gdscript-debug--pool-vector2-array-inline-string (is-object-id)
  (concat "[" (mapconcat #'gdscript-debug--vector2-to-string (gdscript-pool-vector2-array->elements is-object-id) " ") "]"))

(defun gdscript-debug--pool-vector2-array-multiline-string (is-object-id)
  (concat "[\n" (mapconcat (lambda (o)
                             (concat "  " (gdscript-debug--vector2-to-string o) "\n")) (gdscript-pool-vector2-array->elements is-object-id) "") "]"))

(defun gdscript-debug--pool-vector3-array-inline-string (is-object-id)
  (concat "[" (mapconcat #'gdscript-debug--vector3-to-string (gdscript-pool-vector3-array->elements is-object-id) " ") "]"))

(defun gdscript-debug--pool-vector3-array-multiline-string (is-object-id)
  (concat "[\n" (mapconcat (lambda (o)
                             (concat "  " (gdscript-debug--vector3-to-string o) "\n")) (gdscript-pool-vector3-array->elements is-object-id) "") "]"))

(defun gdscript-debug--pool-color-array-inline-string (is-object-id)
  (concat "[" (mapconcat #'gdscript-debug--color-to-string (gdscript-pool-color-array->elements is-object-id) " ") "]"))

(defun gdscript-debug--pool-color-array-multiline-string (is-object-id)
  (concat "[\n" (mapconcat (lambda (o)
                             (concat "  " (gdscript-debug--color-to-string o) "\n")) (gdscript-pool-color-array->elements is-object-id) "") "]"))

(defun gdscript-debug--to-print-data (args property-name buffer-type &optional inline-only)
  (pcase args
    (`(,type-name)
     (gdscript-print-data-create
      :type-name type-name
      :string-repr ""))
    (`(,type-name ,inline-string-repr)
     (gdscript-print-data-create
      :type-name type-name
      :string-repr (gdscript-debug--initial-inline-visibility inline-string-repr nil)))
    (`(,type-name ,inline-string-repr ,multiline-string-repr)
     (let ((multiline-invisible (gethash (cons buffer-type property-name) gdscript-debug--multiline-on)))
       (gdscript-print-data-create
        :type-name type-name
        :string-repr (concat
                      (gdscript-debug--initial-inline-visibility inline-string-repr multiline-invisible)
                      (unless inline-only
                        (gdscript-debug--initial-multiline-visibility multiline-string-repr (not multiline-invisible)))))))))

(cl-defstruct (gdscript-print-data (:constructor gdscript-print-data-create)
                                   (:copier nil)
                                   (:conc-name gdscript-print-data->))
  type-name string-repr)

(defun gdscript-debug--keyword-face (string)
  (propertize string 'font-lock-face font-lock-keyword-face))

(defun gdscript-debug--string-face (string)
  (propertize string 'font-lock-face font-lock-string-face))

(defun gdscript-debug--constant-face (string)
  (propertize string 'font-lock-face font-lock-constant-face))

(defun gdscript-debug--comment-face (string)
  (propertize string 'font-lock-face font-lock-comment-face))

(defun gdscript-debug--builtin-face (string)
  (propertize string 'font-lock-face font-lock-builtin-face))

(defun gdscript-debug-type-face (string)
  (propertize string 'font-lock-face font-lock-type-face))

(defun gdscript-debug-variable-face (string)
  (propertize string 'font-lock-face font-lock-variable-name-face))

(defun gdscript-debug--key-value-to-string (key-value property-name buffer-type)
  (let ((key (car key-value))
        (value (cdr key-value)))
    (concat (gdscript-print-data->string-repr (gdscript-debug--pure-stringify key property-name buffer-type t))
            ":"
            (gdscript-print-data->string-repr (gdscript-debug--pure-stringify value property-name buffer-type t)))))

(defun gdscript-debug--gdscript-bool-to-string (gdscript-bool)
  (if (gdscript-bool->value gdscript-bool) (gdscript-debug--keyword-face "true") (gdscript-debug--keyword-face "false")))

(defun gdscript-debug--color-to-string (color)
  (format "(%s)" (mapconcat #'number-to-string (list (gdscript-color->red color) (gdscript-color->green color) (gdscript-color->blue color) (gdscript-color->alpha color)) ", ")))

(defun gdscript-debug--basis-to-string (basis)
  (mapconcat #'gdscript-debug--vector3-to-string (list (gdscript-basis->x basis) (gdscript-basis->y basis) (gdscript-basis->z basis)) " "))

(defun gdscript-debug--vector2-to-string (vector2)
  (concat "(" (number-to-string (gdscript-vector2->x vector2)) ", " (number-to-string (gdscript-vector2->y vector2)) ")"))

(defun gdscript-debug--vector3-to-string (vector3)
  (concat "(" (number-to-string (gdscript-vector3->x vector3)) ", " (number-to-string (gdscript-vector3->y vector3)) ", " (number-to-string (gdscript-vector3->z vector3)) ")"))

(defvar gdscript-server-clients '()
  "List with client processes")

(defun gdscript-debug--sentinel-function (process event)
  "Gets called when the status of the network connection changes."
  ;; (message "[sentinel] process: %s" process)
  ;; (message "[sentinel] event  : %s" event)
  (cond
   ((string-match "open from .*\n" event)
    (push process gdscript-server-clients))
   ((or
     (string= event "connection broken by remote peer\n")
     (string= event "deleted\n"))
    (set-marker gdscript-debug--thread-position nil)
    (setq gdscript-debug--previous-packet-data nil
          gdscript-debug--offset 0
          gdscript-debug--data-needed nil
          gdscript-debug--inspected-objects (make-hash-table)
          gdscript-debug--multiline-on (make-hash-table :test #'equal)
          gdscript-debug--inspector-stack nil
          gdscript-debug--inspector-focused-object-id nil
          gdscript-debug--pinned-object-id nil
          gdscript-server-clients (seq-remove (lambda (client-process)
                                                (string=
                                                 (process-name client-process)
                                                 (process-name process)))
                                              gdscript-server-clients))
    (message "Resetting server to accept data."))
   ((eq (process-status process) 'closed)
    (message "Process Closed"))))

(defmacro gdscript-debug--send-command (&rest body)
  "Todo"
  (declare (indent 0) (debug t))
  `(pcase gdscript-server-clients
     (`() (message "No game process is running."))
     (`(server-process)
      (let ((command (progn ,@body)))
        (process-send-string server-process command)))
     (_ (message "More than one game process running"))))

(defmacro gdscript-debug--if-server-process (&rest body)
  "Todo"
  (declare (indent 0) (debug t))
  `(pcase gdscript-server-clients
     (`(server-process) (progn ,@body))))

(defun gdscript-debug-inspect-object (object-id)
  (gdscript-debug--send-command
    (gdscript-debug--inspect-object object-id)))

(defun gdscript-debug-request-scene-tree()
  (interactive)
  (gdscript-debug--send-command (gdscript-debug--command "request_scene_tree")))

(defun gdscript-debug-get-stack-dump()
  (interactive)
  (gdscript-debug--send-command (gdscript-debug--command "get_stack_dump")))

(defun gdscript-debug-continue()
  (interactive)
  (gdscript-debug--send-command (gdscript-debug--command "continue")))

(defun gdscript-debug-next()
  (interactive)
  (gdscript-debug--send-command (gdscript-debug--command "next")))

(defun gdscript-debug-step()
  (interactive)
  (gdscript-debug--send-command (gdscript-debug--command "step")))

(defun gdscript-debug-process-name (project-root)
  (format "*Godot debugger %s*" project-root))

;;;###autoload
(defun gdscript-debug-make-server()
  (interactive)

  (setq gdscript-debug--thread-position (make-marker))
  (add-to-list 'overlay-arrow-variable-list 'gdscript-debug--thread-position)

  (if-let* ((project-root (gdscript-util--find-project-configuration-file)))
      (let ((server-process
             (make-network-process
              :name (gdscript-debug-process-name project-root)
              :buffer nil
              :server t
              :host "127.0.0.1"
              :service gdscript-debug-port
              :coding 'binary
              :family 'ipv4
              :filter #'gdscript-debug--handle-server-reply
              :filter-multibyte nil
              :sentinel #'gdscript-debug--sentinel-function)))
        (process-put server-process 'project project-root)
        (message "Debugger server started - project: %s" project-root))
    (error "Not in Godot project!")))

(defun gdscript-debug--inspect-object-definition (command-length)
  `((:packet-length u32r)
    (:array-type u32r)
    (:elements-count u32r)
    (:command-type u32r)
    (:command-length u32r)
    (:command str ,command-length)
    (align 4)
    (:object-id-type u32r)
    (:object-id u32r)))

(defun gdscript-debug--get-stack-frame-vars-definition (command-length)
  `((:packet-length u32r)
    (:array-type u32r)
    (:elements-count u32r)
    (:command-type u32r)
    (:command-length u32r)
    (:command str ,command-length)
    (align 4)
    (:frame-type u32r)
    (:frame u32r)))

(defun gdscript-debug--breakpoint-packet-definition (command-length file-length)
  `((:packet-length u32r)
    (:array-type u32r)
    (:elements-count u32r)
    (:command-type u32r)
    (:command-length u32r)
    (:command str ,command-length)
    (align 4)
    (:file-type u32r)
    (:file-length u32r)
    (:file str ,file-length)
    (align 4)
    (:line-type u32r)
    (:line u32r)
    (:boolean-type u32r)
    (:boolean u32r)))

(defun gdscript-debug--set-skip-breakpoints-packet-definition (command-length)
  `((:packet-length u32r)
    (:array-type u32r)
    (:elements-count u32r)
    (:command-type u32r)
    (:command-length u32r)
    (:command str ,command-length)
    (align 4)
    (:boolean-type u32r)
    (:boolean u32r)))

(defconst gdscript-variant-bool 1 "bool")
(defconst gdscript-variant-integer 2 "integer")
(defconst gdscript-variant-string 4 "string")
(defconst gdscript-variant-array 19 "array")

(defun gdscript-debug--boolean-to-integer (b)
  (if (null b) 0 1))

(defun gdscript-debug--inspect-object (object-id)
  (let* ((command "inspect_object")
         (command-length (length command))
         (command-alength (gdscript-debug-align-length command))
         (packet-length (+ (* 6 4) command-alength))
         (spec (gdscript-debug--inspect-object-definition command-length)))
    (bindat-pack spec
                 `((:packet-length . ,packet-length)
                   (:array-type . ,gdscript-variant-array)
                   (:elements-count . 2)
                   (:command-type . ,gdscript-variant-string)
                   (:command-length . ,command-length)
                   (:command . ,command)
                   (:object-id-type . ,gdscript-variant-integer)
                   (:object-id . ,object-id)))))

(defun gdscript-debug--get-stack-frame-vars (frame)
  (let* ((command "get_stack_frame_vars")
         (command-length (length command))
         (command-alength (gdscript-debug-align-length command))
         (packet-length (+ (* 6 4) command-alength))
         (spec (gdscript-debug--get-stack-frame-vars-definition command-length)))
    (bindat-pack spec
                 `((:packet-length . ,packet-length)
                   (:array-type . ,gdscript-variant-array)
                   (:elements-count . 2)
                   (:command-type . ,gdscript-variant-string)
                   (:command-length . ,command-length)
                   (:command . ,command)
                   (:frame-type . ,gdscript-variant-integer)
                   (:frame . ,frame)))))

(defun gdscript-debug--breakpoint-command (file line add-or-remove)
  (let* ((command "breakpoint")
         (command-length (length command))
         (command-alength (gdscript-debug-align-length command))
         (file-length (length file))
         (file-alength (gdscript-debug-align-length file))
         (packet-length (+ (* 10 4) command-alength file-alength))
         (spec (gdscript-debug--breakpoint-packet-definition command-length file-length)))
    (bindat-pack spec
                 `((:packet-length . ,packet-length)
                   (:array-type . ,gdscript-variant-array)
                   (:elements-count . 4)
                   (:command-type . ,gdscript-variant-string)
                   (:command-length . ,command-length)
                   (:command . ,command)
                   (:file-type . ,gdscript-variant-string)
                   (:file-length . ,file-length)
                   (:file . ,file)
                   (:line-type . ,gdscript-variant-integer)
                   (:line . ,line)
                   (:boolean-type . ,gdscript-variant-bool)
                   (:boolean . ,(gdscript-debug--boolean-to-integer add-or-remove))))))

(defun gdscript-debug--set-skip-breakpoints-command (skip)
  (let* ((command "set_skip_breakpoints")
         (command-length (length command))
         (command-alength (gdscript-debug-align-length command))
         (packet-length (+ (* 6 4) command-alength))
         (spec (gdscript-debug--set-skip-breakpoints-packet-definition command-length)))
    (bindat-pack spec
                 `((:packet-length . ,packet-length)
                   (:array-type . ,gdscript-variant-array)
                   (:elements-count . 2)
                   (:command-type . ,gdscript-variant-string)
                   (:command-length . ,command-length)
                   (:command . ,command)
                   (:boolean-type . ,gdscript-variant-bool)
                   (:boolean . ,(gdscript-debug--boolean-to-integer skip))))))

(defun gdscript-debug--packet-definition (string-length)
  `((:packet-length u32r)
    (:array-type u32r)
    (:elements-count u32r)
    (:type u32r)
    (:string-length u32r)
    (:string-data str ,string-length)
    (align 4)))

(defun gdscript-debug--command (command)
  (let* ((command-alength (gdscript-debug-align-length command))
         (packet-length (+ (* 4 4) command-alength)))
    (bindat-pack
     (gdscript-debug--packet-definition (length command))
     `((:packet-length . ,packet-length)
       (:array-type . ,gdscript-variant-array)
       (:elements-count . 1)
       (:type . ,gdscript-variant-string)
       (:string-length . ,(length command))
       (:string-data . ,command)))))

(defun gdscript-debug-align-length (string)
  (let ((len (length string)))
    (while (/= (% len 4) 0)
      (setq len (1+ len)))
    len))

(defun gdscript-debug--add-fringe(pos enabled &rest sprops)
  (interactive)
  (let* ((string (make-string 1 ?x))
         (buffer (current-buffer))
         (prop `(left-fringe breakpoint ,(if enabled 'breakpoint-enabled 'breakpoint-disabled)))
         (overlay (make-overlay pos pos buffer)))
    (put-text-property 0 1 'display prop string)
    (if sprops
        (add-text-properties 0 1 sprops string))
    (overlay-put overlay 'put-break t)
    (overlay-put overlay 'before-string string)))

(defun gdscript-debug--remove-strings (start end &optional buffer)
  "Remove strings between START and END in BUFFER.
Remove only strings that were put in BUFFER with calls to `gdscript-debug--add-fringe'.
BUFFER nil or omitted means use the current buffer."
  (unless buffer
    (setq buffer (current-buffer)))
  (dolist (overlay (overlays-in start end))
    (when (overlay-get overlay 'put-break)
      (delete-overlay overlay))))

(defun gdscript-debug--absolute-path ()
  "Return the absolute path of current gdscript file."
  (when (and buffer-file-name
             (file-exists-p buffer-file-name)
             (string= (file-name-extension buffer-file-name) "gd"))
    buffer-file-name))

(defun gdscript-debug--current-file ()
  (let ((current-file (gdscript-util--get-godot-project-file-path-relative buffer-file-name)))
    (when current-file
      (let ((extension (file-name-extension buffer-file-name)))
        (when (string= extension "gd")
          (concat "res://" current-file ".gd"))))))

(defmacro gdscript-debug--with-gdscript-file (file-info body)
  (declare (indent 1) (debug t))
  `(let ((,file-info (cons (gdscript-debug--current-file) (gdscript-debug--absolute-path))))
     (if (not (car ,file-info))
         (message "No GDScript file.")
       ,body)))

(defun gdscript-debug-get-stack-frame-vars (level)
  (gdscript-debug--send-command
    (gdscript-debug--get-stack-frame-vars level)))

(cl-defstruct (gdscript-null (:constructor gdscript-null-create)
                             (:copier nil)))

(cl-defstruct (gdscript-bool (:constructor gdscript-bool-create)
                             (:copier nil)
                             (:conc-name gdscript-bool->))
  value)

(cl-defstruct (gdscript-integer (:constructor gdscript-integer-create)
                                (:copier nil)
                                (:conc-name gdscript-integer->))
  value)

(cl-defstruct (gdscript-float (:constructor gdscript-float-create)
                              (:copier nil)
                              (:conc-name gdscript-float->))
  value)

(cl-defstruct (gdscript-string (:constructor gdscript-string-create)
                               (:copier nil)
                               (:conc-name gdscript-string->))
  value)

(cl-defstruct (gdscript-plane (:constructor gdscript-plane-create)
                              (:copier nil)
                              (:conc-name gdscript-plane->))
  normal distance)

(cl-defstruct (gdscript-quat (:constructor gdscript-quat-create)
                             (:copier nil)
                             (:conc-name gdscript-quat->))
  x-imaginary y-imaginary z-imaginary real-w)

(cl-defstruct (gdscript-aabb (:constructor gdscript-aabb-create)
                             (:copier nil)
                             (:conc-name gdscript-aabb->))
  position size)

(cl-defstruct (gdscript-basis (:constructor gdscript-basis-create)
                              (:copier nil)
                              (:conc-name gdscript-basis->))
  x y z)

(cl-defstruct (gdscript-transform (:constructor gdscript-transform-create)
                                  (:copier nil)
                                  (:conc-name gdscript-transform->))
  basis origin)

(cl-defstruct (gdscript-color (:constructor gdscript-color-create)
                              (:copier nil)
                              (:conc-name gdscript-color->))
  red green blue alpha)

(cl-defstruct (gdscript-node-path (:constructor gdscript-node-path-create)
                                  (:copier nil)
                                  (:conc-name gdscript-node-path->))
  names subnames absolute)

(cl-defstruct (gdscript-rid (:constructor gdscript-rid-create)
                            (:copier nil)))

(cl-defstruct (gdscript-object-id (:constructor gdscript-object-id-create)
                                  (:copier nil)
                                  (:conc-name gdscript-object-id->))
  value)

(cl-defstruct (gdscript-dictionary (:constructor gdscript-dictionary-create)
                                   (:copier nil)
                                   (:conc-name gdscript-dictionary->))
  shared elements)

(cl-defstruct (gdscript-vector2 (:constructor gdscript-vector2-create)
                                (:copier nil)
                                (:conc-name gdscript-vector2->))
  x y)

(cl-defstruct (gdscript-rect2 (:constructor gdscript-rect2-create)
                              (:copier nil)
                              (:conc-name gdscript-rect2->))
  coordinate size)

(cl-defstruct (gdscript-vector3 (:constructor gdscript-vector3-create)
                                (:copier nil)
                                (:conc-name gdscript-vector3->))
  x y z)

(cl-defstruct (gdscript-transform2d (:constructor gdscript-transform2d-create)
                                    (:copier nil)
                                    (:conc-name gdscript-transform2d->))
  x y origin)

(cl-defstruct (gdscript-array (:constructor gdscript-array-create)
                              (:copier nil)
                              (:conc-name gdscript-array->))
  shared elements)

(cl-defstruct (gdscript-pool-byte-array (:constructor gdscript-pool-byte-array-create)
                                        (:copier nil)
                                        (:conc-name gdscript-pool-byte-array->))
  elements)

(cl-defstruct (gdscript-pool-int-array (:constructor gdscript-pool-int-array-create)
                                       (:copier nil)
                                       (:conc-name gdscript-pool-int-array->))
  elements)

(cl-defstruct (gdscript-pool-real-array (:constructor gdscript-pool-real-array-create)
                                        (:copier nil)
                                        (:conc-name gdscript-pool-real-array->))
  elements)

(cl-defstruct (gdscript-pool-string-array (:constructor gdscript-pool-string-array-create)
                                          (:copier nil)
                                          (:conc-name gdscript-pool-string-array->))
  elements)

(cl-defstruct (gdscript-pool-vector2-array (:constructor gdscript-pool-vector2-array-create)
                                           (:copier nil)
                                           (:conc-name gdscript-pool-vector2-array->))
  elements)

(cl-defstruct (gdscript-pool-vector3-array (:constructor gdscript-pool-vector3-array-create)
                                           (:copier nil)
                                           (:conc-name gdscript-pool-vector3-array->))
  elements)

(cl-defstruct (gdscript-pool-color-array (:constructor gdscript-pool-color-array-create)
                                         (:copier nil)
                                         (:conc-name gdscript-pool-color-array->))
  elements)

(cl-defstruct (gdscript-stack-frame-vars (:constructor gdscript-stack-frame-vars-create)
                                         (:copier nil)
                                         (:conc-name gdscript-stack-frame-vars->))
  locals members globals)

(cl-defstruct (gdscript-stack-dump (:constructor gdscript-stack-dump-create)
                                   (:copier nil)
                                   (:conc-name gdscript-stack-dump->))
  file line function-name level)

(cl-defstruct (gdscript-output-error (:constructor gdscript-output-error-create)
                                     (:copier nil)
                                     (:conc-name gdscript-output-error->))
  ;; See struct OutputError in script_debugger_remote.h
  hr          ;; int
  min         ;; int
  sec         ;; int
  msec        ;; int
  source-file ;; String
  source-func ;; String
  source-line ;; int
  error       ;; String
  error-descr ;; String
  warning     ;; bool
  callstack)  ;; Array

(cl-defstruct (gdscript-stack-info (:constructor sgdscript-tack-info-create)
                                   (:copier nil)
                                   (:conc-name gdscript-stack-info->))
  file func line)

(cl-defstruct (gdscript-inspect-object (:constructor gdscript-inspect-object-create)
                                       (:copier nil)
                                       (:conc-name gdscript-inspect-object->))
  object-id class properties)

(cl-defstruct (gdscript-property-info (:constructor gdscript-property-info-create)
                                      (:copier nil)
                                      (:conc-name gdscript-property-info->))
  name
  type
  hint ;; see enum PropertyHint in object.h
  hint-string
  usage ;; see enum PropertyUsageFlags in object.h
  variant)

(cl-defstruct (gdscript-breakpoint (:constructor gdscript-breakpoint-create)
                                   (:copier nil)
                                   (:conc-name gdscript-breakpoint->))
  file file-absolute line)

(cl-defstruct (gdscript-debug-enter (:constructor gdscript-debug-enter-create)
                                    (:copier nil)
                                    (:conc-name gdscript-debug-enter->))
  can-continue reason)

(cl-defstruct (gdscript-debug-table (:constructor gdscript-debug-table-create)
                                    (:copier nil)
                                    (:conc-name gdscript-debug-table->))
  column-sizes
  rows
  row-properties
  right-align)

(cl-defstruct (gdscript-debug-breadcrumb-entry (:constructor gdscript-debug-breadcrumb-entry-create)
                                               (:copier nil)
                                               (:conc-name gdscript-debug-breadcrumb-entry->))
  class object-id point)

(defun gdscript-debug--table-add-row (table row &optional properties)
  "Add ROW of string to TABLE and recalculate column sizes.

When non-nil, PROPERTIES will be added to the whole row when
calling `gdscript-debug--table-string'."
  (let ((rows (gdscript-debug-table->rows table))
        (row-properties (gdscript-debug-table->row-properties table))
        (column-sizes (gdscript-debug-table->column-sizes table))
        (right-align (gdscript-debug-table->right-align table)))
    (when (not column-sizes)
      (setf (gdscript-debug-table->column-sizes table)
            (make-list (length row) 0)))
    (setf (gdscript-debug-table->rows table)
          (append rows (list row)))
    (setf (gdscript-debug-table->row-properties table)
          (append row-properties (list properties)))
    (setf (gdscript-debug-table->column-sizes table)
          (cl-mapcar (lambda (x s)
                       (let ((new-x
                              (max (abs x) (string-width (or s "")))))
                         (if right-align new-x (- new-x))))
                     (gdscript-debug-table->column-sizes table)
                     row))
    ;; Avoid trailing whitespace at eol
    (if (not (gdscript-debug-table->right-align table))
        (setcar (last (gdscript-debug-table->column-sizes table)) 0))))

(defun gdscript-debug--parent-mode ()
  "Generic mode to derive all other buffer modes from."
  (kill-all-local-variables)
  (setq buffer-read-only t)
  (buffer-disable-undo))

(defun gdscript-debug-toggle-breakpoint ()
  "Add or remove a breakpoint on the line at POINT."
  (interactive)
  (let* ((breakpoint (gdscript-debug--construct-breakpoint-at-point)))
    (if (gdscript-debug--is-existing-breakpoint-p breakpoint)
      (gdscript-debug--remove-breakpoint breakpoint)
      (gdscript-debug--add-breakpoint-to-line breakpoint))))

(defun gdscript-debug--construct-breakpoint-at-point ()
  "Construct a breakpoint object for the line at POINT and return it.
May match an existing breakpoint."
  (gdscript-debug--with-gdscript-file file-info
    (let* ((line (line-number-at-pos))
           (file (car file-info))
           (file-absolute (cdr file-info))
           (breakpoint (gdscript-breakpoint-create :file file :file-absolute file-absolute :line line)))
      breakpoint)))

(defun gdscript-debug--is-existing-breakpoint-p (breakpoint)
  "Return t if `BREAKPOINT' is an existing breakpoint in the project."
  (member breakpoint gdscript-debug--breakpoints))

(defun gdscript-debug--add-breakpoint-to-line (breakpoint)
  "Register `BREAKPOINT' to the current line in a GDScript buffer."
  (gdscript-debug--with-gdscript-file file-info
    (let* ((line (line-number-at-pos))
           (file (car file-info)))
      (if (member breakpoint gdscript-debug--breakpoints)
          (message "Breakpoint already present at %s:%s" file line)
        (gdscript-debug--add-fringe (line-beginning-position) (not gdscript-debug--skip-breakpoints) 'gdb-bptno 1)
        (gdscript-debug--add-breakpoint-to-buffer breakpoint)
        (gdscript-debug-refresh-breakpoints-buffer)
        (gdscript-debug--if-server-process
          (gdscript-debug--send-command
            (gdscript-debug--breakpoint-command file line t)))))))

(defun gdscript-debug--remove-breakpoint (breakpoint)
  "Remove `BREAKPOINT' to the current line in a GDScript buffer."
  (gdscript-debug--with-gdscript-file file-info
    (let* ((start (line-beginning-position))
           (end (line-end-position))
           (line (line-number-at-pos))
           (file (car file-info)))
      (if (not (member breakpoint gdscript-debug--breakpoints))
          (message "No breakpoint at %s:%s" file line)
        (gdscript-debug--remove-strings start end)
        (gdscript-debug--remove-breakpoint-from-buffer breakpoint)
        (gdscript-debug--if-server-process
          (gdscript-debug--send-command
            (gdscript-debug--breakpoint-command file line nil)))))))

(defun gdscript-debug--set-left-fringe-breakpoints (enabled)
  (gdscript-debug-refresh-breakpoints-buffer)
  (dolist (breakpoint gdscript-debug--breakpoints)
    (let ((file (gdscript-breakpoint->file-absolute breakpoint))
          (line (gdscript-breakpoint->line breakpoint)))
      (save-selected-window
        (let ((buffer (find-file-noselect file)))
          (save-excursion
            (with-current-buffer buffer
              (goto-char (point-min))
              (forward-line (1- line))
              (let ((start (line-beginning-position))
                    (end (line-end-position)))
                (dolist (overlay (overlays-in start end))
                  (when (overlay-get overlay 'put-break)
                    (let* ((string (overlay-get overlay 'before-string))
                           (prop `(left-fringe breakpoint ,(if (not enabled) 'breakpoint-enabled 'breakpoint-disabled))))
                      (put-text-property 0 1 'display prop string))))))))))))

(defun gdscript-debug-toggle-skip-breakpoints ()
  "Toggle the execution of all breakpoints without removing them.
Like Godot's Skip Breakpoints button."
  (interactive)
  (setq gdscript-debug--skip-breakpoints (not gdscript-debug--skip-breakpoints))
  (gdscript-debug--set-left-fringe-breakpoints gdscript-debug--skip-breakpoints)
  (gdscript-debug--send-command
    (gdscript-debug--set-skip-breakpoints-command gdscript-debug--skip-breakpoints)))

(defun gdscript-debug-delete-breakpoint ()
  (interactive)
  (if-let* ((breakpoint (get-text-property (point) 'gdscript-debug--breakpoint)))
      (let ((file (gdscript-breakpoint->file-absolute breakpoint))
            (line (gdscript-breakpoint->line breakpoint)))
        (save-selected-window
          (let ((buffer (find-file-noselect file)))
            (with-current-buffer buffer
              (goto-char (point-min))
              (forward-line (1- line))
              (gdscript-debug--remove-breakpoint breakpoint)))))
    (message "Not recognized as breakpoint line")))

(defun gdscript-debug-goto-breakpoint ()
  (interactive)
  (if-let* ((breakpoint (get-text-property (point) 'gdscript-debug--breakpoint)))
      (let ((file (gdscript-breakpoint->file-absolute breakpoint))
            (line (gdscript-breakpoint->line breakpoint)))
        (save-selected-window
          (let* ((buffer (find-file-noselect file))
                 (window (gdscript-debug--display-buffer buffer)))
            (with-current-buffer buffer
              (goto-char (point-min))
              (forward-line (1- line))
              (set-window-point window (point))))))
    (message "Not recognized as breakpoint line")))

(defun gdscript-debug-inspect-object-id ()
  (interactive)
  (save-excursion
    (when (or (derived-mode-p 'gdscript-debug--scene-tree-mode)
              (derived-mode-p 'gdscript-debug--stack-frame-vars-mode))
      (setq gdscript-debug--inspector-stack nil))
    (if-let* ((object-id (get-text-property (point) 'object-id)))
        (progn
          (setq gdscript-debug--inspector-focused-object-id object-id)
          (gdscript-debug--show-object-id object-id))
      (message "Not recognized as object-id line"))))

(defun gdscript-debug--show-object-id (object-id)
  (if (gethash object-id gdscript-debug--inspected-objects)
      (gdscript-debug--refresh-inspector-buffer object-id)
    (if gdscript-debug-state
        (message "Cannot inspect object-id now")
      (setq gdscript-debug-state :refresh-inspector)
      (gdscript-debug-inspect-object object-id))))

(defun gdscript-debug-show-stack-frame-vars ()
  (interactive)
  (save-excursion
    (beginning-of-line)
    (if-let* ((stack (get-text-property (point) 'gdscript-debug--stack-dump)))
        (progn (setq gdscript-debug--selected-stack-dump stack)
               (gdscript-debug-get-stack-frame-vars (gdscript-stack-dump->level stack)))
      (message "Not recognized as stack-frame line"))))

(defun gdscript-debug-jump-to-stack-point ()
  (interactive)
  (save-excursion
    (beginning-of-line)
    (if-let* ((stack-dump (get-text-property (point) 'gdscript-debug--stack-dump))
              (project-root (get-text-property (point) 'gdscript-debug--project-root)))
        (let* ((file (gdscript-stack-dump->file stack-dump))
               (line (gdscript-stack-dump->line stack-dump))
               (full-file-path (concat project-root (gdscript-debug--drop-res file))))
          (with-current-buffer (find-file full-file-path)
            (let* ((posns (gdscript-debug--line-posns line))
                   (start-posn (car posns)))
              (goto-char start-posn))))
      (message "Not recognized as stack-frame line"))))

(defun gdscript-debug-go-back ()
  (interactive)
  (cond
   ((>= 1 (length gdscript-debug--inspector-stack))
    (switch-to-buffer (gdscript-debug--get-stack-frame-vars-buffer)))
   (t
    (let* ((last-breadcrumb (pop gdscript-debug--inspector-stack))
           (show-breadcrumb (car gdscript-debug--inspector-stack))
           (object-id (gdscript-debug-breadcrumb-entry->object-id show-breadcrumb)))
      (setq gdscript-debug--inspector-focused-object-id object-id)
      (gdscript-debug--show-object-id object-id)
      (goto-char (gdscript-debug-breadcrumb-entry->point last-breadcrumb))))))

(defun gdscript-debug-toggle-visibility ()
  (interactive)
  (when-let ((is-on-multiline (get-pos-property (point) 'multiline)))
    (goto-char (previous-single-property-change (point) 'multiline)))
  (when (get-text-property (line-end-position) 'multiline)
    (let* ((inhibit-read-only t)
           (start (line-beginning-position))
           (end (line-end-position))
           (property-name (get-text-property start 'property-name))
           (inline-start (next-single-property-change start 'inline (current-buffer) end))
           (inline-end (next-single-property-change inline-start 'inline))
           (multiline-start inline-end)
           (multiline-end (next-single-property-change multiline-start 'multiline))
           (inline-invisible (get-pos-property inline-end 'invisible))
           (multiline-invisible (get-pos-property multiline-end 'invisible)))
      (put-text-property inline-start inline-end 'invisible (not inline-invisible))
      (put-text-property multiline-start multiline-end 'invisible (not multiline-invisible))
      (puthash (cons gdscript-debug--buffer-type property-name) multiline-invisible gdscript-debug--multiline-on)
      (when inline-invisible (goto-char start)))))

(defvar gdscript-debug--stack-dump-mode-map
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map)
    (define-key map "q" 'kill-current-buffer)
    (define-key map " " 'gdscript-debug-jump-to-stack-point)
    (define-key map "p" 'previous-line)
    (define-key map "n" 'next-line)
    (define-key map "l" 'gdscript-debug-display-stack-frame-vars-buffer)
    (define-key map "\r" 'gdscript-debug-show-stack-frame-vars)
    (define-key map "?" 'describe-mode)
    (define-key map (kbd "C-c n") 'gdscript-debug-hydra)
    (define-key map (kbd "C-c r") 'gdscript-hydra-show)
    map))

(defvar gdscript-debug--breakpoints-mode-map
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map)
    (define-key map " " 'gdscript-debug-toggle-skip-breakpoints)
    (define-key map "q" 'kill-current-buffer)
    (define-key map "D" 'gdscript-debug-delete-breakpoint)
    (define-key map "\r" 'gdscript-debug-goto-breakpoint)
    (define-key map "\t" 'gdscript-debug-display-stack-dump-buffer)
    (define-key map "?" 'describe-mode)
    (define-key map (kbd "C-c n") 'gdscript-debug-hydra)
    (define-key map (kbd "C-c r") 'gdscript-hydra-show)
    map))

(defvar gdscript-debug--stack-frame-vars-mode-map
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map)
    (define-key map "d" 'gdscript-debug-fetch-object-ids-detail)
    (define-key map "l" 'gdscript-debug-display-stack-dump-buffer)
    (define-key map "n" 'next-line)
    (define-key map "o" 'gdscript-debug-pin-inspected-object-id)
    (define-key map "p" 'previous-line)
    (define-key map "q" 'kill-current-buffer)
    (define-key map "u" 'gdscript-debug-unpin)
    (define-key map "\r" 'gdscript-debug-inspect-object-id)
    (define-key map "\t" 'gdscript-debug-toggle-visibility)
    (define-key map "?" 'describe-mode)
    (define-key map (kbd "C-c n") 'gdscript-debug-hydra)
    (define-key map (kbd "C-c r") 'gdscript-hydra-show)
    map))

(defvar gdscript-debug--inspector-mode-map
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map)
    (define-key map "d" 'gdscript-debug-fetch-object-ids-detail)
    (define-key map "l" 'gdscript-debug-go-back)
    (define-key map "n" 'next-line)
    (define-key map "u" 'gdscript-debug-unpin)
    (define-key map "o" 'gdscript-debug-pin-inspected-object-id)
    (define-key map "p" 'previous-line)
    (define-key map "q" 'kill-current-buffer)
    (define-key map "\t" 'gdscript-debug-toggle-visibility)
    (define-key map "\r" 'gdscript-debug-inspect-object-id)
    (define-key map "?" 'describe-mode)
    (define-key map (kbd "C-c n") 'gdscript-debug-hydra)
    (define-key map (kbd "C-c r") 'gdscript-hydra-show)
    map))

(defvar gdscript-debug--scene-tree-mode-map
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map)
    (define-key map "q" 'kill-current-buffer)
    (define-key map "p" 'previous-line)
    (define-key map "n" 'next-line)
    (define-key map "g" 'gdscript-debug-request-scene-tree)
    (define-key map "\r" 'gdscript-debug-inspect-object-id)
    (define-key map "?" 'describe-mode)
    (define-key map (kbd "C-c n") 'gdscript-debug-hydra)
    (define-key map (kbd "C-c r") 'gdscript-hydra-show)
    map))

(defvar-local gdscript-debug--buffer-type nil
  "One of the symbols bound in `gdscript-debug--get-buffer-create'.")

(defvar-local gdscript-debug--after-refresh-function nil
  "Function to call after command to popular buffer is received.")

(defun gdscript-debug--get-buffer (buffer-type)
  "Get a specific buffer.

In that buffer, `gdscript-debug--buffer-type' must be equal to BUFFER-TYPE."
  (catch 'found
    (dolist (buffer (buffer-list) nil)
      (with-current-buffer buffer
        (when (eq gdscript-debug--buffer-type buffer-type)
          (throw 'found buffer))))))

(defun gdscript-debug--get-breakpoint-buffer()
  (gdscript-debug--get-buffer-create 'breakpoints-buffer))

(defun gdscript-debug--get-stack-dump-buffer ()
  (gdscript-debug--get-buffer-create 'stack-dump-buffer))

(defun gdscript-debug--get-stack-frame-vars-buffer ()
  (gdscript-debug--get-buffer-create 'stack-frame-vars-buffer))

(defun gdscript-debug--get-inspector-buffer ()
  (gdscript-debug--get-buffer-create 'inspector-buffer))

(defun gdscript-debug--get-scene-tree-buffer ()
  (gdscript-debug--get-buffer-create 'scene-tree-buffer))

(defun gdscript-debug--many-windows (buffer-to-display _action-alist)
  (let ((mode-to-display (with-current-buffer buffer-to-display major-mode))
        (window-to-switch))
    (when
        (or (eq mode-to-display 'gdscript-debug--breakpoints-mode)
            (eq mode-to-display 'gdscript-debug--stack-dump-mode)
            (eq mode-to-display 'gdscript-debug--stack-frame-vars-mode)
            (eq mode-to-display 'gdscript-debug--inspector-mode)
            (eq mode-to-display 'gdscript-debug--scene-tree-mode))
      (mapc (lambda (window)
              (with-current-buffer (window-buffer window)
                (when (not
                       (or (eq major-mode 'gdscript-mode)
                           (eq window lv-wnd)))
                  (setq window-to-switch window)
                  (set-window-buffer window buffer-to-display))))
            (window-list)))
    window-to-switch))

(defun gdscript-debug--stack-dump-file-path (stack-dump)
    (concat (cdr gdscript-debug--stack-dump) (gdscript-debug--drop-res (gdscript-stack-dump->file stack-dump))))

(defun gdscript-debug--set-window-buffer (window stack-dump)
  (let ((buffer (find-file-noselect (gdscript-debug--stack-dump-file-path stack-dump))))
    (set-window-buffer window buffer)
    (with-current-buffer buffer
      (goto-char (point-min))
      (forward-line (1-  (gdscript-stack-dump->line stack-dump)))
      (point))))

(defun gdscript-debug-windows ()
  (delete-other-windows)
  (gdscript-debug-hydra)
  (pcase (car gdscript-debug--stack-dump)
    (`() nil)
    (`(,stack-dump)
     (let* ((top-left (selected-window))
            (bottom-left (split-window))
            (bottom-right (split-window bottom-left nil t)))
       (set-window-buffer top-left (find-file-noselect (gdscript-debug--stack-dump-file-path stack-dump)))
       (set-window-buffer bottom-left (gdscript-debug--get-inspector-buffer))
       (set-window-buffer bottom-right (gdscript-debug--get-stack-frame-vars-buffer))))
    (_
     (let* ((stack-dump-a (caar gdscript-debug--stack-dump))
            (stack-dump-b (cadr (car gdscript-debug--stack-dump)))
            (top-left (selected-window))
            (bottom-left (split-window))
            (top-right (split-window nil nil t))
            (bottom-right (split-window bottom-left nil t))
            (top-left-point (gdscript-debug--set-window-buffer top-left stack-dump-b))
            (top-right-point (gdscript-debug--set-window-buffer top-right stack-dump-a)))
       (set-window-point top-left top-left-point)
       (set-window-point top-right top-right-point)
       (set-window-buffer bottom-left (gdscript-debug--get-inspector-buffer))
       (set-window-buffer bottom-right (gdscript-debug--get-stack-frame-vars-buffer))
       (select-window top-right)))))

(defun gdscript-debug--display-buffer (buffer)
  (display-buffer buffer
                  '((display-buffer-reuse-window
                     gdscript-debug--many-windows))))

(defun gdscript-debug-display-stack-dump-buffer ()
  "Display stack dump."
  (interactive)
  (display-buffer (gdscript-debug--get-stack-dump-buffer) '((display-buffer-same-window))))

(defun gdscript-debug-display-stack-frame-vars-buffer ()
  "Display the variables of current stack."
  (interactive)
  (display-buffer (gdscript-debug--get-stack-frame-vars-buffer) '((display-buffer-same-window))))

(defun gdscript-debug-display-breakpoint-buffer ()
  "Display the breakpoints."
  (interactive)
  (display-buffer (gdscript-debug--get-breakpoint-buffer) '((display-buffer-same-window)))
  (gdscript-debug-refresh-breakpoints-buffer))

(defun gdscript-debug-display-inspector-buffer ()
  "Display the inspector."
  (interactive)
  (gdscript-debug--display-buffer (gdscript-debug--get-inspector-buffer)))

(defun gdscript-debug-display-scene-tree-buffer ()
  "Display the Scene tree."
  (interactive)
  (display-buffer (gdscript-debug--get-scene-tree-buffer) '((display-buffer-same-window))))

(defun gdscript-debug-display-source-buffer ()
  "Using stack dump jump to the source"
  (interactive)
  (with-current-buffer (gdscript-debug--get-stack-dump-buffer)
    (goto-char (point-min))
    (gdscript-debug-jump-to-stack-point)))

(defun gdscript-debug--remove-breakpoint-from-buffer (breakpoint)
  (setq gdscript-debug--breakpoints (remove breakpoint gdscript-debug--breakpoints))
  (gdscript-debug-refresh-breakpoints-buffer))

(defun gdscript-debug--add-breakpoint-to-buffer (breakpoint)
  (unless (member breakpoint gdscript-debug--breakpoints)
    (push breakpoint gdscript-debug--breakpoints)))

(defun gdscript-debug--refresh-scene-tree-buffer (scene-tree-data)
  (with-current-buffer (gdscript-debug--get-scene-tree-buffer)
    (let ((inhibit-read-only t)
          (point (point)))
      (erase-buffer)
      (gdscript-debug--scene-tree-row scene-tree-data 0 "")
      (goto-char point)
      (when gdscript-debug--after-refresh-function
        (funcall gdscript-debug--after-refresh-function)
        (setq gdscript-debug--after-refresh-function nil)))))

(defun gdscript-debug--scene-tree-row (scene-tree-level-edge level node-path)
  (let* ((node (gdscript-scene-tree-level-edge->item scene-tree-level-edge))
         (children (gdscript-scene-tree-level-edge->children scene-tree-level-edge))
         (node-name (gdscript-scene-tree-node->node-name node))
         (node-class (gdscript-scene-tree-node->node-class node))
         (path (concat node-path "/" node-name)))
    (insert (propertize (format "%s %s %s %s\n"
                                (gdscript-debug-pad-string (if children "+" " ") (* 4 level))
                                (gdscript-debug-variable-face node-name)
                                (gdscript-debug-type-face node-class)
                                (gdscript-scene-tree-node->instance-id node))
                        'object-id (gdscript-scene-tree-node->instance-id node)
                        'node-path path))
    (dolist (child children)
      (gdscript-debug--scene-tree-row child (1+ level) path))))

(defun gdscript-debug--refresh-stack-dump-buffer (stack-dump project-root)
  (with-current-buffer (gdscript-debug--get-stack-dump-buffer)
    (let ((inhibit-read-only t)
          (longest-file-name 0))
      (dolist (stack stack-dump)
        (let* ((file (gdscript-stack-dump->file stack))
               (line (gdscript-stack-dump->line stack))
               (len (+ (length file) (length (number-to-string line)))))
          (when (< longest-file-name len)
            (setq longest-file-name len))))
      (erase-buffer)
      (dolist (stack stack-dump)
        (let ((ident (format "%s:%s" (gdscript-stack-dump->file stack) (gdscript-stack-dump->line stack))))
          (insert (propertize
                   (concat
                    (format (concat "%s - %-" (number-to-string (1+ longest-file-name)) "s - ") (gdscript-stack-dump->level stack) ident)
                    (propertize
                     (format "%s\n" (gdscript-stack-dump->function-name stack)) 'font-lock-face font-lock-function-name-face))
                   'gdscript-debug--stack-dump stack
                   'gdscript-debug--project-root project-root)))))))

(defun gdscript-debug-refresh-breakpoints-buffer ()
  (with-current-buffer (gdscript-debug--get-breakpoint-buffer)
    (let* ((inhibit-read-only t)
           (window (get-buffer-window (current-buffer) 0))
           (start (window-start window))
           (p (window-point window)))
      (erase-buffer)
      (insert "End Location\n")
      (dolist (breakpoint gdscript-debug--breakpoints)
        (let ((indicator (if (not gdscript-debug--skip-breakpoints)
                             (propertize (format "%-4s" "y") 'font-lock-face
                                         font-lock-warning-face)
                           (propertize (format "%-4s" "n") 'font-lock-face
                                       font-lock-comment-face))))
          (insert (propertize (format "%s%s:%s\n"
                                      indicator
                                      (gdscript-breakpoint->file breakpoint)
                                      (gdscript-breakpoint->line breakpoint))
                              'gdscript-debug--breakpoint breakpoint))))
      (set-window-start window start) ;; Forces fringe icons to refresh
      (set-window-point window p))))

(defun gdscript-debug--get-buffer-create (buffer-type)
  (or (gdscript-debug--get-buffer buffer-type)
      (let ((rules (assoc buffer-type gdscript-debug--buffer-rules))
            (new (generate-new-buffer "limbo")))
        (with-current-buffer new
          (let ((mode (gdscript-debug--rules-buffer-mode rules)))
            (when mode (funcall mode))
            (setq gdscript-debug--buffer-type buffer-type)
            (rename-buffer (funcall (gdscript-debug--rules-name-maker rules)))
            (current-buffer))))))

(define-derived-mode gdscript-debug--stack-dump-mode gdscript-debug--parent-mode "Stack Dump"
  "Major mode for stack dump."
  (setq header-line-format "Stack dump"))

(define-derived-mode gdscript-debug--stack-frame-vars-mode gdscript-debug--parent-mode "Stack Frame Vars"
  "Major mode for stack frame variables."
  (setq header-line-format "Stack frame vars"))

(define-derived-mode gdscript-debug--breakpoints-mode gdscript-debug--parent-mode "Breakpoints"
  "Major mode for breakpoints management."
  (setq header-line-format "Breakpoints"))

(define-derived-mode gdscript-debug--inspector-mode gdscript-debug--parent-mode "Inspector"
  "Major mode for inspector management."
  (setq header-line-format "Inspector"))

(define-derived-mode gdscript-debug--scene-tree-mode gdscript-debug--parent-mode "Scene Tree"
  "Major mode for scene tree."
  (setq header-line-format "Scene Tree"))

(defun gdscript-debug--stack-dump-buffer-name ()
  (concat "* Stack dump *"))

(defun gdscript-debug--stack-frame-vars-buffer-name ()
  (concat "* Stack frame vars *"))

(defun gdscript-debug--breakpoints-buffer-name ()
  (concat "* Breakpoints *"))

(defun gdscript-debug--inspector-buffer-name ()
  (concat "* Inspector *"))

(defun gdscript-debug--scene-tree-buffer-name ()
  (concat "* Scene tree *"))

(defvar gdscript-debug--buffer-rules '())
(defvar gdscript-debug--breakpoints '())
(defvar gdscript-debug--skip-breakpoints nil)

(defun gdscript-debug--rules-name-maker (rules-entry)
  (cadr rules-entry))
(defun gdscript-debug--rules-buffer-mode (rules-entry)
  (nth 2 rules-entry))

(defun gdscript-debug--set-buffer-rules (buffer-type &rest rules)
  (if-let* ((binding (assoc buffer-type gdscript-debug--buffer-rules)))
      (setcdr binding rules)
    (push (cons buffer-type rules)
      gdscript-debug--buffer-rules)))

(gdscript-debug--set-buffer-rules
 'stack-frame-vars-buffer
 'gdscript-debug--stack-frame-vars-buffer-name
 'gdscript-debug--stack-frame-vars-mode)

(gdscript-debug--set-buffer-rules
 'stack-dump-buffer
 'gdscript-debug--stack-dump-buffer-name
 'gdscript-debug--stack-dump-mode)

(gdscript-debug--set-buffer-rules
 'breakpoints-buffer
 'gdscript-debug--breakpoints-buffer-name
 'gdscript-debug--breakpoints-mode)

(gdscript-debug--set-buffer-rules
 'inspector-buffer
 'gdscript-debug--inspector-buffer-name
 'gdscript-debug--inspector-mode)

(gdscript-debug--set-buffer-rules
 'scene-tree-buffer
 'gdscript-debug--scene-tree-buffer-name
 'gdscript-debug--scene-tree-mode)

(ignore-errors
  ;; Don't signal an error when hydra.el is not present
  (defhydra gdscript-debug--hydra (:hint none)
    "
_n_ next _c_ continue _m_ step _b_ breakpoints _s_ stack _v_ vars _i_ inspector _t_ scene-tree _d_ details _o_ pin _u_ unpin _q_ quit
"
    ("n" (gdscript-debug-next))
    ("c" (gdscript-debug-continue))
    ("m" (gdscript-debug-step))
    ("s" (gdscript-debug-display-stack-dump-buffer))
    ("b" (gdscript-debug-display-breakpoint-buffer))
    ("v" (gdscript-debug-display-stack-frame-vars-buffer))
    ("i" (gdscript-debug-display-inspector-buffer))
    ("t" (gdscript-debug-request-scene-tree))
    ("d" (gdscript-debug-fetch-object-ids-detail))
    ("o" (gdscript-debug-pin-current-self))
    ("u" (gdscript-debug-unpin))
    ("q" nil)))

(defun gdscript-debug-hydra ()
  "Show debug hydra."
  (interactive)
  (gdscript-util--with-available-hydra (gdscript-debug--hydra/body)))

(provide 'gdscript-debug)
;;; gdscript-debug.el ends here
