Move button data

src/Dodge/Button/Draw.hs

@@ -0,0 +1,36 @@
+module Dodge.Button.Draw where
+import Dodge.Data.Button
+import Geometry
+import Color
+import ShapePicture
+import Shape
+
+drawButton :: ButtonDraw -> Button -> SPic
+drawButton bd = case bd of
+    DefaultDrawButton col -> defaultDrawButton col
+    DefaultDrawSwitch col1 col2 -> drawSwitch col1 col2
+    DrawNoButton -> const mempty
+
+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 . upperPrismPoly 20 $ reverse $ rectNSWE (-2) (-5) (-10) 10
+        , colorSH col2 . translateSH (V3 0 (-2) 20) . rotateSH a . upperPrismPoly 2 $ reverse
+            $ rectNSWE 10 0 (-2) 2
+        ]   
+        , mempty)
+
+defaultDrawButton :: Color -> Button -> SPic
+defaultDrawButton col bt =
+    ( translateSHz 15 . colorSH col $ upperPrismPoly 5 buttonGeometry
+    , mempty
+    )
+  where
+    buttonGeometry
+        | _btState bt == BtOff = reverse $ rectNSWE 10 (-1) (-width) width
+        | otherwise = reverse $ rectNSWE 2 (-1) (-width) width
+    width = 8

src/Dodge/Button/Event.hs

@@ -0,0 +1,33 @@
+module Dodge.Button.Event where
+import Dodge.Data
+import Dodge.SoundLogic
+import Dodge.Placement.Instance.Terminal
+
+import Dodge.WorldEffect
+import Control.Lens
+
+doButtonEvent :: ButtonEvent -> Button -> World -> World
+doButtonEvent be = case be of
+    ButtonDoNothing -> const id
+    ButtonPress newstate newevent thesound f -> \b -> doWorldEffect f
+        . set (buttons . ix (_btID b) . btState) newstate
+        . set (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
+    ButtonAccessTerminal -> accessTerminal . _btTermMID
+
+flipSwitch :: WorldEffect -> WorldEffect -> Button -> World -> World
+flipSwitch oneff offeff bt 
+    | _btState bt == BtOff = doWorldEffect oneff . dosound
+        . over (buttons . ix (_btID bt)) turnon
+    | otherwise = doWorldEffect offeff . dosound
+        . over (buttons . ix (_btID bt)) turnoff
+  where
+    turnon  = (btState .~ BtOn ) .  (btText .~ "SWITCH\\")
+    turnoff = (btState .~ BtOff) .  (btText .~ "SWITCH/")
+    dosound = soundFromGeneral (LeverSound 0) (const $ _btPos bt) click1S Nothing
+--    switchEffect b = case _btState b of
+--        BtOff -> effOn  . (buttons . ix (_btID b) %~ turnOn )
+--        BtOn  -> effOff . (buttons . ix (_btID b) %~ turnOff)
+--        _ -> error "Trying to switch a button with no label"