-- | Non-realtime score generation.
module Sound.Sc3.Server.Nrt where

import Data.List {- base -}
import Data.Maybe {- base -}
import System.IO {- base -}

import qualified Data.ByteString.Lazy as B {- bytestring -}

import qualified Sound.Osc.Coding.Byte as Byte {- hosc -}
import qualified Sound.Osc.Coding.Decode.Binary as Decode {- hosc3 -}
import qualified Sound.Osc.Coding.Encode.Builder as Encode {- hosc3 -}
import Sound.Osc.Datum {- hosc -}
import Sound.Osc.Packet {- hosc -}

-- | Encode Bundle and prefix with encoded length.
oscWithSize :: BundleOf Message -> B.ByteString
oscWithSize :: BundleOf Message -> ByteString
oscWithSize BundleOf Message
o =
  let b :: ByteString
b = BundleOf Message -> ByteString
Encode.encodeBundle BundleOf Message
o
      l :: ByteString
l = Int -> ByteString
Byte.encode_i32 (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
B.length ByteString
b))
  in ByteString -> ByteString -> ByteString
B.append ByteString
l ByteString
b

-- | An 'Nrt' score is a sequence of 'Bundle's.
newtype Nrt = Nrt {Nrt -> [BundleOf Message]
nrt_bundles :: [BundleOf Message]} deriving (Int -> Nrt -> ShowS
[Nrt] -> ShowS
Nrt -> String
(Int -> Nrt -> ShowS)
-> (Nrt -> String) -> ([Nrt] -> ShowS) -> Show Nrt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Nrt -> ShowS
showsPrec :: Int -> Nrt -> ShowS
$cshow :: Nrt -> String
show :: Nrt -> String
$cshowList :: [Nrt] -> ShowS
showList :: [Nrt] -> ShowS
Show)

{- | 'span' of 'f' of 'bundleTime'.
     Can be used to separate the /initialisation/ and /remainder/ parts of a score.
-}
nrt_span :: (Time -> Bool) -> Nrt -> ([BundleOf Message], [BundleOf Message])
nrt_span :: (Time -> Bool) -> Nrt -> ([BundleOf Message], [BundleOf Message])
nrt_span Time -> Bool
f = (BundleOf Message -> Bool)
-> [BundleOf Message] -> ([BundleOf Message], [BundleOf Message])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Time -> Bool
f (Time -> Bool)
-> (BundleOf Message -> Time) -> BundleOf Message -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BundleOf Message -> Time
forall t. BundleOf t -> Time
bundleTime) ([BundleOf Message] -> ([BundleOf Message], [BundleOf Message]))
-> (Nrt -> [BundleOf Message])
-> Nrt
-> ([BundleOf Message], [BundleOf Message])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nrt -> [BundleOf Message]
nrt_bundles

-- | Encode an 'Nrt' score.
encodeNrt :: Nrt -> B.ByteString
encodeNrt :: Nrt -> ByteString
encodeNrt = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (Nrt -> [ByteString]) -> Nrt -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BundleOf Message -> ByteString)
-> [BundleOf Message] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map BundleOf Message -> ByteString
oscWithSize ([BundleOf Message] -> [ByteString])
-> (Nrt -> [BundleOf Message]) -> Nrt -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nrt -> [BundleOf Message]
nrt_bundles

{- | Write an 'Nrt' score.

> import Sound.Osc {\- hosc -\}
> import Sound.Sc3 {\- hsc3 -\}
> m1 = g_new [(1, AddToTail, 0)]
> m2 = d_recv (synthdef "sin" (out 0 (sinOsc ar 660 0 * 0.15)))
> m3 = s_new "sin" 100 AddToTail 1 []
> m4 = n_free [100]
> m5 = nrt_end
> sc = Nrt [bundle 0 [m1,m2],bundle 1 [m3],bundle 10 [m4],bundle 15 [m5]]
> writeNrt "/tmp/t.osc" sc
-}
writeNrt :: FilePath -> Nrt -> IO ()
writeNrt :: String -> Nrt -> IO ()
writeNrt String
fn = String -> ByteString -> IO ()
B.writeFile String
fn (ByteString -> IO ()) -> (Nrt -> ByteString) -> Nrt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nrt -> ByteString
encodeNrt

