justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Example use of fallback in placement room positions

Browse Source
This commit is contained in:
justin
2022-03-08 23:19:14 +00:00
parent ff6064a3b6
commit 8ff18178b1
2 changed files with 11 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/PlacementSpot.hs
+5
View File
@@ -37,6 +37,11 @@ unusedSpotAwayFromLink x = PSPos f (const id) Nothing
-> Just (PS p a,UsedSpot p a t) -> Just (PS p a,UsedSpot p a t)
_ -> Nothing _ -> Nothing
setFallback :: Placement -> Placement -> Placement
setFallback fallback plmnt = plmnt
& plSpot . psFallback .~ Just fallback
& plIDCont %~ fmap (fmap $ setFallback fallback)
unusedOffPathAwayFromLink :: Float -> PlacementSpot unusedOffPathAwayFromLink :: Float -> PlacementSpot
unusedOffPathAwayFromLink x = PSPos f (const id) Nothing unusedOffPathAwayFromLink x = PSPos f (const id) Nothing
where where
src/Dodge/Room/Tanks.hs
+6 -4
View File
@@ -36,12 +36,14 @@ tanksRoom crs its = do
thetank <- randomTank <&> plSpot .~ unusedOffPathAwayFromLink 50 thetank <- randomTank <&> plSpot .~ unusedOffPathAwayFromLink 50
let room = roomRectAutoLinks w h let room = roomRectAutoLinks w h
nwestlnks = length $ filter ((OnEdge West `S.member`) . _rlType) $ _rmLinks room nwestlnks = length $ filter ((OnEdge West `S.member`) . _rlType) $ _rmLinks room
girderPosOrder <- shuffle [1 .. nwestlnks - 2]
let plmnts = let plmnts =
--[ twoRoomPoss (isUnusedLinkType (OnEdge West)) (isUnusedLinkType (OnEdge East)) $ \ps1 ps2 -> --ok, this has become complicated
[ twoRoomPoss (isUnusedLinkType (FromSouth i)) (isUnusedLinkType (FromSouth i)) $ \ps1 ps2 -> foldr1 setFallback [ twoRoomPoss (isUnusedLinkType (FromSouth i))
(isUnusedLinkType (FromSouth i)) $ \ps1 ps2 ->
sps0 $ PutShape $ girderV 96 20 10 (_psPos ps1) (_psPos ps2) sps0 $ PutShape $ girderV 96 20 10 (_psPos ps1) (_psPos ps2)
| i <- [1 .. nwestlnks - 2]] | i <- girderPosOrder]
++ map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its : map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its
++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs ++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs
++ replicate ntanks thetank ++ replicate ntanks thetank
-- , sps0 $ PutShape $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25) -- , sps0 $ PutShape $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)