refactor vat module system, asset caching system

This commit is contained in:
Jeremy Penner 2025-03-30 01:11:19 -04:00
parent 8e5f1d5264
commit 527a555d9c
23 changed files with 194 additions and 101 deletions

BIN
assets/bomberman.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.3 KiB

View file

@ -160,11 +160,14 @@
(var row-h (or orig-h 0))
(fn [{: x : y : w : h : xpad : ypad &as form} overrides]
(when h (set row-h (math.max row-h h)))
(if (and (not= orig-w nil) (> (+ x (or w 0) xpad (or w 0)) (+ orig-x orig-w)))
(let [new-form (reform form (lume.merge (or overrides {}) {:x orig-x :y (+ y row-h (or ypad 0))}))]
(set row-h (or orig-h 0))
new-form)
(right-of form overrides))))
(if (= w nil) form
(and (not= orig-w nil) (> (+ x w xpad w) (+ orig-x orig-w)))
(let [new-form (reform form (lume.merge (or overrides {}) {:x orig-x :y (+ y row-h (or ypad 0))}))]
(set row-h (or orig-h 0))
new-form)
(right-of form overrides))))
;; widgets and widget helpers
(fn active? [view tag] (= view.imstate.active (make-tag tag)))

View file

@ -1,3 +1,5 @@
(local {: defmethod} (require :vat.safe.multimethod))
(local dim (require :game.dim))
(local {: drawtile} (require :game.draw.tilemap))

View file

@ -1,3 +1,5 @@
(local {: defmethod} (require :vat.safe.multimethod))
(local dim (require :game.dim))
(local {: draw} (require :game.draw.entity))

View file

@ -1,3 +1,5 @@
(local {: defmethod} (require :vat.safe.multimethod))
(local dim (require :game.dim))
(local {: draw} (require :game.draw.entity))

View file

