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 Data.Text (Text)
import Data.Text qualified as Text
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 = Just sampleRate
    , csdBlockSize  = Just 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 = def { config = def { hwBuf = Just hw, ioBuf = Just 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 = Just 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 :: Text -> Options
setJack :: Text -> Options
setJack Text
name = Options
forall a. Default a => a
def { csdFlags = def { rtaudio = Just $ Jack name "input" "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 = Just jackoSpec }

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

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

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

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

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

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

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

-- | Provides name identifier for dac.
setDacBy :: Text -> Options
setDacBy :: Text -> Options
setDacBy Text
port = Text -> Options
setOutput Text
name
    where name :: Text
name
            | Text -> Bool
Text.null Text
port = Text
"dac"
            | Bool
otherwise = Text
"dac:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
port

-- | Provides name identifier for adc.
setAdcBy :: Text -> Options
setAdcBy :: Text -> Options
setAdcBy Text
port = Text -> Options
setInput Text
name
    where name :: Text
name
            | Text -> Bool
Text.null Text
port = Text
"adc"
            | Bool
otherwise = Text
"adc:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
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 = def { audioFileOutput = def { nosound = 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 :: Text -> Options
setMidiDevice :: Text -> Options
setMidiDevice Text
a = Options
forall a. Default a => a
def { csdFlags = def { midiRT = def { midiDevice = Just a } } }

-- | Sets midi device to all.
setMa :: Options
setMa :: Options
setMa = Text -> Options
setMidiDevice Text
"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 = def { displays = def { messageLevel = Just 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 = Just True }

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

-- | Provides options for Cabbage VST-engine.
setCabbage :: Options
setCabbage :: Options
setCabbage = [Options] -> Options
forall a. Monoid a => [a] -> a
mconcat [Int -> Int -> Options
setRates Int
48000 Int
64, Options
setNoRtMidi, Text -> Options
setMidiDevice Text
"0"]
    where setNoRtMidi :: Options
setNoRtMidi = Options
forall a. Default a => a
def { csdFlags = def { rtmidi = Just NoRtmidi, audioFileOutput = def { nosound = 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 :: [(Text, Text)] -> Options
setJackConnect :: [(Text, Text)] -> Options
setJackConnect [(Text, Text)]
connections = Options
forall a. Default a => a
def { csdJackConnect = Just connections }