justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup and reorganise

Browse Source
This commit is contained in:
justin
2021-10-31 19:46:32 +00:00
parent 41e64d14c3
commit 08fa84c1fd
53 changed files with 1352 additions and 1407 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Window.hs
+15 -8
View File
@@ -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
src/Dodge/Config/Load.hs
+1 -2
View File
@@ -1,6 +1,5 @@
module Dodge.Config.Load
(
loadDodgeConfig
( loadDodgeConfig
) where
import Dodge.Config.Data
src/Dodge/Config/Update.hs
+6 -6
View File
@@ -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.
-}
src/Dodge/Creature.hs
+6 -2
View File
@@ -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
src/Dodge/Creature/AutoCrit.hs
+1 -1
View File
@@ -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
src/Dodge/Creature/Inanimate.hs
+81 -15
View File
@@ -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
src/Dodge/Creature/LtAutoCrit.hs
+1 -1
View File
@@ -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
src/Dodge/Creature/PistolCrit.hs
+1 -1
View File
@@ -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
src/Dodge/Creature/Property.hs
+5 -3
View File
@@ -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)
src/Dodge/Creature/SentinelAI.hs
+39 -42
View File
@@ -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]]
src/Dodge/Creature/SpreadGunCrit.hs
+1 -1
View File
@@ -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
src/Dodge/Creature/State.hs
+6 -73
View File
@@ -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
src/Dodge/Creature/State/WalkCycle.hs
+3
View File
@@ -1,4 +1,7 @@
module Dodge.Creature.State.WalkCycle
( updateWalkCycle
, footstepSideEffect
)
where
import Dodge.Data
import Dodge.Data.SoundOrigin
src/Dodge/Creature/Test.hs
+11
View File
@@ -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
src/Dodge/Creature/Update.hs
+2 -4
View File
@@ -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)
src/Dodge/Creature/Volition.hs
+17 -12
View File
@@ -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]])
src/Dodge/Creature/YourControl.hs
+6 -17
View File
@@ -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
src/Dodge/Event/Keyboard.hs
-1
View File
@@ -83,4 +83,3 @@ toggleMap :: World -> World
toggleMap w = w & carteDisplay %~ not
escapeMap :: World -> World
escapeMap w = w & carteDisplay .~ False
src/Dodge/Item/Weapon.hs
+3 -681
View File
@@ -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
src/Dodge/Item/Weapon/AmmoParams.hs
+6 -1
View File
@@ -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
src/Dodge/Item/Weapon/AutoGun.hs
-80
View File
@@ -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
src/Dodge/Item/Weapon/BatteryGuns.hs
+315
View File
@@ -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
src/Dodge/Item/Weapon/Bezier.hs
+3 -4
View File
@@ -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
src/Dodge/Item/Weapon/Booster.hs
+24 -1
View File
@@ -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
src/Dodge/Item/Weapon/Bullet.hs
+4 -1
View File
@@ -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
src/Dodge/Item/Weapon/BulletGuns.hs
+452
View File
@@ -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
src/Dodge/Item/Weapon/Decoration.hs
+2 -2
View File
@@ -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]
src/Dodge/Item/Weapon/ExtraEffect.hs
+20 -15
View File
@@ -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!
src/Dodge/Item/Weapon/Grenade.hs
+58 -5
View File
@@ -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
src/Dodge/Item/Weapon/InventoryDisplay.hs
+2 -4
View File
@@ -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
src/Dodge/Item/Weapon/Laser.hs
-122
View File
@@ -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
src/Dodge/Item/Weapon/Launcher.hs
+9 -7
View File
@@ -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
src/Dodge/Item/Weapon/Remote.hs
+2 -1
View File
@@ -1,5 +1,6 @@
module Dodge.Item.Weapon.Remote
where
( pointToItem
) where
import Dodge.Data
import Control.Lens
src/Dodge/Item/Weapon/Shell.hs
+2
View File
@@ -1,4 +1,6 @@
module Dodge.Item.Weapon.Shell
( decTimMvVel
)
where
import Dodge.Data
import Geometry.Vector
src/Dodge/Item/Weapon/SprayGuns.hs
+119
View File
@@ -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
src/Dodge/Item/Weapon/TriggerType.hs
+17 -27
View File
@@ -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
src/Dodge/Item/Weapon/UseEffect.hs
-86
View File
@@ -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
src/Dodge/Layout/Generate.hs
-2
View File
@@ -21,5 +21,3 @@ randomTreeStructure = undefined
treeMaxDepthFromTrunk :: Int -> Int -> State g (Tree ())
treeMaxDepthFromTrunk = do
undefined
src/Dodge/Layout/Tree/GenerateStructure.hs
-1
View File
@@ -44,4 +44,3 @@ aTreeStrut = do
bs <- replicateM nbs smallBranch
let trunk = treePath d
return $ foldr (uncurry addBranchAt) trunk $ zip bds bs
src/Dodge/Layout/Tree/Polymorphic.hs
+23 -13
View File
@@ -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
src/Dodge/Layout/Tree/Shift.hs
-1
View File
@@ -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)
src/Dodge/LevelGen.hs
-1
View File
@@ -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
src/Dodge/LevelGen/Block.hs
+47
View File
@@ -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
src/Dodge/LevelGen/DoorPane.hs
-3
View File
@@ -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)
src/Dodge/LevelGen/InnerWalls.hs
-44
View File
@@ -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
src/Dodge/LevelGen/LineBlock.hs
-56
View File
@@ -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
src/Dodge/LevelGen/MoveDoor.hs
-2
View File
@@ -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
src/Dodge/LevelGen/Pathing.hs
+1 -1
View File
@@ -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]
src/Dodge/Menu.hs
+1 -1
View File
@@ -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)
src/Dodge/Particle/Bullet/HitEffect.hs
+4 -8
View File
@@ -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
src/Dodge/Room.hs
+1 -2
View File
@@ -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
src/Dodge/Update/Camera.hs
+4 -4
View File
@@ -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))
src/Dodge/WorldEvent/SpawnParticle.hs
+31 -42
View File
@@ -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