SoundMap.hs

-- cf. SuperCollider.SoundMap
-- this module shall replace InstrumentMap in the long term
module Haskore.Interface.CSound.SoundMap where

import qualified Haskore.Interface.CSound.Orchestra as Orchestra

import Haskore.Interface.CSound.Orchestra
          (SigExp, noteDur, noteVel, notePit, pField)
import Haskore.Interface.CSound (PField, Instrument)

import Haskore.General.Utility (toMaybe)
import Data.Maybe (mapMaybe)


type SoundId = Instrument
type InstrumentId = SoundId
type DrumId = SoundId

type Attribute = PField
type AttributeList = [Attribute]
type ToSound instr = instr -> (AttributeList, SoundId)


attributeControl :: Int -> SigExp
attributeControl n = pField (6+n)


type InstrumentTable out instr = [(instr, InstrumentSigExp out)]

type InstrumentTableWithAttributes out instr = [InstrumentAssociation out instr]

type InstrumentSigExp out = SigExp -> SigExp -> SigExp -> out

data InstrumentAssociation out instr =
        InstrumentAssociation InstrumentId (instr -> Maybe AttributeList) out

lookupInstrument :: InstrumentTableWithAttributes out instr -> ToSound instr
lookupInstrument table instr =
   case mapMaybe (\(InstrumentAssociation name toAttributes _) ->
                     fmap (\ps -> (ps,name)) (toAttributes instr)) table of
      [] -> error "SuperCollider.InstrumentMap.lookup: instrument not found"
      [x] -> x
      _ -> error "SuperCollider.InstrumentMap.lookup: multiple instruments found"

instrumentTableToInstrBlocks ::
   InstrumentTableWithAttributes out instr -> [Orchestra.InstrBlock out]
instrumentTableToInstrBlocks =
   map (\(InstrumentAssociation i _ out) -> Orchestra.InstrBlock i 0 out [])

addInstrumentControls :: InstrumentSigExp out -> out
addInstrumentControls graph = graph noteDur noteVel notePit


instrumentAssociation ::
   (parameterTuple -> AttributeList) ->
   (graph -> InstrumentSigExp out) ->
      InstrumentId -> (instr -> Maybe parameterTuple) ->
      graph ->
      InstrumentAssociation out instr
instrumentAssociation makeAttributeList makeInstrumentSigExp name select graph =
   InstrumentAssociation
      name
      (fmap makeAttributeList . select)
      (addInstrumentControls $ makeInstrumentSigExp graph)


instrument ::
   InstrumentId -> (instr -> Maybe ()) -> (InstrumentSigExp out) ->
      InstrumentAssociation out instr
instrument = instrumentAssociation (\() -> []) id

-- simplified variant of 'instrument' for comparable @instrument@ types
instrumentEq :: Eq instrument =>
   InstrumentId -> instrument -> (InstrumentSigExp out) ->
      InstrumentAssociation out instrument
instrumentEq name instrumentId =
   instrument name (\x -> toMaybe (instrumentId==x) ())

instrument1 ::
   InstrumentId -> (instr -> Maybe Attribute) ->
      (SigExp -> InstrumentSigExp out) ->
      InstrumentAssociation out instr
instrument1 =
   instrumentAssociation
      (\p0 -> [p0])
      (\graph -> graph (attributeControl 0))


instrument2 ::
   InstrumentId -> (instr -> Maybe (Attribute, Attribute)) ->
      (SigExp -> SigExp -> InstrumentSigExp out) ->
      InstrumentAssociation out instr
instrument2 =
   instrumentAssociation
      (\(p0,p1) -> [p0,p1])
      (\graph -> graph
         (attributeControl 0)
         (attributeControl 1))

instrument3 ::
   InstrumentId -> (instr -> Maybe (Attribute, Attribute, Attribute)) ->
      (SigExp -> SigExp -> SigExp -> InstrumentSigExp out) ->
      InstrumentAssociation out instr
instrument3 =
   instrumentAssociation
      (\(p0,p1,p2) -> [p0,p1,p2])
      (\graph -> graph
         (attributeControl 0)
         (attributeControl 1)
         (attributeControl 2))

instrument4 ::
   InstrumentId -> (instr -> Maybe (Attribute, Attribute, Attribute, Attribute)) ->
      (SigExp -> SigExp -> SigExp -> SigExp -> InstrumentSigExp out) ->
      InstrumentAssociation out instr
instrument4 =
   instrumentAssociation
      (\(p0,p1,p2,p3) -> [p0,p1,p2,p3])
      (\graph -> graph
         (attributeControl 0)
         (attributeControl 1)
         (attributeControl 2)
         (attributeControl 3))



type DrumTable out drum = [(drum, DrumSigExp out)]

type DrumTableWithAttributes out drum = [DrumAssociation out drum]

type DrumSigExp out = SigExp -> SigExp -> out

data DrumAssociation out drum =
        DrumAssociation DrumId (drum -> Maybe AttributeList) out

lookupDrum :: DrumTableWithAttributes out drum -> ToSound drum
lookupDrum table drumId =
   case mapMaybe (\(DrumAssociation name toAttributes _) ->
                     fmap (\ps -> (ps,name)) (toAttributes drumId)) table of
      [] -> error "SuperCollider.InstrumentMap.lookup: drum not found"
      [x] -> x
      _ -> error "SuperCollider.InstrumentMap.lookup: multiple drums found"

drumTableToInstrBlocks :: DrumTableWithAttributes out instr -> [Orchestra.InstrBlock out]
drumTableToInstrBlocks =
   map (\(DrumAssociation i _ out) -> Orchestra.InstrBlock i 0 out [])

addDrumControls :: DrumSigExp out -> out
addDrumControls graph = graph noteDur noteVel

drumAssociation ::
   (parameterTuple -> AttributeList) ->
   (graph -> DrumSigExp out) ->
      DrumId -> (drum -> Maybe parameterTuple) ->
      graph ->
      DrumAssociation out drum
drumAssociation makeAttributeList makeDrumSigExp name select graph =
   DrumAssociation
      name
      (fmap makeAttributeList . select)
      (addDrumControls $ makeDrumSigExp graph)


drum ::
   DrumId -> (drum -> Maybe ()) -> (DrumSigExp out) ->
      DrumAssociation out drum
drum = drumAssociation (\() -> []) id

-- simplified variant of 'drum' for comparable @drum@ types
drumEq :: Eq drum =>
   DrumId -> drum -> (DrumSigExp out) ->
      DrumAssociation out drum
drumEq name drumId =
   drum name (\x -> toMaybe (drumId==x) ())

drum1 ::
   DrumId -> (drum -> Maybe Attribute) ->
      (SigExp -> DrumSigExp out) ->
      DrumAssociation out drum
drum1 =
   drumAssociation
      (\p0 -> [p0])
      (\graph -> graph (attributeControl 0))

drum2 ::
   DrumId -> (drum -> Maybe (Attribute, Attribute)) ->
      (SigExp -> SigExp -> DrumSigExp out) ->
      DrumAssociation out drum
drum2 =
   drumAssociation
      (\(p0,p1) -> [p0,p1])
      (\graph -> graph
         (attributeControl 0)
         (attributeControl 1))

drum3 ::
   DrumId -> (drum -> Maybe (Attribute, Attribute, Attribute)) ->
      (SigExp -> SigExp -> SigExp -> DrumSigExp out) ->
      DrumAssociation out drum
drum3 =
   drumAssociation
      (\(p0,p1,p2) -> [p0,p1,p2])
      (\graph -> graph
         (attributeControl 0)
         (attributeControl 1)
         (attributeControl 2))

drum4 ::
   DrumId -> (drum -> Maybe (Attribute, Attribute, Attribute, Attribute)) ->
      (SigExp -> SigExp -> SigExp -> SigExp -> DrumSigExp out) ->
      DrumAssociation out drum
drum4 =
   drumAssociation
      (\(p0,p1,p2,p3) -> [p0,p1,p2,p3])
      (\graph -> graph
         (attributeControl 0)
         (attributeControl 1)
         (attributeControl 2)
         (attributeControl 3))