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.

321 lines
13 KiB

;; Windowing and OpenGL access are provided by SDL
(import "SDL.cake"
&defs-only "Licenses.cake")
(c-import "stdio.h"
;; Use galogen-generated header. See (generate-gl-header)
&with-decls "gl46.h") ;; "GL/gl.h"
(register-module-license "Galogen" g-apache-license-string)
(def-type-alias-global gl-id (unsigned int))
(defun opengl-shader-was-compiled-sucessfully (shader gl-id &return bool)
(var success int)
(var output-buffer (array 512 char))
(glGetShaderiv shader GL_COMPILE_STATUS (addr success))
(unless success
(glGetShaderInfoLog shader (sizeof output-buffer) null output-buffer)
(fprintf stderr "error: Shader compilation failed:\n%s\n" output-buffer)
(return false))
(return true))
(defun opengl-program-was-linked-sucessfully (program gl-id &return bool)
(var success int)
(var output-buffer (array 512 char))
(glGetProgramiv program GL_LINK_STATUS (addr success))
(unless success
(glGetProgramInfoLog program (sizeof output-buffer) null output-buffer)
(fprintf stderr "error: Program link failed:\n%s\n" output-buffer)
(return false))
(return true))
(defun test--opengl (&return int)
(var window (addr SDL_Window) null)
(unless (sdl-initialize-for-3d (addr window) "OpenGL" 640 480) (return 1))
(SDL_GL_SetSwapInterval 1) ;; Enable vsync
;; TODO: Support resizing with window resize callback
(glViewport 0 0 640 480)
(var shader-program gl-id (glCreateProgram))
(scope ;; Prepare program
(var vertex-shader gl-id (glCreateShader GL_VERTEX_SHADER))
(scope ;; Vertex shader
;; TODO: Generate this via a new Cakelisp language/dialect feature?
(var vertex-shader-code (addr (const char))
#"##version 460 core
layout (location = 0) in vec3 position;
layout (location = 1) in vec2 textureCoord;
out vec2 TexCoord;
void main()
gl_Position = vec4(position.x, position.y, position.z, 1.0);
TexCoord = textureCoord;
(glShaderSource vertex-shader 1 (addr vertex-shader-code) null)
(glCompileShader vertex-shader)
(unless (opengl-shader-was-compiled-sucessfully vertex-shader)
(sdl-shutdown window)
(return 1)))
(var fragment-shader gl-id (glCreateShader GL_FRAGMENT_SHADER))
(scope ;; Fragment shader
;; TODO: Generate this via a new Cakelisp language/dialect feature?
(var fragment-shader-code (addr (const char))
#"##version 460 core
out vec4 FragmentColor;
in vec2 TexCoord;
uniform sampler2D textureSampler;
void main()
FragmentColor = texture(textureSampler, TexCoord);
(glShaderSource fragment-shader 1 (addr fragment-shader-code) null)
(glCompileShader fragment-shader)
(unless (opengl-shader-was-compiled-sucessfully fragment-shader)
(sdl-shutdown window)
(return 1)))
(scope ;; Link vertex and fragment shader
(glAttachShader shader-program vertex-shader)
(glAttachShader shader-program fragment-shader)
(glLinkProgram shader-program)
(unless (opengl-program-was-linked-sucessfully shader-program)
(sdl-shutdown window)
(return 1)))
(scope ;; Clean up shaders
(glDeleteShader vertex-shader)
(glDeleteShader fragment-shader)))
(var mesh-array-object gl-id)
(var texture gl-id)
(glGenVertexArrays 1 (addr mesh-array-object))
(var start-indices int 0)
(var num-indices int 0)
(defstruct vertex-data
;; Position
x float
y float
z float
;; Texture
s float
t float)
(var-static vertices (array vertex-data)
(array 0.25f 0.25f 0.25f 0.f 0.f)
(array 0.75f 0.25f 0.25f 1.f 0.f)
(array 0.75f 0.75f 0.25f 1.f 1.f)
(array 0.25f 0.75f 0.25f 0.f 1.f)))
(var-static indices (array int)
(array 0 1 3
1 2 3))
(set num-indices (array-size indices))
;; From this point on, configuration will be saved in the vertex array object
(glBindVertexArray mesh-array-object)
;; Make our triangle vertex array
(var vertex-buffer-id gl-id)
(glGenBuffers 1 (addr vertex-buffer-id))
(glBindBuffer GL_ARRAY_BUFFER vertex-buffer-id)
(glBufferData GL_ARRAY_BUFFER (sizeof vertices) vertices GL_STATIC_DRAW)
(var layout-location int 0) ;; Should match vertex shader layout
(glVertexAttribPointer layout-location 3 GL_FLOAT
GL_FALSE ;; Normalize?
;; Stride
(sizeof (type vertex-data))
;; Buffer start offset
(type-cast 0 (addr void)))
(glEnableVertexAttribArray layout-location)
;; Make our index buffer array
(var index-buffer-id gl-id)
(glGenBuffers 1 (addr index-buffer-id))
(glBindBuffer GL_ELEMENT_ARRAY_BUFFER index-buffer-id)
(glBufferData GL_ELEMENT_ARRAY_BUFFER (sizeof indices) indices GL_STATIC_DRAW)
;; Textures
;; Generate a texture
(var width (const int) 256)
(var height (const int) 256)
(var checker-image (array (* width height 3) (unsigned char)) (array 0))
(each-in-range height y
(each-in-range width x
(set (at (+ (* y width 3) (* 3 x) 0) checker-image) (? (or (= 0 (mod (/ x 64) 2))
(= 0 (mod (/ y 64) 2)))
255 0))
(set (at (+ (* y width 3) (* 3 x) 1) checker-image) 163)
(set (at (+ (* y width 3) (* 3 x) 2) checker-image) 0)))
(glGenTextures 1 (addr texture))
(glBindTexture GL_TEXTURE_2D texture)
(glTexImage2D GL_TEXTURE_2D
0 ;; Num mips we are providing
GL_RGB ;; Destination format
0 ;; Legacy
GL_RGB ;; Source format
(glGenerateMipmap GL_TEXTURE_2D)
(var texture-coord-layout-location int 1) ;; Should match vertex shader layout
(glVertexAttribPointer texture-coord-layout-location
2 ;; Two texture coordinates
GL_FALSE ;; Normalized?
(sizeof (type vertex-data)) ;; stride
;; Buffer start offset
(type-cast (offsetof (type vertex-data) s) (addr void)))
(glEnableVertexAttribArray texture-coord-layout-location))
(var exit-reason (addr (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 (addr (const Uint8)) (SDL_GetKeyboardState null))
(when (at SDL_SCANCODE_ESCAPE currentKeyStates)
(set exit-reason "Escape pressed"))
(glClearColor 0.2f 0.2f 0.2f 1.f)
(glUseProgram shader-program)
(glBindTexture GL_TEXTURE_2D texture)
(glBindVertexArray mesh-array-object)
(glDrawElements GL_TRIANGLES num-indices GL_UNSIGNED_INT
(type-cast 0 (addr void)))
(glBindVertexArray 0) ;; Unbind
(SDL_GL_SwapWindow window))
(when exit-reason
(fprintf stderr "Exiting. Reason: %s\n" exit-reason))
(sdl-shutdown window)
(return 0))))
;; Building
(add-library-dependency "GL" "dl"))
(add-static-link-objects "opengl32.lib")))
;; Most OpenGL loading libraries were not to my tastes. I decided on galogen
;; ( because it's only two C++ files (not python or something else) and
;; reads directly from the Khronos spec (and I don't have to use my web browser for *****-sake)
;; See
(add-dependency-git-submodule clone-galogen "" "Dependencies/galogen")
(defun-comptime generate-gl-header (manager (ref ModuleManager) module (addr Module) &return bool)
(var galogen-source-file (addr (const char)) "Dependencies/galogen/galogen.cpp")
(var galogen-executable (array 512 char))
(unless (outputFilenameFromSourceFilename
(call-on c_str (field manager buildOutputDir))
;; Add to end of file for type.
(comptime-cond ('Windows "exe") (true null))
galogen-executable (sizeof galogen-executable))
(return false))
;; Build galogen (GL header code generator)
(when (fileIsMoreRecentlyModified galogen-source-file galogen-executable)
((call-on c_str (field manager environment compileTimeBuildCommand fileToExecute))
galogen-source-file "Dependencies/galogen/third_party/tinyxml2.cpp"
"--std=c++11" "-O3"
"-o" galogen-executable)
(Log "error: failed to build galogen. This uses the compile-time build command\n")
(return false))
(addExecutablePermission galogen-executable))
(var galogen-output (array 512 char) (array 0))
galogen-output (sizeof galogen-output)
(call-on c_str (field manager environment compileTimeBuildCommand fileToExecute)))
((call-on c_str (field manager environment compileTimeBuildCommand fileToExecute))
galogen-source-file "Dependencies/galogen/third_party/tinyxml2.cpp"
"/Ox" "/EHsc" galogen-output)
(Log "error: failed to build galogen. This uses the compile-time build command\n")
(return false)))))
;; Use galogen to generate gl headers/source
;; TODO Use CURL or something to download the latest version from
(var gl-specification (addr (const char)) "Dependencies/galogen/third_party/gl.xml")
;; TODO: Generate the version header name to match the version SDL.cake specifies
(var gl-generated-output-path (array 256 char) (array 0))
(unless (outputFilenameFromSourceFilename
(call-on c_str (field manager buildOutputDir))
null gl-generated-output-path (sizeof gl-generated-output-path))
(Log "error: failed to generate gl output filename\n")
(return false))
(var gl-generated-source-name (array 256 char) (array 0))
(PrintfBuffer gl-generated-source-name "%s.c" gl-generated-output-path)
(when (or (fileIsMoreRecentlyModified galogen-executable
(fileIsMoreRecentlyModified gl-specification
(var galogen-executable-path (array 256 char) (array 0))
(comptime-cond ('Unix (PrintfBuffer galogen-executable-path "./%s" galogen-executable))
('Windows (PrintfBuffer galogen-executable-path "%s" galogen-executable)))
"--api" "gl" "--ver" "4.6" "--profile" "core"
"--filename" gl-generated-output-path)
(Log "error: failed to generate gl headers via galogen\n")
(return false)))
(scope ;; Add the generated file as a dependency
;; TODO: This needs to be cleaned up
(var gl-dependency ModuleDependency (array))
(set (field gl-dependency type) ModuleDependency_CFile)
(set (field gl-dependency name) "gl46.c")
(scope ;; Use this function as the blame token
;; TODO: Add __function__ for this
(var this-definition-name (addr (const char)) "generate-gl-header")
(var this-definition (addr ObjectDefinition)
(findObjectDefinition (field manager environment) this-definition-name))
(unless this-definition
(Logf "error: failed to find definition of %s to create blame token. Was it
renamed? Search for %s and replace it with the new name of the function it is defined in\n"
this-definition-name this-definition-name)
(return false))
(set (field gl-dependency blameToken) (path this-definition > definitionInvocation)))
(call-on push_back (path module > dependencies) gl-dependency))
(scope ;; Search paths for new dependency
;; Make sure Cakelisp can resolve to the file in the cache
(call-on push_back (path module > cSearchDirectories) (call-on c_str (field manager buildOutputDir)))
;; Make sure the source file can find its header
(call-on push_back (path module > cSearchDirectories) "."))
(return true))
(add-compile-time-hook-module pre-build generate-gl-header)