Add missing file, workaround for placement positions bug

src/Dodge/Annotation.hs

@@ -66,7 +66,7 @@ anoToRoomTree anos = case anos of
     [AirlockAno] -> airlock >>=  roomThenCorridor
     [FirstWeapon] -> do
         branchWP <- branchRectWith weaponRoom
-        blockedC <- longBlockedCorridor
+        blockedC <- longBlockedCorridor 3
         join $ takeOne $ return (passUntilUseAll branchWP [blockedC]) : replicate 5 weaponRoom
     [EndRoom] -> fmap (pure . UseAll) (telRoomLev 1)
     (SpecificRoom rt:_) -> rt

src/Dodge/Annotation/Data.hs

@@ -19,6 +19,7 @@ data Annotation g
     | BossAno Creature
     | TreasureAno [Creature] [Item]
     | AnoApplyInt Int (Int -> State g (SubCompTree Room))
+    | AnoNewInt (Int -> State g (SubCompTree Room))
     | PassthroughLockKeyLists Int 
         [(Int -> State g (SubCompTree Room), State g CombineType)]
         [(CombineType, State g (SubCompTree Room))]

src/Dodge/Floor.hs

@@ -33,8 +33,9 @@ import System.Random
 
 initialAnoTree :: RandomGen g => Tree [Annotation g]
 initialAnoTree = padSucWithCorridors $ treeFromTrunk 
-    [[AnoApplyInt 0 startRoom]
+--    [[AnoApplyInt 0 startRoom]
-    , [SpecificRoom $ glassLesson]
+    [[SpecificRoom startRoom']
+--    , [SpecificRoom $ rezThenLasTurret]
 --    , [SpecificRoom $ fmap (return . PassDown) longRoom]
     , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms]
     , [SpecificRoom randomChallenges]

src/Dodge/LevelGen/Data.hs

@@ -39,6 +39,7 @@ data PSType = PutCrit {_unPutCrit :: Creature}
 -- add room effect for any placement spot?
 data PlacementSpot 
     = PS { _psPos :: Point2 , _psRot :: Float }
+    | PSNoShiftCont { _psPos :: Point2 , _psRot :: Float }
     | PSPos 
         { _psSelect     :: RoomPos -> Room -> Maybe (PlacementSpot, RoomPos)
         , _psRoomEff    :: RoomPos -> Room -> Room
@@ -204,8 +205,9 @@ ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (const $ Just plmnt)
 psj :: PlacementSpot -> PSType -> Placement -> Placement
 psj ps pst plmnt = Placement ps pst Nothing (const $ Just plmnt)
 
+-- the NoShiftCont is necessary when shifting then combining rooms
 ps0jPushPS :: PSType -> Placement -> Placement
-ps0jPushPS pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (\p -> Just $ plmnt & plSpot .~ _plSpot p)
+ps0jPushPS pst plmnt = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing (\p -> Just $ plmnt & plSpot .~ _plSpot p)
 
 addPlmnt :: Placement -> Placement -> Placement
 addPlmnt pl pl2 = case pl2 of

src/Dodge/LockAndKey.hs

@@ -17,6 +17,7 @@ lockRoomKeyItems =
     [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] )
     ,(const slowDoorRoomRunPast, return MINIGUN)
     ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD])
+    ,(const glassLessonRunPast, takeOne [LASGUN])
     ]
 
 itemRooms :: RandomGen g => [(CombineType, State g (SubCompTree Room))]

src/Dodge/Placement/Instance/LightSource.hs

@@ -21,6 +21,7 @@ mntLSOn
     -> LightSource -> Point2 -> Point3 -> (Placement -> Maybe Placement) -> Placement
 mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _)
     = ps0jPushPS (PutShape . setCol $ shapeF wallp lsp)
