diff --git a/src/Color.hs b/src/Color.hs index 011db0aac..9c5a4ff95 100644 --- a/src/Color.hs +++ b/src/Color.hs @@ -1,9 +1,15 @@ +{-# LANGUAGE DeriveGeneric #-} module Color where +import GHC.Generics +import Data.Aeson import Geometry data PaletteColor = RED | GREEN | BLUE | YELLOW | CYAN | MAGENTA | ROSE | VIOLET | AZURE | AQUAMARINE | CHARTREUSE | ORANGE | WHITE | BLACK - deriving (Eq,Ord,Enum,Show,Read) + deriving (Eq,Ord,Enum,Show,Read,Generic) +instance ToJSON PaletteColor where + toEncoding = genericToEncoding defaultOptions +instance FromJSON PaletteColor type RGBA = Point4 type Color = Point4 diff --git a/src/Dodge/Block/Draw.hs b/src/Dodge/Block/Draw.hs index 4876ad7b8..c506d8f08 100644 --- a/src/Dodge/Block/Draw.hs +++ b/src/Dodge/Block/Draw.hs @@ -7,9 +7,9 @@ import ShapePicture drawBlock :: BlockDraw -> Block -> SPic drawBlock bd = case bd of BlockDrawMempty -> const mempty - BlockDraws bds -> \bl -> foldMap (flip drawBlock bl) bds - BlockDrawColHeightPoss col h ps -> const $ noPic $ colorSH col (upperPrismPoly h $ ps) - BlockDrawBlSh x -> \bl -> noPic $ doBlSh x bl + BlockDraws bds -> \bl -> foldMap (`drawBlock` bl) bds + BlockDrawColHeightPoss col h ps -> const $ noPic $ colorSH col (upperPrismPoly h ps) + BlockDrawBlSh x -> noPic . doBlSh x doBlSh :: BlSh -> Block -> Shape doBlSh bs = case bs of diff --git a/src/Dodge/Combine/Data.hs b/src/Dodge/Combine/Data.hs index 1a7ec8901..ecb7c3370 100644 --- a/src/Dodge/Combine/Data.hs +++ b/src/Dodge/Combine/Data.hs @@ -1,22 +1,28 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} module Dodge.Combine.Data where +import GHC.Generics +import Data.Aeson import Dodge.Equipment.Data import Dodge.Data.ItemAmount import Control.Lens import qualified Data.Map.Strict as M - -- this should probably store loaded ammo data ItemType = ItemType {_iyBase :: ItemBaseType ,_iyModules :: M.Map ModuleSlot ItemModuleType ,_iyStack :: Stack } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItemType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItemType data Stack = NoStack | Stack IcAmount - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Stack where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Stack data CraftType = PIPE | TUBE @@ -67,8 +73,10 @@ data CraftType | TIMEMODULE | SIZEMODULE | GRAVITYMODULE - deriving (Eq,Ord,Show,Enum,Read) - + deriving (Eq,Ord,Show,Enum,Read,Generic) +instance ToJSON CraftType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CraftType -- TODO make this an enum somehow...? data ItemBaseType = NOTDEFINED @@ -88,8 +96,10 @@ data ItemBaseType | MEDKIT Int | CRAFT CraftType -- - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItemBaseType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItemBaseType data EquipItemType = MAGSHIELD | FLAMESHIELD @@ -105,7 +115,10 @@ data EquipItemType | JUMPLEGS | JETPACK | AUTODETECTOR Detector - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON EquipItemType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON EquipItemType data LeftItemType = BOOSTER | REWINDER @@ -113,8 +126,10 @@ data LeftItemType | BLINKERUNSAFE | SHRINKER | SPAWNER - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON LeftItemType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON LeftItemType data HeldItemType = BANGSTICK {_xNum :: Int} | PISTOL @@ -175,8 +190,10 @@ data HeldItemType | HELDDETECTOR Detector | TORCH | FLATSHIELD - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON HeldItemType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON HeldItemType data ItemModuleType = EMPTYMODULE | DRUMMAG @@ -200,13 +217,18 @@ data ItemModuleType | LAUNCHHOME | EXTRABATTERY | ATTACHTORCH - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItemModuleType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItemModuleType data Detector = ITEMDETECTOR | CREATUREDETECTOR | WALLDETECTOR - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Detector where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Detector data ModuleSlot = ModBullet | ModBulletSpawn @@ -219,8 +241,12 @@ data ModuleSlot | ModTeleport | ModDualBeam | ModHeldAttach - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ModuleSlot where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ModuleSlot +instance ToJSONKey ModuleSlot +instance FromJSONKey ModuleSlot makeLenses ''ItemType makeLenses ''ItemBaseType makeLenses ''HeldItemType diff --git a/src/Dodge/Creature/Memory/Data.hs b/src/Dodge/Creature/Memory/Data.hs index 79212a334..b42833b9d 100644 --- a/src/Dodge/Creature/Memory/Data.hs +++ b/src/Dodge/Creature/Memory/Data.hs @@ -1,15 +1,18 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Creature.Memory.Data where +import GHC.Generics +import Data.Aeson import Geometry.Data - import Control.Lens - data Memory = Memory { _soundsToInvestigate :: [Point2] , _nodesSearched :: [Int] } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Memory where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Memory makeLenses ''Memory diff --git a/src/Dodge/Creature/Perception/Data.hs b/src/Dodge/Creature/Perception/Data.hs index 98b41b632..cbbf484d9 100644 --- a/src/Dodge/Creature/Perception/Data.hs +++ b/src/Dodge/Creature/Perception/Data.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Creature.Perception.Data @@ -20,10 +21,11 @@ module Dodge.Creature.Perception.Data , auDist ) where +import GHC.Generics +import Data.Aeson import Control.Lens import Dodge.Data.FloatFunction import qualified IntMapHelp as IM - data Perception = Perception { _cpVigilance :: Vigilance , _cpAttention :: Attention @@ -31,38 +33,50 @@ data Perception = Perception , _cpVision :: Vision , _cpAudition :: Audition } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Perception where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Perception data Vision = Eyes { _viFOV :: FloatFloat , _viDist :: FloatFloat } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Vision where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Vision newtype Audition = Ears { _auDist :: FloatFloat } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Audition where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Audition data Vigilance = Comatose | Asleep | Lethargic | Vigilant | Overstrung - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Vigilance where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Vigilance data Attention = AttentiveTo {_getAttentiveTo :: IM.IntMap Awareness } | Fixated {_getFixated :: Int } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Attention where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Attention data Awareness = Suspicious Float | Cognizant Float - deriving (Eq,Ord,Show,Read) - -makeLenses ''Attention + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Awareness where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Awareness makeLenses ''Perception makeLenses ''Vision makeLenses ''Audition +makeLenses ''Attention diff --git a/src/Dodge/Creature/Stance/Data.hs b/src/Dodge/Creature/Stance/Data.hs index f695a74b1..c1b7d9526 100644 --- a/src/Dodge/Creature/Stance/Data.hs +++ b/src/Dodge/Creature/Stance/Data.hs @@ -1,7 +1,10 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Creature.Stance.Data where +import GHC.Generics +import Data.Aeson import Geometry.Data import Control.Lens @@ -10,8 +13,10 @@ data Stance = Stance ,_posture :: Posture ,_strideLength :: Int } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Stance where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Stance data Carriage = Walking { _strideAmount :: Int @@ -21,19 +26,25 @@ data Carriage | Floating | Flying | Boosting Point2 - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Carriage where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Carriage data FootForward = LeftForward | RightForward | WasLeftForward | WasRightForward - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON FootForward where + toEncoding = genericToEncoding defaultOptions +instance FromJSON FootForward data Posture = Aiming | AtEase - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Posture where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Posture makeLenses ''Stance makeLenses ''Carriage makeLenses ''Posture diff --git a/src/Dodge/Creature/State/Data.hs b/src/Dodge/Creature/State/Data.hs index 291da1301..87dc1a320 100644 --- a/src/Dodge/Creature/State/Data.hs +++ b/src/Dodge/Creature/State/Data.hs @@ -1,7 +1,10 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Creature.State.Data where +import GHC.Generics +import Data.Aeson --import Geometry import Geometry.Data import Color @@ -12,11 +15,17 @@ data CreatureDropType = DropAll | DropAmount Int | DropSpecific [Int] - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CreatureDropType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CreatureDropType data CrSpState = Barrel { _piercedPoints :: [Point2]} | GenCr - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CrSpState where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CrSpState data Faction = GenericFaction Int | ZombieFaction @@ -26,7 +35,10 @@ data Faction | NoFaction | ColorFaction Color | PlayerFaction - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Faction where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Faction data CrGroup = LoneWolf | Swarm @@ -35,5 +47,9 @@ data CrGroup } | CrGroupID { _crGroupID :: Int } | ShieldGroup - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CrGroup where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CrGroup makeLenses ''CrSpState +makeLenses ''CrGroup diff --git a/src/Dodge/Creature/Statistics.hs b/src/Dodge/Creature/Statistics.hs index 6f77c5e26..16e9658bc 100644 --- a/src/Dodge/Creature/Statistics.hs +++ b/src/Dodge/Creature/Statistics.hs @@ -9,6 +9,7 @@ import LensHelp import Data.Maybe import Data.Strict.IntMap.Autogen.Merge.Strict +--import Data.IntMap.Merge.Strict getCrDexterity :: Creature -> Int getCrDexterity cr = _dexterity (_crStatistics cr) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index ebc7b245d..da219cfc9 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -2,12 +2,16 @@ Contains base datatypes that cannot be seperated into different modules because they are interdependent; circular imports are probably not a good idea. + +WARNING: orphan instances concerning Aeson classes and SDL datatypes have been introduced. +The warnings have been disabled. -} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Dodge.Data ( module Dodge.Data , module Dodge.Data.CrGroupParams @@ -87,7 +91,11 @@ module Dodge.Data , module Dodge.Data.Machine , module Dodge.Data.GenParams , module Dodge.Data.Terminal + , module Dodge.Data.FloorItem ) where +import Dodge.Data.FloorItem +import Data.Aeson +import GHC.Generics import Dodge.Data.Terminal import Dodge.Data.GenParams import Dodge.Data.Machine @@ -305,18 +313,41 @@ data CWorld = CWorld , _lSelect :: Point2 , _rSelect :: Point2 } - deriving (Eq,Show,Read) + deriving (Eq,Show,Read,Generic) +instance ToJSON CWorld where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CWorld +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) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TimeFlowStatus where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TimeFlowStatus data WorldHammer = SubInvHam | DoubleMouseHam - deriving (Eq,Ord,Show,Read,Enum,Bounded) + deriving (Eq,Ord,Show,Read,Enum,Bounded,Generic) +instance ToJSON WorldHammer where + toEncoding = genericToEncoding defaultOptions +instance FromJSON WorldHammer +instance ToJSONKey WorldHammer +instance FromJSONKey WorldHammer data SaveSlot = QuicksaveSlot | LevelStartSlot + | SaveSlotNum Int deriving (Eq,Ord,Show,Read) data OptionScreenFlag = NormalOptions | GameOverOptions @@ -361,8 +392,6 @@ data MenuOption { _moKey :: Scancode , _moEff :: Universe -> IO (Maybe Universe) } -data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int} - deriving (Eq,Ord,Show,Read) data IntID a = IntID Int a @@ -373,7 +402,10 @@ data WorldBeams = WorldBeams ,_positronBeams :: [Beam] ,_electronBeams :: [Beam] } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON WorldBeams where + toEncoding = genericToEncoding defaultOptions +instance FromJSON WorldBeams {- Objects without ids. Update themselves, perhaps with side effects. -} @@ -495,12 +527,8 @@ data InPlacement = InPlacement , _ipPlacementID :: Int } makeLenses ''World -makeLenses ''FloorItem --makeLenses ''Particle makeLenses ''Universe -makeLenses ''GunBarrels -makeLenses ''Nozzle -makeLenses ''Equipment makeLenses ''ScreenLayer makeLenses ''WorldBeams makeLenses ''GenWorld diff --git a/src/Dodge/Data/ActionPlan.hs b/src/Dodge/Data/ActionPlan.hs index 7aa5ebd10..de00b4ff8 100644 --- a/src/Dodge/Data/ActionPlan.hs +++ b/src/Dodge/Data/ActionPlan.hs @@ -1,7 +1,10 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE DeriveGeneric #-} module Dodge.Data.ActionPlan where +import GHC.Generics +import Data.Aeson import Dodge.Creature.Stance.Data import Dodge.Data.CreatureEffect --import Dodge.ShortShow @@ -17,11 +20,17 @@ data ActionPlan ,_apStrategy :: Strategy ,_apGoal :: [Goal] } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ActionPlan where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ActionPlan data RandImpulse = RandImpulseList [Impulse] | RandImpulseCircMove Float - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON RandImpulse where + toEncoding = genericToEncoding defaultOptions +instance FromJSON RandImpulse data Impulse = Move Point2 | MoveForward Float @@ -54,34 +63,10 @@ data Impulse {_impulseUseAheadPos :: P2Imp } | ImpulseNothing - deriving (Eq,Ord,Show,Read) ---instance Show Impulse where --- show imp = case imp of --- Move p -> "Move "++shortPoint2 p --- MoveForward f -> "MoveForward "++ show f --- Turn f -> "Turn "++show f --- RandomTurn f -> "RandomTurn "++show f --- TurnToward p f -> "TurnToward "++shortPoint2 p++show f --- MvTurnToward p -> "MvTurnToward "++shortPoint2 p --- MvForward -> "MvForward" --- TurnTo p -> "TurnTo "++shortPoint2 p --- UseItem -> "UseItem" --- SwitchToItem i -> "SwitchToItem "++show i --- DropItem -> "DropItem" --- Bark sid -> "Bark "++show sid --- Melee i -> "Melee "++show i --- ChangePosture post -> "ChangePosture " ++ show post --- MakeSound sid -> "MakeSound " ++ show sid --- ChangeStrategy s -> "ChangeStrategy " ++ show s --- AddGoal g -> "AddGoal " ++ show g --- ArbitraryImpulseFunction {} -> "ArbitraryImpulseFunction" --- ArbitraryImpulse {} -> "ArbitraryImpulse" --- ArbitraryImpulseEffect {} -> "ArbitraryImpulseEffect" --- ImpulseUseTargetCID {} -> "ImpulseUseTargetCID" --- ImpulseUseTarget {} -> "ImpulseUseTarget" --- ImpulseUseAheadPos {} -> "ImpulseUseAheadPos" --- RandomImpulse {} -> "RandomImpulse" --- ImpulseNothing -> "ImpulseNothing" + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Impulse where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Impulse infixr 9 `WaitThen` infixr 9 `DoActionThen` infixr 9 `DoActionWhile` @@ -182,103 +167,10 @@ data Action {_sideImpulses :: [Impulse] ,_mainAction :: Action } - deriving (Eq,Ord,Show,Read) ---instance Show Action where --- show act = case act of --- ActionNothing -> "ActionNothing" --- LabelAction --- {_actLabel = str --- ,_actAction = subAct --- } -> str++":"++show subAct --- AimAt --- {_targetID = tid --- ,_targetSeenAt = p --- } -> "AimAt tid:"++show tid++" seenAt:"++shortPoint2 p --- PathTo --- {_pathToPoint = p --- } -> "PathTo:"++shortPoint2 p --- TurnToPoint --- {_turnToPoint = p --- } -> "TurnToPoint:"++shortPoint2 p ------- | PickupItem ------- {_pickupItemID :: Int ------- } --- ImpulsesList --- {_impulsesListList = iss --- } -> "ImpulsesList:"++show iss --- DoImpulses --- {_doImpulsesList = is --- } -> "DoImpulses:"++show is --- WaitThen --- {_waitThenTimer = i --- ,_waitThenAction = a --- } -> "WaitThen timer:"++show i++" act:"++show a --- DoActionWhile --- {_doActionWhileCondition = _ --- ,_doActionWhileAction = a --- } -> "DoActionWhile (function) act:"++show a --- DoActionWhilePartial --- {_doActionWhilePartial = partact --- ,_doActionWhileCondition = _ --- ,_doActionWhileAction = a --- } -> "DoActionWhilePartial partAct:"++show partact++" resetAct:"++show a --- DoActionIf --- {_doActionIfCondition = _ --- ,_doActionIfAction = a --- } -> "DoActionIf act:"++show a --- DoActionIfElse --- {_doActionIfElseIfAction = ifa --- ,_doActionIfElseCondition = _ --- ,_doActionIfElseElseAction = elsea --- } -> "DoActionIfElse ifa:"++show ifa++" elsea:"++show elsea --- DoActionWhileInterrupt --- {_doActionWhileThenDo = whilea --- ,_doActionWhileThenCondition = _ --- ,_doActionWhileThenThen = thena --- } -> "DoActionWhileInterrupt whilea:" ++show whilea++" interrupta:"++show thena --- DoActions --- {_doActionsList = as --- } -> "DoActions " ++ foldMap show as --- DoActionThen --- {_doActionThenFirst = a1 --- ,_doActionThenSecond = a2 --- } -> "DoActionThen " ++ show a1 ++ " then:" ++ show a2 ------- | DoGuardActions ------- {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)] ------- } --- DoReplicate --- {_doReplicateTimes = i --- ,_doReplicateAction = a --- } -> "DoReplicate times:" ++ show i ++ " act:"++ show a --- DoReplicatePartial --- {_partialAction = pa --- ,_doReplicateTimes = i --- ,_doReplicateAction = ra --- } -> "DoReplicatePartial pa:" ++ show pa ++ " times:" ++ show i ++ " reset:"++ show ra --- LeadTarget --- {_leadTargetBy = p --- } -> "LeadTarget by:"++ show p --- NoAction -> "NoAction" --- StartSentinelPost -> "StartSentinelPost" --- UseTarget --- {_useTarget = _ --- } -> "UseTarget func" --- UseSelf --- {_useSelf = _ --- } -> "UseSelf func" --- UseAheadPos --- {_useAheadPos = _ --- } -> "UseAheadPos func" --- UseMvTargetPos --- {_useMvTargetPos = _ --- } -> "UseMvTargetPos func" --- ArbitraryAction {} -> "ArbitraryAction func" --- DoImpulsesAlongside --- {_sideImpulses = is --- ,_mainAction = a --- } -> "DoImpulsesAlongside sideImpulses:"++show is ++ " mainA:"++show a - --- deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Action where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Action data Strategy = Flank Int | Ambush Int @@ -295,13 +187,18 @@ data Strategy | Reload | Flee | MeleeStrike - deriving (Eq,Ord,Show,Read) --- deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Strategy where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Strategy data Goal = LiveLongAndProsper | Kill Int | SentinelAt Point2 Float - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Goal where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Goal makeLenses ''ActionPlan makeLenses ''Impulse makeLenses ''Action diff --git a/src/Dodge/Data/Ammo.hs b/src/Dodge/Data/Ammo.hs index 722984141..c02d67b8f 100644 --- a/src/Dodge/Data/Ammo.hs +++ b/src/Dodge/Data/Ammo.hs @@ -1,15 +1,24 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Ammo where +import GHC.Generics +import Data.Aeson import Dodge.Data.Payload import Dodge.Data.Bullet import Dodge.Data.Gas import Dodge.Data.Wall import Control.Lens data ProjectileDraw = DrawShell | DrawRemoteShell | DrawDrone | DrawBlankProjectile - deriving (Show,Read,Eq,Ord,Enum,Bounded) + deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic) +instance ToJSON ProjectileDraw where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ProjectileDraw data ProjectileCreate = CreateShell | CreateTrackingShell - deriving (Show,Read,Eq,Ord,Enum,Bounded) + deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic) +instance ToJSON ProjectileCreate where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ProjectileCreate data ProjectileUpdate = PJThrust {_pjuStart :: Int, _pjuEnd :: Int} | PJSpin {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int} @@ -18,8 +27,10 @@ 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) - + deriving (Show,Read,Eq,Ord,Generic) +instance ToJSON ProjectileUpdate where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ProjectileUpdate data AmmoType = ProjectileAmmo { _amPayload :: Payload @@ -41,6 +52,9 @@ data AmmoType { _amForceFieldType :: Wall } | GenericAmmo - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON AmmoType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON AmmoType makeLenses ''ProjectileUpdate makeLenses ''AmmoType diff --git a/src/Dodge/Data/ArcStep.hs b/src/Dodge/Data/ArcStep.hs index d601bd09d..3aaba1fbd 100644 --- a/src/Dodge/Data/ArcStep.hs +++ b/src/Dodge/Data/ArcStep.hs @@ -1,16 +1,25 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.ArcStep where import Dodge.Data.CrWlID import Geometry.Data import Control.Lens +import GHC.Generics +import Data.Aeson data ArcStep = ArcStep { _asPos :: Point2 , _asDir :: Float , _asObject :: CrWlID --Maybe (Either Creature Wall) } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ArcStep where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ArcStep data NextArcStep = EndArc | DefaultArcStep - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON NextArcStep where + toEncoding = genericToEncoding defaultOptions +instance FromJSON NextArcStep makeLenses ''ArcStep diff --git a/src/Dodge/Data/Beam.hs b/src/Dodge/Data/Beam.hs index 643570ab2..d40c891bf 100644 --- a/src/Dodge/Data/Beam.hs +++ b/src/Dodge/Data/Beam.hs @@ -1,10 +1,12 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Beam where +import GHC.Generics +import Data.Aeson import Geometry.Data import Color import Control.Lens - {- | Linear beams. Last only one frame. - Can interact with one another in a limited manner - can probably be moved to a separate file @@ -22,22 +24,33 @@ data Beam = Beam , _bmOrigin :: Maybe Int , _bmType :: BeamType } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Beam where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Beam data BeamDraw = BasicBeamDraw | BeamDrawColor Color - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON BeamDraw where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BeamDraw data BeamCombineType = FlameBeamCombine | LasBeamCombine | TeslaBeamCombine | SplitBeamCombine | NoBeamCombine - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON BeamCombineType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BeamCombineType data BeamType = BeamCombine { _beamCombine :: BeamCombineType -- (Point2 , (Point2,Point2,Beam) , (Point2,Point2,Beam)) -> World -> World } | BeamSimple - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON BeamType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BeamType makeLenses ''BeamType makeLenses ''Beam diff --git a/src/Dodge/Data/Block.hs b/src/Dodge/Data/Block.hs index b7a5aac03..58659dbe1 100644 --- a/src/Dodge/Data/Block.hs +++ b/src/Dodge/Data/Block.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Block where +import GHC.Generics +import Data.Aeson import Shape.Data import Color import Dodge.Data.Material @@ -21,13 +24,22 @@ data Block = Block , _blDraw :: BlockDraw --Block -> SPic , _blObstructs :: [(Int,Int,PathEdge)] } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Block where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Block data BlockDraw = BlockDrawMempty | BlockDrawBlSh BlSh | BlockDraws [BlockDraw] | BlockDrawColHeightPoss Color Float [Point2] - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON BlockDraw where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BlockDraw data BlSh = BlShMempty | BlShConst Shape - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON BlSh where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BlSh makeLenses ''Block diff --git a/src/Dodge/Data/Bounds.hs b/src/Dodge/Data/Bounds.hs index eab2bf216..18bc6b3c0 100644 --- a/src/Dodge/Data/Bounds.hs +++ b/src/Dodge/Data/Bounds.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Bounds where import Control.Lens +import GHC.Generics +import Data.Aeson data Bounds = Bounds { _bdMinX :: Float @@ -10,7 +13,10 @@ data Bounds = Bounds , _bdMinY :: Float , _bdMaxY :: Float } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Bounds where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Bounds defaultBounds :: Bounds defaultBounds = Bounds 0 0 0 0 diff --git a/src/Dodge/Data/Bullet.hs b/src/Dodge/Data/Bullet.hs index 6a3b6b710..ef3c2ebcc 100644 --- a/src/Dodge/Data/Bullet.hs +++ b/src/Dodge/Data/Bullet.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Bullet where +import GHC.Generics +import Data.Aeson import Dodge.Data.Damage import Geometry.Data import Control.Lens @@ -18,25 +21,46 @@ data Bullet = Bullet , _buTimer :: Int , _buDamages :: [Damage] } - deriving (Show,Read,Eq,Ord) + deriving (Show,Read,Eq,Ord,Generic) +instance ToJSON Bullet where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Bullet data EnergyBallType = IncBall | TeslaBall | ConcBall - deriving (Show,Read,Eq,Ord,Enum,Bounded) + deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic) +instance ToJSON EnergyBallType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON EnergyBallType data BulletState = NormalBulletState | DelayedBullet Float - deriving (Show,Read,Eq,Ord) + deriving (Show,Read,Eq,Ord,Generic) +instance ToJSON BulletState where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BulletState data BulletUpdateMod = NoBulletUpdateMod - deriving (Show,Read,Eq,Ord,Enum,Bounded) + deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic) +instance ToJSON BulletUpdateMod where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BulletUpdateMod data BulletEffect = DestroyBullet | BounceBullet | PenetrateBullet - deriving (Eq,Ord,Show,Read,Enum,Bounded) + deriving (Eq,Ord,Show,Read,Enum,Bounded,Generic) +instance ToJSON BulletEffect where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BulletEffect data BulletSpawn = BulBall EnergyBallType | BulSpark - deriving (Show,Read,Eq,Ord) + deriving (Show,Read,Eq,Ord,Generic) +instance ToJSON BulletSpawn where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BulletSpawn data BulletTrajectory = BasicBulletTrajectory | BezierTrajectory Point2 Point2 Point2 | FlechetteTrajectory Point2 | MagnetTrajectory Point2 - deriving (Show,Read,Eq,Ord) + deriving (Show,Read,Eq,Ord,Generic) +instance ToJSON BulletTrajectory where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BulletTrajectory makeLenses ''Bullet diff --git a/src/Dodge/Data/Button.hs b/src/Dodge/Data/Button.hs index cd0518f1e..16c67e0c8 100644 --- a/src/Dodge/Data/Button.hs +++ b/src/Dodge/Data/Button.hs @@ -1,16 +1,21 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Button where +import GHC.Generics +import Data.Aeson import Dodge.Data.WorldEffect import Control.Lens import Geometry.Data import Sound.Data import Color - data ButtonDraw = DefaultDrawButton Color | DefaultDrawSwitch Color Color | DrawNoButton - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ButtonDraw where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ButtonDraw data ButtonEvent = ButtonDoNothing | ButtonPress {_bpState :: ButtonState @@ -33,8 +38,10 @@ data ButtonEvent = ButtonDoNothing ,_boffEff :: WdWd } | ButtonAccessTerminal - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ButtonEvent where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ButtonEvent data Button = Button { _btPict :: ButtonDraw --Button -> SPic , _btPos :: Point2 @@ -47,8 +54,14 @@ data Button = Button , _btName :: String , _btColor :: Color } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Button where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Button data ButtonState = BtOn | BtOff | BtNoLabel - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ButtonState where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ButtonState makeLenses ''Button makeLenses ''ButtonEvent diff --git a/src/Dodge/Data/CamouflageStatus.hs b/src/Dodge/Data/CamouflageStatus.hs index bad688fdc..f0243ed8e 100644 --- a/src/Dodge/Data/CamouflageStatus.hs +++ b/src/Dodge/Data/CamouflageStatus.hs @@ -1,5 +1,11 @@ +{-# LANGUAGE DeriveGeneric #-} module Dodge.Data.CamouflageStatus where +import GHC.Generics +import Data.Aeson data CamouflageStatus = FullyVisible | Invisible - deriving (Eq,Ord,Enum,Read,Show,Bounded) + deriving (Eq,Ord,Enum,Read,Show,Bounded,Generic) +instance ToJSON CamouflageStatus where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CamouflageStatus diff --git a/src/Dodge/Data/Cloud.hs b/src/Dodge/Data/Cloud.hs index 2951bb8ad..5acaa1ac6 100644 --- a/src/Dodge/Data/Cloud.hs +++ b/src/Dodge/Data/Cloud.hs @@ -1,14 +1,18 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Cloud where +import GHC.Generics +import Data.Aeson import Geometry import Color import Control.Lens - data CloudDraw = CloudColor Float Float Color -- radius-multiply fade-time color | DrawGasCloud Color - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CloudDraw where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CloudDraw data Cloud = Cloud { _clPos :: Point3 , _clVel :: Point3 @@ -18,9 +22,15 @@ data Cloud = Cloud , _clTimer :: Int , _clType :: CloudType } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Cloud where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Cloud data CloudType = SmokeCloud | GasCloud - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CloudType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CloudType makeLenses ''Cloud diff --git a/src/Dodge/Data/Corpse.hs b/src/Dodge/Data/Corpse.hs index 36363b043..fbfade840 100644 --- a/src/Dodge/Data/Corpse.hs +++ b/src/Dodge/Data/Corpse.hs @@ -1,12 +1,18 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Corpse where +import GHC.Generics +import Data.Aeson import ShapePicture.Data import Geometry.Data import Control.Lens data CorpseResurrection = NoResurrection - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CorpseResurrection where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CorpseResurrection data Corpse = Corpse { _cpID :: Int , _cpPos :: Point2 @@ -14,5 +20,8 @@ data Corpse = Corpse , _cpSPic :: SPic , _cpRes :: CorpseResurrection } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Corpse where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Corpse makeLenses ''Corpse diff --git a/src/Dodge/Data/CrGroupParams.hs b/src/Dodge/Data/CrGroupParams.hs index f9cc702b9..23cf7f0ab 100644 --- a/src/Dodge/Data/CrGroupParams.hs +++ b/src/Dodge/Data/CrGroupParams.hs @@ -1,20 +1,26 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.CrGroupParams where +import GHC.Generics +import Data.Aeson import Geometry.Data import qualified Data.IntSet as IS import Control.Lens - data CrGroupParams = CrGroupParams { _crGroupParamID :: Int , _crGroupIDs :: IS.IntSet , _crGroupCenter :: Point2 , _crGroupUpdate :: CrGroupUpdate --World -> CrGroupParams -> Maybe CrGroupParams } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CrGroupParams where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CrGroupParams data CrGroupUpdate = DefaultCrGroupUpdate - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CrGroupUpdate where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CrGroupUpdate makeLenses ''CrGroupParams diff --git a/src/Dodge/Data/CrWlID.hs b/src/Dodge/Data/CrWlID.hs index 8e5647de8..ae730957c 100644 --- a/src/Dodge/Data/CrWlID.hs +++ b/src/Dodge/Data/CrWlID.hs @@ -1,7 +1,13 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} 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) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CrWlID where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CrWlID makeLenses ''CrWlID diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index f01ad3f28..7ae528a49 100644 --- a/src/Dodge/Data/Creature.hs +++ b/src/Dodge/Data/Creature.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Creature @@ -5,6 +6,8 @@ module Dodge.Data.Creature , module Dodge.Data.Creature.Misc , module Dodge.Data.Creature.State ) where +import GHC.Generics +import Data.Aeson import Dodge.Data.Creature.Misc import Dodge.Data.Creature.State import Dodge.Data.Item @@ -62,14 +65,23 @@ data Creature = Creature , _crStatistics :: CreatureStatistics , _crCamouflage :: CamouflageStatus } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Creature where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Creature data CreatureCorpse = MakeDefaultCorpse - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CreatureCorpse where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CreatureCorpse data Intention = Intention { _targetCr :: Maybe Creature , _mvToPoint :: Maybe Point2 , _viewPoint :: Maybe Point2 } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Intention where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Intention makeLenses ''Creature makeLenses ''Intention diff --git a/src/Dodge/Data/Creature/Misc.hs b/src/Dodge/Data/Creature/Misc.hs index a5cf6d61b..5d96ae1e5 100644 --- a/src/Dodge/Data/Creature/Misc.hs +++ b/src/Dodge/Data/Creature/Misc.hs @@ -1,23 +1,27 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Creature.Misc ( module Dodge.Data.Creature.Misc , module Dodge.Data.CamouflageStatus ) where +import GHC.Generics +import Data.Aeson import Dodge.Data.FloatFunction import Dodge.Data.CamouflageStatus import Sound.Data import Geometry.Data import Color import Control.Lens - data CreatureStatistics = CreatureStatistics { _strength :: Int , _dexterity :: Int , _intelligence :: Int } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CreatureStatistics where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CreatureStatistics data Vocalization = Mute | Vocalization @@ -26,8 +30,10 @@ data Vocalization ,_vcMaxCoolDown :: Int ,_vcCoolDown :: Int } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Vocalization where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Vocalization data CrMvType = NoMvType | MvWalking { _mvSpeed :: Float } @@ -37,13 +43,17 @@ data CrMvType , _mvTurnJit :: Float , _mvAimSpeed :: FloatFloat } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CrMvType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CrMvType data HumanoidAI = YourAI | ChaseAI | InanimateAI | SpreadGunAI | PistolAI | LtAutoAI | LauncherAI | SwarmAI | AutoAI | FlockArmourChaseAI | MiniGunAI | LongAI | MultGunAI - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON HumanoidAI where + toEncoding = genericToEncoding defaultOptions +instance FromJSON HumanoidAI data CreatureType = Humanoid { _skinHead :: Color @@ -55,11 +65,15 @@ data CreatureType | Lampoid {_lampHeight :: Float, _lampColor :: Point3, _lampLSID :: Maybe Int} | Turretoid | NonDrawnCreature - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CreatureType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CreatureType data BarrelType = PlainBarrel | ExplosiveBarrel - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON BarrelType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BarrelType makeLenses ''CreatureStatistics makeLenses ''Vocalization makeLenses ''CrMvType diff --git a/src/Dodge/Data/Creature/State.hs b/src/Dodge/Data/Creature/State.hs index 21dd65d8b..e71a249ca 100644 --- a/src/Dodge/Data/Creature/State.hs +++ b/src/Dodge/Data/Creature/State.hs @@ -1,14 +1,19 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Creature.State where +import GHC.Generics +import Data.Aeson import Dodge.Data.Damage import Dodge.Creature.State.Data import Control.Lens - data CreatureState = CrSt { _csDamage :: [Damage] , _csSpState :: CrSpState , _csDropsOnDeath :: CreatureDropType } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CreatureState where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CreatureState makeLenses ''CreatureState diff --git a/src/Dodge/Data/CreatureEffect.hs b/src/Dodge/Data/CreatureEffect.hs index e7c02458a..0c2be9fb4 100644 --- a/src/Dodge/Data/CreatureEffect.hs +++ b/src/Dodge/Data/CreatureEffect.hs @@ -1,51 +1,81 @@ +{-# LANGUAGE StrictData #-} +{-# LANGUAGE DeriveGeneric #-} module Dodge.Data.CreatureEffect where - +import GHC.Generics +import Data.Aeson data WdCrCr = NoCreatureEffect - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON WdCrCr where + toEncoding = genericToEncoding defaultOptions +instance FromJSON WdCrCr data CrWdImp = NoCrWdImp - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CrWdImp where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CrWdImp data CrWdWd = CrWdWdId - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CrWdWd where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CrWdWd data IntImp = NoIntImp - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON IntImp where + toEncoding = genericToEncoding defaultOptions +instance FromJSON IntImp data CrImp = NoCrImp | TurnTowardCr Float -- turn amount - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CrImp where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CrImp data P2Imp = P2ImpNo - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON P2Imp where + toEncoding = genericToEncoding defaultOptions +instance FromJSON P2Imp data WdCrBl = WdCrTrue | WdCrBlfromCrBl CrBl | WdCrNegate WdCrBl | WdCrLOSTarget | WdCrSafeDistFromTarget Float - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON WdCrBl where + toEncoding = genericToEncoding defaultOptions +instance FromJSON WdCrBl data CrBl = CrCanShoot | CrIsReloading | CrIsAiming | CrIsAnimate - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CrBl where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CrBl data MCrAc = MCrNoAction - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON MCrAc where + toEncoding = genericToEncoding defaultOptions +instance FromJSON MCrAc data CrAc = CrTurnAround | CrFleeFromTarget - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CrAc where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CrAc data P2Ac = P2NoAction - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON P2Ac where + toEncoding = genericToEncoding defaultOptions +instance FromJSON P2Ac data MP2Ac = MP2NoAction - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON MP2Ac where + toEncoding = genericToEncoding defaultOptions +instance FromJSON MP2Ac data CrWdAc = CrWdBFSThenReturn Int | ChooseMovementSpreadGun | ChooseMovementLtAuto - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CrWdAc where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CrWdAc diff --git a/src/Dodge/Data/Damage.hs b/src/Dodge/Data/Damage.hs index 93f3d5e28..93d8fe312 100644 --- a/src/Dodge/Data/Damage.hs +++ b/src/Dodge/Data/Damage.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} {- @@ -8,6 +9,8 @@ module Dodge.Data.Damage ( module Dodge.Data.Damage , module Dodge.Data.Damage.Type ) where +import GHC.Generics +import Data.Aeson import Dodge.Data.Damage.Type import Geometry.Data import Control.Lens @@ -20,14 +23,19 @@ data DamageEffect | TorqueDamage { _deTorque :: Float } | PushBackDamage {_dePushBack :: Float } | NoDamageEffect - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON DamageEffect where + toEncoding = genericToEncoding defaultOptions +instance FromJSON DamageEffect data Damage = Damage { _dmType :: DamageType , _dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 , _dmEffect :: DamageEffect } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Damage where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Damage isElectrical :: Damage -> Bool isElectrical dm = case _dmType dm of ELECTRICAL -> True diff --git a/src/Dodge/Data/Damage/Type.hs b/src/Dodge/Data/Damage/Type.hs index 92938f42b..60babb148 100644 --- a/src/Dodge/Data/Damage/Type.hs +++ b/src/Dodge/Data/Damage/Type.hs @@ -1,5 +1,8 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Damage.Type where +import GHC.Generics +import Data.Aeson data DamageType = PIERCING | BLUNT @@ -16,4 +19,9 @@ data DamageType | PUSHDAM | POISONDAM | ENTERREMENT - deriving (Eq,Ord,Show,Read,Enum,Bounded) + deriving (Eq,Ord,Show,Read,Enum,Bounded,Generic) +instance ToJSON DamageType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON DamageType +instance ToJSONKey DamageType +instance FromJSONKey DamageType diff --git a/src/Dodge/Data/Door.hs b/src/Dodge/Data/Door.hs index 0a32566d4..f5b13c831 100644 --- a/src/Dodge/Data/Door.hs +++ b/src/Dodge/Data/Door.hs @@ -1,20 +1,27 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Door where +import GHC.Generics +import Data.Aeson import Dodge.Data.PathGraph import Dodge.Data.MountedObject import Geometry.Data import Dodge.Data.WorldEffect import qualified Data.IntSet as IS import Control.Lens - data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int - deriving (Eq, Ord, Show,Read) - + deriving (Eq, Ord, Show,Read,Generic) +instance ToJSON DoorStatus where + toEncoding = genericToEncoding defaultOptions +instance FromJSON DoorStatus data PushSource = PushesItself | PushedBy Int | NotPushed - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON PushSource where + toEncoding = genericToEncoding defaultOptions +instance FromJSON PushSource data Door = Door { _drID :: Int , _drWallIDs :: IS.IntSet @@ -33,5 +40,8 @@ data Door = Door , _drObstructs :: [(Int,Int,PathEdge)] , _drObstacleType :: EdgeObstacle } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Door where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Door makeLenses ''Door diff --git a/src/Dodge/Data/EnergyBall.hs b/src/Dodge/Data/EnergyBall.hs index 8e0ee1b8d..a92291a37 100644 --- a/src/Dodge/Data/EnergyBall.hs +++ b/src/Dodge/Data/EnergyBall.hs @@ -1,11 +1,13 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.EnergyBall where +import GHC.Generics +import Data.Aeson import Geometry.Data import Color import Dodge.Data.Damage.Type import Control.Lens - data EnergyBall = EnergyBall { _ebVel :: Point2 , _ebColor :: Color @@ -16,5 +18,8 @@ data EnergyBall = EnergyBall , _ebZ :: Float , _ebRot :: Float } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON EnergyBall where + toEncoding = genericToEncoding defaultOptions +instance FromJSON EnergyBall makeLenses ''EnergyBall diff --git a/src/Dodge/Data/Flame.hs b/src/Dodge/Data/Flame.hs index a2384164d..4a0098734 100644 --- a/src/Dodge/Data/Flame.hs +++ b/src/Dodge/Data/Flame.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Flame where +import GHC.Generics +import Data.Aeson import Control.Lens import Geometry.Data import Color @@ -13,5 +16,8 @@ data Flame = Flame , _flZ :: Float , _flOriginalVel :: Point2 } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Flame where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Flame makeLenses ''Flame diff --git a/src/Dodge/Data/Flare.hs b/src/Dodge/Data/Flare.hs index 5480516ac..d30567e44 100644 --- a/src/Dodge/Data/Flare.hs +++ b/src/Dodge/Data/Flare.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Flare where +import GHC.Generics +import Data.Aeson import Color import Geometry import Control.Lens @@ -17,5 +20,8 @@ data Flare , _flareTran3 :: Point3 , _flareTime :: Int } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Flare where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Flare makeLenses ''Flare diff --git a/src/Dodge/Data/FloatFunction.hs b/src/Dodge/Data/FloatFunction.hs index 98dc2a693..8d5e0b98f 100644 --- a/src/Dodge/Data/FloatFunction.hs +++ b/src/Dodge/Data/FloatFunction.hs @@ -1,8 +1,13 @@ +{-# LANGUAGE DeriveGeneric #-} module Dodge.Data.FloatFunction where - +import GHC.Generics +import Data.Aeson data FloatFloat = FloatID | FloatFOV Float | FloatLessCheck Float | FloatAbsCheckGreaterLess Float Float Float | FloatConst Float - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON FloatFloat where + toEncoding = genericToEncoding defaultOptions +instance FromJSON FloatFloat diff --git a/src/Dodge/Data/FloorItem.hs b/src/Dodge/Data/FloorItem.hs new file mode 100644 index 000000000..45f88b403 --- /dev/null +++ b/src/Dodge/Data/FloorItem.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE DeriveGeneric #-} +module Dodge.Data.FloorItem + where +import Dodge.Data.Item +import Geometry.Data +import GHC.Generics +import Data.Aeson +import Control.Lens +data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int} + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON FloorItem where + toEncoding = genericToEncoding defaultOptions +instance FromJSON FloorItem +makeLenses ''FloorItem diff --git a/src/Dodge/Data/ForegroundShape.hs b/src/Dodge/Data/ForegroundShape.hs index 5fe9a936f..de7d2990e 100644 --- a/src/Dodge/Data/ForegroundShape.hs +++ b/src/Dodge/Data/ForegroundShape.hs @@ -1,10 +1,12 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.ForegroundShape where +import GHC.Generics +import Data.Aeson import Geometry import ShapePicture import Control.Lens - data ForegroundShape = ForegroundShape { _fsID :: Int , _fsPos :: Point2 @@ -12,5 +14,8 @@ data ForegroundShape = ForegroundShape , _fsRad :: Float -- This should probably be a bounding box , _fsSPic :: SPic } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ForegroundShape where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ForegroundShape makeLenses ''ForegroundShape diff --git a/src/Dodge/Data/Gas.hs b/src/Dodge/Data/Gas.hs index 4ac9eed5a..fe5eb281b 100644 --- a/src/Dodge/Data/Gas.hs +++ b/src/Dodge/Data/Gas.hs @@ -1,5 +1,10 @@ ---{-# LANGUAGE TemplateHaskell #-} ---{-# LANGUAGE StrictData #-} +{-# 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) + deriving (Eq,Ord,Show,Enum,Bounded,Read,Generic) +instance ToJSON GasCreate where + toEncoding = genericToEncoding defaultOptions +instance FromJSON GasCreate diff --git a/src/Dodge/Data/GenParams.hs b/src/Dodge/Data/GenParams.hs index 2a60ed40a..e42a5bd16 100644 --- a/src/Dodge/Data/GenParams.hs +++ b/src/Dodge/Data/GenParams.hs @@ -1,7 +1,10 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.GenParams where +import GHC.Generics +import Data.Aeson import Color import Dodge.Data.Damage.Type import Control.Lens @@ -9,7 +12,13 @@ import qualified Data.Map.Strict as M newtype GenParams = GenParams { _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape) } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON GenParams where + toEncoding = genericToEncoding defaultOptions +instance FromJSON GenParams data DecorationShape = PLUS | SQUARE | CIRCLE | THREELINES - deriving (Eq,Ord,Enum,Show,Read) + deriving (Eq,Ord,Enum,Show,Read,Generic) +instance ToJSON DecorationShape where + toEncoding = genericToEncoding defaultOptions +instance FromJSON DecorationShape makeLenses ''GenParams diff --git a/src/Dodge/Data/Gust.hs b/src/Dodge/Data/Gust.hs index 40ac13ba2..5aaf1d62f 100644 --- a/src/Dodge/Data/Gust.hs +++ b/src/Dodge/Data/Gust.hs @@ -1,7 +1,10 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Gust where +import GHC.Generics +import Data.Aeson import Geometry.Data import Control.Lens data Gust = Gust @@ -10,5 +13,8 @@ data Gust = Gust , _guVel :: Point2 , _guTime :: Int } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Gust where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Gust makeLenses ''Gust diff --git a/src/Dodge/Data/HUD.hs b/src/Dodge/Data/HUD.hs index 9d579df64..894b1692e 100644 --- a/src/Dodge/Data/HUD.hs +++ b/src/Dodge/Data/HUD.hs @@ -1,14 +1,18 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.HUD where +import GHC.Generics +import Data.Aeson import Geometry.Data import Control.Lens data HUDElement = DisplayInventory {_subInventory :: SubInventory} | DisplayCarte - deriving (Eq,Ord,Show,Read) --- deriving (Eq,Ord,Show) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON HUDElement where + toEncoding = genericToEncoding defaultOptions +instance FromJSON HUDElement data SubInventory = NoSubInventory | TweakInventory @@ -16,16 +20,20 @@ data SubInventory | InspectInventory | LockedInventory | DisplayTerminal {_termID :: Int } - deriving (Eq,Ord,Show,Read) --- deriving (Eq,Ord,Show) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON SubInventory where + toEncoding = genericToEncoding defaultOptions +instance FromJSON SubInventory data HUD = HUD { _hudElement :: HUDElement , _carteCenter :: Point2 , _carteZoom :: Float , _carteRot :: Float } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON HUD where + toEncoding = genericToEncoding defaultOptions +instance FromJSON HUD makeLenses ''HUD makeLenses ''HUDElement makeLenses ''SubInventory diff --git a/src/Dodge/Data/Hammer.hs b/src/Dodge/Data/Hammer.hs index e3b2fc960..dc71e24aa 100644 --- a/src/Dodge/Data/Hammer.hs +++ b/src/Dodge/Data/Hammer.hs @@ -1,16 +1,23 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} module Dodge.Data.Hammer where +import GHC.Generics +import Data.Aeson import Control.Lens data HammerType = NoHammer | HasHammer {_hammerPosition :: HammerPosition} - deriving - (Eq, Ord, Show,Read) + deriving (Eq, Ord, Show,Read,Generic) +instance ToJSON HammerType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON HammerType data HammerPosition = HammerDown | HammerReleased | HammerUp - deriving - (Eq, Ord, Show,Read) + deriving (Eq, Ord, Show,Read,Generic) +instance ToJSON HammerPosition where + toEncoding = genericToEncoding defaultOptions +instance FromJSON HammerPosition makeLenses ''HammerType diff --git a/src/Dodge/Data/ItEffect.hs b/src/Dodge/Data/ItEffect.hs index 6752a78c2..8b3dc7f8f 100644 --- a/src/Dodge/Data/ItEffect.hs +++ b/src/Dodge/Data/ItEffect.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.ItEffect where +import GHC.Generics +import Data.Aeson import Control.Lens -- I believe this is called every frame, not sure when though data ItEffect @@ -27,8 +30,10 @@ data ItEffect , _ieDrop :: ItDropEffect --Item -> Creature -> World -> World , _ieMID :: Maybe Int } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItEffect where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItEffect data ItInvEffect = NoInvEffect | RewindEffect | ResetAttachmentEffect @@ -36,9 +41,18 @@ data ItInvEffect = NoInvEffect | CreateHeldLight | CreateShieldWall | RemoveShieldWall - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItInvEffect where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItInvEffect data ItFloorEffect = NoFloorEffect - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItFloorEffect where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItFloorEffect data ItDropEffect = NoDropEffect - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItDropEffect where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItDropEffect makeLenses ''ItEffect diff --git a/src/Dodge/Data/Item.hs b/src/Dodge/Data/Item.hs index 39e2346c4..8615e9fd0 100644 --- a/src/Dodge/Data/Item.hs +++ b/src/Dodge/Data/Item.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Item @@ -7,6 +8,8 @@ module Dodge.Data.Item , module Dodge.Data.Item.Params , module Dodge.Data.Item.Use ) where +import GHC.Generics +import Data.Aeson import Control.Lens import Dodge.Data.Item.Misc import Dodge.Data.Item.Tweak @@ -40,13 +43,19 @@ data Item = Item , _itValue :: ItemValue , _itParams :: ItemParams } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Item where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Item data ItemTweaks = NoTweaks | Tweakable { _tweakParams :: IM.IntMap TweakParam , _tweakSel :: Int } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItemTweaks where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItemTweaks makeLenses ''Item makeLenses ''ItemTweaks diff --git a/src/Dodge/Data/Item/Consumption.hs b/src/Dodge/Data/Item/Consumption.hs index 317867892..468e5a399 100644 --- a/src/Dodge/Data/Item/Consumption.hs +++ b/src/Dodge/Data/Item/Consumption.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Item.Consumption where +import GHC.Generics +import Data.Aeson import Control.Lens import Dodge.Data.Ammo import Dodge.Data.LoadAction @@ -28,5 +31,8 @@ data ItemConsumption { _icAmount :: IcAmount } | NoConsumption - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItemConsumption where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItemConsumption makeLenses ''ItemConsumption diff --git a/src/Dodge/Data/Item/HeldScroll.hs b/src/Dodge/Data/Item/HeldScroll.hs index 880664027..2a56f3390 100644 --- a/src/Dodge/Data/Item/HeldScroll.hs +++ b/src/Dodge/Data/Item/HeldScroll.hs @@ -1,5 +1,10 @@ ---{-# LANGUAGE StrictData #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StrictData #-} module Dodge.Data.Item.HeldScroll where - +import GHC.Generics +import Data.Aeson data HeldScroll = HeldScrollDoNothing | HeldScrollZoom | HeldScrollCharMode - deriving (Eq,Ord,Enum,Bounded,Show,Read) + deriving (Eq,Ord,Enum,Bounded,Show,Read,Generic) +instance ToJSON HeldScroll where + toEncoding = genericToEncoding defaultOptions +instance FromJSON HeldScroll diff --git a/src/Dodge/Data/Item/HeldUse.hs b/src/Dodge/Data/Item/HeldUse.hs index e19fcea4e..d7211b520 100644 --- a/src/Dodge/Data/Item/HeldUse.hs +++ b/src/Dodge/Data/Item/HeldUse.hs @@ -1,7 +1,10 @@ +{-# LANGUAGE StrictData #-} +{-# LANGUAGE DeriveGeneric #-} module Dodge.Data.Item.HeldUse where +import GHC.Generics +import Data.Aeson import Dodge.Combine.Data import Dodge.Data.CamouflageStatus - data HeldUse = HeldDoNothing | HeldUseAmmoParams | HeldOverNozzlesUseGasParams @@ -17,12 +20,16 @@ data HeldUse = HeldDoNothing | HeldTractor | HeldForceField | HeldShatter - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON HeldUse where + toEncoding = genericToEncoding defaultOptions +instance FromJSON HeldUse data Cuse = CDoNothing | CHeal Int - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Cuse where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Cuse data Euse = EDoNothing | EDetector Detector | EMagShield @@ -33,15 +40,20 @@ data Euse = EDoNothing | EonWristShield | EoffWristShield - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Euse where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Euse data Luse = LDoNothing | LRewind | LShrink | LBlink | LUnsafeBlink | LBoost - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Luse where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Luse data HeldMod = HeldModNothing | PoisonSprayerMod | FlameSpitterMod @@ -74,4 +86,7 @@ data HeldMod = HeldModNothing | SmgMod | RevolverXMod | BangConeMod - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON HeldMod where + toEncoding = genericToEncoding defaultOptions +instance FromJSON HeldMod diff --git a/src/Dodge/Data/Item/Misc.hs b/src/Dodge/Data/Item/Misc.hs index e92edf725..9b1ed9add 100644 --- a/src/Dodge/Data/Item/Misc.hs +++ b/src/Dodge/Data/Item/Misc.hs @@ -1,15 +1,20 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Item.Misc where +import GHC.Generics +import Data.Aeson import Geometry.Data import Control.Lens - data ItemDimension = ItemDimension { _dimRad :: Float , _dimCenter :: Point3 , _dimAttachPos :: Point3 } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItemDimension where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItemDimension data ItemPortage = HeldItem { _handlePos :: Float @@ -17,20 +22,31 @@ data ItemPortage } | WornItem | NoPortage - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItemPortage where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItemPortage data ItemValue = ItemValue { _ivInt :: Int , _ivType :: ItemValueType } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItemValue where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItemValue data ItemValueType = MundaneItem | ArtefactItem - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItemValueType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItemValueType data ItemPos = InInv { _ipCrID :: Int , _ipInvID :: Int } | OnFloor { _ipFlID :: Int } | VoidItm - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItemPos where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItemPos makeLenses ''ItemDimension makeLenses ''ItemPortage makeLenses ''ItemValue diff --git a/src/Dodge/Data/Item/Params.hs b/src/Dodge/Data/Item/Params.hs index 7be0cea08..23742e4eb 100644 --- a/src/Dodge/Data/Item/Params.hs +++ b/src/Dodge/Data/Item/Params.hs @@ -1,12 +1,14 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Item.Params where +import GHC.Generics +import Data.Aeson import Dodge.Data.Beam import Dodge.Data.ArcStep import Geometry.Data import Color import Control.Lens - data ItemParams = NoParams | ShellLauncher @@ -55,9 +57,15 @@ data ItemParams , _previousArcEffect :: PreviousArcEffect } | ParamMID {_paramMID :: Maybe Int} - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItemParams where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItemParams data PreviousArcEffect = NoPreviousArcEffect | PerturbTillBreakPreviousArc - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON PreviousArcEffect where + toEncoding = genericToEncoding defaultOptions +instance FromJSON PreviousArcEffect data GunBarrels = MultiBarrel { _brlSpread :: BarrelSpread @@ -69,7 +77,10 @@ data GunBarrels , _brlInaccuracy :: Float } | SingleBarrel {_brlInaccuracy :: Float} - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON GunBarrels where + toEncoding = genericToEncoding defaultOptions +instance FromJSON GunBarrels data Nozzle = Nozzle { _nzPressure :: Float , _nzDir :: Float @@ -78,12 +89,19 @@ data Nozzle = Nozzle , _nzWalkSpeed :: Float , _nzLength :: Float } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Nozzle where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Nozzle data BarrelSpread = AlignedBarrels | SpreadBarrels {_spreadAngle :: Float} | RotatingBarrels {_rotatingBarrelInaccuracy :: Float} - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON BarrelSpread where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BarrelSpread makeLenses ''BarrelSpread makeLenses ''ItemParams +makeLenses ''Nozzle +makeLenses ''GunBarrels diff --git a/src/Dodge/Data/Item/Tweak.hs b/src/Dodge/Data/Item/Tweak.hs index 710ea1090..3a8cd1d54 100644 --- a/src/Dodge/Data/Item/Tweak.hs +++ b/src/Dodge/Data/Item/Tweak.hs @@ -1,17 +1,26 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Item.Tweak where +import GHC.Generics +import Data.Aeson import Control.Lens data TweakType = TweakPhaseV | TweakTractionPower | TweakSpinDrag | TweakSpinAmount | TweakThrustDelay - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TweakType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TweakType data TweakParam = TweakParam { _tweakType :: TweakType -- Int -> Item -> Item , _tweakVal :: Int , _tweakMax :: Int } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TweakParam where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TweakParam makeLenses ''TweakParam diff --git a/src/Dodge/Data/Item/Use.hs b/src/Dodge/Data/Item/Use.hs index 32ce82274..124442643 100644 --- a/src/Dodge/Data/Item/Use.hs +++ b/src/Dodge/Data/Item/Use.hs @@ -1,13 +1,15 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Item.Use where +import GHC.Generics +import Data.Aeson import Dodge.Data.Item.HeldUse import Dodge.Data.Item.HeldScroll import Dodge.Data.Item.UseDelay import Dodge.Data.Hammer import Dodge.Equipment.Data import Control.Lens - data ItemUse = RightUse { _rUse :: HeldUse -- Item -> Creature -> World -> World @@ -30,7 +32,10 @@ data ItemUse { _eqEq :: Equipment } | NoUse - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItemUse where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItemUse data Equipment = Equipment { _eqUse :: Euse --Item -> Creature -> World -> World , _eqOnEquip :: Euse --Item -> Creature -> World -> World @@ -39,7 +44,10 @@ data Equipment = Equipment , _eqParams :: EquipParams , _eqViewDist :: Maybe Float } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Equipment where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Equipment data AimParams = AimParams { _aimWeight :: Int , _aimRange :: Float @@ -48,27 +56,38 @@ data AimParams = AimParams , _aimHandlePos :: Float , _aimMuzPos :: Float } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON AimParams where + toEncoding = genericToEncoding defaultOptions +instance FromJSON AimParams data AimStance = TwoHandTwist | TwoHandFlat | OneHand | LeaveHolstered - deriving - (Eq,Show,Ord,Enum,Read) - + deriving (Eq,Show,Ord,Enum,Read,Generic) +instance ToJSON AimStance where + toEncoding = genericToEncoding defaultOptions +instance FromJSON AimStance data EquipParams = NoEquipParams | EquipID {_eparamID :: Int} | EquipCounter {_eparamInt :: Int} - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON EquipParams where + toEncoding = genericToEncoding defaultOptions +instance FromJSON EquipParams data ItZoom = ItZoom { _itZoomMax :: Float , _itZoomMin :: Float , _itZoomFac :: Float } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItZoom where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItZoom makeLenses ''ItemUse +makeLenses ''Equipment makeLenses ''AimParams makeLenses ''EquipParams makeLenses ''ItZoom diff --git a/src/Dodge/Data/Item/UseDelay.hs b/src/Dodge/Data/Item/UseDelay.hs index c67b3cb46..da53dacbd 100644 --- a/src/Dodge/Data/Item/UseDelay.hs +++ b/src/Dodge/Data/Item/UseDelay.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} module Dodge.Data.Item.UseDelay where +import GHC.Generics +import Data.Aeson import Control.Lens data UseDelay -- should just be Delay = NoDelay @@ -18,5 +21,8 @@ data UseDelay -- should just be Delay {_warmTime :: Int ,_warmMax :: Int } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON UseDelay where + toEncoding = genericToEncoding defaultOptions +instance FromJSON UseDelay makeLenses ''UseDelay diff --git a/src/Dodge/Data/ItemAmount.hs b/src/Dodge/Data/ItemAmount.hs index 477563691..e402d4b5c 100644 --- a/src/Dodge/Data/ItemAmount.hs +++ b/src/Dodge/Data/ItemAmount.hs @@ -1,7 +1,10 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Dodge.Data.ItemAmount where - +import GHC.Generics +import Data.Aeson newtype IcAmount = IcAmount {_toInt :: Int} - deriving (Eq,Ord,Num,Integral,Real,Enum,Read) -instance Show IcAmount where - show (IcAmount i) = 'x':show i + deriving (Eq,Ord,Num,Integral,Real,Enum,Read,Show,Generic) +instance ToJSON IcAmount where + toEncoding = genericToEncoding defaultOptions +instance FromJSON IcAmount diff --git a/src/Dodge/Data/Laser.hs b/src/Dodge/Data/Laser.hs index 46331fbff..38e2346ce 100644 --- a/src/Dodge/Data/Laser.hs +++ b/src/Dodge/Data/Laser.hs @@ -1,15 +1,19 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Laser where +import GHC.Generics +import Data.Aeson import Color import Geometry.Data import Control.Lens - data LaserType = DamageLaser {_laserTypeDamage :: Int} | TargetLaser - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON LaserType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON LaserType data LaserStart = LaserStart { _lpPhaseV :: Float , _lpPos :: Point2 @@ -17,14 +21,19 @@ data LaserStart = LaserStart , _lpColor :: Color , _lpType :: LaserType } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON LaserStart where + toEncoding = genericToEncoding defaultOptions +instance FromJSON LaserStart data Laser = Laser { _laColor :: Color , _laPoints :: [Point2] , _laType :: LaserType } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Laser where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Laser makeLenses ''Laser makeLenses ''LaserStart makeLenses ''LaserType diff --git a/src/Dodge/Data/LightSource.hs b/src/Dodge/Data/LightSource.hs index 928e9d6ff..b977dfc55 100644 --- a/src/Dodge/Data/LightSource.hs +++ b/src/Dodge/Data/LightSource.hs @@ -1,37 +1,58 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.LightSource where +import GHC.Generics +import Data.Aeson import Geometry import Control.Lens data LightSourceDraw = DefaultLightSourceDraw - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON LightSourceDraw where + toEncoding = genericToEncoding defaultOptions +instance FromJSON LightSourceDraw data TLSIntensity = ConstantIntensity | TLSFade Point3 Int - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TLSIntensity where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TLSIntensity data TLSUpdate = DestroyTLS | TimerTLS | IntensityTLS TLSIntensity - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TLSUpdate where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TLSUpdate data LSParam = LSParam { _lsPos :: !Point3 , _lsRad :: !Float , _lsCol :: !Point3 } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON LSParam where + toEncoding = genericToEncoding defaultOptions +instance FromJSON LSParam data LightSource = LS { _lsID :: Int , _lsParam :: LSParam , _lsDir :: Float , _lsPict :: LightSourceDraw --LightSource -> Picture } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON LightSource where + toEncoding = genericToEncoding defaultOptions +instance FromJSON LightSource data TempLightSource = TLS { _tlsParam :: LSParam , _tlsUpdate :: TLSUpdate --TempLightSource -> Maybe TempLightSource , _tlsTime :: Int } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TempLightSource where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TempLightSource makeLenses ''LSParam makeLenses ''LightSource makeLenses ''TempLightSource diff --git a/src/Dodge/Data/LinearShockwave.hs b/src/Dodge/Data/LinearShockwave.hs index 755a15ed8..f76170506 100644 --- a/src/Dodge/Data/LinearShockwave.hs +++ b/src/Dodge/Data/LinearShockwave.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.LinearShockwave where +import GHC.Generics +import Data.Aeson import Geometry.Data import Control.Lens data LinearShockwave = LinearShockwave @@ -9,5 +12,8 @@ data LinearShockwave = LinearShockwave , _lwPoints :: [(Point2,Point2)] , _lwTimer :: Int } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON LinearShockwave where + toEncoding = genericToEncoding defaultOptions +instance FromJSON LinearShockwave makeLenses ''LinearShockwave diff --git a/src/Dodge/Data/LoadAction.hs b/src/Dodge/Data/LoadAction.hs index 8c912e2b5..7d5c5f808 100644 --- a/src/Dodge/Data/LoadAction.hs +++ b/src/Dodge/Data/LoadAction.hs @@ -1,6 +1,9 @@ +{-# 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 @@ -9,13 +12,22 @@ data LoadAction | LoadInsert {_actionTime :: Int, _actionSound :: SoundID} | LoadAdd {_actionTime :: Int, _actionSound :: SoundID, _insertMax :: Int } | LoadPrime {_actionTime :: Int, _actionSound :: SoundID} - deriving (Eq,Ord,Show,Read) + 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) + 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) + 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 d8c2fad52..db384b56b 100644 --- a/src/Dodge/Data/Machine.hs +++ b/src/Dodge/Data/Machine.hs @@ -1,7 +1,10 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Machine where +import GHC.Generics +import Data.Aeson import Dodge.Data.GenParams import Dodge.Data.Item import Sound.Data @@ -12,15 +15,16 @@ import Geometry.Data import Color import Dodge.Data.Material import qualified Data.IntSet as IS - import qualified Data.Map.Strict as M import Control.Lens - data MachineDraw = MachineDrawMempty | MachineDrawTerminal | MachineDrawTurret | MachineDrawDamageSensor Float (PaletteColor,DecorationShape) - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON MachineDraw where + toEncoding = genericToEncoding defaultOptions +instance FromJSON MachineDraw data Machine = Machine { _mcID :: Int , _mcWallIDs :: IS.IntSet @@ -33,11 +37,14 @@ data Machine = Machine , _mcSensor :: Sensor , _mcDamage :: [Damage] , _mcType :: MachineType - , _mcMounts :: M.Map Object Int + , _mcMounts :: M.Map ObjectType Int , _mcName :: String , _mcCloseSound :: Maybe SoundID } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Machine where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Machine data MachineType = StaticMachine | Turret @@ -46,6 +53,9 @@ data MachineType , _tuFireTime :: Int , _tuMCrID :: Maybe Int } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON MachineType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON MachineType makeLenses ''Machine makeLenses ''MachineType diff --git a/src/Dodge/Data/Magnet.hs b/src/Dodge/Data/Magnet.hs index 6f9bf8493..7ca83bacf 100644 --- a/src/Dodge/Data/Magnet.hs +++ b/src/Dodge/Data/Magnet.hs @@ -1,20 +1,30 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Magnet where +import GHC.Generics +import Data.Aeson import Geometry.Data import Control.Lens - newtype MagnetUpdate = MagnetUpdateTimer Int - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON MagnetUpdate where + toEncoding = genericToEncoding defaultOptions +instance FromJSON MagnetUpdate data MagnetBuBu = MagnetBuId | MagnetBuBuCurveAroundField Float Float - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON MagnetBuBu where + toEncoding = genericToEncoding defaultOptions +instance FromJSON MagnetBuBu data Magnet = Magnet { _mgID :: Int , _mgUpdate :: MagnetUpdate , _mgPos :: Point2 , _mgField :: MagnetBuBu } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Magnet where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Magnet makeLenses ''Magnet diff --git a/src/Dodge/Data/Material.hs b/src/Dodge/Data/Material.hs index 2bb6d1c60..0a2564df9 100644 --- a/src/Dodge/Data/Material.hs +++ b/src/Dodge/Data/Material.hs @@ -1,7 +1,12 @@ --{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE FlexibleInstances #-} ---{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric #-} module Dodge.Data.Material where +import GHC.Generics +import Data.Aeson data Material = Wood | Dirt | Stone | Glass | Metal | Crystal | Flesh | Electronics - deriving (Eq,Ord,Show,Bounded,Enum,Read) + deriving (Eq,Ord,Show,Bounded,Enum,Read,Generic) +instance ToJSON Material where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Material diff --git a/src/Dodge/Data/Modification.hs b/src/Dodge/Data/Modification.hs index 89e3352ea..55875d076 100644 --- a/src/Dodge/Data/Modification.hs +++ b/src/Dodge/Data/Modification.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Modification @@ -6,7 +7,8 @@ module Dodge.Data.Modification import Dodge.Data.WorldEffect import Geometry.Data import Control.Lens - +import GHC.Generics +import Data.Aeson data Modification = ModIDTimerPoint3Bool { _mdID :: Int @@ -22,5 +24,8 @@ data Modification , _mdExternalID2 :: Int , _mdUpdate :: MdWdWd } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Modification where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Modification makeLenses ''Modification diff --git a/src/Dodge/Data/MountedObject.hs b/src/Dodge/Data/MountedObject.hs index ce0b7d757..3d76150b0 100644 --- a/src/Dodge/Data/MountedObject.hs +++ b/src/Dodge/Data/MountedObject.hs @@ -1,9 +1,13 @@ ---{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} module Dodge.Data.MountedObject where +import GHC.Generics +import Data.Aeson data MountedObject = MountedLS Int | MountedProp Int - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON MountedObject where + toEncoding = genericToEncoding defaultOptions +instance FromJSON MountedObject diff --git a/src/Dodge/Data/Object.hs b/src/Dodge/Data/Object.hs index 81ddc997d..a78aea01d 100644 --- a/src/Dodge/Data/Object.hs +++ b/src/Dodge/Data/Object.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE StrictData #-} +{-# LANGUAGE DeriveGeneric #-} module Dodge.Data.Object where - -data Object +import GHC.Generics +import Data.Aeson +data ObjectType = ObTerminal | ObCreature | ObMachine @@ -12,4 +15,9 @@ data Object | ObProp | ObTrigger | ObItem - deriving (Eq,Show,Ord,Read,Enum,Bounded) + deriving (Eq,Show,Ord,Read,Enum,Bounded,Generic) +instance ToJSON ObjectType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ObjectType +instance ToJSONKey ObjectType +instance FromJSONKey ObjectType diff --git a/src/Dodge/Data/PathGraph.hs b/src/Dodge/Data/PathGraph.hs index 310611a3a..f0d21b2b3 100644 --- a/src/Dodge/Data/PathGraph.hs +++ b/src/Dodge/Data/PathGraph.hs @@ -1,6 +1,14 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- | +WARNING: orphan instances concerning Aeson classes and FGL datatypes have been introduced. +The warnings have been disabled. +-} module Dodge.Data.PathGraph where +import GHC.Generics +import Data.Aeson import Geometry.Data import Control.Lens import Data.Graph.Inductive @@ -12,20 +20,31 @@ data PathGraph = PathGraph , _pgNodeCount :: Int , _pgEdgeMap :: Map (V2 Point2) (Int,Int,PathEdge) } - deriving (Eq,Show,Read) + deriving (Eq,Show,Read,Generic) +instance ToJSON PathGraph where + toEncoding = genericToEncoding defaultOptions +instance FromJSON PathGraph data PathEdge = PathEdge {_peStart :: Point2 ,_peEnd :: Point2 ,_peDist :: Float ,_peObstacles :: Set.Set EdgeObstacle } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON PathEdge where + toEncoding = genericToEncoding defaultOptions +instance FromJSON PathEdge data EdgeObstacle = BlockObstacle | DoorObstacle | AutoDoorObstacle | WallObstacle - deriving (Eq,Ord,Show,Read,Bounded,Enum) - + deriving (Eq,Ord,Show,Read,Bounded,Enum,Generic) +instance ToJSON EdgeObstacle where + toEncoding = genericToEncoding defaultOptions +instance FromJSON EdgeObstacle +instance (ToJSON a,ToJSON b) => ToJSON (Gr a b) where + toEncoding = genericToEncoding defaultOptions +instance (FromJSON a,FromJSON b) => FromJSON (Gr a b) makeLenses ''PathGraph makeLenses ''PathEdge diff --git a/src/Dodge/Data/Payload.hs b/src/Dodge/Data/Payload.hs index a280c9f56..dba74ef25 100644 --- a/src/Dodge/Data/Payload.hs +++ b/src/Dodge/Data/Payload.hs @@ -1,5 +1,11 @@ +{-# LANGUAGE DeriveGeneric #-} --{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Payload where +import GHC.Generics +import Data.Aeson data Payload = ExplosionPayload | DudPayload - deriving (Show,Read,Eq,Ord,Enum,Bounded) + deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic) +instance ToJSON Payload where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Payload diff --git a/src/Dodge/Data/PosEvent.hs b/src/Dodge/Data/PosEvent.hs index 26607be82..371a3552a 100644 --- a/src/Dodge/Data/PosEvent.hs +++ b/src/Dodge/Data/PosEvent.hs @@ -1,15 +1,23 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.PosEvent where +import GHC.Generics +import Data.Aeson import Geometry.Data import Control.Lens - data PosEventType = SparkSpawner - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON PosEventType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON PosEventType data PosEvent = PosEvent { _pvType :: PosEventType , _pvTimer :: Int , _pvPos :: Point2 } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON PosEvent where + toEncoding = genericToEncoding defaultOptions +instance FromJSON PosEvent makeLenses ''PosEvent diff --git a/src/Dodge/Data/PressPlate.hs b/src/Dodge/Data/PressPlate.hs index 0d5670dc0..7b449c853 100644 --- a/src/Dodge/Data/PressPlate.hs +++ b/src/Dodge/Data/PressPlate.hs @@ -1,13 +1,19 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.PressPlate where +import GHC.Generics +import Data.Aeson import Geometry.Data import Picture import Control.Lens data PressPlateEvent = PressPlateId | PPLevelReset - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON PressPlateEvent where + toEncoding = genericToEncoding defaultOptions +instance FromJSON PressPlateEvent data PressPlate = PressPlate { _ppPict :: Picture , _ppPos :: Point2 @@ -16,5 +22,8 @@ data PressPlate = PressPlate , _ppID :: Int , _ppText :: String } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON PressPlate where + toEncoding = genericToEncoding defaultOptions +instance FromJSON PressPlate makeLenses ''PressPlate diff --git a/src/Dodge/Data/Projectile.hs b/src/Dodge/Data/Projectile.hs index 515ad8f91..a0b1e1e91 100644 --- a/src/Dodge/Data/Projectile.hs +++ b/src/Dodge/Data/Projectile.hs @@ -1,12 +1,14 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Projectile where +import GHC.Generics +import Data.Aeson import Dodge.Data.Payload import Dodge.Data.Ammo import Geometry.Data import Control.Lens - -data ProjectileType = ShellType +--data ProjectileType = ShellType data Proj = RemoteShell { _prjPos :: Point2 @@ -32,5 +34,8 @@ data Proj , _prjUpdates :: [ProjectileUpdate] , _prjMITID :: Maybe Int } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Proj where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Proj makeLenses ''Proj diff --git a/src/Dodge/Data/Prop.hs b/src/Dodge/Data/Prop.hs index cf3b64aea..e1ac72a83 100644 --- a/src/Dodge/Data/Prop.hs +++ b/src/Dodge/Data/Prop.hs @@ -1,15 +1,17 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Prop where +import GHC.Generics +import Data.Aeson import Dodge.Data.WorldEffect import Shape.Data import Color -import qualified Linear.Quaternion as Q +import qualified Quaternion as Q import Geometry.Data import ShapePicture.Data import Control.Lens - data PropDraw = PropDrawSPic SPic | PropDrawMovingShapeCol Shape | PropDrawMovingShape PropDraw @@ -19,7 +21,10 @@ data PropDraw = PropDrawSPic SPic | PropLampCover Float | PropDrawToggle PropDraw | PropDrawGib Float - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON PropDraw where + toEncoding = genericToEncoding defaultOptions +instance FromJSON PropDraw data PropUpdate -- = UpdatePropZ = PropUpdateAnd PropUpdate PropUpdate -- | UpdateShapeProp @@ -33,11 +38,17 @@ data PropUpdate -- = UpdatePropZ | PropUpdatePosition WdP2f | PropUpdateWhen WdBl PropUpdate | PropUpdateIf WdBl PropUpdate PropUpdate - deriving (Eq,Ord,Show,Read) + 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) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON PrWdLsLs where + toEncoding = genericToEncoding defaultOptions +instance FromJSON PrWdLsLs data Prop = PropZ { _prPos :: Point2 @@ -61,5 +72,8 @@ data Prop , _prRot :: Float , _prToggle :: Bool } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Prop where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Prop makeLenses ''Prop diff --git a/src/Dodge/Data/RadarBlip.hs b/src/Dodge/Data/RadarBlip.hs index ef6bf49be..7c3ed2219 100644 --- a/src/Dodge/Data/RadarBlip.hs +++ b/src/Dodge/Data/RadarBlip.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.RadarBlip where +import GHC.Generics +import Data.Aeson import Color import Geometry import Control.Lens @@ -11,5 +14,8 @@ data RadarBlip = RadarBlip , _rbRad :: Float , _rbPos :: Point2 } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON RadarBlip where + toEncoding = genericToEncoding defaultOptions +instance FromJSON RadarBlip makeLenses ''RadarBlip diff --git a/src/Dodge/Data/RadarSweep.hs b/src/Dodge/Data/RadarSweep.hs index bf0162ffb..4d46a1144 100644 --- a/src/Dodge/Data/RadarSweep.hs +++ b/src/Dodge/Data/RadarSweep.hs @@ -1,15 +1,20 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.RadarSweep where +import GHC.Generics +import Data.Aeson import Dodge.Data.Object import Geometry.Data import Control.Lens - data RadarSweep = RadarSweep { _rsPos :: Point2 , _rsRad :: Float - , _rsObject :: Object + , _rsObject :: ObjectType , _rsTimer :: Int } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON RadarSweep where + toEncoding = genericToEncoding defaultOptions +instance FromJSON RadarSweep makeLenses ''RadarSweep diff --git a/src/Dodge/Data/RightButtonOptions.hs b/src/Dodge/Data/RightButtonOptions.hs index 2b242dcb3..f27a90912 100644 --- a/src/Dodge/Data/RightButtonOptions.hs +++ b/src/Dodge/Data/RightButtonOptions.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.RightButtonOptions where +import GHC.Generics +import Data.Aeson import Dodge.Equipment.Data import Control.Lens @@ -13,13 +16,19 @@ data RightButtonOptions ,_opAllocateEquipment :: AllocateEquipment ,_opActivateEquipment :: ActivateEquipment } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON RightButtonOptions where + toEncoding = genericToEncoding defaultOptions +instance FromJSON RightButtonOptions data ActivateEquipment = ActivateEquipment {_activateEquipment :: Int } | DeactivateEquipment {_deactivateEquipment :: Int} | ActivateDeactivateEquipment {_activateEquipment :: Int ,_deactivateEquipment :: Int} | NoChangeActivateEquipment - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ActivateEquipment where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ActivateEquipment data AllocateEquipment = DoNotMoveEquipment | PutOnEquipment @@ -41,7 +50,10 @@ data AllocateEquipment | RemoveEquipment { _allocOldPos :: EquipPosition } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON AllocateEquipment where + toEncoding = genericToEncoding defaultOptions +instance FromJSON AllocateEquipment makeLenses ''RightButtonOptions makeLenses ''AllocateEquipment makeLenses ''ActivateEquipment diff --git a/src/Dodge/Data/Sensor.hs b/src/Dodge/Data/Sensor.hs index 32d59dde9..1aacafd25 100644 --- a/src/Dodge/Data/Sensor.hs +++ b/src/Dodge/Data/Sensor.hs @@ -1,10 +1,12 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Sensor where +import GHC.Generics +import Data.Aeson import Dodge.Combine.Data import Dodge.Data.Damage.Type import Control.Lens - data Sensor = NoSensor | DamageSensor { _sensToggle :: Bool @@ -17,13 +19,22 @@ data Sensor = NoSensor , _proxRequirement :: ProximityRequirement , _sensToggle :: Bool } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Sensor where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Sensor data ProximityRequirement = RequireHealth {_proxReqMinHealth :: Int} | RequireEquipment {_proxReqEquipment :: ItemBaseType} | RequireImpossible - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ProximityRequirement where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ProximityRequirement data CloseToggle = NotClose | IsClose - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CloseToggle where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CloseToggle makeLenses ''Sensor makeLenses ''ProximityRequirement diff --git a/src/Dodge/Data/Shockwave.hs b/src/Dodge/Data/Shockwave.hs index 0df74f263..602835dcc 100644 --- a/src/Dodge/Data/Shockwave.hs +++ b/src/Dodge/Data/Shockwave.hs @@ -1,12 +1,18 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Shockwave where +import GHC.Generics +import Data.Aeson import Color import Geometry.Data import Control.Lens data ShockwaveDirection = OutwardShockwave | InwardShockwave - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ShockwaveDirection where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ShockwaveDirection data Shockwave = Shockwave { _swColor :: Color , _swDirection :: ShockwaveDirection @@ -18,5 +24,8 @@ data Shockwave = Shockwave , _swMaxTime :: Int , _swTimer :: Int } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Shockwave where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Shockwave makeLenses ''Shockwave diff --git a/src/Dodge/Data/SoundOrigin.hs b/src/Dodge/Data/SoundOrigin.hs index f5c5ba7a3..8b4552a37 100644 --- a/src/Dodge/Data/SoundOrigin.hs +++ b/src/Dodge/Data/SoundOrigin.hs @@ -1,6 +1,10 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StrictData #-} module Dodge.Data.SoundOrigin where import Dodge.Data.Material +import GHC.Generics +import Data.Aeson data SoundOrigin = InventorySound | BackgroundSound | OnceSound @@ -26,5 +30,7 @@ data SoundOrigin = InventorySound | LeverSound Int | Explosion Int | Tap Int - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON SoundOrigin where + toEncoding = genericToEncoding defaultOptions +instance FromJSON SoundOrigin diff --git a/src/Dodge/Data/Spark.hs b/src/Dodge/Data/Spark.hs index 4f4c599da..e74c6d2f7 100644 --- a/src/Dodge/Data/Spark.hs +++ b/src/Dodge/Data/Spark.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Spark where +import GHC.Generics +import Data.Aeson import Dodge.Data.Damage.Type import Geometry.Data import Color @@ -13,5 +16,8 @@ data Spark = Spark , _skWidth :: Float , _skDamageType :: DamageType } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Spark where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Spark makeLenses ''Spark diff --git a/src/Dodge/Data/Targeting.hs b/src/Dodge/Data/Targeting.hs index 54684ec02..dec688ae4 100644 --- a/src/Dodge/Data/Targeting.hs +++ b/src/Dodge/Data/Targeting.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Targeting where +import GHC.Generics +import Data.Aeson import Geometry.Data import Control.Lens data Targeting @@ -12,16 +15,25 @@ data Targeting , _tgID :: Maybe Int , _tgActive :: Bool } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Targeting where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Targeting data TargetUpdate = NoTargetUpdate | TargetLaserUpdate | TargetRBPressUpdate | TargetRBCreatureUpdate | TargetCursorUpdate - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TargetUpdate where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TargetUpdate data TargetDraw = NoTargetDraw | TargetDistanceDraw | SimpleDrawTarget | TargetRBCreatureDraw - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TargetDraw where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TargetDraw makeLenses ''Targeting diff --git a/src/Dodge/Data/Terminal.hs b/src/Dodge/Data/Terminal.hs index 0edcf66dd..47a18eeb3 100644 --- a/src/Dodge/Data/Terminal.hs +++ b/src/Dodge/Data/Terminal.hs @@ -1,23 +1,35 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.Terminal where +import GHC.Generics +import Data.Aeson import Dodge.Data.WorldEffect import Color import Control.Lens import qualified Data.Text as T import qualified Data.Map.Strict as M data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TerminalStatus where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TerminalStatus data TerminalInput = TerminalInput { _tiText :: T.Text , _tiFocus :: Bool , _tiSel :: (Int,Int) } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TerminalInput where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TerminalInput data TerminalBootProgram = TerminalBootMempty | TerminalBootLines [TerminalLine] - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TerminalBootProgram where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TerminalBootProgram data Terminal = Terminal { _tmID :: Int , _tmBootProgram :: TerminalBootProgram -- Terminal -> World -> [TerminalLine] @@ -36,13 +48,22 @@ data Terminal = Terminal , _tmCommandHistory :: [String] , _tmToggles :: M.Map String TerminalToggle } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Terminal where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Terminal data TerminalLineString = TerminalLineConst String Color - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TerminalLineString where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TerminalLineString data TmTm = TmId | TmTmClearDisplayedLines | TmTmSetStatus TerminalStatus - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TmTm where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TmTm data TerminalLine = TerminalLineDisplay {_tlPause :: Int @@ -56,25 +77,35 @@ data TerminalLine {_tlPause :: Int ,_tlEffect :: TmWdWd --Terminal -> World -> World } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TerminalLine where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TerminalLine data TerminalToggle = TerminalToggle { _ttTriggerID :: Int , _ttDeathEffect :: BlBl } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TerminalToggle where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TerminalToggle data BlBl = BlNegate | BlConst Bool | BlId - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON BlBl where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BlBl data EffectArguments = NoArguments {_cmdEffect :: [TerminalLine]} | OneArgument {_argType :: String ,_argList :: M.Map String [TerminalLine] } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON EffectArguments where + toEncoding = genericToEncoding defaultOptions +instance FromJSON EffectArguments data TerminalCommandEffect = TerminalCommandArguments EffectArguments | TerminalCommandEffectDamageCoding | TerminalCommandEffectSensorParameter @@ -84,16 +115,23 @@ data TerminalCommandEffect = TerminalCommandArguments EffectArguments | TerminalCommandEffectCommands | TerminalCommandEffectSingleCommand WdWd [String] | TerminalCommandEffectNone - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TerminalCommandEffect where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TerminalCommandEffect data TerminalCommand = TerminalCommand { _tcString :: String , _tcAlias :: [String] , _tcHelp :: String , _tcEffect :: TerminalCommandEffect -- Terminal -> World -> EffectArguments } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TerminalCommand where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TerminalCommand +makeLenses ''TerminalInput makeLenses ''Terminal makeLenses ''TerminalLine +makeLenses ''TerminalToggle +makeLenses ''EffectArguments makeLenses ''TerminalCommand -makeLenses ''TerminalInput diff --git a/src/Dodge/Data/TeslaArc.hs b/src/Dodge/Data/TeslaArc.hs index ccb7a3553..1a672739d 100644 --- a/src/Dodge/Data/TeslaArc.hs +++ b/src/Dodge/Data/TeslaArc.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.TeslaArc where +import GHC.Generics +import Data.Aeson import Geometry.Data import Color import Control.Lens @@ -11,5 +14,8 @@ data TeslaArc = TeslaArc , _taArcSteps :: [ArcStep] , _taColor :: Color } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TeslaArc where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TeslaArc makeLenses ''TeslaArc diff --git a/src/Dodge/Data/TractorBeam.hs b/src/Dodge/Data/TractorBeam.hs index 4ac2cd0ea..07a569c8c 100644 --- a/src/Dodge/Data/TractorBeam.hs +++ b/src/Dodge/Data/TractorBeam.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.TractorBeam where +import GHC.Generics +import Data.Aeson import Geometry.Data import Control.Lens data TractorBeam = TractorBeam @@ -9,5 +12,8 @@ data TractorBeam = TractorBeam , _tbVel :: Point2 , _tbTime :: Int } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TractorBeam where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TractorBeam makeLenses ''TractorBeam diff --git a/src/Dodge/Data/Wall.hs b/src/Dodge/Data/Wall.hs index c2ab7a913..4c4674a38 100644 --- a/src/Dodge/Data/Wall.hs +++ b/src/Dodge/Data/Wall.hs @@ -3,6 +3,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveGeneric #-} module Dodge.Data.Wall where +import GHC.Generics +import Data.Aeson import Dodge.Data.Material import Geometry import Color @@ -26,15 +28,24 @@ data Wall = Wall , _wlHeight :: Float , _wlMaterial :: Material } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Wall where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Wall data Opacity = SeeThrough | SeeAbove | DrawnWall {_opDraw :: WallDraw } -- Wall -> SPic | Opaque - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Opacity where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Opacity data WallDraw = DrawForceField - deriving (Eq,Ord,Show,Read,Enum,Bounded) + deriving (Eq,Ord,Show,Read,Enum,Bounded,Generic) +instance ToJSON WallDraw where + toEncoding = genericToEncoding defaultOptions +instance FromJSON WallDraw data WallStructure = StandaloneWall | DoorPart { _wsDoor :: Int } @@ -44,7 +55,10 @@ data WallStructure { _wlStCreature :: Int -- , _wlStDamCreature :: Damage -> Wall -> Int -> World -> World } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON WallStructure where + toEncoding = genericToEncoding defaultOptions +instance FromJSON WallStructure makeLenses ''Wall -makeLenses ''WallStructure makeLenses ''Opacity +makeLenses ''WallStructure diff --git a/src/Dodge/Data/WorldEffect.hs b/src/Dodge/Data/WorldEffect.hs index 54b98695d..58d0f0a32 100644 --- a/src/Dodge/Data/WorldEffect.hs +++ b/src/Dodge/Data/WorldEffect.hs @@ -1,4 +1,10 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE DeriveGeneric #-} module Dodge.Data.WorldEffect where +import Data.Aeson +import GHC.Generics import Dodge.Data.CreatureEffect import Sound.Data import Geometry.Data @@ -13,15 +19,24 @@ data WdWd = NoWorldEffect | MakeStartCloudAt Point3 | TorqueCr Float Int | WdWdNegateTrig Int - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON WdWd where + toEncoding = genericToEncoding defaultOptions +instance FromJSON WdWd data WdP2 = WdP2Const Point2 | WdYouPos - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON WdP2 where + toEncoding = genericToEncoding defaultOptions +instance FromJSON WdP2 data MdWdWd = MdWdId | MdTrigIf MdWdWd MdWdWd | MdSetLSCol Point3 | MdFlickerUpdate - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON MdWdWd where + toEncoding = genericToEncoding defaultOptions +instance FromJSON MdWdWd data WdBl = WdTrig Int | WdBlDoorMoving Int | WdBlConst Bool @@ -29,18 +44,30 @@ data WdBl = WdTrig Int | WdBlCrFilterNearPoint Float Point2 CrBl | WdBlBtOn Int | WdBlBtNotOff Int - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON WdBl where + toEncoding = genericToEncoding defaultOptions +instance FromJSON WdBl data WdP2f = WdP2f0 | WdP2fDoorPosition Int - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON WdP2f where + toEncoding = genericToEncoding defaultOptions +instance FromJSON WdP2f data DrWdWd = DrWdId | DrWdMakeDoorDebris | DrWdMechanismStepwise Int [Int] [(Point2,Point2)] | DoorMechanism - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON DrWdWd where + toEncoding = genericToEncoding defaultOptions +instance FromJSON DrWdWd data TmWdWd = TmWdId | TmWdWdDisconnectTerminal | TmWdWdfromWdWd WdWd | TmWdWdTermSound SoundID | TmWdWdDoDeathTriggers - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON TmWdWd where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TmWdWd diff --git a/src/Dodge/Distortion/Data.hs b/src/Dodge/Distortion/Data.hs index 578fa9782..f7ef063d9 100644 --- a/src/Dodge/Distortion/Data.hs +++ b/src/Dodge/Distortion/Data.hs @@ -1,8 +1,14 @@ +{-# LANGUAGE DeriveGeneric #-} --{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Distortion.Data where +import GHC.Generics +import Data.Aeson import Geometry data Distortion = RadialDistortion Point2 Point2 Point2 Float - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Distortion where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Distortion diff --git a/src/Dodge/Equipment.hs b/src/Dodge/Equipment.hs index 3580a1a53..541849431 100644 --- a/src/Dodge/Equipment.hs +++ b/src/Dodge/Equipment.hs @@ -3,6 +3,7 @@ import Dodge.Data import qualified IntMapHelp as IM import Data.Strict.IntMap.Autogen.Merge.Strict +--import Data.IntMap.Merge.Strict getCrEquipment :: Creature -> IM.IntMap Item getCrEquipment cr = merge dropMissing dropMissing (zipWithMatched $ \_ _ -> id) diff --git a/src/Dodge/Equipment/Data.hs b/src/Dodge/Equipment/Data.hs index 9b715baaa..9ab2eb069 100644 --- a/src/Dodge/Equipment/Data.hs +++ b/src/Dodge/Equipment/Data.hs @@ -1,4 +1,8 @@ +{-# LANGUAGE StrictData #-} +{-# LANGUAGE DeriveGeneric #-} module Dodge.Equipment.Data where +import GHC.Generics +import Data.Aeson data EquipSite = GoesOnHead | GoesOnChest @@ -6,7 +10,10 @@ data EquipSite | GoesOnWrist | GoesOnLegs | GoesOnSpecial - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON EquipSite where + toEncoding = genericToEncoding defaultOptions +instance FromJSON EquipSite data EquipPosition = OnHead | OnChest @@ -15,4 +22,9 @@ data EquipPosition | OnRightWrist | OnLegs | OnSpecial - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON EquipPosition where + toEncoding = genericToEncoding defaultOptions +instance FromJSON EquipPosition +instance ToJSONKey EquipPosition +instance FromJSONKey EquipPosition diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index c590106dc..4e6ff3a05 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -73,6 +73,8 @@ handlePressedKey True ScancodeBackspace u | otherwise = return $ Just $ u & uvWorld . cWorld . backspaceTimer -~ 1 handlePressedKey True _ u = return $ Just u handlePressedKey _ scode u = case scode of + ScancodeF1 -> Just <$> (writeSaveSlot (SaveSlotNum 1) u >> return u) + ScancodeF2 -> Just <$> readSaveSlot (SaveSlotNum 1) u ScancodeF5 -> return . Just $ doQuicksave u ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u ScancodeSemicolon -> return . Just $ gotoTerminal u diff --git a/src/Dodge/GameRoom.hs b/src/Dodge/GameRoom.hs index d801a1c4c..a25e15390 100644 --- a/src/Dodge/GameRoom.hs +++ b/src/Dodge/GameRoom.hs @@ -1,9 +1,14 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} {- | GameRooms contain information about given positions in the world -} module Dodge.GameRoom where import Geometry +import Control.Lens +import GHC.Generics +import Data.Aeson data GameRoom = GameRoom { _grViewpoints :: [Point2] @@ -13,4 +18,8 @@ data GameRoom = GameRoom , _grLinkDirs :: [Float] , _grName :: String } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON GameRoom where + toEncoding = genericToEncoding defaultOptions +instance FromJSON GameRoom +makeLenses ''GameRoom diff --git a/src/Dodge/Item/Attachment/Data.hs b/src/Dodge/Item/Attachment/Data.hs index 603e083c5..70e33417d 100644 --- a/src/Dodge/Item/Attachment/Data.hs +++ b/src/Dodge/Item/Attachment/Data.hs @@ -1,12 +1,13 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Item.Attachment.Data where +import GHC.Generics +import Data.Aeson import Geometry.Data - import Control.Lens import qualified Data.Sequence as Seq - data ItAttachment = AttachFuse {_atFuseTime :: Int} | AttachMode {_atMode :: Int} @@ -17,8 +18,10 @@ data ItAttachment | AttachFloat { _atFloat :: Float } | AttachBool { _atBool :: Bool } | NoItAttachment - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItAttachment where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItAttachment data Scope = NoScope | RemoteScope {_scopePos :: Point2 -- ^ a camera offset @@ -32,7 +35,9 @@ data Scope = NoScope ,_scopeDefaultZoom :: Float ,_scopeIsCamera :: Bool -- ^ if the camera offset is also the center of vision } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Scope where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Scope makeLenses ''ItAttachment makeLenses ''Scope diff --git a/src/Dodge/Item/Data.hs b/src/Dodge/Item/Data.hs index 667d97c48..0cc70281c 100644 --- a/src/Dodge/Item/Data.hs +++ b/src/Dodge/Item/Data.hs @@ -1,9 +1,14 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} --{-# LANGUAGE TemplateHaskell #-} module Dodge.Item.Data where ---import Control.Lens +import GHC.Generics +import Data.Aeson data CurseStatus = Uncursed | UndroppableIdentified | UndroppableUnidentified - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON CurseStatus where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CurseStatus diff --git a/src/Dodge/RadarSweep.hs b/src/Dodge/RadarSweep.hs index 6f192f8e5..c3e0513b0 100644 --- a/src/Dodge/RadarSweep.hs +++ b/src/Dodge/RadarSweep.hs @@ -8,7 +8,7 @@ import LensHelp import Data.Maybe import qualified IntMapHelp as IM -aRadarPulse :: Object -> Creature -> World -> World +aRadarPulse :: ObjectType -> Creature -> World -> World aRadarPulse ob cr = cWorld . radarSweeps .:~ RadarSweep { _rsTimer = 100 , _rsRad = 0 @@ -34,13 +34,13 @@ updateRadarSweep w pt circPoints = blipsF p r w r = fromIntegral (400 - x*4) -findBlips :: Object -> Point2 -> Float -> World -> [Point2] +findBlips :: ObjectType -> Point2 -> Float -> World -> [Point2] findBlips ob = case ob of ObCreature -> crBlips ObItem -> itemBlips ObWall -> wallBlips _ -> undefined -makeBlip :: Object -> Point2 -> RadarBlip +makeBlip :: ObjectType -> Point2 -> RadarBlip makeBlip ob = case ob of ObCreature -> blipAt 8 (withAlpha 0.2 green) 50 ObWall -> blipAt 2 red 50 diff --git a/src/Dodge/RadarSweep/Draw.hs b/src/Dodge/RadarSweep/Draw.hs index adc64fd75..365838d88 100644 --- a/src/Dodge/RadarSweep/Draw.hs +++ b/src/Dodge/RadarSweep/Draw.hs @@ -19,7 +19,7 @@ drawRadarSweep pt = setLayer DebugLayer $ pictures sweepPics | otherwise = fromIntegral x / 10 x = _rsTimer pt -rsObjectColor :: Object -> Color +rsObjectColor :: ObjectType -> Color rsObjectColor ob = case ob of ObWall -> red ObCreature -> green diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index c3d93b83a..294ca7377 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -310,8 +310,8 @@ drawCarte cfig w = pictures $ ++ [mainListCursor white iPos cfig] where iPos = _selLocation (_cWorld w) - locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ (_cWorld w) - locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations $ (_cWorld w) + locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ _cWorld w + locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations $ _cWorld w locTexts = map fst locs displayListEndCoords :: Configuration -> [String] -> [Point2] diff --git a/src/Dodge/Save.hs b/src/Dodge/Save.hs index 50e287498..44434b4e7 100644 --- a/src/Dodge/Save.hs +++ b/src/Dodge/Save.hs @@ -3,13 +3,38 @@ module Dodge.Save , loadSaveSlot , doQuicksave , saveLevelStartSlot + , writeSaveSlot + , readSaveSlot ) where import Dodge.Data +import Text.Read (readMaybe) import qualified Data.Map.Strict as M --import Data.Maybe import Control.Lens --import qualified Data.Set as S +import System.Directory + +writeSaveSlot :: SaveSlot -> Universe -> IO () +writeSaveSlot ss u = do + createDirectoryIfMissing True "saveSlot" + writeFile (saveSlotPath ss) (show $ u ^. uvWorld . cWorld) + +saveSlotPath :: SaveSlot -> String +saveSlotPath (SaveSlotNum i) = "saveSlot/" ++ show i +saveSlotPath QuicksaveSlot = "saveSlot/QuickSave" +saveSlotPath LevelStartSlot = "saveSlot/LevelStartSave" + +readSaveSlot :: SaveSlot -> Universe -> IO Universe +readSaveSlot ss uv = do + fExists <- doesFileExist $ saveSlotPath ss + if fExists + then do + cwstr <- readFile $ saveSlotPath ss + case readMaybe cwstr of + Nothing -> putStrLn "loadSaveSlot failed to read saved file" >> return uv + Just cw -> return $ uv & uvWorld . cWorld .~ cw + else putStrLn "loadSaveSlot failed to find saved file" >> return uv saveWorldInEmptySlot :: SaveSlot -> Universe -> Universe saveWorldInEmptySlot slot w = case M.lookup slot $ _savedWorlds w of diff --git a/src/Geometry/ConvexPoly.hs b/src/Geometry/ConvexPoly.hs index 884519950..8d56e6297 100644 --- a/src/Geometry/ConvexPoly.hs +++ b/src/Geometry/ConvexPoly.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE BangPatterns #-} module Geometry.ConvexPoly @@ -10,6 +11,8 @@ module Geometry.ConvexPoly , convexPolysOverlap , pointInPolyPoints ) where +import GHC.Generics +import Data.Aeson import Geometry.Data import Geometry.Vector import Geometry.LHS @@ -23,7 +26,10 @@ data ConvexPoly = ConvexPoly , _cpCen :: Point2 , _cpRad :: Float } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ConvexPoly where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ConvexPoly pointsToPoly :: [Point2] -> ConvexPoly pointsToPoly xs = ConvexPoly { _cpPoints = xs diff --git a/src/Geometry/Data.hs b/src/Geometry/Data.hs index adbfd63a1..61652d3db 100644 --- a/src/Geometry/Data.hs +++ b/src/Geometry/Data.hs @@ -1,3 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- | +WARNING: orphan instances concerning Aeson classes and Linear.Vx datatypes have been introduced. +The warnings have been disabled. +-} module Geometry.Data ( module Geometry.Data , V2 (..) @@ -5,13 +11,25 @@ module Geometry.Data , V4 (..) ) where +import Data.Aeson import Linear.V2 import Linear.V3 import Linear.V4 type Int2 = V2 Int type Point2 = V2 Float +instance ToJSON a => ToJSON (V2 a) where + toEncoding = genericToEncoding defaultOptions +instance FromJSON a => FromJSON (V2 a) +instance ToJSON a => ToJSONKey (V2 a) +instance FromJSON a => FromJSONKey (V2 a) type Point3 = V3 Float +instance ToJSON a => ToJSON (V3 a) where + toEncoding = genericToEncoding defaultOptions +instance FromJSON a => FromJSON (V3 a) type Point4 = V4 Float +instance ToJSON a => ToJSON (V4 a) where + toEncoding = genericToEncoding defaultOptions +instance FromJSON a => FromJSON (V4 a) type DPoint2 = (Point2,Float) diff --git a/src/IntMapHelp.hs b/src/IntMapHelp.hs index 3e62b2994..a455dae10 100644 --- a/src/IntMapHelp.hs +++ b/src/IntMapHelp.hs @@ -1,6 +1,14 @@ +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DeriveGeneric #-} {-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- | +WARNING: orphan instances concerning Aeson classes and Data.Strict.IntMap datatypes have been introduced. +The warnings have been disabled. + -} module IntMapHelp ( module Data.Strict.IntMap + --( module Data.IntMap.Strict , newKey , insertNewKey , insertWithNewKeys @@ -8,10 +16,40 @@ module IntMapHelp , safeSwapKeys , findIndex ) where +import GHC.Generics +import Data.Aeson import LensHelp ---import Data.List hiding (foldr,insert) + +--import Data.IntMap.Strict + import Data.Strict.IntMap import Data.Strict.Containers.Lens + +--import qualified Data.Strict.IntMap as IM +--import qualified Data.Strict.IntMap.Autogen.Strict as IM +--deriving instance Generic (IntMap a) + +--deriving instance (Generic a) => Generic (IM.IntMap a) +instance ToJSON1 IntMap where + liftToJSON t tol = liftToJSON to' tol' . toList + where + to' = liftToJSON2 toJSON toJSONList t tol + tol' = liftToJSONList2 toJSON toJSONList t tol + + liftToEncoding t tol = liftToEncoding to' tol' . toList + where + to' = liftToEncoding2 toEncoding toEncodingList t tol + tol' = liftToEncodingList2 toEncoding toEncodingList t tol + +instance ToJSON a => ToJSON (IntMap a) where + toJSON = toJSON1 + toEncoding = toEncoding1 +instance FromJSON a => FromJSON (IntMap a) where + parseJSON = fmap fromList . parseJSON + +--instance ToJSON a => ToJSON (IntMap a) where +-- toEncoding = genericToEncoding defaultOptions + {- | Find a key value one higher than any key in the map, or zero if the map is - empty -} newKey :: IntMap a -> Int diff --git a/src/MaybeHelp.hs b/src/MaybeHelp.hs index 4acd63b52..f399bdf25 100644 --- a/src/MaybeHelp.hs +++ b/src/MaybeHelp.hs @@ -1,10 +1,16 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} +{-# LANGUAGE DeriveGeneric #-} module MaybeHelp where import Control.Lens +import Data.Aeson +import GHC.Generics data Maybe' a = Just' {__Just' :: a} | Nothing' - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON a => ToJSON (Maybe' a) where + toEncoding = genericToEncoding defaultOptions +instance FromJSON a => FromJSON (Maybe' a) fromJust' :: Maybe' a -> a fromJust' mx = case mx of diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs index f3ce7ef25..bca8ae5bc 100644 --- a/src/Picture/Data.hs +++ b/src/Picture/Data.hs @@ -1,11 +1,13 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} module Picture.Data where +import GHC.Generics +import Data.Aeson import Geometry.Data -import GHC.Generics import Control.Lens import Streaming data Verx = Verx @@ -15,8 +17,10 @@ data Verx = Verx , _vxLayer :: !Layer , _vxShadNum :: !ShadNum } - deriving (Eq,Ord,Show,Generic,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Verx where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Verx data Layer = BottomLayer | MidLayer @@ -24,15 +28,20 @@ data Layer | BloomNoZWrite | DebugLayer | FixedCoordLayer - deriving (Eq,Ord,Enum,Bounded,Show,Generic,Read) - + deriving (Eq,Ord,Enum,Bounded,Show,Read,Generic) +instance ToJSON Layer where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Layer layerNum :: Layer -> Int layerNum = fromEnum numLayers :: Int numLayers = length [minBound::Layer .. maxBound] --TODO use synonyms for layer numbers newtype ShadNum = ShadNum { _unShadNum :: Int } - deriving (Eq,Ord,Show,Generic,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ShadNum where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ShadNum polyNum, polyzNum, bezNum, textNum, arcNum, ellNum :: ShadNum {-# INLINE polyNum #-} {-# INLINE polyzNum #-} diff --git a/src/Quaternion.hs b/src/Quaternion.hs index 2c7f42ddc..86aef24a1 100644 --- a/src/Quaternion.hs +++ b/src/Quaternion.hs @@ -1,13 +1,25 @@ +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DeriveGeneric #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- | +WARNING: orphan instances concerning Aeson classes and Linear.Quaternion datatypes have been introduced. +The warnings have been disabled. +-} module Quaternion ( rotateToZ , vToQuat , module Linear.Quaternion ) where +import Data.Aeson import Geometry.Data import Geometry.Vector3D import qualified Linear.Quaternion as Q import Linear.Quaternion +instance ToJSON a => ToJSON (Q.Quaternion a) where + toEncoding = genericToEncoding defaultOptions +instance FromJSON a => FromJSON (Q.Quaternion a) + -- apply a rotation as if the z axis moves to the new point. -- i think this may instead do as if the new point moves to be on z axis rotateToZ :: Point3 -> Point3 -> Point3 diff --git a/src/Shape/Data.hs b/src/Shape/Data.hs index b06c75f4c..95208d20c 100644 --- a/src/Shape/Data.hs +++ b/src/Shape/Data.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# OPTIONS_GHC -Wno-missing-signatures #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} @@ -6,25 +7,16 @@ module Shape.Data where import Geometry.Data - ---import Data.Vector.Fusion.Util +import GHC.Generics +import Data.Aeson import Control.Lens import Streaming type Shape' = Stream (Of ShapeObj) IO () type Shape = [ShapeObj] ---_shVertices :: Shape -> [ShapeV] ---{-# INLINE _shVertices #-} ---_shVertices = concatMap _shVs - ---shVList :: Shape -> [ShapeV] ---{-# INLINE shVList #-} ---shVList = _shVertices ---shVList = DL.toList . _shVertices - {-# INLINE shVfromList #-} shVfromList = id ---shVfromList = DL.fromList + {-# INLINE shEfromList #-} shEfromList = id @@ -32,17 +24,24 @@ data ShapeObj = ShapeObj { _shType :: ShapeType , _shVs :: [ShapeV] } - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ShapeObj where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ShapeObj newtype ShapeType = TopPrism Int - deriving (Eq,Ord,Show,Read) - + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ShapeType where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ShapeType -- edges are given by four consecutive points data ShapeV = ShapeV {_svPos :: Point3 ,_svCol :: Point4 } - deriving (Eq,Ord,Show,Read) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ShapeV where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ShapeV pairToSV :: (Point3,Point4) -> ShapeV {-# INLINE pairToSV #-} pairToSV = uncurry ShapeV diff --git a/src/Sound/Data.hs b/src/Sound/Data.hs index 32c866a0f..07a3ec0ef 100644 --- a/src/Sound/Data.hs +++ b/src/Sound/Data.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveGeneric #-} {-# 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 @@ -12,7 +15,10 @@ data SoundStatus = SoundStatus {_playStatus :: PlayStatus ,_isLooping :: Bool } - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Generic) +instance ToJSON SoundStatus where + toEncoding = genericToEncoding defaultOptions +instance FromJSON SoundStatus -- TODO make this more sensible (use product rather than union in some cases) data PlayStatus = JustStartedPlaying @@ -20,9 +26,15 @@ data PlayStatus | ToStart | ToContinueStart | ToStop - deriving (Eq,Ord,Show) + 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) + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON SoundID where + toEncoding = genericToEncoding defaultOptions +instance FromJSON SoundID newtype SoundData = SoundData {_loadedChunks :: IM.IntMap Mix.Chunk }