Attempt to incorporate free link positions into placement chain

src/Dodge/Initialisation.hs

@@ -28,8 +28,8 @@ import qualified Data.Map as M
 
 firstWorld :: IO World
 firstWorld = do
-    i <- randomRIO (0,5000)
+--    i <- randomRIO (0,5000)
---    let i = 2
+    let i = 2
     putStrLn $ "Seed for level generation: " ++ show ( i :: Int)
     return $ generateLevelFromRoomList (levx 1) $ initialWorld {_randGen = mkStdGen i}
 

src/Dodge/Layout.hs

@@ -56,6 +56,8 @@ generateLevelFromRoomList gr w
     rs = zipWith addTile zs . evalState gr $ _randGen w
     zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
 
+-- the idea is to allow use of link coordinates for placements
+-- though the implementation is clunky
 assignPlacementSpots :: Room -> [Placement]
 assignPlacementSpots rm = plmnts ++ plmnts'
   where
@@ -63,9 +65,12 @@ assignPlacementSpots rm = plmnts ++ plmnts'
     islnk Placement{_placementSpot=PSLnk{}} = True
     islnk _ = False
     (_,plmnts') = mapAccumR f (_rmLinks rm) lnkplmnts
+    (la,lb) = head $ _rmUsedLinks rm
+    lnkTo = (la,lb+1.5*pi)
     f lnks plmnt = 
         let (x:xs,ys) = partition (_psLinkTest $ _placementSpot plmnt) lnks
-            thepair = _psLinkShift (_placementSpot plmnt) x
+            thepair = bimap (invShiftPointBy lnkTo) (\r -> r - snd lnkTo)
+                $ _psLinkShift (_placementSpot plmnt) x
         in (xs++ys, updatePS (updatePSLnkUsing thepair) plmnt)
 
 updatePSLnkUsing :: (Point2,Float) -> PlacementSpot -> PlacementSpot

src/Dodge/LevelGen.hs

@@ -5,6 +5,7 @@ module Dodge.LevelGen
     ( shiftPlacement
     , shiftPointBy
     , placeSpot
+    , invShiftPointBy
     ) where
 import Dodge.Data
 import Dodge.LevelGen.Block
@@ -77,6 +78,9 @@ placeWallPoly ps wl = rmCrossPaths . over walls (addWalls ps wl)
 shiftPointBy :: (Point2,Float) -> Point2 -> Point2
 shiftPointBy (pos,rot) p = pos +.+ rotateV rot p
 
+invShiftPointBy :: (Point2,Float) -> Point2 -> Point2
+invShiftPointBy (p1,r) p2 = rotateV (-r) $ p2 -.- p1
+
 shiftPoint3By :: (Point2,Float) -> Point3 -> Point3
 shiftPoint3By (pos,rot) (V3 x y z) = addZ z $ pos +.+ rotateV rot (V2 x y)
 
@@ -119,7 +123,6 @@ placeBt bt p a w = (i , over buttons addBT w)
     i = IM.newKey $ _buttons w
     addBT xs = IM.insert i (f bt) xs
     f = (btRot +~ a) . (btPos %~ ( (p +.+) . rotateV a )) . (btID .~ i)
-    --addBT bts = IM.insert (IM.newKey bts) (bt {_btPos = p, _btRot = rot, _btID = IM.newKey bts}) bts
 {- Creates a floor item at a given point.
 Assigns an id correctly.  -}
 placeFlIt

src/Dodge/Placements/Button.hs

@@ -23,10 +23,10 @@ putLitButtonID col p a subpl = mountLightAID ls p'' (addZ 40 p')
     ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
 
 putLitButtonID' :: Color -> ((Point2,Float) -> Bool) -> (Int -> Maybe Placement) -> Placement
-putLitButtonID' col f subpl = setLocalPS thePS $ mountLightAID ls 0 (V3 20 0 40)
+putLitButtonID' col f subpl = updatePSToLevel 3 (const thePS) $ mountLightAID ls 0 (V3 0 40 40)
     $ \lsid -> jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = 0, _btRot = 0})
     subpl
   where
     changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
     ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
-    thePS = PSLnk f id
+    thePS = PSLnk f (\(p,a)->(p,a))

src/Dodge/Placements/Spot.hs

@@ -0,0 +1,23 @@
+module Dodge.Placements.Spot
+    ( setPS
+    , setLocalPS
+    , updatePS
+    , updatePSToLevel
+    ) where
+import Dodge.LevelGen.Data
+
+setPS :: PlacementSpot -> Placement -> Placement
+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)
+
+setLocalPS :: PlacementSpot -> Placement -> Placement
+setLocalPS ps (Placement _ pt f) = Placement ps pt f
+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)

src/Dodge/Room/LongDoor.hs

@@ -114,9 +114,10 @@ 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 bpos brot = putLitButtonID' col (const True)
         $  \btid -> Just $ putDoubleDoor False col (cond' btid) (V2 0 h) (V2 x h) 2
+    --butPosCond (V2 _ y,_) = y < h
     col = dim $ light red
     cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff