-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Setup StaticConfig.
module User.Elaforge.Config (load_static_config) where
import qualified Data.Map as Map
import qualified System.FilePath as FilePath

import qualified Util.Lists as Lists
import qualified Util.Log as Log
import qualified Util.Network as Network

import qualified App.Config as Config
import qualified App.LoadInstruments as LoadInstruments
import qualified App.ParseArgs as ParseArgs
import qualified App.Path as Path
import qualified App.StaticConfig as StaticConfig

import qualified Cmd.Cmd as Cmd
import qualified Cmd.Controller as Controller
import qualified Cmd.Load.Med as Load.Med
import qualified Cmd.Load.Mod as Load.Mod
import qualified Cmd.Load.ModSexpr as ModSexpr
import qualified Cmd.Load.ModT as ModT
import qualified Cmd.Msg as Msg
import qualified Cmd.SyncKeycaps as SyncKeycaps

import qualified Derive.C.All as C.All
import qualified Derive.ScoreT as ScoreT
import qualified Midi.Key as Key
import qualified Perform.Pitch as Pitch
import qualified Ui.Id as Id
import qualified Ui.Ui as Ui
import qualified User.Elaforge.Config.Hobbes as Hobbes
import qualified User.Elaforge.Config.Tammananny as Tammananny

import           Global


keycaps :: Bool
keycaps :: Bool
keycaps = Bool
False

load_static_config :: IO StaticConfig.StaticConfig
load_static_config :: IO StaticConfig
load_static_config = do
    AppDir
app_dir <- IO AppDir
Path.get_app_dir
    Db InstrumentCode
instrument_db <- AppDir -> IO (Db InstrumentCode)
LoadInstruments.load AppDir
app_dir
    Midi
midi <- Db InstrumentCode -> IO Midi
get_midi_config Db InstrumentCode
instrument_db
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ StaticConfig.StaticConfig
        { instrument_db :: Db InstrumentCode
instrument_db = Db InstrumentCode
instrument_db
        , global_cmds :: [Msg -> CmdT IO Status]
global_cmds = [Msg -> CmdT IO Status]
global_cmds
        , builtins :: Builtins
builtins = Builtins
C.All.builtins
        , setup_cmd :: [FilePath] -> Either Text (CmdT IO Status)
setup_cmd = [FilePath] -> Either Text (CmdT IO Status)
parse_args
        , post_setup_cmd :: CmdT IO ()
post_setup_cmd = if Bool
keycaps then forall (m :: * -> *). M m => m ()
SyncKeycaps.open else forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , midi :: Midi
midi = Midi
midi
        , highlight_colors :: Map Highlight Color
highlight_colors = Map Highlight Color
Config.highlight_colors
        , im_play_direct :: Bool
im_play_direct = Bool
False
        }

parse_args :: [String] -> Either Text (Cmd.CmdT IO Cmd.Status)
parse_args :: [FilePath] -> Either Text (CmdT IO Status)
parse_args = \case
    [FilePath
"med", FilePath
fname] -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FilePath -> CmdT IO Status
load_med FilePath
fname
    [FilePath
"mod-sexpr", FilePath
fname] -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FilePath -> CmdT IO Status
load_mod_sexpr FilePath
fname
    [FilePath]
args -> [FilePath] -> Either Text (CmdT IO Status)
ParseArgs.parse_args [FilePath]
args

oxygen8_v2 :: Controller.TransportConfig
oxygen8_v2 :: TransportConfig
oxygen8_v2 = Controller.TransportConfig
    { config_repeat :: MatchMidi
config_repeat = Key -> MatchMidi
note_on Key
Key.cs_1
    , config_backward :: MatchMidi
config_backward = Key -> MatchMidi
note_on Key
Key.ds_1
    , config_forward :: MatchMidi
config_forward = Key -> MatchMidi
note_on Key
Key.fs_1
    , config_stop :: MatchMidi
config_stop = Key -> MatchMidi
note_on Key
Key.gs_1
    , config_play :: MatchMidi
config_play = Key -> MatchMidi
note_on Key
Key.as_1
    , config_record :: MatchMidi
config_record = Key -> MatchMidi
note_on Key
Key.cs0
    }
    where note_on :: Key -> MatchMidi
note_on = Key -> MatchMidi
Controller.note_on

global_cmds :: [Msg.Msg -> Cmd.CmdT IO Cmd.Status]
global_cmds :: [Msg -> CmdT IO Status]
global_cmds =
    [ TransportConfig -> Msg -> CmdT IO Status
Controller.transport TransportConfig
oxygen8_v2
    ]

get_midi_config :: Cmd.InstrumentDb -> IO StaticConfig.Midi
get_midi_config :: Db InstrumentCode -> IO Midi
get_midi_config Db InstrumentCode
db = do
    FilePath
full_host <- IO FilePath
Network.getHostName
    case forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'.') FilePath
full_host of
        FilePath
"tammananny" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Db InstrumentCode -> Midi
Tammananny.midi_config Db InstrumentCode
db
        FilePath
"hobbes" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Db InstrumentCode -> Midi
Hobbes.midi_config Db InstrumentCode
db
        FilePath
host -> do
          forall (m :: * -> *). (Stack, LogMonad m) => Text -> m ()
Log.warn forall a b. (a -> b) -> a -> b
$ Text
"no midi configuration for host: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt FilePath
host
          forall (m :: * -> *) a. Monad m => a -> m a
return Midi
default_midi

default_midi :: StaticConfig.Midi
default_midi :: Midi
default_midi = StaticConfig.Midi
    { rdev_map :: Map ReadDevice ReadDevice
rdev_map = forall a. Monoid a => a
mempty
    , wdev_map :: Map WriteDevice WriteDevice
wdev_map = [(Text, Text)] -> Map WriteDevice WriteDevice
StaticConfig.make_wdev_map forall a b. (a -> b) -> a -> b
$
        [(Text
"loop" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Integer
n, forall a. Show a => a -> Text
iac Integer
n) | Integer
n <- [Integer
1..Integer
4]]
    , read_devices :: Set ReadDevice
read_devices = forall a. Monoid a => a
mempty
    }
    where iac :: a -> Text
iac a
n = Text
"IAC Driver " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt a
n

-- * mod

load_mod_sexpr :: FilePath -> Cmd.CmdT IO Cmd.Status
load_mod_sexpr :: FilePath -> CmdT IO Status
load_mod_sexpr FilePath
fname =
    forall (m :: * -> *). M m => FilePath -> Module -> m Status
convert_mod FilePath
fname forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) err a.
(Stack, M m) =>
(err -> Text) -> Either err a -> m a
Cmd.require_right forall a. a -> a
id forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Either Text Module)
ModSexpr.load FilePath
fname)

load_med :: FilePath -> Cmd.CmdT IO Cmd.Status
load_med :: FilePath -> CmdT IO Status
load_med FilePath
fname = forall (m :: * -> *). M m => FilePath -> Module -> m Status
convert_mod FilePath
fname forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Module
Load.Med.load FilePath
fname)

convert_mod :: Cmd.M m => FilePath -> ModT.Module -> m Cmd.Status
convert_mod :: forall (m :: * -> *). M m => FilePath -> Module -> m Status
convert_mod FilePath
fname Module
mod = do
    State
state <- forall (m :: * -> *) err a.
(Stack, M m) =>
(err -> Text) -> Either err a -> m a
Cmd.require_right forall a. Pretty a => a -> Text
pretty forall a b. (a -> b) -> a -> b
$ Namespace -> Module -> Either Error State
Load.Mod.convert (FilePath -> Namespace
fn_to_ns FilePath
fname) forall a b. (a -> b) -> a -> b
$
        Map Instrument NoteNumber -> Module -> Module
ModT.transpose_instruments Map Instrument NoteNumber
transpose forall a b. (a -> b) -> a -> b
$
        Map Text Text -> Module -> Module
ModT.map_instruments Map Text Text
inst_map Module
mod
    forall (m :: * -> *). M m => State -> m ()
