From 6f1f817ed3ccaf2a900db9a8f1c57380d8f0ce54 Mon Sep 17 00:00:00 2001 From: jgk Date: Fri, 12 Mar 2021 02:54:15 +0100 Subject: [PATCH] Modularise triggers for weapons --- src/Dodge/Item/Weapon.hs | 180 +------------------------- src/Dodge/Item/Weapon/TriggerType.hs | 187 +++++++++++++++++++++++++++ src/Dodge/Rooms.hs | 2 +- 3 files changed, 193 insertions(+), 176 deletions(-) create mode 100644 src/Dodge/Item/Weapon/TriggerType.hs diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index cf263834e..a86829a03 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -1,5 +1,8 @@ {-# LANGUAGE BangPatterns #-} -module Dodge.Item.Weapon where +module Dodge.Item.Weapon + ( module Dodge.Item.Weapon + ) + where -- imports {{{ import Dodge.Data import Dodge.Base @@ -15,6 +18,7 @@ import Dodge.Item.Draw import Dodge.Item.Weapon.Bullet import Dodge.Item.Weapon.InventoryDisplay +import Dodge.Item.Weapon.TriggerType import Geometry import Picture @@ -607,86 +611,6 @@ blinkGun = defaultGun , _itAimingRange = 0 } -withWarmUp :: Int -> (Int -> World -> World) -> Int -> World -> World -withWarmUp t f cid w - | reloadCondition = fromMaybe w $ reloadWeapon cid w - | _wpReloadState item /= 0 = w - | fState == 0 = set (pointerToItem . wpFire) (withWarmUp 100 f) - $ set (pointerToItem . wpFireState) 2 - w - | t > 1 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) - $ set (pointerToItem . wpFireState) 2 - $ soundFrom (CrWeaponSound cid) 26 1 0 - w - | t > 0 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) - $ set (pointerToItem . wpFireState) 2 - w - -- | otherwise = set (pointerToItem . wpFire) (withWarmUp 0 f) - | otherwise = set (pointerToItem . wpFire) (withWarmUp 1 f) - $ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) - $ set (pointerToItem . wpFireState) 2 - $ f cid - $ continueSoundFrom (CrWeaponSound cid) 28 2 0 - w - where cr = _creatures w IM.! cid - itRef = _crInvSel cr - item = _crInv cr IM.! itRef - pointerToItem = creatures . ix cid . crInv . ix itRef - fState = _wpFireState item - fRate = _wpFireRate item - reloadCondition = _wpLoadedAmmo item == 0 --- rotC = case cid of 0 -> fst $ randomR (-0.03,0.03) (_randGen w) --- _ -> 0 - -withSound :: Int -> (Int -> World -> World) -> Int -> World -> World -withSound soundid f cid = soundOnce soundid . f cid - -withRecoil :: Float -> (Int -> World -> World) -> Int -> World -> World -withRecoil recoilAmount eff cid w = eff cid . over (creatures . ix cid) pushback $ w - where pushback cr = over crPos --- where pushback cr = colCrWall w $ over crPos - (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0)) - cr -withSidePush :: Float -> (Int -> World -> World) -> Int -> World -> World -withSidePush maxSide eff cid w = eff cid . over (creatures . ix cid) push $ w - where push cr = over crPos - (+.+ rotateV (_crDir cr) (0,(pushAmount) / _crMass cr)) - cr - (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w - - - -shootWithSound :: Int -> (Int -> World -> World) -> Int -> World -> World -shootWithSound soundid f cid w - | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) - $ soundOnce soundid - $ set (pointerToItem . wpFireState) (_wpFireRate item) - $ f cid w - | reloadCondition = fromMaybe w $ reloadWeapon cid w - | otherwise = w - where cr = (_creatures w IM.! cid) - itRef = _crInvSel cr - item = _crInv cr IM.! itRef - pointerToItem = creatures . ix cid . crInv . ix itRef - fireCondition = _wpReloadState item == 0 - && _wpFireState item == 0 - && _wpLoadedAmmo item > 0 - reloadCondition = _wpLoadedAmmo item == 0 - -shoot :: (Int -> World -> World) -> Int -> World -> World -shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) - $ set (pointerToItem . wpFireState) (_wpFireRate item) - $ f cid w - | reloadCondition = fromMaybe w $ reloadWeapon cid w - | otherwise = w - where cr = (_creatures w IM.! cid) - itRef = _crInvSel cr - item = _crInv cr IM.! itRef - pointerToItem = creatures . ix cid . crInv . ix itRef - fireCondition = _wpReloadState item == 0 - && _wpFireState item == 0 - && _wpLoadedAmmo item > 0 - reloadCondition = _wpLoadedAmmo item == 0 aTeslaArc :: Int -> World -> World aTeslaArc cid w = aTeslaArc' cid @@ -856,39 +780,6 @@ tractorBeamAt colID i pos dir = Particle where d = unitVectorAtAngle dir p' = pos +.+ 400 *.* d -spreadNumVelWthHiteff' :: Float -> Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World -spreadNumVelWthHiteff' spread num vel wth eff cid w - = over particles' (newbuls ++) - $ flip (foldr muzFlareAt) poss - w - where cr = _creatures w IM.! cid - newbuls = zipWith3 (\pos d colid -> aGenBulAt' (Just cid) (numColor colid) - pos (rotateV d vel) eff wth - ) poss dirs colids - pos' = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) - poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)) - $ evalState ((sequence . take num . repeat . randInCirc) 5) $ _randGen w - dirs = map ((+) (_crDir cr)) - $ zipWith (+) [-spread,-spread+(2*spread/(fromIntegral num))..] - $ randomRs (0,spreadGunSpread/5) (_randGen w) - colids = take num $ randomRs (0,11) (_randGen w) - -numVelWthHitEff' :: Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World -numVelWthHitEff' num vel wth eff cid w - = over particles' (newbuls ++) - $ flip (foldr muzFlareAt) (take num poss) - w - where cr = _creatures w IM.! cid - newbuls = zipWith (\pos colid -> aGenBulAt' (Just cid) (numColor colid) - pos (rotateV d vel) eff wth) - poss colids - d = _crDir cr - poss = map (\o -> o +.+ pos) offsets - maxOffset = fromIntegral num * 2.5 - 2.5 - offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..] - colids = take num $ randomRs (0,11) (_randGen w) - pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d - pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr) aGasCloud :: Int -> World -> World aGasCloud cid w @@ -1060,59 +951,6 @@ flamerAngle = 0.3 aSelf :: Int -> World -> World aSelf = blinkAction -withAccVelWthHiteff' :: Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World -withAccVelWthHiteff' acc vel width hiteff cid w - = over particles' ((:) newbul) - . over tempLightSources ((:) (tLightAt 4 pos)) - . lowLightAt pos2 - $ set randGen g - w - where cr = _creatures w IM.! cid - newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width - (colid, g) = randomR (0,11) $ _randGen w - (a, _) = randomR (-acc,acc) $ _randGen w - dir = _crDir cr + a - pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) - pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr) - -withOffsetAccVelWthHiteff' :: Float -> Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World -withOffsetAccVelWthHiteff' offsetAmount acc vel width hiteff cid w - = over particles' ((:) newbul ) - $ muzFlareAt pos - $ set randGen g - w - where cr = _creatures w IM.! cid - newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width - (colid, g) = randomR (0,11) $ _randGen w - (a, _) = randomR (-acc,acc) $ _randGen w - dir = _crDir cr + a - pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) +.+ offset - (offsetVal , _) = randomR (-offsetAmount,offsetAmount) $ _randGen w - offset = rotateV (_crDir cr) (0,offsetVal) - -torqueBeforeForced :: Float -> (Int -> World -> World) -> Int -> World -> World -torqueBeforeForced torque feff cid w - | cid == 0 = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot') - $ over cameraRot (+rot') w - | otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot') w - where (rot, g) = randomR (-torque,torque) $ _randGen w - rot' | rot < 0 = rot - 0.1 - | otherwise = rot + 0.1 - -torqueBefore :: Float -> (Int -> World -> World) -> Int -> World -> World -torqueBefore torque feff cid w - | cid == 0 = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot) - $ over cameraRot (+rot) w - | otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot) w - where (rot, g) = randomR (-torque,torque) $ _randGen w - -torqueAfter :: Float -> (Int -> World -> World) -> Int -> World -> World -torqueAfter torque feff cid w - | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff cid w - | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cid w - where (rot, g) = randomR (-torque,torque) $ _randGen w - rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) - . itAttachment . _Just . scopePos %~ rotateV rot @@ -1879,14 +1717,6 @@ crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0)) g (E3x1 cr1) = dist p $ _crPos cr1 (arcLen,_) = randomR (25,50) $ _randGen w -thingHit' :: Point2 -> Maybe (Point2,a) -> Maybe (Point2,c) -> Maybe (Either (Point2,a) (Point2,c)) -thingHit' p Nothing Nothing = Nothing -thingHit' p (Just x) Nothing = Just (Left x) -thingHit' p Nothing (Just x) = Just (Right x) -thingHit' p (Just x@(p1,_)) (Just y@(p2,_)) - | magV (p -.- p1) > magV (p -.- p2) = Just (Right y) - | otherwise = Just (Left x) - spreadGunSpread,autogunSpread :: Float spreadGunSpread = 0.5 autogunSpread = 0.07 diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs new file mode 100644 index 000000000..9370f8b37 --- /dev/null +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -0,0 +1,187 @@ +module Dodge.Item.Weapon.TriggerType + where +import Dodge.Data +import Dodge.SoundLogic +import Dodge.CreatureActions (reloadWeapon) +import Dodge.WorldActions (muzFlareAt,lowLightAt,tLightAt) +import Dodge.RandomHelp + +import Dodge.Item.Weapon.Bullet + +import Geometry + +import System.Random + +import Control.Lens +import Control.Monad.State + +import Data.Maybe +import qualified Data.IntMap.Strict as IM + +withWarmUp :: Int -> (Int -> World -> World) -> Int -> World -> World +withWarmUp t f cid w + | reloadCondition = fromMaybe w $ reloadWeapon cid w + | _wpReloadState item /= 0 = w + | fState == 0 = set (pointerToItem . wpFire) (withWarmUp 100 f) + $ set (pointerToItem . wpFireState) 2 + w + | t > 1 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) + $ set (pointerToItem . wpFireState) 2 + $ soundFrom (CrWeaponSound cid) 26 1 0 + w + | t > 0 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) + $ set (pointerToItem . wpFireState) 2 + w + -- | otherwise = set (pointerToItem . wpFire) (withWarmUp 0 f) + | otherwise = set (pointerToItem . wpFire) (withWarmUp 1 f) + $ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) + $ set (pointerToItem . wpFireState) 2 + $ f cid + $ continueSoundFrom (CrWeaponSound cid) 28 2 0 + w + where cr = _creatures w IM.! cid + itRef = _crInvSel cr + item = _crInv cr IM.! itRef + pointerToItem = creatures . ix cid . crInv . ix itRef + fState = _wpFireState item + fRate = _wpFireRate item + reloadCondition = _wpLoadedAmmo item == 0 + +withSound :: Int -> (Int -> World -> World) -> Int -> World -> World +withSound soundid f cid = soundOnce soundid . f cid + +withRecoil :: Float -> (Int -> World -> World) -> Int -> World -> World +withRecoil recoilAmount eff cid w = eff cid . over (creatures . ix cid) pushback $ w + where pushback cr = over crPos +-- where pushback cr = colCrWall w $ over crPos + (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0)) + cr +withSidePush :: Float -> (Int -> World -> World) -> Int -> World -> World +withSidePush maxSide eff cid w = eff cid . over (creatures . ix cid) push $ w + where push cr = over crPos + (+.+ rotateV (_crDir cr) (0,(pushAmount) / _crMass cr)) + cr + (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w + + + +shootWithSound :: Int -> (Int -> World -> World) -> Int -> World -> World +shootWithSound soundid f cid w + | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) + $ soundOnce soundid + $ set (pointerToItem . wpFireState) (_wpFireRate item) + $ f cid w + | reloadCondition = fromMaybe w $ reloadWeapon cid w + | otherwise = w + where cr = (_creatures w IM.! cid) + itRef = _crInvSel cr + item = _crInv cr IM.! itRef + pointerToItem = creatures . ix cid . crInv . ix itRef + fireCondition = _wpReloadState item == 0 + && _wpFireState item == 0 + && _wpLoadedAmmo item > 0 + reloadCondition = _wpLoadedAmmo item == 0 + +shoot :: (Int -> World -> World) -> Int -> World -> World +shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) + $ set (pointerToItem . wpFireState) (_wpFireRate item) + $ f cid w + | reloadCondition = fromMaybe w $ reloadWeapon cid w + | otherwise = w + where cr = (_creatures w IM.! cid) + itRef = _crInvSel cr + item = _crInv cr IM.! itRef + pointerToItem = creatures . ix cid . crInv . ix itRef + fireCondition = _wpReloadState item == 0 + && _wpFireState item == 0 + && _wpLoadedAmmo item > 0 + reloadCondition = _wpLoadedAmmo item == 0 + +withAccVelWthHiteff' :: Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World +withAccVelWthHiteff' acc vel width hiteff cid w + = over particles' ((:) newbul) + . over tempLightSources ((:) (tLightAt 4 pos)) + . lowLightAt pos2 + $ set randGen g + w + where cr = _creatures w IM.! cid + newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width + (colid, g) = randomR (0,11) $ _randGen w + (a, _) = randomR (-acc,acc) $ _randGen w + dir = _crDir cr + a + pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) + pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr) + +withOffsetAccVelWthHiteff' :: Float -> Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World +withOffsetAccVelWthHiteff' offsetAmount acc vel width hiteff cid w + = over particles' ((:) newbul ) + $ muzFlareAt pos + $ set randGen g + w + where cr = _creatures w IM.! cid + newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width + (colid, g) = randomR (0,11) $ _randGen w + (a, _) = randomR (-acc,acc) $ _randGen w + dir = _crDir cr + a + pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) +.+ offset + (offsetVal , _) = randomR (-offsetAmount,offsetAmount) $ _randGen w + offset = rotateV (_crDir cr) (0,offsetVal) + +torqueBeforeForced :: Float -> (Int -> World -> World) -> Int -> World -> World +torqueBeforeForced torque feff cid w + | cid == 0 = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot') + $ over cameraRot (+rot') w + | otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot') w + where (rot, g) = randomR (-torque,torque) $ _randGen w + rot' | rot < 0 = rot - 0.1 + | otherwise = rot + 0.1 + +torqueBefore :: Float -> (Int -> World -> World) -> Int -> World -> World +torqueBefore torque feff cid w + | cid == 0 = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot) + $ over cameraRot (+rot) w + | otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot) w + where (rot, g) = randomR (-torque,torque) $ _randGen w + +torqueAfter :: Float -> (Int -> World -> World) -> Int -> World -> World +torqueAfter torque feff cid w + | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff cid w + | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cid w + where (rot, g) = randomR (-torque,torque) $ _randGen w + rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) + . itAttachment . _Just . scopePos %~ rotateV rot + +spreadNumVelWthHiteff' :: Float -> Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World +spreadNumVelWthHiteff' spread num vel wth eff cid w + = over particles' (newbuls ++) + $ flip (foldr muzFlareAt) poss + w + where cr = _creatures w IM.! cid + newbuls = zipWith3 (\pos d colid -> aGenBulAt' (Just cid) (numColor colid) + pos (rotateV d vel) eff wth + ) poss dirs colids + pos' = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) + poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)) + $ evalState ((sequence . take num . repeat . randInCirc) 5) $ _randGen w + dirs = map ((+) (_crDir cr)) + $ zipWith (+) [-spread,-spread+(2*spread/(fromIntegral num))..] + $ randomRs (0,spread/5) (_randGen w) + -- $ randomRs (0,spreadGunSpread/5) (_randGen w) + colids = take num $ randomRs (0,11) (_randGen w) + +numVelWthHitEff' :: Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World +numVelWthHitEff' num vel wth eff cid w + = over particles' (newbuls ++) + $ flip (foldr muzFlareAt) (take num poss) + w + where cr = _creatures w IM.! cid + newbuls = zipWith (\pos colid -> aGenBulAt' (Just cid) (numColor colid) + pos (rotateV d vel) eff wth) + poss colids + d = _crDir cr + poss = map (\o -> o +.+ pos) offsets + maxOffset = fromIntegral num * 2.5 - 2.5 + offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..] + colids = take num $ randomRs (0,11) (_randGen w) + pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d + pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr) diff --git a/src/Dodge/Rooms.hs b/src/Dodge/Rooms.hs index a7286c0b7..b14d4fa6a 100644 --- a/src/Dodge/Rooms.hs +++ b/src/Dodge/Rooms.hs @@ -206,7 +206,7 @@ door = Room , _rmLinks = lnks , _rmPath = [((20,35),(20,5))] -- door extends into side walls (for shadows as rendered 12/03) - , _rmPS = [PS (0,20) 0 $ PutAutoDoor (-10,0) (50,0)] + , _rmPS = [PS (0,20) 0 $ PutAutoDoor (-20,0) (60,0)] , _rmBound = [] } where lnks = [((20,35),0)