justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Refactor machines

Browse Source
This commit is contained in:
justin
2022-07-24 20:55:44 +01:00
parent d6a94ec4bc
commit 24531b75a1
10 changed files with 110 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+5 -35
View File
@@ -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
src/Dodge/Data/GenParams.hs
+15
View File
@@ -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
src/Dodge/Data/Machine.hs
+49
View File
@@ -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
src/Dodge/Default.hs
+1 -2
View File
@@ -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
src/Dodge/Machine/Draw.hs
+33
View File
@@ -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
src/Dodge/Placement/Instance/Analyser.hs
+1 -1
View File
@@ -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}
src/Dodge/Placement/Instance/Sensor.hs
+2 -1
View File
@@ -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
src/Dodge/Placement/Instance/Terminal.hs
+1 -18
View File
@@ -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
src/Dodge/Placement/Instance/Turret.hs
+1 -1
View File
@@ -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
)
src/Dodge/Render/ShapePicture.hs
+2 -1
View File
@@ -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