module System.Hardware.Arduino.Protocol(package, unpackageSysEx, unpackageNonSysEx) where
import Data.Word (Word8)
import qualified Data.ByteString as B
import qualified Data.Map as M
import System.Hardware.Arduino.Data
import System.Hardware.Arduino.Utils
sysEx :: SysExCmd -> [Word8] -> B.ByteString
sysEx cmd bs = B.pack $ firmataCmdVal START_SYSEX
: sysExCmdVal cmd
: bs
++ [firmataCmdVal END_SYSEX]
nonSysEx :: FirmataCmd -> [Word8] -> B.ByteString
nonSysEx cmd bs = B.pack $ firmataCmdVal cmd : bs
package :: Request -> B.ByteString
package SystemReset = nonSysEx SYSTEM_RESET []
package QueryFirmware = sysEx REPORT_FIRMWARE []
package CapabilityQuery = sysEx CAPABILITY_QUERY []
package AnalogMappingQuery = sysEx ANALOG_MAPPING_QUERY []
package (AnalogReport p b) = nonSysEx (REPORT_ANALOG_PIN p) [if b then 1 else 0]
package (DigitalReport p b) = nonSysEx (REPORT_DIGITAL_PORT p) [if b then 1 else 0]
package (SetPinMode p m) = nonSysEx SET_PIN_MODE [fromIntegral (pinNo p), fromIntegral (fromEnum m)]
package (DigitalPortWrite p l m) = nonSysEx (DIGITAL_MESSAGE p) [l, m]
package (SamplingInterval l m) = sysEx SAMPLING_INTERVAL [l, m]
unpackageSysEx :: [Word8] -> Response
unpackageSysEx [] = Unimplemented (Just "<EMPTY-SYSEX-CMD>") []
unpackageSysEx (cmdWord:args)
| Right cmd <- getSysExCommand cmdWord
= case (cmd, args) of
(REPORT_FIRMWARE, majV : minV : rest) -> Firmware majV minV (getString rest)
(CAPABILITY_RESPONSE, bs) -> Capabilities (getCapabilities bs)
(ANALOG_MAPPING_RESPONSE, bs) -> AnalogMapping bs
_ -> Unimplemented (Just (show cmd)) args
| True
= Unimplemented Nothing (cmdWord : args)
getCapabilities :: [Word8] -> BoardCapabilities
getCapabilities bs = BoardCapabilities $ M.fromList $ zipWith (\p c -> (p, (Nothing, c))) (map pin [0..]) (map pinCaps (chunk bs))
where chunk xs = case break (== 0x7f) xs of
([], []) -> []
(cur, 0x7f:rest) -> cur : chunk rest
_ -> [xs]
pinCaps (x:y:rest) = (toEnum (fromIntegral x), y) : pinCaps rest
pinCaps _ = []
unpackageNonSysEx :: (Int -> IO [Word8]) -> FirmataCmd -> IO Response
unpackageNonSysEx getBytes c = grab c
where unimplemented n = Unimplemented (Just (show c)) `fmap` getBytes n
grab (ANALOG_MESSAGE p) = getBytes 2 >>= \[l, h] -> return (AnalogMessage p l h)
grab (DIGITAL_MESSAGE p) = getBytes 2 >>= \[l, h] -> return (DigitalMessage p l h)
grab (REPORT_ANALOG_PIN _pin) = unimplemented 1
grab (REPORT_DIGITAL_PORT _port) = unimplemented 1
grab START_SYSEX = unimplemented 0
grab SET_PIN_MODE = unimplemented 2
grab END_SYSEX = unimplemented 0
grab PROTOCOL_VERSION = unimplemented 2
grab SYSTEM_RESET = unimplemented 0