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

Add support for group placements

Browse Source
This commit is contained in:
justin
2021-05-14 19:46:52 +02:00
parent 0b26761be5
commit 2b09bf2072
18 changed files with 307 additions and 266 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature.hs
+1 -1
View File
@@ -279,7 +279,7 @@ startInventory = IM.fromList (zip [0..20]
,lasGun ,lasGun
,autoGun ,autoGun
--,poisonSprayer --,poisonSprayer
--,launcher ,launcher
--,lasGun --,lasGun
--,grenade --,grenade
--,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher --,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher
src/Dodge/Floor.hs
+2 -1
View File
@@ -30,6 +30,7 @@ import Dodge.SoundLogic
import Dodge.RandomHelp import Dodge.RandomHelp
import Dodge.LightSources import Dodge.LightSources
import Dodge.LevelGen.Data import Dodge.LevelGen.Data
import Dodge.LevelGen.SwarmPlacement
import Dodge.Item.Weapon import Dodge.Item.Weapon
import Data.Tree import Data.Tree
@@ -50,7 +51,7 @@ roomTreex = do
[[StartRoom] [[StartRoom]
,[Corridor] ,[Corridor]
,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400
& rmPS %~ (PS (0,200) 0 (PutCrit spreadGunCrit) :) & rmPS %~ ([swarmPS 0 (x,y) 0 smallChaseCrit | x <- [-20,-19.5.. 20] , y <- [200,200.5..202] ]++)
] ]
,[Corridor] ,[Corridor]
,[Corridor] ,[Corridor]
src/Dodge/LevelGen.hs
+62 -48
View File
@@ -37,56 +37,66 @@ import qualified Data.Set as S
import qualified Data.Map as M import qualified Data.Map as M
placeSpots :: [PlacementSpot] -> World -> World placeSpots :: [Placement] -> World -> World
placeSpots pss w = foldr placeSpot w pss placeSpots pss w = foldr placeSpot w' $ map _placementSpot singlePlacements
where
(singlePlacements, groupedPlacements) = partition isSPS pss
isSPS (SinglePlacement {}) = True
isSPS _ = False
gplmnts = groupBy ((==) `on` _groupPlacementID) $ sortOn _groupPlacementID groupedPlacements
w' = foldr updateGroup w gplmnts
{- | OK, this is perhaps slightly impenetrable.
- The idea is that for a list of collected group placements, we first update
- the world for each placement and update the placements into PSTypes.
- This is the mapAccumR step.
- After this, for each placement we apply the group placement function to
- the psType using a zipWith, and taking all the pstypes as a paramenter,
- then successively update the world using a foldr. -}
updateGroup :: [Placement] -> World -> World
updateGroup ps w =
let (w', psTypes) = mapAccumR updateSpot w $ map _placementSpot ps
fs = zipWith (\gp pst -> _groupPlacementFunc gp psTypes pst) ps psTypes
in foldr ($) w' fs
updateSpot :: World -> PlacementSpot -> (World, PSType)
updateSpot w ps = case _psType ps of
PutButton bt -> undefined
PutCrit cr -> placeUpdateCr cr p rot w
where
p = _psPos ps
rot = _psRot ps
placeSpot :: PlacementSpot -> World -> World placeSpot :: PlacementSpot -> World -> World
placeSpot ps w = case ps of placeSpot ps w = case _psType ps of
PS {_psPos = p, _psRot = rot, _psType = PutButton bt} PutButton bt -> placeBt bt p rot w
-> placeBt bt p rot w PutFlIt itm -> placeFlIt itm p rot w
PS {_psPos = p, _psRot = rot, _psType = PutFlIt itm} PutCrit cr -> placeCr cr p rot w
-> placeFlIt itm p rot w PutLS ls dec -> placeLS ls dec p rot w
PS {_psPos = p, _psRot = rot, _psType = PutCrit cr} PutPressPlate pp -> placePressPlate pp p rot w
-> placeCr cr p rot w RandPS rgen -> placeSpot (set psType evaluatedType ps) (set randGen g w)
PS {_psPos = p, _psRot = rot, _psType = PutLS ls dec}
-> placeLS ls dec p rot w
PS {_psPos = p, _psRot = rot, _psType = PutPressPlate pp}
-> placePressPlate pp p rot w
PS {_psType = RandPS rgen}
-> placeSpot (set psType evaluatedType ps) (set randGen g w)
where where
(evaluatedType, g) = runState rgen (_randGen w) (evaluatedType, g) = runState rgen (_randGen w)
PutDoor col f pss -> putDoor col f (map (mapBoth $ shiftPointBy (p,rot)) pss) w
PS {_psPos = p, _psRot = rot, _psType = PutDoor col f pss}
-> putDoor col f (map (mapBoth $ shiftPointBy (p,rot)) pss) w
where where
mapBoth fn (x,y) = (fn x, fn y) mapBoth fn (x,y) = (fn x, fn y)
PutDoubleDoor col f a b -> putDoubleDoor col f (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
PS {_psPos = p, _psRot = rot, _psType = PutDoubleDoor col f a b} PutAutoDoor a b -> addAutoDoor (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
-> putDoubleDoor col f (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w PutBlock (hp:hps) col ps -> putBlock (map (shiftPointBy (p,rot)) ps) hp col False hps w
PutBtDoor c bp f a b -> addButtonDoor c (shiftPointBy (p,rot) bp) (f + rot)
PS {_psPos = p, _psRot = rot, _psType = PutAutoDoor a b}
-> addAutoDoor (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
PS {_psPos = p, _psRot = rot, _psType = PutBlock (hp:hps) col ps}
-> putBlock (map (shiftPointBy (p,rot)) ps) hp col False hps w
PS {_psPos = p, _psRot = rot, _psType = PutBtDoor c bp f a b}
-> addButtonDoor c (shiftPointBy (p,rot) bp) (f + rot)
(shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
PS {_psPos = p, _psRot = rot, _psType = PutSwitchDoor c bp f a b} PutSwitchDoor c bp f a b -> addSwitchDoor c (shiftPointBy (p,rot) bp) (f + rot)
-> addSwitchDoor c (shiftPointBy (p,rot) bp) (f + rot)
(shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
PutLineBlock wl width depth a b
PS {_psPos = p, _psRot = rot, _psType = PutLineBlock wl width depth a b}
-> putLineBlock wl width depth (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w -> putLineBlock wl width depth (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
PutWall { _pwPoly = ps, _pwWall = wl } -> rmCrossPaths $ over walls (addWalls (q:qs) wl) w
PS {_psPos = p, _psRot = rot, _psType = PutWall { _pwPoly = ps, _pwWall = wl }} where
-> rmCrossPaths $ over walls (addWalls (q:qs) wl) w (q:qs) = map (shiftPointBy (p,rot)) ps
where (q:qs) = map (shiftPointBy (p,rot)) ps
rmCrossPaths w = foldr (uncurry removePathsCrossing) w $ zip (q:qs) (qs++[q]) rmCrossPaths w = foldr (uncurry removePathsCrossing) w $ zip (q:qs) (qs++[q])
_ -> w _ -> w
where
p = _psPos ps
rot = _psRot ps
-- TODO: remove this typeclass -- TODO: remove this typeclass
class Shiftable a where class Shiftable a where
@@ -109,7 +119,6 @@ instance Shiftable PlacementSpot where
translateS p' (PS p r x) = PS (p +.+ p') r x translateS p' (PS p r x) = PS (p +.+ p') r x
rotateS r' (PS p r x) = PS (rotateV r' p) (r + r') x rotateS r' (PS p r x) = PS (rotateV r' p) (r + r') x
shiftPointBy (pos,rot) p = pos +.+ rotateV rot p shiftPointBy (pos,rot) p = pos +.+ rotateV rot p
addWalls :: [Point2] -> Wall -> IM.IntMap Wall -> IM.IntMap Wall addWalls :: [Point2] -> Wall -> IM.IntMap Wall -> IM.IntMap Wall
@@ -117,6 +126,7 @@ addWalls qs wl wls = foldr (addPane wl) wls pairs
where where
(p:ps) = orderPolygon qs (p:ps) = orderPolygon qs
pairs = zip (ps ++ [p]) (p:ps) pairs = zip (ps ++ [p]) (p:ps)
addPane :: Wall -> (Point2,Point2) -> IM.IntMap Wall -> IM.IntMap Wall addPane :: Wall -> (Point2,Point2) -> IM.IntMap Wall -> IM.IntMap Wall
addPane wl (p0,p1) wls = IM.insert (newKey wls) (wl addPane wl (p0,p1) wls = IM.insert (newKey wls) (wl
{ _wlLine = (p0,p1) { _wlLine = (p0,p1)
@@ -124,15 +134,11 @@ addPane wl (p0,p1) wls = IM.insert (newKey wls) (wl
}) })
wls wls
placeBt bt p rot w = over buttons addBT w placeBt bt p rot w = over buttons addBT w
where where
addBT bts = IM.insert (newKey bts) (bt {_btPos = p, _btRot = rot, _btID = newKey bts}) bts addBT bts = IM.insert (newKey bts) (bt {_btPos = p, _btRot = rot, _btID = newKey bts}) bts
{- Creates a floor item at a given point.
{- Assigns an id correctly. -}
Creates a floor item at a given point.
Assigns an id correctly.
-}
placeFlIt placeFlIt
:: Item :: Item
-> Point2 -- ^ Position -> Point2 -- ^ Position
@@ -150,11 +156,19 @@ placeFlIt itm p rot = floorItems %~
) fis ) fis
placePressPlate pp p rot w = over pressPlates addPP w placePressPlate pp p rot w = over pressPlates addPP w
where addPP pps = IM.insert (newKey pps) (pp {_ppPos = p,_ppRot = rot}) pps where
addPP pps = IM.insert (newKey pps) (pp {_ppPos = p,_ppRot = rot}) pps
placeUpdateCr :: Creature -> Point2 -> Float -> World -> (World, PSType)
placeUpdateCr scr p rot w = (w & creatures %~ IM.insert cid cr, PutCrit cr)
where
cid = newKey (_creatures w)
cr = scr {_crPos = p,_crOldPos = p,_crDir = rot,_crID = cid}
placeCr :: Creature -> Point2 -> Float -> World -> World placeCr :: Creature -> Point2 -> Float -> World -> World
placeCr crF p rot w = over creatures addCr w placeCr crF p rot w = over creatures addCr w
where addCr crs = IM.insert (newKey crs) where
addCr crs = IM.insert (newKey crs)
(crF {_crPos = p,_crOldPos = p,_crDir = rot,_crID = newKey crs}) (crF {_crPos = p,_crOldPos = p,_crDir = rot,_crID = newKey crs})
crs crs
src/Dodge/LevelGen/Data.hs
+4 -2
View File
@@ -9,7 +9,7 @@ import Control.Lens
import Control.Monad.State import Control.Monad.State
import System.Random import System.Random
data PSType = PutCrit Creature data PSType = PutCrit {_unPutCrit :: Creature}
| PutLS LightSource Picture | PutLS LightSource Picture
| PutButton Button | PutButton Button
| PutFlIt Item | PutFlIt Item
@@ -34,10 +34,12 @@ data Placement
= SinglePlacement {_placementSpot :: PlacementSpot } = SinglePlacement {_placementSpot :: PlacementSpot }
| GroupedPlacement | GroupedPlacement
{_groupPlacementID :: Int {_groupPlacementID :: Int
,_groupPlacementFunc :: [PlacementSpot] -> PlacementSpot -> PlacementSpot ,_groupPlacementFunc :: [PSType] -> PSType -> World -> World
,_placementSpot :: PlacementSpot ,_placementSpot :: PlacementSpot
} }
sPS p a = SinglePlacement . PS p a
makeLenses ''PSType makeLenses ''PSType
makeLenses ''PlacementSpot makeLenses ''PlacementSpot
makeLenses ''Placement makeLenses ''Placement
src/Dodge/LevelGen/SwarmPlacement.hs
+25
View File
@@ -0,0 +1,25 @@
module Dodge.LevelGen.SwarmPlacement
( swarmPS
)
where
import Dodge.Data
import Dodge.LevelGen.Data
import Dodge.Creature.State.Data
import qualified Data.Set as S
import Control.Lens
swarmPS :: Int -> Point2 -> Float -> Creature -> Placement
swarmPS i p a cr = GroupedPlacement
{ _groupPlacementID = i
, _groupPlacementFunc = setSwarm
, _placementSpot = PS p a $ PutCrit cr
}
setSwarm :: [PSType] -> PSType -> World -> World
setSwarm psts (PutCrit cr) w
= w & creatures . ix cid . crGroup .~ theSwarm
where
cid = _crID cr
theSwarm = Swarm swarmSet
swarmSet = S.fromList $ map (_crID . _unPutCrit) psts
src/Dodge/Room.hs
+89 -89
View File
@@ -77,9 +77,9 @@ roomPadCut ps p = Room
roomPillars :: Room roomPillars :: Room
roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2 roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2
where where
plmnts = PS (120,120) 0 putLamp plmnts = sPS (120,120) 0 putLamp
: PS (12,12) 0 putLamp : sPS (12,12) 0 putLamp
: PS (228,228) 0 putLamp : sPS (228,228) 0 putLamp
: g 180 150 90 60 : g 180 150 90 60
f a x b y = putBlockRect a x b y f a x b y = putBlockRect a x b y
g a b c d = f a b a b ++ f a b c d ++ f c d a b ++ f c d c d g a b c d = f a b a b ++ f a b c d ++ f c d a b ++ f c d c d
@@ -103,7 +103,7 @@ glassSwitchBack = do
,blockLine (wth-wllen, 2*hf) ( wth,2*hf) ,blockLine (wth-wllen, 2*hf) ( wth,2*hf)
,blockLine ( 0, 3*hf) (wllen,3*hf) ,blockLine ( 0, 3*hf) (wllen,3*hf)
,blockLine (wth-wllen, 4*hf) ( wth,4*hf) ,blockLine (wth-wllen, 4*hf) ( wth,4*hf)
, PS (wth/2,hgt/2) 0 $ putLamp , sPS (wth/2,hgt/2) 0 $ putLamp
] ]
return $ set rmPS plmnts $ roomRect wth hgt 2 6 return $ set rmPS plmnts $ roomRect wth hgt 2 6
@@ -119,14 +119,14 @@ glassLesson = do
$ roomRect 200 200 1 1 $ roomRect 200 200 1 1
topRoom = set rmPS topplmnts topRoom = set rmPS topplmnts
$ roomRect 200 200 1 1 $ roomRect 200 200 1 1
botplmnts = [PS (0,0) 0 $ PutWall (rectNSWE (200) 0 (90) (110)) botplmnts = [sPS (0,0) 0 $ PutWall (rectNSWE (200) 0 (90) (110))
$ defaultCrystalWall $ defaultCrystalWall
,PS (50,100) 0 $ PutCrit miniGunCrit ,sPS (50,100) 0 $ PutCrit miniGunCrit
,PS (50,50) 0 putLamp ,sPS (50,50) 0 putLamp
] ]
topplmnts = [windowLine (100,200) (100,0) topplmnts = [windowLine (100,200) (100,0)
,PS (50,100) 0 $ PutCrit miniGunCrit ,sPS (50,100) 0 $ PutCrit miniGunCrit
,PS (50,50) 0 putLamp ,sPS (50,50) 0 putLamp
] ]
miniRoom1 :: RandomGen g => State g Room miniRoom1 :: RandomGen g => State g Room
@@ -144,9 +144,9 @@ miniRoom1 = do
,windowLine (wth-wllen,40+2*hf) (60,40+2*hf) ,windowLine (wth-wllen,40+2*hf) (60,40+2*hf)
,windowLine (wth-60, 40+3*hf) (wllen,40+3*hf) ,windowLine (wth-60, 40+3*hf) (wllen,40+3*hf)
,windowLine (wth-wllen,40+4*hf) (60,40+4*hf) ,windowLine (wth-wllen,40+4*hf) (60,40+4*hf)
,PS (crx,cry) 0 $ PutCrit miniGunCrit ,sPS (crx,cry) 0 $ PutCrit miniGunCrit
,PS (wth-20,hgt/2+40) 0 $ randC ,sPS (wth-20,hgt/2+40) 0 $ randC
,PS (wth/2,hgt/2) 0 putLamp ,sPS (wth/2,hgt/2) 0 putLamp
,blockLine ( 0, 40+1*hf) (wllen,40+1*hf) ,blockLine ( 0, 40+1*hf) (wllen,40+1*hf)
,blockLine (wth-wllen, 40+2*hf) ( wth,40+2*hf) ,blockLine (wth-wllen, 40+2*hf) ( wth,40+2*hf)
,blockLine ( 0, 40+3*hf) (wllen,40+3*hf) ,blockLine ( 0, 40+3*hf) (wllen,40+3*hf)
@@ -169,24 +169,24 @@ miniRoom3 = do
,( 10,-80) ,( 10,-80)
,(-10,-80) ,(-10,-80)
] ]
let plmnts = [PS cp 0 $ PutCrit miniGunCrit let plmnts = [sPS cp 0 $ PutCrit miniGunCrit
,PS cp 0 $ windowLineType (0,-40) (0,-80) ,sPS cp 0 $ windowLineType (0,-40) (0,-80)
,PS cp (1*pi/4) $ windowLineType (0,-40) (0,-80) ,sPS cp (1*pi/4) $ windowLineType (0,-40) (0,-80)
,PS cp (2*pi/4) $ windowLineType (0,-40) (0,-80) ,sPS cp (2*pi/4) $ windowLineType (0,-40) (0,-80)
,PS cp (3*pi/4) $ windowLineType (0,-40) (0,-80) ,sPS cp (3*pi/4) $ windowLineType (0,-40) (0,-80)
,PS cp (4*pi/4) $ windowLineType (0,-40) (0,-80) ,sPS cp (4*pi/4) $ windowLineType (0,-40) (0,-80)
,PS cp (5*pi/4) $ windowLineType (0,-40) (0,-80) ,sPS cp (5*pi/4) $ windowLineType (0,-40) (0,-80)
,PS cp (6*pi/4) $ windowLineType (0,-40) (0,-80) ,sPS cp (6*pi/4) $ windowLineType (0,-40) (0,-80)
,PS cp (7*pi/4) $ windowLineType (0,-40) (0,-80) ,sPS cp (7*pi/4) $ windowLineType (0,-40) (0,-80)
,PS cp (pi/8) b ,sPS cp (pi/8) b
,PS cp (pi/8+1*pi/4) b ,sPS cp (pi/8+1*pi/4) b
,PS cp (pi/8+2*pi/4) b ,sPS cp (pi/8+2*pi/4) b
,PS cp (pi/8+3*pi/4) b ,sPS cp (pi/8+3*pi/4) b
,PS cp (pi/8+4*pi/4) b ,sPS cp (pi/8+4*pi/4) b
,PS cp (pi/8+5*pi/4) b ,sPS cp (pi/8+5*pi/4) b
,PS cp (pi/8+6*pi/4) b ,sPS cp (pi/8+6*pi/4) b
,PS cp (pi/8+7*pi/4) b ,sPS cp (pi/8+7*pi/4) b
,PS (w/2,h/2) 0 putLamp ,sPS (w/2,h/2) 0 putLamp
] ]
fmap connectRoom $ randomiseOutLinks $ set rmPS plmnts $ roomRectAutoLinks w h fmap connectRoom $ randomiseOutLinks $ set rmPS plmnts $ roomRectAutoLinks w h
@@ -215,8 +215,8 @@ roomCenterPillar = changeLinkTo ((\p -> dist p (120,0) < 10) . fst)
plmnts = plmnts =
[ blockLine (115,115) (115,125) [ blockLine (115,115) (115,125)
, blockLine (125,115) (125,125) , blockLine (125,115) (125,125)
, PS (40,120) 0 putLamp , sPS (40,120) 0 putLamp
, PS (200,120) 0 putLamp , sPS (200,120) 0 putLamp
] ]
roomOctogon :: Room roomOctogon :: Room
@@ -264,10 +264,10 @@ weaponEmptyRoom :: RandomGen g => State g (Tree (Either Room Room))
weaponEmptyRoom = do weaponEmptyRoom = do
w <- state $ randomR (220,300) w <- state $ randomR (220,300)
h <- state $ randomR (220,300) h <- state $ randomR (220,300)
let plmnts = [PS (w/2,h-40) 0 $ RandPS randFirstWeapon let plmnts = [sPS (w/2,h-40) 0 $ RandPS randFirstWeapon
,PS (20,20) (pi/2) $ randC1 ,sPS (20,20) (pi/2) $ randC1
,PS (w-20,20) (pi/2) $ randC1 ,sPS (w-20,20) (pi/2) $ randC1
,PS (w/2,h/2) 0 $ putLamp ,sPS (w/2,h/2) 0 $ putLamp
] ]
(fmap connectRoom . randomiseOutLinks) =<< (changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst) (fmap connectRoom . randomiseOutLinks) =<< (changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst)
$ set rmPS plmnts $ roomRect w h 2 2) $ set rmPS plmnts $ roomRect w h 2 2)
@@ -275,14 +275,14 @@ weaponEmptyRoom = do
weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room)) weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room))
weaponUnderCrits = do weaponUnderCrits = do
let plmnts = let plmnts =
[PS (20,0) 0 $ RandPS randFirstWeapon [sPS (20,0) 0 $ RandPS randFirstWeapon
,PS (20,0) (0-pi/2) $ randC1 ,sPS (20,0) (0-pi/2) $ randC1
,PS (20,20) (0-pi/2) $ randC1 ,sPS (20,20) (0-pi/2) $ randC1
] ]
let continuationRoom = treeFromTrunk [Left corridorN,Left corridorN] let continuationRoom = treeFromTrunk [Left corridorN,Left corridorN]
(connectRoom (set rmPS plmnts $ corridorN)) (connectRoom (set rmPS plmnts $ corridorN))
rcp' <- roomCenterPillar rcp' <- roomCenterPillar
let rcp = over rmPS ( PS (120,80) 0 putLamp : ) rcp' let rcp = over rmPS ( sPS (120,80) 0 putLamp : ) rcp'
deadEndRoom <- takeOne [roomPillars,rcp] deadEndRoom <- takeOne [roomPillars,rcp]
junctionRoom <- takeOne [Left tEast,Left tWest] junctionRoom <- takeOne [Left tEast,Left tWest]
return $ treeFromTrunk [Left corridorN,Left corridorN] return $ treeFromTrunk [Left corridorN,Left corridorN]
@@ -295,13 +295,13 @@ weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room))
weaponBehindPillar = do weaponBehindPillar = do
crPos <- takeOne $ [(x,y) | x <- [20,220], y <- [20,220]] ++ [(120,160),(120,200)] crPos <- takeOne $ [(x,y) | x <- [20,220], y <- [20,220]] ++ [(120,160),(120,200)]
let d p = argV $ (120,80) -.- p let d p = argV $ (120,80) -.- p
let plmnts1 = [PS (120,160) 0 $ RandPS randFirstWeapon let plmnts1 = [sPS (120,160) 0 $ RandPS randFirstWeapon
,PS crPos (d crPos) $ randC1 ,sPS crPos (d crPos) $ randC1
] ]
rcp <- roomCenterPillar rcp <- roomCenterPillar
return $ treeFromTrunk [Left door return $ treeFromTrunk [Left door
,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp] ,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp]
(connectRoom $ set rmPS [PS (20,60) (0-pi/2) $ randC1] (connectRoom $ set rmPS [sPS (20,60) (0-pi/2) $ randC1]
$ corridorN) $ corridorN)
weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room)) weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room))
@@ -312,9 +312,9 @@ weaponBetweenPillars = do
crPos2 = ps !! 1 crPos2 = ps !! 1
d p = argV $ (120,120) -.- p d p = argV $ (120,120) -.- p
plmnts = plmnts =
[PS wpPos 0 $ RandPS randFirstWeapon [sPS wpPos 0 $ RandPS randFirstWeapon
,PS crPos1 (d crPos1) $ randC1 ,sPS crPos1 (d crPos1) $ randC1
,PS crPos2 (d crPos2) $ randC1 ,sPS crPos2 (d crPos2) $ randC1
] ]
(fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars) (fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars)
where where
@@ -324,23 +324,23 @@ weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
weaponLongCorridor = do weaponLongCorridor = do
root <- takeOne $ [tEast, tWest] root <- takeOne $ [tEast, tWest]
connectingRoom <- takeOne connectingRoom <- takeOne
[tEast & rmPS .~ [PS (-40,60) 0 $ putLamp] [tEast & rmPS .~ [sPS (-40,60) 0 $ putLamp]
,tWest & rmPS .~ [PS ( 40,60) 0 $ putLamp] ,tWest & rmPS .~ [sPS ( 40,60) 0 $ putLamp]
] ]
i1 <- state $ randomR (2,5) i1 <- state $ randomR (2,5)
i2 <- state $ randomR (2,5) i2 <- state $ randomR (2,5)
let branch1 = treeFromTrunk (replicate i1 $ Left corridorN) (connectRoom $ putCrs connectingRoom) let branch1 = treeFromTrunk (replicate i1 $ Left corridorN) (connectRoom $ putCrs connectingRoom)
let branch2 = treeFromTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor) let branch2 = treeFromTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor)
return $ Node (Left root) [branch1,branch2] return $ Node (Left root) [branch1,branch2]
where putCrs = over rmPS (++ [PS (10,40) (-pi/2) $ randC where putCrs = over rmPS (++ [sPS (10,40) (-pi/2) $ randC
,PS (-10,40) (-pi/2) $ randC ,sPS (-10,40) (-pi/2) $ randC
]) ])
putWp = set rmPS [PS (20,40) 0 $ RandPS randFirstWeapon putWp = set rmPS [sPS (20,40) 0 $ RandPS randFirstWeapon
,PS (20,60) 0 $ putLamp ,sPS (20,60) 0 $ putLamp
] ]
critInDeadEnd :: Room critInDeadEnd :: Room
critInDeadEnd = set rmPS [PS (0,0) 0 $ randC] deadEndRoom critInDeadEnd = set rmPS [sPS (0,0) 0 $ randC] deadEndRoom
deadEndRoom :: Room deadEndRoom :: Room
deadEndRoom = Room deadEndRoom = Room
@@ -348,7 +348,7 @@ deadEndRoom = Room
] ]
, _rmLinks = lnks , _rmLinks = lnks
, _rmPath = [] , _rmPath = []
, _rmPS = [PS (0,-10) 0 putLamp] , _rmPS = [sPS (0,-10) 0 putLamp]
, _rmBound = [rectNSWE 20 (-20) (-30) 30] , _rmBound = [rectNSWE 20 (-20) (-30) 30]
} }
where where
@@ -366,9 +366,9 @@ weaponRoom = join $ takeOne
roomCCrits :: RandomGen g => State g (Tree (Either Room Room)) roomCCrits :: RandomGen g => State g (Tree (Either Room Room))
roomCCrits = do roomCCrits = do
ps <- sequence $ replicate 20 $ randInCirc 9 ps <- sequence $ replicate 20 $ randInCirc 9
let plmnts = map (\p -> PS p 0 $ randC) let plmnts = map (\p -> sPS p 0 $ randC)
$ zipWith (+.+) [(x,y) | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps $ zipWith (+.+) [(x,y) | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps
lamps = [PS (50,100) 0 putLamp , PS (175,100) 0 putLamp] lamps = [sPS (50,100) 0 putLamp , sPS (175,100) 0 putLamp]
return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200 return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200
@@ -377,25 +377,25 @@ longRoom = do
h <- state $ randomR (1500,1500) h <- state $ randomR (1500,1500)
let w = 75 let w = 75
let cond x = (snd . fst) x < h - 40 let cond x = (snd . fst) x < h - 40
let ws = map (\ps -> PS (0,0) 0 $ PutWall ps defaultCrystalWall) let ws = map (\ps -> sPS (0,0) 0 $ PutWall ps defaultCrystalWall)
[rectNSWE (h-35) (h-135) (-10) 10 [rectNSWE (h-35) (h-135) (-10) 10
,rectNSWE (h-35) (h-135) 15 35 ,rectNSWE (h-35) (h-135) 15 35
,rectNSWE (h-35) (h-135) 40 60 ,rectNSWE (h-35) (h-135) 40 60
,rectNSWE (h-35) (h-135) 65 85 ,rectNSWE (h-35) (h-135) 65 85
] ]
let wsDefense = map (\ps -> PS (0,0) 0 $ PutWall ps defaultCrystalWall) let wsDefense = map (\ps -> sPS (0,0) 0 $ PutWall ps defaultCrystalWall)
[rectNSWE (95) (70) 0 25 [rectNSWE (95) (70) 0 25
,rectNSWE (95) (70) 50 75 ,rectNSWE (95) (70) 50 75
] ]
brls <- fmap (map (\p -> PS (p +.+ (10,200)) 0 $ PutCrit explosiveBarrel) ) brls <- fmap (map (\p -> sPS (p +.+ (10,200)) 0 $ PutCrit explosiveBarrel) )
$ sequence $ replicate 5 $ randInRect (w-20) 900 $ sequence $ replicate 5 $ randInRect (w-20) 900
let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++) let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++)
changeLinkTo cond $ set rmPS (ws ++ brls ++ wsDefense ++ changeLinkTo cond $ set rmPS (ws ++ brls ++ wsDefense ++
[PS ( 12.5,h-25) 0 $ PutCrit longCrit [sPS ( 12.5,h-25) 0 $ PutCrit longCrit
,PS ( 37.5,h-25) 0 $ PutCrit longCrit ,sPS ( 37.5,h-25) 0 $ PutCrit longCrit
,PS ( 62.5,h-25) 0 $ PutCrit longCrit ,sPS ( 62.5,h-25) 0 $ PutCrit longCrit
,PS ( 25, 20) 0 $ putLamp ,sPS ( 25, 20) 0 $ putLamp
,PS ( 25, h-10) 0 $ putLamp ,sPS ( 25, h-10) 0 $ putLamp
] ]
) )
$ rm $ rm
@@ -406,12 +406,12 @@ shooterRoom = do
h <- state $ randomR (200,300) h <- state $ randomR (200,300)
let cond x = (snd . fst) x < h - 40 let cond x = (snd . fst) x < h - 40
changeLinkTo cond $ set rmPS ( [blockLine (50,50) (50,h) changeLinkTo cond $ set rmPS ( [blockLine (50,50) (50,h)
,PS ( 25,h-25) 0 $ PutCrit $ addArmour autoCrit ,sPS ( 25,h-25) 0 $ PutCrit $ addArmour autoCrit
,PS ( 75,h-30) 0 $ PutCrit explosiveBarrel ,sPS ( 75,h-30) 0 $ PutCrit explosiveBarrel
,PS ( 75,h-60) 0 $ PutCrit explosiveBarrel ,sPS ( 75,h-60) 0 $ PutCrit explosiveBarrel
,PS ( 85,h-10) 0 $ PutCrit explosiveBarrel ,sPS ( 85,h-10) 0 $ PutCrit explosiveBarrel
,PS ( 85,h-45) 0 $ PutCrit explosiveBarrel ,sPS ( 85,h-45) 0 $ PutCrit explosiveBarrel
,PS ( 75,h-80) 0 putLamp ,sPS ( 75,h-80) 0 putLamp
] ]
) )
$ roomRect 100 h 1 1 $ roomRect 100 h 1 1
@@ -432,8 +432,8 @@ shootersRoom1 = do
let bln x y = putBlockN (x+25) (x-25) (y+10) y 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 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 let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
++ [PS p (-pi/2) $ PutCrit autoCrit ++ [sPS p (-pi/2) $ PutCrit autoCrit
,PS (w/2,200) 0 putLamp ,sPS (w/2,200) 0 putLamp
] ]
return $ set rmPS plmnts $ roomRectAutoLinks w 600 return $ set rmPS plmnts $ roomRectAutoLinks w 600
@@ -451,10 +451,10 @@ shootersRoom = do
let bln x y = putBlockN (x+25) (x-25) (y+10) y 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 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 let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
++ [PS (x1,y1-10) (-pi/2) $ PutCrit autoCrit ++ [sPS (x1,y1-10) (-pi/2) $ PutCrit autoCrit
,PS (x2,y2-10) (-pi/2) $ PutCrit autoCrit ,sPS (x2,y2-10) (-pi/2) $ PutCrit autoCrit
,PS (x3,y3-10) (-pi/2) $ PutCrit autoCrit ,sPS (x3,y3-10) (-pi/2) $ PutCrit autoCrit
,PS (w/2,200) 0 putLamp ,sPS (w/2,200) 0 putLamp
] ]
return $ set rmPS plmnts $ roomRectAutoLinks w 600 return $ set rmPS plmnts $ roomRectAutoLinks w 600
@@ -480,16 +480,16 @@ pistolerRoom = do
aa <- state $ randomR (0,2*pi) aa <- state $ randomR (0,2*pi)
ab <- state $ randomR (0,2*pi) ab <- state $ randomR (0,2*pi)
ac <- state $ randomR (0,2*pi) ac <- state $ randomR (0,2*pi)
let plmnts = [PS (ps !! 0) aa $ PutCrit pistolCrit let plmnts = [sPS (ps !! 0) aa $ PutCrit pistolCrit
,PS (ps !! 1) ab $ PutCrit pistolCrit ,sPS (ps !! 1) ab $ PutCrit pistolCrit
,PS (ps !! 2) ac $ PutCrit pistolCrit ,sPS (ps !! 2) ac $ PutCrit pistolCrit
,PS (w/2,h-50) 0 putLamp ,sPS (w/2,h-50) 0 putLamp
,PS (w/2,50) 0 putLamp ,sPS (w/2,50) 0 putLamp
,PS (w-5,h-5) 0 putLamp ,sPS (w-5,h-5) 0 putLamp
,PS (5,h-5) 0 putLamp ,sPS (5,h-5) 0 putLamp
,PS (w-5,5) 0 putLamp ,sPS (w-5,5) 0 putLamp
,PS (5,5) 0 putLamp ,sPS (5,5) 0 putLamp
,PS (w/2,h/2) 0 putLamp ,sPS (w/2,h/2) 0 putLamp
] ]
++ ++
concat [f x y | x<-xs,y<-ys] concat [f x y | x<-xs,y<-ys]
@@ -515,13 +515,13 @@ spawnerRoom :: RandomGen g => State g (Tree (Either Room Room))
spawnerRoom = do spawnerRoom = do
x <- state $ randomR (250,300) x <- state $ randomR (250,300)
y <- state $ randomR (300,400) y <- state $ randomR (300,400)
wl <- takeOne [PS (0,0) 0 $ PutWall (rectNSWE (y-60) 0 (x/2-10) (x/2+10)) wl <- takeOne [sPS (0,0) 0 $ PutWall (rectNSWE (y-60) 0 (x/2-10) (x/2+10))
defaultCrystalWall defaultCrystalWall
,windowLine (x/2,0) (x/2,y-60) ,windowLine (x/2,0) (x/2,y-60)
] ]
let plmnts = [PS (x/4, y/4) (pi/2) $ PutCrit spawnerCrit let plmnts = [sPS (x/4, y/4) (pi/2) $ PutCrit spawnerCrit
,wl ,wl
,PS (x/2, y-10) 0 putLamp ,sPS (x/2, y-10) 0 putLamp
] ]
let f ((lx,_),_) = lx < x/2-5 let f ((lx,_),_) = lx < x/2-5
roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (set rmPS plmnts $ roomRect x y 2 2) roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (set rmPS plmnts $ roomRect x y 2 2)
src/Dodge/Room/Airlock.hs
+14 -14
View File
@@ -22,9 +22,9 @@ airlockOneWay n = Room
{ _rmPolys = [rectNSWE 90 0 0 40] { _rmPolys = [rectNSWE 90 0 0 40]
, _rmLinks = lnks , _rmLinks = lnks
, _rmPath = [] , _rmPath = []
, _rmPS = [PS (0,15) 0 $ PutDoubleDoor col (not . cond) (0,0) (0,40) , _rmPS = [sPS (0,15) 0 $ PutDoubleDoor col (not . cond) (0,0) (0,40)
,PS (0,75) 0 $ PutDoubleDoor col cond (0,0) (0,40) ,sPS (0,75) 0 $ PutDoubleDoor col cond (0,0) (0,40)
,PS (35,45) (pi/2) $ PutButton $ makeButton col (over worldState ,sPS (35,45) (pi/2) $ PutButton $ makeButton col (over worldState
(M.insert (DoorNumOpen n) True)) (M.insert (DoorNumOpen n) True))
] ]
--, _rmBound = rectNSWE 90 30 (-30) 30 --, _rmBound = rectNSWE 90 30 (-30) 30
@@ -59,12 +59,12 @@ airlock0 n = Room
,((20,45),(20, 5)) ,((20,45),(20, 5))
] ]
, _rmPS = , _rmPS =
[PS (0,20) 0 $ PutDoubleDoor col (not . cond) (1,0) (39,0) [sPS (0,20) 0 $ PutDoubleDoor col (not . cond) (1,0) (39,0)
,PS (0,80) 0 $ PutDoubleDoor col cond (1,0) (39,0) ,sPS (0,80) 0 $ PutDoubleDoor col cond (1,0) (39,0)
,PS (35,50) (pi/2) $ PutButton $ makeSwitch col ,sPS (35,50) (pi/2) $ PutButton $ makeSwitch col
(over worldState (M.insert (DoorNumOpen n) True)) (over worldState (M.insert (DoorNumOpen n) True))
(over worldState (M.insert (DoorNumOpen n) False)) (over worldState (M.insert (DoorNumOpen n) False))
,PS (-25, 50) 0 putLamp ,sPS (-25, 50) 0 putLamp
] ]
, _rmBound = [rectNSWE 75 15 0 40] , _rmBound = [rectNSWE 75 15 0 40]
} }
@@ -98,11 +98,11 @@ airlock90 n = Room
,((40,0),(0,40)) ,((40,0),(0,40))
] ]
, _rmPS = , _rmPS =
[PS (5,5) 0 $ PutDoor col (not . cond) pss [sPS (5,5) 0 $ PutDoor col (not . cond) pss
,PS (120,120) (3* pi/4) $ PutButton $ makeSwitch col ,sPS (120,120) (3* pi/4) $ PutButton $ makeSwitch col
(over worldState (M.insert (DoorNumOpen n) True)) (over worldState (M.insert (DoorNumOpen n) True))
(over worldState (M.insert (DoorNumOpen n) False)) (over worldState (M.insert (DoorNumOpen n) False))
,PS (60, 60) 0 putLamp ,sPS (60, 60) 0 putLamp
] ]
, _rmBound = , _rmBound =
[[ (10,10) [[ (10,10)
@@ -138,13 +138,13 @@ airlockCrystal n = Room
[ [
] ]
, _rmPS = , _rmPS =
[PS (0,0) 0 $ PutDoor col (not . cond) pss [sPS (0,0) 0 $ PutDoor col (not . cond) pss
,PS (145,70) (pi/2) $ PutButton $ makeSwitch col ,sPS (145,70) (pi/2) $ PutButton $ makeSwitch col
(over worldState (M.insert (DoorNumOpen n) True)) (over worldState (M.insert (DoorNumOpen n) True))
(over worldState (M.insert (DoorNumOpen n) False)) (over worldState (M.insert (DoorNumOpen n) False))
,crystalLine (0,70) (40,70) ,crystalLine (0,70) (40,70)
,PS (20, 40) 0 putLamp ,sPS (20, 40) 0 putLamp
,PS (20, 100) 0 putLamp ,sPS (20, 100) 0 putLamp
] ]
, _rmBound = , _rmBound =
[ ] [ ]
src/Dodge/Room/Boss.hs
+12 -12
View File
@@ -34,10 +34,10 @@ roomGlassOctogon x = Room
, _rmPath = [((0,x),(0,-(x+40))) , _rmPath = [((0,x),(0,-(x+40)))
,((0,-(x+40)),(0,x))] ,((0,-(x+40)),(0,x))]
, _rmPS = , _rmPS =
[PS (fx,fx) 0 putLamp [sPS (fx,fx) 0 putLamp
,PS (-fx,fx) 0 putLamp ,sPS (-fx,fx) 0 putLamp
,PS (fx,-fx) 0 putLamp ,sPS (fx,-fx) 0 putLamp
,PS (-fx,-fx) 0 putLamp ,sPS (-fx,-fx) 0 putLamp
,crystalLine (-x,x/2) (negate (x/2), x) ,crystalLine (-x,x/2) (negate (x/2), x)
,crystalLine (x,x/2) (x/2, x) ,crystalLine (x,x/2) (x/2, x)
,crystalLine (x/2,-x) (x,negate (x/2)) ,crystalLine (x/2,-x) (x,negate (x/2))
@@ -50,13 +50,13 @@ roomGlassOctogon x = Room
fx = 4 * x / 5 fx = 4 * x / 5
bossRoom :: RandomGen g => Creature -> State g Room bossRoom :: RandomGen g => Creature -> State g Room
bossRoom cr = randomMediumRoom <&> rmPS %~ ( PS (0,100) (negate $ pi/2) (PutCrit cr) :) bossRoom cr = randomMediumRoom <&> rmPS %~ ( sPS (0,100) (negate $ pi/2) (PutCrit cr) :)
armouredChasers :: RandomGen g => State g (Tree Room) armouredChasers :: RandomGen g => State g (Tree Room)
armouredChasers = do armouredChasers = do
ps <- takeN 5 [(x,y) | x <- [-100,-80 .. 100] ,y <- [-100,-80 .. 100] ] ps <- takeN 5 [(x,y) | x <- [-100,-80 .. 100] ,y <- [-100,-80 .. 100] ]
as <- replicateM 5 . state $ randomR (0,2*pi) as <- replicateM 5 . state $ randomR (0,2*pi)
let theCrits = zipWith3 (\p a c -> PS p a (PutCrit c)) ps as cs let theCrits = zipWith3 (\p a c -> sPS p a (PutCrit c)) ps as cs
treeFromPost [corridor,corridor] <$> (randomMediumRoom <&> rmPS %~ (++ theCrits)) treeFromPost [corridor,corridor] <$> (randomMediumRoom <&> rmPS %~ (++ theCrits))
where where
cs = (armourChaseCrit & crState . crDropsOnDeath .~ DropSpecific [0]) cs = (armourChaseCrit & crState . crDropsOnDeath .~ DropSpecific [0])
@@ -90,10 +90,10 @@ roomCross x y = Room
] ]
, _rmPath = [] , _rmPath = []
, _rmPS = , _rmPS =
[PS ( x, 0) 0 putLamp [sPS ( x, 0) 0 putLamp
,PS (-x, 0) 0 putLamp ,sPS (-x, 0) 0 putLamp
,PS ( 0, x) 0 putLamp ,sPS ( 0, x) 0 putLamp
,PS ( 0,-x) 0 putLamp ,sPS ( 0,-x) 0 putLamp
] ]
, _rmBound = , _rmBound =
[rectNSWE y (-y) (-x) x [rectNSWE y (-y) (-x) x
@@ -116,7 +116,7 @@ roomShuriken x y =
{ _rmPolys = ps { _rmPolys = ps
, _rmLinks = [((x-1,y-20),negate $ pi/2)] , _rmLinks = [((x-1,y-20),negate $ pi/2)]
, _rmPath = [] , _rmPath = []
, _rmPS = [PS (x/2,x/2) 0 putLamp] , _rmPS = [sPS (x/2,x/2) 0 putLamp]
, _rmBound = ps , _rmBound = ps
} }
in foldr1 combineRooms $ map (\r -> shiftRoomBy ((0,0), r) corner) [0,pi/2,pi,3*pi/2] in foldr1 combineRooms $ map (\r -> shiftRoomBy ((0,0), r) corner) [0,pi/2,pi,3*pi/2]
@@ -140,7 +140,7 @@ roomTwistCross x y z =
{ _rmPolys = ps { _rmPolys = ps
, _rmLinks = [((z,y-20), pi/2)] , _rmLinks = [((z,y-20), pi/2)]
, _rmPath = [] , _rmPath = []
, _rmPS = [PS (x/2,x/2) 0 putLamp] , _rmPS = [sPS (x/2,x/2) 0 putLamp]
, _rmBound = ps , _rmBound = ps
} }
in foldr1 combineRooms $ map (\r -> shiftRoomBy ((0,0), r) corner) [0,pi/2,pi,3*pi/2] in foldr1 combineRooms $ map (\r -> shiftRoomBy ((0,0), r) corner) [0,pi/2,pi,3*pi/2]
src/Dodge/Room/Data.hs
+1 -1
View File
@@ -20,7 +20,7 @@ data Room = Room
{ _rmPolys :: [ [Point2] ] { _rmPolys :: [ [Point2] ]
, _rmLinks :: [(Point2,Float)] , _rmLinks :: [(Point2,Float)]
, _rmPath :: [(Point2, Point2)] , _rmPath :: [(Point2, Point2)]
, _rmPS :: [PlacementSpot] , _rmPS :: [Placement]
, _rmBound :: [ [Point2] ] , _rmBound :: [ [Point2] ]
} }
makeLenses ''Room makeLenses ''Room
src/Dodge/Room/Door.hs
+1 -1
View File
@@ -16,7 +16,7 @@ door = Room
, _rmLinks = lnks , _rmLinks = lnks
, _rmPath = [((20,35),(20,5))] , _rmPath = [((20,35),(20,5))]
-- door extends into side walls (for shadows as rendered 12/03) -- door extends into side walls (for shadows as rendered 12/03)
, _rmPS = [PS (0,20) 0 $ PutAutoDoor (0,0) (40,0)] , _rmPS = [sPS (0,20) 0 $ PutAutoDoor (0,0) (40,0)]
, _rmBound = [] , _rmBound = []
} }
where lnks = [((20,35),0) where lnks = [((20,35),0)
src/Dodge/Room/Link.hs
+8 -4
View File
@@ -73,9 +73,13 @@ shiftRoomBy shift@(pos,rot) r =
r r
shiftLinkBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot) shiftLinkBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot)
shiftPSBy (pos,rot) ps = case ps of shiftPSBy (pos,rot) ps = ps
PS {} -> over psPos (shiftPointBy (pos,rot)) & placementSpot . psPos %~ shiftPointBy (pos,rot)
$ over psRot (+rot) & placementSpot . psRot %~ (+ rot)
ps
--shiftPSBy (pos,rot) ps = case ps of
-- PS {} -> over psPos (shiftPointBy (pos,rot))
-- $ over psRot (+rot)
-- ps
shiftPathPointBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2) shiftPathPointBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2)
src/Dodge/Room/LongDoor.hs
+11 -11
View File
@@ -38,12 +38,12 @@ twinSlowDoorRoom drID w h x = Room
] ]
, _rmPath = [] , _rmPath = []
, _rmPS = , _rmPS =
[ PS (0,h/2) 0 putLamp [ sPS (0,h/2) 0 putLamp
, PS (25,5) 0 putLamp , sPS (25,5) 0 putLamp
, PS (negate 25,5) 0 putLamp , sPS (negate 25,5) 0 putLamp
, PS (0,0) 0 $ PutDoor col (not . cond) drL , sPS (0,0) 0 $ PutDoor col (not . cond) drL
, PS (0,0) 0 $ PutDoor col (not . cond) drR , sPS (0,0) 0 $ PutDoor col (not . cond) drR
, PS (0,h-5) pi $ PutButton $ makeButton col , sPS (0,h-5) pi $ PutButton $ makeButton col
(over worldState (M.insert (DoorNumOpen drID) True)) (over worldState (M.insert (DoorNumOpen drID) True))
] ]
, _rmBound = ps , _rmBound = ps
@@ -69,7 +69,7 @@ twinSlowDoorChasers drid = do
let lps = (-65 ,) <$> [20,40 .. 180] let lps = (-65 ,) <$> [20,40 .. 180]
rps = (65 ,) <$> [20,40 .. 180] rps = (65 ,) <$> [20,40 .. 180]
ps <- takeN 4 $ lps ++ rps ps <- takeN 4 $ lps ++ rps
let plmnts = map (\p -> PS p 0 $ PutCrit chaseCrit) ps let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps
return $ twinSlowDoorRoom drid 80 200 40 & rmPS %~ (plmnts ++) return $ twinSlowDoorRoom drid 80 200 40 & rmPS %~ (plmnts ++)
slowDoorRoom :: RandomGen g => State g (Tree (Either Room Room)) slowDoorRoom :: RandomGen g => State g (Tree (Either Room Room))
@@ -88,9 +88,9 @@ slowDoorRoom = do
let ps = zip xs ys let ps = zip xs ys
xs' <- replicateM 5 $ state $ randomR (10,x-10) xs' <- replicateM 5 $ state $ randomR (10,x-10)
ys' <- replicateM 5 $ state $ randomR (h+20,y) ys' <- replicateM 5 $ state $ randomR (h+20,y)
let crits = zipWith (\p r -> PS p r randC1) ps rs let crits = zipWith (\p r -> sPS p r randC1) ps rs
lsources = [PS (x/2,30) 0 putLamp, PS (x/2,y-30) 0 putLamp] lsources = [sPS (x/2,30) 0 putLamp, sPS (x/2,y-30) 0 putLamp]
barrels = zipWith (\x y -> PS (x,y) 0 $ PutCrit explosiveBarrel) xs' ys' barrels = zipWith (\x y -> sPS (x,y) 0 $ PutCrit explosiveBarrel) xs' ys'
pillarsa = [] pillarsa = []
pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20) pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20)
++ putBlockRect (2*x/5-20) (2*x/5+20) (h/2-20) (h/2+20) ++ putBlockRect (2*x/5-20) (2*x/5+20) (h/2-20) (h/2+20)
@@ -107,7 +107,7 @@ slowDoorRoom = do
fmap connectRoom fmap connectRoom
(filterLinks cond =<< (filterLinks cond =<<
changeLinkTo cond2 changeLinkTo cond2
(set rmPS ([PS (0,0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources) (set rmPS ([sPS (0,0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources)
$ roomRectAutoLinks x y $ roomRectAutoLinks x y
) )
) )
src/Dodge/Room/NoNeedWeapon.hs
+5 -5
View File
@@ -29,11 +29,11 @@ centerVaultExplosiveExit
centerVaultExplosiveExit drID = do centerVaultExplosiveExit drID = do
cr <- takeOne [miniGunCrit, autoCrit] cr <- takeOne [miniGunCrit, autoCrit]
let extraPS = let extraPS =
[PS (0,175) 0 $ PutCrit explosiveBarrel [sPS (0,175) 0 $ PutCrit explosiveBarrel
,PS (5,195) 0 $ PutCrit explosiveBarrel ,sPS (5,195) 0 $ PutCrit explosiveBarrel
,PS (0,200) 0 $ PutCrit explosiveBarrel ,sPS (0,200) 0 $ PutCrit explosiveBarrel
,PS (-4,195) 0 $ PutCrit explosiveBarrel ,sPS (-4,195) 0 $ PutCrit explosiveBarrel
,PS (0,0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll) ,sPS (0,0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll)
] ]
r <- centerVaultRoom drID 200 200 50 <&> rmPS %~ (extraPS ++) r <- centerVaultRoom drID 200 200 50 <&> rmPS %~ (extraPS ++)
randomiseLinksBy shuffleTail r <&> rmLinks %~ take 2 randomiseLinksBy shuffleTail r <&> rmLinks %~ take 2
src/Dodge/Room/Placement.hs
+12 -12
View File
@@ -15,15 +15,15 @@ import Control.Lens
putLamp = PutCrit lamp putLamp = PutCrit lamp
singleBlock :: Point2 -> [PlacementSpot] singleBlock :: Point2 -> [Placement]
singleBlock a = [PS a 0 $ PutBlock [5,20,20] (greyN 0.5) singleBlock a = [sPS a 0 $ PutBlock [5,20,20] (greyN 0.5)
$ reverse $ rectNSWE 10 (-10) (-10) 10] $ reverse $ rectNSWE 10 (-10) (-10) 10]
{- {-
Places a line of blocks between two points. Places a line of blocks between two points.
Width 9, also extends out from each point by 9. Width 9, also extends out from each point by 9.
-} -}
blockLine :: Point2 -> Point2 -> PlacementSpot blockLine :: Point2 -> Point2 -> Placement
blockLine a b = PS blockLine a b = SinglePlacement $ PS
{ _psPos = (0,0) { _psPos = (0,0)
, _psRot = 0 , _psRot = 0
, _psType = PutLineBlock baseBlockPane 9 9 a b , _psType = PutLineBlock baseBlockPane 9 9 a b
@@ -33,8 +33,8 @@ blockLine a b = PS
Places an breakable window between two points. Places an breakable window between two points.
Width 8, also extends out from each point by 8. Width 8, also extends out from each point by 8.
-} -}
windowLine :: Point2 -> Point2 -> PlacementSpot windowLine :: Point2 -> Point2 -> Placement
windowLine a b = PS windowLine a b = SinglePlacement $ PS
{ _psPos = (0,0) { _psPos = (0,0)
, _psRot = 0 , _psRot = 0
, _psType = PutLineBlock baseWindowPane 8 8 a b , _psType = PutLineBlock baseWindowPane 8 8 a b
@@ -44,8 +44,8 @@ windowLine a b = PS
Places an unbreakable window between two points. Places an unbreakable window between two points.
Width 7, also extends out from each point by 7. Width 7, also extends out from each point by 7.
-} -}
crystalLine :: Point2 -> Point2 -> PlacementSpot crystalLine :: Point2 -> Point2 -> Placement
crystalLine a b = PS crystalLine a b = SinglePlacement $ PS
{ _psPos = (0,0) { _psPos = (0,0)
, _psRot = 0 , _psRot = 0
, _psType = PutWall ps defaultCrystalWall , _psType = PutWall ps defaultCrystalWall
@@ -62,8 +62,8 @@ crystalLine a b = PS
{- Places an unbreakable wall between two points. {- Places an unbreakable wall between two points.
Depth 15, does not extend wider than points. Depth 15, does not extend wider than points.
-} -}
wallLine :: Point2 -> Point2 -> PlacementSpot wallLine :: Point2 -> Point2 -> Placement
wallLine a b = PS wallLine a b = SinglePlacement $ PS
{ _psPos = (0,0) { _psPos = (0,0)
, _psRot = 0 , _psRot = 0
, _psType = PutWall ps defaultWall , _psType = PutWall ps defaultWall
@@ -114,7 +114,7 @@ replacePutID
-> Room -> Room
-> Room -> Room
replacePutID i psts r = replacePutID i psts r =
r & rmPS %~ flip (subZipWith (isPutID i) (\ps pt -> ps & psType .~ pt)) psts r & rmPS %~ flip (subZipWith (isPutID i) (\ps pt -> ps & placementSpot . psType .~ pt)) psts
{- Partition a list by a predicate, apply a zip to those elements {- Partition a list by a predicate, apply a zip to those elements
that satisfy the predicate, concatenate that satisfy the predicate, concatenate
the new zipped list and the other (unchanged) half. -} the new zipped list and the other (unchanged) half. -}
@@ -128,7 +128,7 @@ subZipWith f g xs ys =
let (zs,ws) = partition f xs let (zs,ws) = partition f xs
in zipWith g zs ys ++ ws in zipWith g zs ys ++ ws
isPutID i ps = Just i == ps ^? psType . putID isPutID i ps = Just i == ps ^? placementSpot . psType . putID
putBlockRect a x b y = [ blockLine (a,b) (a,y) putBlockRect a x b y = [ blockLine (a,b) (a,y)
, blockLine (a,y) (x,y) , blockLine (a,y) (x,y)
src/Dodge/Room/Procedural.hs
+33 -33
View File
@@ -43,7 +43,7 @@ roomRect x y xn yn = Room
{ _rmPolys = [rectNSWE y 0 0 x ] { _rmPolys = [rectNSWE y 0 0 x ]
, _rmLinks = lnks , _rmLinks = lnks
, _rmPath = concatMap doublePair pth , _rmPath = concatMap doublePair pth
, _rmPS = [PS (x/2,y/2) 0 putLamp] , _rmPS = [sPS (x/2,y/2) 0 putLamp]
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)] , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
} }
where where
@@ -103,7 +103,7 @@ fourth w = Room
, _rmLinks = [((0,w), 0)] , _rmLinks = [((0,w), 0)]
, _rmPath = [((0,w),(0,0)),((0,0),(0,w))] , _rmPath = [((0,w),(0,0)),((0,0),(0,w))]
, _rmPS = , _rmPS =
[PS (0,w/2) 0 putLamp [sPS (0,w/2) 0 putLamp
] ]
, _rmBound = [[(0,0),(w,w),(-w,w)]] , _rmBound = [[(0,0),(w,w),(-w,w)]]
} }
@@ -112,19 +112,19 @@ Add a light and a 'PutNothing' placement. -}
fourthWall :: RandomGen g => Float -> State g Room fourthWall :: RandomGen g => Float -> State g Room
fourthWall w = do fourthWall w = do
b <- takeOne b <- takeOne
[ [ PS (20-w,w-40) 0 putLamp [ [ sPS (20-w,w-40) 0 putLamp
, PS (0,40) 0 putLamp , sPS (0,40) 0 putLamp
, PS (w-20,w-20) pi PutNothing , sPS (w-20,w-20) pi PutNothing
, blockLine (w/2,w/2) (w/2,w) , blockLine (w/2,w/2) (w/2,w)
] ]
, [ PS (20-w,w-40) 0 putLamp , [ sPS (20-w,w-40) 0 putLamp
, PS (0,40) 0 putLamp , sPS (0,40) 0 putLamp
, PS (w-20,w-20) pi PutNothing , sPS (w-20,w-20) pi PutNothing
, blockLine (w/2,w/2) (negate $ w/2,w/2) , blockLine (w/2,w/2) (negate $ w/2,w/2)
] ]
, [ PS (20-w,w-40) 0 putLamp , [ sPS (20-w,w-40) 0 putLamp
, PS (0,20) 0 putLamp , sPS (0,20) 0 putLamp
, PS (w-20,w-20) pi PutNothing , sPS (w-20,w-20) pi PutNothing
, blockLine (w/2,w/2) (0,w/2) , blockLine (w/2,w/2) (0,w/2)
, blockLine (-29,w) (0,w/2) , blockLine (-29,w) (0,w/2)
] ]
@@ -145,32 +145,32 @@ fourthCorner w = Room
,((negate $ w/2,3*w/2), pi/4) ,((negate $ w/2,3*w/2), pi/4)
] ]
, _rmPath = [((0,w),(0,0)),((0,0),(0,w))] , _rmPath = [((0,w),(0,0)),((0,0),(0,w))]
, _rmPS = [PS (0,w) 0 putLamp] , _rmPS = [sPS (0,w) 0 putLamp]
, _rmBound = [[(w,w),(0,2*w),(-w,w)]] , _rmBound = [[(w,w),(0,2*w),(-w,w)]]
} }
fourthCornerWall :: RandomGen g => Float -> State g Room fourthCornerWall :: RandomGen g => Float -> State g Room
fourthCornerWall w = do fourthCornerWall w = do
b <- takeOne b <- takeOne
[ [ PS (10-w,w) 0 putLamp [ [ sPS (10-w,w) 0 putLamp
, PS (w-10,w) 0 putLamp , sPS (w-10,w) 0 putLamp
, PS (0,10) 0 putLamp , sPS (0,10) 0 putLamp
, PS (0,2*w-20) pi PutNothing , sPS (0,2*w-20) pi PutNothing
, blockLine (w/2,w/2) (0,w) , blockLine (w/2,w/2) (0,w)
, blockLine (negate $ w/2,w/2) (0,w) , blockLine (negate $ w/2,w/2) (0,w)
] ]
, [ PS (0,3*w/2) 0 putLamp , [ sPS (0,3*w/2) 0 putLamp
, PS (w-10,w) 0 putLamp , sPS (w-10,w) 0 putLamp
, PS (10-w,w-20) 0 putLamp , sPS (10-w,w-20) 0 putLamp
, PS (0,10) 0 putLamp , sPS (0,10) 0 putLamp
, PS (0,2*w-20) pi PutNothing , sPS (0,2*w-20) pi PutNothing
, blockLine (w/2,w/2) (0,w) , blockLine (w/2,w/2) (0,w)
, blockLine (negate w,w) (0,w) , blockLine (negate w,w) (0,w)
] ]
, [ PS (10-w,w) 0 putLamp , [ sPS (10-w,w) 0 putLamp
, PS (w-10,w) 0 putLamp , sPS (w-10,w) 0 putLamp
, PS (0,10) 0 putLamp , sPS (0,10) 0 putLamp
, PS (20,2*w-40) pi PutNothing , sPS (20,2*w-40) pi PutNothing
, blockLine (w/2,w/2) (0,w) , blockLine (w/2,w/2) (0,w)
, blockLine (0,w) (0,w*2) , blockLine (0,w) (0,w*2)
] ]
@@ -190,7 +190,7 @@ fillNothingPlacement :: PSType -> Room -> Room
fillNothingPlacement pst r = fillNothingPlacement pst r =
r & rmPS %~ replaceNothingWith pst r & rmPS %~ replaceNothingWith pst
where where
replaceNothingWith x (PS p rot PutNothing: pss) = PS p rot x : pss replaceNothingWith x (SinglePlacement (PS p rot PutNothing): pss) = sPS p rot x : pss
replaceNothingWith x (ps:pss) = ps : replaceNothingWith x pss replaceNothingWith x (ps:pss) = ps : replaceNothingWith x pss
replaceNothingWith _ [] = [] replaceNothingWith _ [] = []
{- | Successively fill 'PutNothing' placements with a list of given 'PSType's. {- | Successively fill 'PutNothing' placements with a list of given 'PSType's.
@@ -243,11 +243,11 @@ centerVaultRoom n w h d = do
] ]
, _rmPath = [] , _rmPath = []
, _rmPS = , _rmPS =
[PS (d-25,d-25) 0 putLamp [sPS (d-25,d-25) 0 putLamp
,PS (w-5,h-5) 0 putLamp ,sPS (w-5,h-5) 0 putLamp
,PS (w-5,5-h) 0 putLamp ,sPS (w-5,5-h) 0 putLamp
,PS (5-w,h-5) 0 putLamp ,sPS (5-w,h-5) 0 putLamp
,PS (5-w,5-h) 0 putLamp ,sPS (5-w,5-h) 0 putLamp
] ]
++ concat (zipWith (\i r -> map (shiftPSBy ((0,0),r)) $ theDoor i) ++ concat (zipWith (\i r -> map (shiftPSBy ((0,0),r)) $ theDoor i)
[n, n+1, n+2, n+3] [0,pi/2,pi,3*pi/2]) [n, n+1, n+2, n+3] [0,pi/2,pi,3*pi/2])
@@ -256,8 +256,8 @@ centerVaultRoom n w h d = do
where where
col = dim $ dim $ bright red col = dim $ dim $ bright red
theDoor i = theDoor i =
[ PS (0,d-10) 0 $ PutDoubleDoor col (cond i) (-19,0) (19,0) [ sPS (0,d-10) 0 $ PutDoubleDoor col (cond i) (-19,0) (19,0)
, PS (35,d+4) 0 $ PutButton $ makeSwitch col , sPS (35,d+4) 0 $ PutButton $ makeSwitch col
(over worldState (M.insert (DoorNumOpen i) True)) (over worldState (M.insert (DoorNumOpen i) True))
(over worldState (M.insert (DoorNumOpen i) False)) (over worldState (M.insert (DoorNumOpen i) False))
] ]
src/Dodge/Room/RoadBlock.hs
+8 -8
View File
@@ -40,12 +40,12 @@ litCorridor90 = do
,((40,h-40),(20,h-40)) ,((40,h-40),(20,h-40))
] ]
, _rmPS = , _rmPS =
[ PS (20,h-5) 0 putLamp [ sPS (20,h-5) 0 putLamp
, windowLine (0,h-20) (40,h-20) , windowLine (0,h-20) (40,h-20)
, PS (-50,h-85) 0 putLamp , sPS (-50,h-85) 0 putLamp
, windowLine (-40,h-60) (-40,h-100) , windowLine (-40,h-60) (-40,h-100)
, PS ( 20,h-40) 0 $ PutID 0 , sPS ( 20,h-40) 0 $ PutID 0
, PS (-20,h-80) 0 $ PutID 2 , sPS (-20,h-80) 0 $ PutID 2
] ]
, _rmBound = [poly] , _rmBound = [poly]
} }
@@ -59,9 +59,9 @@ longBlockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
longBlockedCorridor = do longBlockedCorridor = do
r <- state $ randomR (0,pi) r <- state $ randomR (0,pi)
n <- state $ randomR (0,3) n <- state $ randomR (0,3)
let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256) let plmnts = [sPS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256)
$ reverse $ rectNSWE 10 (-10) (-10) 10 $ reverse $ rectNSWE 10 (-10) (-10) 10
,PS (20,15) 0 putLamp ,sPS (20,15) 0 putLamp
] ]
sequence $ treeFromPost (replicate n $ Left <$> randomiseOutLinks corridor) sequence $ treeFromPost (replicate n $ Left <$> randomiseOutLinks corridor)
$ return $ Right $ set rmPS plmnts corridor $ return $ Right $ set rmPS plmnts corridor
@@ -70,8 +70,8 @@ longBlockedCorridor = do
blockedCorridor :: RandomGen g => State g (Tree (Either Room Room)) blockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
blockedCorridor = do blockedCorridor = do
r <- state $ randomR (0,pi) r <- state $ randomR (0,pi)
let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256) let plmnts = [sPS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256)
$ reverse $ rectNSWE 10 (-10) (-10) 10 $ reverse $ rectNSWE 10 (-10) (-10) 10
,PS (20,15) 0 putLamp ,sPS (20,15) 0 putLamp
] ]
sequence $ treeFromPost [] $ return $ Right $ set rmPS plmnts corridor sequence $ treeFromPost [] $ return $ Right $ set rmPS plmnts corridor
src/Dodge/Room/Teleport.hs
+2 -2
View File
@@ -28,8 +28,8 @@ telRoomLev i = do
w <- state $ randomR (200,300) w <- state $ randomR (200,300)
h <- state $ randomR (200,300) h <- state $ randomR (200,300)
return $ roomRectAutoLinks w h & rmPS .~ return $ roomRectAutoLinks w h & rmPS .~
[ PS (w/2,h/2) 0 $ PutPressPlate telPP [ sPS (w/2,h/2) 0 $ PutPressPlate telPP
, PS (w/2,h/2+ 30) 0 putLamp , sPS (w/2,h/2+ 30) 0 putLamp
] ]
where where
telPP = PressPlate telPP = PressPlate
src/Dodge/Room/Treasure.hs
+11 -16
View File
@@ -1,4 +1,4 @@
{- {- |
Rooms that contain valuable items, typically protected in some manner. Rooms that contain valuable items, typically protected in some manner.
Typically dead ends. Typically dead ends.
-} -}
@@ -14,12 +14,9 @@ import Data.List
import Control.Monad.State import Control.Monad.State
import Control.Lens import Control.Lens
import System.Random import System.Random
{- | A triangular room with loot at the top (with 'PutID' 2),
{-
A triangular room with loot at the top (with 'PutID' 2),
creatures in the bottom two corners (with 'PutID' 0), creatures in the bottom two corners (with 'PutID' 0),
and (single) entrance bottom middle. and (single) entrance bottom middle. -}
-}
triLootRoom triLootRoom
:: Float -- Width :: Float -- Width
-> Float -- Height -> Float -- Height
@@ -31,13 +28,13 @@ triLootRoom w h = pure $ Room
, _rmLinks = [((0,-80),pi)] , _rmLinks = [((0,-80),pi)]
, _rmPath = doublePair ((0,-80),(0,h/2)) , _rmPath = doublePair ((0,-80),(0,h/2))
, _rmPS = , _rmPS =
[PS (15-w,15) 0 $ PutID 0 [sPS (15-w, 15) 0 $ PutID 0
,PS (w-15,15) pi $ PutID 0 ,sPS (w-15, 15) pi $ PutID 0
,PS (0,h-35) 0 $ PutID 2 ,sPS ( 0,h-35) 0 $ PutID 2
,PS (-5,h-10) 0 putLamp ,sPS ( -5,h-10) 0 putLamp
,PS (5,h-10) 0 putLamp ,sPS ( 5,h-10) 0 putLamp
,PS (0,h-15) 0 putLamp ,sPS ( 0,h-15) 0 putLamp
,PS (0,-60) 0 putLamp ,sPS ( 0, -60) 0 putLamp
] ]
, _rmBound = [tri , base] , _rmBound = [tri , base]
} }
@@ -51,9 +48,7 @@ triLootRoom w h = pure $ Room
, (-20, h) , (-20, h)
] ]
base = rectNSWE 20 (-80) (-20) 20 base = rectNSWE 20 (-80) (-20) 20
{- | Create a random room with one entrance containing given creatures and items. -}
{- Create a random room with one entrance containing given creatures and items.
-}
lootRoom :: RandomGen g => [Creature] -> [Item] -> State g Room lootRoom :: RandomGen g => [Creature] -> [Item] -> State g Room
lootRoom crs itms = do lootRoom crs itms = do
let w = 300 let w = 300