424 lines
15 KiB
Clojure
424 lines
15 KiB
Clojure
(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))))
|