{-# LANGUAGE ScopedTypeVariables #-}

module Sound.Tidal.EspGrid (tidalEspGridLink,cpsEsp,espgrid) where

{-
    EspGrid.hs - Provides ability to sync via the ESP Grid
    Copyright (C) 2020, David Ogborn and contributors

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

import Control.Concurrent.MVar
import Control.Concurrent (forkIO,threadDelay)
import Control.Monad (forever)
import Control.Exception
import Sound.OSC.FD
import Sound.Tidal.Tempo
import Sound.Tidal.Stream (Stream, sTempoMV)

parseEspTempo :: [Datum] -> Maybe (Tempo -> Tempo)
parseEspTempo :: [Datum] -> Maybe (Tempo -> Tempo)
parseEspTempo [Datum]
d = do
  Integer
on :: Integer <- Datum -> Maybe Integer
forall i. Integral i => Datum -> Maybe i
datum_integral ([Datum]
d[Datum] -> Int -> Datum
forall a. [a] -> Int -> a
!!Int
0)
  Time
bpm <- Datum -> Maybe Time
forall n. Floating n => Datum -> Maybe n
datum_floating ([Datum]
d[Datum] -> Int -> Datum
forall a. [a] -> Int -> a
!!Int
1)
  Integer
t1 :: Integer <- Datum -> Maybe Integer
forall i. Integral i => Datum -> Maybe i
datum_integral ([Datum]
d[Datum] -> Int -> Datum
forall a. [a] -> Int -> a
!!Int
2)
  Integer
t2 <- Datum -> Maybe Integer
forall i. Integral i => Datum -> Maybe i
datum_integral ([Datum]
d[Datum] -> Int -> Datum
forall a. [a] -> Int -> a
!!Int
3)
  Integer
n :: Integer <- Datum -> Maybe Integer
forall i. Integral i => Datum -> Maybe i
datum_integral ([Datum]
d[Datum] -> Int -> Datum
forall a. [a] -> Int -> a
!!Int
4)
  let nanos :: Integer
nanos = (Integer
t1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
1000000000) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
t2
  (Tempo -> Tempo) -> Maybe (Tempo -> Tempo)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Tempo -> Tempo) -> Maybe (Tempo -> Tempo))
-> (Tempo -> Tempo) -> Maybe (Tempo -> Tempo)
forall a b. (a -> b) -> a -> b
$ \Tempo
t -> Tempo
t {
    atTime :: Time
atTime = Time -> Time
forall n. Num n => n -> n
ut_to_ntpr (Time -> Time) -> Time -> Time
forall a b. (a -> b) -> a -> b
$ Integer -> Time
forall a b. (Real a, Fractional b) => a -> b
realToFrac Integer
nanos Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Time
1000000000,
    atCycle :: Rational
atCycle = Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n,
    cps :: Time
cps = Time
bpmTime -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
60,
    paused :: Bool
paused = Integer
on Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
    }

changeTempo :: MVar Tempo -> Packet -> IO ()
changeTempo :: MVar Tempo -> Packet -> IO ()
changeTempo MVar Tempo
t (Packet_Message Message
msg) =
  case [Datum] -> Maybe (Tempo -> Tempo)
parseEspTempo (Message -> [Datum]
messageDatum Message
msg) of
    Just Tempo -> Tempo
f -> MVar Tempo -> (Tempo -> IO Tempo) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVarMasked_ MVar Tempo
t ((Tempo -> IO Tempo) -> IO ()) -> (Tempo -> IO Tempo) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Tempo
t0 -> Tempo -> IO Tempo
forall (m :: * -> *) a. Monad m => a -> m a
return (Tempo -> Tempo
f Tempo
t0)
    Maybe (Tempo -> Tempo)
Nothing -> String -> IO ()
putStrLn String
"Warning: Unable to parse message from EspGrid as Tempo"
changeTempo MVar Tempo
_ Packet
_ = String -> IO ()
putStrLn String
"Serious error: Can only process Packet_Message"

tidalEspGridLink :: MVar Tempo -> IO ()
tidalEspGridLink :: MVar Tempo -> IO ()
tidalEspGridLink MVar Tempo
_ = String -> IO ()
putStrLn String
"Function no longer supported, please use 'espgrid tidal' to connect to ESPgrid instead."

espgrid :: Stream -> IO ()
espgrid :: Stream -> IO ()
espgrid Stream
st = do
  let t :: MVar Tempo
t = Stream -> MVar Tempo
sTempoMV Stream
st
  UDP
socket <- String -> Int -> IO UDP
openUDP String
"127.0.0.1" Int
5510
  ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    (do
      UDP -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage UDP
socket (Message -> IO ()) -> Message -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [Datum] -> Message
Message String
"/esp/tempo/q" []
      Packet
response <- UDP -> String -> IO Packet
forall t. Transport t => t -> String -> IO Packet
waitAddress UDP
socket String
"/esp/tempo/r"
      MVar Tempo -> Packet -> IO ()
Sound.Tidal.EspGrid.changeTempo MVar Tempo
t Packet
response
      Int -> IO ()
threadDelay Int
200000)
      IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\SomeException
e -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"exception caught in tidalEspGridLink: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: SomeException))
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

cpsEsp :: Real t => t -> IO ()
cpsEsp :: t -> IO ()
cpsEsp t
t = do
  UDP
socket <- String -> Int -> IO UDP
openUDP String
"127.0.0.1" Int
5510
  UDP -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage UDP
socket (Message -> IO ()) -> Message -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [Datum] -> Message
Message String
"/esp/beat/tempo" [t -> Datum
forall n. Real n => n -> Datum
float (t
tt -> t -> t
forall a. Num a => a -> a -> a
*t
60)]