Comment out DeriveAnyClass extensions

src/Color/Data.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 --{-# LANGUAGE DeriveGeneric #-}

src/Dodge/Creature/Action.hs

@@ -3,7 +3,6 @@
 -- | Actions performed by creatures within the world
 module Dodge.Creature.Action (
     performActions,
-    dropExcept,
     dropItem,
     blinkActionMousePos,
     blinkActionFail,
@@ -13,7 +12,6 @@ module Dodge.Creature.Action (
 
 import Control.Applicative
 import Control.Monad
-import Data.Bifunctor
 import Data.Foldable
 import Data.Maybe
 import Dodge.Base
@@ -35,6 +33,8 @@ import LensHelp
 import Linear
 import NewInt
 
+-- it is desirable to be able to determine when an action is finished,
+-- so that DoActionThen and the like are easy to define
 performActions :: Int -> World -> World
 performActions cid w =
     foldl'
@@ -45,59 +45,13 @@ performActions cid w =
     cr = w ^?! cWorld . lWorld . creatures . ix cid
     (iss, mayas) = foldMap (performAction cr w) $ cr ^. crActionPlan . apAction
 
-type OutAction = ([Impulse], [Action])
+type ActionUpdate = ([Impulse], [Action])
 
-performAimAt :: Creature -> World -> Int -> Point2 -> OutAction
-performAimAt cr w tcid p = ([TurnToward tpos aimSp], [AimAt tcid tpos])
-  where
-    cdir = _crDir cr
-    cpos = cr ^. crPos . _xy
-    canSee' = canSee (_crID cr) tcid w
-    aimSp = case crMvType cr ^? mvAimSpeed of
-        Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
-        Nothing -> error "creature without aiming type"
-    tpos
-        | canSee' = w ^?! cWorld . lWorld . creatures . ix tcid . crPos . _xy
-        | otherwise = p
-
-performPathTo :: Creature -> World -> Point2 -> OutAction
-performPathTo cr w p
-    | dist cpos p <= crRad (cr ^. crType) = ([], [])
-    | isWalkable cpos p w =
-        ( [MvTurnToward 0 cpos p p, MvForward, RandomTurn jit]
-        , [PathTo p]
-        )
-    | otherwise = case pointTowardsImpulse cpos p w of
-        Just q ->
-            (
-                [ MvTurnToward 1 cpos p q
-                , MvForward
-                , RandomTurn jit
-                ]
-            , [PathTo p]
-            )
-        _ -> ([ChangeStrategy Flee], [])
-  where
-    cpos = cr ^. crPos . _xy
-    jit = _mvTurnJit $ crMvType cr
-
-performTurnToA :: Creature -> Point2 -> OutAction
-performTurnToA cr p
-    | angleVV cdirv dirv < 0.1 = ([], [])
-    | otherwise = ([MvTurnToward 2 p p p, RandomTurn jit], [TurnToPoint p])
-  where
-    cpos = cr ^. crPos . _xy
-    cdirv = unitVectorAtAngle (_crDir cr)
-    dirv = p -.- cpos
-    jit = _mvTurnJit $ crMvType cr
-
-{- | Performing an action on a frame creates an OutAction:
-  adds impulses and updates or deletes the action itself.
+{- | Performing an action on a frame creates an ActionUpdate:
+  gives impulses and updates/deletes the action itself.
 -}
-performAction :: Creature -> World -> Action -> OutAction
+performAction :: Creature -> World -> Action -> ActionUpdate
 performAction cr w ac = case ac of
-    ActionNothing -> ([], mempty)
-    LabelAction str subAc -> second (fmap (LabelAction str)) $ performAction cr w subAc
     AimAt tcid p -> performAimAt cr w tcid p
     WaitThen 0 newAc -> ([], [newAc])
     WaitThen t newAc -> ([], [WaitThen (t -1) newAc])
@@ -145,15 +99,44 @@ performAction cr w ac = case ac of
         (imps, _) -> (imps, [DoReplicatePartial startac (t -1) startac])
     NoAction -> ([], mempty)
 
+performAimAt :: Creature -> World -> Int -> Point2 -> ActionUpdate
+performAimAt cr w tcid p = ([TurnToward tpos aimSp], [AimAt tcid tpos])
+  where
+    cdir = _crDir cr
+    cpos = cr ^. crPos . _xy
+    canSee' = canSee (_crID cr) tcid w
+    aimSp = case crMvType cr ^? mvAimSpeed of
+        Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
+        Nothing -> error "creature without aiming type"
+    tpos
+        | canSee' = w ^?! cWorld . lWorld . creatures . ix tcid . crPos . _xy
+        | otherwise = p
+
+performPathTo :: Creature -> World -> Point2 -> ActionUpdate
+performPathTo cr w p
+    | dist cpos p <= crRad (cr ^. crType) = mempty
+    | isWalkable cpos p w = gotowards p
+    | otherwise = case pointTowardsImpulse cpos p w of
+        Just q -> gotowards q
+        _ -> ([ChangeStrategy Flee], [])
+  where
+    gotowards q = ( [MvTurnToward q, MvForward, RandomTurn jit] , [PathTo p])
+    cpos = cr ^. crPos . _xy
+    jit = _mvTurnJit $ crMvType cr
+
+performTurnToA :: Creature -> Point2 -> ActionUpdate
+performTurnToA cr p
+    | angleVV cdirv dirv < 0.1 = mempty
+    | otherwise = ([MvTurnToward p, RandomTurn jit], [TurnToPoint p])
+  where
+    cpos = cr ^. crPos . _xy
+    cdirv = unitVectorAtAngle (_crDir cr)
+    dirv = p -.- cpos
+    jit = _mvTurnJit $ crMvType cr
+
 --setMinInvSize :: Int -> Creature -> World -> World
 --setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n
 
----- maybe this should be removed...
---stripNoItems :: Creature -> World -> World
---stripNoItems cr =
---    organiseInvKeys (_crID cr)
---        . (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just)
---
 --organiseInvKeys :: Int -> World -> World
 --organiseInvKeys cid w =
 --    w & cWorld . lWorld . creatures . ix cid
@@ -167,12 +150,6 @@ performAction cr w ac = case ac of
 --    newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs
 --    newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs
 
-dropExcept :: Creature -> Int -> World -> World
-dropExcept cr invid w =
-    foldr (dropItem cr) w . IM.keys $
-        --        invid `IM.delete` _crInv cr
-        invid `IM.delete` _unNIntMap (_crInv cr)
-
 -- why not a cid (Int)?
 dropItem :: Creature -> Int -> World -> World
 dropItem cr invid w' =

src/Dodge/Creature/Impulse.hs

@@ -56,7 +56,7 @@ followImpulse cid w = \case
         tcr <- w ^? cWorld . lWorld . creatures . ix i
         return $ followImpulse cid w (doCrImp f tcr)
     MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld)
-    MvTurnToward _ _ _ p ->
+    MvTurnToward p ->
         crup $
             creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir))
   where

src/Dodge/Data/ActionPlan.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -32,7 +32,7 @@ data Impulse
     | RandomTurn Float
     | RandomImpulse RandImpulse -- (State StdGen Impulse)
     | TurnToward Point2 Float
-    | MvTurnToward Int Point2 Point2 Point2 -- the Int is just a label
+    | MvTurnToward Point2
     | MvForward
     | TurnTo Point2
     | UseItem
@@ -65,28 +65,14 @@ infixr 9 `DoReplicate`
 infixr 9 `DoImpulsesAlongside`
 
 data Action
-    = LabelAction
-        { _actLabel :: String
-        , _actAction :: Action
-        }
-    | ActionNothing
-    | AimAt
+    = AimAt
         { _targetID :: Int
         , _targetSeenAt :: Point2
         }
     | PathTo { _pathToPoint :: Point2 }
-    | TurnToPoint
-        { _turnToPoint :: Point2
-        }
-    | --    | PickupItem
-      --        {_pickupItemID :: Int
-      --        }
-      ImpulsesList
-        { _impulsesListList :: [[Impulse]]
-        }
-    | DoImpulses
-        { _doImpulsesList :: [Impulse]
-        }
+    | TurnToPoint { _turnToPoint :: Point2 }
+    | ImpulsesList { _impulsesListList :: [[Impulse]] }
+    | DoImpulses { _doImpulsesList :: [Impulse] }
     | WaitThen
         { _waitThenTimer :: Int
         , _waitThenAction :: Action
@@ -114,17 +100,12 @@ data Action
         , _doActionWhileThenCondition :: WdCrBl
         , _doActionWhileThenThen :: Action
         }
-    | DoActions
-        { _doActionsList :: [Action]
-        }
+    | DoActions { _doActionsList :: [Action] }
     | DoActionThen
         { _doActionThenFirst :: Action
         , _doActionThenSecond :: Action
         }
-    | --    | DoGuardActions
-      --        {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)]
-      --        }
-      DoReplicate
+    | DoReplicate
         { _doReplicateTimes :: Int
         , _doReplicateAction :: Action
         }