-- | Write an 'Nrt' score to a file handle.
putNrt :: Handle -> Nrt -> IO ()
putNrt :: Handle -> Nrt -> IO ()
putNrt Handle
h = Handle -> ByteString -> IO ()
B.hPut Handle
h (ByteString -> IO ()) -> (Nrt -> ByteString) -> Nrt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nrt -> ByteString
encodeNrt

-- | Decode an 'Nrt' 'B.ByteString' to a list of 'Bundle's.
decode_nrt_bundles :: B.ByteString -> [BundleOf Message]
decode_nrt_bundles :: ByteString -> [BundleOf Message]
decode_nrt_bundles ByteString
s =
  let (ByteString
p, ByteString
q) = Int64 -> ByteString -> (ByteString, ByteString)
B.splitAt Int64
4 ByteString
s
      n :: Int64
n = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
Byte.decode_i32 ByteString
p)
      (ByteString
r, ByteString
s') = Int64 -> ByteString -> (ByteString, ByteString)
B.splitAt Int64
n ByteString
q
      r' :: BundleOf Message
r' = ByteString -> BundleOf Message
Decode.decodeBundle ByteString
r
  in if ByteString -> Bool
B.null ByteString
s'
      then [BundleOf Message
r']
      else BundleOf Message
r' BundleOf Message -> [BundleOf Message] -> [BundleOf Message]
forall a. a -> [a] -> [a]
: ByteString -> [BundleOf Message]
decode_nrt_bundles ByteString
s'

-- | Decode an 'Nrt' 'B.ByteString'.
decodeNrt :: B.ByteString -> Nrt
decodeNrt :: ByteString -> Nrt
decodeNrt = [BundleOf Message] -> Nrt
Nrt ([BundleOf Message] -> Nrt)
-> (ByteString -> [BundleOf Message]) -> ByteString -> Nrt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [BundleOf Message]
decode_nrt_bundles

{- | 'decodeNrt' of 'B.readFile'.

> readNrt "/tmp/t.osc"
-}
readNrt :: FilePath -> IO Nrt
readNrt :: String -> IO Nrt
readNrt = (ByteString -> Nrt) -> IO ByteString -> IO Nrt
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Nrt
decodeNrt (IO ByteString -> IO Nrt)
-> (String -> IO ByteString) -> String -> IO Nrt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
B.readFile

-- * Query

-- | Find any non-ascending sequences.
nrt_non_ascending :: Nrt -> [(BundleOf Message, BundleOf Message)]
nrt_non_ascending :: Nrt -> [(BundleOf Message, BundleOf Message)]
nrt_non_ascending (Nrt [BundleOf Message]
b) =
  case [BundleOf Message] -> Maybe (BundleOf Message, [BundleOf Message])
forall a. [a] -> Maybe (a, [a])
uncons [BundleOf Message]
b of
    Maybe (BundleOf Message, [BundleOf Message])
Nothing -> String -> [(BundleOf Message, BundleOf Message)]
forall a. HasCallStack => String -> a
error String
"nrt_non_ascending: empty nrt"
    Just (BundleOf Message
_, [BundleOf Message]
t) ->
      let p :: [(BundleOf Message, BundleOf Message)]
p = [BundleOf Message]
-> [BundleOf Message] -> [(BundleOf Message, BundleOf Message)]
forall a b. [a] -> [b] -> [(a, b)]
zip [BundleOf Message]
b [BundleOf Message]
t
          f :: (BundleOf t, BundleOf t) -> Maybe (BundleOf t, BundleOf t)
f (BundleOf t
i, BundleOf t
j) = if BundleOf t -> Time
forall t. BundleOf t -> Time
bundleTime BundleOf t
i Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> BundleOf t -> Time
forall t. BundleOf t -> Time
bundleTime BundleOf t
j then (BundleOf t, BundleOf t) -> Maybe (BundleOf t, BundleOf t)
forall a. a -> Maybe a
Just (BundleOf t
i, BundleOf t
j) else Maybe (BundleOf t, BundleOf t)
forall a. Maybe a
Nothing
      in ((BundleOf Message, BundleOf Message)
 -> Maybe (BundleOf Message, BundleOf Message))
-> [(BundleOf Message, BundleOf Message)]
-> [(BundleOf Message, BundleOf Message)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (BundleOf Message, BundleOf Message)
-> Maybe (BundleOf Message, BundleOf Message)
forall {t} {t}.
(BundleOf t, BundleOf t) -> Maybe (BundleOf t, BundleOf t)
f [(BundleOf Message, BundleOf Message)]
p