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

Move towards unifying RoomPos constructors

Browse Source
This commit is contained in:
justin
2022-03-10 16:21:44 +00:00
parent 907cca0ef0
commit 7b1ac2b682
7 changed files with 94 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Layout.hs
+6 -6
View File
@@ -215,16 +215,16 @@ gameRoomFromRoom rm = GameRoom
[p +.+ 10 *.* unitVectorAtAngle a [p +.+ 10 *.* unitVectorAtAngle a
,p -.- 10 *.* unitVectorAtAngle a ,p -.- 10 *.* unitVectorAtAngle a
] ]
filterUnusedLinks (UnusedLink p _ _) = Just p filterUnusedLinks (UnusedLink p _ _ _) = Just p
filterUnusedLinks _ = Nothing filterUnusedLinks _ = Nothing
filterUsedLinks (UsedOutLink _ _ p a _) = doubleShift p a filterUsedLinks (UsedOutLink _ _ p a _ _) = doubleShift p a
filterUsedLinks (UsedInLink _ p a _) = doubleShift p a filterUsedLinks (UsedInLink _ p a _ _) = doubleShift p a
filterUsedLinks _ = [] filterUsedLinks _ = []
undir (UsedOutLink _ _ _ a _) = Just $ 0.5*pi + a + snd (_rmShift rm) undir (UsedOutLink _ _ _ a _ _) = Just $ 0.5*pi + a + snd (_rmShift rm)
undir (UsedInLink _ _ a _) = Just $ 0.5*pi + a + snd (_rmShift rm) undir (UsedInLink _ _ a _ _) = Just $ 0.5*pi + a + snd (_rmShift rm)
undir _ = Nothing undir _ = Nothing
closePoints x y = roundPoint2 x == roundPoint2 y closePoints x y = roundPoint2 x == roundPoint2 y
getDir (UsedInLink _ _ a _:_) = a + snd (_rmShift rm) getDir (UsedInLink _ _ a _ _:_) = a + snd (_rmShift rm)
getDir (_:xs) = getDir xs getDir (_:xs) = getDir xs
getDir _ = 0 -- fallback getDir _ = 0 -- fallback
src/Dodge/LevelGen/Data.hs
+43 -21
View File
@@ -116,39 +116,60 @@ data CardinalPoint
data RoomWire data RoomWire
= --RoomWire Point2 Float = --RoomWire Point2 Float
WallWire Point2 Float Float WallWire Point2 Float Float
data RPLinkStatus
= UsedAsOutLink
{ _rplsType :: S.Set RoomLinkType
, _rplsChildNum :: Int
, _rplsOutRoomID :: Int
}
| UsedAsInLink
{ _rplsType :: S.Set RoomLinkType
, _rplsInRoomID :: Int
}
| UnusedAsLink { _rplsType :: S.Set RoomLinkType }
| NotLink
deriving (Eq,Ord,Show)
data RoomPos data RoomPos
= UsedOutLink = UsedOutLink
{_rpChildNum :: Int { _rpChildNum :: Int
,_rpOutRoomID :: Int , _rpOutRoomID :: Int
,_rpPos :: Point2 , _rpPos :: Point2
,_rpDir :: Float , _rpDir :: Float
,_rpLinkType :: S.Set RoomLinkType , _rpLinkType :: S.Set RoomLinkType
, _rpLinkStatus :: RPLinkStatus
} }
| UsedInLink | UsedInLink
{_rpInRoomID :: Int { _rpInRoomID :: Int
,_rpPos :: Point2 , _rpPos :: Point2
,_rpDir :: Float , _rpDir :: Float
,_rpLinkType :: S.Set RoomLinkType , _rpLinkType :: S.Set RoomLinkType
, _rpLinkStatus :: RPLinkStatus
} }
| UnusedLink | UnusedLink
{_rpPos :: Point2 { _rpPos :: Point2
,_rpDir ::Float , _rpDir ::Float
,_rpLinkType :: S.Set RoomLinkType , _rpLinkType :: S.Set RoomLinkType
, _rpLinkStatus :: RPLinkStatus
} }
| UsedLink | UsedLink
{_rpPos :: Point2 { _rpPos :: Point2
,_rpDir :: Float , _rpDir :: Float
,_rpLinkType :: S.Set RoomLinkType , _rpLinkType :: S.Set RoomLinkType
, _rpLinkStatus :: RPLinkStatus
} }
| UsedSpot | UsedSpot
{_rpPos :: Point2 { _rpPos :: Point2
,_rpDir :: Float , _rpDir :: Float
,_rpType :: S.Set RoomPosType , _rpType :: S.Set RoomPosType
, _rpLinkStatus :: RPLinkStatus
} }
| UnusedSpot | UnusedSpot
{_rpPos :: Point2 { _rpPos :: Point2
,_rpDir :: Float , _rpDir :: Float
,_rpType :: S.Set RoomPosType , _rpType :: S.Set RoomPosType
, _rpLinkStatus :: RPLinkStatus
} }
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
@@ -165,6 +186,7 @@ makeLenses ''Placement
makeLenses ''RoomLink makeLenses ''RoomLink
makeLenses ''RoomPos makeLenses ''RoomPos
makeLenses ''RoomPosType makeLenses ''RoomPosType
makeLenses ''RPLinkStatus
spNoID :: PlacementSpot -> PSType -> Placement spNoID :: PlacementSpot -> PSType -> Placement
spNoID ps pst = Placement ps pst Nothing (const Nothing) spNoID ps pst = Placement ps pst Nothing (const Nothing)
src/Dodge/PlacementSpot.hs
+21 -14
View File
@@ -26,16 +26,16 @@ anyUnusedSpot :: PlacementSpot
anyUnusedSpot = PSPos f (const id) Nothing anyUnusedSpot = PSPos f (const id) Nothing
where where
f rp _ = case rp of f rp _ = case rp of
UnusedSpot p a t -> Just (PS p a,UsedSpot p a t) UnusedSpot p a t rpls -> Just (PS p a,UsedSpot p a t rpls)
_ -> Nothing _ -> Nothing
unusedSpotAwayFromLink :: Float -> PlacementSpot unusedSpotAwayFromLink :: Float -> PlacementSpot
unusedSpotAwayFromLink x = PSPos f (const id) Nothing unusedSpotAwayFromLink x = PSPos f (const id) Nothing
where where
f rp r = case rp of f rp r = case rp of
UnusedSpot p a t UnusedSpot p a t rpls
| all ( (>x) . dist p ) (usedRoomLinkPoss r) | all ( (>x) . dist p ) (usedRoomLinkPoss r)
-> Just (PS p a,UsedSpot p a t) -> Just (PS p a,UsedSpot p a t rpls)
_ -> Nothing _ -> Nothing
setFallback :: Placement -> Placement -> Placement setFallback :: Placement -> Placement -> Placement
@@ -47,16 +47,17 @@ unusedOffPathAwayFromLink :: Float -> PlacementSpot
unusedOffPathAwayFromLink x = PSPos f (const id) Nothing unusedOffPathAwayFromLink x = PSPos f (const id) Nothing
where where
f rp r = case rp of f rp r = case rp of
UnusedSpot p a t UnusedSpot p a t rpls
| all ( (>x) . dist p ) (usedRoomLinkPoss r) && RoomPosOffPath `S.member` t | all ( (>x) . dist p ) (usedRoomLinkPoss r) && RoomPosOffPath `S.member` t
-> Just (PS p a,UsedSpot p a t) -> Just (PS p a,UsedSpot p a t rpls)
_ -> Nothing _ -> Nothing
unusedSpotAwayFromInLink :: Float -> PlacementSpot unusedSpotAwayFromInLink :: Float -> PlacementSpot
unusedSpotAwayFromInLink x = PSPos f (const id) Nothing unusedSpotAwayFromInLink x = PSPos f (const id) Nothing
where where
f rp r = case rp of f rp r = case rp of
UnusedSpot p a t | all ( (>x) . dist p ) (usedRoomInLinkPoss r) -> Just (PS p a,UsedSpot p a t) UnusedSpot p a t rpls
| all ( (>x) . dist p ) (usedRoomInLinkPoss r) -> Just (PS p a,UsedSpot p a t rpls)
_ -> Nothing _ -> Nothing
twoUnusedLinks :: (PlacementSpot -> PlacementSpot -> Placement) twoUnusedLinks :: (PlacementSpot -> PlacementSpot -> Placement)
@@ -82,7 +83,7 @@ useRoomPos cond = PSPos (useRoomPosCond cond) (const id) Nothing
useRoomPosCond :: (RoomPos -> Bool) useRoomPosCond :: (RoomPos -> Bool)
-> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
useRoomPosCond t rp _ useRoomPosCond t rp _
| t rp = Just (PS p a, UsedSpot p a (fromMaybe S.empty $ rp ^? rpType)) | t rp = Just (PS p a, UsedSpot p a (fromMaybe S.empty $ rp ^? rpType) NotLink)
| otherwise = Nothing | otherwise = Nothing
where where
p = _rpPos rp p = _rpPos rp
@@ -93,6 +94,11 @@ unusedLnkToPS = useRoomPosCond $ \case
UnusedLink {} -> True UnusedLink {} -> True
_ -> False _ -> False
usedInLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
usedInLnkToPS = useRoomPosCond $ \case
UsedInLink {} -> True
_ -> False
isUnusedLinkType :: RoomLinkType -> RoomPos -> Bool isUnusedLinkType :: RoomLinkType -> RoomPos -> Bool
isUnusedLinkType rlt rp = case rp of isUnusedLinkType rlt rp = case rp of
UnusedLink{_rpLinkType = rlts} -> rlt `S.member` rlts UnusedLink{_rpLinkType = rlts} -> rlt `S.member` rlts
@@ -102,7 +108,8 @@ unusedSpotNearInLink :: Float -> PlacementSpot
unusedSpotNearInLink x = PSPos f (const id) Nothing unusedSpotNearInLink x = PSPos f (const id) Nothing
where where
f rp r = case rp of f rp r = case rp of
UnusedSpot p a t | any ( (<x) . dist p ) (usedRoomInLinkPoss r) -> Just (PS p a,UsedSpot p a t) UnusedSpot p a t rpls
| any ( (<x) . dist p ) (usedRoomInLinkPoss r) -> Just (PS p a,UsedSpot p a t rpls)
_ -> Nothing _ -> Nothing
usedRoomInLinkPoss :: Room -> [Point2] usedRoomInLinkPoss :: Room -> [Point2]
@@ -124,19 +131,19 @@ usedRoomLinkPoss r = mapMaybe f $ _rmPos r
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, UsedSpot p a S.empty) f (UnusedLink p a _ rpls) _ = Just (PS p a, UsedSpot p a S.empty rpls)
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 lt) _ = Just (PS p a, UsedOutLink 0 i p a lt) f (UsedOutLink 0 i p a lt rpls) _ = Just (PS p a, UsedOutLink 0 i p a lt rpls)
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 lt) _ | n == i = Just (PS p' a', UsedOutLink n rmid p a lt) f (UsedOutLink i rmid p a lt rpls) _ | n == i = Just (PS p' a', UsedOutLink n rmid p a lt rpls)
where where
(p',a') = theshift (p,a) (p',a') = theshift (p,a)
f _ _ = Nothing f _ _ = Nothing
@@ -155,14 +162,14 @@ 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 lt) _ = Just (PS p a, UsedLink p a lt) f (UsedOutLink 0 _ p a lt rpls) _ = Just (PS p a, UsedLink p a lt rpls)
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' ,UsedSpot v' a' S.empty) f (UnusedLink v a _ rpls) _ = Just (PS v' a' ,UsedSpot v' a' S.empty rpls)
where where
v' = v -.- x *.* unitVectorAtAngle (a + 0.5 * pi) v' = v -.- x *.* unitVectorAtAngle (a + 0.5 * pi)
a' = a + pi a' = a + pi
@@ -170,7 +177,7 @@ anyLnkInPS x = PSPos f (const id) Nothing
useLnkRoomPos :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos) useLnkRoomPos :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
useLnkRoomPos rp _ = case rp of useLnkRoomPos rp _ = case rp of
(UnusedLink (V2 x y) a lt) -> Just (PS (V2 x y) a , UsedLink (V2 x y) a lt) (UnusedLink (V2 x y) a lt rpls) -> Just (PS (V2 x y) a , UsedLink (V2 x y) a lt rpls)
_ -> 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/LongDoor.hs
+13 -12
View File
@@ -9,6 +9,7 @@ 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.PlacementSpot
import Dodge.Room.Link import Dodge.Room.Link
import Dodge.Room.Door import Dodge.Room.Door
import Dodge.Room.Procedural import Dodge.Room.Procedural
@@ -92,7 +93,7 @@ southPillarsRoom x y h = do
pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20) pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20) ++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
pillars <- takeOne [pillarsa, pillarsb, pillarsc] pillars <- takeOne [pillarsa, pillarsb, pillarsc]
return $ roomRectAutoLinks x y & rmPmnts .~ pillars return $ roomRectAutoLinks x y & rmPmnts .~ (pillars ++ [mntLightLnkCond usedInLnkToPS])
addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room
addSouthPillars x h r = do addSouthPillars x h r = do
@@ -118,21 +119,21 @@ addButtonSlowDoor x h rm = do
openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2) openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2)
belowH y = (sndV2 . fst) y < h - 40 belowH y = (sndV2 . fst) y < h - 40
aboveH y = (sndV2 . fst) y > h + 40 aboveH y = (sndV2 . fst) y > h + 40
amountedlight dr xoff = Just . moveLSThen (getdoorpos (fromJust $ _plMID dr))
(V3 15 xoff 89) (aShape (V2 15 0) (V3 15 xoff 90)) . const . const
-- TODO make the height of this light source and of other mounted lights
-- be taken from a single consistent source
butDoor _ _ = putLitButOnPos col butPosCond butDoor _ _ = putLitButOnPos col butPosCond
$ \btid -> Just $ putDoubleDoorThen False col (cond' btid) 30 (V2 0 h) (V2 x h) 2 $ \btid -> Just $ putDoubleDoorThen False col (cond' btid) 30 (V2 0 h) (V2 x h) 2
$ \dr1 dr2 -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr1)) $ \dr1 dr2 -> amountedlight dr1 50
(V3 15 50 88) (aShape (V2 15 0) (V3 15 50 90)) $ amountedlight dr1 (-50)
$ \_ _ -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr2)) $ amountedlight dr2 50
(V3 15 (-50) 88) (aShape (V2 15 0) (V3 15 (-50) 90)) $ amountedlight dr2 (-50)
$ \_ _ -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr2)) $ Nothing
(V3 15 50 88) (aShape (V2 15 0) (V3 15 50 90))
$ \_ _ -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr1))
(V3 15 (-50) 88) (aShape (V2 15 0) (V3 15 (-50) 90))
$ \_ _ ->Nothing
getdoorpos drid w = let Just (a,b) = w ^? doors . ix drid . drPos getdoorpos drid w = let Just (a,b) = w ^? doors . ix drid . drPos
in (b, argV (a-.-b)) in (b, argV (a-.-b))
butPosCond (UnusedLink (V2 x' y') a' _) _ | y' < 0.5 * h butPosCond (UnusedLink (V2 x' y') a' _ rpls) _ | y' < 0.5 * h
= Just (PS (V2 x' y') a' , UsedSpot (V2 x' y') a' (S.singleton RoomPosExLink)) = Just (PS (V2 x' y') a' , UsedSpot (V2 x' y') a' (S.singleton RoomPosExLink) rpls)
butPosCond _ _ = Nothing butPosCond _ _ = Nothing
--butPosCond _ = True -- y < h --butPosCond _ = True -- y < h
col = dim $ light red col = dim $ light red
src/Dodge/Room/Procedural.hs
+6 -6
View File
@@ -53,8 +53,8 @@ roomRect x y xn yn = defaultRoom
{ _rmPolys = [rectNSWE y 0 0 x ] { _rmPolys = [rectNSWE y 0 0 x ]
, _rmLinks = lnks , _rmLinks = lnks
, _rmPath = concatMap doublePair pth , _rmPath = concatMap doublePair pth
, _rmPos = map (\pd -> UnusedSpot pd 0 $ S.singleton RoomPosOnPath) posps , _rmPos = map (\pd -> UnusedSpot pd 0 (S.singleton RoomPosOnPath) NotLink) posps
++ map (\pd -> UnusedSpot pd 0 $ S.singleton RoomPosOffPath) interposps ++ map (\pd -> UnusedSpot pd 0 (S.singleton RoomPosOffPath) NotLink) interposps
, _rmPmnts = [] , _rmPmnts = []
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)] , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
, _rmFloor = Tiled [Tile , _rmFloor = Tiled [Tile
@@ -147,8 +147,8 @@ quarterRoomTri w = do
, sPS (V2 (w-15) (w-25)) pi PutNothing , sPS (V2 (w-15) (w-25)) pi PutNothing
] ]
, _rmPos = , _rmPos =
[ UnusedSpot (V2 (w-20) (w-20)) pi S.empty [ UnusedSpot (V2 (w-20) (w-20)) pi S.empty NotLink
, UnusedSpot (V2 (w-15) (w-25)) pi S.empty , UnusedSpot (V2 (w-15) (w-25)) pi S.empty NotLink
] ]
, _rmBound = [[V2 0 0,V2 w w,V2 (-w) w]] , _rmBound = [[V2 0 0,V2 w w,V2 (-w) w]]
} }
@@ -188,8 +188,8 @@ quarterRoomSquare w = do
, sPS (V2 20 (2*w-40)) pi PutNothing , sPS (V2 20 (2*w-40)) pi PutNothing
, sPS (V2 25 (2*w-45)) pi PutNothing , sPS (V2 25 (2*w-45)) pi PutNothing
] ]
, _rmPos = [UnusedSpot (V2 20 (2*w-40)) pi S.empty , _rmPos = [UnusedSpot (V2 20 (2*w-40)) pi S.empty NotLink
, UnusedSpot (V2 25 (2*w-45)) pi S.empty , UnusedSpot (V2 25 (2*w-45)) pi S.empty NotLink
] ]
, _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]] , _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]]
} }
src/Dodge/Room/Room.hs
+2 -1
View File
@@ -83,7 +83,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 , UsedSpot (V2 x y) a $ S.singleton RoomPosExLink) con1 cond (UnusedLink (V2 x y) a _ rpls) _
| cond y = Just (PS (V2 x y) a , UsedSpot (V2 x y) a (S.singleton RoomPosExLink) rpls)
con1 _ _ _ = Nothing con1 _ _ _ = Nothing
plmnts = plmnts =
[ mntLightLnkCond $ con1 (< 0.5 * hgt) [ mntLightLnkCond $ con1 (< 0.5 * hgt)
src/Dodge/Tree/Shift.hs
+3
View File
@@ -73,6 +73,7 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
, _rpPos = fst (lnkPosDir outlnk) , _rpPos = fst (lnkPosDir outlnk)
, _rpDir = snd (lnkPosDir outlnk) , _rpDir = snd (lnkPosDir outlnk)
, _rpLinkType = _rlType outlnk , _rpLinkType = _rlType outlnk
, _rpLinkStatus = UsedAsOutLink (_rlType outlnk) numChild (snd childi)
} }
& rmChildren .:~ snd childi & rmChildren .:~ snd childi
shiftedoutlink = shiftLinkBy (_rmShift parent) outlnk shiftedoutlink = shiftLinkBy (_rmShift parent) outlnk
@@ -85,6 +86,7 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
, _rpPos = fst (lnkPosDir il) , _rpPos = fst (lnkPosDir il)
, _rpDir = snd (lnkPosDir il) , _rpDir = snd (lnkPosDir il)
, _rpLinkType = _rlType il , _rpLinkType = _rlType il
, _rpLinkStatus = UsedAsInLink (_rlType il) 0
} }
shiftedt = applyToRoot shiftedt = applyToRoot
(first $ updatechild . shiftRoomShiftToLink (lnkPosDir shiftedoutlink) (lnkPosDir il)) (first $ updatechild . shiftRoomShiftToLink (lnkPosDir shiftedoutlink) (lnkPosDir il))
@@ -97,6 +99,7 @@ createUnusedLinkPos rm = rm & rmPos .++~ map f (_rmLinks rm)
{ _rpPos = _rlPos rl { _rpPos = _rlPos rl
, _rpDir = _rlDir rl , _rpDir = _rlDir rl
, _rpLinkType = _rlType rl , _rpLinkType = _rlType rl
, _rpLinkStatus = UnusedAsLink $ _rlType rl
} }
zipCount :: [a] -> [(Int,a)] zipCount :: [a] -> [(Int,a)]