justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Refactor, try to limit dependencies

Browse Source
This commit is contained in:
justin
2022-07-28 00:59:56 +01:00
parent 8aa5c17ab9
commit 160560af5f
418 changed files with 15104 additions and 13342 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Wall/Move.hs
+31 -27
View File
@@ -1,47 +1,51 @@
{-# 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
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
import qualified IntMapHelp as IM
moveWallIDUnsafe :: Int -> (Point2,Point2) -> World -> World
moveWallIDUnsafe :: Int -> (Point2, Point2) -> World -> World
moveWallIDUnsafe wlid wlline w = case w ^? cWorld . walls . ix wlid of
Nothing -> error "tried moving nonexistant wall"
Just wl -> moveWall wlid wl wlline w
moveWallID :: Int -> (Point2,Point2) -> World -> World
moveWallID :: Int -> (Point2, Point2) -> World -> World
moveWallID wlid wlline w = case w ^? cWorld . 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 . walls . ix wlid .~ newwl
& deleteWallFromZones wl
& insertWallInZones newwl
moveWall :: Int -> Wall -> (Point2, Point2) -> World -> World
moveWall wlid wl wlline w =
w & cWorld . walls . ix wlid .~ newwl
& deleteWallFromZones wl
& insertWallInZones newwl
where
newwl = wl {_wlLine = wlline}
newwl = wl{_wlLine = wlline}
translateWallID :: Int -> Point2 -> World -> World
translateWallID wlid p w = fromMaybe w $ do
oldwl <- w ^? cWorld . walls . ix wlid
let newwl = oldwl & wlLine . each +~ p
return $ w
& cWorld . walls . ix wlid .~ newwl
& deleteWallFromZones oldwl
& insertWallInZones newwl
return $
w
& cWorld . walls . ix wlid .~ newwl
& deleteWallFromZones oldwl
& insertWallInZones newwl
moveWallIDToward :: Int -> Float -> (Point2,Point2) -> World -> World
moveWallIDToward :: Int -> Float -> (Point2, Point2) -> World -> World
moveWallIDToward wlid speed ep w = moveWall wlid wl newwlline w
where
wl = _walls (_cWorld w) IM.! wlid
@@ -51,6 +55,6 @@ mvP :: Float -> Point2 -> Point2 -> Point2
{-# INLINE mvP #-}
mvP !speed !ep !p = mvPointTowardAtSpeed speed ep p
mvPs :: Float -> (Point2,Point2) -> (Point2,Point2) -> (Point2,Point2)
mvPs :: Float -> (Point2, Point2) -> (Point2, Point2) -> (Point2, Point2)
{-# INLINE mvPs #-}
mvPs !speed (!ex,!ey) (!sx,!sy) = (mvP speed ex sx,mvP speed ey sy)
mvPs !speed (!ex, !ey) (!sx, !sy) = (mvP speed ex sx, mvP speed ey sy)