From 4c6d9090313c6f67ff33fdb45a1590ac18b12686 Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Sat, 10 Apr 2021 23:39:42 -0400 Subject: [PATCH] implement multimethods --- editor/repl.fnl | 6 +++--- game/entities/bomb.fnl | 15 +++++++++------ game/entities/bomberman.fnl | 13 +++++++------ game/entities/pacman.fnl | 13 ++++++++++++- game/entity.fnl | 7 ++++++- game/mode.fnl | 6 ++++-- game/tilemap.fnl | 18 +++++++++--------- game/tiles.fnl | 18 +++++++++--------- lib/multimethod.fnl | 18 ++++++++++++++++++ lib/util.fnl | 9 ++++++++- 10 files changed, 85 insertions(+), 38 deletions(-) create mode 100644 lib/multimethod.fnl diff --git a/editor/repl.fnl b/editor/repl.fnl index 8e79b1f..36eef94 100644 --- a/editor/repl.fnl +++ b/editor/repl.fnl @@ -38,9 +38,9 @@ (fn repl.inspect [v view x y w depth state] (if (> w 0) - (match (type v) - :table (repl.inspect-table v view x y w depth state) - _ (repl.inspect-default v view x y w depth state)) + (if (and (= (type v) :table) (not= (next v) nil)) + (repl.inspect-table v view x y w depth state) + (repl.inspect-default v view x y w depth state)) 0)) (fn repl.inspector [{: vals : state} view x y] diff --git a/game/entities/bomb.fnl b/game/entities/bomb.fnl index 52b666a..40eb1b7 100644 --- a/game/entities/bomb.fnl +++ b/game/entities/bomb.fnl @@ -1,5 +1,8 @@ (local util (require :lib.util)) (local dim (require :game.dim)) +(local {: defmethod} (util.require :lib.multimethod)) +(local {: update} (util.require :game.entity)) +(local {: drawtile} (util.require :game.tilemap)) (local Bomb (util.hot-table ...)) @@ -16,10 +19,10 @@ (love.graphics.setColor 1 0.7 0) (love.graphics.rectangle :fill l t dim.tilesize dim.tilesize))) -(fn Bomb.draw [x y bomb] +(defmethod drawtile :bomb (fn [bomb x y] (match bomb.state :ticking (draw-ticking bomb x y) - :exploding (draw-exploding bomb x y))) + :exploding (draw-exploding bomb x y)))) (fn Bomb.set-state [bomb state time] (set bomb.timer time) @@ -32,17 +35,17 @@ (set bomb.deadly true) (rules.explode-bomb bomb)) -(fn Bomb.update [bomb dt rules] +(defmethod update :bomb (fn [bomb dt rules] (set bomb.timer (- bomb.timer dt)) (when (<= bomb.timer 0) (match bomb.state :ticking (Bomb.explode bomb rules) - :exploding (rules.clear-bomb bomb)))) + :exploding (rules.clear-bomb bomb))))) (fn Bomb.new [] - {:state :ticking :timer 3 :bomb true :draw #(Bomb.draw $...) :update #(Bomb.update $...)}) + {:state :ticking :timer 3 :bomb true :entity :bomb}) (fn Bomb.new-explosion [] - {:state :exploding :timer 0.5 :deadly true :draw #(Bomb.draw $...) :update #(Bomb.update $...)}) + {:state :exploding :timer 0.5 :deadly true :entity :bomb}) Bomb.hot diff --git a/game/entities/bomberman.fnl b/game/entities/bomberman.fnl index 8ce05bb..cff58cf 100644 --- a/game/entities/bomberman.fnl +++ b/game/entities/bomberman.fnl @@ -1,15 +1,16 @@ (local util (require :lib.util)) (local dim (require :game.dim)) -(local {: direct : move} (util.require :game.entity)) +(local {: direct : draw : update} (util.require :game.entity)) (local {: edge : edge-crosses : vec*} (util.require :game.helpers)) +(local {: defmethod} (util.require :lib.multimethod)) (local map (require :game.tilemap)) (local bomberman (util.hot-table ...)) (set bomberman.keymap {:up :w :down :s :left :a :right :d :bomb :x}) -(fn bomberman.draw [entity] +(defmethod draw :bomberman (fn [{:pos [x y]}] (love.graphics.setColor 0.2 0.2 0.2) - (love.graphics.circle :fill (. entity.pos 1) (. entity.pos 2) (/ dim.tilesize 2))) + (love.graphics.circle :fill x y dim.halftile))) (fn tile-at [x y rules] (-?> [x y] @@ -55,7 +56,7 @@ pos-collides [dc-edge (math.max (- dcopp) (- (bomberman.tile-edge (- neg-edge dim.tilesize) -1) copp))])] (make-xy cn coppn))) -(fn bomberman.update [entity dt rules] +(defmethod update :bomberman (fn [entity dt rules] (set entity.vel (direct bomberman.keymap (* dim.tilesize 3))) (let [[x y] entity.pos [dx dy] (vec* entity.vel dt) @@ -63,9 +64,9 @@ (bomberman.axis-movement vertical y x dy rules))] (set entity.pos [(+ x dx) (+ y dy)])) (when (love.keyboard.isDown bomberman.keymap.bomb) - (rules.place-bomb (map.world-to-tile entity.pos)))) + (rules.place-bomb (map.world-to-tile entity.pos))))) (fn bomberman.new [pos] - {: pos :vel [0 0] :draw #(bomberman.draw $...) :update #(bomberman.update $...)}) + {: pos :vel [0 0] :entity :bomberman}) bomberman.hot diff --git a/game/entities/pacman.fnl b/game/entities/pacman.fnl index 6625f87..05a32de 100644 --- a/game/entities/pacman.fnl +++ b/game/entities/pacman.fnl @@ -1,10 +1,16 @@ (local util (require :lib.util)) (local dim (require :game.dim)) - +(local {: defmethod} (util.require :lib.multimethod)) +(local {: direct : draw : update} (util.require :game.entity)) (local map (require :game.tilemap)) (local pacman (util.hot-table ...)) +(set pacman.keymap {:up :up :down :down :left :left :right :right}) +(defmethod draw :pacman (fn [{:pos [x y]}] + (love.graphics.setColor 1 1 0) + (love.graphics.circle :fill x y dim.halftile))) + ; Pacman movement and collision rules ; * Pacman moves in the direction he was told until stopped by a wall ; * If the player tells Pacman to change direction but there is a wall there, @@ -20,4 +26,9 @@ ; the track. (The "post-turn" correction means we can't simply treat this as the corners having ; their edges filed off!) ; I think Bomberman actually does this too + + +(fn pacman.new [pos] + {: pos :vel [0 0] :entity :pacman}) + pacman.hot diff --git a/game/entity.fnl b/game/entity.fnl index f110400..c39965e 100644 --- a/game/entity.fnl +++ b/game/entity.fnl @@ -1,6 +1,6 @@ (local util (require :lib.util)) +(local {: defmulti : defmethod} (util.require :lib.multimethod)) (local {: vec* : vec+ : dir-from-key} (util.require :game.helpers)) -(local rules (require :game.rules)) (local dim (require :game.dim)) (local entity {}) @@ -10,5 +10,10 @@ (fn entity.direct [keymap speed] (vec* (dir-from-key keymap) speed)) +(set entity.draw (defmulti #(or $1.draw $1.entity) :draw ...)) +(set entity.update (defmulti #(or $1.update $1.entity) :update ...)) +(defmethod entity.draw :default #nil) +(defmethod entity.update :default #nil) + entity diff --git a/game/mode.fnl b/game/mode.fnl index 3987409..1dabd9f 100644 --- a/game/mode.fnl +++ b/game/mode.fnl @@ -1,11 +1,13 @@ +(local util (require :lib.util)) (local state (require :game.state)) (local map (require :game.tilemap)) (local rules (require :game.rules)) +(local {: draw : update} (util.require :game.entity)) (fn game-update [dt] (map.update-entitymap state.bombs dt rules) (each [_ entity (ipairs state.entities)] - (entity:update dt rules))) + (update entity dt rules))) (fn exception-update [dt] (when (love.keyboard.isDown :f2) @@ -20,7 +22,7 @@ (fn game-draw [] (map.draw-tilemaps 0 0 [state.bombs state.map]) (each [_ entity (ipairs state.entities)] - (entity:draw))) + (draw entity))) (fn exception-draw [] (love.graphics.setColor 1 0 0 1) diff --git a/game/tilemap.fnl b/game/tilemap.fnl index 894ee4d..1f02285 100644 --- a/game/tilemap.fnl +++ b/game/tilemap.fnl @@ -1,8 +1,13 @@ (local dim (require :game.dim)) (local util (require :lib.util)) (local {: all-coordinates : vec* : vec+ : vec-op} (util.require :game.helpers)) +(local {: update} (util.require :game.entity)) +(local {: defmulti : defmethod} (util.require :lib.multimethod)) (local lume (require :lib.lume)) +(local drawtile (defmulti #(or $1.draw $1.entity $1.name) :drawtile ...)) +(defmethod drawtile :default #nil) + (fn itile-at [x y tilemap] (-?> tilemap (. y) (. x))) @@ -52,22 +57,17 @@ (let [(tile tilemap) (tile-at-overlay tx ty tilemaps) xt (+ x (* tx dim.tilesize) (/ dim.tilesize 2)) yt (+ y (* ty dim.tilesize) (/ dim.tilesize 2))] - (if (and tile tile.draw) - (tile.draw xt yt tile) - - (and tile tilemap.tileset tilemap.tileset.draw) - (tilemap.tileset.draw tile xt yt))))) + (drawtile tile xt yt)))) (fn update-entitymap [tilemap ...] (each [_ entity (ipairs (lume.clone tilemap.entities))] - (when entity.update - (entity:update ...)))) + (update entity ...))) (fn world-to-tile [vec] (-> vec ((vec-op #(math.floor (/ $1 dim.tilesize)))))) -{: new-tilemap : itile-at : tile-at : set-itile-at : tile-at-overlay : draw-tilemaps +{: new-tilemap : itile-at : tile-at : set-itile-at : tile-at-overlay : draw-tilemaps : new-entitymap : set-entity-at : remove-entity : update-entitymap - : world-to-tile} + : world-to-tile : drawtile} diff --git a/game/tiles.fnl b/game/tiles.fnl index 8772aa9..ddaeca3 100644 --- a/game/tiles.fnl +++ b/game/tiles.fnl @@ -1,5 +1,7 @@ (local dim (require :game.dim)) (local util (require :lib.util)) +(local {: defmethod} (util.require :lib.multimethod)) +(local {: drawtile} (util.require :game.tilemap)) (local tileset (util.hot-table ...)) (fn rect [x y color] @@ -9,21 +11,19 @@ (- y (/ dim.tilesize 2)) dim.tilesize dim.tilesize)) -(fn tileset.make-tileset [tiles draw] +(fn tileset.make-tileset [tiles] (each [itile tile (ipairs tiles)] (tset tiles tile.name itile)) - (set tiles.draw draw) tiles) (fn tileset.itile-named [tileset name] (. tileset name)) -(fn tileset.bombertile-draw [tile x y] - (match tile.name - :strongwall (rect x y [0.7 0.7 0.7]) - :weakwall (rect x y [0.4 0.4 0.4]) - :dot (do (love.graphics.setColor 1 1 1) - (love.graphics.circle :fill x y (/ dim.tilesize 8))))) +(defmethod drawtile :strongwall (fn [tile x y] (rect x y [0.7 0.7 0.7]))) +(defmethod drawtile :weakwall (fn [tile x y] (rect x y [0.4 0.4 0.4]))) +(defmethod drawtile :dot (fn [tile x y] + (love.graphics.setColor 1 1 1) + (love.graphics.circle :fill x y (/ dim.tilesize 8)))) (set tileset.bombertile (tileset.make-tileset [{:name :empty @@ -35,7 +35,7 @@ :breakable true} {:name :dot :edible true} - ] #(tileset.bombertile-draw $...))) + ])) tileset.hot diff --git a/lib/multimethod.fnl b/lib/multimethod.fnl new file mode 100644 index 0000000..4ca7aac --- /dev/null +++ b/lib/multimethod.fnl @@ -0,0 +1,18 @@ +(local util (require :lib.util)) + +(local mm {}) + +(fn mm.__call [{: module : name} ...] + (let [dispatcher (. mm.dispatchers module name) + key (dispatcher ...) + method (or (. mm.methods module name key) (. mm.methods module name :default))] + (method ...))) + +(fn mm.defmulti [dispatcher name module] + (util.nested-tset mm [:dispatchers module name] dispatcher) + (setmetatable {: module : name} mm)) + +(fn mm.defmethod [{: module : name} key method] + (util.nested-tset mm [:methods module name key] method)) + +mm diff --git a/lib/util.fnl b/lib/util.fnl index 0e87065..8095c6c 100644 --- a/lib/util.fnl +++ b/lib/util.fnl @@ -99,8 +99,15 @@ (tset multival i (select i ...))) multival) +(fn nested-tset [t keys value] + (let [next-key (. keys 1)] + (if (= (length keys) 1) (tset t next-key value) + (do (when (= (. t next-key) nil) + (tset t next-key {})) + (nested-tset (. t next-key) (lume.slice keys 2) value))))) + {: int8-to-bytes : int16-to-bytes : int24-to-bytes : bytes-to-uint8 : bytes-to-uint16 : bytes-to-uint24 : splice : lo : hi - : reload : hotswap : swappable :require swappable-require : hot-table + : reload : hotswap : swappable :require swappable-require : hot-table : nested-tset : readjson : writejson : waitfor : in-coro : multival}