[import
Evan Martin <martine@danga.com>**20060216041530] {
addfile ./MPD.hs
hunk ./MPD.hs 1
+
+module MPD where
+
+import qualified Network
+import System.IO
+import List
+import System.Posix
+
+ignoreSIGPIPE = installHandler sigPIPE Ignore Nothing
+
+-- we keep around the host/port for reconnecting.
+data Connection = Connection Handle (String, Int)
+
+connectionHandle (Connection h _) = h
+
+connect :: String -> Int -> IO Connection
+connect host port = do
+  handle <- Network.connectTo host (Network.PortNumber $ fromIntegral port)
+  hSetBuffering handle LineBuffering
+  welcome <- hGetLine handle
+  putStrLn welcome
+  return $ Connection handle (host, port)
+
+reconnect :: Connection -> IO Connection
+reconnect (Connection _ (host, port)) = connect host port
+
+runCommand (Connection handle _) cmd = do
+  hPutStrLn handle cmd
+  lines <- getResponseLines []
+  return $ reverse lines where
+    getResponseLines :: [String] -> IO [String]
+    getResponseLines ls = do
+      line <- hGetLine handle
+      if line == "OK"
+        then return ls
+        else getResponseLines (line:ls)
+
+runCommand_ conn cmd = runCommand conn cmd >> return ()
+
+getVolume :: Connection -> IO Integer
+getVolume conn = do
+  lines <- runCommand conn "status"
+  let volume_line = lines !! 0  -- XXX hack; should actually parse this
+  let volume_key = "volume: "
+  if volume_key `isPrefixOf` volume_line
+    then return $ read (drop (length volume_key) volume_line)
+    else return (-1)
+
+setVolume :: Connection -> Int -> IO ()
+setVolume conn v = runCommand_ conn ("setvol " ++ show v)
+
+-- vim: set ts=2 sw=2 et ft=haskell :
addfile ./MPDMate.hs
hunk ./MPDMate.hs 1
+module Main where
+
+import qualified PowerMate
+import qualified MPD
+import System.IO
+import System.IO.Error
+
+file = "/dev/input/event3"
+
+loop :: a -> (a -> IO a) -> IO a
+loop a f = loop' a where
+  loop' a = f a >>= loop'
+
+processEvent :: MPD.Connection -> PowerMate.Event -> IO ()
+processEvent mpd (PowerMate.Button pressed) = do
+  if pressed then MPD.runCommand_ mpd "pause" else return ()
+processEvent mpd (PowerMate.Rotate dir) = do
+  putStr (if dir > 0 then "+" else "-")
+  hFlush stdout
+  MPD.runCommand_ mpd ("volume " ++ show dir)
+processEvent mpd PowerMate.Misc = putStrLn "misc"
+
+main = do
+  name <- PowerMate.getName file
+  putStrLn name
+
+  mpd <- MPD.connect "localhost" 6600
+
+  handle_pm <- openBinaryFile file ReadWriteMode
+  loop mpd $ \mpd -> do
+    event <- PowerMate.readEventWithSkip handle_pm Nothing
+    (do maybe (return ()) (processEvent mpd) event
+        return mpd)
+       `catch` \e -> do
+         print $ ioeGetErrorString e
+         MPD.reconnect mpd
+
+-- vim: set ts=2 sw=2 et ft=haskell :
addfile ./PowerMate.hsc
hunk ./PowerMate.hsc 1
+{-# OPTIONS -fffi #-}
+module PowerMate (
+  getName,
+  readEvent,
+  readEventWithSkip,
+  Event(..)
+) where
+
+import Foreign
+import Foreign.C.Error (throwErrnoIf)
+import Foreign.C.Types
+-- ioctl wants an Fd, so we use System.Posix.IO for that,
+import System.Posix.Types (Fd)
+import System.Posix.IO
+-- and then System.IO for everything else.
+import System.IO
+import IO
+import CString (withCAString, peekCString)
+import Debug.Trace (trace)
+
+#include <linux/input.h>
+
+foreign import ccall "sys/ioctl.h ioctl" ioctlChar ::
+  Fd -> CInt -> Ptr CChar -> IO CInt
+
+ioctlName :: Fd -> IO String
+ioctlName fd = do
+  withCAString (take 255 (repeat '\0')) $ \buf -> do
+    throwErrnoIf (< 0) "ioctl" $ ioctlChar fd #{const EVIOCGNAME(255)} buf
+    peekCString buf
+
+getName :: FilePath -> IO String
+getName filename = do
+  bracket (openFd filename ReadOnly Nothing defaultFileFlags) closeFd ioctlName
+
+data Event = Button Bool | Rotate Int | Misc
+--instance Show Event where
+--  show (typ, code, value) = 
+decodeEvent :: (Word16, Word16, Int32) -> Maybe Event
+decodeEvent (#{const EV_KEY}, _, value) = Just $ Button (value == 1)
+decodeEvent (#{const EV_REL}, _, value) = Just $ Rotate (fromIntegral value)
+decodeEvent (#{const EV_MSC}, _, _) = Just $ Misc
+decodeEvent (0, 0, 0) = Nothing  -- where do these come from?
+decodeEvent (typ, code, value) = trace ("Unhandled event: " ++ show typ ++ "," ++ show code ++ "," ++ show value) Nothing
+
+readEvent :: Handle -> IO (Maybe Event)
+readEvent handle = do
+  allocaBytes size $ \buf -> do
+    readsize <- hGetBuf handle buf size
+    -- putStrLn ("read " ++ show readsize ++ " bytes, wanted " ++ show size)
+    -- XXX die if readsize < size...
+    typ   <- #{peek struct input_event, type}  buf :: IO Word16
+    code  <- #{peek struct input_event, code}  buf :: IO Word16
+    value <- #{peek struct input_event, value} buf :: IO Int32
+    return $ decodeEvent (typ, code, value)
+  where size = #{size struct input_event}
+
+readEventWithSkip :: Handle -> Maybe Event -> IO (Maybe Event)
+readEventWithSkip handle prev = do
+  event <- readEvent handle
+  let actualevent = case event of
+                      Nothing -> prev
+                      _       -> event
+  more <- hReady handle
+  if more then readEventWithSkip handle actualevent
+          else return actualevent
+
+
+-- vim: set ts=2 sw=2 et ft=haskell :
}