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

Cleanup module pathing

Browse Source
This commit is contained in:
justin
2022-07-27 17:37:18 +01:00
parent b52adddd5d
commit 8aa5c17ab9
27 changed files with 484 additions and 517 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+15 -146
View File
@@ -1,4 +1,3 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
@@ -15,142 +14,49 @@ The warnings have been disabled.
-} -}
module Dodge.Data ( module Dodge.Data (
module Dodge.Data, module Dodge.Data,
module Dodge.Data.CrGroupParams,
module Dodge.Data.Corpse,
module Dodge.Data.ActionPlan,
module Dodge.Data.CreatureEffect,
module Dodge.Data.WorldEffect,
module Dodge.Data.Button,
module Dodge.Data.Beam,
module Dodge.Data.Hammer,
module Dodge.Data.ArcStep, module Dodge.Data.ArcStep,
module Dodge.Data.CrWlID,
module Dodge.Data.Gas,
module Dodge.Data.Ammo,
module Dodge.Data.Payload,
module Dodge.Data.RadarSweep,
module Dodge.Data.PosEvent,
module Dodge.Data.EnergyBall,
module Dodge.Data.Flame,
module Dodge.Data.Magnet,
module Dodge.Data.Spark,
module Dodge.Data.Bullet,
module Dodge.Data.Door,
module Dodge.Data.Item,
module Dodge.Data.HUD,
module Dodge.Data.Cloud,
module Dodge.Data.RightButtonOptions,
module Dodge.Data.Material,
module Dodge.Data.LightSource,
module Dodge.Data.Creature,
module Dodge.Data.Block,
module Dodge.Data.Flare,
module Dodge.Data.LoadAction,
module Dodge.Data.ForegroundShape,
module Dodge.Data.Wall,
module Dodge.Data.Object,
module Dodge.Data.Zoning, module Dodge.Data.Zoning,
module Dodge.Data.Bounds,
module Dodge.Data.Sensor,
module Dodge.Data.Distortion, module Dodge.Data.Distortion,
module Dodge.Data.Damage, module Dodge.Data.Material,
module Dodge.Data.SoundOrigin, module Dodge.Data.SoundOrigin,
module Dodge.Data.Hammer,
module Dodge.Data.RightButtonOptions,
module Dodge.Data.Config, module Dodge.Data.Config,
module MaybeHelp, module MaybeHelp,
module Dodge.Data.RoomCluster, module Dodge.Data.RoomCluster,
module Dodge.Data.Room, module Dodge.Data.Room,
module Dodge.Data.RadarBlip,
module Dodge.Data.PathGraph,
module Dodge.Data.Gust,
module Dodge.Data.Projectile,
module Dodge.Data.Modification,
module Dodge.Data.PressPlate,
module Dodge.Data.Laser,
module Dodge.Data.TeslaArc,
module Dodge.Data.Shockwave,
module Dodge.Data.Prop,
module Dodge.Data.LinearShockwave,
module Dodge.Data.TractorBeam,
module Dodge.Data.MountedObject,
module Dodge.Data.Machine,
module Dodge.Data.GenParams,
module Dodge.Data.Terminal,
module Dodge.Data.FloorItem,
module Dodge.Data.CWorld, module Dodge.Data.CWorld,
module Dodge.Data.ObjectType,
module Dodge.Data.CrWlID,
module Dodge.Data.CreatureEffect,
module Dodge.Data.MountedObject,
) where ) where
import Dodge.Data.CWorld
import Color import Color
import Control.Lens import Control.Lens
import Control.Monad.State import Control.Monad.State
import Data.Aeson
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Preload import Data.Preload
import qualified Data.Set as S import qualified Data.Set as S
import qualified Data.Text as T import qualified Data.Text as T
import Data.Tile import Data.Tile
import Dodge.Data.Config
import Dodge.Config.KeyConfig import Dodge.Config.KeyConfig
import Dodge.Data.ActionPlan import Dodge.Data.ActionPlan
import Dodge.Data.Ammo
import Dodge.Data.ArcStep import Dodge.Data.ArcStep
import Dodge.Data.Beam import Dodge.Data.CWorld
import Dodge.Data.Block import Dodge.Data.Config
import Dodge.Data.Bounds
import Dodge.Data.Bullet
import Dodge.Data.Button
import Dodge.Data.Cloud
import Dodge.Data.Corpse
import Dodge.Data.CrGroupParams
import Dodge.Data.CrWlID import Dodge.Data.CrWlID
import Dodge.Data.Creature
import Dodge.Data.CreatureEffect import Dodge.Data.CreatureEffect
import Dodge.Data.Damage import Dodge.Data.Distortion
import Dodge.Data.Door
import Dodge.Data.EnergyBall
import Dodge.Data.Flame
import Dodge.Data.Flare
import Dodge.Data.FloorItem
import Dodge.Data.ForegroundShape
import Dodge.Data.Gas
import Dodge.Data.GenParams
import Dodge.Data.Gust
import Dodge.Data.HUD
import Dodge.Data.Hammer import Dodge.Data.Hammer
import Dodge.Data.Item
import Dodge.Data.Laser
import Dodge.Data.LightSource
import Dodge.Data.LinearShockwave
import Dodge.Data.LoadAction
import Dodge.Data.Machine
import Dodge.Data.Magnet
import Dodge.Data.Material import Dodge.Data.Material
import Dodge.Data.Modification
import Dodge.Data.MountedObject import Dodge.Data.MountedObject
import Dodge.Data.Object import Dodge.Data.ObjectType
import Dodge.Data.PathGraph
import Dodge.Data.Payload
import Dodge.Data.PosEvent
import Dodge.Data.PressPlate
import Dodge.Data.Projectile
import Dodge.Data.Prop
import Dodge.Data.RadarBlip
import Dodge.Data.RadarSweep
import Dodge.Data.RightButtonOptions import Dodge.Data.RightButtonOptions
import Dodge.Data.Room import Dodge.Data.Room
import Dodge.Data.Sensor
import Dodge.Data.Shockwave
import Dodge.Data.SoundOrigin
import Dodge.Data.Spark
import Dodge.Data.Terminal
import Dodge.Data.TeslaArc
import Dodge.Data.TractorBeam
import Dodge.Data.Wall
import Dodge.Data.WorldEffect
import Dodge.Data.Zoning
import Dodge.Data.Distortion
import Dodge.Data.RoomCluster import Dodge.Data.RoomCluster
import GHC.Generics import Dodge.Data.SoundOrigin
import Dodge.Data.Zoning
import Geometry.Data import Geometry.Data
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import MaybeHelp import MaybeHelp
@@ -198,49 +104,16 @@ data World = World
, _rbOptions :: RightButtonOptions , _rbOptions :: RightButtonOptions
} }
instance ToJSON MouseButton where
toEncoding = genericToEncoding defaultOptions
instance FromJSON MouseButton
instance ToJSONKey MouseButton
instance FromJSONKey MouseButton
instance ToJSON Scancode where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Scancode
instance ToJSONKey Scancode
instance FromJSONKey Scancode
data TimeFlowStatus data TimeFlowStatus
= RewindingNow = RewindingNow
| RewindingLastFrame | RewindingLastFrame
| NormalTimeFlow | NormalTimeFlow
deriving (Eq, Ord, Show, Read, Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON TimeFlowStatus where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TimeFlowStatus
data WorldHammer data WorldHammer
= SubInvHam = SubInvHam
| DoubleMouseHam | DoubleMouseHam
deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic) deriving (Eq, Ord, Show, Read, Enum, Bounded)
instance ToJSON WorldHammer where
toEncoding = genericToEncoding defaultOptions
instance FromJSON WorldHammer
instance ToJSONKey WorldHammer
instance FromJSONKey WorldHammer
data SaveSlot data SaveSlot
= QuicksaveSlot = QuicksaveSlot
@@ -295,15 +168,12 @@ data MenuOption
data IntID a = IntID Int a data IntID a = IntID Int a
type HitEffect' = type HitEffect' =
Flame -> Flame ->
Stream (Of (Point2, Either Creature Wall)) Identity () -> Stream (Of (Point2, Either Creature Wall)) Identity () ->
World -> World ->
(World, Maybe Flame) (World, Maybe Flame)
data Either3 a b c = E3x1 a | E3x2 b | E3x3 c
---- ROOM DATATYPES ---- ROOM DATATYPES
data PSType data PSType
= PutCrit {_unPutCrit :: Creature} = PutCrit {_unPutCrit :: Creature}
@@ -414,7 +284,6 @@ data InPlacement = InPlacement
makeLenses ''World makeLenses ''World
--makeLenses ''Particle
makeLenses ''Universe makeLenses ''Universe
makeLenses ''ScreenLayer makeLenses ''ScreenLayer
makeLenses ''GenWorld makeLenses ''GenWorld
src/Dodge/Data/ArcStep.hs
+21 -11
View File
@@ -1,25 +1,35 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.ArcStep where module Dodge.Data.ArcStep where
import Dodge.Data.CrWlID
import Geometry.Data
import Control.Lens import Control.Lens
import GHC.Generics
import Data.Aeson import Data.Aeson
import Dodge.Data.CrWlID
import GHC.Generics
import Geometry.Data
data ArcStep = ArcStep data ArcStep = ArcStep
{ _asPos :: Point2 { _asPos :: Point2
, _asDir :: Float , _asDir :: Float
, _asObject :: CrWlID --Maybe (Either Creature Wall) , _asObject :: CrWlID --Maybe (Either Creature Wall)
} }
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON ArcStep where
instance ToJSON ArcStep where
toEncoding = genericToEncoding defaultOptions toEncoding = genericToEncoding defaultOptions
instance FromJSON ArcStep
data NextArcStep = EndArc instance FromJSON ArcStep
data NextArcStep
= EndArc
| DefaultArcStep | DefaultArcStep
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON NextArcStep where
instance ToJSON NextArcStep where
toEncoding = genericToEncoding defaultOptions toEncoding = genericToEncoding defaultOptions
instance FromJSON NextArcStep
instance FromJSON NextArcStep
makeLenses ''ArcStep makeLenses ''ArcStep
src/Dodge/Data/CWorld.hs
+41
View File
@@ -3,6 +3,47 @@
module Dodge.Data.CWorld ( module Dodge.Data.CWorld (
module Dodge.Data.CWorld, module Dodge.Data.CWorld,
module Dodge.Data.Beam,
module Dodge.Data.Block,
module Dodge.Data.Bounds,
module Dodge.Data.Bullet,
module Dodge.Data.Button,
module Dodge.Data.Cloud,
module Dodge.Data.Corpse,
module Dodge.Data.CrGroupParams,
module Dodge.Data.Creature,
module Dodge.Data.Damage,
module Dodge.Data.Distortion,
module Dodge.Data.Door,
module Dodge.Data.EnergyBall,
module Dodge.Data.Flame,
module Dodge.Data.Flare,
module Dodge.Data.FloorItem,
module Dodge.Data.ForegroundShape,
module Dodge.Data.GenParams,
module Dodge.Data.Gust,
module Dodge.Data.HUD,
module Dodge.Data.Item,
module Dodge.Data.Laser,
module Dodge.Data.LightSource,
module Dodge.Data.LinearShockwave,
module Dodge.Data.Machine,
module Dodge.Data.Magnet,
module Dodge.Data.Modification,
module Dodge.Data.PathGraph,
module Dodge.Data.PosEvent,
module Dodge.Data.PressPlate,
module Dodge.Data.Projectile,
module Dodge.Data.Prop,
module Dodge.Data.RadarBlip,
module Dodge.Data.RadarSweep,
module Dodge.Data.Shockwave,
module Dodge.Data.Spark,
module Dodge.Data.Terminal,
module Dodge.Data.TeslaArc,
module Dodge.Data.TractorBeam,
module Dodge.Data.Wall,
module Dodge.Data.WorldEffect,
) where ) where
import Control.Lens import Control.Lens
src/Dodge/Data/CrWlID.hs
+10 -9
View File
@@ -1,13 +1,14 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.CrWlID where module Dodge.Data.CrWlID where
import GHC.Generics
import Data.Aeson
import Control.Lens import Control.Lens
data CrWlID = CrID Int | WlID Int | NothingID -- TODO rewrite/remove this import Data.Aeson
deriving (Eq,Ord,Show,Read,Generic) import Data.Aeson.TH
instance ToJSON CrWlID where
toEncoding = genericToEncoding defaultOptions data CrWlID = CrID Int | WlID Int | NothingID -- TODO rewrite/remove this
instance FromJSON CrWlID deriving (Eq, Ord, Show, Read)
makeLenses ''CrWlID makeLenses ''CrWlID
deriveJSON defaultOptions ''CrWlID
src/Dodge/Data/Creature.hs
+1 -1
View File
@@ -9,6 +9,7 @@ module Dodge.Data.Creature (
module Dodge.Data.Creature.Perception, module Dodge.Data.Creature.Perception,
module Dodge.Data.Creature.Memory, module Dodge.Data.Creature.Memory,
module Dodge.Data.Creature.Stance, module Dodge.Data.Creature.Stance,
module Dodge.Data.ActionPlan
) where ) where
import Control.Lens import Control.Lens
@@ -22,7 +23,6 @@ import Dodge.Data.Creature.Stance
import Dodge.Data.Creature.State import Dodge.Data.Creature.State
import Dodge.Data.Hammer import Dodge.Data.Hammer
import Dodge.Data.Item import Dodge.Data.Item
import Dodge.Data.LoadAction
import Dodge.Data.Material import Dodge.Data.Material
import GHC.Generics import GHC.Generics
import Geometry.Data import Geometry.Data
src/Dodge/Data/CreatureEffect.hs
+54 -59
View File
@@ -1,81 +1,76 @@
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.CreatureEffect where module Dodge.Data.CreatureEffect where
import GHC.Generics
import Data.Aeson import Data.Aeson
import Data.Aeson.TH
data WdCrCr = NoCreatureEffect data WdCrCr = NoCreatureEffect
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON WdCrCr where
toEncoding = genericToEncoding defaultOptions
instance FromJSON WdCrCr
data CrWdImp = NoCrWdImp data CrWdImp = NoCrWdImp
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON CrWdImp where
toEncoding = genericToEncoding defaultOptions
instance FromJSON CrWdImp
data CrWdWd = CrWdWdId data CrWdWd = CrWdWdId
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON CrWdWd where
toEncoding = genericToEncoding defaultOptions
instance FromJSON CrWdWd
data IntImp = NoIntImp data IntImp = NoIntImp
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON IntImp where
toEncoding = genericToEncoding defaultOptions data CrImp
instance FromJSON IntImp = NoCrImp
data CrImp = NoCrImp
| TurnTowardCr Float -- turn amount | TurnTowardCr Float -- turn amount
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON CrImp where
toEncoding = genericToEncoding defaultOptions
instance FromJSON CrImp
data P2Imp = P2ImpNo data P2Imp = P2ImpNo
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON P2Imp where
toEncoding = genericToEncoding defaultOptions data WdCrBl
instance FromJSON P2Imp = WdCrTrue
data WdCrBl = WdCrTrue
| WdCrBlfromCrBl CrBl | WdCrBlfromCrBl CrBl
| WdCrNegate WdCrBl | WdCrNegate WdCrBl
| WdCrLOSTarget | WdCrLOSTarget
| WdCrSafeDistFromTarget Float | WdCrSafeDistFromTarget Float
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON WdCrBl where
toEncoding = genericToEncoding defaultOptions data CrBl
instance FromJSON WdCrBl = CrCanShoot
data CrBl = CrCanShoot
| CrIsReloading | CrIsReloading
| CrIsAiming | CrIsAiming
| CrIsAnimate | CrIsAnimate
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON CrBl where
toEncoding = genericToEncoding defaultOptions
instance FromJSON CrBl
data MCrAc = MCrNoAction data MCrAc = MCrNoAction
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON MCrAc where
toEncoding = genericToEncoding defaultOptions data CrAc
instance FromJSON MCrAc = CrTurnAround
data CrAc = CrTurnAround
| CrFleeFromTarget | CrFleeFromTarget
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON CrAc where
toEncoding = genericToEncoding defaultOptions
instance FromJSON CrAc
data P2Ac = P2NoAction data P2Ac = P2NoAction
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON P2Ac where
toEncoding = genericToEncoding defaultOptions
instance FromJSON P2Ac
data MP2Ac = MP2NoAction data MP2Ac = MP2NoAction
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON MP2Ac where
toEncoding = genericToEncoding defaultOptions data CrWdAc
instance FromJSON MP2Ac = CrWdBFSThenReturn Int
data CrWdAc = CrWdBFSThenReturn Int
| ChooseMovementSpreadGun | ChooseMovementSpreadGun
| ChooseMovementLtAuto | ChooseMovementLtAuto
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON CrWdAc where
toEncoding = genericToEncoding defaultOptions deriveJSON defaultOptions ''WdCrCr
instance FromJSON CrWdAc deriveJSON defaultOptions ''CrWdImp
deriveJSON defaultOptions ''CrWdWd
deriveJSON defaultOptions ''IntImp
deriveJSON defaultOptions ''CrImp
deriveJSON defaultOptions ''P2Imp
deriveJSON defaultOptions ''WdCrBl
deriveJSON defaultOptions ''CrBl
deriveJSON defaultOptions ''MCrAc
deriveJSON defaultOptions ''CrAc
deriveJSON defaultOptions ''P2Ac
deriveJSON defaultOptions ''MP2Ac
deriveJSON defaultOptions ''CrWdAc
src/Dodge/Data/Gas.hs
-10
View File
@@ -1,10 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Gas where
import GHC.Generics
import Data.Aeson
data GasCreate = CreatePoisonGas | CreateFlame
deriving (Eq,Ord,Show,Enum,Bounded,Read,Generic)
instance ToJSON GasCreate where
toEncoding = genericToEncoding defaultOptions
instance FromJSON GasCreate
src/Dodge/Data/Item/Use/Consumption.hs
+7 -3
View File
@@ -2,13 +2,17 @@
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Use.Consumption where module Dodge.Data.Item.Use.Consumption (
module Dodge.Data.Item.Use.Consumption,
module Dodge.Data.Item.Use.Consumption.Ammo,
module Dodge.Data.Item.Use.Consumption.LoadAction,
) where
import Control.Lens import Control.Lens
import Data.Aeson import Data.Aeson
import Data.Aeson.TH import Data.Aeson.TH
import Dodge.Data.Ammo import Dodge.Data.Item.Use.Consumption.Ammo
import Dodge.Data.LoadAction import Dodge.Data.Item.Use.Consumption.LoadAction
data HeldConsumption data HeldConsumption
= LoadableAmmo = LoadableAmmo
src/Dodge/Data/Ammo.hs → src/Dodge/Data/Item/Use/Consumption/Ammo.hs
+9 -2
View File
@@ -1,13 +1,16 @@
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Ammo where module Dodge.Data.Item.Use.Consumption.Ammo (
module Dodge.Data.Item.Use.Consumption.Ammo,
module Dodge.Data.Bullet,
module Dodge.Data.Payload,
) where
import Control.Lens import Control.Lens
import Data.Aeson import Data.Aeson
import Data.Aeson.TH import Data.Aeson.TH
import Dodge.Data.Bullet import Dodge.Data.Bullet
import Dodge.Data.Gas
import Dodge.Data.Payload import Dodge.Data.Payload
import Dodge.Data.Wall import Dodge.Data.Wall
@@ -50,9 +53,13 @@ data AmmoType
| GenericAmmo | GenericAmmo
deriving (Eq, Ord, Show, Read) deriving (Eq, Ord, Show, Read)
data GasCreate = CreatePoisonGas | CreateFlame
deriving (Eq, Ord, Show, Enum, Bounded, Read)
makeLenses ''ProjectileUpdate makeLenses ''ProjectileUpdate
makeLenses ''AmmoType makeLenses ''AmmoType
deriveJSON defaultOptions ''ProjectileDraw deriveJSON defaultOptions ''ProjectileDraw
deriveJSON defaultOptions ''ProjectileCreate deriveJSON defaultOptions ''ProjectileCreate
deriveJSON defaultOptions ''ProjectileUpdate deriveJSON defaultOptions ''ProjectileUpdate
deriveJSON defaultOptions ''AmmoType deriveJSON defaultOptions ''AmmoType
deriveJSON defaultOptions ''GasCreate
src/Dodge/Data/Item/Use/Consumption/LoadAction.hs
+32
View File
@@ -0,0 +1,32 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Use.Consumption.LoadAction where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Hammer
import Sound.Data
data LoadAction
= LoadEject {_actionTime :: Int, _actionSound :: SoundID}
| LoadInsert {_actionTime :: Int, _actionSound :: SoundID}
| LoadAdd {_actionTime :: Int, _actionSound :: SoundID, _insertMax :: Int}
| LoadPrime {_actionTime :: Int, _actionSound :: SoundID}
deriving (Eq, Ord, Show, Read)
data InvSel = InvSel {_iselPos :: Int, _iselAction :: InvSelAction}
deriving (Eq, Ord, Show, Read)
data InvSelAction
= NoInvSelAction
| ReloadAction {_actionProgress :: Int, _reloadAction :: LoadAction, _actionHammer :: HammerType}
deriving (Eq, Ord, Show, Read)
makeLenses ''LoadAction
makeLenses ''InvSel
makeLenses ''InvSelAction
deriveJSON defaultOptions ''LoadAction
deriveJSON defaultOptions ''InvSel
deriveJSON defaultOptions ''InvSelAction
src/Dodge/Data/LoadAction.hs
-33
View File
@@ -1,33 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.LoadAction where
import GHC.Generics
import Data.Aeson
import Sound.Data
import Dodge.Data.Hammer
import Control.Lens
data LoadAction
= LoadEject {_actionTime :: Int, _actionSound :: SoundID}
| LoadInsert {_actionTime :: Int, _actionSound :: SoundID}
| LoadAdd {_actionTime :: Int, _actionSound :: SoundID, _insertMax :: Int }
| LoadPrime {_actionTime :: Int, _actionSound :: SoundID}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON LoadAction where
toEncoding = genericToEncoding defaultOptions
instance FromJSON LoadAction
data InvSel = InvSel {_iselPos :: Int, _iselAction :: InvSelAction }
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON InvSel where
toEncoding = genericToEncoding defaultOptions
instance FromJSON InvSel
data InvSelAction
= NoInvSelAction
| ReloadAction { _actionProgress :: Int, _reloadAction :: LoadAction, _actionHammer :: HammerType}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON InvSelAction where
toEncoding = genericToEncoding defaultOptions
instance FromJSON InvSelAction
makeLenses ''LoadAction
makeLenses ''InvSel
makeLenses ''InvSelAction
src/Dodge/Data/Machine.hs
+16 -24
View File
@@ -1,21 +1,25 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Machine where module Dodge.Data.Machine (
module Dodge.Data.Machine,
module Dodge.Data.Machine.Sensor,
module Dodge.Data.Material,
module Dodge.Data.ObjectType,
) where
import Color import Color
import Control.Lens import Control.Lens
import Data.Aeson import Data.Aeson
import Data.Aeson.TH
import qualified Data.IntSet as IS import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Dodge.Data.Damage import Dodge.Data.Damage
import Dodge.Data.GenParams import Dodge.Data.GenParams
import Dodge.Data.Item import Dodge.Data.Item
import Dodge.Data.Machine.Sensor
import Dodge.Data.Material import Dodge.Data.Material
import Dodge.Data.Object import Dodge.Data.ObjectType
import Dodge.Data.Sensor
import GHC.Generics
import Geometry.Data import Geometry.Data
import Sound.Data import Sound.Data
@@ -24,17 +28,12 @@ data MachineDraw
| MachineDrawTerminal | MachineDrawTerminal
| MachineDrawTurret | MachineDrawTurret
| MachineDrawDamageSensor Float (PaletteColor, DecorationShape) | MachineDrawDamageSensor Float (PaletteColor, DecorationShape)
deriving (Eq, Ord, Show, Read, Generic) deriving (Eq, Show, Read)
instance ToJSON MachineDraw where
toEncoding = genericToEncoding defaultOptions
instance FromJSON MachineDraw
data Machine = Machine data Machine = Machine
{ _mcID :: Int { _mcID :: Int
, _mcWallIDs :: IS.IntSet , _mcWallIDs :: IS.IntSet
, _mcDraw :: MachineDraw --Machine -> SPic , _mcDraw :: MachineDraw
, _mcMaterial :: Material , _mcMaterial :: Material
, _mcPos :: Point2 , _mcPos :: Point2
, _mcDir :: Float , _mcDir :: Float
@@ -47,12 +46,7 @@ data Machine = Machine
, _mcName :: String , _mcName :: String
, _mcCloseSound :: Maybe SoundID , _mcCloseSound :: Maybe SoundID
} }
deriving (Eq, Show, Read, Generic) deriving (Eq, Show, Read)
instance ToJSON Machine where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Machine
data MachineType data MachineType
= StaticMachine = StaticMachine
@@ -62,12 +56,10 @@ data MachineType
, _tuFireTime :: Int , _tuFireTime :: Int
, _tuMCrID :: Maybe Int , _tuMCrID :: Maybe Int
} }
deriving (Eq, Show, Read, Generic) deriving (Eq, Show, Read)
instance ToJSON MachineType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON MachineType
makeLenses ''Machine makeLenses ''Machine
makeLenses ''MachineType makeLenses ''MachineType
deriveJSON defaultOptions ''MachineDraw
deriveJSON defaultOptions ''Machine
deriveJSON defaultOptions ''MachineType
src/Dodge/Data/Sensor.hs → src/Dodge/Data/Machine/Sensor.hs
+1 -1
View File
@@ -1,7 +1,7 @@
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Sensor where module Dodge.Data.Machine.Sensor where
import Control.Lens import Control.Lens
import Data.Aeson import Data.Aeson
src/Dodge/Data/MountedObject.hs
+9 -8
View File
@@ -1,13 +1,14 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.MountedObject {-# LANGUAGE TemplateHaskell #-}
where
import GHC.Generics module Dodge.Data.MountedObject where
import Data.Aeson import Data.Aeson
import Data.Aeson.TH
data MountedObject data MountedObject
= MountedLS Int = MountedLS Int
| MountedProp Int | MountedProp Int
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON MountedObject where
toEncoding = genericToEncoding defaultOptions deriveJSON defaultOptions ''MountedObject
instance FromJSON MountedObject
src/Dodge/Data/Object.hs → src/Dodge/Data/ObjectType.hs
+11 -7
View File
@@ -1,8 +1,11 @@
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Object where
import GHC.Generics module Dodge.Data.ObjectType where
import Data.Aeson import Data.Aeson
import Data.Aeson.TH
data ObjectType data ObjectType
= ObTerminal = ObTerminal
| ObCreature | ObCreature
@@ -15,9 +18,10 @@ data ObjectType
| ObProp | ObProp
| ObTrigger | ObTrigger
| ObItem | ObItem
deriving (Eq,Show,Ord,Read,Enum,Bounded,Generic) deriving (Eq, Show, Ord, Read, Enum, Bounded)
instance ToJSON ObjectType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ObjectType
instance ToJSONKey ObjectType instance ToJSONKey ObjectType
instance FromJSONKey ObjectType instance FromJSONKey ObjectType
deriveJSON defaultOptions ''ObjectType
src/Dodge/Data/Payload.hs
+8 -7
View File
@@ -1,11 +1,12 @@
{-# LANGUAGE DeriveGeneric #-}
--{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Payload where module Dodge.Data.Payload where
import GHC.Generics
import Data.Aeson import Data.Aeson
import Data.Aeson.TH
data Payload = ExplosionPayload | DudPayload data Payload = ExplosionPayload | DudPayload
deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic) deriving (Show, Read, Eq, Ord, Enum, Bounded)
instance ToJSON Payload where
toEncoding = genericToEncoding defaultOptions deriveJSON defaultOptions ''Payload
instance FromJSON Payload
src/Dodge/Data/Projectile.hs
+1 -1
View File
@@ -5,7 +5,7 @@ module Dodge.Data.Projectile where
import GHC.Generics import GHC.Generics
import Data.Aeson import Data.Aeson
import Dodge.Data.Payload import Dodge.Data.Payload
import Dodge.Data.Ammo import Dodge.Data.Item.Use.Consumption.Ammo
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
--data ProjectileType = ShellType --data ProjectileType = ShellType
src/Dodge/Data/Prop.hs
+53 -55
View File
@@ -1,55 +1,19 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Prop {-# LANGUAGE TemplateHaskell #-}
where
import GHC.Generics module Dodge.Data.Prop where
import Data.Aeson
import Dodge.Data.WorldEffect
import Shape.Data
import Color import Color
import qualified Quaternion as Q
import Geometry.Data
import ShapePicture.Data
import Control.Lens import Control.Lens
data PropDraw = PropDrawSPic SPic import Data.Aeson
| PropDrawMovingShapeCol Shape import Data.Aeson.TH
| PropDrawMovingShape PropDraw import Dodge.Data.WorldEffect
| PropDrawFlatTranslate PropDraw import Geometry.Data
| PropDoubleLampCover Float import qualified Quaternion as Q
| PropVerticalLampCover Float import Shape.Data
| PropLampCover Float import ShapePicture.Data
| PropDrawToggle PropDraw
| PropDrawGib Float data Prop
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON PropDraw where
toEncoding = genericToEncoding defaultOptions
instance FromJSON PropDraw
data PropUpdate -- = UpdatePropZ
= PropUpdateAnd PropUpdate PropUpdate
-- | UpdateShapeProp
| PropFallSmallBounceDamage
| PropFallSmallBounce
| PropUpdateId
| PropRotate Float
| PropSetToggleAnd WdBl PropUpdate
| PropUpdates [PropUpdate]
| PropUpdateLS Int PrWdLsLs -- Prop -> World -> LightSource -> LightSource
| PropUpdatePosition WdP2f
| PropUpdateWhen WdBl PropUpdate
| PropUpdateIf WdBl PropUpdate PropUpdate
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON PropUpdate where
toEncoding = genericToEncoding defaultOptions
instance FromJSON PropUpdate
data PrWdLsLs = PrWdLsId
| PrWdLsSetPosition WdP2f Point3
| PrWdLsSetColor Point3
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON PrWdLsLs where
toEncoding = genericToEncoding defaultOptions
instance FromJSON PrWdLsLs
data Prop
= PropZ = PropZ
{ _prPos :: Point2 { _prPos :: Point2
, _prDraw :: PropDraw , _prDraw :: PropDraw
@@ -60,8 +24,8 @@ data Prop
, _prPosZ :: Float , _prPosZ :: Float
, _prVelZ :: Float , _prVelZ :: Float
, _prTimer :: Int , _prTimer :: Int
, _prQuat :: Q.Quaternion Float , _prQuat :: Q.Quaternion Float
, _prQuatSpin :: Q.Quaternion Float , _prQuatSpin :: Q.Quaternion Float
, _prColor :: Color , _prColor :: Color
} }
| ShapeProp | ShapeProp
@@ -72,8 +36,42 @@ data Prop
, _prRot :: Float , _prRot :: Float
, _prToggle :: Bool , _prToggle :: Bool
} }
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON Prop where
toEncoding = genericToEncoding defaultOptions data PropDraw
instance FromJSON Prop = PropDrawSPic SPic
| PropDrawMovingShapeCol Shape
| PropDrawMovingShape PropDraw
| PropDrawFlatTranslate PropDraw
| PropDoubleLampCover Float
| PropVerticalLampCover Float
| PropLampCover Float
| PropDrawToggle PropDraw
| PropDrawGib Float
deriving (Eq, Ord, Show, Read)
data PropUpdate
= PropUpdateAnd PropUpdate PropUpdate
| PropFallSmallBounceDamage
| PropFallSmallBounce
| PropUpdateId
| PropRotate Float
| PropSetToggleAnd WdBl PropUpdate
| PropUpdates [PropUpdate]
| PropUpdateLS Int PrWdLsLs
| PropUpdatePosition WdP2f
| PropUpdateWhen WdBl PropUpdate
| PropUpdateIf WdBl PropUpdate PropUpdate
deriving (Eq, Ord, Show, Read)
data PrWdLsLs
= PrWdLsId
| PrWdLsSetPosition WdP2f Point3
| PrWdLsSetColor Point3
deriving (Eq, Ord, Show, Read)
makeLenses ''Prop makeLenses ''Prop
deriveJSON defaultOptions ''PropDraw
deriveJSON defaultOptions ''PropUpdate
deriveJSON defaultOptions ''PrWdLsLs
deriveJSON defaultOptions ''Prop
src/Dodge/Data/RadarSweep.hs
+18 -14
View File
@@ -1,20 +1,24 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.RadarSweep where {-# LANGUAGE TemplateHaskell #-}
import GHC.Generics
import Data.Aeson module Dodge.Data.RadarSweep (
import Dodge.Data.Object module Dodge.Data.RadarSweep,
import Geometry.Data module Dodge.Data.ObjectType,
) where
import Control.Lens import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.ObjectType
import Geometry.Data
data RadarSweep = RadarSweep data RadarSweep = RadarSweep
{ _rsPos :: Point2 { _rsPos :: Point2
, _rsRad :: Float , _rsRad :: Float
, _rsObject :: ObjectType , _rsObject :: ObjectType
, _rsTimer :: Int , _rsTimer :: Int
} }
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON RadarSweep where
toEncoding = genericToEncoding defaultOptions
instance FromJSON RadarSweep
makeLenses ''RadarSweep makeLenses ''RadarSweep
deriveJSON defaultOptions ''RadarSweep
src/Dodge/Data/RightButtonOptions.hs
+35 -24
View File
@@ -1,59 +1,70 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.RightButtonOptions where module Dodge.Data.RightButtonOptions where
import GHC.Generics
import Control.Lens
import Data.Aeson import Data.Aeson
import Dodge.Data.Equipment.Misc import Dodge.Data.Equipment.Misc
import Control.Lens import GHC.Generics
data RightButtonOptions data RightButtonOptions
= NoRightButtonOptions = NoRightButtonOptions
| EquipOptions | EquipOptions
{_opEquip :: [EquipPosition] { _opEquip :: [EquipPosition]
,_opSel :: Int , _opSel :: Int
,_opCurInvPos :: Int , _opCurInvPos :: Int
,_opAllocateEquipment :: AllocateEquipment , _opAllocateEquipment :: AllocateEquipment
,_opActivateEquipment :: ActivateEquipment , _opActivateEquipment :: ActivateEquipment
} }
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON RightButtonOptions where instance ToJSON RightButtonOptions where
toEncoding = genericToEncoding defaultOptions toEncoding = genericToEncoding defaultOptions
instance FromJSON RightButtonOptions instance FromJSON RightButtonOptions
data ActivateEquipment data ActivateEquipment
= ActivateEquipment {_activateEquipment :: Int } = ActivateEquipment {_activateEquipment :: Int}
| DeactivateEquipment {_deactivateEquipment :: Int} | DeactivateEquipment {_deactivateEquipment :: Int}
| ActivateDeactivateEquipment {_activateEquipment :: Int ,_deactivateEquipment :: Int} | ActivateDeactivateEquipment {_activateEquipment :: Int, _deactivateEquipment :: Int}
| NoChangeActivateEquipment | NoChangeActivateEquipment
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON ActivateEquipment where instance ToJSON ActivateEquipment where
toEncoding = genericToEncoding defaultOptions toEncoding = genericToEncoding defaultOptions
instance FromJSON ActivateEquipment instance FromJSON ActivateEquipment
data AllocateEquipment
data AllocateEquipment
= DoNotMoveEquipment = DoNotMoveEquipment
| PutOnEquipment | PutOnEquipment
{ _allocNewPos :: EquipPosition { _allocNewPos :: EquipPosition
} }
| MoveEquipment | MoveEquipment
{ _allocNewPos :: EquipPosition { _allocNewPos :: EquipPosition
, _allocOldPos :: EquipPosition , _allocOldPos :: EquipPosition
} }
| SwapEquipment | SwapEquipment
{ _allocNewPos :: EquipPosition { _allocNewPos :: EquipPosition
, _allocOldPos :: EquipPosition , _allocOldPos :: EquipPosition
, _allocSwapID :: Int , _allocSwapID :: Int
} }
| ReplaceEquipment | ReplaceEquipment
{ _allocNewPos :: EquipPosition { _allocNewPos :: EquipPosition
, _allocRemoveID :: Int , _allocRemoveID :: Int
} }
| RemoveEquipment | RemoveEquipment
{ _allocOldPos :: EquipPosition { _allocOldPos :: EquipPosition
} }
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON AllocateEquipment where
instance ToJSON AllocateEquipment where
toEncoding = genericToEncoding defaultOptions toEncoding = genericToEncoding defaultOptions
instance FromJSON AllocateEquipment
instance FromJSON AllocateEquipment
makeLenses ''RightButtonOptions makeLenses ''RightButtonOptions
makeLenses ''AllocateEquipment makeLenses ''AllocateEquipment
makeLenses ''ActivateEquipment makeLenses ''ActivateEquipment
src/Dodge/Data/SoundOrigin.hs
+16 -10
View File
@@ -1,11 +1,14 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.SoundOrigin {-# LANGUAGE TemplateHaskell #-}
where
import Dodge.Data.Material module Dodge.Data.SoundOrigin where
import GHC.Generics
import Data.Aeson import Data.Aeson
data SoundOrigin = InventorySound import Data.Aeson.TH
import Dodge.Data.Material
data SoundOrigin
= InventorySound
| BackgroundSound | BackgroundSound
| OnceSound | OnceSound
| CrSound Int | CrSound Int
@@ -30,7 +33,10 @@ data SoundOrigin = InventorySound
| LeverSound Int | LeverSound Int
| Explosion Int | Explosion Int
| Tap Int | Tap Int
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON SoundOrigin where
toEncoding = genericToEncoding defaultOptions instance ToJSONKey SoundOrigin
instance FromJSON SoundOrigin
instance FromJSONKey SoundOrigin
deriveJSON defaultOptions ''SoundOrigin
src/Dodge/Default/Weapon.hs
-1
View File
@@ -2,7 +2,6 @@ module Dodge.Default.Weapon where
import Control.Lens import Control.Lens
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Dodge.Data.Ammo
import Dodge.Data.Hammer import Dodge.Data.Hammer
import Dodge.Data.Item import Dodge.Data.Item
import Dodge.Default.AimParams import Dodge.Default.AimParams
src/Dodge/Default/World.hs
+1
View File
@@ -1,4 +1,5 @@
module Dodge.Default.World where module Dodge.Default.World where
import Dodge.Data.Hammer
import Dodge.Data import Dodge.Data
import Geometry.Data import Geometry.Data
import Geometry.Polygon import Geometry.Polygon
src/Dodge/Projectile/Create.hs
+58 -46
View File
@@ -1,42 +1,51 @@
module Dodge.Projectile.Create where module Dodge.Projectile.Create where
import Dodge.Data import Dodge.Data
import Dodge.Item.Location import Dodge.Item.Location
import LensHelp
import qualified IntMapHelp as IM
import Geometry import Geometry
import qualified IntMapHelp as IM
import LensHelp
createProjectile :: ProjectileCreate -> Item -> Creature -> World -> World createProjectile :: ProjectileCreate -> Item -> Creature -> World -> World
createProjectile pt = case pt of createProjectile pt = case pt of
CreateShell -> fireShell CreateShell -> fireShell
CreateTrackingShell -> fireTrackingShell CreateTrackingShell -> fireTrackingShell
fireShell :: Item -> Creature -> World -> World fireShell :: Item -> Creature -> World -> World
fireShell it cr = makeShell it cr fireShell it cr =
[ PJSpin 335 (_crID cr) spinamount makeShell
, PJThrust (350 - thrustdelay) 0 it
, PJReduceSpin (1-fromIntegral spindrag*2 / 200) cr
] [ PJSpin 335 (_crID cr) spinamount
where , PJThrust (350 - thrustdelay) 0
, PJReduceSpin (1 - fromIntegral spindrag * 2 / 200)
]
where
params = _itParams it params = _itParams it
spindrag = _shellSpinDrag params spindrag = _shellSpinDrag params
spinamount = _shellSpinAmount params spinamount = _shellSpinAmount params
thrustdelay = _shellThrustDelay params thrustdelay = _shellThrustDelay params
makeShell :: Item -> Creature -> [ProjectileUpdate] -> World -> World makeShell :: Item -> Creature -> [ProjectileUpdate] -> World -> World
makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell makeShell it cr theupdate w =
{ _prjPos = pos w & cWorld . projectiles
, _prjZ = 20 %~ IM.insert
, _prjStartPos = pos i
, _prjVel = rotateV dir (V2 1 0) Shell
, _prjDraw = DrawShell { _prjPos = pos
, _prjID = i , _prjZ = 20
, _prjAcc = rotateV dir (V2 3 0) , _prjStartPos = pos
, _prjDir = dir , _prjVel = rotateV dir (V2 1 0)
, _prjSpin = 0 , _prjDraw = DrawShell
, _prjPayload = _amPayload $ _laAmmoType am , _prjID = i
, _prjTimer = 350 , _prjAcc = rotateV dir (V2 3 0)
, _prjUpdates = theupdate , _prjDir = dir
, _prjMITID = _itID it , _prjSpin = 0
} , _prjPayload = _amPayload $ _laAmmoType am
, _prjTimer = 350
, _prjUpdates = theupdate
, _prjMITID = _itID it
}
where where
i = IM.newKey $ _props (_cWorld w) i = IM.newKey $ _props (_cWorld w)
dir = _crDir cr dir = _crDir cr
@@ -44,19 +53,19 @@ makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell
am = _heldConsumption $ _itUse it am = _heldConsumption $ _itUse it
--fireShell :: Item -> Creature -> World -> World --fireShell :: Item -> Creature -> World -> World
--fireShell it cr = makeShell it cr $ \pj -> pjEffAtTime 35 (trySpinByCID (_crID cr) spinamount) pj --fireShell it cr = makeShell it cr $ \pj -> pjEffAtTime 35 (trySpinByCID (_crID cr) spinamount) pj
-- . pjThrust thrustdelay pj -- . pjThrust thrustdelay pj
-- . reduceSpinBy (1-fromIntegral spindrag*2 / 200) pj -- . reduceSpinBy (1-fromIntegral spindrag*2 / 200) pj
-- . decTimMvVel pj -- . decTimMvVel pj
-- . moveShell pj -- . moveShell pj
-- where -- where
-- params = _itParams it -- params = _itParams it
-- spindrag = _shellSpinDrag params -- spindrag = _shellSpinDrag params
-- spinamount = _shellSpinAmount params -- spinamount = _shellSpinAmount params
-- thrustdelay = _shellThrustDelay params -- thrustdelay = _shellThrustDelay params
-- --
--makeShell :: Item -> Creature -> (Proj -> World -> World) -> World -> World --makeShell :: Item -> Creature -> (Proj -> World -> World) -> World -> World
--makeShell it cr theupdate w = w & projectiles %~ IM.insert i Shell --makeShell it cr theupdate w = w & projectiles %~ IM.insert i Shell
-- { _prjPos = pos -- { _prjPos = pos
-- , _prjZ = 20 -- , _prjZ = 20
-- , _prjStartPos = pos -- , _prjStartPos = pos
@@ -77,19 +86,19 @@ makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell
-- am = _itConsumption it -- am = _itConsumption it
-- --
--moveShell :: Proj --moveShell :: Proj
-- -> World
-- -> World -- -> World
--moveShell pj w -- -> World
--moveShell pj w
-- | time > 40 = if circOnSomeWall oldPos 4 w -- | time > 40 = if circOnSomeWall oldPos 4 w
-- then doExplode -- then doExplode
-- else w -- else w
-- | anythingHitCirc 2 oldPos newPos w = doExplode -- | anythingHitCirc 2 oldPos newPos w = doExplode
-- | time > -300 = w -- | time > -300 = w
-- | otherwise = doExplode -- | otherwise = doExplode
-- where -- where
-- time = _prjTimer pj -- time = _prjTimer pj
-- doExplode = w -- doExplode = w
-- & usePayload (_prjPayload pj) oldPos -- & usePayload (_prjPayload pj) oldPos
-- & stopSoundFrom (ShellSound i) -- & stopSoundFrom (ShellSound i)
-- & props %~ IM.delete i -- & props %~ IM.delete i
-- i = _prjID pj -- i = _prjID pj
@@ -101,13 +110,13 @@ makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell
--usePjCreation it = createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it --usePjCreation it = createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it
-- --
--usePjCreationX :: Int -> Item -> Creature -> World -> World --usePjCreationX :: Int -> Item -> Creature -> World -> World
--usePjCreationX i it cr = foldr f --usePjCreationX i it cr = foldr f
-- (createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it cr) -- (createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it cr)
-- [1..i-1] -- [1..i-1]
-- where -- where
-- f n = (. createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it (cr & crDir +~ (2*pi*fromIntegral n / fromIntegral i))) -- f n = (. createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it (cr & crDir +~ (2*pi*fromIntegral n / fromIntegral i)))
-- --
--pjEffAtTime --pjEffAtTime
-- :: Int -- :: Int
-- -> (Proj -> World -> World) -- -> (Proj -> World -> World)
-- -> Proj -- -> Proj
@@ -121,7 +130,7 @@ makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell
-- :: Int -- ^ creature id -- :: Int -- ^ creature id
-- -> Int -- ^ Spin amount -- -> Int -- ^ Spin amount
-- -> Proj -- -> Proj
-- -> World -- -> World
-- -> World -- -> World
--trySpinByCID cid i pj w = w & projectiles . ix pjid . prjSpin .~ newSpin --trySpinByCID cid i pj w = w & projectiles . ix pjid . prjSpin .~ newSpin
-- where -- where
@@ -146,7 +155,7 @@ makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell
-- st = et - 100 -- st = et - 100
-- rotateToTarget _ = fromMaybe id $ do -- rotateToTarget _ = fromMaybe id $ do
-- tpos <- w ^? itPoint . itTargeting . tgPos . _Just -- tpos <- w ^? itPoint . itTargeting . tgPos . _Just
-- return $ projectiles . ix (_prjID pj) . prjSpin .~ turnToAmount 0.15 (_prjPos pj) tpos -- return $ projectiles . ix (_prjID pj) . prjSpin .~ turnToAmount 0.15 (_prjPos pj) tpos
-- (argV $ _prjAcc pj) -- (argV $ _prjAcc pj)
-- itPoint = pointToItem $ _itemPositions w IM.! itid -- itPoint = pointToItem $ _itemPositions w IM.! itid
-- --
@@ -174,7 +183,7 @@ makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell
-- :: (Int,Int) -- :: (Int,Int)
-- -> (Proj -> World -> World) -- -> (Proj -> World -> World)
-- -> Proj -- -> Proj
-- -> World -- -> World
-- -> World -- -> World
--pjEffTimeRange (st,et) f pj --pjEffTimeRange (st,et) f pj
-- | t <= et && t >= st = f pj -- | t <= et && t >= st = f pj
@@ -184,13 +193,16 @@ makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell
fireTrackingShell :: Item -> Creature -> World -> World fireTrackingShell :: Item -> Creature -> World -> World
fireTrackingShell it cr w = addTrackRocket w' fireTrackingShell it cr w = addTrackRocket w'
where where
(w',itid) = getHeldItemLoc cr w (w', itid) = getHeldItemLoc cr w
addTrackRocket = makeShell it cr addTrackRocket =
[ PJSpin 335 (_crID cr) spinamount makeShell
, PJTrack (350 - thrustdelay) 0 itid it
, PJThrust (350 - thrustdelay) 0 cr
, PJReduceSpin (1-fromIntegral spindrag*2 / 200) [ PJSpin 335 (_crID cr) spinamount
] , PJTrack (350 - thrustdelay) 0 itid
, PJThrust (350 - thrustdelay) 0
, PJReduceSpin (1 - fromIntegral spindrag * 2 / 200)
]
spinamount = _shellSpinAmount params spinamount = _shellSpinAmount params
thrustdelay = _shellThrustDelay params thrustdelay = _shellThrustDelay params
spindrag = _shellSpinDrag params spindrag = _shellSpinDrag params
src/Dodge/RadarSweep/Draw.hs
+10 -8
View File
@@ -1,5 +1,5 @@
module Dodge.RadarSweep.Draw where module Dodge.RadarSweep.Draw where
import Dodge.Data.Object
import Dodge.Data.RadarSweep import Dodge.Data.RadarSweep
import Geometry import Geometry
import Picture import Picture
@@ -10,18 +10,20 @@ drawRadarSweep pt = setLayer DebugLayer $ pictures sweepPics
col = rsObjectColor $ _rsObject pt col = rsObjectColor $ _rsObject pt
p = _rsPos pt p = _rsPos pt
r = _rsRad pt r = _rsRad pt
sweepPics = [colHelper 0.1 $ uncurryV translate p $ thickCircle r 15 sweepPics =
,colHelper 0.06 $ uncurryV translate p $ thickCircle (r-5) 5 [ colHelper 0.1 $ uncurryV translate p $ thickCircle r 15
,colHelper 0.03 $ uncurryV translate p $ thickCircle (r-10) 5 , colHelper 0.06 $ uncurryV translate p $ thickCircle (r -5) 5
] , colHelper 0.03 $ uncurryV translate p $ thickCircle (r -10) 5
]
colHelper y = color (withAlpha (y * globalAlpha) col) colHelper y = color (withAlpha (y * globalAlpha) col)
globalAlpha | x > 10 = 1 globalAlpha
| otherwise = fromIntegral x / 10 | x > 10 = 1
| otherwise = fromIntegral x / 10
x = _rsTimer pt x = _rsTimer pt
rsObjectColor :: ObjectType -> Color rsObjectColor :: ObjectType -> Color
rsObjectColor ob = case ob of rsObjectColor ob = case ob of
ObWall -> red ObWall -> red
ObCreature -> green ObCreature -> green
ObItem -> blue ObItem -> blue
_ -> yellow _ -> yellow
src/Dodge/Reloading/Action.hs
+1 -1
View File
@@ -1,6 +1,6 @@
module Dodge.Reloading.Action where module Dodge.Reloading.Action where
import Dodge.SoundLogic.ExternallyGeneratedSounds import Dodge.SoundLogic.ExternallyGeneratedSounds
import Dodge.Data.LoadAction import Dodge.Data.Item.Use.Consumption.LoadAction
loadInsert :: Int -> LoadAction loadInsert :: Int -> LoadAction
loadInsert x = LoadInsert x insertS loadInsert x = LoadInsert x insertS
src/Sound/Data.hs
+56 -36
View File
@@ -1,54 +1,74 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Sound.Data
where module Sound.Data where
import GHC.Generics
import Data.Aeson
import qualified SDL.Mixer as Mix
import qualified IntMapHelp as IM
--import qualified Data.Map.Strict as M
import Control.Lens import Control.Lens
import Geometry.Data import Data.Aeson
import Data.Word (Word8) import Data.Aeson.TH
import Data.Int (Int16) import Data.Int (Int16)
import Data.Word (Word8)
import Geometry.Data
import qualified IntMapHelp as IM
import qualified SDL.Mixer as Mix
data SoundStatus = SoundStatus data SoundStatus = SoundStatus
{_playStatus :: PlayStatus { _playStatus :: PlayStatus
,_isLooping :: Bool , _isLooping :: Bool
} }
deriving (Eq,Ord,Show,Generic) deriving (Eq, Ord, Show)
instance ToJSON SoundStatus where
toEncoding = genericToEncoding defaultOptions
instance FromJSON SoundStatus
-- TODO make this more sensible (use product rather than union in some cases) -- TODO make this more sensible (use product rather than union in some cases)
data PlayStatus data PlayStatus
= JustStartedPlaying = JustStartedPlaying
| Playing | Playing
| ToStart | ToStart
| ToContinueStart | ToContinueStart
| ToStop | ToStop
deriving (Eq,Ord,Show,Generic) deriving (Eq, Ord, Show)
instance ToJSON PlayStatus where
toEncoding = genericToEncoding defaultOptions
instance FromJSON PlayStatus
newtype SoundID = SoundID { _getSoundID :: Int } newtype SoundID = SoundID {_getSoundID :: Int}
deriving (Eq,Ord,Show,Read,Generic) deriving (Eq, Ord, Show, Read)
instance ToJSON SoundID where
toEncoding = genericToEncoding defaultOptions
instance FromJSON SoundID
newtype SoundData = SoundData newtype SoundData = SoundData
{_loadedChunks :: IM.IntMap Mix.Chunk { _loadedChunks :: IM.IntMap Mix.Chunk
} }
data Sound = Sound
{ _soundTime :: Maybe Int data ToPlaySound = ToPlaySound
, _soundStatus :: SoundStatus { _toPlaySoundTime :: Maybe Int
, _soundChannel :: Maybe Mix.Channel , _toPlaySoundStatus :: SoundStatus
, _soundAngDist :: Maybe (Int16,Word8) -- why do BOTH of , _toPlaySoundPos :: Point2 -- these exist?
, _soundPos :: Point2 -- these exist? , _toPlaySoundVolume :: Float
, _soundVolume :: Float , _toPlaySoundVolumeFraction :: Float -- this needs cleaning up/combining
, _toPlaySoundChunkID :: SoundID
}
deriving (Eq, Show)
data Sound = Sound
{ _soundTime :: Maybe Int
, _soundStatus :: SoundStatus
, _soundChannel :: Maybe Mix.Channel
, _soundAngDist :: Maybe (Int16, Word8) -- why do BOTH of
, _soundPos :: Point2 -- these exist?
, _soundVolume :: Float
, _soundVolumeFraction :: Float -- this needs cleaning up/combining , _soundVolumeFraction :: Float -- this needs cleaning up/combining
, _soundChunkID :: SoundID , _soundChunkID :: SoundID
} }
deriving (Eq,Ord,Show) deriving (Eq, Ord, Show)
makeLenses ''SoundData makeLenses ''SoundData
makeLenses ''Sound makeLenses ''Sound
makeLenses ''SoundID
makeLenses ''SoundStatus makeLenses ''SoundStatus
deriveJSON defaultOptions ''SoundStatus
deriveJSON defaultOptions ''PlayStatus
deriveJSON defaultOptions ''SoundID
deriveJSON defaultOptions ''ToPlaySound