Cleanup buttons

src/Dodge/Button/Event.hs

@@ -1,34 +1,22 @@
-module Dodge.Button.Event where
+{-# LANGUAGE LambdaCase #-}
+module Dodge.Button.Event (doButtonEvent) where
 
-import Sound.Data
 import Control.Lens
 import Dodge.Data.World
 import Dodge.SoundLogic
 import Dodge.WorldEffect
+import Sound.Data
 
 doButtonEvent :: ButtonEvent -> Button -> World -> World
-doButtonEvent be = case be of
---    ButtonDoNothing -> const id
+doButtonEvent = \case
     ButtonPress True _ _ -> const id
-    ButtonPress False f _ -> \b ->
-        doWdWd f
-            . set (cWorld . lWorld . buttons . ix (_btID b) . btEvent . btOn) True
-            . soundStart (LeverSound 0) (_btPos b) click1S Nothing
-    ButtonSwitch oneff offeff _ _ _ -> flipSwitch oneff offeff
+    ButtonPress False f _ -> buttonFlip f
+    ButtonSwitch _ f _ _ True -> buttonFlip f
+    ButtonSwitch f _ _ _ False -> buttonFlip f
     ButtonAccessTerminal -> accessTerminal . _btTermMID
 
-flipSwitch :: WdWd -> WdWd -> Button -> World -> World
-flipSwitch oneff offeff bt
-    | _btOn (_btEvent bt) =
-        doWdWd offeff . dosound
-            . set (cWorld . lWorld . buttons . ix (_btID bt) . btEvent . btOn) False
-    | otherwise =
-        doWdWd oneff . dosound
-            . set (cWorld . lWorld . buttons . ix (_btID bt) . btEvent . btOn) True
-  where
-    dosound = soundWithStatus ToStart (LeverSound 0) (_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"
+buttonFlip :: WdWd -> Button -> World -> World
+buttonFlip f bt =
+    doWdWd f
+        . soundWithStatus ToStart (LeverSound 0) (bt ^. btPos) click1S Nothing
+        . over (cWorld . lWorld . buttons . ix (bt ^. btID) . btEvent . btOn) not

src/Dodge/SelectedClose.hs

@@ -1,16 +1,15 @@
-module Dodge.SelectedClose (getSelectedCloseObj,interactWithCloseObj) where
+module Dodge.SelectedClose (getSelectedCloseObj, interactWithCloseObj) where
 
-import Dodge.Button.Event
-import Dodge.Inventory.Add
 import Control.Lens
+import Dodge.Button.Event
 import Dodge.Data.World
+import Dodge.Inventory.Add
 import NewInt
 
 interactWithCloseObj :: Either FloorItem Button -> World -> World
 interactWithCloseObj e w = worldEventFlags . at InventoryChange ?~ () $ case e of
     (Left flit) -> pickUpItem 0 flit w
-    (Right but) -> doButtonEvent (_btEvent but) but w
-
+    (Right but) -> doButtonEvent (but ^. btEvent) but w
 
 getSelectedCloseObj :: World -> Maybe (Either FloorItem Button)
 getSelectedCloseObj w = do