From 8aa5c17ab94bddd60cdbbdac8a69c0c8cc87a697 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 27 Jul 2022 17:37:18 +0100 Subject: [PATCH] Cleanup module pathing --- src/Dodge/Data.hs | 161 ++---------------- src/Dodge/Data/ArcStep.hs | 32 ++-- src/Dodge/Data/CWorld.hs | 41 +++++ src/Dodge/Data/CrWlID.hs | 19 ++- src/Dodge/Data/Creature.hs | 2 +- src/Dodge/Data/CreatureEffect.hs | 113 ++++++------ src/Dodge/Data/Gas.hs | 10 -- src/Dodge/Data/Item/Use/Consumption.hs | 10 +- .../Data/{ => Item/Use/Consumption}/Ammo.hs | 11 +- .../Data/Item/Use/Consumption/LoadAction.hs | 32 ++++ src/Dodge/Data/LoadAction.hs | 33 ---- src/Dodge/Data/Machine.hs | 40 ++--- src/Dodge/Data/{ => Machine}/Sensor.hs | 2 +- src/Dodge/Data/MountedObject.hs | 17 +- src/Dodge/Data/{Object.hs => ObjectType.hs} | 18 +- src/Dodge/Data/Payload.hs | 15 +- src/Dodge/Data/Projectile.hs | 2 +- src/Dodge/Data/Prop.hs | 108 ++++++------ src/Dodge/Data/RadarSweep.hs | 32 ++-- src/Dodge/Data/RightButtonOptions.hs | 59 ++++--- src/Dodge/Data/SoundOrigin.hs | 26 +-- src/Dodge/Default/Weapon.hs | 1 - src/Dodge/Default/World.hs | 1 + src/Dodge/Projectile/Create.hs | 104 ++++++----- src/Dodge/RadarSweep/Draw.hs | 18 +- src/Dodge/Reloading/Action.hs | 2 +- src/Sound/Data.hs | 92 ++++++---- 27 files changed, 484 insertions(+), 517 deletions(-) delete mode 100644 src/Dodge/Data/Gas.hs rename src/Dodge/Data/{ => Item/Use/Consumption}/Ammo.hs (84%) create mode 100644 src/Dodge/Data/Item/Use/Consumption/LoadAction.hs delete mode 100644 src/Dodge/Data/LoadAction.hs rename src/Dodge/Data/{ => Machine}/Sensor.hs (96%) rename src/Dodge/Data/{Object.hs => ObjectType.hs} (55%) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index d5d65d849..9ec80de6d 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE StrictData #-} @@ -15,142 +14,49 @@ The warnings have been disabled. -} 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.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.Bounds, - module Dodge.Data.Sensor, module Dodge.Data.Distortion, - module Dodge.Data.Damage, + module Dodge.Data.Material, module Dodge.Data.SoundOrigin, + module Dodge.Data.Hammer, + module Dodge.Data.RightButtonOptions, module Dodge.Data.Config, module MaybeHelp, module Dodge.Data.RoomCluster, 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.ObjectType, + module Dodge.Data.CrWlID, + module Dodge.Data.CreatureEffect, + module Dodge.Data.MountedObject, ) where -import Dodge.Data.CWorld import Color import Control.Lens import Control.Monad.State -import Data.Aeson import qualified Data.Map.Strict as M import Data.Preload import qualified Data.Set as S import qualified Data.Text as T import Data.Tile -import Dodge.Data.Config import Dodge.Config.KeyConfig import Dodge.Data.ActionPlan -import Dodge.Data.Ammo import Dodge.Data.ArcStep -import Dodge.Data.Beam -import Dodge.Data.Block -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.CWorld +import Dodge.Data.Config import Dodge.Data.CrWlID -import Dodge.Data.Creature import Dodge.Data.CreatureEffect -import Dodge.Data.Damage -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.Distortion 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.Modification import Dodge.Data.MountedObject -import Dodge.Data.Object -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.ObjectType import Dodge.Data.RightButtonOptions 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 GHC.Generics +import Dodge.Data.SoundOrigin +import Dodge.Data.Zoning import Geometry.Data import qualified IntMapHelp as IM import MaybeHelp @@ -198,49 +104,16 @@ data World = World , _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 = RewindingNow | RewindingLastFrame | NormalTimeFlow - deriving (Eq, Ord, Show, Read, Generic) - -instance ToJSON TimeFlowStatus where - toEncoding = genericToEncoding defaultOptions - -instance FromJSON TimeFlowStatus + deriving (Eq, Ord, Show, Read) data WorldHammer = SubInvHam | DoubleMouseHam - deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic) - -instance ToJSON WorldHammer where - toEncoding = genericToEncoding defaultOptions - -instance FromJSON WorldHammer - -instance ToJSONKey WorldHammer - -instance FromJSONKey WorldHammer + deriving (Eq, Ord, Show, Read, Enum, Bounded) data SaveSlot = QuicksaveSlot @@ -295,15 +168,12 @@ data MenuOption data IntID a = IntID Int a - type HitEffect' = Flame -> Stream (Of (Point2, Either Creature Wall)) Identity () -> World -> (World, Maybe Flame) -data Either3 a b c = E3x1 a | E3x2 b | E3x3 c - ---- ROOM DATATYPES data PSType = PutCrit {_unPutCrit :: Creature} @@ -414,7 +284,6 @@ data InPlacement = InPlacement makeLenses ''World ---makeLenses ''Particle makeLenses ''Universe makeLenses ''ScreenLayer makeLenses ''GenWorld diff --git a/src/Dodge/Data/ArcStep.hs b/src/Dodge/Data/ArcStep.hs index 3aaba1fbd..de8fed610 100644 --- a/src/Dodge/Data/ArcStep.hs +++ b/src/Dodge/Data/ArcStep.hs @@ -1,25 +1,35 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} + module Dodge.Data.ArcStep where -import Dodge.Data.CrWlID -import Geometry.Data + import Control.Lens -import GHC.Generics import Data.Aeson +import Dodge.Data.CrWlID +import GHC.Generics +import Geometry.Data + data ArcStep = ArcStep { _asPos :: Point2 , _asDir :: Float , _asObject :: CrWlID --Maybe (Either Creature Wall) } - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON ArcStep where + deriving (Eq, Ord, Show, Read, Generic) + +instance ToJSON ArcStep where toEncoding = genericToEncoding defaultOptions -instance FromJSON ArcStep -data NextArcStep = EndArc + +instance FromJSON ArcStep + +data NextArcStep + = EndArc | DefaultArcStep - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON NextArcStep where + deriving (Eq, Ord, Show, Read, Generic) + +instance ToJSON NextArcStep where toEncoding = genericToEncoding defaultOptions -instance FromJSON NextArcStep + +instance FromJSON NextArcStep + makeLenses ''ArcStep diff --git a/src/Dodge/Data/CWorld.hs b/src/Dodge/Data/CWorld.hs index 939c90e21..8cfc6ea73 100644 --- a/src/Dodge/Data/CWorld.hs +++ b/src/Dodge/Data/CWorld.hs @@ -3,6 +3,47 @@ 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 import Control.Lens diff --git a/src/Dodge/Data/CrWlID.hs b/src/Dodge/Data/CrWlID.hs index ae730957c..a896fb2b7 100644 --- a/src/Dodge/Data/CrWlID.hs +++ b/src/Dodge/Data/CrWlID.hs @@ -1,13 +1,14 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} + module Dodge.Data.CrWlID where -import GHC.Generics -import Data.Aeson + import Control.Lens -data CrWlID = CrID Int | WlID Int | NothingID -- TODO rewrite/remove this - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON CrWlID where - toEncoding = genericToEncoding defaultOptions -instance FromJSON CrWlID +import Data.Aeson +import Data.Aeson.TH + +data CrWlID = CrID Int | WlID Int | NothingID -- TODO rewrite/remove this + deriving (Eq, Ord, Show, Read) + makeLenses ''CrWlID +deriveJSON defaultOptions ''CrWlID diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index a54e2dcf6..be59e602b 100644 --- a/src/Dodge/Data/Creature.hs +++ b/src/Dodge/Data/Creature.hs @@ -9,6 +9,7 @@ module Dodge.Data.Creature ( module Dodge.Data.Creature.Perception, module Dodge.Data.Creature.Memory, module Dodge.Data.Creature.Stance, + module Dodge.Data.ActionPlan ) where import Control.Lens @@ -22,7 +23,6 @@ import Dodge.Data.Creature.Stance import Dodge.Data.Creature.State import Dodge.Data.Hammer import Dodge.Data.Item -import Dodge.Data.LoadAction import Dodge.Data.Material import GHC.Generics import Geometry.Data diff --git a/src/Dodge/Data/CreatureEffect.hs b/src/Dodge/Data/CreatureEffect.hs index 0c2be9fb4..4420639f7 100644 --- a/src/Dodge/Data/CreatureEffect.hs +++ b/src/Dodge/Data/CreatureEffect.hs @@ -1,81 +1,76 @@ {-# LANGUAGE StrictData #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell #-} + module Dodge.Data.CreatureEffect where -import GHC.Generics + import Data.Aeson +import Data.Aeson.TH + data WdCrCr = NoCreatureEffect - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON WdCrCr where - toEncoding = genericToEncoding defaultOptions -instance FromJSON WdCrCr + deriving (Eq, Ord, Show, Read) + data CrWdImp = NoCrWdImp - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON CrWdImp where - toEncoding = genericToEncoding defaultOptions -instance FromJSON CrWdImp + deriving (Eq, Ord, Show, Read) + data CrWdWd = CrWdWdId - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON CrWdWd where - toEncoding = genericToEncoding defaultOptions -instance FromJSON CrWdWd + deriving (Eq, Ord, Show, Read) + data IntImp = NoIntImp - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON IntImp where - toEncoding = genericToEncoding defaultOptions -instance FromJSON IntImp -data CrImp = NoCrImp + deriving (Eq, Ord, Show, Read) + +data CrImp + = NoCrImp | TurnTowardCr Float -- turn amount - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON CrImp where - toEncoding = genericToEncoding defaultOptions -instance FromJSON CrImp + deriving (Eq, Ord, Show, Read) + data P2Imp = P2ImpNo - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON P2Imp where - toEncoding = genericToEncoding defaultOptions -instance FromJSON P2Imp -data WdCrBl = WdCrTrue + deriving (Eq, Ord, Show, Read) + +data WdCrBl + = WdCrTrue | WdCrBlfromCrBl CrBl | WdCrNegate WdCrBl | WdCrLOSTarget | WdCrSafeDistFromTarget Float - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON WdCrBl where - toEncoding = genericToEncoding defaultOptions -instance FromJSON WdCrBl -data CrBl = CrCanShoot + deriving (Eq, Ord, Show, Read) + +data CrBl + = CrCanShoot | CrIsReloading | CrIsAiming | CrIsAnimate - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON CrBl where - toEncoding = genericToEncoding defaultOptions -instance FromJSON CrBl + deriving (Eq, Ord, Show, Read) + data MCrAc = MCrNoAction - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON MCrAc where - toEncoding = genericToEncoding defaultOptions -instance FromJSON MCrAc -data CrAc = CrTurnAround + deriving (Eq, Ord, Show, Read) + +data CrAc + = CrTurnAround | CrFleeFromTarget - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON CrAc where - toEncoding = genericToEncoding defaultOptions -instance FromJSON CrAc + deriving (Eq, Ord, Show, Read) + data P2Ac = P2NoAction - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON P2Ac where - toEncoding = genericToEncoding defaultOptions -instance FromJSON P2Ac + deriving (Eq, Ord, Show, Read) + data MP2Ac = MP2NoAction - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON MP2Ac where - toEncoding = genericToEncoding defaultOptions -instance FromJSON MP2Ac -data CrWdAc = CrWdBFSThenReturn Int + deriving (Eq, Ord, Show, Read) + +data CrWdAc + = CrWdBFSThenReturn Int | ChooseMovementSpreadGun | ChooseMovementLtAuto - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON CrWdAc where - toEncoding = genericToEncoding defaultOptions -instance FromJSON CrWdAc + deriving (Eq, Ord, Show, Read) + +deriveJSON defaultOptions ''WdCrCr +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 diff --git a/src/Dodge/Data/Gas.hs b/src/Dodge/Data/Gas.hs deleted file mode 100644 index fe5eb281b..000000000 --- a/src/Dodge/Data/Gas.hs +++ /dev/null @@ -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 diff --git a/src/Dodge/Data/Item/Use/Consumption.hs b/src/Dodge/Data/Item/Use/Consumption.hs index 83bec6c7b..261b80e06 100644 --- a/src/Dodge/Data/Item/Use/Consumption.hs +++ b/src/Dodge/Data/Item/Use/Consumption.hs @@ -2,13 +2,17 @@ {-# LANGUAGE StrictData #-} {-# 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 Data.Aeson import Data.Aeson.TH -import Dodge.Data.Ammo -import Dodge.Data.LoadAction +import Dodge.Data.Item.Use.Consumption.Ammo +import Dodge.Data.Item.Use.Consumption.LoadAction data HeldConsumption = LoadableAmmo diff --git a/src/Dodge/Data/Ammo.hs b/src/Dodge/Data/Item/Use/Consumption/Ammo.hs similarity index 84% rename from src/Dodge/Data/Ammo.hs rename to src/Dodge/Data/Item/Use/Consumption/Ammo.hs index 2339008e9..b59805284 100644 --- a/src/Dodge/Data/Ammo.hs +++ b/src/Dodge/Data/Item/Use/Consumption/Ammo.hs @@ -1,13 +1,16 @@ {-# LANGUAGE StrictData #-} {-# 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 Data.Aeson import Data.Aeson.TH import Dodge.Data.Bullet -import Dodge.Data.Gas import Dodge.Data.Payload import Dodge.Data.Wall @@ -50,9 +53,13 @@ data AmmoType | GenericAmmo deriving (Eq, Ord, Show, Read) +data GasCreate = CreatePoisonGas | CreateFlame + deriving (Eq, Ord, Show, Enum, Bounded, Read) + makeLenses ''ProjectileUpdate makeLenses ''AmmoType deriveJSON defaultOptions ''ProjectileDraw deriveJSON defaultOptions ''ProjectileCreate deriveJSON defaultOptions ''ProjectileUpdate deriveJSON defaultOptions ''AmmoType +deriveJSON defaultOptions ''GasCreate diff --git a/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs b/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs new file mode 100644 index 000000000..a8b0744da --- /dev/null +++ b/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs @@ -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 diff --git a/src/Dodge/Data/LoadAction.hs b/src/Dodge/Data/LoadAction.hs deleted file mode 100644 index 7d5c5f808..000000000 --- a/src/Dodge/Data/LoadAction.hs +++ /dev/null @@ -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 diff --git a/src/Dodge/Data/Machine.hs b/src/Dodge/Data/Machine.hs index 3688ac872..670d6e53a 100644 --- a/src/Dodge/Data/Machine.hs +++ b/src/Dodge/Data/Machine.hs @@ -1,21 +1,25 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} {-# 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 Control.Lens import Data.Aeson +import Data.Aeson.TH import qualified Data.IntSet as IS import qualified Data.Map.Strict as M import Dodge.Data.Damage import Dodge.Data.GenParams import Dodge.Data.Item +import Dodge.Data.Machine.Sensor import Dodge.Data.Material -import Dodge.Data.Object -import Dodge.Data.Sensor -import GHC.Generics +import Dodge.Data.ObjectType import Geometry.Data import Sound.Data @@ -24,17 +28,12 @@ data MachineDraw | MachineDrawTerminal | MachineDrawTurret | MachineDrawDamageSensor Float (PaletteColor, DecorationShape) - deriving (Eq, Ord, Show, Read, Generic) - -instance ToJSON MachineDraw where - toEncoding = genericToEncoding defaultOptions - -instance FromJSON MachineDraw + deriving (Eq, Show, Read) data Machine = Machine { _mcID :: Int , _mcWallIDs :: IS.IntSet - , _mcDraw :: MachineDraw --Machine -> SPic + , _mcDraw :: MachineDraw , _mcMaterial :: Material , _mcPos :: Point2 , _mcDir :: Float @@ -47,12 +46,7 @@ data Machine = Machine , _mcName :: String , _mcCloseSound :: Maybe SoundID } - deriving (Eq, Show, Read, Generic) - -instance ToJSON Machine where - toEncoding = genericToEncoding defaultOptions - -instance FromJSON Machine + deriving (Eq, Show, Read) data MachineType = StaticMachine @@ -62,12 +56,10 @@ data MachineType , _tuFireTime :: Int , _tuMCrID :: Maybe Int } - deriving (Eq, Show, Read, Generic) - -instance ToJSON MachineType where - toEncoding = genericToEncoding defaultOptions - -instance FromJSON MachineType + deriving (Eq, Show, Read) makeLenses ''Machine makeLenses ''MachineType +deriveJSON defaultOptions ''MachineDraw +deriveJSON defaultOptions ''Machine +deriveJSON defaultOptions ''MachineType diff --git a/src/Dodge/Data/Sensor.hs b/src/Dodge/Data/Machine/Sensor.hs similarity index 96% rename from src/Dodge/Data/Sensor.hs rename to src/Dodge/Data/Machine/Sensor.hs index d18e9fe49..46eaf6f97 100644 --- a/src/Dodge/Data/Sensor.hs +++ b/src/Dodge/Data/Machine/Sensor.hs @@ -1,7 +1,7 @@ {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} -module Dodge.Data.Sensor where +module Dodge.Data.Machine.Sensor where import Control.Lens import Data.Aeson diff --git a/src/Dodge/Data/MountedObject.hs b/src/Dodge/Data/MountedObject.hs index 3d76150b0..42e7a8908 100644 --- a/src/Dodge/Data/MountedObject.hs +++ b/src/Dodge/Data/MountedObject.hs @@ -1,13 +1,14 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} -module Dodge.Data.MountedObject - where -import GHC.Generics +{-# LANGUAGE TemplateHaskell #-} + +module Dodge.Data.MountedObject where + import Data.Aeson +import Data.Aeson.TH + data MountedObject = MountedLS Int | MountedProp Int - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON MountedObject where - toEncoding = genericToEncoding defaultOptions -instance FromJSON MountedObject + deriving (Eq, Ord, Show, Read) + +deriveJSON defaultOptions ''MountedObject diff --git a/src/Dodge/Data/Object.hs b/src/Dodge/Data/ObjectType.hs similarity index 55% rename from src/Dodge/Data/Object.hs rename to src/Dodge/Data/ObjectType.hs index a78aea01d..7b273ba91 100644 --- a/src/Dodge/Data/Object.hs +++ b/src/Dodge/Data/ObjectType.hs @@ -1,8 +1,11 @@ {-# LANGUAGE StrictData #-} -{-# LANGUAGE DeriveGeneric #-} -module Dodge.Data.Object where -import GHC.Generics +{-# LANGUAGE TemplateHaskell #-} + +module Dodge.Data.ObjectType where + import Data.Aeson +import Data.Aeson.TH + data ObjectType = ObTerminal | ObCreature @@ -15,9 +18,10 @@ data ObjectType | ObProp | ObTrigger | ObItem - deriving (Eq,Show,Ord,Read,Enum,Bounded,Generic) -instance ToJSON ObjectType where - toEncoding = genericToEncoding defaultOptions -instance FromJSON ObjectType + deriving (Eq, Show, Ord, Read, Enum, Bounded) + instance ToJSONKey ObjectType + instance FromJSONKey ObjectType + +deriveJSON defaultOptions ''ObjectType diff --git a/src/Dodge/Data/Payload.hs b/src/Dodge/Data/Payload.hs index dba74ef25..01ba0f9f6 100644 --- a/src/Dodge/Data/Payload.hs +++ b/src/Dodge/Data/Payload.hs @@ -1,11 +1,12 @@ -{-# LANGUAGE DeriveGeneric #-} ---{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} + module Dodge.Data.Payload where -import GHC.Generics + import Data.Aeson +import Data.Aeson.TH + data Payload = ExplosionPayload | DudPayload - deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic) -instance ToJSON Payload where - toEncoding = genericToEncoding defaultOptions -instance FromJSON Payload + deriving (Show, Read, Eq, Ord, Enum, Bounded) + +deriveJSON defaultOptions ''Payload diff --git a/src/Dodge/Data/Projectile.hs b/src/Dodge/Data/Projectile.hs index a0b1e1e91..5783bfc1f 100644 --- a/src/Dodge/Data/Projectile.hs +++ b/src/Dodge/Data/Projectile.hs @@ -5,7 +5,7 @@ module Dodge.Data.Projectile where import GHC.Generics import Data.Aeson import Dodge.Data.Payload -import Dodge.Data.Ammo +import Dodge.Data.Item.Use.Consumption.Ammo import Geometry.Data import Control.Lens --data ProjectileType = ShellType diff --git a/src/Dodge/Data/Prop.hs b/src/Dodge/Data/Prop.hs index e1ac72a83..ec025f234 100644 --- a/src/Dodge/Data/Prop.hs +++ b/src/Dodge/Data/Prop.hs @@ -1,55 +1,19 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} -module Dodge.Data.Prop - where -import GHC.Generics -import Data.Aeson -import Dodge.Data.WorldEffect -import Shape.Data +{-# LANGUAGE TemplateHaskell #-} + +module Dodge.Data.Prop where + import Color -import qualified Quaternion as Q -import Geometry.Data -import ShapePicture.Data import Control.Lens -data PropDraw = PropDrawSPic SPic - | PropDrawMovingShapeCol Shape - | PropDrawMovingShape PropDraw - | PropDrawFlatTranslate PropDraw - | PropDoubleLampCover Float - | PropVerticalLampCover Float - | PropLampCover Float - | PropDrawToggle PropDraw - | PropDrawGib Float - 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 +import Data.Aeson +import Data.Aeson.TH +import Dodge.Data.WorldEffect +import Geometry.Data +import qualified Quaternion as Q +import Shape.Data +import ShapePicture.Data + +data Prop = PropZ { _prPos :: Point2 , _prDraw :: PropDraw @@ -60,8 +24,8 @@ data Prop , _prPosZ :: Float , _prVelZ :: Float , _prTimer :: Int - , _prQuat :: Q.Quaternion Float - , _prQuatSpin :: Q.Quaternion Float + , _prQuat :: Q.Quaternion Float + , _prQuatSpin :: Q.Quaternion Float , _prColor :: Color } | ShapeProp @@ -72,8 +36,42 @@ data Prop , _prRot :: Float , _prToggle :: Bool } - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON Prop where - toEncoding = genericToEncoding defaultOptions -instance FromJSON Prop + deriving (Eq, Ord, Show, Read) + +data PropDraw + = 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 +deriveJSON defaultOptions ''PropDraw +deriveJSON defaultOptions ''PropUpdate +deriveJSON defaultOptions ''PrWdLsLs +deriveJSON defaultOptions ''Prop diff --git a/src/Dodge/Data/RadarSweep.hs b/src/Dodge/Data/RadarSweep.hs index 4d46a1144..20c76e609 100644 --- a/src/Dodge/Data/RadarSweep.hs +++ b/src/Dodge/Data/RadarSweep.hs @@ -1,20 +1,24 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} -module Dodge.Data.RadarSweep where -import GHC.Generics -import Data.Aeson -import Dodge.Data.Object -import Geometry.Data +{-# LANGUAGE TemplateHaskell #-} + +module Dodge.Data.RadarSweep ( + module Dodge.Data.RadarSweep, + module Dodge.Data.ObjectType, +) where + import Control.Lens +import Data.Aeson +import Data.Aeson.TH +import Dodge.Data.ObjectType +import Geometry.Data + data RadarSweep = RadarSweep - { _rsPos :: Point2 - , _rsRad :: Float + { _rsPos :: Point2 + , _rsRad :: Float , _rsObject :: ObjectType - , _rsTimer :: Int + , _rsTimer :: Int } - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON RadarSweep where - toEncoding = genericToEncoding defaultOptions -instance FromJSON RadarSweep + deriving (Eq, Ord, Show, Read) + makeLenses ''RadarSweep +deriveJSON defaultOptions ''RadarSweep diff --git a/src/Dodge/Data/RightButtonOptions.hs b/src/Dodge/Data/RightButtonOptions.hs index 1d0347563..7571c8c42 100644 --- a/src/Dodge/Data/RightButtonOptions.hs +++ b/src/Dodge/Data/RightButtonOptions.hs @@ -1,59 +1,70 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} + module Dodge.Data.RightButtonOptions where -import GHC.Generics + +import Control.Lens import Data.Aeson import Dodge.Data.Equipment.Misc -import Control.Lens +import GHC.Generics data RightButtonOptions = NoRightButtonOptions - | EquipOptions - {_opEquip :: [EquipPosition] - ,_opSel :: Int - ,_opCurInvPos :: Int - ,_opAllocateEquipment :: AllocateEquipment - ,_opActivateEquipment :: ActivateEquipment + | EquipOptions + { _opEquip :: [EquipPosition] + , _opSel :: Int + , _opCurInvPos :: Int + , _opAllocateEquipment :: AllocateEquipment + , _opActivateEquipment :: ActivateEquipment } - deriving (Eq,Ord,Show,Read,Generic) + deriving (Eq, Ord, Show, Read, Generic) + instance ToJSON RightButtonOptions where toEncoding = genericToEncoding defaultOptions + instance FromJSON RightButtonOptions + data ActivateEquipment - = ActivateEquipment {_activateEquipment :: Int } + = ActivateEquipment {_activateEquipment :: Int} | DeactivateEquipment {_deactivateEquipment :: Int} - | ActivateDeactivateEquipment {_activateEquipment :: Int ,_deactivateEquipment :: Int} + | ActivateDeactivateEquipment {_activateEquipment :: Int, _deactivateEquipment :: Int} | NoChangeActivateEquipment - deriving (Eq,Ord,Show,Read,Generic) + deriving (Eq, Ord, Show, Read, Generic) + instance ToJSON ActivateEquipment where toEncoding = genericToEncoding defaultOptions + instance FromJSON ActivateEquipment -data AllocateEquipment + +data AllocateEquipment = DoNotMoveEquipment | PutOnEquipment { _allocNewPos :: EquipPosition } | MoveEquipment - { _allocNewPos :: EquipPosition - , _allocOldPos :: EquipPosition + { _allocNewPos :: EquipPosition + , _allocOldPos :: EquipPosition } | SwapEquipment - { _allocNewPos :: EquipPosition - , _allocOldPos :: EquipPosition - , _allocSwapID :: Int + { _allocNewPos :: EquipPosition + , _allocOldPos :: EquipPosition + , _allocSwapID :: Int } | ReplaceEquipment - { _allocNewPos :: EquipPosition + { _allocNewPos :: EquipPosition , _allocRemoveID :: Int } | RemoveEquipment - { _allocOldPos :: EquipPosition + { _allocOldPos :: EquipPosition } - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON AllocateEquipment where + deriving (Eq, Ord, Show, Read, Generic) + +instance ToJSON AllocateEquipment where toEncoding = genericToEncoding defaultOptions -instance FromJSON AllocateEquipment + +instance FromJSON AllocateEquipment + makeLenses ''RightButtonOptions makeLenses ''AllocateEquipment makeLenses ''ActivateEquipment diff --git a/src/Dodge/Data/SoundOrigin.hs b/src/Dodge/Data/SoundOrigin.hs index 8b4552a37..b7f521cea 100644 --- a/src/Dodge/Data/SoundOrigin.hs +++ b/src/Dodge/Data/SoundOrigin.hs @@ -1,11 +1,14 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} -module Dodge.Data.SoundOrigin - where -import Dodge.Data.Material -import GHC.Generics +{-# LANGUAGE TemplateHaskell #-} + +module Dodge.Data.SoundOrigin where + import Data.Aeson -data SoundOrigin = InventorySound +import Data.Aeson.TH +import Dodge.Data.Material + +data SoundOrigin + = InventorySound | BackgroundSound | OnceSound | CrSound Int @@ -30,7 +33,10 @@ data SoundOrigin = InventorySound | LeverSound Int | Explosion Int | Tap Int - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON SoundOrigin where - toEncoding = genericToEncoding defaultOptions -instance FromJSON SoundOrigin + deriving (Eq, Ord, Show, Read) + +instance ToJSONKey SoundOrigin + +instance FromJSONKey SoundOrigin + +deriveJSON defaultOptions ''SoundOrigin diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index 13a6c5c9f..b58e6efac 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -2,7 +2,6 @@ module Dodge.Default.Weapon where import Control.Lens import qualified Data.Map.Strict as M -import Dodge.Data.Ammo import Dodge.Data.Hammer import Dodge.Data.Item import Dodge.Default.AimParams diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index a71e8da87..d3614d184 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -1,4 +1,5 @@ module Dodge.Default.World where +import Dodge.Data.Hammer import Dodge.Data import Geometry.Data import Geometry.Polygon diff --git a/src/Dodge/Projectile/Create.hs b/src/Dodge/Projectile/Create.hs index 746a44ba4..c479a5180 100644 --- a/src/Dodge/Projectile/Create.hs +++ b/src/Dodge/Projectile/Create.hs @@ -1,42 +1,51 @@ module Dodge.Projectile.Create where + import Dodge.Data import Dodge.Item.Location -import LensHelp -import qualified IntMapHelp as IM 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 CreateShell -> fireShell CreateTrackingShell -> fireTrackingShell fireShell :: Item -> Creature -> World -> World -fireShell it cr = makeShell it cr - [ PJSpin 335 (_crID cr) spinamount - , PJThrust (350 - thrustdelay) 0 - , PJReduceSpin (1-fromIntegral spindrag*2 / 200) - ] - where +fireShell it cr = + makeShell + it + cr + [ PJSpin 335 (_crID cr) spinamount + , PJThrust (350 - thrustdelay) 0 + , PJReduceSpin (1 - fromIntegral spindrag * 2 / 200) + ] + where params = _itParams it spindrag = _shellSpinDrag params spinamount = _shellSpinAmount params thrustdelay = _shellThrustDelay params + makeShell :: Item -> Creature -> [ProjectileUpdate] -> World -> World -makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell - { _prjPos = pos - , _prjZ = 20 - , _prjStartPos = pos - , _prjVel = rotateV dir (V2 1 0) - , _prjDraw = DrawShell - , _prjID = i - , _prjAcc = rotateV dir (V2 3 0) - , _prjDir = dir - , _prjSpin = 0 - , _prjPayload = _amPayload $ _laAmmoType am - , _prjTimer = 350 - , _prjUpdates = theupdate - , _prjMITID = _itID it - } +makeShell it cr theupdate w = + w & cWorld . projectiles + %~ IM.insert + i + Shell + { _prjPos = pos + , _prjZ = 20 + , _prjStartPos = pos + , _prjVel = rotateV dir (V2 1 0) + , _prjDraw = DrawShell + , _prjID = i + , _prjAcc = rotateV dir (V2 3 0) + , _prjDir = dir + , _prjSpin = 0 + , _prjPayload = _amPayload $ _laAmmoType am + , _prjTimer = 350 + , _prjUpdates = theupdate + , _prjMITID = _itID it + } where i = IM.newKey $ _props (_cWorld w) dir = _crDir cr @@ -44,19 +53,19 @@ makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell am = _heldConsumption $ _itUse it --fireShell :: Item -> Creature -> World -> World ---fireShell it cr = makeShell it cr $ \pj -> pjEffAtTime 35 (trySpinByCID (_crID cr) spinamount) pj --- . pjThrust thrustdelay pj --- . reduceSpinBy (1-fromIntegral spindrag*2 / 200) pj --- . decTimMvVel pj +--fireShell it cr = makeShell it cr $ \pj -> pjEffAtTime 35 (trySpinByCID (_crID cr) spinamount) pj +-- . pjThrust thrustdelay pj +-- . reduceSpinBy (1-fromIntegral spindrag*2 / 200) pj +-- . decTimMvVel pj -- . moveShell pj --- where +-- where -- params = _itParams it -- spindrag = _shellSpinDrag params -- spinamount = _shellSpinAmount params -- thrustdelay = _shellThrustDelay params -- --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 -- , _prjZ = 20 -- , _prjStartPos = pos @@ -77,19 +86,19 @@ makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell -- am = _itConsumption it -- --moveShell :: Proj --- -> World -- -> World ---moveShell pj w +-- -> World +--moveShell pj w -- | time > 40 = if circOnSomeWall oldPos 4 w -- then doExplode -- else w -- | anythingHitCirc 2 oldPos newPos w = doExplode -- | time > -300 = w -- | otherwise = doExplode --- where +-- where -- time = _prjTimer pj -- doExplode = w --- & usePayload (_prjPayload pj) oldPos +-- & usePayload (_prjPayload pj) oldPos -- & stopSoundFrom (ShellSound i) -- & props %~ IM.delete i -- 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 -- --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) -- [1..i-1] -- where -- f n = (. createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it (cr & crDir +~ (2*pi*fromIntegral n / fromIntegral i))) -- ---pjEffAtTime +--pjEffAtTime -- :: Int -- -> (Proj -> World -> World) -- -> Proj @@ -121,7 +130,7 @@ makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell -- :: Int -- ^ creature id -- -> Int -- ^ Spin amount -- -> Proj --- -> World +-- -> World -- -> World --trySpinByCID cid i pj w = w & projectiles . ix pjid . prjSpin .~ newSpin -- where @@ -146,7 +155,7 @@ makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell -- st = et - 100 -- rotateToTarget _ = fromMaybe id $ do -- 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) -- itPoint = pointToItem $ _itemPositions w IM.! itid -- @@ -174,7 +183,7 @@ makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell -- :: (Int,Int) -- -> (Proj -> World -> World) -- -> Proj --- -> World +-- -> World -- -> World --pjEffTimeRange (st,et) 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 it cr w = addTrackRocket w' where - (w',itid) = getHeldItemLoc cr w - addTrackRocket = makeShell it cr - [ PJSpin 335 (_crID cr) spinamount - , PJTrack (350 - thrustdelay) 0 itid - , PJThrust (350 - thrustdelay) 0 - , PJReduceSpin (1-fromIntegral spindrag*2 / 200) - ] + (w', itid) = getHeldItemLoc cr w + addTrackRocket = + makeShell + it + cr + [ PJSpin 335 (_crID cr) spinamount + , PJTrack (350 - thrustdelay) 0 itid + , PJThrust (350 - thrustdelay) 0 + , PJReduceSpin (1 - fromIntegral spindrag * 2 / 200) + ] spinamount = _shellSpinAmount params thrustdelay = _shellThrustDelay params spindrag = _shellSpinDrag params diff --git a/src/Dodge/RadarSweep/Draw.hs b/src/Dodge/RadarSweep/Draw.hs index 365838d88..e13a94eb9 100644 --- a/src/Dodge/RadarSweep/Draw.hs +++ b/src/Dodge/RadarSweep/Draw.hs @@ -1,5 +1,5 @@ module Dodge.RadarSweep.Draw where -import Dodge.Data.Object + import Dodge.Data.RadarSweep import Geometry import Picture @@ -10,18 +10,20 @@ drawRadarSweep pt = setLayer DebugLayer $ pictures sweepPics col = rsObjectColor $ _rsObject pt p = _rsPos pt r = _rsRad pt - sweepPics = [colHelper 0.1 $ uncurryV translate p $ thickCircle r 15 - ,colHelper 0.06 $ uncurryV translate p $ thickCircle (r-5) 5 - ,colHelper 0.03 $ uncurryV translate p $ thickCircle (r-10) 5 - ] + sweepPics = + [ colHelper 0.1 $ uncurryV translate p $ thickCircle r 15 + , 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) - globalAlpha | x > 10 = 1 - | otherwise = fromIntegral x / 10 + globalAlpha + | x > 10 = 1 + | otherwise = fromIntegral x / 10 x = _rsTimer pt rsObjectColor :: ObjectType -> Color rsObjectColor ob = case ob of ObWall -> red ObCreature -> green - ObItem -> blue + ObItem -> blue _ -> yellow diff --git a/src/Dodge/Reloading/Action.hs b/src/Dodge/Reloading/Action.hs index 92a820803..f2f2a3e47 100644 --- a/src/Dodge/Reloading/Action.hs +++ b/src/Dodge/Reloading/Action.hs @@ -1,6 +1,6 @@ module Dodge.Reloading.Action where import Dodge.SoundLogic.ExternallyGeneratedSounds -import Dodge.Data.LoadAction +import Dodge.Data.Item.Use.Consumption.LoadAction loadInsert :: Int -> LoadAction loadInsert x = LoadInsert x insertS diff --git a/src/Sound/Data.hs b/src/Sound/Data.hs index 07a3ec0ef..5a4deb13f 100644 --- a/src/Sound/Data.hs +++ b/src/Sound/Data.hs @@ -1,54 +1,74 @@ -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} -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 + +module Sound.Data where + import Control.Lens -import Geometry.Data -import Data.Word (Word8) +import Data.Aeson +import Data.Aeson.TH 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 - {_playStatus :: PlayStatus - ,_isLooping :: Bool + { _playStatus :: PlayStatus + , _isLooping :: Bool } - deriving (Eq,Ord,Show,Generic) -instance ToJSON SoundStatus where - toEncoding = genericToEncoding defaultOptions -instance FromJSON SoundStatus + deriving (Eq, Ord, Show) + + + -- TODO make this more sensible (use product rather than union in some cases) -data PlayStatus +data PlayStatus = JustStartedPlaying | Playing | ToStart | ToContinueStart | ToStop - deriving (Eq,Ord,Show,Generic) -instance ToJSON PlayStatus where - toEncoding = genericToEncoding defaultOptions -instance FromJSON PlayStatus -newtype SoundID = SoundID { _getSoundID :: Int } - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON SoundID where - toEncoding = genericToEncoding defaultOptions -instance FromJSON SoundID + deriving (Eq, Ord, Show) + + + +newtype SoundID = SoundID {_getSoundID :: Int} + deriving (Eq, Ord, Show, Read) + + + newtype SoundData = SoundData - {_loadedChunks :: IM.IntMap Mix.Chunk + { _loadedChunks :: IM.IntMap Mix.Chunk } -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 + +data ToPlaySound = ToPlaySound + { _toPlaySoundTime :: Maybe Int + , _toPlaySoundStatus :: SoundStatus + , _toPlaySoundPos :: Point2 -- these exist? + , _toPlaySoundVolume :: 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 - , _soundChunkID :: SoundID + , _soundChunkID :: SoundID } - deriving (Eq,Ord,Show) + deriving (Eq, Ord, Show) + makeLenses ''SoundData makeLenses ''Sound +makeLenses ''SoundID makeLenses ''SoundStatus +deriveJSON defaultOptions ''SoundStatus +deriveJSON defaultOptions ''PlayStatus +deriveJSON defaultOptions ''SoundID +deriveJSON defaultOptions ''ToPlaySound