Add generic derivations and To/FromJSON instances

This commit is contained in:
2022-07-25 22:49:18 +01:00
parent f5604ef429
commit b8e8413daa
99 changed files with 1406 additions and 517 deletions
+7 -1
View File
@@ -1,9 +1,15 @@
{-# LANGUAGE DeriveGeneric #-}
module Color where module Color where
import GHC.Generics
import Data.Aeson
import Geometry import Geometry
data PaletteColor = RED | GREEN | BLUE | YELLOW | CYAN data PaletteColor = RED | GREEN | BLUE | YELLOW | CYAN
| MAGENTA | ROSE | VIOLET | AZURE | AQUAMARINE | CHARTREUSE | ORANGE | WHITE | BLACK | 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 RGBA = Point4
type Color = Point4 type Color = Point4
+3 -3
View File
@@ -7,9 +7,9 @@ import ShapePicture
drawBlock :: BlockDraw -> Block -> SPic drawBlock :: BlockDraw -> Block -> SPic
drawBlock bd = case bd of drawBlock bd = case bd of
BlockDrawMempty -> const mempty BlockDrawMempty -> const mempty
BlockDraws bds -> \bl -> foldMap (flip drawBlock bl) bds BlockDraws bds -> \bl -> foldMap (`drawBlock` bl) bds
BlockDrawColHeightPoss col h ps -> const $ noPic $ colorSH col (upperPrismPoly h $ ps) BlockDrawColHeightPoss col h ps -> const $ noPic $ colorSH col (upperPrismPoly h ps)
BlockDrawBlSh x -> \bl -> noPic $ doBlSh x bl BlockDrawBlSh x -> noPic . doBlSh x
doBlSh :: BlSh -> Block -> Shape doBlSh :: BlSh -> Block -> Shape
doBlSh bs = case bs of doBlSh bs = case bs of
+45 -19
View File
@@ -1,22 +1,28 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Dodge.Combine.Data module Dodge.Combine.Data
where where
import GHC.Generics
import Data.Aeson
import Dodge.Equipment.Data import Dodge.Equipment.Data
import Dodge.Data.ItemAmount import Dodge.Data.ItemAmount
import Control.Lens import Control.Lens
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
-- this should probably store loaded ammo -- this should probably store loaded ammo
data ItemType = ItemType data ItemType = ItemType
{_iyBase :: ItemBaseType {_iyBase :: ItemBaseType
,_iyModules :: M.Map ModuleSlot ItemModuleType ,_iyModules :: M.Map ModuleSlot ItemModuleType
,_iyStack :: Stack ,_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 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 data CraftType
= PIPE = PIPE
| TUBE | TUBE
@@ -67,8 +73,10 @@ data CraftType
| TIMEMODULE | TIMEMODULE
| SIZEMODULE | SIZEMODULE
| GRAVITYMODULE | 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...? -- TODO make this an enum somehow...?
data ItemBaseType data ItemBaseType
= NOTDEFINED = NOTDEFINED
@@ -88,8 +96,10 @@ data ItemBaseType
| MEDKIT Int | MEDKIT Int
| CRAFT CraftType | 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 data EquipItemType
= MAGSHIELD = MAGSHIELD
| FLAMESHIELD | FLAMESHIELD
@@ -105,7 +115,10 @@ data EquipItemType
| JUMPLEGS | JUMPLEGS
| JETPACK | JETPACK
| AUTODETECTOR Detector | 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 data LeftItemType
= BOOSTER = BOOSTER
| REWINDER | REWINDER
@@ -113,8 +126,10 @@ data LeftItemType
| BLINKERUNSAFE | BLINKERUNSAFE
| SHRINKER | SHRINKER
| SPAWNER | SPAWNER
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON LeftItemType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON LeftItemType
data HeldItemType data HeldItemType
= BANGSTICK {_xNum :: Int} = BANGSTICK {_xNum :: Int}
| PISTOL | PISTOL
@@ -175,8 +190,10 @@ data HeldItemType
| HELDDETECTOR Detector | HELDDETECTOR Detector
| TORCH | TORCH
| FLATSHIELD | FLATSHIELD
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON HeldItemType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON HeldItemType
data ItemModuleType data ItemModuleType
= EMPTYMODULE = EMPTYMODULE
| DRUMMAG | DRUMMAG
@@ -200,13 +217,18 @@ data ItemModuleType
| LAUNCHHOME | LAUNCHHOME
| EXTRABATTERY | EXTRABATTERY
| ATTACHTORCH | ATTACHTORCH
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItemModuleType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItemModuleType
data Detector data Detector
= ITEMDETECTOR = ITEMDETECTOR
| CREATUREDETECTOR | CREATUREDETECTOR
| WALLDETECTOR | WALLDETECTOR
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Detector where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Detector
data ModuleSlot data ModuleSlot
= ModBullet = ModBullet
| ModBulletSpawn | ModBulletSpawn
@@ -219,8 +241,12 @@ data ModuleSlot
| ModTeleport | ModTeleport
| ModDualBeam | ModDualBeam
| ModHeldAttach | 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 ''ItemType
makeLenses ''ItemBaseType makeLenses ''ItemBaseType
makeLenses ''HeldItemType makeLenses ''HeldItemType
+7 -4
View File
@@ -1,15 +1,18 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Creature.Memory.Data module Dodge.Creature.Memory.Data
where where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
data Memory = Memory data Memory = Memory
{ _soundsToInvestigate :: [Point2] { _soundsToInvestigate :: [Point2]
, _nodesSearched :: [Int] , _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 makeLenses ''Memory
+28 -14
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Creature.Perception.Data module Dodge.Creature.Perception.Data
@@ -20,10 +21,11 @@ module Dodge.Creature.Perception.Data
, auDist , auDist
) )
where where
import GHC.Generics
import Data.Aeson
import Control.Lens import Control.Lens
import Dodge.Data.FloatFunction import Dodge.Data.FloatFunction
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
data Perception = Perception data Perception = Perception
{ _cpVigilance :: Vigilance { _cpVigilance :: Vigilance
, _cpAttention :: Attention , _cpAttention :: Attention
@@ -31,38 +33,50 @@ data Perception = Perception
, _cpVision :: Vision , _cpVision :: Vision
, _cpAudition :: Audition , _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 data Vision = Eyes
{ _viFOV :: FloatFloat { _viFOV :: FloatFloat
, _viDist :: 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 newtype Audition = Ears
{ _auDist :: FloatFloat { _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 data Vigilance
= Comatose = Comatose
| Asleep | Asleep
| Lethargic | Lethargic
| Vigilant | Vigilant
| Overstrung | Overstrung
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Vigilance where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Vigilance
data Attention data Attention
= AttentiveTo {_getAttentiveTo :: IM.IntMap Awareness } = AttentiveTo {_getAttentiveTo :: IM.IntMap Awareness }
| Fixated {_getFixated :: Int } | 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 data Awareness
= Suspicious Float = Suspicious Float
| Cognizant Float | Cognizant Float
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Awareness where
makeLenses ''Attention toEncoding = genericToEncoding defaultOptions
instance FromJSON Awareness
makeLenses ''Perception makeLenses ''Perception
makeLenses ''Vision makeLenses ''Vision
makeLenses ''Audition makeLenses ''Audition
makeLenses ''Attention
+19 -8
View File
@@ -1,7 +1,10 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Creature.Stance.Data module Dodge.Creature.Stance.Data
where where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
@@ -10,8 +13,10 @@ data Stance = Stance
,_posture :: Posture ,_posture :: Posture
,_strideLength :: Int ,_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 data Carriage
= Walking = Walking
{ _strideAmount :: Int { _strideAmount :: Int
@@ -21,19 +26,25 @@ data Carriage
| Floating | Floating
| Flying | Flying
| Boosting Point2 | 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 data FootForward
= LeftForward = LeftForward
| RightForward | RightForward
| WasLeftForward | WasLeftForward
| WasRightForward | 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 data Posture = Aiming
| AtEase | 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 ''Stance
makeLenses ''Carriage makeLenses ''Carriage
makeLenses ''Posture makeLenses ''Posture
+20 -4
View File
@@ -1,7 +1,10 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Creature.State.Data module Dodge.Creature.State.Data
where where
import GHC.Generics
import Data.Aeson
--import Geometry --import Geometry
import Geometry.Data import Geometry.Data
import Color import Color
@@ -12,11 +15,17 @@ data CreatureDropType
= DropAll = DropAll
| DropAmount Int | DropAmount Int
| DropSpecific [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 data CrSpState
= Barrel { _piercedPoints :: [Point2]} = Barrel { _piercedPoints :: [Point2]}
| GenCr | GenCr
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON CrSpState where
toEncoding = genericToEncoding defaultOptions
instance FromJSON CrSpState
data Faction data Faction
= GenericFaction Int = GenericFaction Int
| ZombieFaction | ZombieFaction
@@ -26,7 +35,10 @@ data Faction
| NoFaction | NoFaction
| ColorFaction Color | ColorFaction Color
| PlayerFaction | PlayerFaction
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Faction where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Faction
data CrGroup data CrGroup
= LoneWolf = LoneWolf
| Swarm | Swarm
@@ -35,5 +47,9 @@ data CrGroup
} }
| CrGroupID { _crGroupID :: Int } | CrGroupID { _crGroupID :: Int }
| ShieldGroup | 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 ''CrSpState
makeLenses ''CrGroup
+1
View File
@@ -9,6 +9,7 @@ import LensHelp
import Data.Maybe import Data.Maybe
import Data.Strict.IntMap.Autogen.Merge.Strict import Data.Strict.IntMap.Autogen.Merge.Strict
--import Data.IntMap.Merge.Strict
getCrDexterity :: Creature -> Int getCrDexterity :: Creature -> Int
getCrDexterity cr = _dexterity (_crStatistics cr) getCrDexterity cr = _dexterity (_crStatistics cr)
+38 -10
View File
@@ -2,12 +2,16 @@
Contains base datatypes that cannot be seperated into Contains base datatypes that cannot be seperated into
different modules because they are interdependent; different modules because they are interdependent;
circular imports are probably not a good idea. 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 TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingStrategies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Dodge.Data module Dodge.Data
( module Dodge.Data ( module Dodge.Data
, module Dodge.Data.CrGroupParams , module Dodge.Data.CrGroupParams
@@ -87,7 +91,11 @@ module Dodge.Data
, module Dodge.Data.Machine , module Dodge.Data.Machine
, module Dodge.Data.GenParams , module Dodge.Data.GenParams
, module Dodge.Data.Terminal , module Dodge.Data.Terminal
, module Dodge.Data.FloorItem
) where ) where
import Dodge.Data.FloorItem
import Data.Aeson
import GHC.Generics
import Dodge.Data.Terminal import Dodge.Data.Terminal
import Dodge.Data.GenParams import Dodge.Data.GenParams
import Dodge.Data.Machine import Dodge.Data.Machine
@@ -305,18 +313,41 @@ data CWorld = CWorld
, _lSelect :: Point2 , _lSelect :: Point2
, _rSelect :: 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 data TimeFlowStatus
= RewindingNow = RewindingNow
| RewindingLastFrame | RewindingLastFrame
| NormalTimeFlow | NormalTimeFlow
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TimeFlowStatus where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TimeFlowStatus
data WorldHammer data WorldHammer
= SubInvHam = SubInvHam
| DoubleMouseHam | DoubleMouseHam
deriving (Eq,Ord,Show,Read,Enum,Bounded) 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 data SaveSlot = QuicksaveSlot | LevelStartSlot
| SaveSlotNum Int
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read)
data OptionScreenFlag = NormalOptions | GameOverOptions data OptionScreenFlag = NormalOptions | GameOverOptions
@@ -361,8 +392,6 @@ data MenuOption
{ _moKey :: Scancode { _moKey :: Scancode
, _moEff :: Universe -> IO (Maybe Universe) , _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 data IntID a = IntID Int a
@@ -373,7 +402,10 @@ data WorldBeams = WorldBeams
,_positronBeams :: [Beam] ,_positronBeams :: [Beam]
,_electronBeams :: [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. {- Objects without ids.
Update themselves, perhaps with side effects. -} Update themselves, perhaps with side effects. -}
@@ -495,12 +527,8 @@ data InPlacement = InPlacement
, _ipPlacementID :: Int , _ipPlacementID :: Int
} }
makeLenses ''World makeLenses ''World
makeLenses ''FloorItem
--makeLenses ''Particle --makeLenses ''Particle
makeLenses ''Universe makeLenses ''Universe
makeLenses ''GunBarrels
makeLenses ''Nozzle
makeLenses ''Equipment
makeLenses ''ScreenLayer makeLenses ''ScreenLayer
makeLenses ''WorldBeams makeLenses ''WorldBeams
makeLenses ''GenWorld makeLenses ''GenWorld
+27 -130
View File
@@ -1,7 +1,10 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.ActionPlan where module Dodge.Data.ActionPlan where
import GHC.Generics
import Data.Aeson
import Dodge.Creature.Stance.Data import Dodge.Creature.Stance.Data
import Dodge.Data.CreatureEffect import Dodge.Data.CreatureEffect
--import Dodge.ShortShow --import Dodge.ShortShow
@@ -17,11 +20,17 @@ data ActionPlan
,_apStrategy :: Strategy ,_apStrategy :: Strategy
,_apGoal :: [Goal] ,_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 data RandImpulse
= RandImpulseList [Impulse] = RandImpulseList [Impulse]
| RandImpulseCircMove Float | 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 data Impulse
= Move Point2 = Move Point2
| MoveForward Float | MoveForward Float
@@ -54,34 +63,10 @@ data Impulse
{_impulseUseAheadPos :: P2Imp {_impulseUseAheadPos :: P2Imp
} }
| ImpulseNothing | ImpulseNothing
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
--instance Show Impulse where instance ToJSON Impulse where
-- show imp = case imp of toEncoding = genericToEncoding defaultOptions
-- Move p -> "Move "++shortPoint2 p instance FromJSON Impulse
-- 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"
infixr 9 `WaitThen` infixr 9 `WaitThen`
infixr 9 `DoActionThen` infixr 9 `DoActionThen`
infixr 9 `DoActionWhile` infixr 9 `DoActionWhile`
@@ -182,103 +167,10 @@ data Action
{_sideImpulses :: [Impulse] {_sideImpulses :: [Impulse]
,_mainAction :: Action ,_mainAction :: Action
} }
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
--instance Show Action where instance ToJSON Action where
-- show act = case act of toEncoding = genericToEncoding defaultOptions
-- ActionNothing -> "ActionNothing" instance FromJSON Action
-- 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)
data Strategy data Strategy
= Flank Int = Flank Int
| Ambush Int | Ambush Int
@@ -295,13 +187,18 @@ data Strategy
| Reload | Reload
| Flee | Flee
| MeleeStrike | MeleeStrike
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
-- deriving (Eq,Ord,Show) instance ToJSON Strategy where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Strategy
data Goal data Goal
= LiveLongAndProsper = LiveLongAndProsper
| Kill Int | Kill Int
| SentinelAt Point2 Float | 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 ''ActionPlan
makeLenses ''Impulse makeLenses ''Impulse
makeLenses ''Action makeLenses ''Action
+19 -5
View File
@@ -1,15 +1,24 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Ammo where module Dodge.Data.Ammo where
import GHC.Generics
import Data.Aeson
import Dodge.Data.Payload import Dodge.Data.Payload
import Dodge.Data.Bullet import Dodge.Data.Bullet
import Dodge.Data.Gas import Dodge.Data.Gas
import Dodge.Data.Wall import Dodge.Data.Wall
import Control.Lens import Control.Lens
data ProjectileDraw = DrawShell | DrawRemoteShell | DrawDrone | DrawBlankProjectile 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 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 data ProjectileUpdate
= PJThrust {_pjuStart :: Int, _pjuEnd :: Int} = PJThrust {_pjuStart :: Int, _pjuEnd :: Int}
| PJSpin {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int} | PJSpin {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
@@ -18,8 +27,10 @@ data ProjectileUpdate
| PJRemoteDirection {_pjuStart :: Int, _pjuEnd :: Int, _pjuCID :: Int, _pjuITID :: Int} | PJRemoteDirection {_pjuStart :: Int, _pjuEnd :: Int, _pjuCID :: Int, _pjuITID :: Int}
| PJSetScope {_pjuITID :: Int} | PJSetScope {_pjuITID :: Int}
| PJRetireRemote {_pjuITID :: Int, _pjuTimer :: Int, _pjuPJID :: 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 data AmmoType
= ProjectileAmmo = ProjectileAmmo
{ _amPayload :: Payload { _amPayload :: Payload
@@ -41,6 +52,9 @@ data AmmoType
{ _amForceFieldType :: Wall { _amForceFieldType :: Wall
} }
| GenericAmmo | 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 ''ProjectileUpdate
makeLenses ''AmmoType makeLenses ''AmmoType
+11 -2
View File
@@ -1,16 +1,25 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.ArcStep where module Dodge.Data.ArcStep where
import Dodge.Data.CrWlID import Dodge.Data.CrWlID
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
import GHC.Generics
import Data.Aeson
data ArcStep = ArcStep data ArcStep = ArcStep
{ _asPos :: Point2 { _asPos :: Point2
, _asDir :: Float , _asDir :: Float
, _asObject :: CrWlID --Maybe (Either Creature Wall) , _asObject :: CrWlID --Maybe (Either Creature Wall)
} }
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ArcStep where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ArcStep
data NextArcStep = EndArc data NextArcStep = EndArc
| DefaultArcStep | DefaultArcStep
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON NextArcStep where
toEncoding = genericToEncoding defaultOptions
instance FromJSON NextArcStep
makeLenses ''ArcStep makeLenses ''ArcStep
+19 -6
View File
@@ -1,10 +1,12 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Beam where module Dodge.Data.Beam where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Color import Color
import Control.Lens import Control.Lens
{- | Linear beams. Last only one frame. {- | Linear beams. Last only one frame.
- Can interact with one another in a limited manner - Can interact with one another in a limited manner
- can probably be moved to a separate file - can probably be moved to a separate file
@@ -22,22 +24,33 @@ data Beam = Beam
, _bmOrigin :: Maybe Int , _bmOrigin :: Maybe Int
, _bmType :: BeamType , _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 data BeamDraw = BasicBeamDraw
| BeamDrawColor Color | 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 data BeamCombineType = FlameBeamCombine
| LasBeamCombine | LasBeamCombine
| TeslaBeamCombine | TeslaBeamCombine
| SplitBeamCombine | SplitBeamCombine
| NoBeamCombine | NoBeamCombine
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON BeamCombineType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON BeamCombineType
data BeamType data BeamType
= BeamCombine = BeamCombine
{ _beamCombine :: BeamCombineType -- (Point2 , (Point2,Point2,Beam) , (Point2,Point2,Beam)) -> World -> World { _beamCombine :: BeamCombineType -- (Point2 , (Point2,Point2,Beam) , (Point2,Point2,Beam)) -> World -> World
} }
| BeamSimple | 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 ''BeamType
makeLenses ''Beam makeLenses ''Beam
+15 -3
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Block where module Dodge.Data.Block where
import GHC.Generics
import Data.Aeson
import Shape.Data import Shape.Data
import Color import Color
import Dodge.Data.Material import Dodge.Data.Material
@@ -21,13 +24,22 @@ data Block = Block
, _blDraw :: BlockDraw --Block -> SPic , _blDraw :: BlockDraw --Block -> SPic
, _blObstructs :: [(Int,Int,PathEdge)] , _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 data BlockDraw = BlockDrawMempty
| BlockDrawBlSh BlSh | BlockDrawBlSh BlSh
| BlockDraws [BlockDraw] | BlockDraws [BlockDraw]
| BlockDrawColHeightPoss Color Float [Point2] | 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 data BlSh = BlShMempty
| BlShConst Shape | 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 makeLenses ''Block
+7 -1
View File
@@ -1,8 +1,11 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Bounds module Dodge.Data.Bounds
where where
import Control.Lens import Control.Lens
import GHC.Generics
import Data.Aeson
data Bounds = Bounds data Bounds = Bounds
{ _bdMinX :: Float { _bdMinX :: Float
@@ -10,7 +13,10 @@ data Bounds = Bounds
, _bdMinY :: Float , _bdMinY :: Float
, _bdMaxY :: 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
defaultBounds = Bounds 0 0 0 0 defaultBounds = Bounds 0 0 0 0
+31 -7
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Bullet where module Dodge.Data.Bullet where
import GHC.Generics
import Data.Aeson
import Dodge.Data.Damage import Dodge.Data.Damage
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
@@ -18,25 +21,46 @@ data Bullet = Bullet
, _buTimer :: Int , _buTimer :: Int
, _buDamages :: [Damage] , _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 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 data BulletState = NormalBulletState
| DelayedBullet Float | 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 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 data BulletEffect
= DestroyBullet = DestroyBullet
| BounceBullet | BounceBullet
| PenetrateBullet | 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 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 data BulletTrajectory
= BasicBulletTrajectory = BasicBulletTrajectory
| BezierTrajectory Point2 Point2 Point2 | BezierTrajectory Point2 Point2 Point2
| FlechetteTrajectory Point2 | FlechetteTrajectory Point2
| MagnetTrajectory 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 makeLenses ''Bullet
+19 -6
View File
@@ -1,16 +1,21 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Button where module Dodge.Data.Button where
import GHC.Generics
import Data.Aeson
import Dodge.Data.WorldEffect import Dodge.Data.WorldEffect
import Control.Lens import Control.Lens
import Geometry.Data import Geometry.Data
import Sound.Data import Sound.Data
import Color import Color
data ButtonDraw = DefaultDrawButton Color data ButtonDraw = DefaultDrawButton Color
| DefaultDrawSwitch Color Color | DefaultDrawSwitch Color Color
| DrawNoButton | 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 data ButtonEvent = ButtonDoNothing
| ButtonPress | ButtonPress
{_bpState :: ButtonState {_bpState :: ButtonState
@@ -33,8 +38,10 @@ data ButtonEvent = ButtonDoNothing
,_boffEff :: WdWd ,_boffEff :: WdWd
} }
| ButtonAccessTerminal | 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 data Button = Button
{ _btPict :: ButtonDraw --Button -> SPic { _btPict :: ButtonDraw --Button -> SPic
, _btPos :: Point2 , _btPos :: Point2
@@ -47,8 +54,14 @@ data Button = Button
, _btName :: String , _btName :: String
, _btColor :: Color , _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 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 ''Button
makeLenses ''ButtonEvent makeLenses ''ButtonEvent
+7 -1
View File
@@ -1,5 +1,11 @@
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.CamouflageStatus where module Dodge.Data.CamouflageStatus where
import GHC.Generics
import Data.Aeson
data CamouflageStatus data CamouflageStatus
= FullyVisible = FullyVisible
| Invisible | 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
+15 -5
View File
@@ -1,14 +1,18 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Cloud where module Dodge.Data.Cloud where
import GHC.Generics
import Data.Aeson
import Geometry import Geometry
import Color import Color
import Control.Lens import Control.Lens
data CloudDraw = CloudColor Float Float Color -- radius-multiply fade-time color data CloudDraw = CloudColor Float Float Color -- radius-multiply fade-time color
| DrawGasCloud 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 data Cloud = Cloud
{ _clPos :: Point3 { _clPos :: Point3
, _clVel :: Point3 , _clVel :: Point3
@@ -18,9 +22,15 @@ data Cloud = Cloud
, _clTimer :: Int , _clTimer :: Int
, _clType :: CloudType , _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 data CloudType
= SmokeCloud = SmokeCloud
| GasCloud | GasCloud
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON CloudType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON CloudType
makeLenses ''Cloud makeLenses ''Cloud
+11 -2
View File
@@ -1,12 +1,18 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Corpse where module Dodge.Data.Corpse where
import GHC.Generics
import Data.Aeson
import ShapePicture.Data import ShapePicture.Data
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
data CorpseResurrection = NoResurrection 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 data Corpse = Corpse
{ _cpID :: Int { _cpID :: Int
, _cpPos :: Point2 , _cpPos :: Point2
@@ -14,5 +20,8 @@ data Corpse = Corpse
, _cpSPic :: SPic , _cpSPic :: SPic
, _cpRes :: CorpseResurrection , _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 makeLenses ''Corpse
+11 -5
View File
@@ -1,20 +1,26 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.CrGroupParams module Dodge.Data.CrGroupParams
where where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import qualified Data.IntSet as IS import qualified Data.IntSet as IS
import Control.Lens import Control.Lens
data CrGroupParams = CrGroupParams data CrGroupParams = CrGroupParams
{ _crGroupParamID :: Int { _crGroupParamID :: Int
, _crGroupIDs :: IS.IntSet , _crGroupIDs :: IS.IntSet
, _crGroupCenter :: Point2 , _crGroupCenter :: Point2
, _crGroupUpdate :: CrGroupUpdate --World -> CrGroupParams -> Maybe CrGroupParams , _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 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 makeLenses ''CrGroupParams
+7 -1
View File
@@ -1,7 +1,13 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.CrWlID where module Dodge.Data.CrWlID where
import GHC.Generics
import Data.Aeson
import Control.Lens import Control.Lens
data CrWlID = CrID Int | WlID Int | NothingID -- TODO rewrite/remove this 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 makeLenses ''CrWlID
+15 -3
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Creature module Dodge.Data.Creature
@@ -5,6 +6,8 @@ module Dodge.Data.Creature
, module Dodge.Data.Creature.Misc , module Dodge.Data.Creature.Misc
, module Dodge.Data.Creature.State , module Dodge.Data.Creature.State
) where ) where
import GHC.Generics
import Data.Aeson
import Dodge.Data.Creature.Misc import Dodge.Data.Creature.Misc
import Dodge.Data.Creature.State import Dodge.Data.Creature.State
import Dodge.Data.Item import Dodge.Data.Item
@@ -62,14 +65,23 @@ data Creature = Creature
, _crStatistics :: CreatureStatistics , _crStatistics :: CreatureStatistics
, _crCamouflage :: CamouflageStatus , _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 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 data Intention = Intention
{ _targetCr :: Maybe Creature { _targetCr :: Maybe Creature
, _mvToPoint :: Maybe Point2 , _mvToPoint :: Maybe Point2
, _viewPoint :: 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 ''Creature
makeLenses ''Intention makeLenses ''Intention
+27 -13
View File
@@ -1,23 +1,27 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Creature.Misc module Dodge.Data.Creature.Misc
( module Dodge.Data.Creature.Misc ( module Dodge.Data.Creature.Misc
, module Dodge.Data.CamouflageStatus , module Dodge.Data.CamouflageStatus
) where ) where
import GHC.Generics
import Data.Aeson
import Dodge.Data.FloatFunction import Dodge.Data.FloatFunction
import Dodge.Data.CamouflageStatus import Dodge.Data.CamouflageStatus
import Sound.Data import Sound.Data
import Geometry.Data import Geometry.Data
import Color import Color
import Control.Lens import Control.Lens
data CreatureStatistics = CreatureStatistics data CreatureStatistics = CreatureStatistics
{ _strength :: Int { _strength :: Int
, _dexterity :: Int , _dexterity :: Int
, _intelligence :: 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 data Vocalization
= Mute = Mute
| Vocalization | Vocalization
@@ -26,8 +30,10 @@ data Vocalization
,_vcMaxCoolDown :: Int ,_vcMaxCoolDown :: Int
,_vcCoolDown :: 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 data CrMvType
= NoMvType = NoMvType
| MvWalking { _mvSpeed :: Float } | MvWalking { _mvSpeed :: Float }
@@ -37,13 +43,17 @@ data CrMvType
, _mvTurnJit :: Float , _mvTurnJit :: Float
, _mvAimSpeed :: FloatFloat , _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 data HumanoidAI = YourAI | ChaseAI | InanimateAI | SpreadGunAI | PistolAI
| LtAutoAI | LauncherAI | SwarmAI | AutoAI | FlockArmourChaseAI | MiniGunAI | LtAutoAI | LauncherAI | SwarmAI | AutoAI | FlockArmourChaseAI | MiniGunAI
| LongAI | MultGunAI | 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 data CreatureType
= Humanoid = Humanoid
{ _skinHead :: Color { _skinHead :: Color
@@ -55,11 +65,15 @@ data CreatureType
| Lampoid {_lampHeight :: Float, _lampColor :: Point3, _lampLSID :: Maybe Int} | Lampoid {_lampHeight :: Float, _lampColor :: Point3, _lampLSID :: Maybe Int}
| Turretoid | Turretoid
| NonDrawnCreature | 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 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 ''CreatureStatistics
makeLenses ''Vocalization makeLenses ''Vocalization
makeLenses ''CrMvType makeLenses ''CrMvType
+7 -2
View File
@@ -1,14 +1,19 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Creature.State where module Dodge.Data.Creature.State where
import GHC.Generics
import Data.Aeson
import Dodge.Data.Damage import Dodge.Data.Damage
import Dodge.Creature.State.Data import Dodge.Creature.State.Data
import Control.Lens import Control.Lens
data CreatureState = CrSt data CreatureState = CrSt
{ _csDamage :: [Damage] { _csDamage :: [Damage]
, _csSpState :: CrSpState , _csSpState :: CrSpState
, _csDropsOnDeath :: CreatureDropType , _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 makeLenses ''CreatureState
+56 -26
View File
@@ -1,51 +1,81 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.CreatureEffect where module Dodge.Data.CreatureEffect where
import GHC.Generics
import Data.Aeson
data WdCrCr = NoCreatureEffect 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 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 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 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 data CrImp = NoCrImp
| TurnTowardCr Float -- turn amount | 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 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 data WdCrBl = WdCrTrue
| WdCrBlfromCrBl CrBl | WdCrBlfromCrBl CrBl
| WdCrNegate WdCrBl | WdCrNegate WdCrBl
| WdCrLOSTarget | WdCrLOSTarget
| WdCrSafeDistFromTarget Float | 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 data CrBl = CrCanShoot
| CrIsReloading | CrIsReloading
| CrIsAiming | CrIsAiming
| CrIsAnimate | 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 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 data CrAc = CrTurnAround
| CrFleeFromTarget | 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 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 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 data CrWdAc = CrWdBFSThenReturn Int
| ChooseMovementSpreadGun | ChooseMovementSpreadGun
| ChooseMovementLtAuto | ChooseMovementLtAuto
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON CrWdAc where
toEncoding = genericToEncoding defaultOptions
instance FromJSON CrWdAc
+11 -3
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{- {-
@@ -8,6 +9,8 @@ module Dodge.Data.Damage
( module Dodge.Data.Damage ( module Dodge.Data.Damage
, module Dodge.Data.Damage.Type , module Dodge.Data.Damage.Type
) where ) where
import GHC.Generics
import Data.Aeson
import Dodge.Data.Damage.Type import Dodge.Data.Damage.Type
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
@@ -20,14 +23,19 @@ data DamageEffect
| TorqueDamage { _deTorque :: Float } | TorqueDamage { _deTorque :: Float }
| PushBackDamage {_dePushBack :: Float } | PushBackDamage {_dePushBack :: Float }
| NoDamageEffect | 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 data Damage = Damage
{ _dmType :: DamageType { _dmType :: DamageType
, _dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 , _dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2
, _dmEffect :: DamageEffect , _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 :: Damage -> Bool
isElectrical dm = case _dmType dm of isElectrical dm = case _dmType dm of
ELECTRICAL -> True ELECTRICAL -> True
+9 -1
View File
@@ -1,5 +1,8 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Damage.Type where module Dodge.Data.Damage.Type where
import GHC.Generics
import Data.Aeson
data DamageType data DamageType
= PIERCING = PIERCING
| BLUNT | BLUNT
@@ -16,4 +19,9 @@ data DamageType
| PUSHDAM | PUSHDAM
| POISONDAM | POISONDAM
| ENTERREMENT | 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
+15 -5
View File
@@ -1,20 +1,27 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Door where module Dodge.Data.Door where
import GHC.Generics
import Data.Aeson
import Dodge.Data.PathGraph import Dodge.Data.PathGraph
import Dodge.Data.MountedObject import Dodge.Data.MountedObject
import Geometry.Data import Geometry.Data
import Dodge.Data.WorldEffect import Dodge.Data.WorldEffect
import qualified Data.IntSet as IS import qualified Data.IntSet as IS
import Control.Lens import Control.Lens
data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int 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 data PushSource = PushesItself
| PushedBy Int | PushedBy Int
| NotPushed | 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 data Door = Door
{ _drID :: Int { _drID :: Int
, _drWallIDs :: IS.IntSet , _drWallIDs :: IS.IntSet
@@ -33,5 +40,8 @@ data Door = Door
, _drObstructs :: [(Int,Int,PathEdge)] , _drObstructs :: [(Int,Int,PathEdge)]
, _drObstacleType :: EdgeObstacle , _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 makeLenses ''Door
+7 -2
View File
@@ -1,11 +1,13 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.EnergyBall where module Dodge.Data.EnergyBall where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Color import Color
import Dodge.Data.Damage.Type import Dodge.Data.Damage.Type
import Control.Lens import Control.Lens
data EnergyBall = EnergyBall data EnergyBall = EnergyBall
{ _ebVel :: Point2 { _ebVel :: Point2
, _ebColor :: Color , _ebColor :: Color
@@ -16,5 +18,8 @@ data EnergyBall = EnergyBall
, _ebZ :: Float , _ebZ :: Float
, _ebRot :: 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 makeLenses ''EnergyBall
+7 -1
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Flame where module Dodge.Data.Flame where
import GHC.Generics
import Data.Aeson
import Control.Lens import Control.Lens
import Geometry.Data import Geometry.Data
import Color import Color
@@ -13,5 +16,8 @@ data Flame = Flame
, _flZ :: Float , _flZ :: Float
, _flOriginalVel :: Point2 , _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 makeLenses ''Flame
+7 -1
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Flare where module Dodge.Data.Flare where
import GHC.Generics
import Data.Aeson
import Color import Color
import Geometry import Geometry
import Control.Lens import Control.Lens
@@ -17,5 +20,8 @@ data Flare
, _flareTran3 :: Point3 , _flareTran3 :: Point3
, _flareTime :: Int , _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 makeLenses ''Flare
+7 -2
View File
@@ -1,8 +1,13 @@
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.FloatFunction where module Dodge.Data.FloatFunction where
import GHC.Generics
import Data.Aeson
data FloatFloat = FloatID data FloatFloat = FloatID
| FloatFOV Float | FloatFOV Float
| FloatLessCheck Float | FloatLessCheck Float
| FloatAbsCheckGreaterLess Float Float Float | FloatAbsCheckGreaterLess Float Float Float
| FloatConst Float | FloatConst Float
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON FloatFloat where
toEncoding = genericToEncoding defaultOptions
instance FromJSON FloatFloat
+16
View File
@@ -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
+7 -2
View File
@@ -1,10 +1,12 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.ForegroundShape where module Dodge.Data.ForegroundShape where
import GHC.Generics
import Data.Aeson
import Geometry import Geometry
import ShapePicture import ShapePicture
import Control.Lens import Control.Lens
data ForegroundShape = ForegroundShape data ForegroundShape = ForegroundShape
{ _fsID :: Int { _fsID :: Int
, _fsPos :: Point2 , _fsPos :: Point2
@@ -12,5 +14,8 @@ data ForegroundShape = ForegroundShape
, _fsRad :: Float -- This should probably be a bounding box , _fsRad :: Float -- This should probably be a bounding box
, _fsSPic :: SPic , _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 makeLenses ''ForegroundShape
+8 -3
View File
@@ -1,5 +1,10 @@
--{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-}
--{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Gas where module Dodge.Data.Gas where
import GHC.Generics
import Data.Aeson
data GasCreate = CreatePoisonGas | CreateFlame 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
+11 -2
View File
@@ -1,7 +1,10 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.GenParams module Dodge.Data.GenParams
where where
import GHC.Generics
import Data.Aeson
import Color import Color
import Dodge.Data.Damage.Type import Dodge.Data.Damage.Type
import Control.Lens import Control.Lens
@@ -9,7 +12,13 @@ import qualified Data.Map.Strict as M
newtype GenParams = GenParams newtype GenParams = GenParams
{ _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape) { _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 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 makeLenses ''GenParams
+7 -1
View File
@@ -1,7 +1,10 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Gust module Dodge.Data.Gust
where where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
data Gust = Gust data Gust = Gust
@@ -10,5 +13,8 @@ data Gust = Gust
, _guVel :: Point2 , _guVel :: Point2
, _guTime :: Int , _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 makeLenses ''Gust
+15 -7
View File
@@ -1,14 +1,18 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.HUD where module Dodge.Data.HUD where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
data HUDElement data HUDElement
= DisplayInventory {_subInventory :: SubInventory} = DisplayInventory {_subInventory :: SubInventory}
| DisplayCarte | DisplayCarte
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
-- deriving (Eq,Ord,Show) instance ToJSON HUDElement where
toEncoding = genericToEncoding defaultOptions
instance FromJSON HUDElement
data SubInventory data SubInventory
= NoSubInventory = NoSubInventory
| TweakInventory | TweakInventory
@@ -16,16 +20,20 @@ data SubInventory
| InspectInventory | InspectInventory
| LockedInventory | LockedInventory
| DisplayTerminal {_termID :: Int } | DisplayTerminal {_termID :: Int }
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
-- deriving (Eq,Ord,Show) instance ToJSON SubInventory where
toEncoding = genericToEncoding defaultOptions
instance FromJSON SubInventory
data HUD = HUD data HUD = HUD
{ _hudElement :: HUDElement { _hudElement :: HUDElement
, _carteCenter :: Point2 , _carteCenter :: Point2
, _carteZoom :: Float , _carteZoom :: Float
, _carteRot :: 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 ''HUD
makeLenses ''HUDElement makeLenses ''HUDElement
makeLenses ''SubInventory makeLenses ''SubInventory
+11 -4
View File
@@ -1,16 +1,23 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Hammer where module Dodge.Data.Hammer where
import GHC.Generics
import Data.Aeson
import Control.Lens import Control.Lens
data HammerType data HammerType
= NoHammer = NoHammer
| HasHammer {_hammerPosition :: HammerPosition} | HasHammer {_hammerPosition :: HammerPosition}
deriving deriving (Eq, Ord, Show,Read,Generic)
(Eq, Ord, Show,Read) instance ToJSON HammerType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON HammerType
data HammerPosition data HammerPosition
= HammerDown = HammerDown
| HammerReleased | HammerReleased
| HammerUp | HammerUp
deriving deriving (Eq, Ord, Show,Read,Generic)
(Eq, Ord, Show,Read) instance ToJSON HammerPosition where
toEncoding = genericToEncoding defaultOptions
instance FromJSON HammerPosition
makeLenses ''HammerType makeLenses ''HammerType
+19 -5
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.ItEffect where module Dodge.Data.ItEffect where
import GHC.Generics
import Data.Aeson
import Control.Lens import Control.Lens
-- I believe this is called every frame, not sure when though -- I believe this is called every frame, not sure when though
data ItEffect data ItEffect
@@ -27,8 +30,10 @@ data ItEffect
, _ieDrop :: ItDropEffect --Item -> Creature -> World -> World , _ieDrop :: ItDropEffect --Item -> Creature -> World -> World
, _ieMID :: Maybe Int , _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 data ItInvEffect = NoInvEffect
| RewindEffect | RewindEffect
| ResetAttachmentEffect | ResetAttachmentEffect
@@ -36,9 +41,18 @@ data ItInvEffect = NoInvEffect
| CreateHeldLight | CreateHeldLight
| CreateShieldWall | CreateShieldWall
| RemoveShieldWall | 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 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 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 makeLenses ''ItEffect
+11 -2
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Item module Dodge.Data.Item
@@ -7,6 +8,8 @@ module Dodge.Data.Item
, module Dodge.Data.Item.Params , module Dodge.Data.Item.Params
, module Dodge.Data.Item.Use , module Dodge.Data.Item.Use
) where ) where
import GHC.Generics
import Data.Aeson
import Control.Lens import Control.Lens
import Dodge.Data.Item.Misc import Dodge.Data.Item.Misc
import Dodge.Data.Item.Tweak import Dodge.Data.Item.Tweak
@@ -40,13 +43,19 @@ data Item = Item
, _itValue :: ItemValue , _itValue :: ItemValue
, _itParams :: ItemParams , _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 data ItemTweaks
= NoTweaks = NoTweaks
| Tweakable | Tweakable
{ _tweakParams :: IM.IntMap TweakParam { _tweakParams :: IM.IntMap TweakParam
, _tweakSel :: Int , _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 ''Item
makeLenses ''ItemTweaks makeLenses ''ItemTweaks
+7 -1
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Item.Consumption where module Dodge.Data.Item.Consumption where
import GHC.Generics
import Data.Aeson
import Control.Lens import Control.Lens
import Dodge.Data.Ammo import Dodge.Data.Ammo
import Dodge.Data.LoadAction import Dodge.Data.LoadAction
@@ -28,5 +31,8 @@ data ItemConsumption
{ _icAmount :: IcAmount { _icAmount :: IcAmount
} }
| NoConsumption | NoConsumption
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItemConsumption where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItemConsumption
makeLenses ''ItemConsumption makeLenses ''ItemConsumption
+8 -3
View File
@@ -1,5 +1,10 @@
--{-# LANGUAGE StrictData #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Item.HeldScroll where module Dodge.Data.Item.HeldScroll where
import GHC.Generics
import Data.Aeson
data HeldScroll = HeldScrollDoNothing | HeldScrollZoom | HeldScrollCharMode 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
+24 -9
View File
@@ -1,7 +1,10 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.Item.HeldUse where module Dodge.Data.Item.HeldUse where
import GHC.Generics
import Data.Aeson
import Dodge.Combine.Data import Dodge.Combine.Data
import Dodge.Data.CamouflageStatus import Dodge.Data.CamouflageStatus
data HeldUse = HeldDoNothing data HeldUse = HeldDoNothing
| HeldUseAmmoParams | HeldUseAmmoParams
| HeldOverNozzlesUseGasParams | HeldOverNozzlesUseGasParams
@@ -17,12 +20,16 @@ data HeldUse = HeldDoNothing
| HeldTractor | HeldTractor
| HeldForceField | HeldForceField
| HeldShatter | 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 data Cuse = CDoNothing
| CHeal Int | 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 data Euse = EDoNothing
| EDetector Detector | EDetector Detector
| EMagShield | EMagShield
@@ -33,15 +40,20 @@ data Euse = EDoNothing
| EonWristShield | EonWristShield
| EoffWristShield | 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 data Luse = LDoNothing
| LRewind | LRewind
| LShrink | LShrink
| LBlink | LBlink
| LUnsafeBlink | LUnsafeBlink
| LBoost | 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 data HeldMod = HeldModNothing
| PoisonSprayerMod | PoisonSprayerMod
| FlameSpitterMod | FlameSpitterMod
@@ -74,4 +86,7 @@ data HeldMod = HeldModNothing
| SmgMod | SmgMod
| RevolverXMod | RevolverXMod
| BangConeMod | BangConeMod
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON HeldMod where
toEncoding = genericToEncoding defaultOptions
instance FromJSON HeldMod
+23 -7
View File
@@ -1,15 +1,20 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Item.Misc where module Dodge.Data.Item.Misc where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
data ItemDimension = ItemDimension data ItemDimension = ItemDimension
{ _dimRad :: Float { _dimRad :: Float
, _dimCenter :: Point3 , _dimCenter :: Point3
, _dimAttachPos :: 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 data ItemPortage
= HeldItem = HeldItem
{ _handlePos :: Float { _handlePos :: Float
@@ -17,20 +22,31 @@ data ItemPortage
} }
| WornItem | WornItem
| NoPortage | 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 data ItemValue = ItemValue
{ _ivInt :: Int { _ivInt :: Int
, _ivType :: ItemValueType , _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 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 data ItemPos
= InInv { _ipCrID :: Int , _ipInvID :: Int } = InInv { _ipCrID :: Int , _ipInvID :: Int }
| OnFloor { _ipFlID :: Int } | OnFloor { _ipFlID :: Int }
| VoidItm | 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 ''ItemDimension
makeLenses ''ItemPortage makeLenses ''ItemPortage
makeLenses ''ItemValue makeLenses ''ItemValue
+25 -7
View File
@@ -1,12 +1,14 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Item.Params where module Dodge.Data.Item.Params where
import GHC.Generics
import Data.Aeson
import Dodge.Data.Beam import Dodge.Data.Beam
import Dodge.Data.ArcStep import Dodge.Data.ArcStep
import Geometry.Data import Geometry.Data
import Color import Color
import Control.Lens import Control.Lens
data ItemParams data ItemParams
= NoParams = NoParams
| ShellLauncher | ShellLauncher
@@ -55,9 +57,15 @@ data ItemParams
, _previousArcEffect :: PreviousArcEffect , _previousArcEffect :: PreviousArcEffect
} }
| ParamMID {_paramMID :: Maybe Int} | 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 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 data GunBarrels
= MultiBarrel = MultiBarrel
{ _brlSpread :: BarrelSpread { _brlSpread :: BarrelSpread
@@ -69,7 +77,10 @@ data GunBarrels
, _brlInaccuracy :: Float , _brlInaccuracy :: Float
} }
| SingleBarrel {_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 data Nozzle = Nozzle
{ _nzPressure :: Float { _nzPressure :: Float
, _nzDir :: Float , _nzDir :: Float
@@ -78,12 +89,19 @@ data Nozzle = Nozzle
, _nzWalkSpeed :: Float , _nzWalkSpeed :: Float
, _nzLength :: 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 data BarrelSpread
= AlignedBarrels = AlignedBarrels
| SpreadBarrels {_spreadAngle :: Float} | SpreadBarrels {_spreadAngle :: Float}
| RotatingBarrels {_rotatingBarrelInaccuracy :: 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 ''BarrelSpread
makeLenses ''ItemParams makeLenses ''ItemParams
makeLenses ''Nozzle
makeLenses ''GunBarrels
+11 -2
View File
@@ -1,17 +1,26 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Item.Tweak where module Dodge.Data.Item.Tweak where
import GHC.Generics
import Data.Aeson
import Control.Lens import Control.Lens
data TweakType = TweakPhaseV data TweakType = TweakPhaseV
| TweakTractionPower | TweakTractionPower
| TweakSpinDrag | TweakSpinDrag
| TweakSpinAmount | TweakSpinAmount
| TweakThrustDelay | 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 data TweakParam = TweakParam
{ _tweakType :: TweakType -- Int -> Item -> Item { _tweakType :: TweakType -- Int -> Item -> Item
, _tweakVal :: Int , _tweakVal :: Int
, _tweakMax :: 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 makeLenses ''TweakParam
+28 -9
View File
@@ -1,13 +1,15 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Item.Use where module Dodge.Data.Item.Use where
import GHC.Generics
import Data.Aeson
import Dodge.Data.Item.HeldUse import Dodge.Data.Item.HeldUse
import Dodge.Data.Item.HeldScroll import Dodge.Data.Item.HeldScroll
import Dodge.Data.Item.UseDelay import Dodge.Data.Item.UseDelay
import Dodge.Data.Hammer import Dodge.Data.Hammer
import Dodge.Equipment.Data import Dodge.Equipment.Data
import Control.Lens import Control.Lens
data ItemUse data ItemUse
= RightUse = RightUse
{ _rUse :: HeldUse -- Item -> Creature -> World -> World { _rUse :: HeldUse -- Item -> Creature -> World -> World
@@ -30,7 +32,10 @@ data ItemUse
{ _eqEq :: Equipment { _eqEq :: Equipment
} }
| NoUse | 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 data Equipment = Equipment
{ _eqUse :: Euse --Item -> Creature -> World -> World { _eqUse :: Euse --Item -> Creature -> World -> World
, _eqOnEquip :: Euse --Item -> Creature -> World -> World , _eqOnEquip :: Euse --Item -> Creature -> World -> World
@@ -39,7 +44,10 @@ data Equipment = Equipment
, _eqParams :: EquipParams , _eqParams :: EquipParams
, _eqViewDist :: Maybe Float , _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 data AimParams = AimParams
{ _aimWeight :: Int { _aimWeight :: Int
, _aimRange :: Float , _aimRange :: Float
@@ -48,27 +56,38 @@ data AimParams = AimParams
, _aimHandlePos :: Float , _aimHandlePos :: Float
, _aimMuzPos :: 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 data AimStance
= TwoHandTwist = TwoHandTwist
| TwoHandFlat | TwoHandFlat
| OneHand | OneHand
| LeaveHolstered | LeaveHolstered
deriving deriving (Eq,Show,Ord,Enum,Read,Generic)
(Eq,Show,Ord,Enum,Read) instance ToJSON AimStance where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AimStance
data EquipParams data EquipParams
= NoEquipParams = NoEquipParams
| EquipID {_eparamID :: Int} | EquipID {_eparamID :: Int}
| EquipCounter {_eparamInt :: 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 data ItZoom = ItZoom
{ _itZoomMax :: Float { _itZoomMax :: Float
, _itZoomMin :: Float , _itZoomMin :: Float
, _itZoomFac :: 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 ''ItemUse
makeLenses ''Equipment
makeLenses ''AimParams makeLenses ''AimParams
makeLenses ''EquipParams makeLenses ''EquipParams
makeLenses ''ItZoom makeLenses ''ItZoom
+7 -1
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.UseDelay where module Dodge.Data.Item.UseDelay where
import GHC.Generics
import Data.Aeson
import Control.Lens import Control.Lens
data UseDelay -- should just be Delay data UseDelay -- should just be Delay
= NoDelay = NoDelay
@@ -18,5 +21,8 @@ data UseDelay -- should just be Delay
{_warmTime :: Int {_warmTime :: Int
,_warmMax :: 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 makeLenses ''UseDelay
+7 -4
View File
@@ -1,7 +1,10 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Dodge.Data.ItemAmount where module Dodge.Data.ItemAmount where
import GHC.Generics
import Data.Aeson
newtype IcAmount = IcAmount {_toInt :: Int} newtype IcAmount = IcAmount {_toInt :: Int}
deriving (Eq,Ord,Num,Integral,Real,Enum,Read) deriving (Eq,Ord,Num,Integral,Real,Enum,Read,Show,Generic)
instance Show IcAmount where instance ToJSON IcAmount where
show (IcAmount i) = 'x':show i toEncoding = genericToEncoding defaultOptions
instance FromJSON IcAmount
+15 -6
View File
@@ -1,15 +1,19 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Laser module Dodge.Data.Laser
where where
import GHC.Generics
import Data.Aeson
import Color import Color
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
data LaserType = DamageLaser {_laserTypeDamage :: Int} data LaserType = DamageLaser {_laserTypeDamage :: Int}
| TargetLaser | 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 data LaserStart = LaserStart
{ _lpPhaseV :: Float { _lpPhaseV :: Float
, _lpPos :: Point2 , _lpPos :: Point2
@@ -17,14 +21,19 @@ data LaserStart = LaserStart
, _lpColor :: Color , _lpColor :: Color
, _lpType :: LaserType , _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 data Laser = Laser
{ _laColor :: Color { _laColor :: Color
, _laPoints :: [Point2] , _laPoints :: [Point2]
, _laType :: LaserType , _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 ''Laser
makeLenses ''LaserStart makeLenses ''LaserStart
makeLenses ''LaserType makeLenses ''LaserType
+27 -6
View File
@@ -1,37 +1,58 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.LightSource where module Dodge.Data.LightSource where
import GHC.Generics
import Data.Aeson
import Geometry import Geometry
import Control.Lens import Control.Lens
data LightSourceDraw = DefaultLightSourceDraw 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 data TLSIntensity = ConstantIntensity
| TLSFade Point3 Int | 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 data TLSUpdate = DestroyTLS
| TimerTLS | TimerTLS
| IntensityTLS TLSIntensity | 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 data LSParam = LSParam
{ _lsPos :: !Point3 { _lsPos :: !Point3
, _lsRad :: !Float , _lsRad :: !Float
, _lsCol :: !Point3 , _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 data LightSource = LS
{ _lsID :: Int { _lsID :: Int
, _lsParam :: LSParam , _lsParam :: LSParam
, _lsDir :: Float , _lsDir :: Float
, _lsPict :: LightSourceDraw --LightSource -> Picture , _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 data TempLightSource = TLS
{ _tlsParam :: LSParam { _tlsParam :: LSParam
, _tlsUpdate :: TLSUpdate --TempLightSource -> Maybe TempLightSource , _tlsUpdate :: TLSUpdate --TempLightSource -> Maybe TempLightSource
, _tlsTime :: Int , _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 ''LSParam
makeLenses ''LightSource makeLenses ''LightSource
makeLenses ''TempLightSource makeLenses ''TempLightSource
+7 -1
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.LinearShockwave where module Dodge.Data.LinearShockwave where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
data LinearShockwave = LinearShockwave data LinearShockwave = LinearShockwave
@@ -9,5 +12,8 @@ data LinearShockwave = LinearShockwave
, _lwPoints :: [(Point2,Point2)] , _lwPoints :: [(Point2,Point2)]
, _lwTimer :: Int , _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 makeLenses ''LinearShockwave
+15 -3
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.LoadAction where module Dodge.Data.LoadAction where
import GHC.Generics
import Data.Aeson
import Sound.Data import Sound.Data
import Dodge.Data.Hammer import Dodge.Data.Hammer
import Control.Lens import Control.Lens
@@ -9,13 +12,22 @@ data LoadAction
| LoadInsert {_actionTime :: Int, _actionSound :: SoundID} | LoadInsert {_actionTime :: Int, _actionSound :: SoundID}
| LoadAdd {_actionTime :: Int, _actionSound :: SoundID, _insertMax :: Int } | LoadAdd {_actionTime :: Int, _actionSound :: SoundID, _insertMax :: Int }
| LoadPrime {_actionTime :: Int, _actionSound :: SoundID} | 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 } 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 data InvSelAction
= NoInvSelAction = NoInvSelAction
| ReloadAction { _actionProgress :: Int, _reloadAction :: LoadAction, _actionHammer :: HammerType} | 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 ''LoadAction
makeLenses ''InvSel makeLenses ''InvSel
makeLenses ''InvSelAction makeLenses ''InvSelAction
+16 -6
View File
@@ -1,7 +1,10 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Machine module Dodge.Data.Machine
where where
import GHC.Generics
import Data.Aeson
import Dodge.Data.GenParams import Dodge.Data.GenParams
import Dodge.Data.Item import Dodge.Data.Item
import Sound.Data import Sound.Data
@@ -12,15 +15,16 @@ import Geometry.Data
import Color import Color
import Dodge.Data.Material import Dodge.Data.Material
import qualified Data.IntSet as IS import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Control.Lens import Control.Lens
data MachineDraw = MachineDrawMempty data MachineDraw = MachineDrawMempty
| MachineDrawTerminal | MachineDrawTerminal
| MachineDrawTurret | MachineDrawTurret
| MachineDrawDamageSensor Float (PaletteColor,DecorationShape) | 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 data Machine = Machine
{ _mcID :: Int { _mcID :: Int
, _mcWallIDs :: IS.IntSet , _mcWallIDs :: IS.IntSet
@@ -33,11 +37,14 @@ data Machine = Machine
, _mcSensor :: Sensor , _mcSensor :: Sensor
, _mcDamage :: [Damage] , _mcDamage :: [Damage]
, _mcType :: MachineType , _mcType :: MachineType
, _mcMounts :: M.Map Object Int , _mcMounts :: M.Map ObjectType Int
, _mcName :: String , _mcName :: String
, _mcCloseSound :: Maybe SoundID , _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 data MachineType
= StaticMachine = StaticMachine
| Turret | Turret
@@ -46,6 +53,9 @@ data MachineType
, _tuFireTime :: Int , _tuFireTime :: Int
, _tuMCrID :: Maybe 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 ''Machine
makeLenses ''MachineType makeLenses ''MachineType
+15 -5
View File
@@ -1,20 +1,30 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Magnet where module Dodge.Data.Magnet where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
newtype MagnetUpdate = MagnetUpdateTimer Int 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 data MagnetBuBu = MagnetBuId
| MagnetBuBuCurveAroundField Float Float | 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 data Magnet = Magnet
{ _mgID :: Int { _mgID :: Int
, _mgUpdate :: MagnetUpdate , _mgUpdate :: MagnetUpdate
, _mgPos :: Point2 , _mgPos :: Point2
, _mgField :: MagnetBuBu , _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 makeLenses ''Magnet
+7 -2
View File
@@ -1,7 +1,12 @@
--{-# LANGUAGE TemplateHaskell #-} --{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
--{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.Material where module Dodge.Data.Material where
import GHC.Generics
import Data.Aeson
data Material = Wood | Dirt | Stone | Glass | Metal | Crystal | Flesh | Electronics 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
+7 -2
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Modification module Dodge.Data.Modification
@@ -6,7 +7,8 @@ module Dodge.Data.Modification
import Dodge.Data.WorldEffect import Dodge.Data.WorldEffect
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
import GHC.Generics
import Data.Aeson
data Modification data Modification
= ModIDTimerPoint3Bool = ModIDTimerPoint3Bool
{ _mdID :: Int { _mdID :: Int
@@ -22,5 +24,8 @@ data Modification
, _mdExternalID2 :: Int , _mdExternalID2 :: Int
, _mdUpdate :: MdWdWd , _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 makeLenses ''Modification
+7 -3
View File
@@ -1,9 +1,13 @@
--{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.MountedObject module Dodge.Data.MountedObject
where where
import GHC.Generics
import Data.Aeson
data MountedObject data MountedObject
= MountedLS Int = MountedLS Int
| MountedProp Int | MountedProp Int
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON MountedObject where
toEncoding = genericToEncoding defaultOptions
instance FromJSON MountedObject
+11 -3
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.Object where module Dodge.Data.Object where
import GHC.Generics
data Object import Data.Aeson
data ObjectType
= ObTerminal = ObTerminal
| ObCreature | ObCreature
| ObMachine | ObMachine
@@ -12,4 +15,9 @@ data Object
| ObProp | ObProp
| ObTrigger | ObTrigger
| ObItem | 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
+23 -4
View File
@@ -1,6 +1,14 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# 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 module Dodge.Data.PathGraph where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
import Data.Graph.Inductive import Data.Graph.Inductive
@@ -12,20 +20,31 @@ data PathGraph = PathGraph
, _pgNodeCount :: Int , _pgNodeCount :: Int
, _pgEdgeMap :: Map (V2 Point2) (Int,Int,PathEdge) , _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 data PathEdge = PathEdge
{_peStart :: Point2 {_peStart :: Point2
,_peEnd :: Point2 ,_peEnd :: Point2
,_peDist :: Float ,_peDist :: Float
,_peObstacles :: Set.Set EdgeObstacle ,_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 data EdgeObstacle
= BlockObstacle = BlockObstacle
| DoorObstacle | DoorObstacle
| AutoDoorObstacle | AutoDoorObstacle
| WallObstacle | 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 ''PathGraph
makeLenses ''PathEdge makeLenses ''PathEdge
+7 -1
View File
@@ -1,5 +1,11 @@
{-# LANGUAGE DeriveGeneric #-}
--{-# LANGUAGE TemplateHaskell #-} --{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Payload where module Dodge.Data.Payload where
import GHC.Generics
import Data.Aeson
data Payload = ExplosionPayload | DudPayload 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
+11 -3
View File
@@ -1,15 +1,23 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.PosEvent where module Dodge.Data.PosEvent where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
data PosEventType = SparkSpawner 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 data PosEvent = PosEvent
{ _pvType :: PosEventType { _pvType :: PosEventType
, _pvTimer :: Int , _pvTimer :: Int
, _pvPos :: Point2 , _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 makeLenses ''PosEvent
+11 -2
View File
@@ -1,13 +1,19 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.PressPlate module Dodge.Data.PressPlate
where where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Picture import Picture
import Control.Lens import Control.Lens
data PressPlateEvent = PressPlateId data PressPlateEvent = PressPlateId
| PPLevelReset | 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 data PressPlate = PressPlate
{ _ppPict :: Picture { _ppPict :: Picture
, _ppPos :: Point2 , _ppPos :: Point2
@@ -16,5 +22,8 @@ data PressPlate = PressPlate
, _ppID :: Int , _ppID :: Int
, _ppText :: String , _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 makeLenses ''PressPlate
+8 -3
View File
@@ -1,12 +1,14 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Projectile where module Dodge.Data.Projectile where
import GHC.Generics
import Data.Aeson
import Dodge.Data.Payload import Dodge.Data.Payload
import Dodge.Data.Ammo import Dodge.Data.Ammo
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
--data ProjectileType = ShellType
data ProjectileType = ShellType
data Proj data Proj
= RemoteShell = RemoteShell
{ _prjPos :: Point2 { _prjPos :: Point2
@@ -32,5 +34,8 @@ data Proj
, _prjUpdates :: [ProjectileUpdate] , _prjUpdates :: [ProjectileUpdate]
, _prjMITID :: Maybe Int , _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 makeLenses ''Proj
+20 -6
View File
@@ -1,15 +1,17 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Prop module Dodge.Data.Prop
where where
import GHC.Generics
import Data.Aeson
import Dodge.Data.WorldEffect import Dodge.Data.WorldEffect
import Shape.Data import Shape.Data
import Color import Color
import qualified Linear.Quaternion as Q import qualified Quaternion as Q
import Geometry.Data import Geometry.Data
import ShapePicture.Data import ShapePicture.Data
import Control.Lens import Control.Lens
data PropDraw = PropDrawSPic SPic data PropDraw = PropDrawSPic SPic
| PropDrawMovingShapeCol Shape | PropDrawMovingShapeCol Shape
| PropDrawMovingShape PropDraw | PropDrawMovingShape PropDraw
@@ -19,7 +21,10 @@ data PropDraw = PropDrawSPic SPic
| PropLampCover Float | PropLampCover Float
| PropDrawToggle PropDraw | PropDrawToggle PropDraw
| PropDrawGib Float | 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 data PropUpdate -- = UpdatePropZ
= PropUpdateAnd PropUpdate PropUpdate = PropUpdateAnd PropUpdate PropUpdate
-- | UpdateShapeProp -- | UpdateShapeProp
@@ -33,11 +38,17 @@ data PropUpdate -- = UpdatePropZ
| PropUpdatePosition WdP2f | PropUpdatePosition WdP2f
| PropUpdateWhen WdBl PropUpdate | PropUpdateWhen WdBl PropUpdate
| PropUpdateIf WdBl PropUpdate 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 data PrWdLsLs = PrWdLsId
| PrWdLsSetPosition WdP2f Point3 | PrWdLsSetPosition WdP2f Point3
| PrWdLsSetColor 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 data Prop
= PropZ = PropZ
{ _prPos :: Point2 { _prPos :: Point2
@@ -61,5 +72,8 @@ data Prop
, _prRot :: Float , _prRot :: Float
, _prToggle :: Bool , _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 makeLenses ''Prop
+7 -1
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.RadarBlip where module Dodge.Data.RadarBlip where
import GHC.Generics
import Data.Aeson
import Color import Color
import Geometry import Geometry
import Control.Lens import Control.Lens
@@ -11,5 +14,8 @@ data RadarBlip = RadarBlip
, _rbRad :: Float , _rbRad :: Float
, _rbPos :: Point2 , _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 makeLenses ''RadarBlip
+8 -3
View File
@@ -1,15 +1,20 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.RadarSweep where module Dodge.Data.RadarSweep where
import GHC.Generics
import Data.Aeson
import Dodge.Data.Object import Dodge.Data.Object
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
data RadarSweep = RadarSweep data RadarSweep = RadarSweep
{ _rsPos :: Point2 { _rsPos :: Point2
, _rsRad :: Float , _rsRad :: Float
, _rsObject :: Object , _rsObject :: ObjectType
, _rsTimer :: Int , _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 makeLenses ''RadarSweep
+15 -3
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.RightButtonOptions where module Dodge.Data.RightButtonOptions where
import GHC.Generics
import Data.Aeson
import Dodge.Equipment.Data import Dodge.Equipment.Data
import Control.Lens import Control.Lens
@@ -13,13 +16,19 @@ data RightButtonOptions
,_opAllocateEquipment :: AllocateEquipment ,_opAllocateEquipment :: AllocateEquipment
,_opActivateEquipment :: ActivateEquipment ,_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 data ActivateEquipment
= ActivateEquipment {_activateEquipment :: Int } = ActivateEquipment {_activateEquipment :: Int }
| DeactivateEquipment {_deactivateEquipment :: Int} | DeactivateEquipment {_deactivateEquipment :: Int}
| ActivateDeactivateEquipment {_activateEquipment :: Int ,_deactivateEquipment :: Int} | ActivateDeactivateEquipment {_activateEquipment :: Int ,_deactivateEquipment :: Int}
| NoChangeActivateEquipment | NoChangeActivateEquipment
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ActivateEquipment where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ActivateEquipment
data AllocateEquipment data AllocateEquipment
= DoNotMoveEquipment = DoNotMoveEquipment
| PutOnEquipment | PutOnEquipment
@@ -41,7 +50,10 @@ data AllocateEquipment
| RemoveEquipment | RemoveEquipment
{ _allocOldPos :: EquipPosition { _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 ''RightButtonOptions
makeLenses ''AllocateEquipment makeLenses ''AllocateEquipment
makeLenses ''ActivateEquipment makeLenses ''ActivateEquipment
+15 -4
View File
@@ -1,10 +1,12 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Sensor where module Dodge.Data.Sensor where
import GHC.Generics
import Data.Aeson
import Dodge.Combine.Data import Dodge.Combine.Data
import Dodge.Data.Damage.Type import Dodge.Data.Damage.Type
import Control.Lens import Control.Lens
data Sensor = NoSensor data Sensor = NoSensor
| DamageSensor | DamageSensor
{ _sensToggle :: Bool { _sensToggle :: Bool
@@ -17,13 +19,22 @@ data Sensor = NoSensor
, _proxRequirement :: ProximityRequirement , _proxRequirement :: ProximityRequirement
, _sensToggle :: Bool , _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 data ProximityRequirement
= RequireHealth {_proxReqMinHealth :: Int} = RequireHealth {_proxReqMinHealth :: Int}
| RequireEquipment {_proxReqEquipment :: ItemBaseType} | RequireEquipment {_proxReqEquipment :: ItemBaseType}
| RequireImpossible | 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 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 ''Sensor
makeLenses ''ProximityRequirement makeLenses ''ProximityRequirement
+11 -2
View File
@@ -1,12 +1,18 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Shockwave module Dodge.Data.Shockwave
where where
import GHC.Generics
import Data.Aeson
import Color import Color
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
data ShockwaveDirection = OutwardShockwave | InwardShockwave 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 data Shockwave = Shockwave
{ _swColor :: Color { _swColor :: Color
, _swDirection :: ShockwaveDirection , _swDirection :: ShockwaveDirection
@@ -18,5 +24,8 @@ data Shockwave = Shockwave
, _swMaxTime :: Int , _swMaxTime :: Int
, _swTimer :: 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 makeLenses ''Shockwave
+8 -2
View File
@@ -1,6 +1,10 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.SoundOrigin module Dodge.Data.SoundOrigin
where where
import Dodge.Data.Material import Dodge.Data.Material
import GHC.Generics
import Data.Aeson
data SoundOrigin = InventorySound data SoundOrigin = InventorySound
| BackgroundSound | BackgroundSound
| OnceSound | OnceSound
@@ -26,5 +30,7 @@ data SoundOrigin = InventorySound
| LeverSound Int | LeverSound Int
| Explosion Int | Explosion Int
| Tap Int | Tap Int
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON SoundOrigin where
toEncoding = genericToEncoding defaultOptions
instance FromJSON SoundOrigin
+7 -1
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Spark where module Dodge.Data.Spark where
import GHC.Generics
import Data.Aeson
import Dodge.Data.Damage.Type import Dodge.Data.Damage.Type
import Geometry.Data import Geometry.Data
import Color import Color
@@ -13,5 +16,8 @@ data Spark = Spark
, _skWidth :: Float , _skWidth :: Float
, _skDamageType :: DamageType , _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 makeLenses ''Spark
+15 -3
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Targeting where module Dodge.Data.Targeting where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
data Targeting data Targeting
@@ -12,16 +15,25 @@ data Targeting
, _tgID :: Maybe Int , _tgID :: Maybe Int
, _tgActive :: Bool , _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 data TargetUpdate = NoTargetUpdate
| TargetLaserUpdate | TargetLaserUpdate
| TargetRBPressUpdate | TargetRBPressUpdate
| TargetRBCreatureUpdate | TargetRBCreatureUpdate
| TargetCursorUpdate | 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 data TargetDraw = NoTargetDraw
| TargetDistanceDraw | TargetDistanceDraw
| SimpleDrawTarget | SimpleDrawTarget
| TargetRBCreatureDraw | TargetRBCreatureDraw
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TargetDraw where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TargetDraw
makeLenses ''Targeting makeLenses ''Targeting
+54 -16
View File
@@ -1,23 +1,35 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.Terminal module Dodge.Data.Terminal
where where
import GHC.Generics
import Data.Aeson
import Dodge.Data.WorldEffect import Dodge.Data.WorldEffect
import Color import Color
import Control.Lens import Control.Lens
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady 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 data TerminalInput = TerminalInput
{ _tiText :: T.Text { _tiText :: T.Text
, _tiFocus :: Bool , _tiFocus :: Bool
, _tiSel :: (Int,Int) , _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 data TerminalBootProgram = TerminalBootMempty
| TerminalBootLines [TerminalLine] | 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 data Terminal = Terminal
{ _tmID :: Int { _tmID :: Int
, _tmBootProgram :: TerminalBootProgram -- Terminal -> World -> [TerminalLine] , _tmBootProgram :: TerminalBootProgram -- Terminal -> World -> [TerminalLine]
@@ -36,13 +48,22 @@ data Terminal = Terminal
, _tmCommandHistory :: [String] , _tmCommandHistory :: [String]
, _tmToggles :: M.Map String TerminalToggle , _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 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 data TmTm = TmId
| TmTmClearDisplayedLines | TmTmClearDisplayedLines
| TmTmSetStatus TerminalStatus | 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 data TerminalLine
= TerminalLineDisplay = TerminalLineDisplay
{_tlPause :: Int {_tlPause :: Int
@@ -56,25 +77,35 @@ data TerminalLine
{_tlPause :: Int {_tlPause :: Int
,_tlEffect :: TmWdWd --Terminal -> World -> World ,_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 data TerminalToggle = TerminalToggle
{ _ttTriggerID :: Int { _ttTriggerID :: Int
, _ttDeathEffect :: BlBl , _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 data BlBl = BlNegate
| BlConst Bool | BlConst Bool
| BlId | BlId
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON BlBl where
toEncoding = genericToEncoding defaultOptions
instance FromJSON BlBl
data EffectArguments data EffectArguments
= NoArguments {_cmdEffect :: [TerminalLine]} = NoArguments {_cmdEffect :: [TerminalLine]}
| OneArgument | OneArgument
{_argType :: String {_argType :: String
,_argList :: M.Map String [TerminalLine] ,_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 data TerminalCommandEffect = TerminalCommandArguments EffectArguments
| TerminalCommandEffectDamageCoding | TerminalCommandEffectDamageCoding
| TerminalCommandEffectSensorParameter | TerminalCommandEffectSensorParameter
@@ -84,16 +115,23 @@ data TerminalCommandEffect = TerminalCommandArguments EffectArguments
| TerminalCommandEffectCommands | TerminalCommandEffectCommands
| TerminalCommandEffectSingleCommand WdWd [String] | TerminalCommandEffectSingleCommand WdWd [String]
| TerminalCommandEffectNone | 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 data TerminalCommand = TerminalCommand
{ _tcString :: String { _tcString :: String
, _tcAlias :: [String] , _tcAlias :: [String]
, _tcHelp :: String , _tcHelp :: String
, _tcEffect :: TerminalCommandEffect -- Terminal -> World -> EffectArguments , _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 ''Terminal
makeLenses ''TerminalLine makeLenses ''TerminalLine
makeLenses ''TerminalToggle
makeLenses ''EffectArguments
makeLenses ''TerminalCommand makeLenses ''TerminalCommand
makeLenses ''TerminalInput
+7 -1
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.TeslaArc where module Dodge.Data.TeslaArc where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Color import Color
import Control.Lens import Control.Lens
@@ -11,5 +14,8 @@ data TeslaArc = TeslaArc
, _taArcSteps :: [ArcStep] , _taArcSteps :: [ArcStep]
, _taColor :: Color , _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 makeLenses ''TeslaArc
+7 -1
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Data.TractorBeam where module Dodge.Data.TractorBeam where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
data TractorBeam = TractorBeam data TractorBeam = TractorBeam
@@ -9,5 +12,8 @@ data TractorBeam = TractorBeam
, _tbVel :: Point2 , _tbVel :: Point2
, _tbTime :: Int , _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 makeLenses ''TractorBeam
+19 -5
View File
@@ -3,6 +3,8 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.Wall where module Dodge.Data.Wall where
import GHC.Generics
import Data.Aeson
import Dodge.Data.Material import Dodge.Data.Material
import Geometry import Geometry
import Color import Color
@@ -26,15 +28,24 @@ data Wall = Wall
, _wlHeight :: Float , _wlHeight :: Float
, _wlMaterial :: Material , _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 data Opacity
= SeeThrough = SeeThrough
| SeeAbove | SeeAbove
| DrawnWall {_opDraw :: WallDraw } -- Wall -> SPic | DrawnWall {_opDraw :: WallDraw } -- Wall -> SPic
| Opaque | 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 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 data WallStructure
= StandaloneWall = StandaloneWall
| DoorPart { _wsDoor :: Int } | DoorPart { _wsDoor :: Int }
@@ -44,7 +55,10 @@ data WallStructure
{ _wlStCreature :: Int { _wlStCreature :: Int
-- , _wlStDamCreature :: Damage -> Wall -> Int -> World -> World -- , _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 ''Wall
makeLenses ''WallStructure
makeLenses ''Opacity makeLenses ''Opacity
makeLenses ''WallStructure
+34 -7
View File
@@ -1,4 +1,10 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.WorldEffect where module Dodge.Data.WorldEffect where
import Data.Aeson
import GHC.Generics
import Dodge.Data.CreatureEffect import Dodge.Data.CreatureEffect
import Sound.Data import Sound.Data
import Geometry.Data import Geometry.Data
@@ -13,15 +19,24 @@ data WdWd = NoWorldEffect
| MakeStartCloudAt Point3 | MakeStartCloudAt Point3
| TorqueCr Float Int | TorqueCr Float Int
| WdWdNegateTrig 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 data WdP2 = WdP2Const Point2
| WdYouPos | 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 data MdWdWd = MdWdId
| MdTrigIf MdWdWd MdWdWd | MdTrigIf MdWdWd MdWdWd
| MdSetLSCol Point3 | MdSetLSCol Point3
| MdFlickerUpdate | 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 data WdBl = WdTrig Int
| WdBlDoorMoving Int | WdBlDoorMoving Int
| WdBlConst Bool | WdBlConst Bool
@@ -29,18 +44,30 @@ data WdBl = WdTrig Int
| WdBlCrFilterNearPoint Float Point2 CrBl | WdBlCrFilterNearPoint Float Point2 CrBl
| WdBlBtOn Int | WdBlBtOn Int
| WdBlBtNotOff 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 data WdP2f = WdP2f0
| WdP2fDoorPosition Int | 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 data DrWdWd = DrWdId
| DrWdMakeDoorDebris | DrWdMakeDoorDebris
| DrWdMechanismStepwise Int [Int] [(Point2,Point2)] | DrWdMechanismStepwise Int [Int] [(Point2,Point2)]
| DoorMechanism | 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 data TmWdWd = TmWdId
| TmWdWdDisconnectTerminal | TmWdWdDisconnectTerminal
| TmWdWdfromWdWd WdWd | TmWdWdfromWdWd WdWd
| TmWdWdTermSound SoundID | TmWdWdTermSound SoundID
| TmWdWdDoDeathTriggers | TmWdWdDoDeathTriggers
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TmWdWd where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TmWdWd
+7 -1
View File
@@ -1,8 +1,14 @@
{-# LANGUAGE DeriveGeneric #-}
--{-# LANGUAGE TemplateHaskell #-} --{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Distortion.Data where module Dodge.Distortion.Data where
import GHC.Generics
import Data.Aeson
import Geometry import Geometry
data Distortion data Distortion
= RadialDistortion Point2 Point2 Point2 Float = 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
+1
View File
@@ -3,6 +3,7 @@ import Dodge.Data
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import Data.Strict.IntMap.Autogen.Merge.Strict import Data.Strict.IntMap.Autogen.Merge.Strict
--import Data.IntMap.Merge.Strict
getCrEquipment :: Creature -> IM.IntMap Item getCrEquipment :: Creature -> IM.IntMap Item
getCrEquipment cr = merge dropMissing dropMissing (zipWithMatched $ \_ _ -> id) getCrEquipment cr = merge dropMissing dropMissing (zipWithMatched $ \_ _ -> id)
+14 -2
View File
@@ -1,4 +1,8 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Equipment.Data where module Dodge.Equipment.Data where
import GHC.Generics
import Data.Aeson
data EquipSite data EquipSite
= GoesOnHead = GoesOnHead
| GoesOnChest | GoesOnChest
@@ -6,7 +10,10 @@ data EquipSite
| GoesOnWrist | GoesOnWrist
| GoesOnLegs | GoesOnLegs
| GoesOnSpecial | GoesOnSpecial
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON EquipSite where
toEncoding = genericToEncoding defaultOptions
instance FromJSON EquipSite
data EquipPosition data EquipPosition
= OnHead = OnHead
| OnChest | OnChest
@@ -15,4 +22,9 @@ data EquipPosition
| OnRightWrist | OnRightWrist
| OnLegs | OnLegs
| OnSpecial | 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
+2
View File
@@ -73,6 +73,8 @@ handlePressedKey True ScancodeBackspace u
| otherwise = return $ Just $ u & uvWorld . cWorld . backspaceTimer -~ 1 | otherwise = return $ Just $ u & uvWorld . cWorld . backspaceTimer -~ 1
handlePressedKey True _ u = return $ Just u handlePressedKey True _ u = return $ Just u
handlePressedKey _ scode u = case scode of 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 ScancodeF5 -> return . Just $ doQuicksave u
ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u
ScancodeSemicolon -> return . Just $ gotoTerminal u ScancodeSemicolon -> return . Just $ gotoTerminal u
+10 -1
View File
@@ -1,9 +1,14 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{- | GameRooms contain information about given positions in the world {- | GameRooms contain information about given positions in the world
-} -}
module Dodge.GameRoom module Dodge.GameRoom
where where
import Geometry import Geometry
import Control.Lens
import GHC.Generics
import Data.Aeson
data GameRoom = GameRoom data GameRoom = GameRoom
{ _grViewpoints :: [Point2] { _grViewpoints :: [Point2]
@@ -13,4 +18,8 @@ data GameRoom = GameRoom
, _grLinkDirs :: [Float] , _grLinkDirs :: [Float]
, _grName :: String , _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
+11 -6
View File
@@ -1,12 +1,13 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
module Dodge.Item.Attachment.Data module Dodge.Item.Attachment.Data
where where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
data ItAttachment data ItAttachment
= AttachFuse {_atFuseTime :: Int} = AttachFuse {_atFuseTime :: Int}
| AttachMode {_atMode :: Int} | AttachMode {_atMode :: Int}
@@ -17,8 +18,10 @@ data ItAttachment
| AttachFloat { _atFloat :: Float } | AttachFloat { _atFloat :: Float }
| AttachBool { _atBool :: Bool } | AttachBool { _atBool :: Bool }
| NoItAttachment | 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 data Scope = NoScope
| RemoteScope | RemoteScope
{_scopePos :: Point2 -- ^ a camera offset {_scopePos :: Point2 -- ^ a camera offset
@@ -32,7 +35,9 @@ data Scope = NoScope
,_scopeDefaultZoom :: Float ,_scopeDefaultZoom :: Float
,_scopeIsCamera :: Bool -- ^ if the camera offset is also the center of vision ,_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 ''ItAttachment
makeLenses ''Scope makeLenses ''Scope
+7 -2
View File
@@ -1,9 +1,14 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
--{-# LANGUAGE TemplateHaskell #-} --{-# LANGUAGE TemplateHaskell #-}
module Dodge.Item.Data where module Dodge.Item.Data where
--import Control.Lens import GHC.Generics
import Data.Aeson
data CurseStatus data CurseStatus
= Uncursed = Uncursed
| UndroppableIdentified | UndroppableIdentified
| UndroppableUnidentified | UndroppableUnidentified
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON CurseStatus where
toEncoding = genericToEncoding defaultOptions
instance FromJSON CurseStatus
+3 -3
View File
@@ -8,7 +8,7 @@ import LensHelp
import Data.Maybe import Data.Maybe
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
aRadarPulse :: Object -> Creature -> World -> World aRadarPulse :: ObjectType -> Creature -> World -> World
aRadarPulse ob cr = cWorld . radarSweeps .:~ RadarSweep aRadarPulse ob cr = cWorld . radarSweeps .:~ RadarSweep
{ _rsTimer = 100 { _rsTimer = 100
, _rsRad = 0 , _rsRad = 0
@@ -34,13 +34,13 @@ updateRadarSweep w pt
circPoints = blipsF p r w circPoints = blipsF p r w
r = fromIntegral (400 - x*4) r = fromIntegral (400 - x*4)
findBlips :: Object -> Point2 -> Float -> World -> [Point2] findBlips :: ObjectType -> Point2 -> Float -> World -> [Point2]
findBlips ob = case ob of findBlips ob = case ob of
ObCreature -> crBlips ObCreature -> crBlips
ObItem -> itemBlips ObItem -> itemBlips
ObWall -> wallBlips ObWall -> wallBlips
_ -> undefined _ -> undefined
makeBlip :: Object -> Point2 -> RadarBlip makeBlip :: ObjectType -> Point2 -> RadarBlip
makeBlip ob = case ob of makeBlip ob = case ob of
ObCreature -> blipAt 8 (withAlpha 0.2 green) 50 ObCreature -> blipAt 8 (withAlpha 0.2 green) 50
ObWall -> blipAt 2 red 50 ObWall -> blipAt 2 red 50
+1 -1
View File
@@ -19,7 +19,7 @@ drawRadarSweep pt = setLayer DebugLayer $ pictures sweepPics
| otherwise = fromIntegral x / 10 | otherwise = fromIntegral x / 10
x = _rsTimer pt x = _rsTimer pt
rsObjectColor :: Object -> Color rsObjectColor :: ObjectType -> Color
rsObjectColor ob = case ob of rsObjectColor ob = case ob of
ObWall -> red ObWall -> red
ObCreature -> green ObCreature -> green
+2 -2
View File
@@ -310,8 +310,8 @@ drawCarte cfig w = pictures $
++ [mainListCursor white iPos cfig] ++ [mainListCursor white iPos cfig]
where where
iPos = _selLocation (_cWorld w) iPos = _selLocation (_cWorld w)
locs = map (\(_,s) -> (s,white)) . 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) locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations $ _cWorld w
locTexts = map fst locs locTexts = map fst locs
displayListEndCoords :: Configuration -> [String] -> [Point2] displayListEndCoords :: Configuration -> [String] -> [Point2]
+25
View File
@@ -3,13 +3,38 @@ module Dodge.Save
, loadSaveSlot , loadSaveSlot
, doQuicksave , doQuicksave
, saveLevelStartSlot , saveLevelStartSlot
, writeSaveSlot
, readSaveSlot
) where ) where
import Dodge.Data import Dodge.Data
import Text.Read (readMaybe)
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
--import Data.Maybe --import Data.Maybe
import Control.Lens import Control.Lens
--import qualified Data.Set as S --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 :: SaveSlot -> Universe -> Universe
saveWorldInEmptySlot slot w = case M.lookup slot $ _savedWorlds w of saveWorldInEmptySlot slot w = case M.lookup slot $ _savedWorlds w of
+7 -1
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
module Geometry.ConvexPoly module Geometry.ConvexPoly
@@ -10,6 +11,8 @@ module Geometry.ConvexPoly
, convexPolysOverlap , convexPolysOverlap
, pointInPolyPoints , pointInPolyPoints
) where ) where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import Geometry.Vector import Geometry.Vector
import Geometry.LHS import Geometry.LHS
@@ -23,7 +26,10 @@ data ConvexPoly = ConvexPoly
, _cpCen :: Point2 , _cpCen :: Point2
, _cpRad :: Float , _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 :: [Point2] -> ConvexPoly
pointsToPoly xs = ConvexPoly pointsToPoly xs = ConvexPoly
{ _cpPoints = xs { _cpPoints = xs
+18
View File
@@ -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
( module Geometry.Data ( module Geometry.Data
, V2 (..) , V2 (..)
@@ -5,13 +11,25 @@ module Geometry.Data
, V4 (..) , V4 (..)
) )
where where
import Data.Aeson
import Linear.V2 import Linear.V2
import Linear.V3 import Linear.V3
import Linear.V4 import Linear.V4
type Int2 = V2 Int type Int2 = V2 Int
type Point2 = V2 Float 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 type Point3 = V3 Float
instance ToJSON a => ToJSON (V3 a) where
toEncoding = genericToEncoding defaultOptions
instance FromJSON a => FromJSON (V3 a)
type Point4 = V4 Float type Point4 = V4 Float
instance ToJSON a => ToJSON (V4 a) where
toEncoding = genericToEncoding defaultOptions
instance FromJSON a => FromJSON (V4 a)
type DPoint2 = (Point2,Float) type DPoint2 = (Point2,Float)
+39 -1
View File
@@ -1,6 +1,14 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wno-unused-imports #-} {-# 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 IntMapHelp
( module Data.Strict.IntMap ( module Data.Strict.IntMap
--( module Data.IntMap.Strict
, newKey , newKey
, insertNewKey , insertNewKey
, insertWithNewKeys , insertWithNewKeys
@@ -8,10 +16,40 @@ module IntMapHelp
, safeSwapKeys , safeSwapKeys
, findIndex , findIndex
) where ) where
import GHC.Generics
import Data.Aeson
import LensHelp import LensHelp
--import Data.List hiding (foldr,insert)
--import Data.IntMap.Strict
import Data.Strict.IntMap import Data.Strict.IntMap
import Data.Strict.Containers.Lens 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 {- | Find a key value one higher than any key in the map, or zero if the map is
- empty -} - empty -}
newKey :: IntMap a -> Int newKey :: IntMap a -> Int
+7 -1
View File
@@ -1,10 +1,16 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-}
module MaybeHelp where module MaybeHelp where
import Control.Lens import Control.Lens
import Data.Aeson
import GHC.Generics
data Maybe' a = Just' {__Just' :: a} | Nothing' 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' :: Maybe' a -> a
fromJust' mx = case mx of fromJust' mx = case mx of
+15 -6
View File
@@ -1,11 +1,13 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Picture.Data module Picture.Data
where where
import GHC.Generics
import Data.Aeson
import Geometry.Data import Geometry.Data
import GHC.Generics
import Control.Lens import Control.Lens
import Streaming import Streaming
data Verx = Verx data Verx = Verx
@@ -15,8 +17,10 @@ data Verx = Verx
, _vxLayer :: !Layer , _vxLayer :: !Layer
, _vxShadNum :: !ShadNum , _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 data Layer
= BottomLayer = BottomLayer
| MidLayer | MidLayer
@@ -24,15 +28,20 @@ data Layer
| BloomNoZWrite | BloomNoZWrite
| DebugLayer | DebugLayer
| FixedCoordLayer | 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 :: Layer -> Int
layerNum = fromEnum layerNum = fromEnum
numLayers :: Int numLayers :: Int
numLayers = length [minBound::Layer .. maxBound] numLayers = length [minBound::Layer .. maxBound]
--TODO use synonyms for layer numbers --TODO use synonyms for layer numbers
newtype ShadNum = ShadNum { _unShadNum :: Int } 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 polyNum, polyzNum, bezNum, textNum, arcNum, ellNum :: ShadNum
{-# INLINE polyNum #-} {-# INLINE polyNum #-}
{-# INLINE polyzNum #-} {-# INLINE polyzNum #-}
+12
View File
@@ -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 module Quaternion
( rotateToZ ( rotateToZ
, vToQuat , vToQuat
, module Linear.Quaternion , module Linear.Quaternion
) where ) where
import Data.Aeson
import Geometry.Data import Geometry.Data
import Geometry.Vector3D import Geometry.Vector3D
import qualified Linear.Quaternion as Q import qualified Linear.Quaternion as Q
import Linear.Quaternion 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. -- 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 -- i think this may instead do as if the new point moves to be on z axis
rotateToZ :: Point3 -> Point3 -> Point3 rotateToZ :: Point3 -> Point3 -> Point3
+16 -17
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-} {-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
@@ -6,25 +7,16 @@
module Shape.Data module Shape.Data
where where
import Geometry.Data import Geometry.Data
import GHC.Generics
--import Data.Vector.Fusion.Util import Data.Aeson
import Control.Lens import Control.Lens
import Streaming import Streaming
type Shape' = Stream (Of ShapeObj) IO () type Shape' = Stream (Of ShapeObj) IO ()
type Shape = [ShapeObj] type Shape = [ShapeObj]
--_shVertices :: Shape -> [ShapeV]
--{-# INLINE _shVertices #-}
--_shVertices = concatMap _shVs
--shVList :: Shape -> [ShapeV]
--{-# INLINE shVList #-}
--shVList = _shVertices
--shVList = DL.toList . _shVertices
{-# INLINE shVfromList #-} {-# INLINE shVfromList #-}
shVfromList = id shVfromList = id
--shVfromList = DL.fromList
{-# INLINE shEfromList #-} {-# INLINE shEfromList #-}
shEfromList = id shEfromList = id
@@ -32,17 +24,24 @@ data ShapeObj = ShapeObj
{ _shType :: ShapeType { _shType :: ShapeType
, _shVs :: [ShapeV] , _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 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 -- edges are given by four consecutive points
data ShapeV = ShapeV data ShapeV = ShapeV
{_svPos :: Point3 {_svPos :: Point3
,_svCol :: Point4 ,_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 pairToSV :: (Point3,Point4) -> ShapeV
{-# INLINE pairToSV #-} {-# INLINE pairToSV #-}
pairToSV = uncurry ShapeV pairToSV = uncurry ShapeV
+15 -3
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Sound.Data module Sound.Data
where where
import GHC.Generics
import Data.Aeson
import qualified SDL.Mixer as Mix import qualified SDL.Mixer as Mix
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
--import qualified Data.Map.Strict as M --import qualified Data.Map.Strict as M
@@ -12,7 +15,10 @@ data SoundStatus = SoundStatus
{_playStatus :: PlayStatus {_playStatus :: PlayStatus
,_isLooping :: Bool ,_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) -- TODO make this more sensible (use product rather than union in some cases)
data PlayStatus data PlayStatus
= JustStartedPlaying = JustStartedPlaying
@@ -20,9 +26,15 @@ data PlayStatus
| ToStart | ToStart
| ToContinueStart | ToContinueStart
| ToStop | 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 } 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 newtype SoundData = SoundData
{_loadedChunks :: IM.IntMap Mix.Chunk {_loadedChunks :: IM.IntMap Mix.Chunk
} }