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

Commit before generalising FromWest/South etc

Browse Source
This commit is contained in:
justin
2022-06-14 10:37:24 +01:00
parent d17f83928a
commit 4a910566e6
14 changed files with 137 additions and 126 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Girder.hs
+26
View File
@@ -1,2 +1,28 @@
module Dodge.Room.Girder where
import Dodge.Data
import RandomHelp
import Dodge.Room.Foreground
import Dodge.Room.Modify.Girder
import Color
addRandomGirderEW :: RandomGen g => Room -> State g Room
addRandomGirderEW rm = do
hgshape <- takeOne [girder 96 20 10, girderZ 96 20 10, girderV 96 20 10]
lgshape <- takeOne [girder 60 20 10, girderZ 60 20 10, girderV 60 20 10]
addgird <- takeOne $
[ addGirderNS' hgshape black
, addGirderNS' lgshape red
]
addgird rm
addRandomGirderFromWest :: RandomGen g => Int -> Room -> State g Room
addRandomGirderFromWest i rm = do
(h,col) <- takeOne [(96,black),(60,red)]
gtype <- takeOne [girder,girderZ,girderV]
addGirderFromWest i (gtype h 20 10) col rm
addRandomGirderFrom :: RandomGen g => CardinalPoint -> Int -> Room -> State g Room
addRandomGirderFrom cp i rm = do
(h,col) <- takeOne [(96,black),(60,red)]
gtype <- takeOne [girder,girderZ,girderV]
addGirderFrom cp i (gtype h 20 10) col rm
src/Dodge/Room/Modify/Girder.hs
+40
View File
@@ -1,8 +1,11 @@
module Dodge.Room.Modify.Girder
( addGirderLights
, addGirderFrom
, addHighGirder
, addGirderEW
, addGirderNS
, addGirderNS'
, addGirderFromWest
) where
--import Dodge.Data
import Dodge.LevelGen.Data
@@ -36,6 +39,43 @@ addGirderNS shapef col room = do
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- girderPosOrder]
)
-- this can be cleaned up
addGirderFromWest :: RandomGen g => Int -> (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
addGirderFromWest fromwesti shapef col room = do
let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room
girderPosOrder <- shuffle [0 .. nwestlnks - 1]
return $ room & rmPmnts .:~ foldr1 setFallback
(sps0 PutNothing : [ twoRoomPoss
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromWest i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- [fromwesti]]
)
addGirderFrom :: RandomGen g => CardinalPoint -> Int
-> (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
addGirderFrom cp fromwesti shapef col room = do
let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room
girderPosOrder <- shuffle [0 .. nwestlnks - 1]
return $ room & rmPmnts .:~ foldr1 setFallback
(sps0 PutNothing : [ twoRoomPoss
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromWest i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- [fromwesti]]
)
-- | Allows girder to be on edge
addGirderNS' :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
addGirderNS' shapef col room = do
let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room
girderPosOrder <- shuffle [0 .. nwestlnks - 1]
return $ room & rmPmnts .:~ foldr1 setFallback
(sps0 PutNothing : [ twoRoomPoss
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromWest i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- girderPosOrder]
)
addGirderEW :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
addGirderEW shapef col room = do
let nwestlnks = length $ filter ((OnEdge West `S.member`) . _rlType) $ _rmLinks room
src/Dodge/Room/Procedural.hs
+2 -2
View File
@@ -74,8 +74,8 @@ roomRect x y xn yn = defaultRoom
yd = (y - 40) / fromIntegral yn
xd = (x - 40) / fromIntegral xn
somelnks poffset ps a = zip (map (+.+ poffset) ps) (repeat a)
elnks = somelnks (V2 0 20) (gridPoints 0 1 yd (yn+1)) ( pi/2)
wlnks = somelnks (V2 x 20) (gridPoints 0 1 yd (yn+1)) (-pi/2)
wlnks = somelnks (V2 0 20) (gridPoints 0 1 yd (yn+1)) ( pi/2)
elnks = somelnks (V2 x 20) (gridPoints 0 1 yd (yn+1)) (-pi/2)
nlnks = somelnks (V2 20 y) (gridPoints xd (xn+1) 0 1 ) 0
slnks = somelnks (V2 20 0) (gridPoints xd (xn+1) 0 1 ) pi
lnks = m North FromWest FromEast nlnks
src/Dodge/Room/Room.hs
+26 -64
View File
@@ -1,6 +1,11 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Room.Room where
import Data.Tile
module Dodge.Room.Room
( shootingRange
, weaponRoom
, roomMiniIntro
, roomCCrits
, doubleCorridorBarrels
) where
import Dodge.UseAll
import Dodge.Data
import Dodge.PlacementSpot
@@ -9,6 +14,7 @@ import Dodge.Default.Room
import Dodge.Item.Weapon.BulletGuns
import Dodge.Creature
import Dodge.Room.Pillar
import Dodge.Room.Girder
import Dodge.Room.Modify.Girder
import Dodge.LevelGen.Data
import RandomHelp
@@ -18,18 +24,16 @@ import Dodge.Placement.Instance
--import Dodge.LevelGen.Data
import Dodge.Room.Procedural
import Dodge.Room.Corridor
import Dodge.Room.Tanks
import Dodge.Room.Link
import Dodge.Room.Door
import Dodge.Room.Airlock
import Geometry
import Tile
import MonadHelp
import LensHelp
--import Color
import qualified Data.Set as S
--import Control.Monad.Loops
import Data.Bifunctor
roomC :: RandomGen g => Float -> Float -> State g Room
roomC w h = do
@@ -37,12 +41,18 @@ roomC w h = do
[ sPS (V2 0 0) 0 $ PutWall (rectNSWE (h-60) 0 (w/2-10) (w/2+10)) defaultCrystalWall
, windowLine (V2 (w/2) 0) (V2 (w/2) (h-60))
]
shuffleLinks $ roomRectAutoLinks w h
& restrictOutLinks fromCond
& rmPmnts .:~ wl
ntanks <- takeOne [0,0,0,0,0,1,1,1,1,2,3,4]
thetank <- randomTank <&> plSpot .~ unusedOffPathAwayFromLink 50
maybeaddgird <- takeOne [return, addRandomGirderFromWest 0, addRandomGirderFrom North 0]
maybeaddgird =<< (shuffleLinks $ roomRectAutoLinks w h
& rmLinks %~
( (setInLinks (\rl -> S.fromList [FromEast 0,OnEdge South] `S.isSubsetOf` _rlType rl))
. (setOutLinks (\rl -> OnEdge West `S.member` _rlType rl))
)
& rmPmnts .++~ (wl : replicate ntanks thetank)
& rmRandPSs .~ [farside]
)
where
fromCond (V2 x _,_) = x < w / 2 - 10
farside = do
x <- state $ randomR (5, w/2 - 20)
y <- state $ randomR (5, h - 70)
@@ -59,10 +69,6 @@ roomPadCut ps p = defaultRoom
branchWith :: Room -> [Tree Room] -> Tree Room
branchWith r ts = Node r $ return (cleatOnward door) : ts
manyDoors :: Int -> Tree Room
manyDoors i = treeFromPost (replicate i door) $ cleatOnward door
glassSwitchBack :: RandomGen g => State g Room
glassSwitchBack = do
wth <- state $ randomR (200,400)
@@ -103,23 +109,6 @@ miniTree2 = do
rm <- glassSwitchBackCrits >>= shuffleLinks . restrictInLinks (\p -> (sndV2 . fst) p < 70)
return $ branchWith rm (replicate 3 $ treePost [door,corridor,critInDeadEnd])
miniRoom3 :: RandomGen g => State g (Tree Room)
miniRoom3 = do
w <- state $ randomR (300,400)
h <- state $ randomR (300,400)
let cp = V2 0 (h/2+40)
let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ rectNSEW 10 (-10) (-60) (-80)
-- baseBlockPlane might need a reverse...
let plmnts = concatMap
(\i -> [ sPS cp (fromIntegral i*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
, sPS cp (pi/8+fromIntegral i*pi/4) b]
) [0..7::Int]
++ [ sPS cp 0 $ PutCrit miniGunCrit , sPS (V2 (w/2) (h/2)) 0 putLamp ]
pure <$> shuffleLinks (cleatOnward $ set rmPmnts plmnts $ roomRectAutoLinks w h)
rot90Around :: Point2 -> Point2 -> Point2
rot90Around cen p = cen +.+ vNormal (p -.- cen)
-- So, the idea is to attach outer children to the bottommost right nodes
-- inside an inner tree
-- no idea what was going on here...
@@ -142,31 +131,6 @@ roomCenterPillar = shuffleLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10
, mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
]
roomOctogon :: Room
roomOctogon = defaultRoom
{ _rmPolys = [poly ]
, _rmLinks = muout (init lnks) ++ muin [last lnks]
, _rmPath = allPairs $ map fst lnks -- this is too much
, _rmPmnts = []
, _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ]
, _rmFloor = Tiled [makeTileFromPoly poly 7]
}
where
poly = map toV2 [(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)]
lnks = map (first toV2)
[((0,140),0)
,((35,125),negate $ pi/4)
,((-35,125),pi/4)
,( (50,90),negate $ pi/2)
,( (-50,90),pi/2)
,((35,55),negate $ 3*pi/4)
,((-35,55),3*pi/4)
,( (0,40),pi)
]
allPairs :: Eq a => [a] -> [(a,a)]
allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y]
{- Probabilites of the type of the first floor weapon. -}
randFirstWeapon :: State StdGen PSType
randFirstWeapon = do
@@ -287,9 +251,9 @@ weaponRoom i = join $ takeOne
, weaponLongCorridor >>= rToOnward "weaponLongCorridor"
]
roomCCrits :: RandomGen g => State g Room
roomCCrits = roomC 200 200
<&> rmPmnts %~ (replicate 20 (spNoID (PSRoomRand 0 (uncurry PS)) randC1) ++ )
roomCCrits :: RandomGen g => Int -> State g Room
roomCCrits i = roomC 200 200
<&> rmPmnts .++~ replicate i (spNoID (PSRoomRand 0 (uncurry PS)) randC1)
doubleCorridorBarrels :: RandomGen g => State g Room
doubleCorridorBarrels = do
@@ -297,13 +261,11 @@ doubleCorridorBarrels = do
let cond x = (sndV2 . fst) x < h - 40
return $ restrictInLinks cond $ roomRect 100 h 1 1 & rmPmnts .~
[blockLine (V2 50 50) (V2 50 h)
,sPS (V2 25 (h-25)) 0 $ PutCrit $ addArmour autoCrit
,sPS (V2 75 (h-30)) 0 $ PutCrit explosiveBarrel
,sPS (V2 75 (h-60)) 0 $ PutCrit explosiveBarrel
,sPS (V2 85 (h-10)) 0 $ PutCrit explosiveBarrel
,sPS (V2 85 (h-45)) 0 $ PutCrit explosiveBarrel
,sPS (V2 25 (h-25)) (negate pi/2) $ PutCrit $ addArmour autoCrit
,sPS (V2 75 (h-80)) 0 putLamp
]
] ++
[sPS p 0 $ PutCrit explosiveBarrel
| p <- [ V2 75 (h-30) ,V2 75 (h-60) ,V2 85 (h-10) ,V2 85 (h-45) ] ]
shootersRoom' :: RandomGen g => State g Room
shootersRoom' = do
src/Dodge/Room/RunPast.hs
+10 -25
View File
@@ -1,37 +1,25 @@
module Dodge.Room.RunPast where
module Dodge.Room.RunPast
( lockedStart
) where
import Dodge.UseAll
import Geometry.Polygon
import Dodge.LevelGen.Data
import Dodge.LightSource
--import Dodge.RoomLink
import Dodge.Data
--import Dodge.Default
--import Dodge.Layout.Tree.Either
import RandomHelp
import Dodge.Room.Door
--import Dodge.Room.Room
import Dodge.Room.Link
import Dodge.Room.Procedural
import Dodge.Room.Corridor
--import Dodge.Room.Foreground
--import Dodge.Room.RoadBlock
import Dodge.PlacementSpot
import Dodge.Placement.Instance
import Dodge.Tree
import Dodge.Item.Random
--import Dodge.Item.Weapon.SprayGuns
--import Dodge.Item.Weapon.Grenade
--import Dodge.LevelGen.Data
import Geometry.Data
--import Padding
import Color
import LensHelp
import qualified Data.Set as S
--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
@@ -43,27 +31,24 @@ roomCritLS = do
smallRoom :: Room
smallRoom = corridorWallN & rmRandPSs .~ [psRandRanges (15,25) (30,45) (pi,2*pi)]
lookedStart :: RandomGen g => Int -> State g (Tree Room)
lookedStart i = do
lockedStart :: RandomGen g => Int -> State g (Tree Room)
lockedStart i = do
h <- state $ randomR (200,400::Float)
thels <- roomCritLS
theweapon <- randBlockBreakWeapon
cenroom <- shuffleLinks
$ roomRectAutoLinks 40 h & rmPmnts .~ [plRRpt 0 (PutFlIt theweapon)]
cenroom <- shuffleLinks $ roomRectAutoLinks 40 h & rmPmnts .~ []
theedge <- takeOne $ map OnEdge [West,East]
let linkcor = smallRoom & rmPmnts .~ [ spanLS thels (V2 0 65) (V2 40 65) ]
critroom = linkcor & rmPmnts .:~ plRRpt 0 randC1
switchdoor = triggerDoorRoom i
n = length $ filter (elem theedge . _rlType) (_rmLinks cenroom)
doorrooms = map (treePost . (switchdoor:))
$ [critroom]
doorrooms = map (treePost . (triggerDoorRoom i:))
$ [linkcor & rmPmnts .:~ plRRpt 0 randC1]
: [linkcor,corridor,corridor,cleatOnward door]
: replicate (n-2) [linkcor]
return $ Node cenroom $
map (over root $ rmConnectsTo .~ S.member theedge) doorrooms
++ [return corridorWallN
++ [return smallRoom
{_rmOutPmnt = [OutPlacement (putLitButOnPosExtTrig red useUnusedLnk) i]
,_rmPmnts = []
,_rmPmnts = [plRRpt 0 (PutFlIt theweapon)]
,_rmBound = [rectNSWE 70 30 0 40]
}
]
src/Dodge/Room/Start.hs
+1 -1
View File
@@ -71,7 +71,7 @@ randomChallenges = shootingRange
runPastStart :: RandomGen g => Int -> State g (Tree Room)
runPastStart i = do
s <- rezBoxStart
rp <- lookedStart i
rp <- lockedStart i
return . shiftChildren $ attachTree toOnward rp $ fmap ([],) s