Make "tanks" into Blocks

This commit is contained in:
2022-06-18 23:28:17 +01:00
parent cc93fc83d7
commit bae0f7dcad
10 changed files with 38 additions and 19 deletions
+1 -1
View File
@@ -1,6 +1,6 @@
module Dodge.Block where
import Dodge.Data
import Dodge.Block.Debris
--import Dodge.Block.Debris
import Dodge.SoundLogic
import Dodge.Zone
import Dodge.WorldEvent.Sound
+1 -1
View File
@@ -13,7 +13,7 @@ data Configuration = Configuration
, _volume_music :: Float
, _graphics_wall_textured :: Bool
, _graphics_cloud_shadows :: Bool
, _graphics_object_shadows :: Bool
, _graphics_object_shadows :: Bool
, _graphics_resolution_factor :: ResFactor
, _windowX :: Float
, _windowY :: Float
+1
View File
@@ -924,6 +924,7 @@ data Block = Block
, _blShadows :: [Int] -- a list of blocks/walls? that are not shown when this block exists
, _blFootprint :: [Point2]
, _blPos :: Point2
, _blRot :: Float
, _blDraw :: Block -> SPic
, _blDeath :: Block -> World -> World
}
+3 -2
View File
@@ -11,8 +11,9 @@ defaultBlock = Block
, _blShadows = []
, _blFootprint = []
, _blPos = 0
, _blRot = 0
, _blDraw = const mempty
, _blDeath = makeBlockDebris
, _blDeath = makeBlockDebris
}
defaultDirtBlock :: Block
defaultDirtBlock = defaultBlock & blHP .~ 50
+20 -4
View File
@@ -4,6 +4,7 @@ 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
@@ -11,7 +12,9 @@ import Dodge.Default.Wall
--import Dodge.Placement.TopDecoration
import Geometry
import Shape
import ShapePicture
import Color
import LensHelp
--import Quaternion
tankSquareDec :: (Float -> Float -> Float -> Color -> Color -> Shape)
@@ -19,10 +22,23 @@ 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' = ps0jPushPS
(PutShape $ colorSH col (upperPrismPoly 31 baseshape) <> facade col col')
$ sps0 $ PutWall baseshape defaultWall
{_wlDraw = False, _wlColor = col, _wlRotateTo = False, _wlOpacity = SeeAbove}
tankShape baseshape facade col col'
= sps0 $ PutBlock bl wl $ reverse baseshape
where
bl = defaultBlock
& blDraw .~ (\bl' -> (noPic $ uncurryV translateSHf (_blPos bl') $ rotateSH (_blRot bl') $ colorSH col (upperPrismPoly 31 $ reverse baseshape) <> facade col col'))
& blDeath .~ const id
wl = defaultWall
& wlDraw .~ False
& wlColor .~ col
& wlRotateTo .~ False
& wlOpacity .~ SeeAbove
& wlMaterial .~ Metal
-- = ps0jPushPS
-- (PutShape $ colorSH col (upperPrismPoly 31 baseshape) <> facade col col')
-- $ sps0 $ PutWall baseshape defaultWall
-- {_wlDraw = False, _wlColor = col, _wlRotateTo = False, _wlOpacity = SeeAbove}
roundTank :: Color -> Color -> Placement
roundTank = tankShape (polyCirc 4 20)
+1 -1
View File
@@ -2,7 +2,7 @@ module Dodge.Placement.Instance.Wall
where
import Dodge.Data
import Dodge.Default.Block
import Dodge.Block.Debris
--import Dodge.Block.Debris
import Dodge.LevelGen.Data
import Dodge.Default.Wall
--import Dodge.Wall.DamageEffect
+2 -2
View File
@@ -103,8 +103,8 @@ placeSpotID ps pt w = case pt of
PutCoord cp -> plNewID coordinates (doShift cp) w
PutSlideDr pth col f off a b spd
-> plSlideDoor pth col f off (doShift a) (doShift b) spd w
PutBlock bl wl ps'
-> placeBlock (map doShift ps') bl wl w
PutBlock bl wl ps' -> placeBlock (map doShift ps') (bl & blPos %~ doShift & blRot .~ rot)
wl w
PutLineBlock wl wdth dpth a b -> placeLineBlock wl wdth dpth (doShift a) (doShift b) w
PutWall qs wl -> (0,placeWallPoly (map doShift qs) wl w)
PutShape sh -> placeShape sh p rot w
+3 -2
View File
@@ -28,8 +28,8 @@ addBlock (p:ps) wl bl w = w
& walls %~ IM.union panes
& blocks %~ IM.insert blid bl
{_blID = blid,_blWallIDs = IS.fromList is, _blShadows=[]
, _blFootprint = p:ps, _blPos = centroid (p:ps), _blDraw = const mempty
, _blDeath = makeBlockDebris}
, _blFootprint = p:ps
}
where
blid = IM.newKey $ _blocks w
lns = zip (p:ps) (ps ++ [p])
@@ -85,6 +85,7 @@ placeLineBlock basePane blockWidth depth a b gw = ( 0
insertBlock (i,p) = over blocks $ IM.insert (i+blid) Block
{ _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i
, _blHP = 1000, _blShadows = shadowsAt i
, _blRot = 0 -- THIS IS NOT SENSIBLE. TODO rethink block positioning
, _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise)
, _blPos = p, _blDraw = const mempty , _blDeath = makeBlockDebris}
insertBlocks = flip (foldr insertBlock) $ zip is blockCenPs
+2 -2
View File
@@ -33,7 +33,7 @@ blockPillar w' h' = ps0jPushPS (aline tl tr)
aline = PutLineBlock baseBlockPane 9 9
smallPillar :: PSType
smallPillar = PutBlock defaultBlock 500 baseBlockPane $ reverse $ square 5
smallPillar = PutBlock defaultBlock baseBlockPane $ reverse $ square 5
crossPillar :: Float -> Float -> Placement
crossPillar w' h' = ps0jPushPS (aline (V2 (-w) 0) (V2 w 0))
@@ -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 StoneBlock 9 9
aline = PutLineBlock baseBlockPane 9 9
roomPillarsSquare :: RandomGen g => State g Room
roomPillarsSquare = do
+4 -4
View File
@@ -41,13 +41,13 @@ windowWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of
PIERCING -> dosplint . colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> dosplint . wlDustAt wl outTo
SHATTERING -> dosplint . muchWlDustAt wl outTo
CRUSHING -> dosplint . id
EXPLOSIVE -> dosplint . id
CUTTING -> dosplint . id
CRUSHING -> dosplint
EXPLOSIVE -> dosplint
CUTTING -> dosplint
SPARKING -> id
FLAMING -> id
ELECTRICAL -> id
CONCUSSIVE -> dosplint . id
CONCUSSIVE -> dosplint
TORQUEDAM -> id
PUSHDAM -> id
POISONDAM -> id