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
|
||||
|
||||
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
|
||||
|
|
|
|||
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 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)))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
Loading…
Reference in a new issue