StaccatoEnvelopes.hs

import Graphics.Dynamic.Plot.R2
import Data.Function

type Time = Double
type Duration = Time
type RMS = Double

pianoShape :: Duration -> Time -> RMS
pianoShape len t
  | t<0        = 0
  | t<d        = exp (-t/2)
  | otherwise  = exp (-d/2) * exp (-30*(t-d))
 where d = len * 7/8

data Articulation = Normal | Stacc

violinShape :: Articulation -> Duration -> Time -> RMS
violinShape artic len t
  | t<0        = 0
  | t<atk      = (1 + scratchiness * sin (300 * t)) * (1 - (1-t/atk)^2)
  | t<d        = 1
  | t<len      = exp (-dcr*(t-d)^2)
  | otherwise  = exp (-dcr*(t-d)^2) * exp (-400*(t-len)^2)
 where atk = case artic of
        Normal -> d/3
        Stacc -> d/2
       d = case artic of
        Normal -> len * 1/2
        Stacc -> len * 1/12
       dcr = case artic of
        Normal -> 2 / sqrt len
        Stacc -> 3 / len
       scratchiness = case artic of
        Normal -> 0.01
        Stacc -> 0.1

main :: IO ()
main = do
  plotWindow [ xAxisLabel "𝑡 in 𝅘𝅥   "
             , yAxisLabel "RMS"
             , xInterval (0,1)
             , yInterval (0,1)
          -- , continFnPlot (pianoShape 0.5) & legendName "𝅘𝅥𝅮   (pno)"
          -- , continFnPlot (pianoShape 1) & legendName "𝅘𝅥   (pno)"
             , continFnPlot (violinShape Normal 0.5) & legendName "𝅘𝅥𝅮   (vln)"
             , continFnPlot (violinShape Normal 1) & legendName "𝅘𝅥   (vln)"
             , continFnPlot (violinShape Stacc 1) & legendName "𝅘𝅥 𝅼   (vln)"
             ]
  plotWindow [ xAxisLabel "𝑡 in 𝅘𝅥   "
             , yAxisLabel "RMS"
             , xInterval (0,3)
             , yInterval (0,2)
             , continFnPlot (\t -> 1 + maximum
                                 [ violinShape Normal 0.5 t
                                 , violinShape Normal 0.5 (t-1)
                                 , violinShape Normal 0.5 (t-1.5)
                                 , violinShape Normal 0.5 (t-2.5)
                                 ]) & legendName "𝅘𝅥𝅮   𝄾  𝅘𝅥𝅮   𝅘𝅥𝅮   𝄾  𝅘𝅥𝅮   "
             , continFnPlot (\t -> maximum
                                 [ violinShape Stacc 1 t
                                 , violinShape Normal 0.5 (t-1)
                                 , violinShape Stacc 1 (t-1.5)
                                 , violinShape Normal 0.5 (t-2.5)
                                 ]) & legendName " 𝅼𝅘𝅥   𝅘𝅥𝅮   𝅘𝅥 𝅼   𝅘𝅥𝅮    "
             ]
  return ()

https://music.stackexchange.com/a/114970/932