22 lines
720 B
Haskell
22 lines
720 B
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
module Dodge.Button.Event (doButtonEvent) where
|
|
|
|
import Control.Lens
|
|
import Dodge.Data.World
|
|
import Dodge.SoundLogic
|
|
import Dodge.WorldEffect
|
|
|
|
doButtonEvent :: ButtonEvent -> Button -> World -> World
|
|
doButtonEvent = \case
|
|
ButtonPress True _ _ -> const id
|
|
ButtonPress False f _ -> buttonFlip f
|
|
ButtonSwitch _ f _ _ True -> buttonFlip f
|
|
ButtonSwitch f _ _ _ False -> buttonFlip f
|
|
ButtonAccessTerminal tid -> const $ accessTerminal tid
|
|
|
|
buttonFlip :: WdWd -> Button -> World -> World
|
|
buttonFlip f bt =
|
|
doWdWd f
|
|
. soundStart (ButtonSound (bt ^. btID)) (bt ^. btPos) click1S Nothing
|
|
. over (cWorld . lWorld . buttons . ix (bt ^. btID) . btEvent . btOn) not
|