(ns rl
  "Hand-written raylib bindings via coffi/Panama. Only what sand needs.

   Struct layouts are written against raylib 6.0's raylib.h -- a mismatch here is
   silent memory corruption, not an error, so check src/raylib.h before bumping."
  (:require
   [coffi.mem :as mem :refer [defalias]]
   [coffi.ffi :as ffi :refer [defcfn]])
  (:import
   (java.lang.foreign Arena MemorySegment)))

(ffi/load-library (or (System/getProperty "raylib.path")
                      "libraylib.so.600"))

;;; ---------------------------------------------------------------- primitives
;; coffi's ::mem/byte is signed; raylib's Color fields are unsigned char, so 230
;; would overflow on the way in. Round-trip through unchecked-byte instead.

(defmethod mem/primitive-type ::ubyte [_type] ::mem/byte)
(defmethod mem/serialize* ::ubyte [obj _type _scope] (unchecked-byte obj))
(defmethod mem/deserialize* ::ubyte [obj _type] (Byte/toUnsignedLong obj))

;; C bool is one byte.
(defmethod mem/primitive-type ::bool [_type] ::mem/byte)
(defmethod mem/serialize* ::bool [obj _type _scope] (byte (if obj 1 0)))
(defmethod mem/deserialize* ::bool [obj _type] (not (zero? obj)))

;;; ------------------------------------------------------------------- structs

(defalias ::color
  [::mem/struct [[:r ::ubyte] [:g ::ubyte] [:b ::ubyte] [:a ::ubyte]]])

(defalias ::vector-2
  [::mem/struct [[:x ::mem/float] [:y ::mem/float]]])

(defalias ::rectangle
  [::mem/struct [[:x ::mem/float] [:y ::mem/float]
                 [:width ::mem/float] [:height ::mem/float]]])

(defalias ::texture
  [::mem/struct [[:id ::mem/int] [:width ::mem/int] [:height ::mem/int]
                 [:mipmaps ::mem/int] [:format ::mem/int]]])

(defalias ::image
  [::mem/struct [[:data ::mem/pointer] [:width ::mem/int] [:height ::mem/int]
                 [:mipmaps ::mem/int] [:format ::mem/int]]])

(defalias ::font
  [::mem/struct [[:base-size ::mem/int] [:glyph-count ::mem/int] [:glyph-padding ::mem/int]
                 [:texture ::texture] [:recs ::mem/pointer] [:glyphs ::mem/pointer]]])

(defalias ::n-patch-info
  [::mem/struct [[:source ::rectangle] [:left ::mem/int] [:top ::mem/int]
                 [:right ::mem/int] [:bottom ::mem/int] [:layout ::mem/int]]])

;;; ----------------------------------------------------------------- constants

;; KeyboardKey, raylib.h.
(def ^:const key-null 0)
(def ^:const key-apostrophe 39)
(def ^:const key-comma 44)
(def ^:const key-minus 45)
(def ^:const key-period 46)
(def ^:const key-slash 47)
(def ^:const key-zero 48)
(def ^:const key-one 49)
(def ^:const key-two 50)
(def ^:const key-three 51)
(def ^:const key-four 52)
(def ^:const key-five 53)
(def ^:const key-six 54)
(def ^:const key-seven 55)
(def ^:const key-eight 56)
(def ^:const key-nine 57)
(def ^:const key-semicolon 59)
(def ^:const key-equal 61)
(def ^:const key-a 65)
(def ^:const key-b 66)
(def ^:const key-c 67)
(def ^:const key-d 68)
(def ^:const key-e 69)
(def ^:const key-f 70)
(def ^:const key-g 71)
(def ^:const key-h 72)
(def ^:const key-i 73)
(def ^:const key-j 74)
(def ^:const key-k 75)
(def ^:const key-l 76)
(def ^:const key-m 77)
(def ^:const key-n 78)
(def ^:const key-o 79)
(def ^:const key-p 80)
(def ^:const key-q 81)
(def ^:const key-r 82)
(def ^:const key-s 83)
(def ^:const key-t 84)
(def ^:const key-u 85)
(def ^:const key-v 86)
(def ^:const key-w 87)
(def ^:const key-x 88)
(def ^:const key-y 89)
(def ^:const key-z 90)
(def ^:const key-left-bracket 91)
(def ^:const key-backslash 92)
(def ^:const key-right-bracket 93)
(def ^:const key-grave 96)

(def ^:const key-space 32)
(def ^:const key-escape 256)
(def ^:const key-enter 257)
(def ^:const key-tab 258)
(def ^:const key-backspace 259)
(def ^:const key-insert 260)
(def ^:const key-delete 261)
(def ^:const key-right 262)
(def ^:const key-left 263)
(def ^:const key-down 264)
(def ^:const key-up 265)
(def ^:const key-page-up 266)
(def ^:const key-page-down 267)
(def ^:const key-home 268)
(def ^:const key-end 269)
(def ^:const key-caps-lock 280)
(def ^:const key-scroll-lock 281)
(def ^:const key-num-lock 282)
(def ^:const key-print-screen 283)
(def ^:const key-pause 284)
(def ^:const key-f1 290)
(def ^:const key-f2 291)
(def ^:const key-f3 292)
(def ^:const key-f4 293)
(def ^:const key-f5 294)
(def ^:const key-f6 295)
(def ^:const key-f7 296)
(def ^:const key-f8 297)
(def ^:const key-f9 298)
(def ^:const key-f10 299)
(def ^:const key-f11 300)
(def ^:const key-f12 301)
(def ^:const key-left-shift 340)
(def ^:const key-left-control 341)
(def ^:const key-left-alt 342)
(def ^:const key-left-super 343)
(def ^:const key-right-shift 344)
(def ^:const key-right-control 345)
(def ^:const key-right-alt 346)
(def ^:const key-right-super 347)
(def ^:const key-kb-menu 348)

(def ^:const key-kp-0 320)
(def ^:const key-kp-1 321)
(def ^:const key-kp-2 322)
(def ^:const key-kp-3 323)
(def ^:const key-kp-4 324)
(def ^:const key-kp-5 325)
(def ^:const key-kp-6 326)
(def ^:const key-kp-7 327)
(def ^:const key-kp-8 328)
(def ^:const key-kp-9 329)
(def ^:const key-kp-decimal 330)
(def ^:const key-kp-divide 331)
(def ^:const key-kp-multiply 332)
(def ^:const key-kp-subtract 333)
(def ^:const key-kp-add 334)
(def ^:const key-kp-enter 335)
(def ^:const key-kp-equal 336)

(def ^:const mouse-button-left 0)
(def ^:const mouse-button-right 1)
(def ^:const mouse-button-middle 2)
(def ^:const log-warning 4)
(def ^:const pixelformat-r8g8b8a8 7)
(def ^:const texture-filter-point 0)

(def ^:const num-keys [key-zero key-one key-two key-three key-four
                       key-five key-six key-seven key-eight key-nine])

;;; ----------------------------------------------------------------- functions

(defcfn init-window!    "InitWindow"  [::mem/int ::mem/int ::mem/c-string] ::mem/void)
(defcfn close-window!   "CloseWindow" [] ::mem/void)
(defcfn set-target-fps! "SetTargetFPS" [::mem/int] ::mem/void)
(defcfn set-trace-log-level! "SetTraceLogLevel" [::mem/int] ::mem/void)
(defcfn window-should-close? "WindowShouldClose" [] ::bool)
(defcfn window-ready?        "IsWindowReady"      [] ::bool)

(defcfn begin-drawing! "BeginDrawing" [] ::mem/void)
(defcfn end-drawing!   "EndDrawing"   [] ::mem/void)

(defcfn draw-fps       "DrawFPS"      [::mem/int ::mem/int] ::mem/void)
(defcfn get-fps        "GetFPS"       [] ::mem/int)

(defcfn key-pressed?           "IsKeyPressed"          [::mem/int] ::bool)
(defcfn key-down?              "IsKeyDown"             [::mem/int] ::bool)
(defcfn key-released?          "IsKeyPressed"          [::mem/int] ::bool)
(defcfn mouse-button-down?     "IsMouseButtonDown"     [::mem/int] ::bool)
(defcfn mouse-button-pressed?  "IsMouseButtonPressed"  [::mem/int] ::bool)
(defcfn mouse-button-released? "IsMouseButtonReleased" [::mem/int] ::bool)
(defcfn get-mouse-position     "GetMousePosition"      [] ::vector-2)
(defcfn get-mouse-wheel-move   "GetMouseWheelMove"     [] ::mem/float)
(defcfn get-mouse-wheel-move-v "GetMouseWheelMoveV"    [] ::vector-2)

;; The !* forms take pre-serialized struct segments and allocate nothing per
;; call. Everything in a per-frame path uses these.
(def clear-background!*
  (ffi/make-downcall "ClearBackground" [::color] ::mem/void))

(def ^:private draw-rectangle-raw!*
  (ffi/make-downcall "DrawRectangle"
                     [::mem/int ::mem/int ::mem/int ::mem/int ::color] ::mem/void))

