123 lines
3.6 KiB
Haskell
123 lines
3.6 KiB
Haskell
module Dodge.LevelGen.Switch
|
|
( makeSwitch
|
|
, makeButton
|
|
, makeSwitchSPic
|
|
, drawSwitchWire
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Default
|
|
import Dodge.SoundLogic
|
|
import Picture
|
|
import ShapePicture
|
|
import Shape
|
|
import Geometry
|
|
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Control.Lens
|
|
makeButton
|
|
:: Color
|
|
-> (World -> World) -- ^ Effect when pressed
|
|
-> Button
|
|
makeButton col eff = Button
|
|
{ _btPict = defaultDrawButton col
|
|
, _btPos = V2 0 0
|
|
, _btRot = 0
|
|
, _btEvent = \b w -> eff
|
|
. over buttons (IM.adjust turnOn (_btID b))
|
|
. soundFromGeneral (LeverSound 0) (btpos b) click1S Nothing $ w
|
|
, _btID = 0
|
|
, _btText = "Button"
|
|
, _btState = BtOff
|
|
}
|
|
where
|
|
turnOn bt = bt {_btState = BtNoLabel, _btEvent = const id}
|
|
btpos b w' = _btPos $ _buttons w' IM.! _btID b
|
|
|
|
drawSwitch :: Color -> Color -> Button -> SPic
|
|
drawSwitch col1 col2 bt
|
|
| _btState bt == BtOff = flick $ pi/4
|
|
| otherwise = flick (negate (pi/4))
|
|
where
|
|
flick a = ( mconcat
|
|
[ colorSH col1 . translateSHz 10 . upperPrismPoly 10 $ rectNSEW (-2) (-5) 10 (-10)
|
|
, colorSH col2 . translateSH (V3 0 (-2) 15) . rotateSH a . upperPrismPoly 2 $ rectNSEW 10 0 2 (-2)
|
|
]
|
|
, mempty)
|
|
|
|
drawSwitchWire :: Color -> Color -> Button -> SPic
|
|
drawSwitchWire col1 col2 bt
|
|
| _btState bt == BtOff = flick $ pi/4
|
|
| otherwise = flick (negate (pi/4))
|
|
where
|
|
flick a = ( mconcat
|
|
[ colorSH col1 . translateSHz 10 . upperPrismPoly 10 $ rectNSEW (-2) (-5) 10 (-10)
|
|
, colorSH col2 . translateSH (V3 0 (-2) 15) . rotateSH a . upperPrismPoly 2 $ rectNSEW 10 0 2 (-2)
|
|
]
|
|
, mempty)
|
|
|
|
makeSwitchSPic
|
|
:: (Button -> SPic)
|
|
-> (World -> World) -- ^ Switch on effect
|
|
-> (World -> World) -- ^ Switch off effect
|
|
-> Button
|
|
makeSwitchSPic dswitch effOn effOff = Button
|
|
{ _btPict = dswitch
|
|
, _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) click1S 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"
|
|
turnOn :: Button -> Button
|
|
turnOn bt = bt
|
|
{ _btState = BtOn
|
|
, _btText = "SWITCH\\"
|
|
}
|
|
turnOff :: Button -> Button
|
|
turnOff bt = bt
|
|
{ _btState = BtOff
|
|
, _btText = "SWITCH/"
|
|
}
|
|
|
|
|
|
makeSwitch
|
|
:: Color
|
|
-> Color
|
|
-> (World -> World) -- ^ Switch on effect
|
|
-> (World -> World) -- ^ Switch off effect
|
|
-> Button
|
|
makeSwitch col1 col2 effOn effOff = Button
|
|
{ _btPict = drawSwitch col1 col2
|
|
, _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) click1S 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"
|
|
turnOn :: Button -> Button
|
|
turnOn bt = bt
|
|
{ _btState = BtOn
|
|
, _btText = "SWITCH\\"
|
|
}
|
|
turnOff :: Button -> Button
|
|
turnOff bt = bt
|
|
{ _btState = BtOff
|
|
, _btText = "SWITCH/"
|
|
}
|