diff --git a/src/Dodge/Debug.hs b/src/Dodge/Debug.hs index e9096088d..7f735ff4b 100644 --- a/src/Dodge/Debug.hs +++ b/src/Dodge/Debug.hs @@ -7,7 +7,6 @@ import Dodge.WorldBool import Dodge.Zoning.Pathing import Dodge.Door.DoorLerp import Dodge.ShiftPoint -import Dodge.Path import Dodge.Zoning.Base import Control.Lens import Control.Monad @@ -78,19 +77,21 @@ debugItem = \case Debug_put -> debugPutItems debugGet :: Universe -> [String] -debugGet u = [maybe "DebugGetFail" show $ debugGet1 u - , maybe "DebugGetFail" show $ debugGet2 u - , maybe "DebugGetFail" show $ debugGet3 u +debugGet u = [fromMaybe "DebugGetFail" $ debugGet1 u + , fromMaybe "DebugGetFail" $ debugGet2 u + , fromMaybe "DebugGetFail" $ debugGet3 u ] --debugGet1 :: Show a => Universe -> Maybe a +debugGet1 :: Universe -> Maybe String debugGet1 u = do dr <- u ^? uvWorld . cWorld . lWorld . doors . ix 2 let wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr x) ps = wlposs (dr ^. drLerp) is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) ps - return $ S.toList is + return $ show $ S.toList is +debugGet2 :: Universe -> Maybe String debugGet2 u = do let w = u ^. uvWorld dr <- u ^? uvWorld . cWorld . lWorld . doors . ix 2 @@ -107,7 +108,7 @@ debugGet2 u = do is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) ps return $ show is - +debugGet3 :: Universe -> Maybe String debugGet3 u = do dr <- u ^? uvWorld . cWorld . lWorld . doors . ix 2 let wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr x) @@ -129,18 +130,20 @@ doDebugPut i u | u ^. uvWorld . input . mouseButtons . at SDL.ButtonLeft == Just 0 = u & uvIOEffects %~ \ f u' -> do s <- getClipboard - f $ u & uvDebugPut . at i ?~ s + f $ u' & uvDebugPut . at i ?~ s | otherwise = u debugPutDraw :: IM.IntMap String -> Universe -> Picture debugPutDraw _ u = drawthedoor u <> drawthezones u +drawthezones :: Universe -> Picture drawthezones u = fold $ do is <- readMaybe =<< u ^? uvDebugPut . ix 0 let f :: [Int2] -> [Int2] f = id return $ foldMap (drawZoneCol yellow peZoneSize) $ f is +drawthedoor :: Universe -> Picture drawthedoor u = fold $ do dr <- u ^? uvWorld . cWorld . lWorld . doors . ix 2 let wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr x) diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index db7f0876b..9889b76d6 100644 --- a/src/Dodge/Debug/Picture.hs +++ b/src/Dodge/Debug/Picture.hs @@ -314,13 +314,14 @@ drawDDATest w = <> foldMap (drawZone f 50) qs <> foldMap (drawZone g 50) rs <> foldMap (drawCrossCol yellow) xs --- <> foldMap (drawCrossCol cyan) xs' <> setLayer DebugLayer (color yellow (line [x, y])) where x = w ^. wCam . camViewFrom y = mouseWorldPos (w ^. input) (w ^. wCam) - f [a,b,c,d] = color red $ thickLine 2 [a,c] - g [a,b,c,d] = color blue $ thickLine 2 [b,d] + f [a,_,c,_] = color red $ thickLine 2 [a,c] + f _ = undefined + g [_,b,_,d] = color blue $ thickLine 2 [b,d] + g _ = undefined ps = zoneOfSeg 50 x y qs = map (zoneOfPoint 50) $ xIntercepts' 50 x y rs = map (zoneOfPoint 50) $ yIntercepts' 50 x y diff --git a/src/Dodge/DrWdWd.hs b/src/Dodge/DrWdWd.hs index 54e97deb2..0c3792492 100644 --- a/src/Dodge/DrWdWd.hs +++ b/src/Dodge/DrWdWd.hs @@ -47,14 +47,12 @@ doorLerp :: Float -> Door -> World -> (S.Set Int2, World) doorLerp speed dr w = fromMaybe (mempty,domounts (dr ^. drLerp) w) $ do x <- newlerp let ps = wlposs x - is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) ps ps' = wlposs (dr ^. drLerp) - is' = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) ps' - is'' = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) (ps <> ps') + is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) (ps <> ps') -- it seems possible that this will miss some paths: we don't add zones for the -- old footprint. Seems unlikely, but a possible cause of pathfinding bugs return - ( is'' + ( is , domounts x $ f x & playSound x & cWorld . lWorld . doors . ix drid . drLerp .~ x diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index dd6f6113d..32e2027de 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -77,6 +77,7 @@ walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear -- where -- nodesNear = zonesExtract (w ^. incNodeZoning) . snailAround $ zoneOfPoint pnZoneSize p +nodesNear :: World -> Point2 -> [(Int, Point2)] nodesNear w p = zonesExtract (w ^. incNodeZoning) . snailAround $ zoneOfPoint pnZoneSize p snailAround :: Int2 -> [Int2]