unit etimer;

interface

uses amiga, exec;

const

	unit_microhz = 0;
	unit_vblank = 1;


type
	ttimeval = packed record
		tv_secs: longint;
		tv_micro: longint;
	end;
	ptimeval = ^ttimeval;

	ttimerequest = packed record
		tr_node: tiorequest;
		tr_time: ttimeval;
	end;
	ptimerequest = ^ttimerequest;

procedure delete_timer(tr: ptimerequest);
function create_timer(_unit: longint): ptimerequest;
function wait_for_timer(tr: ptimerequest; secs, micro: longint): shortint;

implementation

procedure delete_timer(tr: ptimerequest);
var tp: pmsgport;
begin
	if (tr <> nil) then
	begin
		tp := tr^.tr_node.io_message.mn_replyport;
		if (tp <> nil) then
		begin
			deleteport(tp);
		end;
		closedevice(piorequest(tr));
		deleteextio(piorequest(tr));
	end;
end;

function create_timer(_unit: longint): ptimerequest;
var
	error: longint;
	timerport: pmsgport;
	timerio: ptimerequest;
begin
	timerport := createport(nil, 0);
	if (timerport = nil) then
	begin
		create_timer := nil;
		exit
	end;
	
	timerio := ptimerequest(createextio(timerport, sizeof(ttimerequest)));
	if (timerio = nil) then
	begin
		deleteport(timerport);
		create_timer := nil;
		exit;
	end;

	error := opendevice('timer.device', _unit, piorequest(timerio), 0);
	if (error <> 0) then
	begin
		delete_timer(timerio);
		create_timer := nil;
		exit;
	end;
	timerio^.tr_node.io_command := 9;
	create_timer := timerio;
end;

function wait_for_timer(tr: ptimerequest; secs, micro: longint): shortint;
begin
	tr^.tr_time.tv_secs := secs;
	tr^.tr_time.tv_micro := micro;
	wait_for_timer := doio(piorequest(tr));
end;

end.

program timtest;

uses etimer;

var
	x: shortint;
	y: ptimerequest;
	i: integer;

begin
	y := create_timer(unit_microhz);
	writeln('x');
	for i := 0 to 29 do
	begin
		x := wait_for_timer(y, 0, 500000);
	end;
	writeln('x');
	delete_timer(y);
end.