-- 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.Multiplate where
import qualified Data.Set as Set
import qualified Data.Text as Text

import qualified Util.Lists as Lists

import           Global
import           Ness.Global


renderAll :: SamplingRate -> (Instrument, Score) -> (Text, Text)
renderAll :: SamplingRate -> (Instrument, Score) -> (Text, Text)
renderAll SamplingRate
sr (Instrument
instrument, Score
score) =
    (SamplingRate -> Instrument -> Text
renderInstrument SamplingRate
sr Instrument
instrument, forall a. Render a => a -> Text
render Score
score)

verify :: Instrument -> Score -> [Text]
verify :: Instrument -> Score -> [Text]
verify Instrument
instrument Score
score =
    forall a b. (a -> b) -> [a] -> [b]
map (Text
"duplicate object name: "<>) [Text]
duplicates
        forall a. [a] -> [a] -> [a]
++ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Strike -> Maybe Text
strike (Score -> [Strike]
sStrikes Score
score)
    where
    (Set Text
objects, [Text]
duplicates) = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst) 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 (Instrument -> [Text]
iObjects Instrument
instrument)
    strike :: Strike -> Maybe Text
strike Strike
s
        | Strike -> Text
sObject Strike
s forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
objects =
            forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text
"strike at " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty (Strike -> Meters
sStart Strike
s) forall a. Semigroup a => a -> a -> a
<> Text
": unknown object "
                forall a. Semigroup a => a -> a -> a
<> Strike -> Text
sObject Strike
s
        | Bool
otherwise = forall a. Maybe a
Nothing

-- * instrument

data Instrument = Instrument {
    Instrument -> Text
iName :: Text
    , Instrument -> Bool
iNormalize :: Bool
    , Instrument -> Airbox
iAirbox :: Airbox
    , Instrument -> [Plate]
iPlates :: [Plate]
    , Instrument -> [Membrane]
iMembranes :: [Membrane]
    , Instrument -> [Drumshell]
iDrumshells :: [Drumshell]
    } 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, SamplingRate -> Instrument -> ShowS
[Instrument] -> ShowS
Instrument -> String
forall a.
(SamplingRate -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instrument] -> ShowS
$cshowList :: [Instrument] -> ShowS
show :: Instrument -> String
$cshow :: Instrument -> String
showsPrec :: SamplingRate -> Instrument -> ShowS
$cshowsPrec :: SamplingRate -> Instrument -> ShowS
Show)

iObjects :: Instrument -> [Text]
iObjects :: Instrument -> [Text]
iObjects Instrument
i = forall a b. (a -> b) -> [a] -> [b]
map Plate -> Text
pName (Instrument -> [Plate]
iPlates Instrument
i) forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Membrane -> Text
mName (Instrument -> [Membrane]
iMembranes Instrument
i)

renderInstrument :: SamplingRate -> Instrument -> Text
renderInstrument :: SamplingRate -> Instrument -> Text
renderInstrument SamplingRate
sr
        (Instrument Text
_ Bool
normalize Airbox
airbox [Plate]
plates [Membrane]
membranes [Drumshell]
drumshells) =
    [Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [ Text
"# mpversion 0.1"
          , Text
"samplerate " forall a. Semigroup a => a -> a -> a
<> forall a. Render a => a -> Text
render SamplingRate
sr
          , Text
"normalise_outs " forall a. Semigroup a => a -> a -> a
<> forall a. Render a => a -> Text
render Bool
normalize
          , forall a. Render a => a -> Text
render Airbox
airbox
          ]
        , forall a b. (a -> b) -> [a] -> [b]
map forall a. Render a => a -> Text
render [Plate]
plates
        , forall a b. (a -> b) -> [a] -> [b]
map forall a. Render a => a -> Text
render (Airbox -> [AirboxOutput]
aOutputs Airbox
airbox)
        , [Plate] -> [Text]
renderPlateOutputs [Plate]
plates
        , forall a b. (a -> b) -> [a] -> [b]
map forall a. Render a => a -> Text
render [Membrane]
membranes
        , forall a b. (a -> b) -> [a] -> [b]
map forall a. Render a => a -> Text
render [Drumshell]
drumshells
        ]

