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/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