justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Fix no damage to walls bug

Browse Source
This commit is contained in:
justin
2022-07-28 18:57:53 +01:00
parent ec4ff84c46
commit c8ad3e1294
19 changed files with 177 additions and 158 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Machine/Destroy.hs
+7
View File
@@ -1,5 +1,6 @@
module Dodge.Machine.Destroy where
import Dodge.FloorItem
import Data.Maybe
import Dodge.Data.World
import Dodge.Wall.Delete
@@ -15,6 +16,12 @@ destroyMachine mc =
. makeExplosionAt (_mcPos mc)
. mcKillTerm mc
. mcKillBut mc
. destroyMcType (mc ^. mcType) mc
destroyMcType :: MachineType -> Machine -> World -> World
destroyMcType mt mc = case mt of
McTurret tu -> copyItemToFloor (_mcPos mc) (_tuWeapon tu)
_ -> id
mcKillTerm :: Machine -> World -> World
mcKillTerm mc w = fromMaybe w $ do
src/Dodge/Machine/Draw.hs
+33 -30
View File
@@ -1,58 +1,61 @@
module Dodge.Machine.Draw
where
import Dodge.Item.HeldOffset
import Dodge.Item.Draw.SPic
import Dodge.Placement.TopDecoration
import Shape
import Picture
import Geometry
module Dodge.Machine.Draw where
import Dodge.Data.Machine
import Dodge.Item.Draw.SPic
import Dodge.Item.HeldOffset
import Dodge.Placement.TopDecoration
import Geometry
import Picture
import Shape
import ShapePicture
drawMachine :: Machine -> SPic
drawMachine mc = case _mcType mc of
McStatic -> mempty
McTerminal -> terminalSPic mc
McTurret tu -> drawTurret tu mc
McSensor se -> drawSensor se mc
McTurret tu -> drawBaseMachine 20 mc <> drawTurret tu mc
McSensor se -> drawBaseMachine 25 mc <> drawSensor se mc
drawSensor :: Sensor -> Machine -> SPic
drawSensor sens = case sens of
DamageSensor {_sensDraw = pcds} -> sensorSPic pcds
ProximitySensor {} -> const mempty
DamageSensor{_sensDraw = pcds} -> sensorSPic pcds
ProximitySensor{} -> const mempty
terminalSPic :: Machine -> SPic
terminalSPic = noPic . terminalShape
terminalShape :: Machine -> Shape
terminalShape mc = colorSH col (prismPoly
[V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10]
[V3 10 10 0, V3 (-10) 10 0, V3 (-10) (-10) 0, V3 10 (-10) 0]
)
<> colorSH black (prismPoly
[V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10]
[V3 8 8 19, V3 (-8) 8 19, V3 0 (-8) 9]
--[V3 8 8 20, V3 (-8) 8 20, V3 (-8) (-8) 10, V3 8 (-8) 10]
--[V3 8 8 19, V3 (-8) 8 19, V3 (-8) (-8) 9, V3 8 (-8) 9]
)
terminalShape mc =
colorSH
col
( prismPoly
[V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10]
[V3 10 10 0, V3 (-10) 10 0, V3 (-10) (-10) 0, V3 10 (-10) 0]
)
<> colorSH
black
( prismPoly
[V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10]
[V3 8 8 19, V3 (-8) 8 19, V3 0 (-8) 9]
--[V3 8 8 20, V3 (-8) 8 20, V3 (-8) (-8) 10, V3 8 (-8) 10]
--[V3 8 8 19, V3 (-8) 8 19, V3 (-8) (-8) 9, V3 8 (-8) 9]
)
where
col = _mcColor mc
drawTurret :: Turret -> Machine -> SPic
drawTurret tu mc =
( colorSH (_mcColor mc) $ upperPrismPoly 20 (square w)
drawBaseMachine :: Float -> Machine -> SPic
drawBaseMachine h mc =
( colorSH (_mcColor mc) $ upperPrismPoly h (reverse $ square (_mcWidth mc))
, mempty
)
<> overPosSP (turretItemOffset it tu mc) (itemSPic it)
drawTurret :: Turret -> Machine -> SPic
drawTurret tu mc = overPosSP (turretItemOffset it tu mc) (itemSPic it)
where
it = _tuWeapon tu
w = _mcWidth mc
sensorSPic :: (PaletteColor, DecorationShape) -> Machine -> SPic
sensorSPic (pc, ds) mc =
noPic $
colorSH (_mcColor mc) (upperPrismPoly 25 (square w))
<> decorationToShape ds w w 25 col col
noPic $ decorationToShape ds w w 25 col col
where
col = paletteToColor pc
w = _mcWidth mc
src/Dodge/Machine/Update.hs
+38 -45
View File
@@ -1,22 +1,17 @@
module Dodge.Machine.Update where
import Control.Monad
import Data.List (partition)
import Data.Maybe
import Dodge.Base.Collide
import Dodge.Base.You
import Dodge.Data.World
import Dodge.FloorItem
import Dodge.HeldUse
import Dodge.Item.Held.BatteryGuns
import Dodge.Machine.Destroy
import Dodge.Movement.Turn
import Dodge.SoundLogic
import Dodge.Wall.Delete
import Dodge.WorldEvent.Explosion
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Control.Monad
updateMachine :: Machine -> World -> World
updateMachine mc
@@ -24,27 +19,21 @@ updateMachine mc
| otherwise =
mcApplyDamage (_mcDamage mc) mc
. mcPlaySound mc
. mcSensorTriggerUpdate mc
. mcTurretUpdate mc
. mcSensorUpdate mc
. mcTypeUpdate mc
mcTurretUpdate :: Machine -> World -> World
mcTurretUpdate mc = case mc ^? mcType . _McTurret of
Just tu -> updateTurret (_tuTurnSpeed tu) mc
_ -> id
mcTypeUpdate :: Machine -> World -> World
mcTypeUpdate mc = case mc ^. mcType of
McStatic -> id
McTerminal -> id
McTurret tu -> updateTurret (_tuTurnSpeed tu) mc
McSensor se -> mcSensorTriggerUpdate se mc . mcSensorUpdate se mc
updateTurret :: Float -> Machine -> World -> World
updateTurret rotSpeed mc w
| _mcHP mc < 1 =
w & cWorld . machines %~ IM.delete mcid
& deleteWallIDs (_mcWallIDs mc)
& makeExplosionAt mcpos
& copyItemToFloor mcpos lasGun
| otherwise =
w
& dodamage
& mcUseItem mc
& elecDamBranch
updateTurret rotSpeed mc w =
w
& dodamage
& mcUseItem mc
& elecDamBranch
where
dodamage =
cWorld . machines . ix mcid
@@ -77,17 +66,16 @@ mcUseItem mc = fromMaybe id $ do
guard (_tuFireTime tu > 0)
return $ mcUseHeld hit it mc
mcSensorTriggerUpdate :: Machine -> World -> World
mcSensorTriggerUpdate mc = fromMaybe id $ do
mcSensorTriggerUpdate :: Sensor -> Machine -> World -> World
mcSensorTriggerUpdate se mc = fromMaybe id $ do
trid <- mc ^? mcMounts . ix ObTrigger
bval <- mcTriggerVal mc
bval <- mcTriggerVal se
return $ cWorld . triggers . ix trid .~ bval
mcTriggerVal :: Machine -> Maybe Bool
mcTriggerVal mc = case mc ^? mcType . _McSensor of
Nothing -> Nothing
Just s@ProximitySensor{} -> s ^? sensToggle
Just s@DamageSensor{} -> Just $ _sensAmount s > 900
mcTriggerVal :: Sensor -> Maybe Bool
mcTriggerVal se = case se of
ProximitySensor{} -> se ^? sensToggle
DamageSensor{} -> Just $ _sensAmount se > _sensThreshold se
mcPlaySound :: Machine -> World -> World
mcPlaySound mc w = case _mcCloseSound mc of
@@ -101,16 +89,17 @@ mcPlaySound mc w = case _mcCloseSound mc of
mcApplyDamage :: [Damage] -> Machine -> World -> World
mcApplyDamage ds mc = case mc ^? mcType . _McSensor of
Nothing ->
cWorld . machines . ix (_mcID mc)
Nothing -> mcpointer
%~ ((mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)))
_ -> id
_ -> mcpointer
%~ (mcDamage .~ [])
where
mcpointer = cWorld . machines . ix (_mcID mc)
mcSensorUpdate :: Machine -> World -> World
mcSensorUpdate mc w = case mc ^? mcType . _McSensor of
Nothing -> w
Just s@DamageSensor{} -> senseDamage (_sensType s) mc w
Just ProximitySensor{} -> mcProximitySensorUpdate mc w
mcSensorUpdate :: Sensor -> Machine -> World -> World
mcSensorUpdate se mc w = case se of
s@DamageSensor{} -> senseDamage (_sensThreshold se) (_sensType s) mc w
ProximitySensor{} -> mcProximitySensorUpdate mc w
mcProximitySensorUpdate :: Machine -> World -> World
mcProximitySensorUpdate mc w = case ( _proxStatus sens
@@ -142,15 +131,19 @@ mcProxTest mc w = case mc ^? mcType . _McSensor . proxRequirement of
where
cr = you w
senseDamage :: DamageType -> Machine -> World -> World
senseDamage dt mc =
senseDamage :: Int -> DamageType -> Machine -> World -> World
senseDamage threshold dt mc =
(cWorld . machines . ix mcid %~ upmc)
. updatels
where
upmc = mcType . _McSensor . sensAmount %~ min 1000 . max 0 . (+ (newsense - 5))
upmc = mcType . _McSensor . sensAmount %~ min (100 * threshold) . max 0 . (+ newsense)
mcid = _mcID mc
newsense = sum . map _dmAmount $ filter ((== dt) . _dmType) (_mcDamage mc)
ni = fromIntegral (mc ^?! mcType . _McSensor . sensAmount) / 1000
newsense
| x > 0 = x
| otherwise = -5
where
x = sum . map _dmAmount $ filter ((== dt) . _dmType) (_mcDamage mc)
ni = fromIntegral (mc ^?! mcType . _McSensor . sensAmount) / fromIntegral threshold
updatels = fromMaybe id $ do
lsid <- mc ^? mcMounts . ix ObLightSource
return $ cWorld . lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni