{-# LANGUAGE BangPatterns #-}

module Dodge.Wall.Move (
    moveWallID,
    moveWallIDUnsafe,
    moveWall,
    moveWallIDToward,
    translateWallID,
    mvPs,
) where

import Control.Lens
import Data.Maybe
import Dodge.Base
import Dodge.Data.World
import Dodge.Wall.Zone
import Geometry

moveWallIDUnsafe :: Int -> (Point2, Point2) -> World -> World
moveWallIDUnsafe wlid wlline w = case w ^? cWorld . lWorld . 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 ^? cWorld . lWorld . 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 & cWorld . lWorld . 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 ^? cWorld . lWorld . walls . ix wlid
    let newwl = oldwl & wlLine . each +~ p
    return $
        w
            & cWorld . lWorld . 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 (_cWorld w) IM.! wlid
    wl = w ^?! cWorld . lWorld . walls . ix 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)