Cleanup
This commit is contained in:
+10
-7
@@ -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)
|
||||
|
||||
@@ -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
@@ -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
|
||||
|
||||
@@ -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]
|
||||
|
||||
Reference in New Issue
Block a user