module Csound.Options(
    Options(..),

    -- * Shortcuts
    setDur,
    setRates, setBufs, setGain,
    setJack, setJackConnect, setAlsa, setCoreAudio, setMme,
    setOutput, setInput,
    setDac, setAdc, setDacBy, setAdcBy, setThru,
    setSilent, setMidiDevice, setMa,
    setMessageLevel, noMessages, setTrace,
    setCabbage,
    setJacko,

    -- * Flags
    -- | Csound's command line flags. See original documentation for
    -- detailed overview: <http://www.csounds.com/manual/html/CommandFlagsCategory.html>
    Flags(..),

    -- * Audio file output
    AudioFileOutput(..),
    FormatHeader(..), FormatSamples(..), FormatType(..),
    Dither(..), IdTags(..),

    -- * Realtime Audio Input/Output
    Rtaudio(..), PulseAudio(..),

    -- * MIDI File Input/Ouput
    MidiIO(..),

    -- * MIDI Realtime Input/Ouput
    MidiRT(..), Rtmidi(..),

    -- * Display
    Displays(..), DisplayMode(..),

    -- * Performance Configuration and Control
    Config(..)
) where

import Data.Default
import Csound.Typed

-- | Sets sample rate and block size
--
-- > setRates sampleRate blockSize
setRates :: Int -> Int -> Options
setRates :: Int -> Int -> Options
setRates Int
sampleRate Int
blockSize = Options
forall a. Default a => a
def
    { csdSampleRate :: Maybe Int
csdSampleRate = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
sampleRate
    , csdBlockSize :: Maybe Int
csdBlockSize  = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
blockSize }

-- | Sets hardware and software buffers.
--
-- > setBufs hardwareBuf ioBuf
setBufs :: Int -> Int -> Options
setBufs :: Int -> Int -> Options
setBufs Int
hw Int
io = Options
forall a. Default a => a
def { csdFlags :: Flags
csdFlags = Flags
forall a. Default a => a
def { config :: Config
config = Config
forall a. Default a => a
def { hwBuf :: Maybe Int
hwBuf = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
hw, ioBuf :: Maybe Int
ioBuf = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
io } } }

