From 1ccb87ff13a4449c2ebbafc5af548680016c54e9 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 12 Jul 2022 10:57:37 +0100 Subject: [PATCH] Make tanks into decorated blocks --- src/Dodge/Data.hs | 7 ++--- src/Dodge/Default/Block.hs | 2 ++ src/Dodge/Default/Wall.hs | 3 -- src/Dodge/Placement/Instance/Block.hs | 12 +++++--- src/Dodge/Placement/Instance/Tank.hs | 31 ++++++++------------ src/Dodge/Placement/PlaceSpot/Block.hs | 2 ++ src/Dodge/Placement/PlaceSpot/TriggerDoor.hs | 4 ++- src/Dodge/Render/Walls.hs | 4 +-- 8 files changed, 33 insertions(+), 32 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 8782a85fd..1b4688af4 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -986,6 +986,8 @@ data Block = Block , _blFootprint :: [Point2] , _blPos :: Point2 , _blDir :: Float + , _blHeight :: Float + , _blMaterial :: Material , _blDraw :: Block -> SPic , _blDeath :: Block -> World -> World , _blObstructs :: [(Int,Int,PathEdge)] @@ -1064,10 +1066,6 @@ data MachineType , _tuFireTime :: Int , _tuMCrID :: Maybe Int } -data BlockShifter = BlockShifter - { _bsID :: Int - , _bsBlocks :: IS.IntSet - } data Door = Door { _drID :: Int , _drWallIDs :: IS.IntSet @@ -1097,6 +1095,7 @@ data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int data PushSource = PushesItself | PushedBy Int | NotPushed + deriving (Eq,Ord,Show) data ActionPlan = Inanimate diff --git a/src/Dodge/Default/Block.hs b/src/Dodge/Default/Block.hs index c7813c4c8..2754f8327 100644 --- a/src/Dodge/Default/Block.hs +++ b/src/Dodge/Default/Block.hs @@ -14,6 +14,8 @@ defaultBlock = Block , _blDir = 0 , _blDraw = const mempty , _blDeath = makeBlockDebris + , _blHeight = 100 + , _blMaterial = Stone , _blObstructs = [] } defaultDirtBlock :: Block diff --git a/src/Dodge/Default/Wall.hs b/src/Dodge/Default/Wall.hs index a8165ef51..0ffa1b097 100644 --- a/src/Dodge/Default/Wall.hs +++ b/src/Dodge/Default/Wall.hs @@ -38,7 +38,6 @@ defaultCrystalWall = defaultWall defaultMachineWall :: Wall defaultMachineWall = defaultWall { _wlOpacity = SeeAbove - , _wlUnshadowed = False , _wlRotateTo = False , _wlStructure = MachinePart 0 , _wlMaterial = Metal @@ -51,7 +50,6 @@ defaultDirtWall = defaultWall , _wlSeen = False , _wlOpacity = Opaque , _wlRotateTo = False - , _wlUnshadowed = True , _wlFireThrough = True , _wlMaterial = Dirt } @@ -62,7 +60,6 @@ defaultWindow = defaultWall , _wlColor = withAlpha 0.5 cyan , _wlSeen = False , _wlOpacity = SeeThrough - , _wlUnshadowed = True , _wlFireThrough = True , _wlMaterial = Glass } diff --git a/src/Dodge/Placement/Instance/Block.hs b/src/Dodge/Placement/Instance/Block.hs index 89ec0e94b..5d0b78f81 100644 --- a/src/Dodge/Placement/Instance/Block.hs +++ b/src/Dodge/Placement/Instance/Block.hs @@ -8,16 +8,20 @@ import Shape import Dodge.Default.Wall import Dodge.Default.Block -lowBlock :: Material -> Color -> Float -> [Point2] -> PSType -lowBlock mat col h ps = PutBlock bl wl $ reverse ps +decoratedBlock :: (Block -> Shape) -> Material -> Color -> Float -> [Point2] -> PSType +decoratedBlock decf mat col h ps = PutBlock bl wl $ reverse ps where bl = defaultBlock - & blDraw .~ const (noPic $ colorSH col (upperPrismPoly h $ reverse ps)) + & blDraw .~ (\bl' -> noPic (colorSH col (upperPrismPoly h $ reverse ps) <> decf bl')) & blDeath .~ const id + & blHeight .~ h + & blMaterial .~ mat wl = defaultWall - & wlUnshadowed .~ False & wlColor .~ col & wlRotateTo .~ False & wlOpacity .~ SeeAbove & wlMaterial .~ mat & wlHeight .~ h + +lowBlock :: Material -> Color -> Float -> [Point2] -> PSType +lowBlock = decoratedBlock (const mempty) diff --git a/src/Dodge/Placement/Instance/Tank.hs b/src/Dodge/Placement/Instance/Tank.hs index f044c1c85..bb5ae0f19 100644 --- a/src/Dodge/Placement/Instance/Tank.hs +++ b/src/Dodge/Placement/Instance/Tank.hs @@ -4,17 +4,13 @@ module Dodge.Placement.Instance.Tank , roundTankCross ) where import Dodge.Data -import Dodge.Default.Block ---import Dodge.Placement.PlaceSpot import Dodge.LevelGen.Data import Dodge.Room.Foreground -import Dodge.Default.Wall ---import Dodge.Placement.TopDecoration +import Dodge.Placement.Instance.Block import Geometry import Shape -import ShapePicture import Color -import LensHelp +--import LensHelp --import Quaternion tankSquareDec :: (Float -> Float -> Float -> Color -> Color -> Shape) @@ -22,18 +18,17 @@ tankSquareDec :: (Float -> Float -> Float -> Color -> Color -> Shape) tankSquareDec dec = tankShape (square 20) (dec 20 20 31) tankShape :: [Point2] -> (Color -> Color -> Shape) -> Color -> Color -> Placement -tankShape baseshape facade col col' - = sps0 $ PutBlock bl wl $ reverse baseshape - where - bl = defaultBlock - & blDraw .~ const (noPic $ colorSH col (upperPrismPoly 31 $ reverse baseshape) <> facade col col') - & blDeath .~ const id - wl = defaultWall - & wlUnshadowed .~ False - & wlColor .~ col - & wlRotateTo .~ False - & wlOpacity .~ SeeAbove - & wlMaterial .~ Metal +tankShape baseshape facade col col' = sps0 $ decoratedBlock (const $ facade col col') Metal col 31 baseshape +-- = sps0 $ PutBlock bl wl $ reverse baseshape +-- where +-- bl = defaultBlock +-- & blDraw .~ const (noPic $ colorSH col (upperPrismPoly 31 $ reverse baseshape) <> facade col col') +-- & blDeath .~ const id +-- wl = defaultWall +-- & wlColor .~ col +-- & wlRotateTo .~ False +-- & wlOpacity .~ SeeAbove +-- & wlMaterial .~ Metal -- = ps0jPushPS -- (PutShape $ colorSH col (upperPrismPoly 31 baseshape) <> facade col col') diff --git a/src/Dodge/Placement/PlaceSpot/Block.hs b/src/Dodge/Placement/PlaceSpot/Block.hs index 468e0ea66..17c8e8f38 100644 --- a/src/Dodge/Placement/PlaceSpot/Block.hs +++ b/src/Dodge/Placement/PlaceSpot/Block.hs @@ -74,6 +74,8 @@ plLineBlock basePane blwidth a b gw = ( 0 , _blDir = 0 -- THIS IS NOT SENSIBLE. TODO rethink block positioning , _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise) , _blObstructs = [] + , _blMaterial = _wlMaterial basePane + , _blHeight = 100 , _blPos = p, _blDraw = const mempty , _blDeath = makeBlockDebris} ) insertBlocks = flip (foldr insertBlock) $ zip is blockCenPs diff --git a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs index de8bc02f1..7d260c52b 100644 --- a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs +++ b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs @@ -101,7 +101,9 @@ doorMechanism dr w = case mvDir of speed = _drSpeed dr drid = _drID dr moveUpdate = playSound . setStatus - playSound = soundContinue (WallSound drid) dpos slideDoorS (Just 1) + playSound + | _drPushedBy dr == PushesItself = soundContinue (WallSound drid) dpos slideDoorS (Just 1) + | otherwise = id dpos = snd $ _drPos dr dop = snd $ _drOpenPos dr dcp = snd $ _drClosePos dr diff --git a/src/Dodge/Render/Walls.hs b/src/Dodge/Render/Walls.hs index d2974a3f5..f3621cde6 100644 --- a/src/Dodge/Render/Walls.hs +++ b/src/Dodge/Render/Walls.hs @@ -29,9 +29,9 @@ wallsToDraw w g (V2 i j) = w ^? wlZoning . znObjects . ix i . ix j wlOpaqueDraw :: Wall -> Bool -wlOpaqueDraw wl = wlIsOpaque wl && _wlUnshadowed wl +wlOpaqueDraw wl = wlIsOpaque wl && _wlHeight wl == 100 wlSeeThroughDraw :: Wall -> Bool -wlSeeThroughDraw wl = wlIsSeeThrough wl && _wlUnshadowed wl +wlSeeThroughDraw wl = wlIsSeeThrough wl && _wlHeight wl == 100 getWallSPic :: Wall -> SPic getWallSPic wl = case wl ^? wlOpacity . opDraw of