Add tilemap floors to rooms

This commit is contained in:
2021-06-15 14:56:32 +02:00
parent 73bd407c49
commit da631e3b37
31 changed files with 181 additions and 66 deletions
+2 -1
View File
@@ -2,7 +2,8 @@
{-# LANGUAGE StrictData #-}
module Dodge.Creature.State.Data
where
import Geometry
--import Geometry
import Geometry.Data
import Dodge.Data.DamageType
--import Dodge.Creature.Stance.Data
import Picture.Data
+2 -1
View File
@@ -6,7 +6,8 @@ creatures.
-}
module Dodge.Data.DamageType
where
import Geometry
--import Geometry
import Geometry.Data
import Control.Lens
+13
View File
@@ -0,0 +1,13 @@
module Dodge.Default.Room
where
import Dodge.Room.Data
defaultRoom :: Room
defaultRoom = Room
{ _rmPolys = []
, _rmLinks = []
, _rmPath = []
, _rmPS = []
, _rmBound = []
, _rmFloor = []
}
+19 -11
View File
@@ -10,6 +10,8 @@ import Dodge.Item.Data
import Picture
import Geometry
import Picture.Texture
import Data.Tile
import Tile
import System.Random
import qualified Data.IntMap.Strict as IM
@@ -37,17 +39,23 @@ defaultWorld = World
, _wallsZone = IM.empty
, _forceFields = IM.empty
, _floorItems = IM.empty
, _floorTiles =
let x = 200
y = 0.9
z = 16
r = 4
in tileToRender [(0,0,z),(r,0,z),(r,r,z),(0,r,z)]
[(20,100 + 20,y)
,( x,100 + 20,y)
,( x,100 + x,y)
,(20,100 + x,y)
]
, _floorTiles = tToRender $ Tile
{ _tilePoly = rectNSWE 200 0 0 200
, _tileCenter = (0,0)
, _tileX = (100,0)
, _tileY = (0,100)
, _tileZ = 16
}
-- let x = 200
-- y = 0.9
-- z = 16
-- r = 8
-- in tileToRender [(0,0,z),(r,0,z),(r,r,z),(0,r,z)]
-- [(20,100 + 20,y)
-- ,( x,100 + 20,y)
-- ,( x,100 + x,y)
-- ,(20,100 + x,y)
-- ]
, _randGen = mkStdGen 2
, _mousePos = (0,0)
, _testString = []
+6
View File
@@ -14,6 +14,8 @@ import Geometry
import Dodge.Room.Link
import qualified IntMapHelp as IM
--import Dodge.Debug.LinkDecoration
import Picture.Data
import Tile
import Control.Monad.State
import Control.Lens
@@ -30,6 +32,7 @@ generateLevelFromRoomList gr w = updateWallZoning
-- . addRoomPolyDecorations rs
-- . addRoomLinkDecorations rs
$ w { _walls = wallsFromRooms rs
, _floorTiles = floorsFromRooms rs
}
where
plmnts = concatMap _rmPS rs
@@ -89,6 +92,9 @@ wallsFromRooms =
where
f i (x,y) = defaultWall {_wlLine = (x,y) , _wlID = i}
floorsFromRooms :: [Room] -> [RenderType]
floorsFromRooms = concatMap (concatMap tToRender . _rmFloor)
divideWall :: Wall -> [Wall]
divideWall wl
= let (a,b) = _wlLine wl
+1
View File
@@ -9,6 +9,7 @@ import Dodge.Room.Data
import Dodge.Room.Link
import Dodge.Layout.Tree.Polymorphic
import Geometry
import Geometry.Data
import Data.Tree
import Data.Sequence hiding (zipWith)
+1
View File
@@ -4,6 +4,7 @@ Creates uniform sizes and commands for the Dodge modules. -}
module Dodge.Picture
where
import Geometry
import Geometry.Data
import Picture
+1 -1
View File
@@ -3,7 +3,7 @@ Helpers for random generation.
-}
module Dodge.RandomHelp where
import Geometry
--import Geometry.Data
import Geometry.Data
import System.Random
import Control.Monad.State
+2 -1
View File
@@ -11,7 +11,8 @@ import Dodge.Base
--import Dodge.Render.MenuScreen
import Dodge.Render.Picture
--import Dodge.Render.PerspectiveMatrix
import Geometry
--import Geometry
import Geometry.Data
--import Picture
import Picture.Render
import Data.Preload.Render
+1
View File
@@ -7,6 +7,7 @@ import Dodge.Picture.Layer
import Dodge.Render.HUD
import Dodge.Render.MenuScreen
import Geometry
import Geometry.Data
import Picture
--import Dodge.Creature.YourControl
+5 -4
View File
@@ -6,6 +6,7 @@ module Dodge.Room
, module Dodge.Room.Corridor
) where
import Dodge.Data
import Dodge.Default.Room
import Dodge.Item.Weapon
import Dodge.Item.Weapon.AutoGun
import Dodge.Item.Weapon.Launcher
@@ -43,7 +44,7 @@ import Data.Tree
--import qualified Data.IntMap.Strict as IM
roomC :: Float -> Float -> Room
roomC x y = Room
roomC x y = defaultRoom
{ _rmPolys = [rectNSWE y 0 0 x]
, _rmLinks = lnks
, _rmPath = []
@@ -59,7 +60,7 @@ roomC x y = Room
]
roomPadCut :: [Point2] -> Point2 -> Room
roomPadCut ps p = Room
roomPadCut ps p = defaultRoom
{ _rmPolys = [ps]
, _rmLinks = [(p,0),((0,0),pi)]
, _rmPath = [((0,0),p)]
@@ -212,7 +213,7 @@ roomCenterPillar = changeLinkTo ((\p -> dist p (120,0) < 10) . fst)
]
roomOctogon :: Room
roomOctogon = Room
roomOctogon = defaultRoom
{ _rmPolys = [[(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)]
]
, _rmLinks = lnks
@@ -338,7 +339,7 @@ critInDeadEnd :: Room
critInDeadEnd = set rmPS [sPS (0,0) 0 randC1] deadEndRoom
deadEndRoom :: Room
deadEndRoom = Room
deadEndRoom = defaultRoom
{ _rmPolys = [rectNSWE 40 (-20) (-20) 20
]
, _rmLinks = lnks
+5 -4
View File
@@ -5,6 +5,7 @@ module Dodge.Room.Airlock
where
import Dodge.Room.Data
import Dodge.Room.Placement
import Dodge.Default.Room
import Dodge.Data
import Dodge.LevelGen.Data
import Dodge.LevelGen.Switch
@@ -18,7 +19,7 @@ import Control.Monad.State
import Control.Lens
airlockOneWay :: Int -> Room
airlockOneWay n = Room
airlockOneWay n = defaultRoom
{ _rmPolys = [rectNSWE 90 0 0 40]
, _rmLinks = lnks
, _rmPath = []
@@ -49,7 +50,7 @@ Straight airlock -}
airlock0
:: Int -- ^ Door id
-> Room
airlock0 n = Room
airlock0 n = defaultRoom
{ _rmPolys =
[ rectNSWE 100 0 0 40
, rectNSWE 65 35 (-40) 20
@@ -78,7 +79,7 @@ airlock0 n = Room
airlock90
:: Int -- ^ Door id
-> Room
airlock90 n = Room
airlock90 n = defaultRoom
{ _rmPolys =
[ rectNSWE 100 10 10 100
, rectNSWE 20 0 20 60
@@ -120,7 +121,7 @@ airlock90 n = Room
airlockCrystal
:: Int -- ^ Door id
-> Room
airlockCrystal n = Room
airlockCrystal n = defaultRoom
{ _rmPolys =
[ rectNSWE 140 0 0 40
, orderPolygon
+5 -4
View File
@@ -4,6 +4,7 @@ Rooms containing particularly challenging creatures, that may drop useful loot.
module Dodge.Room.Boss
where
import Dodge.Data
import Dodge.Default.Room
import Dodge.Room.Data
import Dodge.Room.Procedural
import Dodge.Room.Placement
@@ -23,7 +24,7 @@ import System.Random
roomGlassOctogon
:: Float -- ^ Size
-> Room
roomGlassOctogon x = Room
roomGlassOctogon x = defaultRoom
{ _rmPolys = [rectNSWE x (-x) (-x) x
,rectNSWE 0 (-(x + 40)) (-20) 20
]
@@ -74,7 +75,7 @@ roomCross
:: Float -- ^ First width/2
-> Float -- ^ Second width/2
-> Room
roomCross x y = Room
roomCross x y = defaultRoom
{ _rmPolys = [rectNSWE y (-y) (-x) x
,rectNSWE (-x) x y (-y)
]
@@ -112,7 +113,7 @@ roomShuriken x y =
, (x,y)
, (0,x)
] ]
corner = Room
corner = defaultRoom
{ _rmPolys = ps
, _rmLinks = [((x-1,y-20),negate $ pi/2)]
, _rmPath = []
@@ -136,7 +137,7 @@ roomTwistCross x y z =
]
, rectNSWE (x-5) 0 0 (x-5)
]
corner = Room
corner = defaultRoom
{ _rmPolys = ps
, _rmLinks = [((z,y-20), pi/2)]
, _rmPath = []
+6 -5
View File
@@ -1,11 +1,12 @@
module Dodge.Room.Corridor
where
import Dodge.Room.Data
import Dodge.Default.Room
import Geometry
{- | First exit due north, two other exits at angles next to this.
Entrance from south. -}
corridor :: Room
corridor = Room
corridor = defaultRoom
{ _rmPolys = [rectNSWE 80 0 0 40
--{ _rmPolys = [rectNSWE 90 (-10) 0 40
-- ,[(0,80), (0,80) +.+ rotateV (pi/3) (40,0),(40,80)]
@@ -25,7 +26,7 @@ corridor = Room
]
{- | Debug drop-in copy of corridor -}
corridorDebug :: Room
corridorDebug = Room
corridorDebug = defaultRoom
{ _rmPolys =
[ rectNSWE 80 0 0 40
--, [ (0,0), (0,200) , (200,100)]
@@ -44,7 +45,7 @@ corridorDebug = Room
,((20,10) ,pi)
]
corridorN :: Room
corridorN = Room
corridorN = defaultRoom
{ _rmPolys = [rectNSWE 80 0 0 40
]
, _rmLinks = lnks
@@ -58,7 +59,7 @@ corridorN = Room
pth = doublePair ((20,70),(20,10))
tEast :: Room
tEast = Room
tEast = defaultRoom
{ _rmPolys = [rectNSWE 80 0 (-20) 20
,rectNSWE 80 40 (-40) 40
]
@@ -72,7 +73,7 @@ tEast = Room
,((0,10),pi)
]
tWest :: Room
tWest = Room
tWest = defaultRoom
{ _rmPolys = [rectNSWE 80 0 (-20) 20
,rectNSWE 80 40 (-40) 40
]
+4 -1
View File
@@ -3,7 +3,9 @@
module Dodge.Room.Data
where
import Dodge.LevelGen.Data
import Geometry
--import Geometry
import Geometry.Data
import Data.Tile
import Control.Lens
@@ -22,5 +24,6 @@ data Room = Room
, _rmPath :: [(Point2, Point2)]
, _rmPS :: [Placement]
, _rmBound :: [ [Point2] ]
, _rmFloor :: [Tile]
}
makeLenses ''Room
+2 -1
View File
@@ -6,12 +6,13 @@ module Dodge.Room.Door
import Geometry
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Dodge.Default.Room
--import Control.Monad.State
--import System.Random
door :: Room
door = Room
door = defaultRoom
{ _rmPolys = [rectNSWE 40 0 0 40]
, _rmLinks = lnks
, _rmPath = [((20,35),(20,5))]
+14 -7
View File
@@ -12,6 +12,8 @@ import Dodge.LevelGen.Data
import Dodge.Room.Data
import Dodge.RandomHelp
import Geometry
import Geometry.Data
import Data.Tile
import System.Random
import Control.Monad.State
@@ -64,13 +66,18 @@ shiftRoomToLink l r
(p,a) = last $ _rmLinks r
shiftRoomBy :: (Point2,Float) -> Room -> Room
shiftRoomBy shift r =
over rmPolys (fmap (map (shiftPointBy shift)))
$ over rmLinks (fmap (shiftLinkBy shift))
$ over rmPath (map (shiftPathPointBy shift))
$ over rmPS (fmap (shiftPSBy shift))
$ over rmBound (fmap (map (shiftPointBy shift)))
r
shiftRoomBy shift r = r
& rmPolys %~ fmap (map (shiftPointBy shift))
& rmLinks %~ fmap (shiftLinkBy shift)
& rmPath %~ map (shiftPathPointBy shift)
& rmPS %~ fmap (shiftPSBy shift)
& rmBound %~ fmap (map (shiftPointBy shift))
& rmFloor %~ map
( (tilePoly %~ map (shiftPointBy shift))
. (tileCenter %~ shiftPointBy shift )
. (tileX %~ shiftPointBy shift )
. (tileY %~ shiftPointBy shift )
)
shiftLinkBy
:: (Point2,Float)
+2 -1
View File
@@ -4,6 +4,7 @@
module Dodge.Room.LongDoor
where
import Dodge.Data
import Dodge.Default.Room
import Dodge.Room.Data
import Dodge.Room.Placement
import Dodge.Room.Link
@@ -29,7 +30,7 @@ twinSlowDoorRoom
-> Float -- ^ Half height
-> Float -- ^ Inner width
-> Room
twinSlowDoorRoom drID w h x = Room
twinSlowDoorRoom drID w h x = defaultRoom
{ _rmPolys = ps
, _rmLinks =
[ ((w,h/2) , negate $ pi/2)
+14 -5
View File
@@ -11,6 +11,7 @@ import Dodge.Data
import Dodge.Room.Data
import Dodge.Room.Placement
import Dodge.Room.Link
import Dodge.Default.Room
import Dodge.Item.Consumable
import Dodge.Item.Equipment
import Dodge.Item.Weapon
@@ -21,6 +22,7 @@ import Dodge.Creature
--import Dodge.Default
import Geometry
import Picture
import Data.Tile
import Data.List
import Data.Function (on)
@@ -40,12 +42,19 @@ roomRect
-> Int -- ^ Number of links on vertical walls
-> Int -- ^ Number of links on horizontal walls
-> Room
roomRect x y xn yn = Room
roomRect x y xn yn = defaultRoom
{ _rmPolys = [rectNSWE y 0 0 x ]
, _rmLinks = lnks
, _rmPath = concatMap doublePair pth
, _rmPS = [sPS (x/2,y/2) 0 putLamp]
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
, _rmFloor = [Tile
{ _tilePoly = rectNSWE y 0 0 x
, _tileCenter = (0,0)
, _tileX = (50,0)
, _tileY = (0,50)
, _tileZ = 16
} ]
}
where
yd = (y - 40) / fromIntegral yn
@@ -88,7 +97,7 @@ linksAndPath lnks subpth = subpth ++ concatMap linkClosest lnks
{- Combines two rooms into one room.
Combines into one big bound, concatenates the rest. -}
combineRooms :: Room -> Room -> Room
combineRooms r r' = Room
combineRooms r r' = defaultRoom
{ _rmPolys = _rmPolys r ++ _rmPolys r'
, _rmLinks = _rmLinks r ++ _rmLinks r'
, _rmPath = _rmPath r ++ _rmPath r'
@@ -130,7 +139,7 @@ fourthWall w = do
, blockLine (-29,w) (0,w/2)
]
]
pure $ Room
pure $ defaultRoom
{ _rmPolys = [ [(0,0),(w,w),(-w,w)] ]
, _rmLinks = [((0,w), 0)]
, _rmPath = [((0,w),(0,0)),((0,0),(0,w))]
@@ -175,7 +184,7 @@ fourthCornerWall w = do
, blockLine (0,w) (0,w*2)
]
]
pure $ Room
pure $ defaultRoom
{ _rmPolys = [ [(0,0),(w,w),(0,2*w),(-w,w)] ]
, _rmLinks =
[((w/2,3*w/2), negate $ pi/4)
@@ -233,7 +242,7 @@ centerVaultRoom n w h d = do
weDoors = rectNSWE 20 (-20) (d + 20) (negate (d +20))
centerPoly = rectWdthHght (d - 20) (d - 20)
polys = centerPoly : nsDoors : weDoors : take 4 (iterate (map vNormal) northPoly)
return $ Room
return $ defaultRoom
{ _rmPolys = polys
, _rmLinks =
[((0,h),0)
+2 -1
View File
@@ -4,6 +4,7 @@ Connecting rooms designed with a pass-through technique in mind.
module Dodge.Room.RoadBlock
where
import Geometry
import Dodge.Default.Room
import Dodge.Room.Data
import Dodge.Room.Link
import Dodge.Room.Placement
@@ -29,7 +30,7 @@ litCorridor90 = do
h <- state $ randomR (500,800)
let poly = rectNSWE h 0 0 40
poly2 = rectNSWE (h-60) (h-100) (-60) 5
pure $ Room
pure $ defaultRoom
{ _rmPolys = [poly,poly2]
, _rmLinks = [ ((40,h - 80), -pi/2)
, ((20, 0), pi)
+3 -2
View File
@@ -4,11 +4,12 @@ Typically dead ends.
-}
module Dodge.Room.Treasure
where
import Geometry
import Dodge.Data
import Dodge.Room.Data
import Dodge.Room.Placement
import Dodge.Default.Room
import Dodge.LevelGen.Data
import Geometry
--import Data.List
import Control.Monad.State
@@ -21,7 +22,7 @@ triLootRoom
:: Float -- Width
-> Float -- Height
-> State g Room
triLootRoom w h = pure $ Room
triLootRoom w h = pure $ defaultRoom
{ _rmPolys = [ tri
, base
]