+    -- = ps0j (PutShape . setCol $ shapeF wallp lsp)
     . pt0 (PutLS $ ls & lsParam . lsPos .~ lsp')
   where
     lsp' = lsp -.-.- V3 x y 1

src/Dodge/Placement/PlaceSpot.hs

@@ -54,6 +54,7 @@ placePlainPSSpot :: GenWorld -> Room -> Placement -> DPoint2 -> ((GenWorld,Room)
 placePlainPSSpot w rm plmnt shift = 
     let (i,w') = placeSpotID (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
         newplmnt = plmnt & plMID ?~ i
+    --in maybe ((w',rm),[newplmnt]) (recrPlace newplmnt w') (_plIDCont plmnt newplmnt)
     in maybe ((w',rm),[newplmnt]) (recrPlace newplmnt w') (_plIDCont plmnt newplmnt)
   where
     recrPlace newplmnt w' pl = let (wr,newplmnts) = placeSpot (w',rm) pl

src/Dodge/Placement/Shift.hs

@@ -12,10 +12,10 @@ shiftPSBy (pos,rot) ps = ps
     & psRot +~ rot
 shiftPlacement :: (Point2,Float) -> Placement -> Placement
 shiftPlacement shift plmnt = case plmnt of
+-- slightly messy NoShiftCont, necessary to stop interference with ps0jPushPS
+    Placement {_plSpot = PSNoShiftCont {}} -> plmnt & plSpot %~ shiftPSBy shift 
     Placement {} -> plmnt & plSpot %~ shiftPSBy shift 
--- TODO check whether the following continuation is ever necessary
+        & plIDCont %~ fmap (fmap $ shiftPlacement shift)
--- it can interfere with ps0jPushPS
---        & plIDCont %~ fmap (fmap $ shiftPlacement shift)
     PlacementUsingPos p f -> PlacementUsingPos (shiftPoint3By shift p)
         (fmap (shiftPlacement shift) f)
     RandomPlacement rpl -> RandomPlacement $ fmap (shiftPlacement shift) rpl

src/Dodge/PlacementSpot.hs

@@ -10,6 +10,7 @@ import System.Random
 setDirPS :: Float -> PlacementSpot -> PlacementSpot
 setDirPS a ps = case ps of
     PS p _ -> PS p a
+    PSNoShiftCont p _ -> PS p a
     PSPos f re fb -> PSPos (\rp r -> fmap (first (setDirPS a)) (f rp r)) re fb
     PSRoomRand i f -> PSRoomRand i (fmap (setDirPS a) f)
 

src/Dodge/Room/GlassLesson.hs

@@ -19,12 +19,10 @@ import Control.Monad.State
 --import Control.Monad.Loops
 import System.Random
 import Data.Tree
-
--- TODO: partially combine a room tree into a room
 glassLesson :: RandomGen g => State g (SubCompTree Room)
 glassLesson = do
     i <- takeOne [1,2,3]
-    corridors <- replicateM i $ PassDown <$> randomiseOutLinks corridor
+    corridors <- replicateM i $ PassDown <$> shuffleLinks corridor
     return $ Node (PassDown botRoom) 
         [ singleUseNone $ door & rmConnectsTo .~ S.singleton (LabLink 0)
         , uppers
@@ -58,3 +56,7 @@ glassLesson = do
             , mntLS vShape (V2 180 200) (V3 160 180 50)
             ]
         ]
+glassLessonRunPast :: RandomGen g => State g (SubCompTree Room)
+glassLessonRunPast = f <$> glassLesson
+  where
+    f (Node r rs) = Node r $ (return $ UseLabel 0 $ door & rmConnectsTo .~ S.singleton (OnEdge West)) : rs

src/Dodge/Room/LasTurret.hs

@@ -20,11 +20,11 @@ import Geometry
 --import Padding
 import Color
 import Shape
+import LensHelp
 
 import Data.Maybe
 import Data.Tree
 import Control.Monad.State
-import Control.Lens
 import System.Random
 
 cenLasTur :: Room
@@ -36,46 +36,44 @@ cenLasTur = roomNgon 8 200 & rmPmnts .~
 
 lightSensInsideDoor :: Room -> Room
 lightSensInsideDoor rm = rm 
-    & rmPmnts %~ ( (psPt atFstLnkOut $ PutShape $ colorSH yellow $ 
+    & rmPmnts .:~ (psPt atFstLnkOut $ PutShape $ colorSH yellow $
         thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
         <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
-        <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)) : )
+        <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
-    & rmExtPmnt ?~
+    & rmExtPmnt ?~ lasSensLightAboveDoor 10 (atFstLnkOutShiftInward 100)
-        extTrigLitPos (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
+
-        ( \tp -> Just $ lightSensor 10 (upf $ fromJust $ _plMID tp) (atFstLnkOutShiftInward 100)
+lasSensLightAboveDoor :: Float -> PlacementSpot -> Placement
-        )
+lasSensLightAboveDoor wth ps = extTrigLitPos 
+    (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
+    ( \tp -> Just $ lightSensor wth (upf $ fromJust $ _plMID tp) ps )
   where
     upf trid mc w | _mcSensor mc > 900 = w & triggers . ix trid .~ const True
         | otherwise = w
 
+
 lightSensByDoor :: Room -> Room
 lightSensByDoor rm = rm 
-    & rmPmnts %~ ( 
+    & rmPmnts .++~ 
         [ psPt atFstLnkOut $ PutShape $ colorSH yellow 
             $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)
         , heightWallPS (atNthLnkOutShiftInward 1 100) 30 (rectNSEW 10 (-10) 20 (-20))
-        , heightWallPS (atFstLnkOutShiftInward 100) 30 (rectNSEW 10 (-10) 20 (-20))
+        , heightWallPS (atFstLnkOutShiftInward 100)   30 (rectNSEW 10 (-10) 20 (-20))
-        ] ++ )
+        ]
-    & rmExtPmnt ?~
+    & rmExtPmnt ?~ lasSensLightAboveDoor 20 (atFstLnkOutShiftBy sensorshift)
-        extTrigLitPos (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
-        ( \tp -> Just $ lightSensor 20 (upf $ fromJust $ _plMID tp) (atFstLnkOutShiftBy sensorshift)
-        )
   where
     sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a)
-    upf trid mc w | _mcSensor mc > 900 = w & triggers . ix trid .~ const True
-        | otherwise = w
 
 lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room)
 lasSensorTurretTest n = do
-    cenroom <- randomiseOutLinks $ (lightSensInsideDoor cenLasTur) {_rmLabel = Just n}
+    cenroom <- shuffleLinks $ lightSensInsideDoor cenLasTur & rmLabel .~ Just n
-    let doorroom = switchDoorRoom {_rmTakeFrom = Just n}
+    let doorroom = switchDoorRoom & rmTakeFrom .~ Just n
     return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
 
 lasCenSensEdge :: RandomGen g => Int -> State g (SubCompTree Room)
 lasCenSensEdge n = do
-    cenroom <- randomiseOutLinks $ (lightSensByDoor cenLasTur) {_rmLabel = Just n}
+    cenroom <- shuffleLinks $ (lightSensByDoor cenLasTur) {_rmLabel = Just n}
     let doorroom = switchDoorRoom {_rmTakeFrom = Just n}
-    return $ treeFromTrunk [PassDown door] (Node (PassDown cenroom) 
+    return $ treeFromTrunk [PassDown door] $ Node (PassDown cenroom) 
-        [treeFromPost [PassDown doorroom] (UseAll door), treeFromPost [PassDown door] (UseLabel 0 corridor)
+        [ treeFromPost [PassDown doorroom] (UseAll door)
+        , treeFromPost [PassDown door]     (UseLabel 0 corridor)
         ]
-        )

src/Dodge/Room/RoadBlock.hs

@@ -53,25 +53,19 @@ litCorridor90 = do
         }
 
 -- | A random length corridor with a destructible block blocking it.
-longBlockedCorridor :: RandomGen g => State g (SubCompTree Room)
+longBlockedCorridor :: RandomGen g => Int -> State g (SubCompTree Room)
-longBlockedCorridor = do
+longBlockedCorridor maxn = do
     r <- state $ randomR (0,pi)
-    n <- state $ randomR (0,3)
+    n <- state $ randomR (0,maxn)
     let plmnts = [sPS (V2 20 40) r $ dirtPoly $ square 10
-                 ,sPS (V2 20 15) 0 putLamp
+            ,sPS (V2 20 15) 0 putLamp
-                 ]
+            ]
-    sequence $ treeFromPost (replicate n $ PassDown <$> randomiseOutLinks corridor) 
+    sequence $ treeFromPost (replicate n $ PassDown <$> shuffleLinks corridor) 
                         $ return $ UseAll $ set rmPmnts plmnts corridor
 
 -- | A single corridor with a destructible block blocking it.
 blockedCorridor :: RandomGen g => State g (SubCompTree Room)
-blockedCorridor = do
+blockedCorridor = longBlockedCorridor 0
-    r <- state $ randomR (0,pi)
-    let plmnts = 
-            [sPS (V2 20 40) r $ dirtPoly $ square 10
-            ,spanLightI (V2 0 15) (V2 40 15)
-            ]
-    sequence $ treeFromPost [] $ return $ UseAll $ set rmPmnts plmnts corridor
 
 dirtPoly :: [Point2] -> PSType
 dirtPoly = PutBlock DirtBlock 1 [] dirtWall . reverse

src/Dodge/Room/Room.hs

@@ -138,7 +138,7 @@ miniRoom3 = do
             ] ++ 
             [ sPS cp 0 $ PutCrit miniGunCrit 
             , sPS (V2 (w/2) (h/2)) 0 putLamp ]
