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 Data.Maybe.HT (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
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
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))