-- Copyright 2017 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

{-# LANGUAGE RecordWildCards #-}
module Ness.Guitar.Patch where
import Prelude hiding (String)
import qualified Data.Text as Text

import qualified Util.Lists as Lists
import qualified Perform.NN as NN
import qualified Perform.Pitch as Pitch
import qualified Synth.Shared.Control as Control
import Ness.Global
import Ness.Guitar
import Global


c_location :: Control.Control
c_location :: Control
c_location = Control
"location"

c_finger :: Control.Control
c_finger :: Control
c_finger = Control
"finger"

instruments :: [Instrument]
instruments :: [Instrument]
instruments =
    [ Text -> Double -> [String] -> Instrument
instrument Text
"polos" (-Double
0.0017) [String]
legongStrings
    , Text -> Double -> [String] -> Instrument
instrument Text
"sangsih" (-Double
0.0013) [String]
legongStrings2
    , Text -> Double -> [String] -> Instrument
instrument Text
"g12-1" (-Double
0.0020) [String]
guitarStrings
    , Text -> Double -> [String] -> Instrument
instrument Text
"g12-2" (-Double
0.0015) [String]
guitarStrings2
    ]


-- * implementation

instrument :: Text -> Double -> [String] -> Instrument
instrument Text
name Double
backboard [String]
strings = Instrument
    { iName :: Text
iName = Text
name
    , iStrings :: [String]
iStrings = [String]
strings
    , iFrets :: [Fret]
iFrets = [] -- frets
    , iBarrier :: Barrier
iBarrier = Double -> Double -> Double -> Solver -> Barrier
Barrier Double
1e10 Double
1.3 Double
10 (Int -> Double -> Solver
Solver Int
20 Double
1e-12)
    , iBackboard :: Backboard
iBackboard = Backboard -- a + bx + bx^2, where x is length
        -- distances = [-0.002, -0.0017, -0.0015, -0.0013,  -0.001]
        { ba :: Double
ba = Double
backboard
        , bb :: Double
bb = Double
0
        , bc :: Double
bc = Double
0
        }
    , iFingerParams :: FingerParams
iFingerParams = FingerParams
        -- { fMass = 0.005
        -- , fStiffness = 2e7
        -- , fExponent = 3
        -- , fLoss = 10
        -- }
        { fMass :: Double
fMass = Double
0.005
        , fStiffness :: Double
fStiffness = Double
1e7
        , fExponent :: Double
fExponent = Double
3.3
        , fLoss :: Double
fLoss = Double
100
        }
    , iNormalizeOutputs :: Bool
iNormalizeOutputs = Bool
True
    , iSolver :: Solver
iSolver = Int -> Double -> Solver
Solver Int
20 Double
0
    , iConnections :: [Connection]
iConnections = []
    }

guitarStrings :: [String]
guitarStrings = forall a b. (a -> b) -> [a] -> [b]
map (Double, Double, Double, NoteNumber, Double) -> String
make
    [ (Double
12.1, Double
0.00020, Double
5, NoteNumber
NN.e3, Double
0.1)
    , (Double
12.3, Double
0.00015, Double
5, NoteNumber
NN.a3, Double
0.15)
    , (Double
21.9, Double
0.00015, Double
5, NoteNumber
NN.d4, Double
0.2)
    , (Double
39.2, Double
0.00015, Double
7, NoteNumber
NN.g4, Double
0.25)
    , (Double
27.6, Double
0.00010, Double
5, NoteNumber
NN.b4, Double
0.3)
    , (Double
49.2, Double
0.00010, Double
8, NoteNumber
NN.e5, Double
0.35)
    ]
    where
    make :: (Double, Double, Double, NoteNumber, Double) -> String
make (Double
tension, Double
radius, Double
t60, NoteNumber
nn, Double
pan) = String
        { sLength :: Double
sLength = Double
0.68
        , sTension :: Double
sTension = Double
tension
        , sMaterial :: Material
sMaterial = Material
steel
        , sRadius :: Double
sRadius = Double
radius
        , sT60 :: (Double, Double)
sT60 = (Double
15, Double
t60)
        , sNn :: NoteNumber
sNn = NoteNumber
nn
        , sName :: Text
sName = NoteNumber -> Text
NN.karya_name NoteNumber
nn
        , sOutputs :: [Output]
sOutputs = [Double -> Double -> Output
Output Double
0.9 Double
pan, Double -> Double -> Output
Output Double
0.7 (Double
pan forall a. Num a => a -> a -> a
+ Double
0.2)]
        }

guitarStrings2 :: [String]
guitarStrings2 = forall a b. (a -> b) -> [a] -> [b]
map (Double, Double, Double, NoteNumber, Double) -> String
make
    [ (Double
12.2, Double
0.00020, Double
5, NoteNumber
NN.e3, Double
0.6)
    , (Double
12.4, Double
0.00015, Double
5, NoteNumber
NN.a3, Double
0.65)
    , (Double
22.0, Double
0.00015, Double
5, NoteNumber
NN.d4, Double
0.7)
    , (Double
39.3, Double
0.00015, Double
7, NoteNumber
NN.g4, Double
0.75)
    , (Double
27.7, Double
0.00010, Double
5, NoteNumber
NN.b4, Double
0.8)
    , (Double
49.3, Double
0.00010, Double
8, NoteNumber
NN.e5, Double
0.85)
    ]
    where
    make :: (Double, Double, Double, NoteNumber, Double) -> String
make (Double
tension, Double
radius, Double
t60, NoteNumber
nn, Double
pan) = String
        { sLength :: Double
sLength = Double
0.68
        , sTension :: Double
sTension = Double
tension
        , sMaterial :: Material
sMaterial = Material
steel
        , sRadius :: Double
sRadius = Double
radius
        , sT60 :: (Double, Double)
sT60 = (Double
15, Double
t60)
        , sNn :: NoteNumber
sNn = NoteNumber
nn
        , sName :: Text
sName = NoteNumber -> Text
NN.karya_name NoteNumber
nn
        , sOutputs :: [Output]
sOutputs = [Double -> Double -> Output
Output Double
0.9 (Double
pan forall a. Num a => a -> a -> a
- Double
0.2), Double -> Double -> Output
Output Double
0.7 Double
pan]
        }

bassStrings :: [String]
bassStrings = forall a b. (a -> b) -> [a] -> [b]
map (Double, Double, NoteNumber) -> String
make
    [ (Double
4.8, Double
0.0002, NoteNumber
NN.e1)
    , (Double
9.3, Double
0.0002, NoteNumber
NN.a1)
    , (Double
9.2, Double
0.00015, NoteNumber
NN.d2)
    , (Double
10.5, Double
0.00012, NoteNumber
NN.g2)
    ]
    where
    make :: (Double, Double, NoteNumber) -> String
make (Double
tension, Double
radius, NoteNumber
nn) = String
        { sLength :: Double
sLength = Double
0.88
        , sTension :: Double
sTension = Double
tension
        , sMaterial :: Material
sMaterial = Material
steel
        , sRadius :: Double
sRadius = Double
radius
        , sT60 :: (Double, Double)
sT60 = (Double
15, Double
3)
        , sNn :: NoteNumber
sNn = NoteNumber
nn
        , sName :: Text
sName = NoteNumber -> Text
NN.karya_name NoteNumber
nn
        , sOutputs :: [Output]
sOutputs =  Double -> [Output]
outputsAt Double
0.5
        }

legongNames :: [(Text, Pitch.NoteNumber)]
legongNames :: [(Text, NoteNumber)]
legongNames = forall a. [a] -> a
head [(Text, NoteNumber)]
legong forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
drop Int
5 [(Text, NoteNumber)]
legong

legongStrings :: [String]
legongStrings = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Text, NoteNumber) -> String -> String
withName [(Text, NoteNumber)]
legongNames forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall a b. (a -> b) -> [a] -> [b]
map (Double -> String -> String
lenBy Double
0.5 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double, Double) -> String
make) [(Double, Double, Double, Double, Double)]
strings
    , forall a b. (a -> b) -> [a] -> [b]
