diff --git a/src/Dodge/Block.hs b/src/Dodge/Block.hs index eb465443e..f2dcd7552 100644 --- a/src/Dodge/Block.hs +++ b/src/Dodge/Block.hs @@ -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 diff --git a/src/Dodge/Config/Data.hs b/src/Dodge/Config/Data.hs index caa3baa51..da6fa6124 100644 --- a/src/Dodge/Config/Data.hs +++ b/src/Dodge/Config/Data.hs @@ -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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index c863e0f9b..40d0b9524 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 } diff --git a/src/Dodge/Default/Block.hs b/src/Dodge/Default/Block.hs index b9e9d2f27..345a1a74c 100644 --- a/src/Dodge/Default/Block.hs +++ b/src/Dodge/Default/Block.hs @@ -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 diff --git a/src/Dodge/Placement/Instance/Tank.hs b/src/Dodge/Placement/Instance/Tank.hs index 97293dd29..02dc24061 100644 --- a/src/Dodge/Placement/Instance/Tank.hs +++ b/src/Dodge/Placement/Instance/Tank.hs @@ -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) diff --git a/src/Dodge/Placement/Instance/Wall.hs b/src/Dodge/Placement/Instance/Wall.hs index 45ce2d3d2..c9e51ea96 100644 --- a/src/Dodge/Placement/Instance/Wall.hs +++ b/src/Dodge/Placement/Instance/Wall.hs @@ -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 diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index f723b7cbb..fa2bec9e1 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/src/Dodge/Placement/PlaceSpot.hs @@ -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 diff --git a/src/Dodge/Placement/PlaceSpot/Block.hs b/src/Dodge/Placement/PlaceSpot/Block.hs index fe8b105c4..c582f03a8 100644 --- a/src/Dodge/Placement/PlaceSpot/Block.hs +++ b/src/Dodge/Placement/PlaceSpot/Block.hs @@ -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 diff --git a/src/Dodge/Room/Pillar.hs b/src/Dodge/Room/Pillar.hs index 492403a4e..dfbaecd44 100644 --- a/src/Dodge/Room/Pillar.hs +++ b/src/Dodge/Room/Pillar.hs @@ -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 diff --git a/src/Dodge/Wall/DamageEffect.hs b/src/Dodge/Wall/DamageEffect.hs index f955c83ca..ecc7c9a06 100644 --- a/src/Dodge/Wall/DamageEffect.hs +++ b/src/Dodge/Wall/DamageEffect.hs @@ -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