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

Add source files, commit before reverting pictures to lists

Browse Source
This commit is contained in:
justin
2021-02-15 00:07:55 +01:00
parent c6bcfacc7a
commit 8447844bcd
41 changed files with 13677 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+715
View File
@@ -0,0 +1,715 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
--{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data
( module Dodge.Data
, Point2 (..)
)
where
-- imports {{{
import Picture.Data
import Geometry.Data
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 (Keycode, MouseButton)
import Graphics.Rendering.OpenGL (PrimitiveMode (..),GLfloat,Program,VertexArrayObject,BufferObject)
import Codec.Picture (Image,PixelRGBA8)
import qualified Data.DList as DL
--}}}
-- datatypes {{{
data World = World
{ _keys :: !(S.Set Keycode)
, _mouseButtons :: !(S.Set MouseButton)
, _cameraPos :: !Point2
, _cameraAimTime :: Int
, _cameraRot :: !Float
, _cameraZoom :: !Float
, _cameraCenter :: !Point2
, _creatures :: IM.IntMap Creature
, _creaturesZone :: IM.IntMap (IM.IntMap (IM.IntMap Creature))
, _itemPositions :: IM.IntMap ItemPos
, _clouds :: IM.IntMap Cloud
, _cloudsZone :: IM.IntMap (IM.IntMap (IM.IntMap Cloud))
, _particles :: IM.IntMap Particle
, _particles' :: ![Particle']
, _afterParticles' :: ![Particle']
, _smoke :: [Smoke]
, _walls :: !(IM.IntMap Wall)
, _wallsZone :: (IM.IntMap (IM.IntMap (IM.IntMap Wall)))
, _forceFields :: IM.IntMap ForceField
, _floorItems :: IM.IntMap FloorItem
, _randGen :: StdGen
, _mousePos :: !(Float,Float)
, _testString :: String
, _yourID :: !Int
, _worldEvents :: !(World -> World)
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _soundQueue :: [Int]
-- , _loadedSounds :: IM.IntMap Mix.Chunk
, _sounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Drawing
, _corpses :: IM.IntMap (IM.IntMap [Corpse])
, _lbClickMousePos :: (Float,Float)
, _lbRotation :: Float
, _pathGraph :: ~(Gr Point2 Float)
, _pathGraph' :: ~[(Point2,Point2)]
, _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)]))
, _pathInc :: ~(M.Map Point2 [Point2])
, _unlimitedAmmo :: Bool
, _storedLevel :: Maybe World
, _menuState :: MenuState
, _worldState :: M.Map WorldState Bool
, _windowX :: Float
, _windowY :: Float
, _mapDisplay :: (Bool, Float)
, _lightSources :: !(IM.IntMap LightSource)
, _tempLightSources :: ![TempLightSource]
} --deriving (Show)
type Drawing = Picture
data Corpse = Corpse
{ _cpPos :: Point2
, _cpPict :: Drawing
, _cpRes :: Creature
}
data Layer = PtLayer | CrLayer | WlLayer | BgLayer | ShadowLayer
| FlItLayer | LabelLayer | InvLayer | MenuLayer
| PressPlateLayer | CorpseLayer
| UPtLayer
| HPtLayer
| GloomLayer
data Cloud = Cloud
{ _clID :: Int
, _clPos :: Point2
, _clVel :: Point2
, _clPict :: Cloud -> Drawing
, _clRad :: Float
, _clTimer :: Int
, _clEffect :: Cloud -> World -> World
}
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 Creature = Creature
{ _crPos :: Point2
, _crOldPos :: Point2
, _crDir :: Float
, _crID :: Int
, _crPict :: Creature -> Drawing
, _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
, _crAmmo :: M.Map Ammo Int
, _crState :: CreatureState
, _crCorpse :: Drawing
}
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
deriving (Eq,Show)
-- NOTE: walls must be drawn counterclockwise
data WorldState = DoorNumOpen Int
| CrNumAlive Int
deriving (Eq,Ord)
data MenuState
= LevelMenu Int
| PauseMenu
| GameOverMenu
| InGame
data Sound = Sound { _soundTime :: Int
, _soundFadeTime :: Int
, _soundChannel :: Maybe Int
, _soundPos :: Maybe Point2
, _soundType :: Int
}
deriving (Eq,Ord,Show)
data Button = Button
{ _btPict :: Drawing
, _btPos :: Point2
, _btRot :: Float
, _btEvent :: Button -> World -> World
, _btID :: Int
, _btText :: String
, _btState :: ButtonState
}
data ButtonState = BtOn | BtOff | BtNoLabel
deriving (Eq, Show)
data PressPlate = PressPlate { _ppPict :: Drawing
, _ppPos :: Point2
, _ppRot :: Float
, _ppEvent :: PressPlate -> World -> World
, _ppID :: Int
, _ppText :: String
}
data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int}
| FlAm { _flAm :: Ammo , _flItPos :: Point2 , _flAmNum :: Int , _flItID :: Int}
data ItemPos = InInv { _itCrId :: Int
, _itInvId :: Int
}
| OnFloor { _itFlID :: Int
}
data Item = Weapon
{ _itName :: String
, _wpMaxAmmo :: Int
, _wpLoadedAmmo :: Int
, _wpAmmoType :: Ammo
, _wpReloadTime :: Int
, _wpReloadState :: Int
, _wpFireRate :: Int
, _wpFireState :: Int
, _wpFire :: Int -> World -> World
, _wpSpread :: Float
, _wpRange :: Float
, _itHammer :: HammerPosition
, _itFloorPict :: Drawing
, _itMaxStack :: Int
, _itAmount :: Int
, _itAimingSpeed :: Float
, _itAimingRange :: Float
, _itZoom :: ItZoom
, _itEquipPict :: Creature -> Int -> Drawing
, _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 :: Drawing
, _itEquipPict :: Creature -> Int -> Drawing
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
, _itEffect :: ItEffect
, _itHammer :: HammerPosition
}
| Craftable
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: Drawing
, _itEquipPict :: Creature -> Int -> Drawing
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
}
| Equipment
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: Drawing
, _itEquipPict :: Creature -> Int -> Drawing
, _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 :: Drawing
, _twMaxRange :: Float
, _twAccuracy :: Float
, _twFire :: Int -> World -> World
, _itAimingSpeed :: Float
, _itAimingRange :: Float
, _itZoom :: ItZoom
, _itEquipPict :: Creature -> Int -> Drawing
, _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
}
| ItFuse {_itFuseTime :: Int}
| ItPhaseV {_itPhaseV :: Float}
| ItMode {_itMode :: Int}
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
}
data IntID a = IntID Int a
data HammerPosition = HammerDown
| HammerReleased
| HammerUp
| NoHammer
data ItemIdentity
= Pistol
| SpreadGun
| MultGun
| HvAutoGun
| AutoGun
| LtAutoGun
| MiniGun
| Medkit25
| MagShield
| FrontArmour
| JetPack
| FlameShield
| Generic
| SparkGun
| ShatterGun
| LongGun
| Flamethrower
| Blinker
| Grenade
| RemoteBomb
| TeslaGun
| LasGun
| ForceFieldGun
| GrapGun
| TractorGun
| Launcher
| RemoteLauncher
| LightningGun
| PoisonSprayer
deriving (Eq,Show,Ord,Enum)
data Particle' =
Particle' { _ptPict' :: Drawing
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
}
| Bul' { _ptPict' :: Drawing
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
, _btVel' :: Point2
, _btColor' :: Color
, _btTrail' :: [Point2]
, _btPassThrough' :: Maybe Int
, _btWidth' :: Float
, _btTimer' :: Int
, _btHitEffect' :: HitEffect'
}
| Pt' { _ptPict' :: Drawing
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
, _btVel' :: Point2
, _btColor' :: Color
, _btPos' :: Point2
, _btPassThrough' :: Maybe Int
, _btWidth' :: Float
, _btTimer' :: Int
, _btHitEffect' :: HitEffect'
}
| Shockwave'
{ _ptPict' :: Drawing
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
, _btColor' :: Color
, _btPos' :: Point2
, _btRad' :: Float
, _btDam' :: Int
, _btPush' :: Float
, _btMaxTime' :: Int
, _btTimer' :: Int
}
type HitEffect = Point2 -> Point2 -> (Point2, (Either3 Creature Wall ForceField)) -> World -> World
type HitEffect' = Particle' -> (Point2, (Either3 Creature Wall ForceField)) -> World -> World
data Particle =
Particle { _ptPos :: Point2
, _ptStartPos :: Point2
, _ptVel :: Point2
, _ptPict :: Drawing
, _ptID :: Int
, _ptUpdate :: World -> World
}
| Bullet { _ptPos :: Point2
, _ptVel :: Point2
, _ptPict :: Drawing
, _ptID :: Int
, _ptUpdate :: World -> World
, _btTrail :: [Point2]
, _btPassThrough :: Maybe Int
, _btColor :: Color
, _btWidth :: Float
-- , _btHitEffect :: Particle -> [(Point2, Either3 Creature Wall ForceField)] -> World -> World
}
| Bullet'
{ _ptPos :: Point2
, _ptVel :: Point2
, _ptPict :: Drawing
, _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 Either3 a b c = E3x1 a | E3x2 b | E3x3 c
data Smoke =
Smoke
{ _smPos :: Point2
, _smRad :: Float
, _smColor :: Color
, _smUpdate :: Smoke -> Maybe Smoke
, _smPs :: [Point2]
, _smTime :: Int
}
data WLID = WLID { _wlIDx :: Int, _wlIDy :: Int, _wlIDid :: Int}
data Wall = Wall
{ _wlLine :: [Point2] , _wlID :: Int
, _wlColor :: Color
, _wlDraw :: Maybe (Wall -> Drawing)
, _wlSeen :: Bool
, _wlIsSeeThrough :: Bool
-- , _wlID' :: WLID
}
| BlockAutoDoor
{ _wlLine :: [Point2]
, _wlID :: Int
, _doorMech :: World -> World
, _wlColor :: Color
, _wlDraw :: Maybe (Wall -> Drawing)
, _wlSeen :: Bool
, _blIDs :: [Int]
, _blHP :: Int
, _wlIsSeeThrough :: Bool
-- , _wlID' :: WLID
}
| AutoDoor
{ _wlLine :: [Point2] , _wlID :: Int
, _doorMech :: World -> World
, _wlColor :: Color
, _wlDraw :: Maybe (Wall -> Drawing)
, _wlSeen :: Bool
, _wlIsSeeThrough :: Bool
-- , _wlID' :: WLID
-- , _doorLine :: [Point2]
}
| Door
{ _wlLine :: [Point2] , _wlID :: Int
, _doorMech :: World -> World
, _wlColor :: Color
, _wlDraw :: Maybe (Wall -> Drawing)
, _wlSeen :: Bool
, _wlIsSeeThrough :: Bool
-- , _wlID' :: WLID
-- , _doorLine :: [Point2]
}
| Block
{ _wlLine :: [Point2]
, _wlID :: Int
, _wlColor :: Color
, _wlDraw :: Maybe (Wall -> Drawing)
, _wlSeen :: Bool
, _blIDs :: [Int]
, _blHP :: Int
, _wlIsSeeThrough :: Bool
, _blVisible :: Bool
, _blShadows :: [Int]
, _blDegrades :: [Int]
-- , _wlID' :: WLID
}
data Block' = Block'
{ _blPoly :: [Point2]
, _blLines :: [[Point2]]
, _blColor :: Color
, _blSeen :: Bool
, _blHP' :: [Int]
, _blVisible' :: Bool
, _blShadows' :: [Int]
, _blID :: Int
}
data ForceField = FF { _ffLine :: [Point2] , _ffID :: Int
, _ffColor :: Color
, _ffDeflect :: Maybe (StdGen -> Point2 -> ForceField -> (Point2,StdGen))
, _ffState :: FFState
}
data FFState = FFDestroyable { _ffsHP :: Int }
data Ammo = PistolBullet | LiquidFuel | Battery | Shell
deriving (Eq,Ord,Enum)
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)
type Poly = [Point2]
data PSType = PutCrit Creature
| PutLS LightSource Drawing
| PutButton Button
| PutFlIt FloorItem
| PutPressPlate PressPlate
| PutAutoDoor Point2 Point2
| PutBlock [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
}
data PlacementSpot = PS
{ _psPos :: Point2
, _psRot :: Float
, _psType :: PSType
}
data Room = Room
{ _rmPolys :: [Poly]
, _rmLinks :: [(Point2,Float)]
, _rmPath :: [(Point2, Point2)]
, _rmPS :: [PlacementSpot]
, _rmBound :: Poly
}
data SubNode a = SN a | InLink | OutLink
data RoomLink = RL {_rlPos :: Point2, _rlRot :: Float}
makeLenses ''RoomLink
makeLenses ''World
makeLenses ''Cloud
makeLenses ''Creature
makeLenses ''CreatureState
makeLenses ''CrSpState
makeLenses ''Goal
makeLenses ''LightSource
makeLenses ''TempLightSource
makeLenses ''Stance
makeLenses ''Carriage
makeLenses ''Posture
makeLenses ''Item
makeLenses ''ItemPos
makeLenses ''ItEffect
makeLenses ''ItAttachment
makeLenses ''ItZoom
makeLenses ''FloorItem
makeLenses ''Particle
makeLenses ''Particle'
makeLenses ''Wall
makeLenses ''Smoke
makeLenses ''ForceField
makeLenses ''FFState
makeLenses ''PressPlate
makeLenses ''Button
makeLenses ''PSType
makeLenses ''PlacementSpot
makeLenses ''Room
makeLenses ''Sound
--
-- }}}
numColor :: Int -> Color
numColor 0 = (1,0,0,1)
numColor 1 = (0,1,0,1)
numColor 2 = (0,0,1,1)
numColor 3 = (1,1,0,1)
numColor 4 = (0,1,1,1)
numColor 5 = (1,0,1,1)
numColor 6 = (1,0,0.5,1)
numColor 7 = (0.5,0,1,1)
numColor 8 = (0,0.5,1,1)
numColor 9 = (0,1,0.5,1)
numColor 10 = (0.5,1,0,1)
numColor 11 = (1,0.5,0,1)
numColor 12 = (1,1,1,1)