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

module Ness.Guitar where
import           Prelude hiding (String)
import qualified Data.Map as Map
import qualified Data.Text as Text

import qualified Util.Lists as Lists
import qualified Perform.Pitch as Pitch

import           Global
import           Ness.Global


steel :: Material
steel   = Double -> Double -> Material
Material Double
7860   Double
200e9 -- 8050 kg/m^3, 200 GPa
gold :: Material
gold    = Double -> Double -> Material
Material Double
19300  Double
79e9 -- 19320
uranium :: Material
uranium = Double -> Double -> Material
Material Double
19050  Double
208e9
nylon :: Material
nylon   = Double -> Double -> Material
Material Double
1150   Double
3e9 -- 1.15 g/m^3, 2--4 GPa
hemp :: Material
hemp    = Double -> Double -> Material
Material Double
860    Double
35e9 -- .86 g/m^3, 35 GPa
bronze :: Material
bronze  = Double -> Double -> Material
Material Double
8000   Double
105e9 -- 7400 - 8900, 96--120 GPa
silk :: Material
silk    = Double -> Double -> Material
Material Double
1300   Double
200e9 -- spider silk: 40--280 GPa as strain increases

renderAll :: SamplingRate -> (Instrument, Score) -> (Text, Text)
renderAll :: StringIndex -> (Instrument, Score) -> (Text, Text)
renderAll StringIndex
sr (Instrument
instrument, Score
score) =
    (StringIndex -> Instrument -> Text
renderInstrument StringIndex
sr Instrument
instrument, [String] -> Score -> Text
renderScore (Instrument -> [String]
iStrings Instrument
instrument) Score
score)

verify :: Instrument -> [Text]
verify :: Instrument -> [Text]
verify Instrument
instrument = forall a b. (a -> b) -> [a] -> [b]
map (Text
"duplicate string names: "<>) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => (a -> k) -> [a] -> ([a], [(a, [a])])
Lists.partitionDups forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Text
sName forall a b. (a -> b) -> a -> b
$ Instrument -> [String]
iStrings Instrument
instrument

-- * Instrument

