├── .VERSION_PREFIX ├── .dir-locals.el ├── .gitignore ├── CHANGELOG.md ├── LICENSE.txt ├── README.md ├── bb.edn ├── bin ├── kaocha └── proj ├── deps.edn ├── dev └── user.clj ├── notes.org ├── package.json ├── pom.xml ├── repl_sessions └── svd.clj ├── resources ├── 0x72_DungeonTilesetII_v1.3.png └── Fireball_68x9.png ├── shadow-cljs.edn ├── src └── lambdaisland │ ├── cljbox2d.cljc │ ├── cljbox2d │ ├── camera.cljc │ ├── clojure2d.clj │ ├── data_printer.cljc │ ├── demo │ │ ├── clojure2d │ │ │ ├── pinball.clj │ │ │ ├── pyramid.clj │ │ │ ├── simple_shapes.clj │ │ │ └── template.clj │ │ ├── hello_cljbox2d.clj │ │ ├── platformer.clj │ │ ├── pyramid.clj │ │ ├── simple_shapes.cljc │ │ ├── template.cljc │ │ └── testbed.clj │ ├── math.cljc │ ├── quil.cljc │ └── svd.clj │ └── quil_extras.clj └── tests.edn /.VERSION_PREFIX: -------------------------------------------------------------------------------- 1 | 0.8 -------------------------------------------------------------------------------- /.dir-locals.el: -------------------------------------------------------------------------------- 1 | ((nil . ((cider-clojure-cli-global-options . "-A:cljs:quil4:testbed:test:clojure2d") 2 | (cider-custom-cljs-repl-init-form . "(user/cljs-repl)") 3 | (cider-default-cljs-repl . custom) 4 | (cider-preferred-build-tool . clojure-cli) 5 | (cider-redirect-server-output-to-repl . t) 6 | (cider-repl-display-help-banner . nil) 7 | (clojure-toplevel-inside-comment-form . t) 8 | ;; (eval . (progn 9 | ;; (make-variable-buffer-local 'cider-jack-in-nrepl-middlewares) 10 | ;; (add-to-list 'cider-jack-in-nrepl-middlewares "shadow.cljs.devtools.server.nrepl/middleware"))) 11 | (eval . (define-clojure-indent 12 | (assoc 0) 13 | (ex-info 0)))))) 14 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .cpcache 2 | .nrepl-port 3 | target 4 | repl 5 | scratch.clj 6 | .shadow-cljs 7 | target 8 | yarn.lock 9 | node_modules/ 10 | .DS_Store 11 | resources/public/ui 12 | .store 13 | package-lock.json 14 | resources/public/index.html 15 | JBox2d.log 16 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Unreleased 2 | 3 | ## Added 4 | 5 | ## Fixed 6 | 7 | ## Changed 8 | 9 | - Bumped dependencies 10 | 11 | # 0.8.46 (2023-03-01 / ef4c8e8) 12 | 13 | ## Added 14 | 15 | - Add a null-implementation for `joints` to `Contact`, so `find-by` works on 16 | `Contact` instances 17 | 18 | # 0.7.43 (2023-03-01 / 7c1ad72) 19 | 20 | ## Added 21 | 22 | - Added two-arity version of `apply-impulse!`, defaults to `wake? false` 23 | - Implement `joints` for body instances. This returns `nil`, since joints are 24 | part of the world, but it allows code to recurse safely by calling `bodies` 25 | and `joints` on various entities 26 | 27 | ## Fixed 28 | 29 | - Make return type tags in protocols fully qualified, Clojure seems to like that 30 | better 31 | - Fix PrismaticJointDef creation, some vector fields are final, we can only 32 | mutate the existing instance 33 | - Wrap `destroy` in a mutex, to allow for rendering of a consistent world view 34 | - Prevent exceptions in the Clojure2D renderer when the world is being changed 35 | underneath it 36 | - Fix 2-arity circle shape constructor 37 | 38 | ## Changed 39 | 40 | - When adding bodies/joints that have an `:id`, remove any bodies/joints with 41 | the same `:id`. This is to ensure uniqueness, but also makes for a nicer REPL 42 | experience 43 | - When converting to edn (IValue), include :joints for world, and omit default 44 | values for body 45 | 46 | # 0.6.31 (2022-03-14 / 8d5ff0e) 47 | 48 | ## Added 49 | 50 | - [Clojure2d](https://github.com/Clojure2D/clojure2d) support 51 | - `math/vec-mul`, and shorter math aliases (`v+`, `v*`, `m*`, etc) 52 | 53 | ## Changed 54 | 55 | - Breaking! Return maps from `raycast-seq`, rather than fixtures, allow setting 56 | raycast-callback return value to set filtering behavior. 57 | 58 | # 0.5.23 (2022-03-11 / 7b55d21) 59 | 60 | ## Fixed 61 | 62 | - Rewrite to a single :require form to appease cljdoc 63 | 64 | # 0.4.19 (2022-03-11 / 48f72c2) 65 | 66 | ## Fixed 67 | 68 | - Fix cljdoc build 69 | - Fix platformer demo, load images from resources (jar) instead of filesystem 70 | - Switch to Quil 4 snapshot 71 | 72 | # 0.1.9 (2022-03-11 / 9627741) 73 | 74 | ## Added 75 | 76 | - First release, with jBox2D (clj) and Planck.js (cljs) support 77 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Mozilla Public License Version 2.0 2 | ================================== 3 | 4 | 1. Definitions 5 | -------------- 6 | 7 | 1.1. "Contributor" 8 | means each individual or legal entity that creates, contributes to 9 | the creation of, or owns Covered Software. 10 | 11 | 1.2. "Contributor Version" 12 | means the combination of the Contributions of others (if any) used 13 | by a Contributor and that particular Contributor's Contribution. 14 | 15 | 1.3. "Contribution" 16 | means Covered Software of a particular Contributor. 17 | 18 | 1.4. "Covered Software" 19 | means Source Code Form to which the initial Contributor has attached 20 | the notice in Exhibit A, the Executable Form of such Source Code 21 | Form, and Modifications of such Source Code Form, in each case 22 | including portions thereof. 23 | 24 | 1.5. "Incompatible With Secondary Licenses" 25 | means 26 | 27 | (a) that the initial Contributor has attached the notice described 28 | in Exhibit B to the Covered Software; or 29 | 30 | (b) that the Covered Software was made available under the terms of 31 | version 1.1 or earlier of the License, but not also under the 32 | terms of a Secondary License. 33 | 34 | 1.6. "Executable Form" 35 | means any form of the work other than Source Code Form. 36 | 37 | 1.7. "Larger Work" 38 | means a work that combines Covered Software with other material, in 39 | a separate file or files, that is not Covered Software. 40 | 41 | 1.8. "License" 42 | means this document. 43 | 44 | 1.9. "Licensable" 45 | means having the right to grant, to the maximum extent possible, 46 | whether at the time of the initial grant or subsequently, any and 47 | all of the rights conveyed by this License. 48 | 49 | 1.10. "Modifications" 50 | means any of the following: 51 | 52 | (a) any file in Source Code Form that results from an addition to, 53 | deletion from, or modification of the contents of Covered 54 | Software; or 55 | 56 | (b) any new file in Source Code Form that contains any Covered 57 | Software. 58 | 59 | 1.11. "Patent Claims" of a Contributor 60 | means any patent claim(s), including without limitation, method, 61 | process, and apparatus claims, in any patent Licensable by such 62 | Contributor that would be infringed, but for the grant of the 63 | License, by the making, using, selling, offering for sale, having 64 | made, import, or transfer of either its Contributions or its 65 | Contributor Version. 66 | 67 | 1.12. "Secondary License" 68 | means either the GNU General Public License, Version 2.0, the GNU 69 | Lesser General Public License, Version 2.1, the GNU Affero General 70 | Public License, Version 3.0, or any later versions of those 71 | licenses. 72 | 73 | 1.13. "Source Code Form" 74 | means the form of the work preferred for making modifications. 75 | 76 | 1.14. "You" (or "Your") 77 | means an individual or a legal entity exercising rights under this 78 | License. For legal entities, "You" includes any entity that 79 | controls, is controlled by, or is under common control with You. For 80 | purposes of this definition, "control" means (a) the power, direct 81 | or indirect, to cause the direction or management of such entity, 82 | whether by contract or otherwise, or (b) ownership of more than 83 | fifty percent (50%) of the outstanding shares or beneficial 84 | ownership of such entity. 85 | 86 | 2. License Grants and Conditions 87 | -------------------------------- 88 | 89 | 2.1. Grants 90 | 91 | Each Contributor hereby grants You a world-wide, royalty-free, 92 | non-exclusive license: 93 | 94 | (a) under intellectual property rights (other than patent or trademark) 95 | Licensable by such Contributor to use, reproduce, make available, 96 | modify, display, perform, distribute, and otherwise exploit its 97 | Contributions, either on an unmodified basis, with Modifications, or 98 | as part of a Larger Work; and 99 | 100 | (b) under Patent Claims of such Contributor to make, use, sell, offer 101 | for sale, have made, import, and otherwise transfer either its 102 | Contributions or its Contributor Version. 103 | 104 | 2.2. Effective Date 105 | 106 | The licenses granted in Section 2.1 with respect to any Contribution 107 | become effective for each Contribution on the date the Contributor first 108 | distributes such Contribution. 109 | 110 | 2.3. Limitations on Grant Scope 111 | 112 | The licenses granted in this Section 2 are the only rights granted under 113 | this License. No additional rights or licenses will be implied from the 114 | distribution or licensing of Covered Software under this License. 115 | Notwithstanding Section 2.1(b) above, no patent license is granted by a 116 | Contributor: 117 | 118 | (a) for any code that a Contributor has removed from Covered Software; 119 | or 120 | 121 | (b) for infringements caused by: (i) Your and any other third party's 122 | modifications of Covered Software, or (ii) the combination of its 123 | Contributions with other software (except as part of its Contributor 124 | Version); or 125 | 126 | (c) under Patent Claims infringed by Covered Software in the absence of 127 | its Contributions. 128 | 129 | This License does not grant any rights in the trademarks, service marks, 130 | or logos of any Contributor (except as may be necessary to comply with 131 | the notice requirements in Section 3.4). 132 | 133 | 2.4. Subsequent Licenses 134 | 135 | No Contributor makes additional grants as a result of Your choice to 136 | distribute the Covered Software under a subsequent version of this 137 | License (see Section 10.2) or under the terms of a Secondary License (if 138 | permitted under the terms of Section 3.3). 139 | 140 | 2.5. Representation 141 | 142 | Each Contributor represents that the Contributor believes its 143 | Contributions are its original creation(s) or it has sufficient rights 144 | to grant the rights to its Contributions conveyed by this License. 145 | 146 | 2.6. Fair Use 147 | 148 | This License is not intended to limit any rights You have under 149 | applicable copyright doctrines of fair use, fair dealing, or other 150 | equivalents. 151 | 152 | 2.7. Conditions 153 | 154 | Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted 155 | in Section 2.1. 156 | 157 | 3. Responsibilities 158 | ------------------- 159 | 160 | 3.1. Distribution of Source Form 161 | 162 | All distribution of Covered Software in Source Code Form, including any 163 | Modifications that You create or to which You contribute, must be under 164 | the terms of this License. You must inform recipients that the Source 165 | Code Form of the Covered Software is governed by the terms of this 166 | License, and how they can obtain a copy of this License. You may not 167 | attempt to alter or restrict the recipients' rights in the Source Code 168 | Form. 169 | 170 | 3.2. Distribution of Executable Form 171 | 172 | If You distribute Covered Software in Executable Form then: 173 | 174 | (a) such Covered Software must also be made available in Source Code 175 | Form, as described in Section 3.1, and You must inform recipients of 176 | the Executable Form how they can obtain a copy of such Source Code 177 | Form by reasonable means in a timely manner, at a charge no more 178 | than the cost of distribution to the recipient; and 179 | 180 | (b) You may distribute such Executable Form under the terms of this 181 | License, or sublicense it under different terms, provided that the 182 | license for the Executable Form does not attempt to limit or alter 183 | the recipients' rights in the Source Code Form under this License. 184 | 185 | 3.3. Distribution of a Larger Work 186 | 187 | You may create and distribute a Larger Work under terms of Your choice, 188 | provided that You also comply with the requirements of this License for 189 | the Covered Software. If the Larger Work is a combination of Covered 190 | Software with a work governed by one or more Secondary Licenses, and the 191 | Covered Software is not Incompatible With Secondary Licenses, this 192 | License permits You to additionally distribute such Covered Software 193 | under the terms of such Secondary License(s), so that the recipient of 194 | the Larger Work may, at their option, further distribute the Covered 195 | Software under the terms of either this License or such Secondary 196 | License(s). 197 | 198 | 3.4. Notices 199 | 200 | You may not remove or alter the substance of any license notices 201 | (including copyright notices, patent notices, disclaimers of warranty, 202 | or limitations of liability) contained within the Source Code Form of 203 | the Covered Software, except that You may alter any license notices to 204 | the extent required to remedy known factual inaccuracies. 205 | 206 | 3.5. Application of Additional Terms 207 | 208 | You may choose to offer, and to charge a fee for, warranty, support, 209 | indemnity or liability obligations to one or more recipients of Covered 210 | Software. However, You may do so only on Your own behalf, and not on 211 | behalf of any Contributor. You must make it absolutely clear that any 212 | such warranty, support, indemnity, or liability obligation is offered by 213 | You alone, and You hereby agree to indemnify every Contributor for any 214 | liability incurred by such Contributor as a result of warranty, support, 215 | indemnity or liability terms You offer. You may include additional 216 | disclaimers of warranty and limitations of liability specific to any 217 | jurisdiction. 218 | 219 | 4. Inability to Comply Due to Statute or Regulation 220 | --------------------------------------------------- 221 | 222 | If it is impossible for You to comply with any of the terms of this 223 | License with respect to some or all of the Covered Software due to 224 | statute, judicial order, or regulation then You must: (a) comply with 225 | the terms of this License to the maximum extent possible; and (b) 226 | describe the limitations and the code they affect. Such description must 227 | be placed in a text file included with all distributions of the Covered 228 | Software under this License. Except to the extent prohibited by statute 229 | or regulation, such description must be sufficiently detailed for a 230 | recipient of ordinary skill to be able to understand it. 231 | 232 | 5. Termination 233 | -------------- 234 | 235 | 5.1. The rights granted under this License will terminate automatically 236 | if You fail to comply with any of its terms. However, if You become 237 | compliant, then the rights granted under this License from a particular 238 | Contributor are reinstated (a) provisionally, unless and until such 239 | Contributor explicitly and finally terminates Your grants, and (b) on an 240 | ongoing basis, if such Contributor fails to notify You of the 241 | non-compliance by some reasonable means prior to 60 days after You have 242 | come back into compliance. Moreover, Your grants from a particular 243 | Contributor are reinstated on an ongoing basis if such Contributor 244 | notifies You of the non-compliance by some reasonable means, this is the 245 | first time You have received notice of non-compliance with this License 246 | from such Contributor, and You become compliant prior to 30 days after 247 | Your receipt of the notice. 248 | 249 | 5.2. If You initiate litigation against any entity by asserting a patent 250 | infringement claim (excluding declaratory judgment actions, 251 | counter-claims, and cross-claims) alleging that a Contributor Version 252 | directly or indirectly infringes any patent, then the rights granted to 253 | You by any and all Contributors for the Covered Software under Section 254 | 2.1 of this License shall terminate. 255 | 256 | 5.3. In the event of termination under Sections 5.1 or 5.2 above, all 257 | end user license agreements (excluding distributors and resellers) which 258 | have been validly granted by You or Your distributors under this License 259 | prior to termination shall survive termination. 260 | 261 | ************************************************************************ 262 | * * 263 | * 6. Disclaimer of Warranty * 264 | * ------------------------- * 265 | * * 266 | * Covered Software is provided under this License on an "as is" * 267 | * basis, without warranty of any kind, either expressed, implied, or * 268 | * statutory, including, without limitation, warranties that the * 269 | * Covered Software is free of defects, merchantable, fit for a * 270 | * particular purpose or non-infringing. The entire risk as to the * 271 | * quality and performance of the Covered Software is with You. * 272 | * Should any Covered Software prove defective in any respect, You * 273 | * (not any Contributor) assume the cost of any necessary servicing, * 274 | * repair, or correction. This disclaimer of warranty constitutes an * 275 | * essential part of this License. No use of any Covered Software is * 276 | * authorized under this License except under this disclaimer. * 277 | * * 278 | ************************************************************************ 279 | 280 | ************************************************************************ 281 | * * 282 | * 7. Limitation of Liability * 283 | * -------------------------- * 284 | * * 285 | * Under no circumstances and under no legal theory, whether tort * 286 | * (including negligence), contract, or otherwise, shall any * 287 | * Contributor, or anyone who distributes Covered Software as * 288 | * permitted above, be liable to You for any direct, indirect, * 289 | * special, incidental, or consequential damages of any character * 290 | * including, without limitation, damages for lost profits, loss of * 291 | * goodwill, work stoppage, computer failure or malfunction, or any * 292 | * and all other commercial damages or losses, even if such party * 293 | * shall have been informed of the possibility of such damages. This * 294 | * limitation of liability shall not apply to liability for death or * 295 | * personal injury resulting from such party's negligence to the * 296 | * extent applicable law prohibits such limitation. Some * 297 | * jurisdictions do not allow the exclusion or limitation of * 298 | * incidental or consequential damages, so this exclusion and * 299 | * limitation may not apply to You. * 300 | * * 301 | ************************************************************************ 302 | 303 | 8. Litigation 304 | ------------- 305 | 306 | Any litigation relating to this License may be brought only in the 307 | courts of a jurisdiction where the defendant maintains its principal 308 | place of business and such litigation shall be governed by laws of that 309 | jurisdiction, without reference to its conflict-of-law provisions. 310 | Nothing in this Section shall prevent a party's ability to bring 311 | cross-claims or counter-claims. 312 | 313 | 9. Miscellaneous 314 | ---------------- 315 | 316 | This License represents the complete agreement concerning the subject 317 | matter hereof. If any provision of this License is held to be 318 | unenforceable, such provision shall be reformed only to the extent 319 | necessary to make it enforceable. Any law or regulation which provides 320 | that the language of a contract shall be construed against the drafter 321 | shall not be used to construe this License against a Contributor. 322 | 323 | 10. Versions of the License 324 | --------------------------- 325 | 326 | 10.1. New Versions 327 | 328 | Mozilla Foundation is the license steward. Except as provided in Section 329 | 10.3, no one other than the license steward has the right to modify or 330 | publish new versions of this License. Each version will be given a 331 | distinguishing version number. 332 | 333 | 10.2. Effect of New Versions 334 | 335 | You may distribute the Covered Software under the terms of the version 336 | of the License under which You originally received the Covered Software, 337 | or under the terms of any subsequent version published by the license 338 | steward. 339 | 340 | 10.3. Modified Versions 341 | 342 | If you create software not governed by this License, and you want to 343 | create a new license for such software, you may create and use a 344 | modified version of this License if you rename the license and remove 345 | any references to the name of the license steward (except to note that 346 | such modified license differs from this License). 347 | 348 | 10.4. Distributing Source Code Form that is Incompatible With Secondary 349 | Licenses 350 | 351 | If You choose to distribute Source Code Form that is Incompatible With 352 | Secondary Licenses under the terms of this version of the License, the 353 | notice described in Exhibit B of this License must be attached. 354 | 355 | Exhibit A - Source Code Form License Notice 356 | ------------------------------------------- 357 | 358 | This Source Code Form is subject to the terms of the Mozilla Public 359 | License, v. 2.0. If a copy of the MPL was not distributed with this 360 | file, You can obtain one at http://mozilla.org/MPL/2.0/. 361 | 362 | If it is not possible or desirable to put the notice in a particular 363 | file, then You may include the notice in a location (such as a LICENSE 364 | file in a relevant directory) where a recipient would be likely to look 365 | for such a notice. 366 | 367 | You may add additional accurate notices of copyright ownership. 368 | 369 | Exhibit B - "Incompatible With Secondary Licenses" Notice 370 | --------------------------------------------------------- 371 | 372 | This Source Code Form is "Incompatible With Secondary Licenses", as 373 | defined by the Mozilla Public License, v. 2.0. 374 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # cljbox2d 2 | 3 | 4 | [![cljdoc badge](https://cljdoc.org/badge/com.lambdaisland/cljbox2d)](https://cljdoc.org/d/com.lambdaisland/cljbox2d) [![Clojars Project](https://img.shields.io/clojars/v/com.lambdaisland/cljbox2d.svg)](https://clojars.org/com.lambdaisland/cljbox2d) 5 | 6 | 7 | Idiomatic and cross-platform Clojure version of the Box2D physics engine API. Wraps jBox2D (Clojure) and Planck.js (ClojureScript). 8 | 9 | Box2D is just a physics engine, you most likely want to combine it with a 10 | graphics library to show something on the screen. We bundle some helpers to get 11 | you started on [Quil](http://quil.info/) or 12 | [Clojure2D](https://github.com/Clojure2D/clojure2d), see the namespaces 13 | `lambdaisland.cljbox2d.quil` or `lambdaisland.cljbox2d.clojure2d` respectively, 14 | or browse the examples under `lambdaisland.cljbox2d.demo.*` 15 | 16 | ## Rationale 17 | 18 | The Box2D API is highly imperative, to create a body or a fixture you first 19 | create a BodyDef or FixtureDef object, call a bunch of setters to set the right 20 | parameters, then use that to construct the actual object. Yuck. 21 | 22 | For us it's all just data. For comparison 23 | 24 | ```c++ 25 | ;; create bodyDef 26 | b2BodyDef groundBodyDef; 27 | groundBodyDef.position.Set(0.0f, -10.0f); 28 | 29 | ;; use it to create a body 30 | b2Body* groundBody = world.CreateBody(&groundBodyDef); 31 | 32 | ;; Add a fixture 33 | b2PolygonShape groundBox; 34 | groundBox.SetAsBox(50.0f, 10.0f); 35 | groundBody->CreateFixture(&groundBox, 0.0f); 36 | ``` 37 | 38 | With cljbox2d: 39 | 40 | ```clojure 41 | (b/populate world [{:position [0 -10] 42 | :fixtures [{:shape [:rect 50 10]}]}]) 43 | ``` 44 | 45 | ## Demos 46 | 47 | Run these commands to see cljbox2d in action: 48 | 49 | ``` 50 | clojure -Sdeps '{:deps {com.lambdaisland/cljbox2d {:mvn/version "0.8.46"} quil/quil {:mvn/version "4.0.0-SNAPSHOT"}}}' -M -m lambdaisland.cljbox2d.demo.simple-shapes 51 | clojure -Sdeps '{:deps {com.lambdaisland/cljbox2d {:mvn/version "0.8.46"} quil/quil {:mvn/version "4.0.0-SNAPSHOT"}}}' -M -m lambdaisland.cljbox2d.demo.pyramid 52 | clojure -Sdeps '{:deps {com.lambdaisland/cljbox2d {:mvn/version "0.8.46"} quil/quil {:mvn/version "4.0.0-SNAPSHOT"}}}' -M -m lambdaisland.cljbox2d.demo.platformer 53 | ``` 54 | 55 | Or if you already have a REPL open then simply open any of the 56 | `lambdaisland.cljbox2d.demo.*` namespaces, evaluate them, and then run the 57 | `(-main)` function. 58 | 59 | ```clj 60 | (require 'lambdaisland.cljbox2d.demo.pyramid) 61 | (lambdaisland.cljbox2d.demo.pyramid/-main) 62 | ``` 63 | 64 | To start your own project you can copy `lambdaisland.cljbox2d.demo.template` 65 | (for Quil) or `lambdaisland.cljbox2d.demo.clojure2d.template` (for Clojure2D) 66 | over to your own project and take it from there. 67 | 68 | 69 | ## Installation 70 | 71 | To use the latest release, add the following to your `deps.edn` ([Clojure CLI](https://clojure.org/guides/deps_and_cli)) 72 | 73 | ``` 74 | com.lambdaisland/cljbox2d {:mvn/version "0.8.46"} 75 | ``` 76 | 77 | or add the following to your `project.clj` ([Leiningen](https://leiningen.org/)) 78 | 79 | ``` 80 | [com.lambdaisland/cljbox2d "0.8.46"] 81 | ``` 82 | 83 | 84 | You will also need a library to deal with graphics and user interaction. If unsure you can start with [Quil](http://quil.info/). 85 | 86 | ## Getting started 87 | 88 | There's a 89 | [template](https://github.com/lambdaisland/cljbox2d/blob/main/src/lambdaisland/cljbox2d/demo/template.cljc) 90 | file that you can use to set up your first project with cljbox2d and Quil. 91 | 92 | You'll want to learn about the main Box2D concepts: bodies, shapes, fixtures, 93 | and joints. The clearest explanation I've come across is in these iForce2D 94 | tutorials: [bodies](https://www.iforce2d.net/b2dtut/bodies), [fixtures & 95 | shapes](https://www.iforce2d.net/b2dtut/fixtures). There are also the official 96 | [Box2D docs](https://box2d.org/documentation/). Until we get more comprehensive 97 | documentation of our own together you'll have to make due with these, and the 98 | convert to cljbox2d. 99 | 100 | The 101 | [demos](https://github.com/lambdaisland/cljbox2d/tree/main/src/lambdaisland/cljbox2d/demo) 102 | contain a number of examples you can study, from trivial (template, 103 | simple-shapes, pyramid), to more full-fledged (platformer). 104 | 105 | ## Writing portable code 106 | 107 | The following jBox2D features are not supported by planck.js 108 | 109 | - ConstantVolumeJoin 110 | - Particles (and thus particle raycast) 111 | 112 | 113 | ## Lambda Island Open Source 114 | 115 | 116 | 117 |   118 | 119 | cljbox2d is part of a growing collection of quality Clojure libraries created and maintained 120 | by the fine folks at [Gaiwan](https://gaiwan.co). 121 | 122 | Pay it forward by [becoming a backer on our Open Collective](http://opencollective.com/lambda-island), 123 | so that we may continue to enjoy a thriving Clojure ecosystem. 124 | 125 | You can find an overview of our projects at [lambdaisland/open-source](https://github.com/lambdaisland/open-source). 126 | 127 |   128 | 129 |   130 | 131 | 132 | 133 | ## Contributing 134 | 135 | Everyone has a right to submit patches to cljbox2d, and thus become a contributor. 136 | 137 | Contributors MUST 138 | 139 | - adhere to the [LambdaIsland Clojure Style Guide](https://nextjournal.com/lambdaisland/clojure-style-guide) 140 | - write patches that solve a problem. Start by stating the problem, then supply a minimal solution. `*` 141 | - agree to license their contributions as MPL 2.0. 142 | - not break the contract with downstream consumers. `**` 143 | - not break the tests. 144 | 145 | Contributors SHOULD 146 | 147 | - update the CHANGELOG and README. 148 | - add tests for new functionality. 149 | 150 | If you submit a pull request that adheres to these rules, then it will almost 151 | certainly be merged immediately. However some things may require more 152 | consideration. If you add new dependencies, or significantly increase the API 153 | surface, then we need to decide if these changes are in line with the project's 154 | goals. In this case you can start by [writing a pitch](https://nextjournal.com/lambdaisland/pitch-template), 155 | and collecting feedback on it. 156 | 157 | `*` This goes for features too, a feature needs to solve a problem. State the problem it solves, then supply a minimal solution. 158 | 159 | `**` As long as this project has not seen a public release (i.e. is not on Clojars) 160 | we may still consider making breaking changes, if there is consensus that the 161 | changes are justified. 162 | 163 | 164 | 165 | ## License 166 | 167 | Copyright © 2021-2022 Arne Brasseur and Contributors 168 | 169 | Licensed under the term of the Mozilla Public License 2.0, see LICENSE. 170 | 171 | -------------------------------------------------------------------------------- /bb.edn: -------------------------------------------------------------------------------- 1 | {:deps 2 | {lambdaisland/open-source {:git/url "https://github.com/lambdaisland/open-source" 3 | :git/sha "5ae5327ff37b45228a40a3981fa83ad151bedf3c"}}} 4 | -------------------------------------------------------------------------------- /bin/kaocha: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | clojure -A:test -m kaocha.runner "$@" 3 | -------------------------------------------------------------------------------- /bin/proj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bb 2 | 3 | (ns proj (:require [lioss.main :as lioss])) 4 | 5 | (lioss/main 6 | {:license :mpl 7 | :inception-year 2021 8 | :description "Clojure/ClojureScript wrapper for the Box2D physics engine" 9 | :group-id "com.lambdaisland" 10 | :aliases-as-scope-provided [:quil4 :clojure2d :testbed]}) 11 | 12 | ;; Local Variables: 13 | ;; mode:clojure 14 | ;; End: 15 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src" "resources"] 2 | 3 | :deps 4 | {lambdaisland/data-printers {:mvn/version "0.7.47"} 5 | lambdaisland/jbox2d-library {:mvn/version "2.3.1.756"} 6 | org.apache.commons/commons-math3 {:mvn/version "3.6.1"}} 7 | 8 | :aliases 9 | {:testbed 10 | {:extra-deps {lambdaisland/jbox2d-testbed-jogl {:mvn/version "2.3.1.756"} 11 | lambdaisland/jbox2d-testbed {:mvn/version "2.3.1.756"}}} 12 | 13 | :quil 14 | {:extra-deps {quil/quil {:mvn/version "3.1.0"}}} 15 | 16 | :quil4 17 | {:extra-deps {quil/quil {:mvn/version "4.0.0-SNAPSHOT"}}} 18 | 19 | :clojure2d 20 | {:extra-deps {clojure2d/clojure2d {:mvn/version "1.4.5-SNAPSHOT"}}} 21 | 22 | :cljs 23 | {:extra-paths ["dev"] 24 | :extra-deps {thheller/shadow-cljs {:mvn/version "2.22.0"}}} 25 | 26 | :test 27 | {:extra-paths ["test"] 28 | :extra-deps {lambdaisland/kaocha {:mvn/version "1.80.1274"}}}}} 29 | -------------------------------------------------------------------------------- /dev/user.clj: -------------------------------------------------------------------------------- 1 | (ns user) 2 | 3 | (defmacro jit [sym] 4 | `(requiring-resolve '~sym)) 5 | 6 | (defn cljs-repl 7 | ([] 8 | (cljs-repl :main)) 9 | ([build-id] 10 | ((jit shadow.cljs.devtools.server/start!)) 11 | ((jit shadow.cljs.devtools.api/watch) build-id) 12 | (loop [] 13 | (when (nil? @@(jit shadow.cljs.devtools.server.runtime/instance-ref)) 14 | (Thread/sleep 250) 15 | (recur))) 16 | ((jit shadow.cljs.devtools.api/nrepl-select) build-id))) 17 | 18 | (defn browse [] 19 | ((jit clojure.java.browse/browse-url) "http://localhost:8000")) 20 | -------------------------------------------------------------------------------- /notes.org: -------------------------------------------------------------------------------- 1 | - https://www.gamedesigning.org/engines/box2d/ 2 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "dependencies": { 3 | "p5": "^1.2.0", 4 | "planck-js": "^0.3.23", 5 | "react": "17.0.1", 6 | "react-dom": "17.0.1" 7 | } 8 | } 9 | -------------------------------------------------------------------------------- /pom.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4.0.0 4 | com.lambdaisland 5 | cljbox2d 6 | 0.8.46 7 | cljbox2d 8 | Clojure/ClojureScript wrapper for the Box2D physics engine 9 | https://github.com/lambdaisland/cljbox2d 10 | 2021 11 | 12 | Lambda Island 13 | https://lambdaisland.com 14 | 15 | 16 | UTF-8 17 | 18 | 19 | 20 | MPL-2.0 21 | https://www.mozilla.org/media/MPL/2.0/index.txt 22 | 23 | 24 | 25 | https://github.com/lambdaisland/cljbox2d 26 | scm:git:git://github.com/lambdaisland/cljbox2d.git 27 | scm:git:ssh://git@github.com/lambdaisland/cljbox2d.git 28 | 204b434642f5cb0de6cb63e460d5115802f40047 29 | 30 | 31 | 32 | lambdaisland 33 | data-printers 34 | 0.7.47 35 | 36 | 37 | lambdaisland 38 | jbox2d-library 39 | 2.3.1.756 40 | 41 | 42 | org.apache.commons 43 | commons-math3 44 | 3.6.1 45 | 46 | 47 | quil 48 | quil 49 | 4.0.0-SNAPSHOT 50 | provided 51 | 52 | 53 | clojure2d 54 | clojure2d 55 | 1.4.4-SNAPSHOT 56 | provided 57 | 58 | 59 | lambdaisland 60 | jbox2d-testbed-jogl 61 | 2.3.1.756 62 | provided 63 | 64 | 65 | lambdaisland 66 | jbox2d-testbed 67 | 2.3.1.756 68 | provided 69 | 70 | 71 | 72 | src 73 | 74 | 75 | src 76 | 77 | 78 | resources 79 | 80 | 81 | 82 | 83 | org.apache.maven.plugins 84 | maven-compiler-plugin 85 | 3.8.1 86 | 87 | 1.8 88 | 1.8 89 | 90 | 91 | 92 | org.apache.maven.plugins 93 | maven-jar-plugin 94 | 3.2.0 95 | 96 | 97 | 98 | 204b434642f5cb0de6cb63e460d5115802f40047 99 | 100 | 101 | 102 | 103 | 104 | org.apache.maven.plugins 105 | maven-gpg-plugin 106 | 1.6 107 | 108 | 109 | sign-artifacts 110 | verify 111 | 112 | sign 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | clojars 122 | https://repo.clojars.org/ 123 | 124 | 125 | 126 | 127 | clojars 128 | Clojars repository 129 | https://clojars.org/repo 130 | 131 | 132 | -------------------------------------------------------------------------------- /repl_sessions/svd.clj: -------------------------------------------------------------------------------- 1 | (ns svd 2 | (:import (org.apache.commons.math3.linear MatrixUtils 3 | RealMatrix 4 | SingularValueDecomposition) 5 | (org.jbox2d.common Mat22))) 6 | 7 | (set! *warn-on-reflection* true) ;; To avoid accidental reflection 8 | 9 | #_(defmacro aget2d [a i j] 10 | `(aget ^"[D" (aget ~a ~i) ~j)) 11 | 12 | (defmacro aset2d [a i j v] 13 | `(aset ^"[D" (aget ~a ~i) ~j ~v)) 14 | 15 | (defn make-matrix [vals] 16 | (MatrixUtils/createRealMatrix 17 | (let [^"[[D" a (make-array Double/TYPE (count vals) (count (first vals)))] 18 | (dotimes [i (count vals)] 19 | (dotimes [j (count (first vals))] 20 | (aset2d a i j (get-in vals [i j])))) 21 | a))) 22 | 23 | (make-matrix [[1.0 2.0] [3.0 4.0]]) 24 | 25 | (def camera 26 | (let [m (Mat22/mul (Mat22/createRotationalTransform 1.5) 27 | ;; => #object[org.jbox2d.common.Mat22 0x6eea72a1 "[0.07078076595527008,-0.9974921571471675]\n[0.9974921571471675,0.07078076595527008]"] 28 | (Mat22/createScaleTransform 20) 29 | ;; => #object[org.jbox2d.common.Mat22 0x608f850 "[20.0,0.0]\n[0.0,20.0]"] 30 | )] 31 | )) 32 | 33 | (def svd (SingularValueDecomposition. camera)) 34 | 35 | (.getU svd) 36 | ;; => #object[org.apache.commons.math3.linear.Array2DRowRealMatrix 0x270a112c "Array2DRowRealMatrix{{-0.9974918976,-0.0707807475},{0.0707807475,-0.9974918976}}"] 37 | (.getV svd) 38 | ;; => #object[org.apache.commons.math3.linear.Array2DRowRealMatrix 0x3d80d4d7 "Array2DRowRealMatrix{{0.0,-1.0},{1.0,-0.0}}"] 39 | (.getS svd) 40 | ;; => #object[org.apache.commons.math3.linear.Array2DRowRealMatrix 0x75341449 "Array2DRowRealMatrix{{20.000005204,0.0},{0.0,20.000005204}}"] 41 | -------------------------------------------------------------------------------- /resources/0x72_DungeonTilesetII_v1.3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lambdaisland/cljbox2d/951c63563ea4e637462ced247f84cd6492648333/resources/0x72_DungeonTilesetII_v1.3.png -------------------------------------------------------------------------------- /resources/Fireball_68x9.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lambdaisland/cljbox2d/951c63563ea4e637462ced247f84cd6492648333/resources/Fireball_68x9.png -------------------------------------------------------------------------------- /shadow-cljs.edn: -------------------------------------------------------------------------------- 1 | {:deps 2 | {:aliases [:dev]} 3 | 4 | :dev-http 5 | {8000 "classpath:public"} 6 | 7 | :builds 8 | {:main 9 | {:target :browser 10 | :modules {:main {:entries [cljbox2d.demo]}} 11 | :output-dir "resources/public/ui" 12 | :asset-path "/ui" 13 | :devtools {:repl-pprint true}}}} 14 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d.cljc: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d 2 | #?(:clj (:require [lambdaisland.cljbox2d.data-printer :as data-printer] 3 | [lambdaisland.cljbox2d.camera :as camera] 4 | [lambdaisland.cljbox2d.math :as math] 5 | [lambdaisland.cljbox2d.svd :as svd]) 6 | :cljs (:require [lambdaisland.cljbox2d.data-printer :as data-printer] 7 | [lambdaisland.cljbox2d.camera :as camera] 8 | [lambdaisland.cljbox2d.math :as math] 9 | ["planck-js" :as planck] 10 | ["planck-js/lib/common/Vec2" :as Vec2] 11 | ["planck-js/lib/common/Mat22" :as Mat22] 12 | ["planck-js/lib/common/Transform" :as Transform] 13 | ["planck-js/lib/common/Rot" :as Rot] 14 | ["planck-js/lib/World" :as World] 15 | ["planck-js/lib/Body" :as Body] 16 | ["planck-js/lib/Fixture" :as Fixture] 17 | ["planck-js/lib/Joint" :as Joint] 18 | ["planck-js/lib/Shape" :as Shape] 19 | ["planck-js/lib/shape/CircleShape" :as CircleShape] 20 | ["planck-js/lib/shape/EdgeShape" :as EdgeShape] 21 | ["planck-js/lib/shape/PolygonShape" :as PolygonShape] 22 | ["planck-js/lib/shape/ChainShape" :as ChainShape] 23 | ["planck-js/lib/shape/BoxShape" :as BoxShape] 24 | ["planck-js/lib/joint/DistanceJoint" :as DistanceJoint] 25 | ["planck-js/lib/joint/FrictionJoint" :as FrictionJoint] 26 | ["planck-js/lib/joint/GearJoint" :as GearJoint] 27 | ["planck-js/lib/joint/MotorJoint" :as MotorJoint] 28 | ["planck-js/lib/joint/MouseJoint" :as MouseJoint] 29 | ["planck-js/lib/joint/PrismaticJoint" :as PrismaticJoint] 30 | ["planck-js/lib/joint/PulleyJoint" :as PulleyJoint] 31 | ["planck-js/lib/joint/RevoluteJoint" :as RevoluteJoint] 32 | ["planck-js/lib/joint/RopeJoint" :as RopeJoint] 33 | ["planck-js/lib/joint/WeldJoint" :as WeldJoint] 34 | ["planck-js/lib/joint/WheelJoint" :as WheelJoint])) 35 | #?(:clj 36 | (:import (org.jbox2d.collision.shapes Shape 37 | ShapeType 38 | CircleShape 39 | EdgeShape 40 | PolygonShape 41 | ChainShape) 42 | (org.jbox2d.common Vec2 Mat22 Transform OBBViewportTransform Rot) 43 | (org.jbox2d.dynamics World 44 | Body 45 | BodyDef 46 | BodyType 47 | Filter 48 | Fixture 49 | FixtureDef) 50 | (org.jbox2d.dynamics.contacts Contact) 51 | (org.jbox2d.dynamics.joints ConstantVolumeJointDef 52 | DistanceJointDef 53 | FrictionJointDef 54 | GearJointDef 55 | Joint 56 | JointDef 57 | MotorJointDef 58 | MouseJointDef 59 | PrismaticJointDef 60 | PulleyJointDef 61 | RevoluteJointDef 62 | RopeJointDef 63 | WeldJointDef 64 | WheelJointDef) 65 | (org.jbox2d.callbacks RayCastCallback 66 | ParticleRaycastCallback 67 | QueryCallback 68 | ContactListener)))) 69 | 70 | #?(:clj 71 | (do 72 | (set! *warn-on-reflection* true) 73 | (set! *unchecked-math* :warn-on-boxed)) 74 | :cljs 75 | (set! *warn-on-infer* true)) 76 | 77 | (def ^:dynamic *camera* (camera/camera 0 0 100)) ;; 1 meter = 100px 78 | 79 | (defprotocol IValue 80 | (value [_])) 81 | 82 | (defprotocol IProperty 83 | (body ^org.jbox2d.dynamics.Body [_]) 84 | (angle [_]) 85 | (position ^org.jbox2d.common.Vec2 [_]) 86 | (fixture ^org.jbox2d.dynamics.Fixture [_]) 87 | (shape ^org.jbox2d.collision.shapes.Shape [_]) 88 | (centroid [_] "Local position of a shape/fixture inside a body") 89 | (bodies [_]) 90 | (fixtures [_]) 91 | (joints [_]) 92 | (vertices [_]) 93 | (user-data [_]) 94 | (gravity [_]) 95 | (density [_]) 96 | (filter-data [_]) 97 | (friction [_]) 98 | (sensor? [_]) 99 | (restitution [_]) 100 | (transform ^Mat22 [_]) 101 | (fixed-rotation? [_]) 102 | (bullet? [_]) 103 | (radius [_]) 104 | (awake? [_]) 105 | (linear-velocity [_]) 106 | (angular-velocity [_]) 107 | (world-center [_]) 108 | (zoom [_])) 109 | 110 | (defprotocol IOperations 111 | (move-to! [_ v]) 112 | (move-by! [_ v]) 113 | (zoom! [_ f]) 114 | (zoom+! [_ f]) 115 | (ctl1! [entity k v] "Generically control properties") 116 | (alter-user-data*! [entity f args]) 117 | (apply-force! [_ force] [_ force point]) 118 | (apply-torque! [_ torque]) 119 | (apply-impulse! [_ impulse] [_ impulse wake?] [_ impulse point wake?]) 120 | (apply-angular-impulse! [_ impulse])) 121 | 122 | (defn alter-user-data! [entity f & args] 123 | (alter-user-data*! entity f args)) 124 | 125 | (defprotocol ICoerce 126 | (as-vec2 ^org.jbox2d.common.Vec2 [_])) 127 | 128 | (extend-protocol IValue 129 | World 130 | (value [w] 131 | {:gravity (gravity w) 132 | :bodies (bodies w) 133 | :joints (joints w)}) 134 | Vec2 135 | (value [v] 136 | [(.-x v) (.-y v)]) 137 | Fixture 138 | (value [f] 139 | {:type (.getType f) 140 | :density (density f) 141 | :filter (filter-data f) 142 | :friction (friction f) 143 | :sensor? (sensor? f) 144 | :restitution (restitution f) 145 | :shape (shape f) 146 | :user-data (user-data f)}) 147 | Body 148 | (value [b] 149 | (cond-> {:position (position b) 150 | :fixtures (fixtures b) 151 | :transform (transform b)} 152 | (not= 0.0 (angle b)) 153 | (assoc :angle (angle b)) 154 | (fixed-rotation? b) 155 | (assoc :fixed-rotation? true) 156 | (bullet? b) 157 | (assoc :bullet? true) 158 | (seq (user-data b)) 159 | (assoc :user-data (user-data b)))) 160 | 161 | Shape 162 | (value [s] 163 | {:childCount (.getChildCount s) 164 | :radius (.getRadius s) 165 | :type (.getType s) 166 | :vertices (vertices s)}) 167 | PolygonShape 168 | (value [s] 169 | {:childCount (.getChildCount s) 170 | :normals (into [] (take (.-m_count s) (.-m_normals s))) 171 | :radius (.getRadius s) 172 | :type (.getType s) 173 | :vertices (vertices s)}) 174 | 175 | Transform 176 | (value [t] 177 | [(.-p t) (.-q t)]) 178 | Rot 179 | (value [r] 180 | {:sin (.-s r) 181 | :cos (.-c r)})) 182 | 183 | #?(:clj 184 | (extend-protocol IValue 185 | BodyDef 186 | (value [b] 187 | {:active (.-active b) 188 | :allow-sleep? (.-allowSleep b) 189 | :angle (.-angle b) 190 | :angular-damping (.-angularDamping b) 191 | :angular-velocity (.-angularVelocity b) 192 | :awake (.-awake b) 193 | :bullet (.-bullet b) 194 | :fixed-rotation (.-fixedRotation b) 195 | :gravity-scale (.-gravityScale b) 196 | :linear-damping (.-linearDamping b) 197 | :linear-velocity (.-linearVelocity b) 198 | :position (.-position b) 199 | :type (.-type b) 200 | :user-data (.-userData b)}) 201 | FixtureDef 202 | (value [f] 203 | {:density (.-density f) 204 | :filter (.-filter f) 205 | :friction (.-friction f) 206 | :sensor? (.-isSensor f) 207 | :restitution (.-restitution f) 208 | :shape (.-shape f) 209 | :user-data (.-userData f)}) 210 | Filter 211 | (value [f] 212 | {:category-bits (.-categoryBits f) 213 | :mask-bits (.-maskBits f) 214 | :group-index (.-groupIndex f)}))) 215 | 216 | (data-printer/register-print World 'box2d/world value) 217 | (data-printer/register-print Vec2 'box2d/vec2 value) 218 | (data-printer/register-print Fixture 'box2d/fixture value) 219 | (data-printer/register-print Body 'box2d/body value) 220 | (data-printer/register-print PolygonShape 'box2d/polygon-shape value) 221 | (data-printer/register-print Shape 'box2d/shape value) 222 | (data-printer/register-print Transform 'box2d/transform value) 223 | (data-printer/register-print Rot 'box2d/rot value) 224 | 225 | #?(:clj 226 | (do 227 | (data-printer/register-print BodyDef 'box2d/body-def value) 228 | (data-printer/register-print FixtureDef 'box2d/fixture-def value) 229 | (data-printer/register-print Filter 'box2d/filter value) 230 | (data-printer/register-print BodyType 'box2d/body-type str) 231 | (data-printer/register-print ShapeType 'box2d/shape-type str))) 232 | 233 | (defn vec2 ^Vec2 [^double x ^double y] 234 | (#?(:clj Vec2. 235 | :cljs planck/Vec2) x y)) 236 | 237 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 238 | ;; Shapes 239 | 240 | #?(:clj 241 | (defn- set-as-box 242 | ([^PolygonShape polygon-shape half-width half-height] 243 | (.setAsBox polygon-shape half-width half-height) 244 | polygon-shape) 245 | ([^PolygonShape polygon-shape half-width half-height center angle] 246 | (.setAsBox polygon-shape half-width half-height center angle) 247 | polygon-shape))) 248 | 249 | (defn rectangle 250 | ([^double w ^double h] 251 | #?(:clj (set-as-box (PolygonShape.) (/ w 2) (/ h 2)) 252 | :cljs (planck/Box (/ w 2) (/ h 2)))) 253 | ([^double w ^double h center angle] 254 | #?(:clj (set-as-box (PolygonShape.) (/ w 2) (/ h 2) (as-vec2 center) angle) 255 | :cljs (planck/Box (/ w 2) (/ h 2) (as-vec2 center) angle)))) 256 | 257 | (defmulti make-shape (fn [s] (when (vector? s) (first s)))) 258 | (defmethod make-shape :default [s] s) 259 | 260 | (defmethod make-shape :rect [[_ ^double width ^double height center angle]] 261 | (cond 262 | (and center angle) 263 | (rectangle width height center angle) 264 | center 265 | (rectangle width height center 0) 266 | :else 267 | (rectangle width height))) 268 | 269 | (defmethod make-shape :circle [[_ a b]] 270 | #?(:clj 271 | (let [s (CircleShape.)] 272 | (if b 273 | (do 274 | (.set (.-m_p s) (as-vec2 a)) 275 | (set! (.-m_radius s) b)) 276 | (set! (.-m_radius s) a)) 277 | s) 278 | :cljs 279 | (CircleShape. a b))) 280 | 281 | (defmethod make-shape :edge [[_ v1 v2]] 282 | (let [s (EdgeShape.)] 283 | (#?(:clj .set :cljs ._set) s (as-vec2 v1) (as-vec2 v2)) 284 | s)) 285 | 286 | (defmethod make-shape :polygon [[_ & vs]] 287 | #?(:clj (doto (PolygonShape.) 288 | (.set (into-array Vec2 (map as-vec2 vs)) (count vs))) 289 | :cljs (PolygonShape. (into-array (map as-vec2 vs))))) 290 | 291 | (defmethod make-shape :chain [[_ & vs]] 292 | #?(:clj (doto (ChainShape.) 293 | (.createChain (into-array Vec2 (map as-vec2 vs)) 294 | (count vs))) 295 | :cljs (ChainShape. (into-array (map as-vec2 vs))))) 296 | 297 | (defmethod make-shape :loop [[_ & vs]] 298 | #?(:clj (doto (ChainShape.) 299 | (.createLoop (into-array Vec2 (map as-vec2 vs)) 300 | (count vs))) 301 | :cljs (ChainShape. (into-array (map as-vec2 vs)) true))) 302 | 303 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 304 | ;; Body 305 | 306 | (def body-type #?(:clj {:kinematic BodyType/KINEMATIC 307 | :dynamic BodyType/DYNAMIC 308 | :static BodyType/STATIC} 309 | :cljs {:kinematic "kinematic" 310 | :dynamic "dynamic" 311 | :static "static"})) 312 | 313 | (defn user-data-def [props] 314 | (cond 315 | (nil? (:user-data props)) 316 | (select-keys props [:id :draw]) 317 | (map? (:user-data props)) 318 | (merge (:user-data props) (select-keys props [:id :draw])) 319 | :else 320 | (:user-data props))) 321 | 322 | (defn body-def [{:keys [active? allow-sleep? angle angular-damping angular-velocity awake? 323 | bullet? fixed-rotation? gravity-scale linear-damping linear-velocity position 324 | type user-data] 325 | :as props}] 326 | (let [b #?(:clj (BodyDef.) :cljs #js {})] 327 | (when (some? active?) (set! (.-active b) active?)) 328 | (when (some? allow-sleep?) (set! (.-allowSleep b) allow-sleep?)) 329 | (when (some? angle) (set! (.-angle b) angle)) 330 | (when (some? angular-damping) (set! (.-angularDamping b) angular-damping)) 331 | (when (some? angular-velocity) (set! (.-angularVelocity b) angular-velocity)) 332 | (when (some? awake?) (set! (.-awake b) awake?)) 333 | (when (some? bullet?) (set! (.-bullet b) bullet?)) 334 | (when (some? fixed-rotation?) (set! (.-fixedRotation b) fixed-rotation?)) 335 | (when (some? gravity-scale) (set! (.-gravityScale b) gravity-scale)) 336 | (when (some? linear-damping) (set! (.-linearDamping b) linear-damping)) 337 | (when (some? linear-velocity) (set! (.-linearVelocity b) (as-vec2 linear-velocity))) 338 | (when (some? position) (set! (.-position b) (as-vec2 position))) 339 | (when (some? type) (set! (.-type b) (get body-type type))) 340 | (set! (.-userData b) (user-data-def props)) 341 | b)) 342 | 343 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 344 | ;; Fixture 345 | 346 | (defn fixture-def [{:keys [density filter friction sensor? 347 | restitution shape user-data] 348 | :as props}] 349 | (let [f #?(:clj (FixtureDef.) :cljs #js {})] 350 | (when (some? density) (set! (.-density f) density)) 351 | (when (some? filter) (set! (.-filter f) filter)) 352 | (when (some? friction) (set! (.-friction f) friction)) 353 | (when (some? sensor?) (set! (.-isSensor f) sensor?)) 354 | (when (some? restitution) (set! (.-restitution f) restitution)) 355 | (when (some? shape) (set! (.-shape f) (make-shape shape))) 356 | (set! (.-userData f) (user-data-def props)) 357 | f)) 358 | 359 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 360 | ;; Joint 361 | 362 | (defn- start-joint-def [type] 363 | #?(:clj 364 | (case type 365 | :constant-volume (ConstantVolumeJointDef.) 366 | :distance (DistanceJointDef.) 367 | :friction (FrictionJointDef.) 368 | :gear (GearJointDef.) 369 | :motor (MotorJointDef.) 370 | :mouse (MouseJointDef.) 371 | :prismatic (PrismaticJointDef.) 372 | :pulley (PulleyJointDef.) 373 | :revolute (RevoluteJointDef.) 374 | :rope (RopeJointDef.) 375 | :weld (WeldJointDef.) 376 | :wheel (WheelJointDef.)) 377 | :cljs 378 | #js {})) 379 | 380 | (defn- end-joint-def [type definition] 381 | #?(:clj 382 | definition 383 | :cljs 384 | (case type 385 | :distance (DistanceJoint. definition) 386 | :friction (FrictionJoint. definition) 387 | :gear (GearJoint. definition) 388 | :motor (MotorJoint. definition) 389 | :mouse (MouseJoint. definition) 390 | :prismatic (PrismaticJoint. definition) 391 | :pulley (PulleyJoint. definition) 392 | :revolute (RevoluteJoint. definition) 393 | :rope (RopeJoint. definition) 394 | :weld (WeldJoint. definition) 395 | :wheel (WheelJoint. definition)))) 396 | 397 | (defn joint-def [{:keys [type collide-connected? bodies joints 398 | ;; constant-volume, distance, mouse 399 | frequency damping 400 | ;; distance, friction, prismatic 401 | local-anchors length 402 | ;; friction, motor, mouse 403 | max-force max-torque 404 | ;; gear, pulley 405 | ratio 406 | ;; motor 407 | linear-offset angular-offset correction-factor 408 | ;; prismatic 409 | local-axis reference-angle enable-limit? 410 | lower-translation upper-translation enable-motor? 411 | max-motor-force motor-speed 412 | ;; pulley 413 | ground-anchors lengths 414 | ;; Revolute 415 | lower-angle upper-angle max-motor-torque 416 | ;; rope 417 | max-length 418 | ] 419 | :as props}] 420 | (let [#?(:clj ^JointDef j :cljs ^js j) (start-joint-def type)] 421 | (case type 422 | :constant-volume 423 | (let [j ^ConstantVolumeJointDef j] 424 | (when (some? frequency) (set! (.-frequencyHz j) frequency)) 425 | (when (some? damping) (set! (.-dampingRatio j) damping)) 426 | (when (seq bodies) 427 | (run! #(.addBody j %) bodies))) 428 | :distance 429 | (let [j ^DistanceJointDef j] 430 | (let [[aa ab] local-anchors] 431 | (when aa (set! (.-localAnchorA j) (as-vec2 aa))) 432 | (when ab (set! (.-localAnchorB j) (as-vec2 ab)))) 433 | (when (some? frequency) (set! (.-frequencyHz j) frequency)) 434 | (when (some? damping) (set! (.-dampingRatio j) damping)) 435 | (when (some? length) (set! (.-length j) length))) 436 | :friction 437 | (let [j ^FrictionJointDef j] 438 | (let [[aa ab] local-anchors] 439 | (when aa (set! (.-localAnchorA j) (as-vec2 aa))) 440 | (when ab (set! (.-localAnchorB j) (as-vec2 ab)))) 441 | (when (some? max-force) (set! (.-maxForce j) max-force)) 442 | (when (some? max-torque) (set! (.-maxTorque j) max-torque))) 443 | :gear 444 | (let [j ^GearJointDef j] 445 | (let [[j1 j2] joints] 446 | (set! (.-joint1 j) j1) 447 | (set! (.-joint2 j) j2)) 448 | (when (some? ratio) (set! (.-ratio j) ratio))) 449 | :motor 450 | (let [j ^MotorJointDef j] 451 | (when (some? linear-offset) (set! (.-linearOffset j) (as-vec2 linear-offset))) 452 | (when (some? angular-offset) (set! (.-angularOffset j) angular-offset)) 453 | (when (some? max-force) (set! (.-maxForce j) max-force)) 454 | (when (some? max-torque) (set! (.-maxTorque j) max-torque)) 455 | (when (some? correction-factor) (set! (.-correctionFactor j) correction-factor))) 456 | :mouse 457 | (let [j ^MouseJointDef j] 458 | (when (some? max-force) (set! (.-maxForce j) max-force)) 459 | (when (some? frequency) (set! (.-frequencyHz j) frequency)) 460 | (when (some? damping) (set! (.-dampingRatio j) damping))) 461 | :prismatic 462 | (let [j ^PrismaticJointDef j] 463 | (let [[[ax ay] [bx by]] local-anchors] 464 | (when ax (.set (.-localAnchorA j) ax ay)) 465 | (when bx (.set (.-localAnchorB j) bx by))) 466 | (when (some? local-axis) (.set (.-localAxisA j) (first local-axis) (second local-axis))) 467 | (when (some? reference-angle) (set! (.-referenceAngle j) reference-angle)) 468 | (when (some? enable-limit?) (set! (.-enableLimit j) enable-limit?)) 469 | (when (some? lower-translation) (set! (.-lowerTranslation j) lower-translation)) 470 | (when (some? upper-translation) (set! (.-upperTranslation j) upper-translation)) 471 | (when (some? enable-motor?) (set! (.-enableMotor j) enable-motor?)) 472 | (when (some? max-motor-force) (set! (.-maxMotorForce j) max-motor-force)) 473 | (when (some? motor-speed) (set! (.-motorSpeed j) motor-speed))) 474 | :pulley 475 | (let [j ^PulleyJointDef j] 476 | (let [[aa ab] local-anchors] 477 | (when aa (set! (.-localAnchorA j) (as-vec2 aa))) 478 | (when ab (set! (.-localAnchorB j) (as-vec2 ab)))) 479 | (let [[aa ab] ground-anchors] 480 | (when aa (set! (.-groundAnchorA j) (as-vec2 aa))) 481 | (when ab (set! (.-groundAnchorB j) (as-vec2 ab)))) 482 | (let [[la lb] lengths] 483 | (when la (set! (.-lengthA j) la)) 484 | (when lb (set! (.-lengthB j) lb))) 485 | (when (some? ratio) (set! (.-ratio j) ratio))) 486 | :revolute 487 | (let [j ^RevoluteJointDef j] 488 | (let [[aa ab] local-anchors] 489 | (when aa (set! (.-localAnchorA j) (as-vec2 aa))) 490 | (when ab (set! (.-localAnchorB j) (as-vec2 ab)))) 491 | (when (some? reference-angle) (set! (.-referenceAngle j) reference-angle)) 492 | (when (some? lower-angle) (set! (.-lowerAngle j) lower-angle)) 493 | (when (some? upper-angle) (set! (.-upperAngle j) upper-angle)) 494 | (when (some? max-motor-torque) (set! (.-maxMotorTorque j) max-motor-torque)) 495 | (when (some? motor-speed) (set! (.-motorSpeed j) motor-speed)) 496 | (when (some? enable-limit?) (set! (.-enableLimit j) enable-limit?)) 497 | (when (some? enable-motor?) (set! (.-enableMotor j) enable-motor?))) 498 | :rope 499 | (let [j ^RopeJointDef j] 500 | (let [[aa ab] local-anchors] 501 | (when aa (set! (.-localAnchorA j) (as-vec2 aa))) 502 | (when ab (set! (.-localAnchorB j) (as-vec2 ab)))) 503 | (when (some? max-length) (set! (.-maxLength j) max-length))) 504 | :weld 505 | (let [j ^WeldJointDef j] 506 | (let [[aa ab] local-anchors] 507 | (when aa (set! (.-localAnchorA j) (as-vec2 aa))) 508 | (when ab (set! (.-localAnchorB j) (as-vec2 ab)))) 509 | (when (some? reference-angle) (set! (.-referenceAngle j) reference-angle)) 510 | (when (some? frequency) (set! (.-frequencyHz j) frequency)) 511 | (when (some? damping) (set! (.-dampingRatio j) damping))) 512 | :wheel 513 | (let [j ^WheelJointDef j] 514 | (let [[aa ab] local-anchors] 515 | (when aa (set! (.-localAnchorA j) (as-vec2 aa))) 516 | (when ab (set! (.-localAnchorB j) (as-vec2 ab)))) 517 | (when (some? local-axis) (set! (.-localAxisA j) (as-vec2 local-axis))) 518 | (when (some? enable-motor?) (set! (.-enableMotor j) enable-motor?)) 519 | (when (some? max-motor-torque) (set! (.-maxMotorTorque j) max-motor-torque)) 520 | (when (some? motor-speed) (set! (.-motorSpeed j) motor-speed)))) 521 | (set! (.-userData j) (user-data-def props)) 522 | (let [[bodyA bodyB] bodies] 523 | (when bodyA (set! (.-bodyA j) bodyA)) 524 | (when bodyB (set! (.-bodyB j) bodyB))) 525 | (set! (.-collideConnected j) (boolean collide-connected?)) 526 | (end-joint-def type j))) 527 | 528 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 529 | ;; Listeners 530 | 531 | ;; Some differences here between jBox2d and planck. The former only allows 532 | ;; setting a single ContactListener, the latter has replaced the ContactListener 533 | ;; with JavaScript style event registration (world.on("begin-contact", 534 | ;; function(contact) {...})). We turn this into an interface that is more 535 | ;; idiomatic for Clojure, allowing multiple listeners identified by keyword, 536 | ;; similar to watches on an atom. This also makes them quite suitable for a REPL 537 | ;; driven workflow, since it's easy to continuously replace a specific listener. 538 | 539 | (comment 540 | ;; listeners looks like: 541 | (def listeners (atom {:begin-contact {:my-key (fn [,,,])}}))) 542 | 543 | (defn- dispatch-event [listeners event & args] 544 | (doseq [f (vals (get @listeners event))] 545 | (apply f args))) 546 | 547 | #?(:clj 548 | (defrecord ContactListenerFanout [listeners] 549 | ContactListener 550 | (beginContact [this contact] 551 | (dispatch-event listeners :begin-contact contact)) 552 | (endContact [this contact] 553 | (dispatch-event listeners :end-contact contact)) 554 | (preSolve [this contact old-manifold] 555 | (dispatch-event listeners :pre-solve contact old-manifold)) 556 | (postSolve [this contact impulse] 557 | (dispatch-event listeners :post-solve contact impulse)))) 558 | 559 | (defn setup-listener-fanout! [^World world] 560 | #?(:clj 561 | (.setContactListener world (->ContactListenerFanout (atom {}))) 562 | :cljs 563 | (let [listeners (atom {})] 564 | (set! (.-CLJS_LISTENERS world) listeners) 565 | (.on world "begin-contact" #(dispatch-event listeners :begin-contact %1)) 566 | (.on world "end-contact" #(dispatch-event listeners :end-contact %1)) 567 | (.on world "pre-solve" #(dispatch-event listeners :pre-solve %1 %2)) 568 | (.on world "post-solve" #(dispatch-event listeners :post-solve %1 %2))))) 569 | 570 | (defn listen! 571 | "Listen for world events, `event` is one 572 | of :begin-contact, :end-contact, :pre-solve, :post-solve. `key` is a key you 573 | choose to identify this listener. Calling [[listen!]] again with the same 574 | event+key will replace the old listener. The key can also be used 575 | to [[unlisten!]] 576 | 577 | Returns the world instance for easy threading." 578 | [^World world event key f] 579 | (swap! #?(:clj (:listeners (.. world getContactManager -m_contactListener)) 580 | :cljs (.-CLJS_LISTENERS world)) 581 | assoc-in 582 | [event key] 583 | f) 584 | world) 585 | 586 | (defn unlisten! 587 | "Remove a specific event listener" 588 | [^World world event key] 589 | (swap! #?(:clj (:listeners (.. world getContactManager -m_contactListener)) 590 | :cljs (.-CLJS_LISTENERS world)) 591 | update event 592 | dissoc key) 593 | world) 594 | 595 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 596 | ;; Build world 597 | 598 | (defn find-by 599 | "Find a body or fixture with a given user-data property, 600 | e.g. (find-by world :id :player)." 601 | [container k v] 602 | (when container 603 | (if (sequential? container) 604 | (some #(find-by % k v) container) 605 | (reduce #(when (= (get (user-data %2) k) v) 606 | (reduced %2)) 607 | nil 608 | (concat (bodies container) 609 | (fixtures container) 610 | (joints container)))))) 611 | 612 | (defn find-all-by 613 | "Find all bodies or fixtures with a given user-data property, 614 | e.g. (find-by world :type :npc)" 615 | [container k v] 616 | (when container 617 | (if (sequential? container) 618 | (mapcat #(find-all-by % k v)) 619 | (filter (comp #{v} #(get % k) user-data) 620 | (concat (bodies container) 621 | (fixtures container) 622 | (joints container)))))) 623 | 624 | (defn destroy [^World world object] 625 | (locking world 626 | (cond 627 | (instance? Joint object) 628 | (.destroyJoint world ^Joint object)) 629 | (cond 630 | (instance? Body object) 631 | (.destroyBody world ^Body object)))) 632 | 633 | (defn add-fixture 634 | ([^Body body f] 635 | #?(:clj (cond 636 | (instance? Shape f) 637 | (add-fixture body f 0) 638 | (map? f) 639 | (add-fixture body (fixture-def f)) 640 | (instance? FixtureDef f) 641 | (.createFixture body ^FixtureDef f)) 642 | :cljs (cond 643 | (instance? Shape f) 644 | (add-fixture body f 0) 645 | (map? f) 646 | (.createFixture body (fixture-def f))))) 647 | ([^Body body shape density] 648 | (.createFixture body ^Shape shape ^double density))) 649 | 650 | (defn add-body 651 | "Add a new body to the world based on the given properties map. 652 | 653 | - `:position [x y]` : position in the world 654 | - `:fixtures [...]` : list of fixtures to add to the body 655 | - `:type` one of `:kinematic`, `:dynamic`, `:static` 656 | - `:user-date` map of data to associate with this body. Can be accessed by 657 | deref-ing the body instance 658 | - `:id` : unique id for this body, when present will cause an existing body 659 | with the same `:id` to be destroyed and replaced. Gets added to `:user-data`. 660 | - `:draw` : custom draw function. Gets added to `:user-data` 661 | - `:active?` 662 | - `:allow-sleep?` 663 | - `:angle` 664 | - `:angular-damping` 665 | - `:angular-velocity` 666 | - `:awake?` 667 | - `:bullet?` 668 | - `:fixed-rotation?` 669 | - `:gravity-scale` 670 | - `:linear-damping` 671 | - `:linear-velocity` 672 | " 673 | [^World world 674 | {:keys [active? allow-sleep? angle angular-damping angular-velocity awake? 675 | bullet? fixed-rotation? gravity-scale linear-damping linear-velocity 676 | position type user-data id draw] :as props}] 677 | (when-let [prev-body (and (:id props) (find-by (bodies world) :id (:id props)))] 678 | (.destroyBody world ^Body prev-body)) 679 | (let [body (.createBody world (body-def props))] 680 | (run! (partial add-fixture body) (:fixtures props)) 681 | body)) 682 | 683 | (defn indexed [entities] 684 | (into {} (map (juxt (comp :id user-data) identity)) entities)) 685 | 686 | (defn add-joint [^World world props] 687 | (when-let [prev-joint (and (:id props) (find-by (joints world) :id (:id props)))] 688 | (.destroyJoint world ^Joint prev-joint)) 689 | (let [id->body (indexed (bodies world)) 690 | id->joint (indexed (joints world)) 691 | props (-> props 692 | (update :bodies (partial map id->body)) 693 | (update :joints (partial map id->joint)))] 694 | (.createJoint world (joint-def props)))) 695 | 696 | (defn world [gravity-x gravity-y] 697 | (let [world (World. (vec2 gravity-x gravity-y))] 698 | (setup-listener-fanout! world) 699 | world)) 700 | 701 | (defn populate 702 | ([world bodies] 703 | (populate world bodies nil)) 704 | ([world bodies joints] 705 | (run! (partial add-body world) bodies) 706 | (run! (partial add-joint world) joints) 707 | world)) 708 | 709 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 710 | ;; Use world 711 | 712 | (defn step-world 713 | ([world] 714 | (step-world world (/ 1 60))) 715 | ([world timestep] 716 | (step-world world timestep 4 2)) 717 | ([^World world timestep velocity-iterations position-iterations] 718 | (.step world timestep velocity-iterations position-iterations))) 719 | 720 | (defn- get-next [x] 721 | #?(:clj (cond (instance? Body x) 722 | (.getNext ^Body x) 723 | (instance? Fixture x) 724 | (.getNext ^Fixture x) 725 | (instance? Joint x) 726 | (.getNext ^Joint x)) 727 | :cljs (.getNext ^js x))) 728 | 729 | (defn linked-list-seq [x] 730 | (when x 731 | (loop [x x 732 | xs [x]] 733 | (if-let [x (get-next x)] 734 | (recur x (conj xs x)) 735 | xs)))) 736 | 737 | (defn world->screen 738 | ([vec] 739 | (camera/world->screen *camera* vec)) 740 | ([camera vec] 741 | (camera/world->screen camera vec))) 742 | 743 | (defn screen->world 744 | ([vec] 745 | (camera/screen->world *camera* vec)) 746 | ([camera vec] 747 | (camera/screen->world camera vec))) 748 | 749 | (defn world-point [^Body body vec] 750 | (.getWorldPoint body (as-vec2 vec))) 751 | 752 | (defn world-vertices 753 | ([fixture] 754 | (world-vertices (body fixture) fixture)) 755 | ([^Body body fixture-or-shape] 756 | (let [vertices (vertices fixture-or-shape)] 757 | (map (partial world-point body) vertices)))) 758 | 759 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 760 | ;; Querying 761 | 762 | #?(:clj 763 | (defn raycast-callback ^RayCastCallback [f] 764 | (if (instance? RayCastCallback f) 765 | f 766 | (reify RayCastCallback 767 | (reportFixture [_ fixture point normal fraction] 768 | (f fixture point normal fraction)))))) 769 | 770 | #?(:clj 771 | (defn particle-raycast-callback ^ParticleRaycastCallback [f] 772 | (if (instance? ParticleRaycastCallback f) 773 | f 774 | (reify ParticleRaycastCallback 775 | (reportParticle [_ index point normal fraction] 776 | (f index point normal fraction)))))) 777 | 778 | (defn raycast 779 | "Perform a raycasting query, this finds bodies that are \"visible\" from the 780 | given point. This takes a callback function, which receives the fixture, 781 | point, normal, and fraction. The return value from the callback determines 782 | whether the search terminates or not. See [[raycast-seq]] for a more 783 | convenient wrapper." 784 | ([^World world rcb point1 point2] 785 | #?(:clj 786 | (.raycast world 787 | (raycast-callback rcb) 788 | (as-vec2 point1) 789 | (as-vec2 point2)) 790 | :cljs 791 | (.raycast world 792 | (as-vec2 point1) 793 | (as-vec2 point2) 794 | rcb))) 795 | #?(:clj ([^World world rcb pcb point1 point2] 796 | (.raycast world 797 | (raycast-callback rcb) 798 | (particle-raycast-callback pcb) 799 | (as-vec2 point1) 800 | (as-vec2 point2))))) 801 | 802 | #?(:clj (defn particle-raycast [^World world pcb point1 point2] 803 | (.raycast world 804 | #?(:clj (particle-raycast-callback pcb) :cljs pcb) 805 | (as-vec2 point1) 806 | (as-vec2 point2)))) 807 | 808 | (defn raycast-seq 809 | "Perform raycasting and return a sequence of fixtures 810 | 811 | This draws a line from point1 to point2, and returns fixtures that intersect 812 | the line. Behavior can be `:all`, return all fixtures, or `:first`, return the 813 | first matching fixture. Defaults to `:first`. 814 | 815 | For each fixture returns a map of `:fixture`: the matching fixture, `:point`: 816 | the point of initial intersection, `:normal`: the normal vector at point of 817 | intersection, `:fraction`: the fraction along the ray at point of 818 | intersection." 819 | ([^World world point1 point2] 820 | (raycast-seq world point1 point2 :first)) 821 | ([^World world point1 point2 behavior] 822 | (let [result (volatile! (transient [])) 823 | return-val (case behavior 824 | :all 1 825 | :first 0)] 826 | (raycast world 827 | (fn [fixture point normal fraction] 828 | (vswap! result conj! {:fixture fixture :point point :normal normal :fraction fraction}) 829 | return-val) 830 | point1 point2) 831 | (persistent! @result)))) 832 | 833 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 834 | ;; Properties and Operations 835 | 836 | (defn ctl! [entity & kvs] 837 | (doseq [[k v] (partition 2 kvs)] 838 | (ctl1! entity k v))) 839 | 840 | (defn zoom-by! 841 | ([amount] 842 | (zoom+! *camera* amount)) 843 | ([camera amount] 844 | (zoom+! camera amount))) 845 | 846 | (defn pan! 847 | ([x y] 848 | (camera/pan! *camera* x y)) 849 | ([camera x y] 850 | (camera/pan! camera x y))) 851 | 852 | (defn pan-x! 853 | ([x] 854 | (camera/pan-x! *camera* x)) 855 | ([camera x] 856 | (camera/pan-x! camera x))) 857 | 858 | (defn pan-y! 859 | ([y] 860 | (camera/pan-y! *camera* y)) 861 | ([camera y] 862 | (camera/pan-y! camera y))) 863 | 864 | (defn set-viewport! [x y scale] 865 | (camera/pan! *camera* x y) 866 | (camera/set-scale! *camera* scale)) 867 | 868 | (extend-protocol IProperty 869 | World 870 | (bodies [w] 871 | (linked-list-seq (.getBodyList w))) 872 | (joints [w] 873 | (linked-list-seq (.getJointList w))) 874 | (fixtures [w] 875 | (mapcat fixtures (bodies w))) 876 | (vertices [w] 877 | (mapcat vertices (fixtures w))) 878 | (gravity [w] 879 | (.getGravity w)) 880 | (user-data [w] nil) 881 | 882 | Body 883 | (body [b] 884 | b) 885 | (angle [b] 886 | (.getAngle b)) 887 | (position [b] 888 | (.getPosition b)) 889 | (bodies [b] 890 | [b]) 891 | (fixtures [b] 892 | (linked-list-seq (.getFixtureList b))) 893 | (vertices [b] 894 | (mapcat vertices (fixtures b))) 895 | (transform [b] 896 | (.getTransform b)) 897 | (fixed-rotation? [b] 898 | (.isFixedRotation b)) 899 | (bullet? [b] 900 | (.isBullet b)) 901 | (user-data [b] 902 | (.-m_userData b)) 903 | (awake? [b] 904 | (.isAwake b)) 905 | (linear-velocity [b] 906 | (.-m_linearVelocity b)) 907 | (angular-velocity [b] 908 | (.-m_angularVelocity b)) 909 | (world-center [b] 910 | (.getWorldCenter b)) 911 | (joints [b] 912 | nil) 913 | 914 | Fixture 915 | (body [f] 916 | (.-m_body f)) 917 | (bodies [f] 918 | [(body f)]) 919 | (fixtures [f] 920 | [f]) 921 | (angle [f] 922 | (angle (body f))) 923 | (shape [f] 924 | (.-m_shape f)) 925 | (vertices [f] 926 | (vertices (shape f))) 927 | (density [f] 928 | (.-m_density f)) 929 | (friction [f] 930 | (.-m_friction f)) 931 | (restitution [f] 932 | (.-m_restitution f)) 933 | (sensor? [f] 934 | (.-m_isSensor f)) 935 | (user-data [f] 936 | (.-m_userData f)) 937 | (filter-data [f] 938 | #?(:clj (let [filter (.getFilterData f)] 939 | {:category-bits (.-categoryBits filter) 940 | :mask-bits (.-maskBits filter) 941 | :group-index (.-groupIndex filter)}) 942 | :cljs 943 | {:category-bits (.-m_filterCategoryBits f) 944 | :mask-bits (.-m_filterMaskBits f) 945 | :group-index (.-m_filterGroupIndex f)})) 946 | 947 | PolygonShape 948 | (vertices [s] 949 | (into [] (take (.-m_count s) (.-m_vertices s)))) 950 | (centroid [s] 951 | (.-m_centroid s)) 952 | 953 | CircleShape 954 | (vertices [s] 955 | [(.-m_p s)]) 956 | (centroid [s] 957 | (.-m_p s)) 958 | (radius [s] 959 | (.-m_radius s)) 960 | 961 | EdgeShape 962 | (vertices [s] 963 | [(.-m_vertex1 s) (.-m_vertex2 s)]) 964 | (centroid [s] 965 | (doto ^Vec2 (vec2 0 0) 966 | (.addLocal (.-m_vertex0 s)) 967 | (.addLocal (.-m_vertex1 s)) 968 | (.mulLocal 0.5))) 969 | 970 | ChainShape 971 | (vertices [s] 972 | (.-m_vertices s)) 973 | 974 | lambdaisland.cljbox2d.camera.Camera 975 | (position [c] 976 | (camera/center c)) 977 | (transform [c] 978 | (.-transform c)) 979 | (zoom [c] 980 | (camera/zoom c)) 981 | 982 | Joint 983 | (user-data [j] 984 | (.-m_userData j)) 985 | 986 | Contact 987 | (fixtures [c] 988 | [(.-m_fixtureA c) (.-m_fixtureB c)]) 989 | (bodies [c] 990 | (map body (fixtures c))) 991 | (joints [c] 992 | nil)) 993 | 994 | (extend-protocol IOperations 995 | World 996 | (ctl1! [w k v] 997 | (case k 998 | :allow-sleep? (.setAllowSleep w v) 999 | :sub-stepping? (.setSubStepping w v) 1000 | :gravity (.setGravity w (as-vec2 v)) 1001 | :particle-max-count (.setParticleMaxCount w v) 1002 | :particle-density (.setParticleDensity w v) 1003 | :particle-gravity-scale (.setParticleGravityScale w v) 1004 | :particle-dampint (.setParticleDamping w v) 1005 | :particle-radius (.setParticleRadius w v))) 1006 | 1007 | Body 1008 | (ctl1! [b k v] 1009 | (case k 1010 | :linear-velocity (.setLinearVelocity b (as-vec2 v)) 1011 | :angular-velocity (.setAngularVelocity b v) 1012 | :transform (.setTransform b (as-vec2 (first v)) (second v)) 1013 | :position (.setTransform b (as-vec2 v) (.getAngle b)) 1014 | :gravity-scale (.setGravityScale b v) 1015 | :allow-sleep? (.setSleepingAllowed b v) 1016 | :awake? (.setAwake b v) 1017 | :active? (.setActive b v) 1018 | :fixed-rotation? (.setFixedRotation b v) 1019 | :bullet? (.setBullet b v))) 1020 | (alter-user-data*! [b f args] 1021 | (.setUserData b (apply f (.-m_userData b) args))) 1022 | (apply-force! 1023 | ([b force] 1024 | (.applyForceToCenter b (as-vec2 force))) 1025 | ([b force point] 1026 | (.applyForce b (as-vec2 force) (as-vec2 point)))) 1027 | (apply-torque! [b torque] 1028 | (.applyTorque b torque)) 1029 | (apply-impulse! 1030 | ([b impulse] 1031 | (.applyLinearImpulse b (as-vec2 impulse) (.getWorldCenter b) false)) 1032 | ([b impulse wake?] 1033 | (.applyLinearImpulse b (as-vec2 impulse) (.getWorldCenter b) wake?)) 1034 | ([b impulse point wake?] 1035 | (.applyLinearImpulse b (as-vec2 impulse) (as-vec2 point) wake?))) 1036 | (apply-angular-impulse! [b impulse] 1037 | (.applyAngularImpulse b impulse)) 1038 | 1039 | lambdaisland.cljbox2d.camera.Camera 1040 | (move-to! [camera center] 1041 | (.set ^Vec2 (.-center camera) (as-vec2 center)) 1042 | camera) 1043 | (move-by! [camera offset] 1044 | (.set ^Vec2 (.-center camera) (math/vec-add (.-center camera) 1045 | (as-vec2 offset))) 1046 | camera) 1047 | (zoom! [camera amount] 1048 | (camera/set-scale! camera amount)) 1049 | (zoom+! [camera amount] 1050 | (zoom! camera (math/mat-add (zoom camera) (math/scale-transform amount)))) 1051 | 1052 | Fixture 1053 | (alter-user-data*! [fixt f args] 1054 | (.setUserData fixt (apply f (.-m_userData fixt) args))) 1055 | 1056 | Joint 1057 | (alter-user-data*! [j f args] 1058 | (.setUserData j (apply f (.-m_userData j) args)))) 1059 | 1060 | (extend-protocol ICoerce 1061 | #?(:clj Vec2 :cljs planck/Vec2) 1062 | (as-vec2 [v] v) 1063 | #?(:clj clojure.lang.Indexed :cljs cljs.core/PersistentVector) 1064 | (as-vec2 [[x y]] 1065 | (vec2 x y))) 1066 | 1067 | #?(:cljs 1068 | (extend-type planck/Vec2 1069 | ;; Allow destructuring. In Clojure we use a patched jBox2D for this. 1070 | cljs.core/IIndexed 1071 | (-nth 1072 | ([v n] 1073 | (case n 0 (.-x v) 1 (.-y v))) 1074 | ([v n not-found] 1075 | (case n 0 (.-x v) 1 (.-y v) not-found))))) 1076 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/camera.cljc: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d.camera 2 | #?(:clj (:require [lambdaisland.cljbox2d.math :as math]) 3 | :cljs (:require [lambdaisland.cljbox2d.math :as math] 4 | ["planck-js/lib/common/Vec2" :as Vec2] 5 | ["planck-js/lib/common/Mat22" :as Mat22])) 6 | #?(:clj (:import (org.jbox2d.common Vec2 Mat22)))) 7 | 8 | (defprotocol ICamera 9 | (center [cam]) 10 | (world->screen [cam vec]) 11 | (screen->world [cam vec]) 12 | (zoom [cam])) 13 | 14 | (defrecord Camera [^Mat22 transform ^Vec2 center ^Vec2 extents] 15 | ICamera 16 | (center [_] 17 | center) 18 | (world->screen [_ world] 19 | (math/vec-add (math/mat-mul transform (math/vec-sub world center)) extents)) 20 | (screen->world [_ screen] 21 | (math/vec-add (math/mat-mul (math/mat-invert transform) (math/vec-sub screen extents)) center)) 22 | (zoom [_] 23 | transform)) 24 | 25 | (defn camera [x y scale] 26 | (let [r (math/scale-transform scale) 27 | center (Vec2. x y)] 28 | (->Camera r center (Vec2. 0 0)))) 29 | 30 | (defn pan! [camera x y] 31 | (.set (:center camera) (Vec2. x y)) 32 | camera) 33 | 34 | (defn pan-x! [camera x] 35 | (.set (:center camera) (Vec2. x (.-y (:center camera)))) 36 | camera) 37 | 38 | (defn pan-y! [camera y] 39 | (.set (:center camera) (Vec2. (.-x (:center camera)) y)) 40 | camera) 41 | 42 | (defn set-scale! [camera scale] 43 | (case (type scale) 44 | Mat22 (.set (:transform camera) scale) 45 | (.set (:transform camera) (math/scale-transform scale))) 46 | camera) 47 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/clojure2d.clj: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d.clojure2d 2 | "Glue code to enable drawing via `clojure2d` library. 3 | The main difference from `quil` is that `canvas` context should be provided explicitely. 4 | Contract for a custom `draw` function should accept a canvas as the last parameter." 5 | (:require [lambdaisland.cljbox2d :as b] 6 | [lambdaisland.cljbox2d.math :as math] 7 | [clojure2d.core :as c2d]) 8 | (:import [org.jbox2d.dynamics World Body Fixture] 9 | [org.jbox2d.collision.shapes PolygonShape CircleShape EdgeShape] 10 | [org.jbox2d.common Mat22])) 11 | 12 | (defprotocol IDraw 13 | (draw*! [fixture canvas]) 14 | (draw-shape! [shape body canvas])) 15 | 16 | (defn draw! [canvas entity] 17 | (if-let [draw (:draw (b/user-data entity))] 18 | (draw entity canvas) 19 | (draw*! entity canvas))) 20 | 21 | (extend-protocol IDraw 22 | World 23 | (draw*! [w canvas] 24 | (locking w 25 | (run! (partial draw! canvas) (b/bodies w)))) 26 | Body 27 | (draw*! [b canvas] (run! (partial draw! canvas) (b/fixtures b))) 28 | Fixture 29 | (draw*! [f canvas] 30 | (if-let [draw (:draw (b/user-data f))] 31 | (draw f canvas) 32 | (when-let [s (b/shape f)] 33 | (draw-shape! s (b/body f) canvas)))) 34 | 35 | PolygonShape 36 | (draw-shape! [shape body canvas] 37 | (c2d/path canvas 38 | (for [[x y] (map b/world->screen (b/world-vertices body shape))] 39 | [x y]) ;; Vec2 is not seqable... 40 | true)) 41 | 42 | CircleShape 43 | (draw-shape! [shape body canvas] 44 | (let [^Mat22 matrix (b/transform b/*camera*) 45 | scale-x (.-x (.-ex matrix)) 46 | scale-y (.-y (.-ey matrix)) 47 | [x y] (b/world->screen (b/world-point body (b/centroid shape))) 48 | radius (double (b/radius shape))] 49 | (-> canvas 50 | (c2d/push-matrix) 51 | (c2d/rotate (math/mat-angle matrix)) 52 | (c2d/ellipse x y (* scale-x radius 2.0) (* scale-y radius 2.0) true) 53 | (c2d/pop-matrix)))) 54 | 55 | EdgeShape 56 | (draw-shape! [shape body canvas] 57 | (let [[[x1 y1] [x2 y2]] (map b/world->screen (b/world-vertices body shape))] 58 | (c2d/line canvas x1 y1 x2 y2)))) 59 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/data_printer.cljc: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d.data-printer 2 | (:require [lambdaisland.data-printers :as dp])) 3 | 4 | (defn register-print [type tag to-edn] 5 | (dp/register-print type tag to-edn) 6 | (dp/register-pprint type tag to-edn) 7 | 8 | ;; `alter-var-root!` this function before loading cljbox2d if you want 9 | ;; printers to be registered for other printing backends 10 | 11 | ;; (dp-puget/register-puget type tag to-edn) 12 | ;; (dp-ddiff/register-deep-diff type tag to-edn) 13 | ;; (dp-ddiff2/register-deep-diff2 type tag to-edn) 14 | ;; (dp-transit/register-write-handler type tag to-edn) 15 | ) 16 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/demo/clojure2d/pinball.clj: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d.demo.clojure2d.pinball 2 | (:require [lambdaisland.cljbox2d :as b] 3 | [lambdaisland.cljbox2d.math :as m] 4 | [lambdaisland.cljbox2d.clojure2d :as bc2d] 5 | [clojure2d.core :as c2d])) 6 | 7 | (def state (atom {})) 8 | 9 | (defn world [] (:world @state)) 10 | 11 | (defn setup [canvas _] 12 | (let [{:keys [world]} @state]) 13 | ) 14 | 15 | (defn draw [canvas _ _ _] 16 | (let [{:keys [world]} @state] 17 | (b/step-world world) 18 | (-> canvas 19 | (c2d/set-background :white) 20 | (c2d/set-color :black) 21 | (c2d/set-stroke 5.0) 22 | (bc2d/draw! world)))) 23 | 24 | (defmethod c2d/mouse-event ["Pinball" :mouse-pressed] [event _state] 25 | (prn (b/vec2 (.getX event) (.getY event)) (b/screen->world (b/vec2 (.getX event) (.getY event))))) 26 | 27 | 28 | (defn -main [] 29 | (let [canvas (c2d/canvas 600 1000)] 30 | (reset! state {:world (b/world 0 10) 31 | :canvas canvas}) 32 | (let [window (c2d/show-window {:canvas canvas 33 | :draw-fn draw 34 | :setup setup 35 | :window-name "Pinball"})] 36 | (swap! state assoc :window window)))) 37 | 38 | 39 | (comment 40 | (-main) 41 | 42 | (swap! state assoc :world (b/world 0 10)) 43 | 44 | (b/populate 45 | (world) 46 | [{:id :case 47 | :fixtures [{:shape [:edge [0.3 0.3] [5.7 0.3]]} 48 | {:shape [:edge [5.7 0.3] [5.7 9.7]]} 49 | #_{:shape [:edge [4.7 9.7] [0.3 9.7]]} 50 | {:shape [:edge [0.3 9.7] [0.3 0.3]]} 51 | 52 | ;; top slant 53 | {:shape [:edge [0.3 0.8] [3 0.3]]} 54 | {:shape [:edge [3 0.3] [5.7 0.8]]} 55 | 56 | ;; bottom pit 57 | {:shape [:edge [1 8.7] [2.2 9.3]]} 58 | {:shape [:edge [4.2 8.7] [3 9.3]]} 59 | #_ {:shape [:edge [3 0.3] [5.7 0.8]]} 60 | 61 | 62 | {:shape [:edge [4.7 9.1] [5.0 9.3]]} 63 | {:shape [:edge [5.4 9.3] [5.7 9.1]]} 64 | ]} 65 | {:id :ball 66 | :position [5.2 8.8] 67 | :type :dynamic 68 | :fixtures [{:shape [:circle 0.30] 69 | :density 0.2 70 | :restitution 0.5}]} 71 | 72 | {:id :slider 73 | :position [5.2 10.6] 74 | :type :dynamic 75 | :fixtures [{:shape [:rect 0.2 2] 76 | :density 10 77 | :friction 1 78 | }]} 79 | {:id :rail 80 | :position [5.5 9.3] 81 | :fixtures [{:shape [:edge [0 0] [0 1]]}]} 82 | ] 83 | [{:id :rail-slider-joint 84 | :type :prismatic 85 | :bodies [:rail :slider] 86 | :local-anchors [[-0.3 0]] 87 | :local-axis [0 1] 88 | :upper-translation 1.5 89 | :lower-translation 0 90 | :enable-limit? true 91 | }] 92 | 93 | 94 | ) 95 | 96 | (b/apply-impulse! 97 | (b/find-by (world) :id :slider) 98 | [0 -70]) 99 | 100 | 101 | 102 | (ancestors (class (first (b/joints (world))))) 103 | (bean (first (b/joints (world)))) 104 | ) 105 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/demo/clojure2d/pyramid.clj: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d.demo.clojure2d.pyramid 2 | "Render a whole bunch of small squares that together form a Pyramid. 3 | Click with the mouse to simulate an explosion." 4 | (:require [lambdaisland.cljbox2d :as b] 5 | [lambdaisland.cljbox2d.math :as m] 6 | [lambdaisland.cljbox2d.clojure2d :as bc2d] 7 | [clojure2d.core :as c2d])) 8 | 9 | (def world (b/world 0 10)) 10 | 11 | (defn setup [_ _] 12 | (-> world 13 | (b/populate [{:fixtures [{:shape [:edge [-10 9.5] [20 9.5]]}]}]) 14 | (b/populate 15 | (for [i (range 20) 16 | j (range i 20)] 17 | {:type :dynamic 18 | :position [(+ 6 (* i 0.5625) (* j -0.25)) 19 | (* j 0.50)] 20 | :fixtures [{:shape [:rect 0.4 0.4] 21 | :density 1 22 | :friction 3}]}))) 23 | 24 | (b/set-viewport! -2 -3 70)) 25 | 26 | (defn draw 27 | [canvas _ _ _] 28 | (b/step-world world) 29 | (-> canvas 30 | (c2d/set-background :white) 31 | (c2d/set-color :black) 32 | (c2d/set-stroke 5.0) 33 | (bc2d/draw! world))) 34 | 35 | (defn apply-blast-impulse [body center apply-point power] 36 | (let [dir (m/v- apply-point center) 37 | distance (m/vec-length dir)] 38 | (when (not= 0 distance) 39 | (b/apply-impulse! body 40 | (m/v* dir (* power (/ 1 distance) (/ 1 distance))) 41 | apply-point 42 | true)))) 43 | 44 | (defn explosion [center] 45 | (let [numrays 32 46 | blast-radius 10 47 | blast-power 6] 48 | (doseq [x (range numrays) 49 | :let [rad (* (/ x numrays) 2 Math/PI) 50 | ray-end (m/v+ center (m/v* (b/vec2 (Math/sin rad) (Math/cos rad)) blast-radius))] 51 | {:keys [fixture point normal fraction]} (b/raycast-seq world center ray-end :all)] 52 | (apply-blast-impulse (b/body fixture) center point (/ blast-power numrays))))) 53 | 54 | (defmethod c2d/mouse-event ["Pyramid" :mouse-pressed] [event _state] 55 | (explosion 56 | (b/screen->world (b/vec2 (.getX event) (.getY event))))) 57 | 58 | (defn -main [] 59 | (c2d/show-window {:canvas (c2d/canvas 1200 1000) 60 | :draw-fn draw 61 | :setup setup 62 | :window-name "Pyramid"})) 63 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/demo/clojure2d/simple_shapes.clj: -------------------------------------------------------------------------------- 1 | ;; https://github.com/lambdaisland/cljbox2d/blob/main/src/lambdaisland/cljbox2d/demo/simple_shapes.cljc 2 | (ns lambdaisland.cljbox2d.demo.clojure2d.simple-shapes 3 | (:require [lambdaisland.cljbox2d :as b] 4 | [lambdaisland.cljbox2d.clojure2d :as bc2d] 5 | [clojure2d.core :as c2d] 6 | [fastmath.random :as r])) 7 | 8 | (def walls 9 | [{:id :ground 10 | :position [6 9.8] 11 | :fixtures [{:shape [:rect 12 0.4]}]} 12 | {:id :left-wall 13 | :position [0.2 5] 14 | :fixtures [{:shape [:rect 0.4 10]}]} 15 | {:id :right-wall 16 | :position [11.8 5] 17 | :fixtures [{:shape [:rect 0.4 10]}]}]) 18 | 19 | (defn random-body [] 20 | {:position [(r/drand 1 11) (r/drand -2 7)] 21 | :type :dynamic 22 | :fixtures [{:shape 23 | (rand-nth 24 | [[:circle (r/drand 0.2 0.6)] 25 | [:rect (r/drand 0.4 1.2) (r/drand 0.4 1.2)]]) 26 | :restitution 0.1 27 | :density 1 28 | :friction 3}]}) 29 | 30 | (def world (-> (b/world 0 1.0) 31 | (b/populate walls) 32 | (b/populate (repeatedly 50 random-body)))) 33 | 34 | (defn draw 35 | [canvas _ _ _] 36 | (b/step-world world) 37 | (-> canvas 38 | (c2d/set-background 161 165 134) 39 | (bc2d/draw! world))) 40 | 41 | 42 | (defn -main [] 43 | (c2d/show-window {:canvas (c2d/canvas 1200 1000) 44 | :draw-fn draw 45 | :window-name "Simple shapes"})) 46 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/demo/clojure2d/template.clj: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d.demo.clojure2d.template 2 | "Basic structure to start with" 3 | (:require [lambdaisland.cljbox2d :as b] 4 | [lambdaisland.cljbox2d.clojure2d :as bc2d] 5 | [clojure2d.core :as c2d]) 6 | (:import [org.jbox2d.common Vec2])) 7 | 8 | ;; Create the world, we'll set gravity-y to 10 so things fall down 9 | (def world (b/world 0 10)) 10 | 11 | ;; Clojure2d setup function, this gets called once at the start 12 | (defn setup [_canvas _window] 13 | (b/populate world [;; A static body that is basically just a straight line, so 14 | ;; we have a "floor" for objects to rest on 15 | {:fixtures [{:shape [:edge [-10 9.5] [20 9.5]]}]} 16 | ;; A dynamic body, a 1x1 rectangular box 17 | {:type :dynamic 18 | :position [0 0] 19 | :fixtures [{:shape [:rect 1 1]}]}]) 20 | 21 | ;; Set the viewport, x, y, and scale 22 | (b/set-viewport! -2 -3 70)) 23 | 24 | ;; This is the Clojur2d drawing function which gets called every "tick" 25 | (defn draw [canvas _window _framecount _state] 26 | ;; Progress the physics animation 27 | (b/step-world world) 28 | 29 | (-> canvas 30 | ;; Clear the screen 31 | (c2d/set-background :white) 32 | ;; Set lines color 33 | (c2d/set-color :black) 34 | 35 | ;; Set stroke size 36 | (c2d/set-stroke 5) 37 | 38 | ;; "Draw" the world. This loops over all the things in the world and draws 39 | ;; them. By default it uses simple primitive shapes, but you can set 40 | ;; a :draw function on an entity to customize how it's drawn. 41 | (bc2d/draw! world))) 42 | 43 | ;; Launch Clojure2d window 44 | (defn -main [] 45 | (c2d/show-window {:canvas (c2d/canvas 1200 1000) 46 | :draw-fn draw 47 | :setup setup 48 | :window-name "cljbox2d template"})) 49 | 50 | ;; Event handler, add new block after mouse pressed 51 | (defmethod c2d/mouse-event ["cljbox2d template" :mouse-pressed] [event _state] 52 | (b/populate world [{:type :dynamic 53 | :position (b/screen->world (Vec2. (c2d/mouse-x event) (c2d/mouse-y event))) 54 | :fixtures [{:shape [:rect 1 1]}]}])) 55 | 56 | (comment 57 | (-main)) 58 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/demo/hello_cljbox2d.clj: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d.demo.hello-cljbox2d 2 | (:require [lambdaisland.cljbox2d :as b] 3 | [lambdaisland.cljbox2d.quil :as bq] 4 | [quil.core :as q :include-macros true])) 5 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/demo/platformer.clj: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d.demo.platformer 2 | (:require [lambdaisland.cljbox2d :as b] 3 | [lambdaisland.cljbox2d.quil :as bq] 4 | [lambdaisland.quil-extras :as e] 5 | [clojure.java.io :as io] 6 | [quil.core :as q :include-macros true]) 7 | (:import (processing.core PApplet PImage))) 8 | 9 | (def pressed-keys (atom #{})) 10 | 11 | (def debug? false) 12 | 13 | (def assets (atom nil)) 14 | 15 | (defn millis [] 16 | (System/currentTimeMillis)) 17 | 18 | (defn load-assets! [] 19 | (let [tile-path (io/resource "0x72_DungeonTilesetII_v1.3.png") 20 | fireball-path (io/resource "Fireball_68x9.png") 21 | 22 | tile-set (e/load-grid tile-path {:width 16 :height 16 :scale 4}) 23 | fireball-tiles (e/load-grid fireball-path {:width 67 24 | :height 9 25 | :pad-x 1 26 | :pad-y 0 27 | :scale 4})] 28 | (reset! assets {:monster (e/tile-sequence tile-set [1 20 2 2] 8) 29 | :fireball (mapcat 30 | #(e/tile-sequence fireball-tiles [0 %] 10) 31 | (range 6))}))) 32 | 33 | (defn setup [] 34 | (q/text-font (q/create-font "Roboto" 24 true)) 35 | (load-assets!)) 36 | 37 | (defn draw-monster-body [body] 38 | (when-let [monster (:monster @assets)] 39 | (let [[x y] (b/world->screen (b/world-center body)) 40 | {:keys [flipped?]} @body 41 | {:keys [touching?]} @(b/find-by body :id :foot-sensor)] 42 | (let [w (.-pixelWidth ^PImage (first monster)) 43 | h (.-pixelHeight ^PImage (first monster))] 44 | (q/with-translation [x y] 45 | (q/with-rotation [(b/angle body)] 46 | (q/with-translation [(+ (- (double x)) 47 | (- (double (/ w 2)))) 48 | (+ (- (double y)) 49 | (- -10 (double (/ h 2))))] 50 | (q/push-matrix) 51 | (q/scale (if flipped? -1 1) 1) 52 | (if (and touching? (b/awake? body)) 53 | (e/animate monster 9 (if flipped? (- (- x) w) x) y) 54 | (q/image (first monster) (if flipped? (- (- x) w) x) y)) 55 | (q/pop-matrix)))) 56 | (when debug? 57 | (q/no-fill) 58 | (bq/draw*! body)))))) 59 | 60 | (defn draw-bullet [body] 61 | (when-let [fireball (:fireball @assets)] 62 | (let [[x y] (b/world->screen (b/world-center body)) 63 | {:keys [flipped?]} @body] 64 | (let [w (.-pixelWidth ^PImage (first fireball)) 65 | h (.-pixelHeight ^PImage (first fireball))] 66 | (q/with-translation [x y] 67 | (q/with-translation [(+ (- (double x)) 68 | (- (double (/ w 2)))) 69 | (+ (- (double y)) 70 | (- -10 (double (/ h 2))))] 71 | (q/push-matrix) 72 | (q/scale (if flipped? 1 -1) 1) 73 | (e/animate fireball 30 (if flipped? x (- (- x) w)) y) 74 | (q/pop-matrix))) 75 | (when debug? 76 | (q/no-fill) 77 | (bq/draw*! body)))))) 78 | 79 | (defn on-begin-contact [contact] 80 | (when-let [feet (b/find-by contact :id :foot-sensor)] 81 | (swap! feet assoc :touching? true))) 82 | 83 | (defn on-end-contact [contact] 84 | (when-let [feet (b/find-by contact :id :foot-sensor)] 85 | (swap! feet assoc :touching? false))) 86 | 87 | (def world 88 | (-> (b/world 0 9.806) 89 | (b/populate [{:id :ground 90 | :position [6 9.8] 91 | :fixtures [{:shape [:rect 100 0.4]}]} 92 | {:id ::player 93 | :type :dynamic 94 | :position [6 8] 95 | :fixed-rotation? true 96 | :fixtures [{:shape [:rect 0.8 1.08] 97 | :friction 5 98 | :density 100} 99 | {:id :foot-sensor 100 | :sensor? true 101 | :shape [:rect 0.5 0.1 [0 0.53]] 102 | :user-data {:touching? true}}] 103 | :draw #'draw-monster-body} 104 | {:id :platform 105 | :position [5 7] 106 | :fixtures [{:shape [:rect 5 0.4]}]}]) 107 | (b/listen! :begin-contact ::c #'on-begin-contact) 108 | (b/listen! :end-contact ::c #'on-end-contact))) 109 | 110 | (defn shoot-fire! [] 111 | (let [bullets (seq (b/find-all-by world :type :bullet))] 112 | (when (or (not bullets) 113 | (< 300 (- (millis) (apply max (map (comp :start-time deref) bullets))))) 114 | (let [player (b/find-by world :id ::player) 115 | [x y] (b/world-center player) 116 | {:keys [flipped?]} @player] 117 | (b/add-body world 118 | {:position [((if flipped? - +) x 2) y] 119 | :linear-velocity (if flipped? [-7 0] [7 0]) 120 | :type :kinematic 121 | :bullet? true 122 | :draw draw-bullet 123 | :fixtures [{:shape [:rect 2.68 0.32] 124 | :density 100}] 125 | :user-data {:type :bullet 126 | :start-time (millis) 127 | :flipped? flipped?}}))))) 128 | 129 | (defn control-player [[x y]] 130 | (let [player (b/find-by world :id ::player) 131 | [vx vy] (b/linear-velocity player)] 132 | (b/ctl! player :linear-velocity [(if (= 0 x) vx x) 133 | (if (= 0 y) vy y)]))) 134 | 135 | (defn process-keypress [] 136 | (when (:left @pressed-keys) 137 | (b/alter-user-data! (b/find-by world :id ::player) assoc :flipped? true) 138 | (control-player [-3 0])) 139 | (when (:right @pressed-keys) 140 | (b/alter-user-data! (b/find-by world :id ::player) assoc :flipped? false) 141 | (control-player [3 0])) 142 | (when (and (:up @pressed-keys) (:touching? @(b/find-by world :id :foot-sensor))) 143 | (control-player [0 -8])) 144 | (when (:space @pressed-keys) 145 | (shoot-fire!))) 146 | 147 | (defn clean-up-bullets [] 148 | (let [now (millis)] 149 | (doseq [b (b/find-all-by world :type :bullet)] 150 | (when (< 1200 (- now (:start-time @b))) 151 | (b/destroy world b))))) 152 | 153 | (defn draw [] 154 | (clean-up-bullets) 155 | (process-keypress) 156 | (b/pan-x! (- (.-x (b/world-center (b/find-by world :id ::player))) 157 | (/ (q/width) 100 2))) 158 | (b/step-world world) 159 | (q/background 255) 160 | (bq/draw! world) 161 | (q/fill 100) 162 | (q/text (pr-str @pressed-keys) (- (q/width) 300) 150)) 163 | 164 | (defn -main [] 165 | (q/defsketch tileset 166 | :host "app" 167 | :size [1200 1000] 168 | :setup setup 169 | :draw draw 170 | :frame-rate 1 171 | :key-pressed #(swap! pressed-keys conj (q/key-as-keyword)) 172 | :key-released #(swap! pressed-keys disj (q/key-as-keyword)))) 173 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/demo/pyramid.clj: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d.demo.pyramid 2 | (:require [lambdaisland.cljbox2d :as b] 3 | [lambdaisland.cljbox2d.quil :as bq] 4 | [quil.core :as q :include-macros true])) 5 | 6 | (def world (b/world 0 10)) 7 | 8 | (defn setup [] 9 | (-> world 10 | (b/populate [{:fixtures [{:shape [:edge [-10 9.5] [20 9.5]]}]}]) 11 | (b/populate 12 | (for [i (range 20) 13 | j (range i 20)] 14 | {:type :dynamic 15 | :position [(+ 6 (* i 0.5625) (* j -0.25)) 16 | (+ -3 (* j 0.6))] 17 | :fixtures [{:shape [:rect 0.4 0.4]}]}))) 18 | 19 | (b/set-viewport! -2 -3 70)) 20 | 21 | (defn draw [] 22 | (q/stroke-weight 5) 23 | (b/step-world world) 24 | (q/background 255) 25 | (bq/draw! world)) 26 | 27 | (defn -main [] 28 | (q/defsketch pyramid 29 | :host "app" 30 | :size [1200 1000] 31 | :draw draw 32 | :setup setup 33 | :frame-rate 60)) 34 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/demo/simple_shapes.cljc: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d.demo.simple-shapes 2 | (:require [lambdaisland.cljbox2d :as b] 3 | [lambdaisland.cljbox2d.quil :as bq] 4 | [quil.core :as q :include-macros true])) 5 | 6 | (declare world) 7 | 8 | (def gravity 1) 9 | 10 | (def walls 11 | [{:id :ground 12 | :position [6 9.8] 13 | :fixtures [{:shape [:rect 12 0.4]}]} 14 | {:id :left-wall 15 | :position [0.2 5] 16 | :fixtures [{:shape [:rect 0.4 10]}]} 17 | {:id :right-wall 18 | :position [11.8 5] 19 | :fixtures [{:shape [:rect 0.4 10]}]}]) 20 | 21 | (defn random-body [] 22 | {:position [(q/random 1 11) (q/random -2 7)] 23 | :type :dynamic 24 | :fixtures [{:shape 25 | (rand-nth 26 | [[:circle (q/random 0.2 0.6)] 27 | [:rect (q/random 0.4 1.2) (q/random 0.4 1.2)]]) 28 | :restitution 0.1 29 | :density 1 30 | :friction 3}]}) 31 | 32 | (defn setup [] 33 | (alter-var-root #'world (constantly (b/world 0 gravity))) 34 | (q/stroke-weight 5) 35 | (-> world 36 | (b/populate walls) 37 | (b/populate (take 50 (repeatedly random-body))))) 38 | 39 | (defn draw [] 40 | (b/step-world world) 41 | (q/background 161 165 134) 42 | (bq/draw! world)) 43 | 44 | (defn -main [] 45 | (q/defsketch box 46 | :host "app" 47 | :size [1200 1000] 48 | :setup setup 49 | :draw draw 50 | :frame-rate 60)) 51 | 52 | (comment 53 | (b/zoom! b/*camera* -10) 54 | (b/move-by! b/*camera* [-3 0])) 55 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/demo/template.cljc: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d.demo.template 2 | "Basic structure to start with" 3 | (:require [lambdaisland.cljbox2d :as b] 4 | [lambdaisland.cljbox2d.quil :as bq] 5 | [quil.core :as q :include-macros true])) 6 | 7 | ;; Create the world, we'll set gravity-y to 10 so things fall down 8 | (def world (b/world 0 10)) 9 | 10 | ;; Quil setup function, this gets called once at the start 11 | (defn setup [] 12 | (b/populate world [;; A static body that is basically just a straight line, so 13 | ;; we have a "floor" for objects to rest on 14 | {:fixtures [{:shape [:edge [-10 9.5] [20 9.5]]}]} 15 | ;; A dynamic body, a 1x1 rectangular box 16 | {:type :dynamic 17 | :position [0 0] 18 | :fixtures [{:shape [:rect 1 1]}]}]) 19 | 20 | ;; Set the viewport, x, y, and scale 21 | (b/set-viewport! -2 -3 70)) 22 | 23 | ;; This is the Quil drawing function which gets called every "tick" 24 | (defn draw [] 25 | ;; Progress the physics animation 26 | (b/step-world world) 27 | 28 | ;; Clear the screen 29 | (q/background 255) 30 | 31 | ;; Set drawing parameters 32 | (q/stroke-weight 5) 33 | 34 | ;; "Draw" the world. This loops over all the things in the world and draws 35 | ;; them. By default it uses simple Quil primitive shapes, but you can set 36 | ;; a :draw function on an entity to customize how it's drawn. 37 | (bq/draw! world)) 38 | 39 | ;; Launch Quil 40 | (defn -main [] 41 | (q/defsketch my-sketch 42 | :host "app" 43 | :size [1200 1000] 44 | :draw draw 45 | :setup setup 46 | :frame-rate 60)) 47 | 48 | (comment 49 | (-main)) 50 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/demo/testbed.clj: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d.demo.testbed 2 | (:require [lambdaisland.cljbox2d :as b]) 3 | (:import (org.jbox2d.testbed.framework.jogl JoglPanel JoglDebugDraw) 4 | java.awt.BorderLayout 5 | java.awt.Component 6 | javax.swing.JFrame 7 | javax.swing.JOptionPane 8 | javax.swing.JScrollPane 9 | javax.swing.SwingUtilities 10 | org.jbox2d.testbed.framework.TestList 11 | org.jbox2d.testbed.framework.TestbedTest 12 | org.jbox2d.testbed.framework.TestbedController 13 | org.jbox2d.testbed.framework.TestbedSettings 14 | org.jbox2d.testbed.framework.AbstractTestbedController$MouseBehavior 15 | org.jbox2d.testbed.framework.AbstractTestbedController$UpdateBehavior 16 | org.jbox2d.testbed.framework.TestbedErrorHandler 17 | org.jbox2d.testbed.framework.TestbedModel 18 | org.jbox2d.testbed.framework.j2d.TestbedSidePanel)) 19 | 20 | ;; This simply replicates JoglTestbedMain, so you can run the test cases that 21 | ;; come with jbox2d 22 | (defn testbed-orig [] 23 | (let [model (TestbedModel.) 24 | controller (TestbedController. 25 | model 26 | AbstractTestbedController$UpdateBehavior/UPDATE_IGNORED 27 | AbstractTestbedController$MouseBehavior/FORCE_Y_FLIP 28 | (reify TestbedErrorHandler 29 | (serializationError [this e msg]))) 30 | panel (JoglPanel. model controller) 31 | testbed-panel (doto (JFrame.) 32 | (.setTitle "JBox2D Testbed") 33 | (.setLayout (BorderLayout.))) 34 | side-panel (TestbedSidePanel. model controller)] 35 | (doto model 36 | (.setDebugDraw (JoglDebugDraw. panel)) 37 | (.setPanel panel)) 38 | (TestList/populateModel model) 39 | (set! (.. model getSettings (getSetting TestbedSettings/DrawWireframe) -enabled) false) 40 | 41 | (doto testbed-panel 42 | (.add panel "Center") 43 | (.add (JScrollPane. side-panel) "East") 44 | .pack 45 | (.setVisible true)) 46 | 47 | (SwingUtilities/invokeLater (fn [] 48 | (doto controller 49 | (.playTest 0) 50 | .start))))) 51 | 52 | (def testbed-model (doto (TestbedModel.) 53 | TestList/populateModel)) 54 | 55 | (defn launch [] 56 | (let [model testbed-model 57 | controller (TestbedController. 58 | model 59 | AbstractTestbedController$UpdateBehavior/UPDATE_IGNORED 60 | AbstractTestbedController$MouseBehavior/FORCE_Y_FLIP 61 | (reify TestbedErrorHandler 62 | (serializationError [this e msg]))) 63 | panel (JoglPanel. model controller) 64 | testbed-panel (doto (JFrame.) 65 | (.setTitle "JBox2D Testbed") 66 | (.setLayout (BorderLayout.))) 67 | side-panel (TestbedSidePanel. model controller)] 68 | (doto model 69 | (.setDebugDraw (JoglDebugDraw. panel)) 70 | (.setPanel panel)) 71 | 72 | (set! (.. model getSettings (getSetting TestbedSettings/DrawWireframe) -enabled) false) 73 | 74 | (doto testbed-panel 75 | (.add panel "Center") 76 | (.add (JScrollPane. side-panel) "East") 77 | .pack 78 | (.setVisible true)) 79 | 80 | (SwingUtilities/invokeLater (fn [] 81 | (doto controller 82 | (.playTest 0) 83 | .start))))) 84 | 85 | 86 | (def walls 87 | [{:id :ground 88 | :position [6 9.8] 89 | :fixtures [{:shape [:rect 12 0.4]}]} 90 | {:id :left-wall 91 | :position [0.2 5] 92 | :fixtures [{:shape [:rect 0.4 10]}]} 93 | {:id :right-wall 94 | :position [11.8 5] 95 | :fixtures [{:shape [:rect 0.4 10]}]}]) 96 | 97 | (defn random [i a] 98 | (+ i (rand (- a i)))) 99 | 100 | (defn random-body [] 101 | {:position [(random 1 11) (random -2 7)] 102 | :type :dynamic 103 | :fixtures [{:shape 104 | (rand-nth 105 | [[:circle (random 0.2 0.6)] 106 | [:rect (random 0.4 1.2) (random 0.4 1.2)]]) 107 | :restitution 0.1 108 | :density 1 109 | :friction 3}]}) 110 | 111 | (defn testbed-test [world] 112 | (proxy [TestbedTest] [] 113 | (initTest [_] 114 | (set! (.-m_world this) world)) 115 | (getTestName [] 116 | (str `testbed-test)))) 117 | 118 | ;; FIXME: this seems to no longer run on openjdk 17 119 | (defn -main [] 120 | (launch) 121 | 122 | (.addTest testbed-model 123 | (testbed-test (-> (b/world 0 -9) 124 | (b/populate walls) 125 | (b/populate (take 50 (repeatedly random-body)))))) 126 | 127 | (.addTest testbed-model 128 | (testbed-test (-> (b/world 0 -10) 129 | (b/populate [{:fixtures [{:shape [:edge [-40 0] [40 0]]}]}]) 130 | (b/populate 131 | (for [i (range 20) 132 | j (range i 20)] 133 | {:type :dynamic 134 | :position [(+ -7 (* i 0.5625) (* j 1.125)) (+ 0.75 (* j 1.25))] 135 | :fixtures [{:shape [:rect 0.5 0.5]}]})))))) 136 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/math.cljc: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d.math 2 | "Helper functions for Box2D vector/matrix math" 3 | #?(:cljs (:require ["planck-js/lib/common/Vec2" :as Vec2] 4 | ["planck-js/lib/common/Mat22" :as Mat22]) 5 | :clj (:import (org.jbox2d.common Vec2 Mat22)))) 6 | 7 | (defn mat-invert ^Mat22 [^Mat22 mat] 8 | #?(:clj (.invert mat) 9 | :cljs (.getInverse mat))) 10 | 11 | (defn mat-mul ^Vec2 [^Mat22 mat ^Vec2 vec] 12 | #?(:clj (.mul mat vec) 13 | :cljs (Mat22/mul mat vec))) 14 | 15 | (defn mat-add ^Mat22 [^Mat22 m1 ^Mat22 m2] 16 | #?(:clj (.add m1 m2) 17 | :cljs (Mat22/add m1 m2))) 18 | 19 | (defn vec-add ^Vec2 [^Vec2 v1 ^Vec2 v2] 20 | #?(:clj (.add v1 v2) 21 | :cljs (Vec2/add v1 v2))) 22 | 23 | (defn vec-sub ^Vec2 [^Vec2 v1 ^Vec2 v2] 24 | #?(:clj (.sub v1 v2) 25 | :cljs (Vec2/sub v1 v2))) 26 | 27 | (defn vec-mul ^Vec2 [^Vec2 v ^double a] 28 | #?(:clj (.mul v a) 29 | :cljs (Vec2/mul v a))) 30 | 31 | (defn vec-length ^double [^Vec2 v] 32 | #?(:clj (.length v) 33 | :cljs (Vec2/lengthOf v))) 34 | 35 | (defn mat-angle 36 | "Extract the angle from this matrix (assumed to be a rotation matrix)." 37 | [^Mat22 mat] 38 | #?(:clj (.getAngle mat) 39 | :cljs (Math/atan2 (.-y (.-ex mat)) (.-x (.-ex mat))))) 40 | 41 | (defn scale-transform 42 | "Transformation matrix that scales vectors by a fixed amount in both dimensions" 43 | [^double scale] 44 | (Mat22. (Vec2. scale 0) (Vec2. 0 scale))) 45 | 46 | ;; Convenience shorthand 47 | 48 | (def m* mat-mul) 49 | (def m+ mat-add) 50 | (def v+ vec-add) 51 | (def v- vec-sub) 52 | (def v* vec-mul) 53 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/quil.cljc: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d.quil 2 | "Helpers for rendering a Box2D world to a Quil sketch 3 | 4 | Iteates over all bodies and draws them with simple drawing primitives using 5 | the current stroke style and color. Supply a custom `:draw` function to a 6 | body's `:user-data` to customize the drawing." 7 | #?(:clj (:require [lambdaisland.cljbox2d :as b] 8 | [lambdaisland.cljbox2d.camera :as camera] 9 | [lambdaisland.cljbox2d.math :as math] 10 | [quil.core :as q]) 11 | :cljs (:require [lambdaisland.cljbox2d :as b] 12 | [lambdaisland.cljbox2d.camera :as camera] 13 | [lambdaisland.cljbox2d.math :as math] 14 | [quil.core :as q] 15 | ["planck-js" :as planck] 16 | ["planck-js/lib/common/Vec2" :as Vec2] 17 | ["planck-js/lib/common/Mat22" :as Mat22] 18 | ["planck-js/lib/World" :as World] 19 | ["planck-js/lib/Body" :as Body] 20 | ["planck-js/lib/Fixture" :as Fixture] 21 | ["planck-js/lib/Joint" :as Joint] 22 | ["planck-js/lib/Shape" :as Shape] 23 | ["planck-js/lib/shape/CircleShape" :as CircleShape] 24 | ["planck-js/lib/shape/EdgeShape" :as EdgeShape] 25 | ["planck-js/lib/shape/PolygonShape" :as PolygonShape] 26 | ["planck-js/lib/shape/ChainShape" :as ChainShape] 27 | ["planck-js/lib/shape/BoxShape" :as BoxShape] 28 | ["planck-js/lib/joint/DistanceJoint" :as DistanceJoint] 29 | ["planck-js/lib/joint/FrictionJoint" :as FrictionJoint] 30 | ["planck-js/lib/joint/GearJoint" :as GearJoint] 31 | ["planck-js/lib/joint/MotorJoint" :as MotorJoint] 32 | ["planck-js/lib/joint/MouseJoint" :as MouseJoint] 33 | ["planck-js/lib/joint/PrismaticJoint" :as PrismaticJoint] 34 | ["planck-js/lib/joint/PulleyJoint" :as PulleyJoint] 35 | ["planck-js/lib/joint/RevoluteJoint" :as RevoluteJoint] 36 | ["planck-js/lib/joint/RopeJoint" :as RopeJoint] 37 | ["planck-js/lib/joint/WeldJoint" :as WeldJoint] 38 | ["planck-js/lib/joint/WheelJoint" :as WheelJoint])) 39 | #?(:clj (:import (org.jbox2d.collision.shapes Shape 40 | ShapeType 41 | CircleShape 42 | EdgeShape 43 | PolygonShape 44 | ChainShape) 45 | (org.jbox2d.common Vec2 Mat22 OBBViewportTransform) 46 | (org.jbox2d.dynamics World 47 | Body 48 | BodyDef 49 | BodyType 50 | Filter 51 | Fixture 52 | FixtureDef) 53 | (org.jbox2d.dynamics.joints ConstantVolumeJointDef 54 | DistanceJointDef 55 | FrictionJointDef 56 | GearJointDef 57 | Joint 58 | JointDef 59 | MotorJointDef 60 | MouseJointDef 61 | PrismaticJointDef 62 | PulleyJointDef 63 | RevoluteJointDef 64 | RopeJointDef 65 | WeldJointDef 66 | WheelJointDef) 67 | (org.jbox2d.callbacks RayCastCallback 68 | ParticleRaycastCallback 69 | QueryCallback)))) 70 | 71 | (defprotocol IDraw 72 | (draw*! [entity] "Draw the given entity to the sketch using the current stroke style") 73 | (draw-shape! [shape body] "Draw a Box2D shape to the sketch using the current stroke style")) 74 | 75 | (defn draw! 76 | "Draw a world, body, or fixture. Will iterate over nested entities, and honor a 77 | `:draw` function present in the `:user-data`." 78 | [entity] 79 | (if-let [draw (:draw (b/user-data entity))] 80 | (draw entity) 81 | (draw*! entity))) 82 | 83 | (extend-protocol IDraw 84 | World 85 | (draw*! [w] 86 | (run! draw! (b/bodies w))) 87 | Body 88 | (draw*! [b] 89 | (run! draw! (b/fixtures b))) 90 | Fixture 91 | (draw*! [fixture] 92 | (if-let [draw (:draw (b/user-data fixture))] 93 | (draw fixture) 94 | (draw-shape! (b/shape fixture) (b/body fixture)))) 95 | 96 | PolygonShape 97 | (draw-shape! [shape body] 98 | (q/begin-shape) 99 | (let [vs (map b/world->screen (b/world-vertices body shape))] 100 | (doseq [[^double x ^double y] vs] 101 | (q/vertex x y)) 102 | (let [[^double x ^double y] (first vs)] 103 | (q/vertex x y))) 104 | (q/end-shape)) 105 | 106 | CircleShape 107 | (draw-shape! [shape body] 108 | (let [[x y] (b/world->screen (b/world-point body (b/centroid shape))) 109 | radius (double (b/radius shape)) 110 | matrix (b/transform b/*camera*) 111 | scale-x (.-x (.-ex matrix)) 112 | scale-y (.-y (.-ey matrix)) 113 | #_#_[^double scale-x ^double scale-y] (svd/get-scale matrix)] 114 | (q/push-matrix) 115 | (q/rotate (math/mat-angle matrix)) 116 | (q/ellipse x y (* scale-x radius 2) (* scale-y radius 2)) 117 | (q/pop-matrix))) 118 | 119 | EdgeShape 120 | (draw-shape! [shape body] 121 | (let [[[x1 y1] [x2 y2]] (map b/world->screen (b/world-vertices body shape))] 122 | (q/line x1 y1 x2 y2)))) 123 | -------------------------------------------------------------------------------- /src/lambdaisland/cljbox2d/svd.clj: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.cljbox2d.svd 2 | "Singular Value Transform" 3 | (:import (org.apache.commons.math3.linear MatrixUtils 4 | RealMatrix 5 | SingularValueDecomposition) 6 | (org.jbox2d.common Mat22))) 7 | 8 | (defmacro aset2d [a i j v] 9 | `(aset ^"[D" (aget ~a ~i) ~j ~v)) 10 | 11 | (defn mat22->real [^Mat22 m] 12 | (MatrixUtils/createRealMatrix 13 | (let [^"[[D" a (make-array Double/TYPE 2 2)] 14 | (aset2d a 0 0 (.-x (.-ex m))) 15 | (aset2d a 0 1 (.-x (.-ey m))) 16 | (aset2d a 1 0 (.-y (.-ex m))) 17 | (aset2d a 1 1 (.-y (.-ey m))) 18 | a))) 19 | 20 | (defn get-scale 21 | "Returns the scale factor along X and Y axis" 22 | [^Mat22 m] 23 | (let [svd (SingularValueDecomposition. (mat22->real m)) 24 | sigma (.getS svd)] 25 | [(.getEntry sigma 0 0) (.getEntry sigma 1 1)])) 26 | 27 | (comment 28 | (let [m (Mat22/mul (Mat22/createRotationalTransform 1.5) 29 | ;; => #object[org.jbox2d.common.Mat22 0x6eea72a1 "[0.07078076595527008,-0.9974921571471675]\n[0.9974921571471675,0.07078076595527008]"] 30 | (Mat22/createScaleTransform 20) 31 | ;; => #object[org.jbox2d.common.Mat22 0x608f850 "[20.0,0.0]\n[0.0,20.0]"] 32 | )] 33 | (get-scale m)) 34 | ;; => [20.00000520399257 20.000005203992565] 35 | ) 36 | -------------------------------------------------------------------------------- /src/lambdaisland/quil_extras.clj: -------------------------------------------------------------------------------- 1 | (ns lambdaisland.quil-extras 2 | (:require [quil.core :as q] 3 | [quil.applet :as applet]) 4 | (:import (java.awt Graphics2D) 5 | (javax.imageio ImageIO) 6 | (processing.core PApplet PImage))) 7 | 8 | (set! *unchecked-math* :warn-on-boxed) 9 | (set! *warn-on-reflection* true) 10 | 11 | ;; Type hinted versions of standard quil functions 12 | (defn width ^long [] (q/width)) 13 | (defn height ^long [] (q/height)) 14 | 15 | (defn load-image ^PImage [path] 16 | (let [applet (applet/current-applet)] 17 | (if (instance? java.net.URL path) 18 | (let [bi (ImageIO/read (.openStream ^java.net.URL path)) 19 | width (.getWidth bi) 20 | height (.getHeight bi) 21 | graphics (doto (.createGraphics applet width height) (.beginDraw)) 22 | g2d (.getNative graphics)] 23 | (.drawImage ^Graphics2D g2d bi 0 0 width height nil) 24 | (.endDraw graphics) 25 | (.copy graphics)) 26 | (.loadImage (doto (PApplet.) .sketchPath) path)))) 27 | 28 | (defn background-image 29 | "Set the given image as background image, filling the entire sketch. Will resize 30 | the sketch/applet if necessary to make the aspect ratio match." 31 | [file] 32 | (let [img (load-image file) 33 | ratio (max (double (/ (width) (.-width img))) 34 | (double (/ (height) (.-height img)))) 35 | width (* (.-width img) ratio) 36 | height (* (.-height img) ratio)] 37 | (q/resize-sketch width height) 38 | (q/resize img width height) 39 | ;; Hack... if the sketch resize hasn't been fully finished yet we'll get an 40 | ;; error, so retry a few times with small sleep calls in between 41 | (loop [i 0] 42 | (when-let [ex (try 43 | (q/background-image img) 44 | nil 45 | (catch java.lang.ArrayIndexOutOfBoundsException e 46 | e))] 47 | (if (< i 5) 48 | (do 49 | (Thread/sleep 20) 50 | (recur (inc i))) 51 | (throw ex)))) 52 | img)) 53 | 54 | (defn scale-up-pixels 55 | "Scale an image up by an integer factor, without any blurring/smoothing" 56 | [^PImage src ^long factor] 57 | (let [size-x (.-pixelWidth src) 58 | size-y (.-pixelHeight src) 59 | dest (processing.core.PImage. (* factor size-x) (* factor size-y))] 60 | (set! (.-format dest) (.-format src)) 61 | (doseq [^long x (range size-x) 62 | ^long y (range size-y) 63 | :let [pix (int (aget (.-pixels src) (+ x (* size-x y))))]] 64 | (doseq [^long fx (range factor) 65 | ^long fy (range factor)] 66 | (aset (.-pixels dest) 67 | (+ fx (* x factor) 68 | (* size-x factor (+ fy (* y factor)))) 69 | pix))) 70 | (.updatePixels dest) 71 | dest)) 72 | 73 | (defn slice ^PImage [^PImage src x y w h] 74 | (.get src x y w h)) 75 | 76 | (defprotocol IGrid 77 | (tile 78 | [_ x y] 79 | [_ x y w h])) 80 | 81 | (deftype Grid [^PImage src ^long tile-width ^long tile-height ^long pad-x ^long pad-y] 82 | IGrid 83 | (tile [this x y] 84 | (tile this x y 1 1)) 85 | (tile [_ x y w h] 86 | (slice src 87 | (* ^long x (+ tile-width pad-x)) 88 | (* ^long y (+ tile-height pad-y)) 89 | (* ^long w tile-width) 90 | (* ^long h tile-height)))) 91 | 92 | (defn load-grid [src {:keys [^long width ^long height ^long pad-x ^long pad-y ^long scale] 93 | :or {pad-x 0 pad-y 0 scale 1}}] 94 | (let [^PImage src (if (instance? PImage src) src (load-image src)) 95 | src (if (= 1 scale) 96 | src 97 | (scale-up-pixels src scale))] 98 | (->Grid src (* width scale) (* height scale) (* pad-x scale) (* pad-y scale)))) 99 | 100 | (defn tile-sequence 101 | "Slice out a number of left-to-right adjacent tiles out of a tileset" 102 | [grid tile-spec num] 103 | (let [^long tile-width (get tile-spec 2 1)] 104 | (map #(apply tile grid (update tile-spec 0 + (* tile-width ^long %))) 105 | (range num)))) 106 | 107 | (defn grid-stroke [i] 108 | (cond 109 | (= (mod i 2) 0) (q/stroke 161 165 134) 110 | :else (q/stroke 246 206 31))) 111 | 112 | (defn draw-grid 113 | "Draw a line grid over the complete sketch, with column/row numbers. Meant for 114 | identifying tile coordinates in a tile set." 115 | [^long size] 116 | (doseq [^long x (range (Math/ceil (/ (width) size)))] 117 | (grid-stroke x) 118 | (q/line (* x size) 0 (* x size) (height)) 119 | (q/text (str x) (* x size) 20)) 120 | (doseq [^long y (range (Math/ceil (/ (height) size)))] 121 | (grid-stroke y) 122 | (q/line 0 (* y size) (width) (* y size) ) 123 | (q/text (str y) 1 (* (+ y 0.5) size)))) 124 | 125 | (defn animate 126 | "Loops through a sequence of images, drawing one of them on each draw cycle 127 | based on the current time and fps" 128 | [tiles ^long fps x y] 129 | (q/image (nth tiles (mod (long (* (long (q/millis)) 0.001 fps)) 130 | (count tiles))) x y)) 131 | -------------------------------------------------------------------------------- /tests.edn: -------------------------------------------------------------------------------- 1 | #kaocha/v1 2 | {:plugins [:notifier :print-invocations :profiling]} 3 | --------------------------------------------------------------------------------