map (Double -> String -> String
lenBy Double
0.25 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double, Double) -> String
make) (forall a. Int -> [a] -> [a]
drop Int
2 [(Double, Double, Double, Double, Double)]
strings)
    ]
    where
    strings :: [(Double, Double, Double, Double, Double)]
strings =
        [ (Double
1.56, Double
11.0, Double
0.00020, Double
5, Double
0.0)
        , (Double
0.78, Double
11.0, Double
0.00020, Double
5, Double
0.0)
        , (Double
0.78, Double
08.0, Double
0.00015, Double
5, Double
0.1)
        , (Double
0.78, Double
08.5, Double
0.00015, Double
5, Double
0.2)
        , (Double
0.78, Double
14.0, Double
0.00015, Double
5, Double
0.3)
        , (Double
0.78, Double
15.0, Double
0.00015, Double
7, Double
0.4)
        , (Double
0.78, Double
16.1, Double
0.00012, Double
8, Double
0.5)
        ]
    make :: (Double, Double, Double, Double, Double) -> String
make (Double
len, Double
tension, Double
radius, Double
t60, Double
pan) =
        Double
-> Double
-> Material
-> Double
-> (Double, Double)
-> NoteNumber
-> Text
-> [Output]
-> String
String Double
len Double
tension Material
steel Double
radius (Double
15, Double
t60) NoteNumber
0 Text
"" (Double -> [Output]
outputsAt Double
pan)
    lenBy :: Double -> String -> String
