$VERSION = '0.04';

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

###
#
# OO interface to X windows
#
# The approach is that each X object will have an associated X window. The 
# X object stores the X window and the associated GC. The object is responsible 
# for creating & destroying the window, for relaying commands between perl 
# and the window & making sure that the window has not been destroyed in some 
# other way (i.e. the user closed the window directly w/ the mouse).
#
# Not the best convention perhaps, but routines that I wrote that call X
# start with '_X' and "real" X routines start with 'X'.
#
# Hazen 2/05
#
###

###
# Header files
###

pp_addhdr('

/*
 * includes & defines
 */

#include <X11/X.h>
#include <X11/Xlib.h>
#include <X11/Xutil.h>
#include <X11/cursorfont.h>
#include <signal.h>
#include <setjmp.h>
jmp_buf XIOrecover;

static Window root_window;
static int broken_pipe;

/*
 *
 */
 
int IOErrorHandler (Display *dpy) {
	printf("Warning, window is already closed\n");
	broken_pipe = 1;
	longjmp(XIOrecover, 1);
	printf("jump failed...\n");
}

void sig_pipe(int n){
	printf("Caught broken pipe\n");
	broken_pipe = 1;
}

');

###
# Routines that interface to X
###

pp_addxs(<<'EOC');

# checks whether or not a display pointer is null
# FIXME: could this be done in Perl?

int
_DisplayPtrCheck(X_disp)
	Display *X_disp
	CODE:
		if(X_disp == NULL){
			RETVAL = 0;
		} else {
			RETVAL = 1;
		}
	OUTPUT:
		RETVAL

# set-up broken pipe error handler

void
_InitSigPipe()
	CODE:
		if (signal(SIGPIPE, sig_pipe) == SIG_ERR) {
			printf("Unable to set up signal handler, beware X!\n");
		}

# check whether the window has been "externally" destroyed
# done by polling X for some information & seeing if this
# generates a broken pipe

int
_XCheck(X_disp, X_win)
	Display *X_disp
	Window *X_win
	CODE:
		int is_broken;
		XWindowAttributes win_attr;

		is_broken = 0;
		broken_pipe = 0;
		if(setjmp(XIOrecover) == 0) XSetIOErrorHandler(IOErrorHandler);
		if(broken_pipe){
			is_broken = 1;
		} else {
			XGetWindowAttributes(X_disp, *X_win, &win_attr);
		}
		RETVAL = is_broken;
	OUTPUT:
		RETVAL

# clear a window

void
_XClearWindow(X_disp, X_win)
	Display *X_disp
	Window *X_win
	CODE:
		XClearWindow(X_disp, *X_win);
		XFlush(X_disp);

# close the display

void
_XCloseDisplay(X_disp)
	Display *X_disp
	CODE:
		XCloseDisplay(X_disp);
		
# close a window & free storage

void
_XCloseWindow(X_disp, X_win)
	Display *X_disp
	Window *X_win
	CODE:
		XDestroyWindow(X_disp, *X_win);
		XFlush(X_disp);
		free(X_win);
	
# draw a arc in a window

void
_XDrawArc(X_disp, X_win, X_gc, x, y, width, height, angle1, angle2)
	Display *X_disp
	Window *X_win
	GC *X_gc
	int x
	int y
	int width
	int height
	int angle1
	int angle2
	CODE:
		XDrawArc(X_disp, *X_win, *X_gc, x, y, width, height, angle1, angle2);
		XFlush(X_disp);

# draw a line in a window

void
_XDrawLine(X_disp, X_win, X_gc, x1, y1, x2, y2)
	Display *X_disp
	Window *X_win
	GC *X_gc
	int x1
	int y1
	int x2
	int y2
	CODE:
		XDrawLine(X_disp, *X_win, *X_gc, x1, y1, x2, y2);
		XFlush(X_disp);

# draw a rectangle in a window

void
_XDrawRectangle(X_disp, X_win, X_gc, x, y, width, height)
	Display *X_disp
	Window *X_win;
	GC *X_gc;
	int x
	int y
	int width
	int height
	CODE:
		XDrawRectangle(X_disp, *X_win, *X_gc, x, y, width, height);
		XFlush(X_disp);
		
# draw a string in a window

void
_XDrawString(X_disp, X_win, X_gc, x, y, text)
	Display *X_disp
	Window *X_win
	GC *X_gc
	int x
	int y
	char *text
	CODE:
		XDrawString(X_disp, *X_win, *X_gc, x, y, text, strlen(text));
		XFlush(X_disp);

# free a GC

void
_XFreeGC(X_gc)
	GC *X_gc
	CODE:
		free(X_gc);

# get the GC of a window

GC *
_XGetGC(X_disp, X_win)
	Display *X_disp
	Window *X_win
	CODE:
		GC *X_gc;
		XGCValues values;

		X_gc = (GC *) malloc (sizeof(GC));
		*X_gc = XCreateGC(X_disp, *X_win, 0, &values);
		RETVAL = X_gc;
	OUTPUT:
		RETVAL

# returns the name of the first font found that matches our search pattern

char *
_XGetFont(X_disp, search, suppress)
	Display *X_disp
	char *search
	int suppress
	CODE:
		short i;
		int count;
		char **list;

		list = XListFonts(X_disp, search, 2000, &count);
		RETVAL = "not_found";
		if((suppress == 0)&&(count > 0)){
			printf("%d fonts available\n", count);
			for(i=0;i<count;i++){
				printf("  %s\n",list[i]);
			}
		}
		if(count > 0){
			RETVAL = list[0];
		}
	OUTPUT:
		RETVAL

# block until we get a button release event, return event coordinates
# includes some error handling in case the user closes the window in 
# the process of clicking on it
# FIXME : lame hack to pass back x & y position. I'm pretty sure that 
#    I can return these directly, i.e. ($x, $y) = _X11GetMouse($win)
#    but _XGetMouse(wn, OUTLIST int x, OUTLIST int y) seems to
#    require me to pass in 3 parameters...

char *
_XGetMouse(X_disp, X_win)
	Display *X_disp
	Window *X_win
	CODE:
		char temp[40];
		XEvent aEvent;
		Cursor cursor;
		
		cursor = XCreateFontCursor(X_disp, XC_crosshair);
		XDefineCursor(X_disp, *X_win, cursor);
		XSelectInput(X_disp, *X_win, ButtonReleaseMask);

		if(setjmp(XIOrecover) == 0) XSetIOErrorHandler(IOErrorHandler);
		if(broken_pipe){
			sprintf(temp, "0.0 0.0");
		} else {
			XMaskEvent(X_disp, ButtonReleaseMask, &aEvent);
			sprintf(temp, "%d %d", aEvent.xbutton.x, aEvent.xbutton.y);
			XSelectInput(X_disp, *X_win, SubstructureNotifyMask);
			XUndefineCursor(X_disp, *X_win);
			XFlush(X_disp);
		}
		RETVAL = temp;
	OUTPUT:
		RETVAL

# change the line style

void
_XLineStyle(X_disp, X_gc, line_wd, line_s)
	Display *X_disp
	GC *X_gc
	int line_wd
	int line_s
	CODE:
		XSetLineAttributes(X_disp, *X_gc, line_wd, line_s, CapButt, JoinMiter);

# load a font into the current GC

void
_XLoadFont(X_disp, X_gc, font_name)
	Display *X_disp
	GC *X_gc
	char *font_name
	CODE:
		XFontStruct *the_font;
		
		the_font = XLoadQueryFont(X_disp, font_name);
		if(the_font != NULL){
			XSetFont(X_disp, *X_gc, the_font->fid);
		} else {
			printf(" font not found\n");
		}
		free(the_font);

# open a new display (one per window)

Display *
_XNewDisplay()
	CODE:
		int screen;
		Display *X_disp;
		
		X_disp = XOpenDisplay(NULL);
		if(X_disp != NULL){
			screen = DefaultScreen(X_disp);
			root_window = RootWindow(X_disp, screen);
		}
		RETVAL = X_disp;
	OUTPUT:
		RETVAL

# open an X window of specified size & background

Window *
_XNewWindow(X_disp, sx, sy, bg)
	Display *X_disp
	int sx
	int	sy
	unsigned long bg
	CODE:
		Window *X_win;
		
		X_win = (Window *) malloc (sizeof(Window));
		*X_win = XCreateSimpleWindow(X_disp, root_window, 0, 0, sx, sy, 1, 0, bg);
		XMapWindow(X_disp, *X_win);
		XFlush(X_disp);
		RETVAL = X_win;
	OUTPUT:
		RETVAL

# resize a window

void
_XResizeWindow(X_disp, X_win, w, h)
	Display *X_disp
	Window *X_win
	int w
	int h
	CODE:
		XResizeWindow(X_disp, *X_win, w, h);
		XFlush(X_disp);

# change the foreground color

void
_XSetForeground(X_disp, X_gc, color)
	Display *X_disp
	GC *X_gc
	int color
	CODE:
		XSetForeground(X_disp, *X_gc, color);

# set the window title

void
_XSetWindowName(X_disp, X_win, name)
	Display *X_disp
	Window *X_win
	char *name
	CODE:
		char **stringList;
		XTextProperty text_prop;
		
		stringList = (char **) malloc(sizeof(char *));
		stringList[0] = name;
		XStringListToTextProperty(stringList, 1, &text_prop);
		XSetWMName(X_disp, *X_win, &text_prop);
		XFlush(X_disp);
		free(stringList);

# returns the width of a character in the current font
# I guess they all have the same height since there is no
# XTextHeight or equivalent ;)

int 
_XTextWidth(X_disp, font_name, the_text, count)
	Display *X_disp
	char *font_name
	char *the_text
	int count
	CODE:
		int width;
		XFontStruct *the_font;
		
		the_font = XLoadQueryFont(X_disp, font_name);
		width = XTextWidth(the_font, the_text, count);
 		RETVAL = width;
	OUTPUT:
		RETVAL
     
# get the current window size & the maximum window size in X and Y

char *
_XWinSize(X_disp, X_win)
	Display *X_disp
	Window *X_win
	CODE:
		int screen;
		int dw;
		int dh;
		char temp[80];
     	XWindowAttributes win_attr;
     	
		screen = DefaultScreen(X_disp);
		dw = DisplayWidth(X_disp, screen);
		dh = DisplayHeight(X_disp, screen);
		XGetWindowAttributes(X_disp, *X_win, &win_attr);
		sprintf(temp, "%d %d %d %d", win_attr.width, win_attr.height, dw, dh);		
		RETVAL = temp;
	OUTPUT:
		RETVAL
		
EOC

###
# PP sub-routines
###

# draw a polyline

pp_def('_XPolyLine',
	Pars => 'x(n); y(n)',
	OtherPars => 'int X_disp; int X_win; int X_gc',
	GenericTypes => [L],
	Code => '
		int i,j;
		
		for(i=0;i<($SIZE(n)-1);i++){
			j = i+1;
			XDrawLine(((Display *)$COMP(X_disp)), *((Window *)$COMP(X_win)), *((GC *)$COMP(X_gc)), $x(n=>i), $y(n=>i), $x(n=>j), $y(n=>j));
		}
		XFlush((Display *)$COMP(X_disp));
');

# draw a bitmap

pp_def('_XDrawBitmap',
	Pars => 'bm(n,m)',
	OtherPars => 'int x; int y; int X_disp; int X_win; int X_gc',
	GenericTypes => [L],
	Code => '
		int i, j;
		XImage *picture;
		
		picture = XGetImage(((Display *)$COMP(X_disp)), *((Window *)$COMP(X_win)), 0, 0, $SIZE(n), $SIZE(m), AllPlanes, ZPixmap);
		for(i=0;i<$SIZE(n);i++){
			for(j=0;j<$SIZE(m);j++){
				XPutPixel(picture, i, j, $bm(n=>i,m=>j));
			}
		}
		XPutImage(((Display *)$COMP(X_disp)), *((Window *)$COMP(X_win)), *((GC *)$COMP(X_gc)), picture, 0, 0, $COMP(x), $COMP(y), $SIZE(n), $SIZE(m));
		XDestroyImage(picture);
		XFlush((Display *)$COMP(X_disp));
');

###
# Perl subroutines
###

pp_addpm(<<'EOD');

## we need PDL

use PDL;

###
# Global variables
###

my $sig_pipe_initialized = 0;				# flag for whether broken pipe error handling is running
my $number_of_X_objects = 0;				# keeps track of how many X objects exist
my $warning_message = ">>> X Warning : "; 	# generic start of warning messages

my %default_options = (						# default options
	SIZE_X => 400,
	SIZE_Y => 300,
	WIN_TITLE => "X",
	BACK_COLOR => [1.0, 1.0, 1.0],
	LINEWIDTH => 1,
	LINESTYLE => 0,
	COLOR => [0.0, 0.0, 0.0],
	CHARSIZE => 12,
	FONT_NAME => "courier",
	X_FONT => ""
);

###
# private sub-routines
###

# parse options hashes

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

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

# convert a color array to a long, which will give you _roughly_ the right color

sub _RGBToLong {
	my $rgb = shift;
	my $color = ($rgb->[0] * 255.0) * 256.0 * 256.0 + ($rgb->[1] * 255.0) * 256.0 + ($rgb->[2] * 255.0);
	return $color;
}

# create the default gray-scale color table

sub _createGrayScale {
	$color_table = long(xvals(256.0)*256.0*256.0 + xvals(256.0)*256.0 + xvals(256.0));
	return($color_table);
}

# setup the default font, try and find a scalable "medium" font of specified type
# the first one that is found is the one that is used

sub _setupFont {
	my $X_disp = shift;
	my $font_family = shift;

	my $search_string = "-*-" . $font_family . "-medium-r-normal-*-0-0-*-*-*-0-*-*";
	my $x_font = _XGetFont($X_disp, $search_string, 1);
	unless($x_font =~ /not_found/){
		$x_font =~ s!-0!-\*!g;
	} else {
		print "No $font_family family scalable fonts were found\n";
	}
	return $x_font;
}

# handles checking whether or not we still have a valid client-server connection
# and freeing the object is we don't

sub _lost_connection {
	my $xwin = shift;

	unless($xwin->{bad_win}){	
		if(_XCheck($xwin->{X_disp}, $xwin->{X_win})){
			print "The connection to window called \"" . $xwin->{options}->{"WIN_TITLE"} . "\" was lost\n";
			$xwin->{bad_win} = 1;
			return 1;
		} else {
			return 0;
		}
	} else {
		print "Sorry, the window called \"" . $xwin->{options}->{"WIN_TITLE"} . "\" is closed\n";
		return 1;
	}
}	

###
# Object methods
###

# create a new X object & associated X window

sub new {
	my $self = shift;
	my $opt = shift;

	my %wopt = %default_options;
	if(defined($opt)){ _parseOptions($opt, \%wopt); }
	my $X_disp = _XNewDisplay();
	if(_DisplayPtrCheck($X_disp)){
		unless($sig_pipe_initialized){
			_InitSigPipe();
			$sig_pipe_initialized = 1;
		}
		my $X_win = _XNewWindow($X_disp, $wopt{"SIZE_X"}, $wopt{"SIZE_Y"}, _RGBToLong($wopt{"BACK_COLOR"}));
		my $X_gc = _XGetGC($X_disp, $X_win);
		_XSetWindowName($X_disp, $X_win, $wopt{"WIN_TITLE"} . " (" . $number_of_X_objects . ")");
		my $c_table = _createGrayScale();
		$wopt{"X_FONT"} = _setupFont($X_disp, $wopt{"FONT_NAME"});
		$number_of_X_objects++;
		my $bad_win = 0;
		my $param = {X_disp => $X_disp, X_win => $X_win, X_gc => $X_gc, bad_win => $bad_win, c_table => $c_table, options => \%wopt};
		return(bless $param, $self);
	} else {
		print "PDL::Graphics::X X11 display initialization failed\n";
		return undef;
	}
}

# check whether this window still exists

sub we_exist {
	my $self = shift;
	if(_lost_connection($self)) {
		return 1;
	} else {
	}
	return 0;
}

# returns the maximum allowable size of a window
# primarily intended for use by modules that build on this module

sub winsize {
	my $self = shift;

	if(_lost_connection($self)) { return; }

	my $size;
	$size = _XWinSize($self->{X_disp}, $self->{X_win});
	my ($size_x, $size_y, $max_x, $max_y) = split(/ /, $size);
	return ($size_x, $size_y, $max_x, $max_y);
}

# resizes the window, returns whatever the final size actually 
# ended up being, primarily intended for internal/other module use

sub resize {
	my $self = shift;
	my ($size_x, $size_y) = @_;
	
	if(_lost_connection($self)) { return; }

	my ($max_x, $max_y) = (winsize($self))[2,3];
	if($size_x > $max_x) { $size_x = $max_x; }
	if($size_y > $max_y) { $size_y = $max_y; }
	_XResizeWindow($self->{X_disp}, $self->{X_win}, $size_x, $size_y);
	return($size_x, $size_y);
}

# catch object destroy so that we can close the X window & free up the associated memory
# if the window is bad, this means that X has already taken care of this for us

sub DESTROY {
	my $self = shift;
	unless($bad_window){
		_XFreeGC($self->{X_gc});
		_XCloseWindow($self->{X_disp}, $self->{X_win});
		_XCloseDisplay($self->{X_disp});
	}
	$bad_window = 0;
	$number_of_X_objects--;
}

# display a pdl as a 2 dimensional bitmap

sub imag {
	my $self = shift;
	my ($the_bitmap, $options) = @_;
	my %dopt = (	# default display options
		DEST_X => 0,
		DEST_Y => 0,
		DEST_W => -1,
		DEST_H => -1,
		AUTO_SCALE => 0,
		MIN => 0.0,
		MAX => 255.0,
	);
	
	if(_lost_connection($self)) { return 1; }
	
	my $num_dims;
	my @bmp_dims;
	if (defined($the_bitmap)) {
		$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 ($options) { _parseOptions($options, \%dopt); }
	} else {
		print "$warning_message no pdl was supplied for imag\n";
		return 0;
	}

	# round requested x and y position to the nearest pixel

	$dopt{"DEST_X"} = rint($dopt{"DEST_X"});
	$dopt{"DEST_Y"} = rint($dopt{"DEST_Y"});

	# 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 ($dopt{"DEST_W"} == -1) {
		$dopt{"DEST_W"} = $bmp_dims[0];
	}
	if ($dopt{"DEST_H"} == -1) {
		$dopt{"DEST_H"} = $bmp_dims[1];
	}
	
	# get the window size and set the pdl size to fit

	my ($win_x, $win_y) = (winsize($self))[0,1];
	if(($dopt{"DEST_X"} > $win_x)||($dopt{"DEST_Y"} > $win_y)){
		print "$warning message requested x & y offset are outside the window\n";
		return 0;
	}
	if(($dopt{"DEST_X"} + $dopt{"DEST_W"}) > $win_x){
		$dopt{"DEST_W"} = $win_x - $dopt{"DEST_X"};
	}
	if(($dopt{"DEST_Y"} + $dopt{"DEST_H"}) > $win_y){
		$dopt{"DEST_H"} = $win_y - $dopt{"DEST_Y"};
	}
	
	# trim the pdl to the desired size

	if($num_dims == 2){
		my $dw = $dopt{"DEST_W"} - 1;
		my $dh = $dopt{"DEST_H"} - 1;
		$the_bitmap = $the_bitmap->slice("0:$dw,0:$dh")->copy();
	} else {
		my $dw = $dopt{"DEST_W"} - 1;
		my $dh = $dopt{"DEST_H"} - 1;
		$the_bitmap = $the_bitmap->slice("0:$dw,0:$dh,:")->copy();
	}

	# check whether the user wants to auto-scale the image

	if ($dopt{"AUTO_SCALE"}){
		$dopt{"MIN"} = min($the_bitmap);
		$dopt{"MAX"} = max($the_bitmap);
	}
	
	# re-scale the image if necessary

	if (($dopt{"MIN"} != 0.0) || ($dopt{"MAX"} != 255.0)){
		if($debug_on){
			print "$debug_message re-scaling image " . $dopt{"MIN"} . " - " . $dopt{"MAX"} . "\n";
 		}
		$the_bitmap = float($the_bitmap);
		if($dopt{"MIN"} < $dopt{"MAX"}) {
			$the_bitmap = ($the_bitmap - $dopt{"MIN"}) * 255.0 / ($dopt{"MAX"} - $dopt{"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 = long($the_bitmap);
	
	# if this is a false color image, use the color table, otherwise convert as true color

	if ($num_dims == 2) {
		$the_bitmap = index($self->{c_table}, $the_bitmap);	
	} else {
		my $temp = 256*256*($the_bitmap->slice(":,:,0")->copy());
		$temp += 256*($the_bitmap->slice(":,:,1"));
		$temp += $the_bitmap->slice(":,:,2");
		$the_bitmap = $temp->squeeze();
	}

	# display the image

	_XDrawBitmap($the_bitmap, $dopt{"DEST_X"}, $dopt{"DEST_Y"}, $self->{X_disp}, $self->{X_win}, $self->{X_gc});
	
	return 0;
}

# 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 ctab {
	my $self = shift;
	my $col_tab = shift;
	if (defined($col_tab)) {
		if (($col_tab->getdim(0) == 256)&&($col_tab->getdim(1) == 4)){
			$self->{c_table} = long(rint(255.0 * ($col_tab->slice(":,3"))->copy));
			$self->{c_table} += 256 * long(rint(255.0 * ($col_tab->slice(":,2"))->copy));
			$self->{c_table} += 256 * 256 * long(rint(255.0 * ($col_tab->slice(":,1"))->copy));
			$self->{c_table} = $self->{c_table}->squeeze();
		} else {
			print "$warning_message color table has the wrong dimensions (256 x 4 expected)";
		}
	} else {
		print "$warning_message no color table supplied";
	}
}

# Draws vectors of x & y values as interconnected point

sub line {
	my $self = shift;
	my ($x, $y, $options) = @_;
		
	if(_lost_connection($self)) { return 1; }

	if (defined($y)) {
		if (defined($options)){ _parseOptions($options, $self->{options}); }
	} else {
		print "$warning_message no x & y were supplied for line\n";
		return 0;
	}
	if($x->dim(0) != $y->dim(0)){
		print "x & y are not of the same size\n";
		return 0;
	}
	_XLineStyle($self->{X_disp}, $self->{X_gc}, $self->{options}->{"LINEWIDTH"}, $self->{options}->{"LINESTYLE"});
	_XSetForeground($self->{X_disp}, $self->{X_gc}, _RGBToLong($self->{options}->{"COLOR"}));
	_XPolyLine($x, $y, $self->{X_disp}, $self->{X_win}, $self->{X_gc});
	return 0;
}

# erases the window

sub erase {
	my $self = shift;
	if(_lost_connection($self)) { return 1; }
	_XClearWindow($self->{X_disp}, $self->{X_win});
	return 0;
}

# draws text onto the window

sub text {
	my $self = shift;
	my ($text, $x, $y, $angle, $options) = @_;

	if(_lost_connection($self)) { return 1; }
	
	my $old_name = $self->{options}->{"FONT_NAME"};
	if(defined($angle)) {
		if (defined($options)){ _parseOptions($options, $self->{options}); }
	} else {
		print "$warning_message you must specify : text, x, y, angle for text\n";
		return 0;
	}
	unless($old_name eq $self->{options}->{"FONT_NAME"}){
		$self->{options}->{"X_FONT"} = _setupFont($self->{X_disp}, $self->{options}->{"FONT_NAME"});
	}
	my $font_name = $self->{options}->{"X_FONT"};
	unless($self->{options}->{"X_FONT"} eq "not_found"){
		$font_name =~ s!--\*!--$self->{options}->{"CHARSIZE"}!;
		_XLoadFont($self->{X_disp}, $self->{X_gc}, $font_name);
	}
	_XSetForeground($self->{X_disp}, $self->{X_gc}, _RGBToLong($self->{options}->{"COLOR"}));

	my $dy = -sin($angle * 3.14159/180.0) * ($self->{options}->{"CHARSIZE"} - 1);
	for my $i (0..(length($text)-1)){
		my $char = substr($text, $i, 1);
		my $dx = cos($angle * 3.14159/180.0) * (_XTextWidth($self->{X_disp}, $font_name, $char, 1) + 1);
		_XDrawString($self->{X_disp}, $self->{X_win}, $self->{X_gc}, $x, $y, $char);
		$x += $dx;
		$y += $dy;
	}
	return 0;
}

# returns coordinates of mouse click in the window

sub cursor {
	my $self = shift;

	if(_lost_connection($self)) { return; }

	my $event;
	$event = _XGetMouse($self->{X_disp}, $self->{X_win});
	my ($x, $y) = split(/ /, $event);
	return ($x, $y);
}

# draws a rectangle

sub rect {
	my $self = shift;
	my ($x1, $y1, $x2, $y2, $options) = @_;

	if(_lost_connection($self)) { return 1; }

	if(defined($y2)) {
		if (defined($options)){ _parseOptions($options, $self->{options}); }
	} else {
		print "$warning_message you must specify : x1, y1, x2, y2 for rect\n";
		return 0;
	}
	
	_XLineStyle($self->{X_disp}, $self->{X_gc}, $self->{options}->{"LINEWIDTH"}, $self->{options}->{"LINESTYLE"});
	_XSetForeground($self->{X_disp}, $self->{X_gc}, _RGBToLong($self->{options}->{"COLOR"}));
	_XDrawRectangle($self->{X_disp}, $self->{X_win}, $self->{X_gc}, $x1, $y1, ($x2-$x1), ($y2-$y1));
	return 0;
}

# draw a circle

sub circle {
	my $self = shift;
	my ($x, $y, $r, $options) = @_;

	if(_lost_connection($self)) { return 1; }

	if(defined($r)) {
		if (defined($options)){ _parseOptions($options, $self->{options}); }
	} else {
		print "$warning_message you must specify : x, y, r for circle\n";
		return 0;
	}
	
	_XLineStyle($self->{X_disp}, $self->{X_gc}, $self->{options}->{"LINEWIDTH"}, $self->{options}->{"LINESTYLE"});
	_XSetForeground($self->{X_disp}, $self->{X_gc}, _RGBToLong($self->{options}->{"COLOR"}));
	_XDrawArc($self->{X_disp}, $self->{X_win}, $self->{X_gc}, ($x-$r), ($y-$r), 2*$r, 2*$r, 0, 360*64);
	return 0;
}

# draw an ellipse

sub ellipse {
	my $self = shift;
	my ($x, $y, $a, $b, $options) = @_;

	if(_lost_connection($self)) { return 1; }

	if(defined($b)) {
		if (defined($options)){ _parseOptions($options, $self->{options}); }
	} else {
		print "$warning_message you must specify : x, y, a, b for ellipse\n";
		return 0;
	}
	
	_XLineStyle($self->{X_disp}, $self->{X_gc}, $self->{options}->{"LINEWIDTH"}, $self->{options}->{"LINESTYLE"});
	_XSetForeground($self->{X_disp}, $self->{X_gc}, _RGBToLong($self->{options}->{"COLOR"}));
	_XDrawArc($self->{X_disp}, $self->{X_win}, $self->{X_gc}, ($x-$a/2), ($y-$b/2), $a, $b, 0, 360*64);
	return 0;
}

EOD

# this is a OO module, so export nothing
pp_export_nothing();

###
# Documentation
###

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

=head1 NAME

PDL::Graphics::X - PDL OO access to X windows

=head1 SYNOPSIS

  # example 1

  use PDL;
  use PDL::Graphics::X;
  
  my $x_size = 255; my $y_size = 255;
  my $win1 = PDL::Graphics::X->new({SIZE_X => $x_size, SIZE_Y => $y_size});
  my $a = xvals(zeroes(byte,$x_size,$y_size));
  $win1->imag($a);

  # example 2

  use PDL;
  use PDL::Graphics::X;

  my $win1 = PDL::Graphics::X->new({WIN_TITLE => "PDL", SIZE_X => 210, SIZE_Y => 210});
  my $x = pdl(10, 100, 100, 10);
  my $y = pdl(10, 10, 100, 100);
  $win1->line($x, $y, {COLOR => [1,0,0], LINEWIDTH => 5});

=head1 DESCRIPTION

This module interfaces PDL directly to X windows in a OO fashion. Each X object has an associated X window and handles opening, closing and drawing in the associated window. Hopefully it is reasonably intuitive to use. The vision is that this will serve as a base upon which other fully native PDL graphics modules could be built.

Common options such as LINEWIDTH are remembered from function call to function call, i.e. if you call $win1->line($x, $y, {COLOR => [1,0,0], LINEWIDTH => 5}) then the rectangle drawn by $win1->rect(10, 10, 190, 190) will also have a red border of width equal to 5.

=head1 FUNCTIONS

=head2 new

=for ref

Constructor for a new X window object.

=for usage

  Usage: my $win1 = PDL::Graphics::X->new(); # open the window with the defaults
  Usage: my $win1 = PDL::Graphics::X->new({WIN_TITLE => "PDL", SIZE_X => 210, SIZE_Y => 210});
                 				
Creates a new X object & its associated X window.

Options recognized :

      SIZE_X - window x size in pixels (default = 400)
      SIZE_Y - window y size in pixels (default = 300)
   WIN_TITLE - A title for the window, if desired (default = "X")
  BACK_COLOR - [r, g, b] the windows background color (default = [1.0, 1.0, 1.0], i.e. white)
 
=head2 imag

=for ref

Display a PDL as a bitmap.

=for usage

  Usage: $win1->imag($my_img); # display an image with default size and scaling
  Usage: $win1->imag($my_img, {AUTO_SCALE => 1.0}); # display an auto-scaled image

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

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)
         MIN - the minimum value to be displayed (default = 0.0)
         MAX - the maximum value to be displayed (default = 255.0)
	
=head2 ctab

=for ref

Set the color table

=for usage

  Usage: $win1->ctab(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 line

=for ref

Draws a vector as connected points.

=for usage

  Usage: $win1->line($x, $y, {COLOR => [0,0,0], LINEWIDTH => 5}); # draw black line of width 5

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

Options recognized

  LINEWIDTH - line width
  LINESTYLE - line style (0 = normal, 1 = dashed)
      COLOR - [r, g, b] color of the line

=head2 rect

=for ref

Draws a rectangle.

=for usage

  Usage: $win1->rect($x1, $y1, $x2, $y2);

Draws a rectangle with corners at ($x1, $y1) and ($x2, $y2).

Options recognized

  LINEWIDTH - line width
  LINESTYLE - line style (0 = normal, 1 = dashed)
      COLOR - [r, g, b] color of the line

=head2 circle

=for ref

Draws a circle.

=for usage

  Usage: $win1->circle($x, $y, $r);

Draws a circle centered at ($x, $y) with radius $r.

Options recognized

  LINEWIDTH - line width
  LINESTYLE - line style (0 = normal, 1 = dashed)
      COLOR - [r, g, b] color of the line

=head2 ellipse

=for ref

Draws an oval.

=for usage

  Usage: $win1->ellipse($x, $y, $a, $b);

Draws a oval centered at ($x, $y) with x size $a and y size $b.

Options recognized

  LINEWIDTH - line width
  LINESTYLE - line style (0 = normal, 1 = dashed)
      COLOR - [r, g, b] color of the line

=head2 erase

=for ref

Erases the contents of the window.

=for usage

  Usage: $win1->erase();

Resets the contents of the window to the background color.

=head2 text

=for ref

Draw text

=for usage

  Usage: $win1->text("hello", $x, $y, $angle);

Draws text starting at $x and $y with baseline angle given by $angle. If you know how to draw truly rotated text in X, please let me know. How fonts are currently dealt with is imperfect at best. So that the font size can easily be changed, a search is performed for a scalable font with specified font name. If such a font cannot be found then the text will be displayed with the default X font and no font scaling.

Options recognized

  FONT_NAME - name of the font family (default = "courier")
   CHARSIZE - desired font size in points
      COLOR - [r, g, b] color of the font

=head2 cursor

=for ref

Returns the location of next mouse click in the window

=for usage

  Usage : my($x,$y) = $win1->cursor();

Returns the x & y locations of the next mouse click in the window.

=head2 we_exist

=for ref

Returns 0 if the window still exists, 1 if it does not

=for usage

  Usage : my $exists = $win1->we_exist();

Originally written to help debug some problems with associated with X windows being closed by the user with a mouse. Preserved on the off chance that it will be useful to a dependent module.

=head2 winsize

=for ref

Returns the window size & maximum window size (in pixels) in x and y

=for usage

  Usage : my ($win_x, $win_y, $max_x, $max_y) = $win1->winsize();

Primarily intended for use by dependent modules that might want to know what the current and maximum window size is.

=head2 resize

=for ref

resizes a window & returns the new size (which might not be what you requested)

=for usage

  Usage : my ($new_x, $new_y) = $win1->resize($size_x, $size_y);

Primarily intended for use by dependent modules that might want to resize a window without destroying it and creating another one.

=head1 KNOWN ISSUES

In order to keep from crashing hard when an X window is closed by the mouse, this module has its own SIGPIPE error handler. Hopefully this will not conflict with possibly similar error handlers created by other modules.

Font handling is poorly implemented as is rotated text.

Depending on the context RGB triples do not always give you the color you might have desired. They seem to work fine in the context of bitmaps, but more poorly in the context of line & text coloring.

=head1 BUGS

...

=head1 AUTHOR

Hazen Babcock (hbabcockos1 at 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();