{- | • airbox defines the dimensions and other parameters of the airbox.
    Parameters are the width, the depth, the height, c_a and rho_a. Only one
    airbox can be defined currently.
-}
data Airbox = Airbox {
    Airbox -> Meters
aWidth, Airbox -> Meters
aDepth, Airbox -> Meters
aHeight :: Meters
    , Airbox -> Meters
aC_a, Airbox -> Meters
aRho_a :: Double
    , Airbox -> [AirboxOutput]
aOutputs :: [AirboxOutput]
    } deriving (Airbox -> Airbox -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Airbox -> Airbox -> Bool
$c/= :: Airbox -> Airbox -> Bool
== :: Airbox -> Airbox -> Bool
$c== :: Airbox -> Airbox -> Bool
Eq, Eq Airbox
Airbox -> Airbox -> Bool
Airbox -> Airbox -> Ordering
Airbox -> Airbox -> Airbox
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 :: Airbox -> Airbox -> Airbox
$cmin :: Airbox -> Airbox -> Airbox
max :: Airbox -> Airbox -> Airbox
$cmax :: Airbox -> Airbox -> Airbox
>= :: Airbox -> Airbox -> Bool
$c>= :: Airbox -> Airbox -> Bool
> :: Airbox -> Airbox -> Bool
$c> :: Airbox -> Airbox -> Bool
<= :: Airbox -> Airbox -> Bool
$c<= :: Airbox -> Airbox -> Bool
< :: Airbox -> Airbox -> Bool
$c< :: Airbox -> Airbox -> Bool
compare :: Airbox -> Airbox -> Ordering
$ccompare :: Airbox -> Airbox -> Ordering
Ord, SamplingRate -> Airbox -> ShowS
[Airbox] -> ShowS
Airbox -> String
forall a.
(SamplingRate -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Airbox] -> ShowS
$cshowList :: [Airbox] -> ShowS
show :: Airbox -> String
$cshow :: Airbox -> String
showsPrec :: SamplingRate -> Airbox -> ShowS
$cshowsPrec :: SamplingRate -> Airbox -> ShowS
Show)

instance Render Airbox where
    render :: Airbox -> Text
render = [Text] -> Text
Text.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"airbox":) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Render a => a -> Text
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. Airbox -> [Meters]
list
        where
        list :: Airbox -> [Meters]
list (Airbox Meters
width Meters
depth Meters
height Meters
ca Meters
rhoa [AirboxOutput]
_) =
            [Meters
width, Meters
depth, Meters
height, Meters
ca, Meters
rhoa]

{- | • airbox output defines an output taken from within the airbox. The
    parameters are its X, Y and Z position.
-}
data AirboxOutput = AirboxOutput { AirboxOutput -> Meters
aoX, AirboxOutput -> Meters
aoY, AirboxOutput -> Meters
aoZ :: Meters }
    deriving (AirboxOutput -> AirboxOutput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AirboxOutput -> AirboxOutput -> Bool
$c/= :: AirboxOutput -> AirboxOutput -> Bool
== :: AirboxOutput -> AirboxOutput -> Bool
$c== :: AirboxOutput -> AirboxOutput -> Bool
Eq, Eq AirboxOutput
AirboxOutput -> AirboxOutput -> Bool
AirboxOutput -> AirboxOutput -> Ordering
AirboxOutput -> AirboxOutput -> AirboxOutput
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 :: AirboxOutput -> AirboxOutput -> AirboxOutput
$cmin :: AirboxOutput -> AirboxOutput -> AirboxOutput
max :: AirboxOutput -> AirboxOutput -> AirboxOutput
$cmax :: AirboxOutput -> AirboxOutput -> AirboxOutput
>= :: AirboxOutput -> AirboxOutput -> Bool
$c>= :: AirboxOutput -> AirboxOutput -> Bool
> :: AirboxOutput -> AirboxOutput -> Bool
$c> :: AirboxOutput -> AirboxOutput -> Bool
<= :: AirboxOutput -> AirboxOutput -> Bool
$c<= :: AirboxOutput -> AirboxOutput -> Bool
< :: AirboxOutput -> AirboxOutput -> Bool
$c< :: AirboxOutput -> AirboxOutput -> Bool
compare :: AirboxOutput -> AirboxOutput -> Ordering
$ccompare :: AirboxOutput -> AirboxOutput -> Ordering
Ord, SamplingRate -> AirboxOutput -> ShowS
[AirboxOutput] -> ShowS
AirboxOutput -> String
forall a.
(SamplingRate -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AirboxOutput] -> ShowS
$cshowList :: [AirboxOutput] -> ShowS
show :: AirboxOutput -> String
$cshow :: AirboxOutput -> String
showsPrec :: SamplingRate -> AirboxOutput -> ShowS
$cshowsPrec :: SamplingRate -> AirboxOutput -> ShowS
Show)

