Allow for lineBlocks to have different sizes

This commit is contained in:
2022-07-01 21:28:30 +01:00
parent 650b2387b8
commit c866c147b9
5 changed files with 15 additions and 14 deletions
+2 -1
View File
@@ -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)]
+5 -5
View File
@@ -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 =
+1 -1
View File
@@ -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)
+3 -3
View File
@@ -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
+4 -4
View File
@@ -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