Reify press plates

src/Dodge/Data.hs

@@ -76,7 +76,9 @@ module Dodge.Data
     , module Dodge.Data.Gust
     , module Dodge.Data.Projectile
     , module Dodge.Data.Modification
+    , module Dodge.Data.PressPlate
     ) where
+import Dodge.Data.PressPlate
 import Dodge.Data.Modification
 import Dodge.Data.Projectile
 import Dodge.Data.Gust
@@ -351,15 +353,8 @@ data TerminalLine
         {_tlPause :: Int
         ,_tlEffect :: Terminal -> World -> World
         }
-data PressPlate = PressPlate 
-    { _ppPict :: Picture
-    , _ppPos :: Point2
-    , _ppRot :: Float
-    , _ppEvent :: PressPlate -> World -> World
-    , _ppID :: Int
-    , _ppText :: String
-    }
 data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int}
+  deriving (Eq,Ord,Show,Read)
 
 
 data IntID a = IntID Int a
@@ -370,6 +365,7 @@ data WorldBeams = WorldBeams
     ,_positronBeams :: [Beam]
     ,_electronBeams :: [Beam]
     }
+  deriving (Eq,Ord,Show,Read)
 
 {- Objects without ids.
 Update themselves, perhaps with side effects.  -}
@@ -688,7 +684,6 @@ makeLenses ''World
 makeLenses ''FloorItem
 makeLenses ''Prop
 makeLenses ''Particle
-makeLenses ''PressPlate
 makeLenses ''Door
 makeLenses ''Terminal
 makeLenses ''Machine

src/Dodge/Data/PressPlate.hs

@@ -0,0 +1,19 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.PressPlate
+    where
+import Geometry.Data
+import Picture
+import Control.Lens
+data PressPlateEvent = PressPlateId
+    | PPLevelReset
+  deriving (Eq,Ord,Show,Read)
+data PressPlate = PressPlate 
+    { _ppPict :: Picture
+    , _ppPos :: Point2
+    , _ppRot :: Float
+    , _ppEvent :: PressPlateEvent
+    , _ppID :: Int
+    , _ppText :: String
+    }
+makeLenses ''PressPlate

src/Dodge/Default.hs

@@ -103,7 +103,7 @@ defaultPP = PressPlate
     { _ppPict = setDepth 1 . color (dim . dim $ bright blue) $ circleSolid 5
     , _ppPos = V2 0 0
     , _ppRot = 0
-    , _ppEvent = const id
+    , _ppEvent = PressPlateId
     , _ppID = -1
     , _ppText = "Pressure plate"
     }

src/Dodge/PressPlate.hs

@@ -0,0 +1,16 @@
+module Dodge.PressPlate
+    where
+import Dodge.Data
+import Geometry
+import Dodge.Base.You
+import Dodge.WorldEvent.Explosion
+
+doPressPlateEvent :: PressPlateEvent -> PressPlate -> World -> World
+doPressPlateEvent ppe = case ppe of
+    PressPlateId -> const id 
+    PPLevelReset -> ppLevelReset
+
+ppLevelReset pp w
+    | dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) w 
+    | otherwise = w
+

src/Dodge/Room/Teleport.hs

@@ -31,11 +31,8 @@ telRoomLev _ = do
         { _ppPict   = setDepth 0.5 . color red $ polygon ppFootprint
         , _ppPos    = V2 0 0
         , _ppRot    = 0
-        , _ppEvent  = levelReset
+        , _ppEvent  = PPLevelReset
         , _ppID     = 0
         , _ppText   = "NEW LEVEL"
         }
     ppFootprint = reverse $ rectNSWE 20 (-20) (-20) 20
-    levelReset pp w
-        | dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) w 
-        | otherwise = w

src/Dodge/Update.hs

@@ -4,6 +4,7 @@ Module      : Dodge.Update
 Description : Simulation update
 -}
 module Dodge.Update ( updateUniverse ) where
+import Dodge.PressPlate
 import Dodge.ModificationEffect
 import Dodge.CrGroupUpdate
 import Dodge.Zoning.Cloud
@@ -352,7 +353,7 @@ updateMIM f up = f %~ IM.mapMaybe (dbArg up)
 --        (_,g') = genWord8 g
 
 ppEvents :: World -> World
-ppEvents w = IM.foldl' (flip $ \pp -> _ppEvent pp pp) w $ _pressPlates w
+ppEvents w = IM.foldl' (flip $ \pp -> doPressPlateEvent (_ppEvent pp) pp) w $ _pressPlates w
 
 updateSeenWalls :: World -> World
 updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w)