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
-- 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
src/Dodge/Critters.hs
+3 -1
View File
@@ -350,7 +350,8 @@ startCr = defaultCreature
, _crHP = 10000
, _crMaxHP = 1500
, _crInv = IM.fromList (zip [0..20]
([pistol,autoGun,launcher,lasGun,grenade
(
[pistol,autoGun,launcher,lasGun,grenade
,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher
,longGun
,hvAutoGun
@@ -361,6 +362,7 @@ startCr = defaultCreature
,bezierGun
,poisonSprayer
,blinkGun
,frontArmour
]
++ repeat NoItem))
-- startInv
src/Dodge/Data.hs
+65 -61
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
, _cameraRot :: !Float
, _cameraZoom :: !Float
, _cameraViewFrom :: !Point2
@@ -68,7 +55,6 @@ data World = World
, _decorations :: IM.IntMap Picture
, _corpses :: IM.IntMap (IM.IntMap [Corpse])
, _clickMousePos :: (Float,Float)
, _lbRotation :: Float
, _pathGraph :: ~(Gr Point2 Float)
, _pathGraph' :: ~[(Point2,Point2)]
, _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)]))
@@ -96,9 +82,18 @@ data Corpse = Corpse
, _cpRes :: Creature
}
data Layer = PtLayer | CrLayer | WlLayer | BgLayer | ShadowLayer
| FlItLayer | LabelLayer | InvLayer | MenuLayer
| PressPlateLayer | CorpseLayer
data Layer
= PtLayer
| CrLayer
| WlLayer
| BgLayer
| ShadowLayer
| FlItLayer
| LabelLayer
| InvLayer
| MenuLayer
| PressPlateLayer
| CorpseLayer
| UPtLayer
| HPtLayer
| GloomLayer
@@ -113,8 +108,7 @@ data Cloud = Cloud
, _clEffect :: Cloud -> World -> World
}
data LightSource
= LS
data LightSource = LS
{ _lsID :: !Int
, _lsPos :: !Point2
, _lsDir :: !Float
@@ -122,8 +116,8 @@ data LightSource
, _lsIntensity :: !Float
}
data TempLightSource =
TLS { _tlsPos :: !Point2
data TempLightSource = TLS
{ _tlsPos :: !Point2
, _tlsRad :: !Float
, _tlsIntensity :: !Float
, _tlsUpdate :: World -> TempLightSource -> (World, Maybe TempLightSource)
@@ -147,8 +141,8 @@ data Creature = Creature
, _crCorpse :: Picture
}
data CreatureState
= CrSt { _goals :: [[Goal]]
data CreatureState = CrSt
{ _goals :: [[Goal]]
, _stance :: Stance
, _faction :: Faction
, _crDamage :: [DamageType]
@@ -156,11 +150,13 @@ data CreatureState
, _crSpState :: CrSpState
, _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
}
-- deriving (Eq,Show)
data CrSpState = Barrel { _piercedPoints :: [Point2]}
data CrSpState
= Barrel { _piercedPoints :: [Point2]}
| GenCr
deriving (Eq,Show,Ord)
data Goal = MoveTo Point2
data Goal
= MoveTo Point2
| MoveToFor Point2 Int
| MoveFire Point2 Point2
| PathTo Point2
@@ -209,23 +205,22 @@ data Goal = MoveTo Point2
| MakeJudgement
| SetPosture Posture
deriving (Eq,Show)
data Stance = Stance {_carriage :: Carriage
data Stance = Stance
{_carriage :: Carriage
,_posture :: Posture
}
deriving (Eq,Show)
data Carriage = Walking {_stepCycle :: Int
,_stepToAdd :: Int
}
data Carriage
= Walking { _stepCycle :: Int, _stepToAdd :: Int }
| Floating
| Boosting Point2
deriving (Eq,Show)
data Posture = Aiming
| AtEase
data Posture = Aiming | AtEase
deriving (Eq,Show)
data Mind = ZombieMind
| HumanMind
data Mind = ZombieMind | HumanMind
deriving (Eq,Show)
data Faction = GenericFaction Int
data Faction
= GenericFaction Int
| ZombieFaction
| EncircleFlock
| ChaseCritters
@@ -234,9 +229,7 @@ data Faction = GenericFaction Int
deriving (Eq,Show)
-- NOTE: walls must be drawn counterclockwise
data WorldState = DoorNumOpen Int
| CrNumAlive Int
data WorldState = DoorNumOpen Int | CrNumAlive Int
deriving (Eq,Ord)
data MenuState
@@ -259,7 +252,8 @@ data Button = Button
data ButtonState = BtOn | BtOff | BtNoLabel
deriving (Eq, Show)
data PressPlate = PressPlate { _ppPict :: Picture
data PressPlate = PressPlate
{ _ppPict :: Picture
, _ppPos :: Point2
, _ppRot :: Float
, _ppEvent :: PressPlate -> World -> World
@@ -269,13 +263,12 @@ data PressPlate = PressPlate { _ppPict :: Picture
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
data Item
= Weapon
{ _itName :: String
, _wpMaxAmmo :: Int
, _wpLoadedAmmo :: Int
@@ -369,7 +362,8 @@ data Item = Weapon
| NoItem
data ItAttachment
= ItScope {_scopePos :: Point2
= ItScope
{_scopePos :: Point2
,_scopeZoomChange :: Int
,_scopeZoom :: Float
,_scopeIsCamera :: Bool
@@ -380,14 +374,17 @@ data ItAttachment
| ItTargetPos { _itTargetPos :: Point2 }
data ItEffect = NoItEffect
| ItInvEffect {_itInvEffect :: Creature -> Int -> World -> World
| ItInvEffect
{_itInvEffect :: Creature -> Int -> World -> World
,_itEffectCounter :: Int
}
| ItEffect {_itInvEffect :: Creature -> Int -> World -> World
| ItEffect
{_itInvEffect :: Creature -> Int -> World -> World
,_itFloorEffect :: Int -> World -> World
,_itEffectCounter :: Int
}
data ItZoom = ItZoom {_itAimZoomMax :: Float
data ItZoom = ItZoom
{_itAimZoomMax :: Float
,_itAimZoomMin :: Float
,_itAimZoomFac :: Float
,_itZoomMax :: Float
@@ -397,7 +394,8 @@ data ItZoom = ItZoom {_itAimZoomMax :: Float
data IntID a = IntID Int a
data HammerPosition = HammerDown
data HammerPosition
= HammerDown
| HammerReleased
| HammerUp
| NoHammer
@@ -439,7 +437,8 @@ data Particle'
{ _ptDraw :: Particle' -> Picture
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
}
| Bul' { _ptDraw :: Particle' -> Picture
| Bul'
{ _ptDraw :: Particle' -> Picture
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
, _btVel' :: Point2
, _btColor' :: Color
@@ -449,7 +448,8 @@ data Particle'
, _btTimer' :: Int
, _btHitEffect' :: HitEffect
}
| Pt' { _ptDraw :: Particle' -> Picture
| Pt'
{ _ptDraw :: Particle' -> Picture
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
, _btVel' :: Point2
, _btColor' :: Color
@@ -475,7 +475,8 @@ type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] ->
-> (World,Maybe Particle')
data Projectile = Projectile { _ptPos :: Point2
data Projectile = Projectile
{ _ptPos :: Point2
, _ptStartPos :: Point2
, _ptVel :: Point2
, _ptPict :: Picture
@@ -483,14 +484,19 @@ data Projectile = Projectile { _ptPos :: Point2
, _ptUpdate :: World -> World
}
data DamageType = Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
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
| Concussive
{ _dmAmount :: Int
, _dmFrom :: Point2
, _dmPush :: Float
, _dmPushExp :: Float
, _dmPushRadius :: Float}
, _dmPushRadius :: Float
}
| TorqueDam {_dmAmount :: Int , _dmTorque :: Float }
| PushDam {_dmAmount :: Int , _dmPushBack :: Point2 }
| PoisonDam {_dmAmount :: Int}
@@ -542,7 +548,8 @@ data Wall
, _blShadows :: [Int]
}
data ForceField = FF { _ffLine :: [Point2] , _ffID :: Int
data ForceField = FF
{ _ffLine :: [Point2] , _ffID :: Int
, _ffColor :: Color
, _ffDeflect :: Maybe (StdGen -> Point2 -> ForceField -> (Point2,StdGen))
, _ffState :: FFState
@@ -587,8 +594,7 @@ data PSType = PutCrit Creature
, _collectiveFunction :: [Int] -> State StdGen [PSType]
}
| LabelPS { _psLabel :: Int, _ps :: PSType}
| PutWindow { _pwPoly :: [Point2]
, _pwColor :: Color
| PutWindow { _pwPoly :: [Point2] , _pwColor :: Color
}
data PlacementSpot = PS
{ _psPos :: Point2
@@ -635,8 +641,6 @@ makeLenses ''Button
makeLenses ''PSType
makeLenses ''PlacementSpot
makeLenses ''Room
--
-- }}}
numColor :: Int -> Color
numColor 0 = (1,0,0,1)
src/Dodge/Default.hs
-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
src/Dodge/Item/Weapon.hs
+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)
src/Dodge/Item/Weapon/Bullet.hs
+42 -35
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
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 = over (creatures . ix cid . crState . crDamage)
(\dams -> (Piercing 100 sp p ep : mvDams) ++ dams)
addDamageArmoured = over (creatures . ix cid . crState . crDamage)
(\dams -> mvDams ++ dams)
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)
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
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,11 +151,9 @@ 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
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
src/Dodge/Update/Camera.hs
+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