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/" }