instance Render AirboxOutput where
    render :: AirboxOutput -> Text
render = [Text] -> Text
Text.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"airbox_output":) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Render a => a -> Text
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. AirboxOutput -> [Meters]
list
        where list :: AirboxOutput -> [Meters]
list (AirboxOutput Meters
x Meters
y Meters
z) = [Meters
x, Meters
y, Meters
z]

{- | • plate defines a plate within the airbox. The first parameter is a name
    for the plate which must be a unique string and is used to refer to it for
    the purposes of outputs and strikes. The numeric parameters are size X,
    size Y, centre X, centre Y, centre Z, rho, H, E, nu, T60, sig1.
-}
data Plate = Plate {
    Plate -> Text
pName :: Text
    , Plate -> (Meters, Meters)
pSize :: (Meters, Meters)
    , Plate -> (Meters, Meters, Meters)
pCenter :: (Meters, Meters, Meters)
    , Plate -> Material
pMaterial :: Material
    , Plate -> [PlateOutput]
pOutputs :: [PlateOutput]
    } deriving (Plate -> Plate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Plate -> Plate -> Bool
$c/= :: Plate -> Plate -> Bool
== :: Plate -> Plate -> Bool
$c== :: Plate -> Plate -> Bool
Eq, Eq Plate
Plate -> Plate -> Bool
Plate -> Plate -> Ordering
Plate -> Plate -> Plate
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 :: Plate -> Plate -> Plate
$cmin :: Plate -> Plate -> Plate
max :: Plate -> Plate -> Plate
$cmax :: Plate -> Plate -> Plate
>= :: Plate -> Plate -> Bool
$c>= :: Plate -> Plate -> Bool
> :: Plate -> Plate -> Bool
$c> :: Plate -> Plate -> Bool
<= :: Plate -> Plate -> Bool
$c<= :: Plate -> Plate -> Bool
< :: Plate -> Plate -> Bool
$c< :: Plate -> Plate -> Bool
compare :: Plate -> Plate -> Ordering
$ccompare :: Plate -> Plate -> Ordering
Ord, SamplingRate -> Plate -> ShowS
[Plate] -> ShowS
Plate -> String
forall a.
(SamplingRate -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Plate] -> ShowS
$cshowList :: [Plate] -> ShowS
show :: Plate -> String
$cshow :: Plate -> String
showsPrec :: SamplingRate -> Plate -> ShowS
$cshowsPrec :: SamplingRate -> Plate -> ShowS
Show)

instance Render Plate where
    render :: Plate -> Text
render Plate
plate =
        [Text] -> Text
Text.unwords forall a b. (a -> b) -> a -> b
$ Text
"plate" forall a. a -> [a] -> [a]
: Plate -> Text
pName Plate
plate forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Render a => a -> Text
render (Plate -> [Meters]
list Plate
plate)
        where
        list :: Plate -> [Meters]
list (Plate Text
_ (Meters
sx, Meters
sy) (Meters
cx, Meters
cy, Meters
cz) (Material Meters
rho Meters
h Meters
e Meters
nu Meters
t60 Meters
sig1) [PlateOutput]
_) =
            [Meters
sx, Meters
sy, Meters
cx, Meters
cy, Meters
cz, Meters
rho, Meters
h, Meters
e, Meters
nu, Meters
t60, Meters
sig1]

