Replace PutShape with PutForeground
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user