{-# LANGUAGE BangPatterns #-}
module Dodge.Wall.Move
    ( moveWallID
    , moveWallIDUnsafe
    , moveWall
    , moveWallIDToward
    , translateWallID
    , mvPs
    ) where
import Dodge.Data
import Dodge.Base
import Geometry
import Dodge.Wall.Zone

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

moveWallIDUnsafe :: Int -> (Point2,Point2) -> World -> World
moveWallIDUnsafe wlid wlline w = case w ^? walls . ix wlid of
    Nothing -> error "tried moving nonexistant wall"
    Just wl -> moveWall wlid wl wlline w

moveWallID :: Int -> (Point2,Point2) -> World -> World
moveWallID wlid wlline w = case w ^? walls . ix wlid of
    Nothing -> w
    Just wl -> moveWall wlid wl wlline w
moveWall :: Int -> Wall -> (Point2,Point2) -> World -> World
moveWall wlid wl wlline w = w & walls . ix wlid .~ newwl
    & deleteWallFromZones wl
    & insertWallInZones newwl
  where
    newwl = wl {_wlLine = wlline}

translateWallID :: Int -> Point2 -> World -> World
translateWallID wlid p w = fromMaybe w $ do
    oldwl <- w ^? walls . ix wlid
    let newwl = oldwl & wlLine . each +~ p
    return $ w
        & walls . ix wlid .~ newwl
        & deleteWallFromZones oldwl
        & insertWallInZones newwl

moveWallIDToward :: Int -> Float -> (Point2,Point2) -> World -> World
moveWallIDToward wlid speed ep w = moveWall wlid wl newwlline w
  where
    wl = _walls w IM.! wlid
    newwlline = mvPs speed ep (_wlLine wl)

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)