diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2018, Tina Wuest +Copyright (c) 2018-2019, Tina Wuest All rights reserved. diff --git a/src/System/Hardware/Streamdeck.hs b/src/System/Hardware/Streamdeck.hs --- a/src/System/Hardware/Streamdeck.hs +++ b/src/System/Hardware/Streamdeck.hs @@ -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 diff --git a/streamdeck.cabal b/streamdeck.cabal --- a/streamdeck.cabal +++ b/streamdeck.cabal @@ -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