(defn draw-rectangle!*
  [x y w h color]
  (draw-rectangle-raw!* (int x) (int y) (int w) (int h) color))

(def ^:private draw-rectangle-lines-raw!*
  (ffi/make-downcall "DrawRectangleLines"
                     [::mem/int ::mem/int ::mem/int ::mem/int ::color] ::mem/void))

(defn draw-rectangle-lines!*
  [x y w h color]
  (draw-rectangle-lines-raw!* (int x) (int y) (int w) (int h) color))

(def ^:private draw-rectangle-lines-ex-raw!*
  (ffi/make-downcall "DrawRectangleLinesEx"
                     [::rectangle ::mem/float ::color] ::mem/void))

(defn draw-rectangle-lines-ex!* [rec line-thick color]
  (draw-rectangle-lines-ex-raw!* rec (float line-thick) color))

(def update-texture!*
  (ffi/make-downcall "UpdateTexture" [::texture ::mem/pointer] ::mem/void))

(def ^:private draw-texture-raw!*
  (ffi/make-downcall "DrawTexture" [::texture ::mem/int ::mem/int ::color] ::mem/void))

(defn draw-texture!*
  [texture x y color]
  (draw-texture-raw!* texture (int x) (int y) color))

(def draw-texture-v!*
  (ffi/make-downcall "DrawTextureV" [::texture ::vector-2 ::color] ::mem/void))

(def ^:private draw-texture-ex-raw!*
  (ffi/make-downcall "DrawTextureEx"
                     [::texture ::vector-2 ::mem/float ::mem/float ::color] ::mem/void))

(defn draw-texture-ex!*
  [texture position rotation scale color]
  (draw-texture-ex-raw!* texture position (float rotation) (float scale) color))

(def draw-texture-rec!*
  (ffi/make-downcall "DrawTextureRec"
                     [::texture ::rectangle ::vector-2 ::color] ::mem/void))

(def draw-texture-pro!*
  (ffi/make-downcall "DrawTexturePro"
                     [::texture ::rectangle ::rectangle ::vector-2 ::mem/float ::color]
                     ::mem/void))

(def draw-texture-n-patch!*
  (ffi/make-downcall "DrawTextureNPatch"
                     [::texture ::n-patch-info ::rectangle ::vector-2 ::mem/float ::color]
                     ::mem/void))

;; Called once at startup, so the map-taking form is fine.
(defcfn load-texture-raw*       "LoadTexture"          [::mem/c-string] ::texture)
(defcfn load-texture-from-image "LoadTextureFromImage" [::image] ::texture)
(defcfn unload-texture!         "UnloadTexture"        [::texture] ::mem/void)
(defcfn set-texture-filter!     "SetTextureFilter"     [::texture ::mem/int] ::mem/void)
(defcfn get-font-default        "GetFontDefault"       [] ::font)

(defcfn measure-text "MeasureText" [::mem/c-string ::mem/int] ::mem/int)

(def ^:private draw-text-raw!*
  (ffi/make-downcall "DrawText"
                     [::mem/c-string ::mem/int ::mem/int ::mem/int ::color] ::mem/void))

(def ^:private draw-text-ex-raw!*
  (ffi/make-downcall "DrawTextEx"
                     [::font ::mem/c-string ::vector-2 ::mem/float ::mem/float ::color]
                     ::mem/void))

(def ^:private measure-text-ex-raw!*
  (ffi/make-downcall "MeasureTextEx"
                     [::font ::mem/c-string ::mem/float ::mem/float] ::vector-2))

;;; --------------------------------------------------- macros

