diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index e7585a0bf..1221ec225 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -35,8 +35,13 @@ initialRoomTree = do t = treeFromTrunk [[StartRoom] ,[Corridor] - ,[SpecificRoom $ fmap connectRoom glassSwitchBackCrits] ,[Corridor] + ,[SpecificRoom $ fmap connectRoom pistolerRoom] + ,[Corridor] + ,[Corridor] +-- ,[Corridor] +-- ,[Corridor] +-- ,[Corridor] ,[SpecificRoom $ return $ connectRoom lasTunnel ] ,[Corridor] ,[SpecificRoom $ fmap connectRoom slowDoorRoom ] diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index b3057a25d..cbb57f718 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -42,7 +42,8 @@ generateLevelFromRoomList gr w = initWallZoning . setupWorldBounds -- . flip (foldr $ flip placeSpot) plmnts - . flip (foldl' placeSpot) plmnts + -- . flip (foldl' placeSpot) plmnts + . flip (foldl' doRoomPlacements) rs $ w { _walls = wallsFromRooms rs , _floorTiles = floorsFromRooms rs , _gameRooms = gameRoomsFromRooms rs @@ -56,6 +57,9 @@ generateLevelFromRoomList gr w rs = zipWith addTile zs . evalState gr $ _randGen w zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w +doRoomPlacements :: World -> Room -> World +doRoomPlacements w rm = fst $ foldl' placeSpot' (w,rm) $ _rmPS rm + updatePSLnkUsing :: (Point2,Float) -> PlacementSpot -> PlacementSpot updatePSLnkUsing pf PSLnk{_psLinkShift=f} = uncurry PS $ f pf updatePSLnkUsing _ ps = ps diff --git a/src/Dodge/Layout/Tree/Shift.hs b/src/Dodge/Layout/Tree/Shift.hs index 6d222c98f..f03ffc0c7 100644 --- a/src/Dodge/Layout/Tree/Shift.hs +++ b/src/Dodge/Layout/Tree/Shift.hs @@ -23,11 +23,15 @@ shiftRoomTreeSearchAll -> Seq (Tree Room) -- ^ Rooms to be added -> [[Room]] shiftRoomTreeSearchAll _ Empty = [[]] -shiftRoomTreeSearchAll bs (Node r ts :<| ts') - | roomIsClipping = [] -- this is called too often, but whatever +shiftRoomTreeSearchAll bs (Node r ts :<| tseq) + | roomIsClipping = [] -- this is called too often--might get memoized? | otherwise = case ts of - [] -> (r :) <$> shiftRoomTreeSearchAll newBounds ts' - (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (useLink l) ss <| (ts' |> f l s))) ls + [] -> (r :) <$> shiftRoomTreeSearchAll newBounds tseq + (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (useLink l) ss <| (tseq |> f l s))) ls +-- = case ts of +-- [] | roomIsClipping -> [] +-- [] -> (r :) <$> shiftRoomTreeSearchAll newBounds tseq +-- (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (useLink l) ss <| (tseq |> f l s))) ls where convexBounds = map pointsToPoly $ _rmBound r ls = init $ _rmLinks r diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 1ad8b2e62..cdb0c1356 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -4,8 +4,9 @@ module Dodge.LevelGen ( shiftPlacement , shiftPointBy - , placeSpot +-- , placeSpot , invShiftPointBy + , placeSpot' ) where import Dodge.Data import Dodge.LevelGen.Block @@ -25,6 +26,40 @@ import Color import Control.Monad.State import Control.Lens import qualified Data.IntSet as IS +import Data.List (delete) + +placeSpot' :: (World,Room) -> Placement -> (World,Room) +placeSpot' (w,rm) plmnt = case plmnt of + Placement{_placementSpot = PSRoomRand i} + -> let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w + in placeSpot' (w & randGen .~ g,rm) (plmnt & placementSpot .~ uncurry PS ps) + Placement{_placementSpot = PSLnk{}} -> case lnks of + (lnk:_) -> placeSpot' (w & randGen .~ g,uselnk lnk) (updatePS (f lnk) plmnt) + [] -> case fallback of + Nothing -> (w,rm) + Just plmnt' -> placeSpot' (w,rm) plmnt' + where + uselnk lnk = rm & rmLinks %~ delete lnk + rps = _placementSpot plmnt + fallback = _psFallback rps + test = _psLinkTest rps + (lnks,g) = runState (shuffle $ filter test $ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm) + $ _randGen w + f x (PSLnk t s _) + | t x = uncurry PS $ s x + f _ ps = ps + invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float) + invShiftLinkBy (pos,rot) (p,r) = (invShiftPointBy (pos,rot) p, r - rot) + Placement{} -> + let (i,w') = placeSpotID (shiftPSBy shift (_placementSpot plmnt)) (_psType plmnt) w + in (maybe w' (curry (placeSpot w') rm) (_idPlacement plmnt i) , rm) + PlacementUsingPos p subpl -> placeSpot' (w,rm) (subpl (shiftPoint3By shift p)) + RandomPlacement rplmnt -> placeSpot' (w & randGen .~ g,rm) plmnt' + where + (plmnt', g) = runState rplmnt (_randGen w) + where + shift = _rmShift rm + -- potential failure cases: randomising using an already set link position -- others? @@ -49,11 +84,12 @@ placeSpot w (rm, RandomPlacement rplmnt) = placeSpot (w & randGen .~ g) (rm, plm -- this should be woven into placeSpot assignPSToLnk :: Room -> Placement -> World -> World assignPSToLnk rm plmnt w = case lnks of - (lnk:_) -> placeSpot (w & randGen .~ g) (rm, updatePS (f lnk) plmnt) + (lnk:_) -> placeSpot (w & randGen .~ g) (uselnk lnk, updatePS (f lnk) plmnt) [] -> case fallback of Nothing -> w Just plmnt' -> placeSpot w (rm,plmnt') where + uselnk lnk = rm & rmLinks %~ delete lnk rps = _placementSpot plmnt fallback = _psFallback rps test = _psLinkTest rps diff --git a/src/Dodge/Placements/LightSource.hs b/src/Dodge/Placements/LightSource.hs index 8381bbb37..3495fab13 100644 --- a/src/Dodge/Placements/LightSource.hs +++ b/src/Dodge/Placements/LightSource.hs @@ -85,7 +85,7 @@ mountLightl = redMID mountLightlID mountLightAID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement mountLightAID = mountLightOnShape f where - f wallpos (V3 x y z) = girder (z+10) 20 10 pout wallpos + f wallpos (V3 x y z) = girder (z+2) 20 10 pout wallpos where pout = V2 x y -.- 2 *.* safeNormalizeV (V2 x y -.- wallpos) diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 130a7d34e..9e91735e9 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -209,15 +209,17 @@ roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst) plmnts = [ blockLine (V2 115 115) (V2 115 125) , blockLine (V2 125 115) (V2 125 125) - , sPS (V2 40 120) 0 putLamp - , sPS (V2 200 120) 0 putLamp + --, sPS (V2 40 120) 0 putLamp + --, sPS (V2 200 120) 0 putLamp + , mntLightLnkCond (const True) + , mntLightLnkCond (const True) ] roomOctogon :: Room roomOctogon = defaultRoom { _rmPolys = [poly ] , _rmLinks = lnks - , _rmPath = allPairs $ map fst lnks + , _rmPath = allPairs $ map fst lnks -- this is too much , _rmPS = [] , _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ] , _rmFloor = [makeTileFromPoly poly 7] @@ -238,10 +240,6 @@ roomOctogon = defaultRoom allPairs :: Eq a => [a] -> [(a,a)] allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y] -randomCorridorFrom :: RandomGen g => [a] -> State g (Tree (Either a a)) -randomCorridorFrom xs = do - rooms <- replicateM 5 $ takeOne xs - return $ treeFromTrunk (map Left $ init rooms) (Node (Right (last rooms)) []) {- Probabilites of the type of the first floor weapon. -} randFirstWeapon :: State StdGen PSType randFirstWeapon = do @@ -262,7 +260,8 @@ weaponEmptyRoom = do [sPS (V2 (w/2) (h-40)) 0 $ RandPS randFirstWeapon ,sPS (V2 20 20) (pi/2) randC1 ,sPS (V2 (w-20) 20) (pi/2) randC1 - ,sPS (V2 (w/2) (h/2)) 0 putLamp + --,sPS (V2 (w/2) (h/2)) 0 putLamp + ,mntLightLnkCond (const True) ] (fmap connectRoom . randomiseOutLinks) =<< changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPS plmnts $ roomRect w h 2 2) @@ -277,8 +276,7 @@ weaponUnderCrits = do let continuationRoom = treeFromTrunk [Left corridorN,Left corridorN] (connectRoom (set rmPS plmnts corridorN)) - rcp' <- roomCenterPillar - let rcp = over rmPS ( sPS (V2 120 80) 0 putLamp : ) rcp' + rcp <- roomCenterPillar deadEndRoom' <- takeOne [roomPillars,rcp] junctionRoom <- takeOne [Left tEast,Left tWest] return $ treeFromTrunk [Left corridorN,Left corridorN] @@ -322,8 +320,7 @@ weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room)) weaponLongCorridor = do root <- takeOne [tEast, tWest] connectingRoom <- takeOne - [tEast & rmPS .~ [sPS (V2 (-40) 60) 0 putLamp] - ,tWest & rmPS .~ [sPS (V2 40 60) 0 putLamp] + [tEast & rmPS .~ [spanLightI (V2 (-40) 40) (V2 (-40) 80)] ] i1 <- state $ randomR (2,5) i2 <- state $ randomR (2,5) @@ -332,7 +329,7 @@ weaponLongCorridor = do return $ Node (Left root) [branch1,branch2] where putCrs = over rmPS (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ]) - putWp = set rmPS [sPS (V2 20 40) 0 $ RandPS randFirstWeapon ,sPS (V2 20 60) 0 putLamp ] + putWp = set rmPS [sPS (V2 20 60) 0 $ RandPS randFirstWeapon ,spanLightI (V2 0 40) (V2 40 40)] critInDeadEnd :: Room critInDeadEnd = set rmPS [sPS (V2 0 0) 0 randC1] deadEndRoom @@ -393,8 +390,8 @@ longRoom = do ,sPS (V2 25 (h-10)) 0 putLamp ] -shooterRoom :: RandomGen g => State g Room -shooterRoom = do +doubleCorridorBarrels :: RandomGen g => State g Room +doubleCorridorBarrels = do h <- state $ randomR (200,300) let cond x = (sndV2 . fst) x < h - 40 changeLinkTo cond $ roomRect 100 h 1 1 & rmPS .~ @@ -407,84 +404,78 @@ shooterRoom = do ,sPS (V2 75 (h-80)) 0 putLamp ] -shootersRoom1 :: RandomGen g => State g Room -shootersRoom1 = do +shootersRoom' :: RandomGen g => State g Room +shootersRoom' = do w <- state $ randomR (200,300) x1 <- state $ randomR (20,w/3-20) x2 <- state $ randomR (w/3+20,2*w/3-20) x3 <- state $ randomR (2*w/3+20,w-20) - y1 <- state $ randomR (250,560) - y2 <- state $ randomR (250,560) + y1 <- state $ randomR (250,550) + y2 <- state $ randomR (250,550) y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (250,560) x4 <- state $ randomR (60,w-60) y4 <- state $ randomR (40,180) - p <- takeOne [V2 x1 (y1-10),V2 x2 (y2-10),V2 x3 (y3-10)] - let bln x y = putBlockN (x+25) (x-25) (y+10) y - let blv x y = putBlockV (x+25) (x-25) (y+10) y - let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4 - ++ [sPS p (-pi/2) $ PutCrit autoCrit - ,sPS (V2 (w/2) 200) 0 putLamp + --p <- takeOne [V2 x1 y1,V2 x2 y2,V2 x3 y3] + let bln x y = putBlockN (x+25) (x-25) (y+20) (y+10) + blv x y = putBlockV (x+25) (x-25) (y+20) (y+10) + plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4 + ++ [spanLightI (V2 0 200) (V2 w 200) + , mntLightLnkCond (\(V2 _ y,_) -> y < 50) + , mntLightLnkCond (\(V2 _ y,_) -> y > 550) ] + toPS x y = return (V2 x y,-0.5*pi) return $ set rmPS plmnts $ roomRectAutoLinks w 600 + & rmPS .~ plmnts + & rmRandPSs .~ [toPS x1 y1,toPS x2 y2,toPS x3 y3] + +shootersRoom1 :: RandomGen g => State g Room +shootersRoom1 = shootersRoom' <&> rmPS %~ + ( ( + RandomPlacement $ takeOne $ map (\i -> Placement (PSRoomRand i) (PutCrit autoCrit) (const Nothing)) + [0,1,2] + ) :) shootersRoom :: RandomGen g => State g Room -shootersRoom = do - w <- state $ randomR (200,300) - x1 <- state $ randomR (20,w/3-20) - x2 <- state $ randomR (w/3+20,2*w/3-20) - x3 <- state $ randomR (2*w/3+20,w-20) - y1 <- state $ randomR (250,560) - y2 <- state $ randomR (250,560) - y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (250,560) - x4 <- state $ randomR (60,w-60) - y4 <- state $ randomR (40,180) - let bln x y = putBlockN (x+25) (x-25) (y+10) y - let blv x y = putBlockV (x+25) (x-25) (y+10) y - let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4 - ++ [sPS (V2 x1 (y1-10)) (-pi/2) $ PutCrit autoCrit - ,sPS (V2 x2 (y2-10)) (-pi/2) $ PutCrit autoCrit - ,sPS (V2 x3 (y3-10)) (-pi/2) $ PutCrit autoCrit - ,sPS (V2 (w/2) 200 ) 0 putLamp - ] - return $ set rmPS plmnts $ roomRectAutoLinks w 600 +shootersRoom = shootersRoom' <&> rmPS %~ + ( map (\i -> Placement (PSRoomRand i) (PutCrit autoCrit) (const Nothing)) + [0,1,2] + ++ ) -pistolerRoom :: RandomGen g => State g Room -pistolerRoom = do +pillarGrid :: RandomGen g => State g Room +pillarGrid = do let f2 x y = singleBlock (V2 x y) - --f3 x y = [blockLine (x-20,y) (x+20,y) - -- ,blockLine (x,y-20) (x,y+20) ] - --f4 x y = [blockLine (x-20,y-20) (x+20,y+20) - -- ,blockLine (x+20,y-20) (x-20,y+20) ] f <- takeOne [f2] h <- state $ randomR (400,800) let w = h i <- takeOne [3,4,5] - let j = fromIntegral (i+1) + let j = fromIntegral i -- the 20+etc here is to correct for the pathfinding grid, which matches up to -- edges based on the size of doors (i.e. the line next to the wall is 20 -- away from it) - xs = take i [20+0.5*(w-40)/(j-1),20+1.5*(w-40)/(j-1)..] - ys = take i [20+0.5*(h-40)/(j-1),20+1.5*(h-40)/(j-1)..] - gap = 0.5 * h / j - ps <- takeN 3 $ zipWith V2 (map (+gap) xs) ys - aa <- state $ randomR (0,2*pi) - ab <- state $ randomR (0,2*pi) - ac <- state $ randomR (0,2*pi) - let plmnts = [sPS (head ps) aa $ PutCrit pistolCrit - ,sPS (ps !! 1) ab $ PutCrit pistolCrit - ,sPS (ps !! 2) ac $ PutCrit pistolCrit - ,sPS (V2 (w/2) (h-50)) 0 putLamp - ,sPS (V2 (w/2) 50 ) 0 putLamp - ,sPS (V2 (w-5) (h-5) ) 0 putLamp - ,sPS (V2 5 (h-5) ) 0 putLamp - ,sPS (V2 (w-5) 5 ) 0 putLamp - ,sPS (V2 5 5 ) 0 putLamp - ,sPS (V2 (w/2) (h/2) ) 0 putLamp - ] + xs = take i [20+0.5*(w-40)/j,20+1.5*(w-40)/j..] + ys = take i [20+0.5*(h-40)/j,20+1.5*(h-40)/j..] + gap = 0.5 * h / (j+1) + rps = do + x <- takeOne xs + y <- takeOne ys + a <- state $ randomR (0,2*pi) + return (V2 (x+gap) y,a) + let plmnts = replicate 30 (mntLightLnkCond (const True)) ++ concat [f x y | x<-xs,y<-ys] - return - $ set rmPS plmnts $ roomRect w h (max i 2) (max i 2) + return $ roomRect w h (max i 2) (max i 2) + & rmPS .~ plmnts + & rmRandPSs .~ [rps] + +-- TODO remove possible identical draws on random PSs +pistolerRoom :: RandomGen g => State g Room +pistolerRoom = pillarGrid + <&> rmPS %~ ( + [Placement (PSRoomRand 0) (PutCrit pistolCrit) (const Nothing) + ,Placement (PSRoomRand 0) (PutCrit pistolCrit) (const Nothing) + ,Placement (PSRoomRand 0) (PutCrit pistolCrit) (const Nothing) + ] + ++) shootingRange :: RandomGen g => State g (Tree (Either Room Room)) shootingRange = do diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs index 16ff4a77b..29c9480b9 100644 --- a/src/Dodge/Room/Foreground.hs +++ b/src/Dodge/Room/Foreground.hs @@ -135,7 +135,7 @@ girder -> Float -- ^ distance between cross bars -> Float -- ^ width -> Point2 -> Point2 -> Shape -girder = girderCol red +girder = girderCol orange robotArm :: Shape robotArm = undefined