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

Reorganise wall placements

Browse Source
This commit is contained in:
justin
2021-11-17 12:35:05 +00:00
parent bcdf0e643c
commit 5949ad2b3d
13 changed files with 32 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Furniture.hs
-107
View File
@@ -1,107 +0,0 @@
module Dodge.Room.Furniture
where
import Dodge.Data
import Dodge.Placement.PlaceSpot
import Dodge.LevelGen.Data
import Dodge.Room.Foreground
import Dodge.Default.Wall
import Geometry
import Shape
import Color
--import Quaternion
roundTank :: Color -> Float -> Float -> Placement
roundTank col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
upperPrismPoly 31 thecircle
<> foldMap toprail ( take 8 [0,pi/4..])
)
$ sps0 $ PutWall thecircle defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
where
toprail a = rotateSH a $ thinHighBar 31 (V2 0 20) (rotateV (pi/4) $ V2 0 20)
thecircle = polyCirc 4 20
roundTankCross :: Color -> Float -> Float -> Placement
roundTankCross col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
upperPrismPoly 31 thecircle
<> thinHighBar 31 (V2 20 0) (V2 (-20) 0)
<> thinHighBar 31 (V2 0 20) (V2 0 (-20))
)
$ sps0 $ PutWall thecircle defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
where
thecircle = polyCirc 4 20
tankRectCross :: Float -> Float -> Color -> Float -> Float -> Placement
tankRectCross w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
upperPrismPoly 31 therect
<> thinHighBar 31 (V2 w 0) (V2 (-w) 0)
<> thinHighBar 31 (V2 0 h) (V2 0 (-h))
)
$ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
where
therect = rectWH w h
tankSquareCross :: Color -> Float -> Float -> Placement
tankSquareCross = tankRectCross 20 20
lowWall :: [Point2] -> Placement
lowWall ps = ps0j (PutForeground . colorSH col $ upperPrismPoly 30 ps)
$ sps0 $ PutWall ps theWall
where
col = _wlColor defaultWall
theWall = defaultWall
{ _wlOpacity = SeeAbove
, _wlDraw = False
}
tankRect :: Float -> Float -> Color -> Float -> Float -> Placement
tankRect w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col
$ upperPrismPoly 31 therect
<> foldMap f [(w',-w',h',h'),(w',-w',-h',-h'),(w',w',h',-h'),(-w',-w',h',-h')]
)
$ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
where
therect = rectWH w h
w' = w - 1.5
h' = h - 1.5
f (a,b,c,d) = thinHighBar 31 (V2 a b) (V2 c d)
tankSquare :: Color -> Float -> Float -> Placement
tankSquare = tankRect 20 20
tankRectEmboss :: Float -> Float -> Color -> Float -> Float -> Placement
tankRectEmboss w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
upperPrismPoly 31 therect
<> embossingR
<> rotateSH pi embossingR
<> thinHighBar 38 (V2 (-0.3*w) 0) (V2 (0.3*w) 0)
)
$ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
where
w' = 0.3 * w
therect = rectWH w h
embossingR = prismPoly
[V3 w h 31,V3 w (0.3*h) 41,V3 w (-0.3*h) 41,V3 w (-h) 31]
[V3 w' h 31,V3 w' (0.3*h) 41,V3 w' (-0.3*h) 41,V3 w' (-h) 31]
tankSquareEmboss :: Color -> Float -> Float -> Placement
tankSquareEmboss = tankRectEmboss 20 20
tankRectEmboss4 :: Float -> Float -> Color -> Float -> Float -> Placement
tankRectEmboss4 w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
upperPrismPoly 31 therect
<> foldMap f [(w,h),(-w,h),(w,-h),(-w,-h)]
)
$ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
where
therect = rectWH w h
f (a,b) = translateSH (V3 (a/2) (b/2) 31) embossing
embossing = upperPrismPolyHalf 10 $ rectNSEW (h/2) (-h/2) (w/2) (-w/2)
tankSquareEmboss4 :: Color -> Float -> Float -> Placement
tankSquareEmboss4 = tankRectEmboss4 20 20
src/Dodge/Room/LongDoor.hs
+1 -1
View File
@@ -15,7 +15,7 @@ import Dodge.LevelGen.Switch
import Dodge.RandomHelp
import Dodge.Creature.Inanimate
import Dodge.Creature
import Dodge.LightSources.Lamp
import Dodge.LightSource
import Picture
import Geometry
src/Dodge/Room/RoadBlock.hs
-1
View File
@@ -7,7 +7,6 @@ import Dodge.LevelGen.Data
import Dodge.Room.Link
import Dodge.Placement.Instance
import Dodge.Room.Corridor
import Dodge.Room.Furniture
--import Dodge.LevelGen.Data
--import Dodge.Default.Wall
import Dodge.RandomHelp
src/Dodge/Room/RunPast.hs
+1
View File
@@ -0,0 +1 @@
module Dodge.Room.RunPast where
src/Dodge/Room/Start.hs
+8 -9
View File
@@ -9,7 +9,6 @@ import Dodge.Room.Room
import Dodge.Room.Link
import Dodge.Room.Procedural
import Dodge.Room.Foreground
import Dodge.Room.Furniture
import Dodge.Room.RoadBlock
import Dodge.Placement.Instance
import Dodge.Layout.Tree.Polymorphic
@@ -26,6 +25,14 @@ import Control.Lens
import System.Random
--import qualified Data.IntMap.Strict as IM
startRoom :: RandomGen g => State g (Tree (Either Room Room))
startRoom = join $ takeOne
[ rezBoxesWp
, rezBoxesThenWeaponRoom
, rezBoxThenWeaponRoom
, rezBoxesWpCrit
]
rezBox :: LightSource -> Room
rezBox ls = roomRect 40 60 1 1
& rmPmnts .~ [ sPS (V2 20 1) 0 $ PutLS ls]
@@ -65,14 +72,6 @@ rezBoxThenWeaponRoom = do
rcol <- rezColor
treeFromTrunk [Left $ rezBox rcol,Left door] <$> weaponRoom
startRoom :: RandomGen g => State g (Tree (Either Room Room))
startRoom = join $ takeOne
[ rezBoxesWp
, rezBoxesThenWeaponRoom
, rezBoxThenWeaponRoom
, rezBoxesWpCrit
]
rezBoxesWpCrit :: RandomGen g => State g (Tree (Either Room Room))
rezBoxesWpCrit = do
w <- state $ randomR (200,400)