`,]']>Su?݁$k.A;]AsޔVl3S}Wup8d%qy)6o;]AsVl3?pqrstuvw|}~yz{YZLMNOHHHHHHhh\]^_HHHHHHhhlmnoHHHHHHhh|}~HHHHHHHHHHHHHHHHOHffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddXώccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddXϞddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttXOccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddccddddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddttddtt       ;97655544445677888 8 88888888888 vCО01257:<=>>>>>>>>>>>>>>>>>>>>>>-N^^mljWUC2!eT3"П@ @ E HJLMNNOOOOOOOOOOOOOOOOOOOOOs@@EH J L M N N OOOOOOOOOOOOOOOOOOOOOs  Duv  t`    Umffhffmffhffmffhffmffhff P0  `@  P0 `@ P   P EP `@F&Kd&F&|d&eF&Kd&F&|d&;eeee}F & &Kd& & F & F&&|d& F &e & &F&&Kd&&F&fFF|dFfFeFFF&&Kd&&F& F&&|d& F &e &FF&&Kd&&F&fFF|dFfFeFFF&&Kd&&F& F&&|d& F &e & &  0+H[h{  P &=F]m} ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` Dp`P@0 DDPPP@d@d@d@d D @oH@  F @F @@`f`D@`fmf`fP@  `fP@ F&P  hMV @ ava00 q0(Q(q(,0(Q(U)16:'>1B27>(h?""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" """""""""""""""""""""""""""""""""""""" """""pwwwwwwwwpwwwwwwwwpwwwpwwwpwwwwwwwwwpwwwwwwwwwwwpwwwwwwwwwwwwW4333333CuW4333333CuW43TW43TW43333333TW4333333CupE3CuW43TwpE3333333CupE33333333TpE33333333TpE33CupE33CupE33333333CupE33333333TW433TpE33CuW433333333Tp433333333Cup433333333Cp4333tp4333tp4333333333tp433333333CG333CW4333tG333333333Cp3333333333up3333333333p3333tp3333sp3333333333sp33333333337333CwE3333s73333333333p3333333333up3333333333p3333Tp3333sp3333333333sp33333333337333CW43333s73333333333p3333333333up3333333333p3333Cup3333sp3333333333sp33333333337333CG33333t73333333333p333CUU4333up333CUU4333p33333Tw3333sp3333334333sp333CUU43337333C43333Cu7333DDDDDDDp333SUU5333up333SUU5333p33333CU3333sp3333DD4333sp333SUU53337333333333T7333UUUUUUUp333sww7333up333sww7333p333333T3333sp3333UUG333sp333sww7333733333333Cu7333"""""""p333sww7333up333sww7333p33333333333sp3333wwGDDDtp333sww7333733333333S7333wwwwwwwp333sww7333up333sww7333p33333333333sp3333WUUUup333sww7333733333333t7333""""p3333333333up3333333333p3333C333333sp3333p"""p333333333373333333Cu7333wwww""""""""p3333333333up3333333333p3333S433333sp3333wwwp333333333373333333T7333333s""""""""p3333333333up3333333333p3333#E33333sp3333p333333333373333333T7333333s""""""""p333333333Cup333CDD4333p3333sR43333sp3333p333CDD433373333333Cu7333DDDt""""""""p333333333Tp333SUU5333p3333s'E3333sp3333wwwp333SUU5333733333333T7333UUUu""""""""p3333DDDDDup333#""2333p3333spR3333sp3333pE3Tp333#""2333733333333Cu7333"""r""""""""p333CUUUUUp333sww7333p3333s'3333sp3333W43Cup333sww73337333C33333T7333wwww""""""""p333swwwwwp333s7333p3333sp3333sp3333wwG333tp333s73337333S43333Cu7333""""""""p333sp333s7333p3333sp3333sp33333CG333sp333s73337333sE33333t7333wwwwwww""""""""p333sp333s7333p3333sp3333sp3333334333sp333s73337333sW43333s7333333333T""""""""p333sp333s7333p3333sp3333sp3333333333sp333s73337333spE3333s7333333333Cu""""""""p333sp333s7333p3333sp3333sp3333333333sp333s73337333sW4333s73333333333t""""""""p333sp333s7333p3333sp3333sp3333333333sp333s73337333spE333s73333333333s""""""""pDDDtpDDDtGDDDpDDDDtpDDDDtpDDD433CDDDtpDDDtGDDDGDDDtGDDDtGDDDDDDDDDDt""""""""pUUUupUUUuWUUUpUUUUupUUUUupUUUUUUUUUUupUUUuWUUUWUUUupUUUuWUUUUUUUUUUu""""""""p"""rp"""r'"""p""""rp""""rp""""""""""rp"""r'"""'"""r'""r'""""""""""r""""pwwwwpwwwwwwwwpwwwwwpwwwwwpwwwwwwwwwwwpwwwwwwwwwwwwwwwwwwwwwwwwwwwww           "" """" """" """" """" """""""""""""""""""""""""""""""""""""""" """" """"""""""""""""""""""""""""""""""""""  """"""""   """"""""  """"""""   """""""" """""""" """"""""""""""""""""""""""""""""""""""""""""""""""""̈ ̈̈""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""%;; title: Pancake Simulator ;; author: me@alectroemel.com ;; desc: flip pancakes at the perfect time for that wonderful golden color. ;; site: alectroemel.com ;; license: MIT License (change this to your license of choice) ;; version: 1.0 ;; script: fennel ;; strict: false ;; ls | entr -r tic80 --skip --fs . --cmd="load ld51.fnl & run" ;; tic80 --skip --cli --fs . --cmd="load ld51.fnl & import sprites ld51-sprites.png & save & exit" ;; the perfect pancake ;; cooked ten seconds on each side ;; so gold and fluffy ;; Use up all your batter to make as many wonderful pancakes as you can ;; - no time limit. Cook at your own pace ;; - make them as big or smalle as you like, or le multiple globs merge ;; together to make shapes! ;; - each side needs exactly 10 seconds for that perfect gold color. dont ;; let them burn or you'll need to trash 'em. ;; - Present your plate of flapjacks to world ;; DONE: pancake entity ;; - DONE: draw using 2 textured triangles ;; - DONE: drizzle batter on to griddle to start baking it ;; - DONE: cook side for 10 seconds. Should change color & ;; - DONE: flip pancake animation ;; - DONE: start smoking while burning ;; - DONE: outline for pancakes ;; - DONE: bubbles emitter ;; DONE: Pointer that can pick up and drop items ;; DONE: Batter ;; - DONE: artwork ;; - DONE: Logic to create pancake by clicking ;; - DONE: add batter count that depletes as you create pancakes ;; DONE: Spatula ;; - DONE: artwork ;; - DONE: spatula states [hovering, down, mid-flip]. ;; - DONE: have spatula go under pancake, flip it ;; - DONE: prevent going under pancake when hovering over it. Just look at tip of spatula ;; DONE: Tongs to move pancake ;; TODO: Table ;; - DONE: dynamic camera ;; - DONE: Griddle. limit pancake size to griddle edges ;; - DONE: Plate: place to put your finish pancackes ;; - TODO: Garbage: place to throw burnt pancakes away ;; TODO add shadow to objects ;; DONE: End game: when you place 3 pancakes, they are scored ;; TODO: title screen ;; TODO: music ;; https://lospec.com/palette-list/autumn-tree ;; Pallete ;; Borkfest ;; 202215dfd785ebc275f39949ff7831ca5a2e963c3c3a2802 ;; Spatula ;; 21351e224a2f668e8293bcba ;; Tiny ECS (global tiny (do (local tiny {}) (local tinsert table.insert) (local tremove table.remove) (local tsort table.sort) (local setmetatable setmetatable) (local type type) (local select select) (local tiny-manage-entities nil) (local tiny-manage-systems nil) (var tiny-add-entity nil) (var tiny-add-system nil) (var tiny-add nil) (var tiny-remove-entity nil) (var tiny-remove-system nil) (local filter-join nil) (local filter-build-string nil) (let [loadstring load] (fn getchr [c] (.. "\\" (c:byte))) (fn make-safe [text] (: (: (: "%q" :format text) :gsub "\n" :n) :gsub "[�-�]" getchr)) (fn filter-join-raw [prefix seperator ...] (let [accum {} build {}] (for [i 1 (select "#" ...) 1] (local item (select i ...)) (if (= (type item) :string) (tset accum (+ (length accum) 1) (: "(e[%s] ~= nil)" :format (make-safe item))) (= (type item) :function) (do (tset build (+ (length build) 1) (: "local subfilter_%d_ = select(%d, ...)" :format i i)) (tset accum (+ (length accum) 1) (: "(subfilter_%d_(system, e))" :format i))) (error "Filter token must be a string or a filter function."))) (local source (: "%s\nreturn function(system, e) return %s(%s) end" :format (table.concat build "\n") prefix (table.concat accum seperator))) (local (loader err) (loadstring source)) (when err (error err)) (loader ...))) (set-forcibly! filter-join (fn [...] (let [(state value) (pcall filter-join-raw ...)] (if state value (values nil value))))) (fn build-part [str] (let [accum {} sub-parts {}] (set-forcibly! str (str:gsub "%b()" (fn [p] (tset sub-parts (+ (length sub-parts) 1) (build-part (p:sub 2 (- 2)))) (: "�%d" :format (length sub-parts))))) (each [invert part sep (str:gmatch "(%!?)([^%|%&%!]+)([%|%&]?)")] (if (part:match "^�%d+$") (let [part-index (tonumber (part:match (part:sub 2)))] (tset accum (+ (length accum) 1) (: "%s(%s)" :format (or (and (= invert "") "") :not) (. sub-parts part-index)))) (tset accum (+ (length accum) 1) (: "(e[%s] %s nil)" :format (make-safe part) (or (and (= invert "") "~=") "==")))) (when (not= sep "") (tset accum (+ (length accum) 1) (or (and (= sep "|") " or ") " and ")))) (table.concat accum))) (set-forcibly! filter-build-string (fn [str] (let [source (: "return function(_, e) return %s end" :format (build-part str)) (loader err) (loadstring source)] (when err (error err)) (loader))))) (fn tiny.requireAll [...] (filter-join "" " and " ...)) (fn tiny.requireAny [...] (filter-join "" " or " ...)) (fn tiny.rejectAll [...] (filter-join :not " and " ...)) (fn tiny.rejectAny [...] (filter-join :not " or " ...)) (fn tiny.filter [pattern] (let [(state value) (pcall filter-build-string pattern)] (if state value (values nil value)))) (local system-table-key {1 :SYSTEM_TABLE_KEY}) (fn is-system [table] (. table system-table-key)) (fn processing-system-update [system dt] (let [pre-process system.preProcess process system.process post-process system.postProcess] (when pre-process (pre-process system dt)) (when process (if system.nocache (let [entities system.world.entities filter system.filter] (when filter (for [i 1 (length entities) 1] (local entity (. entities i)) (when (filter system entity) (process system entity dt))))) (let [entities system.entities] (for [i 1 (length entities) 1] (process system (. entities i) dt))))) (when post-process (post-process system dt)))) (fn sorted-system-on-modify [system] (let [entities system.entities indices system.indices] (var sort-delegate system.sortDelegate) (when (not sort-delegate) (local compare system.compare) (set sort-delegate (fn [e1 e2] (compare system e1 e2))) (set system.sortDelegate sort-delegate)) (tsort entities sort-delegate) (for [i 1 (length entities) 1] (tset indices (. entities i) i)))) (fn tiny.system [table] (set-forcibly! table (or table {})) (tset table system-table-key true) table) (fn tiny.processingSystem [table] (set-forcibly! table (or table {})) (tset table system-table-key true) (set table.update processing-system-update) table) (fn tiny.sortedSystem [table] (set-forcibly! table (or table {})) (tset table system-table-key true) (set table.onModify sorted-system-on-modify) table) (fn tiny.sortedProcessingSystem [table] (set-forcibly! table (or table {})) (tset table system-table-key true) (set table.update processing-system-update) (set table.onModify sorted-system-on-modify) table) (var world-meta-table nil) (fn tiny.world [...] (let [ret (setmetatable {:entitiesToRemove {} :entitiesToChange {} :systemsToAdd {} :systemsToRemove {} :entities {} :systems {}} world-meta-table)] (tiny-add ret ...) (tiny-manage-systems ret) (tiny-manage-entities ret) (values ret ...))) (fn tiny.addEntity [world entity] (let [e2c world.entitiesToChange] (tset e2c (+ (length e2c) 1) entity) entity)) (set tiny-add-entity tiny.addEntity) (fn tiny.addSystem [world system] (assert (= system.world nil) "System already belongs to a World.") (local s2a world.systemsToAdd) (tset s2a (+ (length s2a) 1) system) (set system.world world) system) (set tiny-add-system tiny.addSystem) (fn tiny.add [world ...] (for [i 1 (select "#" ...) 1] (local obj (select i ...)) (when obj (if (is-system obj) (tiny-add-system world obj) (tiny-add-entity world obj)))) ...) (set tiny-add tiny.add) (fn tiny.removeEntity [world entity] (let [e2r world.entitiesToRemove] (tset e2r (+ (length e2r) 1) entity) entity)) (set tiny-remove-entity tiny.removeEntity) (fn tiny.removeSystem [world system] (assert (= system.world world) "System does not belong to this World.") (local s2r world.systemsToRemove) (tset s2r (+ (length s2r) 1) system) system) (set tiny-remove-system tiny.removeSystem) (fn tiny.remove [world ...] (for [i 1 (select "#" ...) 1] (local obj (select i ...)) (when obj (if (is-system obj) (tiny-remove-system world obj) (tiny-remove-entity world obj)))) ...) (set-forcibly! tiny-manage-systems (fn [world] (let [(s2a s2r) (values world.systemsToAdd world.systemsToRemove)] (when (and (= (length s2a) 0) (= (length s2r) 0)) (lua "return ")) (set world.systemsToAdd {}) (set world.systemsToRemove {}) (local world-entity-list world.entities) (local systems world.systems) (for [i 1 (length s2r) 1] (local system (. s2r i)) (local index system.index) (local on-remove system.onRemove) (when (and on-remove (not system.nocache)) (local entity-list system.entities) (for [j 1 (length entity-list) 1] (on-remove system (. entity-list j)))) (tremove systems index) (for [j index (length systems) 1] (tset (. systems j) :index j)) (local on-remove-from-world system.onRemoveFromWorld) (when on-remove-from-world (on-remove-from-world system world)) (tset s2r i nil) (set system.world nil) (set system.entities nil) (set system.indices nil) (set system.index nil)) (for [i 1 (length s2a) 1] (local system (. s2a i)) (when (not= (. systems (or system.index 0)) system) (when (not system.nocache) (set system.entities {}) (set system.indices {})) (when (= system.active nil) (set system.active true)) (set system.modified true) (set system.world world) (local index (+ (length systems) 1)) (set system.index index) (tset systems index system) (local on-add-to-world system.onAddToWorld) (when on-add-to-world (on-add-to-world system world)) (when (not system.nocache) (local entity-list system.entities) (local entity-indices system.indices) (local on-add system.onAdd) (local filter system.filter) (when filter (for [j 1 (length world-entity-list) 1] (local entity (. world-entity-list j)) (when (filter system entity) (local entity-index (+ (length entity-list) 1)) (tset entity-list entity-index entity) (tset entity-indices entity entity-index) (when on-add (on-add system entity))))))) (tset s2a i nil))))) (set-forcibly! tiny-manage-entities (fn [world] (let [e2r world.entitiesToRemove e2c world.entitiesToChange] (when (and (= (length e2r) 0) (= (length e2c) 0)) (lua "return ")) (set world.entitiesToChange {}) (set world.entitiesToRemove {}) (local entities world.entities) (local systems world.systems) (for [i 1 (length e2c) 1] (local entity (. e2c i)) (when (not (. entities entity)) (local index (+ (length entities) 1)) (tset entities entity index) (tset entities index entity)) (for [j 1 (length systems) 1] (local system (. systems j)) (when (not system.nocache) (local ses system.entities) (local seis system.indices) (var index (. seis entity)) (local filter system.filter) (if (and filter (filter system entity)) (when (not index) (set system.modified true) (set index (+ (length ses) 1)) (tset ses index entity) (tset seis entity index) (local on-add system.onAdd) (when on-add (on-add system entity))) index (do (set system.modified true) (local tmp-entity (. ses (length ses))) (tset ses index tmp-entity) (tset seis tmp-entity index) (tset seis entity nil) (tset ses (length ses) nil) (local on-remove system.onRemove) (when on-remove (on-remove system entity)))))) (tset e2c i nil)) (for [i 1 (length e2r) 1] (local entity (. e2r i)) (tset e2r i nil) (local list-index (. entities entity)) (when list-index (local last-entity (. entities (length entities))) (tset entities last-entity list-index) (tset entities entity nil) (tset entities list-index last-entity) (tset entities (length entities) nil) (for [j 1 (length systems) 1] (local system (. systems j)) (when (not system.nocache) (local ses system.entities) (local seis system.indices) (local index (. seis entity)) (when index (set system.modified true) (local tmp-entity (. ses (length ses))) (tset ses index tmp-entity) (tset seis tmp-entity index) (tset seis entity nil) (tset ses (length ses) nil) (local on-remove system.onRemove) (when on-remove (on-remove system entity)))))))))) (fn tiny.refresh [world] (tiny-manage-systems world) (tiny-manage-entities world) (local systems world.systems) (for [i (length systems) 1 (- 1)] (local system (. systems i)) (when system.active (local on-modify system.onModify) (when (and on-modify system.modified) (on-modify system 0)) (set system.modified false)))) (fn tiny.update [world dt filter] (tiny-manage-systems world) (tiny-manage-entities world) (local systems world.systems) (for [i (length systems) 1 (- 1)] (local system (. systems i)) (when system.active (local on-modify system.onModify) (when (and on-modify system.modified) (on-modify system dt)) (local pre-wrap system.preWrap) (when (and pre-wrap (or (not filter) (filter world system))) (pre-wrap system dt)))) (for [i 1 (length systems) 1] (local system (. systems i)) (when (and (and (not= system nil) system.active) (or (not filter) (filter world system))) (local update system.update) (when update (local interval system.interval) (if interval (do (var buffered-time (+ (or system.bufferedTime 0) dt)) (while (>= buffered-time interval) (set buffered-time (- buffered-time interval)) (update system interval)) (set system.bufferedTime buffered-time)) (update system dt))) (set system.modified false))) (for [i 1 (length systems) 1] (local system (. systems i)) (local post-wrap system.postWrap) (when (and (and post-wrap system.active) (or (not filter) (filter world system))) (post-wrap system dt)))) (fn tiny.clearEntities [world] (let [el world.entities] (for [i 1 (length el) 1] (tiny-remove-entity world (. el i))))) (fn tiny.clearSystems [world] (let [systems world.systems] (for [i (length systems) 1 (- 1)] (tiny-remove-system world (. systems i))))) (fn tiny.getEntityCount [world] (length world.entities)) (fn tiny.getSystemCount [world] (length world.systems)) (fn tiny.setSystemIndex [world system index] (tiny-manage-systems world) (local old-index system.index) (local systems world.systems) (when (< index 0) (set-forcibly! index (+ (+ (tiny.getSystemCount world) 1) index))) (tremove systems old-index) (tinsert systems index system) (for [i old-index index (or (and (>= index old-index) 1) (- 1))] (tset (. systems i) :index i)) old-index) (fn tiny.entity [t] (let [cmpt {}] (set-forcibly! t (or t {})) (setmetatable t {:__index cmpt :__add (fn [self cmp] (assert cmp._cn) (tset self cmp._cn cmp) self) :__sub (fn [self cn] (tset self cn nil) self)}) t)) (fn tiny.component [cn t] (set-forcibly! t (or t {})) (set t._cn cn) t) (set world-meta-table {:__index {:add tiny.add :addEntity tiny.addEntity :addSystem tiny.addSystem :remove tiny.remove :removeEntity tiny.removeEntity :removeSystem tiny.removeSystem :refresh tiny.refresh :update tiny.update :clearEntities tiny.clearEntities :clearSystems tiny.clearSystems :getEntityCount tiny.getEntityCount :getSystemCount tiny.getSystemCount :setSystemIndex tiny.setSystemIndex :entity tiny.entity :component tiny.component} :__tostring (fn [] :)}) tiny)) (global ent tiny.entity) (global cmp tiny.component) (global filter tiny.filter) (global req-all tiny.requireAll) (global rej-all tiny.rejectAll) (global add-ent tiny.addEntity) (global rmv-ent tiny.removeEntity) (global add-sys tiny.addSystem) (global set-sys-index tiny.setSystemIndex) (global clear-systems tiny.clearSystems) (global clear-entities tiny.clearEntities) (global refresh tiny.refresh) (fn add-global-ent [world name ent] (tset world name (add-ent world ent)) ent) ;; system filters (global update-system-filter (req-all :updating-system)) (global draw-system-filter (req-all :drawing-system)) (global ui-system-filter (req-all :ui-system)) ;; System Macros (macro sys [name filter update] `(var ,name (tiny.system {:drawing-system false :filter ,filter :update ,update}))) (macro draw-sys [name filter update] `(var ,name (tiny.system {:drawing-system true :filter ,filter :update ,update}))) (macro proc-sys [name filter process] `(var ,name (tiny.processingSystem {:updating-system true :filter ,filter :process ,process}))) (macro sorted-proc-sys [name filter process compare] `(var ,name (tiny.sortedProcessingSystem {:updating-system true :filter ,filter :process ,process :compare ,compare}))) (macro draw-proc-sys [name filter process ...] `(var ,name (tiny.processingSystem {:drawing-system true :filter ,filter :process ,process}))) (macro sorted-draw-proc-sys [name filter process compare] `(var ,name (tiny.sortedProcessingSystem {:drawing-system true :filter ,filter :process ,process :compare ,compare}))) (macro ui-proc-sys [name filter process ...] `(var ,name (tiny.processingSystem {:ui-system true :filter ,filter :process ,process}))) ;;Game State Manager (global STATE {:current nil :goto-name nil :goto-state nil :transition-tick -1 :transition-size -1 }) (fn state-add [name init tic ovr teardown] (tset STATE name {: init : tic : ovr : teardown})) (fn state-start [name state] (set STATE.current name) (: (. STATE name) :init state)) (fn state-goto [name] (set STATE.goto-name name) (set STATE.goto-state (. STATE name)) (set STATE.transition-tick 0)) (fn state-tic [dt] (: (. STATE STATE.current) :tic dt) (when (and (> STATE.transition-tick -1) (< STATE.transition-tick 15)) (set STATE.transition-tick (+ STATE.transition-tick 1))) (if (> STATE.transition-tick -1) (set STATE.transition-size (+ STATE.transition-size 1)) (if (> STATE.transition-size -1) (set STATE.transition-size (- STATE.transition-size 1)))) (circ 120 68 (* 10 STATE.transition-size) 3) (when (and (= STATE.transition-tick 15) (not= STATE.goto-name nil)) (set STATE.transition-tick -1) (: (. STATE STATE.current) :teardown) (set STATE.current STATE.goto-name) (set STATE.goto-name nil) (: (. STATE STATE.current) :init STATE.goto-state) (set STATE.goto-state nil))) (fn state-ovr [dt] (: (. STATE STATE.current) :ovr dt)) ;; ;; +--------------------+ ;; | fennel Lume, Flume | ;; +--------------------+ ;; Math (global abs math.abs) (global rnd math.random) (global rnd-seed math.randosmeed) (global min math.min) (global max math.max) (global sin math.sin) (global cos math.cos) (global flr math.floor) (global ceil math.ceil) (global sqrt math.sqrt) ;; String (global sub string.sub) (global srt table.sort) ;; Table (global rmv table.remove) (global add table.insert) (global sort table.sort) (macro += [ind val] `(set ,ind (+ ,ind ,val))) (macro -= [ind val] `(set ,ind (- ,ind ,val))) (fn random-choice [t] (. t (rnd (# t)))) (fn random [a b] (when (not a) (set-forcibly! (a b) (values 0 1))) (when (not b) (set-forcibly! b 0)) (+ a (* (rnd) (- b a)))) (fn filter [pred ind] (icollect [_ v (ipairs ind)] (when (pred v) v))) (fn any? [pred ind] (> (# (filter pred ind)) 0)) (fn in? [val ind] (any? #(= $ val) ind)) (fn find-where [pred ind] (. (filter pred ind) 1)) (fn lerp [a b t] (+ (* (- 1 t) a) (* t b))) (fn round [val increment] (if increment (* (round (/ val increment)) increment) (if (>= val 0) (flr (+ val 0.5)) (ceil (- val 0.5))))) (fn map-scales [a-min a-max b-min b-max val] "Map value from number scale a -> b" (+ b-min (* (- b-max b-min) (/ (- val a-min) (- a-max a-min))))) (fn shuffle [tbl] "Shuffle order of indexed table (ie array)" (let [(len random) (values (length tbl) math.random)] (for [i len 2 (- 1)] (local j (random 1 i)) (local temp (. tbl i)) (tset tbl i (. tbl j)) (tset tbl j temp)) tbl)) (fn distance [x1 y1 x2 y2 squared?] (let [dx (- x1 x2) dy (- y1 y2) s (+ (* dx dx) (* dy dy))] (or (and squared? s) (sqrt s)))) ;; Position & other basic physics (fn pos [x y z? locked?] (cmp :pos {: x : y :z (or z? 0) :locked (or locked? false)})) (fn des-pos [x y speed] (cmp :des-pos {: x : y : speed})) (fn vel [x y mx my] (cmp :vel {: x : y : mx : my})) (fn fric [f] (cmp :fric {: f})) (fn bounds [min-x min-y max-x max-y] (cmp :bounds {: min-x : min-y : max-x : max-y})) (fn spring [a b len stiffness] (cmp :spring {: a : b : len : stiffness})) (proc-sys des-pos-tic (req-all :pos :des-pos) (fn [_ {: pos : des-pos} dt] (tset pos :x (round (lerp pos.x des-pos.x des-pos.speed) 0.1)) (tset pos :y (round (lerp pos.y des-pos.y des-pos.speed) 0.1)))) (proc-sys friction-tic (req-all :fric :vel) (fn [_ {: vel : fric} dt] (set vel.x (* vel.x fric.f)) (set vel.y (* vel.y fric.f)))) (proc-sys bounds-tic (req-all :bounds :pos :vel) (fn [_ {: bounds : pos : vel} dt] (let [{: min-x : min-y : max-x : max-y} bounds {: x : y} pos] (when (and (< pos.x min-x) (< vel.x 0)) (tset vel :x (* vel.x -0.98))) (when (and (>= pos.x max-x) (> vel.x 0)) (tset vel :x (* vel.x -0.98))) (when (and (< pos.y min-y) (< vel.y 0)) (tset vel :y (* vel.y -0.98))) (when (and (>= pos.y max-y) (> vel.y 0)) (tset vel :y (* vel.y -0.98)))))) (proc-sys velocity-tic (req-all :pos :vel) (fn [_ {: pos : vel} dt] (set vel.x (max (min vel.x vel.mx) (- vel.mx))) (set vel.y (max (min vel.y vel.my) (- vel.my))) (set pos.x (+ pos.x vel.x)) (set pos.y (+ pos.y vel.y)))) (proc-sys verlet-tic (req-all :spring) (fn [_ {: spring} dt] (let [{: a : b : len : stiffness} spring {:pos apos} a {:pos bpos} b dx (- bpos.x apos.x) dy (- bpos.y apos.y) d2 (sqrt (+ (* dx dx) (* dy dy))) d3 (/ (- d2 len) d2) d3 (if (~= d3 d3) 0 d3)] (when (not apos.locked) (tset apos :x (+ apos.x (* 0.5 dx d3 stiffness))) (tset apos :y (+ apos.y (* 0.5 dy d3 stiffness)))) (when (not bpos.locked) (tset bpos :x (- bpos.x (* 0.5 dx d3 stiffness))) (tset bpos :y (- bpos.y (* 0.5 dy d3 stiffness))))))) ;; # Animation (fn anim [current states ?paused ?hidden] (cmp :anim {:tick 0 :frame 0 :paused (or ?paused false) :hidden (or ?hidden false) : current : states})) (proc-sys anim-tic (req-all :anim :pos) (fn [_ e dt] (let [{: anim : pos} e {: x : y} pos {: frames : speed} (. anim.states anim.current)] (when (not anim.paused) (tset anim :tick (% (+ anim.tick 1) speed)) (when (= anim.tick 0) (tset anim :frame (% (+ anim.frame 1) (# frames)))) (when (> anim.frame (# frames)) (tset anim :frame 0)))))) (draw-proc-sys anim-draw (req-all :anim :pos) (fn [self {: pos : anim} dt] (let [{: world} self {: x : y} pos current-state (. anim.states anim.current) {: frames : speed} current-state width (or (. current-state :width) 1) height (or (. current-state :height) 1) colorkey (or (. current-state :colorkey) 0) scale (or (. current-state :scale) 1) frame (. frames (+ anim.frame 1)) offset (or (. current-state :offset) {:x 0 :y 0}) ] (when (not anim.hidden) (let [x (if (not= nil CAMERA) (CAMERA:relx x) x) y (if (not= nil CAMERA) (CAMERA:rely y) y) y (- y pos.z) x (+ x offset.x) y (+ y offset.y)] (match frame [s flip rotate] (spr s x y colorkey scale flip rotate width height) [s flip] (spr s x y colorkey scale flip 0 width height) s (spr s x y colorkey scale 0 0 width height))))))) ;; # Timers (fn create-timer [wld t i cb fin] (add-ent wld (+ (ent) (cmp :timer {:c 0 ; internal counter : t ; times to run : i ; interval : cb ; interval callback : fin})))) ; finished cb (proc-sys timer-tic (req-all :timer) (fn [{: world} e dt] (tset e.timer :c (+ e.timer.c 1)) (when (= e.timer.c e.timer.i) (: e.timer :cb) (tset e.timer :t (- e.timer.t 1)) (tset e.timer :c 0)) (when (= e.timer.t 0) (when e.timer.fin (: e.timer :fin)) (rmv-ent world e)))) ;; # Screen Shake (fn shake-it [wld d p] (add-ent wld (+ (ent) (cmp :shaker {: d : p})))) (proc-sys shaker-tic (req-all :shaker) (fn [{: world} e dt] (let [{: d : p} e.shaker] ;; time to shake (when (> d 0) (vbank 0) (poke 0x3FF9 (rnd (- p) p)) (poke 0x3FFA (rnd (- p) p)) (vbank 1) (poke 0x3FF9 (rnd (- p) p)) (poke 0x3FFA (rnd (- p) p)) (vbank 0) (tset e.shaker :d (- d 1))) ;; shake all done (when (= d 0) (vbank 0) (memset 0x3FF9 0 2) (vbank 1) (memset 0x3FF9 0 2) (vbank 0) (rmv-ent world e))))) ;; Freeze frame (global FREEZE_FRAME {:active false :duration 0}) (fn freeze-it [duration] (tset FREEZE_FRAME :duration duration) (tset FREEZE_FRAME :active true)) (fn freeze-frame-update [] (when FREEZE_FRAME.active (if (> FREEZE_FRAME.duration 0) (-= FREEZE_FRAME.duration 1) (tset FREEZE_FRAME :active false)))) ;; Camera (global CAMERA {:x 0 :y 0 :follow nil :update (fn [self dt] (when (not= self.follow nil) (let [fx (- 120 self.follow.pos.x) fy (- 64 self.follow.pos.y) dist (or (distance self.x self.y fx fy) 0) ] (when (> dist 4) (set self.x (lerp self.x fx 0.05)) (set self.y (lerp self.y fy 0.05)) )) )) :relx (fn [self x] (+ self.x x)) :rely (fn [self y] (+ self.y y)) :realx (fn [self x] (- x self.x)) :realy (fn [self y] (- y self.y)) :in-view (fn [self x y] (let [rx (self:relx x) ry (self:rely y)] (and (> rx 0) (< rx 240) (> ry 0) (< ry 128)))) }) ;; Color Swapping (fn apply-theme [theme] (each [i [from to] (ipairs theme)] (poke4 (+ (* 0x3FF0 2) from) to))) (fn remove-theme [theme] (each [i [from to] (ipairs theme)] (poke4 (+ (* 0x3FF0 2) from) from))) (fn copy-paste-map [x y x2 y2 w h flip-h ignore?] (var ignore? (or ignore? [])) (for [i 0 (- w 1)] (for [j 0 (- h 1)] (let [sid (mget (+ x i) (+ y j)) mx (if flip-h (- (+ x2 w -1) i) (+ x2 i)) my (+ y2 j) current-sid (mget mx my)] (when (and (not= 0 sid) (not (in? current-sid ignore?))) (mset mx my sid)))))) (var DEBUG false) (fn dtrace [s] (when DEBUG (trace s))) ;; Main Game logic ;; constants & globals (var FLIP_TIME 30) ;; 1 second (var GRIDDLE_SIZE {:w 30 :h 16}) (var GRIDDLE_POS {:x 50 :y 50}) (var GRIDDLE_WORKSPACE {:x 64 :y 54 :w (* 27 8) :h (* 14 8)}) (var GAME_END false) (var FINAL_SCORE 0) (fn vec-mult [va vb] [(* (. va 1) (. vb 1)) (* (. va 2) (. vb 2))]) (fn within-grab-box [pos pos2 grab-box] (let [{: x : y} pos {:x x2 :y y2} pos2 {: x-offset : y-offset : w : h} grab-box] (and (>= x (+ x2 x-offset)) (< x (+ x2 x-offset w)) (>= y (+ y2 y-offset)) (< y (+ y2 y-offset h))))) ;; Components (fn pancake [size] (cmp :pancake {:state :pouring :size size :side :bottom :cook {:bottom 0 :middle 0 :top 0} :spread-rates [[(random 0 0.5) (random 0 0.5)] [(random 0 0.5) (random 0 0.5)] [(random 0 0.5) (random 0 0.5)] [(random 0 0.5) (random 0 0.5)]] :spread [[0 0] [0 0] [0 0] [0 0]] :flip-t 0 :flipped false :z 0 :smoking false :bubbling false :bubble-spring nil })) (fn grab-box [x-offset y-offset w h] (cmp :grab-box {: x-offset : y-offset : w : h})) (fn batter [] (cmp :batter {:pouring-pancake nil :open false :fill 500 :max-fill 500})) (fn spatula [] (cmp :spatula {:down false})) (fn tong [] (cmp :tong {:down false :grabbing nil})) (fn pointer [items] (cmp :pointer {:spring nil :clicked false :clicking false :released false :items items})) (fn follow-point [] (cmp :follow-point {})) (fn plate [r] (cmp :plate {:pancakes [] :radius r :game-end false :game-end-tic 0 })) (fn percent-error [actual ideal] (- 100 (round (* (abs (/ (- actual ideal) ideal)) 100) 0.1))) (fn score [pancake] (let [bottom (percent-error pancake.cook.bottom 600) middle (percent-error pancake.cook.middle 500) top (percent-error pancake.cook.middle 600) size (percent-error pancake.size 25) average (round (+ (* 0.25 bottom) (* 0.25 middle) (* 0.25 top) (* 0.25 size)) 0.1)] (cmp :score {: bottom : middle : top : size : average}))) (fn particle [lifespan speed size col border] (cmp :particle {:t 0 : lifespan : speed : size : col : border})) (fn particle-emitter [radius rate speed-min speed-max size-min size-max colors border ] (cmp :particle-emitter {: radius : rate : speed-min : speed-max : size-min : size-max : colors : border :t 0})) ;; Systems (proc-sys update-particle (req-all :pos :particle) (fn [{: world} ent] (let [{: pos : particle} ent] (tset particle :t (+ 1 particle.t)) (if (< particle.t particle.lifespan) (tset pos :y (- pos.y particle.speed)) (>= particle.t particle.lifespan) (rmv-ent world ent))))) (draw-proc-sys draw-particle (req-all :pos :particle) (fn [_ {: pos : particle}] (if particle.border (circb (CAMERA:relx pos.x) (CAMERA:rely pos.y) particle.size particle.col) (circ (CAMERA:relx pos.x) (CAMERA:rely pos.y) particle.size particle.col)))) (proc-sys update-particle-emitter (req-all :pos :particle-emitter) (fn [{: world} {:pos epos :particle-emitter pe}] (if (< pe.t pe.rate) (tset pe :t (+ 1 pe.t)) (>= pe.t pe.rate) (let [r (* pe.radius (sqrt (rnd))) theta (* (rnd) 2 math.pi) x (+ epos.x (* r (cos theta))) y (+ epos.y (* r (sin theta))) speed (random pe.speed-min pe.speed-max) size (random pe.size-min pe.size-max) col (random-choice pe.colors)] (add-ent world (+ (ent) (pos x y) (particle 60 speed size col pe.border))) (tset pe :t 0))))) (proc-sys update-pancake (req-all :pos :pancake) (fn [{: world} pan-ent] (let [{: pos :pancake pcake} pan-ent] (when (= pcake.state :cooking) (each [i [srx sry] (ipairs pcake.spread-rates)] ;; apply spread rate (let [[sx sy] (. pcake.spread i)] (tset pcake.spread i [(+ sx srx) (+ sy sry)])) ;; descrease spread rate (tset pcake.spread-rates i [(* srx 0.90) (* sry 0.9)])) (tset pcake.cook :bottom (-> (. pcake.cook :bottom) (+ 1))) (tset pcake.cook :middle (-> (. pcake.cook :middle) (+ 0.4))) (tset pcake.cook :top (-> (. pcake.cook :top) (+ 0.1)))) (when (= pcake.state :flipping) ;; the left and right sides of pancake move in towards ;; pos.x then back out follwing a sin wave. ;; At the inflection point, flip top & bottom cook sides (tset pcake :flip-t (+ pcake.flip-t 1)) (tset pcake :z (* -25 (sin (map-scales 0 FLIP_TIME 0 (* 1 math.pi) pcake.flip-t))))) (when (and (not pcake.bubbling) (= pcake.state :cooking)) (let [rate 40 emitter-ent (create-bubble-emitter world pos.x pos.y pcake.size rate) spring-ent (add-ent world (+ (ent) (spring pan-ent emitter-ent 0 0.8))) ] (tset pcake :bubble-spring spring-ent) (tset pcake :bubbling true))) (when (and pcake.bubbling (> pcake.cook.top (* 4 60))) (tset pcake :bubbling false) (rmv-ent world pcake.bubble-spring.spring.b) (rmv-ent world pcake.bubble-spring)) ;; add smoke when you cooked it too long. (when (and (not pcake.smoking) (or (> pcake.cook.bottom (* 18 60)) (> pcake.cook.middle (* 18 60)) (> pcake.cook.top (* 18 60)))) (tset pcake :smoking true) (let [rate 4 emitter-ent (create-smoke-emitter world pos.x pos.y pcake.size rate)] (add-ent world (+ (ent) (spring pan-ent emitter-ent 0 0.8)))))) )) (fn pancake-tri [pos pcake expand uv-box] ;; draw 2 textured triangles using 4 coords to build ;; out plane with a full texture (let [ry pcake.size rx (if (= pcake.state :flipping) (* ry (cos (map-scales 0 FLIP_TIME 0 (* 3 math.pi) pcake.flip-t))) ry) rx (if pcake.flipped (* rx -1) rx) z pcake.z [s1x s1y] (. pcake.spread 1) [s2x s2y] (. pcake.spread 2) [s3x s3y] (. pcake.spread 3) [s4x s4y] (. pcake.spread 4) x1 (CAMERA:relx (- pos.x rx (* expand s1x))) y1 (CAMERA:rely (+ z (- pos.y ry (* expand s1y)))) x2 (CAMERA:relx (+ pos.x rx (* expand s2x))) y2 (CAMERA:rely (+ z (- pos.y ry (* expand s2y)))) x3 (CAMERA:relx (- pos.x rx (* expand s3x))) y3 (CAMERA:rely (+ z (+ pos.y ry (* expand s3y)))) x4 (CAMERA:relx (+ pos.x rx (* expand s4x))) y4 (CAMERA:rely (+ z (+ pos.y ry (* expand s4y)))) [ux uy uw uh] uv-box u1 ux v1 uy u2 (+ ux uw) v2 uy u3 ux v3 (+ uy uh) u4 (+ ux uw) v4 (+ uy uh)] (ttri x1 y1 x2 y2 x3 y3 u1 v1 u2 v2 u3 v3 true 0) (ttri x2 y2 x3 y3 x4 y4 u2 v2 u3 v3 u4 v4 true 0) (when DEBUG (pix x1 y1 14) (pix x2 y2 14) (pix x3 y3 14) (pix x4 y4 14) (circb pos.x pos.y r 14)))) (fn pancake-draw-layer [pos pcake expand layer] (let [cook-ammount (. pcake.cook layer) theme (if (> cook-ammount (* 15 60)) [[3 7]] ; way over (> cook-ammount (* 10.75 60)) [[3 6]] ; slightly over (>= cook-ammount (* 9.25 60)) [[3 5]] ; perfect (> cook-ammount (* 4 60)) [[3 4]] ; almost [])] ; default raw (apply-theme theme) (pancake-tri pos pcake expand [0 0 32 32] ) (remove-theme theme))) (draw-proc-sys draw-pancake-layer-bottom (req-all :pos :pancake) (fn [{: world} {: pos :pancake pcake}] (pancake-draw-layer pos pcake 1.8 :bottom) (pancake-draw-layer pos pcake 1 :middle) (pancake-draw-layer pos pcake 0.6 :top) ;; (print pcake.size 1 1 0) )) ;; (draw-proc-sys ;; draw-pancake-layer-middle ;; (req-all :pos :pancake) ;; (fn [{: world} {: pos :pancake pcake}] ;; (pancake-draw-layer pos pcake 1 :middle))) ;; (draw-proc-sys ;; draw-pancake-layer-top ;; (req-all :pos :pancake) ;; (fn [{: world} {: pos :pancake pcake}] ;; (pancake-draw-layer pos pcake 0.6 :top))) ;; pointer systems (proc-sys update-pointer (req-all :pointer :pos) (fn [{: world} ent dr] (let [{: pointer : pos} ent (x y left middle right) (mouse)] ;; keep track of location (tset pos :x (- (CAMERA:realx x) 0)) (tset pos :y (- (CAMERA:realy y) 0)) ;; clicked if pressing left and was not clicking last frame (when (and left (not pointer.clicking)) (tset pointer :clicked true) (when (ent:holding) (dtrace "pointer: click start action") (sfx 19) (: (ent:holding-ent) :action-start world))) ;; Released if not pressing left, but was last tic (tset pointer :released (and (not left) pointer.clicking)) (when (and pointer.released (ent:holding)) (dtrace "pointer: released stop action") (sfx 19) (: (ent:holding-ent) :action-stop world)) ;; clicking if pressing left (tset pointer :clicking left) (when (and pointer.clicking (ent:holding)) (dtrace "pointer: tic action") (: (ent:holding-ent) :action-tic world)) (when (and right (ent:holding)) (ent:drop world)) (when (and left (not= nil (ent:hovering-over))) (dtrace "pointer: pickup") (dtrace (ent:hovering-over)) (ent:pickup world (ent:hovering-over))) ))) ;; plate (draw-proc-sys draw-plate (req-all :pos :plate) (fn [{: world} ent] (let [{: pos :plate plate} ent r plate.radius x (CAMERA:relx pos.x) y (CAMERA:rely pos.y)] (circ x (+ y 6) (- r 3) 01) (circ x y (+ r 2) 0) (circ x y r 10) (circ x y (- r 2) 12) (circb x y (- r 4) 10) (circb x y (- r 4.5) 10) (circb x y (- r 5) 10) (circ x y (- r 20) 10)))) (draw-proc-sys draw-plate-end-game-bars (req-all :pos :plate) (fn [{: world} ent] (let [{: pos :plate plate} ent] (when plate.game-end (rect 0 0 240 plate.game-end-tic 0) (rect 0 (- 137 plate.game-end-tic) 240 30 0)) (tset plate :game-end-tic (lerp plate.game-end-tic 20 0.1))))) ;; Spatula (draw-proc-sys draw-spatula-down (req-all :pos :spatula) (fn [{: world} ent] (let [{: pos :spatula spat} ent] (when spat.down (map 33 0 3 4 (CAMERA:relx (- pos.x 8)) (CAMERA:rely (- pos.y 54)) 10))))) (draw-proc-sys draw-spatula-up (req-all :pos :spatula) (fn [{: world} ent] (let [{: pos :spatula spat} ent] (when (not spat.down) (map 30 0 3 4 (CAMERA:relx (- pos.x 8)) (CAMERA:rely (- pos.y 54)) 10)) (map 30 4 3 5 (CAMERA:relx (- pos.x 8)) (CAMERA:rely (- pos.y 22)) 10)))) ;; Tongs (draw-proc-sys draw-tong-up (req-all :pos :tong) (fn [{: world} ent] (let [{: pos : tong} ent] (if tong.down (map 43 0 3 7 (CAMERA:relx (- pos.x 8)) (CAMERA:rely (- pos.y 54)) 10) (map 40 0 3 7 (CAMERA:relx (- pos.x 8)) (CAMERA:rely (- pos.y 54)) 10)) (map 30 6 3 3 (CAMERA:relx (- pos.x 8)) (CAMERA:rely (- pos.y 1)) 10)))) (draw-proc-sys draw-batter (req-all :pos :batter) (fn [{: world} {: pos :batter batt}] (if batt.open (do (map 30 9 4 4 (CAMERA:relx (- pos.x 8)) (CAMERA:rely (- pos.y 20)) 10) (let [max-fill batt.max-fill fill-height (map-scales 0 max-fill 0 24 batt.fill) fill-height-front (map-scales 0 max-fill 0 22 batt.fill)] (rect (CAMERA:relx (- pos.x 16)) (CAMERA:rely (- pos.y 14)) 6 fill-height 5) (rect (CAMERA:relx (- pos.x 15)) (CAMERA:rely (- pos.y 13)) 4 fill-height-front 3))) (map 35 9 4 4 (CAMERA:relx (- pos.x 8)) (CAMERA:rely (- pos.y 20)) 10)))) (draw-proc-sys debug-grab-box (req-all :pos :grab-box) (fn [{: world} {: pos : grab-box}] (when (and (not (world.pointer:holding)) (within-grab-box world.pointer.pos pos grab-box)) (let [x (CAMERA:relx (+ pos.x grab-box.x-offset)) y (CAMERA:rely (+ pos.y grab-box.y-offset)) {: w : h} grab-box] (rectb (- x 2) (- y 2) (+ w 4) (+ h 4) 0) (rectb (- x 1) (- y 1) (+ w 2) (+ h 2) 12) (rectb x y w h 0) ) ))) (proc-sys update-follow-point (req-all :pos :follow-point) (fn [{: world} {: pos}] (let [(x y left middle right) (mouse)] (tset pos :x (-> (+ 50 x) (max 120) (min 350))) (tset pos :y (-> (+ 34 y) (max 30) (min 160)))))) (draw-proc-sys draw-score (req-all :pos :score) (fn [{: world} {: pos : score}] (let [x pos.x y pos.y] (rect (- x 2) (- y 2) 72 48 0) (rectb (- x 3) (- y 3) 74 50 3) (print (.. "Bottom: " score.bottom) x (+ y 1) 15 true) (print (.. "Bottom: " score.bottom) x (+ y 0) 12 true) (print (.. "Middle: " score.middle) x (+ y 10) 15 true) (print (.. "Middle: " score.middle) x (+ y 9) 12 true) (print (.. "Top: " score.top) x (+ y 20) 15 true) (print (.. "Top: " score.top) x (+ y 19) 12 true) (print (.. "Size: " score.size) x (+ y 30) 15 true) (print (.. "Size: " score.size) x (+ y 29) 12 true) (print (.. "Avg: " score.average) x (+ y 40) 15 true) (print (.. "Avg: " score.average) x (+ y 39) 12 true)))) ;; factories (global create-smoke-emitter (fn create-smoke-emitter [wld x y radius rate] (add-ent wld (+ (ent) (pos x y) (particle-emitter radius rate 0.1 0.4 1 4 [13 14 15 0] false))))) (global create-bubble-emitter (fn create-bubble-emitter [wld x y radius rate] (add-ent wld (+ (ent) (pos x y) (particle-emitter radius rate 0 0 1 3 [4] true))))) (var pancake-list []) (fn point-inside-circle [circle-pos radius pos] (<= (distance circle-pos.x circle-pos.y pos.x pos.y) radius)) (fn over-pancake [pos] (find-where (fn [e] (point-inside-circle e.pos (+ 8 e.pancake.size) pos)) pancake-list)) (fn pancake-flip [self world] (sfx 16) (tset self.pancake :flip-t 0) (tset self.pancake :state :flipping) (shake-it world 2 2) (create-timer world 1 (/ FLIP_TIME 2) (fn [] ;; flip top and bottom (var bottom-temp self.pancake.cook.bottom) (var top-temp self.pancake.cook.top) (tset self.pancake.cook :bottom top-temp) (tset self.pancake.cook :top bottom-temp) ;; flip spread as well (var spread-temp self.pancake.spread) (tset self.pancake :spread [(vec-mult [-1 1] (. spread-temp 1)) (vec-mult [-1 1] (. spread-temp 2)) (vec-mult [-1 1] (. spread-temp 3)) (vec-mult [-1 1] (. spread-temp 4))]) )) (create-timer world 1 FLIP_TIME (fn [] ;; (freeze-it 4) (shake-it world 2 2) (tset self.pancake :state :cooking) (tset self.pancake :flipped (if self.pancake.flipped false true)) ))) (fn create-pancake [wld x y s] (let [new-pancake (add-ent wld (+ (ent {:flip pancake-flip}) (pos x y) (pancake s)))] (add pancake-list new-pancake) new-pancake)) (fn pointer-hovering-over [self] (find-where (fn [e] (within-grab-box self.pos e.pos e.grab-box)) self.pointer.items)) (fn pointer-holding [self] (not (= nil self.pointer.spring))) (fn pointer-holding-ent [self] (if (self:holding) self.pointer.spring.spring.b nil)) (fn pointer-pickup [self wld grabbing-ent] (when (not (self:holding)) (sfx 18) (let [new-spring (+ (ent) (spring self grabbing-ent 0 0.8))] (tset self.pointer :spring new-spring) (add-ent wld new-spring)))) (fn pointer-drop [self wld] (when (self:holding) (sfx 17) (let [the-spring self.pointer.spring thing the-spring.spring.b] (rmv-ent wld the-spring) (tset self.pointer :spring nil)))) (fn create-pointer [wld items] (add-global-ent wld :pointer (+ (ent {:hovering-over pointer-hovering-over :holding pointer-holding :holding-ent pointer-holding-ent :pickup pointer-pickup :drop pointer-drop}) (pos 0 0) (pointer items)))) (fn spatula-action-start [self world] (if (over-pancake {:x self.pos.x :y (- self.pos.y 52)}) (shake-it world 3 4) (tset self.spatula :down true))) (fn spatula-action-tic [self]) (fn spatula-action-stop [self world] (let [pcake (over-pancake {:x self.pos.x :y (- self.pos.y 52)})] (when (and self.spatula.down (not= nil pcake)) (pcake:flip world))) (tset self.spatula :down false)) (fn create-spatula [wld] (add-global-ent wld :spatula (+ (ent {:action-start spatula-action-start :action-tic spatula-action-tic :action-stop spatula-action-stop}) (pos 24 64) (spatula) (grab-box -8 -54 24 (* 9 8))))) (fn within-griddle-bounds [pos radius] (and (> (- pos.x radius) GRIDDLE_WORKSPACE.x) (< (+ pos.x radius) (+ GRIDDLE_WORKSPACE.x GRIDDLE_WORKSPACE.w)) (> (- pos.y radius) GRIDDLE_WORKSPACE.y) (< (+ pos.y radius) (+ GRIDDLE_WORKSPACE.y GRIDDLE_WORKSPACE.h)))) (fn batter-action-start [self world] (let [pos self.pos] (when (within-griddle-bounds {:x pos.x :y (+ pos.y 8)} 0) (tset self.batter :open true) (tset self :pouring-pancake (create-pancake world (+ pos.x 8) (+ pos.y 8) 1))))) (fn batter-action-stop [self world] (tset self.batter :open false) (when (not= nil self.pouring-pancake) (tset self.pouring-pancake.pancake :state :cooking) (tset self :pouring-pancake nil))) (fn batter-action-tic [self world] (when (not= nil self.pouring-pancake) (let [{:pouring-pancake pcake-ent} self new-size (+ 0.4 pcake-ent.pancake.size)] (when (= (% pcake-ent.pancake.size 30) 1) (sfx 20)) (if (within-griddle-bounds pcake-ent.pos new-size) (do (shake-it world 1 1) (tset pcake-ent.pancake :size new-size) (tset self.batter :fill (- self.batter.fill 1))) (batter-action-stop self world))))) (fn create-batter [wld] (add-global-ent wld :batter (+ (ent {:action-start batter-action-start :action-tic batter-action-tic :action-stop batter-action-stop}) (pos 24 110) (batter) (grab-box -8 -20 32 32)))) (fn tong-holding [self] (if (not (= nil self.tong.grabbing)) self.tong.grabbing nil)) (fn tong-pickup [self wld grabbing-ent] (when (not (self:holding)) (tset self.tong :grabbing grabbing-ent))) (fn tong-drop [self wld] (when (self:holding) (let [pcake (self:holding)] (if (within-griddle-bounds self.pos pcake.pancake.size) (tset pcake.pancake :state :cooking) (tset pcake.pancake :state :sitting)) (if (point-inside-circle wld.plate.pos wld.plate.plate.radius pcake.pos) (when (not (find-where (fn [e] (= e pcake)) wld.plate.plate.pancakes)) (sfx 21) (add wld.plate.plate.pancakes pcake)) (each [i p (ipairs wld.plate.plate.pancakes)] (when (= p pcake) (rmv wld.plate.plate.pancakes i)))) (when (= (length wld.plate.plate.pancakes) 3) (wld.plate:end-game wld))) (tset self.tong :spring nil) (tset self.tong :grabbing nil))) (fn tong-action-start [self world] (let [pcake (over-pancake {:x self.pos.x :y (- self.pos.y 52)})] (if pcake (do (tset self.tong :down true) (tong-pickup self world pcake) (tset pcake.pancake :state :holding)) (shake-it world 3 4)))) (fn tong-action-stop [self world] (when (and self.tong.down (self:holding)) (self:drop world)) (tset self.tong :down false)) (fn tong-action-tic [self world] (let [pos self.pos grabbing-pcake self.tong.grabbing] (when grabbing-pcake (tset grabbing-pcake.pos :x pos.x) (tset grabbing-pcake.pos :y (- self.pos.y 52)) ))) (fn create-tongs [wld] (add-ent wld (+ (ent {:holding tong-holding :pickup tong-pickup :drop tong-drop :action-start tong-action-start :action-tic tong-action-tic :action-stop tong-action-stop}) (pos 24 180) (tong) (grab-box -8 -50 24 (* 9 8))))) (fn create-camera-follow-point [wld] (tset CAMERA :follow (add-ent wld (+ (ent) (follow-point) (pos 120 64))))) (fn plate-end-game [self wld] (music 1 -1 -1 false) (tset self.plate :game-end true) (tset CAMERA :follow self) (each [i e (ipairs self.plate.pancakes)] (create-timer wld 1 (* i 20) (fn [] (sfx 19) (tset e :des-pos (des-pos (CAMERA:realx (map-scales 1 3 60 180 i)) (CAMERA:realy (+ e.pancake.size 8)) 0.2)) (add-ent wld e) (create-timer wld 1 20 (fn [] (sfx 19) (add-ent wld (+ (ent) (pos (map-scales 1 3 4 160 i) 60) (score e.pancake))))))) ) (create-timer wld 1 (* (+ 1 (length self.plate.pancakes)) 20) (fn [] (set GAME_END true))) ) (fn create-plate [wld] (add-global-ent wld :plate (+ (ent {:end-game plate-end-game}) (pos 345 110) (plate 40)))) (state-add :main (fn init [self] (set GAME_END false) (music 0) (set self.world (tiny.world)) (add-sys self.world anim-tic) (add-sys self.world timer-tic) (add-sys self.world shaker-tic) (add-sys self.world des-pos-tic) (add-sys self.world velocity-tic) (add-sys self.world bounds-tic) (add-sys self.world friction-tic) (add-sys self.world verlet-tic) (add-sys self.world update-partiW cle) (add-sys self.world update-particle-emitter) (add-sys self.world update-follow-point) (add-sys self.world update-pointer) (add-sys self.world update-pancake) (add-sys self.world draw-plate) (add-sys self.world draw-spatula-down) (add-sys self.world draw-plate-end-game-bars) (add-sys self.world draw-pancake-layer-bottom) (add-sys self.world draw-particle) ;; (add-sys self.world draw-pancake-layer-middle) ;; (add-sys self.world draw-pancake-layer-top) (add-sys self.world draw-spatula-up) (add-sys self.world draw-tong-up) (add-sys self.world draw-batter) (add-sys self.world draw-score) ;; (add-sys self.world anim-draw) (add-sys self.world debug-grab-box) (create-plate self.world) (create-camera-follow-point self.world) (let [spatula (create-spatula self.world) batter (create-batter self.world) tongs (create-tongs self.world)] (create-pointer self.world [spatula batter tongs])) (for [i 1 100] (CAMERA:update 1)) ) (fn tic [{: world : lvl : pancake} t] (if FREEZE_FRAME.active (freeze-frame-update) (do (CAMERA:update 1) (world:update dt update-system-filter))) (cls 10) ;; table Checkerboard background (map 30 17 58 (- 47 17) (CAMERA:relx 0) (CAMERA:rely 0) 0) ;; griddle (map 231 30 10 4 (- (CAMERA:relx GRIDDLE_POS.x) 64) (+ (CAMERA:rely GRIDDLE_POS.y) 80) 10) (map 0 18 GRIDDLE_SIZE.w GRIDDLE_SIZE.h (CAMERA:relx GRIDDLE_POS.x) (CAMERA:rely GRIDDLE_POS.y) 10) (when DEBUG (rectb (CAMERA:relx GRIDDLE_WORKSPACE.x) (CAMERA:rely GRIDDLE_WORKSPACE.y) GRIDDLE_WORKSPACE.w GRIDDLE_WORKSPACE.h 14)) (world:update dt draw-system-filter) (let [plate world.plate.plate] (circ 228 2 14 5) (circ 228 2 12 4) (print (.. (length plate.pancakes) "/3") 220 3 0) (print (.. (length plate.pancakes) "/3") 220 2 12)) (when GAME_END (print "Click with the mouse to try again!" 25 120 14) (print "Click with the mouse to try again!" 25 121 12) (let [(x y left middle right) (mouse)] (when (or left middle right) (sfx 21) (state-goto :title))) ) ) (fn ovr [{: world} t] (world:update dt ui-system-filter)) (fn teardown [self] (clear-entities self.world) (clear-systems self.world) (refresh self.world) (set self.world nil))) (state-add :title (fn init [self] (music 2) (tset self :t 0)) (fn tic [self] (map 30 17 58 (- 47 17) 0 -40 0) (map 0 18 GRIDDLE_SIZE.w GRIDDLE_SIZE.h 0 8 10) ;; Pancake (each [i s (ipairs [256 260 264 268 260 320 324])] (spr s (+ 14 (* (- i 1) 30)) (+ 18 (* 0 (sin (/ (+ self.t (* i 3)) 15)))) 0 1 0 0 4 4)) ;; Simulator (each [i s (ipairs [384 386 388 390 416 392 394 396 398])] (spr s (+ 30 (* (- i 1) 20)) (+ 56 (* 4 (sin (/ (+ self.t (* i 3)) 15)))) 10 1 0 0 2 2)) (print "Click with the mouse to begin!" 42 99 14) (print "Click with the mouse to begin!" 42 100 12) (tset self :t (+ 1 self.t)) (let [(x y left middle right) (mouse)] (when (or left middle right) (sfx 21) (state-goto :main))) ) (fn ovr [self] nil) (fn teardown [self] nil) ) ;; hide mouse cursor (vbank 0) (poke 0x3FFB 0) (state-start :title) (global TIC (fn tic [] (state-tic 1)))