{- | string_def (array) defines the parameters for each string of the guitar.
    This is a 2-dimensional array with a row for each string. Each row
    contains 7 items: length in metres, Young’s modulus, tension, radius,
    density, T60 at 0Hz, T60 at 1000Hz.
-}
data String = String {
    String -> Double
sLength :: Meters
    , String -> Double
sTension :: Newtons
    , String -> Material
sMaterial :: Material
    , String -> Double
sRadius :: Meters
    , String -> (Double, Double)
sT60 :: (Double, Double) -- -60db at 0hz and 1k
    -- | This is the logical pitch, in order to select a string, which is
    -- different from the actual pitch.  The actual pitch is calculated with
    -- 'sActualNn'.
    , String -> NoteNumber
sNn :: Pitch.NoteNumber
    , String -> Text
sName :: StringName
    , String -> [Output]
sOutputs :: [Output]
    } deriving (String -> String -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: String -> String -> Bool
$c/= :: String -> String -> Bool
== :: String -> String -> Bool
$c== :: String -> String -> Bool
Eq, Eq String
String -> String -> Bool
String -> String -> Ordering
String -> String -> String
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: String -> String -> String
$cmin :: String -> String -> String
max :: String -> String -> String
$cmax :: String -> String -> String
>= :: String -> String -> Bool
$c>= :: String -> String -> Bool
> :: String -> String -> Bool
$c> :: String -> String -> Bool
<= :: String -> String -> Bool
$c<= :: String -> String -> Bool
< :: String -> String -> Bool
$c< :: String -> String -> Bool
compare :: String -> String -> Ordering
$ccompare :: String -> String -> Ordering
Ord, StringIndex -> String -> ShowS
[String] -> ShowS
String -> String
forall a.
(StringIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [String] -> ShowS
$cshowList :: [String] -> ShowS
show :: String -> String
$cshow :: String -> String
showsPrec :: StringIndex -> String -> ShowS
$cshowsPrec :: StringIndex -> String -> ShowS
Show)
type StringName = Text

data Material = Material {
    Material -> Double
mDensity, Material -> Double
mYoung :: Double
    } deriving (Material -> Material -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Material -> Material -> Bool
$c/= :: Material -> Material -> Bool
== :: Material -> Material -> Bool
$c== :: Material -> Material -> Bool
Eq, Eq Material
Material -> Material -> Bool
Material -> Material -> Ordering
Material -> Material -> Material
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Material -> Material -> Material
$cmin :: Material -> Material -> Material
max :: Material -> Material -> Material
$cmax :: Material -> Material -> Material
>= :: Material -> Material -> Bool
$c>= :: Material -> Material -> Bool
> :: Material -> Material -> Bool
$c> :: Material -> Material -> Bool
<= :: Material -> Material -> Bool
$c<= :: Material -> Material -> Bool
< :: Material -> Material -> Bool
$c< :: Material -> Material -> Bool
compare :: Material -> Material -> Ordering
$ccompare :: Material -> Material -> Ordering
Ord, StringIndex -> Material -> ShowS
[Material] -> ShowS
Material -> String
forall a.
(StringIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Material] -> ShowS
$cshowList :: [Material] -> ShowS
show :: Material -> String
$cshow :: Material -> String
showsPrec :: StringIndex -> Material -> ShowS
$cshowsPrec :: StringIndex -> Material -> ShowS
Show)

renderStrings :: [String] -> Text
renderStrings :: [String] -> Text
renderStrings = Text -> [[Double]] -> Text
array2 Text
"string_def" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> [Double]
list
    where
    list :: String -> [Double]
list (String Double
len Double
tension (Material Double
density Double
young) Double
radius (Double
t600, Double
t601)
            NoteNumber
_ Text
_ [Output]
_) =
        [Double
len, Double
young, Double
tension, Double
radius, Double
density, Double
t600, Double
t601]

{- | output_def (array) defines the locations of the outputs. This is
    a 2-dimensional array with a row for each output. Each row contains
    2 items: the index of the string from which the output should be taken
    (1-based), and the distance along the string (normalised to the range
    0-1).
-}
data Output = Output {
    Output -> Double
oLocation :: Location
    , Output -> Double
oPan :: Pan
    } deriving (Output -> Output -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Output -> Output -> Bool
$c/= :: Output -> Output -> Bool
== :: Output -> Output -> Bool
$c== :: Output -> Output -> Bool
Eq, Eq Output
Output -> Output -> Bool
Output -> Output -> Ordering
Output -> Output -> Output
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Output -> Output -> Output
$cmin :: Output -> Output -> Output
max :: Output -> Output -> Output
$cmax :: Output -> Output -> Output
>= :: Output -> Output -> Bool
$c>= :: Output -> Output -> Bool
> :: Output -> Output -> Bool
$c> :: Output -> Output -> Bool
<= :: Output -> Output -> Bool
$c<= :: Output -> Output -> Bool
< :: Output -> Output -> Bool
$c< :: Output -> Output -> Bool
compare :: Output -> Output -> Ordering
$ccompare :: Output -> Output -> Ordering
Ord, StringIndex -> Output -> ShowS
[Output] -> ShowS
Output -> String
forall a.
(StringIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Output] -> ShowS
$cshowList :: [Output] -> ShowS
show :: Output -> String
$cshow :: Output -> String
showsPrec :: StringIndex -> Output -> ShowS
$cshowsPrec :: StringIndex -> Output -> ShowS
Show)

renderOutputs :: [(StringIndex, Output)] -> Text
renderOutputs :: [(StringIndex, Output)] -> Text
renderOutputs = Text -> [[Double]] -> Text
array2 Text
"output_def" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Integral a => (a, Output) -> [Double]
list
    where list :: (a, Output) -> [Double]
list (a
i, (Output Double
location Double
_pan)) = [forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i, Double
location]

{- | backboard (array) defines the shape of the backboard. This is
    a 3 element array; the elements (which should be negative) define
    a quadratic function describing the shape of the backboard.

    Where x is length: a + bx + bx^2
    All should be negative or zero (i.e., the backboard is under the strings).
    E.g. -0.001 -0.000 -0.0002
-}
data Backboard = Backboard {
    Backboard -> Double
ba :: Double
    , Backboard -> Double
bb :: Double
    , Backboard -> Double
bc :: Double
    } deriving (Backboard -> Backboard -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Backboard -> Backboard -> Bool
$c/= :: Backboard -> Backboard -> Bool
== :: Backboard -> Backboard -> Bool
$c== :: Backboard -> Backboard -> Bool
Eq, Eq Backboard
Backboard -> Backboard -> Bool
Backboard -> Backboard -> Ordering
Backboard -> Backboard -> Backboard
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Backboard -> Backboard -> Backboard
$cmin :: Backboard -> Backboard -> Backboard
max :: Backboard -> Backboard -> Backboard
$cmax :: Backboard -> Backboard -> Backboard
>= :: Backboard -> Backboard -> Bool
$c>= :: Backboard -> Backboard -> Bool
> :: Backboard -> Backboard -> Bool
$c> :: Backboard -> Backboard -> Bool
<= :: Backboard -> Backboard -> Bool
$c<= :: Backboard -> Backboard -> Bool
< :: Backboard -> Backboard -> Bool
$c< :: Backboard -> Backboard -> Bool
compare :: Backboard -> Backboard -> Ordering
$ccompare :: Backboard -> Backboard -> Ordering
Ord, StringIndex -> Backboard -> ShowS
[Backboard] -> ShowS
Backboard -> String
forall a.
(StringIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Backboard] -> ShowS
$cshowList :: [Backboard] -> ShowS
show :: Backboard -> String
$cshow :: Backboard -> String
showsPrec :: StringIndex -> Backboard -> ShowS
$cshowsPrec :: StringIndex -> Backboard -> ShowS
Show)

renderBackboard :: Backboard -> Text
renderBackboard :: Backboard -> Text
renderBackboard (Backboard Double
b1 Double
b2 Double
b3) = Text -> [Double] -> Text
array Text
"backboard" [Double
b1, Double
b2, Double
b3]

data Fret = Fret {
    Fret -> Double
fHeight :: Meters -- negative
    , Fret -> Double
fLocation :: Location
    } deriving (Fret -> Fret -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fret -> Fret -> Bool
$c/= :: Fret -> Fret -> Bool
== :: Fret -> Fret -> Bool
$c== :: Fret -> Fret -> Bool
Eq, Eq Fret
Fret -> Fret -> Bool
Fret -> Fret -> Ordering
Fret -> Fret -> Fret
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Fret -> Fret -> Fret
$cmin :: Fret -> Fret -> Fret
max :: Fret -> Fret -> Fret
$cmax :: Fret -> Fret -> Fret
>= :: Fret -> Fret -> Bool
$c>= :: Fret -> Fret -> Bool
> :: Fret -> Fret -> Bool
$c> :: Fret -> Fret -> Bool
<= :: Fret -> Fret -> Bool
$c<= :: Fret -> Fret -> Bool
< :: Fret -> Fret -> Bool
$c< :: Fret -> Fret -> Bool
compare :: Fret -> Fret -> Ordering
$ccompare :: Fret -> Fret -> Ordering
Ord, StringIndex -> Fret -> ShowS
[Fret] -> ShowS
Fret -> String
forall a.
(StringIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fret] -> ShowS
$cshowList :: [Fret] -> ShowS
show :: Fret -> String
$cshow :: Fret -> String
showsPrec :: StringIndex -> Fret -> ShowS
$cshowsPrec :: StringIndex -> Fret -> ShowS
Show)

renderFrets :: [Fret] -> Text
renderFrets :: [Fret] -> Text
renderFrets = Text -> [[Double]] -> Text
array2 Text
"frets" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Fret -> [Double]
list
    where list :: Fret -> [Double]
list (Fret Double
height Double
loc) = [Double
loc, Double
height]

{- | barrier_params_def (array) specifies 5 basic parameters for the barrier
    (fret and backboard) collisions. The parameters are: K, alpha, beta, number
    of iterations for Newton solver, and tolerance for Newton solver.

    E.g. 1e10 1.3 10
-}
data Barrier = Barrier {
    -- | stiffness (normally a high number, like 1e10, or 1e13
    Barrier -> Double
bK :: Double
    -- | stiffness exponent (small number, usually between 1 and 3)
    , Barrier -> Double
bAlpha :: Double
    -- | loss parameter (positive or zero...bigger means more loss)
    , Barrier -> Double
bBeta :: Double
    , Barrier -> Solver
bSolver :: Solver
    } deriving (Barrier -> Barrier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Barrier -> Barrier -> Bool
$c/= :: Barrier -> Barrier -> Bool
== :: Barrier -> Barrier -> Bool
$c== :: Barrier -> Barrier -> Bool
Eq, Eq Barrier
Barrier -> Barrier -> Bool
Barrier -> Barrier -> Ordering
Barrier -> Barrier -> Barrier
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Barrier -> Barrier -> Barrier
$cmin :: Barrier -> Barrier -> Barrier
max :: Barrier -> Barrier -> Barrier
$cmax :: Barrier -> Barrier -> Barrier
>= :: Barrier -> Barrier -> Bool
$c>= :: Barrier -> Barrier -> Bool
> :: Barrier -> Barrier -> Bool
$c> :: Barrier -> Barrier -> Bool
<= :: Barrier -> Barrier -> Bool
$c<= :: Barrier -> Barrier -> Bool
< :: Barrier -> Barrier -> Bool
$c< :: Barrier -> Barrier -> Bool
compare :: Barrier -> Barrier -> Ordering
$ccompare :: Barrier -> Barrier -> Ordering
Ord, StringIndex -> Barrier -> ShowS
[Barrier] -> ShowS
Barrier -> String
forall a.
(StringIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Barrier] -> ShowS
$cshowList :: [Barrier] -> ShowS
show :: Barrier -> String
$cshow :: Barrier -> String
showsPrec :: StringIndex -> Barrier -> ShowS
$cshowsPrec :: StringIndex -> Barrier -> ShowS
Show)

renderBarrier :: Barrier -> Text
renderBarrier :: Barrier -> Text
renderBarrier (Barrier Double
k Double
alpha Double
beta (Solver StringIndex
iterations Double
tolerance)) =
    Text -> [Double] -> Text
array Text
"barrier_params_def"
        [Double
k, Double
alpha, Double
beta, forall a b. (Integral a, Num b) => a -> b
fromIntegral StringIndex
iterations, Double
tolerance]

data FingerParams = FingerParams {
    FingerParams -> Double
fMass :: Kg
    -- | Stiffness.  A big number, like 1e7, usually... tells you the hardness
    -- of the finger.
    , FingerParams -> Double
fStiffness :: Double
    -- | Exponent, should be between 1-3.
    , FingerParams -> Double
fExponent :: Double
    -- | Loss.  0 means lossless, greater than zero, means lossy. Usually 1-100
    -- are good values.
    , FingerParams -> Double
fLoss :: Double
    } deriving (FingerParams -> FingerParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FingerParams -> FingerParams -> Bool
$c/= :: FingerParams -> FingerParams -> Bool
== :: FingerParams -> FingerParams -> Bool
$c== :: FingerParams -> FingerParams -> Bool
Eq, Eq FingerParams
FingerParams -> FingerParams -> Bool
FingerParams -> FingerParams -> Ordering
FingerParams -> FingerParams -> FingerParams
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FingerParams -> FingerParams -> FingerParams
$cmin :: FingerParams -> FingerParams -> FingerParams
max :: FingerParams -> FingerParams -> FingerParams
$cmax :: FingerParams -> FingerParams -> FingerParams
>= :: FingerParams -> FingerParams -> Bool
$c>= :: FingerParams -> FingerParams -> Bool
> :: FingerParams -> FingerParams -> Bool
$c> :: FingerParams -> FingerParams -> Bool
<= :: FingerParams -> FingerParams -> Bool
$c<= :: FingerParams -> FingerParams -> Bool
< :: FingerParams -> FingerParams -> Bool
$c< :: FingerParams -> FingerParams -> Bool
compare :: FingerParams -> FingerParams -> Ordering
$ccompare :: FingerParams -> FingerParams -> Ordering
Ord, StringIndex -> FingerParams -> ShowS
[FingerParams] -> ShowS
FingerParams -> String
forall a.
(StringIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FingerParams] -> ShowS
$cshowList :: [FingerParams] -> ShowS
show :: FingerParams -> String
$cshow :: FingerParams -> String
showsPrec :: StringIndex -> FingerParams -> ShowS
$cshowsPrec :: StringIndex -> FingerParams -> ShowS
Show)

renderFingerParams :: FingerParams -> Text
renderFingerParams :: FingerParams -> Text
renderFingerParams (FingerParams Double
mass Double
k Double
alpha Double
beta) =
    Text -> [Double] -> Text
array Text
"finger_params" [Double
mass, Double
k, Double
alpha, Double
beta]

data Solver = Solver {
    Solver -> StringIndex
nIterations :: Int
    , Solver -> Double
nTolerance :: Double
    } deriving (Solver -> Solver -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Solver -> Solver -> Bool
$c/= :: Solver -> Solver -> Bool
== :: Solver -> Solver -> Bool
$c== :: Solver -> Solver -> Bool
Eq, Eq Solver
Solver -> Solver -> Bool
Solver -> Solver -> Ordering
Solver -> Solver -> Solver
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Solver -> Solver -> Solver
$cmin :: Solver -> Solver -> Solver
max :: Solver -> Solver -> Solver
$cmax :: Solver -> Solver -> Solver
>= :: Solver -> Solver -> Bool
$c>= :: Solver -> Solver -> Bool
> :: Solver -> Solver -> Bool
$c> :: Solver -> Solver -> Bool
<= :: Solver -> Solver -> Bool
$c<= :: Solver -> Solver -> Bool
< :: Solver -> Solver -> Bool
$c< :: Solver -> Solver -> Bool
compare :: Solver -> Solver -> Ordering
$ccompare :: Solver -> Solver -> Ordering
Ord, StringIndex -> Solver -> ShowS
[Solver] -> ShowS
Solver -> String
forall a.
(StringIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Solver] -> ShowS
$cshowList :: [Solver] -> ShowS
show :: Solver -> String
$cshow :: Solver -> String
showsPrec :: StringIndex -> Solver -> ShowS
$cshowsPrec :: StringIndex -> Solver -> ShowS
Show)

-- | 1-based, I think.
type StringIndex = Int

{- | ssconnect_def (array) defines the parameters for each connection between
    strings. This is a 2-dimensional array with a row for each connection. Each
    row contains 9 items: the mass, frequency, loss parameter, collision
    exponent, rattling distance, index of first string, connection point on
    first string (0-1), index of second string, connection point on second
    string. If the second string index is 0, the connection is to a single
    string only. If multiple connections are defined connecting to the same
    point on a string, the latter one will be automatically removed as this is
    not currently supported.
-}
data Connection = Connection {
    Connection -> Double
cMass :: Double
    , Connection -> Double
cFrequency :: Double
    , Connection -> Double
cLoss :: Double
    , Connection -> Double
cCollisionExponent :: Double
    , Connection -> Double
cRattlingDistance :: Meters
    , Connection -> (StringIndex, Double)
cString1 :: (StringIndex, Location)
    , Connection -> (StringIndex, Double)
cString2 :: (StringIndex, Location)
    } deriving (Connection -> Connection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Connection -> Connection -> Bool
$c/= :: Connection -> Connection -> Bool
== :: Connection -> Connection -> Bool
$c== :: Connection -> Connection -> Bool
Eq, Eq Connection
Connection -> Connection -> Bool
Connection -> Connection -> Ordering
Connection -> Connection -> Connection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Connection -> Connection -> Connection
$cmin :: Connection -> Connection -> Connection
max :: Connection -> Connection -> Connection
$cmax :: Connection -> Connection -> Connection
>= :: Connection -> Connection -> Bool
$c>= :: Connection -> Connection -> Bool
> :: Connection -> Connection -> Bool
$c> :: Connection -> Connection -> Bool
<= :: Connection -> Connection -> Bool
$c<= :: Connection -> Connection -> Bool
< :: Connection -> Connection -> Bool
$c< :: Connection -> Connection -> Bool
compare :: Connection -> Connection -> Ordering
$ccompare :: Connection -> Connection -> Ordering
Ord, StringIndex -> Connection -> ShowS
[Connection] -> ShowS
Connection -> String
forall a.
(StringIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Connection] -> ShowS
$cshowList :: [Connection] -> ShowS
show :: Connection -> String
$cshow :: Connection -> String
showsPrec :: StringIndex -> Connection -> ShowS
$cshowsPrec :: StringIndex -> Connection -> ShowS
Show)

renderConnections :: [Connection] -> Text
renderConnections :: [Connection] -> Text
renderConnections = Text -> [[Double]] -> Text
array2 Text
"ssconnect_def" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Connection -> [Double]
list
    where
    list :: Connection -> [Double]
list (Connection Double
mass Double
freq Double
loss Double
collision Double
rattle (StringIndex
s1, Double
s1Loc) (StringIndex
s2, Double
s2Loc)) =
        [ Double
mass, Double
freq, Double
loss, Double
collision, Double
rattle
        , forall a b. (Integral a, Num b) => a -> b
fromIntegral StringIndex
s1, Double
s1Loc, forall a b. (Integral a, Num b) => a -> b
fromIntegral StringIndex
s2, Double
s2Loc
        ]

data Instrument = Instrument {
    Instrument -> Text
iName :: Text
    , Instrument -> [String]
iStrings :: [String]
    , Instrument -> [Fret]
iFrets :: [Fret]
    , Instrument -> Barrier
iBarrier :: Barrier
    , Instrument -> Backboard
iBackboard :: Backboard
    , Instrument -> FingerParams
iFingerParams :: FingerParams
    , Instrument -> Bool
iNormalizeOutputs :: Bool
    , Instrument -> Solver
iSolver :: Solver
    , Instrument -> [Connection]
iConnections :: [Connection]
    } deriving (Instrument -> Instrument -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instrument -> Instrument -> Bool
$c/= :: Instrument -> Instrument -> Bool
== :: Instrument -> Instrument -> Bool
$c== :: Instrument -> Instrument -> Bool
Eq, Eq Instrument
Instrument -> Instrument -> Bool
Instrument -> Instrument -> Ordering
Instrument -> Instrument -> Instrument
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Instrument -> Instrument -> Instrument
$cmin :: Instrument -> Instrument -> Instrument
max :: Instrument -> Instrument -> Instrument
$cmax :: Instrument -> Instrument -> Instrument
>= :: Instrument -> Instrument -> Bool
$c>= :: Instrument -> Instrument -> Bool
> :: Instrument -> Instrument -> Bool
$c> :: Instrument -> Instrument -> Bool
<= :: Instrument -> Instrument -> Bool
$c<= :: Instrument -> Instrument -> Bool
< :: Instrument -> Instrument -> Bool
$c< :: Instrument -> Instrument -> Bool
compare :: Instrument -> Instrument -> Ordering
$ccompare :: Instrument -> Instrument -> Ordering
Ord, StringIndex -> Instrument -> ShowS
[Instrument] -> ShowS
Instrument -> String
forall a.
(StringIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instrument] -> ShowS
$cshowList :: [Instrument] -> ShowS
show :: Instrument -> String
$cshow :: Instrument -> String
showsPrec :: StringIndex -> Instrument -> ShowS
$cshowsPrec :: StringIndex -> Instrument -> ShowS
Show)

renderInstrument :: SamplingRate -> Instrument -> Text
renderInstrument :: StringIndex -> Instrument -> Text
renderInstrument StringIndex
sr (Instrument Text
name [String]
strings [Fret]
frets Barrier
barrier Backboard
backboard
        FingerParams
fingerParams Bool
normalizeOutputs Solver
solver [Connection]
connections) = [Text] -> Text
Text.unlines
    [ Text
"% gtversion 1.0"
    , Text
"% name: " forall a. Semigroup a => a -> a -> a
<> Text
name
    , forall a. Render a => Text -> a -> Text
scalar Text
"SR" StringIndex
sr
    , [String] -> Text
renderStrings [String]
strings
    , [(StringIndex, Output)] -> Text
renderOutputs [(StringIndex
i, Output
o) | (StringIndex
i, String
string) <- [(StringIndex, String)]
byIndex, Output
o <- String -> [Output]
sOutputs String
string]
    , forall a. Render a => Text -> a -> Text
scalar Text
"itnum" (Solver -> StringIndex
nIterations Solver
solver)
    , forall a. Render a => Text -> a -> Text
scalar Text
"normalize_outputs" Bool
normalizeOutputs
    , Text -> [Double] -> Text
array Text
"pan" (forall a b. (a -> b) -> [a] -> [b]
map Output -> Double
oPan (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [Output]
sOutputs [String]
strings))
    , Backboard -> Text
renderBackboard Backboard
backboard
    , [Fret] -> Text
renderFrets [Fret]
frets
    , Barrier -> Text
renderBarrier Barrier
barrier
    , FingerParams -> Text
renderFingerParams FingerParams
fingerParams
    , [Connection] -> Text
renderConnections [Connection]
connections
    ]
    where
    byIndex :: [(StringIndex, String)]
byIndex = forall a b. [a] -> [b] -> [(a, b)]
zip [StringIndex
1..] [String]
strings

-- * Score

data Score = Score {
    Score -> Double
sDecay :: Seconds
    , Score -> Bool
sHighpass :: Bool
    , Score -> [Note]
sNotes :: [Note]
    , Score -> [Finger]
sFingers :: [Finger]
    }
    deriving (Score -> Score -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Score -> Score -> Bool
$c/= :: Score -> Score -> Bool
== :: Score -> Score -> Bool
$c== :: Score -> Score -> Bool
Eq, StringIndex -> Score -> ShowS
[Score] -> ShowS
Score -> String
forall a.
(StringIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Score] -> ShowS
$cshowList :: [Score] -> ShowS
show :: Score -> String
$cshow :: Score -> String
showsPrec :: StringIndex -> Score -> ShowS
$cshowsPrec :: StringIndex -> Score -> ShowS
Show)

renderScore :: [String] -> Score -> Text
renderScore :: [String] -> Score -> Text
renderScore [String]
strings (Score Double
decay Bool
highpass [Note]
notes [Finger]
fingers) = [Text] -> Text
Text.unlines
    [ forall a. Render a => Text -> a -> Text
scalar Text
"Tf" Double
duration
    , forall a. Render a => Text -> a -> Text
scalar Text
"highpass" Bool
highpass
    , (Text -> StringIndex) -> [Note] -> Text
renderNotes forall {a}. (Num a, Enum a) => Text -> a
indexOf [Note]
notes
    , (Text -> StringIndex) -> [Finger] -> Text
renderFingers forall {a}. (Num a, Enum a) => Text -> a
indexOf [Finger]
fingers
    ]
    where
    duration :: Double
duration = forall a. a -> Maybe a -> a
fromMaybe Double
0 (forall a. Ord a => [a] -> Maybe a
Lists.maximum (forall a b. (a -> b) -> [a] -> [b]
map Note -> Double
nStart [Note]
notes)) forall a. Num a => a -> a -> a
+ Double
decay
    indexOf :: Text -> a
indexOf Text
str = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"no string: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
str) forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
str Map Text a
toNum
        where toNum :: Map Text a
toNum = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map String -> Text
sName [String]
strings) [a
1..]

