GameLib is a collection of libraries for creating applications in Cakelisp.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

385 lines
15 KiB

(set-cakelisp-option cakelisp-src-dir "Dependencies/cakelisp/src")
(add-cakelisp-search-directory "Dependencies/cakelisp/runtime")
(import "CHelpers.cake" "BuildTools.cake" "Dependencies.cake")
(c-import "stdio.h"
"SDL.h"
"SDL_syswm.h")
;;
;; Core/windowing
;;
(forward-declare (struct SDL_Window)
(struct SDL_AudioSpec))
(defun sdl-print-error ()
(fprintf stderr "SDL_Error: %s\n" (SDL_GetError)))
;; This supports drawing using SDL functions
(defun sdl-initialize-for-2d (window-out (* (* SDL_Window))
title (* (const char))
width int height int
&return bool)
(when (< (SDL_Init (bit-or SDL_INIT_VIDEO SDL_INIT_AUDIO SDL_INIT_TIMER)) 0)
(sdl-print-error)
(return false))
(set (deref window-out)
(SDL_CreateWindow title
SDL_WINDOWPOS_UNDEFINED SDL_WINDOWPOS_UNDEFINED
width height
(bit-or SDL_WINDOW_RESIZABLE)))
(unless (deref window-out)
(sdl-print-error)
(return false))
(return true))
;; This is the OpenGL version, which may not support SDL drawing functions, only OpenGL
(defun sdl-initialize-for-3d (window-out (* (* SDL_Window))
title (* (const char))
width int height int
&return bool)
(when (< (SDL_Init (bit-or SDL_INIT_VIDEO SDL_INIT_AUDIO SDL_INIT_TIMER)) 0)
(sdl-print-error)
(return false))
;; This is necessary to make sure the context is created using a newer version. I mainly did this
;; because RenderDoc said it needed it. This version comes from my current machine's version, and
;; isn't a requirement to be this high
(SDL_GL_SetAttribute SDL_GL_CONTEXT_MAJOR_VERSION 4)
(SDL_GL_SetAttribute SDL_GL_CONTEXT_MINOR_VERSION 6)
(set (deref window-out)
(SDL_CreateWindow title
SDL_WINDOWPOS_UNDEFINED SDL_WINDOWPOS_UNDEFINED width height
(bit-or SDL_WINDOW_RESIZABLE SDL_WINDOW_OPENGL)))
(unless (deref window-out)
(sdl-print-error)
(return false))
;; Must explicitly create the GL context for Ogre
(unless (SDL_GL_CreateContext (deref window-out))
(sdl-print-error)
(return false))
(return true))
(defun sdl-shutdown (window (* SDL_Window))
(SDL_DestroyWindow window)
(SDL_Quit))
;;
;; Graphics
;;
(defun sdl-list-2d-render-drivers (&return bool)
(var num-render-drivers int (SDL_GetNumRenderDrivers))
(unless num-render-drivers
(return false))
(var i int 0)
(each-in-range
num-render-drivers i
(var driver-info SDL_RendererInfo (array 0))
(unless (= 0 (SDL_GetRenderDriverInfo i (addr driver-info)))
(return false))
(SDL_Log "Renderer [%d]: %s\n
\tHardware accelerated: %s\n
\tRender to texture: %s\n
\tMax texture width: %d\n
\tMax texture height: %d\n
\n"
i (field driver-info name)
(? (bit-and (field driver-info flags) SDL_RENDERER_ACCELERATED) "yes" "no")
(? (bit-and (field driver-info flags) SDL_RENDERER_TARGETTEXTURE) "yes" "no")
(field driver-info max_texture_width)
(field driver-info max_texture_height)))
(return true))
(defun-local sdl-texture-from-bmp (filename (* (const char)) renderer (* SDL_Renderer)
&return (* SDL_Texture))
(var surface (* SDL_Surface) (SDL_LoadBMP filename))
(unless surface
(SDL_Log "Failed to load surface from BMP %s\n" filename)
(sdl-print-error)
(return null))
(var texture (* SDL_Texture)
(SDL_CreateTextureFromSurface renderer surface))
;; No need to hold on to surface after texture has been created
(SDL_FreeSurface surface)
(unless texture (sdl-print-error))
(return texture))
(defun-local sdl-texture-from-bmp-color-to-transparent
(filename (* (const char)) renderer (* SDL_Renderer) r char g char b char
&return (* SDL_Texture))
(var surface (* SDL_Surface) (SDL_LoadBMP filename))
(unless surface
(SDL_Log "Failed to load surface from BMP %s\n" filename)
(sdl-print-error)
(return null))
(SDL_SetColorKey surface SDL_TRUE (SDL_MapRGB (path surface > format) r g b))
(var texture (* SDL_Texture)
(SDL_CreateTextureFromSurface renderer surface))
;; No need to hold on to surface after texture has been created
(SDL_FreeSurface surface)
(unless texture (sdl-print-error))
(return texture))
;;
;; Audio
;;
;; Allocates both names and array
;; Returns number of devices in device-names-out
(defun sdl-audio-get-devices (device-names-out (* (* (* (const char))))
is-capture bool &return int)
(var num-devices int (SDL_GetNumAudioDevices is-capture))
(set (deref device-names-out) (type-cast
(calloc (sizeof (type (* (const char)))) num-devices)
(* (* (const char)))))
(fprintf stderr "Available %s devices:\n" (? is-capture "recording" "playback"))
(var i int 0)
(while (< i num-devices)
(var device-name (* (const char)) (SDL_GetAudioDeviceName i is-capture))
(when device-name
(fprintf stderr "\t[%d] %s\n" i device-name)
(set (at i (deref device-names-out)) (strdup device-name)))
(incr i))
(return num-devices))
(defun sdl-audio-list-specification (spec (* SDL_AudioSpec))
(fprintf stderr "freq: %d\n" (path spec > freq))
(fprintf stderr "format: %d\n" (path spec > format))
(fprintf stderr "channels: %d\n" (path spec > channels))
(fprintf stderr "samples: %d\n" (path spec > samples)))
(defun sdl-audio-free-device-list (device-names (* (* (const char))) num-devices int)
(var i int 0)
(while (< i num-devices)
(free (type-cast (at i device-names) (* void)))
(incr i))
(free device-names))
;;
;; Time
;;
;; Useful for getting a quick idea how long something takes, e.g.:
;; (var start-load-ticks (const Uint64) (SDL_GetPerformanceFrequency))
;; (do-load)
;; (sdl-print-time-delta start-load-ticks "Loading done")
;; ...Will print e.g. "--- Loading done at 0.94 seconds"
(defun-local sdl-print-time-delta (start-num-perf-ticks Uint64 label (* (const char)))
(var performance-num-ticks-per-second (const Uint64) (SDL_GetPerformanceFrequency))
(var current-counter-ticks Uint64 (SDL_GetPerformanceCounter))
(var frame-diff-ticks Uint64 (- current-counter-ticks start-num-perf-ticks))
(var delta-time float (/ frame-diff-ticks
(type-cast performance-num-ticks-per-second float)))
(SDL_Log "--- %s at %f seconds\n" label delta-time))
;; This should be thread-safe assuming set-startup-time-now is only called once
(var s-startup-num-perf-ticks Uint64 0)
(defun set-startup-time-now ()
(set s-startup-num-perf-ticks (SDL_GetPerformanceCounter)))
(defun get-time-since-startup (&return float)
(var performance-num-ticks-per-second (const Uint64) (SDL_GetPerformanceFrequency))
(var current-counter-ticks Uint64 (SDL_GetPerformanceCounter))
(var frame-diff-ticks Uint64 (- current-counter-ticks s-startup-num-perf-ticks))
(var delta-time float (/ frame-diff-ticks
(type-cast performance-num-ticks-per-second float)))
(return delta-time))
;;
;; Input
;;
(defun sdl-is-key-tapped-this-frame (key (unsigned int)
current-key-states (* (const (unsigned char)))
last-frame-key-states (* (const (unsigned char)))
&return bool)
(return (and key
(at key current-key-states)
(not (at key last-frame-key-states)))))
;;
;; Test
;;
(defun test--sdl-main (&return int)
(fprintf stderr "Hello, SDL!\n")
(var window (* SDL_Window) null)
(unless (sdl-initialize-for-2d (addr window) "GameLib" 640 480) (return 1))
;; (var window-surface (* SDL_Surface) (SDL_GetWindowSurface window))
(var exit-reason (* (const char)) null)
(while (not exit-reason)
(var event SDL_Event)
(while (SDL_PollEvent (addr event))
(when (= (field event type) SDL_QUIT)
(set exit-reason "Window event")))
(var currentKeyStates (* (const Uint8)) (SDL_GetKeyboardState null))
(when (at SDL_SCANCODE_ESCAPE currentKeyStates)
(set exit-reason "Escape pressed"))
(SDL_UpdateWindowSurface window))
(when exit-reason
(fprintf stderr "Exiting. Reason: %s\n" exit-reason))
(sdl-shutdown window)
(return 0))
;;
;; Building
;;
(defun-comptime build-sdl-on-failure (failure-message (* (const char)))
(Logf "error: SDL build: %s\n
Note that you can also build SDL manually. This can be useful if you are porting to a new platform
and do not want to try to automate it yet.\n
The build step will automatically detect your build, as long as it is installed to
cakelisp_cache/SDLInstallDir/[include | lib].\n
See http://wiki.libsdl.org/Installation for how to build manually.\n"
failure-message))
;; TODO: Build into cakelisp_cache instead of dirtying Git repo
(defun-comptime build-sdl (manager (& ModuleManager) module (* Module) &return bool)
(comptime-cond
('Windows
(when (and (fileExists "Dependencies/SDL/include/SDL.h")
(fileExists "Dependencies/SDL/VisualC/x64/Debug/SDL2.dll"))
(return true))
(var process-path (* (const char)) "MSBuild.exe")
;; TODO: This shouldn't need a full path
(cond
((fileExists "C:/Program Files (x86)/Microsoft Visual Studio/2017/Community/MSBuild/15.0/Bin/amd64/MSBuild.exe")
(set process-path "C:/Program Files (x86)/Microsoft Visual Studio/2017/Community/MSBuild/15.0/Bin/amd64/MSBuild.exe"))
((fileExists "C:/Program Files (x86)/Microsoft Visual Studio/2019/Community/MSBuild/Current/Bin/amd64/MSBuild.exe")
(set process-path "C:/Program Files (x86)/Microsoft Visual Studio/2019/Community/MSBuild/Current/Bin/amd64/MSBuild.exe")))
(run-process-sequential-or
(process-path
"Dependencies/SDL/VisualC/SDL.sln"
;; TODO: Debug vs release
;; TODO: Auto detect? Environment variables: WindowsSDKVersion
"/p:PlatformToolset=v142"
"/p:WindowsTargetPlatformVersion=10.0.19041.0")
(build-sdl-on-failure
"failed at SDL build step. This requires Microsoft Visual Studio to execute.\nYou may also
need to edit SDL.cake and update the PlatformToolset and SDK versions for your environment.")
(return false))
(unless (and (fileExists "Dependencies/SDL/include/SDL.h")
(fileExists "Dependencies/SDL/VisualC/x64/Debug/SDL2.dll"))
(build-sdl-on-failure
"error: SDL build sequence completed, but files are not where expected. Is there an issue
with the configuration?")
(return false)))
('Unix
;; Already built?
;; We could enhance this by checking for modifications, but that's pretty rare
(when (and (fileExists "cakelisp_cache/SDLInstallDir/include/SDL2/SDL.h")
(fileExists "cakelisp_cache/SDLInstallDir/lib/libSDL2.a"))
(return true))
(Log "SDL: Building via Configure and Make\n")
(var sdl-working-dir (* (const char)) "cakelisp_cache/SDLBuildDir")
(makeDirectory sdl-working-dir)
(var sdl-output-dir (* (const char)) "cakelisp_cache/SDLInstallDir")
(makeDirectory sdl-output-dir)
(var configure-output-prefix ([] MAX_PATH_LENGTH char) (array 0))
(scope ;; Output must be absolute directory
(var absolute-output-path (* (const char))
(makeAbsolutePath_Allocated null sdl-output-dir))
(unless absolute-output-path
(Logf "error: failed to make SDL output directory '%s'\n" sdl-output-dir)
(return false))
(PrintfBuffer configure-output-prefix "--prefix=%s" absolute-output-path)
(free (type-cast absolute-output-path (* void))))
(run-process-sequential-or
("sh" "../../Dependencies/SDL/configure" configure-output-prefix :in-directory sdl-working-dir)
(build-sdl-on-failure
"failed at SDL configure step. This requires a sh/bash-style shell to execute.")
(return false))
(run-process-sequential-or
("make" "--jobs=8" :in-directory sdl-working-dir)
(build-sdl-on-failure "failed at SDL make. This tool requires Makefile support.")
(return false))
(run-process-sequential-or
("make" "install" :in-directory sdl-working-dir)
(build-sdl-on-failure
"failed at SDL make install. Was there a configuration issue with --prefix?")
(return false))
;; One final to check to ensure everything's good to go
(unless (and (fileExists "cakelisp_cache/SDLInstallDir/include/SDL2/SDL.h")
(fileExists "cakelisp_cache/SDLInstallDir/lib/libSDL2.a"))
(build-sdl-on-failure
"error: SDL build sequence completed, but files are not where expected. Is there an issue
with the configuration?\nFiles are expected in:\n\tcakelisp_cache/SDLInstallDir/include
\n\tcakelisp_cache/SDLInstallDir/lib")
(return false)))
(true
(comptime-error "need to define platform, e.g. (comptime-define-symbol 'Unix), or your platform
has not been implemented yet. See http://wiki.libsdl.org/Installation to add your platform.")))
(Log "SDL: Successfully built\n")
(return true))
(add-dependency-git-submodule clone-sdl2 "https://github.com/libsdl-org/SDL" "Dependencies/SDL")
(add-compile-time-hook-module pre-build build-sdl)
(export-and-evaluate
(comptime-cond
('Windows
(add-c-search-directory-module "Dependencies/SDL/include"))
('Unix
(add-c-search-directory-module "cakelisp_cache/SDLInstallDir/include/SDL2"))))
;; TODO: Add debug version
(comptime-cond
('Windows
(add-library-search-directory "Dependencies/SDL/VisualC/x64/Debug")
(add-static-link-objects "SDL2main.lib" "SDL2.lib"))
;; (add-library-runtime-search-directory "Dependencies/SDL/VisualC/x64/Debug" "."))
('Unix ;; Static link
(add-compiler-link-options "-pthread")
(comptime-cond
('SDL-Dynamic
(add-library-search-directory "cakelisp_cache/SDLInstallDir/lib")
(add-library-dependency "SDL2")
;; TODO: Relative path is going to break for sure
(add-library-runtime-search-directory "cakelisp_cache/SDLInstallDir/lib" "."))
(true
(add-static-link-objects "cakelisp_cache/SDLInstallDir/lib/libSDL2.a")))))
(comptime-cond
('Windows ;; DLLs need to be in the same directory as the executable
(defun-comptime copy-sdl2-dlls (manager (& ModuleManager) module (* Module) &return bool)
(unless (fileIsMoreRecentlyModified "Dependencies/SDL/VisualC/x64/Debug/SDL2.dll" "SDL2.dll")
(return true))
(Log "SDL: Copying DLLs to working directory\n")
(unless (copyBinaryFileTo "Dependencies/SDL/VisualC/x64/Debug/SDL2.dll" "SDL2.dll")
(Log "SDL: Failed to copy SDL2 dlls to working directory\n")
(return false))
(return true))
(add-compile-time-hook-module pre-build copy-sdl2-dlls)))