Simplify button drawing
This commit is contained in:
File diff suppressed because one or more lines are too long
@@ -5,12 +5,14 @@ import Dodge.Data.Button
|
||||
import Geometry
|
||||
import Shape
|
||||
import ShapePicture
|
||||
import Control.Lens
|
||||
|
||||
drawButton :: ButtonDraw -> Button -> SPic
|
||||
drawButton bd = case bd of
|
||||
DefaultDrawButton col -> defaultDrawButton col
|
||||
DefaultDrawSwitch col1 col2 -> drawSwitch col1 col2
|
||||
DrawNoButton -> const mempty
|
||||
drawButton :: Button -> SPic
|
||||
drawButton bt = case bt ^. btEvent of
|
||||
ButtonPress {_bpColor = col} -> defaultDrawButton col bt
|
||||
ButtonSimpleSwith {_bssColor1 = col1, _bssColor2 = col2} -> drawSwitch col1 col2 bt
|
||||
ButtonAccessTerminal -> mempty
|
||||
ButtonDoNothing -> mempty
|
||||
|
||||
drawSwitch :: Color -> Color -> Button -> SPic
|
||||
drawSwitch col1 col2 bt
|
||||
|
||||
@@ -9,13 +9,13 @@ import Dodge.WorldEffect
|
||||
doButtonEvent :: ButtonEvent -> Button -> World -> World
|
||||
doButtonEvent be = case be of
|
||||
ButtonDoNothing -> const id
|
||||
ButtonPress newstate newevent thesound f -> \b ->
|
||||
ButtonPress newstate newevent thesound f c -> \b ->
|
||||
doWdWd f
|
||||
. set (cWorld . lWorld . buttons . ix (_btID b) . btState) newstate
|
||||
. set (cWorld . lWorld . buttons . ix (_btID b) . btEvent) newevent
|
||||
. soundStart (LeverSound 0) (_btPos b) thesound Nothing
|
||||
--ButtonSwitch onstate onevent onsound oneff offstate offevent offsound offeff -> undefined
|
||||
ButtonSimpleSwith oneff offeff -> flipSwitch oneff offeff
|
||||
ButtonSimpleSwith oneff offeff _ _ -> flipSwitch oneff offeff
|
||||
ButtonAccessTerminal -> accessTerminal . _btTermMID
|
||||
|
||||
flipSwitch :: WdWd -> WdWd -> Button -> World -> World
|
||||
|
||||
+13
-19
@@ -13,11 +13,11 @@ import Dodge.Data.WorldEffect
|
||||
import Geometry.Data
|
||||
import Sound.Data
|
||||
|
||||
data ButtonDraw
|
||||
= DefaultDrawButton Color
|
||||
| DefaultDrawSwitch Color Color
|
||||
| DrawNoButton
|
||||
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
||||
--data ButtonDraw
|
||||
-- = DefaultDrawButton Color
|
||||
-- | DefaultDrawSwitch Color Color
|
||||
-- | DrawNoButton
|
||||
-- --deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
||||
|
||||
data ButtonEvent
|
||||
= ButtonDoNothing
|
||||
@@ -26,28 +26,22 @@ data ButtonEvent
|
||||
, _bpEvent :: ButtonEvent
|
||||
, _bpSound :: SoundID
|
||||
, _bpEff :: WdWd
|
||||
, _bpColor :: Color
|
||||
}
|
||||
| -- | ButtonSwitch
|
||||
-- {_bonState :: ButtonState
|
||||
-- ,_bonEvent :: ButtonEvent
|
||||
-- ,_bonSound :: SoundID
|
||||
-- ,_bonEff :: WorldEffect
|
||||
-- ,_boffState :: ButtonState
|
||||
-- ,_boffEvent :: ButtonEvent
|
||||
-- ,_boffSound :: SoundID
|
||||
-- ,_boffEff :: WorldEffect
|
||||
-- }
|
||||
ButtonSimpleSwith
|
||||
| ButtonSimpleSwith
|
||||
{ _bonEff :: WdWd
|
||||
, _boffEff :: WdWd
|
||||
, _bssColor1 :: Color
|
||||
, _bssColor2 :: Color
|
||||
}
|
||||
| ButtonAccessTerminal
|
||||
--deriving (Eq, Show, Read) --, Generic)
|
||||
--h--deriving (Eq, Show, Read) --Generic, Flat)
|
||||
|
||||
data Button = Button
|
||||
{ _btPict :: ButtonDraw --Button -> SPic
|
||||
, _btPos :: Point2
|
||||
{
|
||||
-- _btPict :: ButtonDraw --Button -> SPic
|
||||
_btPos :: Point2
|
||||
, _btRot :: Float
|
||||
, _btEvent :: ButtonEvent --Button -> World -> World
|
||||
, _btID :: Int
|
||||
@@ -65,7 +59,7 @@ data ButtonState = BtOn | BtOff | BtInactive
|
||||
|
||||
makeLenses ''Button
|
||||
makeLenses ''ButtonEvent
|
||||
deriveJSON defaultOptions ''ButtonDraw
|
||||
--deriveJSON defaultOptions ''ButtonDraw
|
||||
deriveJSON defaultOptions ''ButtonState
|
||||
deriveJSON defaultOptions ''ButtonEvent
|
||||
deriveJSON defaultOptions ''Button
|
||||
|
||||
@@ -49,10 +49,10 @@ defaultMachine =
|
||||
defaultButton :: Button
|
||||
defaultButton =
|
||||
Button
|
||||
{ _btPict = DefaultDrawButton (dark red)
|
||||
, _btPos = V2 0 0
|
||||
{ _btPos = V2 0 0
|
||||
, _btRot = 0
|
||||
, _btEvent = ButtonPress BtInactive ButtonDoNothing click1S NoWorldEffect
|
||||
, _btEvent = ButtonPress BtInactive ButtonDoNothing click1S NoWorldEffect
|
||||
(dark red)
|
||||
, _btID = 0
|
||||
, _btState = BtOff
|
||||
, _btTermMID = Nothing
|
||||
|
||||
@@ -18,8 +18,7 @@ makeButton
|
||||
-> WdWd -- ^ Effect when pressed
|
||||
-> Button
|
||||
makeButton col eff = defaultButton
|
||||
{ _btPict = DefaultDrawButton col
|
||||
, _btEvent = ButtonPress BtInactive ButtonDoNothing click1S eff
|
||||
{ _btEvent = ButtonPress BtInactive ButtonDoNothing click1S eff col
|
||||
, _btState = BtOff
|
||||
}
|
||||
|
||||
@@ -37,13 +36,13 @@ drawSwitchWire col1 col2 bt
|
||||
)
|
||||
|
||||
makeSwitchSPic
|
||||
:: ButtonDraw
|
||||
:: Color
|
||||
-> Color
|
||||
-> WdWd -- ^ Switch on effect
|
||||
-> WdWd -- ^ Switch off effect
|
||||
-> Button
|
||||
makeSwitchSPic dswitch effOn effOff = defaultButton
|
||||
{ _btPict = dswitch
|
||||
, _btEvent = ButtonSimpleSwith effOn effOff
|
||||
makeSwitchSPic c1 c2 effOn effOff = defaultButton
|
||||
{ _btEvent = ButtonSimpleSwith effOn effOff c1 c2
|
||||
, _btState = BtOff
|
||||
}
|
||||
|
||||
@@ -53,4 +52,4 @@ makeSwitch
|
||||
-> WdWd -- ^ Switch on effect
|
||||
-> WdWd -- ^ Switch off effect
|
||||
-> Button
|
||||
makeSwitch col1 col2 = makeSwitchSPic (DefaultDrawSwitch col1 col2)
|
||||
makeSwitch col1 col2 = makeSwitchSPic col1 col2
|
||||
|
||||
@@ -11,15 +11,15 @@ import Dodge.Placement.Instance.LightSource
|
||||
import Dodge.PlacementSpot
|
||||
import Geometry
|
||||
|
||||
triggerSwitchSPic :: ButtonDraw -> PlacementSpot -> Placement
|
||||
triggerSwitchSPic sdraw ps = psPtCont ps (PutTrigger False) $
|
||||
triggerSwitchSPic :: Color -> Color -> PlacementSpot -> Placement
|
||||
triggerSwitchSPic c1 c2 ps = psPtCont ps (PutTrigger False) $
|
||||
\tp ->
|
||||
Just $
|
||||
pContID
|
||||
ps
|
||||
( PutButton
|
||||
( makeSwitchSPic
|
||||
sdraw
|
||||
c1 c2
|
||||
(SetTrigger True $ trigid tp)
|
||||
(SetTrigger False $ trigid tp)
|
||||
)
|
||||
@@ -28,15 +28,15 @@ triggerSwitchSPic sdraw ps = psPtCont ps (PutTrigger False) $
|
||||
where
|
||||
trigid tp = fromJust $ _plMID tp
|
||||
|
||||
triggerSwitchSPicLight :: ButtonDraw -> PlacementSpot -> Placement
|
||||
triggerSwitchSPicLight sdraw ps = psPtCont ps (PutTrigger False) $
|
||||
triggerSwitchSPicLight :: Color -> Color -> PlacementSpot -> Placement
|
||||
triggerSwitchSPicLight c1 c2 ps = psPtCont ps (PutTrigger False) $
|
||||
\tp -> Just $
|
||||
pContID atFstLnkOut (PutLS thels) $
|
||||
\lsid ->
|
||||
Just $
|
||||
pContID
|
||||
ps
|
||||
(PutButton (makeSwitchSPic sdraw (oneff lsid $ trigid tp) (offeff lsid $ trigid tp)))
|
||||
(PutButton (makeSwitchSPic c1 c2 (oneff lsid $ trigid tp) (offeff lsid $ trigid tp)))
|
||||
(const Nothing)
|
||||
where
|
||||
thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75
|
||||
|
||||
@@ -51,8 +51,7 @@ putMessageTerminal col =
|
||||
termButton :: Button
|
||||
termButton =
|
||||
Button
|
||||
{ _btPict = DrawNoButton
|
||||
, _btPos = 0
|
||||
{ _btPos = 0
|
||||
, _btRot = 0
|
||||
, _btEvent = ButtonAccessTerminal
|
||||
, _btID = 0
|
||||
|
||||
@@ -106,7 +106,7 @@ floorItemSPic flit =
|
||||
btSPic :: Button -> SPic
|
||||
btSPic bt =
|
||||
uncurryV translateSPxy (_btPos bt) $
|
||||
rotateSP (_btRot bt) (drawButton (_btPict bt) bt)
|
||||
rotateSP (_btRot bt) (drawButton bt)
|
||||
|
||||
mcSPic :: LWorld -> Machine -> SPic
|
||||
mcSPic lw mc =
|
||||
|
||||
Reference in New Issue
Block a user