powermate.hs

   1 module Main where
   2
   3 import PowerMate
   4 import System.IO
   5 import System.Process
   6 import Control.Monad
   7 import Text.Regex.Posix
   8 import Data.Time
   9
  10 data State = State {
  11   stPowerMate   :: Handle,
  12   stVolume      :: Int,
  13   stPrevDir     :: Int,
  14   stPrevAction  :: Int,
  15   stPressed     :: Bool,
  16   stLastPress   :: UTCTime
  17 }
  18
  19 processEvent :: State -> Event -> IO State
  20 processEvent state (Button True) = do
  21   time <- getCurrentTime
  22   state <- updateLastPress state (time)
  23   state <- updateButton state True
  24   return state
  25 processEvent state (Button False) = do
  26   time <- getCurrentTime
  27   if (diffUTCTime (time) (stLastPress state) > 0.8)
  28     then ( do runCommand "amixer set Master toggle"; return () )
  29     else ( do runCommand "music-toggle"; return () )
  30   state <- updateButton state False
  31   return state
  32
  33 processEvent state (Rotate dir) = do
  34   state <- (if (stPressed state) == False
  35               && dir < 2
  36               && (stPrevDir state) == 1
  37               && (stPrevAction state) == 1
  38                 then volumeUp
  39               else return) state
  40   state <- (if (stPressed state) == False
  41               && dir > 2
  42               && (stPrevDir state) == 0
  43               && (stPrevAction state) == 0
  44                 then volumeDown
  45               else return) state
  46   when ((stPressed state) == True && dir < 2) ( do runCommand "next"; return () )
  47   state <- updatePrevState state (if dir < 2 then 1 else 0)
  48   updateBrightness state
  49   state <- updatePrevAction state (if (stPrevAction state) == 1 then 0 else 1)
  50   return state
  51
  52 readState :: State -> IO State
  53 readState state = do
  54   return state
  55
  56 next :: a -> (a -> IO a) -> IO ()
  57 next state func = do
  58   newstate <- func state
  59   next newstate func
  60   return ()
  61
  62 updateBrightness :: State -> IO ()
  63 updateBrightness state = do
  64   let brightness = (stVolume state)
  65   writeStatus (stPowerMate state) $
  66     statusInit { brightness=brightness }
  67
  68 volumeUp :: State -> IO State
  69 volumeUp state = do
  70   createProcess (proc "volume-up" [])
  71   state <- readState $ State {
  72     stPowerMate=(stPowerMate state),
  73     stVolume=(max 0 $ 1+(stVolume state)),
  74     stPrevAction=(stPrevAction state),
  75     stPrevDir=(stPrevDir state),
  76     stPressed=(stPressed state),
  77     stLastPress=(stLastPress state) }
  78   state <- updatePrevAction state 1
  79   return state
  80
  81 volumeDown :: State -> IO State
  82 volumeDown state = do
  83   createProcess (proc "volume-down" [])
  84   state <- readState $ State {
  85     stPowerMate=(stPowerMate state),
  86     stVolume=(max 0 $ (stVolume state)-1),
  87     stPrevAction=(stPrevAction state),
  88     stPrevDir=(stPrevDir state),
  89     stPressed=(stPressed state),
  90     stLastPress=(stLastPress state) }
  91   state <- updatePrevAction state 0
  92   return state
  93
  94 updatePrevState :: State -> Int -> IO State
  95 updatePrevState state dir = do
  96   state <- readState $ State {
  97     stPowerMate=(stPowerMate state),
  98     stVolume=(stVolume state),
  99     stPrevAction=(stPrevAction state),
 100     stPrevDir=dir,
 101     stPressed=(stPressed state),
 102     stLastPress=(stLastPress state) }
 103   return state
 104
 105 updatePrevAction :: State -> Int -> IO State
 106 updatePrevAction state action = do
 107   state <- readState $ State {
 108     stPowerMate=(stPowerMate state),
 109     stVolume=(stVolume state),
 110     stPrevAction=action,
 111     stPrevDir=(stPrevDir state),
 112     stPressed=(stPressed state),
 113     stLastPress=(stLastPress state) }
 114   return state
 115
 116 updateButton :: State -> Bool -> IO State
 117 updateButton state button = do
 118   state <- readState $ State {
 119     stPowerMate=(stPowerMate state),
 120     stVolume=(stVolume state),
 121     stPrevAction=(stPrevAction state),
 122     stPrevDir=(stPrevDir state),
 123     stPressed=button,
 124     stLastPress=(stLastPress state) }
 125   return state
 126
 127 updateLastPress :: State -> UTCTime -> IO State
 128 updateLastPress state lastPress = do
 129   state <- readState $ State {
 130     stPowerMate=(stPowerMate state),
 131     stVolume=(stVolume state),
 132     stPrevAction=(stPrevAction state),
 133     stPrevDir=(stPrevDir state),
 134     stPressed=(stPressed state),
 135     stLastPress=lastPress }
 136   return state
 137
 138 loop :: FilePath -> IO ()
 139 loop devname = do
 140   powermate <- openDevice devname
 141
 142   alsaMixers <- readProcess "amixer" ["get", "Master"] []
 143   let alsaMaster = (alsaMixers =~ "\\[([0-9]{1,2})%\\]" :: String)
 144   let volume = read (drop 1
 145                       (take
 146                         (subtract 2
 147                           (length alsaMaster)) alsaMaster)) :: Int
 148   time <- getCurrentTime
 149   state <- readState $ State {
 150     stPowerMate=powermate,
 151     stVolume=volume,
 152     stPrevAction=0,
 153     stPrevDir=0,
 154     stPressed=False,
 155     stLastPress=time }
 156   updateBrightness state
 157
 158   next state $ \call -> do
 159     event <- readEventWithSkip powermate Nothing
 160     case event of
 161       Nothing -> return call
 162       Just event -> processEvent call event
 163
 164 main :: IO ()
 165 main = do
 166   powermate <- searchForDevice
 167   case powermate of
 168     Nothing  -> return ()
 169     Just work -> do
 170       loop work