lenBy Double
n String
str = String
str { sLength :: Double
sLength = String -> Double
sLength String
str forall a. Num a => a -> a -> a
* Double
n }

legongStrings2 :: [String]
legongStrings2 = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Text, NoteNumber) -> String -> String
withName [(Text, NoteNumber)]
legongNames forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall a b. (a -> b) -> [a] -> [b]
map (Double -> String -> String
lenBy Double
0.5 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double, Double) -> String
make) [(Double, Double, Double, Double, Double)]
strings
    , forall a b. (a -> b) -> [a] -> [b]
map (Double -> String -> String
lenBy Double
0.25 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double, Double) -> String
make) (forall a. Int -> [a] -> [a]
drop Int
2 [(Double, Double, Double, Double, Double)]
strings)
    ]
    where
    strings :: [(Double, Double, Double, Double, Double)]
strings =
        [ (Double
1.56, Double
11.1, Double
0.00020, Double
5, Double
0.3)
        , (Double
0.78, Double
11.1, Double
0.00020, Double
5, Double
0.3)
        , (Double
0.78, Double
08.2, Double
0.00015, Double
5, Double
0.4)
        , (Double
0.78, Double
08.7, Double
0.00015, Double
5, Double
0.5)
        , (Double
0.78, Double
14.2, Double
0.00015, Double
5, Double
0.6)
        , (Double
0.78, Double
15.3, Double
0.00015, Double
7, Double
0.7)
        , (Double
0.78, Double
16.7, Double
0.00012, Double
8, Double
0.8)
        ]
    make :: (Double, Double, Double, Double, Double) -> String
make (Double
len, Double
tension, Double
radius, Double
t60, Double
pan) =
        Double
-> Double
-> Material
-> Double
-> (Double, Double)
-> NoteNumber
-> Text
-> [Output]
-> String
String Double
len Double
tension Material
steel Double
radius (Double
15, Double
t60) NoteNumber
0 Text
"" (Double -> [Output]
outs Double
pan)
    lenBy :: Double -> String -> String
lenBy Double
n String
str = String
str { sLength :: Double
sLength = String -> Double
sLength String
str forall a. Num a => a -> a -> a
* Double
n }
    outs :: Double -> [Output]
outs Double
pan = [Double -> Double -> Output
Output Double
0.8 Double
pan, Double -> Double -> Output
Output Double
0.6 (Double
pan forall a. Num a => a -> a -> a
- Double
0.2)]

withName :: (Text, NoteNumber) -> String -> String
withName (Text
name, NoteNumber
nn) String
str = String
str { sName :: Text
sName = Text
name, sNn :: NoteNumber
sNn = NoteNumber
nn }

outputsAt :: Double -> [Output]
outputsAt Double
pan = [Double -> Double -> Output
Output Double
0.9 Double
pan, Double -> Double -> Output
Output Double
0.7 (Double
pan forall a. Num a => a -> a -> a
+ Double
0.2)]

([Note]
notes, [Finger]
fingers) = (forall a. Int -> [a] -> [a]
take Int
1 [Note]
eachString, forall a. Int -> [a] -> [a]
take Int
1 [Finger]
slideEachString)

