From c38c653ece3e7aa252371d367f7d0594d0cac6ff Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Fri, 27 Oct 2023 21:41:42 -0400 Subject: [PATCH] convert to cached sprite logic, scene --- Makefile | 6 +-- src/cache.fnl | 57 ++++++++++++++++++++++++ src/explosion.fnl | 103 +++++++++++++++++++++++++++++--------------- src/meta/reload.fnl | 5 ++- src/meta/table.fnl | 8 ++++ 5 files changed, 141 insertions(+), 38 deletions(-) create mode 100644 src/cache.fnl diff --git a/Makefile b/Makefile index 17695b7..1a39472 100644 --- a/Makefile +++ b/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 diff --git a/src/cache.fnl b/src/cache.fnl new file mode 100644 index 0000000..18a8c24 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/src/explosion.fnl b/src/explosion.fnl index 44c8dbd..f76046a 100644 --- a/src/explosion.fnl +++ b/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})) - -(fn hotload [] - (tbl.extend state - {:draw [:background :bomber :bombs :bucket] - :update [:bomber :bombs :bucket] - :cleanup [:bombs]})) + :level 1 + :state :waiting + :scene :ingame})) (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 [] - (table.insert state.bombs {:x state.bomber.x :y 30})) +(fn drop-bomb [ctx] + (table.insert ctx.bombs {:x ctx.bomber.x :y 30})) -(draw:defmethod :bomber (fn [_ {: x}] - (gfx.fillRoundRect (- x 10) 5 20 30 6))) +(let [image (make-image 20 30 #(gfx.fillRoundRect 0 0 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.drawLine 0 33 screenw 33))) +(gfx.sprite.setBackgroundDrawingCallback #(gfx.drawLine 0 33 screenw 33)) -(draw:defmethod :bombs (fn [_ {: x : y}] - (gfx.fillCircleAtPoint x y 7))) +(let [image (make-image 14 14 #(gfx.fillCircleAtPoint 7 7 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] - (set bomb.y (+ bomb.y 5)))) +(fn bombspeed [ctx] ctx.level) -(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) - (each [_ key (ipairs (or state.cleanup []))] - (cleanup key)) - - (gfx.clear) - (do-to-children state.draw draw) + (scene state.scene state) (gfx.sprite.update) (playdate.timer.updateTimers) - (reload.check)) + (when (reload.check) + (cache.purge))) diff --git a/src/meta/reload.fnl b/src/meta/reload.fnl index e193712..fc08573 100644 --- a/src/meta/reload.fnl +++ b/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) diff --git a/src/meta/table.fnl b/src/meta/table.fnl index c203989..16392ca 100644 --- a/src/meta/table.fnl +++ b/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 \ No newline at end of file