Skip to content

Instantly share code, notes, and snippets.

@danbst
Created October 24, 2013 21:38
Show Gist options
  • Save danbst/7145496 to your computer and use it in GitHub Desktop.
Save danbst/7145496 to your computer and use it in GitHub Desktop.
Generate keypresses with my Synth's sustain pedal. Requires `xdotool` in %PATH%
import System.USB
( InterfaceDesc(interfaceEndpoints, interfaceNumber),
EndpointDesc(endpointAddress),
DeviceDesc(deviceProductId, deviceVendorId),
Device,
Ctx,
ConfigDesc(configInterfaces),
withDeviceHandle,
withDetachedKernelDriver,
withClaimedInterface,
readBulk,
noTimeout,
newCtx,
getDevices,
getDeviceDesc,
getConfigDesc )
import Control.Monad (forever)
import qualified Data.Vector as V
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.List (intercalate, findIndex)
import Text.Printf (printf)
import Control.Concurrent
( takeMVar, putMVar, newEmptyMVar, threadDelay, forkFinally )
import System.Process
whenPedalDown = "i"
whenPedalUp = "Escape"
isMidimanKeystation88es :: DeviceDesc -> Bool
isMidimanKeystation88es desc = deviceVendorId desc == 0x0763
&& deviceProductId desc == 0x0192
main = newCtx >>= mainLoop
prettyByteString :: ByteString -> String
prettyByteString = intercalate " " . map (printf "%02x") . BS.unpack
mainLoop:: Ctx -> IO ()
mainLoop ctx = do
devs <- fmap V.toList $ getDevices ctx
devDescs <- mapM getDeviceDesc devs
case findIndex isMidimanKeystation88es devDescs of
Just i -> performConnection (devs!!i)
Nothing -> threadDelay 200000 -- 200ms
mainLoop ctx
where
performConnection device = do
mvar <- newEmptyMVar
forkFinally (deviceHandler device) (\_ -> putMVar mvar ())
takeMVar mvar
deviceHandler :: Device -> IO ()
deviceHandler device = do
deviceDesc <- getDeviceDesc device
configDesc <- getConfigDesc device 0
let interface = head . V.toList . (!!1) . V.toList . configInterfaces $ configDesc
endPoint = (!!0) . V.toList . interfaceEndpoints $ interface
withDeviceHandle device $ \handle ->
withDetachedKernelDriver handle 1 $
withClaimedInterface handle (interfaceNumber interface) $ forever $ do
result <- fmap fst $ readBulk handle (endpointAddress endPoint) 4 noTimeout
processMidi result
generateKeyPress :: String -> IO ()
generateKeyPress key = system ("xdotool key " ++ key) >> return ()
processMidi :: ByteString -> IO ()
processMidi midi = do
let down = BS.pack [0x0B, 0xB0, 0x40, 0x7F]
up = BS.pack [0x0B, 0xB0, 0x40, 0x00]
if midi == down
then generateKeyPress whenPedalDown
else if midi == up
then generateKeyPress whenPedalUp
else return ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment