From 62b5ffbfaa28c3807948282299ede3a5a2877ccf Mon Sep 17 00:00:00 2001 From: jgk Date: Fri, 26 Mar 2021 23:49:07 +0100 Subject: [PATCH] Cleanup Data --- src/Dodge/Creature/LookupStatus.hs | 10 +- src/Dodge/Critters.hs | 30 +- src/Dodge/Data.hs | 750 +++++++++++++++-------------- src/Dodge/Default.hs | 2 - src/Dodge/Item/Weapon.hs | 3 +- src/Dodge/Item/Weapon/Bullet.hs | 111 +++-- src/Dodge/Update/Camera.hs | 9 +- 7 files changed, 460 insertions(+), 455 deletions(-) diff --git a/src/Dodge/Creature/LookupStatus.hs b/src/Dodge/Creature/LookupStatus.hs index 0144993bd..f07579c11 100644 --- a/src/Dodge/Creature/LookupStatus.hs +++ b/src/Dodge/Creature/LookupStatus.hs @@ -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 diff --git a/src/Dodge/Critters.hs b/src/Dodge/Critters.hs index c1b56821b..a35fa0f3c 100644 --- a/src/Dodge/Critters.hs +++ b/src/Dodge/Critters.hs @@ -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] } diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index d75953019..bf1cd0043 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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) diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 5f99c6e0e..f31aaac35 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -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 diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 8f05a6db4..2660c1d5d 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -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) diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index 8a0bfb163..82b18ef2a 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -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 diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index d99feeac9..8ad77d62b 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -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