implement multimethods
This commit is contained in:
parent
e7d6d76ca8
commit
4c6d909031
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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}
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
18
lib/multimethod.fnl
Normal file
18
lib/multimethod.fnl
Normal 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
|
|
@ -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}
|
||||
|
||||
|
|
Loading…
Reference in a new issue