data Material = Material {
    Material -> Meters
mRho, Material -> Meters
mH, Material -> Meters
mE, Material -> Meters
mNu, Material -> Meters
mT60, Material -> Meters
mSig1 :: 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, SamplingRate -> Material -> ShowS
[Material] -> ShowS
Material -> String
forall a.
(SamplingRate -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Material] -> ShowS
$cshowList :: [Material] -> ShowS
show :: Material -> String
$cshow :: Material -> String
showsPrec :: SamplingRate -> Material -> ShowS
$cshowsPrec :: SamplingRate -> Material -> ShowS
Show)

{- | • plate output defines an output taken from a plate. The parameters are
    the name of the plate and the X and Y position for the output. The position
    values are normalised to the range -1 to +1.
-}
data PlateOutput = PlateOutput { PlateOutput -> Meters
poX, PlateOutput -> Meters
poY :: Meters } deriving (PlateOutput -> PlateOutput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlateOutput -> PlateOutput -> Bool
$c/= :: PlateOutput -> PlateOutput -> Bool
== :: PlateOutput -> PlateOutput -> Bool
$c== :: PlateOutput -> PlateOutput -> Bool
Eq, Eq PlateOutput
PlateOutput -> PlateOutput -> Bool
PlateOutput -> PlateOutput -> Ordering
PlateOutput -> PlateOutput -> PlateOutput
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 :: PlateOutput -> PlateOutput -> PlateOutput
$cmin :: PlateOutput -> PlateOutput -> PlateOutput
max :: PlateOutput -> PlateOutput -> PlateOutput
$cmax :: PlateOutput -> PlateOutput -> PlateOutput
>= :: PlateOutput -> PlateOutput -> Bool
$c>= :: PlateOutput -> PlateOutput -> Bool
> :: PlateOutput -> PlateOutput -> Bool
$c> :: PlateOutput -> PlateOutput -> Bool
<= :: PlateOutput -> PlateOutput -> Bool
$c<= :: PlateOutput -> PlateOutput -> Bool
< :: PlateOutput -> PlateOutput -> Bool
$c< :: PlateOutput -> PlateOutput -> Bool
compare :: PlateOutput -> PlateOutput -> Ordering
$ccompare :: PlateOutput -> PlateOutput -> Ordering
Ord, SamplingRate -> PlateOutput -> ShowS
[PlateOutput] -> ShowS
PlateOutput -> String
forall a.
(SamplingRate -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlateOutput] -> ShowS
$cshowList :: [PlateOutput] -> ShowS
show :: PlateOutput -> String
$cshow :: PlateOutput -> String
showsPrec :: SamplingRate -> PlateOutput -> ShowS
$cshowsPrec :: SamplingRate -> PlateOutput -> ShowS
Show)

renderPlateOutputs :: [Plate] -> [Text]
renderPlateOutputs :: [Plate] -> [Text]
renderPlateOutputs [Plate]
plates =
    [ [Text] -> Text
Text.unwords [Text
"plate_output", Plate -> Text
pName Plate
plate, forall a. Render a => a -> Text
render Meters
x, forall a. Render a => a -> Text
render Meters
y]
    | Plate
plate <- [Plate]
plates
    , PlateOutput Meters
x Meters
y <- Plate -> [PlateOutput]
pOutputs Plate
plate
    ]

