diff --git a/src/explosion.fnl b/src/explosion.fnl new file mode 100644 index 0000000..44c8dbd --- /dev/null +++ b/src/explosion.fnl @@ -0,0 +1,99 @@ +(local reload (require :meta.reload)) +(local {: defmulti} (require :meta.multimethod)) +(local tbl (require :meta.table)) +(local iter (require :meta.iter)) +(local state (require :state)) + +(local gfx playdate.graphics) + +(local draw (defmulti #$1)) +(local update (defmulti #$1)) +(local children (defmulti #$2)) +(local cleanup (defmulti #$1)) + +(draw:defmethod :default #nil) +(update:defmethod :default #nil) +(children:defmethod :default (fn [val] (iter.ivalues val))) + +(fn descend [t k] (children (. t k) k t)) + +(fn do-to-children [keys f ?t] + (each [_ key (ipairs keys)] + (each [id child (descend (or state ?t) key)] + (f key child id (or state ?t))))) + +(fn restart [] + (tbl.extend state + {:bomber {:x 200 :active false} + :bombs [] + :bucket {:x 200 :count 3} + :bombspeed 5})) + +(fn hotload [] + (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)] + (each [k v (descend t key)] + (coroutine.yield k v))))) + +(children:defmethod :bombs ipairs) + +(when (= state.bombspeed nil) + (restart)) +(hotload) + +(local screenw (playdate.display.getWidth)) +(local screenh (playdate.display.getHeight)) + +(update:defmethod :bucket (fn [_ bucket] + (let [crank (playdate.getCrankPosition) + ratio (if (> crank 180) (/ (- 360 crank) -130) (/ crank 130)) + clamped (if (< ratio -1) -1 + (> ratio 1) 1 + ratio) + x (* (/ (+ ratio 1) 2) screenw)] + (set bucket.x x)) +)) + +(let [bucketw 50 bucketh 10 radius 4 + xoffset (/ bucketw 2) + buckety 220] + (draw:defmethod :bucket (fn [_ {: x}] + (gfx.drawRoundRect (- x xoffset) buckety bucketw bucketh radius)))) + +(fn drop-bomb [] + (table.insert state.bombs {:x state.bomber.x :y 30})) + +(draw:defmethod :bomber (fn [_ {: x}] + (gfx.fillRoundRect (- x 10) 5 20 30 6))) + +(update:defmethod :bomber (fn [] + (when (playdate.buttonJustPressed :a) + (drop-bomb)))) + +(draw:defmethod :background (fn [] + (gfx.drawLine 0 33 screenw 33))) + +(draw:defmethod :bombs (fn [_ {: x : y}] + (gfx.fillCircleAtPoint x y 7))) + +(update:defmethod :bombs (fn [_ bomb ibomb s] + (set bomb.y (+ bomb.y 5)))) + +(cleanup:defmethod :bombs #(tbl.remove-matching state.bombs #(> $1.y screenh))) + +(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) + + (gfx.sprite.update) + (playdate.timer.updateTimers) + (reload.check)) diff --git a/src/main.fnl b/src/main.fnl index bbe93c2..f465dbb 100644 --- a/src/main.fnl +++ b/src/main.fnl @@ -4,18 +4,5 @@ (import :CoreLibs/timer) (import :package) -(local reload (require :meta.reload)) - -(local test (require :test)) -(local gfx playdate.graphics) - -(let [font (gfx.getSystemFont gfx.font.kVariantNormal)] - (fn _G.drawtext [text x y] (font:drawText text x y))) - -(fn playdate.update [] - (drawtext test.x 5 5) - (drawtext "Hello from Fennel!" 5 25) - (gfx.sprite.update) - (playdate.timer.updateTimers) - (reload.check) -) +(require :meta.reload) +(require :explosion) diff --git a/src/meta/multimethod.fnl b/src/meta/multimethod.fnl new file mode 100644 index 0000000..81d290a --- /dev/null +++ b/src/meta/multimethod.fnl @@ -0,0 +1,20 @@ +(local mm {}) + +; this indirection allows us to hook a single multimethod pre-dispatch +(set mm.__index mm) +(fn mm.__call [multi ...] (multi:call ...)) + +(fn mm.call [{: dispatcher : methods} ...] + (let [key (dispatcher ...) + method (or (. methods key) methods.default)] + (method ...))) + +(fn mm.defmulti [dispatcher] +"Creates a new multimethod that uses `dispatcher` to determine which method to call." + (setmetatable {: dispatcher :methods {}} mm)) + +(fn mm.defmethod [{: methods} key method] +"Defines the method for a given key." + (tset methods key method)) + +mm diff --git a/src/meta/reload.fnl b/src/meta/reload.fnl index e8ca669..e193712 100644 --- a/src/meta/reload.fnl +++ b/src/meta/reload.fnl @@ -39,10 +39,14 @@ (set package.watches {}) - (fn reload.modtime [modname] - (playdate.file.modtime (package.pdzfilename modname))) + (fn watchmeta [modname] + (let [filename (package.pdzfilename modname)] + (if (playdate.file.exists filename) + {:modtime (playdate.file.modtime filename) + :size (playdate.file.getSize filename)} + {}))) - (fn reload.modtime= [time1 time2] + (fn modtime= [time1 time2] (and (= time1.year time2.year) (= time1.month time2.month) (= time1.day time2.day) @@ -50,23 +54,29 @@ (= time1.minute time2.minute) (= time1.second time2.second))) + (fn should-reload? [watch1 watch2] + (and watch1.modtime watch2.modtime + (not= watch1.size watch2.size) + (not (modtime= watch1.modtime watch2.modtime)))) + (fn reload.watch [modname] (when (and (= nil (. package.watches modname)) (playdate.file.exists (package.pdzfilename modname))) - (tset package.watches modname {:modtime (reload.modtime modname)}))) + (tset package.watches modname (watchmeta modname)))) (fn reload.check [] (each [modname watch (pairs package.watches)] - (let [newmodtime (reload.modtime modname)] - (when (not (reload.modtime= watch.modtime newmodtime)) - (print (.. "Plugin reload: " modname)) - (set watch.modtime newmodtime) - (reload.reload modname))))) + (when watch.modtime + (let [newmeta (watchmeta modname)] + (when (should-reload? watch newmeta) + (print (.. "Plugin reload: " modname)) + (tset package.watches modname newmeta) + (reload.reload modname)))))) (reload.watch :meta.proxy) (reload.watch :meta.iter) (reload.watch :meta.table) - + (let [oldrequire _G.require] (fn _G.require [modname] (when (= nil (. package.loaded modname)) diff --git a/src/meta/table.fnl b/src/meta/table.fnl index 81c423b..c203989 100644 --- a/src/meta/table.fnl +++ b/src/meta/table.fnl @@ -1,4 +1,4 @@ -(local {: ivalues} (require :meta.iter)) +(local {: ivalues : reverse-ipairs} (require :meta.iter)) (local tbl {}) ; Naming convention: Verb means mutation, noun / adjective means no mutation @@ -45,6 +45,12 @@ (icollect [_ v (ipairs t-concat) &into t] v)) t) +(fn tbl.remove-matching [t f] + (let [indexes (icollect [i v (ipairs t)] (when (f v i) i))] + (each [i _ (reverse-ipairs indexes)] + (table.remove t i))) + t) + (fn tbl.extended [...] (tbl.extend {} ...)) diff --git a/src/state.fnl b/src/state.fnl new file mode 100644 index 0000000..9e26dfe --- /dev/null +++ b/src/state.fnl @@ -0,0 +1 @@ +{} \ No newline at end of file diff --git a/src/test.fnl b/src/test.fnl deleted file mode 100644 index ddfc68c..0000000 --- a/src/test.fnl +++ /dev/null @@ -1 +0,0 @@ -{:x :suppery :z 3} \ No newline at end of file