From 9c0e4425da592d1851981e9b113b85479f205e1c Mon Sep 17 00:00:00 2001 From: jgk Date: Fri, 30 Apr 2021 17:50:28 +0200 Subject: [PATCH] Refactoring and linting --- src/Dodge/AIs.hs | 18 +- src/Dodge/AIs.hs.orig | 18 +- src/Dodge/Base.hs | 9 - src/Dodge/Creature.hs | 2 +- src/Dodge/Creature/State.hs | 2 +- src/Dodge/Data.hs | 6 +- src/Dodge/Data.hs.orig | 4 +- src/Dodge/Debug.hs | 1 + src/Dodge/Item.hs | 1 + src/Dodge/Item/Weapon.hs | 749 ++++++++++---------------- src/Dodge/Item/Weapon/Decoration.hs | 1 + src/Dodge/Item/Weapon/Laser.hs | 123 +++++ src/Dodge/Item/Weapon/TriggerType.hs | 73 ++- src/Dodge/Picture.hs | 31 ++ src/Dodge/Render/HUD.hs | 11 +- src/Dodge/Render/Picture.hs | 3 +- src/Dodge/WorldEvent/Flash.hs | 1 + src/Dodge/WorldEvent/SpawnParticle.hs | 1 + 18 files changed, 531 insertions(+), 523 deletions(-) create mode 100644 src/Dodge/Item/Weapon/Laser.hs create mode 100644 src/Dodge/Picture.hs diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index 9d89400a2..af52183a4 100644 --- a/src/Dodge/AIs.hs +++ b/src/Dodge/AIs.hs @@ -467,7 +467,7 @@ miniAI w (f,g) cr = addAction newActions = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) -- autoFireTweak p | _wpIsAuto wp = Just --- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] +-- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]] in --if _crHP cr <= 0 then killCr w f cr else case head $ _goals $ _crState cr of [] | canSeeFire cpos ypos w -> ( ( f , g1 ) @@ -586,7 +586,7 @@ strafeOrChargeAI inRange outRange w (f,g) cr = addAction newActions = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) -- autoFireTweak p | _wpIsAuto wp = Just --- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] +-- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]] in --if _crHP cr <= 0 then killCr w f cr else case head $ _goals $ _crState cr of [] | canSeeFire cpos ypos w -> ( ( f , g1 ) @@ -1101,7 +1101,7 @@ circleClockwiseAI inRange outRange w (f,g) cr = addAction newActions = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) -- autoFireTweak p | _wpIsAuto wp = Just --- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] +-- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]] in --if _crHP cr <= 0 then killCr w f cr else case head $ _goals $ _crState cr of [] | canSeeFire cpos ypos w -> ( ( f , g1 ) @@ -1198,7 +1198,7 @@ twitchMissAI inRange outRange w (f,g) cr = cid = _crID cr ypos = _crPos $ you w wp = _crInv cr IM.! _crInvSel cr - fireRate = fromMaybe 0 $ wp ^? wpFireRate + fireRate = fromMaybe 0 $ wp ^? itUseRate noAmmo = 0 == _wpLoadedAmmo wp strafeCloseSlow p | errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.1 @@ -1297,7 +1297,7 @@ closeToRangeAI inRange outRange w (f,g) cr = cid = _crID cr ypos = _crPos $ you w wp = _crInv cr IM.! _crInvSel cr - fireRate = fromMaybe 0 $ wp ^? wpFireRate + fireRate = fromMaybe 0 $ wp ^? itUseRate (aimtime,g1) = randomR (80,120) g noAmmo = 0 == _wpLoadedAmmo wp strafeCloseSlow p | errorAngleVV 22 (p -.- cpos) @@ -1424,7 +1424,7 @@ suppressShooterAI w (f,g) cr = addAction newActions = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) -- autoFireTweak p | _wpIsAuto wp = Just --- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] +-- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]] in --if _crHP cr <= 0 then killCr w f cr else case head $ _goals $ _crState cr of [] | canSeeFire cpos ypos w -> ( ( f , g1 ) @@ -1528,7 +1528,7 @@ basicShooterAI w (f,g) cr = addAction newActions = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) -- autoFireTweak p | _wpIsAuto wp = Just --- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] +-- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]] in --if _crHP cr <= 0 then killCr w f cr else case head $ _goals $ _crState cr of [] | canSeeFire cpos ypos w -> ( ( f , g1 ) @@ -1631,7 +1631,7 @@ sniperAI w (f,g) cr = addAction newActions = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) -- autoFireTweak p | _wpIsAuto wp = Just --- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] +-- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]] in --if _crHP cr <= 0 then killCr w f cr else case head $ _goals $ _crState cr of [] | canSeeFire cpos ypos w -> ( ( f , g1 ) @@ -1733,7 +1733,7 @@ sniperAI w (f,g) cr = -- addAction newActions = over (creatures . ix cid . crState . goals) -- (\(as:ass) -> (newActions++as):ass) -- autoFireTweak p | _wpIsAuto wp = id --- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] +-- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]] -- in if _crHP cr <= 0 then killCr cid w else -- case head $ _goals $ _crState cr of -- [] | canSeeAny cid (_yourID w) w diff --git a/src/Dodge/AIs.hs.orig b/src/Dodge/AIs.hs.orig index b46b5b03f..6b1d91f11 100644 --- a/src/Dodge/AIs.hs.orig +++ b/src/Dodge/AIs.hs.orig @@ -469,7 +469,7 @@ miniAI w (f,g) cr = addAction newActions = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) -- autoFireTweak p | _wpIsAuto wp = Just --- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] +-- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]] in --if _crHP cr <= 0 then killCr w f cr else case head $ _goals $ _crState cr of [] | canSeeFire cpos ypos w -> ( ( f , g1 ) @@ -588,7 +588,7 @@ strafeOrChargeAI inRange outRange w (f,g) cr = addAction newActions = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) -- autoFireTweak p | _wpIsAuto wp = Just --- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] +-- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]] in --if _crHP cr <= 0 then killCr w f cr else case head $ _goals $ _crState cr of [] | canSeeFire cpos ypos w -> ( ( f , g1 ) @@ -1103,7 +1103,7 @@ circleClockwiseAI inRange outRange w (f,g) cr = addAction newActions = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) -- autoFireTweak p | _wpIsAuto wp = Just --- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] +-- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]] in --if _crHP cr <= 0 then killCr w f cr else case head $ _goals $ _crState cr of [] | canSeeFire cpos ypos w -> ( ( f , g1 ) @@ -1200,7 +1200,7 @@ twitchMissAI inRange outRange w (f,g) cr = cid = _crID cr ypos = _crPos $ you w wp = _crInv cr IM.! _crInvSel cr - fireRate = fromMaybe 0 $ wp ^? wpFireRate + fireRate = fromMaybe 0 $ wp ^? itUseRate noAmmo = 0 == _wpLoadedAmmo wp strafeCloseSlow p | errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.1 @@ -1299,7 +1299,7 @@ closeToRangeAI inRange outRange w (f,g) cr = cid = _crID cr ypos = _crPos $ you w wp = _crInv cr IM.! _crInvSel cr - fireRate = fromMaybe 0 $ wp ^? wpFireRate + fireRate = fromMaybe 0 $ wp ^? itUseRate (aimtime,g1) = randomR (80,120) g noAmmo = 0 == _wpLoadedAmmo wp strafeCloseSlow p | errorAngleVV 22 (p -.- cpos) @@ -1426,7 +1426,7 @@ suppressShooterAI w (f,g) cr = addAction newActions = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) -- autoFireTweak p | _wpIsAuto wp = Just --- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] +-- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]] in --if _crHP cr <= 0 then killCr w f cr else case head $ _goals $ _crState cr of [] | canSeeFire cpos ypos w -> ( ( f , g1 ) @@ -1530,7 +1530,7 @@ basicShooterAI w (f,g) cr = addAction newActions = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) -- autoFireTweak p | _wpIsAuto wp = Just --- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] +-- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]] in --if _crHP cr <= 0 then killCr w f cr else case head $ _goals $ _crState cr of [] | canSeeFire cpos ypos w -> ( ( f , g1 ) @@ -1633,7 +1633,7 @@ sniperAI w (f,g) cr = addAction newActions = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) -- autoFireTweak p | _wpIsAuto wp = Just --- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] +-- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]] in --if _crHP cr <= 0 then killCr w f cr else case head $ _goals $ _crState cr of [] | canSeeFire cpos ypos w -> ( ( f , g1 ) @@ -1735,7 +1735,7 @@ sniperAI w (f,g) cr = -- addAction newActions = over (creatures . ix cid . crState . goals) -- (\(as:ass) -> (newActions++as):ass) -- autoFireTweak p | _wpIsAuto wp = id --- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] +-- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]] -- in if _crHP cr <= 0 then killCr cid w else -- case head $ _goals $ _crState cr of -- [] | canSeeAny cid (_yourID w) w diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index f3583d74c..d90a22c7f 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -425,15 +425,6 @@ collidePointFireVision p1 p2 ws = any ( isJust Just _ -> not $ _wlIsSeeThrough wl Nothing -> True --- shit this is ugly -lineOfThickness :: Float -> [Point2] -> Picture -lineOfThickness t = pictures . f - where f (x:y:ys) - | x == y = f (x:ys) - | otherwise - = polygon [x +.+ n x y, x -.- n x y, y -.- n x y, y +.+ n x y] : f (y:ys) - f _ = [] - n a b = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b)) lineGeom :: Float -> Point2 -> Point2 -> [Point2] lineGeom t x y diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index fb7b6083d..abf666d44 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -264,7 +264,7 @@ Items you start with. -} startInventory = IM.fromList (zip [0..20] ( - [lasGun + [bezierGun ,remoteLauncher ,grenade --,spawnGun lamp diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index d8030eedc..53c1588b4 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -178,7 +178,7 @@ isFrictionless cr = case cr ^? crState . stance . carriage of _ -> False updateReloadCounter :: Creature -> Creature -updateReloadCounter cr = over (crInv . ix iSel . wpFireState) decreaseToZero +updateReloadCounter cr = over (crInv . ix iSel . itUseTime) decreaseToZero . over (crInv . ix iSel . wpReloadState) decreaseToZero $ cr where iSel = _crInvSel cr diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 81bd01467..2f17b38c1 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -215,8 +215,8 @@ data Item , _wpLoadedAmmo :: Int , _wpReloadTime :: Int , _wpReloadState :: Int - , _wpFireRate :: Int - , _wpFireState :: Int + , _itUseRate :: Int + , _itUseTime :: Int , _wpFire :: Int -> World -> World , _wpSpread :: Float , _wpRange :: Float @@ -286,6 +286,8 @@ data Item , _twMaxRange :: Float , _twAccuracy :: Float , _twFire :: Int -> World -> World + , _itUseRate :: Int + , _itUseTime :: Int , _itAimingSpeed :: Float , _itAimingRange :: Float , _itZoom :: ItZoom diff --git a/src/Dodge/Data.hs.orig b/src/Dodge/Data.hs.orig index c403972bc..a2c9eba19 100644 --- a/src/Dodge/Data.hs.orig +++ b/src/Dodge/Data.hs.orig @@ -276,8 +276,8 @@ data Item , _wpLoadedAmmo :: Int , _wpReloadTime :: Int , _wpReloadState :: Int - , _wpFireRate :: Int - , _wpFireState :: Int + , _itUseRate :: Int + , _itUseTime :: Int , _wpFire :: Int -> World -> World , _wpSpread :: Float , _wpRange :: Float diff --git a/src/Dodge/Debug.hs b/src/Dodge/Debug.hs index 17abdbf4c..02c810894 100644 --- a/src/Dodge/Debug.hs +++ b/src/Dodge/Debug.hs @@ -2,6 +2,7 @@ module Dodge.Debug where import Dodge.Data import Dodge.Base +import Dodge.Picture import Geometry.Data import Picture diff --git a/src/Dodge/Item.hs b/src/Dodge/Item.hs index 5a94aeae7..d6a06cf73 100644 --- a/src/Dodge/Item.hs +++ b/src/Dodge/Item.hs @@ -4,6 +4,7 @@ module Dodge.Item import Dodge.Data import Dodge.Base import Dodge.Default +import Dodge.Picture import Picture keyToken :: Int -> Item diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 163aa7fda..cba53b188 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -21,6 +21,7 @@ import Dodge.Item.Weapon.InventoryDisplay import Dodge.Item.Weapon.TriggerType import Dodge.Item.Weapon.ExtraEffect import Dodge.Item.Weapon.UseEffect +import Dodge.Item.Weapon.Laser import Dodge.Item.Attachment.Data import Dodge.Item.Attachment import Geometry @@ -56,8 +57,8 @@ pistol = Weapon , _wpLoadedAmmo = 15 , _wpReloadTime = 40 , _wpReloadState = 0 - , _wpFireRate = 8 - , _wpFireState = 0 + , _itUseRate = 8 + , _itUseTime = 0 , _wpFire = hammerCheck . shootWithSound 0 @@ -108,8 +109,8 @@ autoGun = defaultGun , _wpLoadedAmmo = 30 , _wpReloadTime = 80 , _wpReloadState = 0 - , _wpFireRate = 6 - , _wpFireState = 0 + , _itUseRate = 6 + , _itUseTime = 0 , _wpFire = charFiringStrat [('M',autoFireMode) ,('S',singleFireMode) @@ -134,7 +135,6 @@ autoFireMode = shootWithSound (fromIntegral autoGunSound) . torqueBefore 0.05 $ autoGunNonTwistEff singleFireMode = hammerCheck $ shootWithSound (fromIntegral autoGunSound) --- . torqueAfter 0.03 $ autoGunNonTwistEff autoGunNonTwistEff = withRecoil 40 . withRandomDir (autogunSpread/2) @@ -148,21 +148,23 @@ rezGun = defaultGun , _wpLoadedAmmo = 50 , _wpReloadTime = 80 , _wpReloadState = 0 - , _wpFireRate = 0 - , _wpFireState = 0 + , _itUseRate = 0 + , _itUseTime = 0 , _wpFire = shoot aTeslaArc , _wpSpread = 0.001 , _wpRange = 20 - , _itFloorPict = onLayer FlItLayer $ color chartreuse $ pictures [polygon $ rectNESW 7 3 1 (-3) - ,polygon $ rectNESW (-1) 3 (-7) (-3) - ] + , _itFloorPict = onLayer FlItLayer $ color chartreuse $ pictures + [polygon $ rectNESW 7 3 1 (-3) + ,polygon $ rectNESW (-1) 3 (-7) (-3) + ] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 0 - , _itEquipPict = drawWeapon $ color chartreuse $ pictures [polygon $ rectNESW 7 3 1 (-3) - ,polygon $ rectNESW (-1) 3 (-7) (-3) - ] + , _itEquipPict = drawWeapon $ color chartreuse $ pictures + [polygon $ rectNESW 7 3 1 (-3) + ,polygon $ rectNESW (-1) 3 (-7) (-3) + ] } teslaGun = defaultAutoGun { _itName = "TESLA" @@ -171,22 +173,24 @@ teslaGun = defaultAutoGun , _wpLoadedAmmo = 200 , _wpReloadTime = 80 , _wpReloadState = 0 - , _wpFireRate = 0 - , _wpFireState = 0 + , _itUseRate = 0 + , _itUseTime = 0 , _wpFire = shoot aTeslaArc , _wpSpread = 0.001 , _wpRange = 20 - , _itFloorPict = onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 7 3 1 (-3) - ,polygon $ rectNESW (-1) 3 (-7) (-3) - ] + , _itFloorPict = onLayer FlItLayer $ color blue $ pictures + [polygon $ rectNESW 7 3 1 (-3) + ,polygon $ rectNESW (-1) 3 (-7) (-3) + ] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itZoom = defaultItZoom , _itAimingRange = 0 - , _itEquipPict = drawWeapon $ color blue $ pictures [polygon $ rectNESW 7 3 1 (-3) - ,polygon $ rectNESW (-1) 3 (-7) (-3) - ] + , _itEquipPict = drawWeapon $ color blue $ pictures + [polygon $ rectNESW 7 3 1 (-3) + ,polygon $ rectNESW (-1) 3 (-7) (-3) + ] } lasGun = defaultAutoGun { _itName = "LASGUN ////" @@ -195,8 +199,8 @@ lasGun = defaultAutoGun , _wpLoadedAmmo = 200 , _wpReloadTime = 80 , _wpReloadState = 0 - , _wpFireRate = 0 - , _wpFireState = 0 + , _itUseRate = 0 + , _itUseTime = 0 , _wpFire = shoot aLaser , _wpSpread = 0.001 , _wpRange = 20 @@ -218,8 +222,8 @@ forceFieldGun = defaultGun , _wpLoadedAmmo = 100 , _wpReloadTime = 40 , _wpReloadState = 0 - , _wpFireRate = 10 - , _wpFireState = 0 + , _itUseRate = 10 + , _itUseTime = 0 , _wpFire = undefined , _wpSpread = 0.02 , _wpRange = 20 @@ -236,8 +240,8 @@ forceFieldGun = defaultGun -- , _wpLoadedAmmo = 1 -- , _wpReloadTime = 40 -- , _wpReloadState = 0 --- , _wpFireRate = 10 --- , _wpFireState = 0 +-- , _itUseRate = 10 +-- , _itUseTime = 0 -- , _wpFire = grapFire -- , _wpSpread = 0.002 -- , _wpRange = 20 @@ -255,8 +259,8 @@ tractorGun = defaultAutoGun , _wpLoadedAmmo = 10000 , _wpReloadTime = 40 , _wpReloadState = 0 - , _wpFireRate = 0 - , _wpFireState = 0 + , _itUseRate = 0 + , _itUseTime = 0 , _wpFire = shoot $ aTractorBeam 0 , _wpSpread = 0.00001 , _wpRange = 20 @@ -274,8 +278,8 @@ launcher = defaultGun , _wpLoadedAmmo = 30 , _wpReloadTime = 80 , _wpReloadState = 0 - , _wpFireRate = 20 - , _wpFireState = 0 + , _itUseRate = 20 + , _itUseTime = 0 , _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeExplosionAt , _wpSpread = 0.02 , _wpRange = 20 @@ -305,7 +309,7 @@ teslaLauncher = launcher bezierGun = defaultAutoGun { _itName = "B-GUN" - , _wpFire = maybeSetTarget $ \p -> + , _wpFire = hammerCheck $ maybeSetTarget $ \p -> shootWithSound 0 . withMuzFlare . withRecoil 40 @@ -324,7 +328,7 @@ maybeSetTarget :: (Point2 -> Int -> World -> World) -> Int -> World -> World maybeSetTarget f cid w = case join $ w ^? creatures . ix cid . crInv . ix itRef . itAttachment of Just (ItTargetPos targetp) -> f targetp cid w - _ -> w & creatures . ix cid . crInv . ix itRef . itAttachment .~ Just (ItTargetPos mp) + _ -> w & creatures . ix cid . crInv . ix itRef . itAttachment ?~ ItTargetPos mp where mp = mouseWorldPos w cr = _creatures w IM.! cid @@ -334,26 +338,27 @@ shootBezier :: Point2 -> Int -> World -> World shootBezier targetp cid w = over particles (theBullet :) w where theBullet = aCurveBulAt - (Just cid) - white - startp - (controlp +.+ randPos) - (targetp +.+ randPos') - (destroyOnImpact bulHitCr' bulHitWall' bulHitFF') - 5 + (Just cid) + white + startp + (controlp +.+ randPos) + (targetp +.+ randPos') + (destroyOnImpact bulHitCr' bulHitWall' bulHitFF') + 5 controlp = mouseWorldPos w cr = _creatures w IM.! cid dir = _crDir cr startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) - (randPos,randPos') = flip evalState (_randGen w) - $ do a <- randInCirc 10 - b <- randInCirc 20 - return (a,b) + (randPos,randPos') = flip evalState (_randGen w) $ do + a <- randInCirc 10 + b <- randInCirc 20 + return (a,b) removeItAttachment :: Int -> Int -> World -> World removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ Nothing - where cr = _creatures w IM.! i - itRef = _crInvSel cr + where + cr = _creatures w IM.! i + itRef = _crInvSel cr remoteLauncher = defaultGun { _itName = "ROCKO-REM" @@ -362,9 +367,9 @@ remoteLauncher = defaultGun , _wpLoadedAmmo = 1 , _wpReloadTime = 80 , _wpReloadState = 0 - , _wpFireRate = 10 - , _wpFireState = 0 - , _wpFire = hammerCheck $ fireRemoteLauncher + , _itUseRate = 10 + , _itUseTime = 0 + , _wpFire = hammerCheck fireRemoteLauncher , _wpSpread = 0.02 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) @@ -382,10 +387,9 @@ hvAutoGun = defaultAutoGun , _wpLoadedAmmo = 100 , _wpReloadTime = 200 , _wpReloadState = 0 - , _wpFireRate = 25 - , _wpFireState = 0 - , _wpFire = rateIncAB 24 10 (torqueBeforeForced 0.1 mkHvBul) - $ torqueAfter 0.2 mkHvBul + , _itUseRate = 25 + , _itUseTime = 0 + , _wpFire = rateIncAB 24 10 (torqueBeforeForced 0.1 mkHvBul) $ torqueAfter 0.2 mkHvBul , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color orange $ polygon $ rectNESW 5 5 (-5) (-5) , _itAmount = 1 @@ -394,12 +398,12 @@ hvAutoGun = defaultAutoGun , _itAimingRange = 1 , _itEquipPict = drawWeapon $ color orange $ polygon $ rectNESW 5 5 (-5) (-5) } - where mkHvBul = withSound (fromIntegral longGunSound) - . withThinSmoke - . withMuzFlare - . withVelWthHiteff (80,0) 6 - $ penWalls - hvBulHitCr' hvBulHitWall' bulHitFF' + where + mkHvBul = withSound (fromIntegral longGunSound) + . withThinSmoke + . withMuzFlare + . withVelWthHiteff (80,0) 6 + $ penWalls hvBulHitCr' hvBulHitWall' bulHitFF' ltAutoGun = defaultAutoGun { _itName = "AUTO-LT" @@ -408,8 +412,8 @@ ltAutoGun = defaultAutoGun , _wpLoadedAmmo = 25 , _wpReloadTime = 80 , _wpReloadState = 0 - , _wpFireRate = 4 - , _wpFireState = 0 + , _itUseRate = 4 + , _itUseTime = 0 , _wpFire = shootWithSound 0 . withRandomDir 0.3 . withSidePush 50 . withMuzFlare $ withVelWthHiteff (30,0) 2 basicBulletEffect , _wpSpread = 0.5 @@ -433,8 +437,8 @@ miniGun = defaultAutoGun , _wpLoadedAmmo = 150 , _wpReloadTime = 200 , _wpReloadState = 0 - , _wpFireRate = 2 - , _wpFireState = 0 + , _itUseRate = 2 + , _itUseTime = 0 , _wpFire = withWarmUp 50 . torqueBefore 0.03 . withSidePush 50 . withRecoil 15 . withRandomDir 0.1 . withRandomOffset 9 @@ -456,42 +460,21 @@ spreadGun = defaultGun , _wpLoadedAmmo = 5 , _wpReloadTime = 80 , _wpReloadState = 0 - , _wpFireRate = 20 - , _wpFireState = 0 + , _itUseRate = 20 + , _itUseTime = 0 , _wpFire = shootWithSound (fromIntegral shotgunSound) - . withRecoil 100 - . withMuzFlare - $ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 basicBulletEffect + . withRecoil 100 + . withMuzFlare + $ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 basicBulletEffect , _wpSpread = spreadGunSpread , _wpRange = 20 - , _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] - ] + , _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 1 , _itAimingRange = 0 - , _itEquipPict = drawWeapon $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] - ] + , _itEquipPict = drawWeapon $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ] } --- shatterGun = defaultGun --- { _itName = "shatterGun" --- , _itIdentity = ShatterGun --- , _wpMaxAmmo = 50 --- , _wpLoadedAmmo = 50 --- , _wpReloadTime = 80 --- , _wpReloadState = 0 --- , _wpFireRate = 40 --- , _wpFireState = 0 --- , _wpFire = shatterGunFire --- , _wpSpread = 3.14 --- , _wpRange = 20 --- , _wpIsAuto = False --- , _itFloorPict = polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)] --- , _itAmount = 1 --- , _itMaxStack = 1 --- , _itAimingSpeed = 1 --- , _itAimingRange = 0.5 --- } multGun = defaultGun { _itName = "MULTGUN" , _itIdentity = MultGun @@ -499,30 +482,31 @@ multGun = defaultGun , _wpLoadedAmmo = 2 , _wpReloadTime = 40 , _wpReloadState = 0 - , _wpFireRate = 20 - , _wpFireState = 0 + , _itUseRate = 20 + , _itUseTime = 0 , _wpFire = shootWithSound (fromIntegral shotgunSound) - . withRecoil 200 - . withMuzFlare - $ numVelWthHitEff 5 (50,0) 5 basicBulletEffect + . withRecoil 200 + . withMuzFlare + $ numVelWthHitEff 5 (50,0) 5 basicBulletEffect , _wpSpread = spreadGunSpread , _wpRange = 20 - , _itFloorPict = onLayer FlItLayer $ multGunPic + , _itFloorPict = onLayer FlItLayer multGunPic , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 1 , _itZoom = defaultItZoom {_itAimZoomFac = 1.5} - , _itEquipPict = drawWeapon $ multGunPic + , _itEquipPict = drawWeapon multGunPic } - where multGunPic = color red $ pictures - [ polygon $ rectNSEW 12 8 2 (-2) - , polygon $ rectNSEW 7 3 2 (-2) - , polygon $ rectNSEW 2 (-2) 2 (-2) - , polygon $ rectNSEW (-3) (-7) 2 (-2) - , polygon $ rectNSEW (-8) (-12) 2 (-2) - , polygon [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)] - ] + where + multGunPic = color red $ pictures + [ polygon $ rectNSEW 12 8 2 (-2) + , polygon $ rectNSEW 7 3 2 (-2) + , polygon $ rectNSEW 2 (-2) 2 (-2) + , polygon $ rectNSEW (-3) (-7) 2 (-2) + , polygon $ rectNSEW (-8) (-12) 2 (-2) + , polygon [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)] + ] longGun = defaultGun { _itName = "LONGGUN" , _itIdentity = LongGun @@ -530,16 +514,14 @@ longGun = defaultGun , _wpLoadedAmmo = 1 , _wpReloadTime = 80 , _wpReloadState = 0 - , _wpFireRate = 100 - , _wpFireState = 0 + , _itUseRate = 100 + , _itUseTime = 0 , _wpFire = shootWithSound (fromIntegral longGunSound) - . withThickSmoke - . torqueAfter 0.05 - . withMuzFlare - . withVelWthHiteff (60,0) 6 - $ penWalls hvBulHitCr' hvBulHitWall' bulHitFF' - - , _wpSpread = 0.0 + . withThickSmoke + . torqueAfter 0.05 + . withMuzFlare + . withVelWthHiteff (60,0) 6 + $ penWalls hvBulHitCr' hvBulHitWall' bulHitFF' , _wpRange = 200 , _itFloorPict = onLayer FlItLayer $ pictures [color orange $ polygon $ rectNESW 3 6 (-3) (-6) ] , _itAmount = 1 @@ -568,9 +550,9 @@ poisonSprayer = defaultAutoGun , _wpLoadedAmmo = 500 , _wpReloadTime = 100 , _wpReloadState = 0 - , _wpFireRate = 0 - , _wpFireState = 0 - , _wpFire = shoot $ aGasCloud + , _itUseRate = 0 + , _itUseTime = 0 + , _wpFire = shoot aGasCloud , _wpSpread = 0.3 , _wpRange = 8 , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) @@ -589,8 +571,8 @@ flamer = defaultAutoGun , _wpLoadedAmmo = 250 , _wpReloadTime = 100 , _wpReloadState = 0 - , _wpFireRate = 0 - , _wpFireState = 0 + , _itUseRate = 0 + , _itUseTime = 0 , _wpFire = shoot $ withSidePush 5 $ withSidePushAfter 10 $ randWalkAngle 0.5 0.05 aFlame , _wpSpread = 0 , _wpRange = 8 @@ -610,8 +592,8 @@ blinkGun = defaultGun , _wpLoadedAmmo = 100 , _wpReloadTime = 20 , _wpReloadState = 0 - , _wpFireRate = 0 - , _wpFireState = 0 + , _itUseRate = 0 + , _itUseTime = 0 , _wpFire = shoot aSelf , _wpSpread = 0.05 , _wpRange = 20 @@ -640,34 +622,15 @@ aTeslaArc' cid w = (sideOffset,g) = randomR (-5,5) $ _randGen w dir = _crDir cr -aLaser :: Int -> World -> World -aLaser cid w = over particles ((makeLaserAt phaseV pos dir (Just cid)) : ) - $ soundFrom LasSound 24 1 0 - $ laserGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir) - w - where - cr = (_creatures w IM.! cid) - i = newProjectileKey w - pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) - dir = _crDir cr - phaseV = charToPhaseV $ fromMaybe '/' $ Seq.lookup 0 =<< cr ^? crInv . ix j . itAttachment . _Just . itCharMode - j = _crInvSel cr - -charToPhaseV 'V' = 0.2 -charToPhaseV '/' = 1 -charToPhaseV 'Z' = 5 - - aRocketWithPayload - :: (Point2 -> World -> World) - -- ^ Payload + :: (Point2 -> World -> World) -- ^ Payload -> Int -- ^ Creature id -> World -> World aRocketWithPayload pl cid w = over projectiles (IM.insert i theShell) w where i = newProjectileKey w - cr = (_creatures w IM.! cid) + cr = _creatures w IM.! cid pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) dir = _crDir cr theShell = makeShellAt pl i cid pos dir @@ -717,9 +680,9 @@ moveShell time i cid rot accel w & projectiles . ix i . pjPos %~ (+.+ vel) & randGen .~ g & projectiles . ix i . pjPict .~ pic - & projectiles . ix i . pjUpdate .~ (moveShell (time-1) i cid rot (rotateV rot accel)) + & projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot (rotateV rot accel) & projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v) - & soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) (1) 250 + & soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250 & makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10 & smokeGen | time > -200 = w @@ -739,53 +702,54 @@ moveShell time i cid rot accel w newPos = oldPos +.+ vel (frict,g) = randomR (0.6,0.9) $ _randGen w (sparkD,_) = randomR (-0.2,0.2) $ _randGen w - dir = argV $ vel + dir = argV vel pic = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) shellPic piclow = onLayerL [levLayer CrLayer - 2] - $ uncurry translate newPos $ rotate (argV accel) shellPic - hitCr = fmap fst $ collideCircCrsPoint oldPos newPos 4 w - hitWl = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w + $ uncurry translate newPos $ rotate (argV accel) shellPic + hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w + hitWl = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w) thingHit = hitCr <|> hitWl spin = case w ^? creatures . ix cid of - Just cr -> min 0.2 $ max (-0.2) - $ (normalizeAnglePi (dir - _crDir cr)) / 20 - _ -> 0 - r1 = _randGen w & evalState (randInCirc 10) - smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* (normalizeV (oldPos -.- newPos))) + Just cr -> min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20 + _ -> 0 + r1 = randInCirc 10 & evalState $ _randGen w + smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)) -normalizeAnglePi angle | normalizeAngle angle > pi = normalizeAngle angle - 2*pi - | otherwise = normalizeAngle angle +normalizeAnglePi angle + | normalizeAngle angle > pi = normalizeAngle angle - 2*pi + | otherwise = normalizeAngle angle shellPic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] remoteShellPic :: Int -> Picture -remoteShellPic i | rem (i+200) 20 < 9 = polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] - | otherwise = pictures [ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] - , color col $ circleSolid 3 - ] - where col | i > (-99) = green - | otherwise = red +remoteShellPic i + | rem (i+200) 20 < 9 = polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] + | otherwise = pictures + [ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] + , color col $ circleSolid 3 + ] + where + col | i > (-99) = green + | otherwise = red shellExplosionAt = makeExplosionAt aGasCloud :: Int -> World -> World -aGasCloud cid w - = insertCloud $ set randGen g $ - w - where - (a,g) = randomR (-0.1,0.1) (_randGen w) - cr = (_creatures w IM.! cid) - dir = _crDir cr + a - pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) - pos2 = (0.5 *.* vel) +.+ - _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) - vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* unitVectorAtAngle dir - insertCloud = makeGasCloud pos vel -- . makeFlame pos2 vel (Just cid) +aGasCloud cid w = insertCloud $ set randGen g w + where + (a,g) = randomR (-0.1,0.1) (_randGen w) + cr = _creatures w IM.! cid + dir = _crDir cr + a + pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) + pos2 = (0.5 *.* vel) +.+ + _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) + vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* unitVectorAtAngle dir + insertCloud = makeGasCloud pos vel -- . makeFlame pos2 vel (Just cid) aFlame :: Int -> World -> World aFlame cid w = insertFlame w where (t,_) = randomR (99,101) (_randGen w) - cr = (_creatures w IM.! cid) + cr = _creatures w IM.! cid dir = _crDir cr pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir @@ -797,70 +761,67 @@ aSelf = blinkAction reflect :: Float -> Float -> Float reflect a b = a + 2*(a-b) -moveGrenade :: Int -> Float -> Int -> World -> World +moveGrenade + :: Int -- ^ Timer + -> Float -- ^ Direction + -> Int -- ^ Projectile id + -> World -> World moveGrenade 0 dir pID w = over projectiles (IM.delete pID) - $ explosion (_pjPos (_projectiles w IM.! pID)) - -- set (pointToItem (_itemPositions w IM.! wpID) . itEquipPict) - -- (drawWeapon $ grenadePic 50) - w + $ explosion (_pjPos (_projectiles w IM.! pID)) + w where pj = _projectiles w IM.! pID explosion = _pjPayload pj -moveGrenade time dir pID w - = case hitWl of - Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld - _ -> updatedWorld +moveGrenade time dir pID w = case hitWl of + Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld + _ -> updatedWorld where - updatedWorld = updateV $ set (projectiles . ix pID . pjPos) finalPos - $ set (projectiles .ix pID.pjPict) - (onLayer PtLayer $ uncurry translate newPos - $ rotate dir $ grenadePic time) - $ set (projectiles .ix pID.pjUpdate) (moveGrenade (time-1) dir pID) w - pj = _projectiles w IM.! pID - oldPos = _pjPos pj - newPos = _pjVel pj +.+ oldPos - hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w - finalPos = fromMaybe newPos (fmap fst hitWl) - setV v = set (projectiles .ix pID.pjVel) v - updateV = fromMaybe id (fmap (setV.snd) hitWl) + updatedWorld = updateV $ set (projectiles . ix pID . pjPos) finalPos + $ set (projectiles .ix pID.pjPict) + (onLayer PtLayer $ uncurry translate newPos + $ rotate dir $ grenadePic time) + $ set (projectiles .ix pID.pjUpdate) (moveGrenade (time-1) dir pID) w + pj = _projectiles w IM.! pID + oldPos = _pjPos pj + newPos = _pjVel pj +.+ oldPos + hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w + finalPos = maybe newPos fst hitWl + setV v = set (projectiles .ix pID.pjVel) v + updateV = maybe id (setV . snd) hitWl pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid pointToItem (OnFloor flid) = floorItems . ix flid . flIt retireRemoteRocket :: Int -> Int -> Int -> World -> World -retireRemoteRocket itid 0 pjid w - = set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) - (0,0) - $ set (pointToItem (_itemPositions w IM.! itid) . wpFire) - (hammerCheck fireRemoteLauncher) - (w & projectiles %~ IM.delete pjid) -retireRemoteRocket itid t pjid w = setScope w & projectiles . ix pjid . pjUpdate .~ retireRemoteRocket itid (t-1) pjid - where - setScope w' = case _itemPositions w' IM.! itid of - InInv cid invid - -> w' & creatures . ix cid . crInv . ix invid . itAttachment - . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) - _ -> w' - pos = fromMaybe (0,0) $ w ^? projectiles . ix pjid . pjPos +retireRemoteRocket itid 0 pjid w = + set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0) + $ set (pointToItem (_itemPositions w IM.! itid) . wpFire) (hammerCheck fireRemoteLauncher) + (w & projectiles %~ IM.delete pjid) +retireRemoteRocket itid t pjid w = setScope w + & projectiles . ix pjid . pjUpdate .~ retireRemoteRocket itid (t-1) pjid + where + setScope w' = case _itemPositions w' IM.! itid of + InInv cid invid -> w' + & creatures . ix cid . crInv . ix invid . itAttachment + . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) + _ -> w' + pos = fromMaybe (0,0) $ w ^? projectiles . ix pjid . pjPos retireRemoteBomb :: Int -> Int -> Int -> World -> World -retireRemoteBomb itid 0 pjid w - = set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) - (0,0) - $ set (pointToItem (_itemPositions w IM.! itid) . itZoom) - defaultItZoom - $ set (pointToItem (_itemPositions w IM.! itid) . twFire) - (hammerCheck throwRemoteBomb) - (w & projectiles %~ IM.delete pjid) -retireRemoteBomb itid t pjid w - = setScope w & projectiles . ix pjid . pjUpdate .~ retireRemoteBomb itid (t-1) pjid - where - setScope w' = case _itemPositions w' IM.! itid of - InInv cid invid - -> w' & creatures . ix cid . crInv . ix invid . itAttachment - . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) - _ -> w' - pos = fromMaybe (0,0) $ w ^? projectiles . ix pjid . pjPos +retireRemoteBomb itid 0 pjid w = + set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0) + $ set (pointToItem (_itemPositions w IM.! itid) . itZoom) defaultItZoom + $ set (pointToItem (_itemPositions w IM.! itid) . twFire) (hammerCheck throwRemoteBomb) + (w & projectiles %~ IM.delete pjid) +retireRemoteBomb itid t pjid w = setScope w + & projectiles . ix pjid . pjUpdate .~ retireRemoteBomb itid (t-1) pjid + where + setScope w' = case _itemPositions w' IM.! itid of + InInv cid invid -> w' + & creatures . ix cid . crInv . ix invid . itAttachment + . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) + _ -> w' + pos = fromMaybe (0,0) $ w ^? projectiles . ix pjid . pjPos moveRemoteBomb :: Int -> Int -> Int -> World -> World moveRemoteBomb itid time pID w @@ -876,197 +837,42 @@ moveRemoteBomb itid time pID w = case hitWl of Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld _ -> updatedWorld - where - updatedWorld - = updateV $ set (projectiles . ix pID . pjPos) finalPos - $ updatePicture - $ set (projectiles .ix pID.pjUpdate) (moveRemoteBomb itid (time-1) pID) - $ setScope - w - setScope w' = case _itemPositions w' IM.! itid of - InInv cid invid - -> w' & creatures . ix cid . crInv . ix invid . itAttachment - . _Just . scopePos .~ (newPos -.- _crPos (_creatures w' IM.! cid)) - & creatures . ix cid . crInv . ix invid . itZoom - .~ (defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5}) - _ -> w' - pj = _projectiles w IM.! pID - oldPos = _pjPos pj - newPos = _pjVel pj +.+ oldPos --- this is hacky, should use a version of collidePointWalls' that collides --- circles and walls - invShift x = x -.- 5 *.* normalizeV (_pjVel pj) - hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w - finalPos = fromMaybe newPos (fmap (invShift . fst) hitWl) - setV v = set (projectiles .ix pID.pjVel) v - updateV = fromMaybe id (fmap (setV.snd) hitWl) - halfV = over (projectiles . ix pID . pjVel) (\v -> 0.5 *.* v) - f x | x < -369 = -10 - | otherwise = x - 1 - updatePicture = set (projectiles . ix pID.pjPict) - (onLayer PtLayer $ uncurry translate newPos - $ remoteBombPic time) - . lowLightDirected (withAlpha 0.1 red) newPos - (50 *.* unitVectorAtAngle (negate $ degToRad (10 * fromIntegral time))) - [-0.2,-0.15,-0.1,-0.05,0,0.05,0.1,0.15,0.2] - - -shootRateIncrease :: Int -> Int -> (Int -> World -> World) -> Int -> World -> World -shootRateIncrease startRate fastRate shootEffect cid w - | repeatFire = set (pointItem . wpFireRate) (max fastRate (currentRate - 1)) - $ set (pointItem . wpFireState) currentRate - $ shootEffect cid - w - | firstFire = set (pointItem . wpFireRate) (startRate - 1) - $ set (pointItem . wpFireState) startRate - $ shootEffect cid - w - | reloadCondition = fromMaybe w $ reloadWeapon cid w - | otherwise = w - where cr = _creatures w IM.! cid - itRef = _crInvSel cr - item = _crInv cr IM.! itRef - pointItem = (creatures . ix cid . crInv . ix itRef) - currentRate = _wpFireRate item - repeatFire = _wpReloadState item == 0 - && _wpFireState item == 1 - && _wpLoadedAmmo item > 0 - firstFire = _wpReloadState item == 0 - && _wpFireState item == 0 - && _wpLoadedAmmo item > 0 - reloadCondition = _wpLoadedAmmo item == 0 - -rateIncAB :: Int -> Int -> (Int -> World -> World) - -> (Int -> World -> World) - -> Int -> World -> World -rateIncAB startRate fastRate shooteff1 shooteff2 cid w - | repeatFire = set (pointItem . wpFireRate) (max fastRate (currentRate - 1)) - $ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1) - $ set (pointItem . wpFireState) currentRate - $ shooteff2 cid - w - | firstFire = set (pointItem . wpFireRate) (startRate - 1) - $ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1) - $ set (pointItem . wpFireState) startRate - $ shooteff1 cid - w - | reloadCondition = fromMaybe w $ reloadWeapon cid w - | otherwise = w - where cr = _creatures w IM.! cid - itRef = _crInvSel cr - item = _crInv cr IM.! itRef - pointItem = (creatures . ix cid . crInv . ix itRef) - currentRate = _wpFireRate item - repeatFire = _wpReloadState item == 0 - && _wpFireState item == 1 - && _wpLoadedAmmo item > 0 - firstFire = _wpReloadState item == 0 - && _wpFireState item == 0 - && _wpLoadedAmmo item > 0 - reloadCondition = _wpLoadedAmmo item == 0 - - -makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle -makeLaserAt phaseV pos dir mcid = Particle - { _ptDraw = const blank - , _ptUpdate' = moveLaser phaseV pos dir mcid - } - -moveLaser - :: Float -- ^ Phase velocity, controls deflection in windows - -> Point2 - -> Float - -> Maybe Int - -> World - -> Particle - -> (World, Maybe Particle) -moveLaser phaseV pos dir mcid w pt - = ( set randGen g --- $ over worldEvents ((.) flares) - $ hitEffect w - , Just pt {_ptDraw = const $ onLayer PtLayer $ pic - ,_ptUpdate' = ptTimer' 0 - } - ) where - xp = pos +.+ 800 *.* unitVectorAtAngle dir - (a,g) = randomR (-0.7,0.7) $ _randGen w - reflectDir wall = a + (argV $ reflectIn - (_wlLine wall !! 1 -.- _wlLine wall !! 0) - (xp -.- pos) - ) - (colID,_) = randomR (0,11) $ _randGen w --- flares w = foldr (\p w' -> flareAt' yellow 0.01 0.02 p w') w flarePs --- flarePs = zipWith (\x y -> x +.+ 5 *.* normalizeV (y -.- x)) ps $ tail ps --- flarePos p = p +.+ ((a + 0.8) * 3) *.* (normalizeV (pos -.- p)) - f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either3 Creature Wall ForceField),[Point2]) - f seenWs x y = case listToMaybe $ filter (h' seenWs) - $ thingsHitExceptCrLongLine Nothing x y w of - Just (p,E3x2 wl) - | _wlIsSeeThrough wl -> f' p $ f (wl:seenWs) - p - (h x y wl p) - | otherwise -> (Just (p,E3x2 wl), [p]) - Just (p,obj) -> (Just (p,obj), [p]) - Nothing -> (Nothing, [y]) - f' p (x,ps') = (x,p:ps') - h x y wl p | isEntering = p +.+ rotateV angleRef normalDist - | otherwise = p +.+ rotateV angleRef' normalDist' - where wlNormal = vNormal $ (_wlLine wl !! 1) -.- (_wlLine wl !! 0) - normalDist = magV (p -.- y) *.* normalizeV wlNormal - angleInc = piRange $ argV wlNormal - argV (x -.- y) - angleRef | reflectExternal = angleInc - | otherwise = asin $ sin angleInc / phaseV - piRange a | a > pi = a - 2 * pi - | a > 0 - pi = a - | otherwise = a + 2 * pi - isEntering = isLeftOf (x -.- y) ((_wlLine wl !! 1) -.- (_wlLine wl !! 0)) - wlNormal' = vNormal $ (_wlLine wl !! 0) -.- (_wlLine wl !! 1) - normalDist' = magV (p -.- y) *.* normalizeV wlNormal' - angleInc' = piRange $ argV wlNormal' - argV (x -.- y) - angleRef' | reflectInternal = angleInc' - | otherwise = asin $ phaseV * sin angleInc' - reflectInternal = 1 < abs (phaseV * sin angleInc') - reflectExternal = 1 < abs (sin angleInc / phaseV) - - h' ws (_,E3x2 wl) = not $ any (\w -> _wlID w == _wlID wl) ws - h' _ _ = True - (thHit, ps) = f [] pos xp - hitEffect - = case thHit of - Just (p,E3x1 cr) - -> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 19 pos p xp) --- . over worldEvents ((.) $ flareAt yellow (flarePos p)) - Just (p,E3x2 wl) -> createSpark 8 colID (p +.+ safeNormalizeV (pos -.- p)) - (reflectDir wl) Nothing - _ -> id - pic = pictures [ fadeLine pos (head ps) 0.2 40 yellow - , setLayer 1 $ color (withAlpha 0.9 white) $ vThickLine (pos:ps) - , setLayer 1 $ color (withAlpha 0.5 yellow) $ vvThickLine (pos:ps) - ] - -fadeLine :: Point2 -> Point2 -> Float -> Float -> Color -> Picture -fadeLine sp ep alph width col = setLayer 1 $ - polygonCol [(sp , ca) - ,(sp +.+ n , cb) - ,(ep +.+ n , cb) - ,(ep , ca) - ,(ep -.- n , cb) - ,(sp -.- n , cb) - ] - where n = width *.* (normalizeV $ vNormal $ ep -.- sp) - ca = withAlpha alph col - cb = withAlpha 0 col --- pictures [color (withAlpha (0.8 * alph) col) $ lineOfThickness width [sp,p 0.25] --- ,color (withAlpha (0.6 * alph) col) $ lineOfThickness width [p 0.25,p 0.5] --- ,color (withAlpha (0.4 * alph) col) $ lineOfThickness width [p 0.5,p 0.75] --- ,color (withAlpha (0.2 * alph) col) $ lineOfThickness width [p 0.75,ep] --- ] --- where p x = sp +.+ x *.* (ep -.- sp) - -grenadeLauncher :: Item -grenadeLauncher = pistol - + updatedWorld + = updateV $ set (projectiles . ix pID . pjPos) finalPos + $ updatePicture + $ set (projectiles .ix pID.pjUpdate) (moveRemoteBomb itid (time-1) pID) + $ setScope + w + setScope w' = case _itemPositions w' IM.! itid of + InInv cid invid + -> w' & creatures . ix cid . crInv . ix invid . itAttachment + . _Just . scopePos .~ (newPos -.- _crPos (_creatures w' IM.! cid)) + & creatures . ix cid . crInv . ix invid . itZoom + .~ (defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5}) + _ -> w' + pj = _projectiles w IM.! pID + oldPos = _pjPos pj + newPos = _pjVel pj +.+ oldPos + -- this is hacky, should use a version of collidePointWalls' that collides + -- circles and walls + invShift x = x -.- 5 *.* normalizeV (_pjVel pj) + hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w + finalPos = maybe newPos (invShift . fst) hitWl + setV v = set (projectiles . ix pID . pjVel) v + updateV = maybe id (setV . snd) hitWl + halfV = projectiles . ix pID . pjVel %~ (0.5 *.*) + f x | x < -369 = -10 + | otherwise = x - 1 + updatePicture = + set (projectiles . ix pID.pjPict) + (onLayer PtLayer $ uncurry translate newPos $ remoteBombPic time) + . lowLightDirected + (withAlpha 0.1 red) + newPos + (50 *.* unitVectorAtAngle (negate $ degToRad (10 * fromIntegral time))) + [-0.2,-0.15,-0.1,-0.05,0,0.05,0.1,0.15,0.2] + grenade,remoteBomb :: Item grenade = Throwable { _itName = "GRENADE " ++ show fuseTime @@ -1076,62 +882,76 @@ grenade = Throwable , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _twMaxRange = 150 , _twAccuracy = 30 - , _twFire = throwGrenade' makeExplosionAt fuseTime + , _twFire = useTimeCheck $ throwGrenade makeExplosionAt fuseTime , _itAimingSpeed = 1 , _itAimingRange = 0 - , _itZoom = defaultItZoom {_itAimZoomMax = (f fuseTime), _itAimZoomMin = (f fuseTime)} + , _itZoom = defaultItZoom {_itAimZoomMax = f fuseTime, _itAimZoomMin = f fuseTime} , _itEquipPict = drawWeapon $ grenadePic fuseTime , _itID = Nothing + , _itUseRate = 50 + , _itUseTime = 0 , _itAttachment = Just $ ItFuse fuseTime , _itInvColor = white - , _itInvDisplay = _itName + , _itInvDisplay = basicWeaponDisplay , _itEffect = wpRecock , _itHammer = HammerUp , _itScrollUp = decreaseFuse fuseTime , _itScrollDown = increaseFuse fuseTime } - where fuseTime = 50 - f x = 50 / fromIntegral x - + where + fuseTime = 50 + f x = 50 / fromIntegral x flameGrenade :: Item flameGrenade = grenade { _itName = "FLMGREN " ++ show fuseTime - , _twFire = throwGrenade' makeFlameExplosionAt fuseTime + , _twFire = throwGrenade makeFlameExplosionAt fuseTime } - where fuseTime = 50 - f x = 50 / fromIntegral x + where + fuseTime = 50 + f x = 50 / fromIntegral x teslaGrenade :: Item teslaGrenade = grenade { _itName = "TLSGREN " ++ show fuseTime - , _twFire = throwGrenade' makeTeslaExplosionAt fuseTime + , _twFire = throwGrenade makeTeslaExplosionAt fuseTime } - where fuseTime = 50 - f x = 50 / fromIntegral x + where + fuseTime = 50 + f x = 50 / fromIntegral x +increaseFuse + :: Int -- ^ Old fuse time + -> Int -- ^ Inventory item reference (I believe) + -> World + -> World +increaseFuse fuse i w = w + & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime + & creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime + & creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime + & creatures . ix 0 . crInv . ix itRef . itAttachment ?~ ItFuse newTime + & creatures . ix 0 . crInv . ix itRef . itZoom + .~ (defaultItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm}) + where + itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel + newTime = min (fuse + 5) 90 + zm = 50 / fromIntegral newTime -increaseFuse :: Int -> Int -> World -> World -increaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime - & creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime - & creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime - & creatures . ix 0 . crInv . ix itRef . itAttachment .~ Just (ItFuse newTime) - & creatures . ix 0 . crInv . ix itRef . itZoom - .~ (defaultItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm}) - where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel - newTime = min (fuse + 5) 90 - zm = 50 / fromIntegral newTime - -decreaseFuse :: Int -> Int -> World -> World -decreaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime - & creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime - & creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime - & creatures . ix 0 . crInv . ix itRef . itAttachment .~ Just (ItFuse newTime) - & creatures . ix 0 . crInv . ix itRef . itZoom - .~ (defaultItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm}) - where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel - newTime = max (fuse - 5) 20 - zm = 50 / fromIntegral newTime +decreaseFuse + :: Int -- ^ Old fuse time + -> Int -- ^ Inventory item reference (I believe) + -> World -> World +decreaseFuse fuse i w = w + & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime + & creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime + & creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime + & creatures . ix 0 . crInv . ix itRef . itAttachment ?~ ItFuse newTime + & creatures . ix 0 . crInv . ix itRef . itZoom + .~ (defaultItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm}) + where + itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel + newTime = max (fuse - 5) 20 + zm = 50 / fromIntegral newTime defaultThrowable = grenade remoteBomb = defaultThrowable @@ -1142,14 +962,13 @@ remoteBomb = defaultThrowable , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _twMaxRange = 150 , _twAccuracy = 30 - , _twFire = hammerCheck $ throwRemoteBomb + , _twFire = hammerCheck throwRemoteBomb , _itAttachment = Just $ ItScope (0,0) 0 1 True , _itEquipPict = drawWeapon remoteBombUnarmedPic } - -throwGrenade' :: (Point2 -> World -> World) -> Int -> Int -> World -> World -throwGrenade' explosion fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w +throwGrenade :: (Point2 -> World -> World) -> Int -> Int -> World -> World +throwGrenade explosion fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w where addG = IM.insert i $ Shell { _pjPos = p @@ -1444,18 +1263,6 @@ jetPack = defaultEquipment , _itID = Nothing } {- | -Current thickness: 2 -} -thickLine :: [Point2] -> Picture -thickLine = lineOfThickness 2 -{- | -Current thickness: 3 -} -vThickLine :: [Point2] -> Picture -vThickLine = lineOfThickness 3 -{- | -Current thickness: 6 -} -vvThickLine :: [Point2] -> Picture -vvThickLine = lineOfThickness 6 -{- | Sends out pulses that display walls. -} radar = defaultGun { _itName = "RADAR" @@ -1464,8 +1271,8 @@ radar = defaultGun , _wpLoadedAmmo = 100 , _wpReloadTime = 200 , _wpReloadState = 0 - , _wpFireRate = 120 - , _wpFireState = 0 + , _itUseRate = 120 + , _itUseTime = 0 , _wpFire = shoot aRadarPulse , _wpSpread = autogunSpread , _wpRange = 20 @@ -1486,8 +1293,8 @@ sonar = defaultGun , _wpLoadedAmmo = 100 , _wpReloadTime = 200 , _wpReloadState = 0 - , _wpFireRate = 120 - , _wpFireState = 0 + , _itUseRate = 120 + , _itUseTime = 0 , _wpFire = shoot aSonarPulse , _wpRange = 20 , _itHammer = HammerUp @@ -1537,7 +1344,7 @@ spawnGun cr = defaultGun , _wpLoadedAmmo = 1 , _wpReloadTime = 80 , _wpReloadState = 0 - , _wpFireRate = 100 + , _itUseRate = 100 , _wpFire = spawnCrNextTo cr } spawnCrNextTo diff --git a/src/Dodge/Item/Weapon/Decoration.hs b/src/Dodge/Item/Weapon/Decoration.hs index 36c02a5bc..013dc3073 100644 --- a/src/Dodge/Item/Weapon/Decoration.hs +++ b/src/Dodge/Item/Weapon/Decoration.hs @@ -5,6 +5,7 @@ module Dodge.Item.Weapon.Decoration where import Dodge.Data import Dodge.Base +import Dodge.Picture import Geometry.Data import Picture diff --git a/src/Dodge/Item/Weapon/Laser.hs b/src/Dodge/Item/Weapon/Laser.hs new file mode 100644 index 000000000..3f420444e --- /dev/null +++ b/src/Dodge/Item/Weapon/Laser.hs @@ -0,0 +1,123 @@ +module Dodge.Item.Weapon.Laser + where +import Dodge.Data +import Dodge.Picture +import Dodge.Item.Attachment.Data +import Dodge.Base +import Dodge.SoundLogic +import Dodge.WorldEvent.SpawnParticle +import Dodge.WorldEvent.ThingsHit +import Dodge.WorldEvent.HelperParticle +import Dodge.WorldEvent.Flash +import Geometry +import Picture + +import Control.Lens +import System.Random +import Data.List (find) +import Data.Maybe (fromMaybe) +import qualified Data.Sequence as Seq +import qualified Data.IntMap.Strict as IM + +aLaser :: Int -> World -> World +aLaser cid w = over particles (makeLaserAt phaseV pos dir (Just cid) : ) + $ soundFrom LasSound 24 1 0 + $ laserGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir) + w + where + cr = _creatures w IM.! cid + i = newProjectileKey w + pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) + dir = _crDir cr + phaseV = charToPhaseV + $ fromMaybe '/' $ Seq.lookup 0 =<< cr ^? crInv . ix j . itAttachment . _Just . itCharMode + j = _crInvSel cr + +charToPhaseV 'V' = 0.2 +charToPhaseV '/' = 1 +charToPhaseV 'Z' = 5 + + +makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle +makeLaserAt phaseV pos dir mcid = Particle + { _ptDraw = const blank + , _ptUpdate' = moveLaser phaseV pos dir mcid + } + +moveLaser + :: Float -- ^ Phase velocity, controls deflection in windows + -> Point2 + -> Float + -> Maybe Int + -> World + -> Particle + -> (World, Maybe Particle) +moveLaser phaseV pos dir mcid w pt + = ( set randGen g $ hitEffect w + , Just pt {_ptDraw = const $ onLayer PtLayer $ pic ,_ptUpdate' = ptTimer' 0 } + ) + where + xp = pos +.+ 800 *.* unitVectorAtAngle dir + (a,g) = randomR (-0.7,0.7) $ _randGen w + reflectDir wall = a + + (argV $ reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (xp -.- pos) ) + (colID,_) = randomR (0,11) $ _randGen w + f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either3 Creature Wall ForceField),[Point2]) + f seenWs x y = case find (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of + Just (p,E3x2 wl) + | _wlIsSeeThrough wl -> f' p $ f (wl:seenWs) + p + (h x y wl p) + | otherwise -> (Just (p,E3x2 wl), [p]) + Just (p,obj) -> (Just (p,obj), [p]) + Nothing -> (Nothing, [y]) + f' p (x,ps') = (x,p:ps') + h x y wl p | isEntering = p +.+ rotateV angleRef normalDist + | otherwise = p +.+ rotateV angleRef' normalDist' + where + wlNormal = vNormal $ (_wlLine wl !! 1) -.- (_wlLine wl !! 0) + normalDist = magV (p -.- y) *.* normalizeV wlNormal + angleInc = piRange $ argV wlNormal - argV (x -.- y) + angleRef | reflectExternal = angleInc + | otherwise = asin $ sin angleInc / phaseV + piRange a | a > pi = a - 2 * pi + | a > negate pi = a + | otherwise = a + 2 * pi + isEntering = isLeftOf (x -.- y) ((_wlLine wl !! 1) -.- (_wlLine wl !! 0)) + wlNormal' = vNormal $ (_wlLine wl !! 0) -.- (_wlLine wl !! 1) + normalDist' = magV (p -.- y) *.* normalizeV wlNormal' + angleInc' = piRange $ argV wlNormal' - argV (x -.- y) + angleRef' | reflectInternal = angleInc' + | otherwise = asin $ phaseV * sin angleInc' + reflectInternal = 1 < abs (phaseV * sin angleInc') + reflectExternal = 1 < abs (sin angleInc / phaseV) + + h' ws (_,E3x2 wl) = not $ any (\w -> _wlID w == _wlID wl) ws + h' _ _ = True + (thHit, ps) = f [] pos xp + hitEffect + = case thHit of + Just (p,E3x1 cr) + -> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 19 pos p xp) +-- . over worldEvents ((.) $ flareAt yellow (flarePos p)) + Just (p,E3x2 wl) -> createSpark 8 colID (p +.+ safeNormalizeV (pos -.- p)) + (reflectDir wl) Nothing + _ -> id + pic = pictures [ fadeLine pos (head ps) 0.2 40 yellow + , setLayer 1 $ color (withAlpha 0.9 white) $ vThickLine (pos:ps) + , setLayer 1 $ color (withAlpha 0.5 yellow) $ vvThickLine (pos:ps) + ] + +fadeLine :: Point2 -> Point2 -> Float -> Float -> Color -> Picture +fadeLine sp ep alph width col = setLayer 1 $ polygonCol + [(sp , ca) + ,(sp +.+ n , cb) + ,(ep +.+ n , cb) + ,(ep , ca) + ,(ep -.- n , cb) + ,(sp -.- n , cb) + ] + where + n = width *.* normalizeV (vNormal $ ep -.- sp) + ca = withAlpha alph col + cb = withAlpha 0 col diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index c7c12dcd0..b78d7b18b 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -42,6 +42,44 @@ withThickSmoke eff cid w = eff cid $ foldr (makeThickSmokeAt . (+.+ pos)) w ps pos = _crPos cr +.+ (_crRad cr + 15) *.* unitVectorAtAngle dir ps = (replicateM 20 . randInCirc) 8 & evalState $ _randGen w {- | +Fires at an increasing rate. +Has different effect after first fire. +Applies ammo check and use cooldown check. -} +rateIncAB + :: Int -- ^ Start rate + -> Int -- ^ End rate + -> (Int -> World -> World) -- ^ Effect on first fire + -> (Int -> World -> World) -- ^ Effect on continued fire + -> Int -- ^ Creature id + -> World + -> World +rateIncAB startRate fastRate shooteff1 shooteff2 cid w + | repeatFire = set (pointItem . itUseRate) (max fastRate (currentRate - 1)) + $ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1) + $ set (pointItem . itUseTime) currentRate + $ shooteff2 cid + w + | firstFire = set (pointItem . itUseRate) (startRate - 1) + $ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1) + $ set (pointItem . itUseTime) startRate + $ shooteff1 cid + w + | reloadCondition = fromMaybe w $ reloadWeapon cid w + | otherwise = w + where + cr = _creatures w IM.! cid + itRef = _crInvSel cr + item = _crInv cr IM.! itRef + pointItem = creatures . ix cid . crInv . ix itRef + currentRate = _itUseRate item + repeatFire = _wpReloadState item == 0 + && _itUseTime item == 1 + && _wpLoadedAmmo item > 0 + firstFire = _wpReloadState item == 0 + && _itUseTime item == 0 + && _wpLoadedAmmo item > 0 + reloadCondition = _wpLoadedAmmo item == 0 +{- | Shoot a weapon rapidly after a warm up. Applies ammo check as well. -} withWarmUp @@ -55,18 +93,18 @@ 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 + $ set (pointerToItem . itUseTime) 2 w | t > 2 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) - $ set (pointerToItem . wpFireState) 2 + $ set (pointerToItem . itUseTime) 2 $ soundFrom (CrWeaponSound cid) 26 2 0 w | t > 0 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) - $ set (pointerToItem . wpFireState) 2 + $ set (pointerToItem . itUseTime) 2 w | otherwise = set (pointerToItem . wpFire) (withWarmUp 1 f) $ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) - $ set (pointerToItem . wpFireState) 2 + $ set (pointerToItem . itUseTime) 2 $ f cid $ soundFrom (CrWeaponSound cid) 28 2 0 w @@ -75,8 +113,8 @@ withWarmUp t f cid w itRef = _crInvSel cr item = _crInv cr IM.! itRef pointerToItem = creatures . ix cid . crInv . ix itRef - fState = _wpFireState item - fRate = _wpFireRate item + fState = _itUseTime item + fRate = _itUseRate item reloadCondition = _wpLoadedAmmo item == 0 {- | Adds a sound to a creature based world effect. @@ -136,7 +174,7 @@ shootWithSound shootWithSound soundid f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) $ soundOncePos soundid (_crPos cr) - $ set (pointerToItem . wpFireState) (_wpFireRate item) + $ set (pointerToItem . itUseTime) (_itUseRate item) $ f cid w | reloadCondition = fromMaybe w $ reloadWeapon cid w | otherwise = w @@ -146,10 +184,25 @@ shootWithSound soundid f cid w item = _crInv cr IM.! itRef pointerToItem = creatures . ix cid . crInv . ix itRef fireCondition = _wpReloadState item == 0 - && _wpFireState item == 0 + && _itUseTime item == 0 && _wpLoadedAmmo item > 0 reloadCondition = _wpLoadedAmmo item == 0 {- | +Applies a world effect after an item use cooldown check. -} +useTimeCheck + :: (Int -> World -> World) -- ^ Underlying effect + -> Int -- ^ Creature id + -> World + -> World +useTimeCheck f cid w = case theItem ^? itUseTime of + Just 0 -> f cid $ setUseTime w + _ -> w + where + cr = _creatures w IM.! cid + setUseTime = creatures . ix cid . crInv . ix (_crInvSel cr) . itUseTime +~ useRate + theItem = _crInv cr IM.! _crInvSel cr + useRate = fromMaybe 0 $ theItem ^? itUseRate +{- | Applies a world effect after a hammer position check. -} hammerCheck :: (Int -> World -> World) -- ^ Underlying effect @@ -172,7 +225,7 @@ shoot -> World shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) - $ set (pointerToItem . wpFireState) (_wpFireRate item) + $ set (pointerToItem . itUseTime) (_itUseRate item) $ f cid w | reloadCondition = fromMaybe w $ reloadWeapon cid w | otherwise = w @@ -182,7 +235,7 @@ shoot f cid w item = _crInv cr IM.! itRef pointerToItem = creatures . ix cid . crInv . ix itRef fireCondition = _wpReloadState item == 0 - && _wpFireState item == 0 + && _itUseTime item == 0 && _wpLoadedAmmo item > 0 reloadCondition = _wpLoadedAmmo item == 0 diff --git a/src/Dodge/Picture.hs b/src/Dodge/Picture.hs new file mode 100644 index 000000000..cf05fcdf7 --- /dev/null +++ b/src/Dodge/Picture.hs @@ -0,0 +1,31 @@ +{- | +Compound, universal pictures. +Creates uniform sizes and commands for the Dodge modules. -} +module Dodge.Picture + where +import Geometry +import Picture + + +-- {- | +-- Current thickness: 2 -} +-- thickLine :: [Point2] -> Picture +-- thickLine = lineOfThickness 2 +{- | +Current thickness: 3 -} +vThickLine :: [Point2] -> Picture +vThickLine = lineOfThickness 3 +{- | +Current thickness: 6 -} +vvThickLine :: [Point2] -> Picture +vvThickLine = lineOfThickness 6 + +-- shit this is ugly +lineOfThickness :: Float -> [Point2] -> Picture +lineOfThickness t = pictures . f + where f (x:y:ys) + | x == y = f (x:ys) + | otherwise + = polygon [x +.+ n x y, x -.- n x y, y -.- n x y, y +.+ n x y] : f (y:ys) + f _ = [] + n a b = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b)) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 0681107bf..0cb53f71c 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -20,9 +20,10 @@ hudDrawings w = setLayer 1 . setDepth (-0.5) . pictures $ ] ++ selectionText where - selectionText = if _carteDisplay w - then drawLocations w - else drawInventory w + selectionText = + if _carteDisplay w + then drawLocations w + else drawInventory w scaler = scale (2 / getWindowX w) (2 / getWindowY w) drawInventory :: World -> [Picture] @@ -53,10 +54,6 @@ itemStringCol :: Item -> (String,Color) itemStringCol NoItem = ("----", greyN 0.5) itemStringCol itm = (_itInvDisplay itm itm, _itInvColor itm) -dItem' NoItem = scale 0.1 0.1 $ dShadCol (greyN 0.5) $ text "----" -dItem' i = scale 0.1 0.1 $ dShadCol (_itInvColor i) t - where t = text $ _itInvDisplay i i - drawLocations :: World -> [Picture] drawLocations w = displayListTopLeft locs w ++ zipWith bFunc (displayListEndCoords w locTexts) locPoss diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 9341f24d8..7152ac277 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -2,10 +2,9 @@ module Dodge.Render.Picture where import Dodge.Data import Dodge.Base - +import Dodge.Picture import Dodge.Render.HUD import Dodge.Render.MenuScreen - import Geometry import Picture diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 07a9b9ddd..3b3aa5c83 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -12,6 +12,7 @@ module Dodge.WorldEvent.Flash where import Dodge.Data import Dodge.Base +import Dodge.Picture import Dodge.LightSources import Dodge.WorldEvent.ThingsHit diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index c99bae442..2050bc59b 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -5,6 +5,7 @@ module Dodge.WorldEvent.SpawnParticle where import Dodge.Data import Dodge.Base +import Dodge.Picture import Dodge.WorldEvent.HitEffect import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.Cloud