// parse a list of Prolog terms and add arguments to an OSC message
static int add_msg_args(lo_message msg, term_t list)
{
term_t head=PL_new_term_ref();
// copy term ref so as not to modify original
list=PL_copy_term_ref(list);
while (PL_get_list(list,head,list)) {
atom_t name;
int arity;
const char *type;
if (!PL_get_name_arity(head,&name,&arity)) return type_error(head,"term");
type=PL_atom_chars(name);
switch (arity) {
case 1: {
term_t a1=PL_new_term_ref();
PL_get_arg(1,head,a1);
if (!strcmp(type,"int")) {
int x;
if (!PL_get_integer(a1,&x)) return type_error(a1,"integer");
lo_message_add_int32(msg,x);
} else if (!strcmp(type,"double")) {
double x;
if (!PL_get_float(a1,&x)) return type_error(a1,"float");
lo_message_add_double(msg,x);
} else if (!strcmp(type,"string")) {
char *x;
if (!PL_get_chars(a1,&x,CVT_ATOM|CVT_STRING)) return type_error(a1,"string");
lo_message_add_string(msg,x);
} else if (!strcmp(type,"symbol")) {
char *x;
if (!PL_get_chars(a1,&x,CVT_ATOM)) return type_error(a1,"atom");
lo_message_add_symbol(msg,x);
} else if (!strcmp(type,"float")) {
double x;
if (!PL_get_float(a1,&x)) return type_error(a1,"float");
lo_message_add_float(msg,(float)x);
}
break;
}
case 0: {
if (!strcmp(type,"true")) lo_message_add_true(msg);
else if (!strcmp(type,"false")) lo_message_add_false(msg);
else if (!strcmp(type,"nil")) lo_message_add_nil(msg);
else if (!strcmp(type,"inf")) lo_message_add_infinitum(msg);
break;
}
}
}
if (!PL_get_nil(list)) return type_error(list,"nil");
return TRUE;
}
word
pl_convert_time(term_t time, term_t year, term_t month,
term_t day, term_t hour, term_t minute,
term_t second, term_t usec)
{ double tf;
if ( PL_get_float(time, &tf) && tf <= PLMAXINT && tf >= PLMININT )
{ long t = (long) tf;
long us = (long)((tf - (double) t) * 1000.0);
struct tm *tm = LocalTime(&t);
if ( PL_unify_integer(year, tm->tm_year + 1900) &&
PL_unify_integer(month, tm->tm_mon + 1) &&
PL_unify_integer(day, tm->tm_mday) &&
PL_unify_integer(hour, tm->tm_hour) &&
PL_unify_integer(minute, tm->tm_min) &&
PL_unify_integer(second, tm->tm_sec) &&
PL_unify_integer(usec, us) )
succeed;
else
fail;
}
return PL_error("convert_time", 8, NULL, ERR_TYPE, ATOM_time_stamp, time);
}
static int
get_taia(term_t t, struct taia *taia, double *seconds)
{ double d;
if ( PL_get_float(t, &d) )
{ double fp, ip;
if ( seconds )
*seconds = d;
fp = modf(d, &ip);
if ( fp < 0 )
{ fp += 1.0;
ip -= 1.0;
}
taia->sec.x = (int64_t)ip + TAI_UTC_OFFSET;
taia->nano = (long)(fp*1e9);
taia->atto = 0L;
return TRUE;
}
return FALSE;
}
word
pl_sleep(term_t time)
{ double t;
if ( PL_get_float(time, &t) )
Pause(t);
succeed;
}
// get Prolog (Unix) time value and convert to OSC timestamp
static int get_prolog_time(term_t time, lo_timetag *ts) {
double t, ft;
int ok = PL_get_float(time, &t);
ft=floor(t);
ts->sec = ((uint32_t)ft)+2208988800u;
ts->frac = (uint32_t)(4294967296.0*(t-ft));
return ok;
}
static char *prolog_ciclo(modulo_t *modulo, const char *puerto, const void *dato)
{
predicate_t pred;
term_t h0;
double f = 0.0f;
prolog_dato_t *prolog = (prolog_dato_t*)modulo->m_dato;
if(!strcmp(PUERTO, puerto)) {
char *cadena = (char *)dato;
if(cadena) {
char *cadena_aux = prolog_mayusculas(cadena);
if(!strcmp(cadena_aux, "AVANZAR")) {
printf("jajajaj");
g_hash_table_insert(modulo->m_tabla, PUERTO_ORDEN, "avanzar");
g_hash_table_insert(modulo->m_tabla, PUERTO_PARAMETRO, "media");
}
else if(!strcmp(cadena_aux, "RETROCEDER")) {
g_hash_table_insert(modulo->m_tabla, PUERTO_ORDEN, "avanzar");
g_hash_table_insert(modulo->m_tabla, PUERTO_PARAMETRO, "nula");
}
else if(!strcmp(cadena_aux, "GIRAR IZQUIERDA")) {
g_hash_table_insert(modulo->m_tabla, PUERTO_ORDEN, "girar");
g_hash_table_insert(modulo->m_tabla, PUERTO_PARAMETRO, "alta");
}
else if(!strcmp(cadena_aux, "GIRAR DERECHA")) {
g_hash_table_insert(modulo->m_tabla, PUERTO_ORDEN, "girar_negativo");
g_hash_table_insert(modulo->m_tabla, PUERTO_PARAMETRO, "alta");
}
else {
pred = PL_predicate("camaron", 2, "dcg");
h0 = PL_new_term_refs(2);
PL_put_list_codes(h0, cadena);
if(PL_call_predicate(NULL, PL_Q_NORMAL, pred, h0)) {
PL_get_float(h0 + 1, &f);
sprintf(prolog->m_buffer_salida, "Resultado: %f.", f);
g_hash_table_insert(modulo->m_tabla, PUERTO_SALIDA, prolog->m_buffer_salida);
}
else {
g_hash_table_insert(modulo->m_tabla, PUERTO_SALIDA, 0);
}
}
free(cadena_aux);
}
}
return 0;
}
static foreign_t
pl_gsl_sf_bessel_J0(term_t x_term, term_t out_term)
{
double x;
double y;
int rval;
if ( PL_get_float(x_term, &x) )
{
y = gsl_sf_bessel_j0(x);
rval = PL_unify_float(out_term, y);
return rval;
}
PL_fail;
}
static foreign_t
install_alarm2(term_t alarm, term_t time)
{ Event ev = NULL;
double t;
int rc;
if ( !get_timer(alarm, &ev) )
return FALSE;
if ( !PL_get_float(time, &t) )
return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 1,
time, "number");
setTimeEvent(ev, t);
if ( (rc=installEvent(ev)) != TRUE )
return alarm_error(alarm, rc);
return TRUE;
}
static foreign_t
process_wait(term_t pid, term_t code, term_t options)
{ pid_t p;
wait_options opts;
term_t tail = PL_copy_term_ref(options);
term_t head = PL_new_term_ref();
term_t arg = PL_new_term_ref();
if ( !get_pid(pid, &p) )
return FALSE;
memset(&opts, 0, sizeof(opts));
while(PL_get_list(tail, head, tail))
{ atom_t name;
int arity;
if ( !PL_get_name_arity(head, &name, &arity) || arity != 1 )
return type_error(head, "option");
_PL_get_arg(1, head, arg);
if ( name == ATOM_timeout )
{ atom_t a;
if ( !(PL_get_atom(arg, &a) && a == ATOM_infinite) )
{ if ( !PL_get_float(arg, &opts.timeout) )
return type_error(arg, "timeout");
opts.has_timeout = TRUE;
}
} else if ( name == ATOM_release )
{ if ( !PL_get_bool(arg, &opts.release) )
return type_error(arg, "boolean");
if ( opts.release == FALSE )
return domain_error(arg, "true");
} else
return domain_error(head, "process_wait_option");
}
if ( !PL_get_nil(tail) )
return type_error(tail, "list");
return wait_for_pid(p, code, &opts);
}
word
pl_convert_time2(term_t time, term_t string)
{ double tf;
if ( PL_get_float(time, &tf) && tf <= PLMAXINT && tf >= PLMININT )
{ time_t t = (time_t)(long)tf;
char *s = ctime(&t);
if ( s )
{ char *e = s + strlen(s);
while(e>s && e[-1] == '\n')
e--;
*e = EOS;
return PL_unify_string_chars(string, s);
}
return warning("convert_time/2: %s", OsError());
}
return PL_error("convert_time", 2, NULL, ERR_TYPE, ATOM_time_stamp, time);
}
static foreign_t
tcp_select(term_t Streams, term_t Available, term_t timeout)
{ fd_set fds;
struct timeval t, *to;
double time;
int n, max = 0, ret, min = 1000000;
fdentry *map = NULL;
term_t head = PL_new_term_ref();
term_t streams = PL_copy_term_ref(Streams);
term_t available = PL_copy_term_ref(Available);
term_t ahead = PL_new_term_ref();
int from_buffer = 0;
atom_t a;
FD_ZERO(&fds);
while( PL_get_list(streams, head, streams) )
{ IOSTREAM *s;
#ifdef __WINDOWS__
nbio_sock_t fd;
#else
int fd;
#endif
fdentry *e;
if ( !PL_get_stream_handle(head, &s) )
return FALSE;
#ifdef __WINDOWS__
fd = fdFromHandle(s->handle);
#else
fd = Sfileno(s);
#endif
PL_release_stream(s);
if ( fd < 0 || !is_socket_stream(s) )
{ return pl_error("tcp_select", 3, NULL, ERR_DOMAIN,
head, "socket_stream");
}
/* check for input in buffer */
if ( s->bufp < s->limitp )
{ if ( !PL_unify_list(available, ahead, available) ||
!PL_unify(ahead, head) )
return FALSE;
from_buffer++;
}
e = alloca(sizeof(*e));
e->fd = fd;
e->stream = PL_copy_term_ref(head);
e->next = map;
map = e;
#ifdef __WINDOWS__
FD_SET((SOCKET)fd, &fds);
#else
FD_SET(fd, &fds);
#endif
if ( fd > max )
max = fd;
if( fd < min )
min = fd;
}
if ( !PL_get_nil(streams) )
return pl_error("tcp_select", 3, NULL, ERR_TYPE, Streams, "list");
if ( from_buffer > 0 )
return PL_unify_nil(available);
if ( PL_get_atom(timeout, &a) && a == ATOM_infinite )
{ to = NULL;
} else
{ if ( !PL_get_float(timeout, &time) )
return pl_error("tcp_select", 3, NULL,
ERR_TYPE, timeout, "number");
if ( time >= 0.0 )
{ t.tv_sec = (int)time;
t.tv_usec = ((int)(time * 1000000) % 1000000);
} else
{ t.tv_sec = 0;
t.tv_usec = 0;
}
to = &t;
}
while( (ret=nbio_select(max+1, &fds, NULL, NULL, to)) == -1 &&
errno == EINTR )
{ fdentry *e;
if ( PL_handle_signals() < 0 )
return FALSE; /* exception */
FD_ZERO(&fds); /* EINTR may leave fds undefined */
for(e=map; e; e=e->next) /* so we rebuild it to be safe */
{ FD_SET((SOCKET)e->fd, &fds);
}
}
switch(ret)
{ case -1:
return pl_error("tcp_select", 3, NULL, ERR_ERRNO, errno, "select", "streams", Streams);
case 0: /* Timeout */
break;
default: /* Something happened -> check fds */
for(n=min; n <= max; n++)
{ if ( FD_ISSET(n, &fds) )
{ if ( !PL_unify_list(available, ahead, available) ||
!PL_unify(ahead, findmap(map, n)) )
return FALSE;
}
}
break;
}
return PL_unify_nil(available);
}
/* parse the time window constraints */
void parse_within_op_(EtalisExecNode* operatorNode,term_t t)
{
assert(operatorNode != NULL);
fid_t fid = PL_open_foreign_frame();
EtalisEventNode* opt_t = (EtalisEventNode*)malloc(2*sizeof(EtalisEventNode)); /* memory alignement for L1 cache optimization */
operatorNode->leftChild=opt_t;
memset(operatorNode->leftChild,0,sizeof(EtalisEventNode));
operatorNode->rightChild=opt_t+1;
operatorNode->condition=NULL;
/* get window size */
term_t winsize = PL_new_term_ref();
PL_get_arg(2,t,winsize);
WINDOW_SIZE_T i; /*get window size*/ /* depending on the target processor, this might be an int, a double or a structure. */ /* defined in WINDOW_SIZE_T : e_time.h */
#if PROCESSOR_SUPPORTS_DOUBLE ==1
if (PL_term_type(winsize) == PL_FLOAT)
PL_get_float(winsize,&i);
else
printf("ERROR: window Size must be a floating number ! \n");
#else /* we don't support double accuracy, fall back to int */
PL_get_integer(winsize, &i);
#endif
operatorNode->window_size=i;
#ifdef DEBUG
printf("--- WITHIN Block detected | Window size: %f\n",i);
#endif
/*
term_t _level_1 = PL_new_term_refs(3);
term_t _left_event=_level_1+1;
term_t _right_event=_level_1+2;
atom_t _left_event_name,_right_event_name;
PL_get_arg(1,t,_level_1);
PL_get_arg(1,_level_1,_left_event);
PL_get_arg(2,_level_1,_right_event);
PL_get_name_arity(_left_event,&_left_event_name,(int*)&((operatorNode->leftChild)->event.arity));
PL_get_name_arity(_right_event,&_right_event_name,(int*)&(operatorNode->rightChild->event.arity));
PL_discard_foreign_frame(fid);
strcpy(operatorNode->leftChild->event.name,PL_atom_chars(_left_event_name));
strcpy(operatorNode->rightChild->event.name,PL_atom_chars(_right_event_name));
}
*/
}
static foreign_t
pl_tipc_setopt(term_t Socket, term_t opt)
{ int socket;
atom_t a;
int arity;
if ( !tipc_get_socket(Socket, &socket) )
return FALSE;
if ( PL_get_name_arity(opt, &a, &arity) )
{ if ( a == ATOM_importance && arity == 1 )
{ atom_t val;
term_t a1 = PL_new_term_ref();
int ival = TIPC_LOW_IMPORTANCE;
if (PL_get_arg(1, opt, a1))
{ if(!PL_get_atom(a1, &val) )
return pl_error(NULL, 0, NULL, ERR_DOMAIN, a1, "atom");
if(val == ATOM_low)
ival = TIPC_LOW_IMPORTANCE;
else if(val == ATOM_medium)
ival = TIPC_MEDIUM_IMPORTANCE;
else if(val == ATOM_high)
ival = TIPC_HIGH_IMPORTANCE;
else if(val == ATOM_critical)
ival = TIPC_CRITICAL_IMPORTANCE;
else
return pl_error(NULL, 0, NULL, ERR_DOMAIN, a1, "low, medium, high, or critical");
return((tipc_setopt(socket, NB_TIPC_IMPORTANCE, ival) == 0) ? TRUE : FALSE);
}
}
if ( ((a == ATOM_dest_droppable) ||
(a == ATOM_src_droppable)) && arity == 1 )
{ int val;
term_t a1 = PL_new_term_ref();
int option = (a == ATOM_dest_droppable) ? NB_TIPC_DEST_DROPPABLE
: NB_TIPC_SRC_DROPPABLE;
if (PL_get_arg(1, opt, a1))
{ if(!PL_get_bool(a1, &val) )
return pl_error(NULL, 0, NULL, ERR_DOMAIN, a1, "boolean");
return((tipc_setopt(socket, option, val) == 0) ? TRUE : FALSE);
}
}
if ( a == ATOM_conn_timeout && arity == 1 )
{ double val;
int ival;
term_t a1 = PL_new_term_ref();
if (PL_get_arg(1, opt, a1))
{ if(!PL_get_float(a1, &val) || val < 0)
return pl_error(NULL, 0, NULL, ERR_DOMAIN, a1, "float");
ival = val * 1000; // time is in milliseconds
return((tipc_setopt(socket, NB_TIPC_CONN_TIMEOUT, ival) == 0) ? TRUE : FALSE);
}
}
if ( a == ATOM_nodelay && arity <= 1 )
{ int enable, rc;
if ( arity == 0 )
{ enable = TRUE;
} else /*if ( arity == 1 )*/
{ term_t a = PL_new_term_ref();
_PL_get_arg(1, opt, a);
if ( !PL_get_bool(a, &enable) )
return pl_error(NULL, 0, NULL, ERR_DOMAIN, a, "boolean");
}
if ( (rc=nbio_setopt(socket, TCP_NO_DELAY, enable) == 0) )
return TRUE;
if ( rc == -2 )
return pl_error(NULL, 0, NULL, ERR_DOMAIN, opt, "socket_option");
}
if ( a == ATOM_nonblock && arity == 0 )
return((nbio_setopt(socket, TCP_NONBLOCK) == 0) ? TRUE : FALSE );
if ( a == ATOM_dispatch && arity == 1 )
{ int val;
term_t a1 = PL_new_term_ref();
if ( PL_get_arg(1, opt, a1) && PL_get_bool(a1, &val) )
{ if ( nbio_setopt(socket, TCP_DISPATCH, val) == 0 )
return TRUE;
return FALSE;
}
}
}
return pl_error(NULL, 0, NULL, ERR_DOMAIN, opt, "socket_option");
}
static foreign_t
alarm4_gen(time_abs_rel abs_rel, term_t time, term_t callable,
term_t id, term_t options)
{ Event ev;
double t;
module_t m = NULL;
unsigned long flags = 0L;
if ( options )
{ term_t tail = PL_copy_term_ref(options);
term_t head = PL_new_term_ref();
while( PL_get_list(tail, head, tail) )
{ atom_t name;
int arity;
if ( PL_get_name_arity(head, &name, &arity) )
{ if ( arity == 1 )
{ term_t arg = PL_new_term_ref();
_PL_get_arg(1, head, arg);
if ( name == ATOM_remove )
{ int t = FALSE;
if ( !pl_get_bool_ex(arg, &t) )
return FALSE;
if ( t )
flags |= EV_REMOVE;
} else if ( name == ATOM_install )
{ int t = TRUE;
if ( !pl_get_bool_ex(arg, &t) )
return FALSE;
if ( !t )
flags |= EV_NOINSTALL;
}
}
}
}
if ( !PL_get_nil(tail) )
return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 4, options, "list");
}
if ( !PL_get_float(time, &t) )
return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 1,
time, "number");
if ( !(ev = allocEvent()) )
return FALSE;
if (abs_rel==TIME_REL)
setTimeEvent(ev, t);
else
setTimeEventAbs(ev,t);
if ( !unify_timer(id, ev) )
{ freeEvent(ev); /* not linked: no need to lock */
return FALSE;
}
ev->flags = flags;
PL_strip_module(callable, &m, callable);
ev->module = m;
ev->goal = PL_record(callable);
if ( !(ev->flags & EV_NOINSTALL) )
{ int rc;
if ( (rc=installEvent(ev)) != TRUE )
{ freeEvent(ev); /* not linked: no need to lock */
return alarm_error(id, rc);
}
}
return TRUE;
}
