Continue work on using links for placement positions

src/Dodge/Layout.hs

@@ -64,13 +64,12 @@ assignPlacementSpots rm = plmnts ++ plmnts'
     (lnkplmnts, plmnts) = partition islnk (_rmPS rm)
     islnk Placement{_placementSpot=PSLnk{}} = True
     islnk _ = False
-    (_,plmnts') = mapAccumR f (_rmLinks rm) lnkplmnts
-    (la,lb) = head $ _rmUsedLinks rm
-    lnkTo = (la,lb+1.5*pi)
+    (_,plmnts') = mapAccumR f (map (invShiftLinkBy lnkTo) $ _rmLinks rm) lnkplmnts
+    (la,lb) = _rmShift rm
+    lnkTo = (la,lb)
     f lnks plmnt = 
         let (x:xs,ys) = partition (_psLinkTest $ _placementSpot plmnt) lnks
-            thepair = bimap (invShiftPointBy lnkTo) (\r -> r - snd lnkTo)
-                $ _psLinkShift (_placementSpot plmnt) x
+            thepair = _psLinkShift (_placementSpot plmnt) x
         in (xs++ys, updatePS (updatePSLnkUsing thepair) plmnt)
 
 updatePSLnkUsing :: (Point2,Float) -> PlacementSpot -> PlacementSpot

src/Dodge/Room/Link.hs

@@ -6,7 +6,16 @@ The last link in the list is considered the incoming link, the other links are
 the outgoing links.
 -}
 module Dodge.Room.Link
-    where
+    ( shiftRoomToLink
+    , shiftRoomBy
+    , randomiseAllLinks
+    , filterLinks
+    , changeLinkTo
+    , changeLinkFrom
+    , randomiseOutLinks
+    , randomiseLinksBy
+    , invShiftLinkBy
+    ) where
 import Dodge.LevelGen
 import Dodge.Room.Data
 import Dodge.RandomHelp
@@ -16,8 +25,7 @@ import Data.Tile
 import System.Random
 import Control.Monad.State
 import Control.Lens
-import Data.List (delete)
-
+import Data.List
 {- Shuffle the initial links of a room randomly. -}
 randomiseOutLinks :: RandomGen g => Room -> State g Room
 randomiseOutLinks r = do
@@ -42,8 +50,16 @@ filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
 filterLinks cond r = do
     newLinks <- shuffle $ filter cond $ init $ _rmLinks r
     return $ r {_rmLinks = newLinks ++ [last $ _rmLinks r]}
+{- | Swaps the first link in the list with one that satisfies a given property.
+ - Does not change the last link in the list -}
+changeLinkFrom :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
+changeLinkFrom cond r = do
+    let (possibleLnks,otherLnks) = partition cond . init $ _rmLinks r
+    newLnks <- shuffle possibleLnks
+    return $ r {_rmLinks = newLnks ++ otherLnks ++ [last $ _rmLinks r]}
 {- | Swaps the last link in the list with one that satisfies a given
- - property (it might swap with itself). Unsafe. -}
+ - property (it might swap with itself). Unsafe. 
+ - Be careful about calling this after changeLinkFrom. -}
 changeLinkTo :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
 changeLinkTo cond r = do
     l <- takeOne $ filter cond $ _rmLinks r
@@ -56,8 +72,10 @@ This is intended to work when the external point is an outgoing link from anothe
 shiftRoomToLink :: (Point2,Float) -> Room -> Room
 shiftRoomToLink l r 
     = shiftRoomBy l 
-    . shiftRoomBy (V2 0 0 -.- rotateV (pi-a) p , 0) 
-    $ shiftRoomBy (V2 0 0                      ,pi-a)  
+    . shiftRoomBy (V2 0 0       , pi-a)  
+    $ shiftRoomBy (V2 0 0 -.- p , 0) 
+--    . shiftRoomBy (V2 0 0 -.- rotateV (pi-a) p , 0) 
+--    $ shiftRoomBy (V2 0 0                      ,pi-a)  
     r
   where 
     (p,a) = last $ _rmLinks r
@@ -76,12 +94,12 @@ shiftRoomBy shift r = r
         )
     & rmViewpoints %~ map (shiftPointBy shift)
 
-shiftLinkBy 
-    :: (Point2,Float) 
-    -> (Point2,Float)
-    -> (Point2,Float)
+shiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
 shiftLinkBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot)
 
+invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
+invShiftLinkBy (pos,rot) (p,r) = (invShiftPointBy (pos,rot) p, r - rot)
+
 shiftPathBy  
     :: (Point2,Float) 
     -> (Point2,Point2) 

src/Dodge/Room/LongDoor.hs

@@ -102,11 +102,11 @@ addSouthPillars x h r = do
 addButtonSlowDoor :: RandomGen g => Float -> Float -> Room -> State g Room
 addButtonSlowDoor x h rm = do
     (butPos,butRot) <- takeOne 
-       [( V2 (x/2-50) 5,0)
-       ,( V2 (x/2+50) 5,0)
+       [( V2 (x/2-50) 5,0::Float)
+       ,( V2 (x/2+50) 5,0::Float)
        ]
     thePlacement <- takeOne [butDoor butPos butRot ]
-    filterLinks aboveH =<< changeLinkTo belowH (rm 
+    changeLinkFrom aboveH =<< changeLinkTo belowH (rm 
         & rmPS %~ (thePlacement :)
         & rmBound %~ (openDoorBound :)
         )
@@ -114,10 +114,11 @@ addButtonSlowDoor x h rm = do
     openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2)
     belowH y = (sndV2 . fst) y < h - 40
     aboveH y = (sndV2 . fst) y > h + 40
-    --butDoor _ _ = putLitButtonID' col butPosCond
-    butDoor bpos brot = putLitButtonID col bpos brot
+    butDoor _ _ = putLitButtonID' col butPosCond
+    --butDoor bpos brot = putLitButtonID col bpos brot
         $  \btid -> Just $ putDoubleDoor False col (cond' btid) (V2 0 h) (V2 x h) 2
-    --butPosCond (V2 _ y,_) = y < h
+    butPosCond (V2 _ y,_) = y < h
+    --butPosCond _ = True -- y < h
     col = dim $ light red
     cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff