The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
$VERSION = '0.02';

pp_bless('PDL::Graphics::AquaTerm');

###
# Header files
###

pp_addhdr('
	#include "aquaterm/aquaterm.h"
');

###
# pp_def
###

# set the background color

pp_def('callAqtSetBackgroundColor',
	Pars => 'rgb(n);',
	GenericTypes => [F],
	Code => '
		aqtSetBackgroundColor($rgb(n=>0), $rgb(n=>1), $rgb(n=>2));
	'
);

# set the current plot color

pp_def('callAqtSetColor',
	Pars => 'rgb(n);',
	GenericTypes => [F],
	Code => '
		aqtSetColor($rgb(n=>0), $rgb(n=>1), $rgb(n=>2));
	'
);

# add a bitmap to the plot

pp_def('callAqtBitmap',
	Pars => 'bm(n,m,o)',
	OtherPars => 'float dx; float dy; float dw; float dh',
	GenericTypes => [B],
	Code => '
		aqtEraseRect($COMP(dx), $COMP(dy), $COMP(dw), $COMP(dh));
		aqtAddImageWithBitmap($P(bm), $SIZE(m), $SIZE(o), $COMP(dx), $COMP(dy), $COMP(dw), $COMP(dh));
	'
);

# add a line to the plot
#	printf("size %d %f %f\n",$SIZE(n),$lx(n=>1),$ly(n=>1)); debugging relic

pp_def('callAqtPolyline',
	Pars => 'lx(n); ly(n)',
	GenericTypes => [F],
	Code => '
		aqtAddPolyline($P(lx), $P(ly), $SIZE(n));
	'
);

###
# XS
###

# deals with mouse events, which return a string giving the mouse location

pp_addxs(<<'EOC');

char *
callAqtWaitNextEvent()
	CODE:
		int val;
		char temp[40];
		
		val = aqtWaitNextEvent(temp);
		RETVAL = temp;
	OUTPUT:
		RETVAL
		
void
aqtInit()

void
aqtOpenPlot(win_num)
	int win_num

void
aqtSelectPlot(win_num)
	int win_num

void
aqtSetPlotSize(size_x, size_y)
	int size_x
	int size_y
	
void
aqtSetPlotTitle(title)
	char *title

void
aqtMoveTo(x,y)
	int x
	int y
	
void
aqtAddLineTo(x,y)
	int x
	int y

void
aqtRenderPlot()

void
aqtClearPlot()

void
aqtAddLabel(text, x, y, angle, align)
	char *text
	float x
	float y
	float angle
	int align

void
aqtSetLinewidth(lw)
	float lw

void
aqtSetLineCapStyle(cs)
	int cs

void
aqtSetFontname(fn)
	char *fn

void
aqtSetFontsize(fs)
	float fs

EOC

###
# Perl subroutines
###

pp_addpm(<<'EOD');

## we need PDL

use PDL;

## private variables

my $warning_message = ">>> AquaTerm.pm Warning : "; # generic start of warning messages
my $debug_message = ">>> AquaTerm.pm Debug : ";		# generic start of debugging messages
my %open_windows;			# stores whether the window exists (by whether the key/value is defined/undefined)
my $win_counter = 1;		# the default window number to open
my $initialized = 0;		# flag for whether the connection to the aquaterm program was already made
my $warn_on = 0;			# turn on/off whether warnings are desired
my $debug_on = 0;			# turn on/off whether debugging information is desired
my $current_window = 1;		# the currently active window
my $color_table = pdl(0);	# local storage for a user-defined color table
	
my %window_options = (	# default window options
	SIZE_X => 400,
	SIZE_Y => 300,
	WIN_TITLE => "AquaTerm.pm",
	BACK_COLOR => [1.0, 1.0, 1.0],
	WARN_ON => 1,
	DEBUG_ON => 0
);

## the private sub-routines

# select a window if it exists, return 0 if it does not.

sub selectWindow {
	my $ret = 1;
	my $win_num = $_[0];
	
	if ($win_num == -1) {	# default to the currently open window
		$win_num = $current_window;
	}
	
	if ($open_windows{$win_num}) {
		unless ($current_window == $win_num) {
			aqtSelectPlot($win_num);
			$current_window = $win_num;
		}
	} else {
		print "$warning_message no such window number was available\n";
		$ret = 0;
	}
	
	$ret;
}

# parse options hashes

sub parseOptions {
	my $input_options = shift;
	my $default_options = shift;

	if ($debug_on){
		print "$debug_message options hash is : \n";
	}
	while ( my($temp_key, $temp_value) = each %{$input_options} ) {
		if ($debug_on){
			print "  " . $temp_key . " => " . $temp_value . "\n";
		}
		if (exists $default_options->{$temp_key}) {
			$default_options->{$temp_key} = $temp_value;
		} else {
			print "$warning_message no such option : $temp_key\n";
		}
	}
}

# output an options hash (for debugging mostly)

sub outputHash {
	my $hash_name = shift;
	my $the_hash = shift;
	
	print "$debug_message $hash_name hash is : \n";
	foreach my $temp_key (keys %{$the_hash}){
		print "  " . $temp_key . " => " . $the_hash->{$temp_key} . "\n";
	}
}

## the public sub-routines

# opens a window using user supplied parameters, or uses defaults if they don't exist

sub aquaOpen{
	my %options;
	$window_options{"WIN_NUM"} = $win_counter;
	
	if ($debug_on){
		print "\n>>> aquaOpen\n\n";
	}
	
	# get, check and load any user supplied options
	
	if ($_[0]){ parseOptions($_[0], \%window_options); }

	# check if this window number already exists

	if (exists $open_windows{$window_options{"WIN_NUM"}}) {
		if ($warn_on) {
			print "$warning_message window number " . $window_options{"WIN_NUM"} . " already exists\n";
		}
	}
	
	my $win_title = '(' . $window_options{"WIN_NUM"} . ') ' . $window_options{"WIN_TITLE"};
	$current_window = $window_options{"WIN_NUM"};
	$open_windows{$window_options{"WIN_NUM"}} = 1;
	$win_counter++;
		
	# initialize connection to aquaterm program, if that hasn't already been done
	
	unless ($initialized) {
		aqtInit();
		$initialized = 1;
	}

	# set warnings & debugging flags
	
	$warn_on  = $window_options{"WARN_ON"};
	$debug_on = $window_options{"DEBUG_ON"};
	
	# output the window_options hash if we are in debugging mode
	
	if ($debug_on){
		outputHash("window_options", \%window_options);
		outputHash("open_windows", \%open_windows);
	}
	
	# open up a window with the user/default parameters
	
	aqtOpenPlot($window_options{"WIN_NUM"});
	aqtSetPlotSize($window_options{"SIZE_X"}, $window_options{"SIZE_Y"});
	aqtSetPlotTitle($win_title);

	# this forces aquaterm to actually open and draw the window

	callAqtSetBackgroundColor(pdl($window_options{"BACK_COLOR"}));
	aqtMoveTo(0.0, 0.0);
	aqtAddLineTo(1.0, 1.0);
	aqtRenderPlot();
	aqtClearPlot();
	
	# if necessary, initialize the default color table (a gray scale)
	
	unless($color_table->ndims() == 2){
		$color_table = zeroes(byte,256,3);
		$color_table = xvals($color_table);
	}
	
	return 1;
}

# display a pdl as a 2 dimensional bitmap

sub aquaBitmap{
	my %options;
	my %display_options = (	# default display options
		ERASE => 0,
		DEST_X => 0,
		DEST_Y => 0,
		DEST_W => -1,
		DEST_H => -1,
		AUTO_SCALE => 0,
		M_MIN => 0.0,
		M_MAX => 255.0,
		WIN_NUM => -1,
		TEXT => "",
		TEXT_X => 6.0,
		TEXT_Y => 10.0,
		TEXT_C => [0.0, 0.0, 0.0]
	);
	
	if ($debug_on){
		print "\n>>> aquaDisplayBitmap\n\n";
	}
	
	# get, check and load user supplied options

	my $num_dims;
	my @bmp_dims;
	my $the_bitmap;
	
	if (@_) {
		$the_bitmap = $_[0];
		$num_dims = $the_bitmap->ndims();
		@bmp_dims = $the_bitmap->dims();
		unless (($num_dims == 2) || ($num_dims == 3)) { 
			print "$warning_message a pdl with $num_dims dimensions is not supported\n";
			return 0;
		}
		if ($_[1]) { parseOptions($_[1], \%display_options); }
	} else {
		print "$warning_message no pdl was supplied for aquaDisplayBitmap\n";
		return 0;
	}
	
	# if the user didn't provide the width and height of the part that they want to show, default to showing the whole thing
		
	if ($display_options{"DEST_W"} == -1) {
		if ($num_dims == 2) {
			$display_options{"DEST_W"} = $bmp_dims[0];
		} else {
			$display_options{"DEST_W"} = $bmp_dims[1];
		}
	}
	if ($display_options{"DEST_H"} == -1) {
		if ($num_dims == 2) {
			$display_options{"DEST_H"} = $bmp_dims[1];
		} else {
			$display_options{"DEST_H"} = $bmp_dims[2];
		}
	}
	
	# check whether the user wants to auto-scale the image
	
	if ($display_options{"AUTO_SCALE"}){
		$display_options{"M_MIN"} = min($the_bitmap);
		$display_options{"M_MAX"} = max($the_bitmap);
	}
	
	# re-scale the image if necessary
	
	if (($display_options{"M_MIN"} != 0.0) || ($display_options{"M_MAX"} != 255.0)){
		if($debug_on){
			print "$debug_message re-scaling image " . $display_options{"M_MIN"} . " - " . $display_options{"M_MAX"} . "\n";
 		}
		$the_bitmap = float($the_bitmap);
		if($display_options{"M_MIN"} < $display_options{"M_MAX"}) {
			$the_bitmap = ($the_bitmap - $display_options{"M_MIN"}) * 255.0 / ($display_options{"M_MAX"} - $display_options{"M_MIN"});
		} else {
			print "$warning_message min is greater then max, image re-scale aborted\n";
		}
	}
	
	# threshold the image so that it doesn't roll over
	
	$the_bitmap = $the_bitmap * ($the_bitmap >= 0.0);
	$the_bitmap -= 255.0;
	$the_bitmap = $the_bitmap * ($the_bitmap <= 0.0);
	$the_bitmap += 255.0;
	$the_bitmap = byte($the_bitmap);
		
	# select the appropriate window, or open a new one if no such window is available

	unless(selectWindow($display_options{"WIN_NUM"})){
		aquaOpen({WIN_NUM => $display_options{"WIN_NUM"}, SIZE_X => $display_options{"DEST_W"}, SIZE_Y => $display_options{"DEST_H"}});
	}
	
	# output the display_options hash if we are in debugging mode
	
	if ($debug_on){ outputHash("display_options", \%display_options); }

	# make the image "true-color" if necessary

	if ($num_dims == 2) {
		$the_bitmap = index($color_table, $the_bitmap->dummy(0));	# convert the image to true color
	}
	
	if($display_options{"ERASE"}) { aqtClearPlot(); }	# if desired, clear the current plot

	# display the image
	
	callAqtBitmap($the_bitmap, $display_options{"DEST_X"}, $display_options{"DEST_Y"}, $display_options{"DEST_W"}, $display_options{"DEST_H"});
	
	# if the user supplied a number, then add it to the plot
	
	if ($display_options{"TEXT"}){
		callAqtSetColor(pdl($display_options{"TEXT_C"}));
		aqtAddLabel($display_options{"TEXT"}, $display_options{"TEXT_X"}, $display_options{"TEXT_Y"}, 0.0, 0);
	}
	
	# tell aquaterm to draw the new plot
	
	aqtRenderPlot();
	
	return 1;
}

# Makes a local copy of a user supplied color table. It is assumed that the color 
# table pdl is of the form ($levels, $red, $green, $blue), a 256 x 4 pdl, as would 
# be generated by the command '$color_table = cat(lut_data("xx"))'. $levels is ignored. 
# $red, $green & $blue are assumed to range from 0 to 1.

sub aquaSetColorTable{

	if ($debug_on){
		print "\n>>> aquaSetColorTable\n\n";
	}

	if (@_) {
		my $col_tab = $_[0];
		if (($col_tab->getdim(0) == 256)&&($col_tab->getdim(1) == 4)){
			$color_table = byte(255.0 * ($col_tab->slice('0:255,1:3'))->copy);
		} else {
			print "$warning_message color table has the wrong dimensions (256 x 4 expected)";
		}
	} else {
		print "$warning_message no color table supplied";
	}
}

# Draw lines between a set of points given by a PDL of size (2,n), where the first dimension is
# x & y position of the points and n is the number of points

sub aquaPolyLine{
	my %options;
	my %line_options = (	# default line options
		WIN_NUM => -1,
		ERASE => 0,
		WIDTH => 1,
		CAPS => 0,
		COLOR => [0.0, 0.0, 0.0]
	);
	
	if ($debug_on){
		print "\n>>> aquaPolyLine\n\n";
	}
	
	# get, check and load user supplied options

	my $the_line;
	
	if (@_) {
		$the_line = float($_[0]);
		if ($_[1]){ parseOptions($_[1], \%line_options); }
	} else {
		print "$warning_message no pdl was supplied for aquaPolyLine\n";
		return 0;
	}

	# output the line_options hash if we are in debugging mode
	
	if ($debug_on){ outputHash("line_options", \%line_options); }

	# select the right window to draw in
	
	unless(selectWindow($line_options{"WIN_NUM"})) { return; }

	# set up for line drawing
	
	if($line_options{"ERASE"}) { aqtClearPlot(); }	# if desired, clear the current plot
	callAqtSetColor(pdl($line_options{"COLOR"}));	# set the line color
	aqtSetLinewidth($line_options{"WIDTH"});		# set the line width
	aqtSetLineCapStyle($line_options{"CAPS"});		# set the line cap style
	
	# add the line to the plot
	
	my $x = $the_line->slice("0,:")->squeeze->copy;
	my $y = $the_line->slice("1,:")->squeeze->copy;
	callAqtPolyline($x, $y);
	
	# render the plot
	
	aqtRenderPlot();
}

# draw text on the screen with the selectable font, size & color

sub aquaText{
	my %options;
	my %text_options = (	# default text options
		WIN_NUM => -1,
		ERASE => 0,
		NAME => "Times-Roman",
		ANGLE => 0.0,
		X => 6.0,
		Y => 10.0,
		JUST => 0,
		SIZE => 12.0,
		COLOR => [0.0, 0.0, 0.0]
	);
	
	if ($debug_on){
		print "\n>>> aquaDrawText\n\n";
	}
	
	# get, check and load user supplied options

	my $the_text;
	
	if (@_) {
		$the_text = $_[0];
		if ($_[1]){ parseOptions($_[1], \%text_options); }
	} else {
		print "$warning_message no text was supplied for aquaDrawText\n";
		return 0;
	}

	# output the text_options hash if we are in debugging mode
	
	if ($debug_on){ outputHash("text_options", \%text_options); }

	# select the right window to draw in

	unless(selectWindow($text_options{"WIN_NUM"})) { return; }
	
	# set the font size & type & color
	
	callAqtSetColor(pdl($text_options{"COLOR"}));
	aqtSetFontname($text_options{"NAME"});
	aqtSetFontsize($text_options{"SIZE"});

	# draw the text
	
	if($text_options{"ERASE"}) { aqtClearPlot(); }	# if desired, clear the current plot
	aqtAddLabel($the_text, $text_options{"X"}, $text_options{"Y"}, $text_options{"ANGLE"}, $text_options{"JUST"});

	# render the plot
	
	aqtRenderPlot();	
}


# return the coordinates of the next mouse click

sub aquaMouse{
	my %options;
	my %mouse_options = (	# mouse options
		WIN_NUM => -1
	);
	
	if ($debug_on){
		print "\n>>> aquaMouse\n\n";
	}
	
	# get, check and load user supplied options

	if ($_[0]){ parseOptions($_[0], \%mouse_options); }

	# output the display_options hash if we are in debugging mode
	
	if ($debug_on){ outputHash("mouse_options", \%mouse_options); }

	# select the window that we want to click in
	
	unless(selectWindow($mouse_options{"WIN_NUM"})) { return; }

	my $event = callAqtWaitNextEvent();
	my @loc;
	if($event =~ /{([\d]+)[^\d]+([\d]+)}/){
		push @loc, $1, $2;
		# push @loc, $2;
	}
	@loc;
}

EOD

###
# specify those functions that will be exported
###

# clear the auto-generated list
pp_export_nothing();

# add the "right" functions
pp_add_exported('', 'aquaOpen', 'aquaBitmap', 'aquaSetColorTable', 'aquaPolyLine', 'aquaText', 'aquaMouse');	

###
# Documentation
###

pp_addpm({At=>'Bot'},<<'EOD');

=head1 NAME

PDL::Graphics::AquaTerm - Provides access to the AquaTerm Mac OS-X graphics terminal

=head1 SYNOPSIS

  # example 1

  use PDL;
  use PDL::Graphics::LUT;
  use PDL::Graphics::AquaTerm;
  my $x_size = 255; my $y_size = 255;
  aquaOpen({SIZE_X => $x_size, SIZE_Y => $y_size});
  aquaSetColorTable(cat(lut_data('idl5')));
  my $a = xvals(zeroes(byte,$x_size,$y_size));
  aquaBitmap($a);

# example 2

  use PDL;
  use PDL::Graphics::AquaTerm;
  my $x_size = 255; my $y_size = 255;
  aquaOpen({WIN_NUM => 1, SIZE_X => $x_size, SIZE_Y => $y_size});
  my $a = sin(xvals(zeroes(float, $x_size, $y_size)) * 0.1);
  aquaBitmap($a, {AUTO_SCALE => 1});

=head1 DESCRIPTION

This module interfaces PDL directly to the AquaTerm Mac OS-X graphics terminal. It is primarily intended for quickly and easily displaying bitmap images.

The coordinate system is defined by the window size (given in pixels) with (0,0) at the bottom left corner of the window. This means that if the window is set to be 300 x 200, then the bottom left corner will have coordinates (0,0) and the upper right corner will have coordinates (300,200). Anything that is drawn outside this boundary will be automatically clipped.

=head1 FUNCTIONS

=head2 aquaOpen

=for ref

Open a new AquaTerm window

=for usage

  Usage: aquaOpen(); # open the window with the defaults
  Usage: aquaOpen({SIZE_X => 200, SIZE_Y => 200, BACK_COLOR => [0.0, 0.0, 0.0]});
                 				
Opens a new AquaTerm window, it also starts AquaTerm if necessary.

Options recognized :

      SIZE_X - window x size in pixels (default = 400)
      SIZE_Y - window y size in pixels (default = 300)
     WIN_NUM - The window number, used by the drawing commands to specify which window to draw in
   WIN_TITLE - A title for the window, if desired (default = "Aquaterm.pm")
  BACK_COLOR - [r, g, b] the windows background color (default = [1.0, 1.0, 1.0], i.e. white)
     WARN_ON - set to 1 to turn on warning messages, 0 to turn off (default = 1)
    DEBUG_ON - set to 1 to turn on debugging message, 0 to turn off (default = 0)

=head2 aquaBitmap

=for ref

Display a PDL as a bitmap.

=for usage

  Usage: aquaDisplay($my_img); # display $my_img as a bitmap in the currently open window
  Usage: aquaDisplay($my_img, {AUTO_SCALE => 1.0, TEXT => "my image", TEXT_C => [1.0, 0.0, 0.0]});

Displays a PDL as a bitmap. The PDL can be of size either (m,n) or (3,m,n). PDLs of size (m,n) are converted to indexed color based on the current color table (see aquaSetColorTable). PDLs of size (3,m,n) are displayed as true-color images with the first dimension specifying the color (RGB). Unless a re-scaling is specified, the minimum value displayed is 0.0 and the maximum is 255.0.

Options recognized :

      DEST_X - position of the left side of the bitmap in pixels (default = 0)
      DEST_Y - position of the bottom of the bitmap in pixels (default = 0)
      DEST_W - width of the bitmap to be displayed (default = width of the PDL)
      DEST_H - height of the bitmap to be displayed (default = height of the PDL)
  AUTO_SCALE - if set equal to 1, the PDL will be rescaled such that its 
                     minimum value is 1 and its max is 255 (default = 0)
       M_MIN - the minimum value to be displayed (default = 0.0)
       M_MAX - the maximum value to be displayed (default = 255.0)
     WIN_NUM - specify which window to draw in (default = current window)
        TEXT - text to display on the bitmap
      TEXT_X - x location of the text in pixels (default = 6)
      TEXT_Y - y location of the text in pixels (default = 10)
      TEXT_C - RGB color of the text, (default = [0.0, 0.0, 0.0], i.e. black)
	
=head2 aquaSetColorTable

=for ref

Set the color table

=for usage

  Usage: aquaSetColorTable(cat(lut_data('idl5'))); # set the color table to idl5

Makes a local copy of a user supplied color table. The color table must be a 256 x 4 pdl of the form (l,r,g,b), as would be generated by the command '$ct = cat(lut_data("xyz"))'. The l value is ignored. The r, g and b values should be in the range 0.0 - 1.0.

=head2 aquaPolyLine

=for ref

Draws a (2,n) PDL as a line

=for usage

  Usage: aquaPolyLine($line, {WIDTH => 3, COLOR => [0.0, 0.0, 0.0]}); # draw $line black with width 3

Draw a poly-line between a set of points given by a PDL of size (2,n). The first dimension of the PDL gives the x & y position of the individual points, n is the total number of points.

Options recognized
  WIN_NUM - which window to draw the line in
    ERASE - clear the selected window prior to drawing the line
    WIDTH - line width (default = 1)
     CAPS - line cap style, I'm still unsure exactly what this is...
    COLOR - RGB color of the line (default is black)

=head2 aquaText

=for ref

Draw text

=for usage

  # draw red 'hello world' at position 20, 30 in the current window
  Usage: aquaText("hello world", X => 20, Y => 30, COLOR => [1.0, 0.0, 0.0]);

Draws text.

Options recognized
  WIN_NUM - which window to draw the text in
    ERASE - clear the current window prior to drawing the text
     NAME - name of the font to use (default = "Times-Roman")
    ANGLE - angle to display the text relative to the horizontal in degrees (default = 0.0)
        X - position in the window of the text anchor point (which depends on the justification of the text) (default = 6)
        Y - position in the window of the bottom of the text (default = 10)
     JUST - text justification, left = 0, center = 1, right = -1? (default = 0)
     SIZE - font size in points (default = 12)
    COLOR - text color (default is black)

=head2 aquaMouse

= for ref

Returns location of next mouse click in the active window

= for usage

($mx, $my) = aquaMouse();

Returns the location of the next mouse click in the active window as a 2 element array. The elements of the array are the x and y coordinates of the mouse click in pixels. The coordinates are relative to the bottom left corner of the active area of the window.

Options recognized
  WIN_NUM - which window to get the mouse click in

=head1 INSTALLATION

You must install aquaterm prior to trying to install this module as it links against the aquaterm library. After AquaTerm installation you should have the following directory/file structure:

/usr/local/include/aquaterm/aquaterm.h
/usr/local/lib/libaquaterm.dylib

as explained in the INSTALL file that accompanies aquaterm.

=head1 KNOWN ISSUES

If you are using this module in a perl script simultaneously with another drawing/graphing module such as PDL::Graphics::PGPLOT::Window then you may have problems with the two modules drawing into the same window. This is hard to work around since PGPlot will always draw in the currently active window regardless of which window it opened in the first place.

The (0,0) of bitmaps is their upper left corner, but for mouse events it is the bottom left corner. If you are trying to use the mouse to select a portion of a bitmap then you need to adjust the coordinates returned by the mouse accordingly (i.e. $good_y = $bitmap_size_y - $y_from_aquaMouse).

=head1 BUGS

No known bugs yet.

=head1 SEE ALSO

http://sourceforge.net/projects/aquaterm/

=head1 AUTHOR

Hazen Babcock (hbabcockos1@mac.com)

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut

EOD

pp_done();