├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── VERSION ├── examples └── core │ ├── core-3d-camera-first-person.scm │ ├── core-basic-window.scm │ └── core-input-keys.scm └── generate-bindings.scm /.gitignore: -------------------------------------------------------------------------------- 1 | libraylib-guile.so 2 | raylib-guile.c 3 | raylib_api.xml 4 | raylib.scm 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2021 Peter Elliott 2 | Happy Birthday (🥳) 2021 Jacob Reckhard 3 | 4 | This software is provided "as-is", without any express or implied warranty. In no event 5 | will the authors be held liable for any damages arising from the use of this software. 6 | 7 | Permission is granted to anyone to use this software for any purpose, including commercial 8 | applications, and to alter it and redistribute it freely, subject to the following restrictions: 9 | 10 | 1. The origin of this software must not be misrepresented; you must not claim that you 11 | wrote the original software. If you use this software in a product, an acknowledgment 12 | in the product documentation would be appreciated but is not required. 13 | 14 | 2. Altered source versions must be plainly marked as such, and must not be misrepresented 15 | as being the original software. 16 | 17 | 3. This notice may not be removed or altered from any source distribution. 18 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: libraylib-guile.so raylib.scm 3 | 4 | install: all 5 | install libraylib-guile.so `pkg-config --variable=extensiondir guile-3.0` 6 | install raylib.scm `pkg-config --variable=sitedir guile-3.0` 7 | 8 | libraylib-guile.so: raylib-guile.c 9 | gcc `pkg-config --cflags guile-3.0` -shared -o $@ -fPIC $^ -lraylib 10 | 11 | raylib.scm raylib-guile.c: raylib_api.xml generate-bindings.scm 12 | ./generate-bindings.scm $< 13 | 14 | raylib_api.xml: 15 | wget "https://raw.githubusercontent.com/raysan5/raylib/`cat VERSION`/parser/output/raylib_api.xml" 16 | 17 | clean: 18 | rm raylib-guile.c libraylib-guile.so raylib.scm -f 19 | 20 | .PHONY: clean all install 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # raylib-guile 2 | 3 | raylib-guile is *birthdayware* written for my good friend 4 | [Jacob Reckhard](https://github.com/jacobrec)'s birthday 🥳. 5 | it provides direct GNU guile bindings for [raylib](https://github.com/raysan5/raylib). 6 | if you're not Jacob, don't worry: you can still use it under the terms of the 7 | [zlib license](/LICENSE), the same one used by raylib. 8 | 9 | ## setting the raylib version 10 | 11 | raylib-guile will generally only build when the `VERSION` file is set to the 12 | same version of raylib you have installed. `VERSION` can contain any git ref to 13 | the raylib repo, like `master` or any specific commit id. 14 | 15 | ## building and installing 16 | 17 | prerequisites: 18 | - guile 3.0 or later 19 | - raylib built with shared library support 20 | 21 | ```sh 22 | make 23 | sudo make install 24 | ``` 25 | 26 | note: `make` will download the master-brach version of raylib's api 27 | description. if this causes errors you should change the `VERSION` file to the 28 | version of raylib you have installed. right now all tagged versions xml files 29 | are out of date, and you might need to generate them yourself. 30 | 31 | ## generated API 32 | 33 | all supported functions are exported as is in the `(raylib)` library and take 34 | equivalant arguments. pointer/value arguments are equivalent for structs. 35 | 36 | the following accessors are generated for every struct type: 37 | ``` 38 | (make-{struct} field1 field2 ...) 39 | ({struct}-field obj) 40 | ({struct}-set-field! obj value) 41 | ``` 42 | 43 | ## examples 44 | 45 | you can see some examples in the `examples/` directory. they are directly 46 | translated from raylib's examples, and as such may not represent very elegant 47 | scheme programming. 48 | 49 | ## to Jacob, my best programming buddy 50 | 51 | happy birthday! one day at a party you were complaining about how there were 52 | raylib bindings for like every language except guile, and you joked that if i 53 | was looking for something to do, i should write some. so i did. along with the 54 | rights granted to you by zlib license, i hearby grant you a special birthday boy 55 | license, with the following terms: 56 | 57 | 0. if you want, i will add you as a contributor to this repo, and you may have 58 | complete creative control over this project. 59 | 1. you may relicense this program under any license, even weird ones you made up. 60 | 2. one year of platinum-executive-enterprise support. -------------------------------------------------------------------------------- /VERSION: -------------------------------------------------------------------------------- 1 | 4.5.0 2 | -------------------------------------------------------------------------------- /examples/core/core-3d-camera-first-person.scm: -------------------------------------------------------------------------------- 1 | (use-modules (raylib)) 2 | 3 | (define screen-width 800) 4 | (define screen-height 450) 5 | (define columns 20) 6 | 7 | (InitWindow screen-width screen-height "raylib [core] example - 3d camera first person") 8 | 9 | ;; Define the camera to look into our 3d world (position, target, up vector) 10 | (define camera 11 | (make-Camera3D (make-Vector3 4 2 4) 12 | (make-Vector3 0 1.8 0) 13 | (make-Vector3 0 1 0) 14 | 60 CAMERA_PERSPECTIVE)) 15 | 16 | ;; Generates some random columns 17 | (define heights 18 | (map (lambda (i) 19 | (GetRandomValue 1 12)) 20 | (iota columns))) 21 | 22 | (define positions 23 | (map (lambda (i) 24 | (make-Vector3 (GetRandomValue -15 15) 25 | (/ (list-ref heights i) 2) 26 | (GetRandomValue -15 15))) 27 | (iota columns))) 28 | 29 | (define colors 30 | (map (lambda (i) 31 | (make-Color (GetRandomValue 20 255) 32 | (GetRandomValue 10 55) 33 | 30 255)) 34 | (iota columns))) 35 | 36 | (define camera-mode CAMERA_FIRST_PERSON) 37 | 38 | (DisableCursor) 39 | 40 | (SetTargetFPS 60) 41 | 42 | ;; Main Game Loop 43 | (while (not (WindowShouldClose)) 44 | (UpdateCamera camera camera-mode) 45 | 46 | (BeginDrawing) 47 | 48 | (ClearBackground RAYWHITE) 49 | 50 | (BeginMode3D camera) 51 | 52 | (DrawPlane (make-Vector3 0.0 0.0 0.0) (make-Vector2 32.0 32.0 ) LIGHTGRAY) ; Draw ground 53 | (DrawCube (make-Vector3 -16.0 2.5 0.0) 1.0 5.0 32.0 BLUE) ; Draw a blue wall 54 | (DrawCube (make-Vector3 16.0 2.5 0.0) 1.0 5.0 32.0 LIME) ; Draw a green wall 55 | (DrawCube (make-Vector3 0.0 2.5 16.0) 32.0 5.0 1.0 GOLD) ; Draw a yellow wall 56 | ;; draw some cubes around 57 | (for-each (lambda (height position color) 58 | (DrawCube position 2.0 height 2.0 color) 59 | (DrawCubeWires position 2.0 height 2.0 MAROON)) 60 | heights positions colors) 61 | 62 | (EndMode3D) 63 | 64 | (DrawRectangle 10 10 220 70 (Fade SKYBLUE 0.5)) 65 | (DrawRectangleLines 10 10 220 70 BLUE) 66 | 67 | (DrawText "First person camera default controls:" 20 20 10 BLACK) 68 | (DrawText "- Move with keys: W A S D" 40 40 10 DARKGRAY) 69 | (DrawText "- Mouse move to look around" 40 60 10 DARKGRAY) 70 | 71 | (EndDrawing)) 72 | 73 | (CloseWindow) 74 | -------------------------------------------------------------------------------- /examples/core/core-basic-window.scm: -------------------------------------------------------------------------------- 1 | (use-modules (raylib)) 2 | 3 | (define screen-width 800) 4 | (define screen-height 450) 5 | 6 | (InitWindow screen-width screen-height "raylib [core] example - basic window") 7 | (SetTargetFPS 60) 8 | 9 | (define (main-loop) 10 | (unless (WindowShouldClose) 11 | (BeginDrawing) 12 | 13 | (ClearBackground RAYWHITE) 14 | (DrawText "Congrats! You created your first window!" 190 200 20 LIGHTGRAY) 15 | 16 | (EndDrawing) 17 | (main-loop))) 18 | 19 | (main-loop) 20 | (CloseWindow) 21 | -------------------------------------------------------------------------------- /examples/core/core-input-keys.scm: -------------------------------------------------------------------------------- 1 | (use-modules (raylib)) 2 | 3 | (define screen-width 800) 4 | (define screen-height 450) 5 | 6 | (InitWindow screen-width screen-height "raylib [core] example - keyboard input") 7 | 8 | (define ball-position (make-Vector2 (/ screen-width 2) 9 | (/ screen-height 2))) 10 | 11 | (SetTargetFPS 60) 12 | 13 | (define (Vector2-delta! vec dx dy) 14 | (Vector2-set-x! vec (+ dx (Vector2-x vec))) 15 | (Vector2-set-y! vec (+ dy (Vector2-y vec)))) 16 | 17 | (define (main-loop) 18 | (unless (WindowShouldClose) 19 | ;; Update 20 | (when (IsKeyDown KEY_RIGHT) (Vector2-delta! ball-position 2 0)) 21 | (when (IsKeyDown KEY_LEFT) (Vector2-delta! ball-position -2 0)) 22 | (when (IsKeyDown KEY_UP) (Vector2-delta! ball-position 0 -2)) 23 | (when (IsKeyDown KEY_DOWN) (Vector2-delta! ball-position 0 2)) 24 | 25 | ;; Draw 26 | (BeginDrawing) 27 | 28 | (ClearBackground RAYWHITE) 29 | (DrawText "move the ball with arrow keys" 10 10 20 DARKGRAY) 30 | (DrawCircleV ball-position 50 MAROON) 31 | 32 | (EndDrawing) 33 | (main-loop))) 34 | 35 | (main-loop) 36 | (CloseWindow) 37 | -------------------------------------------------------------------------------- /generate-bindings.scm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/guile -s 2 | !# 3 | (use-modules (sxml simple) 4 | (ice-9 format) 5 | (ice-9 string-fun) 6 | (srfi srfi-1)) 7 | 8 | (define xml-file (cadr (command-line))) 9 | (define coutput "raylib-guile.c") 10 | (define scmoutput "raylib.scm") 11 | 12 | (define xml (call-with-input-file xml-file 13 | (lambda (port) (xml->sxml port)))) 14 | 15 | (define raylibAPI (filter pair? (cddr (assoc 'raylibAPI (cdr xml))))) 16 | 17 | ;; structs is of the form ((name (field . value) ...) ...) 18 | (define structs 19 | (map (lambda (struct) 20 | (cons (cadr (assoc 'name (cdadr struct))) 21 | (map (lambda (value) 22 | (cons (cadr (assoc 'name (cdadr value))) 23 | (cadr (assoc 'type (cdadr value))))) 24 | (filter pair? (cddr struct))))) 25 | (filter pair? (cddr (assoc 'Structs raylibAPI))))) 26 | 27 | (define struct-names (map car structs)) 28 | 29 | ;; these structs are still available, but there are no accessors for them. 30 | (define struct-blacklist 31 | '("Image" 32 | "Mesh" 33 | "Shader" 34 | "Model" 35 | "ModelAnimation" 36 | "Wave" 37 | "AudioStream" 38 | "Music" 39 | "VrDeviceInfo" 40 | "VrStereoConfig" 41 | "Font" 42 | "Material" 43 | "BoneInfo" 44 | "FilePathList" 45 | "AutomationEvent" 46 | "AutomationEventList")) 47 | 48 | (set! structs (filter (lambda (s) (not (member (car s) struct-blacklist))) 49 | structs)) 50 | 51 | (define custom-struct-constructors 52 | '(("Matrix" . "(define (make-Matrix m0 m4 m8 m12 m1 m5 m9 m13 m2 m6 m10 m14 m3 m7 m11 m15) 53 | (define m (construct-Matrix)) 54 | (Matrix-set-m0! m m0) 55 | (Matrix-set-m1! m m1) 56 | (Matrix-set-m2! m m2) 57 | (Matrix-set-m3! m m3) 58 | (Matrix-set-m4! m m4) 59 | (Matrix-set-m5! m m5) 60 | (Matrix-set-m6! m m6) 61 | (Matrix-set-m7! m m7) 62 | (Matrix-set-m8! m m8) 63 | (Matrix-set-m9! m m9) 64 | (Matrix-set-m10! m m10) 65 | (Matrix-set-m11! m m11) 66 | (Matrix-set-m12! m m12) 67 | (Matrix-set-m13! m m13) 68 | (Matrix-set-m14! m m14) 69 | (Matrix-set-m15! m m15) 70 | m)"))) 71 | 72 | ;; enums is of the form ((name (variant . value) ...) ...) 73 | (define enums 74 | (map (lambda (enum) 75 | (cons (cadr (assoc 'name (cdadr enum))) 76 | (map (lambda (value) 77 | (cons (cadr (assoc 'name (cdadr value))) 78 | (string->number (cadr (assoc 'integer (cdadr value)))))) 79 | (filter pair? (cddr enum))))) 80 | (filter pair? (cddr (assoc 'Enums raylibAPI))))) 81 | 82 | ;; these functions don't appear in the generated bindings. 83 | ;; some of them should be re-added when our generation gets smarter, and some will be hand written. 84 | (define fn-blacklist 85 | '("GetWindowHandle" 86 | "SetShaderValue" 87 | "SetShaderValueV" 88 | "TraceLog" 89 | "MemAlloc" 90 | "MemRealloc" 91 | "MemFree" 92 | "SetTraceLogCallback" 93 | "SetLoadFileDataCallback" 94 | "SetSaveFileDataCallback" 95 | "SetLoadFileTextCallback" 96 | "SetSaveFileTextCallback" 97 | "LoadFileData" 98 | "UnloadFileData" 99 | "SaveFileData" 100 | "LoadFileText" 101 | "UnloadFileText" 102 | "SaveFileText" 103 | "GetDirectoryFiles" 104 | "GetDroppedFiles" 105 | "CompressData" 106 | "DecompressData" 107 | "EncodeDataBase64" 108 | "DecodeDataBase64" 109 | "DrawLineStrip" 110 | "DrawTriangleFan" 111 | "DrawTriangleStrip" 112 | "CheckCollisionLines" 113 | "LoadImageAnim" 114 | "LoadImageColors" 115 | "LoadImagePalette" 116 | "UpdateTexture" 117 | "UpdateTextureRec" 118 | "GetPixelColor" 119 | "SetPixelColor" 120 | "LoadFontEx" 121 | "LoadFontFromMemory" 122 | "LoadFontData" 123 | "GenImageFontAtlas" 124 | "LoadCodepoints" 125 | "UnloadCodepoints" 126 | "GetCodepoint" 127 | "CodepointToUTF8" 128 | "TextCodepointsToUTF8" 129 | "TextCopy" 130 | "TextFormat" 131 | "TextJoin" 132 | "TextSplit" 133 | "TextAppend" 134 | "UpdateMeshBuffer" 135 | "LoadMaterials" 136 | "LoadModelAnimations" 137 | "UnloadModelAnimations" 138 | "UpdateSound" 139 | "LoadWaveSamples" 140 | "UnloadWaveSamples" 141 | "UpdateAudioStream" 142 | "LoadUTF8" 143 | "UnloadUTF8" 144 | "DrawTextCodepoints" 145 | "GetCodepointNext" 146 | "GetCodepointPrevious" 147 | "SetAudioStreamCallback" 148 | "AttachAudioStreamProcessor" 149 | "DetachAudioStreamProcessor" 150 | "AttachAudioMixedProcessor" 151 | "DetachAudioMixedProcessor")) 152 | 153 | 154 | ;; functions is of the form ((name rettype (type arg) ...) ...) 155 | (define functions 156 | (filter (lambda (fn) (not (member (car fn) fn-blacklist))) 157 | (map (lambda (fn) 158 | (cons (cadr (assoc 'name (cdadr fn))) 159 | (cons (cadr (assoc 'retType (cdadr fn))) 160 | (map (lambda (arg) 161 | (cons (cadr (assoc 'name (cdadr arg))) 162 | (cadr (assoc 'type (cdadr arg))))) 163 | (filter pair? (cddr fn)))))) 164 | (filter pair? (cddr (assoc 'Functions raylibAPI)))))) 165 | 166 | (define genlocal ((lambda () 167 | (define val 0) 168 | (lambda () 169 | (set! val (+ 1 val)) 170 | (format #f "v~a" val))))) 171 | 172 | ;; TODO: add this to raylib's api parser upstream. 173 | (define (resolve-typedef type) 174 | (define aliases 175 | '(("Quaternion" . "Vector4") 176 | ("Texture2D" . "Texture") 177 | ("TextureCubemap" . "Texture") 178 | ("RenderTexture2D" . "RenderTexture") 179 | ("Camera" . "Camera3D"))) 180 | (define entry (assoc type aliases)) 181 | (if entry (cdr entry) type)) 182 | 183 | (define (sanitize-type type) 184 | (string-replace-substring 185 | (string-replace-substring 186 | (resolve-typedef type) "unsigned " "u") 187 | "const " "")) 188 | 189 | (define (deptr-type type) 190 | (if (and (>= (string-length type) 2) 191 | (string= (substring type (- (string-length type) 2)) " *")) 192 | (substring type 0 (- (string-length type) 2)) 193 | "")) 194 | 195 | (define (scm->c port type expr) 196 | (define stype (sanitize-type type)) 197 | (define dtype (sanitize-type (deptr-type type))) 198 | (cond 199 | ((or (string= stype "char *") (string= stype "uchar *")) 200 | (let ((local (genlocal))) 201 | (format port " char *~a = scm_to_utf8_stringn(~a, NULL);\n scm_dynwind_free(~a);\n" local expr local) 202 | local)) 203 | ((member stype struct-names) 204 | (format port " scm_assert_foreign_object_type(rgtype_~a, ~a);\n" stype expr) 205 | (format #f "(*(~a*)scm_foreign_object_ref(~a, 0))" stype expr)) 206 | ((member dtype struct-names) 207 | (format port " scm_assert_foreign_object_type(rgtype_~a, ~a);\n" dtype expr) 208 | (format #f "scm_foreign_object_ref(~a, 0)" expr)) 209 | ((string= stype "float") (format #f "scm_to_double(~a)" expr)) 210 | ((string-contains type "*") (format #f "scm_to_pointer(~a)" expr)) 211 | (else (format #f "scm_to_~a(~a)" stype expr)))) 212 | 213 | (define (c->scm port type expr) 214 | (define stype (sanitize-type type)) 215 | (define dtype (sanitize-type (deptr-type type))) 216 | (cond 217 | ((or (string= stype "char *") (string= stype "uchar *")) 218 | (format #f "scm_from_utf8_string(~a)" expr)) 219 | ((string= type "void") 220 | (format #f "(~a, SCM_UNSPECIFIED)" expr)) 221 | ((member stype struct-names) 222 | (let ((local (genlocal))) 223 | (format port " void *~a = scm_gc_malloc_pointerless(sizeof(~a), \"raylib-guile ptr\");\n" local stype) 224 | (format port " ~a ~a_data = ~a;\n memcpy(~a, &~a_data, sizeof(~a));\n" 225 | stype local expr local local stype) 226 | (format #f "scm_make_foreign_object_1(rgtype_~a, ~a)" stype local))) 227 | ((string= stype "float") (format #f "scm_from_double(~a)" expr)) 228 | ((string-contains type "*") (format #f "scm_from_pointer(~a, NULL)" expr)) 229 | (else (format #f "scm_from_~a(~a)" stype expr)))) 230 | 231 | (define (generate-function f port) 232 | (format port "SCM rgfun_~a(~{SCM ~a~^, ~}) {\n" (car f) (map car (cddr f))) 233 | (format port " scm_dynwind_begin(0);\n") 234 | (format port " SCM result = ~a;\n" 235 | (c->scm port (cadr f) 236 | (format #f "~a(~{~a~^, ~})" 237 | (car f) 238 | (map (lambda (arg) (scm->c port (cdr arg) (car arg))) 239 | (cddr f))))) 240 | (format port " scm_dynwind_end();\n") 241 | (format port " return result;\n") 242 | (format port "}\n\n")) 243 | 244 | (define (generate-struct-accessors s port) 245 | ;; generate make-struct 246 | (define custom-construct (assoc (car s) custom-struct-constructors)) 247 | (format port "SCM rgacc_make_~a(~{SCM ~a~^, ~}) {\n" (car s) (if custom-construct '() (map car (cdr s)))) 248 | (format port " scm_dynwind_begin(0);\n") 249 | (format port " ~a *rg_data = scm_gc_malloc_pointerless(sizeof(~a), \"raylib-guile ptr\");\n" (car s) (car s)) 250 | (unless custom-construct 251 | (format port "~:{ rg_data->~a = ~a;\n~}" 252 | (map (lambda (field) 253 | (list (car field) 254 | (scm->c port (cdr field) (car field)))) 255 | (cdr s)))) 256 | 257 | (format port " SCM result = scm_make_foreign_object_1(rgtype_~a, rg_data);\n" (car s)) 258 | (format port " scm_dynwind_end();\n") 259 | (format port " return result;\n") 260 | (format port "}\n\n") 261 | ;; generate getters 262 | (for-each 263 | (lambda (field) 264 | (format port "SCM rgacc_~a_~a(SCM _obj) {\n" (car s) (car field)) 265 | (format port " return ~a;\n" 266 | ;; this will sometimes copy a struct when it could just wrap the 267 | ;; pointer. this is probably safer for the GC, but might become a performance issue. 268 | ;;(c->scm port (cdr field) (format #f "((~a *)scm_foreign_object_ref(_obj, 0))->~a" 269 | ;; (car s) (car field)))) 270 | (c->scm port (cdr field) (format #f "~a.~a" (scm->c port (car s) "_obj") (car field)))) 271 | (format port "}\n\n")) 272 | (cdr s)) 273 | ;; generate setters 274 | (for-each 275 | (lambda (field) 276 | (format port "SCM rgacc_~a_set_~a(SCM _obj, SCM ~a) {\n" (car s) (car field) (car field)) 277 | (format port " ~a.~a = ~a;\n" 278 | (scm->c port (car s) "_obj") 279 | (car field) 280 | (scm->c port (cdr field) (car field))) 281 | (format port " return SCM_UNSPECIFIED;\n") 282 | (format port "}\n\n")) 283 | (cdr s))) 284 | 285 | 286 | (define (accessor-names structs) 287 | (fold append '() 288 | (map (lambda (struct) 289 | (define custom-construct (assoc (car struct) custom-struct-constructors)) 290 | `(,(list (format #f "~a-~a" (if custom-construct "construct" "make") (car struct)) 291 | (if custom-construct 0 (length (cdr struct))) 292 | (format #f "rgacc_make_~a" (car struct))) 293 | ,@(map (lambda (field) (list (format #f "~a-~a" (car struct) (car field)) 294 | 1 295 | (format #f "rgacc_~a_~a" (car struct) (car field)))) 296 | (cdr struct)) 297 | ,@(map (lambda (field) (list (format #f "~a-set-~a!" (car struct) (car field)) 298 | 2 299 | (format #f "rgacc_~a_set_~a" (car struct) (car field)))) 300 | (cdr struct)))) 301 | structs))) 302 | 303 | (define (declare-struct name port) 304 | (format port " rgtype_~a = scm_make_foreign_object_type(scm_from_utf8_symbol(\"~a\"), slots, NULL);\n" 305 | name name)) 306 | 307 | (define (declare-accessors structs port) 308 | (for-each (lambda (accessor) 309 | (apply format port " scm_c_define_gsubr(\"~a\", ~a, 0, 0, ~a);\n" accessor)) 310 | (accessor-names structs))) 311 | 312 | (define (declare-function f port) 313 | (format port " scm_c_define_gsubr(\"~a\", ~a, 0, 0, rgfun_~a);\n" 314 | (car f) (length (cddr f)) (car f))) 315 | 316 | (define raylib-colors 317 | '((LIGHTGRAY 200 200 200 255) 318 | (GRAY 130 130 130 255) 319 | (DARKGRAY 80 80 80 255) 320 | (YELLOW 253 249 0 255) 321 | (GOLD 255 203 0 255) 322 | (ORANGE 255 161 0 255) 323 | (PINK 255 109 194 255) 324 | (RED 230 41 55 255) 325 | (MAROON 190 33 55 255) 326 | (GREEN 0 228 48 255) 327 | (LIME 0 158 47 255) 328 | (DARKGREEN 0 117 44 255) 329 | (SKYBLUE 102 191 255 255) 330 | (BLUE 0 121 241 255) 331 | (DARKBLUE 0 82 172 255) 332 | (PURPLE 200 122 255 255) 333 | (VIOLET 135 60 190 255) 334 | (DARKPURPLE 112 31 126 255) 335 | (BEIGE 211 176 131 255) 336 | (BROWN 127 106 79 255) 337 | (DARKBROWN 76 63 47 255) 338 | (WHITE 255 255 255 255) 339 | (BLACK 0 0 0 255) 340 | (BLANK 0 0 0 0) 341 | (MAGENTA 255 0 255 255) 342 | (RAYWHITE 245 245 245 255))) 343 | 344 | ;; generate c guile bindings 345 | (call-with-output-file coutput 346 | (lambda (port) 347 | (format port "#include \n#include \n#include \n") 348 | 349 | (format port "\n// struct slots\n") 350 | (for-each (lambda (s) (format port "static SCM rgtype_~a;\n" s)) struct-names) 351 | 352 | (format port "\n// struct accessors\n") 353 | (for-each (lambda (s) (generate-struct-accessors s port)) structs) 354 | 355 | (format port "\n// function definitions\n") 356 | (for-each (lambda (f) (generate-function f port)) functions) 357 | 358 | (format port "\n// guile extension entry point\n") 359 | (format port "void init_raylib_guile(void) {\n") 360 | (format port " // expose raylib structs to guile\n") 361 | (format port " SCM slots = scm_list_1 (scm_from_utf8_symbol (\"data\"));\n") 362 | (for-each (lambda (s) (declare-struct s port)) struct-names) 363 | (format port " // expose raylib accessors to guile\n") 364 | (declare-accessors structs port) 365 | (format port " // expose raylib functions to guile\n") 366 | (for-each (lambda (f) (declare-function f port)) functions) 367 | (format port "}\n"))) 368 | 369 | ;; generate guile module 370 | (call-with-output-file scmoutput 371 | (lambda (port) 372 | (format port "(define-module (raylib)\n #:export (") 373 | (format port "~a" (caar functions)) 374 | (for-each (lambda (f) (format port "\n ~a" (car f))) (cdr functions)) 375 | (for-each (lambda (e) 376 | (for-each (lambda (v) (format port "\n ~a" (car v))) 377 | (cdr e))) 378 | enums) 379 | (for-each (lambda (acc) (format port "\n ~a" (car acc))) (accessor-names structs)) 380 | (for-each (lambda (c) (format port "\n make-~a" (car c))) custom-struct-constructors) 381 | (for-each (lambda (color) (format port "\n ~a" (car color))) raylib-colors) 382 | (format port "))\n\n") 383 | (format port "(load-extension \"libraylib-guile\" \"init_raylib_guile\")\n\n") 384 | (for-each (lambda (c) 385 | (format port "~a\n" (cdr c))) 386 | custom-struct-constructors) 387 | (for-each (lambda (e) 388 | (for-each (lambda (v) (format port "(define ~a ~a)\n" (car v) (cdr v))) 389 | (cdr e))) 390 | enums) 391 | (for-each (lambda (color) 392 | (format port "(define ~a (make-Color~:{ ~a~}))\n" 393 | (car color) (map list (cdr color)))) 394 | raylib-colors))) 395 | --------------------------------------------------------------------------------