Move button data

2022-07-21 18:22:08 +01:00
parent aabd8a2cb8
commit b58444f931
16 changed files with 185 additions and 89 deletions
@@ -0,0 +1,33 @@
+module Dodge.Button.Event where
+import Dodge.Data
+import Dodge.SoundLogic
+import Dodge.Placement.Instance.Terminal
+
+import Dodge.WorldEffect
+import Control.Lens
+
+doButtonEvent :: ButtonEvent -> Button -> World -> World
+doButtonEvent be = case be of
+    ButtonDoNothing -> const id
+    ButtonPress newstate newevent thesound f -> \b -> doWorldEffect f
+        . set (buttons . ix (_btID b) . btState) newstate
+        . set (buttons . ix (_btID b) . btEvent) newevent
+        . soundStart (LeverSound 0) (_btPos b) thesound Nothing
+    --ButtonSwitch onstate onevent onsound oneff offstate offevent offsound offeff -> undefined
+    ButtonSimpleSwith oneff offeff -> flipSwitch oneff offeff
+    ButtonAccessTerminal -> accessTerminal . _btTermMID
+
+flipSwitch :: WorldEffect -> WorldEffect -> Button -> World -> World
+flipSwitch oneff offeff bt 
+    | _btState bt == BtOff = doWorldEffect oneff . dosound
+        . over (buttons . ix (_btID bt)) turnon
+    | otherwise = doWorldEffect offeff . dosound
+        . over (buttons . ix (_btID bt)) turnoff
+  where
+    turnon  = (btState .~ BtOn ) .  (btText .~ "SWITCH\\")
+    turnoff = (btState .~ BtOff) .  (btText .~ "SWITCH/")
+    dosound = soundFromGeneral (LeverSound 0) (const $ _btPos bt) click1S Nothing
+--    switchEffect b = case _btState b of
+--        BtOff -> effOn  . (buttons . ix (_btID b) %~ turnOn )
+--        BtOn  -> effOff . (buttons . ix (_btID b) %~ turnOff)
+--        _ -> error "Trying to switch a button with no label"