Split trigger door module, improve trigger door shadows

2021-03-06 14:03:28 +01:00
parent 36bccebed9
commit baed2716da
3 changed files with 204 additions and 162 deletions
@@ -0,0 +1,61 @@
+module Dodge.LevelGen.Switch
+    where
+import Dodge.Data
+import Dodge.Base
+import Dodge.SoundLogic
+
+import Picture
+import Geometry
+
+import qualified Data.IntMap.Strict as IM
+
+import Control.Lens
+
+
+makeButton :: Color -> (World -> World) -> Button
+makeButton c eff = Button
+    { _btPict = onLayer WlLayer $ color c $ polygon $ rectNSEW 5 (-5) 10 (-10)
+    , _btPos = (0,0)
+    , _btRot = 0
+    , _btEvent = \b w -> eff . over buttons (IM.adjust turnOn (_btID b))
+--                                . set (buttons . ix (_btID b) . btPict) 
+--                                      (onLayer WlLayer $ color c $ polygon $ rectNSEW (-3) (-5) 10 (-10))
+--                                . set (buttons . ix (_btID b) . btState) BtNoLabel
+--                                . set (buttons . ix (_btID b) . btEvent) (\b -> return)
+                                . soundOnce 1 $ w
+    , _btID = 0
+    , _btText = "Button"
+    --, _btText = "Button"
+    , _btState = BtOff
+    }
+    where
+        turnOn bt = bt {_btState = BtNoLabel, _btPict = onPict, _btEvent = (\_ -> id)}
+        onPict = (onLayer WlLayer $ color c $ polygon $ rectNSEW (-3) (-5) 10 (-10))
+
+makeSwitch :: Color -> (World -> World) -> (World -> World) -> Button
+makeSwitch c effOn effOff = Button
+    { _btPict = offPict
+    , _btPos = (0,0)
+    , _btRot = 0
+    , _btEvent = flipSwitch
+    , _btID = 0
+    , _btText = "Switch"
+    , _btState = BtOff
+    }
+    where 
+        flipSwitch b w = switchEffect b . soundOnce 1 $ w
+        switchEffect b = case _btState b of
+                            BtOff -> effOn  . over buttons (IM.adjust turnOn  (_btID b))
+                            BtOn  -> effOff . over buttons (IM.adjust turnOff (_btID b))
+        offPict = onLayer WlLayer $ color c $ pictures [--translate (-8) 4 $ circleSolid 5
+                                  polygon $ rectNSEW (-2) (-5) (-10) (10)
+                                  ,polygon [(-2,-5),(-10,4),(-6,4),(2,-5)]
+                                 ]
+        onPict  = onLayer WlLayer $ color c $ pictures [--translate (8) 4 $ circleSolid 5
+                                  polygon $ rectNSEW (-2) (-5) (-10) (10)
+                                  ,polygon [(-2,-5), (6,4),( 10,4),(2,-5)]
+                                 ]
+        turnOn :: Button -> Button
+        turnOn bt = bt {_btState = BtOn, _btPict = onPict}
+        turnOff :: Button -> Button
+        turnOff bt = bt {_btState = BtOff, _btPict = offPict}