Ui.put State
state
    forall (m :: * -> *) a. Monad m => a -> m a
return Status
Cmd.Done
    where
    inst_map :: Map Text Text
inst_map = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Monoid a => a
mempty (FilePath -> FilePath
FilePath.takeFileName FilePath
fname)
        Map FilePath (Map Text Text)
inst_maps
    transpose :: Map Instrument NoteNumber
transpose = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Monoid a => a
mempty (FilePath -> FilePath
FilePath.takeFileName FilePath
fname)
        Map FilePath (Map Instrument NoteNumber)
transpose_maps

fn_to_ns :: FilePath -> Id.Namespace
fn_to_ns :: FilePath -> Namespace
fn_to_ns = Text -> Namespace
Id.namespace forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => NonNull a -> NonNull a -> NonNull (NonNull a)
Lists.split FilePath
"." forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
FilePath.takeFileName

inst_maps :: Map FilePath (Map Text Text)
inst_maps :: Map FilePath (Map Text Text)
inst_maps = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (FilePath
"underwater", forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (Text
"Takerimba", Text
"marim")
        , (Text
"SoftShake", Text
"shake")
        , (Text
"Thumb Bass", Text
"bass")
        , (Text
"HeavyBassDrum", Text
"bd")
        , (Text
"SD1", Text
"sd")
        , (Text
"FireHiSyn", Text
"lead")
        , (Text
"VCO Bass", Text
"synb")
        , (Text
"Chin-PanFluteLooped", Text
"pan")
        , (Text
"WoodPf (4/29)", Text
"wood")
        , (Text
"RainyHiMajor", Text
"maj")
        , (Text
"RainyHiMinor", Text
"min")
        , (Text
"technoRush-loud", Text
"rush1")
        , (Text
"technoRush2", Text
"rush2")
        , (Text
"D50-PizzaGogo", Text
"pizz")
        , (Text
"filter.maj", Text
"fmaj")
        ])
    , (FilePath
"piano", forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (Text
"UpPiano (4/1)", Text
"pno")
        , (Text
"UprtBass (6/20)", Text
"bass")
        , (Text
"Glockn2 (6/36)", Text
"glock")
        , (Text
"BigPipe (7/13)", Text
"pipe")
        , (Text
"String2 (5/17)", Text
"string")
        , (Text
"TubeBe1 (6/37)", Text
"bell")
        ])
    , (FilePath
"Elektrodes", forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (Text
"Elektrodes", Text
"elec")
        , (Text
"Jazz Man", Text
"bass")
        , (Text
"440thick-bk", Text
"bd")
        , (Text
"AquaSnare", Text
"sn")
        , (Text
"AlesisHihatC", Text
"hh-c")
        , (Text
"AlesisHihatO", Text
"hh-o")
        , (Text
"AlesisHihatM", Text
"hh-m")
        , (Text
"CheckHiSyn-loud", Text
"syn")
        , (Text
"ClassPiano", Text
"pno")
        , (Text
"BstTom", Text
"tom")
        , (Text
"SundanceJazzHit", Text
"hit")
        ])
    , (FilePath
"green-mold.sexp",) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (Text
"chip 1 -", Text
"c1")
        , (Text
"chip 2 --", Text
"c2")
        , (Text
"chip 3 ---", Text
"c3")
        , (Text
"b 1 -", Text
"b1")
        , (Text
"b 2 --", Text
"b2")
        , (Text
"b 3 ---", Text
"b3")
        ]
    ]

transpose_maps :: Map FilePath (Map ScoreT.Instrument Pitch.NoteNumber)
transpose_maps :: Map FilePath (Map Instrument NoteNumber)
transpose_maps = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (FilePath
"green-mold.sexp",) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (Instrument
"b1", -NoteNumber
12forall a. Num a => a -> a -> a
*NoteNumber
3)
        , (Instrument
"b2", -NoteNumber
12forall a. Num a => a -> a -> a
*NoteNumber
3)
        , (Instrument
"b3", -NoteNumber
12forall a. Num a => a -> a -> a
*NoteNumber
3)
        ]
    ]