convert to cached sprite logic, scene
This commit is contained in:
parent
d097c53d20
commit
c38c653ece
6
Makefile
6
Makefile
|
@ -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
57
src/cache.fnl
Normal 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
|
|
@ -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}))
|
||||||
|
|
||||||
|
(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}]
|
(draw:defmethod :bomber (fn [_ {: x}]
|
||||||
(gfx.fillRoundRect (- x 10) 5 20 30 6)))
|
(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)))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
Loading…
Reference in a new issue