From c2707719fb66f828e9661ba41950aad689bdedcb Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 26 Jul 2022 11:51:53 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Creature.hs | 346 ++++---- src/Dodge/Creature/State/Data.hs | 55 -- src/Dodge/Data.hs | 774 +++++++++--------- src/Dodge/Data/Creature.hs | 1 - src/Dodge/Data/Creature/State.hs | 82 +- src/Dodge/Data/Item.hs | 20 +- .../Data.hs => Data/Item/Attachment.hs} | 2 +- .../Data.hs => Data/Item/CurseStatus.hs} | 3 +- src/Dodge/Data/Item/HeldUse.hs | 64 +- src/Dodge/Data/Item/Tweak.hs | 12 + src/Dodge/Data/Item/Use.hs | 95 ++- src/Dodge/Data/{ => Item/Use}/Equipment.hs | 4 +- 12 files changed, 740 insertions(+), 718 deletions(-) delete mode 100644 src/Dodge/Creature/State/Data.hs rename src/Dodge/{Item/Attachment/Data.hs => Data/Item/Attachment.hs} (97%) rename src/Dodge/{Item/Data.hs => Data/Item/CurseStatus.hs} (89%) rename src/Dodge/Data/{ => Item/Use}/Equipment.hs (92%) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 5215402e9..6046ed5ef 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -1,125 +1,110 @@ -module Dodge.Creature - ( module Dodge.Creature - , module Dodge.Creature.ChaseCrit - , module Dodge.Creature.Inanimate - , launcherCrit - , pistolCrit - , ltAutoCrit - , spreadGunCrit - , autoCrit - , armourChaseCrit - ) where -import Dodge.Creature.State.Data -import Dodge.Item.Equipment.Booster -import Dodge.Item.Weapon.Utility ---import Dodge.Item.Weapon.Drone -import Dodge.Item.Craftable -import Dodge.Creature.LauncherCrit -import Dodge.Creature.PistolCrit -import Dodge.Creature.LtAutoCrit -import Dodge.Creature.SpreadGunCrit +module Dodge.Creature ( + module Dodge.Creature, + module Dodge.Creature.ChaseCrit, + module Dodge.Creature.Inanimate, + launcherCrit, + pistolCrit, + ltAutoCrit, + spreadGunCrit, + autoCrit, + armourChaseCrit, +) where + +import Control.Lens +import Dodge.Creature.ArmourChase import Dodge.Creature.AutoCrit import Dodge.Creature.ChaseCrit -import Dodge.Creature.ArmourChase +import Dodge.Creature.Inanimate +import Dodge.Creature.LauncherCrit +import Dodge.Creature.LtAutoCrit +import Dodge.Creature.PistolCrit +import Dodge.Creature.SpreadGunCrit import Dodge.Data import Dodge.Default -import Dodge.Item.Weapon -import Dodge.Item.Equipment import Dodge.Item.Consumable -import Dodge.Creature.Inanimate -import Picture +import Dodge.Item.Craftable +import Dodge.Item.Equipment +import Dodge.Item.Weapon import Geometry.Data import qualified IntMapHelp as IM - ---import Data.List ---import Data.Char ---import Data.Maybe ---import Data.Function -import Control.Lens ---import System.Random ---import qualified Data.Set as S ---import qualified Data.Map as M +import Picture spawnerCrit :: Creature -spawnerCrit = defaultCreature - { --_crUpdate = stateUpdate $ spawnerAI chaseCrit - _crHP = 300 - , _crInv = IM.empty -- IM.fromList [(0,frontArmour)] - } - & crType . skinUpper .~ light4 blue +spawnerCrit = + defaultCreature + & crHP .~ 300 + & crInv .~ IM.empty + & crType . skinUpper .~ light4 blue miniGunCrit :: Creature -miniGunCrit = defaultCreature - { _crInv = IM.fromList [(0,miniGunX 3)] - , _crRad = 10 - , _crState = defaultState - , _crHP = 500 - , _crMvType = defaultAimMvType - } - & crType . skinUpper .~ light4 red - & crType . humanoidAI .~ MiniGunAI +miniGunCrit = + defaultCreature + & crInv .~ IM.fromList [(0, miniGunX 3)] + & crType . skinUpper .~ light4 red + & crType . humanoidAI .~ MiniGunAI + longCrit :: Creature -longCrit = defaultCreature - { _crActionPlan = ActionPlan - { _apImpulse = [] - , _apAction = [] - , _apStrategy = StrategyActions WatchAndWait [StartSentinelPost] - , _apGoal = [] - } - , _crInv = IM.fromList [(0,sniperRifle),(1,medkit 100)] - , _crRad = 10 - , _crHP = 150 - } - & crType . humanoidAI .~ LongAI - & crType . skinUpper .~ light4 red +longCrit = + defaultCreature + & crActionPlan .~ + ActionPlan + { _apImpulse = [] + , _apAction = [] + , _apStrategy = StrategyActions WatchAndWait [StartSentinelPost] + , _apGoal = [] + } + & crInv .~ IM.fromList [(0, sniperRifle), (1, medkit 100)] + & crType . humanoidAI .~ LongAI + & crType . skinUpper .~ light4 red + multGunCrit :: Creature -multGunCrit = defaultCreature - { _crInv = IM.fromList [(0,volleyGun 4),(1,medkit 100)] - , _crRad = 10 - , _crHP = 300 - } - & crType . skinUpper .~ light4 red - & crType . humanoidAI .~ MultGunAI +multGunCrit = + defaultCreature + & crInv .~ IM.fromList [(0, volleyGun 4), (1, medkit 100)] + & crType . skinUpper .~ light4 red + & crType . humanoidAI .~ MultGunAI addArmour :: Creature -> Creature addArmour = over crInv insarmour - where + where insarmour xs = IM.insert (IM.newKey xs) frontArmour xs + {- | The creature you control. -ID 0. -} +ID 0. +-} startCr :: Creature -startCr = defaultCreature - { _crPos = V2 20 0 - , _crOldPos = V2 20 0 - , _crDir = pi/2 - , _crMvDir = pi/2 - , _crID = 0 - , _crRad = 10 - , _crMass = 10 - , _crHP = 1000 - , _crMaxHP = 1500 - , _crInv = startInventory - , _crCorpse = MakeDefaultCorpse - , _crFaction = PlayerFaction - , _crMvType = MvWalking yourDefaultSpeed - } - & crType . skinUpper .~ light4 black - & crType . humanoidAI .~ YourAI -{- | Items you start with. -} +startCr = + defaultCreature + & crPos .~ V2 20 0 + & crOldPos .~ V2 20 0 + & crDir .~ pi / 2 + & crMvDir .~ pi / 2 + & crID .~ 0 + & crHP .~ 1000 + & crMaxHP .~ 1500 + & crInv .~ startInventory + & crCorpse .~ MakeDefaultCorpse + & crFaction .~ PlayerFaction + & crMvType .~ MvWalking yourDefaultSpeed + & crType . skinUpper .~ light4 black + & crType . humanoidAI .~ YourAI + +-- | Items you start with. startInvList :: [Item] -startInvList = [ ] +startInvList = [] + startInventory :: IM.IntMap Item -startInventory = IM.fromList $ zip [0..] startInvList +startInventory = IM.fromList $ zip [0 ..] startInvList inventoryX :: Char -> [Item] inventoryX c = case c of - 'A' -> + 'A' -> [ clickDetector ITEMDETECTOR , makeTypeCraftNum 1 TRANSFORMER , makeTypeCraftNum 2 CAN , makeTypeCraftNum 2 PIPE ] - 'B' -> + 'B' -> [ forceFieldGun , wristArmour , wristArmour @@ -143,7 +128,7 @@ inventoryX c = case c of [ blinkGun , unsafeBlinkGun , autoDetector WALLDETECTOR --- , effectGun "GIBBER" addCrGibs + -- , effectGun "GIBBER" addCrGibs ] 'E' -> [ makeTypeCraftNum 3 PIPE @@ -182,17 +167,19 @@ inventoryX c = case c of , makeTypeCraftNum 5 CONCUSSMODULE , makeTypeCraftNum 5 STATICMODULE ] - 'H' -> [ shatterGun ] - 'I' -> [ makeTypeCraft TELEPORTMODULE - , makeTypeCraftNum 2 MICROCHIP - ] - 'J' -> [ lasGun - , lasGun - , dualBeam --- , lasWidePulse - , makeTypeCraftNum 10 TRANSFORMER - ] - 'K' -> + 'H' -> [shatterGun] + 'I' -> + [ makeTypeCraft TELEPORTMODULE + , makeTypeCraftNum 2 MICROCHIP + ] + 'J' -> + [ lasGun + , lasGun + , dualBeam + , -- , lasWidePulse + makeTypeCraftNum 10 TRANSFORMER + ] + 'K' -> [ autoRifle , makeTypeCraftNum 7 MICROCHIP , makeTypeCraftNum 4 HARDWARE @@ -211,77 +198,84 @@ inventoryX c = case c of _ -> [] testInventory :: IM.IntMap Item -testInventory = IM.fromList $ zip [0..] - [ makeTypeCraftNum 9 PIPE - , autoAmr - , brainHat - , headLamp - , autoDetector WALLDETECTOR - , magShield - , frontArmour - , wristArmour - , flatShield - , sniperRifle - , makeTypeCraftNum 1 MOTOR - , makeTypeCraft INCENDIARYMODULE - , makeTypeCraft STATICMODULE - , makeTypeCraft CONCUSSMODULE --- , bounceModule --- , medkit 50 & itConsumption . itAmount .~ 3 - , teleportModule --- , makeTypeCraftNum 1 LIGHTER --- , makeTypeCraftNum 15 TUBE --- , makeTypeCraftNum 9 TRANSFORMER --- , makeTypeCraftNum 5 CREATURESENSOR --- , makeTypeCraftNum 9 PRISM --- , makeTypeCraftNum 3 DRUM --- , makeTypeCraftNum 3 PUMP --- , makeTypeCraftNum 3 BATTERY --- , makeTypeCraftNum 1 MAGNET --- , makeTypeCraftNum 1 TRANSMITTER - , makeTypeCraftNum 10 HARDWARE - , makeTypeCraftNum 3 SPRING - , makeTypeCraftNum 10 CAN --- , makeTypeCraftNum 3 TIN - , makeTypeCraftNum 3 PLANK --- , makeTypeCraftNum 1 MOTOR --- , makeTypeCraftNum 5 MICROCHIP --- , makeTypeCraftNum 5 AIUNIT - ] +testInventory = + IM.fromList $ + zip + [0 ..] + [ makeTypeCraftNum 9 PIPE + , autoAmr + , brainHat + , headLamp + , autoDetector WALLDETECTOR + , magShield + , frontArmour + , wristArmour + , flatShield + , sniperRifle + , makeTypeCraftNum 1 MOTOR + , makeTypeCraft INCENDIARYMODULE + , makeTypeCraft STATICMODULE + , makeTypeCraft CONCUSSMODULE + , -- , bounceModule + -- , medkit 50 & itConsumption . itAmount .~ 3 + teleportModule + , -- , makeTypeCraftNum 1 LIGHTER + -- , makeTypeCraftNum 15 TUBE + -- , makeTypeCraftNum 9 TRANSFORMER + -- , makeTypeCraftNum 5 CREATURESENSOR + -- , makeTypeCraftNum 9 PRISM + -- , makeTypeCraftNum 3 DRUM + -- , makeTypeCraftNum 3 PUMP + -- , makeTypeCraftNum 3 BATTERY + -- , makeTypeCraftNum 1 MAGNET + -- , makeTypeCraftNum 1 TRANSMITTER + makeTypeCraftNum 10 HARDWARE + , makeTypeCraftNum 3 SPRING + , makeTypeCraftNum 10 CAN + , -- , makeTypeCraftNum 3 TIN + makeTypeCraftNum 3 PLANK + -- , makeTypeCraftNum 1 MOTOR + -- , makeTypeCraftNum 5 MICROCHIP + -- , makeTypeCraftNum 5 AIUNIT + ] + stackedInventory :: IM.IntMap Item -stackedInventory = IM.fromList $ zip [0..] - [--sonicGun - burstRifle - , pipe - ,rewindGun - ,tractorGun - ,autoPistol - ,pistol - ,teslaGun - ,blinkGun - ,miniGunX 3 --- ,multGun - ,boosterGun - ,remoteLauncher - ,flatShield --- ,grenade - ,spawnGun (lamp 5) - ,lasGun - ,flameThrower - ,poisonSprayer - ,launcher --- ,droneLauncher - --,lasGun - --,grenade - --,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher - --,longGun - --,hvAutoGun - --,teslaGun - --,latchkey 0 - --,miniGun - --,medkit 50 - --,bezierGun - ] +stackedInventory = + IM.fromList $ + zip + [0 ..] + [ --sonicGun + burstRifle + , pipe + , rewindGun + , tractorGun + , autoPistol + , pistol + , teslaGun + , blinkGun + , miniGunX 3 + , -- ,multGun + boosterGun + , remoteLauncher + , flatShield + , -- ,grenade + spawnGun (lamp 5) + , lasGun + , flameThrower + , poisonSprayer + , launcher + -- ,droneLauncher + --,lasGun + --,grenade + --,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher + --,longGun + --,hvAutoGun + --,teslaGun + --,latchkey 0 + --,miniGun + --,medkit 50 + --,bezierGun + ] + --smokeGenGun :: Item --smokeGenGun = effectGun "smoke" $ const spawnSmokeAtCursor - diff --git a/src/Dodge/Creature/State/Data.hs b/src/Dodge/Creature/State/Data.hs deleted file mode 100644 index 87dc1a320..000000000 --- a/src/Dodge/Creature/State/Data.hs +++ /dev/null @@ -1,55 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE StrictData #-} -module Dodge.Creature.State.Data - where -import GHC.Generics -import Data.Aeson ---import Geometry -import Geometry.Data -import Color - -import Control.Lens -import qualified Data.IntSet as IS -data CreatureDropType - = DropAll - | DropAmount Int - | DropSpecific [Int] - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON CreatureDropType where - toEncoding = genericToEncoding defaultOptions -instance FromJSON CreatureDropType -data CrSpState - = Barrel { _piercedPoints :: [Point2]} - | GenCr - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON CrSpState where - toEncoding = genericToEncoding defaultOptions -instance FromJSON CrSpState -data Faction - = GenericFaction Int - | ZombieFaction - | EncircleFlock - | ChaseCritters - | SpawnedBy Int - | NoFaction - | ColorFaction Color - | PlayerFaction - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON Faction where - toEncoding = genericToEncoding defaultOptions -instance FromJSON Faction -data CrGroup - = LoneWolf - | Swarm - { _swarm :: IS.IntSet - , _crGroupID :: Int - } - | CrGroupID { _crGroupID :: Int } - | ShieldGroup - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON CrGroup where - toEncoding = genericToEncoding defaultOptions -instance FromJSON CrGroup -makeLenses ''CrSpState -makeLenses ''CrGroup diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 9fdf9ef9d..72be02208 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -1,475 +1,479 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + {- | -Contains base datatypes that cannot be seperated into +Contains base datatypes that cannot be seperated into different modules because they are interdependent; circular imports are probably not a good idea. WARNING: orphan instances concerning Aeson classes and SDL datatypes have been introduced. The warnings have been disabled. - -} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Dodge.Data - ( module Dodge.Data - , module Dodge.Data.CrGroupParams - , module Dodge.Data.Corpse - , module Dodge.Data.ActionPlan - , module Dodge.Data.CreatureEffect - , module Dodge.Data.WorldEffect - , module Dodge.Data.Button - , module Dodge.Data.Item.Params - , module Dodge.Data.Beam - , module Dodge.Data.Targeting - , module Dodge.Data.ItEffect - , module Dodge.Data.Hammer - , module Dodge.Data.Item.Use - , module Dodge.Data.Item.UseDelay - , module Dodge.Data.ArcStep - , module Dodge.Data.CrWlID - , module Dodge.Data.Item.HeldUse - , module Dodge.Data.Item.HeldScroll - , module Dodge.Data.Item.Consumption - , module Dodge.Data.Gas - , module Dodge.Data.Ammo - , module Dodge.Data.Payload - , module Dodge.Data.RadarSweep - , module Dodge.Data.PosEvent - , module Dodge.Data.EnergyBall - , module Dodge.Data.Flame - , module Dodge.Data.Magnet - , module Dodge.Data.Spark - , module Dodge.Data.Bullet - , module Dodge.Data.Door - , module Dodge.Data.Item - , module Dodge.Data.HUD - , module Dodge.Data.Cloud - , module Dodge.Data.RightButtonOptions - , module Dodge.Data.Material - , module Dodge.Data.LightSource - , module Dodge.Data.Creature - , module Dodge.Data.Block - , module Dodge.Data.Flare - , module Dodge.Data.LoadAction - , module Dodge.Data.ForegroundShape - , module Dodge.Data.Wall - , module Dodge.Data.Object - , module Dodge.Data.Zoning - , module Dodge.Data.Bounds - , module Dodge.Data.Sensor - , module Dodge.Combine.Data - , module Dodge.Distortion.Data - , module Dodge.Data.Damage - , module Dodge.Data.SoundOrigin - , module Dodge.Creature.State.Data - , module Dodge.Creature.Stance.Data - , module Dodge.Creature.Perception.Data - , module Dodge.Creature.Memory.Data - , module Dodge.Item.Attachment.Data - , module Dodge.Item.Data - , module Dodge.Config.Data - , module MaybeHelp - , module Dodge.Data.ItemAmount - , module Dodge.RoomCluster.Data - , module Dodge.Data.Room - , module Dodge.Data.RadarBlip - , module Dodge.Data.PathGraph - , module Dodge.Data.Gust - , module Dodge.Data.Projectile - , module Dodge.Data.Modification - , module Dodge.Data.PressPlate - , module Dodge.Data.Laser - , module Dodge.Data.TeslaArc - , module Dodge.Data.Shockwave - , module Dodge.Data.Prop - , module Dodge.Data.LinearShockwave - , module Dodge.Data.TractorBeam - , module Dodge.Data.MountedObject - , module Dodge.Data.Machine - , module Dodge.Data.GenParams - , module Dodge.Data.Terminal - , module Dodge.Data.FloorItem - ) where -import Dodge.Data.FloorItem +-} +module Dodge.Data ( + module Dodge.Data, + module Dodge.Data.CrGroupParams, + module Dodge.Data.Corpse, + module Dodge.Data.ActionPlan, + module Dodge.Data.CreatureEffect, + module Dodge.Data.WorldEffect, + module Dodge.Data.Button, + module Dodge.Data.Beam, + module Dodge.Data.Targeting, + module Dodge.Data.ItEffect, + module Dodge.Data.Hammer, + module Dodge.Data.ArcStep, + module Dodge.Data.CrWlID, + module Dodge.Data.Gas, + module Dodge.Data.Ammo, + module Dodge.Data.Payload, + module Dodge.Data.RadarSweep, + module Dodge.Data.PosEvent, + module Dodge.Data.EnergyBall, + module Dodge.Data.Flame, + module Dodge.Data.Magnet, + module Dodge.Data.Spark, + module Dodge.Data.Bullet, + module Dodge.Data.Door, + module Dodge.Data.Item, + module Dodge.Data.HUD, + module Dodge.Data.Cloud, + module Dodge.Data.RightButtonOptions, + module Dodge.Data.Material, + module Dodge.Data.LightSource, + module Dodge.Data.Creature, + module Dodge.Data.Block, + module Dodge.Data.Flare, + module Dodge.Data.LoadAction, + module Dodge.Data.ForegroundShape, + module Dodge.Data.Wall, + module Dodge.Data.Object, + module Dodge.Data.Zoning, + module Dodge.Data.Bounds, + module Dodge.Data.Sensor, + module Dodge.Combine.Data, + module Dodge.Distortion.Data, + module Dodge.Data.Damage, + module Dodge.Data.SoundOrigin, + module Dodge.Creature.Stance.Data, + module Dodge.Creature.Perception.Data, + module Dodge.Creature.Memory.Data, + module Dodge.Config.Data, + module MaybeHelp, + module Dodge.Data.ItemAmount, + module Dodge.RoomCluster.Data, + module Dodge.Data.Room, + module Dodge.Data.RadarBlip, + module Dodge.Data.PathGraph, + module Dodge.Data.Gust, + module Dodge.Data.Projectile, + module Dodge.Data.Modification, + module Dodge.Data.PressPlate, + module Dodge.Data.Laser, + module Dodge.Data.TeslaArc, + module Dodge.Data.Shockwave, + module Dodge.Data.Prop, + module Dodge.Data.LinearShockwave, + module Dodge.Data.TractorBeam, + module Dodge.Data.MountedObject, + module Dodge.Data.Machine, + module Dodge.Data.GenParams, + module Dodge.Data.Terminal, + module Dodge.Data.FloorItem, +) where + +import Color +import Control.Lens +import Control.Monad.State import Data.Aeson -import GHC.Generics -import Dodge.Data.Terminal -import Dodge.Data.GenParams -import Dodge.Data.Machine -import Dodge.Data.MountedObject -import Dodge.Data.TractorBeam -import Dodge.Data.LinearShockwave -import Dodge.Data.Prop -import Dodge.Data.Shockwave -import Dodge.Data.TeslaArc -import Dodge.Data.Laser -import Dodge.Data.PressPlate -import Dodge.Data.Modification -import Dodge.Data.Projectile -import Dodge.Data.Gust -import Dodge.Data.CrGroupParams -import Dodge.Data.Corpse -import Dodge.Data.ActionPlan -import Dodge.Data.CreatureEffect -import Dodge.Data.WorldEffect -import Dodge.Data.Button -import Dodge.Data.Item.Params -import Dodge.Data.Beam -import Dodge.Data.Targeting -import Dodge.Data.ItEffect -import Dodge.Data.Hammer -import Dodge.Data.Item.Use -import Dodge.Data.Item.UseDelay -import Dodge.Data.CrWlID -import Dodge.Data.ArcStep -import Dodge.Data.Item.HeldUse -import Dodge.Data.Item.HeldScroll -import Dodge.Data.Item.Consumption -import Dodge.Data.Gas -import Dodge.Data.Ammo -import Dodge.Data.Payload -import Dodge.Data.RadarSweep -import Dodge.Data.PosEvent -import Dodge.Data.EnergyBall -import Dodge.Data.Flame -import Dodge.Data.Magnet -import Dodge.Data.Spark -import Dodge.Data.Bullet -import Dodge.Data.Door -import Dodge.Data.Item -import Dodge.Data.HUD -import Dodge.Data.Cloud -import Dodge.Data.RadarBlip -import Dodge.Data.RightButtonOptions -import Dodge.Data.LightSource -import Dodge.Data.Creature -import Dodge.Data.Room -import Dodge.Data.Block -import Dodge.Data.Sensor -import Dodge.Data.Flare -import Dodge.Data.PathGraph -import Dodge.Data.Object -import Dodge.Data.Zoning -import Dodge.Data.ForegroundShape -import Dodge.Data.LoadAction -import Dodge.Data.Material -import Dodge.Data.Wall -import Dodge.Data.Bounds -import Dodge.RoomCluster.Data -import Dodge.Data.ItemAmount -import Dodge.Creature.State.Data -import Dodge.Creature.Stance.Data -import Dodge.Creature.Perception.Data -import Dodge.Creature.Memory.Data -import Dodge.Distortion.Data -import Dodge.Data.SoundOrigin -import Dodge.Data.Damage +import Data.Graph.Inductive +import qualified Data.IntSet as IS +import qualified Data.Map.Strict as M +import Data.Preload +import qualified Data.Set as S +import qualified Data.Text as T +import Data.Tile import Dodge.Combine.Data import Dodge.Config.Data import Dodge.Config.KeyConfig -import Dodge.Item.Attachment.Data -import Dodge.Item.Data -import Data.Preload -import Picture.Data -import Geometry.Data -import Geometry.ConvexPoly -import Sound.Data +import Dodge.Creature.Memory.Data +import Dodge.Creature.Perception.Data +import Dodge.Creature.Stance.Data +import Dodge.Data.ActionPlan +import Dodge.Data.Ammo +import Dodge.Data.ArcStep +import Dodge.Data.Beam +import Dodge.Data.Block +import Dodge.Data.Bounds +import Dodge.Data.Bullet +import Dodge.Data.Button +import Dodge.Data.Cloud +import Dodge.Data.Corpse +import Dodge.Data.CrGroupParams +import Dodge.Data.CrWlID +import Dodge.Data.Creature +import Dodge.Data.CreatureEffect +import Dodge.Data.Damage +import Dodge.Data.Door +import Dodge.Data.EnergyBall +import Dodge.Data.Flame +import Dodge.Data.Flare +import Dodge.Data.FloorItem +import Dodge.Data.ForegroundShape +import Dodge.Data.Gas +import Dodge.Data.GenParams +import Dodge.Data.Gust +import Dodge.Data.HUD +import Dodge.Data.Hammer +import Dodge.Data.ItEffect +import Dodge.Data.Item +import Dodge.Data.ItemAmount +import Dodge.Data.Laser +import Dodge.Data.LightSource +import Dodge.Data.LinearShockwave +import Dodge.Data.LoadAction +import Dodge.Data.Machine +import Dodge.Data.Magnet +import Dodge.Data.Material +import Dodge.Data.Modification +import Dodge.Data.MountedObject +import Dodge.Data.Object +import Dodge.Data.PathGraph +import Dodge.Data.Payload +import Dodge.Data.PosEvent +import Dodge.Data.PressPlate +import Dodge.Data.Projectile +import Dodge.Data.Prop +import Dodge.Data.RadarBlip +import Dodge.Data.RadarSweep +import Dodge.Data.RightButtonOptions +import Dodge.Data.Room +import Dodge.Data.Sensor +import Dodge.Data.Shockwave +import Dodge.Data.SoundOrigin +import Dodge.Data.Spark +import Dodge.Data.Targeting +import Dodge.Data.Terminal +import Dodge.Data.TeslaArc +import Dodge.Data.TractorBeam +import Dodge.Data.Wall +import Dodge.Data.WorldEffect +import Dodge.Data.Zoning +import Dodge.Distortion.Data import Dodge.GameRoom -import Color -import Data.Tile -import MaybeHelp - -import Control.Lens -import Control.Monad.State -import System.Random -import Data.Graph.Inductive -import qualified Data.Set as S -import qualified Data.IntSet as IS +import Dodge.RoomCluster.Data +import GHC.Generics +import Geometry.ConvexPoly +import Geometry.Data import qualified IntMapHelp as IM -import qualified Data.Map.Strict as M -import qualified Data.Text as T -import SDL (Scancode, MouseButton) +import MaybeHelp +import Picture.Data +import SDL (MouseButton, Scancode) +import Sound.Data import Streaming +import System.Random + type CRUpdate = Creature -> World -> (World -> World, Maybe Creature) + type CRUpdate' = Creature -> World -> (World -> World, Creature) data Universe = Universe - { _uvWorld :: World - , _preloadData :: PreloadData - , _menuLayers :: [ScreenLayer] - , _savedWorlds :: M.Map SaveSlot World - , _keyConfig :: KeyConfigSDL - , _uvIOEffects :: Universe -> IO Universe - , _uvConfig :: Configuration + { _uvWorld :: World + , _preloadData :: PreloadData + , _menuLayers :: [ScreenLayer] + , _savedWorlds :: M.Map SaveSlot World + , _keyConfig :: KeyConfigSDL + , _uvIOEffects :: Universe -> IO Universe + , _uvConfig :: Configuration , _uvTestString :: Universe -> [String] } + data GenWorld = GenWorld { _gwWorld :: World - , _genPlacements :: IM.IntMap [(Placement,Int)] - , _genRooms :: IM.IntMap Room + , _genPlacements :: IM.IntMap [(Placement, Int)] + , _genRooms :: IM.IntMap Room } + data World = World { _cWorld :: CWorld , _randGen :: StdGen - , _toPlaySounds :: M.Map SoundOrigin Sound - , _playingSounds :: M.Map SoundOrigin Sound - , _mousePos :: Point2 - , _keys :: S.Set Scancode - , _mouseButtons :: M.Map MouseButton Bool - , _hammers :: M.Map WorldHammer HammerPosition + , _toPlaySounds :: M.Map SoundOrigin Sound + , _playingSounds :: M.Map SoundOrigin Sound + , _mousePos :: Point2 + , _keys :: S.Set Scancode + , _mouseButtons :: M.Map MouseButton Bool + , _hammers :: M.Map WorldHammer HammerPosition } -data CWorld = CWorld - { _cameraCenter :: Point2 - , _cameraRot :: Float - , _cameraZoom :: Float -- smaller values zoom out - , _itemZoom :: Float - , _defaultZoom :: Float - , _cameraViewFrom :: Point2 - , _viewDistance :: Float - , _boundBox :: [Point2] - , _boundDist :: (Float,Float,Float,Float) -- NSEW, S and W negative - , _creatures :: IM.IntMap Creature - , _crZoning :: IM.IntMap (IM.IntMap IS.IntSet) --Zoning IM.IntMap Creature - , _creatureGroups :: IM.IntMap CrGroupParams - , _itemPositions :: IM.IntMap ItemPos - , _clouds :: [Cloud] - , _clZoning :: IM.IntMap (IM.IntMap [Cloud]) --Zoning IM.IntMap Creature - , _gusts :: IM.IntMap Gust - , _gsZoning :: IM.IntMap (IM.IntMap IS.IntSet) - , _props :: IM.IntMap Prop - , _projectiles :: IM.IntMap Proj - , _instantBullets :: [Bullet] - , _bullets :: [Bullet] - , _radarSweeps :: [RadarSweep] - , _energyBalls :: [EnergyBall] - , _posEvents :: [PosEvent] - , _flames :: [Flame] - , _sparks :: [Spark] - , _radarBlips :: [RadarBlip] - , _flares :: [Flare] - , _newBeams :: WorldBeams - , _beams :: WorldBeams - , _teslaArcs :: [TeslaArc] - , _shockwaves :: [Shockwave] - , _lasers :: [LaserStart] - , _lasersToDraw :: [Laser] + +data CWorld = CWorld + { _cameraCenter :: Point2 + , _cameraRot :: Float + , _cameraZoom :: Float -- smaller values zoom out + , _itemZoom :: Float + , _defaultZoom :: Float + , _cameraViewFrom :: Point2 + , _viewDistance :: Float + , _boundBox :: [Point2] + , _boundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative + , _creatures :: IM.IntMap Creature + , _crZoning :: IM.IntMap (IM.IntMap IS.IntSet) --Zoning IM.IntMap Creature + , _creatureGroups :: IM.IntMap CrGroupParams + , _itemPositions :: IM.IntMap ItemPos + , _clouds :: [Cloud] + , _clZoning :: IM.IntMap (IM.IntMap [Cloud]) --Zoning IM.IntMap Creature + , _gusts :: IM.IntMap Gust + , _gsZoning :: IM.IntMap (IM.IntMap IS.IntSet) + , _props :: IM.IntMap Prop + , _projectiles :: IM.IntMap Proj + , _instantBullets :: [Bullet] + , _bullets :: [Bullet] + , _radarSweeps :: [RadarSweep] + , _energyBalls :: [EnergyBall] + , _posEvents :: [PosEvent] + , _flames :: [Flame] + , _sparks :: [Spark] + , _radarBlips :: [RadarBlip] + , _flares :: [Flare] + , _newBeams :: WorldBeams + , _beams :: WorldBeams + , _teslaArcs :: [TeslaArc] + , _shockwaves :: [Shockwave] + , _lasers :: [LaserStart] + , _lasersToDraw :: [Laser] , _linearShockwaves :: IM.IntMap LinearShockwave - , _tractorBeams :: [TractorBeam] - , _walls :: IM.IntMap Wall - , _wallDamages :: IM.IntMap [Damage] - , _doors :: IM.IntMap Door - , _machines :: IM.IntMap Machine - , _terminals :: IM.IntMap Terminal - , _magnets :: IM.IntMap Magnet - , _blocks :: IM.IntMap Block - , _coordinates :: IM.IntMap Point2 - , _triggers :: IM.IntMap Bool - , _wlZoning :: IM.IntMap (IM.IntMap IS.IntSet) -- Zoning IM.IntMap Wall - , _floorItems :: IM.IntMap FloorItem - , _floorTiles :: [(Point3,Point3)] - , _modifications :: IM.IntMap Modification - , _yourID :: Int - , _worldEvents :: [WdWd] - , _delayedEvents :: [(Int,WdWd)] - , _pressPlates :: IM.IntMap PressPlate - , _buttons :: IM.IntMap Button - , _decorations :: IM.IntMap Picture + , _tractorBeams :: [TractorBeam] + , _walls :: IM.IntMap Wall + , _wallDamages :: IM.IntMap [Damage] + , _doors :: IM.IntMap Door + , _machines :: IM.IntMap Machine + , _terminals :: IM.IntMap Terminal + , _magnets :: IM.IntMap Magnet + , _blocks :: IM.IntMap Block + , _coordinates :: IM.IntMap Point2 + , _triggers :: IM.IntMap Bool + , _wlZoning :: IM.IntMap (IM.IntMap IS.IntSet) -- Zoning IM.IntMap Wall + , _floorItems :: IM.IntMap FloorItem + , _floorTiles :: [(Point3, Point3)] + , _modifications :: IM.IntMap Modification + , _yourID :: Int + , _worldEvents :: [WdWd] + , _delayedEvents :: [(Int, WdWd)] + , _pressPlates :: IM.IntMap PressPlate + , _buttons :: IM.IntMap Button + , _decorations :: IM.IntMap Picture , _foregroundShapes :: IM.IntMap ForegroundShape - , _corpses :: IM.IntMap Corpse - , _clickMousePos :: Point2 - , _pathGraph :: Gr Point2 PathEdge - , _pnZoning :: IM.IntMap (IM.IntMap [(Int,Point2)]) --Zoning IM.IntMap Creature - , _peZoning :: IM.IntMap (IM.IntMap [(Int,Int,PathEdge)]) --Zoning IM.IntMap Creature - , _hud :: HUD - , _lightSources :: IM.IntMap LightSource + , _corpses :: IM.IntMap Corpse + , _clickMousePos :: Point2 + , _pathGraph :: Gr Point2 PathEdge + , _pnZoning :: IM.IntMap (IM.IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature + , _peZoning :: IM.IntMap (IM.IntMap [(Int, Int, PathEdge)]) --Zoning IM.IntMap Creature + , _hud :: HUD + , _lightSources :: IM.IntMap LightSource , _tempLightSources :: [TempLightSource] - , _closeObjects :: [Either FloorItem Button] - , _rbOptions :: RightButtonOptions - , _seenLocations :: IM.IntMap (WdP2,String) - , _selLocation :: Int - , _distortions :: [Distortion] - , _worldBounds :: Bounds - , _gameRooms :: [GameRoom] -- consider using an IntMap - , _roomClipping :: [ConvexPoly] - , _maybeWorld :: Maybe' CWorld - , _rewindWorlds :: [CWorld] - , _timeFlow :: TimeFlowStatus - , _worldClock :: Int - , _backspaceTimer :: Int - , _genParams :: GenParams - , _deathDelay :: Maybe Int - , _testFloat :: Float - , _lLine :: (Point2,Point2) - , _rLine :: (Point2,Point2) - , _lSelect :: Point2 - , _rSelect :: Point2 + , _closeObjects :: [Either FloorItem Button] + , _rbOptions :: RightButtonOptions + , _seenLocations :: IM.IntMap (WdP2, String) + , _selLocation :: Int + , _distortions :: [Distortion] + , _worldBounds :: Bounds + , _gameRooms :: [GameRoom] -- consider using an IntMap + , _roomClipping :: [ConvexPoly] + , _maybeWorld :: Maybe' CWorld + , _rewindWorlds :: [CWorld] + , _timeFlow :: TimeFlowStatus + , _worldClock :: Int + , _backspaceTimer :: Int + , _genParams :: GenParams + , _deathDelay :: Maybe Int + , _testFloat :: Float + , _lLine :: (Point2, Point2) + , _rLine :: (Point2, Point2) + , _lSelect :: Point2 + , _rSelect :: Point2 } - deriving (Eq,Show,Read,Generic) + deriving (Eq, Show, Read, Generic) + instance ToJSON CWorld where - toEncoding = genericToEncoding defaultOptions + toEncoding = genericToEncoding defaultOptions + instance FromJSON CWorld + instance ToJSON MouseButton where - toEncoding = genericToEncoding defaultOptions + toEncoding = genericToEncoding defaultOptions + instance FromJSON MouseButton + instance ToJSONKey MouseButton + instance FromJSONKey MouseButton + instance ToJSON Scancode where - toEncoding = genericToEncoding defaultOptions + toEncoding = genericToEncoding defaultOptions + instance FromJSON Scancode + instance ToJSONKey Scancode + instance FromJSONKey Scancode data TimeFlowStatus = RewindingNow | RewindingLastFrame | NormalTimeFlow - deriving (Eq,Ord,Show,Read,Generic) + deriving (Eq, Ord, Show, Read, Generic) + instance ToJSON TimeFlowStatus where toEncoding = genericToEncoding defaultOptions + instance FromJSON TimeFlowStatus + data WorldHammer = SubInvHam | DoubleMouseHam - deriving (Eq,Ord,Show,Read,Enum,Bounded,Generic) + 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 - deriving (Eq,Ord,Show,Read) + deriving (Eq, Ord, Show, Read) + data ScreenLayer = OptionScreen - { _scTitle :: Universe -> String + { _scTitle :: Universe -> String , _scOptions :: [MenuOption] , _scDefaultEff :: Universe -> IO (Maybe Universe) , _scOptionFlag :: OptionScreenFlag , _scOptionsOffset :: Int } - | ColumnsScreen - { _scTitle :: Universe -> String - , _scColumns :: [(String,String)] + | ColumnsScreen + { _scTitle :: Universe -> String + , _scColumns :: [(String, String)] } - | InputScreen - { _scInput :: T.Text + | InputScreen + { _scInput :: T.Text , _scFooter :: String } | WaitScreen { _scWaitMessage :: Universe -> String - , _scWaitTime :: Int + , _scWaitTime :: Int } | DisplayScreen { _scDisplay :: Universe -> Picture } -data MenuOption + +data MenuOption = Toggle - { _moEff :: Universe -> IO (Maybe Universe) - , _moString :: Universe -> Either String (String,String) - , _moKey :: Scancode + { _moEff :: Universe -> IO (Maybe Universe) + , _moString :: Universe -> Either String (String, String) + , _moKey :: Scancode } | Toggle2 - { _moKey1 :: Scancode - , _moEff1 :: Universe -> IO (Maybe Universe) - , _moKey2 :: Scancode - , _moEff2 :: Universe -> IO (Maybe Universe) - , _moString :: Universe -> Either String (String,String) + { _moKey1 :: Scancode + , _moEff1 :: Universe -> IO (Maybe Universe) + , _moKey2 :: Scancode + , _moEff2 :: Universe -> IO (Maybe Universe) + , _moString :: Universe -> Either String (String, String) } | InvisibleToggle - { _moKey :: Scancode - , _moEff :: Universe -> IO (Maybe Universe) + { _moKey :: Scancode + , _moEff :: Universe -> IO (Maybe Universe) } - data IntID a = IntID Int a data WorldBeams = WorldBeams - {_blockingBeams :: [Beam] - ,_lightBeams :: [Beam] - ,_positronBeams :: [Beam] - ,_electronBeams :: [Beam] + { _blockingBeams :: [Beam] + , _lightBeams :: [Beam] + , _positronBeams :: [Beam] + , _electronBeams :: [Beam] } - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON WorldBeams where - toEncoding = genericToEncoding defaultOptions -instance FromJSON WorldBeams + deriving (Eq, Ord, Show, Read, Generic) -{- Objects without ids. -Update themselves, perhaps with side effects. -} ---data Particle = DPart --- = ShockLine --- { _ptUpdate :: World -> Particle -> (World, Maybe Particle) --- , _ptPointDirs :: [[(Point2,Float)]] --- , _ptTimer :: Int --- , _ptColor :: Color --- , _ptCenter :: Point2 --- } ---type HitEffect = Particle --- -> Stream (Of (Point2, Either Creature Wall)) Identity () --- -> World --- -> (World,Maybe Particle) -type HitEffect' = Flame - -> Stream (Of (Point2, Either Creature Wall)) Identity () - -> World - -> (World,Maybe Flame) +instance ToJSON WorldBeams where + toEncoding = genericToEncoding defaultOptions + +instance FromJSON WorldBeams + +type HitEffect' = + Flame -> + Stream (Of (Point2, Either Creature Wall)) Identity () -> + World -> + (World, Maybe Flame) data Either3 a b c = E3x1 a | E3x2 b | E3x3 c ---- ROOM DATATYPES -data PSType = PutCrit {_unPutCrit :: Creature} - | PutMachine { _putMachinePoly :: [Point2], _putMachineMachine :: Machine , _putMachineWall :: Wall} +data PSType + = PutCrit {_unPutCrit :: Creature} + | PutMachine {_putMachinePoly :: [Point2], _putMachineMachine :: Machine, _putMachineWall :: Wall} | PutLS LightSource | PutButton {_putButton :: Button} | PutProp Prop | PutTerminal {_unputTerminal :: Terminal} | PutFlIt {_putItem :: Item} | PutPPlate PressPlate - | PutBlock {_putBlock :: Block, _putWall :: Wall, _putPoly :: [Point2] } + | PutBlock {_putBlock :: Block, _putWall :: Wall, _putPoly :: [Point2]} | PutCoord Point2 | PutMod Modification | PutTrigger Bool - | PutLineBlock {_putWall :: Wall , _putWidth :: Float - , _putStartPoint :: Point2, _putEndPoint :: Point2} - | PutWall { _pwPoly :: [Point2] , _pwWall :: Wall } + | PutLineBlock + { _putWall :: Wall + , _putWidth :: Float + , _putStartPoint :: Point2 + , _putEndPoint :: Point2 + } + | PutWall {_pwPoly :: [Point2], _pwWall :: Wall} | PutSlideDr Door Wall EdgeObstacle Float Point2 Point2 - | PutDoor Color EdgeObstacle WdBl [(Point2,Point2)] + | PutDoor Color EdgeObstacle WdBl [(Point2, Point2)] | RandPS (State StdGen PSType) | PutForeground ForegroundShape | PutDecoration Picture | PutWorldUpdate (PlacementSpot -> World -> World) | PutNothing - | PutUsingGenParams (World -> (World,PSType)) - | PutID { _putID :: Int} + | PutUsingGenParams (World -> (World, PSType)) + | PutID {_putID :: Int} + -- maybe there is a monadic implementation of this? -- add room effect for any placement spot? -data PlacementSpot - = PS { _psPos :: Point2 , _psRot :: Float } - | PSNoShiftCont { _psPos :: Point2 , _psRot :: Float } - | PSPos - { _psSelect :: RoomPos -> Room -> Maybe (PlacementSpot, RoomPos) - , _psRoomEff :: RoomPos -> Room -> Room - , _psFallback :: Maybe Placement +data PlacementSpot + = PS {_psPos :: Point2, _psRot :: Float} + | PSNoShiftCont {_psPos :: Point2, _psRot :: Float} + | PSPos + { _psSelect :: RoomPos -> Room -> Maybe (PlacementSpot, RoomPos) + , _psRoomEff :: RoomPos -> Room -> Room + , _psFallback :: Maybe Placement } - | PSRoomRand - { _psRoomRandPointNum :: Int - , _psRandShift :: (Point2,Float) -> PlacementSpot + | PSRoomRand + { _psRoomRandPointNum :: Int + , _psRandShift :: (Point2, Float) -> PlacementSpot } + -- TODO attempt to unify/simplify this union type -data Placement +data Placement = Placement - { _plOrder :: Int - , _plSpot :: PlacementSpot - , _plType :: PSType - , _plMID :: Maybe Int - , _plIDCont :: World -> Placement -> Maybe Placement + { _plOrder :: Int + , _plSpot :: PlacementSpot + , _plType :: PSType + , _plMID :: Maybe Int + , _plIDCont :: World -> Placement -> Maybe Placement } - | PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position + | PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position | RandomPlacement {_unRandomPlacement :: State StdGen Placement} | PickOnePlacement Int Placement @@ -481,45 +485,49 @@ Placement spots allow things to be put in the room during level generation. Room bounds between a new room and previously placed rooms are checked during level generation, assigning no bounds will allow rooms to overlap. -} data Room = Room - { _rmPolys :: [ [Point2] ] - , _rmLinks :: [RoomLink] - -- the Int is the number of previous outlinks that have been assigned - , _rmLinkEff - :: RoomLink -- ^ child link - -> Room -- ^ child room - -> Int -- ^ child number - -> RoomLink -- ^ parent link - -> Room -- ^ parent room - -> Room - , _rmPos :: [RoomPos] - , _rmPath :: S.Set (Point2, Point2) - , _rmPmnts :: [Placement] - , _rmInPmnt :: [InPlacement] - , _rmOutPmnt :: [OutPlacement] - , _rmBound :: [ [Point2] ] - , _rmFloor :: Floor - , _rmName :: String - , _rmShift :: (Point2, Float) + { _rmPolys :: [[Point2]] + , _rmLinks :: [RoomLink] + , -- the Int is the number of previous outlinks that have been assigned + _rmLinkEff :: + RoomLink -> -- child link + Room -> -- child room + Int -> -- child number + RoomLink -> -- parent link + Room -> -- parent room + Room + , _rmPos :: [RoomPos] + , _rmPath :: S.Set (Point2, Point2) + , _rmPmnts :: [Placement] + , _rmInPmnt :: [InPlacement] + , _rmOutPmnt :: [OutPlacement] + , _rmBound :: [[Point2]] + , _rmFloor :: Floor + , _rmName :: String + , _rmShift :: (Point2, Float) , _rmViewpoints :: [Point2] - , _rmRandPSs :: [State StdGen (Point2,Float)] + , _rmRandPSs :: [State StdGen (Point2, Float)] , _rmStartWires :: IM.IntMap RoomWire - , _rmEndWires :: IM.IntMap RoomWire + , _rmEndWires :: IM.IntMap RoomWire , _rmConnectsTo :: S.Set RoomLinkType -> Bool - , _rmMID :: Maybe Int - , _rmMParent :: Maybe Int - , _rmChildren :: [Int] - , _rmType :: RoomType + , _rmMID :: Maybe Int + , _rmMParent :: Maybe Int + , _rmChildren :: [Int] + , _rmType :: RoomType , _rmClusterStatus :: ClusterStatus } + data OutPlacement = OutPlacement { _opPlacement :: Placement , _opPlacementID :: Int } + data InPlacement = InPlacement { _ipPlacement :: [Placement] -> Placement , _ipPlacementID :: Int } + makeLenses ''World + --makeLenses ''Particle makeLenses ''Universe makeLenses ''ScreenLayer diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index 416f47210..1ac0d40dd 100644 --- a/src/Dodge/Data/Creature.hs +++ b/src/Dodge/Data/Creature.hs @@ -18,7 +18,6 @@ import Dodge.Data.Hammer import Dodge.Creature.Perception.Data import Dodge.Creature.Memory.Data import Dodge.Creature.Stance.Data -import Dodge.Creature.State.Data import Geometry.Data import qualified IntMapHelp as IM import qualified Data.Map.Strict as M diff --git a/src/Dodge/Data/Creature/State.hs b/src/Dodge/Data/Creature/State.hs index e71a249ca..97cfcb275 100644 --- a/src/Dodge/Data/Creature/State.hs +++ b/src/Dodge/Data/Creature/State.hs @@ -1,19 +1,81 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} + module Dodge.Data.Creature.State where -import GHC.Generics -import Data.Aeson -import Dodge.Data.Damage -import Dodge.Creature.State.Data + +import Color import Control.Lens -data CreatureState = CrSt - { _csDamage :: [Damage] +import Data.Aeson +import qualified Data.IntSet as IS +import Dodge.Data.Damage +import GHC.Generics +import Geometry.Data + +data CreatureState = CrSt + { _csDamage :: [Damage] , _csSpState :: CrSpState , _csDropsOnDeath :: CreatureDropType } - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON CreatureState where + deriving (Eq, Ord, Show, Read, Generic) + +instance ToJSON CreatureState where toEncoding = genericToEncoding defaultOptions -instance FromJSON CreatureState + +instance FromJSON CreatureState + +data CreatureDropType + = DropAll + | DropAmount Int + | DropSpecific [Int] + deriving (Eq, Ord, Show, Read, Generic) + +instance ToJSON CreatureDropType where + toEncoding = genericToEncoding defaultOptions + +instance FromJSON CreatureDropType + +data CrSpState + = Barrel {_piercedPoints :: [Point2]} + | GenCr + deriving (Eq, Ord, Show, Read, Generic) + +instance ToJSON CrSpState where + toEncoding = genericToEncoding defaultOptions + +instance FromJSON CrSpState + +data Faction + = GenericFaction Int + | ZombieFaction + | EncircleFlock + | ChaseCritters + | SpawnedBy Int + | NoFaction + | ColorFaction Color + | PlayerFaction + deriving (Eq, Ord, Show, Read, Generic) + +instance ToJSON Faction where + toEncoding = genericToEncoding defaultOptions + +instance FromJSON Faction + +data CrGroup + = LoneWolf + | Swarm + { _swarm :: IS.IntSet + , _crGroupID :: Int + } + | CrGroupID {_crGroupID :: Int} + | ShieldGroup + deriving (Eq, Ord, Show, Read, Generic) + +instance ToJSON CrGroup where + toEncoding = genericToEncoding defaultOptions + +instance FromJSON CrGroup + makeLenses ''CreatureState +makeLenses ''CrSpState +makeLenses ''CrGroup diff --git a/src/Dodge/Data/Item.hs b/src/Dodge/Data/Item.hs index 8615e9fd0..4f3eacd5d 100644 --- a/src/Dodge/Data/Item.hs +++ b/src/Dodge/Data/Item.hs @@ -7,10 +7,14 @@ module Dodge.Data.Item , module Dodge.Data.Item.Tweak , module Dodge.Data.Item.Params , module Dodge.Data.Item.Use + , module Dodge.Data.Item.Consumption + , module Dodge.Data.Item.CurseStatus + , module Dodge.Data.Item.Attachment ) where import GHC.Generics import Data.Aeson import Control.Lens +import Dodge.Data.Item.CurseStatus import Dodge.Data.Item.Misc import Dodge.Data.Item.Tweak import Dodge.Data.Item.Consumption @@ -18,12 +22,9 @@ import Dodge.Data.Item.Use import Dodge.Data.Item.Params import Dodge.Data.ItEffect import Dodge.Data.Targeting -import Dodge.Item.Data import Dodge.Combine.Data -import Dodge.Item.Attachment.Data +import Dodge.Data.Item.Attachment import Color - -import qualified IntMapHelp as IM data Item = Item { _itConsumption :: ItemConsumption , _itUse :: ItemUse @@ -47,15 +48,4 @@ data Item = Item instance ToJSON Item where toEncoding = genericToEncoding defaultOptions instance FromJSON Item -data ItemTweaks - = NoTweaks - | Tweakable - { _tweakParams :: IM.IntMap TweakParam - , _tweakSel :: Int - } - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON ItemTweaks where - toEncoding = genericToEncoding defaultOptions -instance FromJSON ItemTweaks makeLenses ''Item -makeLenses ''ItemTweaks diff --git a/src/Dodge/Item/Attachment/Data.hs b/src/Dodge/Data/Item/Attachment.hs similarity index 97% rename from src/Dodge/Item/Attachment/Data.hs rename to src/Dodge/Data/Item/Attachment.hs index 70e33417d..13e8236df 100644 --- a/src/Dodge/Item/Attachment/Data.hs +++ b/src/Dodge/Data/Item/Attachment.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} -module Dodge.Item.Attachment.Data +module Dodge.Data.Item.Attachment where import GHC.Generics import Data.Aeson diff --git a/src/Dodge/Item/Data.hs b/src/Dodge/Data/Item/CurseStatus.hs similarity index 89% rename from src/Dodge/Item/Data.hs rename to src/Dodge/Data/Item/CurseStatus.hs index 0cc70281c..ac2d2e016 100644 --- a/src/Dodge/Item/Data.hs +++ b/src/Dodge/Data/Item/CurseStatus.hs @@ -1,7 +1,8 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} --{-# LANGUAGE TemplateHaskell #-} -module Dodge.Item.Data where +module Dodge.Data.Item.CurseStatus + where import GHC.Generics import Data.Aeson data CurseStatus diff --git a/src/Dodge/Data/Item/HeldUse.hs b/src/Dodge/Data/Item/HeldUse.hs index d7211b520..077012cc5 100644 --- a/src/Dodge/Data/Item/HeldUse.hs +++ b/src/Dodge/Data/Item/HeldUse.hs @@ -1,11 +1,15 @@ -{-# LANGUAGE StrictData #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StrictData #-} + module Dodge.Data.Item.HeldUse where -import GHC.Generics + import Data.Aeson import Dodge.Combine.Data import Dodge.Data.CamouflageStatus -data HeldUse = HeldDoNothing +import GHC.Generics + +data HeldUse + = HeldDoNothing | HeldUseAmmoParams | HeldOverNozzlesUseGasParams | HeldPJCreation @@ -20,41 +24,43 @@ data HeldUse = HeldDoNothing | HeldTractor | HeldForceField | HeldShatter - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON HeldUse where + deriving (Eq, Ord, Show, Read, Generic) +instance ToJSON HeldUse where toEncoding = genericToEncoding defaultOptions -instance FromJSON HeldUse -data Cuse = CDoNothing +instance FromJSON HeldUse +data Cuse + = CDoNothing | CHeal Int - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON Cuse where + deriving (Eq, Ord, Show, Read, Generic) +instance ToJSON Cuse where toEncoding = genericToEncoding defaultOptions -instance FromJSON Cuse -data Euse = EDoNothing +instance FromJSON Cuse +data Euse + = EDoNothing | EDetector Detector | EMagShield | EWristShield | EHeadLamp | ECamouflage CamouflageStatus - | EonWristShield - | EoffWristShield - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON Euse where + deriving (Eq, Ord, Show, Read, Generic) +instance ToJSON Euse where toEncoding = genericToEncoding defaultOptions -instance FromJSON Euse -data Luse = LDoNothing +instance FromJSON Euse +data Luse + = LDoNothing | LRewind | LShrink | LBlink | LUnsafeBlink | LBoost - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON Luse where + deriving (Eq, Ord, Show, Read, Generic) +instance ToJSON Luse where toEncoding = genericToEncoding defaultOptions -instance FromJSON Luse -data HeldMod = HeldModNothing +instance FromJSON Luse +data HeldMod + = HeldModNothing | PoisonSprayerMod | FlameSpitterMod | FlameThrowerMod @@ -73,12 +79,12 @@ data HeldMod = HeldModNothing | VolleyGunMod | AutoRifleMod | BangRodMod - | ElephantGunMod - | AutoAmrMod - | MachineGunMod + | ElephantGunMod + | AutoAmrMod + | MachineGunMod | ModWithDirectedTeleport HeldMod - | BangStickMod - | PistolMod + | BangStickMod + | PistolMod | AutoPistolMod | MachinePistolMod | BurstRifleMod @@ -86,7 +92,7 @@ data HeldMod = HeldModNothing | SmgMod | RevolverXMod | BangConeMod - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON HeldMod where + deriving (Eq, Ord, Show, Read, Generic) +instance ToJSON HeldMod where toEncoding = genericToEncoding defaultOptions -instance FromJSON HeldMod +instance FromJSON HeldMod diff --git a/src/Dodge/Data/Item/Tweak.hs b/src/Dodge/Data/Item/Tweak.hs index 3a8cd1d54..d15e71ef4 100644 --- a/src/Dodge/Data/Item/Tweak.hs +++ b/src/Dodge/Data/Item/Tweak.hs @@ -5,6 +5,17 @@ module Dodge.Data.Item.Tweak where import GHC.Generics import Data.Aeson import Control.Lens +import qualified IntMapHelp as IM +data ItemTweaks + = NoTweaks + | Tweakable + { _tweakParams :: IM.IntMap TweakParam + , _tweakSel :: Int + } + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON ItemTweaks where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ItemTweaks data TweakType = TweakPhaseV | TweakTractionPower | TweakSpinDrag @@ -24,3 +35,4 @@ instance ToJSON TweakParam where toEncoding = genericToEncoding defaultOptions instance FromJSON TweakParam makeLenses ''TweakParam +makeLenses ''ItemTweaks diff --git a/src/Dodge/Data/Item/Use.hs b/src/Dodge/Data/Item/Use.hs index d9dda05ef..bf268adb0 100644 --- a/src/Dodge/Data/Item/Use.hs +++ b/src/Dodge/Data/Item/Use.hs @@ -1,75 +1,80 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} -module Dodge.Data.Item.Use - ( module Dodge.Data.Item.Use - , module Dodge.Data.Equipment - ) - where -import GHC.Generics -import Data.Aeson -import Dodge.Data.Item.HeldUse -import Dodge.Data.Item.HeldScroll -import Dodge.Data.Item.UseDelay -import Dodge.Data.Hammer -import Dodge.Data.Equipment +{-# LANGUAGE TemplateHaskell #-} + +module Dodge.Data.Item.Use ( + module Dodge.Data.Item.Use, + module Dodge.Data.Item.Use.Equipment, + module Dodge.Data.Item.HeldUse, + module Dodge.Data.Item.HeldScroll, + module Dodge.Data.Item.UseDelay, +) where + import Control.Lens +import Data.Aeson +import Dodge.Data.Hammer +import Dodge.Data.Item.HeldScroll +import Dodge.Data.Item.HeldUse +import Dodge.Data.Item.Use.Equipment +import Dodge.Data.Item.UseDelay +import GHC.Generics + data ItemUse - = RightUse - { _rUse :: HeldUse -- Item -> Creature -> World -> World - , _useDelay :: UseDelay - , _useMods :: HeldMod --[(Item -> Creature -> World -> World) -> Item -> Creature -> World -> World] - , _useHammer :: HammerPosition - , _useAim :: AimParams - , _heldScroll :: HeldScroll --Float -> Creature -> Item -> Item + = RightUse + { _rUse :: HeldUse + , _useDelay :: UseDelay + , _useMods :: HeldMod + , _useHammer :: HammerPosition + , _useAim :: AimParams + , _heldScroll :: HeldScroll } - | LeftUse - { _lUse :: Luse --Item -> Creature -> World -> World - , _useDelay :: UseDelay - , _useHammer :: HammerPosition - , _eqEq :: Equipment + | LeftUse + { _lUse :: Luse + , _useDelay :: UseDelay + , _useHammer :: HammerPosition + , _eqEq :: Equipment } - | ConsumeUse - { _cUse :: Cuse --Item -> Creature -> World -> World + | ConsumeUse + { _cUse :: Cuse } - | EquipUse + | EquipUse { _eqEq :: Equipment } | NoUse - deriving (Eq,Ord,Show,Read,Generic) + deriving (Eq, Ord, Show, Read, Generic) instance ToJSON ItemUse where toEncoding = genericToEncoding defaultOptions instance FromJSON ItemUse data AimParams = AimParams - { _aimWeight :: Int - , _aimRange :: Float - , _aimZoom :: ItZoom - , _aimStance :: AimStance + { _aimWeight :: Int + , _aimRange :: Float + , _aimZoom :: ItZoom + , _aimStance :: AimStance , _aimHandlePos :: Float - , _aimMuzPos :: Float + , _aimMuzPos :: Float } - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON AimParams where + deriving (Eq, Ord, Show, Read, Generic) +instance ToJSON AimParams where toEncoding = genericToEncoding defaultOptions -instance FromJSON AimParams +instance FromJSON AimParams data AimStance = TwoHandTwist | TwoHandFlat | OneHand | LeaveHolstered - deriving (Eq,Show,Ord,Enum,Read,Generic) + deriving (Eq, Show, Ord, Enum, Read, Generic) instance ToJSON AimStance where toEncoding = genericToEncoding defaultOptions instance FromJSON AimStance -data ItZoom = ItZoom - { _itZoomMax :: Float - , _itZoomMin :: Float - , _itZoomFac :: Float +data ItZoom = ItZoom + { _itZoomMax :: Float + , _itZoomMin :: Float + , _itZoomFac :: Float } - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON ItZoom where + deriving (Eq, Ord, Show, Read, Generic) +instance ToJSON ItZoom where toEncoding = genericToEncoding defaultOptions -instance FromJSON ItZoom +instance FromJSON ItZoom makeLenses ''ItemUse makeLenses ''AimParams makeLenses ''ItZoom diff --git a/src/Dodge/Data/Equipment.hs b/src/Dodge/Data/Item/Use/Equipment.hs similarity index 92% rename from src/Dodge/Data/Equipment.hs rename to src/Dodge/Data/Item/Use/Equipment.hs index f700c81ba..0da183070 100644 --- a/src/Dodge/Data/Equipment.hs +++ b/src/Dodge/Data/Item/Use/Equipment.hs @@ -1,9 +1,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE DeriveGeneric #-} -module Dodge.Data.Equipment +module Dodge.Data.Item.Use.Equipment ( module Dodge.Data.Equipment.Misc - , module Dodge.Data.Equipment + , module Dodge.Data.Item.Use.Equipment ) where import Dodge.Data.Item.HeldUse