{-# LANGUAGE BangPatterns #-}
module Dodge.LevelGen.MoveDoor
    ( doorMechan
    , zoneps
    , moveDoorToward
    , addSoundToDoor
    ) where
import Dodge.Data
import Dodge.Data.SoundOrigin
import Dodge.Base
import Dodge.Zone
import Dodge.Zone.Data
import Dodge.SoundLogic
import Dodge.SoundLogic.Synonyms
import Geometry

import qualified Data.IntMap.Strict as IM
import Control.Lens

-- This deserves a clean up
mvP :: Float -> Point2 -> Point2 -> Point2
{-# INLINE mvP #-}
mvP !speed !ep !p = mvPointTowardAtSpeed speed ep p

mvPs :: Float -> (Point2,Point2) -> (Point2,Point2) -> (Point2,Point2)
{-# INLINE mvPs #-}
mvPs !speed (!ex,!ey) (!sx,!sy) = (mvP speed ex sx,mvP speed ey sy)

moveDoorToward :: Float -> (Point2,Point2) -> Wall -> Wall
{-# INLINE moveDoorToward #-}
moveDoorToward speed (ex,ey) wls = wls & wlLine %~ mvPs speed (ex,ey)
--moveDoorToward !speed !(!ex,!ey) wls = wls & wlLine %~ bimap (f ex) (f ey)
--  where
--    f !p = mvPointTowardAtSpeed speed p

zoneps :: (Point2, Point2) -> [(Int,Int)]
{-# INLINE zoneps #-}
zoneps (a,b)
    | dist a b <= 2 * zoneSize 
                = [zoneOfPoint $ pHalf a b]
    | otherwise = map zoneOfPoint $ divideLine zoneSize a b

doorMechan 
    :: Int
    -> [(Int,Int)]
    -> (Wall -> Wall) 
    -> (Wall -> Wall) 
    -> (World -> Bool) 
    -> World 
    -> World
doorMechan n zonePs openEff closeEff cond w
    | cond w = flip (foldr $ changeZonedWall openEff n) zonePs
                $ over walls (IM.adjust openEff n) w
    | otherwise = flip (foldr $ changeZonedWall closeEff n) zonePs
                $ over walls (IM.adjust closeEff n) w

changeZonedWall
    :: (Wall -> Wall)
    -> Int
    -> (Int,Int)
    -> World
    -> World
changeZonedWall eff n (x,y) = over (wallsZone . znObjects) $ adjustIMZone eff x y n

addSoundToDoor :: Int -> Point2 -> Point2 -> [Wall] -> [Wall]
addSoundToDoor _   _   _ [] = error "When creating door tried to add sound to nothing"
addSoundToDoor i pld hwd (x:ys) = f x : ys
  where
    f wl = over doorMech g wl
      where
        g dm w 
            | dist wp pld > 2 && dist wp hwd > 2 
                        = soundFrom (WallSound i) wp doorSound (Just 1) $ dm w
            | otherwise = dm w
          where 
            wp = fst $ _wlLine (_walls w IM.! i)