module Harmonic.Interface.Tidal.Display
( displayClock
, displayClock'
) where
import Sound.Tidal.Context
import Harmonic.Interface.Tidal.Form (IK, Kinetics(..))
displayClock :: IK -> ControlPattern
displayClock :: IK -> ControlPattern
displayClock IK
k =
let loopSecs :: Double
loopSecs = Kinetics -> Double
kLoopSecs (IK -> Kinetics
forall a b. (a, b) -> a
fst IK
k)
cpsV :: Double
cpsV = Kinetics -> Double
kCps (IK -> Kinetics
forall a b. (a, b) -> a
fst IK
k)
loopInt :: Int
loopInt = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
loopSecs :: Int
hiByte :: Double
hiByte = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
loopInt Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
128) :: Double
loByte :: Double
loByte = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
loopInt Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
128) :: Double
thruCh10 :: ControlPattern
thruCh10 = Pattern String -> ControlPattern
s Pattern String
"thru" ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
midichan Pattern Double
9
thruCh10Fast :: ControlPattern
thruCh10Fast = Pattern Time -> ControlPattern -> ControlPattern
forall a. Pattern Time -> Pattern a -> Pattern a
fast Pattern Time
30 (Pattern String -> ControlPattern
s Pattern String
"thru") ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
midichan Pattern Double
9
wholeSecs :: Int
wholeSecs = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
loopSecs :: Int
currentSecsPat :: Pattern Double
currentSecsPat = if Int
wholeSecs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Double
cpsV Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0
then (Time -> Double) -> Pattern Double
forall a. (Time -> a) -> Pattern a
sig ((Time -> Double) -> Pattern Double)
-> (Time -> Double) -> Pattern Double
forall a b. (a -> b) -> a -> b
$ \Time
t ->
let cyclesNow :: Double
cyclesNow = Time -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Time
t :: Double
secondsNow :: Double
secondsNow = Double
cyclesNow Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
cpsV
formLocalSecs :: Double
formLocalSecs = Double
secondsNow Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
secondsNow Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
loopSecs) :: Int) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
loopSecs
displayed :: Int
displayed = (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
formLocalSecs :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
displayed :: Double
else Double -> Pattern Double
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
0
secsHiPat :: Pattern Double
secsHiPat = (Double -> Double) -> Pattern Double -> Pattern Double
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Double
x -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x :: Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
128) :: Double) Pattern Double
currentSecsPat
secsLoPat :: Pattern Double
secsLoPat = (Double -> Double) -> Pattern Double -> Pattern Double
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Double
x -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x :: Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
128) :: Double) Pattern Double
currentSecsPat
in [ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
stack
[
(Pattern Time
1Pattern Time -> Pattern Time -> Pattern Time
forall a. Fractional a => a -> a -> a
/Pattern Time
64) Pattern Time -> ControlPattern -> ControlPattern
forall a. Pattern Time -> Pattern a -> Pattern a
~> (Pattern Bool -> ControlPattern -> ControlPattern
forall a. Pattern Bool -> Pattern a -> Pattern a
struct ((Int -> Bool) -> Pattern Int -> Pattern Bool
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True) (IK -> Pattern Int
forall a b. (a, b) -> b
snd IK
k)) (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$
ControlPattern
thruCh10 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
midicmd Pattern String
"control" ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
ctlNum Pattern Double
113
# control (fmap (fromIntegral . min 8) (snd k)))
, (Pattern Time
1Pattern Time -> Pattern Time -> Pattern Time
forall a. Fractional a => a -> a -> a
/Pattern Time
64) Pattern Time -> ControlPattern -> ControlPattern
forall a. Pattern Time -> Pattern a -> Pattern a
~> (Pattern Bool -> ControlPattern -> ControlPattern
forall a. Pattern Bool -> Pattern a -> Pattern a
struct ((Time -> Pattern Time
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Time
1Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
8)) Pattern Time -> Pattern Bool -> Pattern Bool
forall a. Pattern Time -> Pattern a -> Pattern a
~> (Int -> Bool) -> Pattern Int -> Pattern Bool
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True) (IK -> Pattern Int
forall a b. (a, b) -> b
snd IK
k)) (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$
ControlPattern
thruCh10 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
midicmd Pattern String
"control" ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
ctlNum Pattern Double
113 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
control Pattern Double
0)
, ControlPattern
thruCh10 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
midicmd Pattern String
"control" ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
ctlNum Pattern Double
114 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
control (Double -> Pattern Double
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
hiByte)
, ControlPattern
thruCh10 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
midicmd Pattern String
"control" ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
ctlNum Pattern Double
115 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
control (Double -> Pattern Double
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
loByte)
, ControlPattern
thruCh10Fast ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
midicmd Pattern String
"control" ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
ctlNum Pattern Double
117 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
control Pattern Double
secsHiPat
, ControlPattern
thruCh10Fast ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
midicmd Pattern String
"control" ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
ctlNum Pattern Double
118 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
control Pattern Double
secsLoPat
]
displayClock' :: IK -> ControlPattern
displayClock' :: IK -> ControlPattern
displayClock' IK
k =
let loopSecs :: Double
loopSecs = Kinetics -> Double
kLoopSecs (IK -> Kinetics
forall a b. (a, b) -> a
fst IK
k)
cpsV :: Double
cpsV = Kinetics -> Double
kCps (IK -> Kinetics
forall a b. (a, b) -> a
fst IK
k)
cyclesPerBar :: Double
cyclesPerBar = Double
4 :: Double
loopBars :: Double
loopBars = Double
loopSecs Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cpsV Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
cyclesPerBar
loopInt :: Int
loopInt = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
loopBars :: Int
hiByte :: Double
hiByte = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
loopInt Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
128) :: Double
loByte :: Double
loByte = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
loopInt Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
128) :: Double
thruCh10 :: ControlPattern
thruCh10 = Pattern String -> ControlPattern
s Pattern String
"thru" ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
midichan Pattern Double
9
thruCh10Fast :: ControlPattern
thruCh10Fast = Pattern Time -> ControlPattern -> ControlPattern
forall a. Pattern Time -> Pattern a -> Pattern a
fast Pattern Time
30 (Pattern String -> ControlPattern
s Pattern String
"thru") ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
midichan Pattern Double
9
wholeBars :: Int
wholeBars = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
loopBars :: Int
currentBarsPat :: Pattern Double
currentBarsPat = if Int
wholeBars Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Double
cpsV Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0
then (Time -> Double) -> Pattern Double
forall a. (Time -> a) -> Pattern a
sig ((Time -> Double) -> Pattern Double)
-> (Time -> Double) -> Pattern Double
forall a b. (a -> b) -> a -> b
$ \Time
t ->
let cyclesNow :: Double
cyclesNow = Time -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Time
t :: Double
barsNow :: Double
barsNow = Double
cyclesNow Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
cyclesPerBar
formLocalBars :: Double
formLocalBars = Double
barsNow Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
barsNow Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
loopBars) :: Int) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
loopBars
displayed :: Int
displayed = (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
formLocalBars :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
displayed :: Double
else Double -> Pattern Double
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
0
barsHiPat :: Pattern Double
barsHiPat = (Double -> Double) -> Pattern Double -> Pattern Double
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Double
x -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x :: Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
128) :: Double) Pattern Double
currentBarsPat
barsLoPat :: Pattern Double
barsLoPat = (Double -> Double) -> Pattern Double -> Pattern Double
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Double
x -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x :: Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
128) :: Double) Pattern Double
currentBarsPat
in [ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
stack
[
(Pattern Time
1Pattern Time -> Pattern Time -> Pattern Time
forall a. Fractional a => a -> a -> a
/Pattern Time
64) Pattern Time -> ControlPattern -> ControlPattern
forall a. Pattern Time -> Pattern a -> Pattern a
~> (Pattern Bool -> ControlPattern -> ControlPattern
forall a. Pattern Bool -> Pattern a -> Pattern a
struct ((Int -> Bool) -> Pattern Int -> Pattern Bool
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True) (IK -> Pattern Int
forall a b. (a, b) -> b
snd IK
k)) (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$
ControlPattern
thruCh10 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
midicmd Pattern String
"control" ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
ctlNum Pattern Double
113
# control (fmap (fromIntegral . min 8) (snd k)))
, (Pattern Time
1Pattern Time -> Pattern Time -> Pattern Time
forall a. Fractional a => a -> a -> a
/Pattern Time
64) Pattern Time -> ControlPattern -> ControlPattern
forall a. Pattern Time -> Pattern a -> Pattern a
~> (Pattern Bool -> ControlPattern -> ControlPattern
forall a. Pattern Bool -> Pattern a -> Pattern a
struct ((Time -> Pattern Time
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Time
1Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
8)) Pattern Time -> Pattern Bool -> Pattern Bool
forall a. Pattern Time -> Pattern a -> Pattern a
~> (Int -> Bool) -> Pattern Int -> Pattern Bool
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True) (IK -> Pattern Int
forall a b. (a, b) -> b
snd IK
k)) (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$
ControlPattern
thruCh10 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
midicmd Pattern String
"control" ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
ctlNum Pattern Double
113 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
control Pattern Double
0)
, ControlPattern
thruCh10 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
midicmd Pattern String
"control" ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
ctlNum Pattern Double
114 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
control (Double -> Pattern Double
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
hiByte)
, ControlPattern
thruCh10 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
midicmd Pattern String
"control" ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
ctlNum Pattern Double
115 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
control (Double -> Pattern Double
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
loByte)
, ControlPattern
thruCh10Fast ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
midicmd Pattern String
"control" ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
ctlNum Pattern Double
117 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
control Pattern Double
barsHiPat
, ControlPattern
thruCh10Fast ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
midicmd Pattern String
"control" ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
ctlNum Pattern Double
118 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
control Pattern Double
barsLoPat
]