33 lines
1.4 KiB
Haskell
33 lines
1.4 KiB
Haskell
module Dodge.Button.Event where
|
|
import Dodge.Data
|
|
import Dodge.SoundLogic
|
|
|
|
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 :: WdWd -> WdWd -> 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"
|