{- | • membrane defines a circular drum membrane within the airbox. The first
    parameter is a name for the membrane which must be a unique string and is
    used to refer to it for the purposes of outputs and strikes. The numeric
    parameters are the radius, centre X, centre Y, centre Z, rho, H, T, E, nu,
    T60 and sig1.
-}
data Membrane = Membrane {
    Membrane -> Text
mName :: Text
    , Membrane -> Meters
mRadius :: Meters
    , Membrane -> (Meters, Meters, Meters)
mCenter :: (Meters, Meters, Meters)
    , Membrane -> Material
mMaterial :: Material
    , Membrane -> Meters
mT :: Double
    } deriving (Membrane -> Membrane -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Membrane -> Membrane -> Bool
$c/= :: Membrane -> Membrane -> Bool
== :: Membrane -> Membrane -> Bool
$c== :: Membrane -> Membrane -> Bool
Eq, Eq Membrane
Membrane -> Membrane -> Bool
Membrane -> Membrane -> Ordering
Membrane -> Membrane -> Membrane
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 :: Membrane -> Membrane -> Membrane
$cmin :: Membrane -> Membrane -> Membrane
max :: Membrane -> Membrane -> Membrane
$cmax :: Membrane -> Membrane -> Membrane
>= :: Membrane -> Membrane -> Bool
$c>= :: Membrane -> Membrane -> Bool
> :: Membrane -> Membrane -> Bool
$c> :: Membrane -> Membrane -> Bool
<= :: Membrane -> Membrane -> Bool
$c<= :: Membrane -> Membrane -> Bool
< :: Membrane -> Membrane -> Bool
$c< :: Membrane -> Membrane -> Bool
compare :: Membrane -> Membrane -> Ordering
$ccompare :: Membrane -> Membrane -> Ordering
Ord, SamplingRate -> Membrane -> ShowS
[Membrane] -> ShowS
Membrane -> String
forall a.
(SamplingRate -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Membrane] -> ShowS
$cshowList :: [Membrane] -> ShowS
show :: Membrane -> String
$cshow :: Membrane -> String
showsPrec :: SamplingRate -> Membrane -> ShowS
$cshowsPrec :: SamplingRate -> Membrane -> ShowS
Show)

instance Render Membrane where
    render :: Membrane -> Text
render Membrane
m = [Text] -> Text
Text.unwords forall a b. (a -> b) -> a -> b
$ Text
"membrane" forall a. a -> [a] -> [a]
: Membrane -> Text
mName Membrane
m forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Render a => a -> Text
render (Membrane -> [Meters]
list Membrane
m)
        where
        list :: Membrane -> [Meters]
list (Membrane Text
_ Meters
radius (Meters
cx, Meters
cy, Meters
cz) (Material Meters
rho Meters
h Meters
e Meters
nu Meters
t60 Meters
sig1) Meters
t) =
            [Meters
radius, Meters
cx, Meters
cy, Meters
cz, Meters
rho, Meters
h, Meters
t, Meters
e, Meters
nu, Meters
t60, Meters
sig1]

{- | • drumshell defines a cylindrical drum shell that acts as a barrier within
    the airbox. The first parameter is a name for the drum shell which must be
    a unique string. The numeric parameters are centre X, centre Y, bottom Z,
    radius and shell height.
-}
data Drumshell = Drumshell {
    Drumshell -> Text
dName :: Text
    , Drumshell -> (Meters, Meters)
dCenter :: (Meters, Meters)
    , Drumshell -> Meters
dBottomZ :: Meters
    , Drumshell -> Meters
dRadius :: Meters
    , Drumshell -> Meters
dHeight :: Meters
    } deriving (Drumshell -> Drumshell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Drumshell -> Drumshell -> Bool
$c/= :: Drumshell -> Drumshell -> Bool
== :: Drumshell -> Drumshell -> Bool
$c== :: Drumshell -> Drumshell -> Bool
Eq, Eq Drumshell
Drumshell -> Drumshell -> Bool
Drumshell -> Drumshell -> Ordering
Drumshell -> Drumshell -> Drumshell
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 :: Drumshell -> Drumshell -> Drumshell
$cmin :: Drumshell -> Drumshell -> Drumshell
max :: Drumshell -> Drumshell -> Drumshell
$cmax :: Drumshell -> Drumshell -> Drumshell
>= :: Drumshell -> Drumshell -> Bool
$c>= :: Drumshell -> Drumshell -> Bool
> :: Drumshell -> Drumshell -> Bool
$c> :: Drumshell -> Drumshell -> Bool
<= :: Drumshell -> Drumshell -> Bool
$c<= :: Drumshell -> Drumshell -> Bool
< :: Drumshell -> Drumshell -> Bool
$c< :: Drumshell -> Drumshell -> Bool
compare :: Drumshell -> Drumshell -> Ordering
$ccompare :: Drumshell -> Drumshell -> Ordering
Ord, SamplingRate -> Drumshell -> ShowS
[Drumshell] -> ShowS
Drumshell -> String
forall a.
(SamplingRate -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Drumshell] -> ShowS
$cshowList :: [Drumshell] -> ShowS
show :: Drumshell -> String
$cshow :: Drumshell -> String
showsPrec :: SamplingRate -> Drumshell -> ShowS
$cshowsPrec :: SamplingRate -> Drumshell -> ShowS
Show)

