This commit is contained in:
2025-10-27 00:09:11 +00:00
parent aa82519e05
commit c676005219
4 changed files with 17 additions and 14 deletions
+10 -7
View File
@@ -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)
+4 -3
View File
@@ -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
+2 -4
View File
@@ -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
+1
View File
@@ -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]