[led status handling
Evan Martin <martine@danga.com>**20060217044020] {
hunk ./PowerMate.hsc 1
+{-# OPTIONS -fffi #-}
hunk ./PowerMate.hsc 5
-{-# OPTIONS -fffi #-}
hunk ./PowerMate.hsc 10
-  Event(..)
+  Event(..),
+
+  Status(..), statusInit,
+  writeStatus
hunk ./PowerMate.hsc 30
+import Data.Bits (testBit)
hunk ./PowerMate.hsc 37
+data Status = Status {
+  brightness, pulse_speed, pulse_mode :: Int,
+  pulse_asleep, pulse_awake :: Bool
+}
+statusInit = Status 0 0 0 False False
+
hunk ./PowerMate.hsc 77
-decodeEvent :: (Word16, Word16, Int32) -> Maybe Event
+decodeEvent :: (Word16, Word16, Word32) -> Maybe Event
hunk ./PowerMate.hsc 94
-    value <- #{peek struct input_event, value} buf :: IO Int32
+    value <- #{peek struct input_event, value} buf :: IO Word32
hunk ./PowerMate.hsc 107
-writeEvent :: Handle -> Word16 -> Word16 -> Int32 -> IO ()
+writeEvent :: Handle -> Word16 -> Word16 -> Word32 -> IO ()
hunk ./PowerMate.hsc 114
+
+encodePulseLED :: Status -> Word32
+encodePulseLED status =
+  enc_brightness .|. enc_speed .|. enc_mode .|. enc_asleep .|. enc_awake where
+    enc_brightness = fromIntegral (brightness status)
+    enc_speed      = fromIntegral (pulse_speed status) `shiftL` 8
+    enc_mode       = fromIntegral (pulse_mode status) `shiftL` 17
+    enc_asleep     = boolBit (pulse_asleep status) `shiftL` 19
+    enc_awake      = boolBit (pulse_awake status) `shiftL` 20
+    boolBit True  = 1
+    boolBit False = 0
+
+decodePulseLED :: Word32 -> Status
+decodePulseLED word = Status { brightness=b, pulse_speed=ps, pulse_mode=pm,
+                               pulse_asleep=pas, pulse_awake=paw } where
+  b = fromIntegral $ word .&. 0xFF
+  ps = fromIntegral $ (word `shiftR` 8) .&. 0x1FF
+  pm = fromIntegral $ (word `shiftR` 17) .&. 0x3
+  pas = Data.Bits.testBit word 19
+  paw = Data.Bits.testBit word 20
+
+showBinary :: Word32 -> String
+showBinary word = concatMap showBit [31,30..0] where
+  showBit n = if Data.Bits.testBit word n then "1" else "0"
+
+writeStatus :: Handle -> Status -> IO ()
+writeStatus handle status = writeEvent handle typ code value where
+  typ   = #{const EV_MSC}
+  code  = #{const MSC_PULSELED}
+  value = encodePulseLED status
}