streamdeck 0.0.3 → 0.1.0
raw patch · 4 files changed
+289/−134 lines, 4 filesdep +splitdep ~base
Dependencies added: split
Dependency ranges changed: base
Files
- ChangeLog.md +4/−0
- LICENSE +1/−1
- src/System/Hardware/Streamdeck.hs +279/−130
- streamdeck.cabal +5/−3
ChangeLog.md view
@@ -4,3 +4,7 @@ * Migrated existing functionality into own library from https://github.com/wuest/streamdeck-controller * Supports: enumeration, read (limited), write (limited)++## 0.1.0 -- 2019-11-18++* Added support for Stream Deck Mini and Stream Deck XL
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2018, Tina Wuest+Copyright (c) 2018-2019, Tina Wuest All rights reserved.
src/System/Hardware/Streamdeck.hs view
@@ -1,50 +1,158 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} -module System.Hardware.Streamdeck ( Deck ( serialNumber- , firmware- )- , solidRGB- , openStreamDeck- , enumerateStreamDecks+module System.Hardware.Streamdeck ( Deck (..)+ , Page (..)+ , ConnectedDecks (..)+ , Image+ , Pixel+ , enumerate+ , open+ , serialNumber, firmware+ , sendRaw+ , writeImage+ , update , setBrightness- , updateDeck , readButtonState- , writeImage- , sendRaw+ , solidRGB ) where import qualified Data.Bits as B import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC (pack)+import qualified Data.List.Split as Split (chunksOf) import qualified Data.Word as DW (Word16, Word8) import qualified System.HIDAPI as HID import Prelude -newtype ActiveMap = ActiveMap [Bool]--newtype Page = Page (Row, Row, Row)+type MiniActiveRow = (Bool, Bool, Bool)+type SDActiveRow = (Bool, Bool, Bool, Bool, Bool)+type XLActiveRow = (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool) -newtype Row = Row (Image, Image, Image, Image, Image)+type MiniActiveMap = (MiniActiveRow, MiniActiveRow)+type SDActiveMap = (SDActiveRow, SDActiveRow, SDActiveRow)+type XLActiveMap = (XLActiveRow, XLActiveRow, XLActiveRow, XLActiveRow) -type Image = BS.ByteString+data ButtonsActive = MiniActive MiniActiveMap+ | SDActive SDActiveMap+ | XLActive XLActiveMap+ deriving (Show, Eq) +type Image = BS.ByteString type PixelR = DW.Word8 type PixelG = DW.Word8 type PixelB = DW.Word8+type Pixel = (PixelR, PixelG, PixelB) -data Deck = Deck { _ref :: HID.Device- , serialNumber :: BS.ByteString- , firmware :: BS.ByteString- , display :: Page- }+type MiniRow = (Image, Image, Image)+type SDRow = (Image, Image, Image, Image, Image)+type XLRow = (Image, Image, Image, Image, Image, Image, Image, Image) -vendorID :: DW.Word16-vendorID = 0x0fd9+data PageType = MiniPage | SDPage | XLPage+data Page :: PageType -> * where+ MiniPage' :: (MiniRow, MiniRow) -> Page 'MiniPage+ SDPage' :: (SDRow, SDRow, SDRow) -> Page 'SDPage+ XLPage' :: (XLRow, XLRow, XLRow, XLRow) -> Page 'XLPage -productID :: DW.Word16-productID = 0x0060+data DeckSpec = DeckSpec { _ref :: HID.Device+ , _serialNumber :: BS.ByteString+ , _firmware :: BS.ByteString+ } +data DeckType = StreamDeckMini | StreamDeck | StreamDeckXL+data Deck :: DeckType -> * where+ StreamDeckMini' :: (HID.DeviceInfo, Maybe DeckSpec, Page 'MiniPage) -> Deck 'StreamDeckMini+ StreamDeck' :: (HID.DeviceInfo, Maybe DeckSpec, Page 'SDPage) -> Deck 'StreamDeck+ StreamDeckXL' :: (HID.DeviceInfo, Maybe DeckSpec, Page 'XLPage) -> Deck 'StreamDeckXL++data ConnectedDecks = ConnectedDecks { minis :: [Deck 'StreamDeckMini]+ , decks :: [Deck 'StreamDeck]+ , xls :: [Deck 'StreamDeckXL]+ }++-- Example Device Info for an early Stream Deck:+-- DeviceInfo { path = "/dev/hidraw%d"+-- , vendorId = 4057+-- , produc tId = 96+-- , serialNumber = Just ""+-- , releaseNumber = 256+-- , manufacturerString = Just "Elgato Systems"+-- , productString = Just "Stream Deck"+-- , usagePage = 13410+-- , usage = 13359+-- , interfaceNumber = 0+-- }++-- Constant across all Elgato hardware+vendorID :: Maybe DW.Word16+vendorID = Just 0x0fd9++-- Enumerate Stream Decks, differentiating by type+enumerate :: IO ConnectedDecks+enumerate = do+ m <- enum (Just 0x0063)+ s <- enum (Just 0x0060)+ x <- enum (Just 0x006c)+ return $ ConnectedDecks { minis = fmap fm m+ , decks = fmap fs s+ , xls = fmap fx x+ }+ where enum = HID.enumerate vendorID+ fm di = StreamDeckMini' (di, Nothing, emptyMiniPage)+ fs di = StreamDeck' (di, Nothing, emptySDPage)+ fx di = StreamDeckXL' (di, Nothing, emptyXLPage)++-- Note: older firmware Stream Decks have a bug where "" is reported as the+-- Serial number unless a feature report requesting the Serial Number is issued.+-- Newer Stream Decks do not require this step.+determineSN :: HID.DeviceInfo -> HID.Device -> IO BS.ByteString+determineSN info dev = case HID.serialNumber info of+ Nothing -> requestSN dev+ Just "" -> requestSN dev+ Just sn -> return $ BSC.pack $ show sn++requestSN :: HID.Device -> IO BS.ByteString+requestSN dev = do+ sn <- HID.getFeatureReport dev 3 17+ return $ BS.takeWhile (/= 0) $ BS.drop 5 $ snd sn++requestFW :: HID.Device -> IO BS.ByteString+requestFW dev = do+ fw <- HID.getFeatureReport dev 4 17+ return $ BS.takeWhile (/= 0) $ BS.drop 5 $ snd fw++open :: Deck a -> IO (Deck a)+open (StreamDeckMini' (device, Nothing, _)) =+ open' device (\deck sn fw -> StreamDeckMini' (device, Just $ DeckSpec { _ref = deck, _serialNumber = sn, _firmware = fw }, emptyMiniPage) )+open (StreamDeck' (device, Nothing, _)) =+ open' device (\deck sn fw -> StreamDeck' (device, Just $ DeckSpec { _ref = deck, _serialNumber = sn, _firmware = fw }, emptySDPage) )+open (StreamDeckXL' (device, Nothing, _)) =+ open' device (\deck sn fw -> StreamDeckXL' (device, Just $ DeckSpec { _ref = deck, _serialNumber = sn, _firmware = fw }, emptyXLPage) )+open _ = undefined -- Opening an already-opened Stream Deck is undefined++open' :: HID.DeviceInfo -> (HID.Device -> BS.ByteString -> BS.ByteString -> Deck a) -> IO (Deck a)+open' device f = HID.withHIDAPI $ do+ deck <- HID.openDeviceInfo device+ sn <- determineSN device deck+ fw <- requestFW deck+ return $ f deck sn fw++serialNumber :: Deck a -> BS.ByteString+serialNumber (StreamDeckMini' (_, Just ds, _)) = _serialNumber ds+serialNumber (StreamDeck' (_, Just ds, _)) = _serialNumber ds+serialNumber (StreamDeckXL' (_, Just ds, _)) = _serialNumber ds+serialNumber _ = undefined++firmware :: Deck a -> BS.ByteString+firmware (StreamDeckMini' (_, Just ds, _)) = _firmware ds+firmware (StreamDeck' (_, Just ds, _)) = _firmware ds+firmware (StreamDeckXL' (_, Just ds, _)) = _firmware ds+firmware _ = undefined++-- Constants useful in communicating with Stream Decks packetSize :: Int packetSize = 4096 @@ -60,51 +168,47 @@ solidRGB :: PixelR -> PixelG -> PixelB -> Image solidRGB r g b = BS.pack $ take (3 * (buttonPixels - 1)) $ cycle [b, g, r] -defaultPage :: Page-defaultPage = Page ( Row ( solidRGB 255 0 0- , solidRGB 204 0 0- , solidRGB 153 0 0- , solidRGB 102 0 0- , solidRGB 51 0 0- )- , Row ( solidRGB 0 255 0- , solidRGB 0 204 0- , solidRGB 0 153 0- , solidRGB 0 102 0- , solidRGB 0 51 0- )- , Row ( solidRGB 0 0 255- , solidRGB 0 0 204- , solidRGB 0 0 153- , solidRGB 0 0 102- , solidRGB 0 0 51- )- )+emptyMiniRow :: MiniRow+emptyMiniRow = (b, b, b)+ where b = solidRGB 0 0 0+emptySDRow :: SDRow+emptySDRow = (b, b, b, b, b)+ where b = solidRGB 0 0 0+emptyXLRow :: XLRow+emptyXLRow = (b, b, b, b, b, b, b, b)+ where b = solidRGB 0 0 0 -setBrightness :: DW.Word8 -> BS.ByteString-setBrightness b- | b <= 100 = setBrightness' b- | otherwise = setBrightness' 100+emptyMiniPage :: Page 'MiniPage+emptyMiniPage = MiniPage' (r, r)+ where r = emptyMiniRow+emptySDPage :: Page 'SDPage+emptySDPage = SDPage' (r, r, r)+ where r = emptySDRow+emptyXLPage :: Page 'XLPage+emptyXLPage = XLPage' (r, r, r, r)+ where r = emptyXLRow -setBrightness' :: DW.Word8 -> BS.ByteString-setBrightness' b = BS.pack [ 0x05 -- Report 0x05- , 0x55, 0xAA, 0xD1, 0x01 -- Command (brightness)- , b, 0x00, 0x00, 0x00 -- brightness- , 0x00, 0x00, 0x00, 0x00- , 0x00, 0x00, 0x00, 0x00- ]+-- Helper method to return the device for a given Deck+ref :: Deck a -> HID.Device+ref (StreamDeckMini' (_, Just spec, _)) = _ref spec+ref (StreamDeck' (_, Just spec, _)) = _ref spec+ref (StreamDeckXL' (_, Just spec, _)) = _ref spec+ref _ = undefined -- requesting a reference to an unopened Deck is undefined -sendRaw :: Deck -> BS.ByteString -> IO ()+-- Send raw bytes to a Deck, broken up by packets+sendRaw :: Deck a -> BS.ByteString -> IO () sendRaw deck bs = if BS.length bs > packetSize then- (do _ <- HID.write (_ref deck) $ BS.take packetSize bs+ (do _ <- HID.write (ref deck) $ BS.take packetSize bs sendRaw deck $ fixContinuationPacket bs) else- (do _ <- HID.write (_ref deck) bs+ (do _ <- HID.write (ref deck) bs return ()) --- In cases where the first byte of a continuation packet is unset, the byte is--- discarded, resulting in discoloration+-- In cases where the first byte of a continuation packet is equal to 0, the+-- byte is discarded entirely, resulting in discoloration. Continuation packets+-- only get used in cases where data > 4096 bytes is being sent, so in practice+-- this is only a concern for sending image data. fixContinuationPacket :: BS.ByteString -> BS.ByteString fixContinuationPacket b | BS.length b < packetSize = BS.pack []@@ -114,9 +218,29 @@ in if byte > 0 then rest else BS.cons ((B..|.) 1 byte) (BS.drop 1 rest) -writePage :: Deck -> Int -> DW.Word8 -> BS.ByteString -> IO ()+-- Generate a packet to set the Deck's brightness. Values passed are bracketed+-- to 0 >= x >= 100. Full brightness is defaulted to otherwise.+setBrightness :: DW.Word8 -> BS.ByteString+setBrightness b+ | b <= 100 && b >= 0 = setBrightness' b+ | otherwise = setBrightness' 100++setBrightness' :: DW.Word8 -> BS.ByteString+setBrightness' b = BS.pack [ 0x05 -- Report 0x05+ , 0x55, 0xAA, 0xD1, 0x01 -- Command (brightness)+ , b, 0x00, 0x00, 0x00 -- brightness+ , 0x00, 0x00, 0x00, 0x00+ , 0x00, 0x00, 0x00, 0x00+ ]++-- Write a given page of data to a Deck.+writePage :: Deck a -> Int -> DW.Word8 -> BS.ByteString -> IO () writePage deck p i bs = sendRaw deck $ BS.append (page p i) bs +-- Generate a given page of data to be sent to a Deck. The first page of a+-- command (for commands requiring 2 pages - typically sending image data) has+-- a longer prologue than the second page. No commands with more than 2 pages+-- exist. page :: Int -> DW.Word8 -> BS.ByteString page 1 i = BS.pack [ 0x02, 0x01, 0x01, 0x00, 0x00, i+1, 0x00, 0x00 , 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00@@ -133,8 +257,9 @@ page _ _ = BS.pack [] -read :: Deck -> Int -> IO BS.ByteString-read deck = HID.read (_ref deck)+-- Helper: read data from a given Deck+readRaw :: HID.Device -> Int -> IO BS.ByteString+readRaw = HID.read -- Stream Deck reports button state ONLY upon button press/release -- Stream Deck will send a 16 byte message, with the following format:@@ -142,87 +267,111 @@ -- * Byte 0 being set to 0x01 is static, indicating a "button event" message. -- * AA-OO are 1 byte, if the low bit is set, the button is pressed. Bits 1-7 -- appear to be unused.-readButtonState :: Deck -> IO ActiveMap-readButtonState deck =- bytesToActiveMap . BS.unpack <$> System.Hardware.Streamdeck.read deck 16+-- Note: The Stream Deck Mini will not send data beyond the 8th byte+-- Note: The Stream Deck XL's format is slightly different. The Stream Deck XL+-- sends a prelude of 01 00 20 00, followed by 32 bytes, following the+-- above pattern - first byte for the first (top-left) button, next for+-- the button to its right, and so on for a total of 36 bytes.+readButtonState :: Deck a -> IO ButtonsActive+readButtonState (StreamDeck' (_, Just ds, _)) =+ bytesToActiveMap . BS.unpack <$> readRaw (_ref ds) 16+readButtonState (StreamDeckMini' (_, Just ds, _)) =+ bytesToActiveMap . BS.unpack <$> readRaw (_ref ds) 7+readButtonState (StreamDeckXL' (_, Just ds, _)) =+ bytesToActiveMap . BS.unpack <$> readRaw (_ref ds) 36+readButtonState _ = undefined -bytesToActiveMap :: [DW.Word8] -> ActiveMap+bytesToActiveMap :: [DW.Word8] -> ButtonsActive bytesToActiveMap xs- | length xs /= 16 = emptyActiveMap- | otherwise = ActiveMap $ map (== 1) $ drop 1 xs+ | length xs == 16 = sdMap $ map (== 1) $ drop 1 xs+ | length xs == 7 = miniMap $ map (== 1) $ drop 1 xs+ | length xs == 36 = xlMap $ map (== 1) $ drop 4 xs+ | otherwise = undefined -emptyActiveMap :: ActiveMap-emptyActiveMap = ActiveMap $ replicate 15 False+sdMap :: [Bool] -> ButtonsActive+sdMap bs = SDActive $ sdam $ sdar <$> Split.chunksOf 5 bs+ where+ sdar :: [Bool] -> SDActiveRow+ sdar [a, b, c, d, e] = (a,b,c,d,e)+ sdar _ = undefined+ sdam :: [SDActiveRow] -> SDActiveMap+ sdam [a, b, c] = (a,b,c)+ sdam _ = undefined -writeImage :: Deck -> DW.Word8 -> Image -> IO ()+miniMap :: [Bool] -> ButtonsActive+miniMap bs = MiniActive $ miniam $ miniar <$> Split.chunksOf 3 bs+ where+ miniar :: [Bool] -> MiniActiveRow+ miniar [a, b, c] = (a,b,c)+ miniar _ = undefined+ miniam :: [MiniActiveRow] -> MiniActiveMap+ miniam [a, b] = (a,b)+ miniam _ = undefined++xlMap :: [Bool] -> ButtonsActive+xlMap bs = XLActive $ xlam $ xlar <$> Split.chunksOf 8 bs+ where+ xlar :: [Bool] -> XLActiveRow+ xlar [a, b, c, d, e, f, g, h] = (a,b,c,d,e,f,g,h)+ xlar _ = undefined+ xlam :: [XLActiveRow] -> XLActiveMap+ xlam [a, b, c, d] = (a,b,c,d)+ xlam _ = undefined++writeImage :: Deck a -> DW.Word8 -> Image -> IO () writeImage deck button img = let page1 = BS.take (3 * page1Pixels) img page2 = BS.take (3 * page2Pixels) $ BS.drop (3 * page1Pixels) img- in do- writePage deck 1 button page1- writePage deck 2 button page2---- DeviceInfo { path = "/dev/hidraw%d"--- , vendorId = 4057--- , produc tId = 96--- , serialNumber = Just ""--- , releaseNumber = 256--- , manufacturerString = Just "Elgato Systems"--- , productString = Just "Stream Deck"--- , usagePage = 13410--- , usage = 13359--- , interfaceNumber = 0--- }-enumerateStreamDecks :: IO [HID.DeviceInfo]-enumerateStreamDecks = HID.enumerate (Just vendorID) (Just productID)--openStreamDeck :: HID.DeviceInfo -> IO Deck-openStreamDeck device = HID.withHIDAPI $ do- deck <- HID.openDeviceInfo device- sn <- determineSN device deck- fw <- requestFW deck- return Deck { _ref = deck- , serialNumber = sn- , firmware = fw- , display = defaultPage- }--determineSN :: HID.DeviceInfo -> HID.Device -> IO BS.ByteString-determineSN info dev = case HID.serialNumber info of- Nothing -> requestSN dev- Just "" -> requestSN dev- Just sn -> return $ BSC.pack $ show sn--requestSN :: HID.Device -> IO BS.ByteString-requestSN dev = do- sn <- HID.getFeatureReport dev 3 17- return $ BS.takeWhile (/= 0) $ BS.drop 5 $ snd sn+ in writePage deck 1 button page1 >> writePage deck 2 button page2 -requestFW :: HID.Device -> IO BS.ByteString-requestFW dev = do- fw <- HID.getFeatureReport dev 4 17- return $ BS.takeWhile (/= 0) $ BS.drop 5 $ snd fw+drawMiniRow :: Deck 'StreamDeckMini -> DW.Word8 -> MiniRow -> IO ()+drawMiniRow d r (i0, i1, i2) = do+ writeImage d (r * 3) i0+ writeImage d (r * 3 + 1) i1+ writeImage d (r * 3 + 2) i2 -drawRow :: Deck -> DW.Word8 -> Row -> IO ()-drawRow d r (Row (i0, i1, i2, i3, i4)) = do+drawSDRow :: Deck 'StreamDeck -> DW.Word8 -> SDRow -> IO ()+drawSDRow d r (i0, i1, i2, i3, i4) = do writeImage d (r * 5) i0 writeImage d (r * 5 + 1) i1 writeImage d (r * 5 + 2) i2 writeImage d (r * 5 + 3) i3 writeImage d (r * 5 + 4) i4 -drawPage :: Deck -> IO ()-drawPage d = do- drawRow d 0 r0- drawRow d 1 r1- drawRow d 2 r2- where- Page (r0, r1, r2) = display d+drawXLRow :: Deck 'StreamDeckXL -> DW.Word8 -> XLRow -> IO ()+drawXLRow d r (i0, i1, i2, i3, i4, i5, i6, i7) = do+ writeImage d (r * 8) i0+ writeImage d (r * 8 + 1) i1+ writeImage d (r * 8 + 2) i2+ writeImage d (r * 8 + 3) i3+ writeImage d (r * 8 + 4) i4+ writeImage d (r * 8 + 5) i5+ writeImage d (r * 8 + 6) i6+ writeImage d (r * 8 + 7) i7 -updateDeck :: Deck -> (Page -> Page) -> IO Deck-updateDeck d f =- let newPage = f $ display d- newDeck = d { display = newPage }- in do- _ <- drawPage newDeck- return newDeck+render :: Deck a -> IO ()+render (StreamDeckMini' (dev, Just ds, display)) = drawRow d 0 r0 >> drawRow d 1 r1+ where MiniPage' (r0, r1) = display+ drawRow = drawMiniRow+ d = StreamDeckMini' (dev, Just ds, display)+render (StreamDeck' (dev, Just ds, display)) = drawRow d 0 r0 >> drawRow d 1 r1 >> drawRow d 2 r2+ where SDPage' (r0, r1, r2) = display+ drawRow = drawSDRow+ d = StreamDeck' (dev, Just ds, display)+render (StreamDeckXL' (dev, Just ds, display)) = drawRow d 0 r0 >> drawRow d 1 r1 >> drawRow d 2 r2 >> drawRow d 3 r3+ where XLPage' (r0, r1, r2, r3) = display+ drawRow = drawXLRow+ d = StreamDeckXL' (dev, Just ds, display)+render _ = undefined++update :: Deck a -> Page b -> IO (Deck a)+update (StreamDeckMini' (di, Just ds, _)) (MiniPage' p) = do+ let new = StreamDeckMini' (di, Just ds, MiniPage' p)+ render new >> return new+update (StreamDeck' (di, Just ds, _)) (SDPage' p) = do+ let new = StreamDeck' (di, Just ds, SDPage' p)+ render new >> return new+update (StreamDeckXL' (di, Just ds, _)) (XLPage' p) = do+ let new = StreamDeckXL' (di, Just ds, XLPage' p)+ render new >> return new+update _ _ = undefined
streamdeck.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: streamdeck-version: 0.0.3+version: 0.1.0 synopsis: Control library for the Elgato Stream Deck description: Support (via System.HIDAPI) for Elgato Stream Deck hardware homepage: https://github.com/wuest/haskell-streamdeck@@ -11,6 +11,7 @@ license-file: LICENSE author: Tina Wuest maintainer: tina@wuest.me+copyright: 2018-2019 Tina Wuest category: Hardware build-type: Simple@@ -22,12 +23,13 @@ location: https://github.com/wuest/haskell-streamdeck.git library- ghc-options: -static -Wall -fwarn-implicit-prelude -fwarn-monomorphism-restriction+ ghc-options: -Wall -fwarn-implicit-prelude -fwarn-monomorphism-restriction -static hs-source-dirs: src default-language: Haskell2010 exposed-modules: System.Hardware.Streamdeck build-depends:- base >= 4.9 && < 4.12+ base >= 4.9 && < 4.13 , hidapi >= 0.1.5 && < 0.2 , bytestring >= 0.10 && < 0.11 , mtl >= 2.2 && < 2.3+ , split >= 0.2 && < 0.3