Replace PutShape with PutForeground

This commit is contained in:
2022-06-27 14:30:08 +01:00
parent fec72cdf48
commit 0def31895f
11 changed files with 39 additions and 55 deletions
+1 -1
View File
@@ -93,7 +93,7 @@ airlockZ = defaultRoom
inDoorps = (V2 0 0 ,) <$> arcStepwise 3 (pi/2) (V2 0 0) (V2 (-61) 0)
cenlight = mntLS vShape (V2 90 60) (V3 90 40 50) `addPlmnt` mntLS vShape (V2 90 60) (V3 90 80 50)
cornlight = mntLS vShape (V2 0 120) (V3 30 90 50) `addPlmnt` mntLS vShape (V2 180 120) (V3 150 90 50)
`addPlmnt` sps0 (PutShape (thinHighBar 50 (V2 30 90) (V2 150 90)))
`addPlmnt` sps0 (putShape (thinHighBar 50 (V2 30 90) (V2 150 90)))
lighting = RandomPlacement $ takeOne [cenlight,cornlight]
airlock90 :: Room
+2 -2
View File
@@ -45,8 +45,8 @@ keyholeCorridor :: Room
keyholeCorridor = corridor
{ _rmPath = []
, _rmPmnts =
[ midWall $ reverse $ rectNSWE top bot 15 0
, midWall $ reverse $ rectNSWE top bot 40 25]
[ midWall $ rectNSWE top bot 15 0
, midWall $ rectNSWE top bot 40 25]
}
where
top = 65
+7 -1
View File
@@ -5,6 +5,7 @@ import Picture
import Geometry
import Shape
import Quaternion
import Bound
--import Dodge.Data.ForegroundShape
import Dodge.Default.Foreground
@@ -12,6 +13,8 @@ import Data.List
import Data.Maybe
import Control.Lens
import ShapePicture
import Streaming
import qualified Streaming.Prelude as S
highDiagonalMesh
:: Point2
@@ -125,8 +128,11 @@ putShape sh = PutForeground $ defaultForeground
bnds = shapeBounds sh
m = midBounds bnds
shapePoints :: Shape -> Stream (Of Point2) Identity ()
shapePoints = S.each . concatMap (map (stripZ . _svPos) . _shVs)
shapeBounds :: Shape -> (Float,Float,Float,Float)
shapeBounds sh = undefined
shapeBounds = fromMaybe (0,0,0,0) . boundPoints . shapePoints
midBounds :: (Float,Float,Float,Float) -> Point2
midBounds (n,s,e,w) = V2 ((n + s)/2) ((e + w)/2)
+5 -5
View File
@@ -122,12 +122,12 @@ lasCenSensEdge n = do
lasTunnel :: RandomGen g => Float -> State g Room
lasTunnel y = do
extraPlmnts <- takeOne
[ [ midWall (reverse $ rectNSWE 115 90 0 60)
, midWall (reverse $ rectNSWE 65 40 (-40) 25)
[ [ midWall ( rectNSWE 115 90 0 60)
, midWall ( rectNSWE 65 40 (-40) 25)
]
, [ midWall (reverse $ rectNSWE 125 100 0 25)
, midWall (reverse $ rectNSWE 80 40 (-40) 0)
, midWall (reverse $ rectNSWE 80 40 25 60)
, [ midWall ( rectNSWE 125 100 0 25)
, midWall ( rectNSWE 80 40 (-40) 0)
, midWall ( rectNSWE 80 40 25 60)
]
]
return defaultRoom
+6 -6
View File
@@ -36,7 +36,7 @@ addGirderNS shapef col room = do
(sps0 PutNothing : [ twoRoomPoss
(isUnusedLnkType (FromEdge West i))
(isUnusedLnkType (FromEdge West i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
$ \ps1 ps2 -> sps0 $ putShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- girderPosOrder]
)
@@ -44,7 +44,7 @@ addGirderFrom :: CardinalPoint -> Int -> (Point2 -> Point2 -> Shape) -> Color ->
addGirderFrom cp fromi shapef col = rmPmnts .:~ foldr1 setFallback
[ sps0 PutNothing
, twoRoomPoss rmposcond rmposcond
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) ]
$ \ps1 ps2 -> sps0 $ putShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) ]
where
rmposcond = isUnusedLnkType (FromEdge cp fromi)
-- | Allows girder to be on edge
@@ -56,7 +56,7 @@ addGirderNS' shapef col room = do
(sps0 PutNothing : [ twoRoomPoss
(isUnusedLnkType (FromEdge West i))
(isUnusedLnkType (FromEdge West i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
$ \ps1 ps2 -> sps0 $ putShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- girderPosOrder]
)
addGirderEW :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
@@ -68,7 +68,7 @@ addGirderEW shapef col room = do
[ twoRoomPoss
(isUnusedLnkType (FromEdge South i))
(isUnusedLnkType (FromEdge South i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
$ \ps1 ps2 -> sps0 $ putShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- girderPosOrder]
)
@@ -86,7 +86,7 @@ addGirder shapef col room = do
girdson f numlnks = [ twoRoomPoss
(isUnusedLnkType (f i))
(isUnusedLnkType (f i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
$ \ps1 ps2 -> sps0 $ putShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- [1 .. numlnks - 2] ]
addGirder' :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
@@ -102,7 +102,7 @@ addGirder' shapef col room = do
girdson f numlnks = [ twoRoomPoss
(isUnusedLnkType (f i))
(isUnusedLnkType (f i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
$ \ps1 ps2 -> sps0 $ putShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- [0 .. numlnks - 1] ]
addHighGirder :: RandomGen g => Room -> State g Room
-12
View File
@@ -15,20 +15,8 @@ import Dodge.Room.Ngon
import Dodge.Room.Procedural
import Dodge.Room.Corridor
import Dodge.Room.Link
--import Dodge.Room.Procedural
import Dodge.Room.Foreground
--import Dodge.Room.RoadBlock
import Dodge.Placement.Instance
--import Dodge.Default.Room
--import Dodge.Item.Weapon.BulletGuns
--import Dodge.Item.Weapon.Utility
--import Dodge.LevelGen.Data
--import Geometry.Data
import Geometry
--import Padding
import Color
import Shape
--import Lorem
import LensHelp
import RandomHelp