57 lines
1.7 KiB
Haskell
57 lines
1.7 KiB
Haskell
{-# 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)
|