`b:.:;vLctnC{b,]P/-;4@vJhZ̸ogvb:.:;vLctnC{b,]P/-;4@vJhZ̸ogv 2TvͫgE#2Tv2Tv"3DUfw"3DUfw͛W#"Cv90Q CTUfvwwpwww˽ygUvW3#SE"sˬyvhUeF!d̼wwgUeE#2dxgVED#2CeެxvW#Rxf1ewVDu o`ffwffwfpwfpwfvofpw gfffwfwffofffvf`vpfhwxvwxxfvvwgvwxwxffhfwwwxxgfvffwffwwfwfwffffvghffgffvxfwhxhvffxffgffgffgvghx  fhffvwwwwwfwxgvxxxwwwpwwwfhvppwwffvhhffgffgwxfxxxwwxwfvfgfvwfffhfffhfvhgffxxxvxgvxffxxxxwxwxxxwxwwxwxw xfvffwfxwgwxhvhffxffvgffgfgvhhwhwwwxwxxfhhfwhfwhfxfffvfxxffvhffgffgvxwhxgvxffwffgfwfgfxfgvggxfvvwgvwwxvwwwwwwwwwwwwwwwwwffwgfwxwwwwwwwwxgfvwffwwffwwwwfwfwfxfffvggffgwffvwwfv fhvfvhvwxwxxwhxhhffwffvhffgfwfhfgfvfgvfgvfxvhffgffvwxfvwxwxwfhwfgxgfxffwwwxwwwwfwwwfvwwffwggfwfvfgfwggwwwwwgfvgwffgwgfgfvfwfwwwvxwwxwwxwxfvwwfgfvwfffgfffgfvwgxwwgffwxwwgwwwvwwwwwgfwwwfwwwwwffw{fvffwfxwgwxhvkff{ffvgffgfgvhhwhwwwxwxxfkhfwhfwhfxfffvf{xffvhffgffgvwwxwwwwxwwwxwxxwwxwwwwxwwwwwwwwwxxwxwwxwxxxwxwxwwwww݈ވ߈ """ 3"3 #32 2"# 2"# #32 3"3""""2#2#22##3333333333333333"""3"3#322"#2"##323"3𪪪 `fff`Vfe`UfU`fUf`fUf`UfU`VfeffffVUUeUUUUVUUeVUUeUUUUVUUefffVfeUfUfUffUfUfUVfefgxffffv݈ހހ  3"3 #32 2"# 2"# #32 3"3 """333333333333333322##2#2#""""3"3#322"#2"##323"3"""𠺻 `Vfe`UfU`fUf`fUf`UfU`Vfe`fffVUUeUUUUVUUeVUUeUUUUVUUeffffVfeUfUfUffUfUfUVfefffwffgffffvwffgffgf ݈ xfxwwxfxfgx݈  ހofffvw`f}fffwwp ȈȌ̈ pU`qU 1V ̈ @L0D4Ȉ ` VPẄ `Vë ͝  gP Wc  ) "," """""""U  e p `q" 1" """ UUV ""Ȉ @̈ 0DD4@@0CDL4@L̈LD4D4@4Ȉ `` w f uUPUvfvPpgu`PUvfpv``VVeWUffe`UuU "") ))Ȑ ̈" "" """ "" " "" """")" ̌@DD@@ ̈Ȍ0D44D44D4 D@LL@LD4̈ Ue`g`g w f ̈pgP``U``gw`gfw fp WePeW`ug  ˼̻̻˪˼̼˻̼˺̺̫ʼ˪̺̻˼̻˼̫˻˻̼̼̼̻ ̼̼˻̼̼̼˼˼̼˻̻̼̻̼˼̻˼̻˻̼̻˻̚˼˻ ̻ @̰L @D@̰ D @D@̰L ̻@ @ @D@̰ D @ @@ @ ̻@̰ @ @ @@ @ @ DDD @ DD@@D @D D@  L@DD@@DD̰@@D@@@D D@D D@D@D D  DD@@DDDD @D@@@D D@D D@D@D D L@DD@@DD @D  D@D @ D D@DD@@ @D@@@D D@D D@D@D D  DD@@DDDD  D@D ̻ ̻̻@DD@@ @ D DD@D D @@D@D@D @DD@DD D@DD D ̻@̻@@@D@ ̰ @̻@̻̻ @ ̰ @  ̻ ̻̻ @ ̰ ̰̰  ̻ ̻ ̻ ̰ ̰̰ ̻ ̻ ̰ ̰̰ ̰̻ ̻ ̻ ̰ ̰̰ ̻ ̻ ̰ ̰̰ ̰D@D@  ̰ @ D D̻@ ̻ ̰ ̰ ̻ 3 0300 33 ̻ 3 0300 33̻ 3 0300 33 ̻ ̻ ̻ ̻0̻ ̰̰ ̻ 3 0300 33 ̻ ̻ ̻ ̻0̻ ̰̰  ̻̻ ̻ 3  ̰ ̰ 0 3  003 3 300003000 00 30 ̻ <<3 3̰ 000000 3003 0 ̻ <<03330<̰̰00 003 30  3<<00033<̰̰0 0 000 0 00000003 330 ̻ <<00033<̰̰0 0  300 0 03 0 0033 30 00 33̰0̰   ̰ 330 ̻00 3 3̰̰ 00 3  3 ̰ < 303 ̻  3 ̰ 03 0̻ 0 0̻ 0 33 3 03̰ 00 0 3 0 ̻00 ˼ p`q 1 "̻UUV ""˼ p`q 1 ̻UUV ̻ Ļ C̼D̻Ļ DA̼D˻ P̻ ``VVeW̻˻ `p U̼ffeUUU " "" "ˀ" " "" """"("̼ " "" "" " """""""""("̼ DA L LA L DA 4̻̻DDD̼ L LA L DA 4ADDD̼ uPU vf vpgp`w̼UUpUVV̻ uPU v vpgp`w̼UpUVV "H D8C(0"( BB" 0$$ "" #B@@D243D30C23 "" " @#DD3C4330#"""# 3#03#0#" "" ""  """"""""""""""""""""223"3"2""""0("" #"CD 8D "2"33DD4DD#" "3B (2#  (0" $3"2#0  " "( """"3#23""""""""""""(""" """"D""D$"CDD3CD3""D "D 3D2CD2D32D"3DDD@D@DD@DD0DD40CD3333233 "32333DD03DD 3"3#0DD33DD3 @DDD@DDCDD3D433333# 0 33#33#333#333"333"""""""""""""""""""""""""""""""232332333"333"3333 3"3#3#3# ("""" "3D"""""""""("("""""""""""3D"""""("""""""2""3"23333("""""DD#23"33(23("3 ("" ("" "" ""3CD03D33303"" """D43D333033"" """03#33"3#3"""""""""030303030# " " 333"33#"3#""#""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""333"233""23"""2""""""""""""""""33332""8 #"""3333333C8CDD3DD 33333333D333DD33DD3"23#(""DD3CDD3DD"""""""(" (" ""(33"D33#B233""333"3"0""D"33$233"33#333"03 """""""""""""" """""""2""2""("" ( ("""""""#333#333"""""""""""""""""""""2"""2333"333""""""""""""""""""""#"""#"""""" ""0("3""2("" "" ""3 "#"""""" """"""""(""""""(""""""""""""""""""Nxxxxvyyyyyyyyyw;;;;;;;;;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@GHIGKGHIJKGHIJKGHIJKGHIJK@@@@@6789:678NONONOLMO_@@@/  NOo@@@? &'()*&'(,-.,-./@@@=6789:678 <=><=>? _@@@?  ,-./o@@@<$%&'()*&'( ,-<=>?./_@@@?6789:678LM=>?<=>?o@@@< NO-./,-./_@@@"# &'()*&'(LMLM?<=>?o@@@678 NONO @@@ E555555FpS CVWWWWWWXBa 1fggggggh2PQ 12`a 1YZ[YZZZ[2Pq 1ijkijjjk2`a 12PQ 1\]]]]^\^2` DlmmmmnlnA "####$ pQ a dc RS  rs ds ;;;;;;;;;;;;; ++  ;;; GHIJKGHIJKGHIJKGHIJKGHIGHIJKGH :678789:678NONONO:678 Pq `a TU be tc rs q JDA@@@AABDDEFGHHIJJKKKLLMMMNNNIEB@@AAAABBBBBBBBBBBBBBBBBBBBBc!#DA@ABCCDDDEEEFFFFFFFFGGGGGGGGG  @@ A!"pp`p``PP@@0 3p`P0 %c22222222233322 2!212B3B4S6c8t9t;u=>?????$2w2w2w2g2g2g2W2W2G272'22222234689;=>?????#"3CTu5n\ZHF0  $vp p ppBpfUS2 5,@ @ @ @ Bp`@`@ `@ `@ ```b+b   pPXb8b8b  @ @   @`   `@hbHb8bhhhhhhhhhhhhhhhh        ddddddddddddddddx        @ ` @ @ @ Bpffffffffffffffff     @@p`PP@@00 ``p`PP@@00 cP@00   `@ `@ `@ `@ ```b&b    `@mbMb=bEaE e ee eeeEcE e ee eeebEE e ee e eebEE e ee e eeEEee eeeEEEee eeeEEEee eeeEEEee eeeE g    g   g        MM m mMM m mMM m m m m mMMM m mMM m mMM m m m m mMMm m mMm m mMm m mm m mmm m mm MMm mm m mmm mmMb Mm mmmm mMb Mm mmmm m McMam m m mm MaMm m m mmMa M mm mm m MMa M mm mm m MbMmmm mmmmMmmmmMm m g   g  gMHH g   g  gMMa M mm mm m MMa M mm mm m MbM mm m  mm mbM mm m  mm mTm m mTm m mTm m mT m mmT m mmT m mmT m mmTm mmk k kkk kkkkkkkkkkkTU4U4U4U4U4U4U4 U4U4U4U4U4U4U4 U4 U4U4U4U4U4U4U4U4 U 4 U 4U 4 U 4U 4 U 4 U 4 U 4 UTU4U4U4U4U4U4U4U4U4U4U4U4U4U4U4UTU4U4U4U4U4U4U4U4U4U4U4U4U4U4U4UKKKKKKx@KK٫KKK٫KKKKKKx@KK٫KHyK٫KKKKKKx@KK٫KKK٫KKKKKKx@KK٫KhxXic j|(kPp`0  i j j |ic j|OkJfjI Ig jI Ig jjjIIg jjIIg| GGgGGgFGg i    j| iTUTU   j|4U4U4U4U@ @ @ @ Bpnn nn nn nnn nn nn na n   nna n   nbn    bn    hnn nn nn nnn nn nn Vna n   nna n   nbn    bn   bbbbbbbbbbbb0P$P4AV\'6lעl0m]}? """""""""""""""" """""""" """""""""" """"""""""""""""" " """""""" """""""""""" """""""""""""""""" "" """""""" """""""""""""" """"""""""""""""""" """ """""""" """""""""""""""" """""""""""""""""""" """" """""""" """""""""""""""""" "",""""""""""""""""" """"" """""" """""""""""""" """""" "-,""""""""""""""""" """""" """"" """""""""""""""""""""" -",""""""""""""""""" """"""" """" """""""""""""""""""""""" -"",""""""""""""""""" """""""" """" """"""" """""""""""""""" )""""""""""""""""" """""""" )"" """""" """""""""""""""" ݐ)""""""""""""""" """""""" )"" """"" """""""""""""""" ݐ)"""""""""""""" """""""" )"" """" """""""""""""""" )"""""""""""""""""""""" )"""""" """""""""""""" )"""""""""""""""""""" )"""""" """""""""""" ݐ )"""""""""""""""""" )"""""" """""""""" ݐ )"""""""""""""""" )"""""" """""""" )"""""" """""""" )"""""""""""""""" )"""""" """""""""" )"""""""""""""""""" )"""""" """""""""""" )"""""""""""""""""""" )"""""" """""""""""""" )"""""""""""""""""""""" )"" """" """""""""""""""" )""""""""""""""" """""""" """" """"" """""""""""""""" ݐ """-""""""""""""""" """""""" """"" """""" """""""""""""""" ݝ """-""""""""""""""""" """""""" """""" """"""" """""""""""""""" """-""""""""""""""""""" """""""" """"""" """""""""""""""""""""""" """-"""""""""""""""""""" """""""" """""""" """""""""""""""""""""""""""""""""""""""""""""""" """""""" """""""" """""""""""""""" """""""""""""""""""""""""""""""" """""""" """""""" """""""""""""""" """""""""""""""""""""""""""""""" """""""" """""""" """"""""""""""""""""""""""""""""""""""""""""""" """""""" "","""","""""""" """""""" """"""""""""" """""""" "-,"""","""" """""""" """"""""" """""""" -","""" " """""""" """"""" """"""" """" """ """ ""ݐ ݐ ""ݐ͝ "ݐ ݐ " ݐ ݐ ͝ ͝ ͝ # title: Titan Ceremony DX # author: Alec Troemel # desc: to spurn the old gods, sacrifices must be made. # site: alectroemel.com # license: MIT License (change this to your license of choice) # version: 1.0 # script: janet # strict: true # saveid: v1.0 (import tic80) (def DEBUG false) # Constants (def RNG (math/rng (tic80/tstamp))) (def UP 0) (def DOWN 1) (def LEFT 2) (def RIGHT 3) (def A 4) (def B 5) (def X 6) (def Y 7) (def MAX_HEALTH 2000) (def OFFSET (math/rng-int RNG 10000)) (def STARTING_X 48) (def STARTING_Y 82) (var GS nil) # Helpers (defmacro btnp-any [& buttons] "True if (btnp) returns true for any of the buttons." ~(or ,;(map |[tic80/btnp $] buttons))) (defn 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))))) (defn wait [self ticks] """ Return false until 'ticks' iterations pass, then return true. Note: self must be a table, and is mutated by this function """ (when (not (get self :wait-ticks false)) (put self :wait-ticks 0)) (if (= (self :wait-ticks) ticks) true (do (++ (self :wait-ticks)) false))) (defmacro with-pallete-swap [pallete & body] """ Swap the color pallete during the given body. Pallete is a dict of {from to} color ids. (with-pallete-swap {0 1 2 3} (tic80/map 0 0 8 8)) """ (with-syms [$from $to] ~(do # apply the theme (loop [[,$from ,$to] :pairs ,pallete] (tic80/poke4 (+ (* 0x3FF0 2) ,$from) ,$to)) ,;body # remove theme (loop [[,$from ,$to] :pairs ,pallete] (tic80/poke4 (+ (* 0x3FF0 2) ,$from) ,$from))))) (defn text-width [text &opt fixed scale smallfont] """ print the text offscreen to get the width """ (default fixed false) (default scale 1) (default smallfont false) (tic80/print text 0 -100 0 fixed scale smallfont)) (defn print-centered [text x y color &opt fixed scale smallfont] """ Prints text where x is the center of text. """ (default fixed false) (default scale 1) (default smallfont false) (let [width (tic80/print text 0 -100 color fixed scale smallfont) x (- x (/ width 2))] (tic80/print text (math/round x) (math/round y) color fixed scale smallfont))) (defn trect [x y w h ux uy uw uh &opt use-map trans] "Draw a textured rectangle using 2 textured tiangles" (default use-map false) (default trans -1) (let [[x1 y1] [x y] [x2 y2] [(+ x w) y] [x3 y3] [x (+ y h)] [x4 y4] [(+ x w) (+ y h)] [u1 v1] [ux uy] [u2 v2] [(+ ux uw) uy] [u3 v3] [ux (+ uy uh)] [u4 v4] [(+ ux uw) (+ uy uh)]] (tic80/ttri x1 y1 x2 y2 x3 y3 u1 v1 u2 v2 u3 v3 use-map trans) (tic80/ttri x2 y2 x3 y3 x4 y4 u2 v2 u3 v3 u4 v4 use-map trans))) (defn print-shadowed [text x y] (print-centered text x (+ 1 y) 1) (print-centered text x y 0)) (defn fps/init [] "Calculate frames per second" @{:value 0 :frames 0 :last-time -1000 :get-value (fn fps/get-value [self] (if (<= (- (tic80/time) (self :last-time)) 1000) (+= (self :frames) 1) (do (put self :value (self :frames)) (put self :frames 0) (put self :last-time (tic80/time)))) (self :value)) :draw (fn fps/draw [self] (when DEBUG (tic80/print (string/format "FPS: %n" (self :value)) 1 0 11)))}) (defn set-channel-register-volume [channel volume-percent] """ Set the volume percentage (0 to 1) for a channel (from 0 to 3) in the sound register. This effects the SFX volume envelope, and is independent of the sfx() volume parameter and Mxy commands in the tracker. for more --> https://github.com/nesbox/TIC-80/wiki/RAM#sound-registers """ (let [mem-location (+ 3 (* 2 (+ 0x0FF9C (* 18 channel)))) volume (tic80/peek4 mem-location) new-volume (math/round (* volume volume-percent))] (tic80/poke4 mem-location new-volume))) # Tweens (defn- flip [f] (fn [s & args] (- 1 (f (- 1 s) ;args)))) (defn- chain [f1 f2] (fn [s & args] (* 0.5 (if (< s 0.5) (f1 (* 2 s) ;args) (+ 1 (f2 (- (* 2 s) 1) ;args)))))) (defn- lerp [func start end percent] (+ start (* (- end start) (func percent)))) (defmacro- def-tween "define the in, out, in-out, and out-in versions of a tween" [name & body] (with-syms [$in $out $in-out $out-in] (let [$in (symbol "in-" name) $out (symbol "out-" name) $in-out (symbol "in-out-" name) $out-in (symbol "out-in-" name)] ~(upscope (defn ,$in [s] ,;body) (def ,$out (flip ,$in)) (def ,$in-out (chain ,$in ,$out)) (def ,$out-in (chain ,$out ,$in)) (def ,(symbol "lerp-" $in) (partial ,lerp ,$in)) (def ,(symbol "lerp-" $out) (partial ,lerp ,$out)) (def ,(symbol "lerp-" $in-out) (partial ,lerp ,$in-out)) (def ,(symbol "lerp-" $out-in) (partial ,lerp ,$out-in)))))) (def-tween linear s) (def-tween quad (* s s)) # Screen Shake (def SHAKER @{:duration 0 :power 0 :shake-it (fn SHAKER/shake-it [self duration power] (put self :duration duration) (put self :power power)) :update (fn SHAKER/update [self] (let [{:duration dur :power pow} self x-offset (math/round (- (math/rng-int RNG pow) (/ pow 2))) y-offset (math/round (- (math/rng-int RNG pow) (/ pow 2)))] # time to shake (when (> dur 0) (tic80/vbank 0) (tic80/poke 0x3FF9 x-offset) (tic80/poke 0x3FFA y-offset) (tic80/vbank 1) (tic80/poke 0x3FF9 x-offset) (tic80/poke 0x3FFA y-offset) (tic80/vbank 0) (-- (self :duration))) # shake all done, reset everything (when (= dur 0) (tic80/vbank 0) (tic80/memset 0x3FF9 0 2) (tic80/vbank 1) (tic80/memset 0x3FF9 0 2) (tic80/vbank 0))))}) # Directed Graph and Gamestate Manager (defn digraph/node [name & properties] [:node (keyword name) {:edges @{} :data (table ;properties)}]) (defn digraph/edge [& pattern] (match pattern [(name (keyword? name)) (from (keyword? from)) (to (keyword? to)) (weight (number? weight))] [:edge from {:to to :name name :weight weight}] [(name (keyword? name)) (from (keyword? from)) (to (keyword? to))] [:edge from {:to to :name name :weight 1}] [(from (keyword? from)) (to (keyword? to)) (weight (number? weight))] [:edge from {:to to :name to :weight weight}] [(from (keyword? from)) (to (keyword? to))] [:edge from {:to to :name to :weight 1}])) (defn contains [self name] (not (nil? (get-in self [:adjacency-table name])))) (defn add-node [self [NODE name node-def]] (if (:contains self name) (errorf "graph already contains node %s" name) (put-in self [:adjacency-table name] node-def))) (defn add-edge [self [EDGE from {:to to :name name :weight weight}]] (cond (not (:contains self from)) (errorf "graph does not contain from node %s" from) (not (:contains self to)) (errorf "graph does not contain to node %s" to) (put-in self [:adjacency-table from :edges name] {:to to :weight weight}))) (defn neighbors [self from-name] (if-let [node (get-in self [:adjacency-table from-name]) edges (get node :edges)] (map (fn [(name data)] {:from from-name :name name :to (get data :to) :weight (get data :weight)}) (pairs edges)) [])) (defn get-node [self name] (get-in self [:adjacency-table name])) (def digraph/Graph @{:contains contains :add-node add-node :add-edge add-edge :get-node get-node :neighbors neighbors :adjacency-table @{}}) (defn digraph/create [& patterns] (let [graph (table/setproto @{:adjacency-table @{}} digraph/Graph) nodes (filter |(= :node (first $)) patterns) edges (filter |(= :edge (first $)) patterns)] (each n nodes (:add-node graph n)) (each e edges (:add-edge graph e)) graph)) (defn- get-current-state [self] (:get-node self (self :current))) (defn- current-node-call [self fn-name & args] (when-let [current-node (:get-current-state self) node-fn (get-in current-node [:data fn-name] nil) leave-exists (not (nil? node-fn))] (node-fn self ;args))) (defn- apply-edges-functions [self] (when-let [current-node (:get-current-state self) edges (current-node :edges)] (each (edge-name edge) (pairs edges) (put self edge-name (fn [self & args] (:goto self (get edge :to) ;args))))) self) (defn- apply-data-to-root [self] # clear out old fields (each key (get self :current-data-keys []) (put self key nil)) (put self :current-data-keys @[]) # apply data to root of fsm (let [current-node (:get-current-state self) {:data data} current-node] (each (key val) (pairs data) (array/push (self :current-data-keys) key) (put self key val))) self) (defn- goto [self to & args] (assert (:contains self to) (string/format "%q is not a valid state" to)) (:current-node-call self :leave to) (let [from (get self :current)] (put self :current to) (:apply-edges-functions self) (:apply-data-to-root self) (when (nil? (get-in self [:visited to])) (:current-node-call self :init) (put-in self [:visited to] true)) (:current-node-call self :enter from ;args))) (def fsm/FSM (merge digraph/Graph @{:current @{} :current-data-keys @[] :visited @{} :get-current-state get-current-state :current-node-call current-node-call :apply-edges-functions apply-edges-functions :apply-data-to-root apply-data-to-root :goto goto :add-state (get digraph/Graph :add-node)})) (defn fsm/create [& states] "Create a new FSM from the given states." (table/setproto (digraph/create ;states) fsm/FSM)) (def state digraph/node) (def transition digraph/edge) (defmacro fsm/def-state [name & args] ~(def ,(symbol name) (,state ,(keyword name) ,;args))) (defmacro fsm/define ``` define a Finite State Machine. This macro creates a factory or blueprint for the FSM. Each state is a Struct with transition functions, and optional data. The Resulting "factory" is pass the starting state when an actual FSM is instantiated. If 'enter' or 'leave' functions are defined in a state, then will be called during the transition. You can also provide addition arguments to a transition fn, and they will be passed to the 'going to' state's enter fn. If the 'init' function is defined on the state, it will be called only once the first time the state is visited. (fsm/define colors-fsm (state :green :enter (fn [self] (print "entering green")) :leave (fn [self] (print "entering leaving"))) (transition :next :green :yellow) (state :yellow :init (fn [self] (print "visiting yellow for the first time")) :enter (fn [self] (print "entering yellow"))) (transition :prev :yellow :green)) (def *colors* (colors-fsm :green)) The ':current' field on the FSM instance will return the name of the current state. (*colors* :current) # -> :green Then call the transition methods on the FSM to move between states. (:next *colors*) (*colors* :current) # -> :yellow # TODO Additionally, you can put any arbitrary data/methods in a state, and it will be available on the root machine when in that state. Just remember that any data will be removed when you leave the state! ``` [name & states] ~(defn ,name [&opt initial-state] (-> (,fsm/create ,;states) (put :current initial-state) (put :__validate__ (fn [& args] true)) (put :__id__ ,(keyword name)) (:apply-edges-functions) (:apply-data-to-root)))) (defn- gamestate/exec-if-has [t f & args] (default args []) (when (get t f) (f t ;args))) (defn- gamestate/change-state [self to & args] (let [pre (array/peek (self :_stack))] (when (nil? (get-in self [:initialized-states to])) (gamestate/exec-if-has to :init)) (put-in self [:initialized-states to] true) (array/push (self :_stack) to) (gamestate/exec-if-has to :enter to pre ;args))) (defn- gamestate/switch [self to & args] "Switch to a gamestate, with any additional arguments passed to the new state." (gamestate/exec-if-has (:current self) :leave to) (array/pop (self :_stack)) (:change-state self to ;args)) (defn- gamestate/push [self to & args] "Pushes the to on top of the state stack, i.e. makes it the active state. Semantics are the same as switch, except that the leave callback is not called on the previously active state." (:change-state self to args)) (defn- gamestate/pop [self & args] "Calls 'leave' on the current state and then removes it from the stack, making the state below the current state and calls 'resume' on the activated state. Does not call 'enter' on the activated state." (assert (> (length (self :_stack)) 1) "No more states to pop!") (let [pre (array/pop (self :_stack)) to (array/peek (self :_stack))] (gamestate/exec-if-has self pre :leave pre) (gamestate/exec-if-has self to :resume to pre ;args))) (defn- gamestate/current [self] (array/peek (self :_stack))) (defn- gamestate/update [self & args] (gamestate/exec-if-has (:current self) :update ;args)) (defn- gamestate/draw [self & args] (gamestate/exec-if-has (:current self) :draw ;args)) (defn gamestate/init [] "create a new gamestate manager" {:_stack @[] :initialized-states @{} :change-state gamestate/change-state :switch gamestate/switch :push gamestate/push :pop gamestate/pop :current gamestate/current :update gamestate/update :draw gamestate/draw}) (defmacro gamestate/def-state [name & args] ~(def ,(symbol name) ,(table ;args))) # Camera (def CAMERA @{:x-offset 0 :y-offset 0 :y-lerp-fn nil :y-tick nil :y-start nil :y-goal nil :reset (fn CAMERA/reset [self] (put self :x-offset 0) (put self :y-offset 0)) :y-to (fn CAMERA/y-to [self goal lerp-fn] (put self :y-tick 0) (put self :y-goal goal) (put self :y-start (self :y-offset)) (put self :y-lerp-fn lerp-fn)) :update (fn CAMERA/update [self] (when (not (nil? (self :y-goal))) (if (= (self :y-offset) (self :y-goal)) (put self :y-goal nil) (do (put self :y-offset (-> ((self :y-lerp-fn) (self :y-start) (self :y-goal) (self :y-tick)) (math/round))) (+= (self :y-tick) 0.009)))))}) ## define Camera version of common draw functions ### map is so different that its not worth the macro (defn cam/map [&opt x y w h sx sy colorkey scale remap] (default x 0) (default y 0) (default w 30) (default h 17) (default sx 0) (default sy 0) (default colorkey -1) (default scale 1) (tic80/map x y w h (- sx (CAMERA :x-offset)) (- sy (CAMERA :y-offset)) colorkey scale)) ### everything else uses this macro which wraps the x/y in camera offsets (defmacro defn-cam [func prefix-args & map-args] ~(defn ,(symbol (string/replace "tic80" "cam" (string func))) [,;prefix-args ,;(map |($ 0) map-args) & args] (,func ,;prefix-args ,;(map |['- ($ 0) ~(CAMERA ,($ 1))] map-args) ;args))) (defn-cam tic80/print (text) (x :x-offset) (y :y-offset)) (defn-cam tic80/spr (id) (x :x-offset) (y :y-offset)) (defn-cam tic80/elli () (x :x-offset) (y :y-offset)) (defn-cam tic80/rect () (x :x-offset) (y :y-offset)) (defn-cam tic80/rectb () (x :x-offset) (y :y-offset)) (defn-cam tic80/circ () (x :x-offset) (y :y-offset)) (defn-cam tic80/circb () (x :x-offset) (y :y-offset)) (defn-cam tic80/tri () (x1 :x-offset) (y1 :y-offset) (x2 :x-offset) (y2 :y-offset) (x3 :x-offset) (y3 :y-offset)) (defn-cam tic80/ttri () (x1 :x-offset) (y1 :y-offset) (x2 :x-offset) (y2 :y-offset) (x3 :x-offset) (y3 :y-offset)) (defn-cam tic80/line () (x1 :x-offset) (y1 :y-offset) (x2 :x-offset) (y2 :y-offset)) # Animation States (defn- animation/machine-goto [self to & args] (when (not= (self :current) to) (let [result ((fsm/FSM :goto) self to ;args) state (:get-current-state self) current-frame (get-in state [:data :frames 0])] (put self :frame 0) (put self :frame-duration (current-frame :duration)) result))) (defn animation/machine-update [self dt player] (when-let [state (:get-current-state self) frames (get-in state [:data :frames]) frames-count (length frames)] (when (not (self :paused)) # NOTE: frame duration is in milliseconds, while dt is in seconds (-= (self :frame-duration) (* dt 1000)) (when (<= (self :frame-duration) 0) (+= (self :frame) 1) (%= (self :frame) frames-count) (when (>= (self :frame) frames-count) (put self :frame 0)) (put self :frame-duration (get-in frames [(self :frame) :duration])))) (when-let [update-fn (get-in state [:data :state-update])] (update-fn self state player)))) (defn animation/machine-draw [self pos &opt z] (default z 0) (when-let [{:frame frame :offset offset} self {:data state} (:get-current-state self) {:colorkey ck :frames frames :width w :height h} state frame-data (get frames frame) id (get frame-data :id) flip (get frame-data :flip 0) rotate (get frame-data :rotate 0)] (cam/spr id (pos :x) (- (pos :y) z) ck 1 flip rotate w h))) (defn animation/machine-reset [self] "reset current animation frame and frame-duration" (when-let [state (:get-current-state self) frames (get-in state [:data :frames]) frames-count (length frames)] (put self :frame 0) (put self :frame-duration (get-in frames [(self :frame) :duration])))) (def AnimationMachine (merge fsm/FSM @{:update animation/machine-update :draw animation/machine-draw :goto animation/machine-goto :reset animation/machine-reset :paused false :frame 0 :frame-duration 0 :offset {:x 0 :y 0}})) (defn create-animation-machine [starting-state & patterns] (-> (fsm/create ;patterns) (table/setproto AnimationMachine) (put :current starting-state) (:apply-edges-functions) (:apply-data-to-root))) # Particles # Adapted in part from https://tic80.com/play?cart=1983 (defn particles/apply-velocity [{:pos pos :vel vel}] (+= (pos :x) (vel :x)) (+= (pos :y) (vel :y))) (defn particles/apply-friction [{:vel vel :friction f}] (*= (vel :x) f) (*= (vel :y) f)) (defn particles/update-tick [self] (put self :tick (+ (- (self :tick) 1) (math/rng-uniform RNG)))) (defn particles/update [particles] (map |(:update $) particles) (loop [i :range [0 (length particles)] :when (and (get particles i) (:dead? (get particles i)))] (array/remove particles i))) (defn particles/dust [pos &named radius friction tick colors] (default radius 3) (default friction 0.92) (default tick 12) (default colors [15 14 13 12]) (let [ang (+ (* (math/rng-uniform RNG) math/pi) math/pi)] @{:pos @{:x (pos :x) :y (pos :y)} :vel @{:x (* (math/cos ang) 0.6) :y (* (math/sin ang) 0.6)} :friction friction :tick tick :colors @[;colors] :radius (* (math/rng-uniform RNG) radius) :dead? (fn p-dust-dead? [self] (< (self :radius) 1)) :update (fn p-dust-update [self] (particles/apply-velocity self) (particles/apply-friction self) (when (< (self :tick) 5) (/= (self :radius) 1.1) (when (and (= 0 (% (math/round (self :tick)) 2)) (> (length (self :colors)) 1)) (array/pop (self :colors)))) (particles/update-tick self)) :draw (fn p-dust-draw [{:pos pos :radius r :colors c :fill fill?}] (cam/circ (math/round (pos :x)) (math/round (pos :y)) (math/round r) (array/peek c)))})) (defn particles/plus [pos &named radius friction tick colors] (default radius 15) (default friction 0.96) (default tick 20) (default colors [2 0]) @{:pos @{:x (pos :x) :y (pos :y)} :vel @{:x (math/cos (* (math/rng-uniform RNG) math/pi 2)) :y (math/sin (* (math/rng-uniform RNG) math/pi 2))} :friction friction :ang (* (math/rng-uniform RNG) math/pi) :ang-v (- (* (math/rng-uniform RNG) 2) 1) :tick tick :colors colors :radius (* (math/rng-uniform RNG) radius) :dead? (fn p-plus-dead? [self] (< (self :radius) 1)) :update (fn p-plus-update [self] (particles/apply-velocity self) (particles/apply-friction self) (*= (self :ang-v) 0.9) (+= (self :ang) (self :ang-v)) (when (< (self :tick) 5) (/= (self :radius) 1.1)) (particles/update-tick self)) :draw (fn p-plus-draw [self] (let [x (get-in self [:pos :x]) y (get-in self [:pos :y]) r (self :radius) a (self :ang) b (+ (self :ang) math/pi) c (+ (self :ang) (/ math/pi 2)) d (+ (self :ang) (/ (* math/pi 3) 2)) xa (math/cos a) ya (math/sin a) xb (math/cos b) yb (math/sin b) xc (math/cos c) yc (math/sin c) xd (math/cos d) yd (math/sin d) fxa (math/round (+ x (* xa r))) fya (math/round (+ y (* ya r))) fxb (math/round (+ x (* xb r))) fyb (math/round (+ y (* yb r))) fxc (math/round (+ x (* xa r))) fyc (math/round (+ y (* ya r))) fxd (math/round (+ x (* xb r))) fyd (math/round (+ y (* yb r)))] (cam/line fxa (- fya 1) fxb (- fyb 1) (get-in self [:colors 1])) (cam/line fxc (- fyc 1) fxd (- fyd 1) (get-in self [:colors 1])) (cam/line fxa fya fxb fyb (get-in self [:colors 0])) (cam/line fxc fyc fxd fyd (get-in self [:colors 0])) (cam/line fxa (+ fya 1) fxb (+ fyb 1) (get-in self [:colors 0])) (cam/line fxc (+ fyc 1) fxd (+ fyd 1) (get-in self [:colors 0]))))}) (defn particles/triangle [pos &named radius friction tick colors] (default radius 15) (default friction 0.96) (default tick 20) (default colors [12 5]) (let [ang (* (math/rng-uniform RNG) math/pi 2)] @{:pos @{:x (pos :x) :y (pos :y)} :vel @{:x (math/cos ang) :y (math/sin ang)} :friction friction :tick tick :ang (* (math/rng-uniform RNG) math/pi) :ang-v (- (* (math/rng-uniform RNG) 2) 1) :colors colors :radius (* (math/rng-uniform RNG) radius) :dead? (fn p-triangle-dead? [self] (< (self :radius) 1)) :update (fn p-triangle-update [self] (particles/apply-velocity self) (particles/apply-friction self) # rotation friction & velocity (*= (self :ang-v) 0.9) (+= (self :ang) (self :ang-v)) # update radius and color (when (< (self :tick) 5) (/= (self :radius) 1.1)) (particles/update-tick self)) :draw (fn p-triangle-draw [self] (let [x (get-in self [:pos :x]) y (get-in self [:pos :y]) r (self :radius) a (self :ang) b (+ (self :ang) (* (/ 2 3) math/pi)) c (+ (self :ang) (* (/ 4 3) math/pi)) xa (math/cos a) ya (math/sin a) xb (math/cos b) yb (math/sin b) xc (math/cos c) yc (math/sin c)] (cam/tri (math/round (+ x (* xa r 1.1))) (math/round (+ y (* ya r 1.1))) (math/round (+ x (* xb r 1.1))) (math/round (+ y (* yb r 1.1))) (math/round (+ x (* xc r 1.1))) (math/round (+ y (* yc r 1.1))) (get-in self [:colors 0])) (cam/tri (math/round (+ x (* xa r))) (math/round (+ y (* ya r))) (math/round (+ x (* xb r))) (math/round (+ y (* yb r))) (math/round (+ x (* xc r))) (math/round (+ y (* yc r))) (get-in self [:colors 1]))))})) # Textbox (defn textbox/parse-script [input] (peg/match ~{:bool (+ (* (constant true) "true") (* (constant false) "false")) :pos-int (number (some (range "09"))) :pos-float (number (some (+ (range "09") "."))) :command (replace (* "(" (+ (* (constant :voice) "voice " :pos-int) (* (constant :speed) "speed " :pos-float) (* (constant :color) "color " :pos-int) (* (constant :wiggle) "wiggle " :bool)) ")" (any " ")) ,struct) :word (replace (* (constant :word) (<- (* (some (+ (range "az" "AZ" "09") (set "',.?!"))) (any " ")))) ,struct) :character-name (replace (* (constant :name) (replace (* (<- (some (+ (range "az" "AZ" "09") " ")))) ,string/trim)) ,struct) :source-line (* "~ " :character-name (any :command)) :dialogue-line (* "| " (some (choice :command :word)) (constant :wait)) :main (* :source-line (some :dialogue-line) (constant :complete))} input)) (defn textbox/init [script &named progress-fn draw-frame pos box padding] """ (def text '~ Hans Zimmer (voice 0) | (wiggle true) Lorem ipsum (wiggle false) | (color 4) dolor (color 12) sit amet, | (speed 0.2) consectetur (speed 1) adipiscing elit') (def *TB* (textbox/create text)) (:update *TB* 1) (:draw *TB*) """ (default progress-fn (fn textbox/default-progress-fn [self] (tic80/btnp 0))) (default draw-frame (fn textbox/default-draw-frame [{:pos pos :box box}] # background (tic80/rect (pos :x) (pos :y) (box :width) (box :height) 0) # border (tic80/rectb (pos :x) (pos :y) (box :width) (box :height) 12))) (default pos {:x 0 :y 106}) (default box {:width 240 :height 30}) (default padding {:x 3 :y 3}) @{:pos pos :box box :padding padding :script (textbox/parse-script script) :script-i 0 :script-page 0 :text @[] :text-cursor 0 :text-tick 0 # parameters that are controlled by script commands :name nil :voice nil :color 12 :speed 1 :wiggle false :complete false # methods :progress? progress-fn :draw-frame draw-frame :length-of-text (fn textbox/length-of-text [self] (if (empty? (self :text)) 0 (+ ;(map |(length ($ :word)) (self :text))))) :consume-next-script-command (fn textbox/consume-next-script-command [self] (match (get (self :script) (self :script-i)) :wait (do (array/clear (self :text)) (put self :text-cursor 0) (++ (self :script-page))) :complete (put self :complete true) {:word word} (array/push (self :text) {:word word :color (self :color) :wiggle (self :wiggle) :width (text-width word)}) {:name n} (put self :name n) {:voice v} (put self :voice v) {:speed s} (do (put self :speed s) (put self :text-tick 0)) {:color c} (put self :color c) {:wiggle w} (put self :wiggle w)) (++ (self :script-i))) :scroll-text (fn textbox/scroll-text [self dt] (+= (self :text-tick) (self :speed)) (->> (self :text-cursor) (+ (self :text-tick)) (min (:length-of-text self)) (math/floor ) (put self :text-cursor)) (when (>= (self :text-tick) 1) (put self :text-tick 0) (when (and (not (nil? (self :voice))) (< (self :text-cursor) (:length-of-text self))) (tic80/sfx (self :voice))))) :can-consume-next-script-command (fn textbox/can-consume-next-script-command [self] (match (get (self :script) (self :script-i)) :wait (:progress? self) _ true)) :update (fn textbox/update [self dt] (if (and (= (:length-of-text self) (self :text-cursor)) (:can-consume-next-script-command self)) (:consume-next-script-command self) (:scroll-text self dt))) :draw (fn textbox/draw [self] (:draw-frame self) (let [{:pos pos :text text :text-cursor text-cursor} self] # offsets will keep track of the final x & y to draw to (var offset-x (pos :x)) (var offset-y (pos :y)) # this will count down as we approach the text-cursor cutoff (var remaining-cursor text-cursor) # outer loop, word by word (loop [text-word :in text :let [{:word word :color color :wiggle wiggle :width width} text-word # handle case where the text-cursor is mid-word sliced-word (if (> remaining-cursor (length word)) word (string/slice word 0 remaining-cursor))] # before printing, update our offsets. # specifically, when the width of word + offset is out of bounds # drop the text down to the next line. :before (when (> (+ width offset-x) (- (get-in self [:box :width]) 5)) (+= offset-y 8) (set offset-x (pos :x))) # after printing the word, decrease our remianing cursor # by its length :after (-= remaining-cursor (length word)) # inner loop, char in word [char-count char ] :pairs sliced-word :let [char-as-str (string/from-bytes char) # the wiggle effect uses some fancy sin math # ... sorry about the magic numbers wiggle-offset (-> (* char-count 20) (+ (/ (tic80/time) 100)) (math/sin) (math/floor))] # after printing update the x offset :after (+= offset-x (text-width char-as-str))] # actual print to screen! (tic80/print char-as-str (+ offset-x (get-in self [:padding :x])) (+ offset-y (get-in self [:padding :y]) (if wiggle wiggle-offset 0)) color))))}) # SFX functions (defn sfx/jump-up [] (tic80/sfx 32 "C#5" -1 3)) (defn sfx/jump-down [] (tic80/sfx 33 "F#4" -1 3)) (defn sfx/take-offering [] (tic80/sfx 34 "G-6" -1 3)) (defn sfx/place-offering [] (tic80/sfx 35 "D-6" -1 3)) (defn sfx/good-offering [] (tic80/sfx 36 "C-7" -1 3)) (defn sfx/bad-offering [] (tic80/sfx 37 "C-3" -1 3)) (defn sfx/near-death [] (tic80/sfx 37 "C-5" -1 3)) # Offering: held by acolyte and place on altar (defn create-offering [posx posy id] (if (nil? id) # if the offering is nil, create a dummy empty object @{:id nil :shift-x (fn [self] nil) :move-y (fn [self newy] nil) :update (fn [self] nil) :draw (fn [self] nil)} @{:pos @{:x (- posx 24) :y (+ posy 12)} :old-pos @{:x (- posx 24) :y (+ posy 12)} :des-pos @{:x posx :y posy} :move-x-tick 0 :move-y-tick 0 :id id :bounce-offset (math/rng-int RNG 40) :move-y (fn acolyte-move-to [self newy] (put self :move-y-tick 0) (put-in self [:old-pos :y] (get-in self [:des-pos :y])) (put-in self [:des-pos :y] newy)) :move-x (fn acolyte-move-to [self newx] (put self :move-x-tick 0) (put-in self [:old-pos :x] (get-in self [:des-pos :x])) (put-in self [:des-pos :x] newx)) :shift-x (fn offering-shift [self] (:move-x self (+ ((self :des-pos) :x) 24))) :update (fn offering-update [self] (let [pos (self :pos) move-x-tick (self :move-x-tick) move-y-tick (self :move-y-tick) {:x old-x :y old-y} (get self :old-pos) {:x des-x :y des-y} (get self :des-pos) y-lerp (if (< old-y des-y) lerp-in-quad lerp-in-linear)] (when (<= move-x-tick 1) (put pos :x (lerp-in-linear old-x des-x move-x-tick)) (put self :move-x-tick (min 1 (+ 0.15 move-x-tick)))) (when (<= move-y-tick 1) (put pos :y (y-lerp old-y des-y move-y-tick)) (put self :move-y-tick (min 1 (+ 0.1 move-y-tick)))))) :draw (fn offering-draw [{:pos pos :id id :des-x dx :bounce-offset bo}] (let [spr (match id 0 352 1 356 2 360) spr (if (> (% (+ bo (/ (tic80/time) 10)) 80) 40) spr (+ spr 2)) {:x x :y y} pos] (cam/spr spr (math/round x) (math/round y) 11 1 0 0 2 2)))})) # Acolytes (defn create-acolyte [posx posy character-id] @{:pos @{:x posx :y posy} :shadow-y posy :old-y posy :des-y posy :move-tick 0 :move-delay 0 :spr-start (match character-id :boy 256 :girl 304) :move-state :idle :holding nil :holding-state :idle :holding-state-tick 0 :particles @[] :take-from (fn acolyte-take [self] (when (not= nil (self :holding)) (put self :holding-state :offer-right) (put self :holding-state-tick 20)) (self :holding)) :give-to (fn acolyte-take [self resource] (when (not (nil? resource)) (if (not (nil? (self :holding))) (put self :holding-state :offer-right-then-take-left) (put self :holding-state :take-left))) (put self :holding-state-tick 20) (put self :holding resource)) :move-y (fn acolyte-move-to [self newy] (put self :move-tick 0) (put self :move-delay (math/rng-int RNG 3)) (put self :old-y (self :des-y)) (put self :des-y newy)) :current-sprite (fn acolyte-current-sprite [{:holding holding :move-state mstate :holding-state hstate :holding-state-tick htick}] (match hstate :idle (if (nil? holding) (match mstate :idle [0 false] :jump-down [4 false] :jump-up [6 false]) (match mstate :idle [2 false] :jump-down [8 false] :jump-up [10 false])) :offer-right [14 false] :take-left [14 true] :offer-right-then-take-left (if (< 10 htick) [14 false] [14 true]))) :update (fn acolyte-update [self] (let [{:pos pos :des-y dy :old-y oy :move-tick mt :move-delay md} self y-diff (- (pos :y) dy)] # give movement of 3 acolytes slightly different delay (when (not= 0 md) (-- (self :move-delay))) # fake 3d jumping by having the shadow and actual pos # use different lerps. (when-let [moving (and (zero? md) (<= mt 1)) lerp-fn (if (neg? y-diff) lerp-in-quad lerp-in-linear) shadow-lerp-fn (if (neg? y-diff) lerp-in-linear lerp-in-quad )] (put pos :y (lerp-fn oy dy mt)) (put self :shadow-y (shadow-lerp-fn oy dy mt)) (put self :move-tick (min 1 (+ 0.1 mt)))) # Animation Move State (var old-state (self :move-state)) (put self :move-state (cond (< (math/abs y-diff) 1) :idle (neg? y-diff) :jump-down :jump-up)) (var new-state (self :move-state)) (when (not= old-state new-state) (for i 0 8 (->> (particles/dust {:x (+ (pos :x) 8) :y (+ (pos :y) 10)}) (array/push (self :particles))))) # Animation Take/Give state (if (pos? (self :holding-state-tick)) (-- (self :holding-state-tick)) (put self :holding-state :idle)) # Update particles, then remove any dead ones (particles/update (self :particles)) )) :draw (fn acolyte-draw [self] # Shadow (cam/elli (math/round (+ 7 (get-in self [:pos :x]))) (math/round (+ 10 (self :shadow-y))) 8 3 0) # Dust particles (map |(:draw $) (self :particles)) # Actual character (let [[sprite flip] (:current-sprite self)] (cam/spr (+ (self :spr-start) sprite) (math/round (get-in self [:pos :x])) (math/round (- (get-in self [:pos :y]) 12)) 11 1 (if flip 1 0) 0 2 3)))}) (defn create-acolyte-list [] @[(create-acolyte STARTING_X STARTING_Y :boy) (create-acolyte (+ STARTING_X 24) STARTING_Y :girl) (create-acolyte (+ STARTING_X 24 24) STARTING_Y :boy)]) # Titan: slowly walks towards the screen (defn create-titan [posx posy last-life] @{:pos @{:x posx :y posy} :size @{:w 1 :h 1} :y-offset 0 :head-y-offset 0 :last-life last-life :particles @[] :particle-spawn-tick 0 :update (fn titan-update [self life] (put self :last-life (min MAX_HEALTH life)) (put-in self [:size :w] (map-scales 0 MAX_HEALTH 52 0 (self :last-life))) (put-in self [:size :h] (map-scales 0 MAX_HEALTH 48 0 (self :last-life))) (put self :y-offset (map-scales 0 MAX_HEALTH -16 0 (self :last-life))) (put self :head-y-offset (map-scales 0 MAX_HEALTH -12 0 (self :last-life))) # Update particles, then remove any dead ones (let [{:x px :y py} (self :pos) {:w sw :h sh} (self :size) x (+ px -1 (math/rng-int RNG 2)) y (+ py (map-scales 0 MAX_HEALTH 40 0 (self :last-life))) radius (math/round (/ (+ sw sh) 8))] (when (> radius 0) (if (zero? (self :particle-spawn-tick)) (do (put self :particle-spawn-tick 2) (array/push (self :particles) (particles/dust {:x x :y y} :radius radius :friction 0.85 :colors [8 9]))) (-- (self :particle-spawn-tick))))) (particles/update (self :particles))) :draw-hands (fn titan-draw-hands [self] (let [{:pos pos :size size :y-offset y-offset} self uvs (if (or (>= (size :w) 28) (>= (size :h) 22)) [0 (+ 128 80) 32 24] [0 (+ 128 64) 16 16]) t (/ (tic80/time) 400) x-size-offset (* (size :w) 1.3) left-x (- (pos :x) x-size-offset) left-y (+ (pos :y) (math/sin t) y-offset) right-x (+ (pos :x) x-size-offset) right-y (+ (pos :y) (math/cos t) y-offset) ] (trect left-x left-y (size :w) (size :h) ;uvs false 11) (trect right-x right-y (* -1 (size :w)) (size :h) ;uvs false 11))) :draw-body (fn titan-draw-body [self] (let [{:pos pos :size size :y-offset y-offset} self t (/ (tic80/time) 700) x (- (pos :x) (/ (size :w) 2)) y (+ (pos :y) 4 (math/sin t) y-offset) uvs (if (or (>= (size :w) 28) (>= (size :h) 22)) [48 (+ 128 64) 24 16] [48 (+ 128 64) 24 16])] (trect x y (size :w) (size :h) ;uvs false 11))) :draw-head (fn titan-draw-head [self] (let [{:pos pos :size size :y-offset yo :head-y-offset hyo} self t (/ (tic80/time) 650) x (- (pos :x) (/ (size :w) 2)) y (+ (pos :y) (math/sin t) yo hyo) uvs (if (or (>= (size :w) 28) (>= (size :h) 22)) [32 (+ 128 64) 16 16] [32 (+ 128 64) 16 16])] (trect x y (size :w) (size :h) ;uvs false 11))) :draw (fn titan-draw [self] # titan is drawn in multiple parts using # textured triangles so that we can slowly # increase the size. (:draw-body self) (:draw-head self) (:draw-hands self) (map |(:draw $) (self :particles)))}) # Altar Row # DONE: need some sort of visual feedback when offering is accepted or denied # one solution is to simple have the offering explode green or red # the more complicated option would be for them to turn into green circles and fly to the score # DONE: fix bug where leaving an offering before new desired shows up causes list to never clear # DONE: clean up supply pixel art (defn create-altar [posx posy supply &opt start-with-expected initial-spawn-delay] (default start-with-expected true) (default initial-spawn-delay false) (var create-desired (fn create-desired [x y] (seq [i :range [0 (+ 2 (math/rng-int RNG 2))]] (create-offering (+ 58 (* i 18) x) (- y 24) (math/rng-int RNG 3))))) @{:pos {:x posx :y posy} :desired (if start-with-expected (create-desired posx posy) []) :offerings @[] :spawn-delay (if initial-spawn-delay initial-spawn-delay (+ 1 (math/rng-int RNG 200))) :supply supply :compare-delay 0 :particles @[] :update (fn update-altar [self max-spawn-delay] (map |(:update $) (self :offerings)) # Update particles, then remove any dead ones (particles/update (self :particles)) # when spawn-delay completes # fill an array of size 2 or 3 with random numbers # between 0-2, otherwise just decrement delay by 1 (cond (and (= 0 (self :spawn-delay)) (empty? (self :desired))) (put self :desired (create-desired (get-in self [:pos :x]) (get-in self [:pos :y]))) (> (self :spawn-delay) 0) (-- (self :spawn-delay))) # When compare-delay completes # check if desired == offerred (cond (and (= 0 (self :compare-delay)) (not (empty? (self :desired))) (not (empty? (self :offerings)))) (let [len-offering (length (self :offerings)) len-desired (length (self :desired)) good-offering (deep= (map |($ :id) (self :offerings)) (map |($ :id) (self :desired)))] (when (and (>= len-offering len-desired) (> len-desired 0)) (:shake-it SHAKER 7 4) (put self :compare-delay -1) (put self :offerings @[]) (put self :spawn-delay (+ 1 (math/rng-int RNG max-spawn-delay))) (for i 0 10 (->> (if good-offering (particles/triangle (self :pos)) (particles/plus (self :pos))) (array/push (self :particles)))) (if good-offering (sfx/good-offering) (sfx/bad-offering))) (if good-offering (do (put self :desired @[]) [true len-offering]) false)) (> (self :compare-delay) 0) (do (-- (self :compare-delay)) false))) :draw (fn altar-draw [{:offerings offerings :desired desired :particles particles}] (map |(:draw $) offerings) (map |(:draw $) desired) (map |(:draw $) particles)) :offer (defn altar-offer [self new-offering] (when (not (nil? (new-offering :id))) (:move-x new-offering (+ (get-in new-offering [:des-pos :x]) (* (length (self :offerings)) 24))) (:move-y new-offering (- (get-in self [:pos :y]) 12)) (array/push (self :offerings) new-offering) (put self :compare-delay (if (> (length (self :offerings)) (length (self :desired))) 0 15))))}) (defn create-altar-list [&opt start-with-expected initial-spawn-delay] (default start-with-expected true) (default initial-spawn-delay false) @[(create-altar 152 64 0 start-with-expected initial-spawn-delay) (create-altar 152 88 1 start-with-expected initial-spawn-delay) (create-altar 152 112 2 start-with-expected initial-spawn-delay)]) # Game Over gamestate (defn create-over-gamestate [new-score] (tic80/vbank 0) (tic80/cls 0) (tic80/vbank 1) (tic80/cls 0) (let [current-highscore 0 # (tic80/pmem 1) new-high-score? (> new-score current-highscore)] # (when new-high-score? # (tic80/pmem 1 new-score)) @{:update (fn over-update [self dt] (when (btnp-any LEFT RIGHT UP DOWN A B X Y) (tic80/reset))) :draw (fn over-draw [self] (tic80/vbank 1) (tic80/cls 2) (print-shadowed "click anything to try again." 120 60) (print-shadowed (string/format "Your Score: %i" new-score) 120 80) # NOTE highscore broken on html # (if new-high-score? # (print-shadowed (string/format "New High Score! %i" new-score) 45 80) # (do (print-shadowed (string/format "Current High Score: %i" current-highscore) 45 80) # (print-shadowed (string/format "Your Score: %i" new-score) 45 90))) ) :bdr (fn title-bdr [self scanline] nil)})) # Main Game gamestate (defn move-acolytes [self dir] """ Move the acolytes either up or down to a different altar. self must have :current-altar, :altars, :acolytes, :offerings fields """ # play sound effect (match dir :up (sfx/jump-up) :down (sfx/jump-down)) # update the current altar (put self :current-altar (-> (+ (self :current-altar) (match dir :up -1 :down 1)) (min 2) (max 0))) # set the desired y coord for each acolyte (let [new-y (get-in self [:altars (self :current-altar) :pos :y])] (map |(:move-y $ (- new-y 6)) (self :acolytes)) (map |(:move-y $ (- new-y 30)) (self :offerings)))) (defn take-offering [self resource] """ Take the resource and pass holdings forward """ (let [{:acolytes acolytes :altars altars :current-altar current-altar :offerings offerings} self] # pass everything else along (->> (:take-from (acolytes 1)) (:give-to (acolytes 2))) (->> (:take-from (acolytes 0)) (:give-to (acolytes 1))) (->> resource (:give-to (acolytes 0))) # move the offerings (map |(:shift-x $) offerings) # Create new resource, if its not nil (array/push offerings (create-offering STARTING_X (- (get-in (acolytes 0) [:pos :y]) 24) resource)) # when offerings length exceeds 3, # place the last one one the altar (if-let [surplus? (> (length offerings) 3) offering (offerings 0)] (do # play sound effect of placing on alter, if its actually something (if (nil? (get offering :id nil)) (sfx/take-offering) (sfx/place-offering)) # altar takes control of the offering, so remove it here (array/remove offerings 0 1) # then add it to the altar (:offer (altars current-altar) offering)) # otherwise, play sound effect of just taking from supply (sfx/take-offering)))) (defn handle-input [self] (cond (tic80/btnp UP) (:move self :up) (tic80/btnp DOWN) (:move self :down)) (cond (btnp-any LEFT A) (:take self (get-in self [:altars (self :current-altar) :supply])) (btnp-any RIGHT B) (:take self nil))) # Main Game state (defn create-main-gamestate [] (:y-to CAMERA 0 lerp-out-quad) @{:score 0 :life MAX_HEALTH :acolytes (create-acolyte-list) :current-altar 1 :altars (create-altar-list) :offerings @[] :titan (create-titan 150 23 MAX_HEALTH) :state :slide-in # :ready? :play :over-screen-swipe :over :volumes-current [1 1 1 1] :volumes-desired [0.1 0.1 0.1 1] :volumes-tick 0 :volumes-tick-speed 0.0001 :near-death-tick 0 :near-death-cutoff 350 :over-screen-wipe 0 :ready-tick 60 :next-state (fn gamestate-next-state [self] (put self :state (match (self :state) :slide-in :ready? :ready? :play :play :over :over nil)) (when (= (self :state) :play) (tic80/music 2) (put self :volumes-desired [0.4 0.2 0 1])) (when (= (self :state) :over) (tic80/music 3 -1 -1 false) (put self :volumes-desired [1 1 1 1]) (put self :volumes-tick-speed 0.1))) :difficulty (fn gamestate-difficulty [{:score score}] (cond (> score 8000) {:spawn-delay 120 :life-drain 2.1 :score-multiply 1.3} (> score 7000) {:spawn-delay 120 :life-drain 2.0 :score-multiply 1.2} (> score 6000) {:spawn-delay 140 :life-drain 1.9 :score-multiply 1.2} (> score 5000) {:spawn-delay 140 :life-drain 1.8 :score-multiply 1.2} (> score 4000) {:spawn-delay 160 :life-drain 1.7 :score-multiply 1.1} (> score 3000) {:spawn-delay 160 :life-drain 1.6 :score-multiply 1.1} (> score 2000) {:spawn-delay 180 :life-drain 1.3 :score-multiply 1.1} (> score 1000) {:spawn-delay 180 :life-drain 1.1 :score-multiply 1} {:spawn-delay 200 :life-drain 1.0 :score-multiply 1})) :move move-acolytes :take take-offering :update (fn gamestate-update [self dt] (handle-input self) (map |(:update $) (self :acolytes)) (map |(:update $) (self :offerings)) # Need to treat offerings a little differently, since they may # return life to add to the health (each altar (self :altars) (when-let [{:score-multiply score-multiply :spawn-delay spawn-delay} (:difficulty self) offer-result (:update altar spawn-delay) score (match offer-result [true 2] 200 [true 3] 300 0)] (+= (self :score) score) (+= (self :life) (* score score-multiply)) (put self :volumes-desired (map |(min 1 (+ 0.1 $)) (self :volumes-desired))))) (:update (self :titan) (self :life)) (match (self :state) :slide-in (when (nil? (CAMERA :y-goal)) (:next-state self)) :ready? (if (= 0 (self :ready-tick)) (:next-state self) (-- (self :ready-tick))) :play (do (-= (self :life) (get (:difficulty self) :life-drain)) (when (>= 0 (self :life)) (:next-state self)) (when (< (self :life) 300) (:shake-it SHAKER 10 2)) # if we're near death, periodically play a warning sfx (when (< (self :life) (self :near-death-cutoff)) (if (zero? (self :near-death-tick)) (do (sfx/near-death) (put self :near-death-tick 60)) (-- (self :near-death-tick))))) :over (if (< (self :over-screen-wipe) 100) (++ (self :over-screen-wipe)) (set GS (create-over-gamestate (self :score))))) # Dynamic music # lerp current volumes to the desired ones (put self :volumes-current (map |(lerp-in-linear ($ 1) ((self :volumes-desired) ($ 0)) (self :volumes-tick)) (pairs (self :volumes-current)))) (put self :volumes-tick (min 1 (+ (self :volumes-tick-speed) (self :volumes-tick)))) # actually set the volumes (each (i v) (pairs (self :volumes-current)) (set-channel-register-volume i v))) :draw (fn gamestate-draw [self] # BANK 0: ocean background (with wave effect from bdr) (tic80/vbank 0) (tic80/cls 0) (cam/map 30 0) # BANK 1: everything else (tic80/vbank 1) # set palette entry 11 to transparent (tic80/poke 0x03FF8 11) # Clear with the transparent color, so that any pixel we # dont draw on will let through vbank 0 (tic80/cls 11) # Stars (cam/map 60 17 30 24 0 (* 21 -8) 0) (:draw (self :titan)) # Map is split into layers so we can use transparency # to avoid grass + temple tile permutations (cam/map 30 17 30 17 0 0 11) (cam/map 30 51 30 17 0 0 8) (cam/map 30 34 30 17 0 0 8) # Entities (map |(:draw $) (self :altars)) (map |(:draw $) (self :acolytes)) (map |(:draw $) (self :offerings)) # draw the final map layer after the entities for # some extra depth (cam/map 30 68 30 17 0 0 8) # UI (tic80/map 0 0 11 3) (tic80/print (string (math/round (self :score))) 50 2 12) (tic80/print (string (math/round (self :life))) 44 10 (cond (> (self :life) 500) 5 (> (self :life) 300) 4 (> (self :life) 150) 3 2)) (when-let [should-print-ready? (or (= :slide-in (self :state)) (= :ready? (self :state))) text "Ready?" width (text-width "Ready?" true 2) x 120 y 68] (cam/rect (- x (/ width 2) 4) (- y 4) (+ width 6) 20 0) (cam/rectb (- x (/ width 2) 5) (- y 5) (+ width 7) 21 13) (cam/print text (- x (/ width 2)) (+ y 1) 1 true 2) (cam/print text (- x (/ width 2)) y 12 true 2)) # game over transition effect (when (= :over (self :state)) (cam/circ 120 68 (math/round (map-scales 0 100 0 200 (self :over-screen-wipe))) 2)) ) :bdr (fn gamestate-bdr [self scanline] # Create a screen/water wave effect on the ocean (vbank 0). # Basic Idea here is to use a big sine wave offset by the # current scan line, then poke the SCREEN OFFSET address # with our generated offset. (when (= :play (self :state)) (tic80/vbank 0) (let [depth 5 speed 0.001 height 10 offset (-> (+ (* (tic80/time) speed) (/ scanline height)) (math/sin) (* depth) (math/round))] (tic80/poke 0x3ff9 offset)) (tic80/vbank 1)) )}) # Tutorial NOTE: that this steals/uses some functions from main-game # NOTE: yayaya global vars are bad... but I needed a way to # know when an altar has been completed (var altar-completed false) # ...and an easy way to set volume of music channels (var tutorial-volume 1) (defn has-pressed [tb buttons] (when (btnp-any ;buttons) (put tb :has-pressed true)) (tb :has-pressed)) (defn tutorial-progress [tb] (if-let [prog-fn (match (tb :script-page) 0 |(and (wait $ 60) (has-pressed $ [UP DOWN])) 1 |(wait $ 60) 2 |(and (wait $ 60) (has-pressed $ [LEFT A])) 3 |(wait $ 60) 4 |(and (wait $ 60) (has-pressed $ [RIGHT B])) 5 |(wait $ 60) 6 |(and (wait $ 60) altar-completed) 7 |(wait $ 100) 8 |(wait $ 60) 9 |(wait $ 100)) should-progress? (prog-fn tb)] (do (put tb :wait-ticks 0) (put tb :has-pressed false) (set tutorial-volume (min 1 (+ tutorial-volume 0.1))) true) false)) (defn create-tutorial-gamestate [] (set altar-completed false) (:y-to CAMERA 0 lerp-out-quad) @{:textbox nil :acolytes (create-acolyte-list) :altars (create-altar-list false 99999999) :current-altar 1 :offerings @[] :state :slide-in # :teach :slide-out :move move-acolytes :take take-offering :next-state (fn tutorial-next-state [self] (put self :state (match (self :state) :slide-in :teach :teach :slide-out :slide-out nil)) (match (self :state) :teach (do (tic80/music 4) (put self :textbox (textbox/init "~ Tutorial (voice 48) | To spurn the old gods sacrifices must be made. Press (color 5)UP (color 12) and (color 5)DOWN (color 12) to move the acolytes. | (wiggle true)Well Done.(wiggle false) | Press (color 5)LEFT (color 12) or (color 5)A (color 12) to take a sacrifice from the supply. | (wiggle true)Thats it.(wiggle false) | Press (color 5)RIGHT (color 12) or (color 5)B (color 12) to pass sacrifices without taking. | (wiggle true)Nice.(wiggle false) | Fulfil the sacrifice show at the altars. | (wiggle true)Good.(wiggle false) | Each successful sacrifice will (color 2)increase your life (color 12), and (color 2)push back the Titan(color 12). | Push back the Titan for as long as you can... (speed 0.1) (wiggle true)Good luck(wiggle false)" :progress-fn tutorial-progress :pos {:x 0 :y 0}))) :slide-out (:y-to CAMERA 136 lerp-in-linear))) :update (fn tutorial-update [self dt] (handle-input self) (map |(:update $) (self :acolytes)) (map |(:update $) (self :offerings)) (when (not (nil? (self :textbox))) (:update (self :textbox) dt) (each altar (self :altars) (when (= 6 (get-in self [:textbox :script-page])) (put altar :spawn-delay 0)) (match (:update altar 50) [true _] (set altar-completed true)))) (match (self :state) :slide-in (do (set tutorial-volume (max 0.1 (- tutorial-volume 0.005))) (when (and (nil? (CAMERA :y-goal)) (wait self 55)) (:next-state self))) :teach (when (get-in self [:textbox :complete]) (:next-state self)) :slide-out (do (set tutorial-volume (max 0 (- tutorial-volume 0.004))) (when (nil? (CAMERA :y-goal)) (tic80/reset)))) (each channel [0 1 2] (set-channel-register-volume 0 tutorial-volume))) :draw (fn tutorial-draw [self] (tic80/vbank 1) (tic80/cls 0) # draw stars (tic80/poke 0x03FF8 0) # set 0 to transperent (cam/map 60 17 30 16 0 136) # Stars below the screen (cam/map 90 0 30 16) # draw some layers from the main game (tic80/poke 0x03FF8 11) # set 11 to transperent (cam/map 30 51 30 17 0 0 8) (cam/map 30 34 30 17 0 0 8) (map |(:draw $) (self :altars)) (map |(:draw $) (self :acolytes)) (map |(:draw $) (self :offerings)) # draw the final map layer after the entities for # some extra depth (cam/map 30 68 30 17 0 0 8) (when (self :textbox) (:draw (self :textbox)))) :bdr (fn title-bdr [self scanline] nil)}) # Title (def options [{:text "Tutorial" :gs create-tutorial-gamestate :y-goal -136} {:text "Begin" :gs create-main-gamestate :y-goal 136}]) # Title Gamestate (defn create-title-gamestate [] (tic80/vbank 0) (tic80/cls 0) (tic80/vbank 1) (tic80/cls 0) (tic80/music 0) @{:selected 0 :moving false :update (fn title-update [self dt] (cond (and (self :moving) (nil? (CAMERA :y-goal))) (do (*= (CAMERA :y-offset) -1) (set GS ((get-in options [(self :selected) :gs])))) (btnp-any A B X Y) (do (tic80/music 1) (:y-to CAMERA (get-in options [(self :selected) :y-goal]) lerp-in-quad) (put self :moving true)) (btnp-any DOWN) (++ (self :selected)) (btnp-any UP) (-- (self :selected))) (cond (neg? (self :selected)) (put self :selected 0) (= (self :selected) (length options)) (put self :selected (- (length options) 1)))) :draw (fn title-draw [{:transition t :transition-goal t-goal :selected selected}] (tic80/vbank 1) (tic80/cls 0) (cam/map 60 17 30 16 0 -136) # Stars above the screen (cam/map 60 0 30 34) # Stars (with-pallete-swap {13 2} (cam/map 0 17 30 17 2 6 0)) # DX (cam/map 0 34 30 17 0 0 0) # Title # oh hey thats me (cam/print "by Alec Troemel" 120 97 13) # options menu (loop [[i option] :pairs options :let [{:text text} option y-offset (+ 110 (* i 10)) length (cam/print text 40 y-offset 1 true)]] (cam/print text 40 (- y-offset 1) 12 true) (when (= i selected) (cam/rectb 38 (- y-offset 3) (+ 4 length) 9 14))) # current high score # (let [highscore-text (string/format "High Score: %i" (tic80/pmem 1))] # (cam/print highscore-text 150 121 9) # (cam/print highscore-text 150 120 12)) ) :bdr (fn title-bdr [self scanline] nil)}) (def *FPS* (fps/init)) (defn BOOT [] (set GS (create-title-gamestate))) (defn TIC [] (:update SHAKER) (:update CAMERA) (:update GS (/ 1 (:get-value *FPS*))) (:draw GS)) (defn BDR [scanline] (:bdr GS scanline))