From 4c5218c63332fbf43637c92613ad8185d157ca18 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 22 Jul 2022 01:06:35 +0100 Subject: [PATCH] Add Read instances --- src/Dodge/Combine/Data.hs | 9 +++-- src/Dodge/Data.hs | 3 -- src/Dodge/Data/ActionPlan.hs | 2 +- src/Dodge/Data/Ammo.hs | 4 +++ src/Dodge/Data/ArcStep.hs | 2 ++ src/Dodge/Data/Beam.hs | 4 +++ src/Dodge/Data/Bullet.hs | 6 ++++ src/Dodge/Data/CamouflageStatus.hs | 2 +- src/Dodge/Data/CrWlID.hs | 3 +- src/Dodge/Data/Creature.hs | 5 +++ src/Dodge/Data/Damage.hs | 4 +-- src/Dodge/Data/Gas.hs | 1 + src/Dodge/Data/Hammer.hs | 4 +-- src/Dodge/Data/ItEffect.hs | 4 +++ src/Dodge/Data/Item.hs | 14 ++++---- src/Dodge/Data/Item/Consumption.hs | 1 + src/Dodge/Data/Item/HeldScroll.hs | 1 + src/Dodge/Data/Item/HeldUse.hs | 6 +++- src/Dodge/Data/Item/Misc.hs | 5 +++ src/Dodge/Data/Item/Params.hs | 5 +++ src/Dodge/Data/Item/Tweak.hs | 17 ++++++++++ src/Dodge/Data/Item/Use.hs | 7 +++- src/Dodge/Data/Item/UseDelay.hs | 1 + src/Dodge/Data/ItemAmount.hs | 2 +- src/Dodge/Data/LoadAction.hs | 4 +-- src/Dodge/Data/Material.hs | 2 +- src/Dodge/Data/Payload.hs | 1 + src/Dodge/Data/Targeting.hs | 3 ++ src/Dodge/Data/Wall.hs | 9 +++-- src/Dodge/Event.hs | 20 +++--------- src/Dodge/Item/Attachment/Data.hs | 2 ++ src/Dodge/Item/Data.hs | 1 + src/Dodge/Item/Weapon/BatteryGuns.hs | 49 +++++++--------------------- src/Dodge/Item/Weapon/Launcher.hs | 25 +++++--------- src/Dodge/LevelGen/Switch.hs | 2 +- src/Dodge/LightSource.hs | 2 +- src/Dodge/Render/HUD.hs | 9 +++-- src/Dodge/Render/Walls.hs | 3 +- src/Dodge/Tweak.hs | 24 ++++++++++++++ src/Dodge/Tweak/Show.hs | 25 ++++++++++++++ src/Dodge/Wall/Draw.hs | 18 ++++++++++ src/Dodge/Wall/ForceField.hs | 13 +------- src/Picture/Data.hs | 9 ++--- src/Sound/Data.hs | 2 +- 44 files changed, 209 insertions(+), 126 deletions(-) create mode 100644 src/Dodge/Data/Item/Tweak.hs create mode 100644 src/Dodge/Tweak/Show.hs create mode 100644 src/Dodge/Wall/Draw.hs diff --git a/src/Dodge/Combine/Data.hs b/src/Dodge/Combine/Data.hs index 391d3e4c2..89b9d0cac 100644 --- a/src/Dodge/Combine/Data.hs +++ b/src/Dodge/Combine/Data.hs @@ -12,10 +12,10 @@ data ItemType = ItemType ,_iyModules :: M.Map ModuleSlot ItemModuleType ,_iyStack :: Stack } - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) data Stack = NoStack | Stack IcAmount - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) data CraftType = PIPE @@ -200,8 +200,7 @@ data ItemModuleType | LAUNCHHOME | EXTRABATTERY | ATTACHTORCH - deriving (Eq,Ord,Show) - + deriving (Eq,Ord,Show,Read) data Detector = ITEMDETECTOR | CREATUREDETECTOR @@ -220,7 +219,7 @@ data ModuleSlot | ModTeleport | ModDualBeam | ModHeldAttach - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) makeLenses ''ItemType makeLenses ''ItemBaseType diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 52954f8cf..59dcddcd4 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -723,7 +723,6 @@ data InPlacement = InPlacement , _ipPlacementID :: Int } makeLenses ''World -makeLenses ''Creature makeLenses ''FloorItem makeLenses ''Prop makeLenses ''Proj @@ -731,7 +730,6 @@ makeLenses ''Modification makeLenses ''Particle makeLenses ''PressPlate makeLenses ''CrGroupParams -makeLenses ''Intention makeLenses ''Door makeLenses ''Terminal makeLenses ''Machine @@ -747,7 +745,6 @@ makeLenses ''WorldBeams makeLenses ''TerminalCommand makeLenses ''TerminalInput makeLenses ''GenParams -makeLenses ''Corpse ----- ROOM LENSES makeLenses ''Room diff --git a/src/Dodge/Data/ActionPlan.hs b/src/Dodge/Data/ActionPlan.hs index 58bd35c29..71ad7427c 100644 --- a/src/Dodge/Data/ActionPlan.hs +++ b/src/Dodge/Data/ActionPlan.hs @@ -19,7 +19,7 @@ data ActionPlan ,_apStrategy :: Strategy ,_apGoal :: [Goal] } -data RandImpulse = RandImpulseList [Impulse] +newtype RandImpulse = RandImpulseList [Impulse] data Impulse = Move Point2 | MoveForward Float diff --git a/src/Dodge/Data/Ammo.hs b/src/Dodge/Data/Ammo.hs index 794a9509f..6174a8e91 100644 --- a/src/Dodge/Data/Ammo.hs +++ b/src/Dodge/Data/Ammo.hs @@ -7,7 +7,9 @@ import Dodge.Data.Gas import Dodge.Data.Wall import Control.Lens data ProjectileDraw = DrawShell | DrawRemoteShell | DrawDrone | DrawBlankProjectile + deriving (Show,Read,Eq,Ord,Enum,Bounded) data ProjectileCreate = CreateShell | CreateTrackingShell + deriving (Show,Read,Eq,Ord,Enum,Bounded) data ProjectileUpdate = PJThrust {_pjuStart :: Int, _pjuEnd :: Int} | PJSpin {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int} @@ -16,6 +18,7 @@ data ProjectileUpdate | PJRemoteDirection {_pjuStart :: Int, _pjuEnd :: Int, _pjuCID :: Int, _pjuITID :: Int} | PJSetScope {_pjuITID :: Int} | PJRetireRemote {_pjuITID :: Int, _pjuTimer :: Int, _pjuPJID :: Int} + deriving (Show,Read,Eq,Ord) data AmmoType = ProjectileAmmo @@ -38,5 +41,6 @@ data AmmoType { _amForceFieldType :: Wall } | GenericAmmo + deriving (Show,Read) makeLenses ''ProjectileUpdate makeLenses ''AmmoType diff --git a/src/Dodge/Data/ArcStep.hs b/src/Dodge/Data/ArcStep.hs index 9a54c6e2a..d601bd09d 100644 --- a/src/Dodge/Data/ArcStep.hs +++ b/src/Dodge/Data/ArcStep.hs @@ -9,6 +9,8 @@ data ArcStep = ArcStep , _asDir :: Float , _asObject :: CrWlID --Maybe (Either Creature Wall) } + deriving (Eq,Ord,Show,Read) data NextArcStep = EndArc | DefaultArcStep + deriving (Eq,Ord,Show,Read) makeLenses ''ArcStep diff --git a/src/Dodge/Data/Beam.hs b/src/Dodge/Data/Beam.hs index 0463d107c..643570ab2 100644 --- a/src/Dodge/Data/Beam.hs +++ b/src/Dodge/Data/Beam.hs @@ -22,18 +22,22 @@ data Beam = Beam , _bmOrigin :: Maybe Int , _bmType :: BeamType } + deriving (Eq,Ord,Show,Read) data BeamDraw = BasicBeamDraw | BeamDrawColor Color + deriving (Eq,Ord,Show,Read) data BeamCombineType = FlameBeamCombine | LasBeamCombine | TeslaBeamCombine | SplitBeamCombine | NoBeamCombine + deriving (Eq,Ord,Show,Read) data BeamType = BeamCombine { _beamCombine :: BeamCombineType -- (Point2 , (Point2,Point2,Beam) , (Point2,Point2,Beam)) -> World -> World } | BeamSimple + deriving (Eq,Ord,Show,Read) makeLenses ''BeamType makeLenses ''Beam diff --git a/src/Dodge/Data/Bullet.hs b/src/Dodge/Data/Bullet.hs index 8a0f90ae0..6a3b6b710 100644 --- a/src/Dodge/Data/Bullet.hs +++ b/src/Dodge/Data/Bullet.hs @@ -18,19 +18,25 @@ data Bullet = Bullet , _buTimer :: Int , _buDamages :: [Damage] } + deriving (Show,Read,Eq,Ord) data EnergyBallType = IncBall | TeslaBall | ConcBall + deriving (Show,Read,Eq,Ord,Enum,Bounded) data BulletState = NormalBulletState | DelayedBullet Float + deriving (Show,Read,Eq,Ord) data BulletUpdateMod = NoBulletUpdateMod + deriving (Show,Read,Eq,Ord,Enum,Bounded) data BulletEffect = DestroyBullet | BounceBullet | PenetrateBullet deriving (Eq,Ord,Show,Read,Enum,Bounded) data BulletSpawn = BulBall EnergyBallType | BulSpark + deriving (Show,Read,Eq,Ord) data BulletTrajectory = BasicBulletTrajectory | BezierTrajectory Point2 Point2 Point2 | FlechetteTrajectory Point2 | MagnetTrajectory Point2 + deriving (Show,Read,Eq,Ord) makeLenses ''Bullet diff --git a/src/Dodge/Data/CamouflageStatus.hs b/src/Dodge/Data/CamouflageStatus.hs index 1d3c906f5..bad688fdc 100644 --- a/src/Dodge/Data/CamouflageStatus.hs +++ b/src/Dodge/Data/CamouflageStatus.hs @@ -2,4 +2,4 @@ module Dodge.Data.CamouflageStatus where data CamouflageStatus = FullyVisible | Invisible - deriving (Eq,Ord,Enum) + deriving (Eq,Ord,Enum,Read,Show,Bounded) diff --git a/src/Dodge/Data/CrWlID.hs b/src/Dodge/Data/CrWlID.hs index 030685b0a..8e5647de8 100644 --- a/src/Dodge/Data/CrWlID.hs +++ b/src/Dodge/Data/CrWlID.hs @@ -2,5 +2,6 @@ {-# LANGUAGE StrictData #-} module Dodge.Data.CrWlID where import Control.Lens -data CrWlID = CrID Int | WlID Int | NothingID +data CrWlID = CrID Int | WlID Int | NothingID -- TODO rewrite/remove this + deriving (Eq,Ord,Show,Read) makeLenses ''CrWlID diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index e2aff4114..02582ecc5 100644 --- a/src/Dodge/Data/Creature.hs +++ b/src/Dodge/Data/Creature.hs @@ -21,6 +21,8 @@ import ShapePicture import Geometry.Data import qualified IntMapHelp as IM import qualified Data.Map.Strict as M + +import Control.Lens data Creature = Creature { _crPos :: Point2 , _crOldPos :: Point2 @@ -73,3 +75,6 @@ data Intention = Intention , _mvToPoint :: Maybe Point2 , _viewPoint :: Maybe Point2 } +makeLenses ''Creature +makeLenses ''Intention +makeLenses ''Corpse diff --git a/src/Dodge/Data/Damage.hs b/src/Dodge/Data/Damage.hs index 47be2bf54..93f3d5e28 100644 --- a/src/Dodge/Data/Damage.hs +++ b/src/Dodge/Data/Damage.hs @@ -20,14 +20,14 @@ data DamageEffect | TorqueDamage { _deTorque :: Float } | PushBackDamage {_dePushBack :: Float } | NoDamageEffect - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) data Damage = Damage { _dmType :: DamageType , _dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 , _dmEffect :: DamageEffect } - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) isElectrical :: Damage -> Bool isElectrical dm = case _dmType dm of ELECTRICAL -> True diff --git a/src/Dodge/Data/Gas.hs b/src/Dodge/Data/Gas.hs index 926b4db37..4ac9eed5a 100644 --- a/src/Dodge/Data/Gas.hs +++ b/src/Dodge/Data/Gas.hs @@ -2,3 +2,4 @@ --{-# LANGUAGE StrictData #-} module Dodge.Data.Gas where data GasCreate = CreatePoisonGas | CreateFlame + deriving (Eq,Ord,Show,Enum,Bounded,Read) diff --git a/src/Dodge/Data/Hammer.hs b/src/Dodge/Data/Hammer.hs index b51f31eac..e3b2fc960 100644 --- a/src/Dodge/Data/Hammer.hs +++ b/src/Dodge/Data/Hammer.hs @@ -6,11 +6,11 @@ data HammerType = NoHammer | HasHammer {_hammerPosition :: HammerPosition} deriving - (Eq, Ord, Show) + (Eq, Ord, Show,Read) data HammerPosition = HammerDown | HammerReleased | HammerUp deriving - (Eq, Ord, Show) + (Eq, Ord, Show,Read) makeLenses ''HammerType diff --git a/src/Dodge/Data/ItEffect.hs b/src/Dodge/Data/ItEffect.hs index 63dc33d0c..6752a78c2 100644 --- a/src/Dodge/Data/ItEffect.hs +++ b/src/Dodge/Data/ItEffect.hs @@ -27,6 +27,7 @@ data ItEffect , _ieDrop :: ItDropEffect --Item -> Creature -> World -> World , _ieMID :: Maybe Int } + deriving (Eq,Ord,Show,Read) data ItInvEffect = NoInvEffect | RewindEffect @@ -35,6 +36,9 @@ data ItInvEffect = NoInvEffect | CreateHeldLight | CreateShieldWall | RemoveShieldWall + deriving (Eq,Ord,Show,Read) data ItFloorEffect = NoFloorEffect + deriving (Eq,Ord,Show,Read) data ItDropEffect = NoDropEffect + deriving (Eq,Ord,Show,Read) makeLenses ''ItEffect diff --git a/src/Dodge/Data/Item.hs b/src/Dodge/Data/Item.hs index a2c9e3a6e..4b9ce4940 100644 --- a/src/Dodge/Data/Item.hs +++ b/src/Dodge/Data/Item.hs @@ -3,9 +3,13 @@ module Dodge.Data.Item ( module Dodge.Data.Item , module Dodge.Data.Item.Misc + , module Dodge.Data.Item.Tweak + , module Dodge.Data.Item.Params + , module Dodge.Data.Item.Use ) where import Control.Lens import Dodge.Data.Item.Misc +import Dodge.Data.Item.Tweak import Dodge.Data.Item.Consumption import Dodge.Data.Item.Use import Dodge.Data.Item.Params @@ -36,19 +40,13 @@ data Item = Item , _itValue :: ItemValue , _itParams :: ItemParams } + deriving (Show,Read) data ItemTweaks = NoTweaks | Tweakable { _tweakParams :: IM.IntMap TweakParam , _tweakSel :: Int } -data TweakParam = TweakParam - { _doTweak :: Int -> Item -> Item - , _curTweak :: Int - , _maxTweak :: Int - , _showTweak :: Int -> String - , _nameTweak :: String - } + deriving (Eq,Ord,Show,Read) makeLenses ''Item makeLenses ''ItemTweaks -makeLenses ''TweakParam diff --git a/src/Dodge/Data/Item/Consumption.hs b/src/Dodge/Data/Item/Consumption.hs index a6edd5cd1..edff4f908 100644 --- a/src/Dodge/Data/Item/Consumption.hs +++ b/src/Dodge/Data/Item/Consumption.hs @@ -28,4 +28,5 @@ data ItemConsumption { _icAmount :: IcAmount } | NoConsumption + deriving (Show,Read) makeLenses ''ItemConsumption diff --git a/src/Dodge/Data/Item/HeldScroll.hs b/src/Dodge/Data/Item/HeldScroll.hs index 3cd2c254b..880664027 100644 --- a/src/Dodge/Data/Item/HeldScroll.hs +++ b/src/Dodge/Data/Item/HeldScroll.hs @@ -2,3 +2,4 @@ module Dodge.Data.Item.HeldScroll where data HeldScroll = HeldScrollDoNothing | HeldScrollZoom | HeldScrollCharMode + deriving (Eq,Ord,Enum,Bounded,Show,Read) diff --git a/src/Dodge/Data/Item/HeldUse.hs b/src/Dodge/Data/Item/HeldUse.hs index 5caefe015..19fa806af 100644 --- a/src/Dodge/Data/Item/HeldUse.hs +++ b/src/Dodge/Data/Item/HeldUse.hs @@ -18,9 +18,11 @@ data HeldUse = HeldDoNothing | HeldSonicWave | HeldForceField | HeldShatter + deriving (Eq,Ord,Show,Read) data Cuse = CDoNothing | CHeal Int + deriving (Eq,Ord,Show,Read) data Euse = EDoNothing | EDetector Detector @@ -32,13 +34,14 @@ data Euse = EDoNothing | EonWristShield | EoffWristShield - + deriving (Eq,Ord,Show,Read) data Luse = LDoNothing | LRewind | LShrink | LBlink | LUnsafeBlink | LBoost + deriving (Eq,Ord,Show,Read) data HeldMod = HeldModNothing | PoisonSprayerMod @@ -72,3 +75,4 @@ data HeldMod = HeldModNothing | SmgMod | RevolverXMod | BangConeMod + deriving (Eq,Ord,Show,Read) diff --git a/src/Dodge/Data/Item/Misc.hs b/src/Dodge/Data/Item/Misc.hs index 304850b1d..e92edf725 100644 --- a/src/Dodge/Data/Item/Misc.hs +++ b/src/Dodge/Data/Item/Misc.hs @@ -9,6 +9,7 @@ data ItemDimension = ItemDimension , _dimCenter :: Point3 , _dimAttachPos :: Point3 } + deriving (Eq,Ord,Show,Read) data ItemPortage = HeldItem { _handlePos :: Float @@ -16,16 +17,20 @@ data ItemPortage } | WornItem | NoPortage + deriving (Eq,Ord,Show,Read) data ItemValue = ItemValue { _ivInt :: Int , _ivType :: ItemValueType } + deriving (Eq,Ord,Show,Read) data ItemValueType = MundaneItem | ArtefactItem + deriving (Eq,Ord,Show,Read) data ItemPos = InInv { _ipCrID :: Int , _ipInvID :: Int } | OnFloor { _ipFlID :: Int } | VoidItm + deriving (Eq,Ord,Show,Read) makeLenses ''ItemDimension makeLenses ''ItemPortage makeLenses ''ItemValue diff --git a/src/Dodge/Data/Item/Params.hs b/src/Dodge/Data/Item/Params.hs index e9bec1b6c..7be0cea08 100644 --- a/src/Dodge/Data/Item/Params.hs +++ b/src/Dodge/Data/Item/Params.hs @@ -55,7 +55,9 @@ data ItemParams , _previousArcEffect :: PreviousArcEffect } | ParamMID {_paramMID :: Maybe Int} + deriving (Eq,Ord,Show,Read) data PreviousArcEffect = NoPreviousArcEffect | PerturbTillBreakPreviousArc + deriving (Eq,Ord,Show,Read) data GunBarrels = MultiBarrel { _brlSpread :: BarrelSpread @@ -67,6 +69,7 @@ data GunBarrels , _brlInaccuracy :: Float } | SingleBarrel {_brlInaccuracy :: Float} + deriving (Eq,Ord,Show,Read) data Nozzle = Nozzle { _nzPressure :: Float , _nzDir :: Float @@ -75,10 +78,12 @@ data Nozzle = Nozzle , _nzWalkSpeed :: Float , _nzLength :: Float } + deriving (Eq,Ord,Show,Read) data BarrelSpread = AlignedBarrels | SpreadBarrels {_spreadAngle :: Float} | RotatingBarrels {_rotatingBarrelInaccuracy :: Float} + deriving (Eq,Ord,Show,Read) makeLenses ''BarrelSpread makeLenses ''ItemParams diff --git a/src/Dodge/Data/Item/Tweak.hs b/src/Dodge/Data/Item/Tweak.hs new file mode 100644 index 000000000..710ea1090 --- /dev/null +++ b/src/Dodge/Data/Item/Tweak.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data.Item.Tweak where +import Control.Lens +data TweakType = TweakPhaseV + | TweakTractionPower + | TweakSpinDrag + | TweakSpinAmount + | TweakThrustDelay + deriving (Eq,Ord,Show,Read) +data TweakParam = TweakParam + { _tweakType :: TweakType -- Int -> Item -> Item + , _tweakVal :: Int + , _tweakMax :: Int + } + deriving (Eq,Ord,Show,Read) +makeLenses ''TweakParam diff --git a/src/Dodge/Data/Item/Use.hs b/src/Dodge/Data/Item/Use.hs index a01885f9d..32ce82274 100644 --- a/src/Dodge/Data/Item/Use.hs +++ b/src/Dodge/Data/Item/Use.hs @@ -30,6 +30,7 @@ data ItemUse { _eqEq :: Equipment } | NoUse + deriving (Eq,Ord,Show,Read) data Equipment = Equipment { _eqUse :: Euse --Item -> Creature -> World -> World , _eqOnEquip :: Euse --Item -> Creature -> World -> World @@ -38,6 +39,7 @@ data Equipment = Equipment , _eqParams :: EquipParams , _eqViewDist :: Maybe Float } + deriving (Eq,Ord,Show,Read) data AimParams = AimParams { _aimWeight :: Int , _aimRange :: Float @@ -46,23 +48,26 @@ data AimParams = AimParams , _aimHandlePos :: Float , _aimMuzPos :: Float } + deriving (Eq,Ord,Show,Read) data AimStance = TwoHandTwist | TwoHandFlat | OneHand | LeaveHolstered deriving - (Eq,Show,Ord,Enum) + (Eq,Show,Ord,Enum,Read) data EquipParams = NoEquipParams | EquipID {_eparamID :: Int} | EquipCounter {_eparamInt :: Int} + deriving (Eq,Ord,Show,Read) data ItZoom = ItZoom { _itZoomMax :: Float , _itZoomMin :: Float , _itZoomFac :: Float } + deriving (Eq,Ord,Show,Read) makeLenses ''ItemUse makeLenses ''AimParams makeLenses ''EquipParams diff --git a/src/Dodge/Data/Item/UseDelay.hs b/src/Dodge/Data/Item/UseDelay.hs index f1737790a..c67b3cb46 100644 --- a/src/Dodge/Data/Item/UseDelay.hs +++ b/src/Dodge/Data/Item/UseDelay.hs @@ -18,4 +18,5 @@ data UseDelay -- should just be Delay {_warmTime :: Int ,_warmMax :: Int } + deriving (Eq,Ord,Show,Read) makeLenses ''UseDelay diff --git a/src/Dodge/Data/ItemAmount.hs b/src/Dodge/Data/ItemAmount.hs index 42a57a5cd..477563691 100644 --- a/src/Dodge/Data/ItemAmount.hs +++ b/src/Dodge/Data/ItemAmount.hs @@ -2,6 +2,6 @@ module Dodge.Data.ItemAmount where newtype IcAmount = IcAmount {_toInt :: Int} - deriving (Eq,Ord,Num,Integral,Real,Enum) + deriving (Eq,Ord,Num,Integral,Real,Enum,Read) instance Show IcAmount where show (IcAmount i) = 'x':show i diff --git a/src/Dodge/Data/LoadAction.hs b/src/Dodge/Data/LoadAction.hs index 347ebc05a..bf14ff21c 100644 --- a/src/Dodge/Data/LoadAction.hs +++ b/src/Dodge/Data/LoadAction.hs @@ -9,12 +9,12 @@ data LoadAction | LoadInsert {_actionTime :: Int, _actionSound :: SoundID} | LoadAdd {_actionTime :: Int, _actionSound :: SoundID, _insertMax :: Int } | LoadPrime {_actionTime :: Int, _actionSound :: SoundID} - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) data InvSel = InvSel {_iselPos :: Int, _iselAction :: InvSelAction } data InvSelAction = NoInvSelAction | ReloadAction { _actionProgress :: Int, _reloadAction :: LoadAction, _actionHammer :: HammerType} - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) makeLenses ''LoadAction makeLenses ''InvSel makeLenses ''InvSelAction diff --git a/src/Dodge/Data/Material.hs b/src/Dodge/Data/Material.hs index 111fa89c8..2bb6d1c60 100644 --- a/src/Dodge/Data/Material.hs +++ b/src/Dodge/Data/Material.hs @@ -4,4 +4,4 @@ --{-# LANGUAGE DeriveGeneric #-} module Dodge.Data.Material where data Material = Wood | Dirt | Stone | Glass | Metal | Crystal | Flesh | Electronics - deriving (Eq,Ord,Show,Bounded,Enum) + deriving (Eq,Ord,Show,Bounded,Enum,Read) diff --git a/src/Dodge/Data/Payload.hs b/src/Dodge/Data/Payload.hs index b58905f3f..a280c9f56 100644 --- a/src/Dodge/Data/Payload.hs +++ b/src/Dodge/Data/Payload.hs @@ -2,3 +2,4 @@ {-# LANGUAGE StrictData #-} module Dodge.Data.Payload where data Payload = ExplosionPayload | DudPayload + deriving (Show,Read,Eq,Ord,Enum,Bounded) diff --git a/src/Dodge/Data/Targeting.hs b/src/Dodge/Data/Targeting.hs index af52b3e1c..54684ec02 100644 --- a/src/Dodge/Data/Targeting.hs +++ b/src/Dodge/Data/Targeting.hs @@ -12,13 +12,16 @@ data Targeting , _tgID :: Maybe Int , _tgActive :: Bool } + deriving (Eq,Ord,Show,Read) data TargetUpdate = NoTargetUpdate | TargetLaserUpdate | TargetRBPressUpdate | TargetRBCreatureUpdate | TargetCursorUpdate + deriving (Eq,Ord,Show,Read) data TargetDraw = NoTargetDraw | TargetDistanceDraw | SimpleDrawTarget | TargetRBCreatureDraw + deriving (Eq,Ord,Show,Read) makeLenses ''Targeting diff --git a/src/Dodge/Data/Wall.hs b/src/Dodge/Data/Wall.hs index ad4d1889c..c2ab7a913 100644 --- a/src/Dodge/Data/Wall.hs +++ b/src/Dodge/Data/Wall.hs @@ -6,7 +6,6 @@ module Dodge.Data.Wall where import Dodge.Data.Material import Geometry import Color -import ShapePicture import Control.Lens data Wall = Wall { _wlLine :: (Point2,Point2) @@ -25,14 +24,17 @@ data Wall = Wall , _wlRotateTo :: Bool , _wlStructure :: WallStructure , _wlHeight :: Float --- , _wlDamageEff :: Damage -> Wall -> World -> World , _wlMaterial :: Material } + deriving (Eq,Ord,Show,Read) data Opacity = SeeThrough | SeeAbove - | DrawnWall {_opDraw :: Wall -> SPic} + | DrawnWall {_opDraw :: WallDraw } -- Wall -> SPic | Opaque + deriving (Eq,Ord,Show,Read) +data WallDraw = DrawForceField + deriving (Eq,Ord,Show,Read,Enum,Bounded) data WallStructure = StandaloneWall | DoorPart { _wsDoor :: Int } @@ -42,6 +44,7 @@ data WallStructure { _wlStCreature :: Int -- , _wlStDamCreature :: Damage -> Wall -> Int -> World -> World } + deriving (Eq,Ord,Show,Read) makeLenses ''Wall makeLenses ''WallStructure makeLenses ''Opacity diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index c92aa5617..d3ba7ea16 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -14,32 +14,20 @@ the simulation step; in particular see 'updatePressedButtons'. module Dodge.Event ( handleEvent ) where +import Dodge.Tweak import Dodge.HeldScroll import Dodge.InputFocus import Dodge.Combine import Dodge.Event.Keyboard ---import Dodge.Event.Menu import Dodge.Base ---import Dodge.Item ---import Dodge.Combine.Module import Dodge.Data ---import Dodge.Base.Window import Dodge.PreloadData ---import Dodge.Creature.Action import Dodge.Inventory import Dodge.SoundLogic ---import Geometry ---import Preload.Update ---import Dodge.FloorItem import qualified IntMapHelp as IM ---import Data.Monoid import Control.Lens import Data.Maybe ---import Data.Maybe ---import Data.Char ---import Data.List ---import Data.Function (on) import qualified Data.Map.Strict as M import qualified Data.Set as S import qualified Data.Text as T @@ -194,10 +182,10 @@ moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of changeTweakParam :: Int -> World -> World changeTweakParam i w = w & creatures . ix (_yourID w) . crInv . ix (crSel (you w)) %~ - ( (itTweaks . tweakParams . ix paramid . curTweak .~ x) - . _doTweak params x) + ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x) + . doTweak (_tweakType params) x) where tweaks = _itTweaks . fromJust $ yourItem w params = _tweakParams tweaks IM.! paramid - x = (_curTweak params + i) `mod` _maxTweak params + x = (_tweakVal params + i) `mod` _tweakMax params paramid = _tweakSel tweaks diff --git a/src/Dodge/Item/Attachment/Data.hs b/src/Dodge/Item/Attachment/Data.hs index 162797aea..603e083c5 100644 --- a/src/Dodge/Item/Attachment/Data.hs +++ b/src/Dodge/Item/Attachment/Data.hs @@ -17,6 +17,7 @@ data ItAttachment | AttachFloat { _atFloat :: Float } | AttachBool { _atBool :: Bool } | NoItAttachment + deriving (Eq,Ord,Show,Read) data Scope = NoScope | RemoteScope @@ -31,6 +32,7 @@ data Scope = NoScope ,_scopeDefaultZoom :: Float ,_scopeIsCamera :: Bool -- ^ if the camera offset is also the center of vision } + deriving (Eq,Ord,Show,Read) makeLenses ''ItAttachment makeLenses ''Scope diff --git a/src/Dodge/Item/Data.hs b/src/Dodge/Item/Data.hs index 7568aeb4a..667d97c48 100644 --- a/src/Dodge/Item/Data.hs +++ b/src/Dodge/Item/Data.hs @@ -6,3 +6,4 @@ data CurseStatus = Uncursed | UndroppableIdentified | UndroppableUnidentified + deriving (Eq,Ord,Show,Read) diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index a616f10cf..8997e5b4e 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -248,33 +248,21 @@ lasGun = defaultAutoBatteryGun lasGunTweak :: TweakParam lasGunTweak = TweakParam - { _doTweak = thetweak - , _curTweak = 1 - , _maxTweak = 3 - , _showTweak = showPhaseV - , _nameTweak = "PHASE VELOCITY" + { _tweakType = TweakPhaseV + , _tweakVal = 1 + , _tweakMax = 3 } - where - thetweak 0 = itParams . phaseV .~ 0.2 - thetweak 1 = itParams . phaseV .~ 1 - thetweak 2 = itParams . phaseV .~ 5 - thetweak _ = id - showPhaseV 0 = "V" - showPhaseV 1 = "/" - showPhaseV 2 = "Z" - showPhaseV i = "THIS SHOULD NOT BE POSSIBLE" ++ show i - tractorGun :: Item tractorGun = lasGun - { _itConsumption = defaultLoadable - & laMax .~ 10000 - & laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60] - , _itParams = Attracting {_attractionPower = 1} - , _itTweaks = Tweakable + & itConsumption .~ + ( defaultLoadable + & laMax .~ 10000 + & laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60] ) + & itParams .~ Attracting {_attractionPower = 1} + & itTweaks .~ Tweakable { _tweakParams = IM.fromList [(0,tractorGunTweak)] , _tweakSel = 0 } - } & itUse . rUse .~ HeldTractor --aTractorBeam & itUse . useDelay .~ NoDelay & itUse . useMods .~ AmmoCheckMod @@ -287,23 +275,10 @@ tractorGun = lasGun tractorGunTweak :: TweakParam tractorGunTweak = TweakParam - { _doTweak = thetweak - , _curTweak = 1 - , _maxTweak = 4 - , _showTweak = showPower - , _nameTweak = "TRACTION POWER" + { _tweakType = TweakTractionPower + , _tweakVal = 1 + , _tweakMax = 4 } - where - thetweak 0 = itParams . attractionPower .~ 1 - thetweak 1 = itParams . attractionPower .~ -1 - thetweak 2 = itParams . attractionPower .~ -10 - thetweak 3 = itParams . attractionPower .~ 0 - thetweak _ = id - showPower 0 = "+" - showPower 1 = "-" - showPower 2 = "#" - showPower 3 = "0" -- object should stay in the center of the beam - showPower i = "THIS SHOULD NOT BE POSSIBLE" ++ show i -- | assumes that the item is held shootTeslaArc :: Item -> Creature -> World -> World diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index bc812d343..38924c727 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -68,30 +68,23 @@ basicAmPjMoves = IM.fromList . zip [0..] $ ] spinDrag :: TweakParam spinDrag = TweakParam - { _doTweak = \i -> itParams . shellSpinDrag .~ i - , _curTweak = 1 - , _showTweak = show - , _maxTweak = 5 - , _nameTweak = "SPIN SLOWDOWN" + { _tweakType = TweakSpinDrag + , _tweakVal = 1 + , _tweakMax = 5 } spinStart :: TweakParam spinStart = TweakParam - { _doTweak = \i -> itParams . shellSpinAmount .~ i - , _curTweak = 2 - , _showTweak = show - , _maxTweak = 5 - , _nameTweak = "SPIN AMOUNT" + { _tweakType = TweakSpinAmount + , _tweakVal = 2 + , _tweakMax = 5 } thrustParam :: TweakParam thrustParam = TweakParam - { _doTweak = \i -> itParams . shellThrustDelay .~ i - , _curTweak = 1 - , _showTweak = show - , _maxTweak = 5 - , _nameTweak = "THRUST DELAY" + { _tweakType = TweakThrustDelay + , _tweakVal = 1 + , _tweakMax = 5 } - remoteLauncher :: Item remoteLauncher = launcher & itType . iyBase .~ HELD REMOTELAUNCHER diff --git a/src/Dodge/LevelGen/Switch.hs b/src/Dodge/LevelGen/Switch.hs index e407aaca8..b5b6049b9 100644 --- a/src/Dodge/LevelGen/Switch.hs +++ b/src/Dodge/LevelGen/Switch.hs @@ -54,4 +54,4 @@ makeSwitch -> WorldEffect -- ^ Switch on effect -> WorldEffect -- ^ Switch off effect -> Button -makeSwitch col1 col2 f1 = makeSwitchSPic (DefaultDrawSwitch col1 col2) f1 +makeSwitch col1 col2 = makeSwitchSPic (DefaultDrawSwitch col1 col2) diff --git a/src/Dodge/LightSource.hs b/src/Dodge/LightSource.hs index b6c229ab9..68e9184e4 100644 --- a/src/Dodge/LightSource.hs +++ b/src/Dodge/LightSource.hs @@ -34,7 +34,7 @@ tlsTimeRadFunPos t rmax intensityF p = TLS , _tlsUpdate = IntensityTLS intensityF , _tlsTime = t } - where +-- where -- upF tls -- | _tlsTime tls <= 0 = Nothing -- | otherwise = Just $ tls diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index c77b0d9e3..3916a9f64 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -3,6 +3,7 @@ module Dodge.Render.HUD ( hudDrawings ) where import Dodge.Data +import Dodge.Tweak.Show import Dodge.Item.Display import Dodge.Combine import Dodge.Clock @@ -79,11 +80,9 @@ subInventoryDisplay subinv cfig w = case subinv of , fromMaybe mempty $ do tweaki <- it ^? _Just . itTweaks . tweakSel -- consider moving this functionality out into a tweaks module - showtweak <- it ^? _Just . itTweaks . tweakParams . ix tweaki . showTweak - tweakname <- it ^? _Just . itTweaks . tweakParams . ix tweaki . nameTweak - tweakstring <- showtweak <$> (it ^? _Just . itTweaks . tweakParams . ix tweaki . curTweak) + tparam <- it ^? _Just . itTweaks . tweakParams . ix tweaki return $ lnkMidInvSel cfig w curpos tweaki - <> listCursorNSW subInvX 60 cfig tweaki white (length $ tweakstring ++ tweakname) 1 + <> listCursorNSW subInvX 60 cfig tweaki white (length $ showTweak tparam) 1 , invHead cfig "TWEAK" , listPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it) ] @@ -269,7 +268,7 @@ ammoTweakStrings it = case it ^? _Just . itTweaks . tweakParams of _ -> ["NOT TWEAKABLE"] tweakString :: TweakParam -> String -tweakString tp = rightPad 12 ' ' (_nameTweak tp) ++ " " ++ _showTweak tp (_curTweak tp) +tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp invHead :: Configuration -> String -> Picture invHead cfig s = winScale cfig diff --git a/src/Dodge/Render/Walls.hs b/src/Dodge/Render/Walls.hs index 52e118ea0..9d45f550d 100644 --- a/src/Dodge/Render/Walls.hs +++ b/src/Dodge/Render/Walls.hs @@ -2,6 +2,7 @@ module Dodge.Render.Walls ( wallsToDraw ) where import Dodge.Data +import Dodge.Wall.Draw import Dodge.Zone import Dodge.Base.Wall import Geometry @@ -36,7 +37,7 @@ wlSeeThroughDraw wl = wlIsSeeThrough wl && _wlHeight wl == 100 getWallSPic :: Wall -> SPic getWallSPic wl = case wl ^? wlOpacity . opDraw of Nothing -> mempty - Just f -> f wl + Just f -> drawWall f wl -- (wins,wls) = partition theTest . IM.elems . IM.filter _wlUnshadowed $ wallsDoubleScreen cfig w -- theTest wl = case _wlOpacity wl of diff --git a/src/Dodge/Tweak.hs b/src/Dodge/Tweak.hs index 69ac89e5f..12157459f 100644 --- a/src/Dodge/Tweak.hs +++ b/src/Dodge/Tweak.hs @@ -1 +1,25 @@ module Dodge.Tweak where +import Dodge.Data.Item + +import Control.Lens + + +doTweak :: TweakType -> Int -> Item -> Item +doTweak tt = case tt of + TweakPhaseV -> tweakPhaseV + TweakTractionPower -> tweakTractionPower + TweakSpinDrag -> \i -> itParams . shellSpinDrag .~ i + TweakSpinAmount -> \i -> itParams . shellSpinAmount .~ i + TweakThrustDelay -> \i -> itParams . shellThrustDelay .~ i +tweakTractionPower :: Int -> Item -> Item +tweakTractionPower 0 = itParams . attractionPower .~ 1 +tweakTractionPower 1 = itParams . attractionPower .~ -1 +tweakTractionPower 2 = itParams . attractionPower .~ -10 +tweakTractionPower 3 = itParams . attractionPower .~ 0 +tweakTractionPower _ = id + +tweakPhaseV :: Int -> Item -> Item +tweakPhaseV 0 = itParams . phaseV .~ 0.2 +tweakPhaseV 1 = itParams . phaseV .~ 1 +tweakPhaseV 2 = itParams . phaseV .~ 5 +tweakPhaseV _ = id diff --git a/src/Dodge/Tweak/Show.hs b/src/Dodge/Tweak/Show.hs new file mode 100644 index 000000000..f42359b4d --- /dev/null +++ b/src/Dodge/Tweak/Show.hs @@ -0,0 +1,25 @@ +module Dodge.Tweak.Show where +import Dodge.Data.Item +showTweak :: TweakParam -> String +showTweak tp = case tt of + TweakPhaseV -> showPhaseV ct + TweakTractionPower -> showTractionPower ct + TweakSpinDrag -> show ct + TweakSpinAmount -> show ct + TweakThrustDelay -> show ct + where + tt = _tweakType tp + ct = _tweakVal tp + +showPhaseV :: Int -> String +showPhaseV 0 = "V" +showPhaseV 1 = "/" +showPhaseV 2 = "Z" +showPhaseV i = show i ++ " should not be possible" + +showTractionPower :: Int -> String +showTractionPower 0 = "+" +showTractionPower 1 = "-" +showTractionPower 2 = "#" +showTractionPower 3 = "0" -- object should stay in the center of the beam +showTractionPower i = "THIS SHOULD NOT BE POSSIBLE" ++ show i diff --git a/src/Dodge/Wall/Draw.hs b/src/Dodge/Wall/Draw.hs new file mode 100644 index 000000000..eb32a4f4b --- /dev/null +++ b/src/Dodge/Wall/Draw.hs @@ -0,0 +1,18 @@ +module Dodge.Wall.Draw where +import Dodge.Data.Wall +import ShapePicture +import Picture.Base + +drawWall :: WallDraw -> Wall -> SPic +drawWall wd = case wd of + DrawForceField -> drawForceField + +drawForceField :: Wall -> SPic +drawForceField wl = (mempty + , setLayer BloomLayer + . setDepth 20 + . color (_wlColor wl) + $ thickLine 5 [a,b] + ) + where + (a,b) = _wlLine wl diff --git a/src/Dodge/Wall/ForceField.hs b/src/Dodge/Wall/ForceField.hs index 4e43ec8b9..1a2846f0d 100644 --- a/src/Dodge/Wall/ForceField.hs +++ b/src/Dodge/Wall/ForceField.hs @@ -2,13 +2,11 @@ module Dodge.Wall.ForceField where import Dodge.Data import Dodge.Default.Wall import Color -import Picture -import ShapePicture forceField :: Wall forceField = defaultWall {_wlColor = orange - ,_wlOpacity = DrawnWall drawForceField + ,_wlOpacity = DrawnWall DrawForceField ,_wlPathable = True ,_wlWalkable = True ,_wlFireThrough = True @@ -18,12 +16,3 @@ forceField = defaultWall ,_wlStructure = StandaloneWall } -drawForceField :: Wall -> SPic -drawForceField wl = (mempty - , setLayer BloomLayer - . setDepth 20 - . color (_wlColor wl) - $ thickLine 5 [a,b] - ) - where - (a,b) = _wlLine wl diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs index e76981e8f..f3ce7ef25 100644 --- a/src/Picture/Data.hs +++ b/src/Picture/Data.hs @@ -1,9 +1,11 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} module Picture.Data where import Geometry.Data +import GHC.Generics import Control.Lens import Streaming data Verx = Verx @@ -13,8 +15,7 @@ data Verx = Verx , _vxLayer :: !Layer , _vxShadNum :: !ShadNum } - deriving (Eq,Ord,Show) ---newtype LayNum = LayNum { _unLayNum :: Int } + deriving (Eq,Ord,Show,Generic,Read) data Layer = BottomLayer @@ -23,7 +24,7 @@ data Layer | BloomNoZWrite | DebugLayer | FixedCoordLayer - deriving (Eq,Ord,Enum,Bounded,Show) + deriving (Eq,Ord,Enum,Bounded,Show,Generic,Read) layerNum :: Layer -> Int layerNum = fromEnum @@ -31,7 +32,7 @@ numLayers :: Int numLayers = length [minBound::Layer .. maxBound] --TODO use synonyms for layer numbers newtype ShadNum = ShadNum { _unShadNum :: Int } - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Generic,Read) polyNum, polyzNum, bezNum, textNum, arcNum, ellNum :: ShadNum {-# INLINE polyNum #-} {-# INLINE polyzNum #-} diff --git a/src/Sound/Data.hs b/src/Sound/Data.hs index 08f44915e..32c866a0f 100644 --- a/src/Sound/Data.hs +++ b/src/Sound/Data.hs @@ -22,7 +22,7 @@ data PlayStatus | ToStop deriving (Eq,Ord,Show) newtype SoundID = SoundID { _getSoundID :: Int } - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) newtype SoundData = SoundData {_loadedChunks :: IM.IntMap Mix.Chunk }