package n8ur_gpib;

use 5.008004;
use strict;
use warnings;
use Time::HiRes qw(usleep);
use LinuxGpib;
use DateTime;
use n8ur qw(round);

require Exporter;

our @ISA = qw(Exporter);

our @EXPORT = qw( checkSRQ serviceSRQ serviceSRQmulti ibwrite logline );

our $VERSION = '0.2';

sub checkSRQ {
	my $board = shift;
	my $lines;	
	LinuxGpib::iblines($board,$lines);
	# 0x2000 is bit 14, busSRQ
	if ($lines & 0x2000) {
		return 1;
	} else {
		return 0;
	}
}
	
sub serviceSRQ {
	my $dev = shift;
	my $status;
	my $device_status = 0x00;
	my $reading;
	my $tries;

	$status = 0x8000;
	$tries = 0;
	while ($status == 0x8000 && $tries < 3) {
		if ($tries > 0) { usleep(1000) };
		$status = LinuxGpib::ibrsp($dev,$device_status);
		$tries++
		}
	if ($tries == 3) {die "Oops: ibrsp $dev failed 3 times!\n";}
	usleep(500);
	# 0x40 is bit 6, "service me, please"
	if ($device_status & 0x40) {
		# get reading
		$status = 0x8000;
		$tries = 0;
		while ($status == 0x8000 && $tries < 3) {
			if ($tries > 0) { usleep(500) };
			$status = LinuxGpib::ibrd($dev,$reading,2048);
			}
		if ($tries == 3) {die "Oops: ibrd $dev failed 3 times!\n";}
		return $reading;
	} else {
		return 0;
	}
}

sub serviceSRQmulti {
        my $dev = shift;
        my $num_readings = shift;
        my $status;
        my $tries;
        my $device_status = 0x00;
        my $i;
        my $tmp;
        my @reading;

        $status = 0x8000;
        $tries = 0;
        while ($status == 0x8000 && $tries < 3) {
                if ($tries > 0) { usleep(500) };
                $status = LinuxGpib::ibrsp($dev,$device_status);
                $tries++;
                }
        if ($tries == 3) {die "Oops: ibrsp $dev failed 3 times!\n";}
        usleep(500);

        # 0x40 is bit 6, "service me, please"
        $status = 0x8000;
        $tries = 0;
        if ($device_status & 0x40) {
                # get reading for each line
                for ($i=1;$i <= $num_readings;$i++) {
                        $status = 0x8000;
                        $tries = 0;
                        while ($status == 0x8000 && $tries < 3) {
                                if ($tries > 0) { usleep(500) };
                                $status = LinuxGpib::ibrd($dev,$tmp,2048);
                                }
                        if ($tries == 3) {
                                die "Oops: ibrd $dev failed 3 times!\n";
                        }
                        $reading[$i] = $tmp;
                }
                return @reading;
        } else {
                return 0;
        }
}

sub ibwrite {
	my $dev = shift;
	my $command = shift;
	my $ibsta = 0x8000;
	my $tries = 0;
	while ($ibsta == 0x8000 && $tries < 3) {
                if ($tries > 0) { usleep(500) };
        	$ibsta = LinuxGpib::ibwrt($dev,$command,length($command));
        	$tries++;
        	}
if ($tries == 3) {die "Oops: Couldn't do ibwrt $command!\n"};
return 0;

}

sub logline {
	my $tags = shift;
	my $places = shift;
	my $value1 = shift;
	my $value2 = shift;
	my $value3 = shift;
	my $value4 = shift;
	my $timetag;
	my $tmpstring;

	my $dt = DateTime->now;

	$timetag = "";
	if ($tags eq "mjd") {
		$timetag = sprintf("%6.6f",round(6,$dt->mjd));
	}
	if ($tags eq "iso") {
		$timetag = $dt->ymd('-') . 'T' . $dt->hms(':');
	}
	$tmpstring = sprintf(" %1.*e",$places,$value1);
	if ($value2) {
		$tmpstring = $tmpstring . sprintf(" %1.*e",$places,$value2);
	 }
	if ($value3) {
		$tmpstring = $tmpstring . sprintf(" %1.*e",$places,$value3);
	 }
	if ($value4) {
		$tmpstring = $tmpstring . sprintf(" %1.*e",$places,$value4);
	 }

	return $timetag . $tmpstring . "\n";
}


# Preloaded methods go here.

1;
__END__
# Below is stub documentation for your module. You'd better edit it!

=head1 NAME

n8ur - Functions for GPIB

=head1 SYNOPSIS

	use n8ur;
	checkSRQ($board)
	serviceSRQ($device)
	logline($tagtype,$precision,$value1,[$value2])

=head1 DESCRIPTION

Some useful functions for GPIB programming.

=head2 EXPORT

None by default.

=head1 SEE ALSO

n8ur.pm

=head1 AUTHOR

John Ackermann   N8UR, jra@febo.com

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005 by John Ackermann N8UR (jra@febo.com)

This program may be copied, modified, distributed and used for 
any legal purpose provided that (a) the copyright notice above as well
as these terms are retained on all copies; (b) any modifications that 
correct bugs or errors, or increase the program's functionality, are 
sent via email to the author at the address above; and (c) such 
modifications are made subject to these license terms.

=cut