-    fmap singleUseAll $ randomiseOutLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h
+    fmap singleUseAll $ shuffleLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h
 
 rot90Around :: Point2 -> Point2 -> Point2
 rot90Around cen p = cen +.+ vNormal (p -.- cen)

src/Dodge/Room/RunPast.hs

@@ -23,19 +23,17 @@ import Dodge.Item.Random
 import Geometry.Data
 --import Padding
 import Color
---import Shape
+import LensHelp
 
 import qualified Data.Set as S
 import Data.Tree
 import Control.Monad.State
-import Control.Lens
 import System.Random
 --import qualified Data.IntMap.Strict as IM
 
 horEdgeTest :: (Float -> Bool) -> ((Point2,Float) -> Bool)
 horEdgeTest t (V2 x _,_) = t x
 
-
 roomCritLS :: RandomGen g => State g LightSource
 roomCritLS = do
     col <- takeOne [0.5, 0.6]
@@ -44,26 +42,20 @@ roomCritLS = do
     return $ lsPosColRad (V3 0 0 h) col rad
 
 critRoom :: Room
-critRoom = corridorWallN
+critRoom = corridorWallN & rmRandPSs .~ [psRandRanges (15,25) (30,45) (pi,2*pi)]
-    { _rmRandPSs = [psRandRanges (15,25) (30,45) (pi,2*pi)]
-    }
 
 runPastRoom :: RandomGen g => Int -> State g (SubCompTree Room)
 runPastRoom i = do
     h <- state $ randomR (200,400::Float)
     theedgetest <- takeOne [horEdgeTest (<1), horEdgeTest  (>39)]
     thels <- roomCritLS