eachString :: [Note]
eachString = [String -> Double -> Double -> Note
note String
str Double
t Double
0.65 | (String
str, Double
t) <- forall a b. [a] -> [b] -> [(a, b)]
zip [String]
strings (forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
+Double
2) Double
0)]

rolledStrings :: [(String, Double, Double)]
rolledStrings =
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall {b} {c} {a}.
(Ord b, Fractional b, Fractional c) =>
a -> b -> b -> [(a, b, c)]
roll String
str Double
t Double
2 | (String
str, Double
t) <- forall a b. [a] -> [b] -> [(a, b)]
zip [String]
strings (forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
+Double
2) Double
0)]
    where
    roll :: a -> b -> b -> [(a, b, c)]
roll a
str b
t b
dur =
        [ (a
str, b
t, c
dyn)
        | (b
t, c
dyn) <- forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. (Num a, Ord a) => a -> a -> a -> [a]
Lists.range' b
t (b
tforall a. Num a => a -> a -> a
+b
dur) b
0.05) (c
0.65 forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat c
0.03)
        ]


eachPitch :: String -> Seconds -> Pitch.NoteNumber -> [Pitch.NoteNumber]
    -> Finger
eachPitch :: String -> Double -> NoteNumber -> [NoteNumber] -> Finger
eachPitch String
str Double
dur NoteNumber
open [NoteNumber]
pitches = Text -> (Double, Double) -> [(Double, Double, Double)] -> Finger
Finger (String -> Text
sName String
str) (Double
0, Double
0) [(Double, Double, Double)]
notes
    where
    notes :: [(Double, Double, Double)]
notes = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ do
        (NoteNumber
p, Double
t) <- forall a b. [a] -> [b] -> [(a, b)]
zip [NoteNumber]
pitches (forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
+Double
dur) Double
0)
        let loc :: Double
loc = NoteNumber -> NoteNumber -> Double
pitchLocation NoteNumber
open NoteNumber
p
        forall (m :: * -> *) a. Monad m => a -> m a
return [(Double
t forall a. Num a => a -> a -> a
- Double
0.025, Double
loc, Double
0.6), (Double
tforall a. Num a => a -> a -> a
+Double
durforall a. Num a => a -> a -> a
-Double
eta, Double
loc, Double
0.6)]
        -- return [(t+eta, loc, 0.6), (t+dur, loc, 0.6)]
    eta :: Double
eta = Double
0.15

slideEachString :: [Finger]
slideEachString =
    [String -> Double -> Double -> Finger
slide String
str Double
t (Double
tforall a. Num a => a -> a -> a
+Double
2) | (String
str, Double
t) <- forall a b. [a] -> [b] -> [(a, b)]
zip [String]
strings (forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
+Double
2) Double
0)]

slide :: String -> Double -> Double -> Finger
slide String
str Double
start Double
end = Finger
    { fString :: Text
fString = String -> Text
sName String
str
    , fInitial :: (Double, Double)
fInitial = (Double
0, Double
0)
    , fMovement :: [(Double, Double, Double)]
fMovement = [(Double
start, Double
0, Double
0.6), (Double
end, Double
0.5, Double
0.6)]
    }

--

note :: String -> Seconds -> Double -> Note
note :: String -> Double -> Double -> Note
note String
str Double
start Double
amp = Note
    { nStrike :: Strike
nStrike = Strike
Strike
    , nString :: Text
nString = String -> Text
sName String
str
    , nStart :: Double
nStart = Double
start
    , nDuration :: Double
nDuration = Double
0.0013
    , nLocation :: Double
nLocation = Double
0.8
    , nAmplitude :: Double
nAmplitude = Double
amp
    }

score0 :: Score
score0 = Score
    { sDecay :: Double
sDecay = Double
2
    , sHighpass :: Bool
sHighpass = Bool
True
    , sNotes :: [Note]
sNotes = [Note]
notes
    , sFingers :: [Finger]
sFingers = [Finger]
fingers
    }

