building out the engine

This commit is contained in:
Jeremy Penner 2023-10-22 22:41:55 -04:00
parent c2860399fa
commit d097c53d20
7 changed files with 149 additions and 27 deletions

99
src/explosion.fnl Normal file
View file

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

View file

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

20
src/meta/multimethod.fnl Normal file
View file

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

View file

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

View file

@ -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 {} ...))

1
src/state.fnl Normal file
View file

@ -0,0 +1 @@
{}

View file

@ -1 +0,0 @@
{:x :suppery :z 3}