(system-include "math.h") (relative-include "SDLHelper.h") (posix-only (add-pkg "sdl2")) ;; Only define these if they're not already defined (allows the user to pre-define them before including SDL.carp) ;; Tip: Set them in your profile.carp which is located at ```C:/Users/USERNAME/AppData/Roaming/carp/profile.carp``` on Windows. (defdynamic-once sdl-windows-header-path "C:\\REDACTED\vcpkg\installed\x86-windows\include\SDL2\\") (defdynamic-once sdl-windows-library-path "C:\\REDACTED\vcpkg\installed\x86-windows\lib\\") (windows-only ;; Note - you'll still need the SDL2.dll to be able to run the executable (add-cflag "-DSDL_MAIN_HANDLED") (add-cflag "-Wno-pragma-pack") (add-cflag (str "-I" sdl-windows-header-path)) (add-lib (str "/link " sdl-windows-library-path "SDL2.lib " sdl-windows-library-path "manual-link\SDL2main.lib"))) ;; Types (register-type SDL_Keycode) (register-type SDL_Rect [x Int, y Int, w Int, h Int]) (register-type SDL_Point [x Int, y Int]) (register-type SDL_EventType) (register-type SDL_Texture) (register-type SDL_Renderer) (register-type SDL_BlendMode) (register-type SDL_RendererFlip) (register-type SDL_Window) (register-type SDL_WindowEventID) (register-type SDL_WindowEvent) (register-type SDL_Event) (register-type Uint8) (register-type SDL_Color) (defmodule SDL_Color (register r (Fn [&SDL_Color] Int)) (register g (Fn [&SDL_Color] Int)) (register b (Fn [&SDL_Color] Int)) (register a (Fn [&SDL_Color] Int))) (doc SDL "is a thin wrapper around the [SDL framework](https://www.libsdl.org/).") (defmodule SDL ;; Setup and teardown (register INIT_EVERYTHING Int) (register init (Fn [Int] ()) "SDL_Init") (register create-window-and-renderer (Fn [Int Int Int (Ptr (Ptr SDL_Window)) (Ptr (Ptr SDL_Renderer))] ()) "SDL_CreateWindowAndRenderer") (register set-window-title (Fn [(Ptr SDL_Window) (Ptr CChar)] ()) "SDL_SetWindowTitle") (register set-window-size (Fn [(Ptr SDL_Window) Int Int] ()) "SDL_SetWindowSize") (register delay (Fn [Int] ()) "SDL_Delay") (register destroy-window (Fn [(Ptr SDL_Window)] ()) "SDL_DestroyWindow") (register quit (Fn [] ()) "SDL_Quit") (defmodule Hint (register set (Fn [(Ptr CChar) (Ptr CChar)] ()) "SDL_SetHint") (register render-vsync (Ptr CChar) "SDL_HINT_RENDER_VSYNC") (register video-mac-fullscreen-spaces (Ptr CChar) "SDL_HINT_VIDEO_MAC_FULLSCREEN_SPACES")) (defmodule Event (register init (Fn [] SDL_Event)) (register type (Fn [(Ref SDL_Event)] SDL_EventType)) (register keycode (Fn [(Ref SDL_Event)] SDL_Keycode)) ;This is intentionally left here to note that in the future we shouldn't need deftemplate for this. ;(register window (Fn [(Ref SDL_Event)] SDL_WindowEvent)) (deftemplate window (Fn [(Ref SDL_Event)] SDL_WindowEvent) "SDL_WindowEvent $NAME(SDL_Event* event)" "$DECL { return event->window; }") (register poll (Fn [(Ptr SDL_Event)] Bool) "SDL_PollEvent") (register = (Fn [SDL_EventType SDL_EventType] Bool)) (register copy (Fn [&SDL_Event] SDL_Event)) ;; Event types (register quit SDL_EventType "SDL_QUIT") (register key-down SDL_EventType "SDL_KEYDOWN") (register key-up SDL_EventType "SDL_KEYUP") (register mouse-motion SDL_EventType "SDL_MOUSEMOTION") (register mouse-button-down SDL_EventType "SDL_MOUSEBUTTONDOWN") (register mouse-button-up SDL_EventType "SDL_MOUSEBUTTONUP") (register mouse-wheel SDL_EventType "SDL_MOUSEWHEEL") (register window-event SDL_EventType "SDL_WINDOWEVENT") (defn all [] (let-do [events [] e (SDL.Event.init)] (while (poll (Pointer.address &e)) (set! events (Array.push-back events e))) events)) (implements = SDL.Event.=) (implements copy SDL.Event.copy) ) ;; Rendering (register render-present (Fn [(Ptr SDL_Renderer)] ()) "SDL_RenderPresent") (register render-clear (Fn [(Ptr SDL_Renderer)] ()) "SDL_RenderClear") (register render-copy (Fn [(Ptr SDL_Renderer) (Ptr SDL_Texture) (Ptr SDL_Rect) (Ptr SDL_Rect)] ()) "SDL_RenderCopy") ;; src-rect & dest-rect (register render-copy-ex (Fn [(Ptr SDL_Renderer) (Ptr SDL_Texture) (Ptr SDL_Rect) (Ptr SDL_Rect) Double (Ptr SDL_Point) SDL_RendererFlip] ()) "SDL_RenderCopyEx") ;; src-rect, dest-rect, angle, center, flip (register set-render-draw-color (Fn [(Ptr SDL_Renderer) Int Int Int Int] ()) "SDL_SetRenderDrawColor") ;; rgba (register render-fill-rect (Fn [(Ptr SDL_Renderer) (Ptr SDL_Rect)] ()) "SDL_RenderFillRect") (register render-fill-rects (Fn [(Ptr SDL_Renderer) (Ptr SDL_Rect) Int] ()) "SDL_RenderFillRects") ;; rects, count (register render-draw-line (Fn [(Ptr SDL_Renderer) Int Int Int Int] ()) "SDL_RenderDrawLine") ;; x1 y1 x2 y2 (register render-draw-lines (Fn [(Ptr SDL_Renderer) (Ptr SDL_Point) Int] ()) "SDL_RenderDrawLines") (register render-draw-point (Fn [(Ptr SDL_Renderer) Int Int] ()) "SDL_RenderDrawPoint") (register render-read-pixels (Fn [(Ptr SDL_Renderer) (Ptr SDL_Rect) Int (Ptr ()) Int] Int) "SDL_RenderReadPixels") (register destroy-texture (Fn [(Ptr SDL_Texture)] ()) "SDL_DestroyTexture") (register set-render-draw-blend-mode (Fn [(Ptr SDL_Renderer) SDL_BlendMode] ()) "SDL_SetRenderDrawBlendMode") (register create-rgb-surface (Fn [Int Int Int Int Int Int Int Int] (Ptr SDL_Surface)) "SDL_CreateRGBSurface") (register blit-surface (Fn [(Ptr SDL_Surface) (Ptr SDL_Rect) (Ptr SDL_Surface) (Ptr SDL_Rect)] ()) "SDL_BlitSurface") ;; src, srcrect, dst, dstrect (register query-texture (Fn [(Ptr SDL_Texture) (Ptr Int) (Ptr Int) (Ptr Int) (Ptr Int)] ()) "SDL_QueryTexture") ;; ? ? w h (register create-texture-from-surface (Fn [(Ptr SDL_Renderer) (Ptr SDL_Surface)] (Ptr SDL_Texture)) "SDL_CreateTextureFromSurface") (register free-surface (Fn [(Ptr SDL_Surface)] ()) "SDL_FreeSurface") (register surface-pixels (Fn [(Ptr SDL_Surface)] (Ptr ())) "SDL_SurfacePixels") (register surface-pitch (Fn [(Ptr SDL_Surface)] Int) "SDL_SurfacePitch") (register get-window-pixel-format (Fn [(Ptr SDL_Window)] Int) "SDL_GetWindowPixelFormat") (register save-bmp (Fn [(Ptr SDL_Surface) String] Int) "SDL_SaveBMP") ;; Blend modes (register blend-mode-none SDL_BlendMode "SDL_BLENDMODE_NONE") (register blend-mode-blend SDL_BlendMode "SDL_BLENDMODE_BLEND") (register blend-mode-add SDL_BlendMode "SDL_BLENDMODE_ADD") (register blend-mode-mod SDL_BlendMode "SDL_BLENDMODE_MOD") ;; SDL_RendererFlip (register flip-none SDL_RendererFlip "SDL_FLIP_NONE") (register flip-horizontal SDL_RendererFlip "SDL_FLIP_HORIZONTAL") (register flip-vertical SDL_RendererFlip "SDL_FLIP_VERTICAL") (defmodule Keycode (defn = [a b] (Int.= (enum-to-int (the SDL_Keycode a)) (enum-to-int (the SDL_Keycode b)))) (implements = SDL.Keycode.=) (register copy (Fn [(Ref SDL_Keycode)] SDL_Keycode)) (implements copy SDL.Keycode.copy) (register str (Fn [SDL_Keycode] String)) (implements str SDL.Keycode.str) (defn prn [x] (SDL.Keycode.str x)) (implements prn SDL.Keycode.prn) (register return SDL_Keycode "SDLK_RETURN") (register space SDL_Keycode "SDLK_SPACE") (register escape SDL_Keycode "SDLK_ESCAPE") (register left SDL_Keycode "SDLK_LEFT") (register right SDL_Keycode "SDLK_RIGHT") (register up SDL_Keycode "SDLK_UP") (register down SDL_Keycode "SDLK_DOWN") (register num-1 SDL_Keycode "SDLK_1") (register num-2 SDL_Keycode "SDLK_2") (register num-3 SDL_Keycode "SDLK_3") (register num-4 SDL_Keycode "SDLK_4") (register num-5 SDL_Keycode "SDLK_5") (register num-6 SDL_Keycode "SDLK_6") (register num-7 SDL_Keycode "SDLK_7") (register num-8 SDL_Keycode "SDLK_8") (register num-9 SDL_Keycode "SDLK_9") (register num-0 SDL_Keycode "SDLK_0") (register a SDL_Keycode "SDLK_a") (register b SDL_Keycode "SDLK_b") (register c SDL_Keycode "SDLK_c") (register d SDL_Keycode "SDLK_d") (register e SDL_Keycode "SDLK_e") (register f SDL_Keycode "SDLK_f") (register g SDL_Keycode "SDLK_g") (register h SDL_Keycode "SDLK_h") (register i SDL_Keycode "SDLK_i") (register j SDL_Keycode "SDLK_j") (register k SDL_Keycode "SDLK_k") (register l SDL_Keycode "SDLK_l") (register m SDL_Keycode "SDLK_m") (register n SDL_Keycode "SDLK_n") (register o SDL_Keycode "SDLK_o") (register p SDL_Keycode "SDLK_p") (register q SDL_Keycode "SDLK_q") (register r SDL_Keycode "SDLK_r") (register s SDL_Keycode "SDLK_s") (register t SDL_Keycode "SDLK_t") (register u SDL_Keycode "SDLK_u") (register v SDL_Keycode "SDLK_v") (register w SDL_Keycode "SDLK_w") (register x SDL_Keycode "SDLK_x") (register y SDL_Keycode "SDLK_y") (register z SDL_Keycode "SDLK_z") (register period SDL_Keycode "SDLK_PERIOD") (register comma SDL_Keycode "SDLK_COMMA") (register plus SDL_Keycode "SDLK_PLUS") (register minus SDL_Keycode "SDLK_MINUS") (register less SDL_Keycode "SDLK_LESS") (register tab SDL_Keycode "SDLK_TAB") (register backspace SDL_Keycode "SDLK_BACKSPACE") ) ;; Mouse (defmodule Mouse (register get-mouse-state (Fn [(Ptr Int) (Ptr Int)] Int) "SDL_GetMouseState") (register button (Fn [Int] Int) "SDL_BUTTON") (register button-left Int "SDL_BUTTON_LEFT") (register button-right Int "SDL_BUTTON_RIGHT")) (deftype MouseState [x Int y Int left Bool right Bool]) (defmodule MouseState (defn get [] (let [x 0 y 0 state (SDL.Mouse.get-mouse-state (Pointer.address &x) (Pointer.address &y)) l (/= 0 (Int.bit-and state (SDL.Mouse.button SDL.Mouse.button-left))) r (/= 0 (Int.bit-and state (SDL.Mouse.button SDL.Mouse.button-right)))] (SDL.MouseState.init x y l r)))) ;; Window Event (defmodule WindowEvent (defmodule WindowEventID (register window-shown SDL_WindowEventID "SDL_WINDOWEVENT_SHOWN") (register window-exposed SDL_WindowEventID "SDL_WINDOWEVENT_EXPOSED") (register window-hidden SDL_WindowEventID "SDL_WINDOWEVENT_HIDDEN") (register window-moved SDL_WindowEventID "SDL_WINDOWEVENT_MOVED") (register window-resized SDL_WindowEventID "SDL_WINDOWEVENT_RESIZED") (register window-size-changed SDL_WindowEventID "SDL_WINDOWEVENT_SIZE_CHANGED") (register window-minimized SDL_WindowEventID "SDL_WINDOWEVENT_MINIMIZED") (register window-mximized SDL_WindowEventID "SDL_WINDOWEVENT_MAXIMIZED") (register window-restored SDL_WindowEventID "SDL_WINDOWEVENT_RESTORED") (register window-enter SDL_WindowEventID "SDL_WINDOWEVENT_ENTER") (register window-leave SDL_WindowEventID "SDL_WINDOWEVENT_LEAVE") (register window-focus-gained SDL_WindowEventID "SDL_WINDOWEVENT_FOCUS_GAINED") (register window-focus-lost SDL_WindowEventID "SDL_WINDOWEVENT_FOCUS_LOST") (register window-close SDL_WindowEventID "SDL_WINDOWEVENT_CLOSE") (register window-take-focus SDL_WindowEventID "SDL_WINDOWEVENT_TAKE_FOCUS") (register window-hit-test SDL_WindowEventID "SDL_WINDOWEVENT_HIT_TEST") (defn = [a b] (Int.= (enum-to-int (the SDL_WindowEventID a)) (enum-to-int (the SDL_WindowEventID b)))) (implements = SDL.WindowEvent.WindowEventID.=) (register copy (Fn [(Ref SDL_WindowEventID)] SDL_WindowEventID)) (implements copy SDL.WindowEvent.WindowEventID.copy)) ;This is intentionally left here to note that in the future we shouldn't need deftemplate for this. ;(register event (Fn [SDL_WindowEvent] SDL_WindowEventID)) (deftemplate event (Fn [SDL_WindowEvent] SDL_WindowEventID) "SDL_WindowEventID $NAME(SDL_WindowEvent window_event)" "$DECL { return window_event.event; }") (register = (Fn [SDL_WindowEvent SDL_WindowEvent] Bool)) (implements = SDL.WindowEvent.=)) ;; Window manager flags (defmodule WindowFlags (register window-fullscreen Int "SDL_WINDOW_FULLSCREEN") (register window-fullscreen-desktop Int "SDL_WINDOW_FULLSCREEN_DESKTOP") (register window-opengl Int "SDL_WINDOW_OPENGL") (register window-vulkan Int "SDL_WINDOW_VULKAN") (register window-shown Int "SDL_WINDOW_SHOWN") (register window-hidden Int "SDL_WINDOW_HIDDEN") (register window-borderless Int "SDL_WINDOW_BORDERLESS") (register window-resizable Int "SDL_WINDOW_RESIZABLE") (register window-minimized Int "SDL_WINDOW_MINIMIZED") (register window-maximized Int "SDL_WINDOW_MAXIMIZED") (register window-input-grabbed Int "SDL_WINDOW_INPUT_GRABBED") (register window-input-focus Int "SDL_WINDOW_INPUT_FOCUS") (register window-mouse-focus Int "SDL_WINDOW_MOUSE_FOCUS") (register window-foreign Int "SDL_WINDOW_FOREIGN") (register window-allow-highdpi Int "SDL_WINDOW_ALLOW_HIGHDPI") (register window-mouse-capture Int "SDL_WINDOW_MOUSE_CAPTURE") (register window-always-on-top Int "SDL_WINDOW_ALWAYS_ON_TOP") (register window-skip-taskbar Int "SDL_WINDOW_SKIP_TASKBAR") (register window-utility Int "SDL_WINDOW_UTILITY") (register window-tooltip Int "SDL_WINDOW_TOOLTIP") (register window-popup-menu Int "SDL_WINDOW_POPUP_MENU")) ;; Time (register get-ticks (Fn [] Int) "SDL_GetTicks") ;; Helpers (not part of SDL) (register rect (Fn [Int Int Int Int] SDL_Rect)) ;; x y w h (register point (Fn [Int Int] SDL_Point)) ;; x y (register rgb (Fn [Int Int Int] SDL_Color)) ;; x y (register rgba (Fn [Int Int Int] SDL_Color)) ;; x y (defn dimensions [texture] (let-do [w 0 h 0] (SDL.query-texture texture NULL NULL (Pointer.address &w) (Pointer.address &h)) ;; TODO: Can't qualify 'query-texture' ??! (SDL.rect 0 0 w h))) (defn draw-texture [rend texture point] (let [dims (SDL.dimensions texture) dest (SDL.rect @(SDL_Point.x point) @(SDL_Point.y point) @(SDL_Rect.w &dims) @(SDL_Rect.h &dims))] (SDL.render-copy rend texture (Pointer.address &dims) (Pointer.address &dest)))) (defn draw-texture-centered [rend texture point] (let [dims (SDL.dimensions texture) w @(SDL_Rect.w &dims) h @(SDL_Rect.h &dims) dest (SDL.rect (- @(SDL_Point.x point) (/ w 2)) (- @(SDL_Point.y point) (/ h 2)) w h)] (SDL.render-copy rend texture (Pointer.address &dims) (Pointer.address &dest)))) (defn-do bg [rend color] (with Int (set-render-draw-color rend (SDL_Color.r color) (SDL_Color.g color) (SDL_Color.b color) 255)) (render-clear rend)) ) ;; App helper (deftype SDLApp [window (Ptr SDL_Window) renderer (Ptr SDL_Renderer) fps Int]) (defmodule SDLApp (doc create "creates an SDLApp instance that can then be used by `run-with-callbacks`.") (defn create [title width height] (let [win NULL ren NULL] (do (SDL.init SDL.INIT_EVERYTHING) (SDL.Hint.set SDL.Hint.render-vsync (cstr "1")) (SDL.create-window-and-renderer width height (bit-or SDL.WindowFlags.window-shown SDL.WindowFlags.window-resizable) (Pointer.address &win) (Pointer.address &ren)) (SDL.set-window-title win (cstr title)) (SDLApp.init win ren 60)))) (hidden reduce-events) (defn reduce-events [app f state-to-reduce-over] (Array.reduce &(fn [s e] (~f app s e)) ;; Note, this will malloc an environment that captures the 'app' variable. state-to-reduce-over &(SDL.Event.all))) (doc run-with-callbacks "starts the SDLApp and uses three callbacks to handle events, update state and render graphics.") (defn run-with-callbacks [app event-fn update-fn draw-fn initial-state] (let-do [rend @(SDLApp.renderer app) state initial-state last-t (SDL.get-ticks) target-dt (/ 1000 @(SDLApp.fps app))] (while true (do (set! state (reduce-events app &event-fn state)) (set! state (update-fn state)) (let-do [dt (- (SDL.get-ticks) last-t) time-left (- target-dt dt)] ;;(println* "dt: " dt ", time left: " time-left) (when (pos? time-left) (SDL.delay time-left))) (set! last-t (SDL.get-ticks)) (draw-fn app rend &state) (SDL.render-present rend))))) (doc stop "stops the app. This function return 'a' to enable it to be called from anywhere.") (defn stop [app] (do (SDL.destroy-window @(window app)) (SDL.quit) (System.exit 0))) (doc default-draw "is a default rendering function that can be passed to `run-with-callbacks`.") (defn default-draw [app rend state-ref] (do (SDL.set-render-draw-color rend 0 0 0 255) (SDL.render-clear rend))) (doc quit-on-esc "is a default event handling function that can be passed to `run-with-callbacks`. Allows the application to quit if the player presses the escape key.") (defn quit-on-esc [app state event] (case (SDL.Event.type event) SDL.Event.quit (SDLApp.stop app) SDL.Event.key-down (let [key (SDL.Event.keycode event)] (if (= key SDL.Keycode.escape) (SDLApp.stop app) state)) state)))