implement multimethods

This commit is contained in:
Jeremy Penner 2021-04-10 23:39:42 -04:00
parent e7d6d76ca8
commit 4c6d909031
10 changed files with 85 additions and 38 deletions

View file

@ -38,9 +38,9 @@
(fn repl.inspect [v view x y w depth state] (fn repl.inspect [v view x y w depth state]
(if (> w 0) (if (> w 0)
(match (type v) (if (and (= (type v) :table) (not= (next v) nil))
:table (repl.inspect-table v view x y w depth state) (repl.inspect-table v view x y w depth state)
_ (repl.inspect-default v view x y w depth state)) (repl.inspect-default v view x y w depth state))
0)) 0))
(fn repl.inspector [{: vals : state} view x y] (fn repl.inspector [{: vals : state} view x y]

View file

@ -1,5 +1,8 @@
(local util (require :lib.util)) (local util (require :lib.util))
(local dim (require :game.dim)) (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 ...)) (local Bomb (util.hot-table ...))
@ -16,10 +19,10 @@
(love.graphics.setColor 1 0.7 0) (love.graphics.setColor 1 0.7 0)
(love.graphics.rectangle :fill l t dim.tilesize dim.tilesize))) (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 (match bomb.state
:ticking (draw-ticking bomb x y) :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] (fn Bomb.set-state [bomb state time]
(set bomb.timer time) (set bomb.timer time)
@ -32,17 +35,17 @@
(set bomb.deadly true) (set bomb.deadly true)
(rules.explode-bomb bomb)) (rules.explode-bomb bomb))
(fn Bomb.update [bomb dt rules] (defmethod update :bomb (fn [bomb dt rules]
(set bomb.timer (- bomb.timer dt)) (set bomb.timer (- bomb.timer dt))
(when (<= bomb.timer 0) (when (<= bomb.timer 0)
(match bomb.state (match bomb.state
:ticking (Bomb.explode bomb rules) :ticking (Bomb.explode bomb rules)
:exploding (rules.clear-bomb bomb)))) :exploding (rules.clear-bomb bomb)))))
(fn Bomb.new [] (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 [] (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 Bomb.hot

View file

@ -1,15 +1,16 @@
(local util (require :lib.util)) (local util (require :lib.util))
(local dim (require :game.dim)) (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 {: edge : edge-crosses : vec*} (util.require :game.helpers))
(local {: defmethod} (util.require :lib.multimethod))
(local map (require :game.tilemap)) (local map (require :game.tilemap))
(local bomberman (util.hot-table ...)) (local bomberman (util.hot-table ...))
(set bomberman.keymap {:up :w :down :s :left :a :right :d :bomb :x}) (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.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] (fn tile-at [x y rules]
(-?> [x y] (-?> [x y]
@ -55,7 +56,7 @@
pos-collides [dc-edge (math.max (- dcopp) (- (bomberman.tile-edge (- neg-edge dim.tilesize) -1) copp))])] pos-collides [dc-edge (math.max (- dcopp) (- (bomberman.tile-edge (- neg-edge dim.tilesize) -1) copp))])]
(make-xy cn coppn))) (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))) (set entity.vel (direct bomberman.keymap (* dim.tilesize 3)))
(let [[x y] entity.pos (let [[x y] entity.pos
[dx dy] (vec* entity.vel dt) [dx dy] (vec* entity.vel dt)
@ -63,9 +64,9 @@
(bomberman.axis-movement vertical y x dy rules))] (bomberman.axis-movement vertical y x dy rules))]
(set entity.pos [(+ x dx) (+ y dy)])) (set entity.pos [(+ x dx) (+ y dy)]))
(when (love.keyboard.isDown bomberman.keymap.bomb) (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] (fn bomberman.new [pos]
{: pos :vel [0 0] :draw #(bomberman.draw $...) :update #(bomberman.update $...)}) {: pos :vel [0 0] :entity :bomberman})
bomberman.hot bomberman.hot

View file

@ -1,10 +1,16 @@
(local util (require :lib.util)) (local util (require :lib.util))
(local dim (require :game.dim)) (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 map (require :game.tilemap))
(local pacman (util.hot-table ...)) (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 movement and collision rules
; * Pacman moves in the direction he was told until stopped by a wall ; * 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, ; * 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 ; the track. (The "post-turn" correction means we can't simply treat this as the corners having
; their edges filed off!) ; their edges filed off!)
; I think Bomberman actually does this too ; I think Bomberman actually does this too
(fn pacman.new [pos]
{: pos :vel [0 0] :entity :pacman})
pacman.hot pacman.hot

View file

@ -1,6 +1,6 @@
(local util (require :lib.util)) (local util (require :lib.util))
(local {: defmulti : defmethod} (util.require :lib.multimethod))
(local {: vec* : vec+ : dir-from-key} (util.require :game.helpers)) (local {: vec* : vec+ : dir-from-key} (util.require :game.helpers))
(local rules (require :game.rules))
(local dim (require :game.dim)) (local dim (require :game.dim))
(local entity {}) (local entity {})
@ -10,5 +10,10 @@
(fn entity.direct [keymap speed] (fn entity.direct [keymap speed]
(vec* (dir-from-key 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 entity

View file

@ -1,11 +1,13 @@
(local util (require :lib.util))
(local state (require :game.state)) (local state (require :game.state))
(local map (require :game.tilemap)) (local map (require :game.tilemap))
(local rules (require :game.rules)) (local rules (require :game.rules))
(local {: draw : update} (util.require :game.entity))
(fn game-update [dt] (fn game-update [dt]
(map.update-entitymap state.bombs dt rules) (map.update-entitymap state.bombs dt rules)
(each [_ entity (ipairs state.entities)] (each [_ entity (ipairs state.entities)]
(entity:update dt rules))) (update entity dt rules)))
(fn exception-update [dt] (fn exception-update [dt]
(when (love.keyboard.isDown :f2) (when (love.keyboard.isDown :f2)
@ -20,7 +22,7 @@
(fn game-draw [] (fn game-draw []
(map.draw-tilemaps 0 0 [state.bombs state.map]) (map.draw-tilemaps 0 0 [state.bombs state.map])
(each [_ entity (ipairs state.entities)] (each [_ entity (ipairs state.entities)]
(entity:draw))) (draw entity)))
(fn exception-draw [] (fn exception-draw []
(love.graphics.setColor 1 0 0 1) (love.graphics.setColor 1 0 0 1)

View file

@ -1,8 +1,13 @@
(local dim (require :game.dim)) (local dim (require :game.dim))
(local util (require :lib.util)) (local util (require :lib.util))
(local {: all-coordinates : vec* : vec+ : vec-op} (util.require :game.helpers)) (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 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] (fn itile-at [x y tilemap]
(-?> tilemap (. y) (. x))) (-?> tilemap (. y) (. x)))
@ -52,22 +57,17 @@
(let [(tile tilemap) (tile-at-overlay tx ty tilemaps) (let [(tile tilemap) (tile-at-overlay tx ty tilemaps)
xt (+ x (* tx dim.tilesize) (/ dim.tilesize 2)) xt (+ x (* tx dim.tilesize) (/ dim.tilesize 2))
yt (+ y (* ty dim.tilesize) (/ dim.tilesize 2))] yt (+ y (* ty dim.tilesize) (/ dim.tilesize 2))]
(if (and tile tile.draw) (drawtile tile xt yt))))
(tile.draw xt yt tile)
(and tile tilemap.tileset tilemap.tileset.draw)
(tilemap.tileset.draw tile xt yt)))))
(fn update-entitymap [tilemap ...] (fn update-entitymap [tilemap ...]
(each [_ entity (ipairs (lume.clone tilemap.entities))] (each [_ entity (ipairs (lume.clone tilemap.entities))]
(when entity.update (update entity ...)))
(entity:update ...))))
(fn world-to-tile [vec] (fn world-to-tile [vec]
(-> vec (-> vec
((vec-op #(math.floor (/ $1 dim.tilesize)))))) ((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 : new-entitymap : set-entity-at : remove-entity : update-entitymap
: world-to-tile} : world-to-tile : drawtile}

View file

@ -1,5 +1,7 @@
(local dim (require :game.dim)) (local dim (require :game.dim))
(local util (require :lib.util)) (local util (require :lib.util))
(local {: defmethod} (util.require :lib.multimethod))
(local {: drawtile} (util.require :game.tilemap))
(local tileset (util.hot-table ...)) (local tileset (util.hot-table ...))
(fn rect [x y color] (fn rect [x y color]
@ -9,21 +11,19 @@
(- y (/ dim.tilesize 2)) (- y (/ dim.tilesize 2))
dim.tilesize dim.tilesize
dim.tilesize)) dim.tilesize))
(fn tileset.make-tileset [tiles draw] (fn tileset.make-tileset [tiles]
(each [itile tile (ipairs tiles)] (each [itile tile (ipairs tiles)]
(tset tiles tile.name itile)) (tset tiles tile.name itile))
(set tiles.draw draw)
tiles) tiles)
(fn tileset.itile-named [tileset name] (fn tileset.itile-named [tileset name]
(. tileset name)) (. tileset name))
(fn tileset.bombertile-draw [tile x y] (defmethod drawtile :strongwall (fn [tile x y] (rect x y [0.7 0.7 0.7])))
(match tile.name (defmethod drawtile :weakwall (fn [tile x y] (rect x y [0.4 0.4 0.4])))
:strongwall (rect x y [0.7 0.7 0.7]) (defmethod drawtile :dot (fn [tile x y]
:weakwall (rect x y [0.4 0.4 0.4]) (love.graphics.setColor 1 1 1)
:dot (do (love.graphics.setColor 1 1 1) (love.graphics.circle :fill x y (/ dim.tilesize 8))))
(love.graphics.circle :fill x y (/ dim.tilesize 8)))))
(set tileset.bombertile (tileset.make-tileset (set tileset.bombertile (tileset.make-tileset
[{:name :empty [{:name :empty
@ -35,7 +35,7 @@
:breakable true} :breakable true}
{:name :dot {:name :dot
:edible true} :edible true}
] #(tileset.bombertile-draw $...))) ]))
tileset.hot tileset.hot

18
lib/multimethod.fnl Normal file
View file

@ -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

View file

@ -99,8 +99,15 @@
(tset multival i (select i ...))) (tset multival i (select i ...)))
multival) 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 {: int8-to-bytes : int16-to-bytes : int24-to-bytes : bytes-to-uint8 : bytes-to-uint16 : bytes-to-uint24
: splice : lo : hi : 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} : readjson : writejson : waitfor : in-coro : multival}