├── .distignore ├── .gitignore ├── LICENSE ├── README.md ├── distrib ├── distribution.lisp └── epilogue.lisp ├── docs ├── bodge.lisp ├── doc-entry.template ├── gamekit.lisp ├── packages.lisp └── renderer.lisp ├── src ├── assets │ └── NotoSans-Regular.ttf ├── gamekit.lisp ├── packages.lisp ├── resources.lisp └── utils.lisp └── trivial-gamekit.asd /.distignore: -------------------------------------------------------------------------------- 1 | ^\..* 2 | \/\..* -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # lisp junk 2 | *.FASL 3 | *.fasl 4 | *.lisp-temp 5 | 6 | # emacs junk 7 | \#* 8 | *~ 9 | .\#* 10 | 11 | # system dependent junk 12 | local/ 13 | 14 | # macOS junk 15 | **/.DS_Store 16 | 17 | # build 18 | build/ -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2016-2019 Pavel Korolev 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # trivial-gamekit 2 | 3 | Library for getting into gamedev with Common Lisp! Very simple interface to graphics, audio and input. 4 | 5 | 6 | ## Requirements 7 | 8 | * OpenGL 2.1 or 3.3+ 9 | * 64-bit (x86_64) Windows, GNU/Linux or macOS 10 | * x86_64 SBCL or CCL 11 | 12 | 13 | ## Installation and loading 14 | 15 | By default, `trivial-gamekit` works in OpenGL 3.3 mode. To enable OpenGL 2.1 you need to 16 | ```lisp 17 | (pushnew :bodge-gl2 *features*) 18 | ``` 19 | 20 | ```lisp 21 | ;; add cl-bodge distribution into quicklisp 22 | (ql-dist:install-dist "http://bodge.borodust.org/dist/org.borodust.bodge.txt") 23 | 24 | ;; load the gamekit 25 | (ql:quickload :trivial-gamekit) 26 | ``` 27 | 28 | 29 | ## Example 30 | 31 | Copy-paste these into your Common Lisp REPL after loading `trivial-gamekit`: 32 | 33 | ```lisp 34 | (gamekit:defgame example () ()) 35 | 36 | (defmethod gamekit:draw ((this example)) 37 | (gamekit:draw-text "Hello, Gamedev!" (gamekit:vec2 240.0 240.0))) 38 | 39 | (gamekit:start 'example) 40 | ``` 41 | 42 | 43 | ## Documentation 44 | 45 | See `trivial-gamekit` external [documentation](https://borodust.org/projects/trivial-gamekit/). 46 | 47 | 48 | ## Help 49 | 50 | `#lispgames` or [`#cl-bodge`](https://web.libera.chat/gamja/?channel=#cl-bodge) at `irc.libera.chat:6697` 51 | -------------------------------------------------------------------------------- /distrib/distribution.lisp: -------------------------------------------------------------------------------- 1 | (cl:defpackage :trivial-gamekit.distribution 2 | (:nicknames :gamekit.distribution) 3 | (:use :cl) 4 | (:export deliver)) 5 | (cl:in-package :trivial-gamekit.distribution) 6 | 7 | 8 | (defun deliver (system-name game-class &key build-directory (zip ge.dist:*zip*) (lisp ge.dist:*lisp*)) 9 | 10 | (let ((game-class-instance (find-class game-class nil))) 11 | (unless game-class-instance 12 | (error "Class with name ~A not found" game-class)) 13 | (unless (subtypep game-class-instance 'gamekit::gamekit-system) 14 | (error "~A is not a gamekit instance class" game-class))) 15 | (apply #'trivial-gamekit::%mount-resources (trivial-gamekit::list-all-resources)) 16 | (let ((game-class-package (make-symbol (package-name (symbol-package game-class)))) 17 | (game-class-name (make-symbol (symbol-name game-class))) 18 | (ge.dist:*zip* zip) 19 | (ge.dist:*lisp* lisp)) 20 | (ge.dist:register-distribution system-name "trivial-gamekit::main" 21 | :asset-containers '(("/_gamekit/" "gamekit.brf") 22 | ("/_asset/" "assets.brf")) 23 | :epilogue (asdf:system-relative-pathname :trivial-gamekit 24 | "distrib/epilogue.lisp") 25 | :bindings (list 26 | (cons '*gamekit-game-class* 27 | ``(,',game-class-package ,',game-class-name)))) 28 | (ge.dist:make-distribution system-name :build-directory build-directory))) 29 | -------------------------------------------------------------------------------- /distrib/epilogue.lisp: -------------------------------------------------------------------------------- 1 | (cl:in-package :cl-user) 2 | 3 | 4 | (declaim (special *gamekit-game-class*)) 5 | 6 | 7 | (defun %find-game-class () 8 | (let ((package (find-package (first *gamekit-game-class*)))) 9 | (find-symbol (symbol-name (second *gamekit-game-class*)) package))) 10 | 11 | 12 | (defun trivial-gamekit::main () 13 | (let ((game-class (%find-game-class))) 14 | (gamekit:start game-class :blocking t))) 15 | 16 | 17 | (defun mount-containers () 18 | (ge.rsc:mount-container "/_gamekit/" 19 | (ge.ng:merge-working-pathname "assets/gamekit.brf") 20 | "/_gamekit/") 21 | (ge.rsc:mount-container "/_asset/" 22 | (ge.ng:merge-working-pathname "assets/assets.brf") 23 | "/_asset/")) 24 | 25 | (pushnew #'mount-containers ge.ng:*engine-startup-hooks*) 26 | -------------------------------------------------------------------------------- /docs/bodge.lisp: -------------------------------------------------------------------------------- 1 | (cl:defpackage :trivial-gamekit.documentation 2 | (:nicknames :gamekit.documentation) 3 | (:use :cl :gamekit :gamekit.distribution :trivial-docstring) 4 | (:export render-documentation)) 5 | (cl:in-package :trivial-gamekit.documentation) 6 | 7 | #| 8 | (docstring #' 9 | " 10 | 11 | Example: 12 | ```common-lisp 13 | ```") 14 | |# 15 | 16 | (docstring #'vec2 17 | "Makes a two-dimensional vector. 18 | 19 | Example: 20 | ```common-lisp 21 | (gamekit:vec2 0 0) 22 | ```") 23 | 24 | (docstring #'vec3 25 | "Makes a three-dimensional vector. 26 | 27 | Example: 28 | ```common-lisp 29 | (gamekit:vec3 1 1 2) 30 | ```") 31 | 32 | (docstring #'vec4 33 | "Makes a four-dimensional vector. 34 | 35 | Example: 36 | ```common-lisp 37 | (gamekit:vec4 1 1 2 3) 38 | ```") 39 | 40 | (docstring #'x 41 | "Reads first element of a vector. 42 | 43 | Example: 44 | ```common-lisp 45 | (gamekit:x (gamekit:vec2 1 1)) 46 | ```") 47 | 48 | (docstring #'(setf x) 49 | "Stores first element of a vector. 50 | 51 | Example: 52 | ```common-lisp 53 | (setf (gamekit:x (gamekit:vec2 1 1)) 0) 54 | ```") 55 | 56 | (docstring #'y 57 | "Reads second element of a vector. 58 | 59 | Example: 60 | ```common-lisp 61 | (gamekit:y (gamekit:vec2 1 1)) 62 | ```") 63 | 64 | (docstring #'(setf y) 65 | "Stores second element of a vector. 66 | 67 | Example: 68 | ```common-lisp 69 | (setf (gamekit:y (gamekit:vec2 1 1)) 0) 70 | ```") 71 | 72 | (docstring #'z 73 | "Reads third element of a vector. 74 | 75 | Example: 76 | ```common-lisp 77 | (gamekit:z (gamekit:vec4 1 1 2 3)) 78 | ```") 79 | 80 | (docstring #'(setf z) 81 | "Stores third element of a vector. 82 | 83 | Example: 84 | ```common-lisp 85 | (setf (gamekit:z (gamekit:vec4 1 1 2 3)) 0) 86 | ```") 87 | 88 | (docstring #'w 89 | "Reads fourth element of a vector. 90 | 91 | Example: 92 | ```common-lisp 93 | (gamekit:w (gamekit:vec4 1 1 2 3)) 94 | ```") 95 | 96 | (docstring #'(setf w) 97 | "Stores fourth element of a vector. 98 | 99 | Example: 100 | ```common-lisp 101 | (setf (gamekit:w (gamekit:vec4 1 1 2 3)) 0) 102 | ```") 103 | 104 | (docstring #'mult 105 | "Element-wise multiplication. Accepts both vectors and scalars. 106 | 107 | Example: 108 | ```common-lisp 109 | (gamekit:mult 2 (gamekit:vec2 1 1) 0.5) 110 | ```") 111 | 112 | (docstring #'add 113 | "Element-wise addition. Accepts both vectors and scalars. 114 | 115 | Example: 116 | ```common-lisp 117 | (gamekit:add 1 (gamekit:vec2 1 1) -1) 118 | ```") 119 | 120 | (docstring #'subt 121 | "Element-wise subtraction. Accepts both vectors and scalars. 122 | 123 | Example: 124 | ```common-lisp 125 | (gamekit:subt 1 (gamekit:vec2 1 1) (gamekit:vec2 -1 -1)) 126 | ```") 127 | 128 | (docstring #'div 129 | "Element-wise division. Accepts both vectors and scalars. 130 | 131 | Example: 132 | ```common-lisp 133 | (gamekit:div (gamekit:vec2 1 1) 2 (gamekit:vec2 0.5 0.5)) 134 | ```") 135 | 136 | (docstring #'draw-text 137 | "Draws text on the canvas starting at coordinates passed as second argument. 138 | Use `:fill-color` key parameter to change text's color. To change a font, pass 139 | object created with [`#'make-font`](#gamekit-make-font) via `:font` parameter. 140 | 141 | Example: 142 | ```common-lisp 143 | (gamekit:draw-text \"Hello, Gamekit!\" (gamekit:vec2 11 23) 144 | :fill-color (gamekit:vec4 0 0 0 1) 145 | :font (gamekit:make-font 'example-package::noto-sans 32)) 146 | ```") 147 | 148 | (docstring #'draw-line 149 | "Draws a line starting from coordinates passed as first argument to 150 | coordinates in second parameter. Third parameter is a color to draw a line 151 | with. `:thickness` is a scalar floating point value controlling pixel-width of a 152 | line. 153 | 154 | Example: 155 | ```common-lisp 156 | (gamekit:draw-line (gamekit:vec2 8 5) (gamekit:vec2 32 11) 157 | (gamekit:vec4 1 0.5 0 1) 158 | :thickness 1.5) 159 | ```") 160 | 161 | (docstring #'draw-curve 162 | "Draws a bezier curve from coordinates passed as first argument to coordinates 163 | in second parameter with two control points in third and fourth parameters 164 | accordingly. Fifth argument is a curve's color. `:thickness` is a scalar 165 | floating point value controlling pixel-width of a curve. 166 | 167 | Example: 168 | ```common-lisp 169 | (gamekit:draw-line (gamekit:vec2 8 5) (gamekit:vec2 32 11) 170 | (gamekit:vec2 0 5) (gamekit:vec2 32 0) 171 | (gamekit:vec4 1 0.5 0 1) 172 | :thickness 1.5) 173 | ```") 174 | 175 | (docstring #'draw-rect 176 | "Draws a rectangle with origin passed in first argument, width and height - 177 | second and third arguments accordingly. `:fill-paint` key is a color to fill 178 | insides of a rectangle with. If you pass color to `:stroke-paint`, edges of the 179 | rectangle are going to be struck with it. `:thickness` controls pixel width of 180 | struck edges. Use `:rounding` in pixels to round rectangle corners. 181 | 182 | Example: 183 | ```common-lisp 184 | (gamekit:draw-rect (gamekit:vec2 0 0) 314 271 185 | :fill-paint (gamekit:vec4 1 0.75 0.5 0.5) 186 | :stroke-paint (gamekit:vec4 0 0 0 1) 187 | :rounding 5.0) 188 | ```") 189 | 190 | (docstring #'draw-circle 191 | "Draws a circle with center in first argument and radius in second argument. 192 | Provide color with `:fill-paint` paramater to fill the inner area of the circle 193 | with. If `:stroke-paint` color is provided, circle's border is going to be 194 | struck with it. `:thickness` controls pixel width of struck border. 195 | 196 | Example: 197 | ```common-lisp 198 | (gamekit:draw-circle (gamekit:vec2 100 500) 3/4 199 | :fill-paint (gamekit:vec4 1 1 1 1) 200 | :stroke-paint (gamekit:vec4 0 0 0 1) 201 | :thickness 3) 202 | ```") 203 | 204 | (docstring #'draw-ellipse 205 | "Draws an ellipse with center provided in first argument, x and y radii as 206 | second and thrid arguments accordingly. Pass a color as `:fill-paint` paramater 207 | to fill the inner area of the ellipse with. If `:stroke-paint` color is 208 | provided, ellipse's border will be struck with it. `:thickness` controls pixel 209 | width of struck border. 210 | 211 | Example: 212 | ```common-lisp 213 | (gamekit:draw-ellipse (gamekit:vec2 128 128) 16 32 214 | :fill-paint (gamekit:vec4 0 0 0 1) 215 | :stroke-paint (gamekit:vec4 1 1 1 1) 216 | :thickness 1.1) 217 | ```") 218 | 219 | (docstring #'draw-arc 220 | "Draws an arc from `a0` to `a1` angles (in radians) with center passed in 221 | first argument and radius in second. If provided, color in `:fill-paint` will be 222 | used to fill the area under an arc confined between a circle's curve and a line 223 | connecting angle points. `:fill-paint` and `:stroke-paint` colors are, if 224 | provided, used to fill insides and stroke arc's border correspondingly. 225 | 226 | Example: 227 | ```common-lisp 228 | (gamekit:draw-arc (gamekit:vec2 256 256) 128 229 | (/ pi 4) (* (/ pi 2) 1.5) 230 | :fill-paint (gamekit:vec4 0.25 0.5 0.75 1) 231 | :stroke-paint (gamekit:vec4 0.75 0.5 0.25 1) 232 | :thickness 2.0) 233 | ```") 234 | 235 | (docstring #'draw-polygon 236 | "Draws a polygon connecting list of vertices provided in first 237 | argument. `:fill-paint` is a color to fill insides of a polygon and 238 | `:stroke-paint` color is used to stroke polygon edges. `:thickness` controls 239 | pixel-width of a stroke. 240 | 241 | Example: 242 | ```common-lisp 243 | (gamekit:draw-polygon (list (gamekit:vec2 10 10) (gamekit:vec2 20 20) 244 | (gamekit:vec2 30 20) (gamekit:vec2 20 10)) 245 | :fill-paint (gamekit:vec4 0.25 0.5 0.75 1) 246 | :stroke-paint (gamekit:vec4 0.75 0.5 0.25 1) 247 | :thickness 3.0) 248 | ```") 249 | 250 | (docstring #'draw-polyline 251 | "Draws a polyline connecting list of vertices provided in first 252 | argument. Second argument is a color to stroke a line with. `:thickness` 253 | controls pixel width of a line. 254 | 255 | Example: 256 | ```common-lisp 257 | (gamekit:draw-polyline (list (gamekit:vec2 10 10) (gamekit:vec2 20 20) 258 | (gamekit:vec2 30 20) (gamekit:vec2 20 10)) 259 | (gamekit:vec4 0.75 0.5 0.25 1) 260 | :thickness 3.0) 261 | ```") 262 | 263 | (docstring #'draw-image 264 | "Draws an image at coordinates specified in first argument. Second argument is 265 | `image-id` used in [`#'define-image`](#gamekit-define-image) earlier. Optional 266 | `:origin` key is a point within image to start drawing from, if you want to 267 | render only a part of image. `:width` and `:height` keys tell width and height 268 | of a subimage to draw. They are optional and could be skipped to draw a subimage 269 | with full height and width available. 270 | 271 | Example: 272 | ```common-lisp 273 | (gamekit:draw-image (gamekit:vec2 314 271) 'example-package::logo 274 | :origin (gamekit:vec2 0 0) 275 | :width 320 276 | :height 240) 277 | ```") 278 | 279 | (docstring #'translate-canvas 280 | "Moves drawing origin to the specified position making the latter a new 281 | origin. All following draw operations will be affected by this change unless 282 | wrapped with [`with-pushed-canvas`](#gamekit-with-pushed-canvas) macro. 283 | 284 | Example: 285 | ```common-lisp 286 | (gamekit:translate-canvas 100 500) 287 | ```") 288 | 289 | (docstring #'rotate-canvas 290 | "Rotates current canvas for specified number of radians. All following drawing 291 | operations will be affected by this change unless wrapped with 292 | [`with-pushed-canvas`](#gamekit-with-pushed-canvas) macro. 293 | 294 | Example: 295 | ```common-lisp 296 | (gamekit:rotate-canvas (/ pi 2)) 297 | ```") 298 | 299 | (docstring #'scale-canvas 300 | "Scales current canvas by x and y axes accordingly. All following drawing 301 | operations will be affected by this change unless wrapped with 302 | [`with-pushed-canvas`](#gamekit-with-pushed-canvas) macro. 303 | 304 | Example: 305 | ```common-lisp 306 | (gamekit:scale-canvas 0.5 1.5) 307 | ```") 308 | -------------------------------------------------------------------------------- /docs/doc-entry.template: -------------------------------------------------------------------------------- 1 | *{{type}}* ***`{{name}}`*** `{{lambda-list}}` 2 | {: {{link}}} 3 |
4 | {{documentation}} 5 |
6 | -------------------------------------------------------------------------------- /docs/gamekit.lisp: -------------------------------------------------------------------------------- 1 | (cl:in-package :trivial-gamekit.documentation) 2 | 3 | 4 | (docstring (macro-function 'defgame) 5 | "Defines a game class that can be passed to [`#'start`](#gamekit-start) to run 6 | a game. `name` is the name of a class generated. `classes` are names of 7 | superclasses, `slots` - standard class slots and `opts` are class options. So, 8 | pretty much standard class definition except it does configure a class in 9 | certain ways specifically for `gamekit` use and allows passing additional 10 | options in `opts` apart from standard `:documentation`, `:default-initargs` and 11 | so others. 12 | 13 | Additional options that can be passed in `opts` are: 14 | 15 | * `:viewport-width` - width of the window and canvas 16 | * `:viewport-height` - height of the window and canvas 17 | * `:viewport-title` - title of the window 18 | * `:prepare-resources` - boolean value that indicates whether `gamekit` should 19 | load resources automatically on startup or if not, user prefers to load them dynamically on request. Defaults to `t`. 20 | 21 | Example: 22 | 23 | ```common-lisp 24 | \(gamekit:defgame example () 25 | ;; some game related state 26 | ((world :initform (make-instance 'world)) 27 | (game-state)) 28 | ;; options 29 | (:viewport-width 800) 30 | (:viewport-height 600) 31 | (:viewport-title \"EXAMPLE\") 32 | (:prepare-resources nil)) 33 | ```") 34 | 35 | 36 | (docstring #'gamekit 37 | "Returns instance of a running game or `nil` if no game is started yet. 38 | 39 | Example: 40 | ```common-lisp 41 | (gamekit:gamekit) 42 | ```") 43 | 44 | 45 | (docstring #'act 46 | "Called every game loop iteration for user to add any per-frame behavior to 47 | the game. NOTE: all drawing operations should be performed in 48 | [`#'draw`](#gamekit-draw) method. 49 | 50 | Example: 51 | ```common-lisp 52 | (defmethod gamekit:act ((this example)) 53 | (report-fps)) 54 | ```") 55 | 56 | 57 | (docstring #'draw 58 | "Called every game loop iteration for frame rendering. 59 | All drawing operations should be performed in this method. 60 | 61 | Example: 62 | ```common-lisp 63 | (defmethod gamekit:draw ((this example)) 64 | (gamekit:draw-text \"Hello, Gamedev!\" (gamekit:vec2 10 10))) 65 | ```") 66 | 67 | 68 | (docstring #'post-initialize 69 | "This function is called after game instance is fully initialized, right 70 | before main game loop starts its execution. Put initialization code for your 71 | application into method of this function. For example, it would be logical to 72 | bind input via [`#'bind-cursor`](#gamekit-bind-cursor) or 73 | [`#'bind-button`](#gamekit-bind-button) here. 74 | 75 | Example: 76 | ```common-lisp 77 | \(defmethod gamekit:post-initialize ((this example)) 78 | (init-game) 79 | (bind-input)) 80 | ```") 81 | 82 | 83 | (docstring #'pre-destroy 84 | "This function is called just before shutting down a game instance for you to 85 | free all acquired resources and do any other clean up procedures. 86 | 87 | Example: 88 | ```common-lisp 89 | (defmethod gamekit:pre-destroy ((this example)) 90 | (release-foreign-memory) 91 | (stop-threads)) 92 | ```") 93 | 94 | 95 | (docstring #'notice-resources 96 | "Called when resource names earlier requested with 97 | [`#'prepare-resources`](#gamekit-prepare-resources) which indicates those 98 | resources are ready to be used. 99 | 100 | Override this generic function to know when resources are ready. 101 | 102 | Example: 103 | ```common-lisp 104 | (defmethod gamekit:notice-resources ((this example) &rest resource-names) 105 | (declare (ignore resource-names)) 106 | (gamekit:play-sound 'example-package::blop) 107 | (show-start-screen)) 108 | ```") 109 | 110 | 111 | (docstring #'prepare-resources 112 | "Loads and prepares resources for later usage asynchronously. `resource-names` 113 | should be symbols used previously registered with `define-*` macros. 114 | 115 | This function returns immediately. When resources are ready for use 116 | [`#'notice-resources`](#gamekit-notice-resources) will be called with names that 117 | were passed to this function. 118 | 119 | `gamekit` by default will try to load and prepare all registered resources on 120 | startup which might take a substantial time, but then you don't need to call 121 | #'prepare-resources yourself. If you prefer load resources on demand and have a 122 | faster startup time, pass nil to :prepare-resources option of a 123 | [`defgame`](#gamekit-defgame) macro which will disable startup resource 124 | autoloading. 125 | 126 | Example: 127 | ```common-lisp 128 | (gamekit:prepare-resources 'example-package::noto-sans 129 | 'example-package::blop 130 | 'example-package::logo) 131 | ```") 132 | 133 | 134 | (docstring #'dispose-resources 135 | "Disposes prepared resources asynchronously. `resource-names` 136 | should be symbols used previously registered with `define-*` macros. 137 | 138 | This function returns immediately. Attempts to use disposed resources will raise 139 | an error. To use resources again you would need to load them with 140 | [`#'prepare-resources`](#gamekit-prepare-resources). 141 | 142 | Example: 143 | ```common-lisp 144 | (gamekit:dispose-resources 'example-package::noto-sans 145 | 'example-package::blop 146 | 'example-package::logo) 147 | ```") 148 | 149 | 150 | (docstring #'bind-button 151 | "Binds `action` to specified `key` `state`. When key state changes to the one specified, 152 | action callback is invoked with no arguments. `#'bind-button` function should be 153 | called when there's active game exists started earlier with 154 | [`#'start`](#gamekit-start). `state` can be either `:pressed`, `:released` or 155 | `:repeating`. 156 | 157 | Actions are not stacked together and would be overwritten for the same key and state. 158 | 159 | Can only be called when gamekit instance is active (started). 160 | 161 | Supported keys: 162 | ```common-lisp 163 | :space :apostrophe :comma :minus :period :slash 164 | :0 :1 :2 :3 :4 :5 :6 :7 :8 :9 165 | :semicolon :equal 166 | :a :b :c :d :e :f :g :h :i :j :k :l :m 167 | :n :o :p :q :r :s :t :u :v :w :x :y :z 168 | :left-bracket :backslash :right-bracket 169 | :grave-accent :world-1 :world-2 170 | :escape :enter :tab :backspace :insert :delete 171 | :right :left :down :up 172 | :page-up :page-down :home :end 173 | :caps-lock :scroll-lock :num-lock :print-screen :pause 174 | :f1 :f2 :f3 :f4 :f5 :f6 :f7 :f8 :f9 :f10 :f11 :f12 175 | :f13 :f14 :f15 :f16 :f17 :f18 :f19 :f20 :f21 :f22 :f23 :f24 :f25 176 | :keypad-0 :keypad-1 :keypad-2 :keypad-3 :keypad-4 177 | :keypad-5 :keypad-6 :keypad-7 :keypad-8 :keypad-9 178 | :keypad-decimal :keypad-divide :keypad-multiply 179 | :keypad-subtract :keypad-add :keypad-enter :keypad-equal 180 | :left-shift :left-control :left-alt :left-super 181 | :right-shift :right-control :right-alt :right-super 182 | :menu 183 | 184 | :mouse-left :mouse-right :mouse-middle 185 | ``` 186 | 187 | Example 188 | ```common-lisp 189 | \(gamekit:bind-button :enter :pressed 190 | (lambda () 191 | (start-game-for *player*))) 192 | ```") 193 | 194 | 195 | (docstring #'bind-any-button 196 | "Binds `action` to all buttons. When key state changes, action callback is 197 | invoked with two arguments: button as a first and its new state as a second 198 | argument. 199 | 200 | Can only be called when gamekit instance is active (started via 201 | [`#'start`](#gamekit-start)). 202 | 203 | For possible values for button and state parameters see documentation for 204 | [`#'bind-button`](#gamekit-bind-button) function. 205 | 206 | Actions provided to this function are not stacked together and would be 207 | overwritten each time the function is called. 208 | 209 | 210 | Example 211 | ```common-lisp 212 | (gamekit:bind-any-button (lambda (button state) 213 | (when (and (eq button :space) (eq state :pressed)) 214 | (shoot *player*)))) 215 | ```") 216 | 217 | 218 | (docstring #'bind-cursor 219 | "Binds action callback to a cursor movement event. Everytime user moves a 220 | cursor callback will be called with x and y of cursor coordinates within the 221 | same coordinate system canvas is defined in: bottom left corner as (0,0) origin 222 | and y-axis pointing upwards. 223 | 224 | Actions doesn't stack together and would be overwritten each time 225 | `#'bind-cursor` is called. 226 | 227 | Can only be called when gamekit instance is active (started). 228 | 229 | Example: 230 | ```common-lisp 231 | (gamekit:bind-cursor (lambda (x y) 232 | (shoot-to x y))) 233 | ```") 234 | 235 | 236 | (docstring #'play-sound 237 | "Plays a sound defined earlier with [`define-sound`](#gamekit-define-sound). Pass `t` to 238 | `:looped-p` key to play sound in a loop. 239 | 240 | Example: 241 | ```common-lisp 242 | (gamekit:play-sound 'example-package::blop 243 | :looped-p t) 244 | ```") 245 | 246 | 247 | (docstring #'stop-sound 248 | "Stops a playing sound by provided sound id. 249 | 250 | Example: 251 | ```common-lisp 252 | (gamekit:stop-sound 'example-package::blop) 253 | ```") 254 | 255 | 256 | (docstring #'play 257 | "Deprecated. Use #'play-sound instead") 258 | 259 | 260 | (docstring #'make-font 261 | "Makes a font instance that can be later passed to [`#'draw-text`](#gamekit-draw-text) to 262 | customize text looks. `font-id` must be a valid resource name previously registered with 263 | [`define-font`](#gamekit-define-font). Second argument is a font size in pixels. 264 | 265 | Example: 266 | ```common-lisp 267 | (gamekit:make-font 'example-package::noto-sans 32) 268 | ```") 269 | 270 | 271 | (docstring #'calc-text-bounds 272 | "Calculates text bounds with the font provided or the default one otherwise and returns 273 | several values: origin as vec2, width, height and calculated advance 274 | 275 | Example: 276 | ```common-lisp 277 | \(gamekit:calc-text-bounds \"hello there\"\) 278 | ```") 279 | 280 | 281 | (docstring #'print-text 282 | "Deprecated. Use #'draw-text instead") 283 | 284 | 285 | (docstring #'start 286 | "Bootsraps a game allocating a window and other system resources. Instantiates 287 | game object defined with [`defgame`](#gamekit-defgame) which can be obtained via 288 | [`#'gamekit`](#gamekit-gamekit). Cannot be called twice - 289 | [`#'stop`](#gamekit-stop) should be called first before running `start` again. 290 | 291 | Example: 292 | 293 | ```common-lisp 294 | \(gamekit:start 'example\) 295 | ```") 296 | 297 | 298 | (docstring #'stop 299 | "Stops currently running game releasing acquired resources. 300 | 301 | Example: 302 | ```common-lisp 303 | \(gamekit:stop\) 304 | ```") 305 | 306 | 307 | (docstring #'register-resource-package 308 | "Associates resource package with filesystem path. For proper resource 309 | handling it is recommended to put it as a top-level form, so resources could be 310 | located at load-time. 311 | 312 | First argument, a package name, must be a valid Common Lisp package name that 313 | could be used to locate package via #'find-package. Second argument is a 314 | filesystem path to a directory where resources can be found. 315 | 316 | Example: 317 | ```common-lisp 318 | (gamekit:register-resource-package :example-package 319 | \"/home/gamdev/example-game/assets/\") 320 | ```") 321 | 322 | 323 | (docstring (macro-function 'define-image) 324 | "Registers image resource by name that can be used by 325 | [`#'draw-image`](#gamekit-draw-image) later. Second argument is a valid path to 326 | the resource. Only .png images are supported at this moment. 327 | 328 | Name must be a symbol. Package of that symbol and its associated path (via 329 | [`#'register-resource-package`](#gamekit-register-resource-package)) will be 330 | used to locate the resource, if relative path is given as an argument to this 331 | macro. 332 | 333 | Example: 334 | ```common-lisp 335 | (gamekit:define-image example-package::logo \"images/logo.png\") 336 | ```") 337 | 338 | 339 | (docstring (macro-function 'define-sound) 340 | "Registers sound resource by name that can be used by [`#'play-sound`](#gamekit-play-sound) later. 341 | Second argument is a valid path to the resource. Formats supported: .wav, 342 | .ogg (Vorbis), .flac, .aiff. 343 | 344 | Name must be a symbol. Package of that symbol and its associated path (via 345 | [`#'register-resource-package`](#gamekit-register-resource-package)) will be 346 | used to locate the resource, if relative path is given as an argument to this 347 | macro. 348 | 349 | Example: 350 | ```common-lisp 351 | (gamekit:define-sound example-package::blop \"sounds/blop.ogg\") 352 | ```") 353 | 354 | 355 | (docstring (macro-function 'define-font) 356 | "Registers font resource by name that can be passed to [`#'make-font`](#gamekit-make-font) later. 357 | Second argument is a valid path to the resource. Only .ttf format is supported 358 | at this moment. 359 | 360 | Name must be a symbol. Package of that symbol and its associated path (via 361 | [`#'register-resource-package`](#gamekit-register-resource-package)) will be 362 | used to locate the resource, if relative path is given as an argument to this 363 | macro. 364 | 365 | Example: 366 | ```common-lisp 367 | (gamekit:define-font example-package::noto-sans \"fonts/NotoSans-Regular.ttf\") 368 | ```") 369 | 370 | 371 | (docstring (macro-function 'define-text) 372 | "Registers text resource by name that can be retrieved with [`#'get-text`](#gamekit-get-text) later. 373 | Second argument is a valid path to the resource. You can specify encoding via 374 | `:encoding` keywrod argument. `:utf-8` is used by default. 375 | 376 | Name must be a symbol. Package of that symbol and its associated path (via 377 | [`#'register-resource-package`](#gamekit-register-resource-package)) will be 378 | used to locate the resource, if relative path is given as an argument to this 379 | macro. 380 | 381 | Example: 382 | ```common-lisp 383 | (gamekit:define-text example-package::example-text \"dialog.txt\" :encoding :utf-8) 384 | ```") 385 | 386 | 387 | (docstring (macro-function 'define-binary) 388 | "Registers binary resource by name that can be retrieved with [`#'get-binary`](#gamekit-get-binary) later. 389 | Second argument is a valid path to the resource. 390 | 391 | Name must be a symbol. Package of that symbol and its associated path (via 392 | [`#'register-resource-package`](#gamekit-register-resource-package)) will be 393 | used to locate the resource, if relative path is given as an argument to this 394 | macro. 395 | 396 | Example: 397 | ```common-lisp 398 | (gamekit:define-binary example-package::example-blob \"blob.data\") 399 | ```") 400 | 401 | 402 | (docstring (macro-function 'with-pushed-canvas) 403 | "Saves current canvas transformations (translations, rotations, scales) before 404 | entering its body and restores previous transformations upon exit from the 405 | body. All transformation operations within this macro don't affect outer canvas 406 | transformations outside of a body of this macro. 407 | 408 | Example: 409 | ```common-lisp 410 | (gamekit:translate-canvas 400 300) 411 | (gamekit:with-pushed-canvas () 412 | (gamekit:rotate-canvas (/ pi 4))) 413 | ```") 414 | 415 | 416 | (docstring #'get-text 417 | "Get text resource (a string) by id. `resource-id` must be a valid resource id 418 | previously registered with [`'define-text`](#gamekit-define-text). 419 | 420 | ```common-lisp 421 | (gamekit:get-text 'example-package::example-text) 422 | ```") 423 | 424 | 425 | (docstring #'get-binary 426 | "Get binary resource (a byte vector) by id. `resource-id` must be a valid 427 | resource id previously registered with [`'define-binary`](#gamekit-define-binary). 428 | 429 | ```common-lisp 430 | (gamekit:get-binary 'example-package::example-blob) 431 | ```") 432 | 433 | 434 | (docstring #'deliver 435 | "Builds an executable, serializes resources and packs required foreign 436 | libraries into a .zip archive for distribution. `system-name` is a name of 437 | `asdf` system of your application and `game-class` is a game class defined with 438 | [`defgame`](#gamekit-defgame) (the one that could be passed to 439 | [`#'start`](#gamekit-start) to start your game). By default, it builds all 440 | artifacts into `build/` directory relative to `system-name` system path, but you 441 | can pass any other path to `:build-directory` key argument to put target files 442 | into it instead. 443 | 444 | This routine uses `zip` and `lisp` ('sbcl' [Steel Bank Common 445 | Lisp](http://sbcl.org) is the default) to build a distributable package on 446 | various platforms. If those executables are not on your system's `PATH`, you 447 | would need to provide absolute paths to them via `:zip` and `:lisp` key 448 | arguments accordingly. 449 | 450 | You can load this function into an image via `:trivial-gamekit/distribution` system. 451 | 452 | Example: 453 | ```common-lisp 454 | \(ql:quickload :trivial-gamekit/distribution) 455 | \(gamekit.distribution:deliver :example-asdf-system 'example-package::example 456 | :build-directory \"/tmp/example-game/\" 457 | :zip \"/usr/bin/zip\" 458 | :lisp \"/usr/bin/sbcl\") 459 | ```") 460 | 461 | 462 | (docstring #'viewport-width 463 | "Returns width of a gamekit viewport (window) if there's an active gamekit 464 | instance (started via [`#'start`](#gamekit-start)) or nil otherwise. 465 | 466 | Example: 467 | 468 | ```common-lisp 469 | (gamekit:viewport-width) 470 | ```") 471 | 472 | 473 | (docstring #'viewport-height 474 | "Returns height of a gamekit viewport (window) if there's an active gamekit 475 | instance (started via [`#'start`](#gamekit-start)) or nil otherwise. 476 | 477 | Example: 478 | 479 | ```common-lisp 480 | (gamekit:viewport-height) 481 | ```") 482 | 483 | 484 | (docstring #'image-width 485 | "Returns width of an image by its id (defined with 486 | [`#'define-image`](#gamekit-define-image)). 487 | 488 | Can only be called when gamekit instance is active (started via 489 | [`#'start`](#gamekit-start)). 490 | 491 | Example: 492 | ```common-lisp 493 | (gamekit:image-width 'example-package::logo) 494 | ```") 495 | 496 | 497 | (docstring #'image-height 498 | "Returns height of an image by its id (defined with 499 | [`#'define-image`](#gamekit-define-image)). 500 | 501 | Can only be called when gamekit instance is active (started via 502 | [`#'start`](#gamekit-start)). 503 | 504 | Example: 505 | ```common-lisp 506 | (gamekit:image-height 'example-package::logo) 507 | ```") 508 | 509 | 510 | (docstring #'bind-any-gamepad 511 | "Binds `action` to a gamepad connection and disconnection events. Once one of 512 | those events happen, `action` is called with two arguments: `gamepad` - opaque 513 | reference to a gamepad that will be supplied as an argument to other 514 | gamepad-related actions, and `state` - which can be either `:connected` or 515 | `:disconnected` to catch connection and disconnection of a gamepad accordingly. 516 | 517 | If there were gamepads already connected before call to `#'bind-any-gamepad`, 518 | `action` is called for each one of those upon invocation. 519 | 520 | Example: 521 | ```common-lisp 522 | (gamekit:bind-any-gamepad (lambda (gamepad state) 523 | (if (eq :connected state) 524 | (add-player-for-gamepad gamepad) 525 | (pause-game-and-wait-for-player gamepad)))) 526 | ```") 527 | 528 | (docstring #'bind-gamepad-button 529 | "Binds `action` to specified gamepad's `button` `state`. When button state 530 | changes to the one specified, action callback is invoked with gamepad opaque 531 | reference as an argument. `state` can be either `:pressed` or `:released`. 532 | 533 | Actions are not stacked together and would be overwritten for the same button and state. 534 | 535 | Can only be called when gamekit instance is active (started via 536 | [`#'start`](#gamekit-start)). 537 | 538 | Gamekit's gamepad is a generic xbox controller with the same layout of controls. 539 | 540 | Supported buttons: 541 | ```common-lisp 542 | :a :b :x :y 543 | :left-bumper :right-bumper 544 | :start :back :guide 545 | :left-thumb :right-thumb 546 | ``` 547 | 548 | Example 549 | ```common-lisp 550 | (gamekit:bind-gamepad-button :start :pressed 551 | (lambda (gamepad) 552 | (declare (ignore gamepad)) 553 | (start-game))) 554 | ```") 555 | 556 | 557 | (docstring #'bind-gamepad-any-button 558 | "Binds `action` to all buttons of gamepads. When any button state of any 559 | gamepad changes, action callback is invoked with gamepad opaque reference as a 560 | first argument, gamepad's button as a second and button's state as a third argument. 561 | See [`#'bind-gamepad-button`](#gamekit-bind-gamepad-button) for available button 562 | values and states. 563 | 564 | Actions are not stacked together and would be overwritten on each function invocation. 565 | 566 | Can only be called when gamekit instance is active (started via 567 | [`#'start`](#gamekit-start)). 568 | 569 | Example 570 | ```common-lisp 571 | (gamekit:bind-gamepad-any-button (lambda (gamepad button state) 572 | (when (and (eq button :start) (eq state :pressed)) 573 | (join-party (make-player-for-gamepad gamepad))))) 574 | ```") 575 | 576 | 577 | (docstring #'bind-gamepad-dpad 578 | "Binds `action` to gamepad's dpad. When dpad state changes, action callback is 579 | invoked with gamepad opaque reference as a first argument and new dpad state as a 580 | second. 581 | 582 | Dpad states: 583 | ```common-lisp 584 | :up :down :left :right 585 | :left-up :left-down 586 | :right-up :right-down 587 | :centered 588 | ``` 589 | 590 | Actions are not stacked together and would be overwritten for the same dpad 591 | state. 592 | 593 | Can only be called when gamekit instance is active (started via 594 | [`#'start`](#gamekit-start)). 595 | 596 | Example 597 | ```common-lisp 598 | (gamekit:bind-gamepad-state :up (lambda (gamepad) 599 | (declare (ignore gamepad)) 600 | (jump *player*))) 601 | ```") 602 | 603 | (docstring #'bind-gamepad-stick 604 | "Binds `action` to gamepad's left or right stick. When position of the 605 | specified stick changes, action callback is invoked with `gamepad` opaque 606 | reference as a first argument, position's `x` and `y` as second and third 607 | arguments. `x` and `y` values are in [-1;1] range: stick up (0;1), stick 608 | down (0;-1), stick left (-1;0) and stick right (1;0). 609 | 610 | Sticks: `:left` and `:right`. 611 | 612 | Actions are not stacked together and would be overwritten for the same stick. 613 | 614 | Can only be called when gamekit instance is active (started via 615 | [`#'start`](#gamekit-start)). 616 | 617 | Example 618 | ```common-lisp 619 | (gamekit:bind-gamepad-stick :left (lambda (gamepad x y) 620 | (declare (ignore gamepad)) 621 | (move-player *player* x y))) 622 | ```") 623 | 624 | (docstring #'bind-gamepad-trigger 625 | "Binds `action` to gamepad's left or right triggers. When value of the 626 | specified trigger changes, action callback is invoked with `gamepad` opaque 627 | reference as a first argument and new trigger value as second. Trigger values 628 | are in [0;1] range. 629 | 630 | Triggers: `:left` and `:right`. 631 | 632 | Actions are not stacked together and would be overwritten for the same trigger. 633 | 634 | Can only be called when gamekit instance is active (started via 635 | [`#'start`](#gamekit-start)). 636 | 637 | Example 638 | ```common-lisp 639 | (gamekit:bind-gamepad-trigger :right (lambda (gamepad value) 640 | (declare (ignore gamepad)) 641 | (setf (shot-power *player*) value))) 642 | ```") 643 | -------------------------------------------------------------------------------- /docs/packages.lisp: -------------------------------------------------------------------------------- 1 | (cl:defpackage :trivial-gamekit.documentation 2 | (:nicknames :gamekit.documentation) 3 | (:use :cl :gamekit :gamekit.distribution :trivial-docstring) 4 | (:export render-documentation)) 5 | -------------------------------------------------------------------------------- /docs/renderer.lisp: -------------------------------------------------------------------------------- 1 | (cl:in-package :trivial-gamekit.documentation) 2 | 3 | 4 | (defclass kramdown-renderer () ()) 5 | 6 | 7 | (defparameter *template* (alexandria:read-file-into-string 8 | (asdf:system-relative-pathname :trivial-gamekit/documentation 9 | "docs/doc-entry.template"))) 10 | 11 | (defun format-name (name) 12 | (if (symbolp name) 13 | (string-downcase (symbol-name name)) 14 | (format nil "~(~A~)" 15 | (mapcar #'symbol-name name)))) 16 | 17 | 18 | (defun format-link (name) 19 | (format nil "#gamekit-~(~{~A~^-~}~)" (alexandria:ensure-list name))) 20 | 21 | 22 | (defun format-documentation-entry (type name documentation &optional lambda-list) 23 | (let ((mustache:*escape-tokens* nil)) 24 | (mustache:render* *template* (alexandria:plist-alist 25 | (append (list :type type 26 | :name (format-name name) 27 | :link (format-link name)) 28 | (when documentation 29 | (list :documentation documentation)) 30 | (list :lambda-list 31 | (format nil "(~{~(~A~)~^ ~})" lambda-list))))))) 32 | 33 | 34 | (defmethod doxy:document-class ((this kramdown-renderer) name docstring) 35 | nil) 36 | 37 | (defmethod doxy:document-function ((this kramdown-renderer) name lambda-list docstring) 38 | (format-documentation-entry "function" name docstring lambda-list)) 39 | 40 | (defmethod doxy:document-macro ((this kramdown-renderer) name lambda-list docstring) 41 | (format-documentation-entry "macro" name docstring lambda-list)) 42 | 43 | (defmethod doxy:document-generic ((this kramdown-renderer) name lambda-list docstring) 44 | (format-documentation-entry "generic" name docstring lambda-list)) 45 | 46 | (defmethod doxy:document-variable ((this kramdown-renderer) name docstring) 47 | (format-documentation-entry "variable" name docstring)) 48 | 49 | 50 | (defun render-documentation-and-collect-index (renderer output-directory exists-action) 51 | (flet ((%render-documentation (file &rest symbols) 52 | (alexandria:with-output-to-file (output (merge-pathnames file output-directory) 53 | :if-exists exists-action) 54 | (loop for (symbol . doc) in (apply #'doxy:collect-documentation renderer symbols) 55 | when doc 56 | do (format output "~A~&~%" doc) 57 | and 58 | collect (format nil "* [~(~A~)](~A)" 59 | (format-name symbol) 60 | (format-link symbol)))))) 61 | (append 62 | (%render-documentation "defining-a-game.md" 63 | 'defgame 64 | 'start 65 | 'stop 66 | 'gamekit 67 | 'post-initialize 68 | 'pre-destroy 69 | 'act 70 | 'draw 71 | 'viewport-width 72 | 'viewport-height) 73 | (%render-documentation "math.md" 74 | 'vec2 75 | 'vec3 76 | 'vec4 77 | 'mult 78 | 'add 79 | 'subt 80 | 'div 81 | 'x 82 | 'y 83 | 'z 84 | 'w) 85 | (%render-documentation "locating-resources.md" 86 | 'register-resource-package 87 | 'define-image 88 | 'define-sound 89 | 'define-font 90 | 'define-text 91 | 'define-binary 92 | 'make-font 93 | 'prepare-resources 94 | 'dispose-resources 95 | 'notice-resources 96 | 'get-text 97 | 'get-binary) 98 | (%render-documentation "drawing.md" 99 | 'draw-line 100 | 'draw-curve 101 | 'draw-rect 102 | 'draw-circle 103 | 'draw-ellipse 104 | 'draw-arc 105 | 'draw-polygon 106 | 'draw-polyline 107 | 'draw-image 108 | 'draw-text 109 | 'translate-canvas 110 | 'rotate-canvas 111 | 'scale-canvas 112 | 'with-pushed-canvas 113 | 'image-width 114 | 'image-height 115 | 'calc-text-bounds) 116 | (%render-documentation "playing-audio.md" 117 | 'play-sound 118 | 'stop-sound) 119 | (%render-documentation "listening-to-input.md" 120 | 'bind-button 121 | 'bind-cursor 122 | 'bind-any-gamepad 123 | 'bind-gamepad-button 124 | 'bind-gamepad-any-button 125 | 'bind-gamepad-dpad 126 | 'bind-gamepad-stick 127 | 'bind-gamepad-trigger) 128 | (%render-documentation "building-a-distributable.md" 129 | 'deliver)))) 130 | 131 | 132 | (defun render-documentation (&key (overwrite t) 133 | (output-directory (asdf:system-relative-pathname 134 | :trivial-gamekit/documentation "build/docs/"))) 135 | (let ((renderer (make-instance 'kramdown-renderer)) 136 | (exists-action (if overwrite :supersede :error))) 137 | (log:info "Rendering documentation into '~A'" output-directory) 138 | (ensure-directories-exist output-directory) 139 | (let ((index (render-documentation-and-collect-index renderer output-directory exists-action))) 140 | (alexandria:with-output-to-file (output (merge-pathnames output-directory "symbol-index.md") 141 | :if-exists exists-action) 142 | (loop for entry in index 143 | do (format output "~A~%" entry)))))) 144 | -------------------------------------------------------------------------------- /src/assets/NotoSans-Regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/borodust/trivial-gamekit/2555cedca7c24b155feb0cb8daa79f142d062e16/src/assets/NotoSans-Regular.ttf -------------------------------------------------------------------------------- /src/gamekit.lisp: -------------------------------------------------------------------------------- 1 | (cl:in-package :trivial-gamekit) 2 | 3 | 4 | (declaim (special *font*)) 5 | 6 | 7 | (defvar +origin+ (vec2 0.0 0.0)) 8 | (defvar *black* (vec4 0 0 0 1)) 9 | 10 | (defvar *gamekit-instance* nil) 11 | 12 | (defclass gamekit-system () 13 | ((keymap :initform nil) 14 | (gamepad-map :initform nil) 15 | (gamepads :initform nil) 16 | (gamepad-action :initform nil) 17 | (cursor-action :initform nil) 18 | (cursor-position :initform (vec2 0 0)) 19 | (cursor-changed-p :initform nil) 20 | (resource-path :initarg :resource-path :initform nil) 21 | (resource-registry) 22 | (prepare-resources :initform t) 23 | (button-action :initform nil) 24 | (scroll-action :initform nil) 25 | (viewport-width :initform 0) 26 | (viewport-height :initform 0) 27 | (canvas-width :initform 0) 28 | (canvas-height :initform 0))) 29 | 30 | 31 | (defmethod initialize-instance ((this gamekit-system) &rest args &key depends-on) 32 | (apply #'call-next-method this 33 | :depends-on (union (list 'ge.snd:audio-system) depends-on) 34 | args)) 35 | 36 | 37 | (defgeneric configure-game (game) 38 | (:method (this) (declare (ignore this)))) 39 | 40 | 41 | (defun split-opts (opts) 42 | (loop for opt in opts 43 | if (member (first opt) '(:prepare-resources)) 44 | collect opt into extended 45 | else 46 | collect opt into std 47 | finally (return (values std extended)))) 48 | 49 | 50 | (defmacro defgame (name (&rest classes) &body ((&rest slots) &rest opts)) 51 | (multiple-value-bind (std-opts extended) (split-opts opts) 52 | `(progn 53 | (ge.app:defapp ,name (gamekit-system ,@classes) 54 | ,slots 55 | ,@std-opts) 56 | ,(with-hash-entries ((prepare-resources :prepare-resources)) 57 | (alist-hash-table extended) 58 | `(progn 59 | (defmethod configure-game ((this ,name)) 60 | (log/debug "Reconfiguring ~A" ',name) 61 | ,@(multiple-value-bind (value exist-p) prepare-resources 62 | `((setf (slot-value this 'prepare-resources) ,(if exist-p 63 | (first value) 64 | t)))))))))) 65 | 66 | 67 | (defun gamekit () 68 | *gamekit-instance*) 69 | 70 | 71 | (defgeneric act (system) 72 | (:method (system) (declare (ignore system)))) 73 | 74 | 75 | (defgeneric initialize-resources (system) 76 | (:method (system) (declare (ignore system)))) 77 | 78 | 79 | (defgeneric initialize-audio (system) 80 | (:method (system) (declare (ignore system)))) 81 | 82 | 83 | (defgeneric initialize-graphics (system) 84 | (:method (system) (declare (ignore system)))) 85 | 86 | 87 | (defgeneric initialize-host (system) 88 | (:method (system) (declare (ignore system)))) 89 | 90 | 91 | (defgeneric post-initialize (system) 92 | (:method (system) 93 | (declare (ignore system)))) 94 | 95 | 96 | (defgeneric pre-destroy (system) 97 | (:method (system) (declare (ignore system)))) 98 | 99 | 100 | (defmethod initialize-resources :around ((system gamekit-system)) 101 | (with-slots (resource-registry) system 102 | (let ((*resource-registry* resource-registry)) 103 | (call-next-method)))) 104 | 105 | 106 | (defmacro when-gamekit ((gamekit-var) &body body) 107 | `(when-let ((,gamekit-var (gamekit))) 108 | ,@body)) 109 | 110 | 111 | (defmacro if-gamekit ((gamekit-var) &body body) 112 | `(if-let ((,gamekit-var (gamekit))) 113 | ,@body)) 114 | 115 | 116 | (defun viewport-width () 117 | (when-gamekit (gamekit) 118 | (with-slots (viewport-width) gamekit 119 | viewport-width))) 120 | 121 | 122 | (defun viewport-height () 123 | (when-gamekit (gamekit) 124 | (with-slots (viewport-height) gamekit 125 | viewport-height))) 126 | 127 | 128 | (defun canvas-width () 129 | (when-gamekit (gamekit) 130 | (with-slots (canvas-width) gamekit 131 | canvas-width))) 132 | 133 | 134 | (defun canvas-height () 135 | (when-gamekit (gamekit) 136 | (with-slots (canvas-height) gamekit 137 | canvas-height))) 138 | 139 | 140 | (defmethod ge.app:draw :around ((this gamekit-system)) 141 | (let ((*font* (cl-bodge.canvas:make-default-font))) 142 | (call-next-method))) 143 | 144 | 145 | (defun register-gamepad (gamekit gamepad) 146 | (with-slots (gamepad-action gamepads) gamekit 147 | (push gamepad gamepads) 148 | (when gamepad-action 149 | (funcall gamepad-action gamepad :connected)))) 150 | 151 | 152 | (defun remove-gamepad (gamekit gamepad) 153 | (with-slots (gamepad-action gamepads) gamekit 154 | (deletef gamepads gamepad) 155 | (unwind-protect 156 | (when gamepad-action 157 | (funcall gamepad-action gamepad :disconnected))))) 158 | 159 | 160 | (define-event-handler on-keyboard ((ev ge.host:keyboard-event) key state) 161 | (when-gamekit (gamekit) 162 | (with-slots (keymap button-action) gamekit 163 | (when-let ((action (getf (gethash key keymap) state))) 164 | (push-action action)) 165 | (when button-action 166 | (flet ((call-action () 167 | (funcall button-action key state))) 168 | (push-action #'call-action)))))) 169 | 170 | 171 | (define-event-handler on-gamepad-connect ((ev ge.host:gamepad-connected-event)) 172 | (when-gamekit (gamekit) 173 | (with-slots (gamepad-map gamepad-action) gamekit 174 | (let ((gamepad (ge.host:gamepad-from ev))) 175 | (flet ((%connect-gamepad () 176 | (register-gamepad gamekit gamepad))) 177 | (push-action #'%connect-gamepad)))))) 178 | 179 | 180 | (define-event-handler on-gamepad-disconnect ((ev ge.host:gamepad-disconnected-event)) 181 | (when-gamekit (gamekit) 182 | (with-slots (gamepad-map gamepad-action) gamekit 183 | (let ((gamepad (ge.host:gamepad-from ev))) 184 | (flet ((%disconnect-gamepad () 185 | (remove-gamepad gamekit gamepad))) 186 | (push-action #'%disconnect-gamepad)))))) 187 | 188 | 189 | (define-event-handler on-gamepad-button ((ev ge.host:gamepad-button-event)) 190 | (when-gamekit (gamekit) 191 | (with-slots (gamepad-map) gamekit 192 | (let ((gamepad (ge.host:gamepad-from ev)) 193 | (button (ge.host:button-from ev)) 194 | (state (ge.host:state-from ev))) 195 | (flet ((process-button () 196 | (when-let ((action (gethash :any gamepad-map))) 197 | (funcall action gamepad button state)) 198 | (when-let ((action (getf (gethash button gamepad-map) state))) 199 | (funcall action gamepad)))) 200 | (push-action #'process-button)))))) 201 | 202 | 203 | (define-event-handler on-gamepad-dpad ((ev ge.host:gamepad-dpad-event)) 204 | (when-gamekit (gamekit) 205 | (with-slots (gamepad-map) gamekit 206 | (let ((gamepad (ge.host:gamepad-from ev)) 207 | (state (ge.host:state-from ev))) 208 | (flet ((process-dpad () 209 | (when-let ((action (getf (gethash :dpad gamepad-map) state))) 210 | (funcall action gamepad)))) 211 | (push-action #'process-dpad)))))) 212 | 213 | 214 | (defun invoke-stick-action (gamekit event stick) 215 | (with-slots (gamepad-map) gamekit 216 | (let ((gamepad (ge.host:gamepad-from event)) 217 | (x (ge.host:x-from event)) 218 | (y (ge.host:y-from event))) 219 | (flet ((process-stick () 220 | (when-let ((action (gethash stick gamepad-map))) 221 | (funcall action gamepad x y)))) 222 | (push-action #'process-stick))))) 223 | 224 | 225 | (define-event-handler on-gamepad-left-stick ((ev ge.host:gamepad-left-stick-event)) 226 | (when-gamekit (gamekit) 227 | (invoke-stick-action gamekit ev :left-stick))) 228 | 229 | 230 | (define-event-handler on-gamepad-right-stick ((ev ge.host:gamepad-right-stick-event)) 231 | (when-gamekit (gamekit) 232 | (invoke-stick-action gamekit ev :right-stick))) 233 | 234 | 235 | (defun invoke-trigger-action (gamekit event trigger) 236 | (with-slots (gamepad-map) gamekit 237 | (let ((gamepad (ge.host:gamepad-from event)) 238 | (value (ge.host:value-from event))) 239 | (flet ((process-trigger () 240 | (when-let ((action (gethash trigger gamepad-map))) 241 | (funcall action gamepad value)))) 242 | (push-action #'process-trigger))))) 243 | 244 | 245 | (define-event-handler on-gamepad-left-trigger ((ev ge.host:gamepad-left-trigger-event)) 246 | (when-gamekit (gamekit) 247 | (invoke-trigger-action gamekit ev :left-trigger))) 248 | 249 | 250 | (define-event-handler on-gamepad-right-trigger ((ev ge.host:gamepad-right-trigger-event)) 251 | (when-gamekit (gamekit) 252 | (invoke-trigger-action gamekit ev :right-trigger))) 253 | 254 | 255 | (define-event-handler on-viewport-size-change ((ev ge.host:viewport-size-change-event) 256 | width height) 257 | (when-gamekit (gamekit) 258 | (with-slots (viewport-width viewport-height) gamekit 259 | (setf viewport-width width 260 | viewport-height height)))) 261 | 262 | 263 | (defun bodge-mouse-button->gamekit (bodge-button) 264 | (case bodge-button 265 | (:left :mouse-left) 266 | (:right :mouse-right) 267 | (:middle :mouse-middle) 268 | (t bodge-button))) 269 | 270 | 271 | (define-event-handler on-mouse ((ev ge.host:mouse-event) button state) 272 | (when-gamekit (gamekit) 273 | (with-slots (keymap button-action) gamekit 274 | (when-let ((action (getf (gethash (bodge-mouse-button->gamekit button) keymap) 275 | state))) 276 | (push-action action)) 277 | (when button-action 278 | (flet ((call-action () 279 | (funcall button-action (bodge-mouse-button->gamekit button) 280 | state))) 281 | (push-action #'call-action)))))) 282 | 283 | (define-event-handler on-scroll-event ((ev ge.host:scroll-event) x-offset y-offset) 284 | (when-gamekit (gamekit) 285 | (with-slots (keymap scroll-action) gamekit 286 | (when scroll-action 287 | (flet ((call-action () 288 | (funcall scroll-action x-offset y-offset))) 289 | (push-action #'call-action)))))) 290 | 291 | 292 | (define-event-handler on-cursor ((ev ge.host:cursor-event) x y) 293 | (when-gamekit (gamekit) 294 | (with-slots (cursor-position cursor-changed-p) gamekit 295 | (unless cursor-changed-p 296 | (setf cursor-changed-p t)) 297 | (setf (x cursor-position) x 298 | (y cursor-position) y)))) 299 | 300 | 301 | (defun make-package-resource-table (resource-paths) 302 | (flet ((to-package-pair (pair) 303 | (cons (find-package (car pair)) (cdr pair)))) 304 | (alist-hash-table (mapcar #'to-package-pair resource-paths)))) 305 | 306 | 307 | (defun push-action (action) 308 | (ge.app:inject-flow 309 | (instantly () 310 | (funcall action))) 311 | (values)) 312 | 313 | 314 | (defgeneric notice-resources (game &rest resource-names) 315 | (:method (this &rest resource-names) 316 | (declare (ignore this resource-names)))) 317 | 318 | 319 | (defmethod notice-resources ((this gamekit-system) &rest resource-names) 320 | (declare (ignore this)) 321 | (log:info "Resources loaded: ~A" resource-names)) 322 | 323 | 324 | (defun prepare-resources (&rest resource-names) 325 | (log:trace "Preparing resources: ~A" resource-names) 326 | (let ((game (gamekit))) 327 | (with-slots (resource-registry) game 328 | (flet ((notify-game () 329 | (apply #'notice-resources game resource-names))) 330 | (run (>> (loading-flow resource-registry #'ge.app:app-canvas resource-names) 331 | (instantly () 332 | (push-action #'notify-game)))))))) 333 | 334 | 335 | (defun dispose-resources (&rest resource-names) 336 | (let ((game (gamekit))) 337 | (with-slots (resource-registry) game 338 | (flet ((%%dispose () 339 | (loop for name in resource-names 340 | do (%dispose-resource resource-registry name)))) 341 | (push-action #'%%dispose))))) 342 | 343 | 344 | (defun %mount-for-executable (this) 345 | (with-slots (resource-path prepare-resources) this 346 | (unless (executablep) 347 | (when resource-path 348 | (register-resource-package :keyword resource-path) 349 | (%mount-packages :keyword)) 350 | (when prepare-resources 351 | (apply #'%mount-resources (list-all-resources)))))) 352 | 353 | 354 | (defun %prepare-resources (this) 355 | (with-slots (resource-registry prepare-resources) this 356 | (when prepare-resources 357 | (loading-flow resource-registry #'ge.app:app-canvas (list-all-resources))))) 358 | 359 | 360 | (defmethod ge.app:acting-flow ((this gamekit-system)) 361 | (with-slots (cursor-position cursor-changed-p cursor-action) this 362 | (labels ((%process-cursor () 363 | (when (and cursor-action cursor-changed-p) 364 | (funcall cursor-action (x cursor-position) (y cursor-position)) 365 | (setf cursor-changed-p nil))) 366 | (%act () 367 | (%process-cursor) 368 | (act this))) 369 | (instantly () (%act))))) 370 | 371 | 372 | (defun %update-canvas-dimensions (gamekit) 373 | (with-slots (canvas-width canvas-height) gamekit 374 | (let ((canvas (ge.app:app-canvas))) 375 | (setf canvas-width (ge.vg:canvas-width canvas) 376 | canvas-height (ge.vg:canvas-height canvas))))) 377 | 378 | 379 | (defmethod ge.app:configuration-flow ((this gamekit-system)) 380 | (with-slots (keymap gamepad-map resource-registry 381 | viewport-width viewport-height 382 | canvas-width canvas-height) 383 | this 384 | (>> (instantly () 385 | (configure-game this) 386 | (setf keymap (make-hash-table) 387 | gamepad-map (make-hash-table) 388 | resource-registry (make-instance 'gamekit-resource-registry) 389 | *gamekit-instance* this)) 390 | (ge.host:for-host () 391 | (ge.host:with-viewport-dimensions (width height) 392 | (setf viewport-width width 393 | viewport-height height))) 394 | (ge.gx:for-graphics () 395 | (%update-canvas-dimensions this)) 396 | (instantly () 397 | (initialize-resources this) 398 | (%mount-for-executable this)) 399 | (ge.host:for-host () 400 | (log/debug "Initializing host") 401 | (initialize-host this)) 402 | (ge.gx:for-graphics () 403 | (log/debug "Initializing graphics") 404 | (initialize-graphics this)) 405 | (->> () 406 | (log/debug "Preparing resources") 407 | (%prepare-resources this)) 408 | (ge.host:for-host () 409 | (loop for gamepad in (ge.host:list-gamepads) 410 | do (register-gamepad this gamepad))) 411 | (instantly () 412 | (log/debug "Initializing audio") 413 | (initialize-audio this) 414 | (log/debug "Invoking post-initialization hook") 415 | (post-initialize this) 416 | (log/debug "Initialization completed"))))) 417 | 418 | 419 | (defmethod ge.app:sweeping-flow ((this gamekit-system)) 420 | (with-slots (resource-registry) this 421 | (instantly () 422 | (log/debug "Invoking pre-destroy hook") 423 | (pre-destroy this) 424 | (log/debug "Disposing resources") 425 | (%dispose-resources resource-registry) 426 | (log/debug "Sweeping complete") 427 | (setf *gamekit-instance* nil)))) 428 | 429 | 430 | (ge.ng:define-event-handler on-viewport-update ((ev ge.host:viewport-size-change-event)) 431 | (when-gamekit (gamekit) 432 | (ge.app:inject-flow (ge.gx:for-graphics () 433 | (%update-canvas-dimensions gamekit))))) 434 | 435 | 436 | (defun resource-by-id (id) 437 | (with-slots (resource-registry) (gamekit) 438 | (%get-resource resource-registry id))) 439 | 440 | 441 | (defun raise-binding-error () 442 | (error "Input can only be bound when gamekit is started.")) 443 | 444 | 445 | (defun bind-button (key state action) 446 | (if-gamekit (gamekit) 447 | (with-slots (keymap) gamekit 448 | (with-system-lock-held (gamekit) 449 | (setf (getf (gethash key keymap) state) action))) 450 | (raise-binding-error))) 451 | 452 | 453 | (defun bind-any-gamepad (action) 454 | (if-gamekit (gamekit) 455 | (with-slots (gamepad-action gamepads) gamekit 456 | (setf gamepad-action action) 457 | (when action 458 | (flet ((register-gamepads () 459 | (loop for gamepad in gamepads 460 | do (funcall action gamepad :connected)))) 461 | (push-action #'register-gamepads)))) 462 | (raise-binding-error))) 463 | 464 | 465 | (defun bind-gamepad-button (button state action) 466 | (if-gamekit (gamekit) 467 | (with-slots (gamepad-map) gamekit 468 | (setf (getf (gethash button gamepad-map) state) action)) 469 | (raise-binding-error))) 470 | 471 | 472 | (defun bind-gamepad-dpad (state action) 473 | (if-gamekit (gamekit) 474 | (with-slots (gamepad-map) gamekit 475 | (setf (getf (gethash :dpad gamepad-map) state) action)) 476 | (raise-binding-error))) 477 | 478 | 479 | (defun bind-gamepad-any-button (action) 480 | (if-gamekit (gamekit) 481 | (with-slots (gamepad-map) gamekit 482 | (setf (gethash :any gamepad-map) action)) 483 | (raise-binding-error))) 484 | 485 | 486 | (defun bind-gamepad-stick (stick action) 487 | (if-gamekit (gamekit) 488 | (with-slots (gamepad-map) gamekit 489 | (let ((stick (ecase stick 490 | (:right :right-stick) 491 | (:left :left-stick)))) 492 | (setf (gethash stick gamepad-map) action))) 493 | (raise-binding-error))) 494 | 495 | 496 | (defun bind-gamepad-trigger (trigger action) 497 | (if-gamekit (gamekit) 498 | (with-slots (gamepad-map) gamekit 499 | (let ((trigger (ecase trigger 500 | (:right :right-trigger) 501 | (:left :left-trigger)))) 502 | (setf (gethash trigger gamepad-map) action))) 503 | (raise-binding-error))) 504 | 505 | 506 | (defun bind-any-button (action) 507 | (if-gamekit (gamekit) 508 | (with-slots (button-action) gamekit 509 | (with-system-lock-held (gamekit) 510 | (setf button-action action))) 511 | (raise-binding-error))) 512 | 513 | 514 | (defun bind-cursor (action) 515 | (if-gamekit (gamekit) 516 | (with-slots (cursor-action) gamekit 517 | (with-system-lock-held (gamekit) 518 | (setf cursor-action action))) 519 | (raise-binding-error))) 520 | 521 | (defun bind-scroll (action) 522 | (if-gamekit (gamekit) 523 | (with-slots (scroll-action) gamekit 524 | (with-system-lock-held (gamekit) 525 | (setf scroll-action action))) 526 | (raise-binding-error))) 527 | 528 | 529 | (defun play-sound (sound-id &key looped-p) 530 | (let ((source (resource-by-id sound-id))) 531 | (when looped-p 532 | (setf (ge.snd:audio-looped-p source) t)) 533 | (ge.snd:play-audio source))) 534 | 535 | 536 | (defun stop-sound (sound-id) 537 | (ge.snd:stop-audio (resource-by-id sound-id))) 538 | 539 | 540 | (defun play (sound-id &key looped-p) 541 | (play-sound sound-id :looped-p looped-p)) 542 | 543 | 544 | (defmacro with-pushed-canvas (() &body body) 545 | `(ge.vg:with-retained-canvas 546 | ,@body)) 547 | 548 | 549 | (defun draw-image (position image-id &key origin width height 550 | mirror-y mirror-x) 551 | (when-let ((image (resource-by-id image-id))) 552 | (let* ((image-origin (or origin +origin+)) 553 | (image-width (if width 554 | width 555 | (ge.vg:image-paint-width image))) 556 | (image-height (if height 557 | height 558 | (ge.vg:image-paint-height image)))) 559 | (ge.vg:with-retained-canvas 560 | (when mirror-y 561 | (ge.vg:translate-canvas 0 image-height) 562 | (ge.vg:scale-canvas 1 -1)) 563 | (when mirror-x 564 | (ge.vg:translate-canvas image-width 0) 565 | (ge.vg:scale-canvas -1 1)) 566 | 567 | (ge.vg:translate-canvas (x position) (y position)) 568 | (ge.vg:translate-canvas (- (x image-origin)) (- (y image-origin))) 569 | (draw-rect image-origin image-width image-height :fill-paint image))))) 570 | 571 | 572 | (defun image-width (image-id) 573 | (if-let ((image (resource-by-id image-id))) 574 | (ge.vg:image-paint-width image) 575 | (error "Image ~A not found" image-id))) 576 | 577 | 578 | (defun image-height (image-id) 579 | (if-let ((image (resource-by-id image-id))) 580 | (ge.vg:image-paint-height image) 581 | (error "Image ~A not found" image-id))) 582 | 583 | 584 | (defun make-font (font-id size) 585 | (ge.vg:make-font (resource-by-id font-id) :size size)) 586 | 587 | 588 | (defun calc-text-bounds (text &optional (font *font*)) 589 | (ge.vg:with-font (font) 590 | (ge.vg:canvas-text-bounds text))) 591 | 592 | 593 | (defun print-text (string x y &optional (color *black*)) 594 | (draw-text string (vec2 x y) :fill-color color)) 595 | 596 | 597 | (defun draw-text (string origin &key fill-color font) 598 | (ge.vg:with-font ((or font *font*)) 599 | (ge.vg:draw-text origin string (or fill-color *black*)))) 600 | 601 | 602 | (defun get-text (resource-id) 603 | (resource-by-id resource-id)) 604 | 605 | 606 | (defun get-binary (resource-id) 607 | (resource-by-id resource-id)) 608 | 609 | 610 | (defun start (classname &key (log-level :info) 611 | (opengl-version '(3 3)) 612 | samples 613 | blocking 614 | viewport-resizable 615 | (viewport-decorated t) 616 | (autoscaled t) 617 | swap-interval 618 | properties) 619 | (log/level log-level) 620 | (ge.app:start classname :log-level log-level 621 | :opengl-version opengl-version 622 | :samples samples 623 | :blocking blocking 624 | :viewport-resizable viewport-resizable 625 | :viewport-decorated viewport-decorated 626 | :autoscaled autoscaled 627 | :swap-interval swap-interval 628 | :properties properties)) 629 | -------------------------------------------------------------------------------- /src/packages.lisp: -------------------------------------------------------------------------------- 1 | (bodge-util:define-package :trivial-gamekit 2 | (:nicknames :gamekit) 3 | (:use :cl :bodge-util :cl-bodge.engine) 4 | (:reexport-from :cl-bodge.canvas 5 | draw-line 6 | draw-curve 7 | draw-rect 8 | draw-circle 9 | draw-ellipse 10 | draw-arc 11 | draw-polygon 12 | draw-polyline 13 | translate-canvas 14 | rotate-canvas 15 | scale-canvas) 16 | (:reexport-from :cl-bodge.appkit 17 | draw 18 | stop) 19 | (:export vec2 20 | vec3 21 | vec4 22 | mult 23 | add 24 | subt 25 | div 26 | normalize 27 | cross 28 | dot 29 | lerp 30 | x 31 | y 32 | z 33 | w 34 | 35 | defgame 36 | start 37 | gamekit 38 | act 39 | push-action 40 | 41 | register-resource-package 42 | define-image 43 | define-sound 44 | define-font 45 | define-text 46 | define-binary 47 | prepare-resources 48 | dispose-resources 49 | notice-resources 50 | make-font 51 | calc-text-bounds 52 | 53 | post-initialize 54 | pre-destroy 55 | 56 | viewport-width 57 | viewport-height 58 | canvas-width 59 | canvas-height 60 | 61 | bind-button 62 | bind-any-button 63 | bind-cursor 64 | bind-scroll 65 | bind-any-gamepad 66 | bind-gamepad-button 67 | bind-gamepad-any-button 68 | bind-gamepad-dpad 69 | bind-gamepad-stick 70 | bind-gamepad-trigger 71 | 72 | draw-text 73 | draw-image 74 | 75 | image-width 76 | image-height 77 | 78 | translate-canvas 79 | rotate-canvas 80 | scale-canvas 81 | with-pushed-canvas 82 | 83 | play-sound 84 | stop-sound 85 | 86 | get-text 87 | get-binary 88 | 89 | ;; deprecated 90 | initialize-host 91 | initialize-graphics 92 | initialize-audio 93 | initialize-resources 94 | 95 | import-image 96 | import-sound 97 | gamekit-system 98 | print-text 99 | play)) 100 | -------------------------------------------------------------------------------- /src/resources.lisp: -------------------------------------------------------------------------------- 1 | (cl:in-package :trivial-gamekit) 2 | 3 | 4 | (declaim (special *resource-registry*)) 5 | 6 | 7 | (define-constant +game-resource-root+ "/_asset/" 8 | :test #'equal) 9 | 10 | (define-constant +kit-resource-root+ "/_gamekit/" 11 | :test #'equal) 12 | 13 | 14 | (defvar *resources* nil) 15 | (defvar *resouce-packages* nil) 16 | 17 | 18 | (defvar *gamekit-assets-root* 19 | (merge-pathnames "assets/" (asdf:component-pathname (asdf:find-system :trivial-gamekit)))) 20 | 21 | 22 | (defun game-resource-path (symbol) 23 | (reduce #'merge-pathnames (list (symbol-name symbol) 24 | (fad:pathname-as-directory 25 | (if-let ((package (symbol-package symbol))) 26 | (package-name package) 27 | (error "Uninterned symbols are not allowed"))) 28 | +game-resource-root+))) 29 | 30 | 31 | (defun kit-resource-path (resource) 32 | (reduce #'merge-pathnames (list resource +kit-resource-root+))) 33 | 34 | 35 | (defun kit-asset-path (file) 36 | (merge-pathnames file *gamekit-assets-root*)) 37 | 38 | 39 | (defclass gamekit-resource-registry () 40 | ((resources :initform (make-hash-table :test 'equal)))) 41 | 42 | 43 | (defun %load-sound (resource-name) 44 | (concurrently () 45 | (let* ((sound (ge.rsc:load-resource resource-name)) 46 | (source (ge.snd:make-audio-source))) 47 | (with-disposable ((buffer (ge.snd:make-audio-buffer sound))) 48 | (ge.snd:attach-audio-buffer buffer source)) 49 | (cons source t)))) 50 | 51 | 52 | (defun %load-image (resource-name canvas-provider &key use-nearest-interpolation) 53 | (>> (concurrently () 54 | (ge.rsc:load-resource resource-name)) 55 | (ge.gx:for-graphics (image) 56 | (cons (ge.vg:make-image-paint (funcall canvas-provider) image 57 | :use-nearest-interpolation use-nearest-interpolation) 58 | t)))) 59 | 60 | 61 | (defun %load-font (resource-name canvas-provider &key) 62 | (>> (concurrently () 63 | (ge.rsc:load-resource resource-name)) 64 | (ge.gx:for-graphics (font-face) 65 | (cons (ge.vg:register-font-face (funcall canvas-provider) resource-name font-face) nil)))) 66 | 67 | 68 | (defun %load-resource (resource-name type canvas-provider parameters) 69 | (eswitch (type :test #'eq) 70 | (:image (apply #'%load-image resource-name canvas-provider parameters)) 71 | (:audio (%load-sound resource-name)) 72 | (:font (%load-font resource-name canvas-provider)) 73 | (:text (instantly () 74 | (cons (ge.rsc:load-resource resource-name) nil))) 75 | (:binary (instantly () 76 | (cons (ge.rsc:load-resource resource-name) nil))))) 77 | 78 | 79 | (defun %dispose-resource (registry resource-name) 80 | (with-slots (resources) registry 81 | (when-let ((resource-info (gethash resource-name resources))) 82 | (destructuring-bind (resource . disposable-p) resource-info 83 | (when disposable-p 84 | (dispose resource)) 85 | (setf (gethash resource-name resources) nil))))) 86 | 87 | 88 | (defun loading-flow (loader canvas-provider resource-names) 89 | (with-slots (resources) loader 90 | (unless (ge.ng:executablep) 91 | (apply #'%mount-resources resource-names)) 92 | (>> 93 | (~> (loop for (id type nil . parameters) in *resources* 94 | when (member id resource-names :test #'eq) 95 | collect (when-let ((id id) 96 | (type type) 97 | (resource-path (game-resource-path id))) 98 | (>> (%load-resource resource-path 99 | type 100 | canvas-provider 101 | parameters) 102 | (instantly ((resource . disposable-p)) 103 | (list id resource disposable-p)))))) 104 | (concurrently ((results)) 105 | (loop for (id resource disposable-p) in results 106 | do (setf (gethash id resources) (cons resource disposable-p))))))) 107 | 108 | 109 | (defun %dispose-resources (registry) 110 | (with-slots (resources) registry 111 | (loop for (resource . disposable-p) being the hash-value of resources 112 | when disposable-p 113 | do (dispose resource)))) 114 | 115 | 116 | (defun list-all-resources () 117 | (mapcar #'car *resources*)) 118 | 119 | 120 | (defun %get-resource (loader id) 121 | (with-slots (resources) loader 122 | (if-let ((resource (gethash id resources))) 123 | (car resource) 124 | (error "Resource with id ~A not found" id)))) 125 | 126 | 127 | (defun register-resource-package (package-name path) 128 | (setf (assoc-value *resouce-packages* (find-package package-name)) path)) 129 | 130 | 131 | (defun %mount-resources (&rest resource-names) 132 | (let ((package-table (alist-hash-table *resouce-packages*))) 133 | (loop for id in resource-names 134 | as (nil path) = (assoc-value *resources* id) 135 | as base-path = (or (gethash (symbol-package id) package-table) *default-pathname-defaults*) 136 | do (ge.rsc:mount-filesystem (game-resource-path id) (merge-pathnames path base-path)) 137 | collect id))) 138 | 139 | 140 | (defun %mount-packages (&rest package-names) 141 | (let ((package-table (alist-hash-table *resouce-packages*))) 142 | (loop for package-name in package-names 143 | as package = (find-package package-name) 144 | as base-path = (or (gethash package package-table) *default-pathname-defaults*) 145 | append (loop for (id nil path) in *resources* 146 | when (eq package (symbol-package id)) 147 | do (ge.rsc:mount-filesystem (game-resource-path id) (merge-pathnames path base-path)) 148 | and 149 | collect id)))) 150 | 151 | 152 | (defun autoprepare (resource-id) 153 | (when (ge.app:app) 154 | (%mount-resources resource-id) 155 | (prepare-resources resource-id))) 156 | 157 | 158 | (defun register-game-resource (id path parameters &rest handler-args) 159 | (check-type id symbol) 160 | (let ((resource-path (game-resource-path id))) 161 | (apply #'ge.rsc:register-resource resource-path handler-args) 162 | (setf (assoc-value *resources* id) (append (list (first handler-args) path) 163 | parameters)))) 164 | 165 | 166 | (defun import-image (resource-id path) 167 | (register-game-resource resource-id path :image :type :png)) 168 | 169 | 170 | (defun import-sound (resource-id path) 171 | (register-game-resource resource-id path :audio)) 172 | 173 | 174 | (defmacro define-image (name path &key use-nearest-interpolation) 175 | `(progn 176 | (register-game-resource ',name ,path 177 | `(:use-nearest-interpolation ,,use-nearest-interpolation) 178 | :image :type :png) 179 | (autoprepare ',name))) 180 | 181 | 182 | (defmacro define-sound (name path) 183 | `(progn 184 | (register-game-resource ',name ,path () :audio) 185 | (autoprepare ',name))) 186 | 187 | 188 | (defmacro define-font (name path) 189 | `(progn 190 | (register-game-resource ',name ,path () :font :type :ttf) 191 | (autoprepare ',name))) 192 | 193 | 194 | (defmacro define-text (name path &key encoding) 195 | `(progn 196 | (register-game-resource ',name ,path () 197 | :text :encoding ,(or encoding :utf-8)) 198 | (autoprepare ',name))) 199 | 200 | 201 | (defmacro define-binary (name path) 202 | `(progn 203 | (register-game-resource ',name ,path () :binary) 204 | (autoprepare ',name))) 205 | -------------------------------------------------------------------------------- /src/utils.lisp: -------------------------------------------------------------------------------- 1 | (cl:in-package :trivial-gamekit) 2 | 3 | (deflogger (log 4 | (:name trivial-gamekit))) 5 | -------------------------------------------------------------------------------- /trivial-gamekit.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem trivial-gamekit 2 | :description "Simple facade for cl-bodge functionality" 3 | :version "1.0.0" 4 | :author "Pavel Korolev" 5 | :mailto "dev@borodust.org" 6 | :license "MIT" 7 | :depends-on (log4cl bodge-utilities 8 | cl-bodge/graphics 9 | cl-bodge/audio 10 | cl-bodge/host 11 | cl-bodge/resources 12 | cl-bodge/canvas 13 | cl-bodge/appkit 14 | uiop cl-muth cl-fad cl-muth) 15 | :pathname "src/" 16 | :serial t 17 | :components ((:file "packages") 18 | (:file "utils") 19 | (:file "resources") 20 | (:file "gamekit"))) 21 | 22 | 23 | (asdf:defsystem trivial-gamekit/distribution 24 | :description "Distribution facilities for trivial-gamekit" 25 | :version "1.0.0" 26 | :author "Pavel Korolev" 27 | :mailto "dev@borodust.org" 28 | :license "MIT" 29 | :depends-on (trivial-gamekit cl-bodge/distribution) 30 | :pathname "distrib/" 31 | :serial t 32 | :components ((:file "distribution"))) 33 | 34 | 35 | (asdf:defsystem trivial-gamekit/documentation 36 | :description "Documentation for trivial-gamekit" 37 | :version "1.0.0" 38 | :author "Pavel Korolev" 39 | :mailto "dev@borodust.org" 40 | :license "MIT" 41 | :depends-on (doxy alexandria cl-mustache trivial-gamekit trivial-gamekit/distribution trivial-docstring) 42 | :pathname "docs/" 43 | :serial t 44 | :components ((:file "packages") 45 | (:file "bodge") 46 | (:file "gamekit") 47 | (:file "renderer"))) 48 | --------------------------------------------------------------------------------