@ -1,3 +1,4 @@
(local {: defmulti : defmethod} (require :vat.safe.multimethod))
(local entity {})
(set entity.draw (defmulti #(or $1.draw $1.entity)))

View file

@ -1,3 +1,5 @@
(local {: defmulti : defmethod} (require :vat.safe.multimethod))
(local dim (require :game.dim))
(local {: all-coordinates} (require :game.helpers))
(local {: tile-at-overlay} (require :game.tilemap))

View file

@ -1,3 +1,5 @@
(local {: defmethod} (require :vat.safe.multimethod))
(local dim (require :game.dim))
(local {: drawtile} (require :game.draw.tilemap))

View file

@ -1,3 +1,5 @@
(local {: defmethod} (require :vat.safe.multimethod))
(local dim (require :game.dim))
(local {: update} (require :game.entity))

View file

@ -1,3 +1,5 @@
(local {: defmethod} (require :vat.safe.multimethod))
(local dim (require :game.dim))
(local {: direct : draw : update} (require :game.entity))
(local {: edge : edge-crosses : vec*} (require :game.helpers))

View file

@ -1,3 +1,5 @@
(local {: defmethod} (require :vat.safe.multimethod))
(local dim (require :game.dim))
(local {: direct : update} (require :game.entity))
(local {: vec* : vec+ : edge : edge-crosses : held-directions : dirs-from-dir : vec-from-dirs}

View file

@ -1,3 +1,5 @@
(local {: defmulti : defmethod} (require :vat.safe.multimethod))
(local {: vec* : vec+ : dir-from-key} (require :game.helpers))
(local dim (require :game.dim))

View file

@ -2,7 +2,7 @@
(local {: basic-sandbox : det} (require :vat.env))
(local {: snapshot : inject} (require :vat.snapshot))
(local Timeline (require :vat.timeline))
(local multimethod (require :vat.lib.multimethod))
(local multimethod (require :vat.safe.multimethod))
(local {: gen-random-env} (require :vat.lib.random))
(local {: on-love-key-event : love-input : make-love-draw-env} (require :vat.lib.love))
(local {: deepmerge} (require :lib.util))
@ -24,19 +24,32 @@
: actions
:inspect (fn [form state val] (inspector.proxy form state val.env.state))})
(icollect [_ inspect (ipairs (f self inspector)) &into inspectors] inspect))))}}})
(module-vat:inject (deepmerge {} multimethod basic-sandbox))
(vat:inject (deepmerge {:state {} :package (snapshot module-vat.env.package)} (gen-random-env) love-input multimethod basic-sandbox))
(module-vat:inject basic-sandbox)
(module-vat:inject-module :vat.safe.multimethod) ;; todo: module-vat should override inject-module and auto-inject into module-vat
(vat:inject (deepmerge {:state {}} (gen-random-env) love-input basic-sandbox))
(vat:inject-module :vat.safe.multimethod)
vat))
(local draw-env (snapshot (deepmerge (make-love-draw-env true) basic-sandbox multimethod (gen-random-env))))
(local draw-vat
(doto (Vat.new :unlogged)
(: :install-components
{:love {:new #(let [(state cache) (make-love-draw-env true)] ($1:inject state) cache)
:hooks {:reload (fn [self]
(self.love:clear)
; we are probably OK to just :inject-module now?
(self:inject (game-vat:export-state-from-module :game.draw self.env)))
:call (fn [self module func ...] ((. self.env.package.loaded module func) ...))}}})
(: :inject (deepmerge (gen-random-env) basic-sandbox))
(: :inject-module :vat.safe.multimethod)))
(fn reload []
(game-vat:set-tick :game :tick)
(inject draw-env (game-vat:export-state-from-module :game.draw draw-env)))
(game-vat:reload)
(draw-vat:reload))
(reload)
(fn get-game-vat [] game-vat)
(fn get-draw-vat [] draw-vat)
(fn make-timeline [tick-count]
(let [vat (get-game-vat)
@ -57,8 +70,7 @@
(set love-input-injection nil))
(game-vat:tick))
(fn drawfunc [module func ...] ((. draw-env.package.loaded module func) ...))
(fn draw [] (drawfunc :game.draw :draw-game game-vat.env.state))
(fn draw [] (draw-vat:call :game.draw :draw-game game-vat.env.state))
{: tick : draw : reload : get-game-vat : make-timeline : drawfunc : love-event : restart}
{: tick : draw : reload : get-game-vat : make-timeline : love-event : restart}

View file

@ -96,11 +96,15 @@
(fn inspector.proxy [form state value ?opts]
(let [inspect (?. ?opts :inspector)
new-state (util.ensure state (or (?. ?opts :key) (inspector.name inspect) :proxy))]
key (or (?. ?opts :key) (inspector.name inspect) :proxy)
new-state (util.ensure state key)
prev-tag form.tag]
(set form.tag [key form.tag])
(if inspect
(do (set new-state.inspector inspect)
(inspector.inspect form new-state value))
(inspector.draw form new-state value))))
(inspector.draw form new-state value))
(set form.tag prev-tag)))
(fn inspector.make-proxy [inspect getter ?actions]
(let [old-actions (inspector.actions inspect)

View file

@ -1,5 +1,5 @@
(local {: x} (require :test.modules.x))
(local Timestamp (require :vat.lib.timestamp))
(local Timestamp (require :vat.safe.timestamp))
(var value 10)

View file

@ -57,6 +57,16 @@
:eval-func (fn [self func ...] (func (unpack (snapshot (table.pack ...)) 1 (select :# ...))))
:eval-lua (fn [self luacode ...] (self:eval-func (load luacode :eval :t self.env) ...))
:eval (fn [self code ...] (self:eval-lua (fennel.compile-string code {:env self.env}) ...))
:install-require
(fn [self]
(when (= self.env.package nil)
(let [state ((require :vat.lib.package))]
(when (= self.env.error nil) (set state.error (det error)))
(self:inject state))))
:inject-module
(fn [self ...]
(self:install-require)
(self:inject {:package {:loaded (collect [_ modname (ipairs [...])] (values modname (require modname)))}}))
:playback-entry
(fn [self entry]
(assert entry "Tried to replay empty event")
@ -135,10 +145,16 @@
:clone (fn [self vat opts] (set self.module-vat (or opts.module-vat vat.module-vat)))
:hooks {:export-state-from-module
(fn [self modulename ?envForGlobals]
(self.module-vat:install-require)
(let [state-vat (self.module-vat:new)
allowedGlobals (if ?envForGlobals (icollect [k _ (pairs ?envForGlobals)] k) nil)
luacode (fennel.compile-string (.. "(require " (fennel.view modulename) ")") {:env state-vat.env :requireAsInclude true : allowedGlobals})]
; (when (= state-vat.env.package.preload nil) (show :dead-include))
existing-packages (icollect [modname _ (pairs (or (?. (or ?envForGlobals self.env) :package :loaded) {}))] modname)
_ (icollect [modname _ (pairs (or (?. (or ?envForGlobals self.env) :package :preload) {})) &into existing-packages] modname)
luacode (fennel.compile-string (.. "(require " (fennel.view modulename) ")")
{:env state-vat.env
: allowedGlobals
:requireAsInclude true
:skipInclude existing-packages})]
(state-vat:eval-lua luacode)
(collect [k v (pairs state-vat.env)] (when (or (= k :package) (not (. self.module-vat.env k))) (values k v)))))
:include (fn [self modulename] (self:inject (self:export-state-from-module modulename self.env)))
@ -216,10 +232,7 @@
(tset self hook (. old-hooks hook)))
(unpack result 1 result.n)))
(set Vat.Components.module-vat.default
(doto (Vat.new [:listeners :log])
(: :inject {:error (det _G.error)})
(: :eval (: (io.open "vat/lib/package.fnl") :read :*a))))
(set Vat.Components.module-vat.default (Vat.new [:listeners :log]))
(fn Vat.__inspectors [self]
(self:inspectors (require :inspector)))

View file

@ -1,62 +1,71 @@
(local {: det : silent : map-env} (require :vat.env))
(local {: deepmerge} (require :lib.util))
(local AssetCache (require :vat.safe.asset))
(fn make-love-draw-env [unlogged?]
(let [drawfunc (if unlogged? det silent)]
(map-env
{:love
{:graphics
{:arc drawfunc
:circle drawfunc
:clear drawfunc
:discard drawfunc
:ellipse drawfunc
:line drawfunc
:points drawfunc
:polygon drawfunc
:print drawfunc
:printf drawfunc
:rectangle drawfunc
:stencil drawfunc
(let [drawfunc (if unlogged? det silent)
env (map-env
{:love
{:graphics
{:arc drawfunc
:circle drawfunc
:clear drawfunc
:discard drawfunc
:ellipse drawfunc
:line drawfunc
:points drawfunc
:polygon drawfunc
:print drawfunc
:printf drawfunc
:rectangle drawfunc
:stencil drawfunc
:getBackgroundColor drawfunc
:getBlendMode drawfunc
:getColor drawfunc
:getColorMask drawfunc
:getLineJoin drawfunc
:getLineStyle drawfunc
:getLineWidth drawfunc
:getPointSize drawfunc
:getStackDepth drawfunc
:reset drawfunc
:setBackgroundColor drawfunc
:setBlendMode drawfunc
:setColor drawfunc
:setColorMask drawfunc
:setLineJoin drawfunc
:setLineStyle drawfunc
:setLineWidth drawfunc
:setPointSize drawfunc
:getBackgroundColor drawfunc
:getBlendMode drawfunc
:getColor drawfunc
:getColorMask drawfunc
:getLineJoin drawfunc
:getLineStyle drawfunc
:getLineWidth drawfunc
:getPointSize drawfunc
:getStackDepth drawfunc
:reset drawfunc
:setBackgroundColor drawfunc
:setBlendMode drawfunc
:setColor drawfunc
:setColorMask drawfunc
:setLineJoin drawfunc
:setLineStyle drawfunc
:setLineWidth drawfunc
:setPointSize drawfunc
:applyTransform drawfunc
:inverseTransformPoint drawfunc
:origin drawfunc
:pop drawfunc
:push drawfunc
:replaceTransform drawfunc
:rotate drawfunc
:scale drawfunc
:shear drawfunc
:transformPoint drawfunc
:translate drawfunc
:applyTransform drawfunc
:inverseTransformPoint drawfunc
:origin drawfunc
:pop drawfunc
:push drawfunc
:replaceTransform drawfunc
:rotate drawfunc
:scale drawfunc
:shear drawfunc
:transformPoint drawfunc
:translate drawfunc
:getDPIScale drawfunc
:getDimensions drawfunc
:getHeight drawfunc
:getPixelDimensions drawfunc
:getPixelHeight drawfunc
:getWidth drawfunc}}}
_G)))
:getDPIScale drawfunc
:getDimensions drawfunc
:getHeight drawfunc
:getPixelDimensions drawfunc
:getPixelHeight drawfunc
:getWidth drawfunc
:newQuad det}}}
_G)
imagecache (AssetCache.new #(love.graphics.newImage $1))]
(set env.love.graphics.newImage (det (fn [filename] (when (= (type filename) :string) filename))))
(set env.love.graphics.draw (silent (fn [filename ...]
(when (= (type filename) :string)
(love.graphics.draw (imagecache:get filename) ...)))))
(values env imagecache)))
(local love-input {:keyboard {:keys {}} :mouse {:x 0 :y 0 :buttons {}}})
(fn love-input.keyboard.isDown [key]

View file

@ -1,19 +1,18 @@
(when (not _G.package) (set _G.package {}))
(when (not package.loaded) (set package.loaded {}))
(when (not package.preload) (set package.preload {}))
(fn gen-package-env []
(let [_G {:package {:loaded {} :preload {}}}]
(fn _G.require [modname]
(let [module (. package.loaded modname)
preloader (. package.preload modname)]
(if (not= module nil)
module
(fn _G.require [modname]
(let [module (. package.loaded modname)
preloader (. package.preload modname)]
(if (not= module nil)
module
(not= preloader nil)
(let [module (preloader modname)]
(tset package.loaded modname module)
(tset package.preload modname nil)
module)
(not= preloader nil)
(let [module (preloader modname)]
(tset package.loaded modname module)
(tset package.preload modname nil)
module)
(error (.. "Module " modname " not found")))))
_G))
(error (.. "Module " modname " not found")))))
require
gen-package-env

28
vat/safe/asset.fnl Normal file
View file

@ -0,0 +1,28 @@
(local {: new} (require :vat.safe.proto))
(local AssetCache {})
(fn AssetCache.new [fncreate]
(new AssetCache {: fncreate :assets {}}))
(fn lookup [cache key ...]
(case (. cache key)
(where val (> (select :# ...) 0)) (lookup val ...)
val val))
(fn put [cache val key ...]
(if (> (select :# ...) 0)
(case (. cache key)
next-cache (put next-cache val ...)
_ (let [next-cache {}]
(tset cache key next-cache)
(put next-cache val ...)))))
(fn AssetCache.get [self ...]
(case (lookup self.assets ...)
val val
_ (let [val (self.fncreate ...)]
(put self.assets val ...)
val)))
(fn AssetCache.clear [self] (set self.assets {}))
AssetCache

5
vat/safe/proto.fnl Normal file
View file

@ -0,0 +1,5 @@
(let [{: det} (require :vat.env)
smt (det setmetatable)
new (fn [base ?obj] (smt (or ?obj {}) {:__index base}))]
{: new})

View file

@ -72,24 +72,25 @@
(set Timeline.Snapshot
{:__inspectors
(fn [self]
(when (= Timeline.Snapshot.actions nil)
(let [{: textbutton} (require :editor.imgui)
movebtn (fn [label method]
(fn [form state value]
(when (textbutton form label)
(: value.timeline method value.tick)
true)))]
(set Timeline.Snapshot.actions
[(movebtn "Clear before" :move-start)
(movebtn "Clear after" :move-end)])))
(let [inspector (require :inspector)
inspectors []]
(icollect [_ inspect (ipairs (self.vat:__inspectors)) &into inspectors]
(inspector.make-proxy inspect #$1.vat Timeline.Snapshot.actions))
(icollect [key _ (pairs self.answers) &into inspectors]
{:label (.. :answer: key) :inspect (fn [form state val] (inspector.proxy form state (. val.answers key)))})
(table.insert inspectors {:label :answers :inspect (fn [form state val] (inspector.proxy form state val.answers))})
inspectors))})
(let [{: textbutton} (require :editor.imgui)
movebtn (fn [label method]
(fn [form state value]
(when (textbutton form label)
(: value.timeline method value.tick)
true)))]
(set Timeline.Snapshot.actions
[(movebtn "Clear before" :move-start)
(movebtn "Clear after" :move-end)]))
(fn Timeline.insert-snapshot [self isnap vat src-steplim tick]
(vat:install-components self.components)
(vat:reset-tweaks)