-    --theweapon <- join $ takeOne [randBlockBreakWeapon,return grenade]
     theweapon <- randBlockBreakWeapon
     cenroom <- shuffleLinks $ restrictRMInLinksPD (\(V2 _ y,_) -> y < 1)
                 $ roomRectAutoLinks 40 h & rmPmnts .~ [plRRpt 0 (PutFlIt theweapon)]
     theedge <- takeOne [West,East]
     --let cenroom = filterSortOutLinksOn theedgetest ((\(V2 a b) -> (a,b)) . fst)
-    let linkcor = critRoom {_rmPmnts = 
+    let linkcor = critRoom & rmPmnts .~ [ spanLS thels (V2 0 65) (V2 40 65) ]
-                    [ spanLS thels (V2 0 65) (V2 40 65)
+        critroom = linkcor & rmPmnts .:~ plRRpt 0 randC1
-                    ]
-                    }
-        critroom = linkcor & rmPmnts %~ ( plRRpt 0 randC1 :)
         aswitchroom = corridorWallN
             {_rmExtPmnt = Just $ putLitButOnPosExtTrig red useLnkRoomPos
             ,_rmLabel = Just i
@@ -75,7 +67,6 @@ runPastRoom i = do
         critrooms :: [SubCompTree Room]
         critrooms = treeFromPost [PassDown switchdoor] (PassDown critroom) : 
             replicate (n-2) (treeFromPost [PassDown switchdoor] (PassDown linkcor))
-    return $ Node (PassDown cenroom) 
+    return $ Node (PassDown cenroom) $ 
-        (map (applyToCompRoot $ rmConnectsTo .~ S.singleton (OnEdge theedge)) (controom : critrooms) 
+        map (applyToCompRoot $ rmConnectsTo .~ S.singleton (OnEdge theedge)) (controom : critrooms) 
             ++ [return $ PassDown aswitchroom]
-        )

src/Dodge/Room/Start.hs

@@ -3,7 +3,6 @@ import Dodge.LevelGen.Data
 --import Dodge.PlacementSpot
 import Dodge.Room.RunPast
 --import Dodge.RoomLink
-import Dodge.Room.LasTurret
 --import Dodge.Data
 --import Dodge.Default
 --import Dodge.RoomLink
@@ -26,12 +25,12 @@ import Dodge.Item.Weapon.Utility
 import Geometry
 --import Padding
 import Color
-import Shape
+--import Shape
+import LensHelp
 
 --import Data.Maybe
 --import Data.Tree
 import Control.Monad.State
-import Control.Lens
 import System.Random
 --import qualified Data.IntMap.Strict as IM
 
@@ -40,30 +39,18 @@ minigunFakeout = do
     rcol <- rezColor
     ncor <- state $ randomR (0,2)
     roomwithmini <- randomiseAllLinks $ roomRectAutoLinks 150 150
-        & rmPmnts %~ (plRRpt 0 (PutFlIt $ miniGunX 6):)
+        & rmPmnts .:~ plRRpt 0 (PutFlIt $ miniGunX 6)
-    randcors <- replicateM ncor $ (fmap PassDown . randomiseOutLinks) corridor
+    randcors <- replicateM ncor $ (fmap PassDown . shuffleLinks) corridor
     return $ ([PassDown $ rezBox rcol
                 ,PassDown door
                 ,PassDown roomwithmini 
                 ,PassDown door
                 ] 
             ++ randcors
-            ++ [PassDown $ corridor & rmPmnts %~ ( plRRpt 0 (PutFlIt shrinkGun) :)
+            ++ [PassDown $ corridor & rmPmnts .:~ plRRpt 0 (PutFlIt shrinkGun)
                 ,PassDown keyholeCorridor,PassDown corridor])
         `treeFromPost` UseAll door
 
-
-rezThenLasTurret :: RandomGen g => State g (SubCompTree Room)
-rezThenLasTurret = do
-    rbox <- rezBoxStart
-    cenroom <- randomiseOutLinks $ (lightSensInsideDoor cenLasTur) {_rmLabel = Just 0}
-    let doorroom = switchDoorRoom {_rmTakeFrom = Just 0}
-        contTree = treeFromPost [PassDown cenroom,PassDown doorroom] (UseAll door)
-    return $ rbox `passUntilUseAll` [contTree]
-
-room2 :: RandomGen g => Int -> State g (SubCompTree Room)
-room2 = lasCenSensEdge    
-
 startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
 startRoom i = join $ uncurry takeOneWeighted $ unzip 
 --    [ (,) (0.5::Float) $ chainUses <$> sequence [minigunFakeout,weaponRoom]
@@ -113,13 +100,8 @@ startRoom' = do
             , tankSquareEmboss4 (dim orange) 50 (h-60)
             , tankSquare (dim orange) 50 50
             , tankSquare (dim orange) 50 120
-            , lightSensor 10 (const id) (PS (V2 (0.8*w) (0.25*h)) 0)
+            --, sps0 $ PutShape $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
-            , putLasTurret 0.005 & plSpot .~ PS (V2 (0.8*w) (0.8*h)) 0
-            , sps0 $ PutShape $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
             ]
     thecol <- rezColor
     treeFromPost [PassDown $ rezBox thecol, PassDown door] . UseAll 
-        <$> randomiseOutLinks 
+        <$> shuffleLinks (roomRectAutoLinks w h & rmPmnts .++~ plmnts)
-            (shiftRoomBy (V2 (-20) (-20),0) 
-            ( roomRectAutoLinks w h & rmPmnts %~ (plmnts ++) 
-            ) & rmShift .~ (0,0) )

src/Dodge/Tile.hs

@@ -0,0 +1,6 @@
+module Dodge.Tile where
+--import Dodge.Data
+
+--tilePolyFromRoomPoly :: Room -> Room
+--tilePolyFromRoomPoly rm = rm & rmFloor .~ Tile
+--    { _tilePoly