@@ -133,9 +114,7 @@ data Action
         , _doReplicateTimes :: Int
         , _doReplicateAction :: Action
         }
-    | LeadTarget
-        { _leadTargetBy :: Point2
-        }
+    | LeadTarget { _leadTargetBy :: Point2 }
     | NoAction
     | StartSentinelPost
     | UseSelf { _useSelf :: CrAc }

src/Dodge/Data/AimStance.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/ArcStep.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Beam.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/BlBl.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Block.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Bounds.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Bullet.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Button.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/CWorld.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -19,6 +19,8 @@ import Dodge.Data.LWorld
 import Dodge.GameRoom
 import Geometry.ConvexPoly
 import Geometry.Data
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as UV
 
 data CWorld = CWorld
     { _lWorld :: LWorld
@@ -26,6 +28,8 @@ data CWorld = CWorld
     , _cClock :: Int
     , _cwTiles :: [Tile]
     , _pathGraph :: Gr Point2 PathEdge
+    , _incGraph :: V.Vector [(Int,SimpleEdge)]
+    , _incNode :: UV.Vector Point2
     , _numberFloorVerxs :: Int
     , _chasms :: [[Point2]]
     , _numberChasmVerxs :: Int

src/Dodge/Data/Camera.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Cloud.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/CombAmount.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}

