packages feed

streamdeck (empty) → 0.0.1

raw patch · 5 files changed

+271/−0 lines, 5 filesdep +basedep +bytestringdep +hidapisetup-changed

Dependencies added: base, bytestring, hidapi, mtl

Files

+ ChangeLog.md view
@@ -0,0 +1,6 @@+# Revision history for streamdeck++## 0.0.1  -- 2018-04-18++* Migrated existing functionality into own library from https://github.com/wuest/streamdeck-controller+* Supports: enumeration, read (limited), write (limited)
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2018, Tina Wuest++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Tina Wuest nor the names of other+      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
+ src/System/Hardware/Streamdeck.hs view
@@ -0,0 +1,201 @@+module System.Hardware.Streamdeck ( Deck+                                  , solidRGB+                                  , openStreamDeck+                                  , enumerateStreamDecks+                                  , setBrightness+                                  , updateDeck+                                  , readButtonState+                                  , writeImage+                                  , sendRaw+                                  ) where++import qualified Data.Bits            as B+import qualified Data.ByteString      as BS+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)++newtype Row = Row (Image, Image, Image, Image, Image)++type Image = BS.ByteString++type PixelR = DW.Word8+type PixelG = DW.Word8+type PixelB = DW.Word8++data Deck = Deck { ref       :: HID.Device+                 , display   :: Page+                 }++vendorID :: DW.Word16+vendorID  = 0x0fd9++productID :: DW.Word16+productID = 0x0060++packetSize :: Int+packetSize = 4096++page1Pixels :: Int+page1Pixels = 2583++page2Pixels :: Int+page2Pixels = 2601++buttonPixels :: Int+buttonPixels = page1Pixels + page2Pixels++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+                         )+                   )++setBrightness :: DW.Word8 -> BS.ByteString+setBrightness b+    | b <= 100 = 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+                           ]++sendRaw :: Deck -> BS.ByteString -> IO ()+sendRaw deck bs =+    if BS.length bs > packetSize then+        (do _ <- HID.write (ref deck) $ BS.take packetSize bs+            sendRaw deck $ fixContinuationPacket bs)+    else+        (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+fixContinuationPacket :: BS.ByteString -> BS.ByteString+fixContinuationPacket b+    | BS.length b < packetSize = BS.pack []+    | otherwise =+        let rest = BS.drop packetSize b+            byte = BS.head rest+        in if byte > 0 then rest+                       else BS.cons ((B..|.) 1 byte) (BS.drop 1 rest)++writePage :: Deck -> Int -> DW.Word8 -> BS.ByteString -> IO ()+writePage deck p i bs = sendRaw deck $ BS.append (page p i) bs++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+                   , 0x42, 0x4d, 0xf6, 0x3c, 0x00, 0x00, 0x00, 0x00+                   , 0x00, 0x00, 0x36, 0x00, 0x00, 0x00, 0x28, 0x00+                   , 0x00, 0x00, 0x48, 0x00, 0x00, 0x00, 0x48, 0x00+                   , 0x00, 0x00, 0x01, 0x00, 0x18, 0x00, 0x00, 0x00+                   , 0x00, 0x00, 0xc0, 0x3c, 0x00, 0x00, 0xc4, 0x0e+                   , 0x00, 0x00, 0xc4, 0x0e, 0x00, 0x00, 0x00, 0x00+                   , 0x00, 0x00, 0x00, 0x00, 0x00, 0x00]++page 2 i = BS.pack [ 0x02, 0x01, 0x02, 0x00, 0x01,  i+1, 0x00, 0x00+                   , 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00]++page _ _ = BS.pack []++read :: Deck -> Int -> IO BS.ByteString+read deck = HID.read (ref deck)++-- Stream Deck reports button state ONLY upon button press/release+-- Stream Deck will send a 16 byte message, with the following format:+-- 01 AA BB CC DD EE FF GG HH II JJ KK LL MM NN OO+-- * 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++bytesToActiveMap :: [DW.Word8] -> ActiveMap+bytesToActiveMap xs+    | length xs /= 16 = emptyActiveMap+    | otherwise = ActiveMap $ map (== 1) $ drop 1 xs++emptyActiveMap :: ActiveMap+emptyActiveMap = ActiveMap $ replicate 15 False++writeImage :: Deck -> 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+    return Deck { ref = deck+                , display = defaultPage+                }++drawRow :: Deck -> DW.Word8 -> Row -> IO ()+drawRow d r (Row (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++updateDeck :: Deck -> (Page -> Page) -> IO Deck+updateDeck d f =+    let newPage = f $ display d+        newDeck = d { display = newPage }+    in do+    _ <- drawPage newDeck+    return newDeck
+ streamdeck.cabal view
@@ -0,0 +1,32 @@+-- Initial streamdeck.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                streamdeck+version:             0.0.1+synopsis:            Control library for the Elgato Stream Deck+homepage:            https://github.com/wuest/haskell-streamdeck+bug-reports:         https://github.com/wuest/haskell-streamdeck/issues+license:             BSD3+license-file:        LICENSE+author:              Tina Wuest+maintainer:          tina@wuest.me++category:            Hardware+build-type:          Simple+extra-source-files:  ChangeLog.md+cabal-version:       >=1.10++source-repository    head+    type:            git+    location:        https://github.com/wuest/haskell-streamdeck.git++library+    ghc-options:         -static -Wall -fwarn-implicit-prelude -fwarn-monomorphism-restriction+    hs-source-dirs:      src+    default-language:    Haskell2010+    exposed-modules:     System.Hardware.Streamdeck+    build-depends:+          base       >= 4.9  && < 4.12+        , hidapi     >= 0.1  && < 0.2+        , bytestring >= 0.10 && < 0.11+        , mtl        >= 2.2  && < 2.3