samer@0: /*
samer@0:  *  Copyright (C) 2009 Samer Abdallah
samer@0:  *
samer@0:  *  This program is free software; you can redistribute it and/or modify
samer@0:  *  it under the terms of the GNU General Public License as published by
samer@0:  *  the Free Software Foundation; either version 2 of the License, or
samer@0:  *  (at your option) any later version.
samer@0:  *
samer@0:  *  This program is distributed in the hope that it will be useful,
samer@0:  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
samer@0:  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
samer@0:  *  GNU General Public License for more details.
samer@0:  *
samer@0:  */
samer@0: 
samer@0: #include <SWI-Stream.h>
samer@0: #include <SWI-Prolog.h>
samer@0: 
samer@0: #include <stdio.h>
samer@0: #include <string.h>
samer@0: #include <math.h>
samer@0: #include <lo/lo.h>
samer@0: 
samer@0: // ---------------------------------------------------------------------------
samer@0: 
samer@0: // Reimplementation of lo_server_thread to all calls to
samer@0: // Prolog from the server thread.
samer@0: 
samer@0: typedef struct _my_server_thread {
samer@0: 	lo_server    s;
samer@0: 	pthread_t    thread;
samer@4: 	int          timeout;
samer@0: 	volatile int active;
samer@0: 	volatile int done;
samer@0: } *my_server_thread;
samer@0: 
samer@0: int my_server_thread_start(my_server_thread st);
samer@0: int my_server_thread_stop(my_server_thread st);
samer@4: int my_server_thread_run(my_server_thread st);
samer@0: void my_server_thread_free(my_server_thread st);
samer@0: my_server_thread my_server_thread_new(const char *port, lo_err_handler err_h);
samer@0: 
samer@0: // ---------------------------------------------------------------------------
samer@0: 
samer@0: // BLOB to hold a lo_address
samer@0: static PL_blob_t addr_blob;
samer@0: 
samer@0: // BLOB to hold server thread
samer@0: static PL_blob_t server_blob;
samer@0: 
samer@0: static predicate_t call3, call5;
samer@0: static atom_t osc_immed;
samer@0: static functor_t osc_ts_2;
samer@0: static functor_t int_1, float_1, double_1, string_1;
samer@0: 
samer@0: install_t install();
samer@0: 
samer@0: foreign_t mk_address( term_t host, term_t port, term_t addr); 
samer@2: foreign_t split_address( term_t addr, term_t host, term_t port); 
samer@0: foreign_t is_address( term_t addr); 
samer@0: foreign_t send_osc_now( term_t addr, term_t msg, term_t args); 
samer@0: foreign_t send_osc_at( term_t addr, term_t msg, term_t args, term_t time); 
samer@0: foreign_t send_osc_from_at( term_t serv, term_t addr, term_t msg, term_t args, term_t time); 
samer@0: foreign_t send_timestamped( term_t addr, term_t msg, term_t args, term_t sec, term_t frac); 
samer@0: foreign_t now( term_t sec, term_t frac);
samer@0: foreign_t time_to_ts( term_t time, term_t sec, term_t frac);
samer@0: foreign_t time_from_ts( term_t time, term_t sec, term_t frac);
samer@0: 
samer@0: // OSC server predicates
samer@0: foreign_t mk_server( term_t port, term_t server);
samer@0: foreign_t start_server( term_t server);
samer@0: foreign_t stop_server( term_t server);
samer@0: foreign_t del_handler( term_t server, term_t msg, term_t types);
samer@0: foreign_t add_handler( term_t server, term_t msg, term_t types, term_t handler);
samer@0: foreign_t add_handler_x( term_t server, term_t msg, term_t types, term_t handler);
samer@0: foreign_t run_server( term_t server);
samer@0: 
samer@0: 
samer@0: // BLOB functions
samer@0: int addr_release(atom_t a) {
samer@0: 	PL_blob_t *type;
samer@0: 	size_t    len;
samer@0: 	void *p=PL_blob_data(a,&len,&type);
samer@0: 	if (p) lo_address_free(*(lo_address *)p);
samer@0: 	return TRUE;
samer@0: }
samer@0: 
samer@0: int addr_write(IOSTREAM *s, atom_t a, int flags) {
samer@0: 	PL_blob_t *type;
samer@0: 	size_t    len;
samer@0: 	lo_address *p=(lo_address *)PL_blob_data(a,&len,&type);
samer@0: 	if (p) {
samer@0: 		const char *host = lo_address_get_hostname(*p);
samer@0: 		const char *port = lo_address_get_port(*p);
samer@0: 		if (host!=NULL && port!=NULL) {
samer@0: 			Sfprintf(s,"osc_address<%s:%s>",host,port);
samer@0: 		} else {
samer@0: 			Sfprintf(s,"osc_address<invalid>");
samer@0: 		}
samer@0: 	}
samer@0: 	return TRUE;
samer@0: }
samer@0: 
samer@0: int server_release(atom_t a) {
samer@0: 	PL_blob_t *type;
samer@0: 	size_t    len;
samer@0: 	void *p=PL_blob_data(a,&len,&type);
samer@0: 	if (p) my_server_thread_free(*(my_server_thread *)p);
samer@0: 	return TRUE;
samer@0: }
samer@0: 
samer@0: int server_write(IOSTREAM *s, atom_t a, int flags) {
samer@0: 	PL_blob_t *type;
samer@0: 	size_t    len;
samer@0: 	my_server_thread *p=(my_server_thread *)PL_blob_data(a,&len,&type);
samer@0: 	if (p) {
samer@0: 		char *url=lo_server_get_url((*p)->s);
samer@0: 		Sfprintf(s,"osc_server<%s>",url);
samer@0: 		free(url);
samer@0: 	}
samer@0: 	return TRUE;
samer@0: }
samer@0: 
samer@0: install_t install() { 
samer@2: 	PL_register_foreign("osc_now",          2, (void *)now, 0);
samer@2: 	PL_register_foreign("time_to_ts",       3, (void *)time_to_ts, 0);
samer@2: 	PL_register_foreign("time_from_ts",     3, (void *)time_from_ts, 0);
samer@2: 	PL_register_foreign("osc_mk_address",   3, (void *)mk_address, 0);
samer@2: 	PL_register_foreign("osc_split_address",3, (void *)split_address, 0);
samer@2: 	PL_register_foreign("osc_is_address",   1, (void *)is_address, 0);
samer@2: 	PL_register_foreign("osc_send_now",     3, (void *)send_osc_now, 0);
samer@2: 	PL_register_foreign("osc_send_at",      4, (void *)send_osc_at, 0);
samer@0: 	PL_register_foreign("osc_send_from_at", 5, (void *)send_osc_from_at, 0);
samer@0: 	PL_register_foreign("osc_mk_server",    2, (void *)mk_server, 0);
samer@0: 	PL_register_foreign("osc_start_server", 1, (void *)start_server, 0);
samer@0: 	PL_register_foreign("osc_stop_server",  1, (void *)stop_server, 0);
samer@0: 	PL_register_foreign("osc_run_server",   1, (void *)run_server, 0);
samer@0: 	PL_register_foreign("osc_del_method",   3, (void *)del_handler, 0);
samer@0: 	PL_register_foreign("osc_add_method",   4, (void *)add_handler, 0);
samer@0: 	PL_register_foreign("osc_add_method_x", 4, (void *)add_handler_x, 0);
samer@0: 
samer@0: 	addr_blob.magic = PL_BLOB_MAGIC;
samer@0: 	addr_blob.flags = PL_BLOB_UNIQUE;
samer@0: 	addr_blob.name = "osc_address";
samer@0: 	addr_blob.acquire = 0;
samer@0: 	addr_blob.release = addr_release;
samer@0: 	addr_blob.write   = addr_write;
samer@0: 	addr_blob.compare = 0; 
samer@0: 
samer@0: 	server_blob.magic = PL_BLOB_MAGIC;
samer@0: 	server_blob.flags = PL_BLOB_UNIQUE;
samer@0: 	server_blob.name = "osc_server";
samer@0: 	server_blob.acquire = 0; 
samer@0: 	server_blob.release = server_release;
samer@0: 	server_blob.write   = server_write; 
samer@0: 	server_blob.compare = 0; 
samer@0: 
samer@0: 	call3 = PL_predicate("call",3,"user");
samer@0: 	call5 = PL_predicate("call",5,"user");
samer@0: 	osc_immed = PL_new_atom("osc_immed");
samer@0: 	osc_ts_2  = PL_new_functor(PL_new_atom("osc_ts"),2);
samer@0: 	int_1     = PL_new_functor(PL_new_atom("int"),1);
samer@0: 	float_1   = PL_new_functor(PL_new_atom("float"),1);
samer@0: 	double_1  = PL_new_functor(PL_new_atom("double"),1);
samer@0: 	string_1  = PL_new_functor(PL_new_atom("string"),1);
samer@0: }
samer@0: 
samer@0: // throws a Prolog exception to signal type error
samer@0: static int type_error(term_t actual, const char *expected)
samer@0: { 
samer@0: 	term_t ex = PL_new_term_ref();
samer@0: 	int rc;
samer@0: 
samer@0:   rc = PL_unify_term(ex, PL_FUNCTOR_CHARS, "error", 2,
samer@0: 		      PL_FUNCTOR_CHARS, "type_error", 2,
samer@0: 		        PL_CHARS, expected,
samer@0: 		        PL_TERM, actual,
samer@0: 		      PL_VARIABLE);
samer@0: 
samer@0:   return PL_raise_exception(ex);
samer@0: }
samer@0: 
samer@0: static int osc_error(int errno, const char *errmsg, const char *msg)
samer@0: { 
samer@0: 	term_t ex = PL_new_term_ref();
samer@0: 	int rc;
samer@0: 
samer@0:   rc=PL_unify_term(ex, PL_FUNCTOR_CHARS, "error", 1,
samer@0: 		      PL_FUNCTOR_CHARS, "osc_error", 3,
samer@0: 		        PL_INTEGER, errno,
samer@0: 		        PL_CHARS, errmsg,
samer@0: 		        PL_CHARS, msg==NULL ? "none" : msg);
samer@0: 
samer@0:   return PL_raise_exception(ex);
samer@0: }
samer@0: 
samer@0: static int arg_error(const char *type, term_t arg)
samer@0: { 
samer@0: 	term_t ex = PL_new_term_ref();
samer@0: 	int rc;
samer@0: 
samer@0:   rc=PL_unify_term(ex, PL_FUNCTOR_CHARS, "error", 1,
samer@0: 		      PL_FUNCTOR_CHARS, "arg_error", 2,
samer@0: 		        PL_CHARS, type,
samer@0: 		        PL_TERM, arg);
samer@0: 
samer@0:   return PL_raise_exception(ex);
samer@0: }
samer@0: 
samer@0: // put lo_address into a Prolog BLOB 
samer@0: static int unify_addr(term_t addr,lo_address a) {
samer@0: 	return PL_unify_blob(addr, &a, sizeof(lo_address), &addr_blob); 
samer@0: }
samer@0: 
samer@0: // get lo_address from BLOB
samer@0: static int get_addr(term_t addr, lo_address *a)
samer@0: { 
samer@0: 	PL_blob_t *type;
samer@0: 	size_t    len;
samer@0: 	lo_address *a1;
samer@0:   
samer@0: 	PL_get_blob(addr, (void **)&a1, &len, &type);
samer@0: 	if (type != &addr_blob) {
samer@0: 		return type_error(addr, "osc_address");
samer@0: 	} else {
samer@0: 		*a=*a1;
samer@0: 		return TRUE;
samer@0: 	}
samer@0: } 
samer@0: 
samer@0: // put lo_address into a Prolog BLOB 
samer@0: static int unify_server(term_t server,my_server_thread s) {
samer@0: 	return PL_unify_blob(server, &s, sizeof(my_server_thread), &server_blob); 
samer@0: }
samer@0: 
samer@0: // get my_server_thread from BLOB
samer@0: static int get_server(term_t server, my_server_thread *a)
samer@0: { 
samer@0: 	PL_blob_t *type;
samer@0: 	size_t    len;
samer@0: 	my_server_thread *a1;
samer@0:   
samer@0: 	PL_get_blob(server, (void **)&a1, &len, &type);
samer@0: 	if (type != &server_blob) {
samer@0: 		return type_error(server, "osc_server");
samer@0: 	} else {
samer@0: 		*a=*a1;
samer@0: 		return TRUE;
samer@0: 	}
samer@0: } 
samer@0: 
samer@0: // get Prolog (Unix) time value and convert to OSC timestamp
samer@0: static int get_prolog_time(term_t time, lo_timetag *ts) {
samer@0: 	double t, ft;
samer@0: 	int 	ok = PL_get_float(time, &t);
samer@0: 
samer@0: 	ft=floor(t);
samer@0: 	ts->sec = ((uint32_t)ft)+2208988800u;
samer@0: 	ts->frac = (uint32_t)(4294967296.0*(t-ft));
samer@0: 	return ok;
samer@0: }
samer@0: 
samer@0: static int get_timetag(term_t sec, term_t frac, lo_timetag *ts) {
samer@0: 	int64_t	s, f;
samer@0: 	int 	ok = PL_get_int64(sec, &s) && PL_get_int64(frac, &f);
samer@0: 	ts->sec = s;
samer@0: 	ts->frac = f;
samer@0: 	return ok;
samer@0: }
samer@0: 
samer@0: 
samer@0: static int get_msg(term_t msg, char **m) {
samer@0: 	int rc=PL_get_chars(msg, m, CVT_ATOM | CVT_STRING);
samer@0: 	if (rc && strcmp(*m,"any")==0) *m=NULL; 
samer@0: 	return rc;
samer@0: }
samer@0: 
samer@0: // parse a list of Prolog terms and add arguments to an OSC message 
samer@0: static int add_msg_args(lo_message msg, term_t list)
samer@0: {
samer@0: 	term_t 	head=PL_new_term_ref();
samer@0: 
samer@0: 	// copy term ref so as not to modify original
samer@0: 	list=PL_copy_term_ref(list);
samer@0: 
samer@0: 	while (PL_get_list(list,head,list)) {
samer@0: 		atom_t name;
samer@0: 		int	 rc, arity;
samer@0: 		const char  *type;
samer@0: 
samer@0: 		if (!PL_get_name_arity(head,&name,&arity)) return type_error(head,"term");
samer@0: 		type=PL_atom_chars(name);
samer@0: 		switch (arity) {
samer@0: 		case 1: {
samer@0: 				term_t a1=PL_new_term_ref();
samer@0: 				rc=PL_get_arg(1,head,a1); // !!!! check return value
samer@0: 
samer@0: 				if (!strcmp(type,"int")) {
samer@0: 					int x;
samer@0: 					if (!PL_get_integer(a1,&x)) return type_error(a1,"integer");
samer@0: 					lo_message_add_int32(msg,x);
samer@0: 				} else if (!strcmp(type,"double")) {
samer@0: 					double x;
samer@0: 					if (!PL_get_float(a1,&x)) return type_error(a1,"float");
samer@0: 					lo_message_add_double(msg,x);
samer@0: 				} else if (!strcmp(type,"string")) {
samer@0: 					char *x;
samer@0: 					if (!PL_get_chars(a1,&x,CVT_ATOM|CVT_STRING)) return type_error(a1,"string");
samer@0: 					lo_message_add_string(msg,x);
samer@0: 				} else if (!strcmp(type,"symbol")) {
samer@0: 					char *x;
samer@0: 					if (!PL_get_chars(a1,&x,CVT_ATOM)) return type_error(a1,"atom");
samer@0: 					lo_message_add_symbol(msg,x);
samer@0: 				} else if (!strcmp(type,"float")) {
samer@0: 					double x;
samer@0: 					if (!PL_get_float(a1,&x)) return type_error(a1,"float");
samer@0: 					lo_message_add_float(msg,(float)x);
samer@0: 				} else {
samer@0: 					return arg_error(type,head);
samer@0: 				}
samer@0: 
samer@0: 				break;
samer@0: 			}
samer@0: 		case 0: {
samer@0: 				if (!strcmp(type,"true")) lo_message_add_true(msg);
samer@0: 				else if (!strcmp(type,"false")) lo_message_add_false(msg);
samer@0: 				else if (!strcmp(type,"nil")) lo_message_add_nil(msg);
samer@0: 				else if (!strcmp(type,"inf")) lo_message_add_infinitum(msg);
samer@0: 				break;
samer@0: 			}
samer@0: 		}
samer@0: 	}
samer@0: 	if (!PL_get_nil(list)) return type_error(list,"nil");
samer@0: 	return TRUE;
samer@0: }
samer@0: 
samer@0: static int send_msg_timestamped(lo_address a, lo_timetag *ts, char *path, term_t args)
samer@0: {
samer@0: 	lo_message msg=lo_message_new();
samer@0: 	lo_bundle  bun=lo_bundle_new(*ts);
samer@0: 
samer@0: 	if (add_msg_args(msg,args)) {
samer@0: 		int ret;
samer@0: 
samer@0: 		lo_bundle_add_message(bun,path,msg);
samer@0: 		ret = lo_send_bundle(a,bun);
samer@0: 		lo_message_free(msg);
samer@0: 		lo_bundle_free(bun);
samer@0: 		if (ret==-1) {
samer@0: 			return osc_error(lo_address_errno(a),lo_address_errstr(a),path);
samer@0: 		} else {
samer@0: 			return TRUE;
samer@0: 		}
samer@0: 	} else return FALSE;
samer@0: }
samer@0: 
samer@0: static int send_msg_timestamped_from(lo_address a, lo_server s, lo_timetag *ts, char *path, term_t args)
samer@0: {
samer@0: 	lo_message msg=lo_message_new();
samer@0: 	lo_bundle  bun=lo_bundle_new(*ts);
samer@0: 
samer@0: 	if (add_msg_args(msg,args)) {
samer@0: 		int ret;
samer@0: 
samer@0: 		lo_bundle_add_message(bun,path,msg);
samer@0: 		ret = lo_send_bundle_from(a,s,bun);
samer@0: 		lo_message_free(msg);
samer@0: 		lo_bundle_free(bun);
samer@0: 		if (ret==-1) {
samer@0: 			return osc_error(lo_address_errno(a),lo_address_errstr(a),path);
samer@0: 		} else {
samer@0: 			return TRUE;
samer@0: 		}
samer@0: 	} else return FALSE;
samer@0: }
samer@0: 
samer@0: static int send_msg(lo_address a, char *path, term_t args)
samer@0: {
samer@0: 	lo_message msg=lo_message_new();
samer@0: 
samer@0: 	if (add_msg_args(msg,args)) {
samer@0: 		if (lo_send_message(a,path,msg)==-1) {
samer@0: 			lo_message_free(msg);
samer@0: 			return osc_error(lo_address_errno(a),lo_address_errstr(a),path);
samer@0: 		} else {
samer@0: 			lo_message_free(msg);
samer@0: 			return TRUE;
samer@0: 		}
samer@0: 	} else return FALSE;
samer@0: }
samer@0: 
samer@0: foreign_t mk_address(term_t host, term_t port, term_t addr) { 
samer@0: 	char *h, *p;
samer@0: 
samer@0: 	if (PL_get_chars(host, &h, CVT_ATOM | CVT_STRING)) {
samer@0: 		if (PL_get_chars(port, &p, CVT_INTEGER)) {
samer@0: 			lo_address a = lo_address_new(h,p);
samer@0: 			return unify_addr(addr,a);
samer@0: 		} else {
samer@0: 			return type_error(port,"integer");
samer@0: 		}
samer@0: 	} else {
samer@0: 		return type_error(host,"atom");
samer@0: 	}
samer@0: }
samer@0: 
samer@2: foreign_t split_address(term_t addr, term_t host, term_t port) { 
samer@2: 	lo_address 	a;
samer@2: 	const char *h, *p;
samer@2: 
samer@2: 	return get_addr(addr,&a)
samer@2: 		&& (h=lo_address_get_hostname(a))!=NULL
samer@2: 		&& (p=lo_address_get_port(a))!=NULL
samer@2: 		&& PL_unify_atom_chars(host,h)
samer@2: 		&& PL_unify_integer(port,atoi(p));
samer@2: }
samer@2: 
samer@0: foreign_t now(term_t sec, term_t frac) { 
samer@0: 	lo_timetag ts;
samer@0: 	int64_t s, f;
samer@0: 
samer@0: 	lo_timetag_now(&ts);
samer@0: 	s=ts.sec; f=ts.frac;
samer@0: 	return PL_unify_int64(sec,s) && PL_unify_int64(frac,f);
samer@0: }
samer@0: 
samer@0: foreign_t time_to_ts(term_t time, term_t sec, term_t frac) { 
samer@0: 	lo_timetag ts;
samer@0: 
samer@0: 	return get_prolog_time(time,&ts) &&
samer@0: 	       PL_unify_int64(sec,ts.sec) && 
samer@0: 			 PL_unify_int64(frac,ts.frac);
samer@0: }
samer@0: 
samer@0: foreign_t time_from_ts(term_t time, term_t sec, term_t frac) { 
samer@0: 	lo_timetag ts;
samer@0: 
samer@0: 	return get_timetag(sec,frac,&ts) &&
samer@0: 	  PL_unify_float(time, (double)(ts.sec-2208988800u) + ts.frac/4294967296.0);
samer@0: }
samer@0: 
samer@0: 
samer@0: 
samer@0: // set current random state structure to values in Prolog term
samer@0: foreign_t is_address(term_t addr) { 
samer@0: 	PL_blob_t *type;
samer@0: 	return PL_is_blob(addr,&type) && type==&addr_blob;
samer@0: }
samer@0: 
samer@0: foreign_t send_osc_from_at(term_t serv, term_t addr, term_t msg, term_t args, term_t time) {
samer@0: 	my_server_thread s;
samer@0: 	lo_address 	a;
samer@0: 	lo_timetag  ts;
samer@0: 	char			*m;
samer@0: 
samer@0: 	return get_addr(addr,&a) &&
samer@0: 			get_server(serv,&s) &&
samer@0: 			get_prolog_time(time,&ts) &&
samer@0: 			get_msg(msg, &m) &&
samer@0: 			send_msg_timestamped_from(a,s->s,&ts,m,args);
samer@0: }
samer@0: 
samer@0: foreign_t send_osc_at(term_t addr, term_t msg, term_t args, term_t time) {
samer@0: 	lo_address 	a;
samer@0: 	lo_timetag  ts;
samer@0: 	char			*m;
samer@0: 
samer@0: 	return get_addr(addr,&a) &&
samer@0: 			get_prolog_time(time,&ts) &&
samer@0: 			get_msg(msg, &m) &&
samer@0: 			send_msg_timestamped(a,&ts,m,args);
samer@0: }
samer@0: 
samer@0: foreign_t send_timestamped(term_t addr, term_t msg, term_t args, term_t secs, term_t frac) {
samer@0: 	lo_address 	a;
samer@0: 	lo_timetag  ts;
samer@0: 	char			*m;
samer@0: 
samer@0: 	return get_addr(addr,&a) &&
samer@0: 			get_timetag(secs,frac,&ts) &&
samer@0: 			get_msg(msg, &m) &&
samer@0: 			send_msg_timestamped(a,&ts,m,args);
samer@0: }
samer@0: 
samer@0: 
samer@0: 
samer@0: foreign_t send_osc_now(term_t addr, term_t msg, term_t args) {
samer@0: 	lo_address 	a;
samer@0: 	char			*m;
samer@0: 
samer@0: 	return get_addr(addr,&a) &&
samer@0: 			get_msg(msg, &m) &&
samer@0: 			send_msg(a,m,args);
samer@0: }
samer@0: 
samer@0: 
samer@0: 
samer@0: /* 
samer@0:  * Server Bits 
samer@0:  */
samer@0: 
samer@0: static void prolog_thread_func(void *data);
samer@0: 
samer@0: // parse a list of type terms and encode as a NULL terminated
samer@0: // string where each character encodes the type of one argument.
samer@0: static int get_types_list(term_t list, char *typespec, int len)
samer@0: {
samer@0: 	term_t 	head=PL_new_term_ref();
samer@0: 	int		count=0;
samer@0: 
samer@0: 	// copy term ref so as not to modify original
samer@0: 	list=PL_copy_term_ref(list);
samer@0: 
samer@0: 	while (PL_get_list(list,head,list) && count<len) {
samer@0: 		atom_t name;
samer@0: 		int	 arity;
samer@0: 		const char  *type;
samer@0: 
samer@0: 		if (!PL_get_name_arity(head,&name,&arity)) return type_error(head,"term");
samer@0: 		type=PL_atom_chars(name);
samer@0: 		switch (arity) {
samer@0: 		case 1: {
samer@0: 				if (!strcmp(type,"int")) {
samer@0: 					typespec[count++]='i';
samer@0: 				} else if (!strcmp(type,"double")) {
samer@0: 					typespec[count++]='d';
samer@0: 				} else if (!strcmp(type,"string")) {
samer@0: 					typespec[count++]='s';
samer@0: 				} else if (!strcmp(type,"symbol")) {
samer@0: 					typespec[count++]='S';
samer@0: 				} else if (!strcmp(type,"float")) {
samer@0: 					typespec[count++]='f';
samer@0: 				}
samer@0: 				break;
samer@0: 			}
samer@0: 		case 0: {
samer@0: 				if (!strcmp(type,"true")) typespec[count++]='T';
samer@0: 				else if (!strcmp(type,"false")) typespec[count++]='F';
samer@0: 				else if (!strcmp(type,"nil")) typespec[count++]='N';
samer@0: 				else if (!strcmp(type,"inf")) typespec[count++]='I';
samer@0: 				break;
samer@0: 			}
samer@0: 		}
samer@0: 	}
samer@0: 	typespec[count]=0;
samer@0: 	if (!PL_get_nil(list)) return type_error(list,"nil");
samer@0: 	return TRUE;
samer@0: }
samer@0: 
samer@0: // parse a term representing argument types - types can be a list
samer@0: // as accepted by get_types_list() above or the atom 'any'
samer@0: static int get_types(term_t types, char *buffer, int len, char **typespec)
samer@0: {
samer@0: 	if (PL_is_list(types)) {
samer@0: 		*typespec=buffer;
samer@0: 		return get_types_list(types,buffer,len);
samer@0: 	} else if (PL_is_atom(types)) {
samer@0: 		char *a;
samer@0: 		if (PL_get_atom_chars(types,&a) && strcmp(a,"any")==0) { 
samer@0: 			*typespec=NULL; return TRUE; 
samer@0: 		} else return type_error(types,"list or 'any'");
samer@0: 	} else return type_error(types,"list or 'any'");
samer@0: }
samer@0: 
samer@0: // handler server error
samer@0: static void server_error(int num, const char *msg, const char *path) {
samer@0: 	osc_error(num,msg,path);
samer@0: }
samer@0: 
samer@0: // handle the /plosc/stop message for the synchronous server loop
samer@0: // in run_stoppable_server() and hence osc_run_server/1
samer@0: static int stop_handler(const char *path, const char *types, lo_arg **argv,
samer@0: 		    int argc, lo_message msg, void *user_data) 
samer@0: {
samer@0: 	my_server_thread s=(my_server_thread)user_data;
samer@0: 	s->active=0;
samer@0: 	return 1;
samer@0: }
samer@0: 
samer@0: // get message arguments and unify given term with list of arg terms
samer@0: static int unify_msg_args(term_t list, const char *types, lo_arg **argv, int argc) 
samer@0: {
samer@0: 	int i, rc=0;
samer@0: 	for (i=0; i<argc; i++) {
samer@0: 		term_t head=PL_new_term_ref();
samer@0: 		term_t tail=PL_new_term_ref();
samer@0: 		if (!PL_unify_list(list,head,tail)) PL_fail; 
samer@0: 		switch (types[i]) {
samer@0: 			case 'i': rc=PL_unify_term(head,PL_FUNCTOR, int_1,    PL_INT,argv[i]->i); break;
samer@0: 			case 'f': rc=PL_unify_term(head,PL_FUNCTOR, float_1,  PL_FLOAT,(double)argv[i]->f); break;
samer@0: 			case 'd': rc=PL_unify_term(head,PL_FUNCTOR, double_1, PL_DOUBLE,argv[i]->d); break;
samer@0: 			case 's': rc=PL_unify_term(head,PL_FUNCTOR, string_1, PL_CHARS,&argv[i]->s); break;
samer@0: 			case 'h': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"int64",1,PL_INT64,argv[i]->h); break;
samer@0: 			case 'c': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"char",1,PL_INT,(int)argv[i]->c); break;
samer@0: 			case 'S': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"symbol",1,PL_CHARS,&argv[i]->S); break;
samer@0: 			case 'T': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"true",0); break;
samer@0: 			case 'F': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"false",0); break;
samer@0: 			case 'N': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"nil",0); break;
samer@0: 			case 'I': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"inf",0); break;
samer@0: 			case 'b': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"blob",0); break;
samer@0: 			case 't': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"timetag",2,
samer@0: 								PL_INT64,(int64_t)argv[i]->t.sec,
samer@0: 								PL_INT64,(int64_t)argv[i]->t.frac); 
samer@0: 						 break;
samer@0: 			case 'm': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"midi",4,
samer@0: 								PL_INT,(int)argv[i]->m[0], PL_INT,(int)argv[i]->m[1],
samer@0: 								PL_INT,(int)argv[i]->m[2], PL_INT,(int)argv[i]->m[3]);
samer@0: 						 break;
samer@0: 		}
samer@0: 		if (!rc) PL_fail;
samer@0: 		list=tail;
samer@0: 	}
samer@0: 	return PL_unify_nil(list);
samer@0: }
samer@0: 
samer@0: // handle OSC message by calling the associated Prolog goal
samer@0: static int prolog_handler(const char *path, const char *types, lo_arg **argv,
samer@0: 		    int argc, lo_message msg, void *user_data) 
samer@0: {
samer@0: 	term_t goal  = PL_new_term_ref();
samer@0: 	term_t term0 = PL_new_term_refs(3);
samer@0: 
samer@0: 
samer@0: 	PL_recorded((record_t)user_data,goal); // retrieve the goal term
samer@0: 	PL_put_term(term0,goal); // term_t goal encoded in user_data
samer@0: 	PL_put_atom_chars(term0+1,path);
samer@0: 
samer@0: 	return !( unify_msg_args(PL_copy_term_ref(term0+2),types,argv,argc) 
samer@0: 	       && PL_call_predicate(NULL,PL_Q_NORMAL,call3,term0));
samer@0: }
samer@0: 
samer@0: static int prolog_handler_x(const char *path, const char *types, lo_arg **argv,
samer@0: 		    int argc, lo_message msg, void *user_data) 
samer@0: {
samer@0: 	term_t goal  = PL_new_term_ref();
samer@0: 	term_t term0 = PL_new_term_refs(5);
samer@3: 	int rc;
samer@0: 
samer@0: 	lo_timetag ts = lo_message_get_timestamp(msg);
samer@0: 	lo_address sender = lo_message_get_source(msg);
samer@3: 	lo_address sender_copy;
samer@3: 
samer@3: 	{	
samer@3: 		const char *host=lo_address_get_hostname(sender);
samer@3: 		const char *port=lo_address_get_port(sender);
samer@3: 		sender_copy=lo_address_new(host,port);
samer@3: 	}
samer@0: 
samer@0: 	PL_recorded((record_t)user_data,goal); // retrieve the goal term
samer@0: 	PL_put_term(term0,goal); // term_t goal encoded in user_data
samer@0: 	PL_put_atom_chars(term0+3,path);
samer@0: 
samer@3: 
samer@3: 	if (ts.sec==0u) rc=PL_put_atom(term0+2,osc_immed);
samer@0: 	else { 
samer@0: 		rc=PL_unify_term( term0+2, PL_FUNCTOR, osc_ts_2, 
samer@0: 				PL_INT64, (int64_t)ts.sec,
samer@0: 				PL_INT64, (int64_t)ts.frac);
samer@0: 	}
samer@3: 
samer@0: 	// PL_put_float(term0+2, (double)(ts.sec-2208988800u) + ts.frac/4294967296.0);
samer@0: 
samer@0: 	return !( rc
samer@3: 	       && unify_addr(term0+1,sender_copy)
samer@3: 		 //	 && PL_put_atom_chars(term0+1,"orac")
samer@0: 	       && unify_msg_args(PL_copy_term_ref(term0+4),types,argv,argc) 
samer@0: 			 && PL_call_predicate(NULL,PL_Q_NORMAL,call5,term0));
samer@0: }
samer@0: 
samer@0: /*
samer@0: static int generic_handler(const char *path, const char *types, lo_arg **argv,
samer@0: 		    int argc, lo_message msg, void *user_data) 
samer@0: {
samer@0: 	int i;
samer@0: 
samer@0: 	printf("path: <%s>\n", path);
samer@0: 	for (i=0; i<argc; i++) {
samer@0: 		printf("arg %d '%c' ", i, types[i]);
samer@0: 		lo_arg_pp(types[i], argv[i]);
samer@0: 		printf("\n");
samer@0: 	}
samer@0: 	printf("\n");
samer@0: 	fflush(stdout);
samer@0: 	return 1;
samer@0: }
samer@0: 
samer@0: static int verbose_prolog_handler(const char *path, const char *types, lo_arg **argv,
samer@0: 		    int argc, lo_message msg, void *user_data) 
samer@0: {
samer@0: 	generic_handler(path,types,argv,argc,msg,user_data);
samer@0: 	prolog_handler(path,types,argv,argc,msg,user_data);
samer@0: 	return 1;
samer@0: }
samer@0: */
samer@0: 
samer@0: // run OSC server in this thread but with an extra message handler
samer@0: // to allow the /plosc/stop message to terminate the loop.
samer@4: static int run_stoppable_server(my_server_thread s)
samer@0: {
samer@0: 	lo_server_add_method(s->s, "/plosc/stop", NULL, stop_handler, (void *)s);
samer@4: 	my_server_thread_run(s);
samer@0: 	lo_server_del_method(s->s,"/plosc/stop",NULL);
samer@0: 	return TRUE;
samer@0: }
samer@0: 
samer@0: foreign_t mk_server(term_t port, term_t server)
samer@0: {
samer@0: 	char *p;
samer@0: 
samer@0: 	if (PL_get_chars(port, &p, CVT_INTEGER)) {
samer@0: 		my_server_thread s = my_server_thread_new(p, server_error);
samer@0: 		if (s) return unify_server(server,s);
samer@0: 		else return FALSE; 
samer@0: 	} else {
samer@0: 		return type_error(port,"integer");
samer@0: 	}
samer@0: }
samer@0: 
samer@0: foreign_t add_handler_x(term_t server, term_t msg, term_t types, term_t goal)
samer@0: {
samer@0: 	my_server_thread s;
samer@0: 	lo_method method;
samer@0: 	char	*pattern, *typespec;
samer@0: 	char	buffer[256]; // !! space for up to 255 arguments
samer@0: 	int	rc;
samer@0: 
samer@0: 	rc = get_server(server,&s) 
samer@0: 		&& get_msg(msg,&pattern) 
samer@0: 		&& get_types(types,buffer,256,&typespec);
samer@0: 
samer@0: 	if (rc) {
samer@0: 		record_t goal_record=PL_record(goal);
samer@0: 		method = lo_server_add_method(s->s, pattern, typespec, prolog_handler_x, (void *)goal_record);
samer@0: 	} 
samer@0: 	return rc;
samer@0: }
samer@0: 
samer@0: foreign_t add_handler(term_t server, term_t msg, term_t types, term_t goal)
samer@0: {
samer@0: 	my_server_thread s;
samer@0: 	lo_method method;
samer@0: 	char	*pattern, *typespec;
samer@0: 	char	buffer[256]; // !! space for up to 255 arguments
samer@0: 	int	rc;
samer@0: 
samer@0: 	rc = get_server(server,&s) 
samer@0: 		&& get_msg(msg,&pattern) 
samer@0: 		&& get_types(types,buffer,256,&typespec);
samer@0: 
samer@0: 	if (rc) {
samer@0: 		record_t goal_record=PL_record(goal);
samer@0: 		method = lo_server_add_method(s->s, pattern, typespec, prolog_handler, (void *)goal_record);
samer@0: 	} 
samer@0: 	return rc;
samer@0: }
samer@0: 
samer@0: foreign_t del_handler(term_t server, term_t msg, term_t types)
samer@0: {
samer@0: 	my_server_thread s;
samer@0: 	char	*pattern, *typespec;
samer@0: 	char	buffer[256]; // !! space for up to 255 arguments
samer@0: 	int	rc;
samer@0: 
samer@0: 	rc = get_server(server,&s) 
samer@0: 		&& get_msg(msg,&pattern) 
samer@0: 		&& get_types(types,buffer,256,&typespec);
samer@0: 
samer@0: 	if (rc) lo_server_del_method(s->s,pattern,typespec);
samer@0: 	return rc;
samer@0: }
samer@0: 
samer@0: foreign_t start_server( term_t server)
samer@0: {
samer@0: 	my_server_thread s;
samer@0: 	return get_server(server,&s) && (my_server_thread_start(s)==0);
samer@0: }
samer@0: 
samer@0: foreign_t stop_server( term_t server)
samer@0: {
samer@0: 	my_server_thread s;
samer@0: 	return get_server(server,&s) && (my_server_thread_stop(s)==0);
samer@0: }
samer@0: 
samer@0: foreign_t run_server( term_t server)
samer@0: {
samer@0: 	my_server_thread s;
samer@0: 	printf("running OSC server synchronously...\n");
samer@4: 	return get_server(server,&s) && run_stoppable_server(s);
samer@0: }
samer@0: 
samer@0: 
samer@0: // -------------------------------------------------------------------------
samer@0: // my_server_thread implementation
samer@0: 
samer@0: my_server_thread my_server_thread_new(const char *port, lo_err_handler err_h)
samer@0: {
samer@0: 	my_server_thread st = malloc(sizeof(struct _my_server_thread));
samer@0: 	st->s = lo_server_new(port, err_h);
samer@4: 	st->timeout= 100; // will check st->active at 10Hz.
samer@0: 	st->active = 0;
samer@0: 	st->done = 0;
samer@0: 
samer@0: 	if (!st->s) {
samer@0: 		free(st);
samer@0: 		return NULL;
samer@0: 	}
samer@0: 	return st;
samer@0: }
samer@0: 
samer@0: void my_server_thread_free(my_server_thread st)
samer@0: {
samer@0: 	if (st) {
samer@0: 		if (st->active) {
samer@0: 			my_server_thread_stop(st);
samer@0: 		}
samer@0: 		lo_server_free(st->s);
samer@0: 	}
samer@0: 	free(st);
samer@0: }
samer@0: 
samer@0: int my_server_thread_stop(my_server_thread st)
samer@0: {
samer@0: 	int result;
samer@0: 
samer@0: 	if (st->active) {
samer@0: 		st->active = 0; // Signal thread to stop
samer@0: 	
samer@0: 		result = pthread_join( st->thread, NULL );
samer@0: 		if (result) {
samer@0: 			fprintf(stderr,"Failed to stop thread: pthread_join(), %s",strerror(result));
samer@0: 			return -result;
samer@0: 		}
samer@0: 	}
samer@0: 
samer@0: 	return 0;
samer@0: }
samer@0: 
samer@0: 
samer@0: int my_server_thread_start(my_server_thread st)
samer@0: {
samer@0: 	int result;
samer@0: 
samer@0: 	if (!st->active) {
samer@0: 		st->active = 1;
samer@0: 		st->done = 0;
samer@0: 
samer@0: 		// Create the server thread
samer@0: 		result = pthread_create(&(st->thread), NULL, (void *)&prolog_thread_func, st);
samer@0: 		if (result) {
samer@0: 			  fprintf(stderr, "Failed to create thread: pthread_create(), %s",
samer@0: 						 strerror(result));
samer@0: 			  return -result;
samer@0: 		}
samer@0: 	
samer@0: 	}
samer@0:     return 0;
samer@0: }
samer@0: 
samer@4: int my_server_thread_run(my_server_thread st)
samer@0: {
samer@4: 	int timeout=st->timeout;
samer@4: 
samer@0: 	st->active = 1;
samer@0: 	st->done = 0;
samer@0: 	while (st->active) {
samer@0: 		lo_server_recv_noblock(st->s, timeout);
samer@0: 	}
samer@0: 	st->done = 1;
samer@0: 	return 0;
samer@0: }
samer@0: 
samer@0: // code for the asynchronous server loop
samer@0: // we must create and attach a new Prolog engine to enable
samer@0: // calls to Prolog from this thread.
samer@0: static void prolog_thread_func(void *data)
samer@0: {
samer@0: 	my_server_thread st = (my_server_thread)data;
samer@0: 
samer@0: 	printf("OSC server started.\n");
samer@0: 	PL_thread_attach_engine(NULL);
samer@4: 	my_server_thread_run(st);
samer@0: 	PL_thread_destroy_engine(); 
samer@0: 	printf("OSC server stopped.\n");
samer@0: 	pthread_exit(NULL);
samer@0: }
samer@0: