Cleanup warnings

This commit is contained in:
2021-05-17 22:39:18 +02:00
parent d7fcdbf550
commit 69f915a894
102 changed files with 1243 additions and 1185 deletions
+13 -13
View File
@@ -39,19 +39,19 @@ charFiringStrat
charFiringStrat strats cid w = case w ^? creatures . ix cid . crInv
. ix (_crInvSel $ _creatures w IM.! cid) . itAttachment . _Just . itCharMode of
Just (c :<| _) -> fromJust (Prelude.lookup c strats) cid w
Nothing -> w
_ -> w
increaseFuse
:: Int -- ^ Old fuse time
-> Int -- ^ Inventory item reference (I believe)
-> World
-> World
increaseFuse fuse itID w = w
& creatures . ix 0 . crInv . ix itID . itScrollUp .~ decreaseFuse newTime
& creatures . ix 0 . crInv . ix itID . itScrollDown .~ increaseFuse newTime
& creatures . ix 0 . crInv . ix itID . itAttachment ?~ ItFuse newTime
& creatures . ix 0 . crInv . ix itID . itZoom
.~ (defaultItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm})
increaseFuse fuse itid w = w
& creatures . ix 0 . crInv . ix itid %~
( itScrollUp .~ decreaseFuse newTime )
. (itScrollDown .~ increaseFuse newTime )
. ( itAttachment ?~ ItFuse newTime )
. ( itZoom .~ defaultItZoom{_itAimZoomMax = zm, _itAimZoomMin = zm} )
where
newTime = min (fuse + 5) 90
zm = 50 / fromIntegral newTime
@@ -60,12 +60,12 @@ decreaseFuse
:: Int -- ^ Old fuse time
-> Int -- ^ Inventory item reference (I believe)
-> World -> World
decreaseFuse fuse itID w = w
& creatures . ix 0 . crInv . ix itID . itScrollUp .~ decreaseFuse newTime
& creatures . ix 0 . crInv . ix itID . itScrollDown .~ increaseFuse newTime
& creatures . ix 0 . crInv . ix itID . itAttachment ?~ ItFuse newTime
& creatures . ix 0 . crInv . ix itID . itZoom
.~ (defaultItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm})
decreaseFuse fuse itid w = w
& creatures . ix 0 . crInv . ix itid %~
( itScrollUp .~ decreaseFuse newTime )
. ( itScrollDown .~ increaseFuse newTime )
. ( itAttachment ?~ ItFuse newTime )
. ( itZoom .~ defaultItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm} )
where
newTime = max (fuse - 5) 20
zm = 50 / fromIntegral newTime
+60
View File
@@ -0,0 +1,60 @@
module Dodge.Item.Equipment
where
import Dodge.Data
import Dodge.Default
import Dodge.Picture.Layer
import Picture
import Geometry
magShield :: Item
magShield = defaultEquipment
{ _itIdentity = MagShield
, _itName = "MAGSHIELD"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> blank
, _itID = Nothing
}
flameShield, frontArmour :: Item
flameShield = defaultEquipment
{ _itIdentity = FlameShield
, _itName = "FLAMESHIELD"
, _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)]
, _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 = \_ _ -> 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 :: Item
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 = \_ _ -> onLayer CrLayer
$ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ]
, _itEffect = NoItEffect
, _itID = Nothing
}
+59 -85
View File
@@ -1,8 +1,6 @@
{- | Definitions of weapons.
In progress: move out effects into other modules. -}
module Dodge.Item.Weapon
( module Dodge.Item.Weapon
)
where
import Dodge.Data
import Dodge.Base
@@ -14,7 +12,7 @@ import Dodge.WorldEvent
import Dodge.Default
import Dodge.Item.Draw
import Dodge.Item.Weapon.Bullet
import Dodge.Item.Weapon.Decoration
--import Dodge.Item.Weapon.Decoration
import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Item.Weapon.TriggerType
import Dodge.Item.Weapon.ExtraEffect
@@ -26,27 +24,43 @@ import Dodge.Item.Attachment
import Geometry
import Picture
import Data.List
import Data.Char
--import Data.List
--import Data.Char
import Data.Maybe
import Data.Function
import qualified Data.ByteString as B
--import qualified Data.ByteString as B
import qualified Data.Sequence as Seq
import Control.Lens
import Control.Applicative
import Control.Monad.State
import Control.Monad
--import Control.Monad
import qualified SDL
import System.Random
import qualified Data.Set as S
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
import Foreign.ForeignPtr
--import qualified Data.Map as M
pistol,lasGun,tractorGun,launcher,autoGun
pistol
,lasGun
,tractorGun
,launcher
,autoGun
,ltAutoGun
,hvAutoGun
,miniGun
,teslaGun
,spreadGun
,multGun
,defaultGun
,defaultAutoGun
,rezGun
,flameLauncher
,poisonLauncher
,teslaLauncher
,remoteLauncher
,bezierGun
,poisonSprayer
,defaultThrowable
-- ,shatterGun
,longGun,flamer,blinkGun,forceFieldGun :: Item
pistol = Weapon
@@ -130,6 +144,7 @@ autoGun = defaultGun
, _itScrollDown = decCharMode
, _itInvDisplay = basicWeaponDisplay
}
autoFireMode, singleFireMode, autoGunNonTwistEff :: Int -> World -> World
autoFireMode = shootWithSound (fromIntegral autoGunSound)
. torqueBefore 0.05
$ autoGunNonTwistEff
@@ -714,10 +729,7 @@ moveShell time i cid rot accel w
smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))
rot' = rot * 0.995
normalizeAnglePi angle
| normalizeAngle angle > pi = normalizeAngle angle - 2*pi
| otherwise = normalizeAngle angle
shellPic :: Picture
shellPic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
remoteShellPic :: Int -> Picture
remoteShellPic i
@@ -730,6 +742,7 @@ remoteShellPic i
col | i > (-99) = green
| otherwise = red
shellExplosionAt :: Point2 -> World -> World
shellExplosionAt = makeExplosionAt
aGasCloud :: Int -> World -> World
@@ -739,8 +752,8 @@ aGasCloud cid w = insertCloud $ set randGen g 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))
--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)
@@ -761,6 +774,8 @@ reflect :: Float -> Float -> Float
reflect a b = a + 2*(a-b)
pointToItem :: Applicative f =>
ItemPos -> (Item -> f Item) -> World -> f World
pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid
pointToItem (OnFloor flid) = floorItems . ix flid . flIt
@@ -880,8 +895,8 @@ flameGrenade = grenade {
, _twFire = throwGrenade makeFlameExplosionAt
}
where
fuseTime = 50
f x = 50 / fromIntegral x
fuseTime = 50 :: Int
--f x = 50 / fromIntegral x
teslaGrenade :: Item
teslaGrenade = grenade {
@@ -889,8 +904,8 @@ teslaGrenade = grenade {
, _twFire = throwGrenade makeTeslaExplosionAt
}
where
fuseTime = 50
f x = 50 / fromIntegral x
fuseTime = 50 :: Int
--f x = 50 / fromIntegral x
defaultThrowable = grenade
remoteBomb = defaultThrowable
@@ -941,7 +956,7 @@ fireRemoteLauncher cid w = setLocation
itid = fromMaybe newitid maybeitid
moveRemoteShell :: Int -> Int -> Int -> Int -> Float -> World -> World
moveRemoteShell time i cid itid dir w
moveRemoteShell time i cid itid _ w
| time > 40 = if circOnSomeWall oldPos 4 w
then doExplosion w
else over (projectiles . ix i . pjPos) (+.+ vel)
@@ -951,7 +966,7 @@ moveRemoteShell time i cid itid dir w
$ setScope
w
| time >= 20 = case thingHit of
Just p -> doExplosion w
Just _ -> doExplosion w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjPict) pic
$ set (projectiles . ix i . pjUpdate)
@@ -959,7 +974,7 @@ moveRemoteShell time i cid itid dir w
$ setScope
w
| time > -99 = case thingHit of
Just p -> doExplosion
Just _ -> doExplosion
$ stopSoundFrom (ShellSound i)
w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
@@ -973,7 +988,7 @@ moveRemoteShell time i cid itid dir w
$ setScope
w
| time > -200 = case thingHit of
Just p -> doExplosion
Just _ -> doExplosion
$ stopSoundFrom (ShellSound i)
w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
@@ -1011,18 +1026,18 @@ moveRemoteShell time i cid itid dir w
smokeGen = makeSmokeCloudAt $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)
doExplosion = explodeRemoteRocket itid i cid
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))
_ -> w'
InInv cid' invid
-> w' & creatures . ix cid' . crInv . ix invid . itAttachment
. _Just . scopePos .~ (newPos -.- _crPos (_creatures w' IM.! cid'))
_ -> w'
explodeRemoteRocket
:: Int -- ^ Item id
-> Int -- ^ Projectile id
-> Int
-> Int -- ^ (Probably) firing creature id
-> World
-> World
explodeRemoteRocket itid pjid n w
explodeRemoteRocket itid pjid _ w
= set (projectiles . ix pjid . pjUpdate) (retireRemoteRocket itid 30 pjid)
$ set (projectiles . ix pjid . pjPict) blank
$ set (itPoint . wpFire) (const id)
@@ -1046,7 +1061,7 @@ throwRemoteBomb n w = setLocation $ removePict $ resetFire
}
i = newProjectileKey w
-- fireDist = zoom *.* (rotateV (_cameraRot w) (_mousePos w) +.+ _cameraCenter w -.- yourPos)
d = argV $ _mousePos w
--d = argV $ _mousePos w
--(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)
@@ -1087,78 +1102,34 @@ explodeRemoteBomb itid pjid n w
(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
remoteBombPic
:: Int -- ^ time
-> Picture
remoteBombPic _ = 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 :: Item
pipe = Craftable
{ _itIdentity = Generic
, _itName = "PIPE"
, _itMaxStack = 3
, _itAmount = 3
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \cr _ -> blank
, _itEquipPict = \_ _ -> blank
, _itID = Nothing
, _itInvDisplay = _itName
, _itInvColor = green
}
magShield = defaultEquipment
{ _itIdentity = MagShield
, _itName = "MAGSHIELD"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \cr _ -> blank
, _itID = Nothing
}
flameShield = defaultEquipment
{ _itIdentity = FlameShield
, _itName = "FLAMESHIELD"
, _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)]
, _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
]
, _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 = \_ _ -> onLayer CrLayer
$ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ]
, _itEffect = NoItEffect
, _itID = Nothing
}
{- |
Sends out pulses that display walls. -}
radar :: Item
radar = defaultGun
{ _itName = "RADAR"
, _itIdentity = Generic
@@ -1181,6 +1152,7 @@ radar = defaultGun
}
{- |
Sends out pulses that display creatures. -}
sonar :: Item
sonar = defaultGun
{ _itName = "SONAR"
, _itIdentity = Generic
@@ -1202,13 +1174,14 @@ sonar = defaultGun
}
{- |
Automatically sends out pulses that display creatures. -}
autoSonar :: Item
autoSonar = defaultEquipment
{ _itIdentity = Generic
, _itName = "AUTOSONAR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \cr _ -> blank
, _itEquipPict = \_ _ -> blank
, _itEffect = autoSonarEffect
, _itID = Nothing
, _itAimingSpeed = 1
@@ -1217,13 +1190,14 @@ autoSonar = defaultEquipment
}
{- |
Automatically sends out pulses that display walls. -}
autoRadar :: Item
autoRadar = defaultEquipment
{ _itIdentity = Generic
, _itName = "AUTORADAR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \cr _ -> blank
, _itEquipPict = \_ _ -> blank
, _itEffect = autoRadarEffect
, _itID = Nothing
, _itAimingSpeed = 1
+22 -46
View File
@@ -4,8 +4,9 @@ Effects of bullets upon impact with walls or creatures, and possibly force field
module Dodge.Item.Weapon.Bullet
where
import Dodge.Data
import Dodge.Base
--import Dodge.Base
import Dodge.WorldEvent
import Dodge.WorldEvent.DamageBlock
import Dodge.SoundLogic
import Dodge.RandomHelp
import Dodge.WorldEvent.Shockwave
@@ -17,14 +18,14 @@ import Picture
import System.Random
import Control.Lens
import Control.Monad.State
import qualified Data.IntMap.Strict as IM
--import Data.Maybe
--import qualified Data.IntMap.Strict as IM
-- | Basic bullet hit creature effect.
bulHitCr' :: Particle -> Point2 -> Creature -> World -> World
bulHitCr' bt p cr w
| crIsArmouredFrom p cr
= createSpark 8 colID p1 (argV (p1 -.- p) + d1) Nothing . addDamageArmoured $ w
| otherwise
= addDamage . hitSound . flashEff $ w
| otherwise = addDamage . makeHitSound . flashEff $ w
where
sp = head $ _btTrail' bt
bulVel = _btVel' bt
@@ -32,19 +33,17 @@ bulHitCr' bt p cr w
mvDams = [ PushDam 1 $ 2 *.* bulVel ]
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
hitSound = soundMultiFrom [CrHitSound 0] 15 10 0
makeHitSound = soundMultiFrom [CrHitSound 0] 15 10 0
flashEff = over worldEvents (bloodFlashAt p . )
cid = _crID cr
(d1,g) = randomR (-0.7,0.7) $ _randGen w
(d1,_) = randomR (-0.7,0.7) $ _randGen w
(colID,_) = randomR (0,11) $ _randGen w
p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr)
{- | Bounce off armoured creatures, otherwise do damage. -}
bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World
bulBounceArmCr' bt p cr w
| crIsArmouredFrom p cr
= addBouncer . addDamageArmoured $ w
| otherwise
= addDamage . hitSound . flashEff $ w
| crIsArmouredFrom p cr = addBouncer . addDamageArmoured $ w
| otherwise = addDamage . makeHitSound . flashEff $ w
where
sp = head $ _btTrail' bt
bulVel = _btVel' bt
@@ -52,7 +51,7 @@ bulBounceArmCr' bt p cr w
mvDams = [ PushDam 1 $ 2 *.* bulVel ]
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
hitSound = soundMultiFrom [CrHitSound 0] 15 10 0
makeHitSound = soundMultiFrom [CrHitSound 0] 15 10 0
flashEff = over worldEvents ((.) $ bloodFlashAt p)
cid = _crID cr
newDir = safeNormalizeV (p -.- _crPos cr)
@@ -77,7 +76,7 @@ bulPenCr' bt p cr w
$ over worldEvents (addPiercer . )
w
where
(d1,g) = randomR (-0.7,0.7) $ _randGen w
(d1,_) = randomR (-0.7,0.7) $ _randGen w
cid = _crID cr
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
@@ -100,7 +99,7 @@ hvBulHitCr' bt p cr w
$ soundMultiFrom [CrHitSound 0] 15 10 0
w
where
(d1,g) = randomR (-0.7,0.7) $ _randGen w
(d1,_) = randomR (-0.7,0.7) $ _randGen w
cid = _crID cr
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
@@ -131,32 +130,24 @@ bulConCr' bt p cr w
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
{- | Hitting wall effects: create a spark, damage blocks. -}
bulHitWall' :: Particle -> Point2 -> Wall -> World -> World
bulHitWall' bt p x w = damageBlocks x
$ createSpark 8 colID pOut (reflectDir x) Nothing
bulHitWall' bt p x w = damageBlocksBy 5 x
$ createSpark 8 12 pOut (reflectDir x) Nothing
$ set randGen g
w
where
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
(colID,g) = randomR (0,11) $ _randGen w
(a, _) = randomR (-0.1,0.1) $ _randGen w
spid = newKey $ _projectiles w
(a, g) = randomR (-0.2,0.2) $ _randGen w
reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) )
damageBlocks wall w = case wall ^? blHP of
Just hp -> foldr (\j -> walls . ix j . blHP -~ 5) w (_blIDs wall)
_ -> w
{- | Bounce off walls, do damage to blocks. -}
bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World
bulBounceWall' bt p wl w = damageBlocks wl $ over worldEvents addBouncer w
bulBounceWall' bt p wl w = damageBlocksBy 5 wl $ over worldEvents addBouncer w
where
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> walls . ix j . blHP -~ 5) w (_blIDs wall)
_ -> w
bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
@@ -174,14 +165,10 @@ bulIncWall'
-> Wall
-> World
-> World
bulIncWall' bt p wl w = damageBlocks wl $ incFlamelets w
bulIncWall' bt p wl w = damageBlocksBy 5 wl $ incFlamelets w
where
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> walls . ix j . blHP -~ 5) w (_blIDs wall)
_ -> w
wallV = uncurry (-.-) (_wlLine wl)
reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20)
@@ -192,15 +179,8 @@ bulConWall'
-> Wall
-> World
-> World
bulConWall' bt p wl w = damageBlocks wl $ mkwave w
where
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> walls . ix j . blHP -~ 5) w (_blIDs wall)
_ -> w
mkwave = over worldEvents ( makeShockwaveAt [] p 15 4 1 white . )
bulConWall' _ p wl = damageBlocksBy 1 wl .
over worldEvents ( makeShockwaveAt [] p 15 4 1 white . )
hvBulHitWall'
:: Particle
@@ -208,18 +188,14 @@ hvBulHitWall'
-> Wall
-> World
-> World
hvBulHitWall' bt p x w = damageBlocks x $ set randGen g $ foldr ($) w (sparks pOut sv)
hvBulHitWall' bt p x w = damageBlocksBy 5 x $ set randGen g $ foldr ($) w (sparks pOut sv)
where
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
(a, g) = randomR (-0.1,0.1) $ _randGen w
spid = newKey $ _projectiles w
(a, g) = randomR (-0.2,0.2) $ _randGen w
reflectDir wall = a +
argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) )
sv = unitVectorAtAngle $ reflectDir x
damageBlocks wall w = case wall ^? blHP of
Just hp -> foldr (\j -> walls . ix j . blHP -~ 20) w (_blIDs wall)
_ -> w
cs = take 10 $ randomRs (0,11) $ _randGen w
ds = randomRs (-0.7,0.7) $ _randGen w
ts = randomRs (4,8) $ _randGen w
+1 -1
View File
@@ -6,7 +6,7 @@ module Dodge.Item.Weapon.Decoration
import Dodge.Data
import Dodge.Picture.Layer
import Dodge.Picture
import Geometry.Data
--import Geometry.Data
import Picture
import Control.Lens
+11 -7
View File
@@ -28,6 +28,7 @@ wpRecock = ItInvEffect
moveHammerUp HammerDown = HammerReleased
moveHammerUp HammerReleased = HammerUp
moveHammerUp HammerUp = HammerUp
moveHammerUp NoHammer = NoHammer
fOnIt it = it & itHammer %~ moveHammerUp
{- |
Special recock for the bezier gun.
@@ -64,10 +65,10 @@ itemLaserScopeEffect
sp = p +.+ (r + 3) *.* unitVectorAtAngle d
xp = sp +.+ 3000 *.* unitVectorAtAngle d
ep = case listToMaybe $ thingsHitLongLine sp xp w of
Just (p,_) -> p
Just (pos,_) -> pos
Nothing -> xp
glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of
Just (p,E3x2 wl) -> p +.+ 2 *.* wallNormal wl
Just (pos,E3x2 wl) -> pos +.+ 2 *.* wallNormal wl
_ -> ep -.- 2 *.* unitVectorAtAngle d
it = (cr ^. crInv) IM.! invid
reloadFrac
@@ -79,6 +80,7 @@ Automatically send out radar pulses that detect walls. -}
autoRadarEffect :: ItEffect
autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
where
f :: Int -> Creature -> Int -> World -> World
f 0 cr i w = aRadarPulse (_crID cr) w
& creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f 100
@@ -89,8 +91,10 @@ autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
Automatically send out sonar pulses that detect creatures. -}
autoSonarEffect :: ItEffect
autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
where f 0 cr i w = aSonarPulse (_crID cr)
w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f 140
f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f (t-1)
where
f :: Int -> Creature -> Int -> World -> World
f 0 cr i w = aSonarPulse (_crID cr)
w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f 140
f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f (t-1)
+7 -7
View File
@@ -6,14 +6,14 @@ import Dodge.Picture.Layer
import Dodge.SoundLogic
import Dodge.Item.Attachment.Data
import Dodge.Item.Draw
import Dodge.Default
--import Dodge.Default
import Picture
import Geometry
import Control.Lens
import Data.Maybe (fromJust)
import qualified Data.IntMap.Strict as IM
import System.Random
--import System.Random
moveGrenade
:: Int -- ^ Timer
@@ -21,7 +21,7 @@ moveGrenade
-> Int -- ^ Projectile id
-> World
-> World
moveGrenade 0 dir pID w = over projectiles (IM.delete pID)
moveGrenade 0 _ pID w = over projectiles (IM.delete pID)
$ explosion (_pjPos (_projectiles w IM.! pID))
w
where
@@ -60,7 +60,7 @@ throwGrenade
-> Int -- ^ Creature id
-> World
-> World
throwGrenade explosion n w = setWp $ removePict $ over projectiles addG $ set randGen g w
throwGrenade explosion n w = setWp $ removePict $ over projectiles addG $ w
where
addG = IM.insert i $ Shell
{ _pjPos = p
@@ -75,8 +75,8 @@ throwGrenade explosion n w = setWp $ removePict $ over projectiles addG $ set ra
j = _crInvSel cr
removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank
i = newProjectileKey w
(a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w)
(l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g
--(_, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w)
--(_, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g
v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w)
v | magV v' > 6 = 6 *.* normalizeV v'
| otherwise = v'
@@ -98,4 +98,4 @@ throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x }
& itEquipPict .~ drawWeapon (grenadePic 50)
| otherwise = it & itEffect . itEffectCounter -~ 1
(grenadeAccL, grenadeAccA) = (0.1, 0.1)
--(grenadeAccL, grenadeAccA) = (0.1, 0.1)
+3 -8
View File
@@ -9,20 +9,15 @@ import Dodge.Item.Attachment.Data
import Data.Sequence
import Control.Lens
import Control.Monad
-- not sure if this is in the right place...
{- |
Displays the item name, ammo if loaded, and any selected '_itCharMode'.
-}
--import Control.Monad
{- | Displays the item name, ammo if loaded, and any selected '_itCharMode'. -}
basicWeaponDisplay :: Item -> String
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
--availableAmmo = show $ _wpMaxAmmo it
aIfLoaded = case it ^? wpReloadState of
Just 0 -> show $ _wpLoadedAmmo it
Just x -> "R" ++ show x
+9 -8
View File
@@ -5,7 +5,7 @@ import Dodge.Data
import Dodge.Picture
import Dodge.Picture.Layer
import Dodge.Item.Attachment.Data
import Dodge.Base
--import Dodge.Base
import Dodge.SoundLogic
import Dodge.WorldEvent.SpawnParticle
import Dodge.WorldEvent.ThingsHit
@@ -30,16 +30,17 @@ aLaser cid w = over particles (makeLaserAt phaseV pos dir (Just cid) : )
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 :: Fractional p => Char -> p
charToPhaseV 'V' = 0.2
charToPhaseV '/' = 1
charToPhaseV 'Z' = 5
charToPhaseV _ = error "Trying to set an undefined phaseV"
makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle
makeLaserAt phaseV pos dir mcid = Particle
@@ -55,7 +56,7 @@ moveLaser
-> World
-> Particle
-> (World, Maybe Particle)
moveLaser phaseV pos dir mcid w pt
moveLaser phaseV pos dir _ w pt
= ( set randGen g $ hitEffect w
, Just pt {_ptDraw = const $ onLayer PtLayer pic ,_ptUpdate' = ptTimer' 0 }
)
@@ -83,10 +84,10 @@ moveLaser phaseV pos dir mcid w pt
angleRef
| reflectExternal = angleInc
| otherwise = asin $ sin angleInc / phaseV
piRange a
| a > pi = a - 2 * pi
| a > negate pi = a
| otherwise = a + 2 * pi
piRange a'
| a' > pi = a' - 2 * pi
| a' > negate pi = a'
| otherwise = a' + 2 * pi
isEntering = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl))
wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl)
normalDist' = magV (p -.- y) *.* normalizeV wlNormal'
@@ -97,7 +98,7 @@ moveLaser phaseV pos dir mcid w pt
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' ws (_,E3x2 wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws
h' _ _ = True
(thHit, ps) = f [] pos xp
hitEffect
+4 -7
View File
@@ -114,7 +114,6 @@ withWarmUp t f cid w
item = _crInv cr IM.! itRef
pointerToItem = creatures . ix cid . crInv . ix itRef
fState = _itUseTime item
fRate = _itUseRate item
reloadCondition = _wpLoadedAmmo item == 0
{- |
Adds a sound to a creature based world effect.
@@ -247,7 +246,6 @@ withMuzFlare
withMuzFlare f cid w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f cid w
where
cr = _creatures w IM.! cid
dir = _crDir cr
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
{- |
@@ -282,7 +280,6 @@ withVelWthHiteff vel width hiteff cid w
(colid, g) = randomR (0,11) $ _randGen 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. -}
withRandomOffset
@@ -349,7 +346,7 @@ torqueAfter torque 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))
rotateScope = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . _Just . scopePos %~ rotateV rot
{- | Create multiple bullets with a given spread, a given amount, given velocity,
given width and given 'HitEffect'. -}
@@ -384,11 +381,11 @@ numVelWthHitEff
-> Int -- ^ Creature id
-> World
-> World
numVelWthHitEff num vel wth eff cid w = over particles (newbuls ++) w
numVelWthHitEff num vel wth eff cid w = over particles (newbuls ++) w
where
cr = _creatures w IM.! cid
newbuls = zipWith
(\pos colid -> aGenBulAt' (Just cid) (numColor colid) pos (rotateV d vel) eff wth)
(\p colid -> aGenBulAt' (Just cid) (numColor colid) p (rotateV d vel) eff wth)
poss
colids
d = _crDir cr
@@ -414,6 +411,6 @@ randWalkAngle ma aspeed f cid w = w
& creatures . ix cid . crInv . ix i . wpSpread .~ newa
where
a = _wpSpread $ _crInv (_creatures w IM.! cid) IM.! i
(walka, g) = randomR (-aspeed,aspeed) (_randGen w)
(walka, _) = randomR (-aspeed,aspeed) (_randGen w)
newa = min ma $ max (negate ma) (a + walka)
i = _crInvSel $ _creatures w IM.! cid
+7 -9
View File
@@ -6,10 +6,10 @@ module Dodge.Item.Weapon.UseEffect
import Dodge.Data
import Dodge.Base
import Dodge.Picture.Layer
import Dodge.Item.Weapon.Decoration
--import Dodge.Item.Weapon.Decoration
import Dodge.Item.Weapon.TriggerType
import Dodge.WorldEvent.Flash
import Dodge.WorldEvent.ThingsHit
--import Dodge.WorldEvent.Flash
--import Dodge.WorldEvent.ThingsHit
import Picture
import Geometry
@@ -39,7 +39,7 @@ mvBlip :: Point2 -> Color
-> Int -- ^ Max possible timer value
-> Int -- ^ Current timer value
-> World -> Particle -> (World, Maybe Particle)
mvBlip p col maxt 0 w pt = (w, Nothing)
mvBlip _ _ _ 0 w _ = (w, Nothing)
mvBlip p col maxt t w pt
= (w, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1)
& ptDraw .~ (const . setDepth (-0.5)
@@ -73,7 +73,7 @@ mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic
where crad = _crRad cr
cpos = _crPos cr
r = fromIntegral (500 - x*5)
sweepPics = [colHelper 0.05 $ uncurry translate p $ thickCircle r 5 ]
--sweepPics = [colHelper 0.05 $ uncurry translate p $ thickCircle r 5 ]
globalAlpha | x > 10 = 1
| otherwise = fromIntegral x / 10
colHelper y = color (withAlpha (y * globalAlpha) green)
@@ -97,7 +97,7 @@ mvRadar x p w pt =
where
pic = onLayerL [levLayer ShadowLayer, 1] $ pictures sweepPics
putBlips = over worldEvents ( over particles (blips ++) . )
blips = map (\p -> blipAt p (withAlpha (0.5*globalAlpha) red) 50) circPoints
blips = map (\bp -> blipAt bp (withAlpha (0.5*globalAlpha) red) 50) circPoints
circPoints = mapMaybe (\wl -> uncurry collidePointCircCorrect (_wlLine wl) r p)
$ map (over wlLine swp) (IM.elems $ wallsAlongCirc p r w)
++ IM.elems (wallsAlongCirc p r w)
@@ -109,7 +109,7 @@ mvRadar x p w pt =
]
globalAlpha | x > 10 = 1
| otherwise = fromIntegral x / 10
colHelper y = color (withAlpha (y * globalAlpha) red)
--colHelper y = color (withAlpha (y * globalAlpha) red)
aTractorBeam
:: Int -- ^ Color id
@@ -186,9 +186,7 @@ updateTractor colID time i w
| 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