Make "tanks" into Blocks
This commit is contained in:
+1
-1
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user