Allow for lineBlocks to have different sizes
This commit is contained in:
+2
-1
@@ -1408,7 +1408,8 @@ data PSType = PutCrit {_unPutCrit :: Creature}
|
|||||||
| PutCoord Point2
|
| PutCoord Point2
|
||||||
| PutMod Modification
|
| PutMod Modification
|
||||||
| PutTrigger (World -> Bool)
|
| PutTrigger (World -> Bool)
|
||||||
| PutLineBlock {_putWall :: Wall , _putStartPoint :: Point2, _putEndPoint :: Point2}
|
| PutLineBlock {_putWall :: Wall , _putWidth :: Float
|
||||||
|
, _putStartPoint :: Point2, _putEndPoint :: Point2}
|
||||||
| PutWall { _pwPoly :: [Point2] , _pwWall :: Wall }
|
| PutWall { _pwPoly :: [Point2] , _pwWall :: Wall }
|
||||||
| PutSlideDr Door Wall Float Point2 Point2
|
| PutSlideDr Door Wall Float Point2 Point2
|
||||||
| PutDoor Color (World -> Bool) [(Point2,Point2)]
|
| PutDoor Color (World -> Bool) [(Point2,Point2)]
|
||||||
|
|||||||
@@ -37,20 +37,20 @@ singleBlock a =
|
|||||||
Places a line of blocks between two points.
|
Places a line of blocks between two points.
|
||||||
-}
|
-}
|
||||||
blockLine :: Point2 -> Point2 -> Placement
|
blockLine :: Point2 -> Point2 -> Placement
|
||||||
blockLine a b = sps0 $ PutLineBlock baseBlockPane a b
|
blockLine a b = sps0 $ PutLineBlock baseBlockPane 9 a b
|
||||||
|
|
||||||
{-
|
{-
|
||||||
Places an breakable window between two points.
|
Places an breakable window between two points.
|
||||||
Width 8, also extends out from each point by 8.
|
Width 8, also extends out from each point by 8.
|
||||||
-}
|
-}
|
||||||
windowLine :: Point2 -> Point2 -> Placement
|
windowLine :: Point2 -> Point2 -> Placement
|
||||||
windowLine a b = sps0 $ PutLineBlock defaultWindow a b
|
windowLine a b = sps0 $ PutLineBlock defaultWindow 8 a b
|
||||||
{-
|
{-
|
||||||
Places an unbreakable window between two points.
|
Places an unbreakable window between two points.
|
||||||
Width 7, also extends out from each point by 7.
|
Width 7, also extends out from each point by 7.
|
||||||
-}
|
-}
|
||||||
crystalLine :: Point2 -> Point2 -> Placement
|
crystalLine :: Point2 -> Point2 -> Placement
|
||||||
crystalLine a b = sps0 $ PutLineBlock defaultCrystalWall a b
|
crystalLine a b = sps0 $ PutLineBlock defaultCrystalWall 7 a b
|
||||||
--crystalLine a b = sps0 $ PutWall ps defaultCrystalWall
|
--crystalLine a b = sps0 $ PutWall ps defaultCrystalWall
|
||||||
-- where
|
-- where
|
||||||
-- ps =
|
-- ps =
|
||||||
@@ -76,7 +76,7 @@ wallLine a b = sps0 $ PutWall ps defaultWall
|
|||||||
up = vNormal left
|
up = vNormal left
|
||||||
|
|
||||||
windowLineType :: Point2 -> Point2 -> PSType
|
windowLineType :: Point2 -> Point2 -> PSType
|
||||||
windowLineType = PutLineBlock defaultWindow
|
windowLineType = PutLineBlock defaultWindow 8
|
||||||
|
|
||||||
baseBlockPane :: Wall
|
baseBlockPane :: Wall
|
||||||
baseBlockPane = defaultWall
|
baseBlockPane = defaultWall
|
||||||
@@ -123,7 +123,7 @@ putBlockRect' w h = ps0jPushPS (aline tl tr)
|
|||||||
tr = V2 w h
|
tr = V2 w h
|
||||||
br = V2 w (-h)
|
br = V2 w (-h)
|
||||||
bl = V2 (-w) (-h)
|
bl = V2 (-w) (-h)
|
||||||
aline = PutLineBlock baseBlockPane
|
aline = PutLineBlock baseBlockPane 9
|
||||||
|
|
||||||
putBlockRect :: Float -> Float -> Float -> Float -> [Placement]
|
putBlockRect :: Float -> Float -> Float -> Float -> [Placement]
|
||||||
putBlockRect a x b y =
|
putBlockRect a x b y =
|
||||||
|
|||||||
@@ -101,7 +101,7 @@ placeSpotID ps pt w = case pt of
|
|||||||
-> plSlideDoor wl dr off (doShift a) (doShift b) w
|
-> plSlideDoor wl dr off (doShift a) (doShift b) w
|
||||||
PutBlock bl wl ps' -> plBlock (map doShift ps') (bl & blPos %~ doShift & blDir .~ rot)
|
PutBlock bl wl ps' -> plBlock (map doShift ps') (bl & blPos %~ doShift & blDir .~ rot)
|
||||||
wl w
|
wl w
|
||||||
PutLineBlock wl a b -> plLineBlock wl (doShift a) (doShift b) w
|
PutLineBlock wl wdth a b -> plLineBlock wl wdth (doShift a) (doShift b) w
|
||||||
PutWall qs wl -> (0,placeWallPoly (map doShift qs) wl w)
|
PutWall qs wl -> (0,placeWallPoly (map doShift qs) wl w)
|
||||||
PutNothing -> (0,w)
|
PutNothing -> (0,w)
|
||||||
PutID i -> (i, w)
|
PutID i -> (i, w)
|
||||||
|
|||||||
@@ -44,16 +44,16 @@ plBlock (p:ps) bl wl w = (,) blid $ w
|
|||||||
{- | Splits a line into many four cornered blocks. -}
|
{- | Splits a line into many four cornered blocks. -}
|
||||||
plLineBlock
|
plLineBlock
|
||||||
:: Wall -- ^ Base pane
|
:: Wall -- ^ Base pane
|
||||||
|
-> Float
|
||||||
-> Point2 -- ^ Start point (symmetric)
|
-> Point2 -- ^ Start point (symmetric)
|
||||||
-> Point2 -- ^ End point (symmetric)
|
-> Point2 -- ^ End point (symmetric)
|
||||||
-> World
|
-> World
|
||||||
-> (Int, World)
|
-> (Int, World)
|
||||||
plLineBlock basePane a b gw = ( 0
|
plLineBlock basePane blwidth a b gw = ( 0
|
||||||
, foldr insertWall (insertBlocks gw) listWalls
|
, foldr insertWall (insertBlocks gw) listWalls
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
blwidth = 10
|
depth = blwidth
|
||||||
depth = 10
|
|
||||||
psOnLine = divideLineOddNumPoints blwidth a b
|
psOnLine = divideLineOddNumPoints blwidth a b
|
||||||
halfBlockWidth = dist a b / fromIntegral (length psOnLine - 1)
|
halfBlockWidth = dist a b / fromIntegral (length psOnLine - 1)
|
||||||
blockCenPs = snd $ evenOddSplit psOnLine
|
blockCenPs = snd $ evenOddSplit psOnLine
|
||||||
|
|||||||
@@ -30,7 +30,7 @@ blockPillar w' h' = ps0jPushPS (aline tl tr)
|
|||||||
tr = V2 w h
|
tr = V2 w h
|
||||||
br = V2 w (-h)
|
br = V2 w (-h)
|
||||||
bl = V2 (-w) (-h)
|
bl = V2 (-w) (-h)
|
||||||
aline = PutLineBlock baseBlockPane
|
aline = PutLineBlock baseBlockPane 9
|
||||||
|
|
||||||
smallPillar :: PSType
|
smallPillar :: PSType
|
||||||
smallPillar = PutBlock defaultBlock baseBlockPane $ reverse $ square 5
|
smallPillar = PutBlock defaultBlock baseBlockPane $ reverse $ square 5
|
||||||
@@ -39,9 +39,9 @@ crossPillar :: Float -> Float -> Placement
|
|||||||
crossPillar w' h' = ps0jPushPS (aline (V2 (-w) 0) (V2 w 0))
|
crossPillar w' h' = ps0jPushPS (aline (V2 (-w) 0) (V2 w 0))
|
||||||
$ sps0 (aline (V2 0 (-h)) (V2 0 h))
|
$ sps0 (aline (V2 0 (-h)) (V2 0 h))
|
||||||
where
|
where
|
||||||
w = w' - 10
|
w = w' - 9
|
||||||
h = h' - 10
|
h = h' - 9
|
||||||
aline = PutLineBlock baseBlockPane
|
aline = PutLineBlock baseBlockPane 9
|
||||||
|
|
||||||
roomPillarsSquare :: RandomGen g => State g Room
|
roomPillarsSquare :: RandomGen g => State g Room
|
||||||
roomPillarsSquare = do
|
roomPillarsSquare = do
|
||||||
|
|||||||
Reference in New Issue
Block a user