packages feed

blink1 (empty) → 0.1

raw patch · 8 files changed

+336/−0 lines, 8 filesdep +basedep +ioctldep +unixsetup-changed

Dependencies added: base, ioctl, unix

Files

+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2012-2013, Dylan Simon+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/Hardware/Blink1.hs view
@@ -0,0 +1,100 @@+module System.Hardware.Blink1+  ( RGB(..)+  , Delay+  , Pos++  , getVersion+  , set+  , fade+  , serverDown+  , play+  , setPattern+  , getPattern+  ) where++import Control.Concurrent (threadDelay)+import Control.Monad (guard, liftM)+import Data.Bits (shiftR, shiftL, (.|.))+import Data.Char (chr, ord)+import Data.Word (Word16)+import System.Hardware.Blink1.Class+import System.Hardware.Blink1.Types++reportId :: Word8+reportId = 1++msgLen :: Int+msgLen = 8++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral++fill :: Int -> a -> [a] -> [a]+fill 0 _ [] = []+fill 0 _ _ = error "fill: list too long"+fill n x [] = replicate n x+fill n x (a:l) = a : fill (pred n) x l++command :: Blink1 b => b -> Char -> [Word8] -> IO ()+command b c d = writeBlink1 b (reportId : fi (ord c) : fill (pred msgLen) 0 d)++request :: Blink1 b => b -> Char -> [Word8] -> IO [Word8]+request b c d = do+  command b c d+  threadDelay 50000 -- FIXME says the original+  tail `liftM` readBlink1 b (succ msgLen)++getVersion :: Blink1 b => b -> IO (Char,Char)+getVersion b = do+  _:_:maj:min:_ <- request b 'v' []+  return $ (chr (fi maj), chr (fi min))++rgb :: RGB -> [Word8]+rgb (RGB r g b) = [r,g,b]++delay :: Delay -> [Word8]+delay d = [i $ t `shiftR` 8, i t] where +  t = truncate (100 * d) :: Word16+  i = fi :: Word16 -> Word8++pos :: Pos -> [Word8]+pos p = [fi (fromEnum p)]++-- | set the given color now+set :: Blink1 b => b -> RGB -> IO ()+set b c = command b 'n' $ rgb c++fade :: Blink1 b => b -> Delay -> RGB -> IO ()+fade b d c = command b 'c' $ rgb c ++ delay d++-- | enable/disable serverdown mode+serverDown :: Blink1 b => b -> Bool -> Delay -> IO ()+serverDown b o d = command b 'D' $ fi (fromEnum o) : delay d++-- | stop or start playing the sequence at the given position+play :: Blink1 b => b -> Maybe Pos -> IO ()+play b Nothing = command b 'p' [0]+play b (Just p) = command b 'p' $ 1 : pos p++-- | set the sequence pattern for the given position+setPattern :: Blink1 b => b -> Pos -> Delay -> RGB -> IO ()+setPattern b p d c = command b 'P' $ rgb c ++ delay d ++ pos p++getPattern :: Blink1 b => b -> Pos -> IO (Delay, RGB)+getPattern b p = do+  _:r:g:b:d1:d2:_ <- request b 'R' $ rgb black ++ delay 0 ++ pos p+  return (fi (i d1 `shiftL` 8 .|. i d2) / 100, RGB r g b)+  where i = fi :: Word8 -> Word16++readEEPROM :: Blink1 b => b -> Word8 -> IO Word8+readEEPROM b a = do+  _:_:v:_ <- request b 'e' [a]+  return v++writeEEPROM :: Blink1 b => b -> Word8 -> Word8 -> IO ()+writeEEPROM b a v = command b 'E' [a, v]++test :: Blink1 b => b -> IO (Maybe Bool)+test b = do+  x:y:u:_ <- request b '!' []+  return $ guard (x == 0x55 && y == 0xAA) >> return (u /= 0)
+ System/Hardware/Blink1/Class.hs view
@@ -0,0 +1,16 @@+module System.Hardware.Blink1.Class+  ( Blink1(..)+  , blink1Vendor, blink1Product+  ) where++import Data.Int (Int16)+import Data.Word (Word8)++-- we could parameterize on monad too, if it comes to that+class Blink1 b where+  writeBlink1 :: b -> [Word8] -> IO ()+  readBlink1 :: b -> Int -> IO [Word8]++blink1Vendor, blink1Product :: Int16+blink1Vendor = 0x27B8+blink1Product = 0x1ED
+ System/Hardware/Blink1/Linux.hs view
@@ -0,0 +1,71 @@+module System.Hardware.Blink1.Linux+  ( Blink1Raw+  , openRawDev+  , openRawHID+  , openRawHIDs+  ) where++import Control.Exception (onException, bracket)+import Control.Monad+import Data.List (isPrefixOf, genericLength)+import Foreign.C.Error (errnoToIOError, eFTYPE) -- hack+import Numeric (readHex)+import System.IO.Error (ioError, mkIOError, fullErrorType, doesNotExistErrorType)+import System.Posix.IO+import System.Posix.IOCtl+import System.Posix.Directory (openDirStream, readDirStream, closeDirStream)+import System.Posix.Types (Fd)+import Foreign.Marshal.Array++import System.Linux.HIDRaw+import System.Hardware.Blink1.Types+import System.Hardware.Blink1.Class++newtype Blink1Raw = Blink1Raw Fd++-- | Open the given blink(1) hidraw device+openRawDev :: FilePath -> IO Blink1Raw+openRawDev f = do+  d <- openFd df ReadWrite Nothing defaultFileFlags+  i <- devInfo d `onException` closeFd d+  when (devVendor i /= blink1Vendor || devProduct i /= blink1Product) $ do+    closeFd d+    ioError $ errnoToIOError "not Blink1" eFTYPE Nothing (Just f)+  return $ Blink1Raw d+  where df = case f of { '/':_ -> f ; _ -> "/dev/" ++ f }++findRawDev :: MonadPlus m => IO (m String)+findRawDev = pds dp hiddir where+  hiddir = "/sys/bus/hid/devices"+  pds f d = bracket (openDirStream d) closeDirStream r where+    r d = do+      e <- readDirStream d+      if null e then return mzero else liftM2 mplus (f e) (r d)+  dp f | null (do+      (_,':':vs) <- readHex f+      (v,':':ps) <- readHex vs+      guard (v == blink1Vendor)+      (p,'.':_) <- readHex ps+      guard (p == blink1Product)) = return mzero+    | otherwise = pds fp (hiddir ++ '/' : f ++ "/hidraw")+  fp f = return $ guard ("hidraw" `isPrefixOf` f) >> return f++-- | Search for and open the first blink(1) hidraw device+openRawHID :: IO Blink1Raw+openRawHID = maybe +  (ioError $ mkIOError doesNotExistErrorType "Blink1.openRawHID" Nothing Nothing) +  openRawDev =<< findRawDev+  +-- | Search for and open all blink(1) hidraw devices+openRawHIDs :: IO [Blink1Raw]+openRawHIDs = mapM openRawDev =<< findRawDev+  +closeRaw :: Blink1Raw -> IO ()+closeRaw (Blink1Raw d) = closeFd d++instance Blink1 Blink1Raw where+  writeBlink1 (Blink1Raw d) x = do -- setFeature d x+    let l = genericLength x+    r <- withArray x $ \p -> fdWriteBuf d p l+    when (r /= l) $ ioError $ mkIOError fullErrorType "Blink1Raw: short write" Nothing Nothing+  readBlink1 (Blink1Raw d) n = getFeature d n
+ System/Hardware/Blink1/Types.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module System.Hardware.Blink1.Types+  ( Word8+  , RGB(..)+  , black+  , Delay(..)+  , Pos(..)+  ) where++import Data.Word (Word8)+import Data.Fixed (Centi)+import Numeric (showHex)++data RGB = RGB { red, green, blue :: !Word8 }++black :: RGB+black = RGB 0 0 0++showHex2 :: Word8 -> ShowS+showHex2 x+  | x < 16 = showChar '0' . showHex x+  | otherwise = showHex x++instance Show RGB where+  showsPrec _ (RGB r g b) = showChar '#' . showHex2 r . showHex2 g . showHex2 b++-- | time is counted in centiseconds+newtype Delay = Delay { delayCentiseconds :: Centi } deriving (Eq, Ord, Num, Real, Fractional, RealFrac)++instance Bounded Delay where+  minBound = Delay 0+  maxBound = Delay 655.36++instance Show Delay where+  showsPrec p (Delay s) = showsPrec p s . showChar 's'++-- | positions are counted 0-11+newtype Pos = Pos Word8 deriving (Eq, Ord, Enum, Num)++instance Bounded Pos where+  minBound = Pos 0+  maxBound = Pos 11
+ System/Linux/HIDRaw.hsc view
@@ -0,0 +1,53 @@+{-# LANGUAGE MultiParamTypeClasses #-}+-- | Minimal interface to hidraw ioctls, sufficient for blink(1)+module System.Linux.HIDRaw+  ( DevInfo(..)+  , devInfo+  , setFeature+  , getFeature+  ) where++import Data.Int (Int16)+import Data.Word (Word8, Word32)+import Foreign.C.Error (errnoToIOError, eOPNOTSUPP)+import Foreign.C.Types (CInt)+import Foreign.Storable+import System.IO.Error (ioError)+import System.Posix.Types (Fd)+import System.Posix.IOCtl++#include <sys/ioctl.h>+#include <linux/hidraw.h>++data DevInfo = DevInfo +  { devBustype :: Word32+  , devVendor :: Int16+  , devProduct :: Int16+  }++instance Storable DevInfo where+  sizeOf _ = #size struct hidraw_devinfo+  alignment _ = 4 -- #alignment struct hidraw_devinfo+  peek p = do+    b <- #{peek struct hidraw_devinfo, bustype} p+    v <- #{peek struct hidraw_devinfo, vendor} p+    i <- #{peek struct hidraw_devinfo, product} p+    return $ DevInfo b v i+  poke p (DevInfo b v i) = do+    #{poke struct hidraw_devinfo, bustype} p b+    #{poke struct hidraw_devinfo, vendor} p v+    #{poke struct hidraw_devinfo, product} p i++data HIDIOCGRAWINFO = HIDIOCGRAWINFO+instance IOControl HIDIOCGRAWINFO DevInfo where+  ioctlReq _ = #const HIDIOCGRAWINFO++devInfo :: Fd -> IO DevInfo+devInfo d = ioctl' d HIDIOCGRAWINFO++-- the ioctl package doesn't support these, so they're unimplemented for now+setFeature :: Fd -> [Word8] -> IO ()+setFeature d _ = ioError $ errnoToIOError "System.Linux.HIDRaw.setFeature" eOPNOTSUPP Nothing Nothing++getFeature :: Fd -> Int -> IO [Word8]+getFeature d _ = ioError $ errnoToIOError "System.Linux.HIDRaw.getFeature" eOPNOTSUPP Nothing Nothing
+ blink1.cabal view
@@ -0,0 +1,26 @@+Name:		blink1+Version:	0.1+Author:		Dylan Simon+Maintainer:     dylan@dylex.net+License:        BSD3+License-File:	LICENSE+Synopsis:	Control library for blink(1) LED from ThingM+Description:    Provides an interface to the ThingM blink(1) LED <http://thingm.com/products/blink-1.html> similar to (but not dependent on) <http://github.com/todbot/blink1>.  Currently only a partially-functional Linux HIDRAW-based interface is defined, but a libusb-based one is planned.+Category:	Hardware+Build-Type:	Simple+Cabal-Version:	>= 1.6+tested-with:	GHC == 7.6.1++Source-Repository head+    Type:	git+    Location:   http://github.com/dylex/blink++Library+    Build-Depends:	base == 4.*+    Exposed-Modules:    System.Hardware.Blink1+    Other-Modules:      System.Hardware.Blink1.Types, System.Hardware.Blink1.Class++    if os(linux)+        Build-Depends:	unix, ioctl+        Exposed-Modules: System.Hardware.Blink1.Linux+        Other-Modules:	System.Linux.HIDRaw