75 lines
2.5 KiB
Haskell
75 lines
2.5 KiB
Haskell
module Dodge.LevelGen.Switch
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Data.SoundOrigin
|
|
import Dodge.SoundLogic
|
|
import Dodge.Picture.Layer
|
|
import Picture
|
|
import Geometry
|
|
--import Geometry.Data
|
|
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Control.Lens
|
|
makeButton
|
|
:: Color
|
|
-> (World -> World) -- ^ Effect when pressed
|
|
-> Button
|
|
makeButton c eff = Button
|
|
{ _btPict = setLayer 0 . onLayer WlLayer $ color c $ polygon $ rectNSEW 5 (-5) 10 (-10)
|
|
, _btPos = V2 0 0
|
|
, _btRot = 0
|
|
, _btEvent = \b w -> eff . over buttons (IM.adjust turnOn (_btID b))
|
|
. soundFromGeneral (LeverSound 0) (btpos b) 1 Nothing $ w
|
|
, _btID = 0
|
|
, _btText = "Button"
|
|
--, _btText = "Button"
|
|
, _btState = BtOff
|
|
}
|
|
where
|
|
turnOn bt = bt {_btState = BtNoLabel, _btPict = onPict, _btEvent = const id}
|
|
onPict = setLayer 0 $ onLayer WlLayer (color c $ polygon $ rectNSEW (-3) (-5) 10 (-10))
|
|
btpos b w' = _btPos $ _buttons w' IM.! _btID b
|
|
|
|
makeSwitch
|
|
:: Color
|
|
-> (World -> World) -- ^ Switch on effect
|
|
-> (World -> World) -- ^ Switch off effect
|
|
-> Button
|
|
makeSwitch c effOn effOff = Button
|
|
{ _btPict = offPict
|
|
, _btPos = V2 0 0
|
|
, _btRot = 0
|
|
, _btEvent = flipSwitch
|
|
, _btID = 0
|
|
, _btText = "SWITCH/"
|
|
, _btState = BtOff
|
|
}
|
|
where
|
|
flipSwitch b w = switchEffect b . soundFromGeneral (LeverSound 0) (bpos b) 1 Nothing $ w
|
|
bpos b w = _btPos $ _buttons w IM.! _btID b
|
|
switchEffect b = case _btState b of
|
|
BtOff -> effOn . over buttons (IM.adjust turnOn (_btID b))
|
|
BtOn -> effOff . over buttons (IM.adjust turnOff (_btID b))
|
|
_ -> error "Trying to switch a button with no label"
|
|
offPict = setLayer 0 . onLayer WlLayer $ color c $ pictures [--translate (-8) 4 $ circleSolid 5
|
|
polygon $ rectNSEW (-2) (-5) (-10) 10
|
|
,polygon $ map toV2 [(-2,-5),(-10,4),(-6,4),(2,-5)]
|
|
]
|
|
onPict = setLayer 0 . onLayer WlLayer $ color c $ pictures [--translate (8) 4 $ circleSolid 5
|
|
polygon $ rectNSEW (-2) (-5) (-10) 10
|
|
,polygon $ map toV2 [(-2,-5), (6,4),( 10,4),(2,-5)]
|
|
]
|
|
turnOn :: Button -> Button
|
|
turnOn bt = bt
|
|
{ _btState = BtOn
|
|
, _btPict = onPict
|
|
, _btText = "SWITCH\\"
|
|
}
|
|
turnOff :: Button -> Button
|
|
turnOff bt = bt
|
|
{ _btState = BtOff
|
|
, _btPict = offPict
|
|
, _btText = "SWITCH/"
|
|
}
|
|
|