hosc-0.14: Haskell Open Sound Control

Safe HaskellSafe-Inferred

Sound.OSC.Type

Contents

Description

Alegbraic data types for OSC datum and packets.

Synopsis

Time

type Time = DoubleSource

NTP time in real-valued (fractional) form.

immediately :: TimeSource

Constant indicating a bundle to be executed immediately.

Datum

type Datum_Type = CharSource

Type enumerating Datum categories.

type ASCII = ByteStringSource

Type for ASCII strings (strict Char8 ByteString).

data MIDI Source

Four-byte midi message.

Constructors

MIDI Word8 Word8 Word8 Word8 

Instances

data Datum Source

The basic elements of OSC messages.

Constructors

Int32 

Fields

d_int32 :: Int32
 
Int64 

Fields

d_int64 :: Int64
 
Float 

Fields

d_float :: Float
 
Double 

Fields

d_double :: Double
 
ASCII_String 
Blob 

Fields

d_blob :: ByteString
 
TimeStamp 

Fields

d_timestamp :: Time
 
Midi 

Fields

d_midi :: MIDI
 

Instances

datum_tag :: Datum -> Datum_TypeSource

Single character identifier of an OSC datum.

datum_integral :: Integral i => Datum -> Maybe iSource

Datum as Integral if Int32 or Int64.

 let d = [Int32 5,Int64 5,Float 5.5,Double 5.5]
 in map datum_integral d == [Just (5::Int),Just 5,Nothing,Nothing]

datum_floating :: Floating n => Datum -> Maybe nSource

Datum as Floating if Int32, Int64, Float, Double or TimeStamp.

 let d = [Int32 5,Int64 5,Float 5,Double 5,TimeStamp 5]
 in Data.Maybe.mapMaybe datum_floating d == replicate 5 (5::Double)

class Datem a whereSource

Class for translating to and from Datum. There are instances for the direct Datum field types.

 d_put (1::Int32) == Int32 1
 d_put (1::Int64) == Int64 1
 d_put (1::Float) == Float 1
 d_put (1::Double) == Double 1
 d_put (C.pack "str") == ASCII_String (C.pack "str")
 d_put (B.pack [37,37]) == Blob (B.pack [37,37])
 d_put (MIDI 0 0 0 0) == Midi (MIDI 0 0 0 0)

There are also instances for standard Haskell types.

 d_put (1::Int) == Int64 1
 d_put (1::Integer) == Int64 1

Methods

d_put :: a -> DatumSource

d_get :: Datum -> Maybe aSource

int32 :: Integral n => n -> DatumSource

Type generalised Int32.

 int32 (1::Int32) == int32 (1::Integer)
 d_int32 (int32 (maxBound::Int32)) == maxBound
 int32 (((2::Int) ^ (64::Int))::Int) == Int32 0

int64 :: Integral n => n -> DatumSource

Type generalised Int64.

 int64 (1::Int32) == int64 (1::Integer)
 d_int64 (int64 (maxBound::Int64)) == maxBound

float :: Real n => n -> DatumSource

Type generalised Float.

 float (1::Int) == float (1::Double)
 floatRange (undefined::Float) == (-125,128)
 isInfinite (d_float (float (encodeFloat 1 256 :: Double))) == True

double :: Real n => n -> DatumSource

Type generalised Double.

 double (1::Int) == double (1::Double)
 double (encodeFloat 1 256 :: Double) == Double 1.157920892373162e77

string :: String -> DatumSource

ASCII_String of pack.

 string "string" == ASCII_String (C.pack "string")

midi :: (Word8, Word8, Word8, Word8) -> DatumSource

Four-tuple variant of Midi . MIDI.

 midi (0,0,0,0) == Midi (MIDI 0 0 0 0)

Message

type Address_Pattern = StringSource

OSC address pattern. This is strictly an ASCII value, but it is very common to pattern match on addresses and matching on ByteString requires OverloadedStrings.

data Message Source

An OSC message.

message :: Address_Pattern -> [Datum] -> MessageSource

Message constructor. It is an error if the Address_Pattern doesn't conform to the OSC specification.

descriptor :: [Datum] -> ASCIISource

Message argument types are given by a descriptor.

 C.unpack (descriptor [Int32 1,Float 1,string "1"]) == ",ifs"

descriptor_tags :: ASCII -> ASCIISource

Descriptor tags are comma prefixed.

Bundle

data Bundle Source

An OSC bundle.

Constructors

Bundle 

Instances

Eq Bundle 
Ord Bundle

OSC Bundles can be ordered (time ascending).

Read Bundle 
Show Bundle 
OSC Bundle 

bundle :: Time -> [Message] -> BundleSource

Bundle constructor. It is an error if the Message list is empty.

Packet

data Packet Source

An OSC Packet is either a Message or a Bundle.

packetTime :: Packet -> TimeSource

The Time of Packet, if the Packet is a Message this is immediately.

packetMessages :: Packet -> [Message]Source

Retrieve the set of Messages from a Packet.

packet_to_bundle :: Packet -> BundleSource

If Packet is a Message add immediately timestamp, else id.

packet_to_message :: Packet -> Maybe MessageSource

If Packet is a Message or a Bundle with an immediate time tag and with one element, return the Message, else Nothing.

packet_is_immediate :: Packet -> BoolSource

Is Packet immediate, ie. a Bundle with timestamp immediately, or a plain Message.

at_packet :: (Message -> a) -> (Bundle -> a) -> Packet -> aSource

Variant of either for Packet.

Address Query

bundle_has_address :: Address_Pattern -> Bundle -> BoolSource

Do any of the Messages at Bundle have the specified Address_Pattern.

Pretty printing

timePP :: Time -> StringSource

Pretty printer for Time (truncate to 4 decimal places).

 timePP (1/3) == "0.3333"

vecPP :: Show a => [a] -> StringSource

Pretty printer for vectors.

 vecPP [1::Int,2,3] == "<1,2,3>"

datumPP :: Datum -> StringSource

Pretty printer for Datum.

 let d = [Int32 1,Float 1.2,string "str",midi (0,0x90,0x40,0x60)]
 in map datumPP d ==  ["1","1.2","\"str\"","<0,144,64,96>"]

messagePP :: Message -> StringSource

Pretty printer for Message.

bundlePP :: Bundle -> StringSource

Pretty printer for Bundle.

packetPP :: Packet -> StringSource

Pretty printer for Packet.

Parser

readMaybe :: Read a => String -> Maybe aSource

Variant of read.

parse_datum :: Datum_Type -> String -> Maybe DatumSource

Given Datum_Type attempt to parse Datum at String.

 parse_datum 'i' "42" == Just (Int32 42)
 parse_datum 'h' "42" == Just (Int64 42)
 parse_datum 'f' "3.14159" == Just (Float 3.14159)
 parse_datum 'd' "3.14159" == Just (Double 3.14159)
 parse_datum 's' "\"pi\"" == Just (string "pi")
 parse_datum 'b' "[112,105]" == Just (Blob (B.pack [112,105]))
 parse_datum 'm' "(0,144,60,90)" == Just (midi (0,144,60,90))