From 83c22208136b01ad1d64b58720f7e4d68a6cfc8e Mon Sep 17 00:00:00 2001 From: jgk Date: Fri, 30 Apr 2021 15:22:24 +0200 Subject: [PATCH] Refactoring, linting --- src/Dodge/Creature.hs | 5 +- src/Dodge/Item/Attachment/Data.hs | 1 - src/Dodge/Item/Weapon.hs | 347 +++++++--------------- src/Dodge/Item/Weapon/InventoryDisplay.hs | 12 +- src/Dodge/Item/Weapon/TriggerType.hs | 10 +- src/Dodge/Item/Weapon/UseEffect.hs | 93 +++++- 6 files changed, 205 insertions(+), 263 deletions(-) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index b4432c757..fb7b6083d 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -265,9 +265,8 @@ Items you start with. startInventory = IM.fromList (zip [0..20] ( [lasGun - ,autoGun - ,flamer - --,blinkGun + ,remoteLauncher + ,grenade --,spawnGun lamp --,poisonSprayer --,autoGun diff --git a/src/Dodge/Item/Attachment/Data.hs b/src/Dodge/Item/Attachment/Data.hs index d295ea50b..52432bd03 100644 --- a/src/Dodge/Item/Attachment/Data.hs +++ b/src/Dodge/Item/Attachment/Data.hs @@ -15,7 +15,6 @@ data ItAttachment ,_scopeIsCamera :: Bool } | ItFuse {_itFuseTime :: Int} - | ItPhaseV {_itPhaseV :: Float} | ItMode {_itMode :: Int} | ItCharMode {_itCharMode :: Seq.Seq Char } | ItTargetPos { _itTargetPos :: Point2 } diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index ce2fae81b..163aa7fda 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -220,7 +220,7 @@ forceFieldGun = defaultGun , _wpReloadState = 0 , _wpFireRate = 10 , _wpFireState = 0 - , _wpFire = forceFieldFire + , _wpFire = undefined , _wpSpread = 0.02 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)] @@ -364,7 +364,7 @@ remoteLauncher = defaultGun , _wpReloadState = 0 , _wpFireRate = 10 , _wpFireState = 0 - , _wpFire = fireRemoteLauncher + , _wpFire = hammerCheck $ fireRemoteLauncher , _wpSpread = 0.02 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) @@ -386,7 +386,6 @@ hvAutoGun = defaultAutoGun , _wpFireState = 0 , _wpFire = rateIncAB 24 10 (torqueBeforeForced 0.1 mkHvBul) $ torqueAfter 0.2 mkHvBul - , _wpSpread = autogunSpread , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color orange $ polygon $ rectNESW 5 5 (-5) (-5) , _itAmount = 1 @@ -442,7 +441,6 @@ miniGun = defaultAutoGun . withMuzFlare . withVelWthHiteff (30,0) 2 $ destroyOnImpact bulBounceArmCr' bulHitWall' bulHitFF' - , _wpSpread = autogunSpread , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color red $ polygon $ rectNESW 9 5 (-9) (-5) , _itAmount = 1 @@ -593,7 +591,7 @@ flamer = defaultAutoGun , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 - , _wpFire = shoot $ withSidePushAfter 10 $ randWalkAngle 0.5 0.05 aFlame + , _wpFire = shoot $ withSidePush 5 $ withSidePushAfter 10 $ randWalkAngle 0.5 0.05 aFlame , _wpSpread = 0 , _wpRange = 8 , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) @@ -659,16 +657,6 @@ charToPhaseV 'V' = 0.2 charToPhaseV '/' = 1 charToPhaseV 'Z' = 5 -aTractorBeam :: Int -> Int -> World -> World -aTractorBeam col cid w - = set (creatures . ix cid . crInv . ix itRef . wpFire) - (shoot $ aTractorBeam ((col + 1) `mod` 10)) - $ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w - where i = newProjectileKey w - cr = (_creatures w IM.! cid) - pos = _crPos cr +.+ ((_crRad cr +10) *.* unitVectorAtAngle dir) - dir = _crDir cr - itRef = _crInvSel cr aRocketWithPayload :: (Point2 -> World -> World) @@ -779,19 +767,6 @@ remoteShellPic i | rem (i+200) 20 < 9 = polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6, shellExplosionAt = makeExplosionAt -tractorBeamAt :: Int -> Int -> Point2 -> Float -> Projectile -tractorBeamAt colID i pos dir = Projectile - { _pjPos = pos - , _pjStartPos = p' - , _pjVel = d - , _pjPict = blank - , _pjID = i - , _pjUpdate = updateTractor colID 10 i - } - where - d = unitVectorAtAngle dir - p' = pos +.+ 400 *.* d - aGasCloud :: Int -> World -> World aGasCloud cid w = insertCloud $ set randGen g $ @@ -857,7 +832,7 @@ retireRemoteRocket itid 0 pjid w = set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0) $ set (pointToItem (_itemPositions w IM.! itid) . wpFire) - fireRemoteLauncher + (hammerCheck fireRemoteLauncher) (w & projectiles %~ IM.delete pjid) retireRemoteRocket itid t pjid w = setScope w & projectiles . ix pjid . pjUpdate .~ retireRemoteRocket itid (t-1) pjid where @@ -875,7 +850,7 @@ retireRemoteBomb itid 0 pjid w $ set (pointToItem (_itemPositions w IM.! itid) . itZoom) defaultItZoom $ set (pointToItem (_itemPositions w IM.! itid) . twFire) - throwRemoteBomb + (hammerCheck throwRemoteBomb) (w & projectiles %~ IM.delete pjid) retireRemoteBomb itid t pjid w = setScope w & projectiles . ix pjid . pjUpdate .~ retireRemoteBomb itid (t-1) pjid @@ -1101,7 +1076,7 @@ grenade = Throwable , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _twMaxRange = 150 , _twAccuracy = 30 - , _twFire = throwGrenade fuseTime + , _twFire = throwGrenade' makeExplosionAt fuseTime , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = defaultItZoom {_itAimZoomMax = (f fuseTime), _itAimZoomMin = (f fuseTime)} @@ -1139,7 +1114,6 @@ teslaGrenade = grenade { 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 . twFire .~ throwGrenade 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 @@ -1151,7 +1125,6 @@ increaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ 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 . twFire .~ throwGrenade 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 @@ -1169,9 +1142,9 @@ remoteBomb = defaultThrowable , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _twMaxRange = 150 , _twAccuracy = 30 - , _twFire = throwRemoteBomb + , _twFire = hammerCheck $ throwRemoteBomb , _itAttachment = Just $ ItScope (0,0) 0 1 True - , _itEquipPict = drawWeapon $ remoteBombUnarmedPic + , _itEquipPict = drawWeapon remoteBombUnarmedPic } @@ -1204,36 +1177,34 @@ throwGrenade' explosion fuseTime n w = setWp $ removePict $ over projectiles add setWp :: World -> World setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20 -throwGrenade :: Int -> Int -> World -> World -throwGrenade = throwGrenade' makeExplosionAt - throwArmReset :: Int -> ItEffect -throwArmReset x = - ItInvEffect {_itInvEffect = f - ,_itEffectCounter = x - } - where f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i - counterDown it | _itEffectCounter (_itEffect it) == 0 - = it & itHammer .~ HammerUp - & itEquipPict .~ (drawWeapon $ grenadePic 50) - | otherwise = it & itEffect . itEffectCounter %~ (\x -> x - 1) +throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x } + where + f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i + counterDown it + | _itEffectCounter (_itEffect it) == 0 = it + & itHammer .~ HammerUp + & itEquipPict .~ drawWeapon (grenadePic 50) + | otherwise = it & itEffect . itEffectCounter -~ 1 (grenadeAccL, grenadeAccA) = (0.1, 0.1) grenadePic :: Int -> Picture -grenadePic x = pictures [ color (dark $ dark green) $ circleSolid 5 - , color green $ arc - (degToRad $ (179 * fromIntegral x / 50) - 180 ) - (degToRad $ 180 - (179 * fromIntegral x / 50) ) - 5 - , translate (-2) 2 $ rotate (pi*0.5) - $ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot x 20 - ] +grenadePic x = pictures + [ color (dark $ dark green) $ circleSolid 5 + , color green $ arc (degToRad $ (179 * fromIntegral x / 50) - 180 ) + (degToRad $ 180 - (179 * fromIntegral x / 50) ) + 5 + , translate (-2) 2 $ rotate (pi*0.5) + $ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot x 20 + ] fireRemoteLauncher :: Int -> World -> World -fireRemoteLauncher cid w = setLocation $ resetFire $ resetName - $ soundOnce (fromIntegral launcherSound) - $ over projectiles remRocket w +fireRemoteLauncher cid w = setLocation + $ resetFire + $ resetName + $ soundOnce (fromIntegral launcherSound) + $ over projectiles remRocket w where i = newKey $ _projectiles w cr = _creatures w IM.! cid @@ -1250,13 +1221,14 @@ fireRemoteLauncher cid w = setLocation $ resetFire $ resetName j = _crInvSel $ _creatures w IM.! cid newitid = newKey $ _itemPositions w maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just - resetFire = set (creatures . ix cid . crInv . ix j . wpFire) $ explodeRemoteRocket itid i + resetFire = set (creatures . ix cid . crInv . ix j . wpFire) + $ hammerCheck $ explodeRemoteRocket itid i resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEROCKET" setLocation :: World -> World setLocation w' = case maybeitid of - Nothing -> w' & creatures . ix cid . crInv . ix j . itID .~ Just newitid - & itemPositions %~ IM.insert newitid (InInv cid j) - _ -> w' + Nothing -> w' & creatures . ix cid . crInv . ix j . itID ?~ newitid + & itemPositions %~ IM.insert newitid (InInv cid j) + _ -> w' itid = fromMaybe newitid maybeitid moveRemoteShell :: Int -> Int -> Int -> Int -> Float -> World -> World @@ -1270,68 +1242,64 @@ moveRemoteShell time i cid itid dir w $ setScope w | time >= 20 = case thingHit of - Just p -> doExplosion w - Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) - $ set (projectiles . ix i . pjPict) pic - $ set (projectiles . ix i . pjUpdate) - (moveRemoteShell (time-1) i cid itid newdir) - $ setScope - w - | time > -99 - = case thingHit of - Just p -> doExplosion - $ stopSoundFrom (ShellSound i) - w - Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) - $ set randGen g - $ set (projectiles . ix i . pjPict) pic - $ set (projectiles . ix i . pjUpdate) - (moveRemoteShell (time-1) i cid itid newdir) - $ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v) - $ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) (1) 250 - $ smokeGen - $ makeFlameletTimed oldPos - (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 - $ setScope - w + Just p -> doExplosion w + Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) + $ set (projectiles . ix i . pjPict) pic + $ set (projectiles . ix i . pjUpdate) + (moveRemoteShell (time-1) i cid itid newdir) + $ setScope + w + | time > -99 = case thingHit of + Just p -> doExplosion + $ stopSoundFrom (ShellSound i) + w + Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) + $ set randGen g + $ set (projectiles . ix i . pjPict) pic + $ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir) + $ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v) + $ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250 + $ smokeGen + $ makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 + $ setScope + w | time > -200 = case thingHit of - Just p -> doExplosion - $ stopSoundFrom (ShellSound i) - w - Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) - $ set (projectiles . ix i . pjPict) pic - $ set (projectiles . ix i . pjUpdate) - (moveRemoteShell (time-1) i cid itid newdir) - $ setScope - w + Just p -> doExplosion + $ stopSoundFrom (ShellSound i) + w + Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) + $ set (projectiles . ix i . pjPict) pic + $ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir) + $ setScope + w | otherwise = doExplosion - $ stopSoundFrom (ShellSound i) - w + $ stopSoundFrom (ShellSound i) + w where pj = _projectiles w IM.! i oldPos = _pjPos pj vel = _pjVel pj newPos = oldPos +.+ vel newdir - | SDL.ButtonRight `S.member` (_mouseButtons w) + | SDL.ButtonRight `S.member` _mouseButtons w && w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . itInvId - = _cameraRot w + (argV $ _mousePos w) + = _cameraRot w + argV (_mousePos w) | otherwise = dir accel = rotateV newdir (2,0) (frict,g) = randomR (0.6,0.9) $ _randGen w (sparkD,_) = randomR (-0.5,0.5) $ _randGen w - dir = argV $ vel + dir = argV vel pic = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) $ remoteShellPic time piclow = onLayerL [levLayer CrLayer - 2] $ uncurry translate newPos $ rotate (argV accel) $ remoteShellPic time - hitCr = fmap fst $ collideCircCrsPoint oldPos newPos 4 w - hitWl = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w + hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w + hitWl = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w) thingHit = hitCr <|> hitWl r1 = _randGen w & evalState (randInCirc 10) - smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* (normalizeV (oldPos -.- newPos))) + smokeGen = makeSmokeCloudAt $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos) doExplosion = explodeRemoteRocket itid i cid setScope w' = case _itemPositions w' IM.! itid of InInv cid invid @@ -1368,12 +1336,14 @@ throwRemoteBomb n w = setLocation $ removePict $ resetFire --(l, _) = randomR (1 - grenadeAccL,1+grenadeAccL) (_randGen w) --(a, g) = randomR (-grenadeAccA,grenadeAccA) (_randGen w) v' = 0.02 / _cameraZoom w *.* rotateV (_cameraRot w) ( _mousePos w) - v | magV v' > 6 = 6 *.* normalizeV v' + v | magV v' > 6 = 6 *.* normalizeV v' + | otherwise = v' -- zoom = 1 / _cameraZoom w j = _crInvSel $ _creatures w IM.! n resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTE" removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank - resetFire = set (creatures . ix n . crInv . ix j . twFire) $ explodeRemoteBomb itid i + resetFire = set (creatures . ix n . crInv . ix j . twFire) + $ hammerCheck $ explodeRemoteBomb itid i cr = _creatures w IM.! n p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0) p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0) @@ -1381,13 +1351,12 @@ throwRemoteBomb n w = setLocation $ removePict $ resetFire maybeitid = w ^? creatures . ix n . crInv . ix j . itID . _Just setLocation :: World -> World setLocation w' = case maybeitid of - Nothing -> w' & creatures . ix n . crInv . ix j . itID .~ Just newitid + Nothing -> w' & creatures . ix n . crInv . ix j . itID ?~ newitid & itemPositions %~ IM.insert newitid (InInv n j) _ -> w' newitid = newKey $ _itemPositions w itid = fromMaybe newitid maybeitid - explodeRemoteBomb :: Int -> Int -> Int -> World -> World explodeRemoteBomb itid pjid n w = set (projectiles . ix pjid . pjUpdate) (retireRemoteBomb itid 30 pjid) @@ -1401,28 +1370,19 @@ explodeRemoteBomb itid pjid n w where resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB" resetPict = set (creatures . ix n . crInv . ix j . itEquipPict ) - (drawWeapon $ remoteBombUnarmedPic) + (drawWeapon remoteBombUnarmedPic) -- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0) j = _crInvSel $ _creatures w IM.! n remoteBombPic :: Int -> Picture -remoteBombPic x = pictures [ color (dark $ dark orange) $ circleSolid 5 - , rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color red $ arc 0 (pi/2) 5 - , rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color (withAlpha 0.05 red) - $ arcSolid 0 90 50 - , rotate (0 - degToRad (fromIntegral x * 10 + 20)) $ color (withAlpha 0.05 red) - $ arcSolid 0 40 40 - , rotate (0 - degToRad (fromIntegral x * 10 + 10)) $ color (withAlpha 0.05 red) - $ arcSolid 0 20 20 - ] +remoteBombPic x = pictures + [ color (dark $ dark orange) $ circleSolid 5 + ] remoteBombUnarmedPic :: Picture remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5 - - spreadGunSpread,autogunSpread :: Float spreadGunSpread = 0.5 autogunSpread = 0.07 - pipe = Craftable { _itIdentity = Generic , _itName = "PIPE" @@ -1449,155 +1409,52 @@ flameShield = defaultEquipment , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] - , _itEquipPict = (\cr _ -> onLayer CrLayer $ - pictures [color cyan $ circle (_crRad cr+2)] - ) + , _itEquipPict = \cr _ -> onLayer CrLayer $ pictures [color cyan $ circle (_crRad cr+2)] , _itID = Nothing } +{- | +Slows you down, blocks forward projectiles. -} frontArmour = defaultEquipment { _itIdentity = FrontArmour , _itName = "FARMOUR" , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = onLayer FlItLayer $ translate 0 (-5) - $ pictures [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5 - ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5 - ] - , _itEquipPict = (\cr _ -> onLayer CrLayer - $ pictures [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5 - ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5 - ] - ) + , _itFloorPict = onLayer FlItLayer $ translate 0 (-5) $ pictures + [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5 + ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5 + ] + , _itEquipPict = \cr _ -> onLayer CrLayer $ pictures + [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5 + ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5 + ] , _itEffect = NoItEffect , _itID = Nothing } +{- | +Increases speed, reduces friction, cannot only move forwards. -} jetPack = defaultEquipment { _itIdentity = JetPack , _itName = "JETPACK" , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] - , _itEquipPict = (\cr _ -> onLayer CrLayer - $ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) - ] - ) + , _itEquipPict = \_ _ -> onLayer CrLayer + $ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ] , _itEffect = NoItEffect , _itID = Nothing } - - - --- }}} - -forceFieldFire :: Int -> World -> World -forceFieldFire cid w = w - ---shatterGunFire :: Int -> World -> World ---shatterGunFire n w | fireCondition = -- soundOnce 0 --- set (creatures . ix n . crInv . ix itRef . wpFireState) --- (_wpFireRate (_crInv cr IM.! itRef)) --- $ over (creatures . ix n . crInv . ix itRef . wpLoadedAmmo) --- (\x -> x - 1) --- $ over projectiles (IM.insert i $ makeTremorAt i pos dir) w --- | reloadCondition = let remAmmo = _crAmmo cr M.! _wpAmmoType item --- (newA,newTotalA) = moveInt (_wpMaxAmmo item) remAmmo --- in set (pointerToItem . wpReloadState) rTime --- $ set (pointerToItem . wpLoadedAmmo) newA --- $ over (creatures . ix n . crAmmo ) --- (M.insert (_wpAmmoType item) newTotalA) w --- | emptyCondition = soundOnce 1 w --- | otherwise = w --- where i = newProjectileKey w --- cr = (_creatures w IM.! n) --- pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) --- dir = _crDir cr --- --(colID, _) = randomR (0,11) (_randGen w) --- itRef = _crInvSel cr --- item = _crInv cr IM.! itRef --- pointerToItem = creatures . ix n . crInv . ix itRef --- rTime = _wpReloadTime (_crInv cr IM.! itRef) --- fireCondition = _wpReloadState (_crInv cr IM.! itRef) == 0 --- && _wpFireState (_crInv cr IM.! itRef) == 0 --- && _wpLoadedAmmo (_crInv cr IM.! itRef) > 0 --- reloadCondition = _wpReloadState (_crInv cr IM.! itRef) == 0 --- && _wpLoadedAmmo (_crInv cr IM.! itRef) == 0 --- && someJust (_crAmmo cr M.!? PistolBullet) --- emptyCondition = _wpLoadedAmmo (_crInv cr IM.! itRef) == 0 - - ---for reloading, we take from the total ammo -moveInt :: Int -> Int -> (Int,Int) -moveInt toReload totalAmmo = (x, totalAmmo-x) - where x = min toReload totalAmmo - -updateTractor :: Int -> Int -> Int -> World -> World -updateTractor colID time i w - | time > 0 = set (projectiles . ix i . pjUpdate) (updateTractor colID (time-1) i) - $ set (projectiles . ix i . pjPict) pic - $ over creatures (IM.map tractCr) - $ over floorItems (IM.map tractFlIt) - w - | otherwise = over projectiles (IM.delete i) w - where tractCr cr | circOnSeg p1 p2 cP 10 - = over crPos (\p -> - p -.- m *.* ((0.3/ x) *.* q +.+ (f y *.* p4)) - ) cr - | otherwise = cr - where x = abs y + 1 - y = errorClosestPointOnLineParam 1 p1 p3 cP - cP = _crPos cr - m | dist cP p1 < 350 = 1 - | otherwise = (400 - dist cP p1) / 50 - tractFlIt it | circOnSeg p1 p2 iP 10 - = over flItPos (\p -> p -.- m *.* - ( (0.3/ x) *.* q +.+ (f y *.* p4)) - ) it - | otherwise = it - where x = abs y + 1 - y = errorClosestPointOnLineParam 2 p1 p3 iP - iP = _flItPos it - m | dist iP p1 < 350 = 1 - | otherwise = (410 - dist iP p1) / 60 - pj = _projectiles w IM.! i - q = _pjVel pj - p1 = _pjPos pj - p' = _pjStartPos pj - p2 = fromMaybe p' $ fmap fst $ collidePointWalls p1 p' $ wallsNearPoint p' w - p4 = vNormal p5 - p5 = errorNormalizeV 12 $ p2 -.- p1 - p3 = p1 +.+ p4 - g x | x > 5 = (10 - x) / 5 - | x > 1 = 1 - | x > -1 = x - | x > -5 = -1 - | otherwise = (x - 10) / 5 - d = errorNormalizeV 13 $ p' -.- p1 - f x = g x / 50 - cID = fromIntegral colID / 10 - col = mixColors 0.5 0.5 white blue - px z = (fromIntegral time + 5) *.* z - pz z = fromIntegral time * 10 *.* z - pic = onLayer PtLayer $ color (withAlpha 0.05 col) - $ polygon [ p1 +.+ px p4 - , p1 -.- 10 *.* p5 - , p1 -.- px p4 - , (p' -.- pz p5) -.- px p4 - , (p' -.- pz p5) +.+ px p4] - +{- | +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 - -thinLine :: [Point2] -> Picture -thinLine = lineOfThickness 1 - -someJust (Just x) | x > 0 = True - | otherwise = False {- | Sends out pulses that display walls. -} radar = defaultGun @@ -1632,7 +1489,6 @@ sonar = defaultGun , _wpFireRate = 120 , _wpFireState = 0 , _wpFire = shoot aSonarPulse - , _wpSpread = autogunSpread , _wpRange = 20 , _itHammer = HammerUp , _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) @@ -1684,7 +1540,6 @@ spawnGun cr = defaultGun , _wpFireRate = 100 , _wpFire = spawnCrNextTo cr } - spawnCrNextTo :: Creature -- ^ Creature to spawn -> Int -- ^ ID of existing creature that will be spawned next to diff --git a/src/Dodge/Item/Weapon/InventoryDisplay.hs b/src/Dodge/Item/Weapon/InventoryDisplay.hs index 47cfe2a34..5ac93ca72 100644 --- a/src/Dodge/Item/Weapon/InventoryDisplay.hs +++ b/src/Dodge/Item/Weapon/InventoryDisplay.hs @@ -17,11 +17,13 @@ import Control.Monad Displays the item name, ammo if loaded, and any selected '_itCharMode'. -} basicWeaponDisplay :: Item -> String -basicWeaponDisplay it = case it ^? itAttachment . _Just . itCharMode of - Just (c :<| _) -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) ++ [' ',c] +basicWeaponDisplay it = case it ^? itAttachment . _Just of + Just ItCharMode {_itCharMode = (c :<| _)} -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) ++ [' ',c] + Just ItMode {_itMode = i} -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) ++ show i _ -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) where availableAmmo = show $ _wpMaxAmmo it - aIfLoaded = case _wpReloadState it of - 0 -> show $ _wpLoadedAmmo it - x -> "R" ++ show x + aIfLoaded = case it ^? wpReloadState of + Just 0 -> show $ _wpLoadedAmmo it + Just x -> "R" ++ show x + _ -> "" diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 3eec22682..c7c12dcd0 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -197,7 +197,6 @@ withMuzFlare f cid w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f cid w dir = _crDir cr pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr) - {- | Rotates the creature randomly, applies the effect, rotates the creature back. -} withRandomDir @@ -213,8 +212,8 @@ withRandomDir acc f cid w = over (creatures . ix cid . crDir) (\d -> d - a) $ set randGen g w where (a, g) = randomR (-acc,acc) $ _randGen w -{- | Creates a bullet with a given velocity, width, and 'HitEffect' - -} +{- | +Creates a bullet with a given velocity, width, and 'HitEffect' -} withVelWthHiteff :: Point2 -- ^ Velocity, x direction is forward with respect to the creature -> Float -- ^ Bullet width @@ -231,7 +230,8 @@ withVelWthHiteff vel width hiteff cid w dir = _crDir cr pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr) -{- | Translate the creature sideways a random amount, apply the effect, translate back. -} +{- | +Translate the creature sideways a random amount, apply the effect, translate back. -} withRandomOffset :: Float -- ^ Max possible translate -> (Int -> World -> World) @@ -249,7 +249,6 @@ withRandomOffset offsetAmount f cid w (offsetVal , g) = randomR (-offsetAmount,offsetAmount) $ _randGen w cr = _creatures w IM.! cid offV = rotateV (_crDir cr) (0,offsetVal) - -- | Rotates a creature with minimum rotation at least 0.1. -- Rotates the player creature before applying the effect, other creatures after. torqueBeforeForced @@ -269,7 +268,6 @@ torqueBeforeForced torque feff cid w (rot, g) = randomR (-torque,torque) $ _randGen w rot' | rot < 0 = rot - 0.1 | otherwise = rot + 0.1 - -- | Rotates the player creature before applying an effect. -- Note this currently (29/4/2021) rotates other creatures /after/ applying the effect. torqueBefore diff --git a/src/Dodge/Item/Weapon/UseEffect.hs b/src/Dodge/Item/Weapon/UseEffect.hs index 78f168848..7101def4d 100644 --- a/src/Dodge/Item/Weapon/UseEffect.hs +++ b/src/Dodge/Item/Weapon/UseEffect.hs @@ -6,6 +6,7 @@ module Dodge.Item.Weapon.UseEffect import Dodge.Data import Dodge.Base import Dodge.Item.Weapon.Decoration +import Dodge.Item.Weapon.TriggerType import Dodge.WorldEvent.Flash import Dodge.WorldEvent.ThingsHit import Picture @@ -102,9 +103,97 @@ mvRadar x p w pt = (putBlips w, Just $ pt {_ptDraw = const pic ++ (IM.elems $ wallsAlongCirc p r w) r = fromIntegral (800 - x*16) sweepPics = [--colHelper 0.1 $ uncurry translate p $ thickCircle r 15 - --,colHelper 0.06 $ uncurry translate p $ thickCircle (r-5) 5 - --,colHelper 0.03 $ uncurry translate p $ thickCircle (r-10) 5 + --,colHelper 0.06 $ uncurry translate p $ thickCircle (r-5) 5 + --,colHelper 0.03 $ uncurry translate p $ thickCircle (r-10) 5 ] globalAlpha | x > 10 = 1 | otherwise = fromIntegral x / 10 colHelper y = color (withAlpha (y * globalAlpha) red) + +aTractorBeam + :: Int -- ^ Color id + -> Int -- ^ Creature id + -> World + -> World +aTractorBeam col cid w + = set (creatures . ix cid . crInv . ix itRef . wpFire) + (shoot $ aTractorBeam ((col + 1) `mod` 10)) + $ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w + where + i = newProjectileKey w + cr = (_creatures w IM.! cid) + pos = _crPos cr +.+ ((_crRad cr +10) *.* unitVectorAtAngle dir) + dir = _crDir cr + itRef = _crInvSel cr + +tractorBeamAt :: Int -> Int -> Point2 -> Float -> Projectile +tractorBeamAt colID i pos dir = Projectile + { _pjPos = pos + , _pjStartPos = p' + , _pjVel = d + , _pjPict = blank + , _pjID = i + , _pjUpdate = updateTractor colID 10 i + } + where + d = unitVectorAtAngle dir + p' = pos +.+ 400 *.* d + +{- | +The interaction of this with objects, walls etc needs more thought. -} +updateTractor :: Int -> Int -> Int -> World -> World +updateTractor colID time i w + | time > 0 = set (projectiles . ix i . pjUpdate) (updateTractor colID (time-1) i) + $ set (projectiles . ix i . pjPict) pic + $ over creatures (IM.map tractCr) + $ over floorItems (IM.map tractFlIt) + w + | otherwise = over projectiles (IM.delete i) w + where + tractCr cr + | circOnSeg p1 p2 cP 10 + = over crPos (\p -> + p -.- m *.* ((0.3/ x) *.* q +.+ (f y *.* p4)) + ) cr + | otherwise = cr + where + x = abs y + 1 + y = errorClosestPointOnLineParam 1 p1 p3 cP + cP = _crPos cr + m | dist cP p1 < 350 = 1 + | otherwise = (400 - dist cP p1) / 50 + tractFlIt it | circOnSeg p1 p2 iP 10 + = over flItPos (\p -> p -.- m *.* + ( (0.3/ x) *.* q +.+ (f y *.* p4)) + ) it + | otherwise = it + where x = abs y + 1 + y = errorClosestPointOnLineParam 2 p1 p3 iP + iP = _flItPos it + m | dist iP p1 < 350 = 1 + | otherwise = (410 - dist iP p1) / 60 + pj = _projectiles w IM.! i + q = _pjVel pj + p1 = _pjPos pj + p' = _pjStartPos pj + p2 = maybe p' fst $ collidePointWalls p1 p' $ wallsNearPoint p' w + p4 = vNormal p5 + p5 = errorNormalizeV 12 $ p2 -.- p1 + p3 = p1 +.+ p4 + g x | x > 5 = (10 - x) / 5 + | x > 1 = 1 + | x > -1 = x + | x > -5 = -1 + | otherwise = (x - 10) / 5 + d = errorNormalizeV 13 $ p' -.- p1 + f x = g x / 50 + cID = fromIntegral colID / 10 + col = mixColors 0.5 0.5 white blue + px z = (fromIntegral time + 5) *.* z + pz z = fromIntegral time * 10 *.* z + pic = setLayer 1 $ onLayer PtLayer $ color (withAlpha 0.05 col) + $ polygon [ p1 +.+ px p4 + , p1 -.- 10 *.* p5 + , p1 -.- px p4 + , (p' -.- pz p5) -.- px p4 + , (p' -.- pz p5) +.+ px p4]