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
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 :: 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
serverDown :: Blink1 b => b -> Bool -> Delay -> IO ()
serverDown b o d = command b 'D' $ fi (fromEnum o) : delay d
play :: Blink1 b => b -> Maybe Pos -> IO ()
play b Nothing = command b 'p' [0]
play b (Just p) = command b 'p' $ 1 : pos p
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)