123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289 |
- ;TODO find home for these game fns
- (fn things-at [v col]
- ;list of all entities at a world pos
- ;naive, replace with bucket hash at some point
- (var found [])
- (each [_ e (ipairs col)]
- (if (and e.pos (point= e.pos v))
- (add found e))) found)
- (fn entities-at [v] (things-at v entities))
- (fn items-at [v] (things-at v items))
- (fn triggers-at [v] (things-at v triggers))
- (fn trigger-at [v] (let [xs (triggers-at v)]
- (if (not (empty? xs)) (first xs))))
- (fn blood [v n c]
- (let [pv (->view (vadd (vmul v 8) (point 4 4)))]
- (for [i 1 n]
- (var c {
- :type :circ
- :pos (vadd pv (rand-point 4))
- :r 1 :c (or c 6)})
- (add fx c)
- (wait (rand 5) (fn []
- (tween c :r (rand 4) 6 {:f (fn [c]
- (tween c :r 0 6 {:f (fn [c] (remove fx c))}))}))))))
- (fn text-fx [v s c]
- (let [pv (->view (vadd (vmul v 8) (point 4 4)))]
- (var c {
- :type :text
- :value s
- :pos pv
- :c c})
- (add fx c)
- (tween pv :y (- pv.y 8) 20 {:f
- (fn [o] (remove fx c))})))
- (fn attack-fx [a b] ;animate the attack sprite towards the target
- (let [dif (vsub b a)
- s (if
- (point= dif (point -1 0)) 241
- (point= dif (point 1 0)) 242
- (point= dif (point 0 -1)) 243
- (point= dif (point 0 1)) 244 241)
- a (->view (vmul a 8))
- b (->view (vmul b 8))]
- (var c {
- :type :sprite
- :value s
- :pos a})
- (add fx c)
- (tween c :pos b 10 {:l vlerp :f
- (fn [o] (remove fx c)) })))
- (fn kill-player [s]
- (set DEATHMSG s)
- (set LOOP :death)
- (set depth 0)
- (song! 2)
- (music 2 0 0 false)
- (set creditsv (point 120 74))
- (wait 200 (fn []
- (tween creditsv :y -500 3000))))
- (fn kill [e]
- (blood e.pos 8)
- ;TODO but what if PLAYER is ME?
- (remove entities e)
- (if
- (= e.name :ohno)
- (kill-player true)
- e.player
- (kill-player false)
- (do
- (wait 1 (fn [] (table.insert msgs 1 (.. "you kill the " e.name)))))))
- (fn attack [e target]
- (attack-fx e.pos target.pos)
- (if (calc-hit e target)
- (let [amount (calc-damage e target)]
- (update target :hp
- (fn [n] (- n amount)))
- (blood target.pos 2)
- (text-fx target.pos (.. amount) 6)
- (sound! :hit))
- (do
- (sound! :miss)))
- (when (< target.hp 0)
- (set e.exp (+ e.exp (exp-value target)))
- (kill target)))
- (fn hat-swap [e target]
- (let [th (. (or target.equip.head {}) :name) ph (. (or e.equip.head {}) :name)]
- (if (and e.equip.head (not th))
- (when true
- (wait 1 (fn [] (table.insert msgs 1 (.. "thanks, " target.equip.head.msg))))
- (var tmp target.equip.head)
- (set target.equip.head e.equip.head)
- (set e.equip.head tmp))
- (wait 1 (fn [] (table.insert msgs 1 (if target.equip.head target.equip.head.msg "hello!")))))))
- (fn bump [e col]
- ; should not all happen at once (attacks)
- ; also check for hit dice etc.
- (let [target (rand-nth col)]
- (if
- (and (or e.player (and e.monster target.player)) (not (or e.passive target.passive)))
- (attack e target))
- (if
- (and e.player target.townie)
- (hat-swap e target))))
- (fn walk [e dir]
- (let [target (vadd e.pos dir)]
- (when (~= 0 (gget world target))
- (let [found (entities-at target)]
- (if (not (empty? found))
- (bump e found)
- (do
- (tset e :pos (vadd (. e :pos) dir))
- (tset e :offset (vmul dir -8))
- (tween e :offset (point 0 0) 10 {:l vlerp :e (powf 2)})))))))
- (fn pickup [e]
- (let [found (first (things-at e.pos items))]
- (when found
- (if found.amount
- (do (set player.gold (+ player.gold found.amount))
- (remove items found))
- (when (and (< (# e.inventory) e.inventory-limit))
- (remove items found)
- (add e.inventory found))))))
- (var A 1)
- (var B 3)
- (when (chance 50)
- (set A 3)
- (set B 1))
- (var dung-song A)
- (fn flip-song [] (wait 6000
- (fn [_]
- (trace "FLIP 1")
- (set dung-song A)
- (wait 6000
- (fn [_]
- (trace "FLIP 3")
- (set dung-song B)
- (flip-song))))))
- (flip-song)
- (var _button_dirty false)
- (fn action [e]
- ;find an appropriate action for situation
- (let [t (trigger-at e.pos)
- i (items-at e.pos)]
- (when (not _button_dirty)
- (if (not (empty? i))
- (pickup e)
- (and t t.stairs)
- (do
- (cache-level)
- (set depth (+ depth t.dir))
- (if (not (load-cache depth))
- (change-level t.dir))
- (clear-cache)
- (if (= depth 0) (song! 0)
- (song! dung-song)))
- :pass))))
- (fn recall [e]
- (if (= depth 0)
- (do (cache-level)
- (set depth DEEPEST)
- (load-cache DEEPEST)
- (song! dung-song))
- (do
- (cache-level)
- (set depth 0)
- (load-cache 0)
- (song! 0) )))
- (fn drop [e o]
- (tset o :pos (copy e.pos))
- (add items o)
- (remove e.inventory o))
- (fn wear [e o]
- (if
- o.wear ;TODO should check if wear key is in equip
- (if true ;(has-key? e.equip o.wear)
- (let [old (. e.equip o.wear)]
- (remove e.inventory o) ;could not even be there
- (if old (add e.inventory old)) ;TODO check inventory limit?
- (tset e.equip o.wear o)))
- o.weapon
- (let [old e.weapon]
- (if old (add e.inventory old))
- (remove e.inventory o)
- (set e.weapon o)) ))
- (fn unwear [e o]
- (each [k v (pairs e.equip)]
- (when (= v o)
- (tset e.equip k false)
- (add e.inventory o))))
- (fn draw-fx []
- (each [_ m (ipairs fx)]
- (if (= m.type :circ)
- (circ m.pos.x m.pos.y m.r m.c)
- (= m.type :sprite)
- (spr m.value m.pos.x m.pos.y (or m.mask 0))
- (= m.type :text)
- (do
- (print m.value (+ m.pos.x 1) (+ m.pos.y 1) 0)
- (print m.value (- m.pos.x 1) (- m.pos.y 1) 0)
- (print m.value m.pos.x m.pos.y m.c)) )))
- (fn path-towards [a b]
- (vfn (vnorm (vsub b a))
- (fn [n] (if (< n 0) -1 (> n 0) 1 0))))
- ; systems
- (local sprites (system [:pos :sprite] (fn [e]
- (let [v (if e.offset
- (->view (vadd (vmul e.pos 8) e.offset))
- (->view (vmul e.pos 8)))]
- (if e.nomask
- (spr e.sprite v.x v.y)
- e.mask
- (spr e.sprite v.x v.y e.mask)
- (spr e.sprite v.x v.y 0))
- (if (and e.equip e.equip.feet)
- (spr e.equip.feet.sprite v.x (+ v.y 1) 0))
- (if (and e.equip e.equip.head)
- (spr e.equip.head.sprite v.x (- v.y 5) 0))
- (if (and e.equip e.equip.body)
- (spr e.equip.body.sprite v.x (+ v.y 2) 0))
- (if e.weapon
- (spr e.weapon.sprite (+ v.x 4) (- v.y 2) 0))))))
- (local stat-updates (system [:exp :level] (fn [e]
- (when (> e.exp (exp-next e.level))
- (set e.exp (math.max 0 (- e.exp (exp-next e.level))))
- (set e.level (inc e.level))
- (set e.maxhp (+ e.maxhp (+ 3 (roll [1 5]))))
- (set e.hp e.maxhp)
- (sound! :levelup))
- )))
- (local brains (system [:ai] (fn [e]
- (if
- (= e.ai :hunt)
- (let [dir (path-towards e.pos player.pos)]
- (walk e dir))
- (= e.ai :wander)
- (let [dir (rand-nth cardinals)]
- (walk e dir))
- (= e.ai :slow-wander)
- (let [dir (rand-nth cardinals)]
- (if (= 0 (math.random 0 5)) (walk e dir)))
- (= e.ai :confused)
- (let [a (rand-nth cardinals)
- b (path-towards e.pos player.pos)]
- (walk e (rand-nth [a b])))
- (= e.ai :breed)
- (let [dir (rand-nth cardinals)]
- (if (chance 20)
- (when (> e.breed 0)
- (update e :breed dec)
- (add entities (copy e))
- (walk e dir))))))))
|