view qutils.pl @ 3:13b598d91c15

get_message_or_timeout/2 now uses thread_get_message/3 if available;
player now supports optional event transform between source and destination;
removed deprecated index declarations.

:- module( qutils, 
		[	with_message/2
		,	with_message_or_timeout/4
		,	get_message_or_timeout/2
		,	send_with_size_limit/3
		]).

:- meta_predicate with_message(?,0).
:- meta_predicate with_message_or_timeout(+,?,0,0).

:- use_module(library(time)).

%% get_message_or_timeout( +TimeOut, -Msg) is det.
%
%  Time-limited wait for next term in message queue.
%  Waits up to TimeOut seconds for the next message that 
%  unifies with Msg in the current thread.  If none arrives, 
%  then Msg is unified  with timeout. 
%  NB: may fail if Msg is bound on input.
get_message_or_timeout(inf,Msg) :- !, thread_get_message(Msg).

:- if(current_predicate(thread_get_message/3)).

get_message_or_timeout(Deadline,Msg) :- 
	get_time(Now), 
	(	Now>=Deadline -> Msg=timeout %, writeln(elapsed)
	;	Timeout is Deadline-Now,
		thread_self(Thread),
		thread_get_message(Thread,Msg,[timeout(Timeout)])
	).	

:- else.

get_message_or_timeout(Deadline,Msg) :- 
	get_time(Now), 
	(	Now>=Deadline -> Msg=timeout %, writeln(elapsed)
	;	thread_self(Thread),
		setup_call_cleanup(
			alarm_at(Deadline, thread_send_message(Thread,timeout), Id), 
			thread_get_message(Thread,Msg),
			time:remove_alarm_notrace(Id))
		%,(Msg\=timeout -> writeln(msg:Msg); true)
	).	

:-endif.

/*
get_message_or_timeout(Deadline,Msg) :- 
	get_time(Now), 
	(	Now>=Deadline -> Msg=timeout, writeln(elapsed)
	;	catch(
			deadline_get_message(Deadline,Msg),
			time_limit_exceeded,
			Msg=timeout)
		%, (Msg\=timeout -> writeln(msg:Msg); true)
	).	

deadline_get_message(Deadline,Msg) :-
	setup_call_cleanup(
		alarm_at(Deadline, ding_ding, Id), 
		thread_get_message(Msg),
		time:remove_alarm_notrace(Id)).

ding_ding :- throw(time_limit_exceeded).


*/



%% with_message( Msg, :Goal) is nondet.
%
%  Waits for next message, unify with Msg, and call Goal.
%  This procedure gets the next term out of the current thread's
%  message queue, waiting if necessary. If it is 'quit', then
%  it succeeds immediately leaving Msg unchanged. If it unifies
%  with Msg, then Goal is called. Otherwise, a message is printed
%  and the proceduce succeeds.
with_message(Temp,OnEvent) :-
	thread_get_message(Msg),
	(	Msg=quit -> true
	;	Msg=Temp -> call(OnEvent)
	;	writeln(template_mismatch(Temp,Msg))
	).

%% with_message_or_timeout( +TimeOut, Msg, :OnEvent, :OnTimeOut) is nondet.
%
%  Time limited wait for message with handler goals for either case.
%  Waits up to TimeOut seconds for next message, unify with Msg, 
%  and call OnEvent. If none arrives before TimeOut expires,
%  OnTimeOut is called instead. If the message is 'quit', it
%  just returns. If the message does not unify with Msg, some
%  text is printed and the proceduce succeeds.
with_message_or_timeout(T,Temp,OnEvent,OnTimeout) :- 
	get_message_or_timeout(T,Msg),
	(	Msg=quit    -> true
	;	Msg=timeout -> call(OnTimeout)
	;	Msg=Temp    -> call(OnEvent)
	;	writeln(template_mismatch(Temp,Msg))
	).

%% send_with_size_limit( +Max:natural, +Queue:queue_id, +Msg:term) is det.
%
%  Adds term to message queue unless queue is already full.
%  If message queue Queu already contains more than Max elements,
%  then "*" is printed and the procedure succeeds. NB. the message
%  is discarded.
send_with_size_limit(Max,Queue,Msg) :-
	message_queue_property(Queue,size(QSize)),
	(	QSize<Max -> thread_send_message(Queue,Msg)
	;	writeln('*')
	).