data Note = Note {
    Note -> Strike
nStrike :: Strike
    , Note -> Text
nString :: StringName
    , Note -> Double
nStart :: Seconds
    , Note -> Double
nDuration :: Seconds
    , Note -> Double
nLocation :: Location
    , Note -> Double
nAmplitude :: Newtons
    } deriving (Note -> Note -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c== :: Note -> Note -> Bool
Eq, StringIndex -> Note -> ShowS
[Note] -> ShowS
Note -> String
forall a.
(StringIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Note] -> ShowS
$cshowList :: [Note] -> ShowS
show :: Note -> String
$cshow :: Note -> String
showsPrec :: StringIndex -> Note -> ShowS
$cshowsPrec :: StringIndex -> Note -> ShowS
Show)

renderNotes :: (StringName -> StringIndex) -> [Note] -> Text
renderNotes :: (Text -> StringIndex) -> [Note] -> Text
renderNotes Text -> StringIndex
indexOf = Text -> [[Double]] -> Text
array2 Text
"exc" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Note -> [Double]
list
    where
    list :: Note -> [Double]
list (Note Strike
strike Text
string Double
start Double
dur Double
loc Double
amp) =
        [forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> StringIndex
indexOf Text
string), Double
start, Double
loc, Double
dur, Double
amp, forall {a}. Num a => Strike -> a
fromStrike Strike
strike]
    fromStrike :: Strike -> a
