From 24531b75a1f0698ffcac6039bedc68d786a2c0dc Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 24 Jul 2022 20:55:44 +0100 Subject: [PATCH] Refactor machines --- src/Dodge/Data.hs | 40 +++---------------- src/Dodge/Data/GenParams.hs | 15 ++++++++ src/Dodge/Data/Machine.hs | 49 ++++++++++++++++++++++++ src/Dodge/Default.hs | 3 +- src/Dodge/Machine/Draw.hs | 33 ++++++++++++++++ src/Dodge/Placement/Instance/Analyser.hs | 2 +- src/Dodge/Placement/Instance/Sensor.hs | 3 +- src/Dodge/Placement/Instance/Terminal.hs | 19 +-------- src/Dodge/Placement/Instance/Turret.hs | 2 +- src/Dodge/Render/ShapePicture.hs | 3 +- 10 files changed, 110 insertions(+), 59 deletions(-) create mode 100644 src/Dodge/Data/GenParams.hs create mode 100644 src/Dodge/Data/Machine.hs create mode 100644 src/Dodge/Machine/Draw.hs diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 4ab8dfcb6..300e1ccf6 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -84,7 +84,11 @@ module Dodge.Data , module Dodge.Data.LinearShockwave , module Dodge.Data.TractorBeam , module Dodge.Data.MountedObject + , module Dodge.Data.Machine + , module Dodge.Data.GenParams ) where +import Dodge.Data.GenParams +import Dodge.Data.Machine import Dodge.Data.MountedObject import Dodge.Data.TractorBeam import Dodge.Data.LinearShockwave @@ -161,7 +165,6 @@ import Dodge.Item.Attachment.Data import Dodge.Item.Data import Data.Preload import Picture.Data -import ShapePicture import Geometry.Data import Geometry.ConvexPoly import Sound.Data @@ -294,18 +297,12 @@ data World = World , _lSelect :: Point2 , _rSelect :: Point2 } - --deriving (Eq,Ord,Show,Read) + --deriving (Eq,Show,Read) data WorldHammer = SubInvHam | DoubleMouseHam deriving (Eq,Ord,Show,Read,Enum,Bounded) -newtype GenParams = GenParams - { _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape) - } - deriving (Eq,Ord,Show,Read) -data DecorationShape = PLUS | SQUARE | CIRCLE | THREELINES - deriving (Eq,Ord,Enum,Show,Read) data TimeFlowStatus = RewindingNow @@ -434,30 +431,6 @@ data TerminalToggle = TerminalToggle { _ttTriggerID :: Int , _ttDeathEffect :: Bool -> Bool } -data Machine = Machine - { _mcID :: Int - , _mcWallIDs :: IS.IntSet - , _mcDraw :: Machine -> SPic - , _mcMaterial :: Material - , _mcPos :: Point2 - , _mcDir :: Float - , _mcColor :: Color - , _mcHP :: Int - , _mcSensor :: Sensor - , _mcDamage :: [Damage] - , _mcType :: MachineType - , _mcMounts :: M.Map Object Int - , _mcName :: String - , _mcCloseSound :: Maybe SoundID - } -data MachineType - = StaticMachine - | Turret - { _tuWeapon :: Item - , _tuTurnSpeed :: Float - , _tuFireTime :: Int - , _tuMCrID :: Maybe Int - } data EffectArguments = NoArguments {_cmdEffect :: [TerminalLine]} @@ -575,8 +548,6 @@ makeLenses ''World makeLenses ''FloorItem --makeLenses ''Particle makeLenses ''Terminal -makeLenses ''Machine -makeLenses ''MachineType makeLenses ''Universe makeLenses ''GunBarrels makeLenses ''Nozzle @@ -586,7 +557,6 @@ makeLenses ''ScreenLayer makeLenses ''WorldBeams makeLenses ''TerminalCommand makeLenses ''TerminalInput -makeLenses ''GenParams ----- ROOM LENSES makeLenses ''Room diff --git a/src/Dodge/Data/GenParams.hs b/src/Dodge/Data/GenParams.hs new file mode 100644 index 000000000..2a60ed40a --- /dev/null +++ b/src/Dodge/Data/GenParams.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data.GenParams + where +import Color +import Dodge.Data.Damage.Type +import Control.Lens +import qualified Data.Map.Strict as M +newtype GenParams = GenParams + { _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape) + } + deriving (Eq,Ord,Show,Read) +data DecorationShape = PLUS | SQUARE | CIRCLE | THREELINES + deriving (Eq,Ord,Enum,Show,Read) +makeLenses ''GenParams diff --git a/src/Dodge/Data/Machine.hs b/src/Dodge/Data/Machine.hs new file mode 100644 index 000000000..8e10773dd --- /dev/null +++ b/src/Dodge/Data/Machine.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data.Machine + where +import Dodge.Data.GenParams +import Dodge.Data.Item +import Sound.Data +import Dodge.Data.Object +import Dodge.Data.Damage +import Dodge.Data.Sensor +import Geometry.Data +import Color +import Dodge.Data.Material +import qualified Data.IntSet as IS + +import qualified Data.Map.Strict as M +import Control.Lens + +data MachineDraw = MachineDrawMempty + | MachineDrawTerminal + | MachineDrawTurret + | MachineDrawDamageSensor Float (PaletteColor,DecorationShape) +data Machine = Machine + { _mcID :: Int + , _mcWallIDs :: IS.IntSet + , _mcDraw :: MachineDraw --Machine -> SPic + , _mcMaterial :: Material + , _mcPos :: Point2 + , _mcDir :: Float + , _mcColor :: Color + , _mcHP :: Int + , _mcSensor :: Sensor + , _mcDamage :: [Damage] + , _mcType :: MachineType + , _mcMounts :: M.Map Object Int + , _mcName :: String + , _mcCloseSound :: Maybe SoundID + } +data MachineType + = StaticMachine + | Turret + { _tuWeapon :: Item + , _tuTurnSpeed :: Float + , _tuFireTime :: Int + , _tuMCrID :: Maybe Int + } + +makeLenses ''Machine +makeLenses ''MachineType diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index b3e3d0d39..757833aa7 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -45,8 +45,7 @@ defaultMachine :: Machine defaultMachine = Machine { _mcID = 0 , _mcWallIDs = mempty --- , _mcUpdate = defaultMachineUpdate - , _mcDraw = const mempty + , _mcDraw = MachineDrawMempty , _mcColor = white , _mcPos = V2 0 0 , _mcDir = 0 diff --git a/src/Dodge/Machine/Draw.hs b/src/Dodge/Machine/Draw.hs new file mode 100644 index 000000000..be3e132aa --- /dev/null +++ b/src/Dodge/Machine/Draw.hs @@ -0,0 +1,33 @@ +module Dodge.Machine.Draw + where +import Dodge.Placement.Instance.Sensor +import Dodge.Placement.Instance.Turret +import Shape +import Picture +import Geometry +import Dodge.Data.Machine +import ShapePicture + +drawMachine :: MachineDraw -> Machine -> SPic +drawMachine md = case md of + MachineDrawMempty -> const mempty + MachineDrawTerminal -> terminalSPic + MachineDrawTurret -> drawTurret + MachineDrawDamageSensor w pcds -> sensorSPic w pcds +terminalSPic :: Machine -> SPic +terminalSPic = noPic . terminalShape + +terminalShape :: Machine -> Shape +terminalShape mc = colorSH col (prismPoly + [V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10] + [V3 10 10 0, V3 (-10) 10 0, V3 (-10) (-10) 0, V3 10 (-10) 0] + ) + <> colorSH black (prismPoly + [V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10] + [V3 8 8 19, V3 (-8) 8 19, V3 0 (-8) 9] + --[V3 8 8 20, V3 (-8) 8 20, V3 (-8) (-8) 10, V3 8 (-8) 10] + --[V3 8 8 19, V3 (-8) 8 19, V3 (-8) (-8) 9, V3 8 (-8) 9] + ) + where + col = _mcColor mc + diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index 850d1acb7..8aa51b075 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -53,7 +53,7 @@ analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp -> -- = triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc) themachine = defaultMachine & mcColor .~ aquamarine -- & mcUpdate .~ mcProximitySensorUpdate - & mcDraw .~ terminalSPic + & mcDraw .~ MachineDrawTerminal & mcHP .~ 100 & mcSensor .~ defaultProximitySensor {_proxRequirement = proxreq} diff --git a/src/Dodge/Placement/Instance/Sensor.hs b/src/Dodge/Placement/Instance/Sensor.hs index 111064765..9ac3aa177 100644 --- a/src/Dodge/Placement/Instance/Sensor.hs +++ b/src/Dodge/Placement/Instance/Sensor.hs @@ -1,6 +1,7 @@ module Dodge.Placement.Instance.Sensor ( lightSensor , damageSensor + , sensorSPic -- this should be moved ) where import Color import Dodge.LightSource @@ -28,7 +29,7 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) & mcColor .~ yellow & mcMounts . at ObTrigger .~ mtrid & mcMounts . at ObLightSource ?~ lsid - & mcDraw .~ sensorSPic wdth (_sensorCoding (_genParams gw) M.! dt) + & mcDraw .~ MachineDrawDamageSensor wdth (_sensorCoding (_genParams gw) M.! dt) & mcSensor .~ DamageSensor False 0 dt ) defaultSensorWall diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 1c0df34d0..0dbf3b7bd 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -4,7 +4,6 @@ module Dodge.Placement.Instance.Terminal , putTerminal , simpleTermMessage , terminalColor - , terminalSPic , accessTerminal ) where import Dodge.Data @@ -48,7 +47,7 @@ putTerminal mc tm putMessageTerminal :: Color -> Terminal -> Placement putMessageTerminal col = putTerminal $ defaultMachine & mcColor .~ col - & mcDraw .~ terminalSPic + & mcDraw .~ MachineDrawTerminal --terminalSPic & mcHP .~ 100 termButton :: Button @@ -68,22 +67,6 @@ termButton = Button terminalColor :: Color terminalColor = dark magenta -terminalSPic :: Machine -> SPic -terminalSPic = noPic . terminalShape - -terminalShape :: Machine -> Shape -terminalShape mc = colorSH col (prismPoly - [V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10] - [V3 10 10 0, V3 (-10) 10 0, V3 (-10) (-10) 0, V3 10 (-10) 0] - ) - <> colorSH black (prismPoly - [V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10] - [V3 8 8 19, V3 (-8) 8 19, V3 0 (-8) 9] - --[V3 8 8 20, V3 (-8) 8 20, V3 (-8) (-8) 10, V3 8 (-8) 10] - --[V3 8 8 19, V3 (-8) 8 19, V3 (-8) (-8) 9, V3 8 (-8) 9] - ) - where - col = _mcColor mc accessTerminal :: Maybe Int -> World -> World accessTerminal mtmid w = case mtmid of diff --git a/src/Dodge/Placement/Instance/Turret.hs b/src/Dodge/Placement/Instance/Turret.hs index fe7118f40..35cd57109 100644 --- a/src/Dodge/Placement/Instance/Turret.hs +++ b/src/Dodge/Placement/Instance/Turret.hs @@ -22,7 +22,7 @@ putLasTurret :: Float -> Placement putLasTurret rotSpeed = sps0 $ PutMachine (reverse $ square wdth) (defaultMachine & mcColor .~ blue - & mcDraw .~ drawTurret + & mcDraw .~ MachineDrawTurret & mcType .~ (lasTurret & tuTurnSpeed .~ rotSpeed) & mcHP .~ 50000 ) diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 25c2df9ef..057987a04 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -1,6 +1,7 @@ module Dodge.Render.ShapePicture ( worldSPic ) where +import Dodge.Machine.Draw import Dodge.LinearShockwave.Draw import Dodge.Prop.Draw import Dodge.TractorBeam.Draw @@ -320,7 +321,7 @@ btSPic bt = uncurryV translateSPf (_btPos bt) $ rotateSP (_btRot bt) (drawButton (_btPict bt) bt) mcSPic :: Machine -> SPic mcSPic bt = uncurryV translateSPf (_mcPos bt) - $ rotateSP (_mcDir bt) (_mcDraw bt bt) + $ rotateSP (_mcDir bt) (drawMachine (_mcDraw bt) bt) soundPic :: Configuration -> World -> Sound -> Picture soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w