{-# LANGUAGE DeriveGeneric #-}
module Data.Tempo where
import Data.Time
import GHC.Generics
data Tempo = Tempo {
Tempo -> Rational
freq :: Rational,
Tempo -> UTCTime
time :: UTCTime,
Tempo -> Rational
count :: Rational
} deriving (Tempo -> Tempo -> Bool
(Tempo -> Tempo -> Bool) -> (Tempo -> Tempo -> Bool) -> Eq Tempo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tempo -> Tempo -> Bool
$c/= :: Tempo -> Tempo -> Bool
== :: Tempo -> Tempo -> Bool
$c== :: Tempo -> Tempo -> Bool
Eq,(forall x. Tempo -> Rep Tempo x)
-> (forall x. Rep Tempo x -> Tempo) -> Generic Tempo
forall x. Rep Tempo x -> Tempo
forall x. Tempo -> Rep Tempo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tempo x -> Tempo
$cfrom :: forall x. Tempo -> Rep Tempo x
Generic,Int -> Tempo -> ShowS
[Tempo] -> ShowS
Tempo -> String
(Int -> Tempo -> ShowS)
-> (Tempo -> String) -> ([Tempo] -> ShowS) -> Show Tempo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tempo] -> ShowS
$cshowList :: [Tempo] -> ShowS
show :: Tempo -> String
$cshow :: Tempo -> String
showsPrec :: Int -> Tempo -> ShowS
$cshowsPrec :: Int -> Tempo -> ShowS
Show)
origin :: Tempo -> UTCTime
origin :: Tempo -> UTCTime
origin Tempo
x = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Rational -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Rational -> NominalDiffTime) -> Rational -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Tempo -> Rational
count Tempo
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (-Rational
1) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Tempo -> Rational
freq Tempo
x) (Tempo -> UTCTime
time Tempo
x)
timeToCount :: Tempo -> UTCTime -> Rational
timeToCount :: Tempo -> UTCTime -> Rational
timeToCount Tempo
x UTCTime
t = (NominalDiffTime -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime -> Rational) -> NominalDiffTime -> Rational
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t (UTCTime -> NominalDiffTime) -> UTCTime -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Tempo -> UTCTime
time Tempo
x) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Tempo -> Rational
freq Tempo
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Tempo -> Rational
count Tempo
x
countToTime :: Tempo -> Rational -> UTCTime
countToTime :: Tempo -> Rational -> UTCTime
countToTime Tempo
x Rational
c = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Rational -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Rational -> NominalDiffTime) -> Rational -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Rational
c Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Tempo -> Rational
freq Tempo
x) (Tempo -> UTCTime
origin Tempo
x)
changeTempo :: Rational -> UTCTime -> Tempo -> Tempo
changeTempo :: Rational -> UTCTime -> Tempo -> Tempo
changeTempo Rational
f UTCTime
t Tempo
x = Tempo :: Rational -> UTCTime -> Rational -> Tempo
Tempo {
freq :: Rational
freq = Rational
f,
time :: UTCTime
time = UTCTime
t,
count :: Rational
count = Tempo -> UTCTime -> Rational
timeToCount Tempo
x UTCTime
t
}
changeTempoNow :: Rational -> Tempo -> IO Tempo
changeTempoNow :: Rational -> Tempo -> IO Tempo
changeTempoNow Rational
f Tempo
x = do
UTCTime
t <- IO UTCTime
getCurrentTime
Tempo -> IO Tempo
forall (m :: * -> *) a. Monad m => a -> m a
return (Tempo -> IO Tempo) -> Tempo -> IO Tempo
forall a b. (a -> b) -> a -> b
$ Rational -> UTCTime -> Tempo -> Tempo
changeTempo Rational
f UTCTime
t Tempo
x
findBeats :: Tempo -> UTCTime -> UTCTime -> Rational -> Rational -> [Rational]
findBeats :: Tempo -> UTCTime -> UTCTime -> Rational -> Rational -> [Rational]
findBeats Tempo
tempo UTCTime
lowerLimitUtc UTCTime
upperLimitUtc Rational
metre Rational
offset =
let lowerLimitCycles :: Rational
lowerLimitCycles = Tempo -> UTCTime -> Rational
timeToCount Tempo
tempo UTCTime
lowerLimitUtc
upperLimitCycles :: Rational
upperLimitCycles = Tempo -> UTCTime -> Rational
timeToCount Tempo
tempo UTCTime
upperLimitUtc
in Rational -> Rational -> Rational -> Rational -> [Rational]
findBeats' Rational
metre Rational
offset Rational
lowerLimitCycles Rational
upperLimitCycles
findBeats' :: Rational -> Rational -> Rational -> Rational -> [Rational]
findBeats' :: Rational -> Rational -> Rational -> Rational -> [Rational]
findBeats' Rational
metre Rational
offset Rational
lowerLimit Rational
upperLimit
| Rational -> Rational -> Rational -> Rational
nextBeat Rational
metre Rational
offset Rational
lowerLimit Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
upperLimit = []
| Bool
otherwise = Rational -> Rational -> Rational -> Rational
nextBeat Rational
metre Rational
offset Rational
lowerLimit Rational -> [Rational] -> [Rational]
forall a. a -> [a] -> [a]
: Rational -> Rational -> Rational -> Rational -> [Rational]
findBeats' Rational
metre Rational
offset (Rational
lowerLimitRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
metre) Rational
upperLimit
nextBeat :: Rational -> Rational -> Rational -> Rational
nextBeat :: Rational -> Rational -> Rational -> Rational
nextBeat Rational
metre Rational
offset Rational
lowerLimit
| Rational
metre Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 = String -> Rational
forall a. HasCallStack => String -> a
error String
"you can't have a metre of 0!!!"
| Bool
otherwise =
let fract :: a -> a
fract a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
- Integer -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor a
x :: Integer)
lowerLimitInMetre :: Rational
lowerLimitInMetre = Rational
lowerLimitRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
metre
offsetInMetre :: Rational
offsetInMetre = Rational -> Rational
forall a. RealFrac a => a -> a
fract (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
offsetRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
metre
nextBeatInMetre :: Rational
nextBeatInMetre | Rational
offsetInMetre Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= (Rational -> Rational
forall a. RealFrac a => a -> a
fract Rational
lowerLimitInMetre) = (Integer -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Rational
lowerLimitInMetre :: Integer)) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
offsetInMetre
| Bool
otherwise = (Integer -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Rational
lowerLimitInMetre :: Integer)) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
offsetInMetre
in Rational
nextBeatInMetreRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
metre