Reify cloud drawing, move gust data

src/Dodge/Cloud/Draw.hs

@@ -0,0 +1,18 @@
+module Dodge.Cloud.Draw
+    where
+import Dodge.Data.Cloud
+import Picture
+
+drawCloud :: CloudDraw -> Cloud -> Picture
+drawCloud cd = case cd of
+    CloudColor radmult fadet col -> drawCloudWith radmult fadet col
+    DrawGasCloud col -> const . setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col) 
+                                          $ circleSolid 20
+
+drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
+drawCloudWith radMult fadet col cl = setLayer MidLayer 
+    . setDepth 25
+    $ circleSolidCol (withAlpha 0 col) (withAlpha a col) (radMult * _clRad cl)
+  where 
+    a = min 1 $ fromIntegral (_clTimer cl) / fadet
+

src/Dodge/Data.hs

@@ -73,7 +73,9 @@ module Dodge.Data
     , module Dodge.Data.Room
     , module Dodge.Data.RadarBlip
     , module Dodge.Data.PathGraph
+    , module Dodge.Data.Gust
     ) where
+import Dodge.Data.Gust
 import Dodge.Data.CrGroupParams
 import Dodge.Data.Corpse
 import Dodge.Data.ActionPlan
@@ -332,12 +334,6 @@ data MenuOption
         { _moKey    :: Scancode
         , _moEff    :: Universe -> IO (Maybe Universe)
         }
-data Gust = Gust
-    { _guID  :: Int
-    , _guPos :: Point2
-    , _guVel :: Point2
-    , _guTime :: Int
-    }
 data TerminalLine
     = TerminalLineDisplay
         {_tlPause :: Int
@@ -736,7 +732,6 @@ makeLenses ''Terminal
 makeLenses ''Machine
 makeLenses ''MachineType
 makeLenses ''Universe
-makeLenses ''Gust
 makeLenses ''GunBarrels
 makeLenses ''Nozzle
 makeLenses ''TerminalLine

src/Dodge/Data/Cloud.hs

@@ -2,19 +2,26 @@
 {-# LANGUAGE StrictData #-}
 module Dodge.Data.Cloud where
 import Geometry
-import Picture
+import Color
 import Control.Lens
+
+data CloudDraw = CloudColor Float Float Color -- radius-multiply fade-time color
+    | DrawGasCloud Color
+  deriving (Eq,Ord,Show,Read)
+
 data Cloud = Cloud
     { _clPos :: Point3
     , _clVel :: Point3
-    , _clPict :: Cloud -> Picture
+    , _clPict :: CloudDraw
     , _clRad :: Float
     , _clAlt :: Float
     , _clTimer :: Int
     , _clType :: CloudType
 --    , _clEffect :: Cloud -> World -> World
     }
+  deriving (Eq,Ord,Show,Read)
 data CloudType
     = SmokeCloud
     | GasCloud
+  deriving (Eq,Ord,Show,Read)
 makeLenses ''Cloud

src/Dodge/Data/Gust.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.Gust
+    where
+import Geometry.Data
+import Control.Lens
+data Gust = Gust
+    { _guID  :: Int
+    , _guPos :: Point2
+    , _guVel :: Point2
+    , _guTime :: Int
+    }
+  deriving (Eq,Ord,Show,Read)
+makeLenses ''Gust

src/Dodge/Data/HUD.hs

@@ -6,6 +6,7 @@ import Control.Lens
 data HUDElement 
     = DisplayInventory {_subInventory :: SubInventory}
     | DisplayCarte
+  deriving (Eq,Ord,Show,Read)
 --  deriving (Eq,Ord,Show)
 
 data SubInventory 
@@ -15,6 +16,7 @@ data SubInventory
     | InspectInventory
     | LockedInventory
     | DisplayTerminal {_termID :: Int }
+  deriving (Eq,Ord,Show,Read)
 --  deriving (Eq,Ord,Show)
 
 data HUD = HUD
@@ -23,6 +25,7 @@ data HUD = HUD
     , _carteZoom    :: Float
     , _carteRot     :: Float
     }
+  deriving (Eq,Ord,Show,Read)
 makeLenses ''HUD
 makeLenses ''HUDElement
 makeLenses ''SubInventory

src/Dodge/Render/ShapePicture.hs

@@ -1,6 +1,7 @@
 module Dodge.Render.ShapePicture
     ( worldSPic
     ) where
+import Dodge.Cloud.Draw
 import Dodge.Zoning
 import Dodge.Button.Draw
 import Dodge.LightSource.Draw
@@ -297,7 +298,7 @@ drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x:xs) ++ [x]
     (x:xs) = _boundBox w
 
 clDraw :: Cloud -> Picture
-clDraw c = translate3 (_clPos c) (_clPict c c)
+clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c)
 ppDraw :: PressPlate -> Picture
 ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
 floorItemSPic :: FloorItem -> SPic

src/Dodge/WorldEvent/Cloud.hs

@@ -18,7 +18,7 @@ import LensHelp
 import System.Random
 
 makeCloudAt 
-    :: (Cloud -> Picture) -- ^ draw function
+    :: CloudDraw
     -> Float    -- ^ radius
     -> Int      -- ^ timer
     -> Float    -- ^ resting altitude
@@ -44,29 +44,23 @@ smokeCloudAt
     -> Point3   -- start position
     -> World 
     -> World
-smokeCloudAt col = makeCloudAt (drawCloudWith (4/3) 800 col)
+smokeCloudAt col = makeCloudAt (CloudColor (4/3) 800 col)
 
-drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
-drawCloudWith radMult fadet col cl = setLayer MidLayer 
-    . setDepth 25
-    $ circleSolidCol (withAlpha 0 col) (withAlpha a col) (radMult * _clRad cl)
-  where 
-    a = min 1 $ fromIntegral (_clTimer cl) / fadet
 
 makeThickSmokeAt :: Point3 -> World -> World
-makeThickSmokeAt = makeCloudAt (drawCloudWith 4 50 black) 3 50 30
+makeThickSmokeAt = makeCloudAt (CloudColor 4 50 black) 3 50 30
 
 makeThinSmokeAt :: Point3 -> World -> World
-makeThinSmokeAt = makeCloudAt (drawCloudWith 4 400 (withAlpha 0.05 black)) 5 400 50
+makeThinSmokeAt = makeCloudAt (CloudColor 4 400 (withAlpha 0.05 black)) 5 400 50
 
 makeStartCloudAt :: Point3 -> World -> World
-makeStartCloudAt = makeCloudAt (drawCloudWith 2 800 white) 10 400 5
+makeStartCloudAt = makeCloudAt (CloudColor 2 800 white) 10 400 5
 
 shellTrailCloud :: Point3 -> World -> World
-shellTrailCloud = makeCloudAt (drawCloudWith (4/3) 800 (greyN 0.5)) 15 400 40
+shellTrailCloud = makeCloudAt (CloudColor (4/3) 800 (greyN 0.5)) 15 400 40
 
 makeFlamerSmokeAt :: Point3 -> World -> World
-makeFlamerSmokeAt p w = makeCloudAt (drawCloudWith 4 300 (greyN x)) 6 200 40 p w
+makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w
   where
     x = fst $ randomR (0.5,0.8) (_randGen w)
 

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -91,8 +91,7 @@ makeGasCloud pos vel w = w
     theCloud = Cloud 
         {  _clPos = addZ 20 pos
         , _clVel = addZ 0 vel
-        , _clPict = \_ -> setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col) 
+        , _clPict = DrawGasCloud col
-                                          $ circleSolid 20
         , _clRad = 10
         , _clAlt = 25
         , _clTimer = 400