src/Dodge/Data/CrGroupParams.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/CrWlID.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Creature.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StrictData #-}

src/Dodge/Data/Creature/Memory.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Creature/Misc.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Creature/Perception.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Creature/Stance.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Creature/State.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/CreatureEffect.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Damage.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Distortion.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Door.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/DoubleTree.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 --{-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/EnergyBall.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/EnergyBall/Type.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Flame.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/FloatFunction.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/FloorItem.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/ForegroundShape.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/GenFloat.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 module Dodge.Data.GenFloat

src/Dodge/Data/GenParams.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Gust.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/HUD.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Input.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Item/Combine.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Item/Location.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE EmptyDataDeriving #-}

src/Dodge/Data/Item/Misc.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Item/Params.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Item/Scope.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Item/Targeting.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Item/Use.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Item/Use/Consumption/LoadAction.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/LWorld.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Laser.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/LightSource.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/LinearShockwave.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Machine.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Machine/Sensor.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Magnet.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Material.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Modification.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/MountedObject.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/ObjectType.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/PathGraph.hs

@@ -45,6 +45,12 @@ data PathEdge = PathEdge
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
+data SimpleEdge = SimpleEdge
+    { _seDist :: Float
+    , _seObstacles :: Set.Set EdgeObstacle
+    }
+    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
 data EdgeObstacle
     = BlockObstacle
     | DoorObstacle
@@ -63,8 +69,10 @@ data EdgeObstacle
 --makeLenses ''PathGraph
 makeLenses ''PathEdge
 makeLenses ''PathEdgeNodes
+makeLenses ''SimpleEdge
 deriveJSON defaultOptions ''EdgeObstacle
 deriveJSON defaultOptions ''PathEdge
 deriveJSON defaultOptions ''PathEdgeNodes
 deriveJSON defaultOptions ''Gr
+deriveJSON defaultOptions ''SimpleEdge
 --deriveJSON defaultOptions ''PathGraph

src/Dodge/Data/Payload.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Projectile.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Prop.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/RadarBlip.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/RadarSweep.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/RightButtonOptions.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/SaveSlot.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Shockwave.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/SoundOrigin.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Spark.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Terminal.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/TeslaArc.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/TractorBeam.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/Universe.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Wall.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Data/Wall/Structure.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Data/World.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -51,6 +51,7 @@ data World = World
     , _wlZoning :: IntMap (IntMap IntSet) -- Zoning IM.IntMap Wall
     , _pnZoning :: IntMap (IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
     , _peZoning :: IntMap (IntMap (Set PathEdgeNodes))
+    , _incNodeZoning :: IntMap (IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
     , _gsZoning :: IntMap (IntMap IntSet)
     , _wCam :: Camera
     , _unpauseClock :: Int

src/Dodge/Data/WorldEffect.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/Dodge/Default/World.hs

@@ -49,6 +49,7 @@ defaultWorld =
         , _wlZoning = mempty
         , _pnZoning = mempty
         , _peZoning = mempty
+        , _incNodeZoning = mempty
         , _gsZoning = mempty --Zoning IM.empty clZoneSize (zonePos _guPos)
         , _unpauseClock = 0
         , _coordinates = mempty
@@ -90,6 +91,8 @@ defaultCWorld =
         , _numberFloorVerxs = 0
         , _chasms = mempty
         , _numberChasmVerxs = 0
+        , _incGraph = mempty
+        , _incNode = mempty
         }
 
 defaultLWorld :: LWorld

src/Dodge/GameRoom.hs

@@ -1,5 +1,5 @@
 --{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Dodge/Graph.hs

@@ -41,3 +41,5 @@ graphToIncidence :: forall a b . F.Gr a b -> [(a,Int)]
 graphToIncidence g = map f $ F.labNodes g
   where
     f (n,p) = (p,length $ F.neighbors g n)
+
+

src/Dodge/Layout.hs

@@ -5,6 +5,7 @@ module Dodge.Layout (
     shuffleRoomPos,
 ) where
 
+import qualified Data.Vector.Unboxed as UV
 import Dodge.Path.Translate
 import qualified Control.Foldl as L
 import Control.Lens
@@ -45,10 +46,14 @@ generateLevelFromRoomList gr' w =
         $ w & cWorld . lWorld . walls .~ wallsFromRooms rs
             & cWorld . cwGen . cwgGameRooms .~ gameRoomsFromRooms (IM.elems rs')
             & cWorld . pathGraph .~ path
+            & cWorld . incNode .~ inodes
+            & cWorld . incGraph .~ igraph
             & pnZoning .~ foldl' (flip zonePn) mempty (labNodes path)
             & peZoning .~ foldl' (flip zonePe) mempty (map fromEdgeTuple $ labEdges path)
+            & incNodeZoning .~ UV.ifoldl' (\m i p -> zonePn (i,p) m) mempty inodes
   where
     (_, path) = pairsToGraph . snapToGrid $ foldMap _rmPath rs
+    (inodes,igraph) = pairsToIncGraph . snapToGrid $ foldMap _rmPath rs
     rs = map doRoomShift $ IM.elems rs'
     rs' = mapM shuffleRoomPos gr' & evalState $ _randGen w
 

src/Dodge/Path.hs

@@ -5,30 +5,33 @@ module Dodge.Path (
     makePathBetweenPs,
     --    , removePathsCrossing
     obstructPathsCrossing,
-    obstructPathsCrossing',
     pairsToGraph,
     getNodePos,
     walkableNodeNear,
     bfsNodePoints,
     snapToGrid,
+    pairsToIncGraph,
 ) where
 
-import Linear
-import Data.List (sortOn)
-import Data.Set (Set)
-import qualified Data.Set as Set
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as UV
 import Control.Lens
+import Data.Bifunctor
 import Data.Foldable
 import Data.Graph.Inductive hiding ((&))
+import Data.List (sortOn)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe
+import Data.Set (Set)
+import qualified Data.Set as Set
 import Dodge.Base.Collide
 import Dodge.Data.World
 import Dodge.Zoning.Base
 import Dodge.Zoning.Pathing
 import Geometry
-import Data.Bifunctor
+import Linear
+import qualified IntMapHelp as IM
 
 getNodePos :: Int -> World -> Maybe Point2
 getNodePos i w = (w ^. cWorld . pathGraph) `lab` i
@@ -37,31 +40,31 @@ makePathUsing :: (PathEdge -> Bool) -> Point2 -> Point2 -> World -> Maybe [Int]
 makePathUsing t s e w = do
     na <- walkableNodeNear w s
     nb <- walkableNodeNear w e
-    sp na nb . second _peDist 
-        . efilter (t . (^. _3)) $ w ^. cWorld . pathGraph
+    sp na nb . second _peDist . efilter (^. _3 . to t) $ w ^. cWorld . pathGraph
 
 makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int]
 makePathBetween = makePathUsing $ not . pathEdgeObstructed
 
 pathEdgeObstructed :: PathEdge -> Bool
-pathEdgeObstructed pe = DoorObstacle `Set.member` obs || BlockObstacle `Set.member` obs
-    || ChasmObstacle `Set.member` obs
-  where
-    obs = _peObstacles pe
+pathEdgeObstructed pe =
+    any
+        (`Set.member` _peObstacles pe)
+        [DoorObstacle, BlockObstacle, ChasmObstacle]
 
 walkableNodeNear :: World -> Point2 -> Maybe Int
 {-# INLINE walkableNodeNear #-}
 walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear
   where
-    --nodesNear = zonesExtract (w ^. pnZoning) $ zonesAroundPoint pnZoneSize p
     nodesNear = zonesExtract (w ^. pnZoning) . snailAround $ zoneOfPoint pnZoneSize p
 
 snailAround :: Int2 -> [Int2]
-snailAround x = (x+) <$> smallSnailInt2
+snailAround x = (x +) <$> smallSnailInt2
 
 smallSnailInt2 :: [Int2]
-smallSnailInt2 = sortOn (distance (V2 0 (0::Float)) . fmap fromIntegral) 
-    [V2 x y | x <-[-2..2], y <-[-2..2]]
+smallSnailInt2 =
+    sortOn
+        (distance (V2 0 (0 :: Float)) . fmap fromIntegral)
+        [V2 x y | x <- [-2 .. 2], y <- [-2 .. 2]]
 
 makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
 makePathBetweenPs a b w = mapMaybe (lab $ w ^. cWorld . pathGraph) <$> makePathBetween a b w
@@ -72,8 +75,11 @@ bfsNodePoints n w = mapMaybe (lab g) $ bfs n g
     g = w ^. cWorld . pathGraph
 
 pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2
-pointTowardsImpulse a b w = (find (flip (isWalkable a) w) . reverse) =<< 
-    (makePathBetweenPs a b w <&> (<>[b]))
+pointTowardsImpulse a b w =
+--    (find (flip (isWalkable a) w) . reverse)
+--        =<< (makePathBetweenPs a b w <&> (<> [b]))
+    (find (flip (isWalkable a) w) . reverse)
+        =<< makePathBetweenPs a b w -- <&> (<> [b]))
 
 ------ continues a walk from a list of points, without repetitions
 ------ supposes that the list is non-empty
@@ -119,7 +125,21 @@ pointTowardsImpulse a b w = (find (flip (isWalkable a) w) . reverse) =<<
 --        _  -> return $ Just $ ns !! i
 --
 
-pairsToGraph :: Set.Set (Point2, Point2) -> (Map (V2 Point2) PathEdgeNodes, Gr Point2 PathEdge)
+pairsToIncGraph :: Set.Set (Point2,Point2) 
+    -> (UV.Vector Point2, V.Vector [(Int,SimpleEdge)])
+pairsToIncGraph pairs = (inodes,incgraph)
+  where
+    incgraph = V.generate (length im) (\i -> im ^?! ix i)
+    im = IM.fromListWith (<>) . fmap toedge $ Set.toList pairs
+    toedge (x,y) = (pstons ^?! ix x . _head
+        , [(pstons ^?! ix y . _head, SimpleEdge (distance x y) mempty)])
+    pstons = IM.invertIntMap . IM.fromList $ zip [0..] ps
+    inodes = UV.generate (length ps) (ps !!)
+    ps = Set.toList $ Set.map fst pairs <> Set.map snd pairs
+
+pairsToGraph ::
+    Set.Set (Point2, Point2) ->
+    (Map (V2 Point2) PathEdgeNodes, Gr Point2 PathEdge)
 pairsToGraph pairs = addEdges nodemap gr pairs
   where
     (nodemap, _, gr) = addNodes $ Set.toList $ Set.map fst pairs <> Set.map snd pairs
@@ -147,31 +167,25 @@ addEdges nodemap gr = foldl' f (mempty, gr)
         theedgedata = PathEdgeNodes (g a) (g b) (PathEdge a b (dist a b) mempty)
     g a = nodemap M.! a
 
-obstructPathsCrossing :: EdgeObstacle -> Point2 -> Point2 -> World 
-    -> (World, Set PathEdgeNodes)
+obstructPathsCrossing ::
+    EdgeObstacle ->
+    Point2 ->
+    Point2 ->
+    World ->
+    (World, Set PathEdgeNodes)
 obstructPathsCrossing obstacletype sp' ep w =
     ( w & cWorld . pathGraph %~ updateedges
     , es
     )
   where
     es = Set.filter edgecrosses $ pesNearSeg sp' ep w
-    edgecrosses (PathEdgeNodes _ _ pe) = isJust $ intersectSegSeg sp' ep (_peStart pe) (_peEnd pe)
+    edgecrosses (PathEdgeNodes _ _ pe) =
+        isJust $ intersectSegSeg sp' ep (_peStart pe) (_peEnd pe)
     updateedges gr = foldl' updateedge gr es
     updateedge gr (PathEdgeNodes x y pe) =
         insEdge (x, y, pe & peObstacles . at obstacletype ?~ ()) $ delEdge (x, y) gr
 
-obstructPathsCrossing' :: EdgeObstacle -> Point2 -> Point2 -> World 
-    -> World
-obstructPathsCrossing' obstacletype sp' ep w =
-     w & cWorld . pathGraph %~ updateedges
-  where
-    es = Set.filter edgecrosses $ pesNearSeg sp' ep w
-    edgecrosses (PathEdgeNodes _ _ pe) = isJust $ intersectSegSeg sp' ep (_peStart pe) (_peEnd pe)
-    updateedges gr = foldl' updateedge gr es
-    updateedge gr (PathEdgeNodes x y pe) =
-        insEdge (x, y, pe & peObstacles . at obstacletype ?~ ()) $ delEdge (x, y) gr
-
-snapToGrid :: Set (Point2,Point2) -> Set (Point2, Point2)
+snapToGrid :: Set (Point2, Point2) -> Set (Point2, Point2)
 snapToGrid = Set.map (over each (fmap (fromIntegral . f)))
   where
     f :: Float -> Int

src/Dodge/Zoning/Pathing.hs

@@ -1,13 +1,13 @@
 module Dodge.Zoning.Pathing where
 
 import Data.Foldable
-import Dodge.Data.World
-import Dodge.Zoning.Base
-import Geometry
-import qualified IntMapHelp as IM
 import Data.Set (Set)
 import qualified Data.Set as Set
+import Dodge.Data.World
+import Dodge.Zoning.Base
 import Dodge.Zoning.Common
+import Geometry
+import qualified IntMapHelp as IM
 
 pnsNearPoint :: Point2 -> World -> [(Int, Point2)]
 pnsNearPoint = nearPoint pnZoneSize _pnZoning
@@ -32,6 +32,7 @@ zonePn pn = zoneMonoid (zoneOfPn pn) [pn]
 
 pesNearPoint :: Point2 -> World -> Set PathEdgeNodes
 pesNearPoint = nearPoint peZoneSize _peZoning
+
 --pesNearPoint p w = zoneExtract (zoneOfPoint peZoneSize p) (w ^. cWorld . lWorld . peZoning)
 
 pesNearSeg :: Point2 -> Point2 -> World -> Set PathEdgeNodes
@@ -49,7 +50,10 @@ peZoneSize = 50
 zoneOfPe :: PathEdgeNodes -> [Int2]
 zoneOfPe (PathEdgeNodes _ _ pe) = zoneOfSeg peZoneSize (_peStart pe) (_peEnd pe)
 
-zonePe :: PathEdgeNodes -> IM.IntMap (IM.IntMap (Set PathEdgeNodes)) -> IM.IntMap (IM.IntMap (Set PathEdgeNodes))
+zonePe ::
+    PathEdgeNodes ->
+    IM.IntMap (IM.IntMap (Set PathEdgeNodes)) ->
+    IM.IntMap (IM.IntMap (Set PathEdgeNodes))
 zonePe pe im = foldl' f im (zoneOfPe pe)
   where
     f im' i2 = zoneMonoid i2 (Set.singleton pe) im'

src/Geometry/ConvexPoly.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TemplateHaskell #-}
 

src/MaybeHelp.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StrictData #-}

src/NewInt.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}

src/Picture/Data.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Shape/Data.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralisedNewtypeDeriving #-}

src/Sound/Data.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
+--{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}