(defmacro with-drawing!
  [& body]
  `(do
     (begin-drawing!)
     (try
       ~@body
       (finally
         (end-drawing!)))))

;;; --------------------------------------------------- native value allocation

(defonce ^Arena arena (Arena/ofAuto))

(defn color-seg
  "Serialize a packed 0xRRGGBB int into a reusable native Color, once."
  ([^long hex] (color-seg hex 255))
  ([^long hex ^long alpha]
   (mem/serialize {:r (bit-and (bit-shift-right hex 16) 0xFF)
                   :g (bit-and (bit-shift-right hex 8) 0xFF)
                   :b (bit-and hex 0xFF)
                   :a alpha}
                  ::color arena))
  ([^long r ^long g ^long b ^long a]
   (mem/serialize {:r r :g g :b b :a a} ::color arena)))

(def black           (color-seg 0x000000))
(def white           (color-seg 0xFFFFFF))
(def cornflower-blue (color-seg 0x6495ED))

;; raylib.h's named palette.
(def light-gray  (color-seg 200 200 200 255))
(def gray        (color-seg 130 130 130 255))
(def dark-gray   (color-seg 80 80 80 255))
(def yellow      (color-seg 253 249 0 255))
(def gold        (color-seg 255 203 0 255))
(def orange      (color-seg 255 161 0 255))
(def pink        (color-seg 255 109 194 255))
(def red         (color-seg 230 41 55 255))
(def maroon      (color-seg 190 33 55 255))
(def green       (color-seg 0 228 48 255))
(def lime        (color-seg 0 158 47 255))
(def dark-green  (color-seg 0 117 44 255))
(def sky-blue    (color-seg 102 191 255 255))
(def blue        (color-seg 0 121 241 255))
(def dark-blue   (color-seg 0 82 172 255))
(def purple      (color-seg 200 122 255 255))
(def violet      (color-seg 135 60 190 255))
(def dark-purple (color-seg 112 31 126 255))
(def beige       (color-seg 211 176 131 255))
(def brown       (color-seg 127 106 79 255))
(def dark-brown  (color-seg 76 63 47 255))
(def blank       (color-seg 0 0 0 0))
(def magenta     (color-seg 255 0 255 255))
(def ray-white   (color-seg 245 245 245 255))

(defn rect-seg [x y w h]
  (mem/serialize {:x (float x) :y (float y) :width (float w) :height (float h)}
                 ::rectangle arena))

(defn vec2-seg [x y]
  (mem/serialize {:x (float x) :y (float y)} ::vector-2 arena))

(defn texture-seg [tex]
  (mem/serialize tex ::texture arena))

(defn load-texture [path]
  (let [tex (load-texture-raw* path)]
    (assoc tex :seg (texture-seg tex))))

(defn n-patch-info-seg [{:keys [source left top right bottom layout]}]
  (mem/serialize {:source source :left (int left) :top (int top)
                  :right (int right) :bottom (int bottom) :layout (int layout)}
                 ::n-patch-info arena))

(defn font-seg [font]
  (mem/serialize font ::font arena))

;; GetFontDefault needs a window/GL context, so this is a fn, not a def --
;; call it once after init-window! and hang onto the result.
(defn default-font-seg []
  (font-seg (get-font-default)))

;; The raw !* downcalls above take fully native args -- no auto marshaling,
;; unlike defcfn. text/x/y change every call anyway (so a per-call c-string
;; alloc is unavoidable), but color/font are expected pre-serialized (rl/white,
;; a font-seg) same as the other !* draw calls.

(defn draw-text!*
  [text x y font-size color]
  (draw-text-raw!* (mem/serialize text ::mem/c-string arena)
                   (int x) (int y) (int font-size) color))

(defn draw-text-ex!*
  [font text x y font-size spacing color]
  (draw-text-ex-raw!* font
                      (mem/serialize text ::mem/c-string arena)
                      (vec2-seg x y)
                      (float font-size) (float spacing) color))

(defn measure-text-ex!*
  "Returns a struct by value, so the raw downcall needs an allocator (arena)
   as its first arg to write the result into, and the segment it hands back
   needs an explicit deserialize -- unlike defcfn, make-downcall doesn't do
   either automatically."
  [font text font-size spacing]
  (mem/deserialize
   (measure-text-ex-raw!* arena font
                          (mem/serialize text ::mem/c-string arena)
                          (float font-size) (float spacing))
   ::vector-2))


;; TODO: LoadFont

(def ^:private set-clipboard-text-raw!*
  (ffi/make-downcall "SetClipboardText" [::mem/c-string] ::mem/void))

(defn set-clipboard-text!* [text]
  (set-clipboard-text-raw!* (mem/serialize text ::mem/c-string arena)))

(defn alloc-pixels
  "An RGBA8888 pixel buffer, native so UpdateTexture can read it directly."
  ^MemorySegment [^long n-pixels]
  (.allocate arena (* 4 n-pixels) 4))

(defn rgba-le
  "0xRRGGBB -> an int whose little-endian bytes are R,G,B,A, matching
   PIXELFORMAT_UNCOMPRESSED_R8G8B8A8 in memory."
  ^long [^long hex]
  (unchecked-int
   (bit-or (bit-and (bit-shift-right hex 16) 0xFF)
           (bit-shift-left (bit-and (bit-shift-right hex 8) 0xFF) 8)
           (bit-shift-left (bit-and hex 0xFF) 16)
           (bit-shift-left 0xFF 24))))