aaa/systems.fnl

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