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

Some cleanup, sidetracked from inter-room placements

Browse Source
This commit is contained in:
justin
2021-11-12 14:16:16 +00:00
parent 1d5b2ea765
commit 67e164c830
13 changed files with 160 additions and 116 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+1
View File
@@ -63,6 +63,7 @@ data World = World
, _machines :: IM.IntMap Machine
, _blocks :: IM.IntMap Block
, _coordinates :: IM.IntMap Point2
, _triggers :: IM.IntMap (World -> Bool)
, _wallsZone :: Zone (IM.IntMap Wall)
, _floorItems :: IM.IntMap FloorItem
, _floorTiles :: [(Point3,Point3)]
src/Dodge/Default/Room.hs
+6 -4
View File
@@ -8,15 +8,17 @@ defaultRoom :: Room
defaultRoom = Room
{ _rmPolys = []
, _rmLinks = []
, _rmUsedLinks = []
, _rmPos = []
, _rmPath = []
, _rmPmnts = []
, _rmPartialPmnts = IM.empty
, _rmLabelledPmnts = IM.empty
, _rmPmnts = []
, _rmTriggerPmnts = IM.empty
, _rmTriggers = IM.empty
, _rmBound = []
, _rmFloor = []
, _rmName = "defaultRoom"
, _rmShift = (V2 0 0 , 0)
, _rmViewpoints = []
, _rmRandPSs = []
, _rmLabel = Nothing
, _rmTakeFrom = Nothing
}
src/Dodge/Default/World.hs
+2 -1
View File
@@ -39,7 +39,8 @@ defaultWorld = World
, _blocks = IM.empty
, _machines = IM.empty
, _doors = IM.empty
, _coordinates = IM.empty
, _coordinates = IM.empty
, _triggers = IM.empty
, _wallsZone = Zone IM.empty
, _floorItems = IM.empty
, _floorTiles = []
src/Dodge/Floor.hs
+49 -63
View File
@@ -1,6 +1,5 @@
{-# OPTIONS_GHC -Wno-unused-imports #-}
{- |
The tree of rooms that make up a level. -}
{- | The tree of rooms that make up a level. -}
module Dodge.Floor
( layoutLevelFromSeed
) where
@@ -34,72 +33,59 @@ import Data.Sequence hiding (zipWith)
import Data.Maybe
initialAnoTree :: RandomGen g => Tree [Annotation g]
initialAnoTree =
let struct = treeFromPost [[Corridor,SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]] [EndRoom]
t' = padWithCorridors struct
in treeFromTrunk
[[StartRoom]
,[Corridor]
,[SpecificRoom $ return $ connectRoom lasTunnel ]
,[Corridor]
,[SpecificRoom $ fmap connectRoom slowDoorRoom ]
,[Corridor]
,[Corridor]
,[Corridor]
,[SpecificRoom $ fmap connectRoom roomCCrits]
,[Corridor]
,[AirlockAno]
,[Corridor]
,[Corridor]
---- ,[SpecificRoom roomCCrits]
---- ,[Corridor]
---- ,[Corridor]
---- ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400
---- & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit
---- ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit
---- ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit
---- ]++)
---- ]
---- --,[Corridor]
---- --,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400
---- -- & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++)
---- -- ]
---- ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400
---- & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++)
---- ]
---- ,[Corridor]
---- ,[Corridor]
-- --,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers]
--- ,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 80 200 40)]
initialAnoTree = padSucWithCorridors $ treeFromTrunk
[[StartRoom]
,[SpecificRoom $ return $ connectRoom lasTunnel ]
,[SpecificRoom $ fmap connectRoom slowDoorRoom ]
,[Corridor]
,[Corridor]
,[SpecificRoom $ fmap connectRoom roomCCrits]
,[AirlockAno]
,[Corridor]
---- ,[SpecificRoom roomCCrits]
---- ,[Corridor]
---- ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400
---- & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit
---- ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit
---- ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit
---- ]++)
---- ]
---- --,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400
---- -- & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++)
---- -- ]
---- ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400
---- & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++)
---- ]
---- ,[Corridor]
-- --,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers]
--- ,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 80 200 40)]
--- ,[DoorAno]
--- ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit]
--- ,[SpecificRoom blockedCorridor]
--- ,[OrAno [[DoorAno]
--- ,[Corridor]
--- ,[DoorAno]
--- ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit]
--- ,[SpecificRoom blockedCorridor]
--- ,[OrAno [[DoorAno]
--- ,[Corridor]
--- ,[DoorNumAno 0,AirlockAno]]
--- ]
--- ,[FirstWeapon]
--- ,[CorridorDebug]
--- ,[SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]
,[Corridor]
,[OrAno
[[SpecificRoom $ branchRectWith $ fmap (fmap Left) armouredChasers]
,[BossAno $ addArmour launcherCrit & crHP +~ 800
& crState . crDropsOnDeath .~ DropSpecific [0] ]
]
]
,[Corridor]
-- ,[SpecificRoom $ fmap (pure . Right) armouredCorridor]
,[Corridor]
,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
]
t'
--- ,[DoorNumAno 0,AirlockAno]]
--- ]
--- ,[FirstWeapon]
--- ,[CorridorDebug]
--- ,[SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]
,[OrAno
[[SpecificRoom $ branchRectWith $ fmap (fmap Left) armouredChasers]
,[BossAno $ addArmour launcherCrit & crHP +~ 800
& crState . crDropsOnDeath .~ DropSpecific [0] ]
]
]
-- ,[SpecificRoom $ fmap (pure . Right) armouredCorridor]
,[Corridor]
,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
]
$ treeFromPost [[Corridor,SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]]
[EndRoom]
{- | A test level tree. -}
initialRoomTree :: RandomGen g => State g (Tree Room)
initialRoomTree = do
expandTreeBy id <$> mapM annoToRoomTree initialAnoTree
expandTreeBy id <$> mapM anoToRoomTree initialAnoTree
layoutLevelFromSeed :: Int -> Int -> IO [Room]
layoutLevelFromSeed i seed = do
src/Dodge/Layout.hs
+2 -4
View File
@@ -10,8 +10,6 @@ import Dodge.Wall.Zone
import Dodge.Zone
import Dodge.GameRoom
import Dodge.Bounds
--import Dodge.RandomHelp
--import Dodge.Graph
import Dodge.Layout.Tree.Polymorphic (applyToRoot)
import Dodge.Room.Data
import Dodge.Room.AddTile
@@ -117,10 +115,10 @@ gameRoomsFromRooms = map f
f rm = GameRoom
{ _grViewpoints = _rmViewpoints rm ++ (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm)
++ map fst (_rmLinks rm)
, _grViewpointsEx = mapMaybe unpos (_rmUsedLinks rm)
, _grViewpointsEx = mapMaybe unpos (_rmPos rm)
, _grBound = expandPolyByFixed 100 . convexHullSafe . nubBy closePoints
. concat $ _rmBound rm ++ _rmPolys rm
, _grDir = getDir $ _rmUsedLinks rm
, _grDir = getDir $ _rmPos rm
, _grName = _rmName rm
}
closePoints x y = roundPoint2 x == roundPoint2 y
src/Dodge/Layout/Tree/Annotate.hs
+17 -8
View File
@@ -1,8 +1,5 @@
{- |
Annotating tree structures with desired properties for rooms.
-}
module Dodge.Layout.Tree.Annotate
where
{- | Annotating tree structures with desired properties for rooms. -}
module Dodge.Layout.Tree.Annotate where
import Dodge.Data
import Dodge.RandomHelp
import Dodge.Layout.Tree.Polymorphic
@@ -23,6 +20,7 @@ import Dodge.Room.Teleport
import Data.Tree
import Control.Monad.State
import System.Random
import Control.Lens
data Annotation g
= Lock Int
@@ -40,6 +38,8 @@ data Annotation g
| SpecificRoom (State g (Tree (Either Room Room)))
| BossAno Creature
| TreasureAno [Creature] [Item]
| SetLabel Int (State g Room)
| UseLabel Int (State g Room)
addLock :: RandomGen g => Int -> Tree [Annotation g] -> State g (Tree [Annotation g])
addLock i t = do
@@ -49,6 +49,9 @@ addLock i t = do
{- | Add one corridor between each parent-child link of a tree of annotations. -}
padWithCorridors :: Tree [Annotation g] -> Tree [Annotation g]
padWithCorridors (Node x xs) = Node [Corridor] [Node x (map padWithCorridors xs)]
padSucWithCorridors :: Tree [Annotation g] -> Tree [Annotation g]
padSucWithCorridors (Node x xs) = Node x (map padWithCorridors xs)
{- Add one to three corridors between each parent-child link of a tree of annotations. -}
randomPadCorridors :: RandomGen g => Tree [Annotation g] -> State g (Tree [Annotation g])
randomPadCorridors (Node x xs) = do
@@ -60,11 +63,17 @@ roomThenCorridor :: RandomGen g => Room -> State g (Tree (Either Room Room))
roomThenCorridor theRoom = fmap (\r -> Node (Left theRoom) [(pure . Right) r])
(randomiseOutLinks corridor)
{- | Create a random room tree structure from a list of annotations. -}
annoToRoomTree :: RandomGen g => [Annotation g] -> State g (Tree (Either Room Room))
annoToRoomTree anos = case anos of
anoToRoomTree :: RandomGen g => [Annotation g] -> State g (Tree (Either Room Room))
anoToRoomTree anos = case anos of
[SetLabel i randrm] -> do
rm <- randrm
return . connectRoom $ rm & rmLabel ?~ i
[UseLabel i randrm] -> do
rm <- randrm
return $ connectRoom $ rm & rmTakeFrom ?~ i
[OrAno as] -> do
a <- takeOne as
annoToRoomTree a
anoToRoomTree a
[Corridor] -> pure . Right <$> randomiseOutLinks corridor
[CorridorDebug] -> pure . Right <$> randomiseOutLinks corridorDebug
[DoorAno] -> roomThenCorridor door
src/Dodge/Layout/Tree/Shift.hs
+1 -1
View File
@@ -47,6 +47,6 @@ posRms bounds (r,i) (t@(Node (_,i') _):ts) tseq = do
where
convexBounds = map pointsToPoly $ _rmBound r'
clipping = or (convexPolysOverlap <$> convexBounds <*> bounds)
useLink = (r & rmLinks %~ delete l & rmUsedLinks %~ (uncurry (OutLink (Prelude.length ts)) l :)
useLink = (r & rmLinks %~ delete l & rmPos %~ (uncurry (OutLink (Prelude.length ts)) l :)
, i)
shiftedt@(Node (r',_) _) = applyToRoot (first $ shiftRoomToLink l) t
src/Dodge/LevelGen.hs
+37 -12
View File
@@ -1,4 +1,5 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
-- | deals with placement of objects within the world
-- after they have had their coordinates set by the layout
module Dodge.LevelGen
@@ -26,11 +27,16 @@ import Control.Monad.State
import Control.Lens
import qualified Data.IntSet as IS
placeSpotRoomRand :: Room -> Int -> Placement -> World -> (World,Room)
placeSpotRoomRand rm i plmnt w =
let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w
in placeSpot (w & randGen .~ g,rm) (plmnt & plSpot .~ uncurry PS ps)
placeSpot :: (World,Room) -> Placement -> (World,Room)
placeSpot (w,rm) plmnt = case plmnt of
Placement{_plSpot = PSRoomRand i}
-> let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w
in placeSpot (w & randGen .~ g,rm) (plmnt & plSpot .~ uncurry PS ps)
Placement{_plSpot = PSRoomRand i} -> placeSpotRoomRand rm i plmnt w
-- -> let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w
-- in placeSpot (w & randGen .~ g,rm) (plmnt & plSpot .~ uncurry PS ps)
Placement{_plSpot = PSLnk{}} -> case lnks of
((lnki,lnk):_) -> placeSpot (w & randGen .~ g,uselnk lnki) (updatePS (f lnk) plmnt)
[] -> case fallback of
@@ -77,8 +83,10 @@ shiftPSBy (pos,rot) ps = ps
-- button ids, etc
placeSpotID :: PlacementSpot -> PSType -> World -> (Int, World)
placeSpotID ps pt w = case pt of
PutTrigger cond -> placeNewInto triggers cond w
PutProp prop -> placeProp prop p rot w
PutButton bt -> placeBt bt p rot w
--PutButton bt -> placeBt bt p rot w
PutButton bt -> placeNewUpdateID buttons btID (mvButton bt p rot) w
PutFlIt itm -> placeFlIt itm p rot w
PutCrit cr -> placeCr cr p rot w
PutMachine col wallpoly mc -> placeMachine col (map doShift wallpoly) mc p rot w
@@ -88,7 +96,7 @@ placeSpotID ps pt w = case pt of
where
(evaluatedType, g) = runState rgen (_randGen w)
PutDoor col f pss -> placeDoor col f (map (bimap doShift doShift) pss) w
PutCoordinate coordp -> placeCoordinate (doShift coordp) w
PutCoordinate coordp -> placeNewInto coordinates (doShift coordp) w
PutSlideDoor pathing col f a b spd -> placeSlideDoor pathing col f (doShift a) (doShift b) spd w
PutBlock (hp:hps) col ps' -> placeBlock (map doShift ps') hp col Opaque hps w
PutBlock{} -> error "messed up block placement somehow"
@@ -129,10 +137,25 @@ addPane wl l wls = IM.insert wlid (wl { _wlLine = l, _wlID = wlid }) wls
where
wlid = IM.newKey wls
placeCoordinate :: Point2 -> World -> (Int,World)
placeCoordinate p w = (i, w & coordinates %~ IM.insert i p)
-- | generalised way of putting a new item into a lensed intmap, returning the
-- new index as well
placeNewInto :: ALens' World (IM.IntMap a)
-> a
-> World
-> (Int,World)
placeNewInto l x w = (i,w & l #%~ IM.insert i x)
where
i = IM.newKey $ _coordinates w
i = IM.newKey $ w ^# l
-- | place an new object into an intmap and update its id
placeNewUpdateID :: ALens' World (IM.IntMap a)
-> ALens' a Int
-> a
-> World
-> (Int,World)
placeNewUpdateID l li x w = (i,w & l #%~ IM.insert i (x & li #~ i))
where
i = IM.newKey $ w ^# l
placeProp
:: Prop
@@ -155,8 +178,11 @@ placeBt
placeBt bt p a w = (i , over buttons addBT w)
where
i = IM.newKey $ _buttons w
addBT xs = IM.insert i (f bt) xs
addBT = IM.insert i (f bt)
f = (btRot +~ a) . (btPos %~ ( (p +.+) . rotateV a )) . (btID .~ i)
mvButton bt p a = bt & btRot +~ a & btPos %~ ( (p +.+) . rotateV a )
{- Creates a floor item at a given point.
Assigns an id correctly. -}
placeFlIt
@@ -165,9 +191,8 @@ placeFlIt
-> Float -- ^ Rotation
-> World
-> (Int, World)
placeFlIt itm p rot w = (i, w & floorItems %~ \ fis -> IM.insert i
( FlIt { _flItPos = p , _flItRot = rot , _flItID = i , _flIt = itm }
) fis
placeFlIt itm p rot w = (i
, w & floorItems %~ IM.insert i FlIt { _flItPos = p , _flItRot = rot , _flItID = i , _flIt = itm }
)
where
i = IM.newKey $ _floorItems w
src/Dodge/LevelGen/Data.hs
+5 -3
View File
@@ -19,6 +19,7 @@ data PSType = PutCrit {_unPutCrit :: Creature}
| PutPressPlate PressPlate
| PutBlock [Int] Color [Point2]
| PutCoordinate Point2
| PutTrigger (World -> Bool)
| PutLineBlock Wall Float Float Point2 Point2
| PutWall { _pwPoly :: [Point2] , _pwWall :: Wall }
| PutSlideDoor Bool Color (World -> Bool) Point2 Point2 Float
@@ -72,9 +73,10 @@ ps0j :: PSType -> Placement -> Placement
ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst (const $ Just plmnt)
addPlmnt :: Placement -> Placement -> Placement
addPlmnt pl (PlacementUsingPos p f) = PlacementUsingPos p (fmap (addPlmnt pl) f)
addPlmnt pl (RandomPlacement rp) = RandomPlacement $ fmap (addPlmnt pl) rp
addPlmnt pl (Placement ps pt f) = Placement ps pt (fmap g f)
addPlmnt pl pl2 = case pl2 of
(PlacementUsingPos p f) -> PlacementUsingPos p (fmap (addPlmnt pl) f)
(RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
(Placement ps pt f) -> Placement ps pt (fmap g f)
where
g Nothing = Just pl
g (Just pl') = Just $ addPlmnt pl pl'
src/Dodge/Placements/Spot.hs
+8 -6
View File
@@ -11,9 +11,10 @@ setPS = updatePS . const
updatePSToLevel :: Int -> (PlacementSpot -> PlacementSpot) -> Placement -> Placement
updatePSToLevel 0 _ plmnt = plmnt
updatePSToLevel i f (PlacementUsingPos p pl) = PlacementUsingPos p (fmap (updatePSToLevel i f) pl)
updatePSToLevel i f (Placement ps pt pl) = Placement (f ps) pt (fmap (fmap (updatePSToLevel (i-1) f)) pl)
updatePSToLevel i f (RandomPlacement rplmnt) = RandomPlacement $ fmap (updatePSToLevel i f) rplmnt
updatePSToLevel i f plmnt = case plmnt of
PlacementUsingPos p pl -> PlacementUsingPos p (fmap (updatePSToLevel i f) pl)
Placement ps pt pl -> Placement (f ps) pt (fmap (fmap (updatePSToLevel (i-1) f)) pl)
RandomPlacement rplmnt -> RandomPlacement $ fmap (updatePSToLevel i f) rplmnt
setLocalPS :: PlacementSpot -> Placement -> Placement
setLocalPS ps (Placement _ pt f) = Placement ps pt f
@@ -21,6 +22,7 @@ setLocalPS ps (RandomPlacement rplmnt) = RandomPlacement (fmap (setLocalPS ps) r
setLocalPS _ plmnt = plmnt
updatePS :: (PlacementSpot -> PlacementSpot) -> Placement -> Placement
updatePS f (Placement ps pt iplmnt) = Placement (f ps) pt ((fmap . fmap $ updatePS f) iplmnt)
updatePS f (PlacementUsingPos p plmnt) = PlacementUsingPos p (fmap (updatePS f) plmnt)
updatePS f (RandomPlacement rplmnt) = RandomPlacement (fmap (updatePS f) rplmnt)
updatePS f pl' = case pl' of
Placement ps pt ipl -> Placement (f ps) pt $ (fmap . fmap $ updatePS f) ipl
PlacementUsingPos p pl -> PlacementUsingPos p (fmap (updatePS f) pl)
RandomPlacement rpl -> RandomPlacement (fmap (updatePS f) rpl)
src/Dodge/Room/Data.hs
+6 -3
View File
@@ -5,6 +5,7 @@ module Dodge.Room.Data
import Dodge.LevelGen.Data
import Geometry.Data
import Data.Tile
import Dodge.Data
import Control.Monad.State
import System.Random
@@ -22,17 +23,19 @@ assigning no bounds will allow rooms to overlap.
data Room = Room
{ _rmPolys :: [ [Point2] ]
, _rmLinks :: [(Point2,Float)]
, _rmUsedLinks :: [RoomPos]
, _rmPos :: [RoomPos]
, _rmPath :: [(Point2, Point2)]
, _rmPmnts :: [Placement]
, _rmLabelledPmnts :: IM.IntMap Placement
, _rmPartialPmnts :: IM.IntMap (Int -> Placement)
, _rmTriggers :: IM.IntMap (World -> Bool)
, _rmTriggerPmnts :: IM.IntMap ((World -> Bool) -> Placement)
, _rmBound :: [ [Point2] ]
, _rmFloor :: [Tile]
, _rmName :: String
, _rmShift :: (Point2, Float)
, _rmViewpoints :: [Point2]
, _rmRandPSs :: [State StdGen (Point2,Float)]
, _rmLabel :: Maybe Int
, _rmTakeFrom :: Maybe Int
}
data RoomPos
= OutLink Int Point2 Float
src/Dodge/Room/Door.hs
+23 -6
View File
@@ -1,12 +1,13 @@
{-
Rooms that connect other rooms, blocking sight.
-}
{- Rooms that connect other rooms, blocking sight. -}
module Dodge.Room.Door
where
import Geometry
import Dodge.Room.Data
import Dodge.Default.Room
import Dodge.Placements
import Color
import qualified Data.IntMap.Strict as IM
door :: Room
door = defaultRoom
@@ -17,8 +18,24 @@ door = defaultRoom
, _rmPmnts = [putAutoDoor (V2 0 20) (V2 40 20)]
-- note no bounds
}
where lnks = [(V2 20 35,0)
,(V2 20 5,pi)
]
where
lnks = [(V2 20 35,0)
,(V2 20 5,pi)
]
switchDoor :: Room
switchDoor = defaultRoom
{ _rmPolys = [rectNSWE 40 0 0 40]
, _rmLinks = lnks
, _rmPath = [(V2 20 35,V2 20 5)]
-- door extends into side walls (for shadows as rendered 12/03)
, _rmTriggerPmnts = IM.fromList
[(0,\cond -> putDoubleDoor False red cond (V2 0 20) (V2 40 20) 2)]
-- note no bounds
}
where
lnks = [(V2 20 35,0)
,(V2 20 5,pi)
]
src/Dodge/Room/Link.hs
+3 -5
View File
@@ -1,10 +1,8 @@
{-
Concerns link pairs of rooms.
{- Concerns link pairs of rooms.
Link pairs determine where rooms can attach to each other; each pair consists
of a position and a rotation.
The last link in the list is considered the incoming link, the other links are
the outgoing links.
-}
the outgoing links. -}
module Dodge.Room.Link
( shiftRoomToLink
, shiftRoomBy
@@ -111,5 +109,5 @@ setLastLinkToUsed :: Room -> Room
setLastLinkToUsed rm = case _rmLinks rm of
(_:_) -> rm
& rmLinks %~ init
& rmUsedLinks %~ (uncurry InLink (last (_rmLinks rm)) :)
& rmPos %~ (uncurry InLink (last (_rmLinks rm)) :)
_ -> rm