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

Cleanup Data

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