Reallow different line block sizes
This commit is contained in:
+1
-1
@@ -1406,7 +1406,7 @@ data PSType = PutCrit {_unPutCrit :: Creature}
|
||||
| PutMod Modification
|
||||
| PutTrigger (World -> Bool)
|
||||
| PutLineBlock {_putWall :: Wall , _putWidth :: Float
|
||||
, _putDepth :: Float, _putStartPoint :: Point2, _putEndPoint :: Point2}
|
||||
, _putStartPoint :: Point2, _putEndPoint :: Point2}
|
||||
| PutWall { _pwPoly :: [Point2] , _pwWall :: Wall }
|
||||
| PutSlideDr Door Wall Float Point2 Point2
|
||||
| PutDoor Color (World -> Bool) [(Point2,Point2)]
|
||||
|
||||
@@ -35,23 +35,22 @@ singleBlock a =
|
||||
]
|
||||
{-
|
||||
Places a line of blocks between two points.
|
||||
Width 9, also extends out from each point by 9.
|
||||
-}
|
||||
blockLine :: Point2 -> Point2 -> Placement
|
||||
blockLine a b = sps0 $ PutLineBlock baseBlockPane 9 9 a b
|
||||
blockLine a b = sps0 $ PutLineBlock baseBlockPane 9 a b
|
||||
|
||||
{-
|
||||
Places an breakable window between two points.
|
||||
Width 8, also extends out from each point by 8.
|
||||
-}
|
||||
windowLine :: Point2 -> Point2 -> Placement
|
||||
windowLine a b = sps0 $ PutLineBlock defaultWindow 8 8 a b
|
||||
windowLine a b = sps0 $ PutLineBlock defaultWindow 8 a b
|
||||
{-
|
||||
Places an unbreakable window between two points.
|
||||
Width 7, also extends out from each point by 7.
|
||||
-}
|
||||
crystalLine :: Point2 -> Point2 -> Placement
|
||||
crystalLine a b = sps0 $ PutLineBlock defaultCrystalWall 7 7 a b
|
||||
crystalLine a b = sps0 $ PutLineBlock defaultCrystalWall 7 a b
|
||||
--crystalLine a b = sps0 $ PutWall ps defaultCrystalWall
|
||||
-- where
|
||||
-- ps =
|
||||
@@ -77,7 +76,7 @@ wallLine a b = sps0 $ PutWall ps defaultWall
|
||||
up = vNormal left
|
||||
|
||||
windowLineType :: Point2 -> Point2 -> PSType
|
||||
windowLineType = PutLineBlock defaultWindow 8 8
|
||||
windowLineType = PutLineBlock defaultWindow 8
|
||||
|
||||
baseBlockPane :: Wall
|
||||
baseBlockPane = defaultWall
|
||||
@@ -124,7 +123,7 @@ putBlockRect' w h = ps0jPushPS (aline tl tr)
|
||||
tr = V2 w h
|
||||
br = V2 w (-h)
|
||||
bl = V2 (-w) (-h)
|
||||
aline = PutLineBlock baseBlockPane 9 9
|
||||
aline = PutLineBlock baseBlockPane 9
|
||||
|
||||
putBlockRect :: Float -> Float -> Float -> Float -> [Placement]
|
||||
putBlockRect a x b y =
|
||||
|
||||
@@ -99,9 +99,9 @@ placeSpotID ps pt w = case pt of
|
||||
PutCoord cp -> plNewID coordinates (doShift cp) w
|
||||
PutSlideDr wl dr off a b
|
||||
-> plSlideDoor wl dr off (doShift a) (doShift b) w
|
||||
PutBlock bl wl ps' -> placeBlock (map doShift ps') (bl & blPos %~ doShift & blDir .~ rot)
|
||||
PutBlock bl wl ps' -> plBlock (map doShift ps') (bl & blPos %~ doShift & blDir .~ rot)
|
||||
wl w
|
||||
PutLineBlock wl wdth dpth a b -> placeLineBlock wl wdth dpth (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)
|
||||
PutNothing -> (0,w)
|
||||
PutID i -> (i, w)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- | Creation, update and destruction of destructible walls. -}
|
||||
module Dodge.Placement.PlaceSpot.Block
|
||||
( placeBlock
|
||||
, placeLineBlock
|
||||
( plBlock
|
||||
, plLineBlock
|
||||
)
|
||||
where
|
||||
import Dodge.Data
|
||||
@@ -17,63 +17,45 @@ import Control.Lens
|
||||
import Data.List
|
||||
import qualified Data.IntSet as IS
|
||||
|
||||
addBlock
|
||||
plBlock
|
||||
:: [Point2] -- ^ Block polygon
|
||||
-> Wall -- ^ Base Pane
|
||||
-> Block
|
||||
-> Wall -- ^ Base Pane
|
||||
-> World
|
||||
-> World
|
||||
addBlock (p:ps) wl bl w = w
|
||||
& wlZoning . znObjects %~ flip (IM.foldl' $ flip wallInZone) panes
|
||||
& walls %~ IM.union panes
|
||||
& blocks %~ IM.insert blid bl
|
||||
{_blID = blid,_blWallIDs = IS.fromList is, _blShadows=[]
|
||||
, _blFootprint = p:ps
|
||||
}
|
||||
-> (Int,World)
|
||||
plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon"
|
||||
plBlock (p:ps) bl wl w = (,) blid $ w
|
||||
& flip (foldr insertWall) wls
|
||||
& blocks . at blid ?~ bl
|
||||
{ _blID = blid
|
||||
, _blWallIDs = IS.fromList is
|
||||
, _blShadows = []
|
||||
, _blFootprint = p:ps
|
||||
}
|
||||
where
|
||||
blid = IM.newKey $ _blocks w
|
||||
lns = zip (p:ps) (ps ++ [p])
|
||||
i = IM.newKey $ _walls w
|
||||
is = [i.. i + length lns-1]
|
||||
panes = IM.fromList $ zipWith
|
||||
(\j (a,b) -> (,) j wl
|
||||
{ _wlLine = (a,b)
|
||||
, _wlID = j
|
||||
, _wlStructure = BlockPart blid
|
||||
}
|
||||
) is lns
|
||||
wallInZone wl'
|
||||
| uncurry dist (_wlLine wl') <= 2*wlZoneSize
|
||||
= insertIMInZone x y wlid wl'
|
||||
| otherwise = flip (foldl' $ flip (\(a,b) -> insertIMInZone a b wlid wl')) ips
|
||||
where
|
||||
V2 x y = wlZoneOfPoint $ uncurry midPoint (_wlLine wl)
|
||||
wlid = _wlID wl
|
||||
ips = map (unv2 . wlZoneOfPoint) $ uncurry (divideLine (2*wlZoneSize)) (_wlLine wl)
|
||||
unv2 (V2 x' y') = (x',y')
|
||||
addBlock _ _ _ _ = error "Trying to add a block with incomplete polygon"
|
||||
wls = zipWith
|
||||
(\j ln -> wl & wlLine .~ ln & wlID .~ j & wlStructure .~ BlockPart blid)
|
||||
is
|
||||
lns
|
||||
|
||||
placeBlock :: [Point2] -> Block -> Wall -> World -> (Int,World)
|
||||
placeBlock poly bl wl w
|
||||
= (0, foldr (uncurry removePathsCrossing) wWithBlock pairs)
|
||||
where
|
||||
pairs = loopPairs poly
|
||||
wWithBlock = addBlock poly wl bl w
|
||||
|
||||
{- | Splits a line into many four cornered blocks. -}
|
||||
placeLineBlock
|
||||
plLineBlock
|
||||
:: Wall -- ^ Base pane
|
||||
-> Float -- ^ Block width
|
||||
-> Float -- ^ Block depth
|
||||
-> Float
|
||||
-> Point2 -- ^ Start point (symmetric)
|
||||
-> Point2 -- ^ End point (symmetric)
|
||||
-> World
|
||||
-> (Int, World)
|
||||
placeLineBlock basePane blockWidth depth a b gw = ( 0
|
||||
, removePathsCrossing a b (foldr insertWall (insertBlocks gw) listWalls)
|
||||
plLineBlock basePane blwidth a b gw = ( 0
|
||||
, foldr insertWall (insertBlocks gw) listWalls
|
||||
)
|
||||
where
|
||||
psOnLine = divideLineOddNumPoints blockWidth a b
|
||||
depth = blwidth
|
||||
psOnLine = divideLineOddNumPoints blwidth a b
|
||||
halfBlockWidth = dist a b / fromIntegral (length psOnLine - 1)
|
||||
blockCenPs = snd $ evenOddSplit psOnLine
|
||||
numBlocks = length blockCenPs
|
||||
@@ -108,4 +90,7 @@ placeLineBlock basePane blockWidth depth a b gw = ( 0
|
||||
,_wlDraw = visStatus
|
||||
}
|
||||
listWalls = concat $ zipWith makeWallAt blockCenPs is
|
||||
insertWall wl = over walls $ IM.insert (_wlID wl) wl
|
||||
|
||||
insertWall :: Wall -> World -> World
|
||||
insertWall wl = (walls . at (_wlID wl) ?~ wl)
|
||||
-- . uncurry (addObstacleCrossing' BlockObstacle) (_wlLine wl)
|
||||
|
||||
@@ -30,7 +30,7 @@ blockPillar w' h' = ps0jPushPS (aline tl tr)
|
||||
tr = V2 w h
|
||||
br = V2 w (-h)
|
||||
bl = V2 (-w) (-h)
|
||||
aline = PutLineBlock baseBlockPane 9 9
|
||||
aline = PutLineBlock baseBlockPane 9
|
||||
|
||||
smallPillar :: PSType
|
||||
smallPillar = PutBlock defaultBlock baseBlockPane $ reverse $ square 5
|
||||
@@ -41,7 +41,7 @@ crossPillar w' h' = ps0jPushPS (aline (V2 (-w) 0) (V2 w 0))
|
||||
where
|
||||
w = w' - 9
|
||||
h = h' - 9
|
||||
aline = PutLineBlock baseBlockPane 9 9
|
||||
aline = PutLineBlock baseBlockPane 9
|
||||
|
||||
roomPillarsSquare :: RandomGen g => State g Room
|
||||
roomPillarsSquare = do
|
||||
|
||||
Reference in New Issue
Block a user