diff --git a/src/Dodge/Cloud/Draw.hs b/src/Dodge/Cloud/Draw.hs new file mode 100644 index 000000000..f3a39389b --- /dev/null +++ b/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 + diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index aa2d32231..b2f9c0ca2 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/Data/Cloud.hs b/src/Dodge/Data/Cloud.hs index 7a7f3c1b7..a58f2ace0 100644 --- a/src/Dodge/Data/Cloud.hs +++ b/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 diff --git a/src/Dodge/Data/Gust.hs b/src/Dodge/Data/Gust.hs new file mode 100644 index 000000000..40ac13ba2 --- /dev/null +++ b/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 diff --git a/src/Dodge/Data/HUD.hs b/src/Dodge/Data/HUD.hs index cf1a88cc2..9d579df64 100644 --- a/src/Dodge/Data/HUD.hs +++ b/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 diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index e89841153..739fd987b 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.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 diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index 029acdc3d..bab9e2097 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/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) diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 04ff202f6..5fc200148 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/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) - $ circleSolid 20 + , _clPict = DrawGasCloud col , _clRad = 10 , _clAlt = 25 , _clTimer = 400