instance Render Drumshell where
    render :: Drumshell -> Text
render Drumshell
d = [Text] -> Text
Text.unwords forall a b. (a -> b) -> a -> b
$ Text
"drumshell" forall a. a -> [a] -> [a]
: Drumshell -> Text
dName Drumshell
d forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Render a => a -> Text
render (Drumshell -> [Meters]
list Drumshell
d)
        where
        list :: Drumshell -> [Meters]
list (Drumshell Text
_ (Meters
cx, Meters
cy) Meters
bz Meters
radius Meters
height) =
            [Meters
cx, Meters
cy, Meters
bz, Meters
radius, Meters
height]

{- |
    • bassdrum defines a bass drum embedded in an airbox. This is just
    a shortcut for defining an airbox, a drum shell and two identical drum
    membranes in one go. The drum is centred within the airbox. The parameters
    are: airbox width, airbox depth, airbox height, c a, rho a, drum shell
    height, drum radius, membrane rho, H, T, E, nu, T60, sig1. For the purposes
    of adding strikes and taking outputs, the top membrane is named ’drumtop’
    and the bottom one ’drumbottom’.
-}

-- * score

data Score = Score {
    Score -> Meters
sDecay :: Seconds
    , Score -> [Strike]
sStrikes :: [Strike]
    } 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, SamplingRate -> Score -> ShowS
[Score] -> ShowS
Score -> String
forall a.
(SamplingRate -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Score] -> ShowS
$cshowList :: [Score] -> ShowS
show :: Score -> String
$cshow :: Score -> String
showsPrec :: SamplingRate -> Score -> ShowS
$cshowsPrec :: SamplingRate -> Score -> ShowS
Show)

instance Render Score where
    render :: Score -> Text
render (Score Meters
decay [Strike]
strikes) = [Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$
        Text
"duration " forall a. Semigroup a => a -> a -> a
<> forall a. Render a => a -> Text
render (Meters
end forall a. Num a => a -> a -> a
+ Meters
decay) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Render a => a -> Text
render [Strike]
strikes
        where
        end :: Meters
end = forall a. a -> Maybe a -> a
fromMaybe Meters
0 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Maybe a
Lists.maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Strike -> Meters
sStart [Strike]
strikes

-- | Probably Newtons?
type Force = Double

{- | The first parameter of a strike is the start time. The other parameters
    are the name of the plate, the X position, the Y position, the duration,
    and the maximum force. The position values are normalised to the range 0-1.
-}
data Strike = Strike {
    Strike -> Text
sObject :: Text
    , Strike -> Meters
sStart :: Seconds
    , Strike -> Meters
sDuration :: Seconds
    , Strike -> (Meters, Meters)
sPosition :: (Meters, Meters)
    , Strike -> Meters
sForce :: Force
    } 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, SamplingRate -> Strike -> ShowS
[Strike] -> ShowS
Strike -> String
forall a.
(SamplingRate -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Strike] -> ShowS
$cshowList :: [Strike] -> ShowS
show :: Strike -> String
$cshow :: Strike -> String
showsPrec :: SamplingRate -> Strike -> ShowS
$cshowsPrec :: SamplingRate -> Strike -> ShowS
Show)

instance Render Strike where
    render :: Strike -> Text
render (Strike Text
name Meters
start Meters
dur (Meters
x, Meters
y) Meters
force) = [Text] -> Text
Text.unwords
        [ Text
"strike", forall a. Render a => a -> Text
render Meters
start, Text
name, forall a. Render a => a -> Text
render Meters
x, forall a. Render a => a -> Text
render Meters
y
        , forall a. Render a => a -> Text
render Meters
dur, forall a. Render a => a -> Text
render Meters
force
        ]