Cleanup Data

This commit is contained in:
jgk
2021-03-26 23:49:07 +01:00
parent fb1d7571e7
commit 62b5ffbfaa
7 changed files with 460 additions and 455 deletions
+5 -5
View File
@@ -6,9 +6,9 @@ import Geometry
import Control.Lens
-- isArmouredFrom :: Point2 -> Creature -> Bool
-- isArmouredFrom p cr
-- = p /= _crPos cr
-- && any (\it -> it ^? itIdentity == Just FrontArmour) (_crInv cr)
-- && angleVV (unitVectorAtAngle $ _crDir cr) (p -.- _crPos cr) < pi/2
isArmouredFrom :: Point2 -> Creature -> Bool
isArmouredFrom p cr
= p /= _crPos cr
&& any (\it -> it ^? itIdentity == Just FrontArmour) (_crInv cr)
&& angleVV (unitVectorAtAngle $ _crDir cr) (p -.- _crPos cr) < pi/2
-- even though angleVV can generate NaN, the comparison seems to deal with it
+16 -14
View File
@@ -350,20 +350,22 @@ startCr = defaultCreature
, _crHP = 10000
, _crMaxHP = 1500
, _crInv = IM.fromList (zip [0..20]
([pistol,autoGun,launcher,lasGun,grenade
,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher
,longGun
,hvAutoGun
,teslaGun
,latchkey 0
,miniGun
,medkit 50
,bezierGun
,poisonSprayer
,blinkGun
]
++ repeat NoItem))
-- startInv
(
[pistol,autoGun,launcher,lasGun,grenade
,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher
,longGun
,hvAutoGun
,teslaGun
,latchkey 0
,miniGun
,medkit 50
,bezierGun
,poisonSprayer
,blinkGun
,frontArmour
]
++ repeat NoItem))
-- startInv
, _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10]
}
+377 -373
View File
@@ -1,6 +1,5 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
--{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data
( module Dodge.Data
@@ -9,39 +8,27 @@ module Dodge.Data
, soundTime
)
where
-- imports {{{
import Picture.Data
import Geometry.Data
import Sound.Preload
import Control.Lens
import Control.Monad.State
import System.Random
import Data.Graph.Inductive
import qualified Data.Set as S
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
import qualified SDL.Mixer as Mix
import SDL (Scancode, MouseButton)
import Graphics.Rendering.OpenGL (PrimitiveMode (..),GLfloat,Program,VertexArrayObject,BufferObject)
import Codec.Picture (Image,PixelRGBA8)
import qualified Data.DList as DL
import LoadConfig
--}}}
-- datatypes {{{
data World = World
{ _keys :: !(S.Set Scancode)
, _mouseButtons :: !(S.Set MouseButton)
, _cameraCenter :: !Point2
, _cameraAimTime :: Int
, _cameraCenter :: !Point2
, _cameraRot :: !Float
, _cameraZoom :: !Float
, _cameraViewFrom :: !Point2
@@ -67,8 +54,7 @@ data World = World
, _sounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Picture
, _corpses :: IM.IntMap (IM.IntMap [Corpse])
, _clickMousePos :: (Float,Float)
, _lbRotation :: Float
, _clickMousePos :: (Float,Float)
, _pathGraph :: ~(Gr Point2 Float)
, _pathGraph' :: ~[(Point2,Point2)]
, _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)]))
@@ -91,17 +77,26 @@ data World = World
}
data Corpse = Corpse
{ _cpPos :: Point2
, _cpPict :: Picture
, _cpRes :: Creature
}
{ _cpPos :: Point2
, _cpPict :: Picture
, _cpRes :: Creature
}
data Layer = PtLayer | CrLayer | WlLayer | BgLayer | ShadowLayer
| FlItLayer | LabelLayer | InvLayer | MenuLayer
| PressPlateLayer | CorpseLayer
| UPtLayer
| HPtLayer
| GloomLayer
data Layer
= PtLayer
| CrLayer
| WlLayer
| BgLayer
| ShadowLayer
| FlItLayer
| LabelLayer
| InvLayer
| MenuLayer
| PressPlateLayer
| CorpseLayer
| UPtLayer
| HPtLayer
| GloomLayer
data Cloud = Cloud
{ _clID :: Int
@@ -113,294 +108,297 @@ data Cloud = Cloud
, _clEffect :: Cloud -> World -> World
}
data LightSource
= LS
{ _lsID :: !Int
, _lsPos :: !Point2
, _lsDir :: !Float
, _lsRad :: !Float
, _lsIntensity :: !Float
}
data LightSource = LS
{ _lsID :: !Int
, _lsPos :: !Point2
, _lsDir :: !Float
, _lsRad :: !Float
, _lsIntensity :: !Float
}
data TempLightSource =
TLS { _tlsPos :: !Point2
, _tlsRad :: !Float
, _tlsIntensity :: !Float
, _tlsUpdate :: World -> TempLightSource -> (World, Maybe TempLightSource)
}
data TempLightSource = TLS
{ _tlsPos :: !Point2
, _tlsRad :: !Float
, _tlsIntensity :: !Float
, _tlsUpdate :: World -> TempLightSource -> (World, Maybe TempLightSource)
}
data Creature = Creature
{ _crPos :: Point2
, _crOldPos :: Point2
, _crDir :: Float
, _crID :: Int
, _crPict :: Creature -> Picture
, _crUpdate :: World -> (World -> World,StdGen) -> Creature
-> ((World -> World,StdGen), Maybe Creature)
, _crRad :: Float
, _crMass :: Float
, _crHP :: Int
, _crMaxHP :: Int
, _crInv :: IM.IntMap Item
, _crInvSel :: Int
, _crState :: CreatureState
, _crCorpse :: Picture
}
{ _crPos :: Point2
, _crOldPos :: Point2
, _crDir :: Float
, _crID :: Int
, _crPict :: Creature -> Picture
, _crUpdate :: World -> (World -> World,StdGen) -> Creature
-> ((World -> World,StdGen), Maybe Creature)
, _crRad :: Float
, _crMass :: Float
, _crHP :: Int
, _crMaxHP :: Int
, _crInv :: IM.IntMap Item
, _crInvSel :: Int
, _crState :: CreatureState
, _crCorpse :: Picture
}
data CreatureState
= CrSt { _goals :: [[Goal]]
, _stance :: Stance
, _faction :: Faction
, _crDamage :: [DamageType]
, _crPastDamage :: Int
, _crSpState :: CrSpState
, _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
}
-- deriving (Eq,Show)
data CrSpState = Barrel { _piercedPoints :: [Point2]}
| GenCr
deriving (Eq,Show,Ord)
data Goal = MoveTo Point2
| MoveToFor Point2 Int
| MoveFire Point2 Point2
| PathTo Point2
| PathAlong [Point2]
| SubPathTo Point2 Int Point2
| Wait
| WaitFor Int
| WaitForID Int Int
| FireAt Point2
| FireAtID Int Point2
| Fire
| Reload
| IncreaseAlert Int
| Guard Point2 Point2
| Search Int
| SearchNear Point2
| AimAt Point2 Int
| InitGuard
| Init
| MeleeAttack Int
| InitTrackYou
| TrackYou
| Track Int
| TrackFor Int Int
| TurnByFor Float Int
| TurnTo Point2
| TurnToward Point2
| TurnTowardAngle Float
| StrafeLeftAround Int Point2
| StrafeRightAround Int Point2
| StrafeLeftFor Int
| StrafeRightFor Int
| StrafeLeftForSpeed Int Float
| StrafeRightForSpeed Int Float
| StrafeLeftFire
| StrafeRightFire
| MoveForwardFor Int
| MoveForwardFire
| MoveBackwardFor Int
| MoveByFor Point2 Int
| MoveBackwardFire
| GoalID Int Goal
| AtRange Float
| AtRanges Float Float
| RepeatAction Int Goal
| MakeJudgement
| SetPosture Posture
deriving (Eq,Show)
data Stance = Stance {_carriage :: Carriage
,_posture :: Posture
}
deriving (Eq,Show)
data Carriage = Walking {_stepCycle :: Int
,_stepToAdd :: Int
}
| Floating
| Boosting Point2
deriving (Eq,Show)
data Posture = Aiming
| AtEase
deriving (Eq,Show)
data Mind = ZombieMind
| HumanMind
deriving (Eq,Show)
data Faction = GenericFaction Int
| ZombieFaction
| EncircleFlock
| ChaseCritters
| SpawnedBy Int
| NoFaction
data CreatureState = CrSt
{ _goals :: [[Goal]]
, _stance :: Stance
, _faction :: Faction
, _crDamage :: [DamageType]
, _crPastDamage :: Int
, _crSpState :: CrSpState
, _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
}
data CrSpState
= Barrel { _piercedPoints :: [Point2]}
| GenCr
deriving (Eq,Show,Ord)
data Goal
= MoveTo Point2
| MoveToFor Point2 Int
| MoveFire Point2 Point2
| PathTo Point2
| PathAlong [Point2]
| SubPathTo Point2 Int Point2
| Wait
| WaitFor Int
| WaitForID Int Int
| FireAt Point2
| FireAtID Int Point2
| Fire
| Reload
| IncreaseAlert Int
| Guard Point2 Point2
| Search Int
| SearchNear Point2
| AimAt Point2 Int
| InitGuard
| Init
| MeleeAttack Int
| InitTrackYou
| TrackYou
| Track Int
| TrackFor Int Int
| TurnByFor Float Int
| TurnTo Point2
| TurnToward Point2
| TurnTowardAngle Float
| StrafeLeftAround Int Point2
| StrafeRightAround Int Point2
| StrafeLeftFor Int
| StrafeRightFor Int
| StrafeLeftForSpeed Int Float
| StrafeRightForSpeed Int Float
| StrafeLeftFire
| StrafeRightFire
| MoveForwardFor Int
| MoveForwardFire
| MoveBackwardFor Int
| MoveByFor Point2 Int
| MoveBackwardFire
| GoalID Int Goal
| AtRange Float
| AtRanges Float Float
| RepeatAction Int Goal
| MakeJudgement
| SetPosture Posture
deriving (Eq,Show)
data Stance = Stance
{_carriage :: Carriage
,_posture :: Posture
}
deriving (Eq,Show)
data Carriage
= Walking { _stepCycle :: Int, _stepToAdd :: Int }
| Floating
| Boosting Point2
deriving (Eq,Show)
data Posture = Aiming | AtEase
deriving (Eq,Show)
data Mind = ZombieMind | HumanMind
deriving (Eq,Show)
data Faction
= GenericFaction Int
| ZombieFaction
| EncircleFlock
| ChaseCritters
| SpawnedBy Int
| NoFaction
deriving (Eq,Show)
-- NOTE: walls must be drawn counterclockwise
data WorldState = DoorNumOpen Int
| CrNumAlive Int
deriving (Eq,Ord)
data WorldState = DoorNumOpen Int | CrNumAlive Int
deriving (Eq,Ord)
data MenuState
= LevelMenu Int
| PauseMenu
| GameOverMenu
| InGame
deriving (Eq,Ord)
deriving (Eq,Ord)
data Button = Button
{ _btPict :: Picture
, _btPos :: Point2
, _btRot :: Float
, _btEvent :: Button -> World -> World
, _btID :: Int
, _btText :: String
, _btState :: ButtonState
}
{ _btPict :: Picture
, _btPos :: Point2
, _btRot :: Float
, _btEvent :: Button -> World -> World
, _btID :: Int
, _btText :: String
, _btState :: ButtonState
}
data ButtonState = BtOn | BtOff | BtNoLabel
deriving (Eq, Show)
deriving (Eq, Show)
data PressPlate = PressPlate { _ppPict :: Picture
, _ppPos :: Point2
, _ppRot :: Float
, _ppEvent :: PressPlate -> World -> World
, _ppID :: Int
, _ppText :: String
}
data PressPlate = PressPlate
{ _ppPict :: Picture
, _ppPos :: Point2
, _ppRot :: Float
, _ppEvent :: PressPlate -> World -> World
, _ppID :: Int
, _ppText :: String
}
data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int}
data ItemPos = InInv { _itCrId :: Int
, _itInvId :: Int
}
| OnFloor { _itFlID :: Int
}
data ItemPos
= InInv { _itCrId :: Int , _itInvId :: Int }
| OnFloor { _itFlID :: Int }
data Item = Weapon
{ _itName :: String
, _wpMaxAmmo :: Int
, _wpLoadedAmmo :: Int
, _wpReloadTime :: Int
, _wpReloadState :: Int
, _wpFireRate :: Int
, _wpFireState :: Int
, _wpFire :: Int -> World -> World
, _wpSpread :: Float
, _wpRange :: Float
, _itHammer :: HammerPosition
, _itFloorPict :: Picture
, _itMaxStack :: Int
, _itAmount :: Int
, _itAimingSpeed :: Float
, _itAimingRange :: Float
, _itZoom :: ItZoom
, _itEquipPict :: Creature -> Int -> Picture
, _itScrollUp :: Int -> World -> World
, _itScrollDown :: Int -> World -> World
, _itIdentity :: ItemIdentity
, _itAttachment :: Maybe ItAttachment
, _itID :: Maybe Int
, _itEffect :: ItEffect
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
}
| Consumable
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _cnEffect :: Int -> World -> Maybe World
, _itFloorPict :: Picture
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
, _itEffect :: ItEffect
, _itHammer :: HammerPosition
}
| Craftable
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: Picture
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
}
| Equipment
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: Picture
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itEffect :: ItEffect
, _itID :: Maybe Int
, _itAimingSpeed :: Float
, _itAimingRange :: Float
, _itZoom :: ItZoom
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
, _itHammer :: HammerPosition
}
| Throwable
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: Picture
, _twMaxRange :: Float
, _twAccuracy :: Float
, _twFire :: Int -> World -> World
, _itAimingSpeed :: Float
, _itAimingRange :: Float
, _itZoom :: ItZoom
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itAttachment :: Maybe ItAttachment
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
, _itEffect :: ItEffect
, _itHammer :: HammerPosition
, _itScrollUp :: Int -> World -> World
, _itScrollDown :: Int -> World -> World
}
| NoItem
data Item
= Weapon
{ _itName :: String
, _wpMaxAmmo :: Int
, _wpLoadedAmmo :: Int
, _wpReloadTime :: Int
, _wpReloadState :: Int
, _wpFireRate :: Int
, _wpFireState :: Int
, _wpFire :: Int -> World -> World
, _wpSpread :: Float
, _wpRange :: Float
, _itHammer :: HammerPosition
, _itFloorPict :: Picture
, _itMaxStack :: Int
, _itAmount :: Int
, _itAimingSpeed :: Float
, _itAimingRange :: Float
, _itZoom :: ItZoom
, _itEquipPict :: Creature -> Int -> Picture
, _itScrollUp :: Int -> World -> World
, _itScrollDown :: Int -> World -> World
, _itIdentity :: ItemIdentity
, _itAttachment :: Maybe ItAttachment
, _itID :: Maybe Int
, _itEffect :: ItEffect
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
}
| Consumable
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _cnEffect :: Int -> World -> Maybe World
, _itFloorPict :: Picture
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
, _itEffect :: ItEffect
, _itHammer :: HammerPosition
}
| Craftable
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: Picture
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
}
| Equipment
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: Picture
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itEffect :: ItEffect
, _itID :: Maybe Int
, _itAimingSpeed :: Float
, _itAimingRange :: Float
, _itZoom :: ItZoom
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
, _itHammer :: HammerPosition
}
| Throwable
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: Picture
, _twMaxRange :: Float
, _twAccuracy :: Float
, _twFire :: Int -> World -> World
, _itAimingSpeed :: Float
, _itAimingRange :: Float
, _itZoom :: ItZoom
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itAttachment :: Maybe ItAttachment
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
, _itEffect :: ItEffect
, _itHammer :: HammerPosition
, _itScrollUp :: Int -> World -> World
, _itScrollDown :: Int -> World -> World
}
| NoItem
data ItAttachment
= ItScope {_scopePos :: Point2
,_scopeZoomChange :: Int
,_scopeZoom :: Float
,_scopeIsCamera :: Bool
}
= ItScope
{_scopePos :: Point2
,_scopeZoomChange :: Int
,_scopeZoom :: Float
,_scopeIsCamera :: Bool
}
| ItFuse {_itFuseTime :: Int}
| ItPhaseV {_itPhaseV :: Float}
| ItMode {_itMode :: Int}
| ItTargetPos { _itTargetPos :: Point2 }
data ItEffect = NoItEffect
| ItInvEffect {_itInvEffect :: Creature -> Int -> World -> World
,_itEffectCounter :: Int
}
| ItEffect {_itInvEffect :: Creature -> Int -> World -> World
,_itFloorEffect :: Int -> World -> World
,_itEffectCounter :: Int
}
data ItZoom = ItZoom {_itAimZoomMax :: Float
,_itAimZoomMin :: Float
,_itAimZoomFac :: Float
,_itZoomMax :: Float
,_itZoomMin :: Float
,_itZoomFac :: Float
}
| ItInvEffect
{_itInvEffect :: Creature -> Int -> World -> World
,_itEffectCounter :: Int
}
| ItEffect
{_itInvEffect :: Creature -> Int -> World -> World
,_itFloorEffect :: Int -> World -> World
,_itEffectCounter :: Int
}
data ItZoom = ItZoom
{_itAimZoomMax :: Float
,_itAimZoomMin :: Float
,_itAimZoomFac :: Float
,_itZoomMax :: Float
,_itZoomMin :: Float
,_itZoomFac :: Float
}
data IntID a = IntID Int a
data HammerPosition = HammerDown
| HammerReleased
| HammerUp
| NoHammer
data HammerPosition
= HammerDown
| HammerReleased
| HammerUp
| NoHammer
data ItemIdentity
= Pistol
@@ -439,62 +437,70 @@ data Particle'
{ _ptDraw :: Particle' -> Picture
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
}
| Bul' { _ptDraw :: Particle' -> Picture
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
, _btVel' :: Point2
, _btColor' :: Color
, _btTrail' :: [Point2]
, _btPassThrough' :: Maybe Int
, _btWidth' :: Float
, _btTimer' :: Int
, _btHitEffect' :: HitEffect
}
| Pt' { _ptDraw :: Particle' -> Picture
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
, _btVel' :: Point2
, _btColor' :: Color
, _btPos' :: Point2
, _btPassThrough' :: Maybe Int
, _btWidth' :: Float
, _btTimer' :: Int
, _btHitEffect' :: HitEffect
}
| Bul'
{ _ptDraw :: Particle' -> Picture
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
, _btVel' :: Point2
, _btColor' :: Color
, _btTrail' :: [Point2]
, _btPassThrough' :: Maybe Int
, _btWidth' :: Float
, _btTimer' :: Int
, _btHitEffect' :: HitEffect
}
| Pt'
{ _ptDraw :: Particle' -> Picture
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
, _btVel' :: Point2
, _btColor' :: Color
, _btPos' :: Point2
, _btPassThrough' :: Maybe Int
, _btWidth' :: Float
, _btTimer' :: Int
, _btHitEffect' :: HitEffect
}
| Shockwave'
{ _ptDraw :: Particle' -> Picture
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
, _btColor' :: Color
, _btPos' :: Point2
, _btRad' :: Float
, _btDam' :: Int
, _btPush' :: Float
, _btMaxTime' :: Int
, _btTimer' :: Int
}
{ _ptDraw :: Particle' -> Picture
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
, _btColor' :: Color
, _btPos' :: Point2
, _btRad' :: Float
, _btDam' :: Int
, _btPush' :: Float
, _btMaxTime' :: Int
, _btTimer' :: Int
}
type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] -> World
-> (World,Maybe Particle')
data Projectile = Projectile { _ptPos :: Point2
, _ptStartPos :: Point2
, _ptVel :: Point2
, _ptPict :: Picture
, _ptID :: Int
, _ptUpdate :: World -> World
}
data Projectile = Projectile
{ _ptPos :: Point2
, _ptStartPos :: Point2
, _ptVel :: Point2
, _ptPict :: Picture
, _ptID :: Int
, _ptUpdate :: World -> World
}
data DamageType = Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Blunt {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| SparkDam {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Flaming {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Lasering {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Concussive {_dmAmount :: Int , _dmFrom :: Point2 , _dmPush :: Float
, _dmPushExp :: Float
, _dmPushRadius :: Float}
| TorqueDam {_dmAmount :: Int , _dmTorque :: Float }
| PushDam {_dmAmount :: Int , _dmPushBack :: Point2 }
| PoisonDam {_dmAmount :: Int}
deriving (Eq,Ord,Show)
data DamageType
= Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Blunt {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| SparkDam {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Flaming {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Lasering {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Concussive
{ _dmAmount :: Int
, _dmFrom :: Point2
, _dmPush :: Float
, _dmPushExp :: Float
, _dmPushRadius :: Float
}
| TorqueDam {_dmAmount :: Int , _dmTorque :: Float }
| PushDam {_dmAmount :: Int , _dmPushBack :: Point2 }
| PoisonDam {_dmAmount :: Int}
deriving (Eq,Ord,Show)
data Either3 a b c = E3x1 a | E3x2 b | E3x3 c
@@ -542,54 +548,54 @@ data Wall
, _blShadows :: [Int]
}
data ForceField = FF { _ffLine :: [Point2] , _ffID :: Int
, _ffColor :: Color
, _ffDeflect :: Maybe (StdGen -> Point2 -> ForceField -> (Point2,StdGen))
, _ffState :: FFState
}
data ForceField = FF
{ _ffLine :: [Point2] , _ffID :: Int
, _ffColor :: Color
, _ffDeflect :: Maybe (StdGen -> Point2 -> ForceField -> (Point2,StdGen))
, _ffState :: FFState
}
data FFState = FFDestroyable { _ffsHP :: Int }
data SoundOrigin = InventorySound
| BackgroundSound
| OnceSound
| CrSound Int
| CrWeaponSound Int
| WallSound Int
| CrReloadSound Int
| Flamer
| ShellSound Int
| Flame
| LasSound
| FootstepSound Int
| BlockDegradeSound Int
| CrHitSound Int
| BarrelHiss Int
deriving (Eq,Ord,Show)
| BackgroundSound
| OnceSound
| CrSound Int
| CrWeaponSound Int
| WallSound Int
| CrReloadSound Int
| Flamer
| ShellSound Int
| Flame
| LasSound
| FootstepSound Int
| BlockDegradeSound Int
| CrHitSound Int
| BarrelHiss Int
deriving (Eq,Ord,Show)
type Poly = [Point2]
data PSType = PutCrit Creature
| PutLS LightSource Picture
| PutButton Button
| PutFlIt FloorItem
| PutPressPlate PressPlate
| PutAutoDoor Point2 Point2
| PutBlock [Int] Color [Point2]
| PutBlockWall [Int] Color [Point2]
| PutWindowBlock Point2 Point2
| PutTriggerDoor Color (World -> Bool) Point2 Point2
| PutBtDoor Color Point2 Float Point2 Point2
| PutSwitchDoor Color Point2 Float Point2 Point2
| RandPS (State StdGen PSType)
| PutNothing
| CollectivePS
{ _collectiveID :: Int
, _collectiveNum :: Int
, _collectiveFunction :: [Int] -> State StdGen [PSType]
| PutLS LightSource Picture
| PutButton Button
| PutFlIt FloorItem
| PutPressPlate PressPlate
| PutAutoDoor Point2 Point2
| PutBlock [Int] Color [Point2]
| PutBlockWall [Int] Color [Point2]
| PutWindowBlock Point2 Point2
| PutTriggerDoor Color (World -> Bool) Point2 Point2
| PutBtDoor Color Point2 Float Point2 Point2
| PutSwitchDoor Color Point2 Float Point2 Point2
| RandPS (State StdGen PSType)
| PutNothing
| CollectivePS
{ _collectiveID :: Int
, _collectiveNum :: Int
, _collectiveFunction :: [Int] -> State StdGen [PSType]
}
| LabelPS { _psLabel :: Int, _ps :: PSType}
| PutWindow { _pwPoly :: [Point2] , _pwColor :: Color
}
| LabelPS { _psLabel :: Int, _ps :: PSType}
| PutWindow { _pwPoly :: [Point2]
, _pwColor :: Color
}
data PlacementSpot = PS
{ _psPos :: Point2
, _psRot :: Float
@@ -635,8 +641,6 @@ makeLenses ''Button
makeLenses ''PSType
makeLenses ''PlacementSpot
makeLenses ''Room
--
-- }}}
numColor :: Int -> Color
numColor 0 = (1,0,0,1)
-2
View File
@@ -182,7 +182,6 @@ defaultWorld = World
{ _keys = S.empty
, _mouseButtons = S.empty
, _cameraCenter = (0,0)
, _cameraAimTime = 0
, _cameraRot = 0
, _cameraZoom = 1
, _cameraViewFrom = (0,0)
@@ -212,7 +211,6 @@ defaultWorld = World
, _menuState = LevelMenu 1
, _worldState = M.empty
, _clickMousePos = (0,0)
, _lbRotation = 0
, _pathGraph = Data.Graph.Inductive.Graph.empty
, _pathGraph' = []
, _pathPoints = IM.empty
+2 -1
View File
@@ -469,7 +469,8 @@ miniGun = defaultAutoGun
. withRandomDir 0.1
. withRandomOffset 9
. withMuzFlare
$ withVelWthHiteff (30,0) 2 bulletEffect'
. withVelWthHiteff (30,0) 2
$ destroyOnImpact bulBounceArmCr' bulHitWall' bulHitFF'
, _wpSpread = autogunSpread
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color red $ polygon $ rectNESW 9 5 (-9) (-5)
+59 -52
View File
@@ -6,6 +6,8 @@ import Dodge.WorldEvent
import Dodge.SoundLogic
import Dodge.RandomHelp
import Dodge.Creature.LookupStatus
import Geometry
import System.Random
@@ -19,42 +21,49 @@ import Picture
-- bullet effects
bulHitCr' :: Particle' -> Point2 -> Creature -> World -> World
bulHitCr' bt p cr w =
let sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
mvDams = [ PushDam 1 $ 2 *.* bulVel ]
addDamage = over (creatures . ix cid . crState . crDamage)
(\dams -> (Piercing 100 sp p ep : mvDams) ++ dams)
addDamageArmoured = over (creatures . ix cid . crState . crDamage)
(\dams -> mvDams ++ dams)
hitSound = soundMultiFrom [CrHitSound 0] 15 10 0
flashEff = over worldEvents ((.) $ bloodFlashAt p)
bulVel = _btVel' bt
ck cid = (+.+) (crKnockBack cid *.* bulVel)
crKnockBack cid = (/) 1 $ (+) 2 $ _crMass $ _creatures w IM.! cid
hasArmour cr = any (\it -> it ^? itIdentity == Just FrontArmour) $ _crInv cr
cid = _crID cr
(d1,g) = randomR (-0.7,0.7) $ _randGen w
(colID,_) = randomR (0,11) $ _randGen w
hitEffect = addDamage
. hitSound
. flashEff
$ w
in case hasArmour cr of --shit this is ugly, to refactor
True -> if hitBack
then hitEffect
else createSpark 8 colID p1
(argV (p -.- _crPos (_creatures w IM.! cid)) + d1)
Nothing
. addDamageArmoured
$ w
where cpos = _crPos $ _creatures w IM.! cid
relHitPos = p -.- cpos
hitBack = errorAngleVV 19 (unitVectorAtAngle (_crDir $ _creatures w IM.! cid))
relHitPos
> pi/2
p1 = p +.+ 2 *.* safeNormalizeV relHitPos
_ -> hitEffect
bulHitCr' bt p cr w
| isArmouredFrom p cr
= createSpark 8 colID p1 (argV (p1 -.- p) + d1) Nothing
. addDamageArmoured $ w
| otherwise
= addDamage . hitSound . flashEff $ w
where
sp = head $ _btTrail' bt
bulVel = _btVel' bt
ep = sp +.+ bulVel
mvDams = [ PushDam 1 $ 2 *.* bulVel ]
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
hitSound = soundMultiFrom [CrHitSound 0] 15 10 0
flashEff = over worldEvents ((.) $ bloodFlashAt p)
cid = _crID cr
(d1,g) = randomR (-0.7,0.7) $ _randGen w
(colID,_) = randomR (0,11) $ _randGen w
p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr)
bulBounceArmCr' :: Particle' -> Point2 -> Creature -> World -> World
bulBounceArmCr' bt p cr w
| isArmouredFrom p cr
= addBouncer . addDamageArmoured $ w
| otherwise
= addDamage . hitSound . flashEff $ w
where
sp = head $ _btTrail' bt
bulVel = _btVel' bt
ep = sp +.+ bulVel
mvDams = [ PushDam 1 $ 2 *.* bulVel ]
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
hitSound = soundMultiFrom [CrHitSound 0] 15 10 0
flashEff = over worldEvents ((.) $ bloodFlashAt p)
cid = _crID cr
newDir = safeNormalizeV (p -.- _crPos cr)
pOut = p +.+ 2 *.* newDir
reflectVel = magV bulVel *.* newDir
addBouncer = worldEvents %~ ((over particles' (bouncer :) ) . )
bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
bulPenCr' :: Particle' -> Point2 -> Creature -> World -> World
bulPenCr' bt p cr w
@@ -142,22 +151,20 @@ bulHitWall' bt p x w = damageBlocks x
_ -> w
bulBounceWall' :: Particle' -> Point2 -> Wall -> World -> World
bulBounceWall' bt p wl w = damageBlocks wl
$ over worldEvents addBouncer
-- yay for hack -- should have used this before? or never?
w
where sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
_ -> w
bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
reflectVel = (reflectIn wallV (_btVel' bt))
addBouncer = (.) (over particles' ((:) bouncer))
bulBounceWall' bt p wl w = damageBlocks wl $ over worldEvents addBouncer w
where
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
_ -> w
bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
reflectVel = (reflectIn wallV (_btVel' bt))
addBouncer = (.) (over particles' ((:) bouncer))
-- the hack is to get around the fact that the particles' list gets reset after
-- all projectiles in it are checked, so we cannot add to it as we accumulate over
-- this list
+1 -8
View File
@@ -17,20 +17,13 @@ import qualified SDL as SDL
import LoadConfig
updateCamera :: World -> World
updateCamera = rotCam . moveCamera . updateAimTime . updateScopeZoom
updateAimTime :: World -> World
updateAimTime w
| SDL.ButtonRight `S.member` _mouseButtons w
= w & cameraAimTime %~ \t -> min (t+1) 10
| otherwise = w & cameraAimTime %~ \t -> max (t-1) 0
updateCamera = rotCam . moveCamera . updateScopeZoom
moveCamera :: World -> World
moveCamera w = w & cameraCenter .~ idealPos
& cameraViewFrom .~ sightFrom
where aimRangeFactor | _cameraZoom w == 0 = 0
| otherwise = (fromMaybe 0 $ yourItem w ^? itAimingRange) / _cameraZoom w
aimTimeFactor = fromIntegral (w ^. cameraAimTime) / 10
aimingMult | SDL.ButtonRight `S.member` _mouseButtons w = 1
| otherwise = 0
ypos = _crPos $ you w