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

Allow for more complex placement positioning

Browse Source
This commit is contained in:
justin
2021-11-24 20:51:50 +00:00
parent c4614866e6
commit e44c5e7120
16 changed files with 178 additions and 173 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Default/Room.hs
+2
View File
@@ -3,6 +3,7 @@ module Dodge.Default.Room
import Geometry.Data import Geometry.Data
import Dodge.LevelGen.Data import Dodge.LevelGen.Data
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import qualified Data.Set as S
defaultRoom :: Room defaultRoom :: Room
defaultRoom = Room defaultRoom = Room
@@ -24,4 +25,5 @@ defaultRoom = Room
, _rmTakeFrom = Nothing , _rmTakeFrom = Nothing
, _rmStartWires = IM.empty , _rmStartWires = IM.empty
, _rmEndWires = IM.empty , _rmEndWires = IM.empty
, _rmConnectsTo = S.singleton OutLink
} }
src/Dodge/LevelGen/Data.hs
+22 -7
View File
@@ -38,11 +38,14 @@ data PSType = PutCrit {_unPutCrit :: Creature}
data PlacementSpot data PlacementSpot
= PS { _psPos :: Point2 , _psRot :: Float } = PS { _psPos :: Point2 , _psRot :: Float }
| PSPos | PSPos
{ _psLnkShift :: RoomPos -> Maybe (PlacementSpot, RoomPos) { _psSelect :: RoomPos -> Room -> Maybe (PlacementSpot, RoomPos)
, _psLnkRoomEff :: RoomPos -> Room -> Room , _psRoomEff :: RoomPos -> Room -> Room
, _psLnkFallback :: Maybe Placement , _psFallback :: Maybe Placement
}
| PSRoomRand
{ _psRoomRandPointNum :: Int
, _psRandShift :: (Point2,Float) -> PlacementSpot
} }
| PSRoomRand { _psRoomRandPointNum :: Int }
data Placement = Placement data Placement = Placement
{ _plSpot :: PlacementSpot { _plSpot :: PlacementSpot
, _plType :: PSType , _plType :: PSType
@@ -82,6 +85,7 @@ data Room = Room
, _rmTakeFrom :: Maybe Int , _rmTakeFrom :: Maybe Int
, _rmStartWires :: IM.IntMap RoomWire , _rmStartWires :: IM.IntMap RoomWire
, _rmEndWires :: IM.IntMap RoomWire , _rmEndWires :: IM.IntMap RoomWire
, _rmConnectsTo :: S.Set RoomLinkType
} }
data RoomLink = RoomLink data RoomLink = RoomLink
{ _rlType :: S.Set RoomLinkType { _rlType :: S.Set RoomLinkType
@@ -92,6 +96,13 @@ data RoomLinkType
= OutLink = OutLink
| InLink | InLink
| LabLink Int | LabLink Int
| OnEdge CardinalPoint
deriving (Eq,Ord)
data CardinalPoint
= North
| East
| South
| West
deriving (Eq,Ord) deriving (Eq,Ord)
data RoomWire data RoomWire
= --RoomWire Point2 Float = --RoomWire Point2 Float
@@ -112,9 +123,13 @@ data RoomPos
{_rpPos :: Point2 {_rpPos :: Point2
,_rpDir ::Float ,_rpDir ::Float
} }
| PosPl | UsedSpot
{_rpPos :: Point2 {_rpPos :: Point2
,_rpDir ::Float ,_rpDir :: Float
}
| UnusedSpot
{_rpPos :: Point2
,_rpDir :: Float
} }
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
@@ -144,7 +159,7 @@ sps :: PlacementSpot -> PSType -> Placement
sps ps pt = Placement ps pt Nothing (const Nothing) sps ps pt = Placement ps pt Nothing (const Nothing)
plRRpt :: Int -> PSType -> Placement plRRpt :: Int -> PSType -> Placement
plRRpt i pt = Placement (PSRoomRand i) pt Nothing (const Nothing) plRRpt i pt = Placement (PSRoomRand i (uncurry PS)) pt Nothing (const Nothing)
jsps :: Point2 -> Float -> PSType -> Maybe Placement jsps :: Point2 -> Float -> PSType -> Maybe Placement
jsps p a pst = Just $ Placement (PS p a) pst Nothing $ const Nothing jsps p a pst = Just $ Placement (PS p a) pst Nothing $ const Nothing
src/Dodge/LockAndKey.hs
+3 -3
View File
@@ -15,14 +15,14 @@ import Control.Monad.State
lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , State g ItemIdentity ) ] lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , State g ItemIdentity ) ]
lockRoomKeyItems = lockRoomKeyItems =
[ (lasCenSensEdge, takeOne [Launcher] ) [(lasCenSensEdge, takeOne [Launcher] )
-- , (const $ fmap singleUseAll slowDoorRoom, return MiniGun) ,(const slowDoorRoomRunPast, return MiniGun)
] ]
itemRooms :: RandomGen g => [(ItemIdentity, State g (SubCompTree Room))] itemRooms :: RandomGen g => [(ItemIdentity, State g (SubCompTree Room))]
itemRooms = itemRooms =
[ (Launcher , corridorBoss launcherCrit ) [ (Launcher , corridorBoss launcherCrit )
-- , (MiniGun , join $ takeOne [roomMiniIntro, minigunFakeout] ) , (MiniGun , join $ takeOne [roomMiniIntro, minigunFakeout] )
] ]
corridorBoss :: RandomGen g => Creature -> State g (SubCompTree Room) corridorBoss :: RandomGen g => Creature -> State g (SubCompTree Room)
src/Dodge/Placement/Instance/Button.hs
+2 -2
View File
@@ -58,7 +58,7 @@ putLitButtonID col p a subpl = mntLSOn aShape (Just col) ls p'' (addZ 40 p')
ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 } ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
putLitButOnPos :: Color putLitButOnPos :: Color
-> (RoomPos -> Maybe (PlacementSpot,RoomPos)) -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
-> (Int -> Maybe Placement) -> Placement -> (Int -> Maybe Placement) -> Placement
putLitButOnPos col f subpl putLitButOnPos col f subpl
= plSpot .~ thePS $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40) = plSpot .~ thePS $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
@@ -89,7 +89,7 @@ extTrigLitPos ps f = psPtCont ps (PutTrigger (const False))
thels = defaultLS {_lsIntensity = V3 0.5 0 0, _lsPos = V3 0 0 78, _lsRad = 75} thels = defaultLS {_lsIntensity = V3 0.5 0 0, _lsPos = V3 0 0 78, _lsRad = 75}
putLitButOnPosExtTrig :: Color putLitButOnPosExtTrig :: Color
-> (RoomPos -> Maybe (PlacementSpot,RoomPos)) -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
-> Placement -> Placement
putLitButOnPosExtTrig col f putLitButOnPosExtTrig col f
= psPtCont thePS (PutTrigger (const False)) = psPtCont thePS (PutTrigger (const False))
src/Dodge/Placement/Instance/LightSource.hs
+5 -5
View File
@@ -81,7 +81,7 @@ mntLS :: (Point2 -> Point3 -> Shape) -> Point2 -> Point3 -> Placement
mntLS shp wallp lampp = mntLSOn shp Nothing defaultLS wallp lampp (const Nothing) mntLS shp wallp lampp = mntLSOn shp Nothing defaultLS wallp lampp (const Nothing)
mntLSCond :: (Point2 -> Point3 -> Shape) mntLSCond :: (Point2 -> Point3 -> Shape)
-> (RoomPos -> Maybe (PlacementSpot,RoomPos)) -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
-> Placement -> Placement
mntLSCond shp shift = -- updatePSToLevel 1 (const $ PSLnk shift (const id) Nothing) $ mntLSCond shp shift = -- updatePSToLevel 1 (const $ PSLnk shift (const id) Nothing) $
mntLS shp 0 (V3 0 (-40) 90) mntLS shp 0 (V3 0 (-40) 90)
@@ -93,15 +93,15 @@ mntLight a b = RandomPlacement $ do
shp <- takeOne [vShape,iShape,lShape,jShape,liShape] shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
return $ mntLS shp a (addZ 90 b) return $ mntLS shp a (addZ 90 b)
mntLightLnkCond :: (RoomPos -> Maybe (PlacementSpot,RoomPos)) mntLightLnkCond :: (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
-> Placement -> Placement
mntLightLnkCond f = RandomPlacement $ do mntLightLnkCond f = RandomPlacement $ do
shp <- takeOne [vShape,iShape,lShape,jShape,liShape] shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
return $ mntLSCond shp f return $ mntLSCond shp f
unusedLnkToPS :: RoomPos -> Maybe (PlacementSpot,RoomPos) unusedLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
unusedLnkToPS rp = case rp of unusedLnkToPS rp _ = case rp of
UnusedLink p a -> Just (PS p a,PosPl p a) UnusedLink p a -> Just (PS p a,UsedSpot p a)
_ -> Nothing _ -> Nothing
spanLSLightI :: LightSource -> Float -> Point2 -> Point2 -> Placement spanLSLightI :: LightSource -> Float -> Point2 -> Point2 -> Placement
src/Dodge/Placement/PlaceSpot.hs
+7 -6
View File
@@ -33,7 +33,7 @@ import Data.Bifunctor
-- to the placement -- to the placement
placeSpot :: (World,Room) -> Placement -> ( (World,Room), [Placement] ) placeSpot :: (World,Room) -> Placement -> ( (World,Room), [Placement] )
placeSpot (w,rm) plmnt = case plmnt of placeSpot (w,rm) plmnt = case plmnt of
Placement{_plSpot = PSRoomRand i} -> placeSpotRoomRand rm i plmnt w Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rm i f plmnt w
Placement{_plSpot = PSPos extract eff fallback} -> placeSpotUsingLink w rm plmnt extract eff fallback Placement{_plSpot = PSPos extract eff fallback} -> placeSpotUsingLink w rm plmnt extract eff fallback
Placement{} -> Placement{} ->
let (i,w') = placeSpotID (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w let (i,w') = placeSpotID (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
@@ -52,7 +52,7 @@ placeSpot (w,rm) plmnt = case plmnt of
-- this should be tidied up -- this should be tidied up
placeSpotUsingLink :: World -> Room -> Placement placeSpotUsingLink :: World -> Room -> Placement
-> (RoomPos -> Maybe (PlacementSpot,RoomPos)) -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
-> (RoomPos -> Room -> Room) -> (RoomPos -> Room -> Room)
-> Maybe Placement -> Maybe Placement
-> ((World, Room), [Placement]) -> ((World, Room), [Placement])
@@ -63,14 +63,15 @@ placeSpotUsingLink w rm plmnt extract eff fallback = case searchedPoss (_rmPos r
Just plmnt' -> placeSpot (w,rm) plmnt' Just plmnt' -> placeSpot (w,rm) plmnt'
where where
searchedPoss [] = Nothing searchedPoss [] = Nothing
searchedPoss (pos:poss) = case extract pos of searchedPoss (pos:poss) = case extract pos rm of
Nothing -> second (pos:) <$> searchedPoss poss Nothing -> second (pos:) <$> searchedPoss poss
Just (ps,rmpos) -> Just ( ps,rmpos:poss) Just (ps,rmpos) -> Just ( ps,rmpos:poss)
placeSpotRoomRand :: Room -> Int -> Placement -> World -> ((World,Room),[Placement]) placeSpotRoomRand :: Room -> Int -> ((Point2,Float) -> PlacementSpot)
placeSpotRoomRand rm i plmnt w = -> Placement -> World -> ((World,Room),[Placement])
placeSpotRoomRand rm i f plmnt w =
let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w
in placeSpot (w & randGen .~ g,rm) (plmnt & plSpot .~ uncurry PS ps) in placeSpot (w & randGen .~ g,rm) (plmnt & plSpot .~ f ps)
shiftPlacement :: (Point2,Float) -> Placement -> Placement shiftPlacement :: (Point2,Float) -> Placement -> Placement
shiftPlacement shift plmnt = case plmnt of shiftPlacement shift plmnt = case plmnt of
src/Dodge/PlacementSpot.hs
+33 -13
View File
@@ -2,29 +2,49 @@ module Dodge.PlacementSpot where
import Dodge.LevelGen.Data import Dodge.LevelGen.Data
import Geometry import Geometry
import Data.Bifunctor
import Control.Monad.State import Control.Monad.State
import System.Random import System.Random
setDirPS :: Float -> PlacementSpot -> PlacementSpot
setDirPS a ps = case ps of
PS p _ -> PS p a
PSPos f re fb -> undefined
_ -> error "TODO write this in"
randDirPS :: RandomGen g => PlacementSpot -> State g PlacementSpot
randDirPS (PSPos f ef fb) = do
a <- state $ randomR (0,pi*2)
return $ PSPos (g a) ef fb
where
g a rp r = fmap (first (setDirPS a)) $ f rp r
--unusedSpotAwayFromInLinkRD :: RandomGen g => Float -> State g PlacementSpot
--unusedSpotAwayFromInLinkRD x = do
-- a <- state $ randomR (0.2*pi)
-- return PSPos (f a) (const id) Nothing
-- where
-- TODO rename to any unused link facing out -- TODO rename to any unused link facing out
anyLnkOutPS :: PlacementSpot anyLnkOutPS :: PlacementSpot
anyLnkOutPS = PSPos f (const id) Nothing anyLnkOutPS = PSPos f (const id) Nothing
where where
f (UnusedLink p a) = Just (PS p a, PosPl p a) f (UnusedLink p a) _ = Just (PS p a, UsedSpot p a)
f _ = Nothing f _ _ = Nothing
atFstLnkOut :: PlacementSpot atFstLnkOut :: PlacementSpot
atFstLnkOut = PSPos f (const id) Nothing atFstLnkOut = PSPos f (const id) Nothing
where where
f (UsedOutLink 0 i p a) = Just (PS p a, UsedOutLink 0 i p a) f (UsedOutLink 0 i p a) _ = Just (PS p a, UsedOutLink 0 i p a)
f _ = Nothing f _ _ = Nothing
atNthLnkOutShiftBy :: Int -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot atNthLnkOutShiftBy :: Int -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
atNthLnkOutShiftBy n theshift = PSPos f (const id) Nothing atNthLnkOutShiftBy n theshift = PSPos f (const id) Nothing
where where
f (UsedOutLink i rmid p a) | n == i = Just (PS p' a', UsedOutLink n rmid p a) f (UsedOutLink i rmid p a) _ | n == i = Just (PS p' a', UsedOutLink n rmid p a)
where where
(p',a') = theshift (p,a) (p',a') = theshift (p,a)
f _ = Nothing f _ _ = Nothing
atFstLnkOutShiftBy :: ((Point2,Float) -> (Point2,Float)) -> PlacementSpot atFstLnkOutShiftBy :: ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
atFstLnkOutShiftBy = atNthLnkOutShiftBy 0 atFstLnkOutShiftBy = atNthLnkOutShiftBy 0
@@ -40,22 +60,22 @@ atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n f
overFstLnkOut :: PlacementSpot overFstLnkOut :: PlacementSpot
overFstLnkOut = PSPos f (const id) Nothing overFstLnkOut = PSPos f (const id) Nothing
where where
f (UsedOutLink 0 _ p a) = Just (PS p a, PosPl p a) f (UsedOutLink 0 _ p a) _ = Just (PS p a, UsedSpot p a)
f _ = Nothing f _ _ = Nothing
anyLnkInPS :: Float -- ^ amount to shift inward anyLnkInPS :: Float -- ^ amount to shift inward
-> PlacementSpot -> PlacementSpot
anyLnkInPS x = PSPos f (const id) Nothing anyLnkInPS x = PSPos f (const id) Nothing
where where
f (UnusedLink v a) = Just (PS v' a' ,PosPl v' a') f (UnusedLink v a) _ = Just (PS v' a' ,UsedSpot v' a')
where where
v' = v -.- x *.* unitVectorAtAngle (a + 0.5 * pi) v' = v -.- x *.* unitVectorAtAngle (a + 0.5 * pi)
a' = a + pi a' = a + pi
f _ = Nothing f _ _ = Nothing
useLnkRoomPos :: RoomPos -> Maybe (PlacementSpot,RoomPos) useLnkRoomPos :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
useLnkRoomPos rp = case rp of useLnkRoomPos rp _ = case rp of
(UnusedLink (V2 x y) a) -> Just (PS (V2 x y) a , PosPl (V2 x y) a) (UnusedLink (V2 x y) a) -> Just (PS (V2 x y) a , UsedSpot (V2 x y) a)
_ -> Nothing _ -> Nothing
psRandRanges :: (Float,Float) -> (Float,Float) -> (Float,Float) -> State StdGen (Point2,Float) psRandRanges :: (Float,Float) -> (Float,Float) -> (Float,Float) -> State StdGen (Point2,Float)
src/Dodge/Room/Link.hs
+12
View File
@@ -16,6 +16,7 @@ module Dodge.Room.Link
, changeLinkTo , changeLinkTo
, changeLinkFrom , changeLinkFrom
, randomiseOutLinks , randomiseOutLinks
, chooseOneInLink
) where ) where
import Dodge.Placement.PlaceSpot import Dodge.Placement.PlaceSpot
import Dodge.LevelGen.Data import Dodge.LevelGen.Data
@@ -29,6 +30,17 @@ import Control.Monad.State
import Control.Lens import Control.Lens
import Data.List import Data.List
import qualified Data.Set as S import qualified Data.Set as S
--import System.Random
chooseOneInLink :: RandomGen g => Room -> State g Room
chooseOneInLink r = restrictToFstInLink <$> shuffleLinks r
restrictToFstInLink :: Room -> Room
restrictToFstInLink = rmLinks %~ f
where
f (rl:xs) | S.member InLink (_rlType rl) = rl : restrictLinkType InLink (const False) xs
| otherwise = rl : f xs
f [] = []
{- Shuffle the initial links of a room randomly. -} {- Shuffle the initial links of a room randomly. -}
randomiseOutLinks :: RandomGen g => Room -> State g Room randomiseOutLinks :: RandomGen g => Room -> State g Room
src/Dodge/Room/LongDoor.hs
+17 -4
View File
@@ -5,10 +5,12 @@ module Dodge.Room.LongDoor where
import Dodge.Data import Dodge.Data
import Dodge.RoomLink import Dodge.RoomLink
import Dodge.Base import Dodge.Base
import Dodge.Tree
import Dodge.Default.Room import Dodge.Default.Room
import Dodge.LevelGen.Data import Dodge.LevelGen.Data
import Dodge.Placement.Instance import Dodge.Placement.Instance
import Dodge.Room.Link import Dodge.Room.Link
import Dodge.Room.Door
import Dodge.Room.Procedural import Dodge.Room.Procedural
--import Dodge.Layout.Tree.Either --import Dodge.Layout.Tree.Either
--import Dodge.LevelGen.Data --import Dodge.LevelGen.Data
@@ -20,6 +22,8 @@ import Dodge.LightSource
import Picture import Picture
import Geometry import Geometry
import qualified Data.Set as S
import Data.Tree
import System.Random import System.Random
import Control.Lens import Control.Lens
import Control.Monad.State import Control.Monad.State
@@ -106,7 +110,7 @@ addButtonSlowDoor x h rm = do
,( V2 (x/2+50) 5,0::Float) ,( V2 (x/2+50) 5,0::Float)
] ]
thePlacement <- takeOne [butDoor butPos butRot ] thePlacement <- takeOne [butDoor butPos butRot ]
shuffleLinks $ setOutLinks aboveH $ setInLinks belowH (rm shuffleLinks $ setOutLinksPD aboveH $ setInLinksPD belowH (rm
& rmPmnts %~ (thePlacement :) & rmPmnts %~ (thePlacement :)
& rmBound %~ (openDoorBound :) & rmBound %~ (openDoorBound :)
) )
@@ -116,9 +120,9 @@ addButtonSlowDoor x h rm = do
aboveH y = (sndV2 . fst) y > h + 40 aboveH y = (sndV2 . fst) y > h + 40
butDoor _ _ = putLitButOnPos col butPosCond butDoor _ _ = putLitButOnPos col butPosCond
$ \btid -> Just $ putDoubleDoor False col (cond' btid) (V2 0 h) (V2 x h) 2 $ \btid -> Just $ putDoubleDoor False col (cond' btid) (V2 0 h) (V2 x h) 2
butPosCond (UnusedLink (V2 x' y') a') | y' < 0.5 * h butPosCond (UnusedLink (V2 x' y') a') _ | y' < 0.5 * h
= Just (PS (V2 x' y') a' , PosPl (V2 x' y') a') = Just (PS (V2 x' y') a' , UsedSpot (V2 x' y') a')
butPosCond _ = Nothing butPosCond _ _ = Nothing
--butPosCond _ = True -- y < h --butPosCond _ = True -- y < h
col = dim $ light red col = dim $ light red
cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff
@@ -141,3 +145,12 @@ slowDoorRoom = do
proom <- southPillarsRoom x y h proom <- southPillarsRoom x y h
addButtonSlowDoor x h (proom & rmPmnts %~ (++ (crits ++ barrels ++ lsources))) addButtonSlowDoor x h (proom & rmPmnts %~ (++ (crits ++ barrels ++ lsources)))
slowDoorRoomRunPast :: RandomGen g => State g (SubCompTree Room)
slowDoorRoomRunPast = do
r <- slowDoorRoom
return $ treeFromTrunk [PassDown door]
(Node (PassDown r)
[ singleUseAll door
, return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton InLink)
]
)
src/Dodge/Room/Procedural.hs
+5 -2
View File
@@ -47,8 +47,9 @@ roomRect
-> Room -> Room
roomRect x y xn yn = defaultRoom roomRect x y xn yn = defaultRoom
{ _rmPolys = [rectNSWE y 0 0 x ] { _rmPolys = [rectNSWE y 0 0 x ]
, _rmLinks = init lnks ++ [last lnks] , _rmLinks = lnks
, _rmPath = concatMap doublePair pth , _rmPath = concatMap doublePair pth
, _rmPos = map (\p -> UnusedSpot p 0) posps
, _rmPmnts = [] , _rmPmnts = []
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)] , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
, _rmFloor = [Tile , _rmFloor = [Tile
@@ -66,8 +67,10 @@ roomRect x y xn yn = defaultRoom
wlnks = zip (map (+.+ V2 x 20) $ gridPoints 0 1 yd (yn+1)) (repeat (-pi/2)) wlnks = zip (map (+.+ V2 x 20) $ gridPoints 0 1 yd (yn+1)) (repeat (-pi/2))
nlnks = zip (map (+.+ V2 20 y) $ gridPoints xd (xn+1) 0 1 ) (repeat 0 ) nlnks = zip (map (+.+ V2 20 y) $ gridPoints xd (xn+1) 0 1 ) (repeat 0 )
slnks = zip (map (+.+ V2 20 0) $ gridPoints xd (xn+1) 0 1 ) (repeat pi ) slnks = zip (map (+.+ V2 20 0) $ gridPoints xd (xn+1) 0 1 ) (repeat pi )
lnks = map toBothLnk $ nlnks ++ elnks ++ wlnks ++ slnks lnks = m North nlnks ++ m East elnks ++ m West wlnks ++ m South slnks
m edge = map (lnkBothAnd (OnEdge edge))
pth = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn) pth = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
posps = map (+.+ V2 20 20) $ gridPoints xd xn yd yn
{- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size. -} {- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size. -}
-- it is not clear to me that this works for very small rooms (but it does seem -- it is not clear to me that this works for very small rooms (but it does seem
-- to do so) -- to do so)
src/Dodge/Room/RoadBlock.hs
+6 -4
View File
@@ -77,8 +77,8 @@ dirtPoly :: [Point2] -> PSType
dirtPoly = PutBlock DirtBlock [1] dirtWall . reverse dirtPoly = PutBlock DirtBlock [1] dirtWall . reverse
-- | A single corridor with a destructible block blocking it. -- | A single corridor with a destructible block blocking it.
blockedCorridor' :: RandomGen g => State g Room blockedCorridorCloseBlocks :: RandomGen g => State g Room
blockedCorridor' = do blockedCorridorCloseBlocks = do
r <- state $ randomR (0,pi) r <- state $ randomR (0,pi)
theblocks <- takeOne theblocks <- takeOne
[ -- [sPS (V2 20 40) r $ dirtPoly $ square 10] [ -- [sPS (V2 20 40) r $ dirtPoly $ square 10]
@@ -86,8 +86,10 @@ blockedCorridor' = do
-- , sPS (V2 35 40) (r+0.5) $ dirtPoly $ square 10 -- , sPS (V2 35 40) (r+0.5) $ dirtPoly $ square 10
-- ] -- ]
--, --,
[ sPS (V2 5 50) r $ dirtPoly $ square 10 --[ sPS (V2 5 50) r $ dirtPoly $ square 10
, sPS (V2 35 35) (r+0.5) $ dirtPoly $ square 10 --, sPS (V2 35 35) (r+0.5) $ dirtPoly $ square 10
[ sPS (V2 6 25) r $ dirtPoly $ square 10
, sPS (V2 35 20) (r+0.5) $ dirtPoly $ square 10
] ]
] ]
return $ corridor & rmPmnts .~ theblocks return $ corridor & rmPmnts .~ theblocks
src/Dodge/Room/Room.hs
+20 -20
View File
@@ -53,8 +53,8 @@ roomPadCut ps p = defaultRoom
, _rmPath = [(V2 0 0,p)] , _rmPath = [(V2 0 0,p)]
} }
roomPillars :: Room roomPillars :: Room
roomPillars = --over rmLinks init $ -- it is unclear to me the purpose of this: perhaps to get the in link in the center? roomPillars = roomRect 240 240 2 2
set rmPmnts plmnts $ roomRect 240 240 2 2 & rmPmnts .~ plmnts
where where
plmnts = spanLightI (V2 120 24) (V2 120 216) plmnts = spanLightI (V2 120 24) (V2 120 216)
: mntLS vShape (V2 12 12) (V3 25 25 70) : mntLS vShape (V2 12 12) (V3 25 25 70)
@@ -106,8 +106,8 @@ glassSwitchBack = do
hgt <- state $ randomR (400,600) hgt <- state $ randomR (400,600)
wllen <- state $ randomR (60,wth/2-40) wllen <- state $ randomR (60,wth/2-40)
let hf = hgt/5 let hf = hgt/5
con1 cond (UnusedLink (V2 x y) a) | cond y = Just (PS (V2 x y) a , PosPl (V2 x y) a) con1 cond (UnusedLink (V2 x y) a) _ | cond y = Just (PS (V2 x y) a , UsedSpot (V2 x y) a)
con1 _ _ = Nothing con1 _ _ _ = Nothing
plmnts = plmnts =
[ mntLightLnkCond $ con1 (< 0.5 * hgt) [ mntLightLnkCond $ con1 (< 0.5 * hgt)
, mntLightLnkCond $ con1 (> 0.5 * hgt) , mntLightLnkCond $ con1 (> 0.5 * hgt)
@@ -134,8 +134,8 @@ glassSwitchBack = do
glassSwitchBackCrits :: RandomGen g => State g Room glassSwitchBackCrits :: RandomGen g => State g Room
glassSwitchBackCrits = glassSwitchBack glassSwitchBackCrits = glassSwitchBack
<&> rmPmnts %~ ([spNoID (PSRoomRand 0) (PutCrit miniGunCrit) <&> rmPmnts %~ ([spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit miniGunCrit)
, spNoID (PSRoomRand 1) randC1 , spNoID (PSRoomRand 1 (uncurry PS)) randC1
] ++) ] ++)
miniTree2 :: RandomGen g => State g (SubCompTree Room) miniTree2 :: RandomGen g => State g (SubCompTree Room)
@@ -182,7 +182,7 @@ rot90Around cen p = cen +.+ vNormal (p -.- cen)
-- inside an inner tree -- inside an inner tree
roomMiniIntro :: RandomGen g => State g (SubCompTree Room) roomMiniIntro :: RandomGen g => State g (SubCompTree Room)
roomMiniIntro = do roomMiniIntro = do
midroom <- join $ takeOne [miniTree2,glassLesson] midroom <- join $ takeOne [miniTree2] --,glassLesson]
return $ chainUses [return $ UseAll door, midroom,return $ UseAll corridor] return $ chainUses [return $ UseAll door, midroom,return $ UseAll corridor]
roomCenterPillar :: RandomGen g => State g Room roomCenterPillar :: RandomGen g => State g Room
@@ -328,7 +328,7 @@ weaponLongCorridor :: RandomGen g => State g (SubCompTree Room)
weaponLongCorridor = do weaponLongCorridor = do
root <- takeOne [tEast, tWest] root <- takeOne [tEast, tWest]
connectingRoom <- takeOne connectingRoom <- takeOne
[tEast & rmPmnts .~ [spanLightI (V2 (-40) 40) (V2 (-40) 80)] [tEast & rmPmnts .~ [spanLightI (V2 (-30) 40) (V2 (-30) 80)]
] ]
i1 <- state $ randomR (2,5) i1 <- state $ randomR (2,5)
i2 <- state $ randomR (2,5) i2 <- state $ randomR (2,5)
@@ -356,16 +356,16 @@ deadEndRoom = defaultRoom
{- A random Either tree with a weapon and melee monster challenge. -} {- A random Either tree with a weapon and melee monster challenge. -}
weaponRoom :: RandomGen g => State g (SubCompTree Room) weaponRoom :: RandomGen g => State g (SubCompTree Room)
weaponRoom = join $ takeOne weaponRoom = join $ takeOne
[ weaponEmptyRoom [-- weaponEmptyRoom
, weaponUnderCrits --, weaponUnderCrits
, weaponBehindPillar --, weaponBehindPillar
, weaponBetweenPillars weaponBetweenPillars
, weaponLongCorridor --, weaponLongCorridor
] ]
roomCCrits :: RandomGen g => State g Room roomCCrits :: RandomGen g => State g Room
roomCCrits = roomC 200 200 roomCCrits = roomC 200 200
<&> rmPmnts %~ (replicate 20 (spNoID (PSRoomRand 0) randC1) ++ ) <&> rmPmnts %~ (replicate 20 (spNoID (PSRoomRand 0 (uncurry PS)) randC1) ++ )
longRoom :: RandomGen g => State g Room longRoom :: RandomGen g => State g Room
longRoom = do longRoom = do
@@ -432,13 +432,13 @@ shootersRoom' = do
shootersRoom1 :: RandomGen g => State g Room shootersRoom1 :: RandomGen g => State g Room
shootersRoom1 = shootersRoom' <&> rmPmnts %~ shootersRoom1 = shootersRoom' <&> rmPmnts %~
( ( ( (
RandomPlacement $ takeOne $ map (\i -> spNoID (PSRoomRand i) (PutCrit autoCrit)) RandomPlacement $ takeOne $ map (\i -> spNoID (PSRoomRand i (uncurry PS)) (PutCrit autoCrit))
[0,1,2] [0,1,2]
) :) ) :)
shootersRoom :: RandomGen g => State g Room shootersRoom :: RandomGen g => State g Room
shootersRoom = shootersRoom' <&> rmPmnts %~ shootersRoom = shootersRoom' <&> rmPmnts %~
( map (\i -> spNoID (PSRoomRand i) (PutCrit autoCrit)) ( map (\i -> spNoID (PSRoomRand i (uncurry PS)) (PutCrit autoCrit))
[0,1,2] [0,1,2]
++ ) ++ )
@@ -477,9 +477,9 @@ pillarGrid = do
pistolerRoom :: RandomGen g => State g Room pistolerRoom :: RandomGen g => State g Room
pistolerRoom = pillarGrid pistolerRoom = pillarGrid
<&> rmPmnts %~ ( <&> rmPmnts %~ (
[spNoID (PSRoomRand 0) (PutCrit pistolCrit) [spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit pistolCrit)
,spNoID (PSRoomRand 0) (PutCrit pistolCrit) ,spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit pistolCrit)
,spNoID (PSRoomRand 0) (PutCrit pistolCrit) ,spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit pistolCrit)
] ]
++) ++)
@@ -506,6 +506,6 @@ spawnerRoom = do
x <- state $ randomR (250,300) x <- state $ randomR (250,300)
y <- state $ randomR (300,400) y <- state $ randomR (300,400)
roomWithSpawner <- roomC x y <&> roomWithSpawner <- roomC x y <&>
rmPmnts %~ (spNoID (PSRoomRand 0) (PutCrit spawnerCrit) :) rmPmnts %~ (spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit spawnerCrit) :)
aRoom <- airlock aRoom <- airlock
return $ treeFromTrunk [PassDown aRoom,PassDown corridor] $ singleUseAll roomWithSpawner return $ treeFromTrunk [PassDown aRoom,PassDown corridor] $ singleUseAll roomWithSpawner
src/Dodge/Room/Start.hs
+6 -97
View File
@@ -10,6 +10,7 @@ import Dodge.Default
import Dodge.Tree import Dodge.Tree
import Dodge.RandomHelp import Dodge.RandomHelp
import Dodge.Room.Door import Dodge.Room.Door
import Dodge.Room.RezBox
import Dodge.Room.Corridor import Dodge.Room.Corridor
import Dodge.Room.Room import Dodge.Room.Room
import Dodge.Room.Link import Dodge.Room.Link
@@ -67,11 +68,11 @@ startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
startRoom i = join $ takeOne startRoom i = join $ takeOne
[-- roomMiniIntro [-- roomMiniIntro
--minigunfakeout --minigunfakeout
rezBoxesWp -- rezBoxesWp
, rezBoxesThenWeaponRoom rezBoxesThenWeaponRoom
, rezBoxThenWeaponRoom -- , rezBoxThenWeaponRoom
, rezBoxesWpCrit -- rezBoxesWpCrit
, runPastStart i -- , runPastStart i
] ]
runPastStart :: RandomGen g => Int -> State g (SubCompTree Room) runPastStart :: RandomGen g => Int -> State g (SubCompTree Room)
@@ -85,33 +86,6 @@ rezBoxStart = do
ls <- rezColor ls <- rezColor
return $ treeFromPost [PassDown $ rezBox ls] (UseAll door) return $ treeFromPost [PassDown $ rezBox ls] (UseAll door)
rezBox :: LightSource -> Room
rezBox ls = roomRect 40 60 1 1
& rmPmnts .~ [ sPS (V2 20 1) 0 $ PutLS ls]
rezColor :: RandomGen g => State g LightSource
rezColor = do
col <- takeOne [V3 0.0 0.1 0.5, V3 0.0 0.5 0.1]
h <- takeOne [30,50,80,90,90,90,90]
rad <- takeOne [150,200,200,250,250,300,300,300]
return defaultLS
{ _lsPos = V3 0 0 h
, _lsIntensity = col
, _lsRad = rad
}
rezInvBox :: LightSource -> Room
rezInvBox = swapInOutLinks . rezBox
crAdd :: Room -> Room
crAdd = rmPmnts %~ (sPS (V2 20 10) (0.5*pi) randC1 :)
wpAdd :: Item -> Room -> Room
wpAdd wp = rmPmnts %~ f
where
f (x:xs) = sPS (V2 15 30) 1 (PutFlIt wp) : g x : xs
f _ = [sPS (V2 15 30) 1 (PutFlIt wp)]
g x = x & plIDCont .~ flickerMod
rezBoxesThenWeaponRoom :: RandomGen g => State g (SubCompTree Room) rezBoxesThenWeaponRoom :: RandomGen g => State g (SubCompTree Room)
rezBoxesThenWeaponRoom = do rezBoxesThenWeaponRoom = do
@@ -124,72 +98,7 @@ rezBoxThenWeaponRoom = do
rcol <- rezColor rcol <- rezColor
treeFromTrunk [PassDown $ rezBox rcol,PassDown door] <$> weaponRoom treeFromTrunk [PassDown $ rezBox rcol,PassDown door] <$> weaponRoom
rezBoxesWpCrit :: RandomGen g => State g (SubCompTree Room)
rezBoxesWpCrit = do
w <- state $ randomR (200,400)
h <- state $ randomR (40,40)
thecol <- rezColor
theweapon <- randBlockBreakWeapon
let bottomEdgeTest (V2 _ y,_) = y < 1
bottomPassDownTest (V2 x y,_) = y < 1 && x < 21
aroom = rezInvBox thecol
centralRoom <- filterSortOutLinksOn bottomEdgeTest ((\(V2 a b) -> (b,a)) . fst) <$>
(randomiseOutLinks =<< changeLinkTo bottomPassDownTest
((roomRectAutoLinks w h) {_rmPmnts = []}))
let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _rmLinks centralRoom
i <- state $ randomR (0,n-3)
j <- state $ randomR (i,n-2)
blcor <- blockedCorridor'
let rezrooms = map adddoor
$ insertAt i (wpAdd theweapon aroom)
$ insertAt j (crAdd aroom)
$ replicate (n-3) aroom
return $ treeFromTrunk [PassDown $ rezBox thecol
, PassDown door
]
(Node (PassDown centralRoom) (rezrooms ++ [onwardtree blcor]))
where
adddoor rm = treeFromPost [PassDown door] (PassDown rm)
onwardtree blcor = treeFromPost [PassDown door] (UseAll blcor)
rezBoxesWp :: RandomGen g => State g (SubCompTree Room)
rezBoxesWp = do
w <- state $ randomR (100,400)
h <- state $ randomR (40,40)
theweapon <- randBlockBreakWeapon
thecol <- rezColor
let bottomEdgeTest (V2 _ y,_) = y < 1
aroom = rezInvBox thecol
centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest
((roomRectAutoLinks w h) {_rmPmnts = []})
blcor <- blockedCorridor'
let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmLinks centralRoom
let rezrooms = map adddoor
$ wpAdd theweapon aroom : replicate (n-2) aroom
centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
return $ treeFromTrunk [PassDown $ rezBox thecol
, PassDown door
]
(Node (PassDown centralRoom') (rezrooms ++ [onwardtree blcor]))
where
adddoor rm = treeFromPost [PassDown door] (PassDown rm)
onwardtree blcor = treeFromPost [PassDown door] (UseAll blcor)
rezBoxes :: RandomGen g => State g (SubCompTree Room)
rezBoxes = do
w <- state $ randomR (100,400)
h <- state $ randomR (40,40)
thecol <- rezColor
let bottomEdgeTest (V2 _ y,_) = y < 1
dbox = treeFromPost [PassDown door] (PassDown $ rezInvBox thecol)
centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest
((roomRectAutoLinks w h) {_rmPmnts = []})
let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmLinks centralRoom
centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
return $ treeFromTrunk [PassDown $ rezBox thecol
, PassDown door
]
(Node (PassDown centralRoom') (replicate (n-1) dbox ++ [Node (UseAll door) []]))
startRoom' :: RandomGen g => State g (SubCompTree Room) startRoom' :: RandomGen g => State g (SubCompTree Room)
startRoom' = do startRoom' = do
src/Dodge/RoomLink.hs
+27 -9
View File
@@ -9,8 +9,11 @@ import Control.Lens
restrictLinkType :: RoomLinkType -> ((Point2,Float) -> Bool) -> [RoomLink] -> [RoomLink] restrictLinkType :: RoomLinkType -> ((Point2,Float) -> Bool) -> [RoomLink] -> [RoomLink]
restrictLinkType rlt f = map g restrictLinkType rlt f = map g
where where
g rl | f $ rlPosDir rl = rl & rlType %~ S.delete rlt g rl | f $ rlPosDir rl = rl
| otherwise = rl | otherwise = rl & rlType %~ S.delete rlt
getLinksOfType :: RoomLinkType -> [RoomLink] -> [RoomLink]
getLinksOfType lt = filter (S.member lt . _rlType)
restrictInLinks :: ((Point2,Float) -> Bool) -> Room -> Room restrictInLinks :: ((Point2,Float) -> Bool) -> Room -> Room
restrictInLinks f = rmLinks %~ restrictLinkType InLink f restrictInLinks f = rmLinks %~ restrictLinkType InLink f
@@ -18,17 +21,26 @@ restrictInLinks f = rmLinks %~ restrictLinkType InLink f
restrictOutLinks :: ((Point2,Float) -> Bool) -> Room -> Room restrictOutLinks :: ((Point2,Float) -> Bool) -> Room -> Room
restrictOutLinks f = rmLinks %~ restrictLinkType OutLink f restrictOutLinks f = rmLinks %~ restrictLinkType OutLink f
setLinkType :: RoomLinkType -> ((Point2,Float) -> Bool) -> [RoomLink] -> [RoomLink] setInLinks :: (RoomLink -> Bool) -> [RoomLink] -> [RoomLink]
setInLinks = setLinkType InLink
setLinkType :: RoomLinkType -> (RoomLink -> Bool) -> [RoomLink] -> [RoomLink]
setLinkType rlt f = map g setLinkType rlt f = map g
where where
g rl | f $ rlPosDir rl = rl & rlType %~ S.delete rlt g rl | f rl = rl & rlType %~ S.insert rlt
| otherwise = rl & rlType %~ S.insert rlt | otherwise = rl & rlType %~ S.delete rlt
setInLinks :: ((Point2,Float) -> Bool) -> Room -> Room
setInLinks f = rmLinks %~ setLinkType InLink f
setOutLinks :: ((Point2,Float) -> Bool) -> Room -> Room setLinkTypePD :: RoomLinkType -> ((Point2,Float) -> Bool) -> [RoomLink] -> [RoomLink]
setOutLinks f = rmLinks %~ setLinkType OutLink f setLinkTypePD rlt f = map g
where
g rl | f $ rlPosDir rl = rl & rlType %~ S.insert rlt
| otherwise = rl & rlType %~ S.delete rlt
setInLinksPD :: ((Point2,Float) -> Bool) -> Room -> Room
setInLinksPD f = rmLinks %~ setLinkTypePD InLink f
setOutLinksPD :: ((Point2,Float) -> Bool) -> Room -> Room
setOutLinksPD f = rmLinks %~ setLinkTypePD OutLink f
swapInOutLinks :: Room -> Room swapInOutLinks :: Room -> Room
swapInOutLinks = rmLinks %~ map (rlType %~ S.map f) swapInOutLinks = rmLinks %~ map (rlType %~ S.map f)
@@ -66,6 +78,12 @@ inLink p a = RoomLink
,_rlPos = p ,_rlPos = p
, _rlDir = a , _rlDir = a
} }
lnkBothAnd :: RoomLinkType -> (Point2,Float) -> RoomLink
lnkBothAnd rlt (p,a) = RoomLink
{_rlType = S.fromList [OutLink,InLink,rlt]
,_rlPos = p
, _rlDir = a
}
toBothLnk :: (Point2,Float) -> RoomLink toBothLnk :: (Point2,Float) -> RoomLink
toBothLnk (p,a) = RoomLink toBothLnk (p,a) = RoomLink
src/Dodge/Tree/Compose.hs
+5
View File
@@ -8,11 +8,13 @@ module Dodge.Tree.Compose
, useAllAtEnd , useAllAtEnd
, changeToPassDown , changeToPassDown
, overwriteLabel , overwriteLabel
, applyToCompRoot
) where ) where
import Dodge.Tree.Compose.Data import Dodge.Tree.Compose.Data
import Dodge.Tree.Polymorphic import Dodge.Tree.Polymorphic
import Dodge.Base import Dodge.Base
import Data.Tree import Data.Tree
import Control.Lens
expandTree :: CompTree a -> Tree a expandTree :: CompTree a -> Tree a
expandTree (Node root extChildren) = case root of expandTree (Node root extChildren) = case root of
@@ -24,6 +26,9 @@ expandTree (Node root extChildren) = case root of
Node (SplitDown x) xs -> Node x $ map expandTree $ zipWith Node xs Node (SplitDown x) xs -> Node x $ map expandTree $ zipWith Node xs
$ map (:[]) extChildren ++ repeat [] $ map (:[]) extChildren ++ repeat []
applyToCompRoot :: (a -> a) -> SubCompTree a -> SubCompTree a
applyToCompRoot f = applyToRoot (unCompose %~ f)
overwriteLabel :: Int -> (a -> ComposingNode a) -> SubCompTree a -> [SubCompTree a] -> SubCompTree a overwriteLabel :: Int -> (a -> ComposingNode a) -> SubCompTree a -> [SubCompTree a] -> SubCompTree a
overwriteLabel i f t ts = errorHead ("tried to overwriteLabel " ++ show i) overwriteLabel i f t ts = errorHead ("tried to overwriteLabel " ++ show i)
$ updateSingleNode islabel update t $ updateSingleNode islabel update t
src/Dodge/Tree/Shift.hs
+6 -1
View File
@@ -12,6 +12,7 @@ import Geometry.ConvexPoly
import Geometry.Data import Geometry.Data
import Padding import Padding
import qualified Data.Set as S
import Data.Tree import Data.Tree
import Data.Sequence hiding (zipWith) import Data.Sequence hiding (zipWith)
import Data.List (delete) import Data.List (delete)
@@ -34,8 +35,12 @@ posRms bounds (parent,_) [] st = case st of
Node childi ts :<| tseq -> fmap (parent:) <$> posRms bounds childi (zipCount ts) tseq Node childi ts :<| tseq -> fmap (parent:) <$> posRms bounds childi (zipCount ts) tseq
posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
printInfoCheckNum parenti numChild childi printInfoCheckNum parenti numChild childi
tryParentLinks $ zipCount $ rmOutLinks parent tryParentLinks outlinks
where where
child = fst childi
outlinks = zipCount
. Prelude.filter (not . S.null . S.intersection (_rmConnectsTo child) . _rlType)
$ _rmLinks parent
tryParentLinks [] = putStrLn "no viable link pairs, backtrack" >> return Nothing tryParentLinks [] = putStrLn "no viable link pairs, backtrack" >> return Nothing
tryParentLinks ((j,outlnk):ls) = tryChildLinks $ zipCount (rmInLinks $ fst childi) tryParentLinks ((j,outlnk):ls) = tryChildLinks $ zipCount (rmInLinks $ fst childi)
where where