Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Sound.Osc
Description
Composite of Sound.Osc.Core and Sound.Osc.Transport.Monad.
Synopsis
- class Monad m => MonadIO (m :: Type -> Type) where
- liftIO :: IO a -> m a
- newtype Udp = Udp {
- udpSocket :: Socket
- newtype Tcp = Tcp {
- tcpHandle :: Handle
- data Datum
- data Packet
- = Packet_Message {
- packetMessage :: !Message
- | Packet_Bundle {
- packetBundle :: !Bundle
- = Packet_Message {
- type Time = Double
- type DatumType = Char
- type Address_Pattern = String
- type Ntp64 = Word64
- class (DuplexOsc m, MonadIO m) => Transport m
- type Ascii = ByteString
- type Blob = ByteString
- data MidiData = MidiData !Word8 !Word8 !Word8 !Word8
- data Message = Message {
- messageAddress :: !Address_Pattern
- messageDatum :: ![Datum]
- data Bundle = Bundle {
- bundleTime :: !Time
- bundleMessages :: ![Message]
- type NtpReal = Double
- type PosixReal = Double
- class Monad m => SendOsc m where
- sendPacket :: Packet -> m ()
- class Monad m => RecvOsc m where
- recvPacket :: m Packet
- class (SendOsc m, RecvOsc m) => DuplexOsc m
- type Connection t a = ReaderT t IO a
- time :: MonadIO m => m NtpReal
- decodeMessage :: ByteString -> Message
- decodeBundle :: ByteString -> Bundle
- decodePacket :: ByteString -> Packet
- get_packet :: Get Packet
- decodePacket_strict :: ByteString -> Packet
- build_packet :: Packet -> Builder
- encodeMessage :: Message -> ByteString
- encodeBundle :: Bundle -> ByteString
- encodePacket :: Packet -> ByteString
- encodePacket_strict :: Packet -> ByteString
- getSystemTimeAsNtpReal :: IO NtpReal
- pauseThreadLimit :: Fractional n => n
- untilPredicate :: Monad m => (a -> Bool) -> m a -> m a
- float :: Real n => n -> Datum
- ascii :: String -> Ascii
- ascii_to_string :: Ascii -> String
- blob_pack :: [Word8] -> Blob
- blob_unpack :: Blob -> [Word8]
- blob_unpack_int :: Blob -> [Int]
- midi_pack :: [Word8] -> MidiData
- midi_unpack_int :: MidiData -> [Int]
- osc_types_required :: [(DatumType, String)]
- osc_types_optional :: [(DatumType, String)]
- osc_types :: [(DatumType, String)]
- osc_type_name :: DatumType -> Maybe String
- osc_type_name_err :: DatumType -> String
- datum_tag :: Datum -> DatumType
- datum_type_name :: Datum -> (DatumType, String)
- datum_integral :: Integral i => Datum -> Maybe i
- datum_floating :: Floating n => Datum -> Maybe n
- int32 :: Integral n => n -> Datum
- int64 :: Integral n => n -> Datum
- double :: Real n => n -> Datum
- string :: String -> Datum
- midi :: (Word8, Word8, Word8, Word8) -> Datum
- blob :: [Word8] -> Datum
- signatureFor :: [Datum] -> String
- descriptor :: [Datum] -> Ascii
- descriptor_tags :: Ascii -> Ascii
- message :: Address_Pattern -> [Datum] -> Message
- messageSignature :: Message -> String
- messageDescriptor :: Message -> Ascii
- bundle :: Time -> [Message] -> Bundle
- p_bundle :: Time -> [Message] -> Packet
- p_message :: Address_Pattern -> [Datum] -> Packet
- immediately :: Time
- packetTime :: Packet -> Time
- at_packet :: (Message -> a) -> (Bundle -> a) -> Packet -> a
- packetMessages :: Packet -> [Message]
- packet_to_bundle :: Packet -> Bundle
- packet_to_message :: Packet -> Maybe Message
- packet_is_immediate :: Packet -> Bool
- message_has_address :: Address_Pattern -> Message -> Bool
- bundle_has_address :: Address_Pattern -> Bundle -> Bool
- packet_has_address :: Address_Pattern -> Packet -> Bool
- ntpr_to_ntpi :: NtpReal -> Ntp64
- ntpi_to_ntpr :: Ntp64 -> NtpReal
- ntp_posix_epoch_diff :: Num n => n
- posix_to_ntpi :: PosixReal -> Ntp64
- posix_to_ntpr :: Num n => n -> n
- ntpr_to_posix :: Num n => n -> n
- ntpi_to_posix :: Ntp64 -> PosixReal
- ntpr_to_posixtime :: NtpReal -> POSIXTime
- posixtime_to_ntpr :: POSIXTime -> NtpReal
- posix_epoch :: UTCTime
- utc_to_posix :: Fractional n => UTCTime -> n
- getCurrentTimeAsPosix :: IO PosixReal
- getPosixTimeAsPosix :: IO PosixReal
- currentTime :: IO NtpReal
- getSystemTimeInMicroseconds :: IO (Int64, Word32)
- pauseThreadFor :: RealFrac n => n -> IO ()
- pauseThreadUntilTime :: RealFrac n => n -> IO ()
- sleepThreadFor :: RealFrac n => n -> IO ()
- sleepThreadUntilTime :: RealFrac n => n -> IO ()
- wait :: MonadIO m => Double -> m ()
- pauseThread :: (MonadIO m, RealFrac n) => n -> m ()
- sleepThread :: (RealFrac n, MonadIO m) => n -> m ()
- pauseThreadUntil :: (MonadIO m, RealFrac n) => n -> m ()
- sleepThreadUntil :: (RealFrac n, MonadIO m) => n -> m ()
- untilMaybe :: Monad m => (a -> Maybe b) -> m a -> m b
- withTransport :: Transport t => IO t -> Connection t r -> IO r
- sendMessage :: SendOsc m => Message -> m ()
- sendBundle :: SendOsc m => Bundle -> m ()
- recvBundle :: RecvOsc m => m Bundle
- recvMessage :: RecvOsc m => m (Maybe Message)
- recvMessages :: RecvOsc m => m [Message]
- waitUntil :: RecvOsc m => (Packet -> Bool) -> m Packet
- waitFor :: RecvOsc m => (Packet -> Maybe a) -> m a
- waitImmediate :: RecvOsc m => m Packet
- waitMessage :: RecvOsc m => m Message
- waitAddress :: RecvOsc m => Address_Pattern -> m Packet
- waitReply :: RecvOsc m => Address_Pattern -> m Message
- waitDatum :: RecvOsc m => Address_Pattern -> m [Datum]
- withTransport_ :: Transport t => IO t -> Connection t r -> IO ()
- recvMessage_err :: RecvOsc m => m Message
- udpPort :: Integral n => Udp -> IO n
- udp_send_data :: Udp -> ByteString -> IO ()
- udp_sendAll_data :: Udp -> ByteString -> IO ()
- udp_send_packet :: Udp -> Packet -> IO ()
- udp_recv_packet :: Udp -> IO Packet
- udp_close :: Udp -> IO ()
- with_udp :: IO Udp -> (Udp -> IO t) -> IO t
- udp_socket :: (Socket -> SockAddr -> IO ()) -> String -> Int -> IO Udp
- set_udp_opt :: SocketOption -> Int -> Udp -> IO ()
- get_udp_opt :: SocketOption -> Udp -> IO Int
- openUdp :: String -> Int -> IO Udp
- udpServer :: String -> Int -> IO Udp
- udp_server :: Int -> IO Udp
- sendTo :: Udp -> Packet -> SockAddr -> IO ()
- recvFrom :: Udp -> IO (Packet, SockAddr)
- tcp_send_data :: Tcp -> ByteString -> IO ()
- tcp_send_packet :: Tcp -> Packet -> IO ()
- tcp_recv_packet :: Tcp -> IO Packet
- tcp_close :: Tcp -> IO ()
- with_tcp :: IO Tcp -> (Tcp -> IO t) -> IO t
- tcp_socket :: (Socket -> SockAddr -> IO ()) -> Maybe String -> Int -> IO Socket
- socket_to_tcp :: Socket -> IO Tcp
- tcp_handle :: (Socket -> SockAddr -> IO ()) -> String -> Int -> IO Tcp
- openTcp :: String -> Int -> IO Tcp
- tcp_server_f :: Socket -> (Tcp -> IO ()) -> IO ()
- tcp_server :: Int -> (Tcp -> IO ()) -> IO ()
Documentation
class Monad m => MonadIO (m :: Type -> Type) where #
Instances
The Udp transport handle data type.
The Tcp transport handle data type.
The basic elements of Osc messages.
Constructors
Int32 | |
Fields
| |
Int64 | |
Fields
| |
Float | |
Fields
| |
Double | |
Fields
| |
AsciiString | |
Fields
| |
Blob | |
TimeStamp | |
Fields
| |
Midi | |
Constructors
Packet_Message | |
Fields
| |
Packet_Bundle | |
Fields
|
A real-valued time stamp. For Osc proper this is an Ntp64 time in real-valued (fractional) form. For SuperCollider Nrt programs this is elapsed time since the start of the score. This is the primary form of timestamp used by hosc.
type Address_Pattern = String Source #
Osc address pattern. This is strictly an Ascii value, however it
is very common to pattern match on addresses and matching on
Data.ByteString.Char8 requires OverloadedStrings
.
Type for binary (integeral) representation of a 64-bit Ntp timestamp (ie. ntpi). The Ntp epoch is January 1, 1900. Ntp v4 also includes a 128-bit format, which is not used by Osc.
Four-byte midi message: port-id, status-byte, data, data.
Constructors
MidiData !Word8 !Word8 !Word8 !Word8 |
An Osc message, an Address_Pattern
and a sequence of Datum
.
Constructors
Message | |
Fields
|
An Osc bundle, a Time
and a sequence of Message
s.
Do not allow recursion, all contents must be messages.
Constructors
Bundle | |
Fields
|
type PosixReal = Double Source #
Unix/Posix
time in real-valued (fractional) form.
The Unix/Posix epoch is January 1, 1970.
type Connection t a = ReaderT t IO a Source #
Transport connection.
decodeMessage :: ByteString -> Message Source #
Decode an Osc Message
from a lazy ByteString.
let b = ByteString.Lazy.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] decodeMessage b == Message "/g_free" [Int32 0]
decodeBundle :: ByteString -> Bundle Source #
Decode an Osc Bundle
from a lazy ByteString.
decodePacket :: ByteString -> Packet Source #
Decode an Osc packet from a lazy ByteString.
let b = ByteString.Lazy.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] decodePacket b == Packet_Message (Message "/g_free" [Int32 0])
get_packet :: Get Packet Source #
Get an Osc Packet
.
decodePacket_strict :: ByteString -> Packet Source #
Decode an Osc packet from a strict Char8 ByteString.
build_packet :: Packet -> Builder Source #
Builder for an Osc Packet
.
encodeMessage :: Message -> ByteString Source #
Encode an Osc Message
, ie. encodePacket
of Packet_Message
.
let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] encodeMessage (Message "/g_free" [Int32 0]) == L.pack m
encodeBundle :: Bundle -> ByteString Source #
Encode an Osc Bundle
, ie. encodePacket
of Packet_Bundle
.
let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] let b = [35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,1,0,0,0,16] ++ m encodeBundle (Bundle immediately [Message "/g_free" [Int32 0]]) == L.pack b
encodePacket :: Packet -> ByteString Source #
Encode an Osc Packet
.
encodePacket_strict :: Packet -> ByteString Source #
Encode an Osc Packet
to a strict ByteString
.
getSystemTimeAsNtpReal :: IO NtpReal Source #
Get the system time, epoch start of 1970 UTC, leap-seconds ignored. getSystemTime is typically much faster than getCurrentTime, however it is not available in Hugs.
pauseThreadLimit :: Fractional n => n Source #
The pauseThread
limit (in seconds).
Values larger than this require a different thread delay mechanism, see sleepThread
.
The value is the number of microseconds in maxBound::Int
.
untilPredicate :: Monad m => (a -> Bool) -> m a -> m a Source #
Repeat action until predicate f is True
when applied to result.
float :: Real n => n -> Datum Source #
Type generalised Float.
float (1::Int) == float (1::Double) floatRange (undefined::Float) == (-125,128) isInfinite (d_float (float (encodeFloat 1 256 :: Double))) == True
ascii_to_string :: Ascii -> String Source #
Type-specialised unpack.
blob_unpack :: Blob -> [Word8] Source #
Type-specialised unpack.
blob_unpack_int :: Blob -> [Int] Source #
Type-specialised unpack.
midi_unpack_int :: MidiData -> [Int] Source #
Type-specialised unpack.
osc_types_required :: [(DatumType, String)] Source #
List of required data types (tag, name).
osc_types_optional :: [(DatumType, String)] Source #
List of optional data types (tag,name).
osc_type_name :: DatumType -> Maybe String Source #
Lookup name of type.
osc_type_name_err :: DatumType -> String Source #
Erroring variant.
datum_integral :: Integral i => Datum -> Maybe i Source #
Datum
as Integral
if Int32 or Int64.
let d = [Int32 5,Int64 5,Float 5.5,Double 5.5] map datum_integral d == [Just (5::Int),Just 5,Nothing,Nothing]
datum_floating :: Floating n => Datum -> Maybe n Source #
Datum
as Floating
if Int32, Int64, Float, Double or TimeStamp.
let d = [Int32 5,Int64 5,Float 5,Double 5,TimeStamp 5] mapMaybe datum_floating d == replicate 5 (5::Double)
int32 :: Integral n => n -> Datum Source #
Type generalised Datum
.
int32 (1::Int32) == int32 (1::Integer) d_int32 (int32 (maxBound::Int32)) == maxBound int32 (((2::Int) ^ (64::Int))::Int) == Int32 0
int64 :: Integral n => n -> Datum Source #
Type generalised Int64.
int64 (1::Int32) == int64 (1::Integer) d_int64 (int64 (maxBound::Int64)) == maxBound
double :: Real n => n -> Datum Source #
Type generalised Double.
double (1::Int) == double (1::Double) double (encodeFloat 1 256 :: Double) == Double 1.157920892373162e77
string :: String -> Datum Source #
AsciiString
of pack.
string "string" == AsciiString (ByteString.Char8.pack "string")
signatureFor :: [Datum] -> String Source #
Message argument types are given by a signature.
signatureFor [Int32 1,Float 1,string "1"] == ",ifs"
descriptor :: [Datum] -> Ascii Source #
The descriptor is an Ascii encoded signature.
descriptor [Int32 1,Float 1,string "1"] == ascii ",ifs"
descriptor_tags :: Ascii -> Ascii Source #
Descriptor tags are comma
prefixed.
message :: Address_Pattern -> [Datum] -> Message Source #
Message
constructor. It is an error
if the Address_Pattern
doesn't conform to the Osc specification.
messageSignature :: Message -> String Source #
messageDescriptor :: Message -> Ascii Source #
immediately :: Time Source #
Constant indicating a bundle to be executed immediately. It has the Ntp64 representation of 1
.
ntpr_to_ntpi immediately == 1
packetTime :: Packet -> Time Source #
The Time
of Packet
, if the Packet
is a Message
this is immediately
.
packet_to_bundle :: Packet -> Bundle Source #
If Packet
is a Message
add immediately
timestamp, else id
.
packet_to_message :: Packet -> Maybe Message Source #
packet_is_immediate :: Packet -> Bool Source #
Is Packet
immediate, ie. a Bundle
with timestamp immediately
, or a plain Message.
message_has_address :: Address_Pattern -> Message -> Bool Source #
Does Message
have the specified Address_Pattern
.
bundle_has_address :: Address_Pattern -> Bundle -> Bool Source #
Do any of the Message
s at Bundle
have the specified
Address_Pattern
.
packet_has_address :: Address_Pattern -> Packet -> Bool Source #
Does Packet
have the specified Address_Pattern
, ie.
message_has_address
or bundle_has_address
.
ntpr_to_ntpi :: NtpReal -> Ntp64 Source #
Convert an NtpReal timestamp to an Ntp64 timestamp.
ntpr_to_ntpi 0 == 0 fmap ntpr_to_ntpi time
ntpi_to_ntpr :: Ntp64 -> NtpReal Source #
Convert an Ntp64
timestamp to a real-valued Ntp timestamp.
ntpi_to_ntpr 0 == 0.0
ntp_posix_epoch_diff :: Num n => n Source #
Difference (in seconds) between Ntp and Posix epochs.
ntp_posix_epoch_diff / (24 * 60 * 60) == 25567 25567 `div` 365 == 70
posix_to_ntpi :: PosixReal -> Ntp64 Source #
Convert a PosixReal timestamp to an Ntp64 timestamp.
posix_to_ntpr :: Num n => n -> n Source #
Convert Unix/Posix
to Ntp
.
ntpr_to_posix :: Num n => n -> n Source #
Convert Ntp
to Unix/Posix
.
ntpr_to_posixtime :: NtpReal -> POSIXTime Source #
Convert Time
to POSIXTime
.
posixtime_to_ntpr :: POSIXTime -> NtpReal Source #
Convert POSIXTime
to Time
.
posix_epoch :: UTCTime Source #
The time at 1970-01-01:00:00:00 which is the Unix/Posix epoch.
utc_to_posix :: Fractional n => UTCTime -> n Source #
Convert UTCTime
to Unix/Posix
.
getCurrentTimeAsPosix :: IO PosixReal Source #
utc_to_posix of Clock.getCurrentTime.
getPosixTimeAsPosix :: IO PosixReal Source #
realToFrac of Clock.Posix.getPOSIXTime
get_ct = getCurrentTimeAsPosix get_pt = getPosixTimeAsPosix (ct,pt) <- get_ct >>= \t0 -> get_pt >>= \t1 -> return (t0,t1) print (pt - ct,pt - ct < 1e-5)
currentTime :: IO NtpReal Source #
Read current real-valued Ntp
timestamp.
getSystemTimeInMicroseconds :: IO (Int64, Word32) Source #
System time with fractional part in microseconds (us) instead of nanoseconds (ns).
pauseThreadFor :: RealFrac n => n -> IO () Source #
Pause current thread for the indicated duration (in seconds), see pauseThreadLimit
.
pauseThreadUntilTime :: RealFrac n => n -> IO () Source #
Pause current thread until the given time, see pauseThreadLimit
.
sleepThreadFor :: RealFrac n => n -> IO () Source #
Sleep current thread for the indicated duration (in seconds).
Divides long sleeps into parts smaller than pauseThreadLimit
.
sleepThreadUntilTime :: RealFrac n => n -> IO () Source #
Sleep current thread until the given time.
Divides long sleeps into parts smaller than pauseThreadLimit
.
pauseThread :: (MonadIO m, RealFrac n) => n -> m () Source #
sleepThread :: (RealFrac n, MonadIO m) => n -> m () Source #
pauseThreadUntil :: (MonadIO m, RealFrac n) => n -> m () Source #
sleepThreadUntil :: (RealFrac n, MonadIO m) => n -> m () Source #
untilMaybe :: Monad m => (a -> Maybe b) -> m a -> m b Source #
Repeat action until f does not give Nothing
when applied to result.
withTransport :: Transport t => IO t -> Connection t r -> IO r Source #
Bracket Open Sound Control communication.
sendMessage :: SendOsc m => Message -> m () Source #
Type restricted synonym for sendOsc
.
sendBundle :: SendOsc m => Bundle -> m () Source #
Type restricted synonym for sendOsc
.
recvBundle :: RecvOsc m => m Bundle Source #
Variant of recvPacket
that runs packet_to_bundle
.
recvMessage :: RecvOsc m => m (Maybe Message) Source #
Variant of recvPacket
that runs packet_to_message
.
recvMessages :: RecvOsc m => m [Message] Source #
Variant of recvPacket
that runs packetMessages
.
waitUntil :: RecvOsc m => (Packet -> Bool) -> m Packet Source #
Wait for a Packet
where the supplied predicate is True
,
discarding intervening packets.
waitFor :: RecvOsc m => (Packet -> Maybe a) -> m a Source #
Wait for a Packet
where the supplied function does not give
Nothing
, discarding intervening packets.
waitMessage :: RecvOsc m => m Message Source #
waitFor
packet_to_message
, ie. an incoming Message
or
immediate mode Bundle
with one element.
waitAddress :: RecvOsc m => Address_Pattern -> m Packet Source #
A waitFor
for variant using packet_has_address
to match on
the Address_Pattern
of incoming Packets
.
waitReply :: RecvOsc m => Address_Pattern -> m Message Source #
Variant on waitAddress
that returns matching Message
.
waitDatum :: RecvOsc m => Address_Pattern -> m [Datum] Source #
Variant of waitReply
that runs messageDatum
.
withTransport_ :: Transport t => IO t -> Connection t r -> IO () Source #
void
of withTransport
.
recvMessage_err :: RecvOsc m => m Message Source #
Erroring variant.
udp_send_data :: Udp -> ByteString -> IO () Source #
Send data over Udp using send
.
udp_sendAll_data :: Udp -> ByteString -> IO () Source #
Send data over Udp using sendAll
.
udp_send_packet :: Udp -> Packet -> IO () Source #
Send packet over Udp.
udp_recv_packet :: Udp -> IO Packet Source #
Receive packet over Udp.
udp_socket :: (Socket -> SockAddr -> IO ()) -> String -> Int -> IO Udp Source #
Create and initialise Udp socket.
set_udp_opt :: SocketOption -> Int -> Udp -> IO () Source #
Set option, ie. Broadcast
or RecvTimeOut
.
get_udp_opt :: SocketOption -> Udp -> IO Int Source #
Get option.
udpServer :: String -> Int -> IO Udp Source #
Trivial Udp
server socket.
import Control.Concurrent {- base -}
let u0 = udpServer "127.0.0.1" 57300 t0 <- forkIO (Fd.withTransport u0 (\fd -> forever (Fd.recvMessage fd >>= print >> print "Received message, continuing"))) killThread t0
let u1 = openUdp "127.0.0.1" 57300 Fd.withTransport u1 (\fd -> Fd.sendMessage fd (Packet.message "/n" []))
udp_server :: Int -> IO Udp Source #
Variant of udpServer
that doesn't require the host address.
tcp_send_data :: Tcp -> ByteString -> IO () Source #
Send data over Tcp.
tcp_send_packet :: Tcp -> Packet -> IO () Source #
Send packet over Tcp.
tcp_recv_packet :: Tcp -> IO Packet Source #
Receive packet over Tcp.
tcp_socket :: (Socket -> SockAddr -> IO ()) -> Maybe String -> Int -> IO Socket Source #
Create and initialise Tcp socket.
socket_to_tcp :: Socket -> IO Tcp Source #
Convert Socket
to Tcp
.
tcp_handle :: (Socket -> SockAddr -> IO ()) -> String -> Int -> IO Tcp Source #
Create and initialise Tcp.
openTcp :: String -> Int -> IO Tcp Source #
Make a Tcp
connection.
import Sound.Osc.Datum {- hosc -} import Sound.Osc.Time {- hosc -} let t = openTcp "127.0.0.1" 57110 let m1 = Packet.message "/dumpOsc" [Int32 1] let m2 = Packet.message "/g_new" [Int32 1] Fd.withTransport t (\fd -> let f = Fd.sendMessage fd in f m1 >> pauseThread 0.25 >> f m2)
tcp_server_f :: Socket -> (Tcp -> IO ()) -> IO () Source #
accept
connection at s and run f.
tcp_server :: Int -> (Tcp -> IO ()) -> IO () Source #
A trivial Tcp
Osc server.