instrument0 :: Instrument
instrument0 = Instrument
    { iName :: Text
iName = Text
"i0"
    , iStrings :: [String]
iStrings = [String]
strings
    , iFrets :: [Fret]
iFrets = [Fret]
frets
    , iBarrier :: Barrier
iBarrier = Double -> Double -> Double -> Solver -> Barrier
Barrier Double
1e10 Double
1.3 Double
10 (Int -> Double -> Solver
Solver Int
20 Double
1e-12)
    , iBackboard :: Backboard
iBackboard = Double -> Double -> Double -> Backboard
Backboard (-Double
0.002) (-Double
0.001) (-Double
0.0002)
    , iFingerParams :: FingerParams
iFingerParams = Double -> Double -> Double -> Double -> FingerParams
FingerParams Double
0.005 Double
1e7 Double
3.3 Double
100
    , iNormalizeOutputs :: Bool
iNormalizeOutputs = Bool
True
    , iSolver :: Solver
iSolver = Int -> Double -> Solver
Solver Int
20 Double
0
    , iConnections :: [Connection]
iConnections = []
    }

strings :: [String]
strings = forall a b. (a -> b) -> [a] -> [b]
map (Double, Double, Double, Double, Double) -> String
make
    [ (Double
0.78, Double
12.1, Double
0.00020, Double
5, Double
0.2)
    , (Double
1.05, Double
12.3, Double
0.00015, Double
5, Double
0.3)
    , (Double
1.40, Double
21.9, Double
0.00015, Double
5, Double
0.4)
    , (Double
1.60, Double
27.6, Double
0.00015, Double
5, Double
0.5)
    , (Double
1.88, Double
39.2, Double
0.00015, Double
7, Double
0.6)
    , (Double
3.15, Double
49.2, Double
0.00010, Double
8, Double
0.7)
    ]
    where
    make :: (Double, Double, Double, Double, Double) -> String
make (Double
length, Double
tension, Double
radius, Double
t60, Double
pan) =
        Double
-> Double
-> Material
-> Double
-> (Double, Double)
-> NoteNumber
-> Text
-> [Output]
-> String
String Double
length Double
tension Material
silk Double
radius (Double
15, Double
t60) NoteNumber
0 Text
"" [Double -> Double -> Output
Output Double
0.9 Double
pan]
        -- TODO add sNn and sName

frets :: [Fret]
frets = Double -> NoteNumber -> [NoteNumber] -> [Fret]
makeFrets (-Double
0.0005) (forall a. [a] -> a
head [NoteNumber]
scale) (forall a. [a] -> [a]
tail [NoteNumber]
scale)

scale :: [NoteNumber]
scale = [NoteNumber]
minor

minor :: [Pitch.NoteNumber]
minor :: [NoteNumber]
minor = forall a b. (a -> b) -> [a] -> [b]
map forall a. Real a => a -> NoteNumber
Pitch.nn forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
21 forall a b. (a -> b) -> a -> b
$ forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) Integer
48 (forall a. [a] -> [a]
cycle [Integer]
intervals)
    where
    intervals :: [Integer]
intervals = [Integer
2, Integer
1, Integer
2, Integer
2, Integer
1, Integer
2, Integer
2]

legong :: [(Text, Pitch.NoteNumber)]
legong :: [(Text, NoteNumber)]
legong = forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
names forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Real a => a -> NoteNumber
Pitch.nn
    [ Double
48.73 -- 3i
    , Double
50.80 -- 3o
    , Double
51.82 -- 3e, rambat begin
    , Double
55.70 -- 3u
    , Double
56.82 -- 3a, trompong begin

    , Double
60.73 -- 4i
    , Double
62.80 -- 4o, pemade begin
    , Double
63.35 -- 4e, reyong begin
    , Double
67.70 -- 4u
    , Double
68.20 -- 4a

    , Double
72.46 -- 5i
    , Double
73.90 -- 5o, kantilan begin
    , Double
75.50 -- 5e
    , Double
79.40 -- 5u, trompong end
    , Double
80.50 -- 5a

    , Double
84.46 -- 6i, rambat end, pemade end
    ]
    where
    names :: [Text]
names = [forall a. Show a => a -> Text
showt Integer
oct forall a. Semigroup a => a -> a -> a
<> Char -> Text
Text.singleton Char
c | Integer
oct <- [Integer
3..], Char
c <- [Char]
"ioeua"]