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

Tweak bullet bouncing and spawning

Browse Source
This commit is contained in:
justin
2022-07-19 18:21:51 +01:00
parent 3031f2478c
commit 89d397a928
8 changed files with 49 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Bullet.hs
+17 -16
View File
@@ -17,7 +17,6 @@ import qualified Streaming.Prelude as S
import Data.Maybe
import Dodge.Movement.Turn
import Dodge.WorldEvent.ThingsHit
import Control.Monad.State
updateBullet :: World -> Bullet -> (World,Maybe Bullet)
updateBullet w bu = case _buState bu of
@@ -53,22 +52,12 @@ useAmmoParams it cr w = w & instantBullets .:~ (_amBullet bultype
mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet)
mvBullet x w bt'
| t <= 0 || magV (_buVel bt) < 1 = (endspawn w,Nothing)
| otherwise = bimap maybebounce (fmap dodrag) $
| otherwise = bimap id (fmap dodrag) $
hiteff bt hitstream w
where
endspawn w' = fromMaybe w' $ do
partspawn <- bulletSpawn bt'
return $ partspawn p w'
maybebounce = fromMaybe id $ do
guard (_buEffect bt' == BounceBullet)
(hp,crwl) <- runIdentity (S.head_ hitstream)
dir <- bounceDir (hp,crwl)
return $ instantBullets .:~ (bt
& buPos .~ hp +.+ normalizeV (_buPos bt' -.- hp)
& buVel %~ reflectIn dir
& buTrajectory .~ BasicBulletTrajectory
& buTimer -~ 1
)
hitstream = thingsHit p (p +.+ vel) w
bt = foldr (\mg b -> _mgField mg mg b) bt' (_magnets w)
& buState .~ NormalBulletState
@@ -86,7 +75,7 @@ mvBullet x w bt'
t = _buTimer bt
bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2
bounceDir (_,Right wl) = Just $ uncurry (-.-) (_wlLine wl)
bounceDir (_,Right wl) | _wlBouncy wl = Just $ uncurry (-.-) (_wlLine wl)
bounceDir (p,Left cr) | crIsArmouredFrom p cr = Just $ vNormal $ p -.- _crPos cr
bounceDir _ = Nothing
@@ -101,11 +90,23 @@ hitEffFromBul :: Float -> Bullet
-> Stream (Of (Point2, Either Creature Wall)) Identity ()
-> World
-> (World,Maybe Bullet)
hitEffFromBul x = expireAndDamage' x setfromtodams
hitEffFromBul x bu hitstream w = case _buEffect bu of
PenetrateBullet -> undefined
BounceBullet -> case runIdentity (S.head_ hitstream) of
Nothing -> (w, moveBullet x bu)
Just (hp,crwl) -> fromMaybe (expireAndDamage' x setfromtodams bu hitstream w) $ do
dir <- bounceDir (hp,crwl)
return $ (w,Just $ bu
& buPos .~ hp +.+ normalizeV (_buPos bu -.- hp)
& buVel %~ reflectIn dir
& buTrajectory .~ BasicBulletTrajectory
& buTimer -~ 1
)
DestroyBullet -> expireAndDamage' x setfromtodams bu hitstream w
where
setfromtodams bu p = map f (_buDamages bu)
setfromtodams bu' p = map f (_buDamages bu')
where
f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu)
f = (dmFrom .~ _buPos bu') . (dmAt .~ p) . (dmTo .~ _buPos bu' +.+ _buVel bu')
expireAndDamage' :: Float -> (Bullet -> Point2 -> [Damage])
-> Bullet
src/Dodge/Data.hs
+1 -1
View File
@@ -1207,7 +1207,7 @@ data TerminalCommand = TerminalCommand
---- ROOM DATATYPES
data PSType = PutCrit {_unPutCrit :: Creature}
| PutMachine { _putMachinePoly :: [Point2], _unPutMachine :: Machine }
| PutMachine { _putMachinePoly :: [Point2], _putMachineMachine :: Machine , _putMachineWall :: Wall}
| PutLS LightSource
| PutButton {_putButton :: Button}
| PutProp Prop
src/Dodge/Data/Wall.hs
+1
View File
@@ -16,6 +16,7 @@ data Wall = Wall
, _wlOpacity :: Opacity
, _wlPathable :: Bool
, _wlPenetrable :: Bool
, _wlBouncy :: Bool
, _wlWalkable :: Bool
, _wlTouchThrough :: Bool
, _wlFireThrough :: Bool
src/Dodge/Default/Wall.hs
+5
View File
@@ -4,6 +4,8 @@ import Dodge.Data
import Dodge.Block.Debris -- this dependency is (directly) for dirtColor
import Picture
import Geometry.Data
import Control.Lens
{- Indestructible wall. -}
defaultWall :: Wall
defaultWall = Wall
@@ -23,6 +25,7 @@ defaultWall = Wall
, _wlWalkable = False
, _wlHeight = 100
, _wlMaterial = Stone
, _wlBouncy = True
}
defaultDoorWall' :: Wall
defaultDoorWall' = defaultWall
@@ -44,6 +47,8 @@ defaultMachineWall = defaultWall
, _wlMaterial = Metal
, _wlPenetrable = True
}
defaultSensorWall :: Wall
defaultSensorWall = defaultMachineWall & wlBouncy .~ False
defaultDirtWall :: Wall
defaultDirtWall = defaultWall
{ _wlLine = (V2 0 0,V2 50 0)
src/Dodge/Placement/Instance/Sensor.hs
+9 -6
View File
@@ -23,12 +23,15 @@ damageSensor
-> Placement
damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1)
$ \lsid -> Just $ spNoID ps $ PutUsingGenParams
$ \gw -> (,) gw $ PutMachine (reverse $ square wdth) $ defaultMachine
& mcColor .~ yellow
& mcMounts . at ObTrigger .~ mtrid
& mcMounts . at ObLightSource ?~ lsid
& mcDraw .~ sensorSPic wdth (_sensorCoding (_genParams gw) M.! dt)
& mcSensor .~ DamageSensor False 0 dt
$ \gw -> (,) gw $ PutMachine (reverse $ square wdth)
(defaultMachine
& mcColor .~ yellow
& mcMounts . at ObTrigger .~ mtrid
& mcMounts . at ObLightSource ?~ lsid
& mcDraw .~ sensorSPic wdth (_sensorCoding (_genParams gw) M.! dt)
& mcSensor .~ DamageSensor False 0 dt
)
defaultSensorWall
lightSensor :: Float
-> Maybe Int
src/Dodge/Placement/Instance/Terminal.hs
+1
View File
@@ -30,6 +30,7 @@ putTerminal mc tm
(PutMachine (reverse $ square 10)
(mc & mcMounts . at ObButton ?~ fromJust (_plMID btpl)
& mcCloseSound ?~ fridgeHumS)
defaultSensorWall
)
$ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl)
where
src/Dodge/Placement/Instance/Turret.hs
+8 -6
View File
@@ -26,12 +26,14 @@ import Data.List
import Data.Maybe
putLasTurret :: Float -> Placement
putLasTurret rotSpeed = sps0 $ PutMachine (reverse $ square wdth) (defaultMachine & mcColor .~ blue)
{ _mcDraw = drawTurret
-- , _mcUpdate = updateTurret rotSpeed
, _mcType = lasTurret & tuTurnSpeed .~ rotSpeed
, _mcHP = 50000
}
putLasTurret rotSpeed = sps0 $ PutMachine (reverse $ square wdth)
(defaultMachine
& mcColor .~ blue
& mcDraw .~ drawTurret
& mcType .~ (lasTurret & tuTurnSpeed .~ rotSpeed)
& mcHP .~ 50000
)
defaultMachineWall
lasTurret :: MachineType
lasTurret = Turret
{ _tuWeapon = lasGun
src/Dodge/Placement/PlaceSpot.hs
+7 -8
View File
@@ -11,7 +11,6 @@ import Dodge.Data
import Dodge.Placement.PlaceSpot.Block
import Dodge.Placement.PlaceSpot.TriggerDoor
import Dodge.Path
import Dodge.Default.Wall
import Dodge.ShiftPoint
import Dodge.Base.NewID
import Geometry
@@ -94,7 +93,7 @@ placeSpotID ps pt w = case pt of
PutCrit cr -> plNewUpID creatures crID (mvCr p rot cr) w
PutForeground fs -> plNewUpID foregroundShapes fsID (mvFS p rot fs) w
PutDecoration pic -> plNewID decorations (shiftDec p rot pic) w
PutMachine pps mc -> plMachine (map doShift pps) mc p rot w
PutMachine pps mc wl -> plMachine (map doShift pps) mc wl p rot w
PutLS ls -> plNewUpID lightSources lsID (mvLS p' rot ls) w
PutPPlate pp -> plNewUpID pressPlates ppID (mvPP p rot pp) w
RandPS rgn -> evaluateRandPS rgn ps w
@@ -169,10 +168,10 @@ mvCr p rot cr = cr {_crPos = p,_crOldPos = p,_crDir = rot}
mvFS :: Point2 -> Float -> ForegroundShape -> ForegroundShape
mvFS p a = (fsDir +~ a) . (fsPos %~ ( (p +.+) . rotateV a ))
plMachine :: [Point2] -> Machine -> Point2 -> Float -> World -> (Int,World)
plMachine wallpoly mc p rot gw = (mcid
plMachine :: [Point2] -> Machine -> Wall -> Point2 -> Float -> World -> (Int,World)
plMachine wallpoly mc wl p rot gw = (mcid
, gw & machines %~ addMc
& walls %~ placeMachineWalls col wallpoly mcid wlid
& walls %~ placeMachineWalls wl col wallpoly mcid wlid
)
where
col = _mcColor mc
@@ -184,11 +183,11 @@ plMachine wallpoly mc p rot gw = (mcid
addMc = IM.insert mcid (mc {_mcPos = p,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids})
-- TODO correctly remove/shift pathfinding lines (removePathsCrossing)
placeMachineWalls :: Color -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
placeMachineWalls col poly mcid wlid = flip (foldr f) $ zip [wlid..] $ loopPairs poly
placeMachineWalls :: Wall -> Color -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
placeMachineWalls wl col poly mcid wlid = flip (foldr f) $ zip [wlid..] $ loopPairs poly
where
f (wid,l) = IM.insert wid baseWall{_wlID = wid, _wlLine = l}
baseWall = defaultMachineWall
baseWall = wl
& wlColor .~ col
& wlStructure . wsMachine .~ mcid
& wlTouchThrough .~ True