-- | Sets the default gain for the output signal (should be in range 0 to 1).
setGain :: Double -> Options
setGain :: Double -> Options
setGain Double
d = Options
forall a. Default a => a
def { csdGain :: Maybe Double
csdGain = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
d' }
    where d' :: Double
d' = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
1 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
d

-- | Runs as JACK unit with given name (first argument).
setJack :: String -> Options
setJack :: String -> Options
setJack String
name = Options
forall a. Default a => a
def { csdFlags :: Flags
csdFlags = Flags
forall a. Default a => a
def { rtaudio :: Maybe Rtaudio
rtaudio = Rtaudio -> Maybe Rtaudio
forall a. a -> Maybe a
Just (Rtaudio -> Maybe Rtaudio) -> Rtaudio -> Maybe Rtaudio
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> Rtaudio
Jack String
name String
"input" String
"output" } }

-- | Defines a header for a Jacko opcodes. The Jacko opcodes allow for greater flexibility
-- with definition of Jack-client. See the Csound docs for details and the datatype @Jacko@.
--
-- > csound doc: <http://csound.github.io/docs/manual/JackoOpcodes.html>
setJacko :: Jacko -> Options
setJacko :: Jacko -> Options
setJacko Jacko
jackoSpec = Options
forall a. Default a => a
def { csdJacko :: Maybe Jacko
csdJacko = Jacko -> Maybe Jacko
forall a. a -> Maybe a
Just Jacko
jackoSpec }

-- | Sets real-time driver to Core Audio (use on OSX).
setCoreAudio :: Options
setCoreAudio :: Options
setCoreAudio = Options
forall a. Default a => a
def { csdFlags :: Flags
csdFlags = Flags
forall a. Default a => a
def { rtaudio :: Maybe Rtaudio
rtaudio = Rtaudio -> Maybe Rtaudio
forall a. a -> Maybe a
Just (Rtaudio -> Maybe Rtaudio) -> Rtaudio -> Maybe Rtaudio
forall a b. (a -> b) -> a -> b
$ Rtaudio
CoreAudio } }

-- | Sets real-time driver to Alsa (use on Linux).
setAlsa :: Options
setAlsa :: Options
setAlsa = Options
forall a. Default a => a
def { csdFlags :: Flags
csdFlags = Flags
forall a. Default a => a
def { rtaudio :: Maybe Rtaudio
rtaudio = Rtaudio -> Maybe Rtaudio
forall a. a -> Maybe a
Just (Rtaudio -> Maybe Rtaudio) -> Rtaudio -> Maybe Rtaudio
forall a b. (a -> b) -> a -> b
$ Rtaudio
Alsa } }

-- | Sets real-time driver to Mme (use on Windows).
setMme :: Options
setMme :: Options
setMme = Options
forall a. Default a => a
def { csdFlags :: Flags
csdFlags = Flags
forall a. Default a => a
def { rtaudio :: Maybe Rtaudio
rtaudio = Rtaudio -> Maybe Rtaudio
forall a. a -> Maybe a
Just (Rtaudio -> Maybe Rtaudio) -> Rtaudio -> Maybe Rtaudio
forall a b. (a -> b) -> a -> b
$ Rtaudio
Mme } }

-- | Sends output to speakers.
setDac :: Options
setDac :: Options
setDac = String -> Options
setDacBy String
""

-- | Reads input from audio-card inputs.
setAdc :: Options
setAdc :: Options
setAdc = String -> Options
setAdcBy String
""

-- | Set's the input name of the device or file.
setInput :: String -> Options
setInput :: String -> Options
setInput String
a = Options
forall a. Default a => a
def { csdFlags :: Flags
csdFlags = Flags
forall a. Default a => a
def { audioFileOutput :: AudioFileOutput
audioFileOutput = AudioFileOutput
forall a. Default a => a
def { input :: Maybe String
input = String -> Maybe String
forall a. a -> Maybe a
Just String
a } } }

-- | Set's the output name of the device or file.
setOutput :: String -> Options
setOutput :: String -> Options
setOutput String
a = Options
forall a. Default a => a
def { csdFlags :: Flags
csdFlags = Flags
forall a. Default a => a
def { audioFileOutput :: AudioFileOutput
audioFileOutput = AudioFileOutput
forall a. Default a => a
def { output :: Maybe String
output = String -> Maybe String
forall a. a -> Maybe a
Just String
a } } }

-- | Provides name identifier for dac.
setDacBy :: String -> Options
setDacBy :: String -> Options
setDacBy String
port = String -> Options
setOutput String
name
    where name :: String
name
            | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
port = String
"dac"
            | Bool
otherwise = String
"dac:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
port

-- | Provides name identifier for adc.
setAdcBy :: String -> Options
setAdcBy :: String -> Options
setAdcBy String
port = String -> Options
setInput String
name
    where name :: String
name
            | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
port = String
"adc"
            | Bool
otherwise = String
"adc:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
port

-- | Sets both dac and adc.
setThru :: Options
setThru :: Options
setThru = Options -> Options -> Options
forall a. Monoid a => a -> a -> a
mappend Options
setDac Options
setAdc

-- | Sets the output to nosound.
setSilent :: Options
setSilent :: Options
setSilent = (Options
forall a. Default a => a
def { csdFlags :: Flags
csdFlags = Flags
forall a. Default a => a
def { audioFileOutput :: AudioFileOutput
audioFileOutput = AudioFileOutput
forall a. Default a => a
def { nosound :: Bool
nosound = Bool
True } } })

-- | Sets midi device. It's an string identifier of the device.
--
-- Read MIDI events from device DEVICE. If using ALSA MIDI (-+rtmidi=alsa),
-- devices are selected by name and not number. So, you need to use an option
-- like -M hw:CARD,DEVICE where CARD and DEVICE are the card and device numbers (e.g. -M hw:1,0).
-- In the case of PortMidi and MME, DEVICE should be a number, and if it is out of range,
-- an error occurs and the valid device numbers are printed. When using PortMidi,
-- you can use '-Ma' to enable all devices. This is also convenient when you
-- don't have devices as it will not generate an error.
setMidiDevice :: String -> Options
setMidiDevice :: String -> Options
setMidiDevice String
a = Options
forall a. Default a => a
def { csdFlags :: Flags
csdFlags = Flags
forall a. Default a => a
def { midiRT :: MidiRT
midiRT = MidiRT
forall a. Default a => a
def { midiDevice :: Maybe String
midiDevice = String -> Maybe String
forall a. a -> Maybe a
Just String
a } } }

-- | Sets midi device to all.
setMa :: Options
setMa :: Options
setMa = String -> Options
setMidiDevice String
"a"

-- | Sets message level. For input integer value consult
-- the Csound docs
--
-- <http://csound.com/docs/manual/CommandFlagsCategory.html>
setMessageLevel :: Int -> Options
setMessageLevel :: Int -> Options
setMessageLevel Int
n = Options
forall a. Default a => a
def { csdFlags :: Flags
csdFlags = Flags
forall a. Default a => a
def { displays :: Displays
displays = Displays
forall a. Default a => a
def { messageLevel :: Maybe Int
messageLevel = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n }}}

-- | Sets the tracing or debug info of csound console to minimum.
noMessages :: Options
noMessages :: Options
noMessages = Int -> Options
setMessageLevel Int
0

setTrace :: Options
setTrace :: Options
setTrace = Options
forall a. Default a => a
def { csdTrace :: Maybe Bool
csdTrace = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True }

---------------------------------------------

-- | Provides options for Cabbage VST-engine.
setCabbage :: Options
setCabbage :: Options
setCabbage = Int -> Int -> Options
setRates Int
48000 Int
64 Options -> Options -> Options
forall a. Semigroup a => a -> a -> a
<> Options
setNoRtMidi Options -> Options -> Options
forall a. Semigroup a => a -> a -> a
<> String -> Options
setMidiDevice String
"0"
    where setNoRtMidi :: Options
setNoRtMidi = Options
forall a. Default a => a
def { csdFlags :: Flags
csdFlags = Flags
forall a. Default a => a
def { rtmidi :: Maybe Rtmidi
rtmidi = Rtmidi -> Maybe Rtmidi
forall a. a -> Maybe a
Just Rtmidi
NoRtmidi, audioFileOutput :: AudioFileOutput
audioFileOutput = AudioFileOutput
forall a. Default a => a
def { nosound :: Bool
nosound = Bool
True } }}

-- | Defines what ports we should connect after application is launched
--
-- It invokes @jack_connect@ for every pair of port-names in the list.
setJackConnect :: [(String, String)] -> Options
setJackConnect :: [(String, String)] -> Options
setJackConnect [(String, String)]
connections = Options
forall a. Default a => a
def { csdJackConnect :: Maybe [(String, String)]
csdJackConnect = [(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just [(String, String)]
connections }