Start work on pathfinding

src/Dodge/Creature/Boid.hs

@@ -142,7 +142,6 @@ holdForm ycr crs cr = p
     cpos = cr  ^. crPos . _xy
     ps = map (^. crPos . _xy) $ IM.elems crs
     cen = centroid ps
-    --cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
     p
         | dist cen ypos < 20 = ypos
         | otherwise = ypos +.+ cpos -.- cen
@@ -153,7 +152,6 @@ lineUp ycr crs cr = p
     ypos = ycr ^. crPos . _xy
     cpos = cr  ^. crPos . _xy
     ps = map (^. crPos . _xy) $ IM.elems crs
-    --cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
     cen = centroid ps
     p = (0.05 *.* ypos) +.+ (0.95 *.* errorClosestPointOnLine 500 cen ypos cpos)
 
@@ -165,7 +163,6 @@ spreadOut ycr crs cr = p
     cpos = cr  ^. crPos . _xy
     ps = map (^. crPos . _xy) $ IM.elems crs
     cen = centroid ps
-    -- cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
     p
         | dist cen ypos < 30 = ypos
         | otherwise = ypos +.+ (spreadFactor *.* cpos -.- cen)

src/Dodge/Creature/Update.hs

@@ -43,11 +43,11 @@ updateCreature' cr =
     chasmTest cr . case _crType cr of
         Avatar{} ->
             (cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
-                . crUpdate' yourControl cr
+                . crUpdate yourControl cr
         LampCrit{} -> updateLampoid cr
         BarrelCrit bt -> updateBarreloid bt cr
         AvatarDead -> id
-        _ -> crUpdate' updateHumanoid cr
+        _ -> crUpdate updateHumanoid cr
 
 {- | this seems to work, but I am not sure about the ordering:
  previously, the movement was updated before the ai in order to correctly set the oldpos.
@@ -56,8 +56,8 @@ updateCreature' cr =
  at what point invSideEffects is applied wrt to when the creature moves
  may affect whether the shield moves correctly
 -}
-crUpdate' :: (Creature -> World -> World) -> Creature -> World -> World
+crUpdate :: (Creature -> World -> World) -> Creature -> World -> World
-crUpdate' f cr =
+crUpdate f cr =
     checkDeath cid
         . doDamage cid
         . invItemEffs cid

src/Dodge/Debug/Picture.hs

@@ -200,8 +200,8 @@ drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWor
 
 drawPathBetween :: World -> Picture
 drawPathBetween w = concat $ do
-    sp <- w ^. input . clickPos . at ButtonLeft
+    sp <- w ^. input . heldWorldPos . at ButtonLeft
-    ep <- w ^. input . clickPos . at ButtonRight
+    ep <- w ^. input . heldWorldPos . at ButtonRight
     let nodepos = (`getNodePos` w)
         nodelist = makePathBetween sp ep w
     return . setLayer DebugLayer $

src/Dodge/Path.hs

@@ -52,7 +52,6 @@ walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear
     nodesNear = zonesExtract (w ^. pnZoning) $ zonesAroundPoint pnZoneSize p
 
 makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
---makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph (_cWorld w)) <$> makePathBetween a b w
 makePathBetweenPs a b w = mapMaybe (lab $ w ^. cWorld . pathGraph) <$> makePathBetween a b w
 
 bfsNodePoints :: Int -> World -> [Point2]
@@ -61,7 +60,8 @@ 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
+pointTowardsImpulse a b w = (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

src/Dodge/Room/Room.hs

@@ -399,9 +399,9 @@ critsRoom :: Int -> State LayoutVars (Tree Room)
 critsRoom i =
     join $
         takeOne
-            [ return <$> roomCCrits i
+--            [ return <$> roomCCrits i
-            , return <$> critsPillarRoom i
+--            , return <$> critsPillarRoom i
-            , return <$> glassSwitchBackCrits i
+            [ return <$> glassSwitchBackCrits i
             ]
 
 --    cor <- shuffleLinks corridor

src/Dodge/Room/Tutorial.hs

@@ -230,7 +230,7 @@ removeLights = rmPmnts %~ mapMaybe f
 
 tutHub :: State LayoutVars (MetaTree Room String)
 tutHub = do
-    (is, wbp) <- setTreeInts =<< critsRoom 2
+    (is, wbp) <- setTreeInts =<< critsRoom 1
     i <- nextLayoutInt
     j <- nextLayoutInt
     k <- nextLayoutInt