Simplify button drawing

src/Dodge/Button/Draw.hs

@@ -5,12 +5,14 @@ import Dodge.Data.Button
 import Geometry
 import Shape
 import ShapePicture
+import Control.Lens
 
-drawButton :: ButtonDraw -> Button -> SPic
+drawButton :: Button -> SPic
-drawButton bd = case bd of
+drawButton bt = case bt ^. btEvent of
-    DefaultDrawButton col -> defaultDrawButton col
+    ButtonPress {_bpColor = col} -> defaultDrawButton col bt
-    DefaultDrawSwitch col1 col2 -> drawSwitch col1 col2
+    ButtonSimpleSwith {_bssColor1 = col1, _bssColor2 = col2} -> drawSwitch col1 col2 bt
-    DrawNoButton -> const mempty
+    ButtonAccessTerminal -> mempty
+    ButtonDoNothing -> mempty
 
 drawSwitch :: Color -> Color -> Button -> SPic
 drawSwitch col1 col2 bt

src/Dodge/Button/Event.hs

@@ -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

src/Dodge/Data/Button.hs

@@ -13,11 +13,11 @@ import Dodge.Data.WorldEffect
 import Geometry.Data
 import Sound.Data
 
-data ButtonDraw
+--data ButtonDraw
-    = DefaultDrawButton Color
+--    = DefaultDrawButton Color
-    | DefaultDrawSwitch Color Color
+--    | DefaultDrawSwitch Color Color
-    | DrawNoButton
+--    | DrawNoButton
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
+--    --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
+    | ButtonSimpleSwith
-      --        {_bonState :: ButtonState
-      --        ,_bonEvent :: ButtonEvent
-      --        ,_bonSound :: SoundID
-      --        ,_bonEff :: WorldEffect
-      --        ,_boffState :: ButtonState
-      --        ,_boffEvent :: ButtonEvent
-      --        ,_boffSound :: SoundID
-      --        ,_boffEff :: WorldEffect
-      --        }
-      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

src/Dodge/Default.hs

@@ -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 
+            (dark red)
         , _btID = 0
         , _btState = BtOff
         , _btTermMID = Nothing

src/Dodge/LevelGen/Switch.hs

@@ -18,8 +18,7 @@ makeButton
     -> WdWd -- ^ Effect when pressed
     -> Button
 makeButton col eff = defaultButton
-    { _btPict = DefaultDrawButton col
+    { _btEvent = ButtonPress BtInactive ButtonDoNothing click1S eff col
-    , _btEvent = ButtonPress BtInactive ButtonDoNothing click1S eff
     , _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
+makeSwitchSPic c1 c2 effOn effOff = defaultButton
-    { _btPict = dswitch
+    { _btEvent = ButtonSimpleSwith effOn effOff c1 c2
-    , _btEvent = ButtonSimpleSwith effOn effOff
     , _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

src/Dodge/Placement/Instance/Button.hs

@@ -11,15 +11,15 @@ import Dodge.Placement.Instance.LightSource
 import Dodge.PlacementSpot
 import Geometry
 
-triggerSwitchSPic :: ButtonDraw -> PlacementSpot -> Placement
+triggerSwitchSPic :: Color -> Color -> PlacementSpot -> Placement
-triggerSwitchSPic sdraw ps = psPtCont ps (PutTrigger False) $
+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 :: Color -> Color -> PlacementSpot -> Placement
-triggerSwitchSPicLight sdraw ps = psPtCont ps (PutTrigger False) $
+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

src/Dodge/Placement/Instance/Terminal.hs

@@ -51,8 +51,7 @@ putMessageTerminal col =
 termButton :: Button
 termButton =
     Button
-        { _btPict = DrawNoButton
+        { _btPos = 0
-        , _btPos = 0
         , _btRot = 0
         , _btEvent = ButtonAccessTerminal
         , _btID = 0

src/Dodge/Render/ShapePicture.hs

@@ -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 =