Launchpad/hs

launchpad.hs

module Main where

import System.MIDI
import System.MIDI.Utility
import Control.Monad
import Data.Word
import Data.Char

main :: IO ()
main = do
  output <- selectOutputDevice "Launchpad Out" (Just "Launchpad")
  input  <- selectInputDevice "Launchpad In" (Just "Launchpad")

  destination <- openDestination output

  setLed destination $ Point 0 0 red
  setLed destination $ Point 0 1 green
  setLed destination $ Point 1 1 orange

  close destination


data Colour
  = Colour Brightness Brightness

data Point
  = Point Int Int Colour

data Brightness
  = Off
  | LowBrightness
  | MediumBrightness
  | FullBrightness


red = Colour FullBrightness Off
green = Colour Off FullBrightness
orange = Colour FullBrightness FullBrightness


setLed :: Connection -> Point -> IO ()
setLed connection point =
  let
    location = encodeLocation point
    colour = encodeColour point
  in
    send connection $ MidiMessage 1 $ NoteOn location colour


encodeLocation :: Point -> Int
encodeLocation (Point x y _) =
  (16 * y) + x

encodeBrightness :: Brightness -> Int
encodeBrightness Off = 0
encodeBrightness LowBrightness = 1
encodeBrightness MediumBrightness = 2
encodeBrightness FullBrightness = 3

encodeColour :: Point -> Int
encodeColour (Point _ _ (Colour red green)) =
  (16 * encodeBrightness green) + encodeBrightness red + 12