fromStrike Strike
Strike = a
0
    fromStrike Strike
Pluck = a
1

data Strike = Strike | Pluck deriving (Strike -> Strike -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Strike -> Strike -> Bool
$c/= :: Strike -> Strike -> Bool
== :: Strike -> Strike -> Bool
$c== :: Strike -> Strike -> Bool
Eq, StringIndex -> Strike -> ShowS
[Strike] -> ShowS
Strike -> String
forall a.
(StringIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Strike] -> ShowS
$cshowList :: [Strike] -> ShowS
show :: Strike -> String
$cshow :: Strike -> String
showsPrec :: StringIndex -> Strike -> ShowS
$cshowsPrec :: StringIndex -> Strike -> ShowS
Show)

data Finger = Finger {
    Finger -> Text
fString :: StringName
    , Finger -> (Double, Double)
fInitial :: (Location, Velocity)
    , Finger -> [(Double, Double, Double)]
fMovement :: [(Seconds, Location, Newtons)]
    } deriving (Finger -> Finger -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Finger -> Finger -> Bool
$c/= :: Finger -> Finger -> Bool
== :: Finger -> Finger -> Bool
$c== :: Finger -> Finger -> Bool
Eq, StringIndex -> Finger -> ShowS
[Finger] -> ShowS
Finger -> String
forall a.
(StringIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Finger] -> ShowS
$cshowList :: [Finger] -> ShowS
show :: Finger -> String
$cshow :: Finger -> String
showsPrec :: StringIndex -> Finger -> ShowS
$cshowsPrec :: StringIndex -> Finger -> ShowS
Show)
    -- finger def (cell array) defines all of the fingers in the simulation,
    -- their movements and the forces associated with them. This is
    -- a 2-dimensional cell array. Each row represents one finger and consists
    -- of 3 elements: the index of the string that the finger is on;
    -- a 2-dimensional array defining how the finger position and force changes
    -- over time; and a two element array specifying the finger’s initial
    -- position and velocity. Each row of the middle element contains a time
    -- (in seconds), a position and a force. The position and force are
    -- interpolated between the times given.

