convert to cached sprite logic, scene

Makefile

@@ -1,6 +1,6 @@
 # adapted from https://git.sr.ht/~nytpu/fennel-playdate-template/tree/master/item/Makefile
 
-rwildcard=$(foreach d,$(wildcard $(1:=/*)),$(call rwildcard,$d,$2) $(filter $(subst *,%,$2),$d))
+rwildcard=$(foreach d,$(wildcard $(1:=/*)),$(call rwildcard,$d,$2) $(shell for f in $(filter $(subst *,%,$2),$d); do [ -d "$$f" ] || printf "%s\n" "$$f"; done))
 
 PDXNAME = Explosionface
 EXCLUDESOURCES = src/macros.fnl
@@ -12,11 +12,11 @@ all: $(PDXNAME).pdx
 source: $(OUTFILES)
 
 source/%.lua: src/%.fnl
-	mkdir -p $(shell dirname $@)
+	mkdir -p $(dir $@)
 	fennel -c $< > $@
 
 source/%: src/%
-	mkdir -p $(shell dirname $@)
+	mkdir -p $(dir $@)
 	cp $< $@
 
 $(PDXNAME).pdx: source

src/cache.fnl

@@ -0,0 +1,57 @@
+;; Cache goals:
+;; - associate some data / objects with a particular token
+;; - create the object if it doesn't yet exist
+;; - ensure the objects are destroyed when the token is destroyed
+;; - token is defined by a type/id pair of simple values (if nil is passed, :singleton is used as the id)
+
+(local {: defmulti} (require :meta.multimethod))
+(local tbl (require :meta.table))
+
+(local cache {
+    :caches {}
+    :asset-lifecycles {}})
+
+(fn cache.register-asset [asset constructor destructor]
+    (let [initializer (defmulti #$2)]
+        (initializer:defmethod :default #nil)
+        (tset cache.asset-lifecycles asset {: constructor : destructor : initializer})))
+
+(fn cache.register-initializer [asset type initializer]
+    (: (. cache.asset-lifecycles asset :initializer) :defmethod type initializer))
+
+(fn cache.caches-for [type id ?ensure]
+    (if ?ensure (-> cache.caches (tbl.ensure type) (tbl.ensure id))
+                (?. cache.caches type id)))
+
+(fn cache.get [asset type ?id]
+    (let [id (or ?id :singleton)
+          caches (cache.caches-for type id true)
+          value (. caches asset)]
+        (if (not= value nil) value
+            (let [{: constructor : initializer} (. cache.asset-lifecycles asset)
+                  value (constructor)]
+                (initializer value type id)
+                (tset caches asset value)
+                value))))
+
+(fn cache.destroy [type ?id]
+    (if ?id
+        (let [caches (cache.caches-for type ?id)]
+            (when caches
+                (each [asset value (pairs caches)]
+                    (let [{: destructor} (. cache.asset-lifecycles asset)]
+                        (destructor value)))
+                (tset cache.caches type ?id nil)))
+        (let [?id-to-caches (. cache.caches type)]
+            (when ?id-to-caches
+                (each [id _ (pairs ?id-to-caches)]
+                    (cache.destroy type id))))))
+
+(fn cache.purge []
+    (each [type _ (pairs cache.caches)]
+        (cache.destroy type)))
+
+(import :CoreLibs/sprites)
+(cache.register-asset :sprite #(doto (playdate.graphics.sprite.new) (: :add)) #($1:remove))
+
+cache

src/explosion.fnl

@@ -3,6 +3,7 @@
 (local tbl (require :meta.table))
 (local iter (require :meta.iter))
 (local state (require :state))
+(local cache (require :cache))
 
 (local gfx playdate.graphics)
 
@@ -10,10 +11,24 @@
 (local update (defmulti #$1))
 (local children (defmulti #$2))
 (local cleanup (defmulti #$1))
+(local scene (defmulti #$1))
+
+(fn destroy-all [type ctx] (cache.destroy type) (tset ctx type nil))
+(fn destroy-key [type id ctx ?key] (cache.destroy type id) (tset (. ctx type) (or ?key id) nil))
+(fn get-id [?f-id key ctx type] (if ?f-id (?f-id key (. ctx type)) key))
+(fn destroy-keys [type ctx keys ?f-id]
+    (each [_ key (ipairs keys)]
+        (destroy-key type (get-id ?f-id key ctx type) ctx key)))
+(fn destroy-item [type id ctx ?index] (cache.destroy type id) (table.remove (. ctx type) (or ?index id)))
+(fn destroy-items [type ctx indexes ?f-id]
+    (each [_ index (ipairs (tbl.sorted indexes #(> $1 $2)))]
+        (destroy-item type (get-id ?f-id index ctx type) ctx index)))
 
 (draw:defmethod :default #nil)
 (update:defmethod :default #nil)
 (children:defmethod :default (fn [val] (iter.ivalues val)))
+(cleanup:defmethod :default #nil)
+(scene:defmethod :default #nil)
 
 (fn descend [t k] (children (. t k) k t))
 
@@ -24,16 +39,12 @@
 
 (fn restart []
     (tbl.extend state
-      {:bomber {:x 200 :active false}
+      {:bomber {:x 200}
        :bombs []
        :bucket {:x 200 :count 3}
-       :bombspeed 5}))
+       :level 1
-
+       :state :waiting
-(fn hotload []
+       :scene :ingame}))
-    (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)]
@@ -42,9 +53,8 @@
 
 (children:defmethod :bombs ipairs)
 
-(when (= state.bombspeed nil)
+(when (= state.level nil)
     (restart))
-(hotload)
 
 (local screenw (playdate.display.getWidth))
 (local screenh (playdate.display.getHeight))
@@ -56,44 +66,69 @@
                       (> ratio 1)   1
                       ratio)
           x (* (/ (+ ratio 1) 2) screenw)]
-        (set bucket.x x))
+        (set bucket.x x))))
-))
+
+(fn make-image [w h f]
+    (let [image (gfx.image.new w h)]
+        (gfx.pushContext image)
+        (f image w h)
+        (gfx.popContext)
+        image))
+
+(fn defsprite [type f] (cache.register-initializer :sprite type f))
+(fn sprite [type ?id] (cache.get :sprite type ?id))
 
 (let [bucketw 50 bucketh 10 radius 4
       xoffset (/ bucketw 2)
-      buckety 220]
+      buckety 220
+      image (make-image bucketw bucketh #(gfx.drawRoundRect 0 0 bucketw bucketh radius))]
+    (defsprite :bucket #(doto $1 (: :setImage image) (: :setCenter 0.5 0)))
     (draw:defmethod :bucket (fn [_ {: x}]
-        (gfx.drawRoundRect (- x xoffset) buckety bucketw bucketh radius))))
+        (doto (sprite :bucket) (: :moveTo x buckety)))))
 
-(fn drop-bomb []
+(fn drop-bomb [ctx]
-    (table.insert state.bombs {:x state.bomber.x :y 30}))
+    (table.insert ctx.bombs {:x ctx.bomber.x :y 30}))
 
-(draw:defmethod :bomber (fn [_ {: x}]
+(let [image (make-image 20 30 #(gfx.fillRoundRect 0 0 20 30 6))]
-    (gfx.fillRoundRect (- x 10) 5 20 30 6)))
+    (defsprite :bomber #(doto $1 (: :setImage image) (: :setCenter 0.5 0)))
+    (draw:defmethod :bomber (fn [_ {: x}]
+        (doto (sprite :bomber) (: :moveTo x 5)))))
 
-(update:defmethod :bomber (fn []
+(update:defmethod :bomber (fn [_ _ _ ctx]
     (when (playdate.buttonJustPressed :a)
-        (drop-bomb))))
+        (set ctx.state :bombing)
+        (drop-bomb ctx))))
 
-(draw:defmethod :background (fn []
+(gfx.sprite.setBackgroundDrawingCallback #(gfx.drawLine 0 33 screenw 33))
-    (gfx.drawLine 0 33 screenw 33)))
 
-(draw:defmethod :bombs (fn [_ {: x : y}]
+(let [image (make-image 14 14 #(gfx.fillCircleAtPoint 7 7 7))]
-    (gfx.fillCircleAtPoint x y 7)))
+    (defsprite :bombs #(doto $1 (: :setImage image) (: :setCenter 0.5 0.5)))
+    (draw:defmethod :bombs (fn [_ {: x : y &as bomb}]
+        (doto (sprite :bombs bomb) (: :moveTo x y)))))
 
-(update:defmethod :bombs (fn [_ bomb ibomb s]
+(fn bombspeed [ctx] ctx.level)
-    (set bomb.y (+ bomb.y 5))))
 
-(cleanup:defmethod :bombs #(tbl.remove-matching state.bombs #(> $1.y screenh)))
+(update:defmethod :bombs (fn [_ bomb ibomb ctx]
+    (when (= ctx.state :bombing)
+        (set bomb.y (+ bomb.y (bombspeed ctx)))
+        (when (> bomb.y screenh)
+            (set ctx.state :lost)))))
+
+(cleanup:defmethod :bombs (fn [_ ctx]
+    (destroy-items :bombs ctx (tbl.keys-matching ctx.bombs #(> $1.y screenh)) #$2)))
+
+(fn scene-update [keys ctx]
+    (do-to-children keys update ctx)
+    (each [_ key (ipairs keys)]
+        (cleanup key ctx))
+    (do-to-children keys draw ctx))
+
+(scene:defmethod :ingame #(scene-update [:bomber :bombs :bucket] $2))
 
 (fn playdate.update []
-    (do-to-children state.update update)
+    (scene state.scene state)
-    (each [_ key (ipairs (or state.cleanup []))]
-        (cleanup key))
-
-    (gfx.clear)
-    (do-to-children state.draw draw)
 
     (gfx.sprite.update)
     (playdate.timer.updateTimers)
-    (reload.check))
+    (when (reload.check)
+        (cache.purge)))

src/meta/reload.fnl

@@ -65,13 +65,16 @@
         (tset package.watches modname (watchmeta modname))))
         
     (fn reload.check []
+      (var reloaded false)
       (each [modname watch (pairs package.watches)]
         (when watch.modtime
           (let [newmeta (watchmeta modname)]
             (when (should-reload? watch newmeta)
+              (set reloaded true)
               (print (.. "Plugin reload: " modname))
               (tset package.watches modname newmeta)
-              (reload.reload modname))))))
+              (reload.reload modname)))))
+      reloaded)
         
     (reload.watch :meta.proxy)
     (reload.watch :meta.iter)

src/meta/table.fnl

@@ -60,4 +60,12 @@
 (fn tbl.unpacked [packed ?i ?j]
     (table.unpack packed ?i (or ?j packed.n)))
 
+(fn tbl.sorted [t ?fcomp]
+    (let [sorted (tbl.concatenated t)]
+        (table.sort sorted ?fcomp)
+        sorted))
+
+(fn tbl.keys-matching [t f] 
+    (icollect [k v (pairs t)] (when (f v k) k)))
+
 tbl