diff --git a/src/Dodge/Base/Window.hs b/src/Dodge/Base/Window.hs index 8b6ec0695..af2ab0e0b 100644 --- a/src/Dodge/Base/Window.hs +++ b/src/Dodge/Base/Window.hs @@ -1,5 +1,13 @@ {- | Getting the window size geometry. -} module Dodge.Base.Window + ( halfWidth + , halfHeight + , screenPolygon + , screenPolygonBord + , getWindowX + , getWindowY + , screenBox + ) where import Dodge.Data import Dodge.Config.Data @@ -7,16 +15,17 @@ import Geometry -- | A box covering the screen in world coordinates screenPolygon :: World -> [Point2] -screenPolygon w = [tr,tl,bl,br] +screenPolygon w = map (scTran . scRot . scZoom) $ screenBox w +-- [tr,tl,bl,br] where scRot = rotateV (_cameraRot w) scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p | otherwise = p scTran p = p +.+ _cameraCenter w - tr = scTran $ scRot $ scZoom (V2 ( halfWidth w) ( halfHeight w)) - tl = scTran $ scRot $ scZoom (V2 (-halfWidth w) ( halfHeight w)) - br = scTran $ scRot $ scZoom (V2 ( halfWidth w) (-halfHeight w)) - bl = scTran $ scRot $ scZoom (V2 (-halfWidth w) (-halfHeight w)) +-- tr = scTran $ scRot $ scZoom (V2 ( halfWidth w) ( halfHeight w)) +-- tl = scTran $ scRot $ scZoom (V2 (-halfWidth w) ( halfHeight w)) +-- br = scTran $ scRot $ scZoom (V2 ( halfWidth w) (-halfHeight w)) +-- bl = scTran $ scRot $ scZoom (V2 (-halfWidth w) (-halfHeight w)) -- | A box covering the screen in world coordinates, with a x and y border screenPolygonBord @@ -44,9 +53,7 @@ getWindowX = _windowX . _config getWindowY = _windowY . _config -- | A box of the size of the screen in screen centered coordinates -screenBox - :: World - -> [Point2] +screenBox :: World -> [Point2] screenBox w = rectNSEW hh (-hh) hw (-hw) where hw = halfWidth w diff --git a/src/Dodge/Config/Load.hs b/src/Dodge/Config/Load.hs index 78808856e..030cc15b4 100644 --- a/src/Dodge/Config/Load.hs +++ b/src/Dodge/Config/Load.hs @@ -1,6 +1,5 @@ module Dodge.Config.Load - ( - loadDodgeConfig + ( loadDodgeConfig ) where import Dodge.Config.Data diff --git a/src/Dodge/Config/Update.hs b/src/Dodge/Config/Update.hs index 42d696026..732bc8c16 100644 --- a/src/Dodge/Config/Update.hs +++ b/src/Dodge/Config/Update.hs @@ -2,7 +2,10 @@ IO actions that apply config side effects and save configuration settings to disk. -} module Dodge.Config.Update - where + ( saveConfig + , setVolThen + , applyWorldConfig + ) where --import Dodge.Data.SoundOrigin import Dodge.Config.Data import Sound @@ -19,7 +22,6 @@ saveConfig cfig f x = do putStrLn "Saving config to data/dodge.config.json" encodeFile "data/dodge.config.json" cfig f x - {- | Apply the volume settings from the world configuration to the running game. -} @@ -28,12 +30,10 @@ setVol cfig = do setSoundVolume ( _volume_master cfig * _volume_sound cfig) setMusicVolume ( _volume_master cfig * _volume_music cfig) -setVol' :: Configuration -> (a -> IO a) -> a -> IO a -setVol' cfig f a = do +setVolThen :: Configuration -> (a -> IO a) -> a -> IO a +setVolThen cfig f a = do setVol cfig f a - - {- | Apply /all/ of the values in the world configuration to the running game. -} diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 9faf0bcca..5d4ad2d84 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -13,6 +13,8 @@ module Dodge.Creature where --import Dodge.Creature.Stance.Data import Dodge.Creature.State.Data +import Dodge.Item.Weapon.Grenade +import Dodge.Item.Weapon.Booster --import Dodge.Creature.ReaderUpdate --import Dodge.Creature.AlertLevel --import Dodge.Creature.SetTarget @@ -30,8 +32,10 @@ import Dodge.Creature.ArmourChase import Dodge.Data import Dodge.Default import Dodge.Item.Weapon +import Dodge.Item.Weapon.SprayGuns +import Dodge.Item.Weapon.BatteryGuns import Dodge.Item.Weapon.Launcher -import Dodge.Item.Weapon.AutoGun +import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Weapon.Bezier import Dodge.Item.Equipment import Dodge.Item.Consumable @@ -117,7 +121,7 @@ multGunCrit = defaultCreature `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] ] ) , (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) - [ drawwp `DoActionThen` shootFirstMiss' `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] ] + [ drawwp `DoActionThen` shootFirstMiss `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] ] ) ] , _crActionPlan = ActionPlan diff --git a/src/Dodge/Creature/AutoCrit.hs b/src/Dodge/Creature/AutoCrit.hs index db4fd634a..42fb1e22e 100644 --- a/src/Dodge/Creature/AutoCrit.hs +++ b/src/Dodge/Creature/AutoCrit.hs @@ -9,7 +9,7 @@ import Dodge.Creature.SentinelAI import Dodge.Creature.Impulse import Dodge.Creature.State --import Dodge.Creature.State.Data -import Dodge.Item.Weapon.AutoGun +import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Consumable --import Geometry import Picture diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 644a8b00d..6dfc93b05 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -3,8 +3,14 @@ Inanimate objects such as lamps, barrels, etc -} module Dodge.Creature.Inanimate - where + ( lamp + , colorLamp + , barrel + , explosiveBarrel + ) where import Dodge.Data +import Dodge.Data.DamageType +import Dodge.WorldEvent.Explosion import Dodge.Creature.Picture --import Dodge.Creature.Stance.Data import Dodge.Creature.State.Data @@ -22,10 +28,14 @@ import Geometry import Geometry.Vector3D import Polyhedra import Shape +import Dodge.WorldEvent +import Dodge.SoundLogic +import Dodge.Data.SoundOrigin +import Dodge.SoundLogic.LoadSound +import System.Random +import Data.List import Control.Lens -import qualified Control.Foldl as L ---import qualified Data.Vector.Fusion.Stream.Monadic as VS import Data.Monoid defaultInanimate :: Creature @@ -60,18 +70,18 @@ lampCrPic h = pictures where f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] 0 polyNum -lTriFold :: a -> a -> L.Fold a [a] -lTriFold s x = L.Fold (f s) (x,[]) snd - where - f s' (x1,l) x2 = (x2,s':x1:x2:l) - -preTriFold :: (a -> b) -> [a] -> [b] -preTriFold f (s:x:xs) = L.fold (L.premap f $ lTriFold (f s) (f x)) xs -preTriFold _ _ = [] - -polyToTriFold :: [a] -> [a] -polyToTriFold (s:x:xs) = L.fold (lTriFold s x) xs -polyToTriFold _ = [] +--lTriFold :: a -> a -> L.Fold a [a] +--lTriFold s x = L.Fold (f s) (x,[]) snd +-- where +-- f s' (x1,l) x2 = (x2,s':x1:x2:l) +-- +--preTriFold :: (a -> b) -> [a] -> [b] +--preTriFold f (s:x:xs) = L.fold (L.premap f $ lTriFold (f s) (f x)) xs +--preTriFold _ _ = [] +-- +--polyToTriFold :: [a] -> [a] +--polyToTriFold (s:x:xs) = L.fold (lTriFold s x) xs +--polyToTriFold _ = [] initialiseLamp :: Float -> CRUpdate initialiseLamp = initialiseColorLamp 0.75 @@ -130,3 +140,59 @@ explosiveBarrel = defaultInanimate , _crInv = IM.empty -- IM.fromList [(0,frontArmour)] ,_crApplyDamage = \_ c -> (id, c) } +updateBarrel + :: Creature + -> World + -> (Endo World, Maybe Creature) +updateBarrel cr _ + | _crHP cr > 0 = (Endo id, newCr) + | otherwise = (Endo id, Nothing) + where + newCr = Just $ doDamage cr + +-- should generate the sparks externally using new random generators +updateExpBarrel + :: Creature + -> World + -> (Endo World, Maybe Creature) +updateExpBarrel cr w + | _crHP cr > 0 = (Endo $ foldr (.) id pierceSparks . hiss, newCr) + | otherwise = (Endo $ makeExplosionAt (_crPos cr) . stopSounds , Nothing) + where + g = _randGen w + damages = _crDamage $ _crState cr + pierceSparks :: [World -> World] + pierceSparks + = zipWith4 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p) (Just $ _crID cr)) + poss as times colids + as = randomRs (-0.7,0.7) g + colids = randomRs (0,11) g + times = randomRs (2,5) g + poss = _piercedPoints $ _crSpState $ _crState cr + --newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages + newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr + --perforate :: DamageType -> Creature -> Creature + --perforate (Piercing amount sp int ep) cr = over (crState . crSpState . piercedPoints) + -- ((:) $ int -.- _crPos cr) cr + --perforate _ cr = cr + applyFuseDamage cr' = cr' & crHP %~ + subtract (length . _piercedPoints . _crSpState $ _crState cr') + hiss | null poss = id + | otherwise = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] (_crPos cr) foamSprayLoopS (Just 1) + stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1) + +damToExpBarrel :: [DamageType] -> Creature -> Creature +damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam + where + (pierceDam,otherDam) = partition isPierce ds + isPierce Piercing{} = True + isPierce _ = False + +damToExpBarrel' :: DamageType -> Creature -> Creature +damToExpBarrel' (Piercing amount _ int _) cr + = over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr) + $ over crHP (\hp -> hp - div amount 200) cr +damToExpBarrel' PoisonDam {} cr = cr +damToExpBarrel' SparkDam {} cr = cr +damToExpBarrel' PushDam{_dmPushBack = v} cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v) +damToExpBarrel' dt cr = cr Control.Lens.& crHP -~ _dmAmount dt diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs index d491639f3..c92945de9 100644 --- a/src/Dodge/Creature/LtAutoCrit.hs +++ b/src/Dodge/Creature/LtAutoCrit.hs @@ -14,7 +14,7 @@ import Dodge.Creature.ReaderUpdate import Dodge.Creature.Perception import Dodge.Creature.State --import Dodge.Creature.State.Data -import Dodge.Item.Weapon +import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Consumable import Geometry import Picture diff --git a/src/Dodge/Creature/PistolCrit.hs b/src/Dodge/Creature/PistolCrit.hs index 99d1bf08b..13c983a21 100644 --- a/src/Dodge/Creature/PistolCrit.hs +++ b/src/Dodge/Creature/PistolCrit.hs @@ -14,7 +14,7 @@ import Dodge.Creature.ReaderUpdate import Dodge.Creature.Perception import Dodge.Creature.State --import Dodge.Creature.State.Data -import Dodge.Item.Weapon +import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Consumable import Geometry import Picture diff --git a/src/Dodge/Creature/Property.hs b/src/Dodge/Creature/Property.hs index 6af6171b5..d2e3f270a 100644 --- a/src/Dodge/Creature/Property.hs +++ b/src/Dodge/Creature/Property.hs @@ -1,5 +1,7 @@ module Dodge.Creature.Property - where + ( crIsArmouredFrom + , crNearSeg + ) where import Dodge.Data import Dodge.Item.Data import Geometry @@ -13,8 +15,8 @@ crIsArmouredFrom p cr && angleVV (unitVectorAtAngle $ _crDir cr) (p -.- _crPos cr) < pi/2 -- even though angleVV can generate NaN, the comparison seems to deal with it -crOnSeg :: Point2 -> Point2 -> Creature -> Bool -crOnSeg p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr) +--crOnSeg :: Point2 -> Point2 -> Creature -> Bool +--crOnSeg p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr) crNearSeg :: Float -> Point2 -> Point2 -> Creature -> Bool crNearSeg d p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr + d) diff --git a/src/Dodge/Creature/SentinelAI.hs b/src/Dodge/Creature/SentinelAI.hs index 50007d1b3..a4114d32e 100644 --- a/src/Dodge/Creature/SentinelAI.hs +++ b/src/Dodge/Creature/SentinelAI.hs @@ -1,5 +1,8 @@ module Dodge.Creature.SentinelAI - where + ( sentinelAI + , sentinelFireType + , sentinelExtraWatchUpdate + ) where import Dodge.Data import Dodge.Base.Collide import Dodge.Creature.Test @@ -7,16 +10,10 @@ import Dodge.Creature.Volition import Dodge.Creature.ReaderUpdate import Dodge.Creature.Strategy import Dodge.Creature.Action ---import Dodge.Creature.ChooseTarget import Dodge.Creature.Perception ---import Dodge.Creature.State ---import Dodge.Creature.State.Data import Geometry.Data ---import Picture ---import Dodge.RandomHelp import Data.Maybe ---import qualified Data.IntMap.Strict as IM import Control.Lens import Control.Monad import Control.Monad.Reader @@ -84,38 +81,38 @@ sentinelExtraWatchUpdate xs = performActionsR (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr) (pure . (crActionPlan . crStrategy .~ WatchAndWait)) -shootAtAdvance :: Int -> [Action] -shootAtAdvance tcid = - [ DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) - `DoActionThen` - lostest `DoActionWhile` - advanceShoot `DoActionThen` - 75 `DoReplicate` - advanceShoot `DoActionThen` - DoImpulses [ChangeStrategy WatchAndWait] - , AimAt - { _targetID = tcid - , _targetSeenAt = V2 0 0 -- hack - } - ] - where - lostest (w,cr') = canSee (_crID cr') tcid w - advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] - -shootAtWhileContinueTime :: Int -> World -> Creature -> Strategy -shootAtWhileContinueTime tcid _ _ = StrategyActions (ShootAt tcid) - [ DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) - `DoActionThen` - lostest `DoActionWhile` - advanceShoot `DoActionThen` - 75 `DoReplicate` - advanceShoot `DoActionThen` - DoImpulses [ChangeStrategy WatchAndWait] - , AimAt - { _targetID = tcid - , _targetSeenAt = V2 0 0 -- hack - } - ] - where - lostest (w,cr') = canSee (_crID cr') tcid w - advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] +--shootAtAdvance :: Int -> [Action] +--shootAtAdvance tcid = +-- [ DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) +-- `DoActionThen` +-- lostest `DoActionWhile` +-- advanceShoot `DoActionThen` +-- 75 `DoReplicate` +-- advanceShoot `DoActionThen` +-- DoImpulses [ChangeStrategy WatchAndWait] +-- , AimAt +-- { _targetID = tcid +-- , _targetSeenAt = V2 0 0 -- hack +-- } +-- ] +-- where +-- lostest (w,cr') = canSee (_crID cr') tcid w +-- advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] +-- +--shootAtWhileContinueTime :: Int -> World -> Creature -> Strategy +--shootAtWhileContinueTime tcid _ _ = StrategyActions (ShootAt tcid) +-- [ DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) +-- `DoActionThen` +-- lostest `DoActionWhile` +-- advanceShoot `DoActionThen` +-- 75 `DoReplicate` +-- advanceShoot `DoActionThen` +-- DoImpulses [ChangeStrategy WatchAndWait] +-- , AimAt +-- { _targetID = tcid +-- , _targetSeenAt = V2 0 0 -- hack +-- } +-- ] +-- where +-- lostest (w,cr') = canSee (_crID cr') tcid w +-- advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] diff --git a/src/Dodge/Creature/SpreadGunCrit.hs b/src/Dodge/Creature/SpreadGunCrit.hs index 2cc6d49bf..2d00e52e3 100644 --- a/src/Dodge/Creature/SpreadGunCrit.hs +++ b/src/Dodge/Creature/SpreadGunCrit.hs @@ -14,7 +14,7 @@ import Dodge.Creature.ReaderUpdate import Dodge.Creature.Perception import Dodge.Creature.State --import Dodge.Creature.State.Data -import Dodge.Item.Weapon +import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Consumable import Geometry import Picture diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 03ed1a233..a27c710f4 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -1,4 +1,7 @@ -module Dodge.Creature.State where +module Dodge.Creature.State + ( stateUpdate + , doDamage + ) where import Dodge.Data import Dodge.Data.DamageType import Dodge.Data.SoundOrigin @@ -19,9 +22,6 @@ import Picture import qualified IntMapHelp as IM --import StrictHelp -import Data.List ---import Data.Char ---import Data.Maybe import Data.Function import Control.Lens --import Control.Applicative @@ -36,8 +36,8 @@ import Data.Monoid import qualified Data.Vector as V import qualified Data.Vector.Mutable as MV -dummyUpdate :: CRUpdate -dummyUpdate cr _ = (Endo id, Just cr) +--dummyUpdate :: CRUpdate +--dummyUpdate cr _ = (Endo id, Just cr) -- | The movement is updated before the ai in order to correctly set the oldpos. stateUpdate :: CRUpdate -> CRUpdate @@ -73,12 +73,6 @@ setOldPos :: Creature -> Creature setOldPos cr = cr & crOldPos .~ _crPos cr & crOldDir .~ _crDir cr -{- | -Given a creature and a velocity, applies friction to that creature and evaluates a -velocity to carry across frames. --} -crFriction :: Creature -> Point2 -> Point2 -crFriction _ _ = V2 0 0 --meleeCooldown :: CRUpdate -> CRUpdate --meleeCooldown u cr = u $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1)) @@ -171,64 +165,3 @@ stepReloading cr = over (crInv . ix iSel . wpReloadState) decreaseToZero cr decreaseToZero :: Int -> Int decreaseToZero x = max 0 (x - 1) -onDeath :: (Creature -> World -> World) -> CRUpdate -> CRUpdate -onDeath h u cr w - | _crHP cr > 0 = u cr w - | otherwise = ( Endo $ h cr , Nothing ) - -updateBarrel - :: Creature - -> World - -> (Endo World, Maybe Creature) -updateBarrel cr _ - | _crHP cr > 0 = (Endo id, newCr) - | otherwise = (Endo id, Nothing) - where - newCr = Just $ doDamage cr - --- should generate the sparks externally using new random generators -updateExpBarrel - :: Creature - -> World - -> (Endo World, Maybe Creature) -updateExpBarrel cr w - | _crHP cr > 0 = (Endo $ foldr (.) id pierceSparks . hiss, newCr) - | otherwise = (Endo $ makeExplosionAt (_crPos cr) . stopSounds , Nothing) - where - g = _randGen w - damages = _crDamage $ _crState cr - pierceSparks :: [World -> World] - pierceSparks - = zipWith4 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p) (Just $ _crID cr)) - poss as times colids - as = randomRs (-0.7,0.7) g - colids = randomRs (0,11) g - times = randomRs (2,5) g - poss = _piercedPoints $ _crSpState $ _crState cr - --newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages - newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr - --perforate :: DamageType -> Creature -> Creature - --perforate (Piercing amount sp int ep) cr = over (crState . crSpState . piercedPoints) - -- ((:) $ int -.- _crPos cr) cr - --perforate _ cr = cr - applyFuseDamage cr' = cr' & crHP %~ - subtract (length . _piercedPoints . _crSpState $ _crState cr') - hiss | null poss = id - | otherwise = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] (_crPos cr) foamSprayLoopS (Just 1) - stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1) - -damToExpBarrel :: [DamageType] -> Creature -> Creature -damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam - where - (pierceDam,otherDam) = partition isPierce ds - isPierce Piercing{} = True - isPierce _ = False - -damToExpBarrel' :: DamageType -> Creature -> Creature -damToExpBarrel' (Piercing amount _ int _) cr - = over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr) - $ over crHP (\hp -> hp - div amount 200) cr -damToExpBarrel' PoisonDam {} cr = cr -damToExpBarrel' SparkDam {} cr = cr -damToExpBarrel' PushDam{_dmPushBack = v} cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v) -damToExpBarrel' dt cr = cr Control.Lens.& crHP -~ _dmAmount dt diff --git a/src/Dodge/Creature/State/WalkCycle.hs b/src/Dodge/Creature/State/WalkCycle.hs index adf6fa354..5165e6115 100644 --- a/src/Dodge/Creature/State/WalkCycle.hs +++ b/src/Dodge/Creature/State/WalkCycle.hs @@ -1,4 +1,7 @@ module Dodge.Creature.State.WalkCycle + ( updateWalkCycle + , footstepSideEffect + ) where import Dodge.Data import Dodge.Data.SoundOrigin diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index 7d0eccf18..8cb3792ef 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -5,6 +5,17 @@ Note that the creature NEED NOT be the same as the creature with that id in the in fact in some cases a creature with that id may not even exist. -} module Dodge.Creature.Test +-- ( crCanShoot +-- , crIsAiming' +-- , crIsReloading +-- , crIsAiming +-- , crHasTargetLOS +-- , crAwayFromPost +-- , crHasTargetR +-- , crStratConMatchesR +-- , crHasAmmo +-- , crSafeDistFromTarg +-- ) where import Dodge.Data import Dodge.Base.Collide diff --git a/src/Dodge/Creature/Update.hs b/src/Dodge/Creature/Update.hs index 370f74c1a..67f2ce791 100644 --- a/src/Dodge/Creature/Update.hs +++ b/src/Dodge/Creature/Update.hs @@ -1,11 +1,9 @@ module Dodge.Creature.Update - where + ( unrandUpdate + ) where import Dodge.Data ---import System.Random import Data.Monoid --- combinators for helping with dealing with creature update - unrandUpdate :: (Creature -> World -> World) diff --git a/src/Dodge/Creature/Volition.hs b/src/Dodge/Creature/Volition.hs index 3d586a3a6..be6cd0c8e 100644 --- a/src/Dodge/Creature/Volition.hs +++ b/src/Dodge/Creature/Volition.hs @@ -1,8 +1,13 @@ {- | Not a good name, perhaps: internal creature actions. -} module Dodge.Creature.Volition - where + ( holsterWeapon + , drawWeapon + , shootTillEmpty + , fleeFrom + , shootFirstMiss + ) where import Dodge.Data -import Dodge.Base.Collide +--import Dodge.Base.Collide import Dodge.Creature.Test import Dodge.Creature.Stance.Data import Dodge.SoundLogic.LoadSound @@ -22,17 +27,17 @@ shootTillEmpty :: Action shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem]) `DoActionThen` 20 `WaitThen` holsterWeapon -advanceShoot' :: Int -> Action -advanceShoot' tcid = lostest `DoActionWhile` - advanceShoot `DoActionThen` - 75 `DoReplicate` - advanceShoot - where - lostest (w,cr) = canSee (_crID cr) tcid w - advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] +--advanceShoot :: Int -> Action +--advanceShoot tcid = lostest `DoActionWhile` +-- advanceShoot' `DoActionThen` +-- 75 `DoReplicate` +-- advanceShoot' +-- where +-- lostest (w,cr) = canSee (_crID cr) tcid w +-- advanceShoot' = ImpulsesList [[UseItem, MoveForward 3]] -shootFirstMiss' :: Action -shootFirstMiss' = +shootFirstMiss :: Action +shootFirstMiss = LeadTarget (V2 30 50) `DoActionThen` DoImpulses [UseItem] `DoActionThen` (crCanShoot `DoActionWhile` DoActions [LeadTarget (V2 0 0),DoImpulses [UseItem]]) diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 7982703a2..73c69e119 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -1,10 +1,8 @@ module Dodge.Creature.YourControl - where + ( yourControl + ) where import Dodge.Data ---import Dodge.Base import Dodge.Creature.Impulse.Movement ---import Dodge.Creature.State ---import Dodge.Creature.State.Data import Dodge.Creature.Stance.Data import Dodge.Update.UsingInput import Dodge.Config.KeyConfig @@ -13,10 +11,8 @@ import Geometry import Control.Lens import qualified SDL ---import Data.Maybe import qualified Data.Set as S import qualified Data.IntMap.Strict as IM ---import System.Random import Data.Monoid {- | The AI equivalent for your control. -} yourControl @@ -57,26 +53,19 @@ wasdWithAiming w speed i cr wasdM :: World -> SDL.Scancode -> Point2 wasdM w scancode - | scancode == moveUpKey (_keyConfig w) = V2 0 1 - | scancode == moveDownKey (_keyConfig w) = V2 0 (-1) - | scancode == moveRightKey (_keyConfig w) = V2 1 0 - | scancode == moveLeftKey (_keyConfig w) = V2 (-1) 0 + | scancode == moveUpKey (_keyConfig w) = V2 0 1 + | scancode == moveDownKey (_keyConfig w) = V2 0 (-1) + | scancode == moveRightKey (_keyConfig w) = V2 1 0 + | scancode == moveLeftKey (_keyConfig w) = V2 (-1) 0 wasdM _ _ = V2 0 0 wasdDir :: World -> Point2 wasdDir w = foldr ((+.+) . wasdM w) (V2 0 0) $ _keys w -wasdComp :: S.Set SDL.Scancode -> World -> (Point2,Maybe Float) -wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (V2 0 0) ks - where - f (V2 0 0) = (V2 0 0, Nothing) - f p = (errorNormalizeV 46 p, Just $ argV p) - {- | Set posture according to mouse presses. -} mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature mouseActionsCr pkeys | rbPressed = crStance . posture .~ Aiming | otherwise = crStance . posture .~ AtEase where - --lbPressed = SDL.ButtonLeft `S.member` pkeys rbPressed = SDL.ButtonRight `S.member` pkeys diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index e1e4e18c4..b9ed627b8 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -83,4 +83,3 @@ toggleMap :: World -> World toggleMap w = w & carteDisplay %~ not escapeMap :: World -> World escapeMap w = w & carteDisplay .~ False - diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 20927b347..e6a9e2c8b 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -12,98 +12,25 @@ import Dodge.SoundLogic.LoadSound import Dodge.Creature.Action import Dodge.WorldEvent import Dodge.Default ---import Dodge.Default.Shell import Dodge.Item.Draw ---import Dodge.Particle.Bullet.HitEffect import Dodge.Item.Data -import Dodge.Item.Weapon.InventoryDisplay +import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Weapon.TriggerType import Dodge.Item.Weapon.ExtraEffect import Dodge.Item.Weapon.UseEffect -import Dodge.Item.Weapon.Laser -import Dodge.Item.Weapon.Bullet -import Dodge.Item.Weapon.AmmoParams import Dodge.Item.Weapon.Remote import Dodge.Item.Attachment.Data import Dodge.Default.Weapon -import Dodge.Item.Weapon.Booster import Dodge.Item.Weapon.Grenade ---import Dodge.Item.Attachment.Data -import Dodge.Item.Attachment import Geometry -import Geometry.Vector3D import Picture import qualified IntMapHelp as IM import Shape import ShapePicture ---import Data.List ---import Data.Char import Data.Maybe import Data.Function ---import qualified Data.ByteString as B -import qualified Data.Sequence as Seq import Control.Lens ---import Control.Monad -import System.Random - -pistol :: Item -pistol = defaultGun - { _itName = "PISTOL" - , _itIdentity = Pistol - , _wpMaxAmmo = 15 - , _wpLoadedAmmo = 15 - , _wpReloadTime = 40 - , _wpReloadState = 0 - , _itUseRate = 8 - , _itUseTime = 0 - , _itUse = useAmmoParams - , _itUseModifiers = - [ ammoCheckI - , hammerCheckI - , useTimeCheckI - , withSoundStart tap3S - , useAmmo 1 - , randSpreadDir - , withMuzFlareI - ] - , _itLeftClickUse = Nothing - , _wpSpread = 0.02 - , _wpRange = 20 - , _itHammer = HammerUp - , _itFloorPict = pistolPic - , _itAmount = 1 - , _itMaxStack = 1 - , _itAimingSpeed = 1 - , _itAimingRange = 0 - , _itZoom = defaultItZoom - , _itEquipPict = pictureWeaponAim pistolPic - , _itAttachment = NoItAttachment - , _itID = Nothing - , _itEffect = wpRecock - , _itInvDisplay = basicWeaponDisplay - , _itInvColor = white - , _itTargeting = Nothing - , _itWorldTrigger = Nothing - , _wpAmmo = basicBullet - } -pistolPic :: Item -> SPic -pistolPic it = - ( colorSH green (prismPoly - (map (addZ 3) $ rectNESW 3 3 (-3) (-3)) - (map (addZ 0) $ rectNESW 5 3 (-5) (-7)) - ) - <> translateSH (V3 (-4) 5.5 4) (rotateSH pi $ bulletClip am) - , mempty - ) - where - am = loadedAmmo it - -bulletClip :: Int -> Shape -bulletClip x = rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW 3 0 (3 - 0.25 * am) (-5) - where - am = fromIntegral x - effectGun :: String -> (Creature -> World -> World) -> Item effectGun name eff = defaultGun @@ -115,110 +42,6 @@ autoEffectGun name eff = defaultAutoGun { _itName = name ++ "Gun" , _itUse = const eff } -rezGun :: Item -rezGun = defaultGun - { _itName = "REANIMATOR" - , _wpMaxAmmo = 50 - , _wpLoadedAmmo = 50 - , _wpReloadTime = 80 - , _wpReloadState = 0 - , _itUseRate = 0 - , _itUseTime = 0 - , _itUse = const aTeslaArc - , _itUseModifiers = - [] - , _wpSpread = 0.001 - , _wpRange = 20 - , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color chartreuse $ pictures - [polygon $ rectNESW 7 3 1 (-3) - ,polygon $ rectNESW (-1) 3 (-7) (-3) - ] - , _itAimingSpeed = 0.4 - , _itAimingRange = 0 - , _itEquipPict = pictureWeaponOnAim $ \_ -> (,) emptySH $ color chartreuse $ pictures - [polygon $ rectNESW 7 3 1 (-3) - ,polygon $ rectNESW (-1) 3 (-7) (-3) - ] - } -teslaGun :: Item -teslaGun = defaultGun - { _itName = "TESLA" - , _itIdentity = TeslaGun - , _wpMaxAmmo = 200 - , _wpLoadedAmmo = 200 - , _wpReloadTime = 80 - , _wpReloadState = 0 - , _itUseRate = 0 - , _itAimStance = TwoHandFlat - , _itUseTime = 0 - , _itUse = const aTeslaArc - , _itUseModifiers = - [ ammoCheckI - , useTimeCheckI - , withTempLight 1 100 (V3 0 0 1) - , withSoundForI elecCrackleS 1 - , useAmmo 1 - ] - , _wpSpread = 0.001 - , _wpRange = 20 - , _itFloorPict = teslaGunPic - , _itAimingSpeed = 0.4 - , _itZoom = defaultItZoom - , _itAimingRange = 0 - , _itEquipPict = pictureWeaponOnAim teslaGunPic - } -teslaGunPic :: Item -> SPic -teslaGunPic _ = - ( colorSH blue $ - upperPrismPoly 5 (rectNESW xb y xa (-y)) - ++ upperPrismPoly 5 (rectNESW (-xa) y (-xb) (-y)) - , mempty - ) - where - xa = 1 - xb = 9 - y = 4 -lasGun :: Item -lasGun = defaultAutoGun - { _itName = "LASGUN ////" - , _itIdentity = LasGun - , _wpMaxAmmo = 200 - , _wpLoadedAmmo = 200 - , _wpReloadTime = 80 - , _wpReloadState = 0 - , _itUseRate = 0 - , _itUseTime = 0 - , _itUse = const aLaser - , _itUseModifiers = - [ ammoCheckI - , useTimeCheckI - , withTempLight 1 100 (V3 1 1 0) - , withSoundForI tone440sawtoothS 1 - , useAmmo 1 - ] - , _wpSpread = 0.001 - , _wpRange = 20 - , _itFloorPict = lasGunPic - , _itAimingSpeed = 0.4 - , _itAimingRange = 1 - , _itEquipPict = pictureWeaponOnAim lasGunPic - , _itAttachment = ItCharMode $ Seq.fromList "/VZ" - , _itScroll = scrollCharMode - , _itInvDisplay = basicWeaponDisplay - } -lasGunPic :: Item -> SPic -lasGunPic it = - ( colorSH blue $ - upperPrismPoly 4 (rectNESW 3 15 1 (-15)) - <> upperPrismPoly 4 (rectNESW (-1) 15 (-3) (-15)) - -- <> (upperPrismPoly 4 $ rectNESW (5) l (-5) (l-2)) - <> upperPrismPoly 1 (rectNESW 3 15 (-3) (-15)) - , setLayer 1 . color col . setDepth 1.1 . polygon $ rectNESW 1 15 (-1) (-15) - ) - where - amFrac = fractionLoadedAmmo it - col = brightX 2 1.5 $ mixColors amFrac (1-amFrac) green red - forceFieldGun :: Item forceFieldGun = defaultGun { _itName = "FORCEFIELD" @@ -255,30 +78,6 @@ forceFieldGun = defaultGun -- , _itAimingSpeed = 1 -- , _itAimingRange = 0.5 -- } -tractorGun :: Item -tractorGun = defaultAutoGun - { _itName = "TRACTORGUN" - , _itIdentity = TractorGun - , _wpMaxAmmo = 10000 - , _wpLoadedAmmo = 10000 - , _wpReloadTime = 40 - , _wpReloadState = 0 - , _itUseRate = 0 - , _itUseTime = 0 - , _itUse = aTractorBeam - , _itUseModifiers = - [ ammoUseCheckI - ] - , _wpSpread = 0.00001 - , _wpRange = 20 - , _itFloorPict = tractorGunSPic - , _itAimingSpeed = 0.4 - , _itAimingRange = 0.5 - , _itEquipPict = pictureWeaponOnAim tractorGunSPic - } --- TODO own picture for tractor gun -tractorGunSPic :: Item -> SPic -tractorGunSPic = lasGunPic removeItAttachment :: Int -> Int -> World -> World removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ NoItAttachment @@ -286,379 +85,6 @@ removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachmen cr = _creatures w IM.! i itRef = _crInvSel cr -hvAutoGun :: Item -hvAutoGun = defaultAutoGun - { _itName = "AUTO-HV" - , _itIdentity = HvAutoGun - , _wpMaxAmmo = 100 - , _wpLoadedAmmo = 100 - , _wpReloadTime = 200 - , _wpReloadState = 0 - , _itUseRate = 25 - , _itUseTime = 0 - , _itUse = useAmmoParams - , _itUseModifiers = - [ ammoCheckI - , rateIncABI 24 7 (torqueBeforeAtLeast 0.1 0.1) (torqueAfterI 0.2) - , withSoundStart bangEchoS - , withThinSmokeI - , withMuzFlareI - ] - , _wpRange = 20 - , _itFloorPict = hvAutoGunPic - , _itAimingSpeed = 0.2 - , _itAimingRange = 1 - , _itEquipPict = pictureWeaponOnAim hvAutoGunPic - , _wpAmmo = hvBullet - } -hvAutoGunPic :: Item -> SPic -hvAutoGunPic it = - ( colorSH orange (prismPoly - (map (addZ 5) $ rectNESW 3 12 (-3) (-8)) - (map (addZ 0) $ rectNESW 5 12 (-5) (-12)) - ) - <> bulletClip am - , mempty - ) - where - am = loadedAmmo it -ltAutoGun :: Item -ltAutoGun = defaultAutoGun - { _itName = "AUTO-LT" - , _itIdentity = LtAutoGun - , _wpMaxAmmo = 25 - , _wpLoadedAmmo = 25 - , _wpReloadTime = 80 - , _wpReloadState = 0 - , _itUseRate = 3 - , _itUseTime = 0 - , _itUse = useAmmoParams - , _itUseModifiers = - [ ammoCheckI - , useTimeCheckI - , withSoundStart tap1S - , useAmmo 1 - , withRandomDirI 0.1 - , torqueAfterI 0.2 - , withSidePushI 50 - , modClock 2 withMuzFlareI - ] - , _wpSpread = 0.5 - , _wpRange = 20 - , _itFloorPict = ltAutoGunPic - , _itAimingSpeed = 1 - , _itAimingRange = 0 - , _itZoom = defaultItZoom - , _itEquipPict = pictureWeaponOnAim ltAutoGunPic - , _itAimStance = OneHand - , _wpAmmo = ltBullet - } -ltAutoGunPic :: Item -> SPic -ltAutoGunPic it = - ( colorSH green $ prismPoly - (map (addZ 5) $ mirrorXAxis [V2 (-2) 3, V2 5 3, V2 10 0]) - (map (addZ 0) $ mirrorXAxis [V2 (-5) 5, V2 5 5, V2 10 0]) - <> bulletClip am - , mempty - ) - where - am = loadedAmmo it -miniGun :: Item -miniGun = defaultAutoGun - { _itName = "MINI-G" - , _itIdentity = MiniGun - , _wpMaxAmmo = 1500 - , _wpLoadedAmmo = 1500 - , _wpReloadTime = 200 - , _wpReloadState = 0 - , _wpMaxWarmUp = 100 - , _itUseRate = 0 - , _itUseTime = 0 - , _itUse = useAmmoParamsVelMod vm4 - , _itUseModifiers = - [ ammoCheckI - , withWarmUpI crankSlowS - , useTimeCheckI - --, afterRecoil recoilAmount - , withSoundForI mini1S 2 - --, withThinSmokeI - , torqueAfterI 0.05 - , withSidePushI 53 - , afterRecoil recoilAmount - , withRandomOffsetI 12 - , trigDoAlso (useAmmoParamsVelMod vm1) - --, torqueBeforeForcedI 0.001 - , withSidePushI 52 - , afterRecoil recoilAmount - , withRandomOffsetI 11 - , withOldDir od1 - , trigDoAlso (useAmmoParamsVelMod vm2) - --, torqueBeforeForcedI 0.001 - , withSidePushI 51 - , afterRecoil recoilAmount - , withRandomOffsetI 10 - , withOldDir od2 - , trigDoAlso (useAmmoParamsVelMod vm3) - , useAmmo 4 - --, torqueBeforeForcedI 0.001 - , withSidePushI 50 - , afterRecoil recoilAmount - , withRandomOffsetI 9 - , withMuzFlareI - , withOldDir od3 - , withSmoke 1 black 20 200 5 - ] - , _wpRange = 20 - , _itFloorPict = miniGunPictItem - , _itAimingSpeed = 0.4 - , _itAimingRange = 1 - , _itEquipPict = pictureWeaponAim miniGunPictItem - , _wpAmmo = basicBullet - } - where - recoilAmount = 5 - [vm1,vm2,vm3,vm4] = - [ 0.25 - , 0.5 - , 0.75 - , 1 - ] - [od1,od2,od3] = - [ 0.25, 0.5, 0.9] - --[ 0.75, 0.5, 0.25] - --[ 0, 0, 0] -miniGunPictItem :: Item -> SPic -miniGunPictItem it = miniGunPict spin (loadedAmmo it) - where - spin = (-10) * _wpLoadedAmmo it + _wpCurWarmUp it - -miniGunPict :: Int -> Int -> SPic -miniGunPict spin am = - ( colorSH red (rotateSHx a barrels) - <> colorSH red (upperPrismPoly 5 $ rectNESW 8 8 (-8) 4) - <> colorSH red (prismPoly - (map (addZ 5) $ rectNESW 2 12 (-2) (-12)) - (map (addZ 0) $ rectNESW 4 12 (-4) (-16)) - ) - <> clip (-1) 0 - <> clip (-7) 0 - , mempty - ) - where - aBarrel = translateSH (V3 7 0 9) $ prismPoly - (map (addZ 5) $ rectNESW 2 12 (-2) (-1)) - (map (addZ 0) $ rectNESW 4 12 (-4) (-5)) - barrels = concatMap (\an -> aBarrel & rotateSHx an) [0,0.5* pi, pi, 1.5*pi] - a = fromIntegral spin / 100 - x = fromIntegral am / 10 - clip y z = translateSH (V3 0 (-1) z) (rotateSHx (negate $ pi/4) - . upperPrismPoly 2 - $ rectNESW (negate $ 3 + 0.25 * x) y 3 (y-5)) -spreadGun :: Item -spreadGun = defaultGun - { _itName = "SPREAD" - , _itIdentity = SpreadGun - , _wpMaxAmmo = 5 - , _wpLoadedAmmo = 5 - , _wpReloadTime = 80 - , _wpReloadState = 0 - , _itUseRate = 20 - , _itUseTime = 0 - --, _itUse = \_ -> spreadNumVelWthHiteff spreadGunSpread 9 (V2 30 0) 2 basicBulletEffect - , _itUse = useAmmoParams - , _itUseModifiers = - [ ammoCheckI - , hammerCheckI - , useTimeCheckI - , withSoundStart shotgunS - , useAmmo 1 - , withRecoilI 100 - , withMuzFlareI - , spreadNumI - ] - , _wpSpread = spreadGunSpread - , _wpRange = 20 - , _itFloorPict = spreadGunPic - , _itAimingSpeed = 1 - , _itAimingRange = 0 - , _itEquipPict = pictureWeaponOnAim spreadGunPic - , _wpAmmo = basicBullet - , _wpNumBarrels = 50 - } -spreadGunPic :: Item -> SPic -spreadGunPic it = - ( colorSH green (upperPrismPoly 5 $ map toV2[(-3,0),(3,6),(3,-6)]) - <> bulletClip am - , mempty - ) - where - am = loadedAmmo it -multGun :: Item -multGun = defaultGun - { _itName = "MULTGUN" - , _itIdentity = MultGun - , _wpMaxAmmo = 2 - , _wpLoadedAmmo = 2 - , _wpReloadTime = 40 - , _wpReloadState = 0 - , _itUseRate = 20 - , _itUseTime = 0 - , _itUse = useAmmoParams - , _itUseModifiers = - [ ammoCheckI - , hammerCheckI - , useTimeCheckI - , withSoundStart shotgunS - , useAmmo 1 - , withRecoilI 200 - , withMuzFlareI - , numI - ] - , _wpSpread = spreadGunSpread - , _wpRange = 20 - , _itFloorPict = multGunSPic - , _itAimingSpeed = 0.4 - , _itAimingRange = 1 - , _itZoom = defaultItZoom - , _itAimZoom = defaultItZoom {_itZoomFac = 1.5} - , _itEquipPict = pictureWeaponOnAim multGunSPic - , _itAimStance = TwoHandTwist - , _wpAmmo = basicBullet - , _wpNumBarrels = 5 - } -multGunSPic :: Item -> SPic -multGunSPic it = - ( colorSH red ( - upperPrismPoly 2 (rectNESW 4 8 (-4) (-12)) <> - translateSHf 8 0 (concatMap barrel [12,7,2,-3,-8] <> - upperPrismPoly 2 (map toV2 [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)]) - ) - ) <> bulletClip am - , mempty - ) - where - barrel y = prismPoly - (map (addZ 5) $ rectNSEW y (y-4) 2 0 ) - (map (addZ 0) $ rectNSEW y (y-4) 2 (-2)) - am = loadedAmmo it -longGun :: Item -longGun = defaultGun - { _itName = "LONGGUN" - , _itIdentity = LongGun - , _wpMaxAmmo = 1 - , _wpLoadedAmmo = 1 - , _wpReloadTime = 100 - , _wpReloadState = 0 - , _wpReloadType = PassiveReload skwareFadeTwoSecS - , _itUseRate = 100 - , _itUseTime = 0 - , _itUse = useAmmoParams - , _itUseModifiers = - [ ammoCheckI - , hammerCheckI - , useTimeCheckI - , withSoundStart bangEchoS - , useAmmo 1 - , withThickSmokeI - , torqueAfterI 0.05 - , withMuzFlareI - ] - , _wpRange = 200 - , _itFloorPict = longGunSPic - , _itAimingSpeed = 0.2 - , _itAimingRange = 1 - , _itZoom = defaultItZoom - , _itAimZoom = defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5} - , _itEquipPict = pictureWeaponOnAim longGunSPic - , _itScroll = zoomLongGun - , _itAttachment = ItScope (V2 0 0) 0 1 False - , _itEffect = itemLaserScopeEffect - , _wpAmmo = hvBullet - , _itAimStance = TwoHandTwist - } -longGunSPic :: Item -> SPic -longGunSPic _ = - ( colorSH orange $ upperPrismPoly 5 $ rectWH 12 2 - , mempty - ) - -zoomLongGun :: Float -> Creature -> Item -> Item -zoomLongGun x _ - | x > 0 = startZoomInLongGun - | x < 0 = startZoomOutLongGun - | otherwise = id - -startZoomInLongGun :: Item -> Item -startZoomInLongGun = itAttachment . scopeZoomChange %~ \x -> max 5 (x + 5) -startZoomOutLongGun :: Item -> Item -startZoomOutLongGun = itAttachment . scopeZoomChange %~ \x -> min (-5) (x-5) -poisonSprayer :: Item -poisonSprayer = defaultAutoGun - { _itName = "POISON" - , _itIdentity = PoisonSprayer - , _wpMaxAmmo = 500 - , _wpLoadedAmmo = 500 - , _wpReloadTime = 100 - , _wpReloadState = 0 - , _itUseRate = 0 - , _itUseTime = 0 - , _itUse = const aGasCloud - , _itUseModifiers = - [ ammoCheckI - , useTimeCheckI - , withSoundForI foamSprayLoopS 5 - , useAmmo 1 - , spreadNumI - ] - , _wpRange = 8 - , _itFloorPict = flamerPic - , _itAimingSpeed = 0.2 - , _itAimingRange = 0 - , _itZoom = defaultItZoom - , _itEquipPict = pictureWeaponOnAim flamerPic - , _wpSpread = 0.1 - , _wpNumBarrels = 3 - } -flamer :: Item -flamer = defaultAutoGun - { _itName = "FLAMER" - , _itIdentity = Flamethrower - , _wpMaxAmmo = 250 - , _wpLoadedAmmo = 250 - , _wpReloadTime = 100 - , _wpReloadState = 0 - , _itUseRate = 0 - , _itUseTime = 0 - , _itUse = \_ -> randWalkAngle 0.2 0.01 aFlame - , _itUseModifiers = - [ ammoUseCheckI - , withSidePushI 5 - --, withTempLight 1 100 (V3 1 0 0) - , withSidePushAfterI 20 - ] - , _wpSpread = 0 - , _wpRange = 8 - , _itFloorPict = flamerPic - , _itAimingSpeed = 0.5 - , _itAimingRange = 0 - , _itZoom = defaultItZoom - , _itAimZoom = defaultItZoom {_itZoomMax = 5, _itZoomMin = 1.5} - , _itEquipPict = pictureWeaponOnAim flamerPic - , _itAttachment = NoItAttachment - } -flamerPic :: Item -> SPic -flamerPic it = - ( colorSH yellow $ - translateSHf tx ty (upperPrismPoly tz $ polyCirc 3 r) - ++ upperPrismPoly 5 (rectNESW 2 9 (-2) (-9)) - , color black $ translate3 (V3 tx ty (tz+0.01)) $ circleSolid (r * am) - ) - where - tx = - 5 - ty = - 6 - tz = 3 - r = 5 - am = fractionLoadedAmmo2 it blinkGun :: Item blinkGun = defaultGun { _itName = "BLINKER" @@ -681,62 +107,11 @@ blinkGun = defaultGun , _itAimingSpeed = 1 , _itAimingRange = 0 } -boosterGun :: Item -boosterGun = defaultGun - { _itName = "BOOSTER" - , _itIdentity = Blinker - , _wpMaxAmmo = 100 - , _wpLoadedAmmo = 100 - , _wpReloadTime = 20 - , _wpReloadState = 0 - , _itUseRate = 0 - , _itUseTime = 0 - , _itUse = \_ -> boostSelf 10 - , _itLeftClickUse = Just $ boostSelfL 10 - , _wpSpread = 0.05 - , _wpRange = 20 - , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] - , _itAimingSpeed = 1 - , _itAimingRange = 0 - , _itEffect = resetAttachmentID - } - -aTeslaArc :: Creature -> World -> World -aTeslaArc cr w - = -- teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir) - set randGen g w - & particles %~ (makeTeslaArcAt col pos dir :) - where - pos = _crPos cr +.+ (_crRad cr +1) *.* unitVectorAtAngle dir - dir = _crDir cr - (colid,g) = randomR (0::Int,3) $ _randGen w - col = chooseColor colid - chooseColor 0 = white - chooseColor 1 = azure - chooseColor 2 = blue - chooseColor _ = cyan shellExplosionAt :: Point2 -> World -> World shellExplosionAt = makeExplosionAt -aGasCloud :: Creature -> World -> World -aGasCloud cr w = insertCloud $ set randGen g w - where - (a,g) = randomR (-0.1,0.1) (_randGen w) - dir = _crDir cr + a - pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) - vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* unitVectorAtAngle dir - insertCloud = makeGasCloud pos vel - -aFlame :: Creature -> World -> World -aFlame cr w = w & particles %~ (aFlameParticle t pos vel (Just cid) :) - where - (t,_) = randomR (99,101) (_randGen w) - cid = _crID cr - dir = _crDir cr - pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) - vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir aSelf :: Creature -> World -> World aSelf = blinkAction @@ -808,57 +183,6 @@ setRemoteBombScope itid pj w' = case _itemPositions w' IM.! itid of & creatures . ix cid . crInv . ix invid . itAimZoom .~ (defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5}) _ -> w' - -grenade :: Item -grenade = Throwable - { _itName = "GRENADE " ++ show fuseTime - , _itIdentity = Grenade - , _itMaxStack = 8 - , _itAmount = 1 - , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] - , _twMaxRange = 150 - , _twAccuracy = 30 - , _itUse = \_ -> throwGrenade makeExplosionAt - , _itUseModifiers = - [ useTimeCheckI - ] - , _itAimingSpeed = 1 - , _itAimingRange = 0 - , _itZoom = defaultItZoom - , _itAimZoom = defaultItZoom {_itZoomMax = f fuseTime, _itZoomMin = f fuseTime} - , _itEquipPict = pictureWeaponOnAim $ \_ -> grenadePic fuseTime - , _itID = Nothing - , _itUseRate = 25 - , _itUseTime = 0 - , _itAttachment = ItFuse fuseTime - , _itInvColor = white - , _itInvDisplay = basicWeaponDisplay - , _itEffect = wpRecock - , _itHammer = HammerUp - , _itScroll = changeFuse - , _itAimStance = OneHand - } - where - fuseTime = 50 - f x = 50 / fromIntegral x - -flameGrenade :: Item -flameGrenade = grenade { - _itName = "FLMGREN " ++ show fuseTime - , _itUse = \_ -> throwGrenade makeFlameExplosionAt - } - where - fuseTime = 50 :: Int - --f x = 50 / fromIntegral x - -teslaGrenade :: Item -teslaGrenade = grenade { - _itName = "TLSGREN " ++ show fuseTime - , _itUse = \_ -> throwGrenade makeTeslaExplosionAt - } - where - fuseTime = 50 :: Int - --f x = 50 / fromIntegral x defaultThrowable :: Item defaultThrowable = grenade @@ -868,7 +192,8 @@ remoteBomb = defaultThrowable , _itIdentity = RemoteBomb , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 + [(-3,-3),(-3,3),(3,3),(3,-3)] , _twMaxRange = 150 , _twAccuracy = 30 , _itUse = const throwRemoteBomb @@ -944,9 +269,6 @@ remoteBombPic _ = pictures remoteBombUnarmedPic :: Picture remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5 -spreadGunSpread,autogunSpread :: Float -spreadGunSpread = 0.5 -autogunSpread = 0.07 pipe :: Item pipe = Craftable { _itIdentity = Generic diff --git a/src/Dodge/Item/Weapon/AmmoParams.hs b/src/Dodge/Item/Weapon/AmmoParams.hs index 79d6c9e25..a895c6db2 100644 --- a/src/Dodge/Item/Weapon/AmmoParams.hs +++ b/src/Dodge/Item/Weapon/AmmoParams.hs @@ -1,5 +1,10 @@ module Dodge.Item.Weapon.AmmoParams - where + ( useAmmoParams + , loadedAmmo + , useAmmoParamsVelMod + , fractionLoadedAmmo + , fractionLoadedAmmo2 + ) where import Dodge.Data import Dodge.Particle.Bullet.Spawn import Geometry diff --git a/src/Dodge/Item/Weapon/AutoGun.hs b/src/Dodge/Item/Weapon/AutoGun.hs deleted file mode 100644 index 04643097d..000000000 --- a/src/Dodge/Item/Weapon/AutoGun.hs +++ /dev/null @@ -1,80 +0,0 @@ -module Dodge.Item.Weapon.AutoGun - where -import Dodge.Data -import Dodge.Default.Weapon -import Dodge.Default -import Dodge.Item.Attachment -import Dodge.Item.Attachment.Data -import Dodge.Item.Weapon.ExtraEffect -import Dodge.Item.Weapon.InventoryDisplay -import Dodge.Item.Weapon.AmmoParams -import Dodge.Item.Data -import Dodge.Item.Draw -import Dodge.Item.Weapon.Bullet -import Dodge.Item.Weapon.TriggerType -import Dodge.SoundLogic.LoadSound -import Picture -import Geometry -import Geometry.Vector3D -import ShapePicture -import Shape - -import qualified Data.Sequence as Seq - -autoGun :: Item -autoGun = defaultAutoGun - { _itName = "AUTOGUN" - , _itIdentity = AutoGun - , _wpMaxAmmo = 30 - , _wpLoadedAmmo = 30 - , _wpReloadTime = 80 - , _wpReloadState = 0 - , _itUseRate = 5 - , _itUseTime = 0 - , _itUse = useAmmoParams - , _itUseModifiers = - [ ammoCheckI - , charFiringStratI - [('S', hammerCheckI) - ] - , useTimeCheckI - , charFiringStratI - [('M', torqueBefore 0.08) - ,('S', torqueBefore 0.05) - ] - , withSoundForI autoBS 5 - , useAmmo 1 - , withRandomDirI (autogunSpread/2) - , withMuzFlareI - , withSmoke 1 black 20 200 5 - ] - , _wpSpread = autogunSpread - , _wpRange = 20 - , _itHammer = HammerUp - , _itFloorPict = autoGunPic - , _itAimingSpeed = 0.4 - , _itAimingRange = 1 - , _itZoom = defaultItZoom - , _itAimZoom = defaultItZoom {_itZoomFac = 1.5} - , _itEquipPict = pictureWeaponOnAim autoGunPic - , _itEffect = wpRecock - , _itAttachment = ItCharMode $ Seq.fromList "MS" - , _itScroll = scrollCharMode - , _itInvDisplay = basicWeaponDisplay - , _wpAmmo = basicBullet - } -autoGunPic :: Item -> SPic -autoGunPic it = - ( colorSH red (prismPoly - (map (addZ 5) $ rectNESW 2 12 (-2) (-8)) - (map (addZ 0) $ rectNESW 4 12 (-4) (-12)) - ) - <> translateSHf 0 (-1) (rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW (negate $ 3 + 0.25 * x) 0 3 (-5)) - , mempty - ) - where - x = fromIntegral $ loadedAmmo it - -autogunSpread :: Float -autogunSpread = 0.07 - diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs new file mode 100644 index 000000000..c9b5a36f0 --- /dev/null +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -0,0 +1,315 @@ +module Dodge.Item.Weapon.BatteryGuns + ( lasGun + , teslaGun + , tractorGun + ) + where +import Dodge.Data +import Dodge.SoundLogic.LoadSound +import Dodge.Creature.State.Data +import Dodge.Data.DamageType +import Dodge.WorldEvent +import Dodge.Default +import Dodge.Item.Draw +import Dodge.Item.Data +import Dodge.Item.Weapon.InventoryDisplay +import Dodge.Item.Weapon.TriggerType +import Dodge.Item.Weapon.AmmoParams +import Dodge.Item.Attachment.Data +import Dodge.Default.Weapon +import Dodge.Item.Attachment +import Dodge.WorldEvent.HelperParticle +import Dodge.Base +import Dodge.Zone +import Geometry +import Picture +import Shape +import ShapePicture +import Dodge.Picture + +import Data.Function +import qualified Data.Sequence as Seq +import Data.List +import Control.Lens +import System.Random +import Data.Maybe +import Data.Tuple +import qualified Data.IntMap.Strict as IM +teslaGun :: Item +teslaGun = defaultGun + { _itName = "TESLA" + , _itIdentity = TeslaGun + , _wpMaxAmmo = 200 + , _wpLoadedAmmo = 200 + , _wpReloadTime = 80 + , _wpReloadState = 0 + , _itUseRate = 0 + , _itAimStance = TwoHandFlat + , _itUseTime = 0 + , _itUse = const aTeslaArc + , _itUseModifiers = + [ ammoCheckI + , useTimeCheckI + , withTempLight 1 100 (V3 0 0 1) + , withSoundForI elecCrackleS 1 + , useAmmo 1 + ] + , _wpSpread = 0.001 + , _wpRange = 20 + , _itFloorPict = teslaGunPic + , _itAimingSpeed = 0.4 + , _itZoom = defaultItZoom + , _itAimingRange = 0 + , _itEquipPict = pictureWeaponOnAim teslaGunPic + } +teslaGunPic :: Item -> SPic +teslaGunPic _ = + ( colorSH blue $ + upperPrismPoly 5 (rectNESW xb y xa (-y)) + ++ upperPrismPoly 5 (rectNESW (-xa) y (-xb) (-y)) + , mempty + ) + where + xa = 1 + xb = 9 + y = 4 +lasGun :: Item +lasGun = defaultAutoGun + { _itName = "LASGUN ////" + , _itIdentity = LasGun + , _wpMaxAmmo = 200 + , _wpLoadedAmmo = 200 + , _wpReloadTime = 80 + , _wpReloadState = 0 + , _itUseRate = 0 + , _itUseTime = 0 + , _itUse = const aLaser + , _itUseModifiers = + [ ammoCheckI + , useTimeCheckI + , withTempLight 1 100 (V3 1 1 0) + , withSoundForI tone440sawtoothS 1 + , useAmmo 1 + ] + , _wpSpread = 0.001 + , _wpRange = 20 + , _itFloorPict = lasGunPic + , _itAimingSpeed = 0.4 + , _itAimingRange = 1 + , _itEquipPict = pictureWeaponOnAim lasGunPic + , _itAttachment = ItCharMode $ Seq.fromList "/VZ" + , _itScroll = scrollCharMode + , _itInvDisplay = basicWeaponDisplay + } +lasGunPic :: Item -> SPic +lasGunPic it = + ( colorSH blue $ + upperPrismPoly 4 (rectNESW 3 15 1 (-15)) + <> upperPrismPoly 4 (rectNESW (-1) 15 (-3) (-15)) + -- <> (upperPrismPoly 4 $ rectNESW (5) l (-5) (l-2)) + <> upperPrismPoly 1 (rectNESW 3 15 (-3) (-15)) + , setLayer 1 . color col . setDepth 1.1 . polygon $ rectNESW 1 15 (-1) (-15) + ) + where + amFrac = fractionLoadedAmmo it + col = brightX 2 1.5 $ mixColors amFrac (1-amFrac) green red + +tractorGun :: Item +tractorGun = defaultAutoGun + { _itName = "TRACTORGUN" + , _itIdentity = TractorGun + , _wpMaxAmmo = 10000 + , _wpLoadedAmmo = 10000 + , _wpReloadTime = 40 + , _wpReloadState = 0 + , _itUseRate = 0 + , _itUseTime = 0 + , _itUse = aTractorBeam + , _itUseModifiers = + [ ammoUseCheckI + ] + , _wpSpread = 0.00001 + , _wpRange = 20 + , _itFloorPict = tractorGunSPic + , _itAimingSpeed = 0.4 + , _itAimingRange = 0.5 + , _itEquipPict = pictureWeaponOnAim tractorGunSPic + } +-- TODO own picture for tractor gun +tractorGunSPic :: Item -> SPic +tractorGunSPic = lasGunPic + +aTeslaArc :: Creature -> World -> World +aTeslaArc cr w = set randGen g w + & particles %~ (makeTeslaArcAt col pos dir :) + where + pos = _crPos cr +.+ (_crRad cr +1) *.* unitVectorAtAngle dir + dir = _crDir cr + (colid,g) = randomR (0::Int,3) $ _randGen w + col = chooseColor colid + chooseColor 0 = white + chooseColor 1 = azure + chooseColor 2 = blue + chooseColor _ = cyan + +aLaser :: Creature -> World -> World +aLaser cr = particles %~ (makeLaserAt phaseV pos dir : ) + where + pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) + dir = _crDir cr + phaseV = charToPhaseV + $ fromMaybe '/' $ Seq.lookup 0 =<< cr ^? crInv . ix j . itAttachment . 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 -> Particle +makeLaserAt phaseV pos dir = Particle + { _ptDraw = const blank + , _ptUpdate = moveLaser phaseV pos dir + } +moveLaser + :: Float -- ^ Phase velocity, controls deflection through windows + -> Point2 + -> Float + -> World + -> Particle + -> (World, Maybe Particle) +moveLaser phaseV pos dir w pt + = ( hitEffect w + , Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 } + ) + where + xp = pos +.+ 800 *.* unitVectorAtAngle dir + reflectDir wall = argV (reflectIn (uncurry (-.-) (_wlLine wall)) (xp -.- pos)) + f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either Creature Wall),[Point2]) + f seenWs x y = case find (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of + Just (p,Right wl) + | _wlIsSeeThrough wl -> f' p $ f (wl:seenWs) p (h x y wl p) + | otherwise -> (Just (p,Right 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 $ uncurry (-.-) $ swap (_wlLine wl) + 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 = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl)) + wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl) + 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 (_,Right wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws + h' _ _ = True + (thHit, ps) = f [] pos xp + hitEffect + = case thHit of + Just (p,Left cr) + -> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 19 pos p xp) + Just (p,Right wl) -> colSpark 8 (V4 20 (-5) 0 1) (p +.+ safeNormalizeV (pos -.- p)) + (reflectDir wl) + _ -> id + pic = setLayer 1 $ pictures + [ setDepth 19 . color (brightX 0 0.5 yellow) $ lineOfThickness 20 (pos:ps) + , setDepth 19.5 . color (brightX 10 1 yellow) $ lineOfThickness 3 (pos:ps) + ] + +aTractorBeam :: Item -> Creature -> World -> World +aTractorBeam _ cr w = over props (IM.insert i (tractorBeamAt i spos outpos dir)) w + where + i = newProjectileKey w + cpos = _crPos cr + spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir + xpos = cpos +.+ 400 *.* unitVectorAtAngle dir + dir = _crDir cr + outpos = collidePointWalls cpos xpos + $ wallsAlongLine cpos xpos w + +tractorBeamAt :: Int -> Point2 -> Point2 -> Float -> Prop +tractorBeamAt i pos outpos dir = ProjectileTimed + { _pjPos = pos + , _pjStartPos = outpos + , _pjVel = d + , _prDraw = tractorSPic + , _pjID = i + , _pjUpdate = updateTractor + , _pjTime = 10 + } + where + d = unitVectorAtAngle dir + +{- | +The interaction of this with objects, walls etc needs more thought. -} +updateTractor :: Prop -> World -> World +updateTractor pj w + | _pjTime pj <= 0 = w & props %~ IM.delete i + | otherwise = w + & props . ix i . pjTime -~ 1 + & creatures %~ IM.map (tractCr pullVel pos outpos) + & floorItems %~ IM.map (tractFlIt pullVel pos outpos) + where + i = _pjID pj + pullVel = _pjVel pj + pos = _pjPos pj + outpos = _pjStartPos pj + +tractFlIt :: Point2 -> Point2 -> Point2 -> FloorItem -> FloorItem +tractFlIt q p1 outpos it + | circOnSeg p1 outpos (_flItPos it) 10 = it & flItPos %~ tractorPullPos q p1 + | otherwise = it + +tractCr :: Point2 -> Point2 -> Point2 -> Creature -> Creature +tractCr q p1 outpos cr + | circOnSeg p1 outpos (_crPos cr) 10 = cr & crPos %~ tractorPullPos q p1 + | otherwise = cr + +tractorPullPos :: Point2 -> Point2 -> Point2 -> Point2 +tractorPullPos q p1 p = p -.- m *.* (0.3/ x' *.* q +.+ g y *.* p4) + where + x' = abs y + 1 + y = errorClosestPointOnLineParam 1 p1 p3 p + m | dist p p1 < 350 = 1 + | otherwise = (400 - dist p p1) / 50 + g x | x > 5 = (10 - x) / 250 + | x > 1 = 0.02 + | x > -1 = x * 0.02 + | x > -5 = -0.02 + | otherwise = (x - 10) / 250 + --p4 = vNormal p5 + p4 = vNormal $ safeNormalizeV q + p3 = p1 +.+ p4 + +tractorSPic :: Prop -> SPic +tractorSPic pj = (,) mempty $ setLayer 1 $ setDepth 20 $ color (withAlpha 0.5 col) $ polygon + [ spos -- not sure if this is anticlockwise... + , spos +.+ size *.* (d +.+ n) + , xpos +.+ size *.* n + , xpos -.- size *.* n + , spos +.+ size *.* (d -.- n) + ] + where + size = fromIntegral (_pjTime pj) + spos = _pjPos pj + xpos = _pjStartPos pj + d = safeNormalizeV $ spos -.- xpos + n = vNormal d + col = mixColors 0.5 0.5 white blue diff --git a/src/Dodge/Item/Weapon/Bezier.hs b/src/Dodge/Item/Weapon/Bezier.hs index 9ef4ef3e3..bc3a0d969 100644 --- a/src/Dodge/Item/Weapon/Bezier.hs +++ b/src/Dodge/Item/Weapon/Bezier.hs @@ -1,12 +1,13 @@ module Dodge.Item.Weapon.Bezier - where + ( bezierGun + ) where import Dodge.Data import Dodge.Base import Dodge.Default.Weapon import Dodge.Item.Data import Dodge.Item.Draw import Dodge.Item.Weapon.Targeting -import Dodge.Item.Weapon.AutoGun +import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Weapon.TriggerType import Dodge.Item.Weapon.ExtraEffect import Dodge.Item.Attachment.Data @@ -16,10 +17,8 @@ import Dodge.Particle.Bullet.HitEffect import Dodge.WorldEvent.HitEffect import Dodge.RandomHelp import Dodge.SoundLogic.LoadSound ---import Picture import Geometry import ShapePicture ---import Shape import Data.Maybe import Control.Lens diff --git a/src/Dodge/Item/Weapon/Booster.hs b/src/Dodge/Item/Weapon/Booster.hs index 7bdc298f4..75a467cd4 100644 --- a/src/Dodge/Item/Weapon/Booster.hs +++ b/src/Dodge/Item/Weapon/Booster.hs @@ -1,15 +1,19 @@ module Dodge.Item.Weapon.Booster - where + ( boosterGun + ) where import Dodge.Data import Dodge.Base import Dodge.Zone import Dodge.Base.Collide +import Dodge.Default.Weapon +import Dodge.Item.Data import Geometry import qualified IntMapHelp as IM import Dodge.Picture.Layer import Picture import Dodge.Item.Attachment.Data import ShapePicture +import Shape import Data.Maybe import Control.Lens @@ -113,6 +117,25 @@ drawBoostShockwave pj = (,) mempty $ setLayer 1 $ onLayer UPtLayer $ pictures $ maxT :: Int maxT = 20 +boosterGun :: Item +boosterGun = defaultGun + { _itName = "BOOSTER" + , _itIdentity = Blinker + , _wpMaxAmmo = 100 + , _wpLoadedAmmo = 100 + , _wpReloadTime = 20 + , _wpReloadState = 0 + , _itUseRate = 0 + , _itUseTime = 0 + , _itUse = \_ -> boostSelf 10 + , _itLeftClickUse = Just $ boostSelfL 10 + , _wpSpread = 0.05 + , _wpRange = 20 + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] + , _itAimingSpeed = 1 + , _itAimingRange = 0 + , _itEffect = resetAttachmentID + } resetAttachmentID :: ItEffect resetAttachmentID = ItInvEffect f 0 where diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index 71005ad80..f154d6459 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -1,5 +1,8 @@ module Dodge.Item.Weapon.Bullet - where + ( basicBullet + , ltBullet + , hvBullet + ) where import Dodge.Data import Dodge.WorldEvent.HitEffect import Dodge.Particle.Bullet.HitEffect diff --git a/src/Dodge/Item/Weapon/BulletGuns.hs b/src/Dodge/Item/Weapon/BulletGuns.hs new file mode 100644 index 000000000..a2f53ed22 --- /dev/null +++ b/src/Dodge/Item/Weapon/BulletGuns.hs @@ -0,0 +1,452 @@ +module Dodge.Item.Weapon.BulletGuns + ( pistol + , autoGun + , multGun + , miniGun + , spreadGun + , ltAutoGun + , hvAutoGun + , autogunSpread + , autoGunPic + , longGun + ) + where +import Dodge.Data +import Dodge.Default.Weapon +import Dodge.Default +import Dodge.Item.Attachment +import Dodge.Item.Attachment.Data +import Dodge.Item.Weapon.ExtraEffect +import Dodge.Item.Weapon.InventoryDisplay +import Dodge.Item.Weapon.AmmoParams +import Dodge.Item.Data +import Dodge.Item.Draw +import Dodge.Item.Weapon.Bullet +import Dodge.Item.Weapon.TriggerType +import Dodge.SoundLogic.LoadSound +import Picture +import Geometry +import Geometry.Vector3D +import ShapePicture +import Shape + +import qualified Data.Sequence as Seq +import Control.Lens + +autoGun :: Item +autoGun = defaultAutoGun + { _itName = "AUTOGUN" + , _itIdentity = AutoGun + , _wpMaxAmmo = 30 + , _wpLoadedAmmo = 30 + , _wpReloadTime = 80 + , _wpReloadState = 0 + , _itUseRate = 5 + , _itUseTime = 0 + , _itUse = useAmmoParams + , _itUseModifiers = + [ ammoCheckI + , charFiringStratI + [('S', hammerCheckI) + ] + , useTimeCheckI + , charFiringStratI + [('M', torqueBefore 0.08) + ,('S', torqueBefore 0.05) + ] + , withSoundForI autoBS 5 + , useAmmo 1 + , withRandomDirI (autogunSpread/2) + , withMuzFlareI + , withSmoke 1 black 20 200 5 + ] + , _wpSpread = autogunSpread + , _wpRange = 20 + , _itFloorPict = autoGunPic + , _itAimingSpeed = 0.4 + , _itAimingRange = 1 + , _itZoom = defaultItZoom + , _itAimZoom = defaultItZoom {_itZoomFac = 1.5} + , _itEquipPict = pictureWeaponOnAim autoGunPic + , _itAttachment = ItCharMode $ Seq.fromList "MS" + , _itScroll = scrollCharMode + , _itInvDisplay = basicWeaponDisplay + , _wpAmmo = basicBullet + } +autoGunPic :: Item -> SPic +autoGunPic it = + ( colorSH red (prismPoly + (map (addZ 5) $ rectNESW 2 12 (-2) (-8)) + (map (addZ 0) $ rectNESW 4 12 (-4) (-12)) + ) + <> translateSHf 0 (-1) (rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW (negate $ 3 + 0.25 * x) 0 3 (-5)) + , mempty + ) + where + x = fromIntegral $ loadedAmmo it + + +pistol :: Item +pistol = defaultGun + { _itName = "PISTOL" + , _itIdentity = Pistol + , _wpMaxAmmo = 15 + , _wpLoadedAmmo = 15 + , _wpReloadTime = 40 + , _wpReloadState = 0 + , _itUseRate = 8 + , _itUseTime = 0 + , _itUse = useAmmoParams + , _itUseModifiers = + [ ammoCheckI + , hammerCheckI + , useTimeCheckI + , withSoundStart tap3S + , useAmmo 1 + , randSpreadDir + , withMuzFlareI + ] + , _itLeftClickUse = Nothing + , _wpSpread = 0.02 + , _wpRange = 20 + , _itFloorPict = pistolPic + , _itAimingSpeed = 1 + , _itAimingRange = 0 + , _itZoom = defaultItZoom + , _itEquipPict = pictureWeaponAim pistolPic + , _itID = Nothing + , _itInvDisplay = basicWeaponDisplay + , _itInvColor = white + , _itTargeting = Nothing + , _itWorldTrigger = Nothing + , _wpAmmo = basicBullet + } +pistolPic :: Item -> SPic +pistolPic it = + ( colorSH green (prismPoly + (map (addZ 3) $ rectNESW 3 3 (-3) (-3)) + (map (addZ 0) $ rectNESW 5 3 (-5) (-7)) + ) + <> translateSH (V3 (-4) 5.5 4) (rotateSH pi $ bulletClip am) + , mempty + ) + where + am = loadedAmmo it + +bulletClip :: Int -> Shape +bulletClip x = rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW 3 0 (3 - 0.25 * am) (-5) + where + am = fromIntegral x + +hvAutoGun :: Item +hvAutoGun = defaultAutoGun + { _itName = "AUTO-HV" + , _itIdentity = HvAutoGun + , _wpMaxAmmo = 100 + , _wpLoadedAmmo = 100 + , _wpReloadTime = 200 + , _wpReloadState = 0 + , _itUseRate = 25 + , _itUseTime = 0 + , _itUse = useAmmoParams + , _itUseModifiers = + [ ammoCheckI + , rateIncABI 24 7 (torqueBeforeAtLeast 0.1 0.1) (torqueAfterI 0.2) + , withSoundStart bangEchoS + , withThinSmokeI + , withMuzFlareI + ] + , _wpRange = 20 + , _itFloorPict = hvAutoGunPic + , _itAimingSpeed = 0.2 + , _itAimingRange = 1 + , _itEquipPict = pictureWeaponOnAim hvAutoGunPic + , _wpAmmo = hvBullet + } +hvAutoGunPic :: Item -> SPic +hvAutoGunPic it = + ( colorSH orange (prismPoly + (map (addZ 5) $ rectNESW 3 12 (-3) (-8)) + (map (addZ 0) $ rectNESW 5 12 (-5) (-12)) + ) + <> bulletClip am + , mempty + ) + where + am = loadedAmmo it +ltAutoGun :: Item +ltAutoGun = defaultAutoGun + { _itName = "AUTO-LT" + , _itIdentity = LtAutoGun + , _wpMaxAmmo = 25 + , _wpLoadedAmmo = 25 + , _wpReloadTime = 80 + , _wpReloadState = 0 + , _itUseRate = 3 + , _itUseTime = 0 + , _itUse = useAmmoParams + , _itUseModifiers = + [ ammoCheckI + , useTimeCheckI + , withSoundStart tap1S + , useAmmo 1 + , withRandomDirI 0.1 + , torqueAfterI 0.2 + , withSidePushI 50 + , modClock 2 withMuzFlareI + ] + , _wpSpread = 0.5 + , _wpRange = 20 + , _itFloorPict = ltAutoGunPic + , _itAimingSpeed = 1 + , _itAimingRange = 0 + , _itZoom = defaultItZoom + , _itEquipPict = pictureWeaponOnAim ltAutoGunPic + , _itAimStance = OneHand + , _wpAmmo = ltBullet + } + & itDimension . muzzleLength .~ 10 +ltAutoGunPic :: Item -> SPic +ltAutoGunPic it = + ( colorSH green $ prismPoly + (map (addZ 5) $ mirrorXAxis [V2 (-2) 3, V2 5 3, V2 10 0]) + (map (addZ 0) $ mirrorXAxis [V2 (-5) 5, V2 5 5, V2 10 0]) + <> bulletClip am + , mempty + ) + where + am = loadedAmmo it +miniGun :: Item +miniGun = defaultAutoGun + { _itName = "MINI-G" + , _itIdentity = MiniGun + , _wpMaxAmmo = 1500 + , _wpLoadedAmmo = 1500 + , _wpReloadTime = 200 + , _wpReloadState = 0 + , _wpMaxWarmUp = 100 + , _itUseRate = 0 + , _itUseTime = 0 + , _itUse = useAmmoParamsVelMod vm4 + , _itUseModifiers = + [ ammoCheckI + , withWarmUpI crankSlowS + , useTimeCheckI + --, afterRecoil recoilAmount + , withSoundForI mini1S 2 + --, withThinSmokeI + , torqueAfterI 0.05 + , withSidePushI 53 + , afterRecoil recoilAmount + , withRandomOffsetI 12 + , trigDoAlso (useAmmoParamsVelMod vm1) + --, torqueBeforeForcedI 0.001 + , withSidePushI 52 + , afterRecoil recoilAmount + , withRandomOffsetI 11 + , withOldDir od1 + , trigDoAlso (useAmmoParamsVelMod vm2) + --, torqueBeforeForcedI 0.001 + , withSidePushI 51 + , afterRecoil recoilAmount + , withRandomOffsetI 10 + , withOldDir od2 + , trigDoAlso (useAmmoParamsVelMod vm3) + , useAmmo 4 + --, torqueBeforeForcedI 0.001 + , withSidePushI 50 + , afterRecoil recoilAmount + , withRandomOffsetI 9 + , withMuzFlareI + , withOldDir od3 + , withSmoke 1 black 20 200 5 + ] + , _wpRange = 20 + , _itFloorPict = miniGunPictItem + , _itAimingSpeed = 0.4 + , _itAimingRange = 1 + , _itEquipPict = pictureWeaponAim miniGunPictItem + , _wpAmmo = basicBullet + } + where + recoilAmount = 5 + [vm1,vm2,vm3,vm4] = + [ 0.25 + , 0.5 + , 0.75 + , 1 + ] + [od1,od2,od3] = + [ 0.25, 0.5, 0.9] + --[ 0.75, 0.5, 0.25] + --[ 0, 0, 0] +miniGunPictItem :: Item -> SPic +miniGunPictItem it = miniGunPict spin (loadedAmmo it) + where + spin = (-10) * _wpLoadedAmmo it + _wpCurWarmUp it + +miniGunPict :: Int -> Int -> SPic +miniGunPict spin am = + ( colorSH red (rotateSHx a barrels) + <> colorSH red (upperPrismPoly 5 $ rectNESW 8 8 (-8) 4) + <> colorSH red (prismPoly + (map (addZ 5) $ rectNESW 2 12 (-2) (-12)) + (map (addZ 0) $ rectNESW 4 12 (-4) (-16)) + ) + <> clip (-1) 0 + <> clip (-7) 0 + , mempty + ) + where + aBarrel = translateSH (V3 7 0 9) $ prismPoly + (map (addZ 5) $ rectNESW 2 12 (-2) (-1)) + (map (addZ 0) $ rectNESW 4 12 (-4) (-5)) + barrels = concatMap (\an -> aBarrel & rotateSHx an) [0,0.5* pi, pi, 1.5*pi] + a = fromIntegral spin / 100 + x = fromIntegral am / 10 + clip y z = translateSH (V3 0 (-1) z) (rotateSHx (negate $ pi/4) + . upperPrismPoly 2 + $ rectNESW (negate $ 3 + 0.25 * x) y 3 (y-5)) +spreadGun :: Item +spreadGun = defaultGun + { _itName = "SPREAD" + , _itIdentity = SpreadGun + , _wpMaxAmmo = 5 + , _wpLoadedAmmo = 5 + , _wpReloadTime = 80 + , _wpReloadState = 0 + , _itUseRate = 20 + , _itUseTime = 0 + --, _itUse = \_ -> spreadNumVelWthHiteff spreadGunSpread 9 (V2 30 0) 2 basicBulletEffect + , _itUse = useAmmoParams + , _itUseModifiers = + [ ammoCheckI + , hammerCheckI + , useTimeCheckI + , withSoundStart shotgunS + , useAmmo 1 + , withRecoilI 100 + , withMuzFlareI + , spreadNumI + ] + , _wpSpread = spreadGunSpread + , _wpRange = 20 + , _itFloorPict = spreadGunPic + , _itAimingSpeed = 1 + , _itAimingRange = 0 + , _itEquipPict = pictureWeaponOnAim spreadGunPic + , _wpAmmo = basicBullet + , _wpNumBarrels = 50 + } +spreadGunPic :: Item -> SPic +spreadGunPic it = + ( colorSH green (upperPrismPoly 5 $ map toV2[(-3,0),(3,6),(3,-6)]) + <> bulletClip am + , mempty + ) + where + am = loadedAmmo it +multGun :: Item +multGun = defaultGun + { _itName = "MULTGUN" + , _itIdentity = MultGun + , _wpMaxAmmo = 2 + , _wpLoadedAmmo = 2 + , _wpReloadTime = 40 + , _wpReloadState = 0 + , _itUseRate = 20 + , _itUseTime = 0 + , _itUse = useAmmoParams + , _itUseModifiers = + [ ammoCheckI + , hammerCheckI + , useTimeCheckI + , withSoundStart shotgunS + , useAmmo 1 + , withRecoilI 200 + , withMuzFlareI + , numI + ] + , _wpSpread = spreadGunSpread + , _wpRange = 20 + , _itFloorPict = multGunSPic + , _itAimingSpeed = 0.4 + , _itAimingRange = 1 + , _itZoom = defaultItZoom + , _itAimZoom = defaultItZoom {_itZoomFac = 1.5} + , _itEquipPict = pictureWeaponOnAim multGunSPic + , _itAimStance = TwoHandTwist + , _wpAmmo = basicBullet + , _wpNumBarrels = 5 + } +multGunSPic :: Item -> SPic +multGunSPic it = + ( colorSH red ( + upperPrismPoly 2 (rectNESW 4 8 (-4) (-12)) <> + translateSHf 8 0 (concatMap barrel [12,7,2,-3,-8] <> + upperPrismPoly 2 (map toV2 [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)]) + ) + ) <> bulletClip am + , mempty + ) + where + barrel y = prismPoly + (map (addZ 5) $ rectNSEW y (y-4) 2 0 ) + (map (addZ 0) $ rectNSEW y (y-4) 2 (-2)) + am = loadedAmmo it +longGun :: Item +longGun = defaultGun + { _itName = "LONGGUN" + , _itIdentity = LongGun + , _wpMaxAmmo = 1 + , _wpLoadedAmmo = 1 + , _wpReloadTime = 100 + , _wpReloadState = 0 + , _wpReloadType = PassiveReload skwareFadeTwoSecS + , _itUseRate = 100 + , _itUseTime = 0 + , _itUse = useAmmoParams + , _itUseModifiers = + [ ammoCheckI + , hammerCheckI + , useTimeCheckI + , withSoundStart bangEchoS + , useAmmo 1 + , withThickSmokeI + , torqueAfterI 0.05 + , withMuzFlareI + ] + , _wpRange = 200 + , _itFloorPict = longGunSPic + , _itAimingSpeed = 0.2 + , _itAimingRange = 1 + , _itZoom = defaultItZoom + , _itAimZoom = defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5} + , _itEquipPict = pictureWeaponOnAim longGunSPic + , _itScroll = zoomLongGun + , _itAttachment = ItScope (V2 0 0) 0 1 False + , _itEffect = itemLaserScopeEffect + , _wpAmmo = hvBullet + , _itAimStance = TwoHandTwist + } +longGunSPic :: Item -> SPic +longGunSPic _ = + ( colorSH orange $ upperPrismPoly 5 $ rectWH 12 2 + , mempty + ) + +zoomLongGun :: Float -> Creature -> Item -> Item +zoomLongGun x _ + | x > 0 = startZoomInLongGun + | x < 0 = startZoomOutLongGun + | otherwise = id + +startZoomInLongGun :: Item -> Item +startZoomInLongGun = itAttachment . scopeZoomChange %~ \x -> max 5 (x + 5) +startZoomOutLongGun :: Item -> Item +startZoomOutLongGun = itAttachment . scopeZoomChange %~ \x -> min (-5) (x-5) + +spreadGunSpread :: Float +spreadGunSpread = 0.5 +autogunSpread :: Float +autogunSpread = 0.07 diff --git a/src/Dodge/Item/Weapon/Decoration.hs b/src/Dodge/Item/Weapon/Decoration.hs index 829c3d4db..60006cf74 100644 --- a/src/Dodge/Item/Weapon/Decoration.hs +++ b/src/Dodge/Item/Weapon/Decoration.hs @@ -2,7 +2,8 @@ Particles and pictures that decorate weapons, such as laser scopes etc. -} module Dodge.Item.Weapon.Decoration - where + ( makeLaserScope + ) where import Dodge.Data import Dodge.Picture.Layer import Dodge.Picture @@ -26,4 +27,3 @@ makeLaserScope p ep relFrac = Particle where lineAlphaThick a w = color (withAlpha a $ mixColors relFrac (1-relFrac) red green) $ lineOfThickness w [p,ep] - diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index a39ee009a..4e45df9a6 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -3,13 +3,18 @@ Extra weapon effects, supplementing explicit use effects. -} module Dodge.Item.Weapon.ExtraEffect - where + ( wpRecock + , itemLaserScopeEffect + , autoSonarEffect + , autoRadarEffect + , rbSetTarget + ) where import Dodge.Data import Dodge.Base import Dodge.Item.Data import Dodge.Item.Weapon.Decoration import Dodge.Item.Weapon.UseEffect -import Dodge.Item.Attachment.Data +--import Dodge.Item.Attachment.Data import Dodge.WorldEvent.ThingsHit import Dodge.Picture.Layer import Dodge.Creature.Test @@ -36,19 +41,19 @@ wpRecock = ItInvEffect moveHammerUp HammerUp = HammerUp moveHammerUp NoHammer = NoHammer fOnIt it = it & itHammer %~ moveHammerUp -{- | -Special recock for the bezier gun. -Not sure of its purpose at this time... -} -bezierRecock :: ItEffect -bezierRecock = ItInvEffect - {_itInvEffect = f - ,_itEffectCounter = 0 - } - where - f _ cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i - fOnIt it = case _itHammer it of - HammerDown -> it & itHammer .~ HammerUp - _ -> it & itAttachment .~ NoItAttachment +--{- | +--Special recock for the bezier gun. +--Not sure of its purpose at this time... -} +--bezierRecock :: ItEffect +--bezierRecock = ItInvEffect +-- {_itInvEffect = f +-- ,_itEffectCounter = 0 +-- } +-- where +-- f _ cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i +-- fOnIt it = case _itHammer it of +-- HammerDown -> it & itHammer .~ HammerUp +-- _ -> it & itAttachment .~ NoItAttachment {- | Creates a laser scope and recocks the weapon. TODO add the laser scope! diff --git a/src/Dodge/Item/Weapon/Grenade.hs b/src/Dodge/Item/Weapon/Grenade.hs index 9b6a7e80a..d07f3157e 100644 --- a/src/Dodge/Item/Weapon/Grenade.hs +++ b/src/Dodge/Item/Weapon/Grenade.hs @@ -1,14 +1,22 @@ module Dodge.Item.Weapon.Grenade - where + ( grenade + ) where import Dodge.Data import Dodge.Data.SoundOrigin import Dodge.Item.Data +import Dodge.Picture.Layer +import Dodge.WorldEvent.Explosion +import Dodge.Item.Weapon.TriggerType +import Dodge.Default import Dodge.Base import Dodge.Zone import Dodge.SoundLogic import Dodge.SoundLogic.LoadSound import Dodge.Item.Attachment.Data import Dodge.Item.Draw +import Dodge.Item.Weapon.InventoryDisplay +import Dodge.Item.Weapon.ExtraEffect +import Dodge.Item.Attachment import Picture import Geometry import ShapePicture @@ -17,6 +25,39 @@ import Shape import Control.Lens import qualified Data.IntMap.Strict as IM +grenade :: Item +grenade = Throwable + { _itName = "GRENADE " ++ show fuseTime + , _itIdentity = Grenade + , _itMaxStack = 8 + , _itAmount = 1 + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] + , _twMaxRange = 150 + , _twAccuracy = 30 + , _itUse = \_ -> throwGrenade makeExplosionAt + , _itUseModifiers = + [ useTimeCheckI + ] + , _itAimingSpeed = 1 + , _itAimingRange = 0 + , _itZoom = defaultItZoom + , _itAimZoom = defaultItZoom {_itZoomMax = f fuseTime, _itZoomMin = f fuseTime} + , _itEquipPict = pictureWeaponOnAim $ \_ -> grenadePic fuseTime + , _itID = Nothing + , _itUseRate = 25 + , _itUseTime = 0 + , _itAttachment = ItFuse fuseTime + , _itInvColor = white + , _itInvDisplay = basicWeaponDisplay + , _itEffect = wpRecock + , _itHammer = HammerUp + , _itScroll = changeFuse + , _itAimStance = OneHand + } + where + fuseTime = 50 + f x = 50 / fromIntegral x + moveGrenade :: Prop -> World -> World moveGrenade pj w | _pjTimer pj <= 0 = w @@ -43,8 +84,6 @@ grenadePic time = [ color green $ arc (degToRad $ (179 * fromIntegral time / 50) - 180 ) (degToRad $ 180 - (179 * fromIntegral time / 50) ) 5 --- , translate (-2) 2 $ rotate (pi*0.5) --- $ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot time 20 ] ) @@ -77,8 +116,6 @@ throwGrenade thePayload cr w = setWp $ removePict $ over props addG w j = _crInvSel cr removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> (,) emptySH blank i = newProjectileKey w - --(_, 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' @@ -99,3 +136,19 @@ throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x } & itHammer .~ HammerUp & itEquipPict .~ pictureWeaponOnAim (\_ -> grenadePic 50) | otherwise = it & itEffect . itEffectCounter -~ 1 + +--flameGrenade :: Item +--flameGrenade = grenade { +-- _itName = "FLMGREN " ++ show fuseTime +-- , _itUse = \_ -> throwGrenade makeFlameExplosionAt +-- } +-- where +-- fuseTime = 50 :: Int +-- +--teslaGrenade :: Item +--teslaGrenade = grenade { +-- _itName = "TLSGREN " ++ show fuseTime +-- , _itUse = \_ -> throwGrenade makeTeslaExplosionAt +-- } +-- where +-- fuseTime = 50 :: Int diff --git a/src/Dodge/Item/Weapon/InventoryDisplay.hs b/src/Dodge/Item/Weapon/InventoryDisplay.hs index 3ea0b4369..d76b6eda9 100644 --- a/src/Dodge/Item/Weapon/InventoryDisplay.hs +++ b/src/Dodge/Item/Weapon/InventoryDisplay.hs @@ -2,15 +2,14 @@ Display of weapon strings in the inventory. -} module Dodge.Item.Weapon.InventoryDisplay - where + ( basicWeaponDisplay + ) where import Dodge.Data ---import Dodge.Base import Dodge.Item.Attachment.Data import Padding import Data.Sequence import Control.Lens ---import Control.Monad {- | Displays the item name, ammo if loaded, and any selected '_itCharMode'. -} basicWeaponDisplay :: Item -> String basicWeaponDisplay it = case it ^? itAttachment of @@ -18,7 +17,6 @@ basicWeaponDisplay it = case it ^? itAttachment of Just ItMode {_itMode = i} -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) ++ show i _ -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) where - --availableAmmo = show $ _wpMaxAmmo it aIfLoaded = case it ^? wpReloadState of Just 0 -> show $ _wpLoadedAmmo it Just x -> "R" ++ show x diff --git a/src/Dodge/Item/Weapon/Laser.hs b/src/Dodge/Item/Weapon/Laser.hs deleted file mode 100644 index 4c4ff1af6..000000000 --- a/src/Dodge/Item/Weapon/Laser.hs +++ /dev/null @@ -1,122 +0,0 @@ -{- | Laser effects -} -module Dodge.Item.Weapon.Laser - where -import Dodge.Data -import Dodge.Data.DamageType -import Dodge.Picture ---import Dodge.Picture.Layer -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 Dodge.Creature.State.Data -import Geometry -import Picture - -import Control.Lens -import System.Random -import Data.Tuple -import Data.List (find) -import Data.Maybe (fromMaybe) -import qualified Data.Sequence as Seq ---import qualified Data.IntMap.Strict as IM - -aLaser :: Creature -> World -> World -aLaser cr = particles %~ (makeLaserAt phaseV pos dir : ) - where - pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) - dir = _crDir cr - phaseV = charToPhaseV - $ fromMaybe '/' $ Seq.lookup 0 =<< cr ^? crInv . ix j . itAttachment . 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 -> Particle -makeLaserAt phaseV pos dir = Particle - { _ptDraw = const blank - , _ptUpdate = moveLaser phaseV pos dir - } - -moveLaser - :: Float -- ^ Phase velocity, controls deflection through windows - -> Point2 - -> Float - -> World - -> Particle - -> (World, Maybe Particle) -moveLaser phaseV pos dir w pt - = ( set randGen g $ hitEffect w - , Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 } - ) - where - xp = pos +.+ 800 *.* unitVectorAtAngle dir - (a,g) = randomR (-0.7,0.7) $ _randGen w - reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (xp -.- pos)) - f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either Creature Wall),[Point2]) - f seenWs x y = case find (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of - Just (p,Right wl) - | _wlIsSeeThrough wl -> f' p $ f (wl:seenWs) p (h x y wl p) - | otherwise -> (Just (p,Right 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 $ uncurry (-.-) $ swap (_wlLine wl) - 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 = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl)) - wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl) - 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 (_,Right wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws - h' _ _ = True - (thHit, ps) = f [] pos xp - hitEffect - = case thHit of - Just (p,Left cr) - -> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 19 pos p xp) - Just (p,Right wl) -> createSparkCol 8 (V4 20 (-5) 0 1) (p +.+ safeNormalizeV (pos -.- p)) - (reflectDir wl) - _ -> id - pic = setLayer 1 $ pictures - [ setDepth 19 . color (brightX 0 0.5 yellow) $ lineOfThickness 20 (pos:ps) - , setDepth 19.5 . color (brightX 10 1 yellow) $ lineOfThickness 3 (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/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index 5f03ebc3a..ccddf84e1 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -1,5 +1,7 @@ module Dodge.Item.Weapon.Launcher - where + ( launcher + , remoteLauncher + ) where import Dodge.Data import Dodge.Data.SoundOrigin import Dodge.Default.Weapon @@ -132,12 +134,12 @@ doThrust pj w = w r1 = randInCirc 10 & evalState $ _randGen w smokeGen = shellTrailCloud $ addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)) -flameLauncher :: Item -flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt -poisonLauncher :: Item -poisonLauncher = launcher & wpAmmo . amPayload .~ makePoisonExplosionAt -teslaLauncher :: Item -teslaLauncher = launcher & wpAmmo . amPayload .~ makeTeslaExplosionAt +--flameLauncher :: Item +--flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt +--poisonLauncher :: Item +--poisonLauncher = launcher & wpAmmo . amPayload .~ makePoisonExplosionAt +--teslaLauncher :: Item +--teslaLauncher = launcher & wpAmmo . amPayload .~ makeTeslaExplosionAt aRocketWithItemParams :: Item -- ^ Firing item diff --git a/src/Dodge/Item/Weapon/Remote.hs b/src/Dodge/Item/Weapon/Remote.hs index d0a90af32..17fc29408 100644 --- a/src/Dodge/Item/Weapon/Remote.hs +++ b/src/Dodge/Item/Weapon/Remote.hs @@ -1,5 +1,6 @@ module Dodge.Item.Weapon.Remote - where + ( pointToItem + ) where import Dodge.Data import Control.Lens diff --git a/src/Dodge/Item/Weapon/Shell.hs b/src/Dodge/Item/Weapon/Shell.hs index 716f88112..aa3bf17c8 100644 --- a/src/Dodge/Item/Weapon/Shell.hs +++ b/src/Dodge/Item/Weapon/Shell.hs @@ -1,4 +1,6 @@ module Dodge.Item.Weapon.Shell + ( decTimMvVel + ) where import Dodge.Data import Geometry.Vector diff --git a/src/Dodge/Item/Weapon/SprayGuns.hs b/src/Dodge/Item/Weapon/SprayGuns.hs new file mode 100644 index 000000000..5c48f9096 --- /dev/null +++ b/src/Dodge/Item/Weapon/SprayGuns.hs @@ -0,0 +1,119 @@ +module Dodge.Item.Weapon.SprayGuns + ( poisonSprayer + , flamer + ) + where +import Dodge.Data +--import Dodge.Data.SoundOrigin +--import Dodge.Base +--import Dodge.Zone +--import Dodge.Picture.Layer +--import Dodge.SoundLogic +import Dodge.SoundLogic.LoadSound +--import Dodge.Creature.Action +import Dodge.WorldEvent +import Dodge.Default +import Dodge.Item.Draw +import Dodge.Item.Data +--import Dodge.Item.Weapon.BulletGuns +--import Dodge.Item.Weapon.InventoryDisplay +import Dodge.Item.Weapon.TriggerType +--import Dodge.Item.Weapon.ExtraEffect +--import Dodge.Item.Weapon.UseEffect +import Dodge.Item.Weapon.AmmoParams +import Dodge.Item.Attachment.Data +import Dodge.Default.Weapon +--import Dodge.Item.Attachment +import Geometry +--import Geometry.Vector3D +import Picture +import Shape +import ShapePicture + +import Data.Function +import Control.Lens +import System.Random +poisonSprayer :: Item +poisonSprayer = defaultAutoGun + { _itName = "POISON" + , _itIdentity = PoisonSprayer + , _wpMaxAmmo = 500 + , _wpLoadedAmmo = 500 + , _wpReloadTime = 100 + , _wpReloadState = 0 + , _itUseRate = 0 + , _itUseTime = 0 + , _itUse = const aGasCloud + , _itUseModifiers = + [ ammoCheckI + , useTimeCheckI + , withSoundForI foamSprayLoopS 5 + , useAmmo 1 + , spreadNumI + ] + , _wpRange = 8 + , _itFloorPict = flamerPic + , _itAimingSpeed = 0.2 + , _itAimingRange = 0 + , _itZoom = defaultItZoom + , _itEquipPict = pictureWeaponOnAim flamerPic + , _wpSpread = 0.1 + , _wpNumBarrels = 3 + } +flamer :: Item +flamer = defaultAutoGun + { _itName = "FLAMER" + , _itIdentity = Flamethrower + , _wpMaxAmmo = 250 + , _wpLoadedAmmo = 250 + , _wpReloadTime = 100 + , _wpReloadState = 0 + , _itUseRate = 0 + , _itUseTime = 0 + , _itUse = \_ -> randWalkAngle 0.2 0.01 aFlame + , _itUseModifiers = + [ ammoUseCheckI + , withSidePushI 5 + --, withTempLight 1 100 (V3 1 0 0) + , withSidePushAfterI 20 + ] + , _wpSpread = 0 + , _wpRange = 8 + , _itFloorPict = flamerPic + , _itAimingSpeed = 0.5 + , _itAimingRange = 0 + , _itZoom = defaultItZoom + , _itAimZoom = defaultItZoom {_itZoomMax = 5, _itZoomMin = 1.5} + , _itEquipPict = pictureWeaponOnAim flamerPic + , _itAttachment = NoItAttachment + } +flamerPic :: Item -> SPic +flamerPic it = + ( colorSH yellow $ + translateSHf tx ty (upperPrismPoly tz $ polyCirc 3 r) + ++ upperPrismPoly 5 (rectNESW 2 9 (-2) (-9)) + , color black $ translate3 (V3 tx ty (tz+0.01)) $ circleSolid (r * am) + ) + where + tx = - 5 + ty = - 6 + tz = 3 + r = 5 + am = fractionLoadedAmmo2 it +aGasCloud :: Creature -> World -> World +aGasCloud cr w = insertCloud $ set randGen g w + where + (a,g) = randomR (-0.1,0.1) (_randGen w) + dir = _crDir cr + a + pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) + vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* unitVectorAtAngle dir + insertCloud = makeGasCloud pos vel + +aFlame :: Creature -> World -> World +aFlame cr w = w & particles %~ (aFlameParticle t pos vel (Just cid) :) + where + (t,_) = randomR (99,101) (_randGen w) + cid = _crID cr + dir = _crDir cr + pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) + vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 5550f086b..0152ef2f1 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -6,7 +6,6 @@ module Dodge.Item.Weapon.TriggerType , withOldDir , trigDoAlso , withTempLight - --, withVelWthHiteff , ammoUseCheckI , rateIncABI , torqueBefore @@ -42,8 +41,6 @@ import Dodge.Data.SoundOrigin import Dodge.SoundLogic import Dodge.Creature.Action (startReloadingWeapon) import Dodge.WorldEvent ---import Dodge.WorldEvent.Flash ---import Dodge.WorldEvent.Cloud import Dodge.RandomHelp import Dodge.Item.Attachment.Data import Dodge.Item.Data @@ -51,7 +48,6 @@ import Dodge.Default import Sound.Data import Geometry import Geometry.Vector3D ---import Color import System.Random import Control.Lens @@ -60,8 +56,8 @@ import Data.Maybe import qualified Data.IntMap.Strict as IM import Data.Foldable -type ChainEffect = - (Item -> Creature -> World -> World) +type ChainEffect + = (Item -> Creature -> World -> World) -> Item -> Creature -> World @@ -74,8 +70,7 @@ trigDoAlso trigDoAlso afterEff eff item cr = afterEff item cr . eff item cr withSmoke :: Int -> Point4 -> Float -> Int -> Float -> ChainEffect -withSmoke num col rad t alt eff item cr w - = eff item cr +withSmoke num col rad t alt eff item cr w = eff item cr $ foldl' (flip $ smokeCloudAt col rad t alt . (+.+.+ pos) . (*8)) w ps where dir = _crDir cr @@ -83,14 +78,16 @@ withSmoke num col rad t alt eff item cr w ps = replicateM num randOnUnitSphere & evalState $ _randGen w withThinSmokeI :: ChainEffect -withThinSmokeI eff item cr w = eff item cr $ foldl' (flip $ makeThinSmokeAt . (+.+.+ pos) . (* 8)) w ps +withThinSmokeI eff item cr w = eff item cr + $ foldl' (flip $ makeThinSmokeAt . (+.+.+ pos) . (* 8)) w ps where dir = _crDir cr pos = addZ 0 $ _crPos cr +.+ (_crRad cr +0.5) *.* unitVectorAtAngle dir ps = replicateM 5 randOnUnitSphere & evalState $ _randGen w withThickSmokeI :: ChainEffect -withThickSmokeI eff item cr w = eff item cr $ foldl' (flip $ makeThickSmokeAt . (+.+.+ pos) . (*8)) w ps +withThickSmokeI eff item cr w = eff item cr + $ foldl' (flip $ makeThickSmokeAt . (+.+.+ pos) . (*8)) w ps where dir = _crDir cr pos = addZ 0 $ _crPos cr +.+ (_crRad cr + 15) *.* unitVectorAtAngle dir @@ -130,10 +127,8 @@ rateIncABI startRate fastRate exeffFirst exeffCont eff item cr w itRef = _crInvSel cr pointItem = creatures . ix cid . crInv . ix itRef currentRate = _itUseRate item - repeatFire = _wpReloadState item == 0 - && _itUseTime item == 1 - firstFire = _wpReloadState item == 0 - && _itUseTime item == 0 + repeatFire = _wpReloadState item == 0 && _itUseTime item == 1 + firstFire = _wpReloadState item == 0 && _itUseTime item == 0 {- | Apply effect after a warm up. -} withWarmUpI :: SoundID -- ^ warm up sound id @@ -159,7 +154,6 @@ withSoundStart -> ChainEffect withSoundStart soundid f item cr = soundMultiFrom [CrWeaponSound cid 0,CrWeaponSound cid 1,CrWeaponSound cid 2] (_crPos cr) soundid Nothing --- = soundStart (CrWeaponSound cid 0) (_crPos cr) soundid Nothing . f item cr where cid = _crID cr @@ -173,7 +167,6 @@ withSoundContinue soundid f item cr . f item cr where cid = _crID cr - {- | Adds a sound to a creature based world effect. The sound is emitted from the creature's position. -} withSoundForI @@ -203,9 +196,9 @@ Applied before the underlying effect. -} withSidePushI :: Float -- ^ Maximal possible side push amount -> ChainEffect -withSidePushI maxSide eff item cr w = eff item (push cr) $ - w & creatures . ix cid %~ push - & randGen .~ g +withSidePushI maxSide eff item cr w = eff item (push cr) $ w + & creatures . ix cid %~ push + & randGen .~ g where cid = _crID cr push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr))) @@ -216,8 +209,8 @@ Applied after the underlying effect. -} withSidePushAfterI :: Float -- ^ Maximal possible side push amount -> ChainEffect -withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff item cr $ - w & randGen .~ g +withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff item cr $ w + & randGen .~ g where cid = _crID cr push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr))) @@ -225,8 +218,8 @@ withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff useAmmo :: Int -- ^ amount of ammo to use -> ChainEffect -useAmmo amAmount eff item cr = eff item cr . - (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . wpLoadedAmmo -~ amAmount) +useAmmo amAmount eff item cr = eff item cr + . (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . wpLoadedAmmo -~ amAmount) {- | Applies a world effect after an item use cooldown check. -} useTimeCheckI :: ChainEffect @@ -314,8 +307,7 @@ modClock n chainEff eff it cr w | otherwise = eff it cr w withMuzFlareI :: ChainEffect -withMuzFlareI f it cr w = - makeTLight 3 100 (V3 1 1 0.5) flashPos +withMuzFlareI f it cr w = makeTLight 3 100 (V3 1 1 0.5) flashPos . muzFlareAt (V4 5 5 0 2) flarePos dir $ f it cr w where @@ -324,7 +316,6 @@ withMuzFlareI f it cr w = flashPos = addZ 35 $ _crPos cr +.+ (2.5 * _crRad cr) *.* unitVectorAtAngle dir dir = _crDir cr itLength = _muzzleLength $ _itDimension it - {- | Applies the effect to a randomly rotated creature, - rotation amount given by wpSpread -} randSpreadDir :: ChainEffect @@ -332,7 +323,6 @@ randSpreadDir f it cr w = f it (cr & crDir +~ a) $ set randGen g w where acc = _wpSpread it (a, g) = randomR (-acc,acc) $ _randGen w - {- | Applies the effect to a randomly rotated creature. -} withRandomDirI :: Float -- ^ Max possible rotation diff --git a/src/Dodge/Item/Weapon/UseEffect.hs b/src/Dodge/Item/Weapon/UseEffect.hs index 6b9909f4b..0e505e2a3 100644 --- a/src/Dodge/Item/Weapon/UseEffect.hs +++ b/src/Dodge/Item/Weapon/UseEffect.hs @@ -4,15 +4,9 @@ These are typically item effects, and typical occur when an item is explictly us module Dodge.Item.Weapon.UseEffect where import Dodge.Data -import Dodge.Base import Dodge.Zone import Dodge.Picture.Layer ---import Dodge.Item.Weapon.Decoration ---import Dodge.Item.Weapon.TriggerType ---import Dodge.WorldEvent.Flash ---import Dodge.WorldEvent.ThingsHit import Picture -import ShapePicture import Geometry import Data.Maybe @@ -105,84 +99,4 @@ mvRadar x p w pt = | otherwise = fromIntegral x / 10 --colHelper y = color (withAlpha (y * globalAlpha) red) -aTractorBeam :: Item -> Creature -> World -> World -aTractorBeam _ cr w = over props (IM.insert i (tractorBeamAt i spos outpos dir)) w - where - i = newProjectileKey w - cpos = _crPos cr - spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir - xpos = cpos +.+ 400 *.* unitVectorAtAngle dir - dir = _crDir cr - outpos = collidePointWalls cpos xpos - $ wallsAlongLine cpos xpos w - -tractorBeamAt :: Int -> Point2 -> Point2 -> Float -> Prop -tractorBeamAt i pos outpos dir = ProjectileTimed - { _pjPos = pos - , _pjStartPos = outpos - , _pjVel = d - , _prDraw = tractorSPic - , _pjID = i - , _pjUpdate = updateTractor - , _pjTime = 10 - } - where - d = unitVectorAtAngle dir - -{- | -The interaction of this with objects, walls etc needs more thought. -} -updateTractor :: Prop -> World -> World -updateTractor pj w - | _pjTime pj <= 0 = w & props %~ IM.delete i - | otherwise = w - & props . ix i . pjTime -~ 1 - & creatures %~ IM.map (tractCr pullVel pos outpos) - & floorItems %~ IM.map (tractFlIt pullVel pos outpos) - where - i = _pjID pj - pullVel = _pjVel pj - pos = _pjPos pj - outpos = _pjStartPos pj - -tractFlIt :: Point2 -> Point2 -> Point2 -> FloorItem -> FloorItem -tractFlIt q p1 outpos it - | circOnSeg p1 outpos (_flItPos it) 10 = it & flItPos %~ tractorPullPos q p1 - | otherwise = it - -tractCr :: Point2 -> Point2 -> Point2 -> Creature -> Creature -tractCr q p1 outpos cr - | circOnSeg p1 outpos (_crPos cr) 10 = cr & crPos %~ tractorPullPos q p1 - | otherwise = cr - -tractorPullPos :: Point2 -> Point2 -> Point2 -> Point2 -tractorPullPos q p1 p = p -.- m *.* (0.3/ x' *.* q +.+ g y *.* p4) - where - x' = abs y + 1 - y = errorClosestPointOnLineParam 1 p1 p3 p - m | dist p p1 < 350 = 1 - | otherwise = (400 - dist p p1) / 50 - g x | x > 5 = (10 - x) / 250 - | x > 1 = 0.02 - | x > -1 = x * 0.02 - | x > -5 = -0.02 - | otherwise = (x - 10) / 250 - --p4 = vNormal p5 - p4 = vNormal $ safeNormalizeV q - p3 = p1 +.+ p4 - -tractorSPic :: Prop -> SPic -tractorSPic pj = (,) mempty $ setLayer 1 $ setDepth 20 $ color (withAlpha 0.5 col) $ polygon - [ spos -- not sure if this is anticlockwise... - , spos +.+ size *.* (d +.+ n) - , xpos +.+ size *.* n - , xpos -.- size *.* n - , spos +.+ size *.* (d -.- n) - ] - where - size = fromIntegral (_pjTime pj) - spos = _pjPos pj - xpos = _pjStartPos pj - d = safeNormalizeV $ spos -.- xpos - n = vNormal d - col = mixColors 0.5 0.5 white blue diff --git a/src/Dodge/Layout/Generate.hs b/src/Dodge/Layout/Generate.hs index cfc65f96a..7bb70f21b 100644 --- a/src/Dodge/Layout/Generate.hs +++ b/src/Dodge/Layout/Generate.hs @@ -21,5 +21,3 @@ randomTreeStructure = undefined treeMaxDepthFromTrunk :: Int -> Int -> State g (Tree ()) treeMaxDepthFromTrunk = do undefined - - diff --git a/src/Dodge/Layout/Tree/GenerateStructure.hs b/src/Dodge/Layout/Tree/GenerateStructure.hs index e4999aba5..ad734ef52 100644 --- a/src/Dodge/Layout/Tree/GenerateStructure.hs +++ b/src/Dodge/Layout/Tree/GenerateStructure.hs @@ -44,4 +44,3 @@ aTreeStrut = do bs <- replicateM nbs smallBranch let trunk = treePath d return $ foldr (uncurry addBranchAt) trunk $ zip bds bs - diff --git a/src/Dodge/Layout/Tree/Polymorphic.hs b/src/Dodge/Layout/Tree/Polymorphic.hs index 52adf3504..cc885107f 100644 --- a/src/Dodge/Layout/Tree/Polymorphic.hs +++ b/src/Dodge/Layout/Tree/Polymorphic.hs @@ -8,6 +8,13 @@ For example, in the tree the nodes in the trunk are [a,b] (note that d is not the first child of b). -} module Dodge.Layout.Tree.Polymorphic + ( applyToRoot + , treeFromPost + , treeFromTrunk + , splitTrunk + , applyToRandomNode + , addToTrunk + ) where import Dodge.RandomHelp @@ -40,9 +47,10 @@ Applies a function to the root of a tree. applyToRoot :: (a -> a) -> Tree a -> Tree a applyToRoot f (Node t ts) = Node (f t) ts --- | Consider defining this using generalised recursion patterns -treeSize :: Tree a -> Int -treeSize = length . flatten +-- find use for? +---- | Consider defining this using generalised recursion patterns +--treeSize :: Tree a -> Int +--treeSize = length . flatten {- | Applies a function to a specific node determined by a list of indices. @@ -54,17 +62,19 @@ applyToNode (i:is) f (Node x xs) = Node x (ys ++ [applyToNode is f z] ++ zs) where (ys, z:zs) = splitAt i xs -{- | -Applies a function to the first node along a trunk that satisfies a given property. --} -applyToSubTrunkBy :: (a -> Bool) -> (Tree a -> Tree a) -> Tree a -> Tree a -applyToSubTrunkBy cond f (Node x (t:ts)) - | cond x = f (Node x (t:ts)) - | otherwise = Node x (applyToSubTrunkBy cond f t : ts) -applyToSubTrunkBy _ _ t = t +-- do not delete: find use for +--{- | +--Applies a function to the first node along a trunk that satisfies a given property. +---} +--applyToSubTrunkBy :: (a -> Bool) -> (Tree a -> Tree a) -> Tree a -> Tree a +--applyToSubTrunkBy cond f (Node x (t:ts)) +-- | cond x = f (Node x (t:ts)) +-- | otherwise = Node x (applyToSubTrunkBy cond f t : ts) +--applyToSubTrunkBy _ _ t = t -zipTree :: Tree a -> Tree b -> Tree (a,b) -zipTree (Node x xs) (Node y ys) = Node (x,y) $ zipWith zipTree xs ys +-- find use for? +--zipTree :: Tree a -> Tree b -> Tree (a,b) +--zipTree (Node x xs) (Node y ys) = Node (x,y) $ zipWith zipTree xs ys {- | Makes each node into its child number, i.e. the index it has diff --git a/src/Dodge/Layout/Tree/Shift.hs b/src/Dodge/Layout/Tree/Shift.hs index 0936aa43b..9c6095b29 100644 --- a/src/Dodge/Layout/Tree/Shift.hs +++ b/src/Dodge/Layout/Tree/Shift.hs @@ -11,7 +11,6 @@ import Dodge.Room.Data import Dodge.Room.Link import Dodge.Layout.Tree.Polymorphic import Geometry.ConvexPoly ---import Geometry.Data import Data.Tree import Data.Sequence hiding (zipWith) diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 11fd18cb5..5dd8605c0 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -10,7 +10,6 @@ module Dodge.LevelGen ) where import Dodge.Data import Dodge.LevelGen.Block -import Dodge.LevelGen.LineBlock import Dodge.LevelGen.Pathing import Dodge.LevelGen.StaticWalls import Dodge.LevelGen.AutoDoor diff --git a/src/Dodge/LevelGen/Block.hs b/src/Dodge/LevelGen/Block.hs index d016384dd..abbf784ba 100644 --- a/src/Dodge/LevelGen/Block.hs +++ b/src/Dodge/LevelGen/Block.hs @@ -1,6 +1,7 @@ {- | Creation, update and destruction of destructible walls. -} module Dodge.LevelGen.Block ( putBlock + , putLineBlock ) where import Dodge.Data @@ -60,3 +61,49 @@ putBlock (p:ps) i c b is w = (0, foldr (uncurry removePathsCrossing) wWithBlock pairs = zip (p:ps) (ps ++ [p]) wWithBlock = addBlock (p:ps) i c b is w putBlock _ _ _ _ _ _ = error "Trying to put a block with incomplete polygon" + +{- | Splits a line into many four cornered blocks. -} +putLineBlock + :: Wall -- ^ Base pane + -> Float -- ^ Block width + -> Float -- ^ Block depth + -> Point2 -- ^ Start point (symmetric) + -> Point2 -- ^ End point (symmetric) + -> World + -> (Int, World) +putLineBlock basePane blockWidth depth a b w = (,) 0 + $ removePathsCrossing a b $ foldr insertWall (insertBlocks w) listWalls + where + d = dist a b + rot = argV (b -.- a) + psOnLine = divideLineOddNumPoints blockWidth a b + halfBlockWidth = d / fromIntegral (length psOnLine - 1) + blockCenPs = snd $ evenOddSplit psOnLine + numBlocks = length blockCenPs + is = [0.. numBlocks - 1] + cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block + cornersAt p = fmap ( (p +.+) . rotateV rot) cornerPoints + linesAt p = makeLoopPairs $ cornersAt p + k = IM.newKey $ _walls w + blid = IM.newKey $ _blocks w + insertBlock i = over blocks $ IM.insert (i+blid) Block + {_blID = i + blid, _blWallIDs = ksAtI i, _blHPs = [5,5], _blShadows = shadowsAt i} + insertBlocks = flip (foldr insertBlock) is + ksAtI i = map ( + (k + i*4) ) [0,1,2,3] + visibilityAt i + | i == 0 = [ True,True,False,True] + | i == numBlocks - 1 = [False,True, True,True] + | otherwise = [False,True,False,True] + shadowsAt i + | i == 0 = ksAtI 1 + | i == numBlocks - 1 = ksAtI $ numBlocks - 2 + | otherwise = ksAtI (i-1) ++ ksAtI (i+1) + makeWallAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p) + makePane i visStatus k' ps = basePane + {_wlID = k' + ,_wlBlockID = Just' $ i + blid + ,_wlLine = ps + ,_wlDraw = visStatus + } + listWalls = concat $ zipWith makeWallAt blockCenPs is + insertWall wl = over walls $ IM.insert (_wlID wl) wl diff --git a/src/Dodge/LevelGen/DoorPane.hs b/src/Dodge/LevelGen/DoorPane.hs index 9b694c02f..445f542d0 100644 --- a/src/Dodge/LevelGen/DoorPane.hs +++ b/src/Dodge/LevelGen/DoorPane.hs @@ -1,12 +1,9 @@ module Dodge.LevelGen.DoorPane ( rectanglePairs ) where ---import Dodge.Data import Geometry.Vector import Geometry.Data - - rectanglePairs :: Float -> Point2 -> Point2 -> [(Point2,Point2)] rectanglePairs wdth a b = [ (aup, ad) diff --git a/src/Dodge/LevelGen/InnerWalls.hs b/src/Dodge/LevelGen/InnerWalls.hs deleted file mode 100644 index da0d75725..000000000 --- a/src/Dodge/LevelGen/InnerWalls.hs +++ /dev/null @@ -1,44 +0,0 @@ -module Dodge.LevelGen.InnerWalls - where ---import Dodge.Data ---import Dodge.Base ---import Geometry - ---import Control.Lens ---import qualified Data.IntMap.Strict as IM ------------------------------------------------------------------------------------- --- idea: create inner walls to draw and to cast shadows ---createInnerWalls :: IM.IntMap Wall -> IM.IntMap Wall ---createInnerWalls wls = IM.map (createInnerWall wls) wls --- ---createInnerWall :: IM.IntMap Wall -> Wall -> Wall ---createInnerWall walls wl = wl & wlLine %~ \l -> l ++ [wlL,wlR] --- where wl0 = _wlLine wl !! 0 --- wl1 = _wlLine wl !! 1 --- wlLeft = findWallLeft wl walls --- wlRight = findWallRight wl walls --- wlN = normalizeV $ vNormal $ wl1 -.- wl0 --- rN = normalizeV $ vNormal $ (_wlLine wlRight !! 1) -.- (_wlLine wlRight !! 0) --- lN = normalizeV $ vNormal $ (_wlLine wlLeft !! 1) -.- (_wlLine wlLeft !! 0) --- wlR = wl0 +.+ 20 *.* normalizeV (wlN +.+ rN) --- wlL = wl1 +.+ 20 *.* normalizeV (wlN +.+ lN) --- ---findWallLeft :: Wall -> IM.IntMap Wall -> Wall ---findWallLeft wl wls = case filter (\w -> _wlID w /= _wlID wl) $ IM.elems $ findWallsLeft (_wlLine wl !! 1) wls of --- [w] -> w --- wls -> error $ "findWallLeft: " ++ show (map _wlID wls) --- ++ " wlLines: "++ show (map _wlLine wls) --- ---findWallRight :: Wall -> IM.IntMap Wall -> Wall ---findWallRight wl wls = case filter (\w -> _wlID w /= _wlID wl) $ IM.elems $ findWallsRight (_wlLine wl !! 0) wls of --- [w] -> w --- wls -> error $ "findWallRight: wall with ID " ++ show (_wlID wl) ++ " and points " ++ --- show (_wlLine wl) ++ "\nhas a right corner with and only with the walls " --- ++ show (map _wlID wls) ++ "\nwlLines "++ show (map _wlLine wls) --- ++ "\nUnless a wall has a corner with exactly one other wall, there is a problem" --- ---findWallsLeft :: Point2 -> IM.IntMap Wall -> IM.IntMap Wall ---findWallsLeft x wls = IM.filter (\wl -> dist x (_wlLine wl !! 0) < 1) wls --- ---findWallsRight :: Point2 -> IM.IntMap Wall -> IM.IntMap Wall ---findWallsRight x wls = IM.filter (\wl -> dist x (_wlLine wl !! 1) < 1) wls diff --git a/src/Dodge/LevelGen/LineBlock.hs b/src/Dodge/LevelGen/LineBlock.hs deleted file mode 100644 index 17b2d2e4c..000000000 --- a/src/Dodge/LevelGen/LineBlock.hs +++ /dev/null @@ -1,56 +0,0 @@ -{- | Splits a line into many four cornered blocks. -} -module Dodge.LevelGen.LineBlock - ( putLineBlock - ) where -import Dodge.Data -import Dodge.Base -import Dodge.LevelGen.Pathing -import Geometry -import qualified IntMapHelp as IM - -import Control.Lens - -putLineBlock - :: Wall -- ^ Base pane - -> Float -- ^ Block width - -> Float -- ^ Block depth - -> Point2 -- ^ Start point (symmetric) - -> Point2 -- ^ End point (symmetric) - -> World - -> (Int, World) -putLineBlock basePane blockWidth depth a b w = (,) 0 - $ removePathsCrossing a b $ foldr insertWall (insertBlocks w) listWalls - where - d = dist a b - rot = argV (b -.- a) - psOnLine = divideLineOddNumPoints blockWidth a b - halfBlockWidth = d / fromIntegral (length psOnLine - 1) - blockCenPs = snd $ evenOddSplit psOnLine - numBlocks = length blockCenPs - is = [0.. numBlocks - 1] - cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block - cornersAt p = fmap ( (p +.+) . rotateV rot) cornerPoints - linesAt p = makeLoopPairs $ cornersAt p - k = IM.newKey $ _walls w - blid = IM.newKey $ _blocks w - insertBlock i = over blocks $ IM.insert (i+blid) Block - {_blID = i + blid, _blWallIDs = ksAtI i, _blHPs = [5,5], _blShadows = shadowsAt i} - insertBlocks = flip (foldr insertBlock) is - ksAtI i = map ( + (k + i*4) ) [0,1,2,3] - visibilityAt i - | i == 0 = [ True,True,False,True] - | i == numBlocks - 1 = [False,True, True,True] - | otherwise = [False,True,False,True] - shadowsAt i - | i == 0 = ksAtI 1 - | i == numBlocks - 1 = ksAtI $ numBlocks - 2 - | otherwise = ksAtI (i-1) ++ ksAtI (i+1) - makeWallAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p) - makePane i visStatus k' ps = basePane - {_wlID = k' - ,_wlBlockID = Just' $ i + blid - ,_wlLine = ps - ,_wlDraw = visStatus - } - listWalls = concat $ zipWith makeWallAt blockCenPs is - insertWall wl = over walls $ IM.insert (_wlID wl) wl diff --git a/src/Dodge/LevelGen/MoveDoor.hs b/src/Dodge/LevelGen/MoveDoor.hs index e0e93367f..50f05cfc4 100644 --- a/src/Dodge/LevelGen/MoveDoor.hs +++ b/src/Dodge/LevelGen/MoveDoor.hs @@ -11,7 +11,6 @@ import Geometry import Control.Lens --- This deserves a clean up mvP :: Float -> Point2 -> Point2 -> Point2 {-# INLINE mvP #-} mvP !speed !ep !p = mvPointTowardAtSpeed speed ep p @@ -38,4 +37,3 @@ changeZonedWall -> World -> World changeZonedWall eff n (x,y) = over (wallsZone . znObjects) $ adjustIMZone eff x y n - diff --git a/src/Dodge/LevelGen/Pathing.hs b/src/Dodge/LevelGen/Pathing.hs index 15e772493..28592609a 100644 --- a/src/Dodge/LevelGen/Pathing.hs +++ b/src/Dodge/LevelGen/Pathing.hs @@ -25,7 +25,7 @@ removePathsCrossing :: Point2 -> Point2 -> World -> World removePathsCrossing a b w = w & pathGraph .~ newGraph & pathGraphP .~ pg' - & pathPoints .~ (foldr insertPoint IM.empty (labNodes newGraph)) + & pathPoints .~ foldr insertPoint IM.empty (labNodes newGraph) where pg' = filter (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraphP w insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp] diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index bc4af245e..ca6694f4b 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -89,7 +89,7 @@ soundMenuOptions = dec x = max 0 (x - 0.1) inc x = min 1 (x + 0.1) --sw w = w & sideEffects %~ (setVol (_config w) : ) - sw w = w & sideEffects %~ setVol' (_config w) + sw w = w & sideEffects %~ setVolThen (_config w) master g = Just . (config . volume_master %~ g) soundEffs g = Just . (config . volume_sound %~ g) music g = Just . (config . volume_music %~ g) diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 3fc4de738..3a6f8db23 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -26,7 +26,7 @@ import Control.Monad.State bulHitCr :: Particle -> Point2 -> Creature -> World -> World bulHitCr bt p cr w | crIsArmouredFrom p cr - = createSparkCol 8 colID p1 (argV (p1 -.- p) + d1) . addDamageArmoured $ w + = colSpark 8 colID p1 (argV (p1 -.- p)) $ addDamageArmoured w | otherwise = addDamage . bulletHitSound p $ w where sp = head $ _btTrail' bt @@ -36,7 +36,6 @@ bulHitCr bt p cr w addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ ) addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++) cid = _crID cr - (d1,_) = randomR (-0.7,0.7) $ _randGen w colID = _btColor' bt p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr) @@ -135,16 +134,14 @@ bulConCr' bt p cr w bulHitWall :: Particle -> Point2 -> Wall -> World -> World bulHitWall bt p wl w = damageBlocksBy 5 wl . smokeCloudAt dustcol 20 200 1 (addZ 20 pOut) - . createSparkCol 8 theCol pOut (reflectDir wl) - $ set randGen g + $ colSpark' 0.2 8 theCol pOut (reflectDir wl) w where dustcol = _wlColor wl & _4 .~ 1 theCol = brightX 100 1.5 white sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) - (a, g) = randomR (-0.2,0.2) $ _randGen w - reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) ) + reflectDir wall = argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) ) {- | Bounce off walls, do damage to blocks. -} bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World bulBounceWall' bt p wl w = damageBlocksBy 5 wl $ over worldEvents addBouncer w @@ -201,6 +198,5 @@ hvBulHitWall bt p x w = damageBlocksBy 5 x $ set randGen g $ foldr ($) w (spark sv = unitVectorAtAngle $ reflectDir x cs' = take 10 $ randomRs (0,11) $ _randGen w cs = map (brightX 100 1.5 . numColor) cs' - ds = randomRs (-0.7,0.7) $ _randGen w ts = randomRs (4,8) $ _randGen w - sparks pos vel = zipWith3 (\t c d -> createSparkCol t c pos (argV vel + d)) ts cs ds + sparks pos vel = zipWith (\t c -> colSpark t c pos (argV vel)) ts cs diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 6a4bf87c8..c39f1d818 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -6,8 +6,7 @@ module Dodge.Room , module Dodge.Room.Corridor ) where import Dodge.Default.Room -import Dodge.Item.Weapon -import Dodge.Item.Weapon.AutoGun +import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Weapon.Launcher import Dodge.Creature import Dodge.Room.Foreground diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 0361ee1d7..e3a11dc62 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -60,10 +60,10 @@ updateScopeZoom w = case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) . itAttachment . scopeZoomChange of Just x - | x > 9 -> zoomInLongGun $ zoomInLongGun $ w - | x > 0 -> zoomInLongGun $ w - | x < -9 -> zoomOutLongGun $ zoomOutLongGun $ w - | x < 0 -> zoomOutLongGun $ w + | x > 9 -> zoomInLongGun $ zoomInLongGun w + | x > 0 -> zoomInLongGun w + | x < -9 -> zoomOutLongGun $ zoomOutLongGun w + | x < 0 -> zoomOutLongGun w | otherwise -> w _ -> w | otherwise = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 26b88be47..1d96beda8 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -2,11 +2,12 @@ Creation of particles in the world. -} module Dodge.WorldEvent.SpawnParticle - ( createSparkCol - , makeGasCloud + ( makeGasCloud , aFlameParticle , makeFlameletTimed , makeTeslaArcAt + , colSpark + , colSpark' ) where import Dodge.Data import Dodge.Data.DamageType @@ -260,15 +261,12 @@ makeTeslaArcAt col pos dir = LinearParticle , _ptColor = brightX 100 1.5 col } drawTeslaArc :: Particle -> Picture -drawTeslaArc pt = pic +drawTeslaArc pt = setLayer 1 $ pictures + [ setDepth 20.5 $ color (brightX 2 1 $ _ptColor pt) $ lineOfThickness 3 ps + , setDepth 20 $ color (V4 0 0 0 0.5) $ lineOfThickness 10 ps + ] where - ps' = _ptPoints pt - pic = setLayer 1 $ pictures - [ setDepth 20.5 $ color (brightX 2 2 $ _ptColor pt) $ lineOfThickness 3 ps' --- , setDepth 20 $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps' --- , setDepth 20 $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps' --- , setDepth 20 $ color (withAlpha 0.02 cyan) $ lineOfThickness 30 ps' - ] + ps = _ptPoints pt -- todo: fix electrical damage location moveTeslaArc :: Point2 -- ^ Emmission position @@ -279,7 +277,7 @@ moveTeslaArc moveTeslaArc p d w pt | t == 2 = (foldr damCrs w hitCrs & randGen .~ g - & createSparkCol 8 nc q2 (argV sv + d1) + & colSpark 8 nc q2 (argV sv) , Just $ pt & ptTimer -~ 1 & ptPoints .~ ps' @@ -305,39 +303,28 @@ moveTeslaArc p d w pt q1 = last $ init ps' q2 = last ps' hitWall = reflectPointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w - (d1,_) = randomR (-0.7,0.7) $ _randGen w sv = maybe (q2 -.- q1) snd hitWall - -{- -Finds a point somewhere roughly inbetween two points. - -} +{- Finds a point somewhere roughly inbetween two points. -} lightningMid :: Float -> Point2 -> Point2 -> Point2 lightningMid d p1 p2 = (0.25 *.* (p1 +.+ p2)) +.+ 0.5 *.* p3 where p3 = errorClosestPointOnLine 1 p1 (p1 +.+ unitVectorAtAngle d) p2 - -{- -Finds extra middle points between successive points in a list of points. --} +{- Finds extra middle points between successive points in a list of points. -} lightningMids :: Float -> [Point2] -> [Point2] -> [Point2] lightningMids d1 (p:pers) (p1:p3:ps) = let p2 = p +.+ lightningMid d1 p1 p3 d2 = argV $ p3 -.- p2 in p1 : p2 : lightningMids d2 pers (p3:ps) lightningMids _ _ ps = ps - -{- -Finds a list of hit things from a given point. -'E3x1' objects are creatures, 'E3x2' objects are points on walls, 'E3x3' objects are points in space. - -} +{- Finds a list of hit things from a given point. +'E3x1' objects are creatures, 'E3x2' objects are points on walls, 'E3x3' objects are points in space. -} crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature Point2 Point2] -crsLightChain p d wlAttract w - = case crOrWallSensitive p d wlAttract w of - E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p)) - (min 1 (wlAttract + 0.3)) w - E3x2 p1 -> [E3x2 p1] - E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w) - -- where (dChange, g) = (0, _randGen w) - where (dChange, g) = randomR (-0.5,0.5) $ _randGen w +crsLightChain p d wlAttract w = case crOrWallSensitive p d wlAttract w of + E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p)) + (min 1 (wlAttract + 0.3)) w + E3x2 p1 -> [E3x2 p1] + E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w) + where + (dChange, g) = randomR (-0.5,0.5) $ _randGen w {- Finds whether a creature or wall is in front of a given point and direction. Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'. @@ -349,8 +336,7 @@ crOrWallSensitive -> Float -- ^ Wall attraction parameter -> World -> Either3 Creature Point2 Point2 -crOrWallSensitive p dir wlAttract w = - fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0)) +crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0)) . listToMaybe . sortBy (compare `on` g) $ catMaybes [cr,wlp] @@ -374,12 +360,16 @@ crOrWallSensitive p dir wlAttract w = g _ = 0 (arcLen,_) = randomR (25,50) $ _randGen w -- BUG: can hit crs through walls --- | Create a spark. --- If the spark is created by another Particle, it cannot be directly added to --- the list, hence the redirect through worldEvents. -createSparkCol :: Int -> Color -> Point2 -> Float -> World -> World -createSparkCol time col pos dir = worldEvents %~ ( over particles (spark :) . ) + +colSpark :: Int -> Color -> Point2 -> Float -> World -> World +colSpark = colSpark' 0.7 +colSpark' :: Float -> Int -> Color -> Point2 -> Float -> World -> World +colSpark' randDir time col pos baseDir w = w + & worldEvents %~ ( over particles (spark :) . ) + & randGen .~ g where + (a,g) = randomR (-randDir,randDir) $ _randGen w + dir = a + baseDir spark = BulletPt { _ptDraw = drawBul , _ptUpdate = mvGenBullet @@ -391,8 +381,7 @@ createSparkCol time col pos dir = worldEvents %~ ( over particles (spark :) . ) , _btTimer' = time , _btHitEffect' = destroyOnImpact sparkEff noEff } - sparkEff bt p cr - = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : ) + sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : ) where sp = head (_btTrail' bt) ep = sp +.+ _btVel' bt