renderFingers :: (StringName -> StringIndex) -> [Finger] -> Text
renderFingers :: (Text -> StringIndex) -> [Finger] -> Text
renderFingers Text -> StringIndex
_ [] = Text
""
renderFingers Text -> StringIndex
indexOf [Finger]
fingers = [Text] -> Text
Text.unlines
    [ Text
"finger_def = {"
    , Text -> [Text] -> Text
Text.intercalate Text
";\n" (forall a b. (a -> b) -> [a] -> [b]
map ((Text
"  "<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finger -> Text
rFinger) [Finger]
fingers)
    , Text
"};"
    ]
    where
    rFinger :: Finger -> Text
rFinger (Finger Text
str (Double
initP, Double
initV) [(Double, Double, Double)]
movement) = Text -> [Text] -> Text
Text.intercalate Text
", "
        [ forall a. Render a => a -> Text
render (Text -> StringIndex
indexOf Text
str)
        , Text
"[" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"; " (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Render a => (a, a, a) -> Text
bp [(Double, Double, Double)]
movement) forall a. Semigroup a => a -> a -> a
<> Text
"]"
        , Text
"[" forall a. Semigroup a => a -> a -> a
<> forall a. Render a => a -> Text
render Double
initP forall a. Semigroup a => a -> a -> a
<> Text
", " forall a. Semigroup a => a -> a -> a
<> forall a. Render a => a -> Text
render Double
initV forall a. Semigroup a => a -> a -> a
<> Text
"]"
        ]
    bp :: (a, a, a) -> Text
bp (a
sec, a
p, a
v) = [Text] -> Text
Text.unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Render a => a -> Text
render [a
sec, a
p, a
v]

-- * render util

array :: Text -> [Double] -> Text
array :: Text -> [Double] -> Text
array Text
name [Double]
array =
    Text
name forall a. Semigroup a => a -> a -> a
<> Text
" = [" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Render a => a -> Text
render [Double]
array) forall a. Semigroup a => a -> a -> a
<> Text
"];"

array2 :: Text -> [[Double]] -> Text
array2 :: Text -> [[Double]] -> Text
array2 Text
name [[Double]]
array = forall a. Monoid a => [a] -> a
mconcat
    [ Text
name forall a. Semigroup a => a -> a -> a
<> Text
" = ["
    , Text -> [Text] -> Text
Text.intercalate Text
";\n  " [[Text] -> Text
Text.unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a. Render a => a -> Text
render [Double]
xs) | [Double]
xs <- [[Double]]
array]
    , Text
"];"
    ]

scalar :: Render a => Text -> a -> Text
scalar :: forall a. Render a => Text -> a -> Text
scalar Text
name a
x = Text
name forall a. Semigroup a => a -> a -> a
<> Text
" = " forall a. Semigroup a => a -> a -> a
<> forall a. Render a => a -> Text
render a
x forall a. Semigroup a => a -> a -> a
<> Text
";"

-- * instrument util

makeFrets :: Meters -> Pitch.NoteNumber -> [Pitch.NoteNumber] -> [Fret]
makeFrets :: Double -> NoteNumber -> [NoteNumber] -> [Fret]
makeFrets Double
height NoteNumber
open [NoteNumber]
nns =
    forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Fret
Fret Double
height) (forall a b. (a -> b) -> [a] -> [b]
map (NoteNumber -> NoteNumber -> Double
pitchLocation NoteNumber
open) [NoteNumber]
nns)

