Files
loop/src/Dodge/Button/Event.hs
T
2022-12-28 10:21:00 +00:00

38 lines
1.5 KiB
Haskell

module Dodge.Button.Event where
import Sound.Data
import Control.Lens
import Dodge.Data.World
import Dodge.SoundLogic
import Dodge.WorldEffect
doButtonEvent :: ButtonEvent -> Button -> World -> World
doButtonEvent be = case be of
ButtonDoNothing -> const id
ButtonPress newstate newevent thesound f -> \b ->
doWdWd f
. set (cWorld . lWorld . buttons . ix (_btID b) . btState) newstate
. set (cWorld . lWorld . 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 :: WdWd -> WdWd -> Button -> World -> World
flipSwitch oneff offeff bt
| _btState bt == BtOff =
doWdWd oneff . dosound
. over (cWorld . lWorld . buttons . ix (_btID bt)) turnon
| otherwise =
doWdWd offeff . dosound
. over (cWorld . lWorld . buttons . ix (_btID bt)) turnoff
where
turnon = (btState .~ BtOn) . (btText .~ "SWITCH\\")
turnoff = (btState .~ BtOff) . (btText .~ "SWITCH/")
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"