62 lines
2.4 KiB
Haskell
62 lines
2.4 KiB
Haskell
module Dodge.LevelGen.Switch
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.SoundLogic
|
|
|
|
import Picture
|
|
import Geometry
|
|
|
|
import qualified Data.IntMap.Strict as IM
|
|
|
|
import Control.Lens
|
|
|
|
|
|
makeButton :: Color -> (World -> World) -> Button
|
|
makeButton c eff = Button
|
|
{ _btPict = onLayer WlLayer $ color c $ polygon $ rectNSEW 5 (-5) 10 (-10)
|
|
, _btPos = (0,0)
|
|
, _btRot = 0
|
|
, _btEvent = \b w -> eff . over buttons (IM.adjust turnOn (_btID b))
|
|
-- . set (buttons . ix (_btID b) . btPict)
|
|
-- (onLayer WlLayer $ color c $ polygon $ rectNSEW (-3) (-5) 10 (-10))
|
|
-- . set (buttons . ix (_btID b) . btState) BtNoLabel
|
|
-- . set (buttons . ix (_btID b) . btEvent) (\b -> return)
|
|
. soundOnce 1 $ w
|
|
, _btID = 0
|
|
, _btText = "Button"
|
|
--, _btText = "Button"
|
|
, _btState = BtOff
|
|
}
|
|
where
|
|
turnOn bt = bt {_btState = BtNoLabel, _btPict = onPict, _btEvent = (\_ -> id)}
|
|
onPict = (onLayer WlLayer $ color c $ polygon $ rectNSEW (-3) (-5) 10 (-10))
|
|
|
|
makeSwitch :: Color -> (World -> World) -> (World -> World) -> Button
|
|
makeSwitch c effOn effOff = Button
|
|
{ _btPict = offPict
|
|
, _btPos = (0,0)
|
|
, _btRot = 0
|
|
, _btEvent = flipSwitch
|
|
, _btID = 0
|
|
, _btText = "Switch"
|
|
, _btState = BtOff
|
|
}
|
|
where
|
|
flipSwitch b w = switchEffect b . soundOnce 1 $ w
|
|
switchEffect b = case _btState b of
|
|
BtOff -> effOn . over buttons (IM.adjust turnOn (_btID b))
|
|
BtOn -> effOff . over buttons (IM.adjust turnOff (_btID b))
|
|
offPict = onLayer WlLayer $ color c $ pictures [--translate (-8) 4 $ circleSolid 5
|
|
polygon $ rectNSEW (-2) (-5) (-10) (10)
|
|
,polygon [(-2,-5),(-10,4),(-6,4),(2,-5)]
|
|
]
|
|
onPict = onLayer WlLayer $ color c $ pictures [--translate (8) 4 $ circleSolid 5
|
|
polygon $ rectNSEW (-2) (-5) (-10) (10)
|
|
,polygon [(-2,-5), (6,4),( 10,4),(2,-5)]
|
|
]
|
|
turnOn :: Button -> Button
|
|
turnOn bt = bt {_btState = BtOn, _btPict = onPict}
|
|
turnOff :: Button -> Button
|
|
turnOff bt = bt {_btState = BtOff, _btPict = offPict}
|