pitchLocation :: Pitch.NoteNumber -> Pitch.NoteNumber -> Location
pitchLocation :: NoteNumber -> NoteNumber -> Double
pitchLocation NoteNumber
f0 NoteNumber
f = Double
1 forall a. Num a => a -> a -> a
- Double
1 forall a. Fractional a => a -> a -> a
/ (NoteNumber -> Double
Pitch.nn_to_hz NoteNumber
f forall a. Fractional a => a -> a -> a
/ NoteNumber -> Double
Pitch.nn_to_hz NoteNumber
f0)

sActualNn :: String -> Pitch.NoteNumber
sActualNn :: String -> NoteNumber
sActualNn String
s = Double -> NoteNumber
Pitch.hz_to_nn forall a b. (a -> b) -> a -> b
$ forall a. Floating a => a -> a
sqrt (String -> Double
sTension String
s forall a. Fractional a => a -> a -> a
/ Double
mu) forall a. Fractional a => a -> a -> a
/ (Double
2 forall a. Num a => a -> a -> a
* String -> Double
sLength String
s)
    where mu :: Double
mu = forall a. Floating a => a
pi forall a. Num a => a -> a -> a
* String -> Double
sRadius String
s forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
2 forall a. Num a => a -> a -> a
* Material -> Double
mDensity (String -> Material
sMaterial String
s)

freq :: Double -> Double
freq Double
harmonic = forall a. Floating a => a -> a
sqrt (Double
tension forall a. Fractional a => a -> a -> a
/ (Double
density forall a. Num a => a -> a -> a
* Double
area)) forall a. Num a => a -> a -> a
* (Double
harmonic forall a. Fractional a => a -> a -> a
/ (Double
2 forall a. Num a => a -> a -> a
* Double
length))
    where
    length :: Double
length = Double
0.648 -- about the same
    tension :: Double
tension = Double -> Double
tensionKgToN Double
7.36 -- 72.13 n, but model uses 49.2
    density :: Double
density = Double
7500
    area :: Double
area = forall a. Floating a => a -> a
hexArea (Double
guage forall a. Fractional a => a -> a -> a
/ Double
2)
    guage :: Double
guage = Double
0.254 forall a. Fractional a => a -> a -> a
/ Double
1000 -- about the same

tensionKgToN :: Double -> Double
tensionKgToN = (forall a. Num a => a -> a -> a
*Double
g)
    where g :: Double
g = Double
9.8

hexArea :: a -> a
hexArea a
r = (a
3 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sqrt a
3) forall a. Fractional a => a -> a -> a
/ a
2 forall a. Num a => a -> a -> a
* a
rforall a b. (Num a, Integral b) => a -> b -> a
^Integer
2

-- I get 155, which is much lower than freq 1, at 369.
freqStiffness :: Double -> Double
freqStiffness Double
harmonic = forall a. Floating a => a -> a
sqrt forall a b. (a -> b) -> a -> b
$
    (Double
tension forall a. Fractional a => a -> a -> a
/ (Double
density forall a. Num a => a -> a -> a
* Double
area)) forall a. Num a => a -> a -> a
* (Double
harmonic forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
* Double
length)forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2
    forall a. Num a => a -> a -> a
+ ((Double
young forall a. Num a => a -> a -> a
* Double
moi) forall a. Fractional a => a -> a -> a
/ (Double
density forall a. Num a => a -> a -> a
* Double
area))
        forall a. Num a => a -> a -> a
* ((Double
harmonicforall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi) forall a. Fractional a => a -> a -> a
/ (Double
2 forall a. Num a => a -> a -> a
* Double
lengthforall a b. (Num a, Integral b) => a -> b -> a
^Integer
2))forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2
    where
    young :: Double
young = Double
steelYoung
    steelYoung :: Double
steelYoung = Double
200e9
    -- cross-sectional moment of inertia
    moi :: Double
moi = Double -> Double
moiHex Double
radius

    length :: Double
length = Double
0.648 -- about the same
    tension :: Double
tension = Double -> Double
tensionKgToN Double
7.36 -- 72.13 n, but model uses 49.2
    density :: Double
density = Double
7500
    area :: Double
area = forall a. Floating a => a -> a
hexArea Double
radius
    radius :: Double
radius = Double
guage forall a. Fractional a => a -> a -> a
/ Double
2
    guage :: Double
guage = Double
0.254 forall a. Fractional a => a -> a -> a
/ Double
1000 -- about the same

moiCircle :: Double -> Double
moiCircle :: Double -> Double
moiCircle Double
r = (forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
4) forall a. Num a => a -> a -> a
* Double
rforall a b. (Num a, Integral b) => a -> b -> a
^Integer
4

moiHex :: Double -> Double
moiHex :: Double -> Double
moiHex Double
r = (Double
5 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sqrt Double
3) forall a. Fractional a => a -> a -> a
/ Double
16 forall a. Num a => a -> a -> a
* Double
rforall a b. (Num a, Integral b) => a -> b -> a
^Integer
4

-- rho = density

-- massOf len radius density = pi * radius^2 * len * density
--
-- fOf t mass len = sqrt (t / (mass / len)) / (2 * len)