Work on connecting pathfinding grid

src/Dodge/Combine/Graph.hs

@@ -114,6 +114,7 @@ clusterFunc n = C JoinClust (N n)
 clusterFormatting :: CombClust -> [GlobalAttributes]
 clusterFormatting cl = case cl of
 --    CraftClust -> [GraphAttrs [Rank SameRank]]
+    CraftClust -> []
     _ -> []
 
 edgeFormatting :: (Int,Int,CombEdge) -> Attributes

src/Dodge/Creature/ReaderUpdate.hs

@@ -181,7 +181,7 @@ searchIfDamaged cr
     | _crPastDamage cr > 0 = case _apStrategy (_crActionPlan cr) of
         WatchAndWait -> cr & crPerception . cpVigilance .~ Vigilant
             & crActionPlan . apStrategy .~ StrategyActions LookAround 
-                [(TurnToPoint (_crPos cr -.- unitVectorAtAngle (_crDir cr)))
+                [TurnToPoint (_crPos cr -.- unitVectorAtAngle (_crDir cr))
                 `DoActionThen` 40 `WaitThen` bfsThenReturn 500
                 ]
         _ -> cr

src/Dodge/Data.hs

@@ -148,7 +148,7 @@ data World = World
     , _corpses              :: IM.IntMap Corpse
     , _clickMousePos        :: Point2
     , _pathGraph            :: Gr Point2 PathEdge
-    , _pathGraphP           :: S.Set (Point2,Point2)
+--    , _pathGraphP           :: S.Set (Point2,Point2)
     , _pnZoning             :: Zoning [] (Int,Point2)
     , _peZoning             :: Zoning [] (Int,Int,PathEdge)
     , _hud                  :: HUD

src/Dodge/Debug/Terminal.hs

@@ -63,7 +63,7 @@ applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
 applyTerminalCommandArguments command args u = case command of
     "ITEM" -> fromMaybe u $ do
         (ibt,n) <- parseItem args
-        return $ u & uvWorld %~ (flip (foldr ($)) $ replicate n (snd . createPutItem (itemFromBase ibt)))
+        return $ u & uvWorld %~ flip (foldr ($)) (replicate n (snd . createPutItem (itemFromBase ibt)))
     _ -> u
 
 parseItem :: [String] -> Maybe (ItemBaseType,Int)
@@ -77,10 +77,6 @@ parseItem [] = Nothing
 parseNum :: [String] -> Int
 parseNum xs = fromMaybe 1 $ xs ^? ix 0 >>= readMaybe
 
-safeTake2 :: [a] -> Maybe [a]
-safeTake2 (x:y:_) = Just (x:y:[])
-safeTake2 _ = Nothing
-
 showTerminalError :: String -> String -> Universe -> Universe
 showTerminalError cmd s = menuLayers .:~ InputScreen (T.pack cmd) s
 

src/Dodge/Default/World.hs

@@ -73,7 +73,7 @@ defaultWorld = World
 --    , _menuLayers = []
     , _clickMousePos = V2 0 0
     , _pathGraph = Data.Graph.Inductive.Graph.empty
-    , _pathGraphP   = mempty
+--    , _pathGraphP   = mempty
     , _pnZoning     = Zoning mempty wlZoneSize (zonePos snd)
     , _peZoning     = Zoning mempty wlZoneSize (\x (_,_,e) -> zoneOfSeg x (_peStart e) (_peEnd e))
     , _hud = HUD

src/Dodge/Floor.hs

@@ -43,9 +43,9 @@ initialAnoTree = OnwardList
     [ IntAnno $ AnTree . startRoom
     , AnRoom $ roomCCrits 0
     , AnRoom $ return airlock0
-    , AnRoom slowDoorRoom
-    , AnRoom $ roomCCrits 10
-    , AnTree firstBreather
+--    , AnRoom slowDoorRoom
+--    , AnRoom $ roomCCrits 10
+--    , AnTree firstBreather
     , AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward
     ]
 

src/Dodge/Item/Weapon/TriggerType.hs

@@ -52,7 +52,6 @@ module Dodge.Item.Weapon.TriggerType
     , duplicateLoaded
     , duplicateOffsets
     , duplicateOffsetsV2
-    , duplicateOffsetsV2Dir
     , duplicateOffsetsFocus
     , hammerCheckI
     , hammerCheckL
@@ -610,12 +609,3 @@ duplicateOffsets xs eff item cr w = foldr f w poss
     poss :: [V2 Float]
     poss = map (rotateV (_crDir cr) . V2 0 ) xs
     f pos = eff item (cr & crPos +.+.~ pos)
-
-duplicateOffsetsV2Dir :: [(Point2,Float)] -> ChainEffect
-duplicateOffsetsV2Dir xs eff item cr w = foldr f w 
-    -- $ xs
-     $ map (over _1 (rotateV (_crDir cr))) xs
-  where
-    f (pos,dir) = eff item $ cr 
-        & crPos +.+.~ pos
-        & crDir +~ dir

src/Dodge/Layout.hs

@@ -44,7 +44,7 @@ generateLevelFromRoomList gr' w = initWallZoning
     $ w { _walls        = wallsFromRooms rs
         , _gameRooms    = gameRoomsFromRooms (IM.elems rs')
         , _pathGraph    = path
-        , _pathGraphP   = pairPath
+--        , _pathGraphP   = pairPath
         }
         & pnZoning   %~ (\zn -> foldl' (flip $ updateZoning (:)) (zn & znObjects .~ mempty)
             (labNodes path))

src/Dodge/Room/Corridor.hs

@@ -20,7 +20,8 @@ corridor :: Room
 corridor = defaultRoom
     { _rmPolys = [poly]
     , _rmLinks = lnks'
-    , _rmPath  = foldMap (doublePairSet . (,) (V2 20 60) . fst) lnks
+    --, _rmPath  = foldMap (doublePairSet . (,) (V2 20 60) . fst) lnks
+    , _rmPath  = foldMap (doublePairSet . (,) (V2 20 60)) [V2 20 70,V2 20 10]
     , _rmPmnts = [ spanLightI (V2 0 39.5) (V2 40 39.5) ]
     , _rmBound = [ rectNSWE 50 30 (-5) 45 ]
     , _rmFloor = Tiled [makeTileFromPoly poly 2]  
@@ -35,12 +36,6 @@ corridor = defaultRoom
         ,uncurry outLink (V2 20 70 , negate $ pi/6)
         ,uncurry inLink  (V2 20 10 , pi)
         ]
-    lnks =
-        [ (V2 20 70, 0::Float)
-        , (V2 20 70, pi/6)
-        , (V2 20 70, negate $ pi/6)
-        , (V2 20 10, pi)
-        ]
 keyholeCorridor :: Room
 keyholeCorridor = corridor
     { _rmPath  = mempty

src/Dodge/Room/Door.hs

@@ -17,7 +17,7 @@ import Control.Lens
 door :: Room
 door = defaultRoom
     { _rmPolys = [rectNSWE 40 0 0 40]
-    , _rmLinks = init lnks ++ [last lnks]
+    , _rmLinks = lnks
     , _rmPath  = doublePairSet (V2 20 35,V2 20 5)
 -- door extends into side walls (for shadows as rendered 12/03)
     , _rmPmnts = [putAutoDoor (V2 0 20) (V2 40 20)]

src/Dodge/Room/Room.hs

@@ -325,5 +325,7 @@ spawnerRoom = do
 
 corDoor :: State StdGen (MetaTree Room String)
 corDoor = do
-    cor <- shuffleLinks $ cleatOnward corridor
-    return $ tToBTree "corDoor" $ treePost [door,cor]
+    --cor <- shuffleLinks $ cleatOnward corridor
+    --return $ tToBTree "corDoor" $ treePost [door,cor]
+    cor <- shuffleLinks corridor
+    return $ tToBTree "corDoor" $ treePost [door,cor,cleatOnward door]