Add lights to buttons, cleanup
This commit is contained in:
@@ -2,12 +2,10 @@
|
||||
{- Rooms that contain two doors and a switch alternating both. -}
|
||||
module Dodge.Room.Airlock where
|
||||
import Dodge.Room.Data
|
||||
import Dodge.LightSources.Fitting
|
||||
import Dodge.Room.Placement
|
||||
import Dodge.Placements
|
||||
import Dodge.Room.Foreground
|
||||
import Dodge.Default.Room
|
||||
import Dodge.Data
|
||||
import Dodge.Placements
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.LevelGen.Switch
|
||||
import Dodge.RandomHelp
|
||||
@@ -30,7 +28,7 @@ airlock0 = defaultRoom
|
||||
[Placement (PS (V2 (-35) 50) (negate $ pi/2) $ PutButton $ makeSwitch col red id id)
|
||||
$ \btid -> Just $ putDoubleDoorThen False col (not . cond' btid) (V2 (-1) 20) (V2 41 20) 2
|
||||
$ Just $ putDoubleDoorThen False col (cond' btid) (V2 (-1) 80) (V2 41 80) 2 Nothing
|
||||
,mountedLightI 70 (V2 (-2) 30) (V2 (-2) 70)
|
||||
,mountLightI 70 (V2 (-2) 30) (V2 (-2) 70)
|
||||
,sps0 $ PutForeground $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
|
||||
]
|
||||
, _rmBound = [rectNSWE 75 15 0 40]
|
||||
@@ -65,7 +63,7 @@ airlock90 = defaultRoom
|
||||
, _rmPS =
|
||||
[ Placement (PS (V2 120 120) (3 * pi/4) (PutButton $ makeSwitch col red id id))
|
||||
$ \btid -> jsps (V2 5 5) 0 $ PutDoor col (cond btid) pss
|
||||
,mountedLightV (V2 20 20) (V3 70 70 50)
|
||||
,mountLightV (V2 20 20) (V3 70 70 50)
|
||||
]
|
||||
, _rmBound =
|
||||
[map toV2 [ (10,10)
|
||||
@@ -94,7 +92,7 @@ airlockCrystal = defaultRoom
|
||||
[ Placement (PS (V2 145 70) (pi/2) (PutButton $ makeSwitch col red id id))
|
||||
$ \btid -> jsps0 $ PutDoor col (cond btid) pss
|
||||
, crystalLine (V2 0 70) (V2 40 70)
|
||||
, mountedLightV (V2 150 70) (V3 110 70 70)
|
||||
, mountLightV (V2 150 70) (V3 110 70 70)
|
||||
]
|
||||
, _rmBound =
|
||||
[ ]
|
||||
|
||||
@@ -5,10 +5,9 @@ module Dodge.Room.Boss
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Default.Room
|
||||
import Dodge.LightSources.Fitting
|
||||
import Dodge.Placements
|
||||
import Dodge.Room.Data
|
||||
import Dodge.Room.Procedural
|
||||
import Dodge.Room.Placement
|
||||
import Dodge.Room.Link
|
||||
import Dodge.Room.Corridor
|
||||
import Dodge.Room.Path
|
||||
@@ -98,8 +97,8 @@ roomCross x y = defaultRoom
|
||||
]
|
||||
, _rmPath = []
|
||||
, _rmPS =
|
||||
[ mountedLightI 70 (V2 (x+5) x) (V2 (x+5) (-x))
|
||||
, mountedLightI 70 (V2 (-x-5) x) (V2 (-x-5) (-x))
|
||||
[ mountLightI 70 (V2 (x+5) x) (V2 (x+5) (-x))
|
||||
, mountLightI 70 (V2 (-x-5) x) (V2 (-x-5) (-x))
|
||||
]
|
||||
, _rmBound =
|
||||
[rectNSWE y (-y) (-x) x
|
||||
@@ -122,7 +121,7 @@ roomShuriken x y =
|
||||
{ _rmPolys = ps
|
||||
, _rmLinks = [(V2 (x-1) (y-20),negate $ pi/2)]
|
||||
, _rmPath = []
|
||||
, _rmPS = [mountedLight (V2 x x) (V3 (x-20) x 70)]
|
||||
, _rmPS = [mountLight (V2 x x) (V3 (x-20) x 70)]
|
||||
, _rmBound = ps
|
||||
}
|
||||
in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2]
|
||||
@@ -146,7 +145,7 @@ roomTwistCross x y z =
|
||||
{ _rmPolys = ps
|
||||
, _rmLinks = [(V2 z (y-20), pi/2)]
|
||||
, _rmPath = []
|
||||
, _rmPS = [mountedLight (V2 x x) (V3 (x-20) (x-20) 70)]
|
||||
, _rmPS = [mountLight (V2 x x) (V3 (x-20) (x-20) 70)]
|
||||
, _rmBound = ps
|
||||
}
|
||||
in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2]
|
||||
|
||||
@@ -5,7 +5,7 @@ import Dodge.Room.Data
|
||||
import Dodge.Default.Room
|
||||
--import Dodge.LevelGen.Data
|
||||
--import Dodge.LightSources.Lamp
|
||||
import Dodge.LightSources.Fitting
|
||||
import Dodge.Placements
|
||||
import Geometry
|
||||
import Tile
|
||||
|
||||
@@ -17,7 +17,7 @@ corridor = defaultRoom
|
||||
{ _rmPolys = [poly]
|
||||
, _rmLinks = lnks
|
||||
, _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
|
||||
, _rmPS = [ mountedLightI 50 (V2 0 40) (V2 40 40) ]
|
||||
, _rmPS = [ mountLightI 50 (V2 0 40) (V2 40 40) ]
|
||||
, _rmBound = [ rectNSWE 50 30 0 40 ]
|
||||
, _rmFloor = [makeTileFromPoly poly 2]
|
||||
}
|
||||
|
||||
+56
-45
@@ -6,24 +6,23 @@ module Dodge.Room.LongDoor
|
||||
import Dodge.Data
|
||||
import Dodge.Default.Room
|
||||
import Dodge.Room.Data
|
||||
import Dodge.Room.Placement
|
||||
import Dodge.Placements
|
||||
import Dodge.Room.Link
|
||||
import Dodge.Room.Procedural
|
||||
import Dodge.Layout.Tree.Either
|
||||
--import Dodge.Layout.Tree.Either
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.LevelGen.Switch
|
||||
import Dodge.RandomHelp
|
||||
import Dodge.Creature.Inanimate
|
||||
import Dodge.Creature
|
||||
import Dodge.LightSources.Lamp
|
||||
import Dodge.Placements
|
||||
import Picture
|
||||
import Geometry
|
||||
|
||||
import System.Random
|
||||
import Control.Lens
|
||||
import Control.Monad.State
|
||||
import Data.Tree
|
||||
--import Data.Tree
|
||||
import qualified Data.IntMap as IM
|
||||
|
||||
twinSlowDoorRoom
|
||||
@@ -76,51 +75,63 @@ twinSlowDoorChasers = do
|
||||
let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps
|
||||
return $ twinSlowDoorRoom 80 200 40 & rmPS %~ (plmnts ++)
|
||||
|
||||
slowDoorRoom :: RandomGen g => State g (Tree (Either Room Room))
|
||||
slowDoorRoom = do
|
||||
x <- state $ randomR (400,800)
|
||||
y <- state $ randomR (400,800)
|
||||
h <- state $ randomR (200,min (y-100) 500)
|
||||
(butPos,butRot) <- takeOne
|
||||
[( V2 (x/2-50) 5,0)
|
||||
,( V2 (x/2+50) 5,0)
|
||||
]
|
||||
let n = 25
|
||||
xs <- replicateM n $ state $ randomR (10,x-10)
|
||||
ys <- replicateM n $ state $ randomR (h+20,y)
|
||||
rs <- replicateM n $ state $ randomR (0,2*pi)
|
||||
let ps = zipWith V2 xs ys
|
||||
xs' <- replicateM 5 $ state $ randomR (10,x-10)
|
||||
ys' <- replicateM 5 $ state $ randomR (h+20,y)
|
||||
let crits = zipWith (\p r -> sPS p r randC1) ps rs
|
||||
lsources = [sPS (V2 (x/2) 30) 0 putLamp, sPS (V2 (x/2) (y-30)) 0 putLamp]
|
||||
barrels = zipWith (\x' y' -> sPS (V2 x' y') 0 $ PutCrit explosiveBarrel) xs' ys'
|
||||
pillarsa = []
|
||||
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 (3*x/5-20) (3*x/5+20) (h/2-20) (h/2+20)
|
||||
++ putBlockRect (4*x/5-20) (4*x/5+20) (h/2-20) (h/2+20)
|
||||
pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
|
||||
++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
|
||||
pillars <- takeOne [pillarsa, pillarsb, pillarsc]
|
||||
let cond x' = (sndV2 . fst) x' > h + 40
|
||||
cond2 x' = (sndV2 . fst) x' < h - 40
|
||||
but <- takeOne [butDoor x h butPos butRot
|
||||
]
|
||||
fmap connectRoom
|
||||
(filterLinks cond =<<
|
||||
changeLinkTo cond2
|
||||
(set rmPS ([but] ++ crits ++ pillars ++ barrels ++ lsources)
|
||||
$ roomRectAutoLinks x y
|
||||
)
|
||||
)
|
||||
southPillarsRoom :: RandomGen g => Float -> Float -> Float -> State g Room
|
||||
southPillarsRoom x y h = do
|
||||
let pillarsa = []
|
||||
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 (3*x/5-20) (3*x/5+20) (h/2-20) (h/2+20)
|
||||
++ putBlockRect (4*x/5-20) (4*x/5+20) (h/2-20) (h/2+20)
|
||||
pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
|
||||
++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
|
||||
pillars <- takeOne [pillarsa, pillarsb, pillarsc]
|
||||
return $ roomRectAutoLinks x y & rmPS .~ pillars
|
||||
|
||||
addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room
|
||||
addSouthPillars x h r = do
|
||||
let pillarsa = []
|
||||
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 (3*x/5-20) (3*x/5+20) (h/2-20) (h/2+20)
|
||||
++ putBlockRect (4*x/5-20) (4*x/5+20) (h/2-20) (h/2+20)
|
||||
pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
|
||||
++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
|
||||
pillars <- takeOne [pillarsa, pillarsb, pillarsc]
|
||||
return $ r & rmPS %~ (++ pillars)
|
||||
|
||||
addButtonSlowDoor :: RandomGen g => Float -> Float -> Room -> State g Room
|
||||
addButtonSlowDoor x h rm = do
|
||||
(butPos,butRot) <- takeOne
|
||||
[( V2 (x/2-50) 5,0)
|
||||
,( V2 (x/2+50) 5,0)
|
||||
]
|
||||
thePlacement <- takeOne [butDoor butPos butRot ]
|
||||
filterLinks aboveH =<< changeLinkTo belowH (rm & rmPS %~ (thePlacement :))
|
||||
where
|
||||
butDoor x h bpos brot
|
||||
= ps0 (PutButton $ (makeButton col id) {_btPos = bpos, _btRot = brot})
|
||||
belowH y = (sndV2 . fst) y < h - 40
|
||||
aboveH y = (sndV2 . fst) y > h + 40
|
||||
butDoor bpos brot = putLitButtonID col bpos brot
|
||||
$ \btid -> Just $ putDoubleDoor False col (cond' btid) (V2 0 h) (V2 x h) 2
|
||||
col = dim $ light red
|
||||
cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff
|
||||
--but <- takeOne [PutBtDoor (dim $ light red) butPos butRot (V2 0 h) (V2 x h) 2
|
||||
|
||||
slowDoorRoom :: RandomGen g => State g Room
|
||||
slowDoorRoom = do
|
||||
x <- state $ randomR (400,800)
|
||||
y <- state $ randomR (400,800)
|
||||
h <- state $ randomR (200,min (y-100) 500)
|
||||
let n = 25
|
||||
xs <- replicateM n $ state $ randomR (10,x-10)
|
||||
ys <- replicateM n $ state $ randomR (h+20,y)
|
||||
rs <- replicateM n $ state $ randomR (0,2*pi)
|
||||
let ps = zipWith V2 xs ys
|
||||
xs' <- replicateM 5 $ state $ randomR (10,x-10)
|
||||
ys' <- replicateM 5 $ state $ randomR (h+20,y)
|
||||
let crits = zipWith (\p r -> sPS p r randC1) ps rs
|
||||
lsources = [sPS (V2 (x/2) 30) 0 putLamp, sPS (V2 (x/2) (y-30)) 0 putLamp]
|
||||
barrels = zipWith (\x' y' -> sPS (V2 x' y') 0 $ PutCrit explosiveBarrel) xs' ys'
|
||||
proom <- southPillarsRoom x y h
|
||||
addButtonSlowDoor x h (proom & rmPS %~ (++ (crits ++ barrels ++ lsources)))
|
||||
|
||||
randC1 :: PSType
|
||||
randC1 = RandPS $ takeOne $ map PutCrit $ armourChaseCrit : replicate 50 chaseCrit
|
||||
|
||||
@@ -1,184 +0,0 @@
|
||||
-- | Module defining helper placements for rooms.
|
||||
module Dodge.Room.Placement
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Default.Wall
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.LevelGen.Switch
|
||||
import Dodge.Room.Data
|
||||
import Dodge.Creature.Inanimate
|
||||
import Picture
|
||||
import Geometry
|
||||
|
||||
import Data.List
|
||||
import Control.Lens
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
|
||||
putColorLamp :: Point3 -> PSType
|
||||
putColorLamp col = PutCrit (colorLamp col 90)
|
||||
|
||||
putLamp :: PSType
|
||||
putLamp = PutCrit (lamp 90)
|
||||
|
||||
singleBlock :: Point2 -> [Placement]
|
||||
singleBlock a =
|
||||
[sPS a 0
|
||||
$ PutBlock [5,20,20] (greyN 0.5)
|
||||
$ reverse
|
||||
$ rectNSWE 10 (-10) (-10) 10
|
||||
]
|
||||
{-
|
||||
Places a line of blocks between two points.
|
||||
Width 9, also extends out from each point by 9.
|
||||
-}
|
||||
blockLine :: Point2 -> Point2 -> Placement
|
||||
blockLine a b = Placement PS
|
||||
{ _psPos = V2 0 0
|
||||
, _psRot = 0
|
||||
, _psType = PutLineBlock baseBlockPane 9 9 a b
|
||||
} (const Nothing)
|
||||
|
||||
{-
|
||||
Places an breakable window between two points.
|
||||
Width 8, also extends out from each point by 8.
|
||||
-}
|
||||
windowLine :: Point2 -> Point2 -> Placement
|
||||
windowLine a b = Placement PS
|
||||
{ _psPos = V2 0 0
|
||||
, _psRot = 0
|
||||
, _psType = PutLineBlock baseWindowPane 8 8 a b
|
||||
} (const Nothing)
|
||||
|
||||
{-
|
||||
Places an unbreakable window between two points.
|
||||
Width 7, also extends out from each point by 7.
|
||||
-}
|
||||
crystalLine :: Point2 -> Point2 -> Placement
|
||||
crystalLine a b = Placement PS
|
||||
{ _psPos = V2 0 0
|
||||
, _psRot = 0
|
||||
, _psType = PutWall ps defaultCrystalWall
|
||||
} (const Nothing)
|
||||
where
|
||||
ps =
|
||||
[ a +.+ left +.+ up
|
||||
, (a +.+ left) -.- up
|
||||
, (b -.- left) -.- up
|
||||
, (b -.- left) +.+ up
|
||||
]
|
||||
left = 7 *.* normalizeV (a-.-b)
|
||||
up = vNormal left
|
||||
{- Places an unbreakable wall between two points.
|
||||
Depth 15, does not extend wider than points.
|
||||
-}
|
||||
wallLine :: Point2 -> Point2 -> Placement
|
||||
wallLine a b = Placement PS
|
||||
{ _psPos = V2 0 0
|
||||
, _psRot = 0
|
||||
, _psType = PutWall ps defaultWall
|
||||
} (const Nothing)
|
||||
where
|
||||
ps =
|
||||
[ a +.+ up
|
||||
, a -.- up
|
||||
, b -.- up
|
||||
, b +.+ up
|
||||
]
|
||||
left = 15 *.* normalizeV (a-.-b)
|
||||
up = vNormal left
|
||||
|
||||
windowLineType :: Point2 -> Point2 -> PSType
|
||||
windowLineType = PutLineBlock baseWindowPane 8 8
|
||||
|
||||
baseBlockPane :: Wall
|
||||
baseBlockPane = defaultWall
|
||||
{ _wlLine = (V2 0 0,V2 50 0)
|
||||
, _wlID = 0
|
||||
, _wlColor = greyN 0.5
|
||||
, _wlSeen = False
|
||||
, _wlOpacity = Opaque
|
||||
, _wlDraw = True
|
||||
, _wlFireThrough = True
|
||||
}
|
||||
baseWindowPane :: Wall
|
||||
baseWindowPane = defaultWall
|
||||
{ _wlLine = (V2 0 0,V2 50 0)
|
||||
, _wlID = 0
|
||||
, _wlColor = withAlpha 0.2 cyan
|
||||
, _wlSeen = False
|
||||
, _wlOpacity = SeeThrough
|
||||
, _wlDraw = True
|
||||
, _wlFireThrough = True
|
||||
}
|
||||
{- Replaces instances of a given 'PutID' with 'PSType's drawn from a list. -}
|
||||
replacePutID
|
||||
:: Int -- ^ The id of 'PutID' to be replaced
|
||||
-> [PSType] -- ^ List of replacements
|
||||
-> Room
|
||||
-> Room
|
||||
replacePutID i psts r =
|
||||
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
|
||||
that satisfy the predicate, concatenate
|
||||
the new zipped list and the other (unchanged) half. -}
|
||||
subZipWith
|
||||
:: (a -> Bool) -- ^ Filter: elements to apply zip to
|
||||
-> (a -> b -> a) -- ^ Combining function
|
||||
-> [a] -- ^ List to be partition
|
||||
-> [b] -- ^ Modifying list
|
||||
-> [a]
|
||||
subZipWith f g xs ys =
|
||||
let (zs,ws) = partition f xs
|
||||
in zipWith g zs ys ++ ws
|
||||
|
||||
isPutID :: Int -> Placement -> Bool
|
||||
isPutID i ps = Just i == ps ^? placementSpot . psType . putID
|
||||
|
||||
putBlockRect
|
||||
:: Float
|
||||
-> Float
|
||||
-> Float
|
||||
-> Float
|
||||
-> [Placement]
|
||||
putBlockRect a x b y = [ blockLine (V2 a b) (V2 a y)
|
||||
, blockLine (V2 a y) (V2 x y)
|
||||
, blockLine (V2 x y) (V2 x b)
|
||||
, blockLine (V2 x b) (V2 a b)
|
||||
]
|
||||
putBlockV
|
||||
:: Float
|
||||
-> Float
|
||||
-> Float
|
||||
-> Float
|
||||
-> [Placement]
|
||||
putBlockV a x b y = [ blockLine (V2 a b) (V2 a y)
|
||||
, blockLine (V2 x b) (V2 a b)
|
||||
]
|
||||
putBlockC
|
||||
:: Float
|
||||
-> Float
|
||||
-> Float
|
||||
-> Float
|
||||
-> [Placement]
|
||||
putBlockC a x b y = [ blockLine (V2 a b) (V2 a y)
|
||||
, blockLine (V2 x b) (V2 a b)
|
||||
, blockLine (V2 a y) (V2 x y)
|
||||
]
|
||||
putBlockN
|
||||
:: Float
|
||||
-> Float
|
||||
-> Float
|
||||
-> Float
|
||||
-> [Placement]
|
||||
putBlockN a x b y = [ blockLine (V2 a b) (V2 a y)
|
||||
, blockLine (V2 x b) (V2 a b)
|
||||
, blockLine (V2 x y) (V2 x b)
|
||||
]
|
||||
|
||||
switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement
|
||||
switchDoor btpos btrot dra drb col = Placement (PS btpos btrot $ PutButton $ makeSwitch col red id id)
|
||||
$ \btid -> jsps0J (PutSlideDoor False col (cond btid) dra drc 2)
|
||||
$ sps0 (PutSlideDoor False col (cond btid) drb drc 2)
|
||||
where
|
||||
drc = 0.5 *.* (dra +.+ drb)
|
||||
cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
|
||||
@@ -12,7 +12,7 @@ module Dodge.Room.Procedural
|
||||
import Dodge.Data
|
||||
import Dodge.Default.Wall
|
||||
import Dodge.Room.Data
|
||||
import Dodge.Room.Placement
|
||||
import Dodge.Placements
|
||||
import Dodge.Room.Link
|
||||
import Dodge.Room.Path
|
||||
import Dodge.Default.Room
|
||||
@@ -24,7 +24,7 @@ import Dodge.Item.Weapon.Launcher
|
||||
import Dodge.RandomHelp
|
||||
import Dodge.LevelGen
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.LightSources.Fitting
|
||||
import Dodge.LevelGen.Switch
|
||||
import Dodge.Creature
|
||||
import Geometry
|
||||
import Geometry.Vector3D
|
||||
@@ -60,12 +60,12 @@ roomRect x y xn yn = defaultRoom
|
||||
where
|
||||
yd = (y - 40) / fromIntegral yn
|
||||
xd = (x - 40) / fromIntegral xn
|
||||
elnks = zip (translateS (V2 0 20) $ gridPoints 0 1 yd (yn+1)) (repeat ( pi/2))
|
||||
wlnks = zip (translateS (V2 x 20) $ gridPoints 0 1 yd (yn+1)) (repeat (-pi/2))
|
||||
nlnks = zip (translateS (V2 20 y) $ gridPoints xd (xn+1) 0 1 ) (repeat 0 )
|
||||
slnks = zip (translateS (V2 20 0) $ gridPoints xd (xn+1) 0 1 ) (repeat pi )
|
||||
elnks = zip (map (+.+ V2 0 20) $ gridPoints 0 1 yd (yn+1)) (repeat ( pi/2))
|
||||
wlnks = zip (map (+.+ V2 x 20) $ gridPoints 0 1 yd (yn+1)) (repeat (-pi/2))
|
||||
nlnks = zip (map (+.+ V2 20 y) $ gridPoints xd (xn+1) 0 1 ) (repeat 0 )
|
||||
slnks = zip (map (+.+ V2 20 0) $ gridPoints xd (xn+1) 0 1 ) (repeat pi )
|
||||
lnks = nlnks ++ elnks ++ wlnks ++ slnks
|
||||
pth = linksAndPath lnks $ translateS (V2 20 20) (makeGrid xd xn yd yn)
|
||||
pth = linksAndPath lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
|
||||
{- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size. -}
|
||||
roomRectAutoLinks :: Float -> Float -> Room
|
||||
roomRectAutoLinks x y = roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y - 40) `div` 60)
|
||||
@@ -94,16 +94,16 @@ Add a light and a 'PutNothing' placement. -}
|
||||
quarterRoomFlat :: RandomGen g => Float -> State g Room
|
||||
quarterRoomFlat w = do
|
||||
b <- takeOne
|
||||
[ [ mountedLightV (V2 0 w) (V3 0 (w-20) 70)
|
||||
, mountedLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
|
||||
[ [ mountLightV (V2 0 w) (V3 0 (w-20) 70)
|
||||
, mountLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
|
||||
, sPS (V2 (w-20) (w-20)) pi PutNothing
|
||||
, blockLine (V2 (w/2) (w/2)) (V2 (w/2) w)
|
||||
]
|
||||
, [ mountedLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
|
||||
, [ mountLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
|
||||
, sPS (V2 (w-20) (w-20)) pi PutNothing
|
||||
, blockLine (V2 (w/2) (w/2)) (V2 (negate $ w/2) (w/2))
|
||||
]
|
||||
, [ mountedLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
|
||||
, [ mountLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
|
||||
, sPS (V2 (w-20) (w-20)) pi PutNothing
|
||||
, blockLine (V2 (w/2) (w/2)) (V2 0 (w/2))
|
||||
, blockLine (V2 (-29) w) (V2 0 (w/2))
|
||||
@@ -127,17 +127,17 @@ quarterRoomFlat w = do
|
||||
fourthCornerWall :: RandomGen g => Float -> State g Room
|
||||
fourthCornerWall w = do
|
||||
b <- takeOne
|
||||
[ [ mountedLightV (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
|
||||
[ [ mountLightV (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
|
||||
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
|
||||
, blockLine (V2 (negate $ w/2) (w/2)) (V2 0 w)
|
||||
, sPS (V2 20 (2*w-40)) pi PutNothing
|
||||
]
|
||||
, [ mountedLightV (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
|
||||
, [ mountLightV (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
|
||||
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
|
||||
, blockLine (V2 (negate w) w ) (V2 0 w)
|
||||
, sPS (V2 20 (2*w-40)) pi PutNothing
|
||||
]
|
||||
, [ mountedLight (V2 (0.7*w) (1.3*w)) (V3 (0.7*w-20) (1.3*w-20) 70)
|
||||
, [ mountLight (V2 (0.7*w) (1.3*w)) (V3 (0.7*w-20) (1.3*w-20) 70)
|
||||
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
|
||||
, blockLine (V2 0 w) (V2 0 (w*2))
|
||||
, sPS (V2 20 (2*w-40)) pi PutNothing
|
||||
@@ -222,7 +222,7 @@ centerVaultRoom w h d = do
|
||||
,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
|
||||
,sps0 $ PutForeground $ girder 70 10 10 (V2 (d-11) (-d)) (V2 (d-11) (-h))
|
||||
]
|
||||
++ map (\a -> mountedLightV (rotateV a $ V2 0 d) (rotate3z a $ V3 0 (d+30) 70))
|
||||
++ map (\a -> mountLightV (rotateV a $ V2 0 d) (rotate3z a $ V3 0 (d+30) 70))
|
||||
[0,0.5*pi,pi,1.5*pi]
|
||||
++ concatMap (\r -> map (shiftPlacement (V2 0 0,r)) theDoor)
|
||||
[0,pi/2,pi,3*pi/2]
|
||||
|
||||
@@ -7,13 +7,12 @@ import Geometry
|
||||
import Dodge.Default.Room
|
||||
import Dodge.Room.Data
|
||||
import Dodge.Room.Link
|
||||
import Dodge.Room.Placement
|
||||
import Dodge.Placements
|
||||
import Dodge.Room.Corridor
|
||||
import Dodge.LevelGen.Data
|
||||
--import Dodge.RandomHelp
|
||||
import Dodge.Creature
|
||||
import Dodge.Layout.Tree.Polymorphic
|
||||
import Dodge.LightSources.Fitting
|
||||
|
||||
import Data.Tree
|
||||
import Control.Monad.State
|
||||
@@ -43,7 +42,7 @@ litCorridor90 = do
|
||||
]
|
||||
, _rmPS =
|
||||
[ sPS (V2 20 (h-5)) 0 putLamp
|
||||
, mountedLightI 70 (V2 0 (0.4*h)) (V2 40 (0.4*h))
|
||||
, mountLightI 70 (V2 0 (0.4*h)) (V2 40 (0.4*h))
|
||||
, windowLine (V2 0 (h-20)) (V2 40 (h-20))
|
||||
, sPS (V2 (-50) (h-85)) 0 putLamp
|
||||
, windowLine (V2 (-40) (h-60)) (V2 (-40) (h-100))
|
||||
@@ -76,6 +75,6 @@ blockedCorridor = do
|
||||
let plmnts =
|
||||
[sPS (V2 20 40) r $ PutBlock [5,5,5] (V4 (150/256) ( 75/256) 0 ( 250/256))
|
||||
$ reverse $ rectNSWE 10 (-10) (-10) 10
|
||||
,mountedLightI 55 (V2 0 15) (V2 40 15)
|
||||
,mountLightI 55 (V2 0 15) (V2 40 15)
|
||||
]
|
||||
sequence $ treeFromPost [] $ return $ Right $ set rmPS plmnts corridor
|
||||
|
||||
@@ -6,9 +6,9 @@ import Dodge.Room.Link
|
||||
import Dodge.Room.Procedural
|
||||
import Dodge.Room.Foreground
|
||||
import Dodge.Room.Furniture
|
||||
import Dodge.Placements
|
||||
import Dodge.Layout.Tree.Polymorphic
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.LightSources.Fitting
|
||||
import Dodge.Machine.Sensor
|
||||
import Geometry.Data
|
||||
import Color
|
||||
@@ -33,7 +33,7 @@ startRoom = do
|
||||
<$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0)
|
||||
$ roomRectAutoLinks w h & rmPS .~
|
||||
[ fground
|
||||
, mountedLightJ (V2 0 (h/3)) (V3 40 (h/3) 70)
|
||||
, mountLightJ (V2 0 (h/3)) (V3 40 (h/3) 70)
|
||||
, tankSquareEmboss4 (dim orange) 50 (h-60)
|
||||
, tankSquare (dim orange) 50 50
|
||||
, tankSquare (dim orange) 50 120
|
||||
|
||||
@@ -5,7 +5,7 @@ import Dodge.Data
|
||||
import Dodge.Base
|
||||
import Dodge.Room.Data
|
||||
import Dodge.Room.Procedural
|
||||
import Dodge.Room.Placement
|
||||
import Dodge.Placements
|
||||
import Dodge.LevelGen.Data
|
||||
import Geometry
|
||||
import Picture
|
||||
|
||||
@@ -6,10 +6,9 @@ module Dodge.Room.Treasure
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Room.Data
|
||||
import Dodge.Room.Placement
|
||||
import Dodge.Placements
|
||||
import Dodge.Default.Room
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.LightSources.Fitting
|
||||
import Geometry
|
||||
|
||||
--import Data.List
|
||||
@@ -33,7 +32,7 @@ triLootRoom w h = pure $ defaultRoom
|
||||
[sPS (V2 (15-w) 15 ) 0 $ PutID 0
|
||||
,sPS (V2 (w-15) 15 ) pi $ PutID 0
|
||||
,sPS (V2 0 (h-35)) 0 $ PutID 2
|
||||
,mountedLightV (V2 0 (h-20)) (V3 0 (h-80) 70)
|
||||
,mountLightV (V2 0 (h-20)) (V3 0 (h-80) 70)
|
||||
,sPS (V2 0 ( -60)) 0 putLamp
|
||||
]
|
||||
, _rmBound = [tri , base]
|
||||
|
||||
Reference in New Issue
Block a user