61 lines
1.8 KiB
Haskell
61 lines
1.8 KiB
Haskell
{-# 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)
|