PDLA-Rest
view release on metacpan or search on metacpan
Graphics/Graphics2D.pm view on Meta::CPAN
# GL_FLOAT
# GL_INT
# GL_LUMINANCE
# GL_LUMINANCE_ALPHA
# GL_MODELVIEW
# GL_PROJECTION
# GL_RGB
# GL_RGBA
# GL_SHORT
# GL_UNPACK_ALIGNMENT
# GL_UNSIGNED_BYTE
# GL_UNSIGNED_INT_8_8_8_8
# GL_UNSIGNED_SHORT
#
#------------------------------------------------------------------------
#------------------------------------------------------------------------
# opengl/glu/glut routines used by imag2d
#------------------------------------------------------------------------
#
# OpenGL::done_glutInit
#
# glutAddMenuEntry
# glutAttachMenu
# glutCreateMenu
# glutCreateWindow
# glutDestroyWindow
# glutDisplayFunc
# glutGet
# glutGetWindow
# glutInit
# glutInitDisplayMode
# glutInitWindowPosition
# glutInitWindowSize
# glutKeyboardFunc
# glutLeaveMainLoop
# glutMouseFunc
# glutPostRedisplay
# glutReshapeFunc
# glutReshapeWindow
# glutSetOption
# glutSwapBuffers
#
# glClear
# glClearColor
# glDrawPixels_s
# glFlush
# glLoadIdentity
# glMatrixMode
# glPixelStorei
# glPixelZoom
# glRasterPos2i
# glViewport
#
# gluOrtho2D
#
#------------------------------------------------------------------------
our $draw_overlay;
my $finished_glutInit = 0;
my $cur_fig_num = 0;
my $imag2d_keep_twiddling;
my $imag2d_is_twiddling;
my $show_overlay = 1;
our $is_paused = 0;
our $do_step = 0;
our $step_count = 1;
our $go_forward = 1;
our $go_backward = 0;
our @imag2d_list = ();
#------------------------------------------------------------------------
# glutMouseFunc callback
#------------------------------------------------------------------------
sub mouse_click {
my ($button, $state, $x, $y) = @_;
my $window_id = glutGetWindow();
my $width = glutGet(GLUT_WINDOW_WIDTH);
my $height = glutGet(GLUT_WINDOW_HEIGHT);
my $img;
# search for image corresponding to window
foreach my $entry ( @imag2d_list ) {
if ( $entry->{window_id} == $window_id ) {
$img = $entry->{img}; # 2D piddle for now
last;
}
}
die "mouse_click: callback could not find image window\n" unless defined $img;
# calculate zoom/aspect ratio factors
my $glds = 0; $glds = 1 if $img->dim(0) < 5; # hack, need verify consistency
my $zoom_x = $width / $img->dim($glds+0);
my $zoom_y = $height / $img->dim($glds+1);
my $zoom = ($zoom_x < $zoom_y) ? $zoom_x : $zoom_y;
# calculate the offset to the image use for centering
my ($hshift, $vshift) = (0,0);
if ( $zoom == $zoom_x ) {
# shift down
$vshift = ($height - $zoom * $img->dim($glds+1)) / 2.0;
} else {
# shift right
$hshift = ($width - $zoom * $img->dim($glds+0)) / 2.0;
}
my ($im_x, $im_y);
$im_x = sprintf "%.1f", ($x - $hshift) / $zoom;
$im_y = sprintf "%.1f", ($y - $vshift) / $zoom;
if ( $state
and (-1 < $im_x)
and (-1 < $im_y)
and ($im_x < $img->dim($glds+0)+1)
and ($im_y < $img->dim($glds+1)+1) ) {
printf STDERR "b_%01d: pixel=(%d,%d), im pt=(%.1f,%.1f),", $button, $x, $y, $im_x, $im_y;
printf STDERR " im val=%s, glds=$glds, winID=$window_id\n", $glds ? $img->(:,(int($im_x)),(int($im_y))) : $img->((int($im_x)),(int($im_y)));
}
};
Graphics/Graphics2D.pm view on Meta::CPAN
my ($gldrawformat, $gldrawtype, $glds);
return unless scalar(@imag2d_list);
# search for image corresponding to window
foreach my $entry ( @imag2d_list ) {
if ( $entry->{window_id} == $window_id ) {
$img = $entry->{img}; # 2D piddle for now
last;
}
}
die "display_window: callback could not find image window\n" unless defined $img;
# determine display pixel format to use
if ($img->ndims > 2 && $img->dim(0) == 4) {
$gldrawformat = GL_RGBA;
$glds = 1;
} elsif ($img->ndims > 2 && $img->dim(0) == 3) {
$gldrawformat = GL_RGB;
$glds = 1;
} elsif ($img->ndims > 2 && $img->dim(0) == 2) {
$gldrawformat = GL_LUMINANCE_ALPHA;
$glds = 1;
} elsif ($img->ndims > 2 && $img->dim(0) == 1) {
$gldrawformat = GL_LUMINANCE;
$glds = 1;
} else {
$gldrawformat = GL_LUMINANCE;
$glds = 0;
};
# convert to float if double for display
if ($img->type->symbol eq 'PDLA_D') { # clean up code
$img = $img->float;
}
# determine display pixel type to use
if ($img->type->symbol eq 'PDLA_F') {
$gldrawtype = GL_FLOAT;
} elsif ($img->type->symbol eq 'PDLA_B') {
$gldrawtype = GL_UNSIGNED_BYTE;
} elsif ($img->type->symbol eq 'PDLA_S') {
$gldrawtype = GL_SHORT;
} elsif ($img->type->symbol eq 'PDLA_US') {
$gldrawtype = GL_UNSIGNED_SHORT;
} elsif ($img->type->symbol eq 'PDLA_L') {
$gldrawtype = ( $gldrawformat == GL_RGBA ) ? GL_UNSIGNED_INT_8_8_8_8 : GL_INT;
} else {
die "display_image: unsupported data type '", $img->type->symbol, "' for image display\n";
}
my ($sizeX, $sizeY) = ($img->dim($glds+0), $img->dim($glds+1));
# print STDERR "... calculated image size is ($sizeX, $sizeY)\n";
# display image
glClear(GL_COLOR_BUFFER_BIT);
# glRasterPos2i( 0, 0 );
glDrawPixels_s( $sizeX, $sizeY, $gldrawformat, $gldrawtype, $img->get_dataref );
&{$draw_overlay}($img, $sizeX, $sizeY) if $show_overlay and defined($draw_overlay);
#draw_hough_lines($img, $sizeX, $sizeY);
glutSwapBuffers();
glFlush();
}
my $RELEASE=99;
#------------------------------------------------------------------------
# glutCreateMenu callback
#------------------------------------------------------------------------
sub ModeMenu {
my $entry = shift;
my $img;
if ($entry == $RELEASE) {
my ($window_id) = glutGetWindow();
# search for image corresponding to window
foreach my $listentry ( @imag2d_list ) {
if ( $listentry->{window_id} == $window_id ) {
$img = $listentry->{img}; # 2D piddle for now
last;
}
}
die "ModeMenu: callback could not find image window\n" unless defined $img;
glutLeaveMainLoop();
# glutDestroyWindow($window_id);
} else {
die "ModeMenu: illegal menu entry '$entry'\n";
}
}
#------------------------------------------------------------------------
# glutKeyboardFunc callback
#------------------------------------------------------------------------
sub key_ops {
my ($key, $x, $y) = @_;
my $win_id = glutGetWindow();
# handle keypress events (defaults first)
# print STDERR "Got keypress for keypress=$key\n";
# stop twiddling
if ($key == ord('Q') or $key == ord('q')) {
$imag2d_is_twiddling = 0;
warn "Stop twiddling command, key '" . chr($key) . "', detected.\n";
return;
}
# exit program
if ($key == 27 or $key == 3) { # ESC or Ctrl-C
warn "Exit program command, key '" . (($key == 27) ? 'ESC' : 'Ctrl-C') . "', detected.\n";
if (defined $PERLDL::TERM) { # don't exit if in the perldl or pdl2 shell
$imag2d_is_twiddling = 0;
warn "PDLA shell in use, stop twiddling instead of exit...\n";
return;
} else {
exit;
}
}
# toggle overlay
if ($key == ord('O') or $key == ord('o')) {
$show_overlay = (($show_overlay) ? 0 : 1);
warn "Toggle overlay command, key '" . chr($key) . "', detected.\n";
return;
}
# lock windows sizes together
if ($key == ord('L') or $key == ord('l')) {
## $lock_sizes = (($lock_sizes) ? 0 : 1);
## warn "Setting \$lock_sizes to $lock_sizes, (window=$win_id)\n";
warn "Lock window sizes command, key '" . chr($key) . "', not implemented.\n";
return;
}
# toggle image histogram equalization
if ($key == ord('H') or $key == ord('h')) {
## $hist_equalize = (($hist_equalize) ? 0 : 1);
## warn "Setting \$hist_equalize to $hist_equalize\n";
warn "Toggle image histogram equalization command, key '" . chr($key) . "', not implemented.\n";
return;
}
# resize current window (last clicked?) to 1:1
if ($key == ord('1')) {
## resize_window(-1,-1); # Special (w,h) args mean set zoom to 1
## glutPostRedisplay();
warn "Resize current window to 1:1 scale command, key '" . chr($key) . "', not implemented.\n";
return;
}
# resize other image windows to this one
if ($key == ord('=')) {
## warn "Resize other images to this one not yet implemented, (window=$win_id)\n";
warn "Resize other windows to this one command, key '" . chr($key) . "', not implemented.\n";
return;
}
# pause/run with space bar
if ($key == 32) { # SPACE
if ($is_paused) {
$is_paused = 0;
} else {
$is_paused = 1;
$step_count = 1;
$do_step = 1;
}
# warn "Pause/Run command, key 'SPACE', detected\n";
return;
}
# toggle verbose output
if ($key == ord('v') or $key == ord('V')) {
## $be_verbose = (($be_verbose) ? 0 : 1);
warn "Toggle verbose output command, key '" . chr($key) . "', not implemented.\n";
return;
}
# change direction or step in direction
if ($key == 46 or $key == 62) { # . or >
$go_forward = 1;
$go_backward = 0;
if ($is_paused) {
$do_step = 1;
$step_count = 1;
} else {
$step_count++;
$step_count = 1 if $step_count == 0;
}
# warn "Change Direction/Step forward command, key '" . (($key == 46) ? '.' : '>') . "', detected.\n";
return;
};
if ($key == 44 or $key == 60) { ; # , or <
$go_forward = 0;
$go_backward = 1;
if ($is_paused) {
$do_step = 1;
$step_count = -1;
} else {
$step_count--;
$step_count = -1 if $step_count == 0;
}
# warn "Change Direction/Step backward command, key '" . (($key == 44) ? ',' : '<') . "', detected.\n";
return;
}
warn "No handler for key " . chr($key) . ", (window=$win_id)\n";
}
#------------------------------------------------------------------------
# Create a new OpenGL context window for image display
#------------------------------------------------------------------------
sub display_new_window {
my ($height, $width, $zoom, $name, $off_r, $off_c, $window_id) = @_;
my ($window_width, $window_height);
my ($zoom_x, $zoom_y);
if ( $width <= 0 || $height <= 0 || $zoom == 0.0 )
{
die "display_new_window: invalid arguments!\n";
}
$window_width = int($zoom*$width + 0.5);
$window_height = int($zoom*$height + 0.5);
# compute zoom factors to make graphics overlay the image precisely
$zoom_x = $window_width/$width;
$zoom_y = $window_height/$height;
# create display window
if (! $finished_glutInit ) {
glutInit() unless OpenGL::done_glutInit();
glutInitDisplayMode(GLUT_RGBA|GLUT_DOUBLE);
glutSetOption(GLUT_ACTION_ON_WINDOW_CLOSE,GLUT_ACTION_CONTINUE_EXECUTION) if OpenGL::_have_freeglut();
$finished_glutInit = 1;
}
glutInitWindowSize( $window_width, $window_height );
glutInitWindowPosition( $off_r, $off_c );
$window_id = glutCreateWindow( $name );
# set some standard defaults
glPixelStorei( GL_UNPACK_ALIGNMENT, 1 );
glClearColor( 0.0, 0.0, 0.0, 0.0 );
glViewport( 0, 0, $window_width, $window_height );
# set coordinate frame for graphics in window
glMatrixMode( GL_PROJECTION );
glLoadIdentity();
gluOrtho2D( 0, $width, $height, 0 );
glMatrixMode( GL_MODELVIEW );
glLoadIdentity();
# set zoom factors for image display
glPixelZoom( $zoom_x, -$zoom_y );
# set origin for drawing images as the top-left corner of the window
glRasterPos2i( 0, 0 );
# success
return $window_id;
};
#------------------------------------------------------------------------
# Display piddle as 2-D image in window using OpenGL
#------------------------------------------------------------------------
=head1 FUNCTIONS
=head2 imag2d
=for ref
Display a 2-D image in a figure window
imag2d() creates a plain FreeGLUT OpenGL window and displays
the input image with 1:1 aspect ratio for pixels. The window
resize is constrained to the actual ratio of the image
dimensions. The initial display size is currently a 200x200
window to prevent things from being too small by default.
The image to display can have dimensions ($c,$M,$N) where for
$c==4 the display is in GL_RGBA, for $c==3 the display is GL_RGB,
for $c==2 the display is GL_LUMINANCE_ALPHA, and for $c==1 or for
for dimensions ($M,$N) then the display is GL_LUMINANCE.
( run in 1.141 second using v1.01-cache-2.11-cpan-39bf76dae61 )