{-# LANGUAGE OverloadedStrings #-}

module System.Hardware.Streamdeck ( Deck
                                  , serialNumber
                                  , solidRGB
                                  , openStreamDeck
                                  , enumerateStreamDecks
                                  , setBrightness
                                  , updateDeck
                                  , readButtonState
                                  , writeImage
                                  , sendRaw
                                  ) where

import Data.Maybe (fromMaybe)

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

-- KNOWN BUG: some versions of the Stream Deck firmware do not report
-- SerialNumber as part of the HID handshake (but can be coerced to report the
-- S/N via special request).  Leaving this bug for another day.
serialNumber :: HID.DeviceInfo -> String
serialNumber = show . fromMaybe "" . HID.serialNumber