Refactor machines

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

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

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

src/Dodge/Default.hs

@@ -45,8 +45,7 @@ defaultMachine :: Machine
 defaultMachine = Machine
     { _mcID = 0
     , _mcWallIDs = mempty
---    , _mcUpdate = defaultMachineUpdate
+    , _mcDraw = MachineDrawMempty
-    , _mcDraw = const mempty
     , _mcColor = white
     , _mcPos = V2 0 0
     , _mcDir = 0

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
+

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}
 

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

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

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
     )

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