├── .gitattributes ├── .github └── workflows │ └── main.yml ├── LICENSE ├── README.md ├── examples ├── 00-everything.janet ├── 01-ecs.janet ├── 02-directed-graph.janet ├── 03-fsm.janet ├── 04-gamestates.janet ├── 05-timers.janet ├── 06-messages.janet ├── 07-tweens.janet ├── 08-fsm-n-ecs.janet ├── 09-vectors.janet ├── 10-envelopes.janet ├── 11-jaylib.janet └── 12-envelopes-visualizer.janet ├── junk-drawer-logo.png ├── junk-drawer.janet ├── junk-drawer ├── cache.janet ├── directed-graph.janet ├── ecs.janet ├── envelopes.janet ├── fsm.janet ├── gamestate.janet ├── messages.janet ├── sparse-set.janet ├── timers.janet ├── tweens.janet └── vector.janet ├── project.janet └── test ├── performance └── ecs-perf-test.janet └── unit ├── cache-test.janet ├── directed-graph-test.janet ├── ecs-test.janet ├── envelopes-test.janet ├── fsm-test.janet ├── gamestate-test.janet ├── messages-test.janet ├── sparse-set-test.janet ├── timers-test.janet ├── tweens-test.janet └── vector-test.janet /.gitattributes: -------------------------------------------------------------------------------- 1 | *.janet text eol=lf 2 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: Test 2 | on: 3 | push: 4 | branches: [ main ] 5 | pull_request: 6 | branches: [ main ] 7 | jobs: 8 | test: 9 | runs-on: ubuntu-latest 10 | steps: 11 | - uses: actions/checkout@v2 12 | - name: install backing for building janet 13 | run: sudo apt install build-essential 14 | - name: build janet, install junk-drawer 15 | run: | 16 | git clone --depth 1 --branch master https://github.com/janet-lang/janet.git /tmp/janet 17 | cd /tmp/janet 18 | sudo make all test install 19 | sudo make install-jpm-git 20 | - name: install junk-drawer 21 | run: sudo jpm install https://github.com/AlecTroemel/junk-drawer.git 22 | - name: run tests 23 | run: sudo jpm test 24 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2021 Alec Troemel and contributors 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of 4 | this software and associated documentation files (the "Software"), to deal in 5 | the Software without restriction, including without limitation the rights to 6 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies 7 | of the Software, and to permit persons to whom the Software is furnished to do 8 | so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in all 11 | copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 19 | SOFTWARE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Junk Drawer hand drawn logo 2 | 3 | [![Test](https://github.com/AlecTroemel/junk-drawer/actions/workflows/main.yml/badge.svg)](https://github.com/AlecTroemel/junk-drawer/actions/workflows/main.yml) 4 | 5 | Everyones got one (usually somewhere in the kitchen). __Junk Drawer__ is a collection of tools & utils for developing games in the wonderful [Janet Lang](https://janet-lang.org). 6 | 7 | ```bash 8 | [sudo] jpm install https://github.com/AlecTroemel/junk-drawer 9 | ``` 10 | 11 | ### Contents: 12 | 13 | - `ecs`: A sparse set based Entity Component System. 14 | - `directed graph`: graph implementation with path finding function. 15 | - `vectors`: common 2d vector functions. 16 | - `fsm`: Finite(ish) State Machine (built off of directed graph). 17 | - `gamestate`: Easy gamestate management (built off of directed graph). 18 | - `timers`: Delayed & Scheduled functions (requires using ECS). 19 | - `messages`: Communication between systems (requires using ECS). 20 | - `tweens`: Some common tweening functions and a way to interpolate components with them (mostly requires ECS). 21 | - `envelopes`: Multi stage tweens from the world of music (built off of directed graph and tweens). 22 | 23 | 24 | Here's an obligitory example that uses most the stuff here. 25 | 26 | ```janet 27 | (use junk-drawer) 28 | 29 | (fsm/define 30 | colors 31 | (fsm/state :green) 32 | (fsm/transition :next :green :yellow) 33 | 34 | (fsm/state :yellow) 35 | (fsm/transition :next :yellow :red) 36 | 37 | (fsm/state :red) 38 | (fsm/transition :next :red :yellow)) 39 | 40 | (def-tag next-color) 41 | 42 | (def-component-alias position vector/from-named) 43 | 44 | (def-system colored-printer 45 | {color-fsms [:colors]} 46 | (each [c] color-fsms 47 | (printf "current color: %q" (c :current)))) 48 | 49 | (def-system colored-switcher 50 | {wld :world 51 | msgs [:message :next-color] 52 | color-fsms [:colors]} 53 | (when (> (length msgs) 0) 54 | (each [msg] msgs 55 | (each [c] color-fsms 56 | ((msg :content) c)) 57 | (messages/consume msg)))) 58 | 59 | (def GS (gamestate/init)) 60 | 61 | (gamestate/def-state example 62 | :name "Example Gamestate" 63 | :world (create-world) 64 | :init (fn [self] 65 | (let [world (get self :world)] 66 | (add-entity world (colors :green) 67 | (position :x 1 :y 2)) 68 | (add-entity world (colors :red)) 69 | (register-system world timers/update-sys) 70 | (register-system world messages/update-sys) 71 | (register-system world colored-printer) 72 | (register-system world colored-switcher) 73 | (timers/every world 4 74 | (fn [wld dt] 75 | (messages/send wld :next next-color))) 76 | (timers/after world 7 77 | (fn [wld dt] 78 | (messages/send wld :next next-color))))) 79 | :update (fn [self dt] 80 | (:update (self :world) dt))) 81 | 82 | (:add-state GS example) 83 | (:goto GS :example) 84 | 85 | (for i 0 20 86 | (:update GS 1)) 87 | ``` 88 | 89 | Each module, and most of the public functions, have detailed doc strings for your reading. 90 | 91 | ```janet 92 | (doc junk-drawer) 93 | (doc junk-drawer/ecs) 94 | (doc junk-drawer/ecs/def-component) 95 | ``` 96 | 97 | If you're looking for more complete examples...check out the `examples/` folder! 98 | -------------------------------------------------------------------------------- /examples/00-everything.janet: -------------------------------------------------------------------------------- 1 | (use /junk-drawer) 2 | 3 | 4 | (fsm/define 5 | colors 6 | (fsm/state :green) 7 | (fsm/transition :next :green :yellow) 8 | 9 | (fsm/state :yellow) 10 | (fsm/transition :next :yellow :red) 11 | 12 | (fsm/state :red) 13 | (fsm/transition :next :red :green)) 14 | 15 | (def-tag next-color) 16 | 17 | (def-system colored-printer 18 | {color-fsms [:colors]} 19 | (each [c] color-fsms 20 | (printf "current color: %q" (c :current)))) 21 | 22 | (def-system colored-switcher 23 | {wld :world 24 | msgs [:message :next-color] 25 | color-fsms [:colors]} 26 | (when (> (length msgs) 0) 27 | (each [msg] msgs 28 | (each [c] color-fsms 29 | ((msg :content) c)) 30 | (messages/consume msg)))) 31 | 32 | (def GS (gamestate/init)) 33 | 34 | (def example 35 | {:name "Example Gamestate" 36 | :world (create-world) 37 | :init (fn [self] 38 | (let [world (get self :world)] 39 | (add-entity world (colors :green)) 40 | (add-entity world (colors :red)) 41 | (register-system world timers/update-sys) 42 | (register-system world messages/update-sys) 43 | (register-system world colored-printer) 44 | (register-system world colored-switcher) 45 | (timers/every world 4 46 | (fn [wld dt] 47 | (messages/send wld :next next-color))) 48 | (timers/after world 7 49 | (fn [wld dt] 50 | (messages/send wld :next next-color))))) 51 | :update (fn [self dt] 52 | (:update (self :world) dt))}) 53 | 54 | (:push GS example) 55 | 56 | (for i 0 20 57 | (:update GS 1)) 58 | -------------------------------------------------------------------------------- /examples/01-ecs.janet: -------------------------------------------------------------------------------- 1 | (use /junk-drawer) 2 | 3 | # Register (global) components, these are shared across worlds. 4 | # Components create tables by listing keyname type-schema. 5 | # The type-schema given can by any form of the syntax listed in spork/schema 6 | # https://github.com/janet-lang/spork/blob/master/spork/schema.janet#L17 7 | (def-component-alias position vector/from-named) 8 | (def-component-alias velocity vector/from-named) 9 | (def-component lives :count :number) 10 | 11 | # create a world to hold your entities + systems 12 | (def world (create-world)) 13 | 14 | # Add entities to a world 15 | (add-entity world 16 | (position :x 10 :y 10) 17 | (velocity :x -1 :y -1) 18 | (lives :count 2)) 19 | (add-entity world 20 | (position :x 8 :y 8) 21 | (velocity :x -2 :y -2) 22 | (lives :count 1)) 23 | (add-entity world 24 | (position :x 3 :y 5) 25 | (lives :count 1)) 26 | 27 | # Systems are a list of queries and a body that does work on them. 28 | # "dt" (which is passed into a worlds update method) is implicitly available to 29 | # all systems 30 | (def-system move 31 | {moveables [:position :velocity]} 32 | (each [pos vel] moveables 33 | (:add pos (-> vel (:clone) (:multiply dt))))) 34 | 35 | # you'll need to register a system on a world 36 | (register-system world move) 37 | 38 | # Here's a system that has multiple queries 39 | (def-system print-position 40 | {poss [:position] vels [:velocity] livs [:lives]} 41 | (print "positions:") 42 | (each [pos] poss (pp pos)) 43 | (print "velocities:") 44 | (each [vel] vels (pp vel)) 45 | (print "lives:") 46 | (each [liv] livs (pp liv))) 47 | 48 | (register-system world print-position) 49 | 50 | # you can also get the parent world of the system with a special query 51 | # you can use this to delete/create entities within a system! 52 | # 53 | # In this example the entity will be destroyed if its x,y coords both become 0. 54 | # Given the entities defined above this should take 10 iterations 55 | (def ZERO_VEC (vector/new 0 0)) 56 | (def-system remove-dead 57 | {entities [:entity :position] wld :world} 58 | (each [ent pos] entities 59 | (when (:equal? pos ZERO_VEC) 60 | (print "time to die entity id " ent) 61 | (remove-entity wld ent)))) 62 | 63 | (register-system world remove-dead) 64 | 65 | # There is a special type of component called a tag, which just has no data 66 | # you can use this to further seperate entities out 67 | 68 | (def-tag monster) 69 | 70 | (add-entity world 71 | (position :y 0 :y 0) 72 | (velocity :y 1 :y 1) 73 | (monster)) 74 | 75 | (add-entity world 76 | (position :y 0 :y 5) 77 | (velocity :y 1 :y 0) 78 | (monster)) 79 | 80 | (def-system print-monsters 81 | {monsters [:entity :position :monster] 82 | entities [:entity :position :lives] 83 | wld :world} 84 | (each [ent pos] monsters 85 | (prin "Monster ") 86 | (pp pos) 87 | (when-let [[e] (filter (fn [[e p l]] 88 | (and (not= ent e) 89 | (:equal? p pos))) 90 | entities) 91 | [i p life] e] 92 | 93 | (printf "monster got %j" e) 94 | (remove-entity wld ent) 95 | 96 | (if (one? (life :count)) 97 | (do (remove-entity wld e) 98 | (printf "good bye %i" (e 0))) 99 | (update life :count dec))))) 100 | 101 | (register-system world print-monsters) 102 | 103 | 104 | # Components can even be added or removed from existing entities. 105 | # Note that the example below would probably be better implimented 106 | # using a FSM. 107 | (def-tag confused) 108 | (def-tag enlightened) 109 | 110 | (add-entity world 111 | (confused)) 112 | 113 | (def-system remove-n-add 114 | {entities [:entity :confused] 115 | wld :world} 116 | 117 | (each [ent cnf] entities 118 | (printf "%q is confused" ent) 119 | (printf "%q is being switched from confused to enlightened" ent) 120 | (remove-component world ent :confused) 121 | (add-component world ent (enlightened)))) 122 | 123 | (register-system world remove-n-add) 124 | 125 | (def-system print-enlightened 126 | {the-enlightened [:entity :enlightened]} 127 | (each [ent enl] the-enlightened 128 | (printf "%q is enlightened" ent))) 129 | 130 | (register-system world print-enlightened) 131 | 132 | 133 | # then just call update every frame :) 134 | # We assume dt is just 1 here 135 | (for i 0 6 136 | (print "i: " i) 137 | (:update world 1) 138 | (print)) 139 | -------------------------------------------------------------------------------- /examples/02-directed-graph.janet: -------------------------------------------------------------------------------- 1 | (use /junk-drawer) 2 | # you can create direct graphs and find paths through them! 3 | # lets create a graph that looks like this 4 | # +---+ 1 +---+ 8 +---+ 5 | # | A |-->| B |-->| C | 6 | # +---+ +---+ +---+ 7 | # 2| 3^ |1 8 | # v / v 9 | # +---+ 1 +---+ +---+ 10 | # | D |<--| E | | F | 11 | # +---+ +---+ +---+ 12 | # |1 |1 13 | # v v 14 | # +---+ 1 +---+ +---+ 15 | # | G |-->| H | | I | 16 | # +---+ +---+ +---+ 17 | # note that nodes can have any arbitrary data in them 18 | # edges can have an edge name (defaults to the "to" node in the edge) and weight (defaults to 1) 19 | (var *graph* 20 | (digraph/create 21 | (digraph/node :a :x 0 :y 0) (digraph/node :b :x 1 :y 0) (digraph/node :c :x 2 :y 0) 22 | (digraph/node :d :x 0 :y 1) (digraph/node :e :x 1 :y 1) (digraph/node :f :x 2 :y 1) 23 | (digraph/node :g :x 0 :y 2) (digraph/node :h :x 1 :y 2) (digraph/node :i :x 2 :y 2) 24 | 25 | (digraph/edge :a :b) 26 | (digraph/edge :b :c 8) (digraph/edge :b :e 2) 27 | (digraph/edge :c :f) 28 | (digraph/edge :d :g) 29 | (digraph/edge :e :c 3) (digraph/edge :e :d) 30 | (digraph/edge :e :i) 31 | (digraph/edge :g :h))) 32 | 33 | # you can add nodes and edges after creating graph 34 | (:add-node *graph* (digraph/node :c2 :x 3 :y 0)) 35 | (:add-edge *graph* (digraph/edge :c :c2)) 36 | 37 | # then look at neighbors or other data of a node 38 | (printf "does the graph contain the newly added node? %q" (:contains *graph* :c2)) 39 | (printf "neighbors for node C: %q" (:neighbors *graph* :c)) 40 | 41 | # you can even find the path (really the edges) from one node to another 42 | (printf "edges to get from node A to node I: %q" (:find-path *graph* :a :i)) 43 | -------------------------------------------------------------------------------- /examples/03-fsm.janet: -------------------------------------------------------------------------------- 1 | (use /junk-drawer) 2 | 3 | # Finite state machines build on the directed graph by adding a "current" field 4 | # and functions in nodes that will be called when current changes. 5 | # 6 | # the main way to interact with this module is to define the state "factory". 7 | # transitions define functions that will be avaible on the root FSM when in that state. 8 | # the Enter, Leave, and Init methods are optional fn in the state and are called when 9 | # the FSM moves between states. 10 | # 11 | # any additional arguments passed into the transition function will be passed in 12 | # to the Enter method. 13 | (fsm/define 14 | colored-warnings 15 | (fsm/state :green 16 | :enter (fn green-enter [self from] (print "entering green")) 17 | :leave (fn green-leave [self to] (print "leaving green"))) 18 | (fsm/transition :warn :green :yellow) 19 | 20 | (fsm/state :yellow 21 | :enter (fn yellow-enter [self from name] 22 | (printf "entering yellow, %s be careful!" name))) 23 | (fsm/transition :panic :yellow :red) 24 | (fsm/transition :clear :yellow :green) 25 | 26 | (fsm/state :red 27 | :leave (fn red-leave [self to] (print "leaving red"))) 28 | (fsm/transition :calm :red :yellow)) 29 | 30 | 31 | # Create the actual fsm object with the initial state 32 | (print "Example 1 output:") 33 | (def *state* (colored-warnings :green)) 34 | (print "start: " (*state* :current)) 35 | (:warn *state* "Alec") 36 | (:panic *state*) 37 | (:calm *state* "Alec") 38 | (:clear *state*) 39 | (print "final: " (*state* :current)) 40 | 41 | # Example 2 42 | # 43 | # This is a very "informal" State machine. 44 | # you can put any arbitrary data/method in a state, 45 | # and it will be available on the root machine when in that state. 46 | # 47 | # Just remember that any data will be removed when you leave the state! 48 | (fsm/define 49 | jumping-frog 50 | (fsm/state :standing 51 | :boredom 0 52 | :update (fn standing-update [self dt] 53 | (printf "boredom %q" (self :boredom)) 54 | (if (= 4 (self :boredom)) 55 | (:jump self) 56 | (put self :boredom (inc (self :boredom)))))) 57 | (fsm/transition :jump :standing :jumping) 58 | 59 | (fsm/state :jumping 60 | :airtime 2 61 | :update (fn jumping-update [self dt] 62 | (printf "airtime %q" (self :airtime)) 63 | (if (= 0 (self :airtime)) 64 | (:land self) 65 | (put self :airtime (dec (self :airtime)))))) 66 | (fsm/transition :land :jumping :standing)) 67 | 68 | (def *froggy* (jumping-frog :standing)) 69 | 70 | (print "\nExample 2 output:") 71 | (for i 0 10 72 | (printf "froggy is currenty %q" (*froggy* :current)) 73 | (:update *froggy* 1)) 74 | -------------------------------------------------------------------------------- /examples/04-gamestates.janet: -------------------------------------------------------------------------------- 1 | (use /junk-drawer) 2 | 3 | (gamestate/def-state 4 | menu 5 | :init (fn menu-init [self] (print "menu init")) 6 | :enter (fn menu-enter [self prev & args] (printf "menu enter %q" args)) 7 | :update (fn menu-update [self dt] (print "menu game state dt: " dt))) 8 | 9 | (gamestate/def-state 10 | game 11 | :init (fn game-init [self] (print "game init")) 12 | :update (fn game-update [self dt] (print "game game state dt: " dt)) 13 | :leave (fn game-leave [self to] (print "game leave"))) 14 | 15 | (var dt 0) 16 | (def *GS* (gamestate/init)) 17 | 18 | (:add-state *GS* menu) 19 | (:add-state *GS* game) 20 | (:add-edge *GS* (gamestate/transition :start-game :menu :game)) 21 | (:add-edge *GS* (gamestate/transition :back-to-menu :game :menu)) 22 | 23 | (:goto *GS* :menu) 24 | (:update *GS* dt) 25 | (+= dt 1) 26 | 27 | (print "switching to game") 28 | (:start-game *GS*) 29 | (:update *GS* dt) 30 | (+= dt 1) 31 | 32 | (print "Lets go back to the menu") 33 | (:back-to-menu *GS*) 34 | (:update *GS* dt) 35 | -------------------------------------------------------------------------------- /examples/05-timers.janet: -------------------------------------------------------------------------------- 1 | (use /junk-drawer) 2 | 3 | # Timers are just entities, with a system registered in the world 4 | # callbacks for timers get both the world and dt args 5 | (def world (create-world)) 6 | (register-system world timers/update-sys) 7 | 8 | # There are some helper macros in creating timers 9 | (timers/after world 10 10 | (fn [wld dt] (print "after: 10 ticks have passed"))) 11 | 12 | (timers/during world 5 13 | (fn [wld dt] (print "during")) 14 | (fn [wld dt] (print "during is complete"))) 15 | 16 | (timers/every world 2 17 | (fn [wld dt] (print "every 2, but only 3 times")) 18 | 3) # default is loop for infinity 19 | 20 | (for i 0 21 21 | (print "i: " i) 22 | (:update world 1) 23 | (print "")) 24 | -------------------------------------------------------------------------------- /examples/06-messages.janet: -------------------------------------------------------------------------------- 1 | (use /junk-drawer) 2 | 3 | (def world (create-world)) 4 | 5 | (register-system world timers/update-sys) 6 | (register-system world messages/update-sys) 7 | 8 | # # on thier own timers may not seem very useful. But with messages 9 | # # you can have timers interact with other systems 10 | # # 11 | # # Messages are also just entities with some helpful wrappers 12 | # # they are composed of content (any type), and any number of tags 13 | (def-tag my-tick) 14 | 15 | (timers/every world 2 16 | (fn [wld dt] 17 | (messages/send wld "hello" my-tick))) 18 | 19 | # then you may query for that specific message. 20 | # dont forget to consume the message after youre done with it, otherwise 21 | # you will get it on the next loop. This example also sorts messages by 22 | # when they were created. 23 | (def-system reciever-sys 24 | {wld :world 25 | msgs [:message :my-tick] 26 | movables [:position :velocity]} 27 | (if (> (length msgs) 0) 28 | (each [msg] (sorted-by |(get-in $ [0 :created]) msgs) 29 | (prin "consume ") 30 | (pp (msg :content)) 31 | (messages/consume msg)) 32 | (print "nothing to consume"))) 33 | 34 | (register-system world reciever-sys) 35 | 36 | (for i 0 3 37 | (print "i: " i) 38 | (:update world 1) 39 | (print "")) 40 | -------------------------------------------------------------------------------- /examples/07-tweens.janet: -------------------------------------------------------------------------------- 1 | (use /junk-drawer) 2 | 3 | # Tweens (short for in-betweening) allows you to interpolate values using predefined functions, 4 | # the applet here https://hump.readthedocs.io/en/latest/timer.html#tweening-methods 5 | # gives a good visualization of what happens. 6 | # 7 | # In this example we will tween the components color using in-cubic over 10 ticks. 8 | (def-component color 9 | :r :number 10 | :g :number 11 | :b :number) 12 | 13 | (def-component map-location 14 | :gps (props :latitude :number :longitude :number) 15 | :timezone :string) 16 | 17 | (def-system print-colors 18 | {colors [:color]} 19 | (map pp (flatten colors))) 20 | 21 | (def-system print-map-locations 22 | {map-locations [:map-location]} 23 | (map pp (flatten map-locations))) 24 | 25 | (def world (create-world)) 26 | 27 | (register-system world tweens/update-sys) 28 | (register-system world print-colors) 29 | (register-system world print-map-locations) 30 | 31 | # Tweens are full fledged entities in the world that will query for then update 32 | # component values. You can have any number of tween entities operating on an entity. 33 | # However, be carefull about tweening the same component in multiple different ways at 34 | # the same time as that could create infinite loops, or tons of tween entities doing 35 | # the same thing! 36 | (var ent1 (add-entity world (color :r 0 :g 0 :b 0))) 37 | (tweens/create world ent1 :color 38 | :to (color :r 255 :g 0 :b 128) 39 | :with tweens/in-cubic 40 | :duration 10) 41 | 42 | 43 | # Tweens work recursively on nested objects, any other type then a number will be 44 | # ignored. 45 | (var ent2 (add-entity world (map-location :gps @{:latitude 100.0 46 | :longitude 34.1} 47 | :timezone "utc"))) 48 | (tweens/create world ent2 :map-location 49 | :to {:gps {:latitude 87.4}} 50 | :with tweens/in-linear 51 | :duration 14) 52 | 53 | (for i 0 20 54 | (print "\ntick: " i) 55 | (:update world 1)) 56 | -------------------------------------------------------------------------------- /examples/08-fsm-n-ecs.janet: -------------------------------------------------------------------------------- 1 | (use ./../junk-drawer) 2 | 3 | # Since FSM's are just functions that return tables, 4 | # they can be added as components to entities! 5 | # here's a (contrived & useless) example 6 | (fsm/define 7 | colored-warnings 8 | (fsm/state :green) 9 | (fsm/transition :warn :green :yellow) 10 | 11 | (fsm/state :yellow) 12 | (fsm/transition :panic :yellow :red) 13 | (fsm/transition :clear :yellow :green) 14 | 15 | (fsm/state :red) 16 | (fsm/transition :calm :red :yellow)) 17 | 18 | (def-component position :x :number :y :number) 19 | 20 | (def world (create-world)) 21 | 22 | (register-system world timers/update-sys) 23 | 24 | (add-entity world 25 | (position :x 5 :y 5) 26 | (colored-warnings :green)) 27 | (add-entity world 28 | (position :x 3 :y 3) 29 | (colored-warnings :yellow)) 30 | 31 | (timers/every world 2 32 | (fn [world _] 33 | (each [e c] (:view world [:entity :colored-warnings]) 34 | (when (= (c :current) :yellow) 35 | (print "Clearing " e " from timer") 36 | (:clear c)))) 37 | 2) 38 | 39 | (def-system x-val-warning 40 | {entities [:position :colored-warnings]} 41 | (each [e machine] entities 42 | (def re (> (math/random) 0.5)) 43 | (def mc (machine :current)) 44 | (printf "%q %q" e mc) 45 | (when re 46 | (print "Random event!") 47 | (case mc 48 | :green (:warn machine) 49 | :yellow (:panic machine) 50 | :red (:calm machine)) 51 | (print "Moved to " (machine :current))))) 52 | 53 | (register-system world x-val-warning) 54 | 55 | (for _ 0 10 56 | (:update world 1) 57 | (print)) 58 | -------------------------------------------------------------------------------- /examples/09-vectors.janet: -------------------------------------------------------------------------------- 1 | # Vectors are pretty straighforward, just create em and use their methods 2 | # check out the implimentation for all the functions available. 3 | (use /junk-drawer) 4 | 5 | (def vec (vector/new 1 2)) 6 | (def vec2 (vector/from-tuple [5 5])) 7 | (printf "vector 1: %q" vec) 8 | (printf "vector 2: %q" vec2) 9 | 10 | (printf "distance between them : %n" (:distance vec vec2)) 11 | 12 | # One useful thing you can do with the vectors module is use them as ECS components 13 | (def-component-alias position vector/from-named) 14 | 15 | (printf "position component alias: %q" (position :x 2 :y 3)) 16 | (printf "it has the vector proto table: %q" (table/getproto (position :x 2 :y 3))) 17 | -------------------------------------------------------------------------------- /examples/10-envelopes.janet: -------------------------------------------------------------------------------- 1 | (use /junk-drawer) 2 | 3 | (defn print-bar [v] 4 | (for j 0 (math/round v) (prin "=")) 5 | (print "")) 6 | 7 | # Envelopes are multi-state tweens. Lets look at the most complicated one, ADSR 8 | # 9 | # ADSR is short for Attack Decay Sustain Release. Targets and durations are required, 10 | # but tweens are optional (default to linear). 11 | (var *adsr* (envelopes/adsr 12 | :attack-target 50 :attack-duration 20 :attack-tween tweens/in-cubic 13 | :decay-target 25 :decay-duration 15 14 | :release-duration 15 :release-tween tweens/in-out-quad)) 15 | 16 | # call begin on adsr to move it off the :idle state 17 | (:trigger *adsr*) 18 | 19 | # call tick to iterate to the next step.. though we'll get trapped in the sustain state 20 | (for i 0 40 (print-bar (:tick *adsr*))) 21 | 22 | (:release *adsr*) 23 | (print "RELEASED") 24 | 25 | (for i 0 15 (print-bar (:tick *adsr*))) 26 | 27 | # There are also the simpler ASR and AR envelopes. 28 | # ALSO, you can release or (re)trigger early from any relevent state 29 | -------------------------------------------------------------------------------- /examples/11-jaylib.janet: -------------------------------------------------------------------------------- 1 | (use jaylib) 2 | (use /junk-drawer) 3 | 4 | (def black (map |(/ $ 255) [50 47 41])) 5 | (def white (map |(/ $ 255) [177 174 168])) 6 | (def screen-width 400) 7 | (def screen-height 240) 8 | 9 | (def GS (gamestate/init)) 10 | 11 | # Components 12 | (def-component-alias position vector/from-named) 13 | (def-component-alias velocity vector/from-named) 14 | (def-component circle :radius :number :color (any)) 15 | 16 | # System Callbacks 17 | (def-system sys-move 18 | {moveables [:position :velocity]} 19 | (each [pos vel] moveables 20 | (put pos :x (+ (pos :x) (* dt (vel :x)))) 21 | (put pos :y (+ (pos :y) (* dt (vel :y)))))) 22 | 23 | (def-system sys-draw-circle 24 | {circles [:position :circle]} 25 | (each [pos circle] circles 26 | (draw-circle 27 | (pos :x) (pos :y) 28 | (circle :radius) (circle :color)))) 29 | 30 | (gamestate/def-state 31 | pause 32 | :update (fn pause-update [self dt] 33 | (draw-poly [100 100] 5 40 0 :magenta) 34 | 35 | (when (key-pressed? :space) 36 | (:unpause-game GS)))) 37 | 38 | (gamestate/def-state 39 | game 40 | :world (create-world) 41 | :init (fn game-init [self] 42 | (let [world (get self :world)] 43 | # Entities 44 | (let [pos (position :x 100.0 :y 100.0) 45 | vel (velocity :x 1 :y 2) 46 | circ (circle :radius 40 :color white)] 47 | (add-entity world pos vel circ)) 48 | 49 | (add-entity world 50 | (position :x 200.0 :y 50.0) 51 | (velocity :x -2 :y 4) 52 | (circle :radius 40 :color white)) 53 | 54 | # Systems 55 | (register-system (self :world) sys-move) 56 | (register-system (self :world) sys-draw-circle))) 57 | :update (fn game-update [self dt] 58 | (:update (self :world) dt) 59 | 60 | (when (key-pressed? :space) 61 | (:pause-game GS)))) 62 | 63 | (:add-state GS pause) 64 | (:add-state GS game) 65 | 66 | (:add-edge GS (gamestate/transition :pause-game :game :pause)) 67 | (:add-edge GS (gamestate/transition :unpause-game :pause :game)) 68 | 69 | (:goto GS :game) 70 | 71 | # Jayley Code 72 | # https://github.com/raysan5/raylib/blob/master/examples/shaders/shaders_custom_uniform.c 73 | 74 | (init-window 800 480 "Test Game") 75 | (set-target-fps 30) 76 | (hide-cursor) 77 | 78 | (def target (load-render-texture screen-width screen-height)) 79 | 80 | (while (not (window-should-close)) 81 | (begin-drawing) 82 | (clear-background black) 83 | (:update GS 1) 84 | (draw-fps 10 10) 85 | (end-drawing) 86 | 87 | # (begin-texture-mode target) 88 | # (draw-circle 300 400 40 white) 89 | # (end-texture-mode) 90 | # (draw-texture (get-texture-default) 0 0 :white) 91 | # (draw-texture-rec target.texture 0 0 screen-width screen-height [0 0] :white) 92 | ) 93 | 94 | (unload-render-texture target) 95 | (close-window) 96 | -------------------------------------------------------------------------------- /examples/12-envelopes-visualizer.janet: -------------------------------------------------------------------------------- 1 | (use jaylib) 2 | (use /junk-drawer) 3 | 4 | (init-window 1000 480 "Envelopes Visualizer") 5 | (set-target-fps 30) 6 | (hide-cursor) 7 | 8 | (var *adsr* (envelopes/adsr 9 | :attack-target 200 :attack-duration 60 :attack-tween tweens/out-linear 10 | :decay-target 120 :decay-duration 40 11 | :release-duration 50 :release-tween tweens/in-out-quad)) 12 | 13 | (:trigger *adsr*) 14 | 15 | (begin-drawing) 16 | (clear-background 0x222034ff) 17 | 18 | (for i 0 150 19 | (draw-circle (+ 20 (* i 4)) 20 | (math/round (- 400 (:tick *adsr*))) 21 | 3 22 | (match (*adsr* :current) 23 | :idle 0xcbdbfcff 24 | :attack 0x99e550ff 25 | :decay 0xd95763ff 26 | :sustain 0x5fcde4ff))) 27 | 28 | (:release *adsr*) 29 | 30 | (for i 150 200 31 | (draw-circle (+ 20 (* i 4)) 32 | (math/round (- 400 (:tick *adsr*))) 33 | 3 0xfbf236ff)) 34 | (end-drawing) 35 | 36 | (while (not (window-should-close)) nil) 37 | 38 | (close-window) 39 | -------------------------------------------------------------------------------- /junk-drawer-logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AlecTroemel/junk-drawer/872f514d3b60a65d9a36bfdbb69a9e1f377b54f4/junk-drawer-logo.png -------------------------------------------------------------------------------- /junk-drawer.janet: -------------------------------------------------------------------------------- 1 | (import ./junk-drawer/ecs :prefix "" :export true) 2 | 3 | (import ./junk-drawer/directed-graph :as digraph :export true) 4 | (import ./junk-drawer/vector :as vector :export true) 5 | (import ./junk-drawer/fsm :as fsm :export true) 6 | (import ./junk-drawer/gamestate :as gamestate :export true) 7 | (import ./junk-drawer/envelopes :as envelopes :export true) 8 | 9 | (import ./junk-drawer/timers :as timers :export true) 10 | (def timer timers/timer) 11 | 12 | (import ./junk-drawer/messages :as messages :export true) 13 | (def message messages/message) 14 | 15 | (import ./junk-drawer/tweens :as tweens :export true) 16 | (def tween tweens/tween) 17 | -------------------------------------------------------------------------------- /junk-drawer/cache.janet: -------------------------------------------------------------------------------- 1 | (defn- insert 2 | "Add a query and its results to the cache." 3 | [self query result] 4 | (put self query result) 5 | result) 6 | 7 | (defn- _get 8 | "Get cache result for the query, nil if DnE." 9 | [self query] 10 | (get self query)) 11 | 12 | (defn- clear 13 | "Clear all cache values that container the component in the query." 14 | [self component] 15 | (loop [query :keys self 16 | :when (index-of component query false)] 17 | (put self query nil))) 18 | 19 | (defn init 20 | "Instantiate new ECS cache." 21 | [] 22 | (table/setproto 23 | @{} 24 | @{:insert insert 25 | :get _get 26 | :clear clear})) 27 | -------------------------------------------------------------------------------- /junk-drawer/directed-graph.janet: -------------------------------------------------------------------------------- 1 | (setdyn :doc ``` 2 | A directed graph is a collection of nodes with edges, in which the edges have a 3 | direction. The implimentation here uses an adjaceny matrix under the hood, and 4 | has these additions... 5 | 6 | - Edges may also have a unique name and weight. 7 | - Nodes may have arbitrary data in them. 8 | 9 | Nodes and edges are created using their respective macros (node) and (edge). 10 | A new graph is created using the (create) function. 11 | 12 | The following graph functions are public in this module, and are also added to the 13 | graph objects metatable if you prefer a OoP style. 14 | 15 | - contains 16 | - add-node 17 | - add-edge 18 | - get-node 19 | - neighbors 20 | - list-nodes 21 | - list-edges 22 | - find-path 23 | 24 | check out the docs on any of those macros/functions for more. 25 | ```) 26 | 27 | (defn node 28 | ``` 29 | Create a node to be used in the "create" or "add-node" functions. Provide 30 | the node name, and any number of key value pairs for the node data. Name 31 | must be a keyword. 32 | 33 | (node :name 34 | :a "pizza" 35 | :b (fn [] "hotdog")) 36 | ``` 37 | [name & properties] 38 | [:node (keyword name) {:edges @{} :data (table ;properties)}]) 39 | 40 | (defn edge 41 | ``` 42 | Create an edge to be used in the "create" or "add-edge" functions. Can be 43 | any of these forms. note that weight defaults to 1, and the edge name defaults 44 | to the to-node name. 45 | 46 | - (edge :edge-name :from-node :to-node weight) 47 | - (edge :edge-name :from-node :to-node) 48 | - (edge :from-node :to-node weight) 49 | - (edge :from-node :to-node) 50 | ``` 51 | [& pattern] 52 | (match pattern 53 | [(name (keyword? name)) (from (keyword? from)) (to (keyword? to)) (weight (number? weight))] 54 | [:edge from {:to to :name name :weight weight}] 55 | 56 | [(name (keyword? name)) (from (keyword? from)) (to (keyword? to))] 57 | [:edge from {:to to :name name :weight 1}] 58 | 59 | [(from (keyword? from)) (to (keyword? to)) (weight (number? weight))] 60 | [:edge from {:to to :name to :weight weight}] 61 | 62 | [(from (keyword? from)) (to (keyword? to))] 63 | [:edge from {:to to :name to :weight 1}])) 64 | 65 | (defn contains [self name] 66 | ``` 67 | Return whether or not the node :name exists in the graph. 68 | ``` 69 | (not (nil? (get-in self [:adjacency-table name])))) 70 | 71 | (defn add-node 72 | ``` 73 | Add a node to the graph. Throws error if node already exists in the graph. 74 | Should use the "node" macro for to create the new node. 75 | ``` 76 | [self [NODE name node-def]] 77 | 78 | (if (:contains self name) 79 | (errorf "graph already contains node %s" name) 80 | (put-in self [:adjacency-table name] node-def))) 81 | 82 | (defn add-edge 83 | ``` 84 | Add a new edge to the graph. You should use the "edge" macro to create the new edge. 85 | Both from and to nodes must exist. 86 | ``` 87 | [self [EDGE from {:to to :name name :weight weight}]] 88 | 89 | (cond (not (:contains self from)) 90 | (errorf "graph does not contain from node %s" from) 91 | 92 | (not (:contains self to)) 93 | (errorf "graph does not contain to node %s" to) 94 | 95 | (put-in self [:adjacency-table from :edges name] 96 | {:to to :weight weight}))) 97 | 98 | (defn neighbors 99 | ``` 100 | Return all the neighbors of the node, in the form {:from :name :to :weight} 101 | ``` 102 | [self from-name] 103 | 104 | (if-let [node (get-in self [:adjacency-table from-name]) 105 | edges (get node :edges)] 106 | (map (fn [(name data)] 107 | {:from from-name 108 | :name name 109 | :to (get data :to) 110 | :weight (get data :weight)}) 111 | (pairs edges)) 112 | [])) 113 | 114 | (defn get-node 115 | "The data & edges for the provided node name." 116 | [self name] 117 | (get-in self [:adjacency-table name])) 118 | 119 | (defn list-nodes 120 | "Names of all the nodes in the graph." 121 | [self] 122 | (keys (self :adjacency-table))) 123 | 124 | (defn list-edges [self] 125 | "Return all the edges in the graph in the form {:from :name :to :weight}." 126 | [;(mapcat (fn [(from-node-name node)] 127 | (map (fn [(edge-name edge)] 128 | (table/to-struct 129 | (merge {:from from-node-name :name edge-name} 130 | edge))) 131 | (pairs (get node :edges)))) 132 | (pairs (self :adjacency-table)))]) 133 | 134 | (defn- priority-push [priority-queue data weight] 135 | (array/push priority-queue [data weight])) 136 | 137 | (defn- priority-pop [priority-queue] 138 | (var lowest-i 0) 139 | (var lowest-weight 0) 140 | 141 | (for i 0 (length priority-queue) 142 | (when-let [[data weight] (get priority-queue i) 143 | is-lower (< weight lowest-weight)] 144 | (set lowest-i i) 145 | (set lowest-weight weight))) 146 | 147 | (let [(data weight) (get priority-queue lowest-i)] 148 | (array/remove priority-queue lowest-i 1) 149 | data)) 150 | 151 | (defn find-path 152 | ``` 153 | Find the shortest path from the "start" node to "end" node. Uses a breadth first 154 | search which takes into account edge weights and exits out early if goal is found. 155 | Returns a list of the edge-names to take from start to reach the goal. 156 | 157 | You can also provided an optional (fn heuristic [graph goal-name next-node-name] number) 158 | function to further improve the search. Consider using the vector module with your node and 159 | using a heuristic like this: 160 | 161 | (node :name-here :position (vector/new 1 3)) 162 | 163 | (defn manhattan-distance-heuristic [graph goal next] 164 | (let [{:data goal-data} (:get-node graph goal) 165 | {:data next-data} (:get-node graph next)] 166 | (:length2 (goal-data :position) 167 | (next-data :position)))) 168 | ``` 169 | [self start goal &opt heuristic] 170 | 171 | (default heuristic (fn [& rest] 0)) 172 | (let [frontier @[[start 0]] 173 | came-from @{} # path A->B is stored as (came-from B) => A 174 | cost-so-far @{start 0}] 175 | 176 | (var current nil) 177 | (while (and (array/peek frontier) (not= current goal)) 178 | (set current (priority-pop frontier)) 179 | (loop [{:name edge-name :to next :weight weight} :in (:neighbors self current) 180 | :let [new-cost (+ (cost-so-far current) weight)] 181 | :when (or (nil? (get came-from next)) 182 | (< new-cost (cost-so-far next)))] 183 | (put cost-so-far next new-cost) 184 | (priority-push frontier next (+ new-cost (heuristic self goal next))) 185 | (put came-from next {:from current :edge-name edge-name}))) 186 | 187 | 188 | # follow the came-from backwards from the goal to the start. 189 | (var current {:from goal}) 190 | (let [path @[]] 191 | (while (not= (get current :from) start) 192 | (array/push path current) 193 | (set current (get came-from (get current :from)))) 194 | (array/push path current) 195 | 196 | (->> (reverse path) 197 | (map |(get $ :edge-name)) 198 | (filter |(not (nil? $))) 199 | (splice) 200 | (tuple))))) 201 | 202 | (def Graph 203 | @{:contains contains 204 | :add-node add-node 205 | :add-edge add-edge 206 | :get-node get-node 207 | :neighbors neighbors 208 | :list-nodes list-nodes 209 | :list-edges list-edges 210 | :find-path find-path 211 | :adjacency-table @{}}) 212 | 213 | (defn create [& patterns] 214 | ``` 215 | Instantiate a new directed graph with optional starting nodes and edges. 216 | See "node" and "edge" macros for more. 217 | 218 | (create 219 | (node :red) 220 | (node :green 221 | :key "val" 222 | :say (fn [self] "hello world")) 223 | (edge :red :green) 224 | (edge :panic :green :red 2)) # override name and weight 225 | ``` 226 | (let [graph (table/setproto @{:adjacency-table @{}} Graph) 227 | nodes (filter |(= :node (first $)) patterns) 228 | edges (filter |(= :edge (first $)) patterns)] 229 | 230 | (each n nodes (:add-node graph n)) 231 | (each e edges (:add-edge graph e)) 232 | 233 | graph)) 234 | -------------------------------------------------------------------------------- /junk-drawer/ecs.janet: -------------------------------------------------------------------------------- 1 | (use spork/schema) 2 | 3 | (import ./sparse-set) 4 | (import ./cache) 5 | 6 | (setdyn :doc ``` 7 | ECS (short for Entity Component System) is a game dev pattern where you 8 | 9 | 1. Define components with (def-component) that hold data of a specific aspect. Components are 10 | just objects that have the :__id__ field on them (which names the component in the world). 11 | 2. Define systems with (def-system) which process entities with matching components 12 | 3. Create a world which will hold your entities and have registered systems. 13 | 4. Create entities comprised of many components in your world. 14 | 15 | ECS encourage code reuse by breaking down problems into their individual and isolated parts! 16 | This implimentation uses a (relatively naive) sparse set data structure. 17 | ```) 18 | 19 | (defmacro def-component 20 | ``` 21 | Define a new component fn of the specified fields, where fields follow the 22 | ":name spork/schema" pattern. Names must be keywords, and the datatype can be 23 | valid spork/schema. The component function will then verify that the types of 24 | the fields are correct when ran. 25 | 26 | (def-component pizza :hotdog :number :frenchfry :string) 27 | (pizza :hotdog 1) # throws error missing "frenchfry" field 28 | (pizza :hotdog "string") # throws error datatype missmatch 29 | (pizza :hotdog 1 :frenchfry "milkshake") # evaluates to... 30 | {:hotdog 1 :frenchfry "milkshake} 31 | 32 | dont need anydata? check out (def-tag) 33 | ``` 34 | [name & fields] 35 | ~(defn ,name [&named ,;(map symbol (keys (table ;fields)))] 36 | (-> (table/setproto ,(table ;(mapcat |[$ (symbol $)] (keys (table ;fields)))) 37 | @{:__id__ ,(keyword name) 38 | :__validate__ ,((make-validator ~(props ,;fields)))}) 39 | (:__validate__)))) 40 | 41 | (defmacro def-tag 42 | ``` 43 | Define a new tag, a component that holds no data. 44 | 45 | (def-tag monster) 46 | (add-entity world (monster)) 47 | ``` 48 | [name] 49 | ~(defn ,name [] 50 | (table/setproto @{} 51 | @{:__id__ ,(keyword name) 52 | :__validate__ (fn [& args] false)}))) 53 | 54 | (defmacro def-component-alias 55 | ``` 56 | Define a component alias. Constructor fn should return a component, which 57 | will be given a new id (the name of the alias). 58 | 59 | (def-component-alias position vector/new) 60 | ``` 61 | [name constructor-fn] 62 | ~(defn ,name [& args] 63 | (merge-into (,constructor-fn ;args) 64 | ,@{:__id__ (keyword name)}))) 65 | 66 | (defmacro def-system 67 | ``` 68 | Define a system fn that operates over queries. Queries are lists 69 | of component names, an are assigned to a variable. Note that "dt" 70 | is implicitly available in all systems context. 71 | 72 | (def-system move-sys 73 | {moveables [:position :velocity]} 74 | (each [pos vel] moveables 75 | (put pos :x (+ (pos :x) (* dt (vel :x)))) 76 | (put pos :y (+ (pos :y) (* dt (vel :y)))))) 77 | 78 | Additionaly, if you need the parent world invoking the system, there's 79 | a special query for that. This is useful when creating or deleting 80 | Entites within a system. 81 | 82 | (def-system give-me-the-world 83 | {wld :world} 84 | (pp wld)) 85 | ``` 86 | [name queries & body] 87 | 88 | ~(def ,name 89 | (tuple 90 | ,(values queries) 91 | (fn ,name [,;(keys queries) dt] ,;body)))) 92 | 93 | (defn- get-or-create-component-set 94 | "return the sparse set for the component, creating if it it does not already exist." 95 | [{:database db :capacity cap} cmp-name] 96 | (match (get db cmp-name) 97 | nil (let [new-set (sparse-set/init cap)] 98 | (put db cmp-name new-set) 99 | new-set) 100 | cmp-set cmp-set)) 101 | 102 | (defn add-component 103 | ``` 104 | Add a new component to an existing entity. Note this has 105 | some performance implications, as it will invalidate the 106 | query cache for all related systems. 107 | 108 | (add-component ENTITY_ID_HERE (position :x 1 :y 2)) 109 | ``` 110 | [world eid component] 111 | (let [cmp-name (component :__id__) 112 | cmp-set (get-or-create-component-set world cmp-name)] 113 | (:insert cmp-set eid component) 114 | (:clear (world :view-cache) cmp-name))) 115 | 116 | (defn remove-component 117 | ``` 118 | Remove a component by its name from an entity. Note this has 119 | some performance implications, as it will invalidate the 120 | query cache for all related systems. 121 | 122 | (remove-component ENTITY_ID_HERE :position) 123 | ``` 124 | [world ent component-name] 125 | (let [pool (get-in world [:database component-name])] 126 | (assert (not (nil? pool)) "component does not exist in world") 127 | (assert (not= -1 (:search pool ent)) "entity with component does not exist in world") 128 | (:delete pool ent) 129 | (:clear (get world :view-cache) component-name))) 130 | 131 | (defn add-entity 132 | ``` 133 | Add a new entity with the given components to the world. 134 | Note this has some performance implications, as it will invalidate the query cache 135 | for all systems using any of the provided components. 136 | 137 | (add-entity world 138 | (position :x 0 :y 0) 139 | (velocity :x 1 :y 1) 140 | (monster)) 141 | ``` 142 | [world & components] 143 | 144 | # Use a free ID (from deleted entity) if available 145 | (let [eid (cond (> (length (world :reusable-ids)) 0) 146 | (array/pop (world :reusable-ids)) 147 | 148 | (let [id (get world :id-counter)] 149 | (+= (world :id-counter) 1) id))] 150 | 151 | # Add individual component data to database 152 | (each component components 153 | (add-component world eid component)) 154 | 155 | # Return the new eid just created 156 | eid)) 157 | 158 | (defn remove-entity 159 | ``` 160 | Remove an entity from the world by its ID. 161 | 162 | Note this has some performance implications, as it will invalidate the query cache 163 | for all systems using any of the components on the entity. 164 | 165 | (remove-entity world ENTITY_ID) 166 | ``` 167 | [world ent] 168 | 169 | (eachp [name pool] (world :database) 170 | (when (:delete pool ent) 171 | (:clear (get world :view-cache) name))) 172 | (array/push (world :reusable-ids) ent)) 173 | 174 | (defn register-system 175 | ``` 176 | Register a system to be run on world update. 177 | 178 | (register-system world move-sys) 179 | ``` 180 | [world & systems] 181 | (each sys systems 182 | (array/push (get world :systems) sys))) 183 | 184 | (defn- smallest-pool [pools] 185 | "Length (n) of smallest pool." 186 | (reduce2 |(if (< (get-in $0 [1 :n]) 187 | (get-in $1 [1 :n])) 188 | $0 $1) 189 | pools)) 190 | 191 | (defn- every-has? [pools eid] 192 | "True if every pool has the entity id, false otherwise." 193 | (every? (map |(not= -1 (:search $ eid)) pools))) 194 | 195 | (defn- intersection-entities [pools] 196 | "List of entities which all pools contain." 197 | 198 | (let [small-pool (smallest-pool pools)] 199 | (mapcat 200 | |(let [eid (get-in small-pool [:entities $])] 201 | (if (every-has? pools eid) [eid] [])) 202 | (range 0 (+ 1 (small-pool :n)))))) 203 | 204 | (defn- view-entry [pools eid] 205 | "Tuple of all component data for eid from pools (eid cmp-data cmp-data-2 ...)." 206 | (tuple ;(map |(:get-component $ eid) pools))) 207 | 208 | (defn- view [{:database database :view-cache view-cache :capacity capacity} query] 209 | "Result of query as list of tuples [(eid cmp-data cmp-data-2 ...)]." 210 | (if-let [cached-view (:get view-cache query)] 211 | cached-view 212 | (if-let [pools (map |(match $ 213 | :entity {:get-component (fn [self eid] eid) 214 | :search (fn [self eid] 0) 215 | :n (+ 1 capacity) 216 | :debug-print (fn [self] (print "entity patch"))} 217 | (database $)) query) 218 | all-not-empty? (empty? (filter nil? pools)) 219 | view-result (map |(view-entry pools $) (intersection-entities pools))] 220 | 221 | (:insert view-cache query view-result) 222 | (:insert view-cache query [])))) 223 | 224 | (defn- query-result [world query] 225 | "Either return a special query, or the results of ECS query." 226 | (match query 227 | :world world 228 | [_] (view world query))) 229 | 230 | (defn- update [self dt] 231 | "Call all registers systems for entities matching thier queries." 232 | (loop [(queries func) 233 | :in (self :systems) 234 | :let [queries-results (map |(query-result self $) queries)]] 235 | 236 | (when (some |(not (empty? $)) queries-results) 237 | (func ;queries-results dt)))) 238 | 239 | (defn create-world 240 | ``` 241 | Instantiate a new world. Worlds contain entities and systems that 242 | operate on them. 243 | 244 | (var world (create-world)) 245 | 246 | Call the :update method on the world and be sure to pass in dt, the time 247 | between last call to update 248 | 249 | (:update world dt) 250 | ``` 251 | [&named capacity] 252 | 253 | (default capacity 1000) 254 | @{:capacity capacity 255 | :id-counter 0 256 | :reusable-ids @[] 257 | :database @{} 258 | :view-cache (cache/init) 259 | :systems @[] 260 | :update update 261 | :view view}) 262 | -------------------------------------------------------------------------------- /junk-drawer/envelopes.janet: -------------------------------------------------------------------------------- 1 | (setdyn :doc ``` 2 | Envolopes are basically multistage tweens. There are 5 possible stages to the envelopes 3 | - Idle: envelope is not running 4 | - Attack: time taken for initial run-up of level from nil to peak, beginning when the envelope is begun. 5 | - Decay: time taken for the subsequent run down from the attack level to the designated sustain level. 6 | - Sustain: level during the main sequence of the sound's duration, until the envelope is released. 7 | - Release: time taken for the level to decay from the sustain level to zero after the envelope is released 8 | 9 | This module contains common envelopes usually used in music, however there are many other uses! For example 10 | consider using an ADSR for a characters run speed, or an ASR for their jump arc. 11 | 12 | All envelopes have the same api. Create them with their constructor, then use the ":begin" and ":tick" object method. 13 | 14 | (:begin *adsr*) 15 | (printf "next value: %q" (:tick *adsr*)) 16 | ```) 17 | 18 | (import ./fsm :as "fsm") 19 | (import ./tweens :as "tweens") 20 | 21 | (defn- attack-state [target duration &opt tween] 22 | (default tween tweens/in-linear) 23 | (fsm/state :attack 24 | :start 0 25 | :target target 26 | :elapsed 0 27 | :duration duration 28 | :complete? (fn attack-complete [self] 29 | (> (self :elapsed) 30 | (self :duration))) 31 | :next-value (fn attack-next-value [self] 32 | (tweens/interpolate 33 | (self :start) 34 | (self :target) 35 | (self :elapsed) 36 | (self :duration) 37 | tween)))) 38 | 39 | (defn- decay-state [target duration &opt tween] 40 | (default tween tweens/out-linear) 41 | (fsm/state :decay 42 | :target target 43 | :elapsed 0 44 | :duration duration 45 | :complete? (fn decay-complete [self] 46 | (> (self :elapsed) 47 | (self :duration))) 48 | :next-value (fn decay-next-value [self] 49 | (tweens/interpolate 50 | (self :start) 51 | (self :target) 52 | (self :elapsed) 53 | (self :duration) 54 | tween)))) 55 | 56 | (defn- sustain-state [] 57 | (fsm/state :sustain 58 | :elapsed 0 59 | :complete? (fn sustain-complete? [self] false) 60 | :next-value (fn sustain-next-value [self] (self :value)))) 61 | 62 | (defn- release-state [duration &opt tween] 63 | (default tween tweens/out-linear) 64 | (fsm/state :release 65 | :target 0 66 | :elapsed 0 67 | :duration duration 68 | :complete? (fn release-complete [self] 69 | (> (self :elapsed) 70 | (self :duration))) 71 | :next-value (fn release-next-value [self] 72 | (tweens/interpolate 73 | (self :start) 74 | (self :target) 75 | (self :elapsed) 76 | (self :duration) 77 | tween)))) 78 | 79 | (defn- idle-state [] 80 | (fsm/state :idle 81 | :elapsed 0 82 | :complete? (fn idle-complete? [self] false) 83 | :next-value (fn idle-next-value [self] 0))) 84 | 85 | (defn- tick [self] 86 | (let [current-node (:get-node self (self :current)) 87 | new-value (:next-value self)] 88 | (+= (self :elapsed) 1) 89 | (put self :value new-value) 90 | 91 | (when-let [state-complete? (:complete? self) 92 | auto-fn (get self :auto false) 93 | next-start (get self :target new-value)] 94 | (:auto self) 95 | (put self :start next-start) 96 | (put self :value next-start)) 97 | 98 | (self :value))) 99 | 100 | (def Envelope 101 | (merge 102 | fsm/FSM 103 | @{:tick tick 104 | :current :idle 105 | :value 0 106 | :__id__ :envelope 107 | :__validate__ (fn [& args] true)})) 108 | 109 | (defmacro- defn-envelope [name docs args & body] 110 | ~(defn ,name 111 | ,docs 112 | [&named ,;args] 113 | (-> (table/setproto 114 | (,fsm/create ,;body) 115 | ,Envelope) 116 | (:apply-edges-functions) 117 | (:apply-data-to-root)))) 118 | 119 | (defn-envelope ar 120 | ``` 121 | Create a new AR finite state machine. It just uses attack -> release. 122 | 123 | /\ 124 | / \ 125 | / \ 126 | / \ 127 | A R 128 | ``` 129 | [attack-target attack-duration attack-tween 130 | release-duration release-tween] 131 | 132 | (idle-state) 133 | (fsm/transition :trigger :idle :attack) 134 | 135 | (attack-state attack-target attack-duration attack-tween) 136 | (fsm/transition :auto :attack :release) 137 | (fsm/transition :trigger :attack :attack) 138 | (fsm/transition :release :attack :release) 139 | 140 | (release-state release-duration release-tween) 141 | (fsm/transition :trigger :release :attack) 142 | (fsm/transition :auto :release :idle)) 143 | 144 | (defn-envelope asr 145 | ``` 146 | Create a new ASR finite state machine, attack -> sustain -> release. 147 | 148 | /------\ 149 | / \ 150 | / \ 151 | / \ 152 | A S R 153 | ``` 154 | [attack-target attack-duration attack-tween 155 | release-duration release-tween] 156 | 157 | (idle-state) 158 | (fsm/transition :trigger :idle :attack) 159 | 160 | (attack-state attack-target attack-duration attack-tween) 161 | (fsm/transition :auto :attack :sustain) 162 | (fsm/transition :trigger :attack :attack) 163 | (fsm/transition :release :attack :release) 164 | 165 | (sustain-state) 166 | (fsm/transition :trigger :sustain :attack) 167 | (fsm/transition :release :sustain :release) 168 | 169 | (release-state release-duration release-tween) 170 | (fsm/transition :trigger :release :attack) 171 | (fsm/transition :auto :release :idle)) 172 | 173 | 174 | (defn-envelope adsr 175 | ``` 176 | Create a new ADSR finite state machine, attack -> decay -> sustain -> release. 177 | 178 | /\ 179 | / \ 180 | / ------\ 181 | / \ 182 | A D S R 183 | ``` 184 | [attack-target attack-duration attack-tween 185 | decay-target decay-duration decay-tween 186 | release-duration release-tween] 187 | (idle-state) 188 | (fsm/transition :trigger :idle :attack) 189 | 190 | (attack-state attack-target attack-duration attack-tween) 191 | (fsm/transition :auto :attack :decay) 192 | (fsm/transition :trigger :attack :attack) 193 | (fsm/transition :release :attack :release) 194 | 195 | (decay-state decay-target decay-duration decay-tween) 196 | (fsm/transition :auto :decay :sustain) 197 | (fsm/transition :trigger :decay :attack) 198 | (fsm/transition :release :decay :release) 199 | 200 | (sustain-state) 201 | (fsm/transition :trigger :sustain :attack) 202 | (fsm/transition :release :sustain :release) 203 | 204 | (release-state release-duration release-tween) 205 | (fsm/transition :trigger :release :attack) 206 | (fsm/transition :auto :release :idle)) 207 | -------------------------------------------------------------------------------- /junk-drawer/fsm.janet: -------------------------------------------------------------------------------- 1 | (import ./directed-graph :as "digraph" :export true) 2 | 3 | (setdyn :doc ``` 4 | FSM (short for Finite State Machine) is a model where you define states (or nodes) 5 | and transitions between those states, with a machine only "at" a single state at a time. 6 | 7 | This module extends the directed-graph. The main way you'll use it is with 8 | the (fsm/define) function, which is used to create a state machine "blueprint" function. 9 | Check out the docs of that fn for more! 10 | ```) 11 | 12 | (defn- get-current-state [self] 13 | (:get-node self (self :current))) 14 | 15 | (defn- current-node-call [self fn-name & args] 16 | "" 17 | (when-let [current-node (:get-current-state self) 18 | node-fn (get-in current-node [:data fn-name] nil) 19 | leave-exists (not (nil? node-fn))] 20 | (node-fn self ;args))) 21 | 22 | (defn- apply-edges-functions [self] 23 | "Create functions on self for each edge in the current node" 24 | # clear out old transition methods 25 | (each key (get self :current-transition-methods []) 26 | (put self key nil)) 27 | (put self :current-transition-methods @[]) 28 | 29 | (when-let [current-node (:get-current-state self) 30 | edges (current-node :edges)] 31 | (each (edge-name edge) (pairs edges) 32 | (array/push (self :current-transition-methods) edge-name) 33 | (put self edge-name 34 | (fn [self & args] (:goto self (get edge :to) ;args))))) 35 | 36 | self) 37 | 38 | (defn- apply-data-to-root [self] 39 | "" 40 | # clear out old fields 41 | (each key (get self :current-data-keys []) 42 | (put self key nil)) 43 | (put self :current-data-keys @[]) 44 | 45 | # apply data to root of fsm 46 | (let [current-node (:get-current-state self) 47 | {:data data} current-node] 48 | (each (key val) (pairs data) 49 | (array/push (self :current-data-keys) key) 50 | (put self key val))) 51 | 52 | self) 53 | 54 | (defn- goto [self to & args] 55 | "" 56 | (assert (:contains self to) (string/format "%q is not a valid state" to)) 57 | 58 | (:current-node-call self :leave to) 59 | 60 | (let [from (get self :current)] 61 | (put self :current to) 62 | (:apply-edges-functions self) 63 | (:apply-data-to-root self) 64 | 65 | (when (nil? (get-in self [:visited to])) 66 | (:current-node-call self :init) 67 | (put-in self [:visited to] true)) 68 | 69 | (:current-node-call self :enter from ;args))) 70 | 71 | (def FSM 72 | (merge digraph/Graph 73 | @{:current @{} 74 | :current-data-keys @[] 75 | :current-transition-methods @[] 76 | :visited @{} 77 | :get-current-state get-current-state 78 | :current-node-call current-node-call 79 | :apply-edges-functions apply-edges-functions 80 | :apply-data-to-root apply-data-to-root 81 | :goto goto 82 | :add-state (get digraph/Graph :add-node)})) 83 | 84 | (defn create [& states] 85 | "Create a new FSM from the given states." 86 | (table/setproto (digraph/create ;states) 87 | FSM)) 88 | 89 | (def state digraph/node) 90 | (def transition digraph/edge) 91 | (defmacro def-state [name & args] 92 | ~(def ,(symbol name) 93 | (,state ,(keyword name) ,;args))) 94 | 95 | (defmacro define 96 | ``` 97 | define a Finite State Machine. This macro creates a factory or blueprint for the 98 | FSM. Each state is a Struct with transition functions, and optional data. The 99 | Resulting "factory" is pass the starting state when an actual FSM is instantiated. 100 | 101 | If 'enter' or 'leave' functions are defined in a state, then will be called during the 102 | transition. You can also provide addition arguments to a transition fn, and they will 103 | be passed to the 'going to' state's enter fn. 104 | 105 | If the 'init' function is defined on the state, it will be called only once the first 106 | time the state is visited. 107 | 108 | (fsm/define colors-fsm 109 | (fsm/state :green 110 | :enter (fn [self from] (print "entering green")) 111 | :leave (fn [self to] (print "entering leaving"))) 112 | (fsm/transition :next :green :yellow) 113 | 114 | (fsm/state :yellow 115 | :init (fn [self] (print "visiting yellow for the first time")) 116 | :enter (fn [self from] (print "entering yellow"))) 117 | (fsm/transition :prev :yellow :green)) 118 | 119 | (def *colors* (colors-fsm :green)) 120 | 121 | The ':current' field on the FSM instance will return the name of the current state. 122 | (*colors* :current) # -> :green 123 | 124 | Then call the transition methods on the FSM to move between states. 125 | (:next *colors*) 126 | (*colors* :current) # -> :yellow 127 | 128 | # TODO 129 | Additionally, you can put any arbitrary data/methods in a state, and it will be available 130 | on the root machine when in that state. Just remember that any data will be removed when 131 | you leave the state! 132 | ``` 133 | [name & states] 134 | 135 | ~(defn ,name [&opt initial-state] 136 | (-> (,create ,;states) 137 | (put :current initial-state) 138 | (put :__validate__ (fn [& args] true)) 139 | (put :__id__ ,(keyword name)) 140 | (:apply-edges-functions) 141 | (:apply-data-to-root)))) 142 | -------------------------------------------------------------------------------- /junk-drawer/gamestate.janet: -------------------------------------------------------------------------------- 1 | (import ./fsm :as "fsm" :export true) 2 | 3 | (setdyn :doc ``` 4 | Gamestates encapsulates specific states... of your game! A typical game could 5 | consist of a menu-state, a level-state and a game-over-state. There is a single 6 | gamestate manager which you initiate with (def *GS* (gamestate/init)), then switch 7 | between states. 8 | 9 | this module is a thin extension to the Finite state machine. 10 | ```) 11 | 12 | (def state fsm/state) 13 | (def transition fsm/transition) 14 | (defmacro def-state [& args] ~(as-macro ,fsm/def-state ,;args)) 15 | 16 | (defn- update 17 | "Update the game state. Called every frame with dt arg." 18 | [self dt & args] 19 | (:current-node-call self :update dt ;args)) 20 | 21 | (defn- draw 22 | "Draw on the screen. Called every frame." 23 | [self & args] 24 | (:current-node-call self :draw ;args)) 25 | 26 | (def GamestateManager 27 | (merge fsm/FSM 28 | {:update update 29 | :draw draw})) 30 | 31 | (defn init 32 | ``` 33 | Create a new gamestate manager. Gamestates are switched to using the "switch" method. 34 | ``` 35 | [] (table/setproto (fsm/create) GamestateManager)) 36 | -------------------------------------------------------------------------------- /junk-drawer/messages.janet: -------------------------------------------------------------------------------- 1 | (use ./ecs) 2 | 3 | (setdyn :doc ``` 4 | It is often useful to pass event messages between systems. This extension 5 | to the ECS gives a simple way to do that. Simply register the update system 6 | 7 | YOU MUST REGISTER THIS FUNCTION AFTER ALL SYSTEMS THAT USE MESSAGES 8 | (register-system world messages/update-sys) 9 | 10 | then send and consume messages.Its very important that you consume every 11 | message you create at some point, otherwise your message queue will grow 12 | indefinitly! 13 | ```) 14 | 15 | (def-component message 16 | :content (any) 17 | :consumed :boolean 18 | :created :number) 19 | 20 | (def-system update-sys 21 | {messages [:entity :message] wld :world} 22 | (loop [[ent msg] :in messages :when (msg :consumed)] 23 | (remove-entity wld ent))) 24 | 25 | (defn send 26 | ``` 27 | create a message entity with content & the tag components. 28 | Message body can be any type, and tags must be tag components 29 | (see def-tag). 30 | 31 | (messages/send wld "hello" my-tick) 32 | 33 | Its very important that you consume every message you create at some 34 | point, otherwise your message queue will grow indefinitly! Consume a 35 | message with (message/consume msg). 36 | ``` 37 | [world content & tag-fns] 38 | (add-entity world 39 | (message :content content 40 | :consumed false 41 | :created (os/clock)) 42 | ;(map |($) tag-fns))) 43 | 44 | (defn consume 45 | ``` 46 | Consume a message, deleting its entity from the world. Its very 47 | important that you consume every message you create at some point, 48 | otherwise your message queue will grow indefinitly! 49 | 50 | (message/consume msg) 51 | ``` 52 | [msg] 53 | (put msg :consumed true)) 54 | -------------------------------------------------------------------------------- /junk-drawer/sparse-set.janet: -------------------------------------------------------------------------------- 1 | (defn- debug-print 2 | "Pretty Prints contents of set." 3 | [{:entity-indices entity-indices :entities entities :components components :n n}] 4 | # (printf "entities (dense): %q" entities) 5 | # (printf "entities-indices (sparse): %q" entity-indices) 6 | (for i 0 n 7 | (printf "%q -> %q" (entities i) (components i)))) 8 | 9 | (defn- search 10 | "If element is present, returns index of element in :entities, Else returns -1." 11 | [self eid] 12 | (if 13 | # the first condition verifies that 'x' is within 'n' in this set 14 | # and the second condition tells us that it is present in the data structure. 15 | (and (< (get-in self [:entity-indices eid]) (self :n)) 16 | (= (get-in self [:entities (get-in self [:entity-indices eid])]) eid)) 17 | (get-in self [:entity-indices eid]) 18 | 19 | # not found 20 | -1)) 21 | 22 | (defn- insert 23 | "Inserts a new element into set." 24 | [self eid cmp-data] 25 | (when-let [{:n n 26 | :capacity capacity 27 | :entities entities 28 | :entity-indices entity-indices 29 | :components components} self 30 | ents-not-full? (<= n capacity) 31 | eid-not-present? (= (search self eid) -1)] 32 | (put entity-indices eid n) 33 | (put entities n eid) 34 | (put components n cmp-data) 35 | (+= (self :n) 1))) 36 | 37 | (defn- delete 38 | "Deletes an element from set. Returns bool on whether anything was deleted." 39 | [self eid] 40 | 41 | (if-let [element-exists? (not= (search self eid) -1) 42 | {:n n 43 | :entities entities 44 | :entity-indices entity-indices 45 | :components components} self 46 | # take elements from end 47 | temp (entities (- n 1)) 48 | temp-cmp (components (- n 1))] 49 | (do (put entities (entity-indices eid) temp) 50 | (put components (entity-indices eid) temp-cmp) 51 | (put entity-indices temp (entity-indices eid)) 52 | (-= (self :n) 1) 53 | true) 54 | false)) 55 | 56 | (defn- clear 57 | "Removes all elements from set." 58 | [self] 59 | (array/clear (self :entity-indices))) 60 | 61 | (defn- get-component 62 | "Get component data for entity id, nil if entity DnE." 63 | [self eid] 64 | ((self :components) (get-in self [:entity-indices eid]))) 65 | 66 | (defn init 67 | "Instantiate new sparse set." 68 | [capacity] 69 | (table/setproto 70 | @{:capacity capacity 71 | :n 0 72 | 73 | # sparse list, the index (not the value) of this sparse array is itself 74 | # the entity id. 75 | :entity-indices (array) 76 | 77 | # dense list of integers, the index doesn't have inherent meaning, other 78 | # than it must be correct from entity-indices. 79 | :entities (array/new-filled capacity) 80 | 81 | # dense list of component type, it is aligned with entitylist such that 82 | # the element at (entity-list n) has component data of (component-list n) 83 | :components (array/new-filled capacity)} 84 | @{:search search 85 | :insert insert 86 | :delete delete 87 | :clear clear 88 | :debug-print debug-print 89 | :get-component get-component})) 90 | -------------------------------------------------------------------------------- /junk-drawer/timers.janet: -------------------------------------------------------------------------------- 1 | (use ./ecs) 2 | 3 | (setdyn :doc ``` 4 | Its common to want to delay the execution of something an amount of time, 5 | or to run something at an interval. This module contains building blocks 6 | for just that! Simply register the update system 7 | 8 | (register-system world timers/update-sys) 9 | 10 | then create your timers. 11 | ```) 12 | 13 | (defn- noop [& args] nil) 14 | 15 | (def-component timer 16 | :time :number 17 | :limit :number 18 | :count :number 19 | :during :function 20 | :after :function) 21 | 22 | (def-system update-sys 23 | {timers [:entity :timer] wld :world} 24 | (each [ent tmr] timers 25 | (put tmr :time (+ (tmr :time) dt)) 26 | ((tmr :during) wld dt) 27 | (when (and (>= (tmr :time) (tmr :limit)) 28 | (> (tmr :count) 0)) 29 | 30 | ((get tmr :after) wld dt) 31 | (put tmr :time (- (tmr :time) (tmr :limit))) 32 | (put tmr :count (- (tmr :count) 1))) 33 | (when (= 0 (tmr :count)) 34 | (remove-entity wld ent)))) 35 | 36 | (defn after 37 | ``` 38 | Schedule a fn to run once after 'delay' ticks. the provided callback 39 | has the signature (fn [world dt] nil). 40 | 41 | (timers/after world 10 (fn [wld dt] (print "10 ticks have passed"))) 42 | ``` 43 | [world delay after-fn] 44 | 45 | (add-entity world 46 | (timer :time 0 47 | :limit delay 48 | :count 1 49 | :during noop 50 | :after after-fn))) 51 | 52 | (defn during 53 | ``` 54 | Schedule a during-fn to run every tick until 'delay' ticks have passed, 55 | then optionally run after-fn. Both callbacks have the signature 56 | (fn [world dt] nil). 57 | 58 | (timers/during world 5 59 | (fn [wld dt] (print "0-5 ticks")) 60 | (fn [wld dt] (print "5 ticks have passed"))) 61 | ``` 62 | [world delay during-fn &opt after-fn] 63 | 64 | (default after-fn noop) 65 | (add-entity world 66 | (timer :time 0 67 | :limit delay 68 | :count 1 69 | :during during-fn 70 | :after after-fn))) 71 | 72 | (defn every 73 | ``` 74 | Schedule a fn to run every 'delay' ticks, up to count (default is infinity). 75 | Callback has the signature (fn [world dt] nil). 76 | 77 | (timers/every world 2 78 | (fn [wld dt] (print "every 2, but only 3 times")) 79 | 3) 80 | ``` 81 | [world delay after-fn &opt count] 82 | 83 | (default count math/inf) 84 | (add-entity world 85 | (timer :time 0 86 | :limit delay 87 | :count count 88 | :during noop 89 | :after after-fn))) 90 | -------------------------------------------------------------------------------- /junk-drawer/tweens.janet: -------------------------------------------------------------------------------- 1 | (use ./ecs) 2 | 3 | (setdyn :doc ``` 4 | Tweens (short for in-betweening) allows you to interpolate values using predefined functions, 5 | the applet here https://hump.readthedocs.io/en/latest/timer.html#tweening-methods 6 | gives a good visualization of what happens. 7 | 8 | This module defines these tweening functions, each with "in-NAME", "out-NAME", "in-out-NAME", and "out-in-NAME" 9 | varients. 10 | 11 | - linear 12 | - quad 13 | - cubic 14 | - quart 15 | - quint 16 | - sine 17 | - expo 18 | - circ 19 | - back 20 | - bounce 21 | - elastic 22 | 23 | (tween/in-cubic 0.5) # -> 0.125 24 | 25 | Additionally, You can tween component values on an entity using the 26 | (tweens/create) function. Read the docs for that fn, or check out 27 | examples/07-tweens.janet for more! 28 | ```) 29 | 30 | (defn- flip 31 | "flip a tween" 32 | [f] 33 | (fn [s & args] 34 | (- 1 (f (- 1 s) ;args)))) 35 | 36 | (defn- chain 37 | "chain 2 tweens together" 38 | [f1 f2] 39 | (fn [s & args] 40 | (* 0.5 41 | (if (< s 0.5) 42 | (f1 (* 2 s) ;args) 43 | (+ 1 (f2 (- (* 2 s) 1) ;args)))))) 44 | 45 | (defmacro- def-tween 46 | "define the in, out, in-out, and out-in versions of a tween" 47 | [name & body] 48 | (with-syms [$in $out $in-out $out-in] 49 | (let [$in (symbol "in-" name) 50 | $out (symbol "out-" name) 51 | $in-out (symbol "in-out-" name) 52 | $out-in (symbol "out-in-" name)] 53 | ~(upscope 54 | (defn ,$in [s] ,;body) 55 | (def ,$out (flip ,$in)) 56 | (def ,$in-out (chain ,$in ,$out)) 57 | (def ,$out-in (chain ,$out ,$in)))))) 58 | 59 | (def-tween linear s) 60 | (def-tween quad (* s s)) 61 | (def-tween cubic (* s s s)) 62 | (def-tween quart (* s s s s)) 63 | (def-tween quint (* s s s s s)) 64 | (def-tween sine (- 1 (math/cos (* s (/ math/pi 2))))) 65 | (def-tween expo (math/exp2 (* 10 (- s 1)))) 66 | (def-tween circ (- 1 (math/sqrt (- 1 (* s s))))) 67 | 68 | # warning: magic numbers ahead 69 | (def-tween back (* s s (- (* s 2.70158) 1.70158))) 70 | 71 | (def-tween bounce 72 | (let [a 7.5625 b (/ 1 2.75)] 73 | (min (* a (math/pow s 2)) 74 | (+ 0.75 (* a (math/pow (- s (* b (- 1.5))) 2))) 75 | (+ 0.9375 (* a (math/pow (- s (* b (- 2.25))) 2))) 76 | (+ 0.984375 (* a (math/pow (- s (* b (- 2.625))) 2)))))) 77 | 78 | (def-tween elastic 79 | (let [amp 1 period 0.3] 80 | (* (- amp) 81 | (math/sin (- (* 2 (/ math/pi period) (- s 1)) (math/asin (/ 1 amp)))) 82 | (math/exp2 (* 10 (dec s)))))) 83 | 84 | (def-component tween 85 | :entity :number 86 | :component :keyword 87 | :start (or :table :struct) 88 | :to (or :table :struct) 89 | :with :function 90 | :duration :number 91 | :elapsed-time :number) 92 | 93 | (defn- deep-clone [x] 94 | ((fn f [y] (walk f y)) x)) 95 | 96 | (defn- find-and-clone [world ent componet] 97 | "find component value for ent using black magic, then deep clone it" 98 | (-> (get-in world [:database componet]) 99 | (:get-component ent) 100 | (deep-clone))) 101 | 102 | (defn create 103 | ``` 104 | Create a tween entity which will tween the provided component 105 | on the entity to the "to" value over "duration" with the "with" 106 | tweening fn. Requires registering (tweens/update-sys) in your ECS. 107 | 108 | (def-component example-cmp 109 | :a :number # can only tween numbers 110 | :b (props :c :number) # nested objects of numbers are tweened recursively 111 | :d :string) # anything other then numbers are ignored 112 | 113 | ... later on in a system ... 114 | 115 | (tweens/create wld ent :example-cmp 116 | :to {:a 10 :b {:c 34}} # could also use the component fn, but defining unused string seemed wrong. 117 | :with tweens/in-cubic 118 | :duration 10) # take 10 Ticks of the ecs to complete 119 | ``` 120 | [world ent component &named to with duration] 121 | (add-entity world (tween :entity ent 122 | :component component 123 | :start (find-and-clone world ent component) 124 | :to to 125 | :with with 126 | :duration duration 127 | :elapsed-time 0))) 128 | 129 | (defn- bucket-by-component 130 | ``` 131 | fiber that yields [tween-ent tween-data current to elapsed duration func] 132 | for each tween. Does this by: 133 | 1. bucketting the tweens by component 134 | 2. querying the ECS for entities with that component 135 | 3. 'filtering' the query results for the ecs in tweens 136 | ``` 137 | [wld tweens] 138 | (fn [] 139 | (loop [[cmp tweens] :pairs (group-by |(get-in $ [1 :component]) tweens) 140 | [tweening-ent current] :in (:view wld [:entity cmp]) 141 | :let [tween (find |(= (get-in $ [1 :entity]) tweening-ent) tweens)] 142 | :when (not (nil? tween))] 143 | (yield [(tween 0) (tween 1) current])))) 144 | 145 | (defn interpolate 146 | ``` 147 | Recursively apply tween 'func' to all fields of 'current'. 148 | ``` 149 | [start to elapsed duration func] 150 | (match (type start) 151 | :number (+ start (* (- to start) (func (/ elapsed duration)))) 152 | :table (table ;(mapcat |[$ (interpolate (get start $) 153 | (get to $) 154 | elapsed 155 | duration 156 | func)] 157 | (keys to))))) 158 | 159 | (def-system update-sys 160 | {tweens [:entity :tween] wld :world} 161 | 162 | (loop [[tween-ent tween-data current] :in (fiber/new (bucket-by-component wld tweens)) 163 | :let [{:start start 164 | :to to 165 | :elapsed-time elapsed 166 | :duration duration 167 | :with func} tween-data]] 168 | 169 | # current in this context is the actual component on the entity being tweened 170 | # So we need to get the new "interpolated value" and apply each key on the 171 | # actual component table. Also Need to be careful to preserve untweened keys. 172 | (each [key val] (pairs (interpolate start to elapsed duration func)) 173 | (put current key 174 | (match (type val) 175 | :number val 176 | :table (merge (current key) val)))) 177 | 178 | # Tick the tweens elapsed time, delete it if we've reached its duration 179 | (let [new-elapsed (+ elapsed 1)] 180 | (if (>= elapsed duration) 181 | (remove-entity wld tween-ent) 182 | (put tween-data :elapsed-time new-elapsed))))) 183 | -------------------------------------------------------------------------------- /junk-drawer/vector.janet: -------------------------------------------------------------------------------- 1 | (setdyn :doc ``` 2 | 2D vector which providing most of the things you do with vectors. 3 | Represented as a table {:x number :y number}. 4 | ```) 5 | 6 | (defn vector? 7 | "Is the object a vector." 8 | [self] 9 | (and (table? self) 10 | (number? (self :x)) 11 | (number? (self :y)))) 12 | 13 | (defn clone 14 | "Deep copy of the vector." 15 | [self] 16 | (table/setproto @{:x (self :x) :y (self :y)} 17 | (table/getproto self))) 18 | 19 | (defn unpack 20 | "The vector as a tuple." 21 | [self] (values self)) 22 | 23 | (defn- apply-operator [op a b] 24 | (assert (vector? a) "a must be a vector.") 25 | (assert (or (vector? b) (number? b)) "b must be a vector or number.") 26 | (let [b (cond (number? b) {:x b :y b} b)] 27 | (put a :x (op (a :x) (b :x))) 28 | (put a :y (op (a :y) (b :y))) 29 | a)) 30 | 31 | (defn add 32 | "Add either a number or another vector to this vector. Mutates the first vector." 33 | [self v] (apply-operator + self v)) 34 | 35 | (defn subtract 36 | "Subtract either a number or another vector from the this vector. Mutates the first vector." 37 | [self v] (apply-operator - self v)) 38 | 39 | (defn multiply 40 | "Multiply this vector by either a number or another vector. Mutates the first vector." 41 | [self v] (apply-operator * self v)) 42 | 43 | (defn divide 44 | "Divide this vector by either a number or another vector. Mutates the first vector." 45 | [self v] (apply-operator / self v)) 46 | 47 | (defn equal? 48 | "Is this vector equal to another? Optionaly round coordinates nearest int before comparing." 49 | [self v &opt round] 50 | (default round false) 51 | (let [{:x ax :y ay} self 52 | {:x bx :y by} v] 53 | (if round 54 | (and (= (math/round ax) (math/round bx)) 55 | (= (math/round ay) (math/round by))) 56 | (and (= ax bx) 57 | (= ay by))))) 58 | 59 | (defn lt? 60 | "Is vector A less then vector B?" 61 | [self v] 62 | (or (< (self :x) (v :x)) 63 | (and (= (self :x) (v :x)) 64 | (< (self :y) (v :y))))) 65 | 66 | (defn lte? 67 | "Is vector A less then or equal vector B?" 68 | [self v] 69 | (and (<= (self :x) (v :x)) 70 | (<= (self :y) (v :y)))) 71 | 72 | (defn vlength2 73 | "The squared length of vector." 74 | [self] 75 | (+ (* (self :x) (self :x)) 76 | (* (self :y) (self :y)))) 77 | 78 | (defn vlength 79 | "The length of the vector." 80 | [self] 81 | (math/sqrt (vlength2 self))) 82 | 83 | (defn to-polar 84 | "Polar version of the vector" 85 | [self] 86 | (table/setproto @{:x (math/atan2 (self :x) (self :y)) 87 | :y (vlength self)} 88 | (table/getproto self))) 89 | 90 | (defn distance2 91 | "The squared distance of this vector to the other." 92 | [self v] 93 | (assert (vector? self) "a must be a vector.") 94 | (assert (vector? v) "v must be a vector.") 95 | (let [dx (- (self :x) (v :x)) 96 | dy (- (self :y) (v :y))] 97 | (+ (* dx dx) 98 | (* dy dy)))) 99 | 100 | (defn distance 101 | "The distance between vectors A and B." 102 | [self v] 103 | (math/sqrt (:distance2 self v))) 104 | 105 | (defn normalize 106 | "Normalize the vector in place." 107 | [self] 108 | (if-let [l (vlength self) 109 | greater-then-zero? (> l 0)] 110 | (:divide self l) 111 | self)) 112 | 113 | (defn rotate 114 | "Rotate the vector by angle phi in place." 115 | [self phi] 116 | (let [c (math/cos phi) 117 | s (math/sin phi)] 118 | (put self :x (- (* c (self :x)) 119 | (* s (self :y)))) 120 | (put self :y (+ (* s (self :x)) 121 | (* c (self :y)))))) 122 | 123 | (defn perpendicular 124 | "Return a new vector perpendicular to this one." 125 | [self] 126 | (table/setproto @{:x (- (self :y)) :y (self :x)} 127 | (table/getproto self))) 128 | 129 | 130 | (defn preject-on 131 | "Return a new vector which is the projection of this one on vector V." 132 | [self v] 133 | (assert (vector? v) "v must be a vector.") 134 | (let [{:x vx :y vy} v 135 | s (/ (+ (* (self :x) vx) 136 | (* (self :y) vy)) 137 | (+ (* vx vx) 138 | (* vy vy)))] 139 | (table/setproto @{:x (* s vx) :y (* s vy)} 140 | (table/getproto self)))) 141 | 142 | 143 | (defn mirror-on 144 | "Return a new vector which is this one mirrored onto vector V." 145 | [self v] 146 | (assert (vector? v) "v must be a vector.") 147 | (let [{:x sx :y sy} self 148 | {:x vx :y vy} v 149 | s (* 2 150 | (/ (+ (* sx vx) 151 | (* sy vy)) 152 | (+ (* vx vx) 153 | (* vy vy))))] 154 | (table/setproto @{:x (- (* s vx) sx) 155 | :y (- (* s vy) sy)} 156 | (table/getproto self)))) 157 | 158 | (defn cross 159 | "The cross product of this vector with another." 160 | [self v] 161 | (assert (vector? v) "v must be a vector.") 162 | (- (* (self :x) (v :y)) 163 | (* (self :y) (v :x)))) 164 | 165 | (defn trim 166 | "Truncate this vector length to max-length." 167 | [self max-length] 168 | (let [s (/ (* max-length max-length) 169 | (vlength2 self))] 170 | (put self :x (* (self :x) s)) 171 | (put self :y (* (self :y) s)))) 172 | 173 | (defn angle-to 174 | "The angle of this vector to another." 175 | [self &opt other] 176 | (if other 177 | (- (math/atan2 (self :x) (self :y)) 178 | (math/atan2 (other :x) (other :y))) 179 | (math/atan2 (self :x) (self :y)))) 180 | 181 | (def Vector 182 | @{:clone clone 183 | :unpack unpack 184 | :add add 185 | :subtract subtract 186 | :multiply multiply 187 | :divide divide 188 | :equal? equal? 189 | :lt? lt? 190 | :lte? lte? 191 | :length2 vlength2 192 | :length vlength 193 | :to-polar to-polar 194 | :distance2 distance2 195 | :distance distance 196 | :normalize normalize 197 | :rotate rotate 198 | :perpendicular perpendicular 199 | :preject-on preject-on 200 | :mirror-on mirror-on 201 | :cross cross 202 | :trim trim 203 | :angle-to angle-to 204 | :__validate__ vector? 205 | :__id__ :vector}) 206 | 207 | (defn new 208 | "Construct a new vector with given x,y coordinates." 209 | [&opt x y] 210 | (default x 0) 211 | (default y 0) 212 | (assert (number? x) "x must be a number") 213 | (assert (number? y) "y must be a number") 214 | (table/setproto @{:x x :y y} Vector)) 215 | 216 | (defn from-polar [angle &opt radius] 217 | "Construct a new vector from the polar coordinates." 218 | (default radius 1) 219 | (new (* (math/cos angle) radius) 220 | (* (math/sin angle) radius))) 221 | 222 | (defn from-tuple 223 | "Construct a new vector from the tuple [x y], look at (:to-tuple vec)." 224 | [tup] 225 | (assert (= (length tup) 2) "length of tuple must be 2.") 226 | (new ;tup)) 227 | 228 | (defn from-named 229 | "Construct a new vector from the named args :x :y, useful when using def-component-alias." 230 | [&named x y] 231 | (new x y)) 232 | 233 | (defn random-direction 234 | "Construct a new vector of random length in random direction." 235 | [&opt len-min len-max seed] 236 | (default len-min 1) 237 | (default len-max len-min) 238 | (default seed nil) 239 | (assert (> len-max 0) "len-max must be greater than zero") 240 | (assert (>= len-max len-min) "len-max must be greater than or equal to len-min") 241 | (let [rng (math/rng seed) ] 242 | (from-polar (* (math/rng-uniform rng) 2 math/pi) 243 | (* (math/rng-uniform rng) (+ (- len-max len-min) len-min))))) 244 | -------------------------------------------------------------------------------- /project.janet: -------------------------------------------------------------------------------- 1 | (declare-project 2 | :name "junk-drawer" 3 | :description "A collection of random tools for gamedev." 4 | :author "Alec Troemel" 5 | :license "MIT" 6 | :url "https://github.com/AlecTroemel/junk-drawer" 7 | :repo "git+https://github.com/AlecTroemel/junk-drawer" 8 | :dependencies ["spork"]) 9 | 10 | (declare-source 11 | :source @["junk-drawer" "junk-drawer.janet"]) 12 | -------------------------------------------------------------------------------- /test/performance/ecs-perf-test.janet: -------------------------------------------------------------------------------- 1 | # run with 'time janet stress-test.janet' 2 | (import spork/test) 3 | 4 | (use /junk-drawer) 5 | 6 | (def ALPHABET ["a" "b" "c" "d" "e" "f" "g" "h" "i" 7 | "j" "k" "l" "m" "n" "o" "p" "q" "r" 8 | "s" "t" "u" "v" "w" "x" "y" "z"]) 9 | 10 | (defmacro def-component-alphabet [] 11 | "Define a component for every letter of the alphabet." 12 | (map |['def-component (symbol $) :val :number] 13 | ALPHABET)) 14 | 15 | (defmacro def-systems-alphabet [] 16 | "Define and register a system with 2 queries, each with 2 alphabet components." 17 | (array/concat 18 | # define system 19 | (map |['def-system (symbol "sys-" $) 20 | ~{first [,(keyword (ALPHABET $)) ,(keyword (ALPHABET (% (inc $) 25)))] 21 | second [,(keyword (ALPHABET (% (+ 2 $) 25))) ,(keyword (ALPHABET (% (+ 3 $) 25)))]} 22 | nil] 23 | (range 0 25)) 24 | 25 | # Register it 26 | (map |['register-system 'world (symbol "sys-" $)] 27 | (range 0 25)))) 28 | 29 | (defmacro create-entities-alphabet [] 30 | "Define a entity for every letter and letter+1 components." 31 | (map |['add-entity 'world 32 | [(symbol (ALPHABET $)) :val $] 33 | [(symbol (ALPHABET (% (inc $) 25))) :val $]] 34 | (range 0 25))) 35 | 36 | (defmacro def-create-entities [] 37 | "Create A LOT of entities by calling create-entities-alphabet lots of times" 38 | ~(defn create-entities [] 39 | ,;(array/new-filled 100 ['create-entities-alphabet]))) 40 | 41 | (print "lets create components and systems") 42 | (def world (create-world)) 43 | 44 | (def-component-alphabet) 45 | (def-systems-alphabet) 46 | 47 | (print "\nlets create a ton of entites") 48 | (def-create-entities) 49 | (test/timeit (create-entities)) 50 | 51 | 52 | (def rng (math/rng)) 53 | 54 | (defn remove-random-entity [] 55 | (remove-entity world (math/rng-int rng 2559))) 56 | 57 | (defn create-random-entity [] 58 | (add-entity world 59 | (a :val 1) 60 | (b :val 1))) 61 | 62 | (print "\neverything created, lets run update") 63 | (test/timeit 64 | (for i 0 1000 65 | (when (= 0 (% i 100)) 66 | (printf "i=%q" i)) 67 | 68 | (:update world 1) 69 | 70 | (when (= 0 (% i 10)) 71 | (remove-random-entity)) 72 | 73 | (when (= 0 (% i 20)) 74 | (create-random-entity)))) 75 | 76 | (print "everything done") 77 | -------------------------------------------------------------------------------- /test/unit/cache-test.janet: -------------------------------------------------------------------------------- 1 | (import spork/test) 2 | (import /junk-drawer/cache) 3 | 4 | (test/start-suite 0) 5 | 6 | (let [cache (cache/init) 7 | key [:pizza] 8 | data {:hotdog "frenchfry"}] 9 | 10 | (test/assert (= data (:insert cache key data)) "Insert returns data just inserted.") 11 | (test/assert (= data (:get cache key)) "Cache contains inserted data.") 12 | 13 | (:insert cache [:remove] {:i-will "go away"}) 14 | (:insert cache [:keep :remove] {:i-will "go away"}) 15 | 16 | (:clear cache :remove) 17 | (test/assert (= data (:get cache key)) "Keep non matching component query.") 18 | (test/assert (= nil (:get cache [:remove])) "Remove matching single component query.") 19 | (test/assert (= nil (:get cache [:keep :remove])) "Remove matching multi component query.")) 20 | 21 | (test/end-suite) 22 | -------------------------------------------------------------------------------- /test/unit/directed-graph-test.janet: -------------------------------------------------------------------------------- 1 | (import spork/test) 2 | (use /junk-drawer/directed-graph) 3 | 4 | (test/start-suite 0) 5 | (let [graph (create 6 | (node :red) 7 | (node :green 8 | :key "val" 9 | :say (fn [self] "hello world")) 10 | (edge :red :green) 11 | (edge :panic :green :red 2))] 12 | (test/assert (and (:contains graph :red) 13 | (:contains graph :green)) 14 | "graph init creates provided nodes") 15 | 16 | (:add-node graph (node :blue :another "data")) 17 | (test/assert (:contains graph :blue) 18 | "contains returns true for just added node") 19 | 20 | (test/assert (= (get-in (:get-node graph :blue) [:data :another]) "data") 21 | "get-node returns the node and contains the provided data") 22 | 23 | (:add-edge graph (edge :blue :red 3)) 24 | (test/assert (not (nil? (get-in (:get-node graph :blue) [:edges :red]))) 25 | "add-edge added the edge") 26 | 27 | (test/assert (= (first (:neighbors graph :blue)) 28 | {:from :blue :name :red :to :red :weight 3}) 29 | "neighbors returns neighbors") 30 | 31 | (test/assert (= (length (:list-nodes graph)) 3) 32 | "there are 3 nodes in the graph") 33 | 34 | (test/assert (= (length (:list-edges graph)) 3) 35 | "there are 2 edges in the graph") 36 | 37 | (test/assert (= (:list-edges graph) 38 | [{:from :red :name :green :to :green :weight 1} 39 | {:from :blue :name :red :to :red :weight 3} 40 | {:from :green :name :panic :to :red :weight 2}]) 41 | "edges list uses correct data format")) 42 | (test/end-suite) 43 | 44 | 45 | (test/start-suite 1) 46 | (let [graph (create (node :a) (node :b) (node :c) 47 | (node :g) 48 | (node :d) (node :e) (node :f) 49 | 50 | (edge :a :b) 51 | (edge :b :d) 52 | (edge :b2g :b :g 10) 53 | (edge :c :f) 54 | (edge :d :e) 55 | (edge :e2g :e :g) 56 | (edge :g :c))] 57 | 58 | (test/assert (= (:find-path graph :a :f) 59 | [:b :d :e :e2g :c :f]) 60 | "should find correct path")) 61 | (test/end-suite) 62 | 63 | # Test if we can use forms for node data and edges info 64 | (test/start-suite 2) 65 | (let [data @{:a "pizza" :b "hotdog"} 66 | new-node (node :a ;(kvs data))] 67 | (test/assert (= (get-in new-node [2 :data :a]) "pizza") 68 | "should have spliced data correctly")) 69 | 70 | (let [name :pizza 71 | from :a 72 | to :b 73 | new-edge (edge name from to)] 74 | (test/assert (= new-edge [:edge :a {:name :pizza :to :b :weight 1}])) 75 | ) 76 | (test/end-suite) 77 | -------------------------------------------------------------------------------- /test/unit/ecs-test.janet: -------------------------------------------------------------------------------- 1 | (import spork/test) 2 | 3 | (use /junk-drawer/ecs) 4 | 5 | (test/start-suite 0) 6 | (var a-counter 0) 7 | (var b-counter 0) 8 | 9 | (var world (create-world)) 10 | 11 | (def-component a :val :number) 12 | (def-component-alias b a) 13 | 14 | (def-system ab-sys 15 | {abs [:a :b]} 16 | (each ab abs 17 | (+= a-counter 1) 18 | (+= b-counter 1))) 19 | 20 | (def-system b-sys 21 | {bs [:b]} 22 | (each b-ent bs 23 | (+= b-counter 1))) 24 | 25 | (register-system world ab-sys) 26 | (register-system world b-sys) 27 | 28 | (add-entity world 29 | (a :val 1) 30 | (b :val 1)) 31 | 32 | (:update world 1) 33 | (test/assert (= a-counter 1) "tick 1: a count should be 1") 34 | (test/assert (= b-counter 2) "tick 1: b count should be 2") 35 | 36 | (test/end-suite) 37 | -------------------------------------------------------------------------------- /test/unit/envelopes-test.janet: -------------------------------------------------------------------------------- 1 | (import spork/test) 2 | (import /junk-drawer/envelopes) 3 | 4 | # AR 5 | (test/start-suite 0) 6 | # Lets go through all the states 7 | (let [*ar* (envelopes/ar 8 | :attack-target 10 :attack-duration 10 9 | :release-duration 10)] 10 | (test/assert (= (*ar* :current) :idle) "AR starts in idle") 11 | 12 | (:trigger *ar*) 13 | (test/assert (= (*ar* :current) :attack) "AR attack after triggering from idle") 14 | 15 | (for i 0 11 (:tick *ar*)) 16 | (test/assert (= (*ar* :value) 10) "AR end of attack is 10") 17 | (test/assert (= (*ar* :current) :release) "AR release after 10 ticks of attack") 18 | 19 | (for i 0 11 (:tick *ar*)) 20 | (test/assert (= (*ar* :value) 0) "AR end of release is 0") 21 | (test/assert (= (*ar* :current) :idle) "AR idle after 10 ticks of release")) 22 | 23 | # Make sure we can re-trigger from both states 24 | (let [*ar* (envelopes/ar 25 | :attack-target 10 :attack-duration 2 26 | :release-duration 10)] 27 | (:trigger *ar*) 28 | (:trigger *ar*) 29 | (test/assert (= (*ar* :current) :attack) "AR attack after (re)triggering from trigger") 30 | 31 | (for i 0 3 (:tick *ar*)) 32 | (:trigger *ar*) 33 | (test/assert (= (*ar* :current) :attack) "AR attack after triggering from release")) 34 | 35 | # Make sure we can release early 36 | (let [*ar* (envelopes/ar 37 | :attack-target 10 :attack-duration 10 38 | :release-duration 10)] 39 | (:trigger *ar*) 40 | 41 | (for i 0 3 (:tick *ar*)) # still in attack after just 3 ticks 42 | (:release *ar*) 43 | (test/assert (= (*ar* :current) :release) "AR release after releasing early in :attack")) 44 | (test/end-suite) 45 | 46 | # ASR 47 | (test/start-suite 1) 48 | 49 | # Test going through all the states 50 | (let [*asr* (envelopes/asr 51 | :attack-target 10 :attack-duration 10 52 | :release-duration 10)] 53 | (test/assert (= (*asr* :current) :idle) "ASR starts in idle") 54 | 55 | (:trigger *asr*) 56 | (test/assert (= (*asr* :current) :attack) "ASR attack after begin") 57 | 58 | (for i 0 11 (:tick *asr*)) 59 | (test/assert (= (*asr* :value) 10) "ASR end of attack is 10") 60 | (test/assert (= (*asr* :current) :sustain) "ASR sustain after 10 ticks of attack") 61 | 62 | (for i 0 10 (:tick *asr*)) 63 | (test/assert (= (*asr* :value) 10) "ASR sustain is still 5") 64 | (test/assert (= (*asr* :current) :sustain) "ASR still in sustain") 65 | (:release *asr*) 66 | (test/assert (= (*asr* :current) :release) "ASR release after calling :release") 67 | 68 | (for i 0 11 (:tick *asr*)) 69 | (test/assert (= (*asr* :value) 0) "ASR end of relase is 0") 70 | (test/assert (= (*asr* :current) :idle) "ASR idle after 10 ticks of release")) 71 | 72 | # Test (re)triggering from all the states 73 | (let [*asr* (envelopes/asr 74 | :attack-target 10 :attack-duration 10 75 | :release-duration 10)] 76 | (:goto *asr* :attack) 77 | (:trigger *asr*) 78 | (test/assert (= (*asr* :current) :attack) "ASR attack after triggering from attack") 79 | 80 | (:goto *asr* :sustain) 81 | (:trigger *asr*) 82 | (test/assert (= (*asr* :current) :attack) "ASR attack after triggering from sustain") 83 | 84 | (:goto *asr* :release) 85 | (:trigger *asr*) 86 | (test/assert (= (*asr* :current) :attack) "ASR attack after triggering from release")) 87 | 88 | # Test releasing early 89 | (let [*asr* (envelopes/asr 90 | :attack-target 10 :attack-duration 10 91 | :release-duration 10)] 92 | (:goto *asr* :attack) 93 | (:release *asr*) 94 | (test/assert (= (*asr* :current) :release) "ASR release after triggering from attack") 95 | 96 | (:goto *asr* :sustain) 97 | (:release *asr*) 98 | (test/assert (= (*asr* :current) :release) "ASR release after triggering from sustain")) 99 | (test/end-suite) 100 | 101 | # ADSR 102 | (test/start-suite 2) 103 | 104 | # Test going through all the states 105 | (let [*adsr* (envelopes/adsr 106 | :attack-target 10 :attack-duration 10 107 | :decay-target 5 :decay-duration 10 108 | :sustain-duration 10 109 | :release-duration 10)] 110 | (test/assert (= (*adsr* :current) :idle) "ADSR starts in idle") 111 | 112 | (:trigger *adsr*) 113 | (test/assert (= (*adsr* :current) :attack) "ADSR attack after begin") 114 | 115 | (for i 0 11 (:tick *adsr*)) 116 | (test/assert (= (*adsr* :value) 10) "ADSR end of attack is 10") 117 | (test/assert (= (*adsr* :current) :decay) "ADSR decay after 10 ticks of attack") 118 | 119 | (for i 0 11 (:tick *adsr*)) 120 | (test/assert (= (*adsr* :value) 5) "ADSR end of decay is 5") 121 | (test/assert (= (*adsr* :current) :sustain) "ADSR sustain after 10 ticks of decay") 122 | 123 | 124 | (for i 0 11 (:tick *adsr*)) 125 | (test/assert (= (*adsr* :value) 5) "ADSR sustain is still 5") 126 | (test/assert (= (*adsr* :current) :sustain) "AdSR still in sustain") 127 | (:release *adsr*) 128 | (test/assert (= (*adsr* :current) :release) "AdSR release after calling :release") 129 | 130 | (for i 0 11 (:tick *adsr*)) 131 | (test/assert (= (*adsr* :value) 0) "ADSR end of sustain is 0") 132 | (test/assert (= (*adsr* :current) :idle) "ADSR idle after 10 ticks of release")) 133 | 134 | # Test (re)triggering from all the states 135 | (let [*adsr* (envelopes/adsr 136 | :attack-target 10 :attack-duration 10 137 | :decay-target 5 :decay-duration 10 138 | :sustain-duration 10 139 | :release-duration 10)] 140 | (:goto *adsr* :attack) 141 | (:trigger *adsr*) 142 | (test/assert (= (*adsr* :current) :attack) "ADSR attack after triggering from attack") 143 | 144 | (:goto *adsr* :decay) 145 | (:trigger *adsr*) 146 | (test/assert (= (*adsr* :current) :attack) "ADSR attack after triggering from decay") 147 | 148 | (:goto *adsr* :sustain) 149 | (:trigger *adsr*) 150 | (test/assert (= (*adsr* :current) :attack) "ADSR attack after triggering from sustain") 151 | 152 | (:goto *adsr* :release) 153 | (:trigger *adsr*) 154 | (test/assert (= (*adsr* :current) :attack) "ADSR attack after triggering from release")) 155 | 156 | # Test releasing early 157 | (let [*adsr* (envelopes/adsr 158 | :attack-target 10 :attack-duration 10 159 | :decay-target 5 :decay-duration 10 160 | :sustain-duration 10 161 | :release-duration 10)] 162 | (:goto *adsr* :attack) 163 | (:release *adsr*) 164 | (test/assert (= (*adsr* :current) :release) "ADSR release after triggering from attack") 165 | 166 | (:goto *adsr* :decay) 167 | (:release *adsr*) 168 | (test/assert (= (*adsr* :current) :release) "ADSR release after triggering from decay") 169 | 170 | (:goto *adsr* :sustain) 171 | (:release *adsr*) 172 | (test/assert (= (*adsr* :current) :release) "ADSR release after triggering from sustain")) 173 | (test/end-suite) 174 | -------------------------------------------------------------------------------- /test/unit/fsm-test.janet: -------------------------------------------------------------------------------- 1 | (import spork/test) 2 | (import /junk-drawer/fsm) 3 | 4 | (test/start-suite 0) 5 | 6 | (var enter-c-called false) 7 | (var leave-c-called false) 8 | 9 | (fsm/define 10 | a2b 11 | (fsm/state :a) 12 | (fsm/transition :goto-b :a :b) 13 | (fsm/transition :goto-c :a :c) 14 | 15 | (fsm/state :b :field "value") 16 | (fsm/transition :goto-a :b :a) 17 | 18 | (fsm/state :c 19 | :enter (fn [self from] (set enter-c-called true)) 20 | :leave (fn [self to] (set leave-c-called true))) 21 | (fsm/transition :goto-a :c :a)) 22 | 23 | (let [*state* (a2b :a)] 24 | (test/assert (= :a (*state* :current)) "Start at state A.") 25 | (:goto-b *state*) 26 | (test/assert (not (has-key? *state* :goto-b)) "State A transition methods removed when state left") 27 | (test/assert (not (has-key? *state* :goto-c)) "State A transition methods removed when state left") 28 | 29 | (test/assert (= :b (*state* :current)) "In state B after moving to it.") 30 | (test/assert (= "value" (*state* :field)) "Copies state data to root of FSM.") 31 | 32 | (:goto-a *state* "arg data") 33 | (test/assert (= :a (*state* :current)) "Move back to state A, with arg passed in.") 34 | (test/assert (= (*state* :field) nil) "no more data from state B.") 35 | 36 | (test/assert-error "transition fn does not exist" 37 | (:goto-dne *state*)) 38 | 39 | (:goto-c *state*) 40 | (test/assert enter-c-called "Enter fn for state C called.") 41 | (:goto-a *state*) 42 | (test/assert leave-c-called "Leave fn for state C called.")) 43 | 44 | (test/end-suite) 45 | -------------------------------------------------------------------------------- /test/unit/gamestate-test.janet: -------------------------------------------------------------------------------- 1 | (import spork/test) 2 | (import /junk-drawer/gamestate) 3 | 4 | (test/start-suite 0) 5 | (var *GS* (gamestate/init)) 6 | 7 | (test/assert (= nil (:current *GS*)) "GS current state is nil to start.") 8 | (test/assert-no-error "calling Update on nil state is ok." 9 | (:update *GS* 1)) 10 | (test/assert-no-error "calling Draw on nil state is ok." 11 | (:draw *GS*)) 12 | 13 | (gamestate/def-state state-a 14 | :init (fn ainit [self] (put self :init-called true)) 15 | :enter (fn aenter[self from] (put self :enter-called true)) 16 | :leave (fn aleave [self to] (put self :leave-called true)) 17 | :update (fn aupdate [self dt] (put self :update-called true)) 18 | :draw (fn adraw [self] (put self :draw-called true))) 19 | 20 | (gamestate/def-state state-b 21 | :init (fn binit [self] (put self :init-b-called true)) 22 | :enter (fn benter [self from] (put self :enter-b-called true)) 23 | :leave (fn bleave [self to] (put self :leave-b-called true)) 24 | :update (fn bupdate [self dt] (put self :update-b-called true)) 25 | :draw (fn bdraw [self] (put self :draw-b-called true))) 26 | 27 | (:add-state *GS* state-a) 28 | (:add-state *GS* state-b) 29 | (:add-edge *GS* (gamestate/transition :my-transition :state-a :state-b)) 30 | 31 | (:goto *GS* :state-a) 32 | (test/assert (get *GS* :init-called) "State A init called after switching.") 33 | (:update *GS* 2) 34 | (test/assert (get *GS* :update-called) "State A updated called.") 35 | (:draw *GS*) 36 | (test/assert (get *GS* :draw-called) "State A draw called.") 37 | 38 | (:my-transition *GS*) 39 | (test/assert (get *GS* :init-b-called) "State B init called after switching.") 40 | 41 | (:update *GS* 2) 42 | (test/assert (get *GS* :update-b-called) "State A updated called.") 43 | (:draw *GS*) 44 | (test/assert (get *GS* :draw-b-called) "State A draw called.") 45 | 46 | (test/end-suite) 47 | -------------------------------------------------------------------------------- /test/unit/messages-test.janet: -------------------------------------------------------------------------------- 1 | (import spork/test) 2 | 3 | (import /junk-drawer/ecs) 4 | (import /junk-drawer/messages) 5 | 6 | (ecs/def-tag msg-tag) 7 | 8 | (test/start-suite 0) 9 | (let [world (ecs/create-world)] 10 | (var message-process-count 0) 11 | (ecs/def-system msg-counter 12 | {wld :world 13 | msgs [:message :msg-tag]} 14 | (each [msg] msgs 15 | (+= message-process-count 1) 16 | (messages/consume msg))) 17 | (ecs/register-system world msg-counter) 18 | (ecs/register-system world messages/update-sys) 19 | 20 | (:update world 1) 21 | (test/assert (= message-process-count 0) "tick 1: called 0, no messages created") 22 | 23 | (messages/send world "hello" msg-tag) 24 | (:update world 1) 25 | (test/assert (= message-process-count 1) "tick 2: called 1 after 1 message") 26 | 27 | (messages/send world "hello again" msg-tag) 28 | (messages/send world "hello once more" msg-tag) 29 | (:update world 1) 30 | (test/assert (= message-process-count 3) "tick 3: called 3 after creating 2 messages")) 31 | (test/end-suite) 32 | -------------------------------------------------------------------------------- /test/unit/sparse-set-test.janet: -------------------------------------------------------------------------------- 1 | (import spork/test) 2 | (import /junk-drawer/sparse-set) 3 | 4 | (test/start-suite 0) 5 | 6 | (let [ss (sparse-set/init 10) 7 | data {:cmp "data"}] 8 | (test/assert (= -1 (:search ss 0)) "Does not find EID 0, set empty.") 9 | 10 | (:insert ss 0 data) 11 | 12 | (test/assert (= 1 (ss :n)) "n is 1 after insert.") 13 | (test/assert (= 0 (:search ss 0)) "Finds EID 0 after insert.") 14 | 15 | (:delete ss 0) 16 | (test/assert (= -1 (:search ss 0)) "Search for 0 returns empty after delete.") 17 | 18 | (:insert ss 1 data) 19 | (:insert ss 2 data) 20 | (:clear ss) 21 | (test/assert (= -1 (:search ss 1)) "Search for 1 returns empty after clear.") 22 | (test/assert (= -1 (:search ss 2)) "Search for 2 returns empty after clear.") 23 | 24 | (:insert ss 3 data) 25 | (test/assert (= data (:get-component ss 3)) "Gets component data for EID 3")) 26 | 27 | (test/end-suite) 28 | -------------------------------------------------------------------------------- /test/unit/timers-test.janet: -------------------------------------------------------------------------------- 1 | (import spork/test) 2 | (import /junk-drawer/ecs) 3 | (import /junk-drawer/timers) 4 | 5 | # timers/after 6 | (test/start-suite 0) 7 | (let [world (ecs/create-world)] 8 | (ecs/register-system world timers/update-sys) 9 | (var called-count 0) 10 | 11 | (timers/after world 2 12 | (fn [wld dt] (+= called-count 1))) 13 | 14 | (:update world 1) 15 | (test/assert (= called-count 0) "After callback NOT called after 1 tick") 16 | (:update world 1) 17 | (test/assert (= called-count 1) "After callback called once after 2 ticks") 18 | (:update world 1) 19 | (test/assert (= called-count 1) "After callback still called once after 3 ticks")) 20 | (test/end-suite) 21 | 22 | # timers/during 23 | (test/start-suite 1) 24 | (let [world (ecs/create-world)] 25 | (ecs/register-system world timers/update-sys) 26 | (var called-count 0) 27 | 28 | (timers/during world 3 29 | (fn [wld dt] (+= called-count 1)) 30 | (fn [wld dt] (+= called-count 1))) 31 | 32 | (:update world 1) 33 | (test/assert (= called-count 1) "tick 1: called 1") 34 | (:update world 1) 35 | (test/assert (= called-count 2) "tick 2: called 2") 36 | (:update world 1) 37 | (test/assert (= called-count 4) "tick 3: called 4")) 38 | (test/end-suite) 39 | 40 | # timers/after 41 | (test/start-suite 2) 42 | (let [world (ecs/create-world)] 43 | (ecs/register-system world timers/update-sys) 44 | (var called-count 0) 45 | 46 | (timers/every world 2 47 | (fn [wld dt] (+= called-count 1)) 48 | 4) 49 | 50 | (:update world 1) 51 | (test/assert (= called-count 0) "tick 1: called 0") 52 | (:update world 1) 53 | (test/assert (= called-count 1) "tick 2: called 1") 54 | (:update world 1) 55 | (test/assert (= called-count 1) "tick 3: called 1") 56 | (:update world 1) 57 | (test/assert (= called-count 2) "tick 4: called 2") 58 | (:update world 1) 59 | (:update world 1) 60 | (test/assert (= called-count 3) "tick 6: called 3") 61 | (:update world 1) 62 | (:update world 1) 63 | (test/assert (= called-count 4) "tick 8: called 4") 64 | (:update world 1) 65 | (:update world 1) 66 | (test/assert (= called-count 4) "tick 8: still called 4, since all done")) 67 | (test/end-suite) 68 | -------------------------------------------------------------------------------- /test/unit/tweens-test.janet: -------------------------------------------------------------------------------- 1 | (import spork/test) 2 | (import /junk-drawer/tweens) 3 | 4 | (defmacro test-tween [tween-fn expected] 5 | (map |['test/assert 6 | ~(> 0.00001 (math/abs 7 | (- (,tween-fn ,(/ $ (length expected))) 8 | ,(expected $)))) 9 | ~(string/format "%q at %n: Expect %.20f, got %.20f" 10 | ,tween-fn 11 | ,(/ $ (length expected)) 12 | ,(expected $) 13 | (,tween-fn ,(/ $ (length expected))) 14 | )] 15 | (range (length expected)))) 16 | 17 | (defn tween-results [tween-fn count] 18 | (pp (map |(tween-fn (/ $ count)) 19 | (range count)))) 20 | 21 | (test/start-suite 0) 22 | (test-tween tweens/in-linear [0 0.25 0.5 0.75]) 23 | (test-tween tweens/out-linear [0 0.25 0.5 0.75]) 24 | (test-tween tweens/in-out-linear [0 0.25 0.5 0.75]) 25 | (test-tween tweens/out-in-linear [0 0.25 0.5 0.75]) 26 | (test/end-suite) 27 | 28 | (test/start-suite 1) 29 | (test-tween tweens/in-quad [0 0.0625 0.25 0.5625]) 30 | (test-tween tweens/out-quad [0 0.4375 0.75 0.9375]) 31 | (test-tween tweens/in-out-quad [0 0.125 0.5 0.875]) 32 | (test-tween tweens/out-in-quad [0 0.375 0.5 0.625]) 33 | (test/end-suite) 34 | 35 | (test/start-suite 2) 36 | (test-tween tweens/in-cubic [0 0.015625 0.125 0.421875]) 37 | (test-tween tweens/out-cubic [0 0.578125 0.875 0.984375]) 38 | (test-tween tweens/in-out-cubic [0 0.0625 0.5 0.9375]) 39 | (test-tween tweens/out-in-cubic [0 0.4375 0.5 0.5625]) 40 | (test/end-suite) 41 | 42 | (test/start-suite 3) 43 | (test-tween tweens/in-quart [0 0.00390625 0.0625 0.31640625]) 44 | (test-tween tweens/out-quart [0 0.6835937500 0.9375 0.9960937500]) 45 | (test-tween tweens/in-out-quart [0 0.03125 0.5 0.96875]) 46 | (test-tween tweens/out-in-quart [0 0.46875 0.5 0.53125]) 47 | (test/end-suite) 48 | 49 | (test/start-suite 4) 50 | (test-tween tweens/in-quint [0 0.0009765625 0.03125 0.2373046875]) 51 | (test-tween tweens/out-quint [0 0.7626953125 0.96875 0.9990234375]) 52 | (test-tween tweens/in-out-quint [0 0.015625 0.5 0.984375]) 53 | (test-tween tweens/out-in-quint [0 0.484375 0.5 0.515625]) 54 | (test/end-suite) 55 | 56 | (test/start-suite 5) 57 | (test-tween tweens/in-sine [0 0.0761204675 0.2928932188 0.6173165676]) 58 | (test-tween tweens/out-sine [1.11022e-16 0.382683 0.707107 0.92388]) 59 | (test-tween tweens/in-out-sine [0 0.146447 0.5 0.853553]) 60 | (test-tween tweens/out-in-sine [5.55112e-17 0.353553 0.5 0.646447]) 61 | (test/end-suite) 62 | 63 | (test/start-suite 6) 64 | (test-tween tweens/in-expo [0.000976562 0.00552427 0.03125 0.176777]) 65 | (test-tween tweens/out-expo [0 0.823223 0.96875 0.994476]) 66 | (test-tween tweens/in-out-expo [0.000488281 0.015625 0.5 0.984375]) 67 | (test-tween tweens/out-in-expo [0 0.484375 0.500488 0.515625]) 68 | (test/end-suite) 69 | 70 | (test/start-suite 7) 71 | (test-tween tweens/in-circ [0 0.0317542 0.133975 0.338562]) 72 | (test-tween tweens/out-circ [0 0.661438 0.866025 0.968246]) 73 | (test-tween tweens/in-out-circ [0 0.0669873 0.5 0.933013]) 74 | (test-tween tweens/out-in-circ [0 0.433013 0.5 0.566987]) 75 | (test/end-suite) 76 | 77 | (test/start-suite 8) 78 | (test-tween tweens/in-back [0 -0.0641366 -0.0876975 0.18259]) 79 | (test-tween tweens/out-back [2.22045e-16 0.81741 1.0877 1.06414]) 80 | (test-tween tweens/in-out-back [0 -0.0438488 0.5 1.04385]) 81 | (test-tween tweens/out-in-back [1.11022e-16 0.543849 0.5 0.456151]) 82 | (test/end-suite) 83 | 84 | (test/start-suite 9) 85 | (test-tween tweens/in-bounce [0 0.472656 1.89062 4.25391]) 86 | (test-tween tweens/out-bounce [-6.5625 -3.25391 -0.890625 0.527344]) 87 | (test-tween tweens/in-out-bounce [0 0.945312 -2.78125 0.0546875]) 88 | (test-tween tweens/out-in-bounce [-3.28125 -0.445312 0.5 1.44531]) 89 | (test/end-suite) 90 | 91 | (test/start-suite 10) 92 | (test-tween tweens/in-elastic [-0.000488281 -0.00552427 -0.015625 0.0883883]) 93 | (test-tween tweens/out-elastic [0 0.911612 1.01562 1.00552]) 94 | (test-tween tweens/in-out-elastic [-0.000244141 -0.0078125 0.5 1.00781]) 95 | (test-tween tweens/out-in-elastic [0 0.507812 0.499756 0.492188]) 96 | (test/end-suite) 97 | 98 | (test/start-suite 11) 99 | (import /junk-drawer/ecs) 100 | 101 | (ecs/def-component tester 102 | :a :number 103 | :b (props :c :number)) 104 | 105 | (let [world (ecs/create-world)] 106 | (ecs/register-system world tweens/update-sys) 107 | (var ent (ecs/add-entity world (tester :a 0 :b @{:c 0}))) 108 | 109 | (tweens/create world ent :tester 110 | :to {:b {:c 10}} 111 | :with tweens/in-linear 112 | :duration 10) 113 | 114 | (for i 0 20 (:update world 1)) 115 | 116 | (var cmp (first (first (:view world [:tester])))) 117 | (test/assert (= (cmp :a) 0)) 118 | (test/assert (= (get-in cmp [:b :c]) 10))) 119 | 120 | (test/end-suite) 121 | -------------------------------------------------------------------------------- /test/unit/vector-test.janet: -------------------------------------------------------------------------------- 1 | (import spork/test) 2 | (import /junk-drawer/vector) 3 | 4 | # Operators: add, subtract, multiply, and divide 5 | (test/start-suite 0) 6 | (let [vec-a (vector/new 1 2) 7 | vec-b (vector/new 3 4)] 8 | (test/assert (= (table/to-struct (:add vec-a 3)) {:x 4 :y 5}) 9 | "add number to vector") 10 | (test/assert (= (table/to-struct (:add vec-a vec-b)) {:x 7 :y 9}) 11 | "add vector to vector")) 12 | 13 | (let [vec-a (vector/new 10 10) 14 | vec-b (vector/new 5 5)] 15 | (test/assert (= (table/to-struct (:subtract vec-a 1)) {:x 9 :y 9}) 16 | "subtract number to vector") 17 | (test/assert (= (table/to-struct (:subtract vec-a vec-b)) {:x 4 :y 4}) 18 | "subtract vector to vector")) 19 | 20 | (let [vec-a (vector/new 2 2) 21 | vec-b (vector/new 3 4)] 22 | (test/assert (= (table/to-struct (:multiply vec-a 2)) {:x 4 :y 4}) 23 | "multiple vector by number") 24 | (test/assert (= (table/to-struct (:multiply vec-a vec-b)) {:x 12 :y 16}) 25 | "multiple vector by vector")) 26 | 27 | (let [vec-a (vector/new 12 8) 28 | vec-b (vector/new 1 2)] 29 | (test/assert (= (table/to-struct (:divide vec-a 2)) {:x 6 :y 4}) 30 | "divide vector by number") 31 | (test/assert (= (table/to-struct (:divide vec-a vec-b)) {:x 6 :y 2}) 32 | "divide vector by vector")) 33 | (test/end-suite) 34 | 35 | # Comparisons: equal?, lt? and lte? 36 | (test/start-suite 1) 37 | (let [vec-a (vector/new 12 8) 38 | vec-b (vector/new 1 2) 39 | vec-c (vector/new 12 8)] 40 | (test/assert (not (:equal? vec-a vec-b)) 41 | "equal? not equal") 42 | (test/assert (:equal? vec-a vec-c) 43 | "equal? are equal") 44 | 45 | (test/assert (not (:lt? vec-a vec-b)) 46 | "lt? not less then") 47 | (test/assert (:lt? vec-b vec-a) 48 | "lt? is less then") 49 | 50 | (test/assert (not (:lte? vec-a vec-b)) 51 | "lte? first greater then second") 52 | (test/assert (:lte? vec-b vec-c) 53 | "lte? first less then second") 54 | (test/assert (:lte? vec-a vec-c) 55 | "lte? are equal")) 56 | (test/end-suite) 57 | 58 | # Length 59 | (test/start-suite 3) 60 | (let [vec-a (vector/new 6 8)] 61 | (test/assert (= (:length2 vec-a) 100) 62 | "length 2 calculated correctly") 63 | (test/assert (= (:length vec-a) 10) 64 | "length calculated correctly")) 65 | (test/end-suite) 66 | 67 | # to Polar 68 | (test/start-suite 4) 69 | (let [vec (vector/new 20 34) 70 | expected (vector/new (math/round 0.5317) (math/round 39.4452))] 71 | (test/assert (:equal? expected (:to-polar vec) true) 72 | "to-polar equals expected vec.. rounded at least")) 73 | (test/end-suite) 74 | 75 | # distance 76 | (test/start-suite 5) 77 | (let [vec-a (vector/new 0 0) 78 | vec-b (vector/new 8 8)] 79 | (test/assert (= (:distance2 vec-a vec-b) 128) 80 | "distance 2") 81 | (test/assert (> 0.001 (- (:distance vec-a vec-b) 11.3137)) 82 | "distance")) 83 | (test/end-suite) 84 | 85 | # normalize 86 | (test/start-suite 6) 87 | (let [vec-a (vector/new 8.5 8) 88 | normalized (:normalize vec-a)] 89 | (test/assert (> 0.001 (- (normalized :x) 0.7282)) 90 | "normalized x") 91 | (test/assert (> 0.001 (- (normalized :y) 0.6853)) 92 | "normalized y")) 93 | (test/end-suite) 94 | 95 | # perpendicular 96 | (test/start-suite 7) 97 | (let [vec-a (vector/new 8.5 8) 98 | expected (vector/new -8 8.5)] 99 | (test/assert (:equal? expected (:perpendicular vec-a)) 100 | "perpendicular")) 101 | (test/end-suite) 102 | 103 | # preject-on, mirror-on 104 | (test/start-suite 8) 105 | (let [vec-a (vector/new 8.5 8) 106 | vec-b (vector/new 2 2)] 107 | (test/assert (:equal? (vector/new 8.25 8.25) (:preject-on vec-a vec-b)) 108 | "preject on") 109 | (test/assert (:equal? (vector/new 8 8.5) (:mirror-on vec-a vec-b)) 110 | "mirror on")) 111 | (test/end-suite) 112 | 113 | # Cross 114 | (test/start-suite 8) 115 | (let [vec-a (vector/new 9 16) 116 | vec-b (vector/new 2 2)] 117 | (test/assert (= (:cross vec-a vec-b) -14) 118 | "cross vec-a and vec-b")) 119 | (test/end-suite) 120 | 121 | # trim 122 | (test/start-suite 9) 123 | (let [vec-a (vector/new 9 16) 124 | trimmed (:trim vec-a 10)] 125 | (test/assert (> 0.001 (- (trimmed :x) 2.6706)) "trimmed to 10 x") 126 | (test/assert (> 0.001 (- (trimmed :y) 4.7477)) "trimmed to 10 y")) 127 | (test/end-suite) 128 | 129 | # angle-to 130 | (test/start-suite 9) 131 | (let [vec-a (vector/new 0 1) 132 | vec-b (vector/new 1 0)] 133 | (test/assert (> 0.001 (- (:angle-to vec-a vec-b) -1.5708)) 134 | "angle to another vector") 135 | (test/assert (> 0.001 (- (:angle-to vec-a) 0)) 136 | "angle to origin")) 137 | (test/end-suite) 138 | 139 | # from-polar 140 | (test/start-suite 10) 141 | (let [vec (vector/from-polar math/pi 10)] 142 | (test/assert (> 0.001 (- (vec :x) -10)) "from polar x") 143 | (test/assert (> 0.001 (- (vec :y) 0)) "from polar y")) 144 | (test/end-suite) 145 | 146 | # from-tuple 147 | (test/start-suite 10) 148 | (let [vec (vector/from-tuple [1 3])] 149 | (test/assert (= 1 (vec :x)) "from tuple x") 150 | (test/assert (= 3 (vec :y)) "from tuple y")) 151 | (test/end-suite) 152 | 153 | # from-named 154 | (test/start-suite 10) 155 | (let [vec (vector/from-named :x 1 :y 3)] 156 | (test/assert (= 1 (vec :x)) "from tuple x") 157 | (test/assert (= 3 (vec :y)) "from tuple y")) 158 | (test/end-suite) 159 | 160 | # random-direction 161 | (test/start-suite 11) 162 | (let [seed 1 163 | vec (vector/random-direction 1 5 seed)] 164 | (test/assert (> 0.001 (- (vec :x) 1.30893)) "random-direction x") 165 | (test/assert (> 0.001 (- (vec :y) 4.54775)) "random-direction y")) 166 | (test/end-suite) 167 | --------------------------------------------------------------------------------