music-score-1.9.0: src/Music/Time/Note.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
-------------------------------------------------------------------------------------
-- |
-- Copyright : (c) Hans Hoglund 2012-2014
--
-- License : BSD-style
--
-- Maintainer : hans@hanshoglund.se
-- Stability : experimental
-- Portability : non-portable (TF,GNTD)
--
-------------------------------------------------------------------------------------
module Music.Time.Note (
-- * Note type
Note,
-- * Construction
note,
notee,
durationNote,
-- noteComplement,
) where
import Control.Applicative
import Control.Lens hiding (Indexable, Level, above,
below, index, inside, parts,
reversed, transform, (<|), (|>))
import Data.Bifunctor
import Data.Foldable (Foldable)
import qualified Data.Foldable as Foldable
import Data.Functor.Couple
import Data.String
import Data.Typeable
import Data.VectorSpace
import Data.Aeson (ToJSON (..))
import qualified Data.Aeson as JSON
import Music.Dynamics.Literal
import Music.Pitch.Literal
import Music.Time.Internal.Util (dependingOn)
import Music.Time.Juxtapose
-- |
-- A value 'Note' value, representing a suspended stretch of some 'Transformable'
-- value. We can access the value in bothits original and note form using 'note'
-- and 'notee', respectively.
--
-- Placing a value inside 'Note' makes it invariant under 'delay', however the inner
-- value can still be delayed using @'fmap' 'delay'@.
--
newtype Note a = Note { getNote :: Duration `Couple` a }
deriving (Eq, Ord, Typeable, Foldable, Traversable,
Functor, Applicative, Monad,
Num, Fractional, Floating, Real, RealFrac)
instance (Show a, Transformable a) => Show (Note a) where
show x = show (x^.from note) ++ "^.note"
instance Wrapped (Note a) where
type Unwrapped (Note a) = (Duration, a)
_Wrapped' = iso (getCouple . getNote) (Note . Couple)
instance Rewrapped (Note a) (Note b)
instance Transformable (Note a) where
transform t = over (from note . _1) (transform t)
instance HasDuration (Note a) where
_duration = _duration . view (from note)
{-
Splitting a note is surprisingly difficult because of the recursive nature of split.
In brief, when splitting (d,(x,a)^.note)^.note at t, we have to split the inner value x at (t/d),
and then scale the results xa and xb by some values p and q such that the duration of the new
nested notes (da*xa) and (db*xb) is the duration of the original nested note (d*x), as stated
by the Splittable laws.
Full derivation below.
-----
split t d = (da+db)
split (t/d) x = (xa*p+xb*q)
split t (d*x) = (da*xa+db*xb)
d = da+db [split laws]
x = (xa*p+xb*q) [split laws]
d*x = da*xa+db*xb [split laws]
Isolate p and q!
xa*p + xb*q = x
xa*p = x - xb*q
p = (x - xb*q)/xa
xa*p + xb*q = x
xb*q = x - xa*p
q = (x - xa*p)/xb
-- Assuming we know t, d, x, xa*p, xb*q, da*xa, db*xb
xa = da*xa/da
xb = db*xb/db
-- Example
t = 0.6, d = 1, x = 2
da = 0.6, db = 0.4
[split t d]
xa*p = 3/5, xb*q = 7/5,
[split (t/d) x]
da*xa = 3/5, db*xb = 7/5
[split t (d*x)]
xb = (7/5)/0.4 = 3.5
[db*xb/db = xb]
xa = (3/5)/0.6 = 1
[da*xa/da = xa]
p = (2 - 7/5) / 1 = 0.6
[p def]
q = (2 - 3/5) / 3.5 = 0.4
[q def]
>>> split 0.6 (1,(2,_)^.note)^.note -- 2
( (0.6,(1,a)^.note)^.note -- da*xa
, (0.4,(3.5,mempty)^.note)^.note -- db*xb
-}
instance (Splittable a, Transformable a) => Splittable (Note a) where
split t ((^.from note) -> (d, x)) = over both (^.note) $ split' t d x
split' :: (Transformable a, Splittable a) => Duration -> Duration -> a -> ((Duration, a), (Duration, a))
split' t d x = ((da, compress p xa_p), (db, compress q xb_q))
-- We are really returning ((da, xa), (db, xb))
-- However because of the polymorphic value, we must derive xa and xb from split (t/d) x, p and q
where
-- (da+db) = split t d
-- (xa*p+xb*q) = split (t/d) x
-- (da*xa+db*xb) = split t (d*x)
(da,db) = split t d
(xa_p, xb_q) = split (t/d) x
(da_xa, db_xb) = split t (d*(x^.duration))
xa = da_xa/da
xb = db_xb/db
p = ((x^.duration) - (xb_q^.duration))/xa
q = ((x^.duration) - (xa_p^.duration))/xb
instance IsString a => IsString (Note a) where
fromString = pure . fromString
instance IsPitch a => IsPitch (Note a) where
fromPitch = pure . fromPitch
instance IsInterval a => IsInterval (Note a) where
fromInterval = pure . fromInterval
instance IsDynamics a => IsDynamics (Note a) where
fromDynamics = pure . fromDynamics
instance ToJSON a => ToJSON (Note a) where
-- TODO meta
toJSON a = JSON.object [ ("duration", toJSON d), ("value", toJSON x) ]
where
(d, x) = a^.from note
-- | View a note value as a pair of the original value and a stretch factor.
note :: Iso (Duration, a) (Duration, b) (Note a) (Note b)
note = _Unwrapped
-- | Access the note value.
-- Taking a value out carries out the stretch (using the 'Transformable' instance),
-- while putting a value in carries out the reverse transformation.
--
-- >>> view notee $ (2,3::Duration)^.note
-- 6
--
-- >>> set notee 6 $ (2,1::Duration)^.note
-- (2,3)^.note
--
notee :: (Transformable a, Transformable b) => Lens (Note a) (Note b) a b
notee = _Wrapped `dependingOn` (transformed . stretching)
-- | A note value as a duration carrying an associated value.
-- Whitness by picking a trivial value.
--
-- >>> 2^.durationNote
-- (2,())^.note
--
durationNote :: Iso' Duration (Note ())
durationNote = iso (\d -> (d,())^.note) (^.duration)
-- >>> (pure ())^.from durationNote
-- 1
-- >>> (pure () :: Note ())^.duration
-- 1
-- TODO could also be an iso...
noteComplement :: Note a -> Note a
noteComplement (Note (Couple (d,x))) = Note $ Couple (negateV d, x)
-- FIXME negateV is negate not recip
-- The negateV method should follow (^+^), which is (*) for durations (is this bad?)