convert to cached sprite logic, scene

This commit is contained in:
Jeremy Penner 2023-10-27 21:41:42 -04:00
parent d097c53d20
commit c38c653ece
5 changed files with 141 additions and 38 deletions

View file

@ -1,6 +1,6 @@
# adapted from https://git.sr.ht/~nytpu/fennel-playdate-template/tree/master/item/Makefile # 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 PDXNAME = Explosionface
EXCLUDESOURCES = src/macros.fnl EXCLUDESOURCES = src/macros.fnl
@ -12,11 +12,11 @@ all: $(PDXNAME).pdx
source: $(OUTFILES) source: $(OUTFILES)
source/%.lua: src/%.fnl source/%.lua: src/%.fnl
mkdir -p $(shell dirname $@) mkdir -p $(dir $@)
fennel -c $< > $@ fennel -c $< > $@
source/%: src/% source/%: src/%
mkdir -p $(shell dirname $@) mkdir -p $(dir $@)
cp $< $@ cp $< $@
$(PDXNAME).pdx: source $(PDXNAME).pdx: source

57
src/cache.fnl Normal file
View file

@ -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

View file

@ -3,6 +3,7 @@
(local tbl (require :meta.table)) (local tbl (require :meta.table))
(local iter (require :meta.iter)) (local iter (require :meta.iter))
(local state (require :state)) (local state (require :state))
(local cache (require :cache))
(local gfx playdate.graphics) (local gfx playdate.graphics)
@ -10,10 +11,24 @@
(local update (defmulti #$1)) (local update (defmulti #$1))
(local children (defmulti #$2)) (local children (defmulti #$2))
(local cleanup (defmulti #$1)) (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) (draw:defmethod :default #nil)
(update:defmethod :default #nil) (update:defmethod :default #nil)
(children:defmethod :default (fn [val] (iter.ivalues val))) (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)) (fn descend [t k] (children (. t k) k t))
@ -24,16 +39,12 @@
(fn restart [] (fn restart []
(tbl.extend state (tbl.extend state
{:bomber {:x 200 :active false} {:bomber {:x 200}
:bombs [] :bombs []
:bucket {:x 200 :count 3} :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] (fn children-keylist [keys _ t]
(iter.coro-iter #(each [_ key (ipairs keys)] (iter.coro-iter #(each [_ key (ipairs keys)]
@ -42,9 +53,8 @@
(children:defmethod :bombs ipairs) (children:defmethod :bombs ipairs)
(when (= state.bombspeed nil) (when (= state.level nil)
(restart)) (restart))
(hotload)
(local screenw (playdate.display.getWidth)) (local screenw (playdate.display.getWidth))
(local screenh (playdate.display.getHeight)) (local screenh (playdate.display.getHeight))
@ -56,44 +66,69 @@
(> ratio 1) 1 (> ratio 1) 1
ratio) ratio)
x (* (/ (+ ratio 1) 2) screenw)] 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 (let [bucketw 50 bucketh 10 radius 4
xoffset (/ bucketw 2) 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}] (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) (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 [] (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) (gfx.sprite.update)
(playdate.timer.updateTimers) (playdate.timer.updateTimers)
(reload.check)) (when (reload.check)
(cache.purge)))

View file

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

View file

@ -60,4 +60,12 @@
(fn tbl.unpacked [packed ?i ?j] (fn tbl.unpacked [packed ?i ?j]
(table.unpack packed ?i (or ?j packed.n))) (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 tbl