/aquaterm.pd
http://github.com/gitpan/PDL-Graphics-AquaTerm · Unknown · 803 lines · 578 code · 225 blank · 0 comment · 0 complexity · 259f223dafdc31a55bbdaea956cf0ce9 MD5 · raw file
- $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();