From d097c53d202167ce49aaa224a4efb5b8cf9d3c8d Mon Sep 17 00:00:00 2001
From: Jeremy Penner <jeremy@sporktania.com>
Date: Sun, 22 Oct 2023 22:41:55 -0400
Subject: [PATCH] building out the engine

---
 src/explosion.fnl        | 99 ++++++++++++++++++++++++++++++++++++++++
 src/main.fnl             | 17 +------
 src/meta/multimethod.fnl | 20 ++++++++
 src/meta/reload.fnl      | 30 ++++++++----
 src/meta/table.fnl       |  8 +++-
 src/state.fnl            |  1 +
 src/test.fnl             |  1 -
 7 files changed, 149 insertions(+), 27 deletions(-)
 create mode 100644 src/explosion.fnl
 create mode 100644 src/meta/multimethod.fnl
 create mode 100644 src/state.fnl
 delete mode 100644 src/test.fnl

diff --git a/src/explosion.fnl b/src/explosion.fnl
new file mode 100644
index 0000000..44c8dbd
--- /dev/null
+++ b/src/explosion.fnl
@@ -0,0 +1,99 @@
+(local reload (require :meta.reload))
+(local {: defmulti} (require :meta.multimethod))
+(local tbl (require :meta.table))
+(local iter (require :meta.iter))
+(local state (require :state))
+
+(local gfx playdate.graphics)
+
+(local draw (defmulti #$1))
+(local update (defmulti #$1))
+(local children (defmulti #$2))
+(local cleanup (defmulti #$1))
+
+(draw:defmethod :default #nil)
+(update:defmethod :default #nil)
+(children:defmethod :default (fn [val] (iter.ivalues val)))
+
+(fn descend [t k] (children (. t k) k t))
+
+(fn do-to-children [keys f ?t]
+    (each [_ key (ipairs keys)]
+        (each [id child (descend (or state ?t) key)]
+            (f key child id (or state ?t)))))
+
+(fn restart []
+    (tbl.extend state
+      {:bomber {:x 200 :active false}
+       :bombs []
+       :bucket {:x 200 :count 3}
+       :bombspeed 5}))
+
+(fn hotload []
+    (tbl.extend state
+        {:draw [:background :bomber :bombs :bucket]
+         :update [:bomber :bombs :bucket]
+         :cleanup [:bombs]}))
+
+(fn children-keylist [keys _ t]
+    (iter.coro-iter #(each [_ key (ipairs keys)]
+                    (each [k v (descend t key)]
+                        (coroutine.yield k v)))))
+
+(children:defmethod :bombs ipairs)
+
+(when (= state.bombspeed nil)
+    (restart))
+(hotload)
+
+(local screenw (playdate.display.getWidth))
+(local screenh (playdate.display.getHeight))
+
+(update:defmethod :bucket (fn [_ bucket]
+    (let [crank (playdate.getCrankPosition)
+          ratio (if (> crank 180) (/ (- 360 crank) -130) (/ crank 130))
+          clamped (if (< ratio -1) -1
+                      (> ratio 1)   1
+                      ratio)
+          x (* (/ (+ ratio 1) 2) screenw)]
+        (set bucket.x x))
+))
+
+(let [bucketw 50 bucketh 10 radius 4
+      xoffset (/ bucketw 2)
+      buckety 220]
+    (draw:defmethod :bucket (fn [_ {: x}]
+        (gfx.drawRoundRect (- x xoffset) buckety bucketw bucketh radius))))
+
+(fn drop-bomb []
+    (table.insert state.bombs {:x state.bomber.x :y 30}))
+
+(draw:defmethod :bomber (fn [_ {: x}]
+    (gfx.fillRoundRect (- x 10) 5 20 30 6)))
+
+(update:defmethod :bomber (fn []
+    (when (playdate.buttonJustPressed :a)
+        (drop-bomb))))
+
+(draw:defmethod :background (fn []
+    (gfx.drawLine 0 33 screenw 33)))
+
+(draw:defmethod :bombs (fn [_ {: x : y}]
+    (gfx.fillCircleAtPoint x y 7)))
+
+(update:defmethod :bombs (fn [_ bomb ibomb s]
+    (set bomb.y (+ bomb.y 5))))
+
+(cleanup:defmethod :bombs #(tbl.remove-matching state.bombs #(> $1.y screenh)))
+
+(fn playdate.update []
+    (do-to-children state.update update)
+    (each [_ key (ipairs (or state.cleanup []))]
+        (cleanup key))
+
+    (gfx.clear)
+    (do-to-children state.draw draw)
+
+    (gfx.sprite.update)
+    (playdate.timer.updateTimers)
+    (reload.check))
diff --git a/src/main.fnl b/src/main.fnl
index bbe93c2..f465dbb 100644
--- a/src/main.fnl
+++ b/src/main.fnl
@@ -4,18 +4,5 @@
 (import :CoreLibs/timer)
 (import :package)
 
-(local reload (require :meta.reload))
-
-(local test (require :test))
-(local gfx playdate.graphics)
-
-(let [font (gfx.getSystemFont gfx.font.kVariantNormal)]
-    (fn _G.drawtext [text x y] (font:drawText text x y)))
-
-(fn playdate.update []
-    (drawtext test.x 5 5)
-    (drawtext "Hello from Fennel!" 5 25)
-    (gfx.sprite.update)
-    (playdate.timer.updateTimers)
-    (reload.check)
-)
+(require :meta.reload)
+(require :explosion)
diff --git a/src/meta/multimethod.fnl b/src/meta/multimethod.fnl
new file mode 100644
index 0000000..81d290a
--- /dev/null
+++ b/src/meta/multimethod.fnl
@@ -0,0 +1,20 @@
+(local mm {})
+
+; this indirection allows us to hook a single multimethod pre-dispatch
+(set mm.__index mm)
+(fn mm.__call [multi ...] (multi:call ...))
+
+(fn mm.call [{: dispatcher : methods} ...]
+  (let [key (dispatcher ...)
+        method (or (. methods key) methods.default)]
+    (method ...)))
+
+(fn mm.defmulti [dispatcher]
+"Creates a new multimethod that uses `dispatcher` to determine which method to call."
+  (setmetatable {: dispatcher :methods {}} mm))
+
+(fn mm.defmethod [{: methods} key method]
+"Defines the method for a given key."
+  (tset methods key method))
+
+mm
diff --git a/src/meta/reload.fnl b/src/meta/reload.fnl
index e8ca669..e193712 100644
--- a/src/meta/reload.fnl
+++ b/src/meta/reload.fnl
@@ -39,10 +39,14 @@
 
     (set package.watches {})
 
-    (fn reload.modtime [modname]
-      (playdate.file.modtime (package.pdzfilename modname)))
+    (fn watchmeta [modname]
+      (let [filename (package.pdzfilename modname)]
+        (if (playdate.file.exists filename)
+          {:modtime (playdate.file.modtime filename)
+           :size    (playdate.file.getSize filename)}
+          {})))
     
-    (fn reload.modtime= [time1 time2]
+    (fn modtime= [time1 time2]
       (and (= time1.year time2.year)
            (= time1.month time2.month)
            (= time1.day time2.day)
@@ -50,23 +54,29 @@
            (= time1.minute time2.minute)
            (= time1.second time2.second)))
 
+    (fn should-reload? [watch1 watch2]
+      (and watch1.modtime watch2.modtime
+           (not= watch1.size watch2.size)
+           (not (modtime= watch1.modtime watch2.modtime))))
+
     (fn reload.watch [modname]
       (when (and (= nil (. package.watches modname))
                  (playdate.file.exists (package.pdzfilename modname)))
-        (tset package.watches modname {:modtime (reload.modtime modname)})))
+        (tset package.watches modname (watchmeta modname))))
         
     (fn reload.check []
       (each [modname watch (pairs package.watches)]
-        (let [newmodtime (reload.modtime modname)]
-          (when (not (reload.modtime= watch.modtime newmodtime))
-            (print (.. "Plugin reload: " modname))
-            (set watch.modtime newmodtime)
-            (reload.reload modname)))))
+        (when watch.modtime
+          (let [newmeta (watchmeta modname)]
+            (when (should-reload? watch newmeta)
+              (print (.. "Plugin reload: " modname))
+              (tset package.watches modname newmeta)
+              (reload.reload modname))))))
         
     (reload.watch :meta.proxy)
     (reload.watch :meta.iter)
     (reload.watch :meta.table)
-    
+
     (let [oldrequire _G.require]
       (fn _G.require [modname]
         (when (= nil (. package.loaded modname))
diff --git a/src/meta/table.fnl b/src/meta/table.fnl
index 81c423b..c203989 100644
--- a/src/meta/table.fnl
+++ b/src/meta/table.fnl
@@ -1,4 +1,4 @@
-(local {: ivalues} (require :meta.iter))
+(local {: ivalues : reverse-ipairs} (require :meta.iter))
 (local tbl {})
 
 ; Naming convention: Verb means mutation, noun / adjective means no mutation
@@ -45,6 +45,12 @@
         (icollect [_ v (ipairs t-concat) &into t] v))
     t)
 
+(fn tbl.remove-matching [t f]
+    (let [indexes (icollect [i v (ipairs t)] (when (f v i) i))]
+        (each [i _ (reverse-ipairs indexes)]
+            (table.remove t i)))
+    t)
+
 (fn tbl.extended [...]
     (tbl.extend {} ...))
 
diff --git a/src/state.fnl b/src/state.fnl
new file mode 100644
index 0000000..9e26dfe
--- /dev/null
+++ b/src/state.fnl
@@ -0,0 +1 @@
+{}
\ No newline at end of file
diff --git a/src/test.fnl b/src/test.fnl
deleted file mode 100644
index ddfc68c..0000000
--- a/src/test.fnl
+++ /dev/null
@@ -1 +0,0 @@
-{:x :suppery :z 3}
\ No newline at end of file