module Dodge.Placement.Instance.Door 
    ( putDoubleDoor
    , putAutoDoor
    , putDoubleDoorThen
    , switchDoor -- not used 9/3/22
    ) where
import Dodge.Data
import Dodge.Default.Door
import Color
import Geometry
import Dodge.LevelGen.Data
import Dodge.LevelGen.Switch

import Control.Lens

putDoubleDoor :: EdgeObstacle -> Wall -> WdBl -> Point2 -> Point2 -> Float -> Placement
putDoubleDoor eo wl cond a b speed 
    = putDoubleDoorThen eo wl cond 1 a b speed (const $ const Nothing)

putDoubleDoorThen ::EdgeObstacle ->  Wall -> WdBl 
    -> Float -> Point2 -> Point2 -> Float 
    -> (Placement -> Placement -> Maybe Placement)
    -> Placement
putDoubleDoorThen eo wl cond soff a b speed cont 
     = doorBetween eo wl cond soff a half speed
    $ \pl1 -> Just $ doorBetween eo wl cond soff b half speed
    $ \pl2 -> cont pl1 pl2
  where
    half = 0.5 *.* (a +.+ b)

doorBetween :: EdgeObstacle -> Wall -> WdBl -> Float -> Point2 -> Point2 -> Float ->
    (Placement -> Maybe Placement) -> Placement
doorBetween eo wl cond soff pa pb speed g = case divideLine 40 pa pb of
    [x,y] -> ptCont (PutSlideDr adoor wl eo soff x y) g
    (x:y:zs) -> divideDoorPane Nothing wl cond (soff - dist y pb) speed (zip (x:y:zs) (y:zs)) g
    _ -> undefined
  where
    adoor = defaultDoor
        & drTrigger .~ cond
        & drSpeed   .~ speed

divideDoorPane :: Maybe Int -> Wall -> WdBl -> Float -> Float 
    -> [(Point2,Point2)] -> (Placement -> Maybe Placement) -> Placement
divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
    [p] -> ptCont (adoor p) g
    (p:ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane (_plMID pl) wl cond soff speed ps g
    _ -> undefined
  where
    adoor (x,y) = PutSlideDr thedoor wl DoorObstacle soff x y
    thedoor = defaultDoor & drSpeed .~ speed & drTrigger .~ cond
        & drPushedBy .~ maybe PushesItself PushedBy mid

putAutoDoor :: Point2 -> Point2 -> Placement
putAutoDoor a b = PlacementUsingPos (addZ 0 a)
    $ \az -> PlacementUsingPos (addZ 0 b)
    $ \bz -> putDoubleDoor AutoDoorObstacle defaultAutoWall
        (cond az bz) a b 3
  where
    --cond az bz = any (crNearSeg 40 (stripZ az) (stripZ bz)) . IM.filter isAnimate . _creatures
    cond az bz = WdBlCrFilterNearPoint 40 (0.5 *.* (stripZ az +.+ stripZ bz)) CrIsAnimate
       --  any (crNearPoint 40 (0.5 *.* (stripZ az +.+ stripZ bz))) 
       -- . IM.filter isAnimate . _creatures

switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement
switchDoor btpos btrot dra drb col = pContID (PS btpos btrot) 
    (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect)
    $ \btid -> jsps0J (doorbetween btid dra drc)
    $          sps0   (doorbetween btid drb drc)
  where
    doorbetween btid a b = PutSlideDr thedoor (switchWallCol col) DoorObstacle 1 a b
      where
        thedoor = defaultDoor
            & drTrigger .~ WdBlBtOn btid
            & drSpeed   .~ 2
    drc = 0.5 *.* (dra +.+ drb)
    --cond btid w' = _btState (_buttons w' IM.! btid) == BtOn