{-|
Module      : Tempi
Description : Various functions over tiles
Copyright   : (c) David Janin, Simon Archipoff, 2016
License     : see the LICENSE file in the distribution
Maintainer  : janin@labri.fr
Stability   : experimental


Various functions over tiles 

-}

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

{-# LANGUAGE TypeSynonymInstances,
             FlexibleInstances,
             MultiParamTypeClasses,
             FlexibleContexts #-}

module TScore.Tempi where

import Tile.Tile
import Tile.QList
import Tile.Tilable
    
import Debug.Trace
myTrace :: [Char] -> a -> a
myTrace w a = seq  (trace w ()) a


-- | Generates a click from a tile. Should end with the end of the tile.
clockT :: (Show v, Show d, Fractional d, Eq d, Lattice d) =>
                Rational -> Tile d iv v -> Tile d iv Rational
clockT p t = case compare 0 p of
               LT -> makeClockT (0,p) t
               _ -> error "clockT : click period must be strictly positive"
    where makeClockT (d,p) t' =
              let t = unfoldNowT t'
              in case t of
                   (Tile _ _ QEnd) -> 0
                   _ -> let pr = fromRational p
                        in re[0*fromValueT d + fromDurationT pr + recT makeClockT (d + p,p) (dropD pr t)]


t0 :: Tile Rational Rational Rational
t0 = re[fromDurationT 5 + fromValueT 1]