samer@0: /* samer@0: * Prolog library for sending and receiving OSC messages samer@0: * Samer Abdallah (2009) samer@0: */ samer@0: samer@0: :- module(plosc, [ samer@0: osc_now/2 % -Seconds:int, -Fraction:int samer@0: , osc_now/1 % -TS:osc_timestamp samer@0: , osc_mk_address/3 % +Host:atom, +Port:nonneg, -Ref:osc_addr samer@2: , osc_split_address/3 % +Ref:osc_addr, -Host:atom, -Port:nonneg samer@0: , osc_is_address/1 % +Ref samer@0: , osc_send/3 % +Ref, +Path:atom, +Args:list(osc_arg) samer@0: , osc_send/4 % +Ref, +Path:atom, +Args:list(osc_arg), +Time:float samer@0: , osc_send_from/5 % +Ref, +Ref, +Path:atom, +Args:list(osc_arg), +Time:float samer@0: , osc_mk_server/2 % +Port:nonneg, -Ref samer@0: , osc_start_server/1 % +Ref samer@0: , osc_stop_server/1 % +Ref samer@0: , osc_run_server/1 % +Ref samer@0: , osc_del_handler/3 % +Ref, +Path:atom, +Types:list(osc_arg) samer@0: , osc_add_handler/4 % +Ref, +Path:atom, +Types:list(osc_arg), +Goal:callable samer@0: , osc_add_handler_x/4 % +Ref, +Path:atom, +Types:list(osc_arg), +Goal:callable samer@0: samer@0: , osc_time_ts/2 samer@0: ]). samer@0: samer@0: :- meta_predicate osc_add_handler(+,+,+,2). samer@0: :- meta_predicate osc_add_handler_x(+,+,+,4). samer@0: samer@0: /** OSC server and client samer@0: samer@0: == samer@0: time == float. samer@0: osc_timestamp ---> osc_ts(int,int). samer@0: == samer@0: */ samer@5: :- use_foreign_library(foreign(plosc)). samer@0: samer@0: %% osc_mk_address(+Host:atom, +Port:nonneg, -Ref:osc_addr) is det. samer@0: % samer@0: % Construct a BLOB atom representing an OSC destination. samer@0: % samer@0: % @param Host is the hostname or IP address of the OSC receiver samer@0: % @param Port is the port number of the OSC receiver samer@0: % @param Ref is an atom representing the address samer@0: samer@2: %% osc_split_address(+Ref:osc_addr,-Host:atom, -Port:nonneg) is det. samer@2: % samer@2: % Deconstruct a BLOB atom representing an OSC destination. samer@2: % samer@2: % @param Ref is an atom representing the OSC address samer@2: % @param Host is the IP address of the OSC receiver samer@2: % @param Port is the port number of the OSC receiver samer@2: samer@0: %% osc_is_address(+Ref) is semidet. samer@0: % samer@0: % Succeeds if Ref is an OSC address created by osc_mk_address/3 samer@0: samer@0: %% osc_send(+Ref:osc_addr, +Path:atom, +Args:list(osc_arg)) is det. samer@0: %% osc_send(+Ref:osc_addr, +Path:atom, +Args:list(osc_arg), +Time:time) is det. samer@0: % samer@0: % Sends an OSC message scheduled for immediate execution (osc_send/3) or samer@0: % at a given time (osc_send/4). samer@0: % samer@0: % @param Ref is an OSC address BLOB as returned by osc_mk_address/3. samer@0: % @param Path is an atom representing the OSC message path, eg '/foo/bar' samer@0: % @param Args is a list of OSC message arguments, which can be any of: samer@0: % * string(+X:text) samer@0: % String as atom or Prolog string samer@0: % * symbol(+X:atom) samer@0: % * double(+X:float) samer@0: % Double precision floating point samer@0: % * float(+X:float) samer@0: % Single precision floating point samer@0: % * int(+X:integer) samer@0: % * true samer@0: % * false samer@0: % * nil samer@0: % * inf samer@0: % samer@0: osc_send(A,B,C) :- osc_send_now(A,B,C). samer@0: osc_send(A,B,C,T) :- T1 is T, osc_send_at(A,B,C,T1). samer@0: samer@0: %% osc_send_from(+Server:osc_server, +Address:osc_addr, +Path:atom, +Args:list(osc_arg), +T:time) is det. samer@0: % samer@0: % Like osc_send/4 but sets the return address to that of the given server. samer@0: osc_send_from(Srv,Targ,Path,Args,Time) :- T1 is Time, osc_send_from_at(Srv,Targ,Path,Args,T1). samer@0: samer@0: %% osc_now(-Secs:integer,-Frac:integer) is det. samer@0: % samer@0: % Gets the current OSC time in seconds and 1/2^64 ths of second. samer@0: samer@0: %% osc_now(-TS:osc_timestamp) is det. samer@0: % samer@0: % Gets the current OSC time in seconds and 1/2^64 ths of second. samer@0: osc_now(osc_ts(Secs,Fracs)) :- osc_now(Secs,Fracs). samer@0: samer@6: %% osc_time_ts(+Time:float,-TS:osc_timestamp) is det. samer@6: %% osc_time_ts(-Time:float,+TS:osc_timestamp) is det. samer@6: % samer@6: % Convert between floating point time as returned by get_time/1 and OSC samer@6: % timestamp structure as returned by osc_now/1. samer@0: osc_time_ts(Time,osc_ts(Secs,Fracs)) :- samer@0: ( var(Time) -> time_from_ts(Time,Secs,Fracs) samer@0: ; time_to_ts(Time,Secs,Fracs)). samer@0: samer@0: %% osc_mk_server(+Port:nonneg, -Ref:osc_server) is det. samer@0: % samer@0: % Create an OSC server and return a BLOB atom representing it. samer@0: % samer@0: % @param Port is the port number of the OSC server samer@0: % @param Ref is an atom representing the server samer@0: samer@0: %% osc_start_server(+Ref:osc_server) is det. samer@0: % samer@0: % Run the OSC server referred to by Ref in a new thread. The new thread samer@0: % dispatches OSC messages received to the appropriate handlers as registered samer@0: % using osc_add_handler/4. samer@0: samer@0: %% osc_stop_server(+Ref:osc_server) is det. samer@0: % samer@0: % If Ref refers to a running server thread, stop the thread. samer@0: samer@0: %% osc_run_server(+Ref:osc_server) is det. samer@0: % samer@0: % The OSC server is run in the current thread, and does not return until samer@0: % the message loop terminates. This can be triggered by sending the samer@0: % message /plosc/stop to the server. Using this synchronous server samer@0: % avoids creating a new thread and a new Prolog engine. samer@0: samer@0: %% osc_add_handler( +Ref:osc_server, +Path:atom, +Types:list(osc_arg), +Goal:handler) is det. samer@0: % samer@0: % This registers a callable goal to handle the specified message Path for the samer@0: % OSC server referred to by Ref. samer@0: % The handler type is =|handler == pred(+atom,+list(osc_arg)).|= samer@0: % samer@0: % @param Types is a list of terms specifying the argument types that this handler samer@0: % will match. The terms are just like those descibed in osc_send/3 samer@0: % and osc_send/4, except that the actual values are not used and samer@0: % can be left as anonymous variables, eg [int(_),string(_)]. samer@0: % Alternatively, Types can be the atom 'any', which will match any samer@0: % arguments. samer@0: % samer@0: % @param Goal is any term which can be called with call/3 with two further samer@0: % arguments, which will be the message Path and the argument list, eg samer@0: % call( Goal, '/foo', [int(45),string(bar)]). samer@0: samer@0: osc_add_handler(Ref,Path,Types,Goal) :- osc_add_method(Ref,Path,Types,Goal). samer@0: samer@0: %% osc_add_handler_x( +Ref:osc_server, +Path:atom, +Types:list(osc_arg), +Goal:handler_x) is det. samer@0: % samer@0: % This registers a callable goal to handle the specified message Path for the samer@0: % OSC server referred to by Ref. samer@0: % The extended handler type is =|handler_x == pred(+osc_addr,+time,+atom,+list(osc_arg)).|= samer@0: % samer@0: % @param Types is a list of terms specifying the argument types that this handler samer@0: % will match. The terms are just like those descibed in osc_send/3 samer@0: % and osc_send/4, except that the actual values are not used and samer@0: % can be left as anonymous variables, eg [int(_),string(_)]. samer@0: % Alternatively, Types can be the atom 'any', which will match any samer@0: % arguments. samer@0: % samer@1: % @param Goal is any term which can be called with call/3 with four further samer@1: % arguments, which will be the address of the sender, the timestamp of the samer@1: % message, message path and the argument list, eg samer@1: % call( Goal, SomeOSCAddress, Time, '/foo', [int(45),string(bar)]). samer@0: samer@0: osc_add_handler_x(Ref,Path,Types,Goal) :- osc_add_method_x(Ref,Path,Types,Goal). samer@0: samer@0: %% osc_del_handler( +Ref:osc_server, +Path:atom, +Types:list(osc_arg)) is det. samer@0: % samer@0: % Deregister a message handler previously registered with osc_add_handler/4. samer@0: samer@0: osc_del_handler(Ref,Path,Types) :- osc_del_method(Ref,Path,Types). samer@0: samer@0: samer@0: prolog:message(error(osc_error(Num,Msg,Path)), ['LIBLO error ~w: ~w [~w]'-[Num,Msg,Path] |Z],Z).