From 4c6d9090313c6f67ff33fdb45a1590ac18b12686 Mon Sep 17 00:00:00 2001
From: Jeremy Penner <jeremy@sporktania.com>
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}