Start work on clouds, damage, sensors

graph/itemCombinations.gv

@@ -45,10 +45,10 @@ digraph {
            ,label="HELD {_ibtHeld = FLAMESPITTER}"];
         57 [shape=box
            ,label="HELD {_ibtHeld = BLOWTORCH}"];
-        60 [shape=box
-           ,label="HELD {_ibtHeld = FLAMEWALL}"];
-        61 [shape=box
+        59 [shape=box
            ,label="HELD {_ibtHeld = FLAMETHROWER}"];
+        61 [shape=box
+           ,label="HELD {_ibtHeld = FLAMEWALL}"];
         63 [shape=box
            ,label="HELD {_ibtHeld = FLAMETORRENT}"];
         65 [shape=box
@@ -109,7 +109,7 @@ digraph {
         52 [shape=point];
         56 [shape=point];
         58 [shape=point];
-        59 [shape=point];
+        60 [shape=point];
         62 [shape=point];
         64 [shape=point];
         68 [shape=point];
@@ -235,14 +235,14 @@ digraph {
              ,arrowhead=onone
              ,headport=w];
     56 -> 57 [xlabel="",tailport=e];
-    58 -> 13 [xlabel="",tailport=e];
-    59 -> 60 [xlabel="",tailport=e];
-    61 -> 59 [xlabel=1
+    58 -> 59 [xlabel="",tailport=e];
+    59 -> 60 [xlabel=1
              ,arrowhead=onone
              ,headport=w];
-    61 -> 62 [xlabel=1
+    59 -> 62 [xlabel=1
              ,arrowhead=onone
              ,headport=w];
+    60 -> 61 [xlabel="",tailport=e];
     62 -> 63 [xlabel="",tailport=e];
     64 -> 65 [xlabel="",tailport=e];
     68 -> 69 [xlabel="",tailport=e];

log/aGeneratedRoomLayout

@@ -11,7 +11,7 @@ Corridor-4
 |
 autoDoor-5
 |
-ELECautoRect-6
+ElecautoRect-6
 |
 +- triggerDoorRoom-7
 |  |

log/treeCluster

@@ -77,7 +77,7 @@ Seed: 7114951007332849727
 
 2:0:0:0:0:autoDoor
 |
-2:0:0:0:1:ELECautoRect
+2:0:0:0:1:ElecautoRect
 |
 +- 2:0:0:0:2:triggerDoorRoom
 |  |

src/Data/Tile.hs

@@ -1,26 +1,30 @@
 {-# LANGUAGE TemplateHaskell #-}
+
 --{-# LANGUAGE StrictData #-}
 module Data.Tile where
-import Geometry.Data
-import Data.Aeson
-import Data.Aeson.TH
 
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Geometry.Data
 
 data Floor
     = InheritFloor
---    | TileWith Float
-    | Tiled { _tiles :: [Tile]}
+    | --    | TileWith Float
+      Tiled {_tiles :: [Tile]}
+
 data Tile = Tile
     { _tilePoly :: [Point2]
-    , _tileZero :: Point2   -- ^ point in the world where tile texture is 0,0
-    , _tileTangentPos :: Point2   
-        -- ^ world position one along in the X direction, note this also set the scale of the
+    , -- | point in the world where tile texture is 0,0
+      _tileZero :: Point2
+    , -- | world position one along in the X direction, note this also set the scale of the
       -- texture
       -- this has to be a position because it is shifted
+      _tileTangentPos :: Point2
     , _tileArrayZ :: Float
     }
     deriving (Eq, Ord, Show)
+
 makeLenses ''Floor
 makeLenses ''Tile
 deriveJSON defaultOptions ''Tile

src/Dodge/Data/AimStance.hs

@@ -1,10 +1,7 @@
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Dodge.Data.AimStance (module Dodge.Data.AimStance) where
-
-import Data.Aeson
-import Data.Aeson.TH
+module Dodge.Data.AimStance where
 
 data AimStance
     = TwoHandUnder
@@ -12,5 +9,3 @@ data AimStance
     | TwoHandFlat
     | OneHand
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
-
-deriveJSON defaultOptions ''AimStance

src/Dodge/Data/AmmoType.hs

@@ -1,11 +1,7 @@
 {-# LANGUAGE StrictData #-}
---{-# LANGUAGE TemplateHaskell #-}
 
 module Dodge.Data.AmmoType where
 
---import Data.Aeson
---import Data.Aeson.TH
-
 data AmmoType
     = LauncherAmmo
     | BulletAmmo
@@ -16,5 +12,3 @@ data AmmoType
     | PrintMaterial
     | ExplosivePutty
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
-
---deriveJSON defaultOptions ''AmmoType

src/Dodge/Data/CamouflageStatus.hs

@@ -1,16 +1,10 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
-{-# LANGUAGE TemplateHaskell #-}
 
 module Dodge.Data.CamouflageStatus where
 
-import Data.Aeson
-import Data.Aeson.TH
-
 data CamouflageStatus
     = FullyVisible
     | Invisible
     deriving (Eq, Ord, Enum, Show, Bounded, Read) --Generic, Flat)
 
-deriveJSON defaultOptions ''CamouflageStatus
+--deriveJSON defaultOptions ''CamouflageStatus

src/Dodge/Data/Cloud.hs

@@ -28,7 +28,11 @@ data Cloud = Cloud
 
 data CloudType
     = SmokeCloud
+    | FlamerSmokeCloud
+    | RocketCloud
+    | CryoReleaseCloud
     | GasCloud
+    | StoneDust
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''Cloud

src/Dodge/Data/ComposedItem.hs

@@ -8,8 +8,6 @@ module Dodge.Data.ComposedItem where
 import Dodge.Data.AmmoType
 import Dodge.Data.DoubleTree
 import Control.Lens
---import Data.Aeson
---import Data.Aeson.TH
 import Dodge.Data.Item
 import Geometry.Data
 import Linear.Quaternion (Quaternion (..))

src/Dodge/Data/Creature/Misc.hs

@@ -17,13 +17,6 @@ import Dodge.Data.FloatFunction
 import Dodge.Data.Material
 import Geometry.Data
 
---data CreatureStatistics = CreatureStatistics
---    { _strength :: Int
---    , _dexterity :: Int
---    , _intelligence :: Int
---    }
---    deriving (Eq, Ord, Show, Read) --Generic, Flat)
-
 data Vocalization
     = Mute
     | Vocalization

src/Dodge/Data/DoubleTree.hs

@@ -6,8 +6,8 @@
 module Dodge.Data.DoubleTree where
 
 import Control.Lens
-import Data.Aeson
-import Data.Aeson.TH
+--import Data.Aeson
+--import Data.Aeson.TH
 import Data.Bifunctor
 
 --import qualified Data.Map.Strict as M
@@ -90,5 +90,5 @@ makeLenses ''DoubleTree
 makeLenses ''LabelDoubleTree
 makeLenses ''LocationLDT
 makeLenses ''ContextLDT
-deriveJSON defaultOptions ''DoubleTree
-deriveJSON defaultOptions ''LabelDoubleTree
+--deriveJSON defaultOptions ''DoubleTree
+--deriveJSON defaultOptions ''LabelDoubleTree

src/Dodge/Data/GenParams.hs

@@ -5,15 +5,15 @@
 
 module Dodge.Data.GenParams where
 
+import Dodge.Data.Machine.Sensor.Type
 import Color
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
 import qualified Data.Map.Strict as M
-import Dodge.Data.Damage.Type
 
 newtype GenParams = GenParams
-    { _sensorCoding :: M.Map DamageType (PaletteColor, DecorationShape)
+    { _sensorCoding :: M.Map SensorType (PaletteColor, DecorationShape)
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/Data/Machine/Sensor.hs

@@ -1,23 +1,27 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Dodge.Data.Machine.Sensor where
+module Dodge.Data.Machine.Sensor (
+    module Dodge.Data.Machine.Sensor,
+    module Dodge.Data.Machine.Sensor.Type,
+) where
 
-import Dodge.Data.GenParams
 import Color
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
+import Dodge.Data.GenParams
 import Dodge.Data.Item.Combine
-import Dodge.Data.Damage.Type
+import Dodge.Data.Machine.Sensor.Type
 
 data Sensor
     = DamageSensor
         { _sensToggle :: Bool
         , _sensAmount :: Int
-        , _sensType :: DamageType
+        , --        , _sensType :: DamageType
+          _sensType :: SensorType
         , _sensDraw :: (PaletteColor, DecorationShape)
         , _sensThreshold :: Int
         }
@@ -27,6 +31,7 @@ data Sensor
         , _proxRequirement :: ProximityRequirement
         , _sensToggle :: Bool
         }
+
 --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data ProximityRequirement
@@ -34,10 +39,12 @@ data ProximityRequirement
     | RequireEquipment {_proxReqEquipment :: ItemType}
     | RequireImpossible
     deriving (Show)
+
 --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data CloseToggle = NotClose | IsClose
     deriving (Show)
+
 --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''Sensor

src/Dodge/Floor.hs

@@ -34,7 +34,7 @@ initialAnoTree =
             [ IntAnno $ AnTree . startRoom
             , IntAnno $
                 PassthroughLockKeyLists
-                    [(sensorRoomRunPast ELECTRICAL, takeOne 
+                    [(sensorRoomRunPast ElectricSensor, takeOne 
                         [-- CRAFT (ENERGYBALLCRAFT TeslaBall) , 
                         HELD SPARKGUN])]
                     itemRooms

src/Dodge/Item/Held/SprayGuns.hs

@@ -64,6 +64,7 @@ flameWall =
 flameThrower :: Item
 flameThrower =
     defaultHeldItem
+        & itType .~ HELD FLAMETHROWER
         & itParams .~ NozzleAngle 0
 --        & itUse . heldDelay .~ NoDelay
 --        & itUse . heldAim . aimZoom .~ defaultItZoom{_izMax = 5, _izMin = 1.5}
@@ -78,7 +79,6 @@ flameThrower =
 --            0
 --            ]
 --        & itAmmoSlots .~ singleAmmo GasAmmo
---        & itType .~ HELD FLAMETHROWER
 --        & itUse . heldParams .~ GasSprayParams
 --            { _weaponInvLock = 0
 ----            , _weaponRepeat = mempty

src/Dodge/LevelGen/LevelStructure.hs

@@ -26,5 +26,5 @@ generateGenParams = do
     return
         . GenParams
         . M.fromList
-        . zip [FLAMING, LASERING, ELECTRICAL]
+        . zip [LaserSensor ..]
         $ zip cols shps

src/Dodge/LockAndKey.hs

@@ -25,7 +25,7 @@ lockRoomMultiItems =
 lockRoomKeyItems :: RandomGen g => [(Int -> State g (MetaTree Room String), State g ItemType)]
 lockRoomKeyItems =
     [ (lasCenSensEdge, takeOne [HELD RLAUNCHER, HELD LASER, HELD SPARKGUN, HELD FLATSHIELD])
-    , (sensorRoomRunPast LASERING, return $ HELD LASER)
+    , (sensorRoomRunPast LaserSensor, return $ HELD LASER)
     , (const slowDoorRoomRunPast, return $ HELD (MINIGUNX 3))
     , (const longRoomRunPast, takeOne [HELD SNIPERRIFLE, HELD FLATSHIELD])
     , (const glassLessonRunPast, takeOne [HELD LASER])

src/Dodge/Machine/Update.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.Machine.Update (
     updateMachine,
 ) where
@@ -151,7 +152,8 @@ mcProxTest mc w = case mc ^? mcType . _McSensor . proxRequirement of
   where
     cr = you w
 
-senseDamage :: Int -> DamageType -> Machine -> World -> World
+--senseDamage :: Int -> DamageType -> Machine -> World -> World
+senseDamage :: Int -> SensorType -> Machine -> World -> World
 senseDamage threshold dt mc =
     (cWorld . lWorld . machines . ix mcid %~ upmc)
         . updatels
@@ -162,12 +164,21 @@ senseDamage threshold dt mc =
         | x > 0 = x
         | otherwise = -5
       where
-        x = sum . map _dmAmount $ filter ((== dt) . _dmType) (_mcDamage mc)
+        f d = d `elem` sensorTypeDamages dt
+        x = sum . map _dmAmount $ filter (f . _dmType) (_mcDamage mc)
     ni = fromIntegral (mc ^?! mcType . _McSensor . sensAmount) / fromIntegral threshold
     updatels = fromMaybe id $ do
         lsid <- mc ^? mcMounts . ix ObLightSource
         return $ cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni
 
+sensorTypeDamages :: SensorType -> [DamageType]
+sensorTypeDamages = \case
+    LaserSensor -> [LASERING]
+    ElectricSensor -> [ELECTRICAL]
+    ThermalSensor -> [FLAMING,SPARKING,EXPLOSIVE]
+    PhysicalSensor -> [PIERCING,BLUNT,CUTTING,CRUSHING,EXPLOSIVE,CONCUSSIVE]
+    
+
 --damageUsing :: DamageType -> Damage -> Either Int Int
 --damageUsing dt dm
 --    | _dmType dm == dt = Left $ _dmAmount dm

src/Dodge/Placement/Instance/Sensor.hs

@@ -13,7 +13,7 @@ import Dodge.LightSource
 import Geometry
 
 damageSensor ::
-    DamageType ->
+    SensorType ->
     Float ->
     Maybe Int ->
     PlacementSpot ->
@@ -42,16 +42,16 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
                 defaultSensorWall
             )
 
-damageTypeThreshold :: DamageType -> Int
+damageTypeThreshold :: SensorType -> Int
 damageTypeThreshold dt = case dt of
-    FLAMING -> 1000
-    LASERING -> 1000
-    ELECTRICAL -> 500
-    _ -> undefined
+    LaserSensor -> 1000
+    ElectricSensor -> 500
+    ThermalSensor -> 1000
+    PhysicalSensor -> 1000
 
 lightSensor ::
     Float ->
     Maybe Int ->
     PlacementSpot ->
     Placement
-lightSensor = damageSensor LASERING
+lightSensor = damageSensor LaserSensor

src/Dodge/Room/LasTurret.hs

@@ -41,7 +41,7 @@ lightSensInsideDoor outplid rm =
                  , psPt atFstLnkOut (PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100)))
                  , psPt atFstLnkOut (PutForeground $ verticalWire (V2 20 0) 0 80)
                  ]
-        & rmOutPmnt .~ [OutPlacement (sensAboveDoor LASERING 10 (atFstLnkOutShiftInward 100)) outplid]
+        & rmOutPmnt .~ [OutPlacement (sensAboveDoor LaserSensor 10 (atFstLnkOutShiftInward 100)) outplid]
 
 lightSensByDoor :: Int -> Room -> Room
 lightSensByDoor outplid rm =
@@ -51,7 +51,7 @@ lightSensByDoor outplid rm =
                  , heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape
                  , heightWallPS (atFstLnkOutShiftInward 100) 30 covershape
                  ]
-        & rmOutPmnt .~ [OutPlacement (sensAboveDoor LASERING 20 (atFstLnkOutShiftBy sensorshift)) outplid]
+        & rmOutPmnt .~ [OutPlacement (sensAboveDoor LaserSensor 20 (atFstLnkOutShiftBy sensorshift)) outplid]
   where
     covershape = rectNSWE 10 (-10) (-20) 20
     sensorshift (p, a) = (p +.+ rotateV a (V2 60 (-20)), a)

src/Dodge/Room/SensorDoor.hs

@@ -24,7 +24,7 @@ import RandomHelp
 
 -- TODO fix case where the sensor created by sensInsideDoor blocks another door
 -- for roomRectAutoLinks-- make the locked door a center door?
-sensorRoom :: RandomGen g => DamageType -> Int -> State g (Tree Room)
+sensorRoom :: RandomGen g => SensorType -> Int -> State g (Tree Room)
 sensorRoom senseType n = do
     rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
     cenroom <- shuffleLinks $ sensInsideDoor senseType n rm
@@ -45,7 +45,7 @@ sensorRoom senseType n = do
         p' = p +.+ rotateV d (V2 0 (negate 100))
         isclose = dist (_rlPos rl) p' < 30
 
-sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g MTRS
+sensorRoomRunPast :: RandomGen g => SensorType -> Int -> State g MTRS
 sensorRoomRunPast dt n = do
     t <- sensorRoom dt n
     rToOnward "sensorRoomRunPast" $
@@ -60,13 +60,13 @@ sensorRoomRunPast dt n = do
                     ]
                 )
 
-sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement
+sensAboveDoor :: SensorType -> Float -> PlacementSpot -> Placement
 sensAboveDoor sensetype wth ps =
     extTrigLitPos
         (atFstLnkOutShiftBy (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
         (\tp -> Just $ damageSensor sensetype wth (_plMID tp) ps)
 
-sensInsideDoor :: DamageType -> Int -> Room -> Room
+sensInsideDoor :: SensorType -> Int -> Room -> Room
 sensInsideDoor senseType outplid rm =
     rm
         & rmName .++~ take 4 (show senseType)

src/Dodge/Terminal.hs

@@ -202,7 +202,7 @@ toggleCommand =
         , _tcEffect = TerminalCommandEffectLinkedObject -- \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
         }
 
-decodedtmap :: M.Map DamageType (PaletteColor, DecorationShape) -> M.Map String [TerminalLine]
+decodedtmap :: M.Map SensorType (PaletteColor, DecorationShape) -> M.Map String [TerminalLine]
 decodedtmap = M.mapKeys show . M.map ((: []) . makeTermLine . show)
 
 sensorCommand :: TerminalCommand

src/Dodge/Update.hs

@@ -734,7 +734,10 @@ mvGust _ gu
 cloudEffect :: Cloud -> World -> World
 cloudEffect cl = case _clType cl of
     GasCloud -> cloudPoisonDamage cl
+    RocketCloud -> id
+    CryoReleaseCloud -> id
     SmokeCloud -> id
+    _ -> id
 
 updateCloud :: World -> Cloud -> (World, Maybe Cloud)
 updateCloud w c