{-|
Module      : SymbolicTime
Description : Converts real time and tempo into symbolic time
Copyright   : (c) Simon Archipoff, David Janin, 2016
License     : see the LICENSE file in the distribution
Maintainer  : janin@labri.fr
Stability   : experimental

-}

-- {-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}

module Runtime.SymbolicTime where
import Data.Function (on)
import Data.Ratio
import Control.Monad.State.Strict
import Text.Printf

import Reactive.TimeStamp

data BPM = BPM {getBPM :: Integer} deriving (Show)

-- | A big integer
quartersSubdiv :: Integer
quartersSubdiv = 2*2*2*3*3*3*5*7*11*17 :: Integer -- it should behave properly when divided 
data Quarters = Quarters {getQuarters :: Integer } deriving ( Eq, Ord)

instance Show Quarters where
  show (Quarters q) = "(Quarters " ++ (printf "%.2f" $ ((fromInteger q / fromInteger quartersSubdiv) :: Float)) ++ ")"

-- | Unit in quarters
oneQuarter :: Quarters
oneQuarter = Quarters quartersSubdiv

instance Num Quarters where
  (+) a b     = Quarters $ ((+) `on` getQuarters) a b
  (*) a b     = Quarters $ (div `on` getQuarters) (Quarters $ ((*) `on` getQuarters) a b) oneQuarter
  negate      = Quarters . negate . getQuarters 
  abs         = Quarters . abs . getQuarters
  signum      = Quarters . signum . getQuarters
  fromInteger = Quarters . (*quartersSubdiv)


instance Fractional Quarters where
  (Quarters a) / (Quarters b) = Quarters $ ((quartersSubdiv * a) `div` b)
  fromRational q = Quarters $ (round (q * fromInteger quartersSubdiv))

quartersInitState :: (TimeStamp Integer, TimeStamp (Ratio Integer))
quartersInitState = (TimeStamp 0, TimeStamp 0)

nsToQuarters :: (TimeStamp Integer, BPM) -> State (TimeStamp Integer,TimeStamp (Ratio Integer)) (TimeStamp Quarters)
--           st in nano sec              ^ last ts     ^ last ts in Quarters (exact value)
nsToQuarters (TimeStamp ns, (BPM bpm)) =
  do (TimeStamp lastns, TimeStamp lastquarters) <- get
     let bpns :: Rational
         bpns = bpm % (60 * 10^9)
         n = bpns * fromInteger (ns - lastns)
         q = n * fromInteger quartersSubdiv
         nowquarters = lastquarters + q
     put (TimeStamp ns, TimeStamp nowquarters)
     return $ TimeStamp . Quarters . floor $ nowquarters