OpenGL-Image-1.03/0000755000175300010010000000000011067510113012014 5ustar chmNoneOpenGL-Image-1.03/Changes0000644000175300010010000000031011067507674013323 0ustar chmNoneChange List for 1.03 - Bob "grafman" Free ____________________________________________________________ Updated Changes Updated Image.pm Update Image/Magick.pm Updated README OpenGL-Image-1.03/COPYRIGHT0000644000175300010010000000036511067507674013335 0ustar chmNone Copyright (c) 2007 Graphcomp. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Author: Bob "Grafman" Free grafman@graphcomp.com http://graphcomp.com/opengl OpenGL-Image-1.03/hex_tile.pl0000644000175300010010000003322211067507674014176 0ustar chmNone#!/usr/bin/perl -w use strict; use Math::Trig; use OpenGL qw/ :all /; use OpenGL::Image; die "Requires ImageMagick\n" if (!OpenGL::Image::HasEngine('Magick')); eval 'use Time::HiRes qw( gettimeofday )'; my $hasHires = !$@; $|++; # Define constants use constant DEBUG=>0; # Get image file my($path,@opts) = @ARGV; die qq { USAGE: $0 [IMAGE_FILE | PATH] [OPTIONS] IMAGE_FILE Identifies a single source image for tiling PATH Recursed path for randomly selected source images OPTIONS: w=WIDTH Width of display window - If neither w nor h are present, h=HEIGHT Height of display window fullscreen mode is assumed. xf=XFREQ Horizonal tiling frequency - If neither xf nor yf are present, yf=YFREQ Vertical tiling frequency a default is selected. d=DURATION Seconds between images - Ignored for single source images. fps=FPS Max frames per second - Requires Time::HiRes. sort=SORT random | alpha | none - Defaults to random. } if (!$path); # Get options my $opts = {}; foreach my $opt (@opts) { my($key,$value) = split('=',$opt); next if (!$key); $opts->{$key} = defined($value) ? $value : 0; } # Default options my $sort = $opts->{sort} || 'random'; my $dur = defined($opts->{d}) ? $opts->{d} : 60; my $scl = $opts->{s} || 1.0; my $sgn = 1.0; my $display_source = 0; # Get image path(s) my @images = GetImages($path); my $images = scalar(@images); die "No images (jpg,png,gif,tga,bmp) found\n" if (!$images); my $current = 0; # Set default frame size if (!$opts->{w} && !$opts->{h}) { $opts->{w} = 512; $opts->{h} = 512; $opts->{fs} = 1; } elsif (!$opts->{h}) { $opts->{h} = $opts->{w}; } elsif (!$opts->{w}) { $opts->{w} = $opts->{h}; } $opts->{fps} = 30 if (!defined($opts->{fps})); my $fps = $opts->{fps}; # Set default tiling frequency if (!$opts->{xf} && !$opts->{yf}) { ($opts->{xf},$opts->{yf}) = DefaultFreq($opts->{w},$opts->{h}); } elsif (!$opts->{yf}) { $opts->{yf} = $opts->{xf} * 2; } elsif (!$opts->{xf}) { $opts->{xf} = int(.5 + $opts->{yf} / 2) || 1; } my $freqx = $opts->{xf}; my $freqy = $opts->{yf}; # Get app name $0 =~ m|^([^\.]+)|; my $name = $1 || 'capture'; # Window parameters my $wnd_ID; my $wnd_title = 'Grafman Hexagonal Tiler'; my $wnd_width = $opts->{w}; my $wnd_height = $opts->{h}; my($save_w,$save_h,$save_x,$save_y); # State parameters my $last_time = $hasHires ? gettimeofday() : 0; my $last_image = 0; my $frames = 0; my $pause = 0; my($image,$image_w,$image_h); my($x0,$y0,$x1,$y1,$x2,$y2); my($ix,$iy,$ix0,$iy0,$ix1,$iy1,$ix2,$iy2); my($dx,$dy,$dx0,$dy0,$dx1,$dy1,$dx2,$dy2); # Init GLUT glutInit(); glutInitDisplayMode(GLUT_RGB | GLUT_DOUBLE | GLUT_DEPTH); glutInitWindowSize($wnd_width,$wnd_height); # Open a window $wnd_ID = glutCreateWindow($wnd_title); ToggleFS(1) if ($opts->{fs}); print "Window size: $wnd_width x $wnd_height\n"; # Test for necessary OpenGL Extensions # Must do this _after_ window context is established my $stat = OpenGL::glpCheckExtension('GL_ARB_texture_rectangle'); my $hasTexRect = !$stat; my $tex_mode = $hasTexRect ? GL_TEXTURE_RECTANGLE_ARB : GL_TEXTURE_2D; # Alloc texture my($tex_ID) = glGenTextures_p(1); Terminate("Unable to alloc texture ID") if (!$tex_ID); glBindTexture($tex_mode, $tex_ID); glTexParameteri($tex_mode, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); glTexParameteri($tex_mode, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); glTexParameteri($tex_mode, GL_TEXTURE_MAG_FILTER, GL_LINEAR); glTexParameteri($tex_mode, GL_TEXTURE_MIN_FILTER, GL_LINEAR); # Register rendering callback glutDisplayFunc(\&cbRenderScene); # Register idle callback glutIdleFunc(\&cbRenderScene); # Register resize callback glutReshapeFunc(\&cbResizeScene); # Register keyboard callback glutKeyboardFunc(\&cbKeyPressed); # Init app environment InitApp($wnd_width,$wnd_height); # Print keyboard commands print qq { p to toggle pause; r to rewind; n steps to next image; + for faster; - for slower; * to unthrottle framerate; 1-9 sets tiling frequency; s to save as JPEG; q or to quit. OpenGL window must have focus for input. }; # Pass off control to GLUT glutMainLoop(); exit(0); ######## # Subroutines ######## # Cleanup routine sub Terminate { # Disable app glutHideWindow(); glutKeyboardFunc(); glutSpecialFunc(); glutIdleFunc(); glutReshapeFunc(); glDeleteTextures_p($tex_ID) if ($tex_ID); # Now we can destroy window glutDestroyWindow($wnd_ID); } # Recursively locate images in a path sub GetImages { my @paths = @_; my @images; foreach my $path (@paths) { if (-d $path) { next if (!opendir(DIR,$path)); foreach my $file (readdir(DIR)) { next if ($file =~ m|^\.|); push(@images,GetImages("$path/$file")); } closedir(DIR); } else { next if ($path !~ m/\.(jpg|png|gif|tga|bmp)$/); push(@images,$path); } } return ($sort eq 'alpha') ? sort(@images) : @images; } # Load image sub LoadNextImage { my($force) = @_; if (!$force && $image) { return 1 if (!$dur || $images==1); my $secs = time() - $last_image; if ($pause || $display_source) { $last_image += $dur - $secs; return 1; } return 1 if ($secs < $dur); } $last_image = time(); my $path; if ($sort eq 'random') { $current = int(rand($images)); $path = $images[$current]; } else { $path = $images[$current++]; $current %= $images; } #$path =~ m|[/\\](.*)|; #print "Attempting to load: '$1'\n"; $image = new OpenGL::Image(engine=>'Magick',source=>$path); return 0 if (!$image); # Resample image if GL_ARB_texture_rectangle not supported if (!$hasTexRect) { my $size = $image->GetPowerOf2(); $image->Native->Resize(width=>$size,height=>$size,filter=>'Hermite'); $image->SyncOGA(); } ($image_w,$image_h) = $image->Get('width','height'); return 0 if (!$image_w || !$image_h); # Init texture coords $x0 = rand($image_w); $y0 = rand($image_h); $x1 = rand($image_w); $y1 = rand($image_h); $x2 = rand($image_w); $y2 = rand($image_h); # Init texture velocity $dx = $image_w/100; $dy = $image_h/100; $ix0 = rand($dx)-$dx; $iy0 = rand($dy)-$dy; $ix1 = rand($dx)-$dx; $iy1 = rand($dy)-$dy; $ix2 = rand($dx)-$dx; $iy2 = rand($dy)-$dy; # Scale velocity $dx0 = $sgn * $scl * $ix0; $dy0 = $sgn * $scl * $iy0; $dx1 = $sgn * $scl * $ix1; $dy1 = $sgn * $scl * $iy1; $dx2 = $sgn * $scl * $ix2; $dy2 = $sgn * $scl * $iy2; my($ifmt,$fmt,$type) = $image->Get('gl_internalformat','gl_format','gl_type'); glTexImage2D_c($tex_mode, 0, $ifmt, $image_w, $image_h, 0, $fmt, $type, $image->Ptr()); glBindTexture($tex_mode, $tex_ID); glTexEnvf(GL_TEXTURE_ENV,GL_TEXTURE_ENV_MODE,GL_DECAL); return 1; } # Rendering callback sub cbRenderScene { # Throttle FPS if ($hasHires && ($fps > 0)) { my $spf = 1 / $fps; return if ($spf > (gettimeofday() - $last_time)); $last_time = gettimeofday(); } # Clear buffers glLoadIdentity(); #glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); #glColor3i(1, 1, 1); # Load image texture print "Bad image\n" while (!LoadNextImage()); glEnable($tex_mode); # Abstract texcoord extensions my $tw = $hasTexRect ? $image_w : 1.0; my $th = $hasTexRect ? $image_h : 1.0; # Display source image if ($display_source) { glBegin (GL_QUADS); { glTexCoord2f(0,0); glVertex2f(0,0); glTexCoord2f($tw,0); glVertex2f($wnd_width,0); glTexCoord2f($tw,$th); glVertex2f($wnd_width,$wnd_height); glTexCoord2f(0,$th); glVertex2f(0,$wnd_height); } glEnd (); } # Render tiles else { my $x00 = $hasTexRect ? $x0 : $x0/$image_w; my $y00 = $hasTexRect ? $y0 : $y0/$image_h; my $x01 = $hasTexRect ? $x1 : $x1/$image_w; my $y01 = $hasTexRect ? $y1 : $y1/$image_h; my $x02 = $hasTexRect ? $x2 : $x2/$image_w; my $y02 = $hasTexRect ? $y2 : $y2/$image_h; my $xa = ($x01+$x02)/2; my $ya = ($y01+$y02)/2; my $tile_x = $wnd_width / $freqx; my $tile_y = $wnd_height / $freqy; for (my $i=0; $i<$freqy; $i++) { for (my $j=0; $j<$freqx; $j++) { my $x = $j*$tile_x; my $y = $i*$tile_y; glBegin (GL_TRIANGLE_STRIP); { glTexCoord2f($xa,$ya); glVertex2f($x,$y+$tile_y/2); glTexCoord2f($x00,$y00); glVertex2f($x,$y); glTexCoord2f($x01,$y01); glVertex2f($x+$tile_x/6,$y+$tile_y/2); glTexCoord2f($x02,$y02); glVertex2f($x+$tile_x/3,$y); glTexCoord2f($x00,$y00); glVertex2f($x+$tile_x/2,$y+$tile_y/2); glTexCoord2f($x01,$y01); glVertex2f($x+2*$tile_x/3,$y); glTexCoord2f($x02,$y02); glVertex2f($x+5*$tile_x/6,$y+$tile_y/2); glTexCoord2f($x00,$y00); glVertex2f($x+$tile_x,$y); glTexCoord2f($xa,$ya); glVertex2f($x+$tile_x,$y+$tile_y/2); } glEnd (); glBegin (GL_TRIANGLE_STRIP); { glTexCoord2f($xa,$ya); glVertex2f($x+$tile_x,$y+$tile_y/2); glTexCoord2f($x00,$y00); glVertex2f($x+$tile_x,$y+$tile_y); glTexCoord2f($x02,$y02); glVertex2f($x+5*$tile_x/6,$y+$tile_y/2); glTexCoord2f($x01,$y01); glVertex2f($x+2*$tile_x/3,$y+$tile_y); glTexCoord2f($x00,$y00); glVertex2f($x+$tile_x/2,$y+$tile_y/2); glTexCoord2f($x02,$y02); glVertex2f($x+$tile_x/3,$y+$tile_y); glTexCoord2f($x01,$y01); glVertex2f($x+$tile_x/6,$y+$tile_y/2); glTexCoord2f($x00,$y00); glVertex2f($x,$y+$tile_y); glTexCoord2f($xa,$ya); glVertex2f($x,$y+$tile_y/2); } glEnd (); } } } glDisable($tex_mode); glutSwapBuffers(); if ($fps && !$pause) { ($x0,$dx0) = nudge($x0,$dx0,$image_w); ($y0,$dy0) = nudge($y0,$dy0,$image_h); ($x1,$dx1) = nudge($x1,$dx1,$image_w); ($y1,$dy1) = nudge($y1,$dy1,$image_h); ($x2,$dx2) = nudge($x2,$dx2,$image_w); ($y2,$dy2) = nudge($y2,$dy2,$image_h); } } # Clamp texcoords sub nudge { my($v,$d,$max) = @_; $v += $d; return(abs($v),-$d) if ($v < 0); return(2*$max-$v,-$d) if ($v > $max); return($v,$d); } # Keyboard callback sub cbKeyPressed { my $key = shift; my $c = uc chr $key; if ($key == 27 or $c eq 'Q') { TermApp(); exit(1); } elsif ($c eq 'P') { $pause = !$pause; } elsif ($c eq '*') { $fps = -1; } elsif (($c eq 'R') || ($c eq '+') || ($c eq '-')) { if ($c eq 'R') { $sgn *= -1.0; } elsif ($hasHires) { if ($c eq '+') { $fps = (($fps < 0) || ($fps >= 60)) ? -1 : $fps + 5; } elsif ($fps < 0) { $fps = 60; } elsif ($fps < 5) { $fps = 0; } else { $fps -= 5; } return; } else { if ($c eq '+') { $scl += 0.1; } elsif ($scl > 0.1) { $scl -= 0.1; } else { $scl = 0.0; } } $dx0 = $sgn * $scl * $ix0; $dy0 = $sgn * $scl * $iy0; $dx1 = $sgn * $scl * $ix1; $dy1 = $sgn * $scl * $iy1; $dx2 = $sgn * $scl * $ix2; $dy2 = $sgn * $scl * $iy2; } elsif ($c eq 'O') { $display_source = !$display_source; } elsif ($c eq 'F') { ToggleFS(); } elsif ($c eq 'N') { LoadNextImage(1); } elsif ($c eq 'S') { my $frame = new OpenGL::Image(engine=>'Magick', width=>$wnd_width, height=>$wnd_height); my($fmt,$size) = $frame->Get('gl_format','gl_type'); glReadPixels_c( 0, 0, $wnd_width, $wnd_height, $fmt, $size, $frame->Ptr() ); $frame->Save("$name.jpg"); } elsif ($c eq '0') { $freqx = $opts->{xf}; $freqy = $opts->{yf}; } elsif ($c ge '1' && $c le '9') { $freqx = $c; $freqy = $c; } else { printf "Key action undefined for %d.\n", $key; } } # Toggle fullscreen mode sub ToggleFS { my($enable) = @_; $opts->{fs} = ($enable) ? 1 : !$opts->{fs}; if ($opts->{fs}) { $save_x = glutGet(GLUT_WINDOW_X); $save_y = glutGet(GLUT_WINDOW_Y); $save_w = $wnd_width; $save_h = $wnd_height; glutFullScreen(); $wnd_width = glutGet(GLUT_SCREEN_WIDTH); $wnd_height = glutGet(GLUT_SCREEN_HEIGHT); } else { $wnd_width = $save_w; $wnd_height = $save_h; glutReshapeWindow($wnd_width,$wnd_height); glutPositionWindow($save_x,$save_y); } $freqx = $opts->{xf}; $freqy = $opts->{yf}; } # Get default tiling freqencies sub DefaultFreq { my($w,$h) = @_; my $aspect = ($w || $wnd_width || 1) / ($h || $wnd_height || 1); my($freqx,$freqy); if ($aspect >= 1) { $freqx = 2; $freqy = int(.5 + 2 * $freqx / $aspect) || 1; } else { $freqy = 2; $freqx = int(.5 + $freqy * $aspect / 2) || 1; } return($freqx,$freqy); } # Window resize callback sub cbResizeScene { my ($Width,$Height) = @_; $wnd_width = $Width; $wnd_height = $Height; InitApp(); } # Initialize app sub InitApp { glViewport(0, 0, $wnd_width, $wnd_height); # Set up projection matrix glMatrixMode(GL_PROJECTION); glLoadIdentity(); gluOrtho2D(0, $wnd_width, 0, $wnd_height); # Load identity modelview glMatrixMode(GL_MODELVIEW); glLoadIdentity(); # Shading states glShadeModel(GL_SMOOTH); glClearColor(0, 0, 0, 1); glColor4f(1.0, 1.0, 1.0, 1.0); glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST); # Depth states glClearDepth(1.0); glDepthFunc(GL_LEQUAL); glEnable(GL_DEPTH_TEST); glEnable(GL_CULL_FACE); } # Cleanup routine sub TermApp { # Disable app glutHideWindow(); glutKeyboardFunc(); glutSpecialFunc(); glutIdleFunc(); glutReshapeFunc(); glDeleteTextures_p($tex_ID); # Now you can destroy window glutDestroyWindow($wnd_ID); } OpenGL-Image-1.03/Image/0000755000175300010010000000000011067510112013035 5ustar chmNoneOpenGL-Image-1.03/Image/Common.pm0000644000175300010010000001425311067507674014653 0ustar chmNone############################################################ # # OpenGL::Image::Common - Copyright 2007 Graphcomp - ALL RIGHTS RESERVED # Author: Bob "grafman" Free - grafman@graphcomp.com # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # ############################################################ package OpenGL::Image::Common; require Exporter; use Carp; use vars qw($VERSION @ISA); $VERSION = '1.01'; @ISA = qw(Exporter); =head1 NAME OpenGL::Image::Common - copyright 2007 Graphcomp - ALL RIGHTS RESERVED Author: Bob "grafman" Free - grafman@graphcomp.com This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DESCRIPTION This module provides a base class for OpenGL imaging engines. Requires the OpenGL module. =head1 SYNOPSIS ########## # Check for installed imaging engines use OpenGL::Image::Common; my $img = new OpenGL::Image::Common(%params); ########## # Must supply width and height, or source: # source - source image file path (some engines supports URLs). # width,height - width and height in pixels for cache allocation. ########## # Optional params: # engine - specifies imaging engine; defaults to 'Targa'. ########## # Methods defined in this Common module: # Get native engine object # Note: must not change image dimensions my $obj = $img->Native; $obj->Quantize() if ($obj); # Alternately (Assuming the native engine supports Blur): $img->Native->Blur(); # Test if image width is a power of 2 if ($img->IsPowerOf2()); # Test if all listed values are a power of 2 if ($img->IsPowerOf2(@list)); # Get largest power of 2 size within dimensions of image my $size = $img->GetPowerOf2(); # Get all parameters as a hashref my $params = $img->Get(); # Get one or more parameter values my @values = $img->Get(@params); # Get/Set Pixel values (normalized to 1.0) my($r,$g,$b,$a) = $img->GetPixel($x,$y); # Sync cache after done modifying pixels $img->SetPixel($x,$y,$r,$g,$b,$a); $frame->Sync(); ########## # Supported parameters: # version - version of the engine # source - source image, if defined # width - width of image in pixels # height - height of image in pixels # pixels - number of pixels # components - number of pixel components # size - bytes per component # length - cache size in bytes # endian - 1 if big endian; otherwise 0 # alpha - 1 if has alpha channel, -1 if has inverted alpha channel; 0 if none # flipped - 1 bit set if cache scanlines are top to bottom; others reserved # gl_internalformat - internal GL pixel format. eg: GL_RGBA8, GL_RGBA16 # gl_format - GL pixel format. eg: GL_RGBA, GL_BGRA # gl_type - GL data type. eg: GL_UNSIGNED_BYTE, GL_UNSIGNED_SHORT ########## # APIs defined in engine modules: # Get engine version my $ver = OpenGL::Image::ENGINE_MODULE::EngineVersion(); # Get engine description my $desc = OpenGL::Image::ENGINE_MODULE::EngineDescription(); ########## # Methods defined in engine modules: # Sync the image cache after modifying pixels. # Used by some engines for paged caches; otherwise a NOP. $img->Sync(); # Return the image's cache as an OpenGL::Array object. # Note: OGA may change after a cache update my $oga = $img->GetArray(); # Return a C pointer to the image's cache. # For use with OpenGL's "_c" APIs. # Note: pointer may change after a cache update $img->Ptr(); # Save the image to a PNG file (assuming the native engine supports PNGs). $img->Save('MyImage.png'); # Get image blob. my $blob = $img->GetBlob(); =cut # Base constructor sub new { my $this = shift; my $class = ref($this) || $this; my %params = @_; my $self = {params=>\%params}; bless($self,$class); # Save CPU endian-ness as default $self->{params}->{endian} = unpack("h*", pack("s", 1)) =~ /01/ || 0; return $self; } # Return engine's native object sub Native { my($self) = @_; return $self->{native}; } # Test for Power of 2 sub IsPowerOf2 { my($self,@values) = @_; if (!scalar(@values)) { my $params = $self->{params}; return 0 if (!$params->{width} || !$params->{height}); @values = ($params->{width},$params->{height}); } foreach my $value (@values) { return 0 if (!po2($value)); } return 1; } sub po2 { my($value) = @_; while ($value) { return 1 if ($value == 1); return 0 if ($value & 1); $value >>= 1; } return 0; } sub GetPowerOf2 { my($self,@values) = @_; if (!scalar(@values)) { my $params = $self->{params}; return 0 if (!$params->{width} || !$params->{height}); @values = ($params->{width},$params->{height}); } my($value) = sort(@values); my $size = 0; while ($value) { $size++; $value >>= 1; } return $size ? 2**($size-1) : 0; } # Get parameter values sub Get { my($self,@params) = @_; return $self->{params} if (!scalar(@params)); my @values = (); foreach my $param (@params) { push(@values,$self->{params}->{$param}); } return @values; } # Get normalized pixels sub GetPixel { my($self,$x,$y,$count) = @_; my $w = $self->{params}->{width}; my $c = $self->{params}->{components}; my $s = $self->{params}->{size}; my $n = (1 << ($s * 8)) - 1; my $pos = ($y * $w + $x) * $c; my $len = $c * ($count || 1); my @pad = (); push(@pad,0) if ($c < 2); push(@pad,0) if ($c < 3); push(@pad,1) if ($c < 4); my $i = 0; my @pixels = (); my @data = $self->{oga}->retrieve($pos,$len); foreach my $value (@data) { push(@pixels,$value/$n); if ($c < 4) { my $e = $i++ % $c; push(@pixels,@pad) if ($e == $c-1); } } return @pixels; } # Set normalized pixels sub SetPixel { my($self,$x,$y,@values) = @_; my $w = $self->{params}->{width}; my $c = $self->{params}->{components}; my $s = $self->{params}->{size}; my $n = (1 << ($s * 8)) - 1; my $pos = ($y * $w + $x) * $c; my $i = 0; my @data = (); foreach my $value (@values) { if ($c < 4) { my $e = $i++ % $c; next if ($e >= $c-1); } push(@data,int(.5+$value*$n)); } $self->{oga}->assign($pos,@data); } 1; __END__ OpenGL-Image-1.03/Image/Magick.pm0000644000175300010010000002342211067507674014614 0ustar chmNone############################################################ # # OpenGL::Image::Magick - Copyright 2007 Graphcomp - ALL RIGHTS RESERVED # Author: Bob "grafman" Free - grafman@graphcomp.com # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # ############################################################ package OpenGL::Image::Magick; require Exporter; use Carp; use vars qw($VERSION $DESCRIPTION @ISA); $VERSION = '1.02'; $DESCRIPTION = qq {Supports optimized internal interfaces to the ImageMagick library.}; use OpenGL::Image::Common; @ISA = qw(Exporter OpenGL::Image::Common); use OpenGL(':constants'); =head1 NAME OpenGL::Image::Magick - copyright 2007 Graphcomp - ALL RIGHTS RESERVED Author: Bob "grafman" Free - grafman@graphcomp.com This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DESCRIPTION This is a driver module for use with the OpenGL module. While it may be called directly, it will more often be called by the OpenGL::Image abstraction module. Note: OpenGL::Image defaults to this module. This is a subclass of the OpenGL::Image::Common module. Requires the Image::Magick module; 6.3.5 or newer is recommended. =head1 SYNOPSIS ########## # Check for installed imaging engines use OpenGL::Image; my $img = new OpenGL::Image(engine=>'Magick',source=>'MyImage.png'); ########## # Methods defined in the OpenGL::Image::Common module: # Get native engine object # Note: must not change image dimensions my $obj = $img->Native; $obj->Quantize() if ($obj); # Alternately (Assuming the native engine supports Blur): $img->Native->Blur(); # Test if image width is a power of 2 if ($img->IsPowerOf2()); # Test if all listed values are a power of 2 if ($img->IsPowerOf2(@list)); # Get largest power of 2 size within dimensions of image my $size = $img->GetPowerOf2(); # Get all parameters as a hashref my $params = $img->Get(); # Get one or more parameter values my @values = $img->Get(@params); # Get/Set Pixel values (normalized to 1.0) my($r,$g,$b,$a) = $img->GetPixel($x,$y); # Sync cache after done modifying pixels $img->SetPixel($x,$y,$r,$g,$b,$a); $frame->Sync(); ########## # Supported parameters: # source - source image, if defined # width - width of image in pixels # height - height of image in pixels # pixels - number of pixels # components - number of pixel components # size - bytes per component # length - cache size in bytes # endian - 1 if big endian; otherwise 0 # alpha - 1 if has alpha channel, -1 if has inverted alpha channel; 0 if none # flipped - 1 bit set if cache scanlines are top to bottom; others reserved # gl_internalformat - internal GL pixel format. eg: GL_RGBA8, GL_RGBA16 # gl_format - GL pixel format. eg: GL_RGBA, GL_BGRA # gl_type - GL data type. eg: GL_UNSIGNED_BYTE, GL_UNSIGNED_SHORT ########## # APIs defined in this module: # Get engine version my $ver = OpenGL::Image::THIS_MODULE::EngineVersion(); # Get engine description my $desc = OpenGL::Image::ENGINE_MODULE::EngineDescription(); ########## # Methods defined in this module: # Sync the image cache after modifying pixels. # Used by some engines for paged caches; otherwise a NOP. $img->Sync(); # Return the image's cache as an OpenGL::Array object. # Note: OGA may change after a cache update my $oga = $img->GetArray(); # Return a C pointer to the image's cache. # For use with OpenGL's "_c" APIs. # Note: pointer may change after a cache update $img->Ptr(); # Save file - automatically does a Sync before write $img->Save('MyImage.png'); # Get image blob. my $blob = $img->GetBlob(); =cut eval 'use Image::Magick'; # Get engine version sub EngineVersion { return $Image::Magick::VERSION; } # Get engine description sub EngineDescription { return $DESCRIPTION; } # Base constructor sub new { my $this = shift; my $class = ref($this) || $this; my $self = new OpenGL::Image::Common(@_); return undef if (!$self); $self->{params}->{engine} = 'Magick'; $self->{params}->{version} = EngineVersion(); $self->{params}->{components} = 4; $self->{params}->{alpha} = 0; $self->{params}->{flipped} = 1; # Use source image if supplied my $img; if ($self->{params}->{source}) { $img = new Image::Magick(); return undef if (!$img); my $stat = $img->Read($self->{params}->{source}); return undef if ($stat); ($self->{params}->{width},$self->{params}->{height}) = $img->Get('Width','Height'); return undef if (!$self->{params}->{width} || !$self->{params}->{height}); $self->{native} = $img; } # Otherwise create uninitialized image else { my $w = $self->{params}->{width}; my $h = $self->{params}->{height}; my $blob = $self->{params}->{blob}; if ($w && $h) { my $dim = $w.'x'.$h; $self->{native} = new Image::Magick(size=>$dim, magick=>'RGBA', depth=>8); } elsif ($blob) { $self->{native} = new Image::Magick(); } return undef if (!$self->{native}); $img = $self->{native}; # Populate with blob if ($blob) { my $stat = $img->BlobToImage($blob); return undef if ($stat); if (!$w || !$h) { ($self->{params}->{width},$self->{params}->{height}) = $img->Get('Width','Height'); } } # Otherwise fill with 'none' else { my $stat = $img->Read('xc:none'); return undef if ($stat); $img->Set(type=>'truecolormatte'); } } my $alpha = $img->Get('matte'); $img->Set('matte'=>'True') if (!$alpha); # Good to go bless($self,$class); # Init params return undef if (!$self->init()); $self->SyncOGA(); return $self; } # Initialize object sub init { my($self) = @_; my $w = $self->{params}->{width}; my $h = $self->{params}->{height}; $self->{params}->{pixels} = $w * $h; my $elements = $self->{params}->{pixels} * $self->{params}->{components}; my $img = $self->{native}; # Use C pointer to image cache, if supported if ($self->{params}->{version} ge '6.3.5') { my $q = $img->Get('quantum'); if ($q == 8) { $self->{params}->{gl_internalformat} = GL_RGBA8; $self->{params}->{gl_type} = GL_UNSIGNED_BYTE; $self->{params}->{size} = 1; } elsif ($q == 16) { $self->{params}->{gl_internalformat} = GL_RGBA16; $self->{params}->{gl_type} = GL_UNSIGNED_SHORT; $self->{params}->{size} = 2; } else { print "Unsupported pixel quantum\n"; } if ($self->{params}->{gl_type}) { $self->{params}->{gl_format} = $self->{params}->{endian} ? GL_RGBA : GL_BGRA; $self->{params}->{length} = $self->{params}->{size} * $elements; $self->{oga} = OpenGL::Array->new_pointer($self->{params}->{gl_type}, $img->GetImagePixels(rows=>$h),$elements); $self->{params}->{alpha} = -1; return $self->{oga}; } } # Fall back to using standard PerlMagick interface $self->{blobs} = 1; $self->{params}->{gl_internalformat} = GL_RGBA8; $self->{params}->{gl_type} = GL_UNSIGNED_BYTE; $self->{params}->{size} = 1; $self->{params}->{gl_format} = GL_RGBA; $self->{params}->{alpha} = 1; $self->{params}->{length} = $self->{params}->{pixels} * $self->{params}->{components} * $self->{params}->{size}; $img->Set(magick=>'RGBA',depth=>8); $self->{oga} = OpenGL::Array->new_scalar($self->{params}->{gl_type}, $img->ImageToBlob(),$elements); return $self->{oga}; } # Sync from GPU framebuffer (OGA/blob) to IM # Call before using native calls sub Sync { my($self) = @_; my $img = $self->{native}; if ($self->{blobs}) { $img->BlobToImage($self->{oga}->retrieve_data()); } else { $img->SyncImagePixels(); } $img->Negate(channel=>'Alpha') if ($self->{params}->{alpha} < 0); $img->Flip(); } # Sync from IM to GPU framebuffer (OGA/blob) # Call after using native calls sub SyncOGA { my($self) = @_; my $img = $self->{native}; $img->Flip(); $img->Negate(channel=>'Alpha') if ($self->{params}->{alpha} < 0); my($w,$h) = $img->Get('width','height'); my $pixels = $w * $h; my $elements = $pixels * $self->{params}->{components}; if ($self->{blobs}) { $img->Set(magick=>'RGBA',depth=>8); $self->{oga} = OpenGL::Array->new_scalar($self->{params}->{gl_type}, $img->ImageToBlob(),$elements); } if ($w == $self->{params}->{width} && $h == $self->{params}->{height}) { return if ($self->{blobs}); $self->{oga}->update_pointer($img->GetImagePixels(rows=>$h)); } $self->{params}->{width} = $w; $self->{params}->{height} = $h; $self->{params}->{pixels} = $pixels; $self->{params}->{length} = $elements * $self->{params}->{size}; return if ($self->{blobs}); $self->{oga} = OpenGL::Array->new_pointer($self->{params}->{gl_type}, $img->GetImagePixels(rows=>$h),$elements); } # Get OpenGL::Array object sub GetArray { my($self) = @_; return $self->{oga}; } # Get C pointer to image cache sub Ptr { my($self) = @_; return undef if (!$self->{oga}); return $self->{oga}->ptr(); } # Save image sub Save { my($self,$file,%user_params) = @_; my $img = $self->{native}; $self->Sync(); my $blob; if ($file) { if ($self->{blobs} && $img->[1]) { $img->[1]->Write(filename=>$file,%user_params); } else { $img->[0]->Write(filename=>$file,%user_params); } } else { %user_params = (magick=>'RGBA',depth=>8) if (!scalar(%user_params)); delete($user_params{filename}); my $clone = $img->Clone(); $clone->Set(%user_params); ($blob) = $clone->ImageToBlob(); } $self->SyncOGA(); return $blob; } # Get image blob sub GetBlob { my($self,%params) = @_; return $self->Save(undef,%params); } 1; __END__ OpenGL-Image-1.03/Image/Targa.pm0000644000175300010010000002033011067507674014452 0ustar chmNone############################################################ # # OpenGL::Image::Targa - Copyright 2007 Graphcomp - ALL RIGHTS RESERVED # Author: Bob "grafman" Free - grafman@graphcomp.com # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # ############################################################ package OpenGL::Image::Targa; require Exporter; use Carp; use vars qw($VERSION $DESCRIPTION @ISA); $VERSION = '1.01'; $DESCRIPTION = qq {Supports uncompressed RGBA files; default engine driver. May be used as a prototype for other imaging drivers}; use OpenGL::Image::Common; @ISA = qw(Exporter OpenGL::Image::Common); use OpenGL(':constants'); =head1 NAME OpenGL::Image::Targa - copyright 2007 Graphcomp - ALL RIGHTS RESERVED Author: Bob "grafman" Free - grafman@graphcomp.com This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DESCRIPTION This is a driver module for use with the OpenGL module. While it may be called directly, it will more often be called by the OpenGL::Image abstraction module. This is a subclass of the OpenGL::Image::Common module. =head1 SYNOPSIS ########## # Check for installed imaging engines use OpenGL::Image; my $img = new OpenGL::Image(engine=>'Targa',source=>'MyImage.tga'); ########## # Methods defined in the OpenGL::Image::Common module: # Get native engine object # Note: No native Targa object # Test if image width is a power of 2 if ($img->IsPowerOf2()); # Test if all listed values are a power of 2 if ($img->IsPowerOf2(@list)); # Get largest power of 2 size within dimensions of image my $size = $img->GetPowerOf2(); # Get all parameters as a hashref my $params = $img->Get(); # Get one or more parameter values my @values = $img->Get(@params); # Get/Set Pixel values (normalized to 1.0) my($r,$g,$b,$a) = $img->GetPixel($x,$y); # Sync cache after done modifying pixels $img->SetPixel($x,$y,$r,$g,$b,$a); $frame->Sync(); ########## # Supported parameters: # source - source image, if defined # width - width of image in pixels # height - height of image in pixels # pixels - number of pixels # components - number of pixel components # size - bytes per component # length - cache size in bytes # endian - 1 if big endian; otherwise 0 # alpha - 1 if has alpha channel, -1 if has inverted alpha channel; 0 if none # flipped - 1 bit set if cache scanlines are top to bottom; others reserved # gl_internalformat - internal GL pixel format. eg: GL_RGBA8, GL_RGBA16 # gl_format - GL pixel format. eg: GL_RGBA, GL_BGRA # gl_type - GL data type. eg: GL_UNSIGNED_BYTE, GL_UNSIGNED_SHORT ########## # APIs defined in this module: # Get engine version my $ver = OpenGL::Image::THIS_MODULE::EngineVersion(); # Get engine description my $desc = OpenGL::Image::ENGINE_MODULE::EngineDescription(); ########## # Methods defined in this module: # Sync the image cache after modifying pixels. # Note: Sync is a NOP for this module $img->Sync(); # Return the image's cache as an OpenGL::Array object. # Note: OGA may change after a cache update my $oga = $img->GetArray(); # Return a C pointer to the image's cache. # For use with OpenGL's "_c" APIs. $img->Ptr(); # Save file $img->Save('MyImage.tga'); # Get image blob. my $blob = $img->GetBlob(); =cut # Get engine version sub EngineVersion { return $VERSION; } # Get engine description sub EngineDescription { return $DESCRIPTION; } # Base constructor sub new { my $this = shift; my $class = ref($this) || $this; my $self = new OpenGL::Image::Common(@_); return undef if (!$self); bless($self,$class); $self->{native} = undef; my $params = $self->{params}; $params->{engine} = 'Targa'; $params->{version} = $VERSION; $params->{gl_internalformat} = GL_RGBA8; $params->{gl_format} = $params->{endian} ? GL_RGBA : GL_BGRA; $params->{gl_type} = GL_UNSIGNED_BYTE; $params->{alpha} = 1; $params->{components} = 4; $params->{flipped} = 0; $params->{size} = 1; my $blob = ''; my $file = $params->{source}; if ($file) { return undef if (!-e $file); $blob = $self->read_file($file); } else { $blob = $self->init(); } return undef if (!$blob); $self->{oga} = OpenGL::Array->new_scalar(GL_UNSIGNED_BYTE,$blob,length($blob)); return undef if (!$self->{oga}); return $self; } # read file sub read_file { my($self,$file) = @_; return undef if (!open(FILE,$file)); binmode(FILE); my $buf; my $len = read(FILE,$buf,18); if ($len != 18) { close(FILE); return undef; } # Parse header my ( $id_len, # byte $cmap_type, # byte $image_type,# byte $cmap_org, # short $cmap_len, # short $cmap_size, # byte $x_org, # short $y_org, # short $w, # short $h, # short $pix_size, # byte $pix_attrs # byte ) = unpack('C C C S S C S S S S C C',$buf); # Check for cmap if ($cmap_type) { close(FILE); return undef; } # Only supporting 24 bit RGB or 32 bit RGBA at this time if (!($pix_size == 32 && $pix_attrs == 8) && !($pix_size == 24 || $pix_attrs == 0)) { close(FILE); return undef; } # read file identifier, if any if ($id_len) { $len = read(FILE,$buf,$id_len); return close(FILE) if ($len != $id_len); } # Save file attrs my $params = $self->{params}; $params->{width} = $w; $params->{height} = $h; $params->{pixels} = $w * $h; my $data_len = $w * $h * 4; $params->{length} = $data_len; $buf = ''; # Handle runlength-encoded RGB if ($image_type == 10) { my($data,$count,$rle); my $size = $pix_size / 8; $len = 0; while (($len < $data_len) && (read(FILE,$data,1) == 1)) { $count = ord($data); $rle = $count & 128; if ($rle) { $count &= 127; $count++; last if (read(FILE,$data,$size) != $size); $data .= chr(0xFF) if ($size != 4); $buf .= $data x $count; $len += $count * 4; } # Raw 32 bit pixels elsif ($pix_size == 32) { $count++; $count *= 4; last if (read(FILE,$data,$count) != $count); $buf .= $data; $len += $count; } # Raw 24 bit pixels else { $count++; $len += $count * 4; for (my $i=0; $i<$count; $i++) { last if (3 != read(FILE,$data,3)); $buf .= $data.chr(0xFF); } } } } # Unsupported image type elsif ($image_type != 2) { close(FILE); return undef; } # Read 32 bit images elsif ($pix_size == 32) { $len = read(FILE,$buf,$data_len); } # Read 24 bit images; add alpha channel else { my $pixel; for (my $i=0; $i<$w*$h; $i++) { last if (3 != read(FILE,$pixel,3)); $buf .= $pixel.chr(0xFF); } $len = length($buf); } close(FILE); # Pad out buffer if it's short if ($len < $data_len) { my $pixel = chr(0) x 4; $buf .= $pixel x ($data_len - $len); } return $buf; } # Initialize empty blob sub init { my($self) = @_; my $params = $self->{params}; my $w = $params->{width}; my $h = $params->{height}; $params->{pixels} = $w * $h; my $buf; my $pix = pack('C C C C', 0, 0, 0, 255); for (my $i=0; $i<$params->{pixels}; $i++) { $buf .= $pix; } return $buf; } # Sync image cache sub Sync { return undef; } # Sync oga sub SyncOGA { return undef; } # Get OpenGL::Array object sub GetArray { my($self) = @_; return $self->{oga}; } # Get C pointer to image cache sub Ptr { my($self) = @_; return undef if (!$self->{oga}); return $self->{oga}->ptr(); } # Save image sub Save { my($self,$file) = @_; return undef if (!$file); my $blob = $self->GetBlob(); return undef if (!$blob); return undef if (!open(FILE,">$file")); binmode(FILE); my $params = $self->{params}; my $w = $params->{width}; my $h = $params->{height}; my $hdr = pack('C C C S S C S S S S C C', 0, 0, 2, 0, 0, 0, 0, 0, $w, $h, 32, 8); print FILE $hdr.$blob; close(FILE); return $blob; } # Get image blob sub GetBlob { my($self) = @_; return $self->{oga}->retrieve_data(); } 1; __END__ OpenGL-Image-1.03/Image.pm0000644000175300010010000000651411067507674013424 0ustar chmNone############################################################ # # OpenGL::Image - Copyright 2007 Graphcomp - ALL RIGHTS RESERVED # Author: Bob "grafman" Free - grafman@graphcomp.com # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # ############################################################ ### SEE DOCS IN Image.pod package OpenGL::Image; require Exporter; use strict; use warnings; use Carp; use vars qw($VERSION @ISA); $VERSION = '1.03'; @ISA = qw(Exporter); # Return hashref of installed imaging engines # Use OpenGL/Image/Engines.lst if exists sub GetEngines { my $dir = __FILE__; return if ($dir !~ s|\.pm$||); my @engines; # Use engine list if exists my $list = "$dir/Engines.lst"; if (open(LIST,$list)) { foreach my $engine () { $engine =~ s|[\r\n]+||g; next if (!-e "$dir/$engine.pm"); push(@engines,$engine); } close(LIST); } # Otherwise grab OpenGL/Image modules elsif (opendir(DIR,$dir)) { foreach my $engine (readdir(DIR)) { next if ($engine !~ s|\.pm$||); push(@engines,$engine); } closedir(DIR); # Targa engine gets priority when no Engines.lst exists @engines = ((grep {$_ eq 'Targa'} @engines), grep {$_ ne 'Targa'} @engines); } return if (!@engines); my @info; my $engines = {}; my $priority = 1; foreach my $engine (@engines) { next if ($engine eq 'Common'); my $info = HasEngine($engine); next if (!$info); if (wantarray) { push(@info,$info); } else { $info->{priority} = $priority++; $engines->{$engine} = $info; } } return wantarray ? @info : $engines; } # Check for engine availability; returns installed version sub HasEngine { my($engine,$min_ver,$max_ver) = @_; return if (!$engine); my($version,$desc); my $module = GetEngineModule($engine); # Redirect Perl errors if module can't be loaded open(OLD_STDERR, ">&STDERR"); close(STDERR); my $exec = qq { use $module; \$version = $module\::EngineVersion(); \$desc = $module\::EngineDescription(); }; eval($exec); # Restore STDERR open(STDERR, ">&OLD_STDERR"); close(OLD_STDERR); return if (!$version); return if ($min_ver && $version lt $min_ver); return if ($max_ver && $version gt $max_ver); my $info = {}; $info->{name} = $engine; $info->{module} = $module; $info->{version} = $version; $info->{description} = $desc; return $info; } # Get module name for engine sub GetEngineModule { my($engine) = @_; return if (!$engine); return __PACKAGE__."::$engine"; } # Constructor wrapper for imaging engine sub new { my $this = shift; my $class = ref($this) || $this; my $self = {}; bless($self,$class); my %params = @_; my $engine = $params{engine}; if ($engine) { return if ($engine eq 'Common'); return NewEngine($engine,%params); } my @engines = GetEngines(); foreach my $info (@engines) { my $obj = NewEngine($info->{name},%params); return $obj if ($obj); } return undef; } # Instantiate engine sub NewEngine { my($engine,%params) = @_; return undef if (!$engine); my $obj; my $module = GetEngineModule($engine); my $exec = qq { use $module; \$obj = new $module\(\%params); }; eval($exec); return $obj; } 1; __END__ OpenGL-Image-1.03/Image.pod0000644000175300010010000001205511067507674013567 0ustar chmNone=head1 NAME OpenGL::Image - v1.03 copyright 2007 Graphcomp - ALL RIGHTS RESERVED Author: Bob "grafman" Free - grafman@graphcomp.com Contributor: Geoff Broadwell This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DESCRIPTION This module is an extensible wrapper to abstract imaging interfaces By default, this module uses the OpenGL::Image::Targa module; support for other imaging libraries may be added by providing plug-in modules in the OpenGL/Image folder. An OpenGL::Image::Magick module is also provided for use with PerlMagick. For best performance, ImageMagick 6.3.5 or newer should be installed. =head1 SYNOPSIS ########## # Check for installed imaging engines use OpenGL::Image; # Get hashref of installed imaging engines # Keys are engine names; values are info hashes, including version, # priority (1 .. n, 1 is highest), module (Perl module name) # and description. # Priority can be set using Engines.lst (see INSTALL); otherwise # 'Targa' has top priority, and others are in unspecified order. my $engine_hashref = OpenGL::Image::GetEngines(); # In list context, returns list of info hashes sorted by engine # priority; info hash does not include a priority value. my @sorted_engine_info = OpenGL::Image::GetEngines(); # Check for a specific engine and optional version support # Returns an info hashref for the engine if available; otherwise undef. my $info_hashref = OpenGL::Image::HasEngine('Magick','6.3.5'); ########## # Load texture - defaults to highest priority engine if none specified; # if Engines.lst is not specified, the highest priority is the Targa engine. my $tex = new OpenGL::Image(source=>'test.tga'); # Get GL info my($ifmt,$fmt,$type) = $tex->Get('gl_internalformat','gl_format','gl_type'); my($w,$h) = $tex->Get('width','height'); # Test if power of 2 if (!$tex->IsPowerOf2()) return; # Set texture glTexImage2D_c(GL_TEXTURE_2D, 0, $ifmt, $w, $h, 0, $fmt, $type, $tex->Ptr()); ########## # Modify GL frame using ImageMagick my $frame = new OpenGL::Image(engine=>'Magick',width=>$w,height=>$h); # Get default GL info my($def_fmt,$def_type) = $tex->Get('gl_format','gl_type'); # Read frame pixels glReadPixels_c(0, 0, $width, $height, $def_fmt, $def_type, $frame->Ptr()); # Sync native image buffer # Must use this prior to making native calls $frame->Sync(); # Modify frame pixels $frame->Native->Blur(); # Sync OGA # Must use this atfer all native calls are done $frame->SyncOGA(); # Draw back to frame glDrawPixels_c(0, 0, $width, $height, $def_fmt, $def_type, $frame->Ptr()); ########## # Save GL frame my $image = new OpenGL::Image(width=>$width,height=>$height); # Read frame pixels glReadPixels_c(0, 0, $width, $height, $def_fmt, $def_type, $image->Ptr()); # Save file - automatically does a Sync before write $image->Save('MyImage.tga'); ########## # Get/Set normalized pixels my($r,$g,$b,$a) = $img->GetPixel($x,$y); $img->SetPixel($x,$y, 1.0, 0.5, 0.0, 1.0); # Sync cache after done modifying pixels $frame->Sync(); ########## # Methods defined in OpenGL::Image::Common: # Get native engine object my $obj = $img->Native; $obj->Quantize() if ($obj); # Alternately (Assuming the native engine supports Blur): $img->Native->Blur(); # Test if image width is a power of 2 if ($img->IsPowerOf2()); # Test if all listed values are a power of 2 if ($img->IsPowerOf2(@list)); # Get largest power of 2 size within dimensions of image my $size = $img->GetPowerOf2(); # Get one or more parameter values my @values = $img->Get(@params); # Return the image's cache as an OpenGL::Array object. # Note: OGA may change after a cache update my $oga = $img->GetArray(); # Return a C pointer to the image's cache. # For use with OpenGL's "_c" APIs. # Note: pointer may change after a cache update $img->Ptr(); ########## # Supported parameters: # version - version of the engine # source - source image, if defined # width - width of image in pixels # height - height of image in pixels # pixels - number of pixels # components - number of pixel components # size - bytes per component # length - cache size in bytes # endian - 1 if big endian; otherwise 0 # alpha - 1: normal alpha channel, -1: inverted alpha channel; 0: none # flipped - 1 bit set if cache ordered top to bottom; others reserved # gl_internalformat - internal GL pixel format. eg: GL_RGBA8, GL_RGBA16 # gl_format - GL pixel format. eg: GL_RGBA, GL_BGRA # gl_type - GL data type. eg: GL_UNSIGNED_BYTE, GL_UNSIGNED_SHORT ########## # APIs and Methods defined in engine modules: # Get engine version my $ver = OpenGL::Image::ENGINE_MODULE::EngineVersion(); # Sync the image cache after a write. # Used by some engines for paged caches; otherwise a NOP. $img->Sync(); # Save the image to a PNG file (assuming the engine supports PNGs) $img->Save('MyImage.png'); # Get image blob. my $blob = $img->GetBlob(); =cut OpenGL-Image-1.03/INSTALL0000644000175300010010000000203511067507674013067 0ustar chmNone To install the OpenGL::Image modules, please follow these instructions: 1. Install the OpenGL module first - you need at least version 0.55_03 See the Perl OpenGL (POGL) Developer's Site: http://graphcomp.com/opengl 2. Optionally install one or more supported imaging library. At this time, OpenGL::Image supports: * Targa - Pure Perl uncompressed RGBA files (installed with OpenGL::Image) * Magick - PerlMagick required; version 6.3.5 or newer is recommended: http://www.imagemagick.org/script/perl-magick.php If you've installed multiple OpenGL::Image engines, you can define the priority of the engines selected by OpenGL::Image by creating a Engines.lst file in the OpenGL/Image folder - separate each engine name by a newline, with no whitespace. 3. Run 'perl Makefile.PL' 4. Run 'make' ('nmake' on Windows). 5. Run 'make test' ('nmake test' on Windows). 6. If all is well, run 'sudo make install' ('nmake install on Windows') to intall the OpenGL::Image modules onto your system. OpenGL-Image-1.03/Makefile.PL0000644000175300010010000000102011067507674014001 0ustar chmNoneuse 5.006001; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'OpenGL::Image', DISTNAME => 'OpenGL-Image', VERSION_FROM => 'Image.pm', PREREQ_PM => {OpenGL=>'0.55_03'}, dist => {COMPRESS => 'gzip', SUFFIX => 'gz'}, ($] >= 5.005 ? (ABSTRACT => 'Image Load/Modify/Save Support for the OpenGL Module', AUTHOR => 'Bob "grafman" Free (grafman@grafcomp.com)') : ()), ); OpenGL-Image-1.03/MANIFEST0000644000175300010010000000035611067510113013151 0ustar chmNoneChanges COPYRIGHT hex_tile.pl Image.pm Image.pod Image/Common.pm Image/Magick.pm Image/Targa.pm INSTALL Makefile.PL MANIFEST README t/OpenGL-Image.t test.png META.yml Module meta-data (added by MakeMaker) OpenGL-Image-1.03/META.yml0000644000175300010010000000052411067510113013266 0ustar chmNone# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: OpenGL-Image version: 1.03 version_from: Image.pm installdirs: site requires: OpenGL: 0.55_03 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30 OpenGL-Image-1.03/README0000644000175300010010000000362311067507674012722 0ustar chmNone Copyright (c) 2007 Graphcomp. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. This module provides methods to load/modify/save images for use with OpenGL textures, FBOs and VBOs. It requires the OpenGL module - version 0.55_03 or newer. It also requires at least one supported OpenGL::Image imaging engine. At this time, the following drivers are supported: * Targa - Pure Perl - uncompressed RGBA files (comes with OpenGL::Image). * Magick - Requires PerlMagick (v6.3.5 or newer for best performance). You can find the latest releases and information for installing/using these modules at the Perl OpenGL (POGL) Developer's Site: http://graphcomp.com/opengl NOTE: as of 1.03, you _must_ call Sync prior to calling native (eg. ImageMagick) APIs on an OpenGL::Image object, and call SyncOGA when done with your native calls. Changes: 1.03 Bob "grafman" Free Revamped Magick.pm to correctly handle alpha channels and sync'g on various platforms. 1.02 Geoff Broadwell Removed redundant documentation from Image.pm Fixed/enhanced priority handling and engine info retrieval for GetEngines and HasEngine. Cleaned up NewEngine. Cleaned up Image.pod, INSTALL and README. Bob "grafman" Free Fixed version number for OpenGL::Image::Common Enhanced hex_tile.pl Updated OpenGL-Image.t to reflect Geoff's changes 1.01 Bob "grafman" Free Fixed typo in test app. Added support for 24 bit images in Targa.pm Added support for runlength-encoded images in Targa.pm Fixed non-alpha image handling (eg: JPEGs) for unix in Magick.pm Updated STDERR handling when attempting to load image modules. Added GetPowerOf2. Updated SyncOGA in Magick.pm to handle image resizing. Added hex_tile.pl screensaver 1.00 First release - Bob "grafman" Free OpenGL-Image-1.03/t/0000755000175300010010000000000011067510112012256 5ustar chmNoneOpenGL-Image-1.03/t/OpenGL-Image.t0000644000175300010010000002526511067507674014644 0ustar chmNone#!/usr/bin/perl -w use strict; use OpenGL(':all'); # Images used for testing my $src_image = 'test.png'; my $dst_image = 'test.jpg'; my $tga_image = 'test.tga'; my $width = 128; my $height = 128; my $deviation = 0.15; # Init tests my $t = new MyTests(26,'Testing OpenGL::Image'); # Get OpenGL version my $pogl_ver = $OpenGL::VERSION; my $has_pogl5503 = $pogl_ver ge '0.5503'; $t->status("Using OpenGL v$pogl_ver"); $t->status("Recommend OpenGL 0.55_03 or newer to use") if (!$has_pogl5503); #1 Get module version my $ogi_ver; my $exec = qq { use OpenGL\::Image; \$ogi_ver = \$OpenGL::Image::VERSION; }; eval($exec); $t->bail("OpenGL::Image failed to load: $@") if ($@ || !$ogi_ver); $t->ok("OpenGL::Image module loaded: v$ogi_ver"); #2 Get ImageMagick version my $im_ver = 0; $exec = qq { use Image\::Magick; \$im_ver = \$Image::Magick::VERSION; }; eval($exec); if ($@ || !$im_ver) { $t->skip("Image::Magick module not installed: $@") } elsif ($im_ver lt '6.3.5' ) { $t->skip("Image::Magick module installed: v$im_ver - recommend 6.3.5 or newer"); } else { $t->ok("Image::Magick module installed: v$im_ver"); } #3 Enumerate installed engines $t->status("Testing OpenGL::Image::GetEngines():"); my $engines = OpenGL::Image::GetEngines(); my @engines = keys(%$engines); $t->bail("No imaging engines installed!") if (!@engines); my $has_TGA = 0; my $has_IM = 0; my $has_IM635 = 0; foreach my $engine (sort @engines) { $t->status(" $engine: ".$engines->{$engine}->{version}); if ($engine eq 'Targa') { $has_TGA = 1; } elsif ($engine eq 'Magick') { $has_IM = 1; $has_IM635 = $engines->{'Magick'}->{version} ge '6.3.5'; } } $t->status('Targa is ' . ($has_TGA ? '' : 'NOT ') . "installed"); $t->status('Magick is ' . ($has_IM ? '' : 'NOT ') . "installed"); $t->ok("At least one imaging engine is installed"); #4 Test HasEngine() my $engine_ver = OpenGL::Image::HasEngine($engines[0])->{version}; $t->bail("HasEngine('$engines[0]') failed to return a version") if (!$engine_ver); $t->ok("HasEngine('$engines[0]') returned '$engine_ver'"); #5 Test OpenGL::Array my $oga = OpenGL::Array->new_list(OpenGL::GL_UNSIGNED_BYTE,1,2,3,4); $t->bail("Unable to instantiate OpenGL::Array") if (!$oga); $t->bail("OpenGL::Array returned invalid element count") if (4 != $oga->elements()); $t->ok("Instantiated OpenGL::Array"); #6 Test image object instantiation my $tga = new OpenGL::Image(width=>$width,height=>$height); $t->bail("Unable to instantiate OpenGL::Image") if (!$tga); $t->ok("Instantiated OpenGL::Image(width\=>$width,height\=>$height)"); #7 Test Get/Set Pixel $tga->SetPixel(0,0, 0.1, 0.2, 0.3, 0.4); my($v0,$v1,$v2,$v3) = $tga->GetPixel(0,0); # Normalized values introduce rounding errors my $dev = (abs($v0 - 0.1) + abs($v1 - 0.2) + abs($v2 - 0.3) + abs($v3 - 0.4)) / 4; #$t->status("Get/SetPixel deviation: $dev"); if ($dev > $deviation) { $t->bail("GetPixel failed to return values used with SetPixel"); } $t->ok("GetPixel returns valid values used with SetPixel"); # set up test pixels my @pixels = (); my $x0 = 1.0 / $width; my $y0 = 1.0 / $height; my $r = 1.0; my $g = 0.0; for (my $y=0; $y<$height; $y++) { $b = 1.0; $a = 0.0; for (my $x=0; $x<$width; $x++) { push(@pixels,[$x,$y, $r,$g,$b,$a]); $b -= $x0; $a += $x0; } $r -= $y0; $g += $y0; } foreach my $pixel (@pixels) { $tga->SetPixel(@$pixel); } #8 Test image saving $tga->Save($tga_image); $t->bail("Save('$tga_image') failed to create $tga_image") if (!-e $tga_image); $t->ok("Save('$tga_image') created image"); #9 Test image loading my $sav = new OpenGL::Image(source=>$tga_image); $t->bail("Unable to instantiate OpenGL::Image") if (!$sav); $t->ok("Instantiated OpenGL::Image(source=>'$tga_image')"); unlink($tga_image); #10 Test image parameters my $params = $sav->Get(); $t->fail("Get() failed to return a parameter hashref") if (!$params); my @params = keys(%$params); $t->fail("Get() failed to return parameters") if (!scalar(@params)); $t->status("Testing object parameters:"); foreach my $key (sort @params) { $t->status(" $key: ".$params->{$key}); } $t->ok("Get() returned parameters"); #11 Test image size my($w,$h,$p,$c,$s) = $sav->Get('width','height','pixels','components','size'); if ($w != $width || $h != $height) { $t->fail("Get('width','height') returned invalid dimensions: $w x $h"); } elsif($p != $w * $h) { $t->fail("Get('pixels') failed to return $w x $h: $p"); } else { $t->ok("Get('width','height','pixels') returned: $w x $h = $p"); } #12 Test pixel deviation my $d = 0; my $i = 0; for (my $y=0; $y<$height; $y++) { for (my $x=0; $x<$width; $x++) { my($r,$g,$b,$a) = $sav->GetPixel($x,$y); my $pixel = $pixels[$i++]; $d += abs($r - (@$pixel)[2]); $d += abs($g - (@$pixel)[3]); $d += abs($b - (@$pixel)[4]); $d += abs($a - (@$pixel)[5]); } } $d /= ($i * 4); if ($d > $deviation) { $t->fail("Set/Get Pixels deviation out of range: $d") } elsif ($d) { $t->ok("Set/Get Pixels within acceptable deviation: $d"); } else { $t->ok("Set/Get Pixels resulted in no deviation"); } #13 Test IsPowerOf2() if (!$sav->IsPowerOf2(256)) { $t->fail("IsPowerOf2(256) returned false"); } elsif ($sav->IsPowerOf2(13)) { $t->fail("IsPowerOf2(13) returned true"); } elsif (!$sav->IsPowerOf2()) { $t->fail("IsPowerOf2() returned false"); } else { $t->ok("IsPowerOf2() returned true"); } #14 Test GetArray() $oga = $sav->GetArray(); $t->bail("GetArray() failed to return an OpenGL::Array object") if (!$oga); my $elements = $oga->elements(); if ($elements != $p * $c) { $t->bail("GetArray() contains invalid number of elements: $elements"); } $t->ok("GetArray() contains $elements elements"); #15 Test Ptr() if ($oga->ptr() && $oga->ptr() != $sav->Ptr()) { $t->bail("Ptr() returned invalid pointer: ".$oga->ptr().', '.$sav->Ptr()."\n"); } $t->ok("Ptr() returned a valid pointer"); #16 Test GetBlob() my $blob = $sav->GetBlob(); $t->bail("GetBlob() failed to return blob\n") if (!$blob); my $blob_len = length($blob); if ('Targa' eq $sav->Get('engine')) { if ($blob_len != $p * $c * $s) { $t->bail("GetBlob() returned invalid blob length: $blob_len\n"); } } $t->ok("GetBlob() returned a blob of length: $blob_len"); # Skip the rest if no Magick engine or test image my $has_image = -e $src_image; if (!$has_IM || !$has_image) { my $msg = $has_IM ? "Test image '$src_image' not found" : 'No ImageMagick'; $t->done($msg); exit 0; } #17 Test Loading source image my $src = new OpenGL::Image(engine=>'Magick',source=>$src_image); $t->bail("Unable to instantiate OpenGL::Image(engine=>'Magick',source=>'$src_image')") if (!$src); $t->ok("Instantiated OpenGL::Image(engine=>'Magick',source=>'$src_image')"); #18 Test source image size my($ws,$hs,$ps,$cs,$ss) = $src->Get('width','height','pixels','components','size'); if ($ws != $width || $hs != $height) { $t->fail("Get('width','height') returned invalid dimensions: $ws x $hs"); } elsif($ps != $ws * $hs) { $t->fail("Get('pixels') failed to return $ws x $hs: $ps"); } else { $t->ok("Get('width','height','pixels') returned: $ws x $hs = $ps"); } #19 Test Save() $src->Save($dst_image); $t->bail("Save('$dst_image') failed to create file") if (!-e $dst_image); $t->ok("Save('$dst_image') created image"); #20 Test Loading destination image my $dst = new OpenGL::Image(engine=>'Magick',source=>$dst_image); $t->bail("Unable to instantiate OpenGL::Image(engine=>'Magick',source=>'$dst_image')") if (!$dst); $t->ok("Instantiated OpenGL::Image(engine=>'Magick',source=>'$dst_image')"); unlink($dst_image); #21 Test destination image size my($wd,$hd,$pd,$cd,$sd) = $dst->Get('width','height','pixels','components','size'); if ($wd != $ws || $hd != $hs) { $t->fail("Get('width','height') returned invalid dimensions: $wd x $hd"); } elsif($pd != $wd * $hd) { $t->fail("Get('pixels') failed to return $wd x $hd: $pd"); } else { $t->ok("Get('width','height','pixels') returned: $wd x $hd = $pd"); } #22 Test RGB deviation $d = 0; for (my $y=0; $y<$height; $y++) { for (my $x=0; $x<$width; $x++) { my($rs,$gs,$bs,$as) = $src->GetPixel($x,$y); my($rd,$gd,$bd,$ad) = $dst->GetPixel($x,$y); $d += abs($rs-$rd) + abs($gs-$gd) + abs($bs-$bd); } } $d /= ($ps * 3); if ($d > $deviation) { $t->fail("Set/Get Pixels deviation out of range: $d") } elsif ($d) { $t->ok("Set/Get Pixels within acceptable deviation: $d"); } else { $t->ok("Set/Get Pixels resulted in no deviation"); } #23 Test Native() $t->bail("Native() returned invalid PerlMagick object") if (!$src->Native()); my($x,$y) = $src->Native->Get('width','height'); if ($x != $w || $y != $h) { $t->bail("Native->Get('width','height') returned invalid dimensions"); } $t->ok("Native->Get('width','height') returned: $x x $y"); #24 Test GetBlob() $blob = $src->GetBlob(magick=>'jpg'); $t->bail("GetBlob(type=>'jpg') failed to return a blob") if (!$blob); my $im = Image::Magick->new(magick=>'jpg'); $im->BlobToImage($blob); my($w0,$h0) = $im->Get('width','height'); if (!$w0 || !$h0) { $t->bail("GetBlob(type=>'jpg') failed"); } elsif ($w != $w0 || $h != $h0) { $t->bail("GetBlob(type=>'jpg') returns invalid dimensions: $w0 x $h0"); } $t->ok("GetBlob(type=>'jpg') returned a blob of length: ".length($blob)); #25 Test GetArray() $oga = $src->GetArray(); $t->bail("GetArray() failed to return an OpenGL::Array object") if (!$oga); $elements = $oga->elements(); if ($elements != $p * $c) { $t->bail("GetArray() contains invalid number of elements: $elements"); } $t->ok("GetArray() contains $elements elements"); #26 Test Ptr() if ($oga->ptr() && $oga->ptr() != $src->Ptr()) { $t->bail("Ptr() returned invalid pointer: ".$oga->ptr().', '.$src->Ptr()."\n"); } $t->ok("Ptr() returned a valid pointer"); $t->done(); exit 0; package MyTests; sub new { my $this = shift; my $class = ref($this) || $this; my $self = {count=>0}; bless($self,$class); my($tests,$title) = @_; $self->{tests} = $tests; print "1..$tests\n"; $self->status("\n________________________________________"); $self->status($title); $self->status("----------------------------------------"); return $self; } sub status { my($self,$msg) = @_; print STDERR "$msg\n"; } sub ok { my($self,$msg) = @_; $self->status("* ok: $msg"); print 'ok '.++$self->{count}."\n"; } sub skip { my($self,$msg) = @_; $self->status("* skip: $msg"); print 'ok '.++$self->{count}." \# skip $msg\n"; } sub fail { my($self,$msg) = @_; $self->status("* fail: $msg"); print 'not ok '.++$self->{count}."\n"; } sub bail { my($self,$msg) = @_; $self->status("* bail: $msg\n"); print "Bail out!\n"; exit 0; } sub done { my($self,$msg) = @_; for (my $c=$self->{count}; $self->{count} < $self->{tests}; $c++) { $self->skip('#'.($c+1)." - $msg"); } $self->status("________________________________________"); } __END__ OpenGL-Image-1.03/test.png0000644000175300010010000006153211067507674013532 0ustar chmNonePNG  IHDR>agAMA7tEXtSoftwareAdobe ImageReadyqe<bIDATx]Wu.6}FSTnٖbLq @ $GM <~ @N!HB 6wɒb4}n_lJ)I?9Gs=g}k ֯w/f} `Z7k֯uX `Z7k֯uX `Z7k֯uX `Z7k֯uX `Z7k֯uX `Z7I%_AKXO@/Ll((7#XmRK&VױF!"ߣ "x,@cH nE {6FO<,@.Mkǎ0ؕ"7uAAY@K o!.66ۂ[9Xl옦<84F?`$nW9nG"kmĶCTN>gN09B#<Ep8GXFSDXX> cx7[WccD<+X ܐBR2=B'gev?C̓fw7m{~9x5k|퉶>_9ĽceE͈KwG_/DtWgnNRyD#)Ux5@ɳylg29Bok@{`Vx2-ҁ\rTϚ56]|[qJ> /0Ibpa ovE?_@AAp =7?+Z{Jv@.,0N ߓ!"K7OdyҲNeV;AUc/whCIègh6f @{Fkǘ<\_<2qڅv5O]]Ws'@Bӝ{?3ĝb8pVp2v1/LP=8@`C@Yh/}(yX oþL0;:ujZ0Bu#&mЁ#Eb^0;MýH?a/ WJ"Y?dx˚ d|up&C6~ƻM%_,B+.C@G, G+$we*3 8".+ z8{1䗈4?8̕d[~@b&٦ 6Q״tف JsqE//Hx%/]_72ow>ާF/`$bqm+C{Y x$ى J_ko^wKK}h=7d=W:hW}P&C'-8qa$M_1﷝C̟ /cЬx_x4}=" $(D"A~4xZIdԏ"*>OL0p=ԚgV[[EbI >8f4|tOτ G,'x<8jׅ dEx`hvBy* BZ MQbP_ }ȅ`.]: jvx`w3 ?T`ΗQvx4}3W]|а_ _lˆ`lHc<,ܔI0Wh8*Bth  AȂ(( :lIu`v1;hI)U|-r,"LS%4N->\>S~,#V(dH}xzwD,D"G"mnҙHc~1{¡aɰxPC< 4<E9fwpN J]x̼J?W"# &61PHצW@cYȐ.(dhtA#Ar;dﭶ޴*pr- `;]עO Q$0 M*HD,V\GkN9C%Y|tdiG"Nc;cPDLCݑpBmz䢅%%C.yY~<֮/F ;GL)0 C5 DdžW\Wm& 48p6bAEh;͚gbx ;GéL,p TBȠGOlv)t#~$@z6ֻÒn.a$@LtVG| 'O|ljSVD426mh.??CAA~"o#)j=Ġ{01q39ݮ .cj?H&@8Ce_z*MkL{RKɃ[a_2JDԂ=ѰyQM`+2ώ&3n=$\=ްpS5"/}_v6!)0DO3~H !ķ?cvs OB4YîOHc+8æ}E[8Ѕf/V͡qlT#WE ,G|vˢhgqxx"zχKloD[ 5?&HeLf[wb}V"0!7NrltCvv&{!tRU8Gzp%'qlR4) Ҭ5nɊ6q|ƐkfX,ý.D`kqDpm>|8hefh-_nWH`0tacПfOc b+ݓyt̹9@WM!= vF&tm<(poz5@JTP5X{vR}=C"BGOj:=m!EVrԤ0cC3l?EhZڸyW^ڃBf$BIxe(k¼~lrz%w}nT_=i,RnSϻ/|aCG~$:m_}xQF!9&u,r2g]^mۺPVQ5n0>ﺅ+zΜ* ֖` T^zޞ/7۲iCfq ,Irog7sa2Jk9M\b|O= ~Z?Hy28kOdהW1'Pb{︓m- k^GU!@.V QA1|e,)f. , xOq) #RYַ?av-K,|8<6ⓧa@1Fc~\ڸtEwV1=RKFf~R(=.er/pRv` erP 8ȧ:-o4j~$e22>45 aWsƨS_5j85C4 h7obYO&d.)r9/CfѰI*rÐ.৩XT%1fsK'?3KN} B4ȳPڄ P0(9BXBPg[( oș8>+:K"&x>}M21QtsN:f ͌t${6h ~{u8f& o'䋢8dzۮ4RO_rQk.LcxZ{$wpL"cTāEɕm7ߺct߿ۍ6(A&ArxLPӹ {VwsUg.$:8ƮO%^CN K }5߾3Ό$0̈ Qhٙ܋g_rcxCj(6뎭#V>W2`z[dy>hQ?0^?mpU:Ӧ_^?s2^ OU6C5CǮ(=Y1{%F?Fdcqb?URa=Jjp &ye<`M륳zg^.fɵ;q :l4NLmH"q3%iT\la+,]5LvF$sk,zٜ%fеNy?z@yD>4TU`@Ь%;gv$6l o> /`xm8VN/sOSmN&]w -} PJ<j˅W,-  =RNSoQKgS=&99q)J cNE$8NȌ =h;p,Y |)&S0}~M)-@PR)aM#~.8>DCXF?vc|=8u0"EQxK`I#2;f+]a0\j fv;췗#"[R | |HpƂRu dI@}%GU""<¢,-u]}?yƿR\Q$t SjǸH2Slm/{ ?RblrVID *YƁ{MԢX,o.GCtYʦ CD5{ʁ ͮ(Dek8L,.6·쯼w>7oSm}mV^6-oyyȏ<@ˆ.Z!z~Ne \3082}}2/)aTRn2QFO)U^A䷻λ+g^ܭdž ^<#m &fZy[!̲ Te⇆a~ LD7aYjB o0 }EC9KgO8#ʡwd2j@="`wkљKgTcJ4^GRv W.x]R$WG> Kx>4:mEn?O:T$٫Cw`c_àHuQl`B&wt" <^l=١n{ZGz?GㅣZθvS$ph'A[}9#HSGK /59Q4}^Sqaiiv B lʱXGk97lF_ddvDm-Ô "EB>tȦJZx>~OKbwj[K&gv$N6My, 0nEP;^{u/12G.U;/.?kY!Ar͙ҏ 𪷑|i=9s+}s_ȳrcNl0챶|T]̔ HFq5%kiZz1.C3C_HaT "/p,ΖLX5VqeS@Vz³J׺ g# ("51X,*5d/!y0xVX쥴 #1- oxMMo>|ۙ( t nҫ!}h7zsO,U(l?`9z-?rѽy|jѩع{+,=t`u#o]t۽ aB"èxseCd+D`vttye9VZ>mYc\m/sU#  ӜNGfN  >pQ?dc{^GnAœF~80&,Wk؞wi;H#Dm,t(ٮF~FXJUDSwV4}\'fy'"JyG] HK$y虗 Ba %R18DLtkKR_[ kI籠r6W+sp$Kh.7p9ILa3EM&mZa{3SH۴cY` Cj"#|!ͻcҳDʇx_/ZW`Zx򫥳sS lzh|-_tؑ×^vMx﹤0̡4!6<Y`ulZ~BM(EEAŠ`{Z.30yjO@{j8pg ]];DÈll RlDՁ5^#d fee Tp8H/8IPjC;凿r@24( os<꛽nUDU-8%N$,iɌeښmg}dr?u$| SIBV_/"Ӏ:J$v@~J)C?Ɛx+n؎0RFřaޫcP$@]Yl>+]e[eP,p$n鴚Eqĥd,_-hS%窓jZ} %(NV".9~$Cbw4ǐ\- 4C3 7jY#Om~X'>WF8aŠM.;xиD/O}%d>k.ˮS<+ʵ͡n<>!-7Zaiˆ+m ݓI. ~z q7o-:;S)5,$ap.g(/&c^^@ʼn8Dӂî7m_kwE)(D!pEPD8ɏdX@啻ЈzT.o u|'8N{Y)cz 4p W?nuo--G yoBVGQJ}TA jJjjL=2%NMi 6Fչè:kaJ86Ѷ:rbNb%t@JB"MKʌjqgy0+S!&DY3zVU`4,-ťj-u,d@TU~lM2/Hgw`C@Faa(SEH<)* )W"HaIl3 9e~^GalWk1~n44],~ HjY&\\񊋋guMWD'Oξtt헗r<鰣k_pv^QiapLmq{1u l&b!c8::n]>qV$17ȅ74 ~q6k%?>}t`XȫE'd ~(qTP*e9F*k1G@@1"cS쉯*^{SCC76O L_@Abۊ"]bWm[7Zjo)dČʇ0,@  TƓ~'Kܴ,& pn>{#dҪD.DT!0 5 ٵ?Ek ~Bu%;%L~7aH5E`1,e5Y;Ψj~B1itރy V+*^t@RΎD;6l.AgvpPYsiB/`A7[rD-[WcG H^Vm ykRd LzJ&]e"R.bE)ۛ/c^W\$Gp-Ás(4BS!6W߱ %A!@eIVh3X. )2.G2kt Aath3wݬVGMJZEZ@aC B?D2swi~VjvYߍe{RWe01E ՆBn,8ocy6?seinj&ؕPGZO/C܁V #)M[AX8).)nΛ>عh@|!(e{V=~ ,lhlHM #(#FF r:6 u֕߬/UM%ZPlS7j4l mGȃ:QuĔ߽xgnl^= 3ޗP!|A'NIbuyIfJxgo_~0FJn||lƶZ%h"&{ PԻMsv~mЬajG @ 6Na6R{b(Iv{ϸLt`Q{IԍR-YG-2 #BxQݔó#Mm&ߌեc7cWY8y[7|D 'OD1'zx$;ƛY璑$'("@o Yv~hayh6Nm pl:B* H2FNۣ^ .*ºg5q"C)ЃMD]rд=G~MG>"e_"Ҕ,;wطeKBzbRtˍ Yok9v̖9%0ʍ(ڬũơ}I U/غgt5xo>NLn&GGYؽ- N&7齰1f,Q+YMJA\ɑ9t0%o 2|]98!wIob}FT&3A$Az Jx/aH=sAGK'\^X<8zFQ:6oOA6_D"(MFU"mQ|Zi/+$B{4,ĉ$%? ԟ)S$surhBBx.^Lw2_y; {NX$!X"'îvPѵ!(t`d~RInXߙ GE1'|w`n9!%}s5iiM ׫pZcߌ&ƣ iv3%&bEć\ %1vrM/ ]_/#{jn,,44ūl~ElH8q-[e8I:W甐ń0`<DzO}|N`)5sxN@!BDf$dwihs無!Eic{1pq< CP{ $@8HP xc$&u F ̣Z NjՆQԅ .< k V@tTH A)UiK AYy$nN෺iWy{,HBrpQ xŇDp k8ؙ+oYюYt7o@ɩڶ\+wU`a}l Pԣ$vAІ3e;:lVCxb 5٨N ::b>20̭md~̬iLք  MMn\#M"K7NK)p խJjX5aA. ut:mv 62?P]CiCkH0_5t):-=Fsݫib, Jl'ȗe~_`E!{7}A0[QYQJbx ~^fS[,  ~.φQ27>E@ 5"A;?Z9;ma.43Ǩcxd:56x^Ri m6>qҵT^i ޅJuKC5AJ{&`&^#n{ EJM:l D5y-vuSivV\VpG$Jq9O _f[HV7f܈&1{cFV4(1ޯ)}\zG:-Gq&yTi vΈH[Kb jE\WO<^'f\\H!s\|VD;VH3u+l o<~GJ!Fž t=aXھX69OdF%9ٟCk/=t+[Ͽ-NꟀF?,RgB`x Dێ%/l TEYVX^%ٙh-eA@LYK`v#2S0n)fr/qfK H#\2ሥA۾ 6fpQ>xcpB8Y@)8!dڻq:QDHӔ7˖Gq^ftw9"4P (tlR? ((vPHeqr[zaKNx6MZt= C#]  WϞY`9񞉳B N0>{|bD!L^(ϸ. fqE&a/2* L/<"FC^l?ey[8yfn~2U_r$n귥BQD)7aDɧߙ:h]9%9l` :~>bNZ]pAf%rlBXMMRO'↱MPZܺӮG=:,(yd7*qkȷ(X_(zP]^{e[vtHVy<##c:'7LOerbcʩDZhnxgi襪ye`ҍSS[N,#< mэ.9],/7Lo];-~`[]G'tف,1[HˊnV8J-ڞi+Um{.zOcK$0HJB9$j//6Z= p4 uax)$T ջ:LdOlԈDYPpG  f:61>5wM0UT_c}RDkv2zF{FJkfTAibpfяs+dH}S\`{Ḟ$; Pۑ$`ī>)5 B[_YR{ۧ yHFR๎[s+liO*c<ߞ B?BJJ AөTN#ߺ埾}对wͯaO$SXUyKc<ڛsځҝ Cn^NKa06qF>ޛzwoL#T(`Eb#3 װ2)]/WVF@G}Ip_JCù7qN_o.&$ӵH@ѡ!&7yG wX~&m*L X%vså 5썽n'V+eq4BK%S{] n'~g.7r=2N"3ϲ+ '\: ŷ{aȴ]sQ޴?DT/d: .Hc9-[v'ijwpnJn4r~&_, mݹGEVz{mZ-2Ó2ܙZyэko.=+oJUURRk]Υӓk~B*F%O$)Dl0<,x4mOGAEG= #$R8auʄdt׶v?eW=qDַrDxs Y}lth;.ra0GWK$ncdyHUO'zYNZ4ZRXϤF'd򋓓~ vB|n{ {G`Fv\\Af6wz| /Ϲ}zzhdYb n0)d5MRv-H 0!e6tLS`e1),$3A-ْ<3ϧ{{,ǤYh]oo#CnՎ#SlϋC3~^D7-v6h$[C޵{ЬyȾvn)қ,ݨ1j辉>z^Gvܟm/V9GVyJQNLSS<:#WN~7ԉǧ^1@ .[cY7i4_莤!ѹc7^]D[G IhuڰZBs\$Q*bdhfzvTVܸ6v$p;vld2I,&~|7TDWG8*8|Z =-GUJ=ޝyD|IY?%k*L˲(t.R$R<6; aRL7qAY~]yylwȞJA2^Ap96 Ac}:6cM8LV 34:tgCR5UN\@' zgX_MS'ˈfˌc5|X\oXIByxb K.GA dVvN aɟG!p+GYHDfHofQGLlނy"J./IࠇcyBYCUFv Xn!JӾ(3ʕ{<TP^=χvV{s EĜm{)d㋺ض F{sE&?M!KA!9hvizKuX[&mgPP J%`%*Zښ&Ă"xWY .~6hʼn'\l]x-f48an!CξZCXqsuev6u&Ip=Ajo\ϪoFmav S1/l< ނ77ߕTjZ&a}9$blm{'&Nv2' "^ƅˣC8ۈoM^S[stRwoCh7c-2W֠[`o]\E|1KJ2M^x>0@M؏ۈ(#q :ڙ.~;i$ϑ A&O'.kg͘$TٮXꩲ .NH$,VMARʣ~( ,$(uG>LL^I) 9~!5]®ѧI@$ ܄zc%P[. x2mvuzG?%z2( 6{o`3Mk/pXb]6x[k"ߨ$. *Ǫ~To~~Lvf| ]m&@OR4?/$Aal,}TuGs׿|d: 1Ҟ `D'ij݋{w)[/=|E.USo۟=7ѦThgH9 ^rzi\Ea^b&%9y^hu_>d;_d )nQd{&[UM'D;S_- zl2m&gO;4t0(dr4}5h wŸ\}?`y5JKe_ MP1V۷|>[d۱w6@ʖF&} |+$8r]>;9pl!IqWIv "{" f/JCuP>~m;Br{eWp L&hgI('A8$+T<s+O)|cT/O)M0:B`2fmhFaA_CsAzR-Ϟ-.6W`u%/~MwtR͡j<@)>X@PR$蛬w7 Պam-UܨTu^bWlo|yN&,RtO(O»E'k!̞@#. Sc*B!Vl 0}ã&Dxc 1CWX%*jTR85&o:݂N+Fq8Ovwla^ $ UEF#X+ _`8_]p\_Π\ Oɻ/4:Ͽ]d>ƭ`H+Oࣷ_-T<ى( QSc"|@϶m&>GQrh\މ~nKȞO8'WeD'Zp|hCXuAV"4Df,i/ N& "M\=冨I}aQ,=Eс˛~NSi rYw6lء;ۨSM HMF G.с)8HJu&6h"8^j?H (du#YE8A-H)e mP'ֽ\VB!CC,bzc8m#IFh2/^;vi^,CNވ2#ਥ(e&3B)n ˽nRK|k]=" L+vQ˸6~.U(]{j垺UgM#7z}me-)s|Ax5:hfT P wSNB,џXRq2-sA)f9]B$ ωO.>BʊqgNu=HU.%7PBޥK)91Ldb Ծ7JSķ@ fb}8)tz\Qg^MswzBB娫t9;n;IU3z15 M=LVEeŗn’Fu8'!4V3nO6iW9](P=1'JMNE[+VDD|E!1muWi8- A4a-3rU|Zܣr4X'e71ʎ%T* n=6uĭu=$Ȳ}T\C^:R[!3NSBce~^WO#[ DƜI=)bAAb#yRgYκD{^Gs"9ŒN5[|2_MtJf7tv}H!ǧ|eB1aF49pӤT(c湷mq}7EQ7[J^*)BvO ӳlJ{+ŲFp8y ]:V[x3N-!Qwb+.>bqfwy*q-!jio2ׯt<'7aʕ KiI^|_Jɀ,')|kWE*eo),g;mƒI${9, <5EY,ě0x*(i(V%9IVƒOo@O}F|_ƣjJz6q= |FPfn4^xdxL}AR|8ǖz+UǂAB\Aҥ ˹m޹^ܾ'@o˂bEq_v`$'K度q$(ly@HAYZ-nbV;&8&z*Cv. Gn툳IJUN6,XS!\u Ӹ^"KV# s9U]` __GWQ*yPՠ66 ,ۗJǝxQONjMʈ*r E2{=o*]w^KP(s(2$r~,S?ozra$C?tI{$ܾ_瀘EN9 ts)W%+Y,o.IeўOVLm|SW˵O{Pi^`3mjۋd-Sv{q\sI-rc=oWF{FD M'xa.~f$+Q8&8Z5(T鶟VU|X<{Y-8ZJe8}`8T QI4u?:Xsp/E$z̲Ɏ {/9×pH OwG/ 0i2bP?4hw;{;q^zڹR+:S;Rrn~A@M+.Z􁃟+_}$y͛_p}ZuC7_q5G5UOfƱnӋ*(G?#v,w[ͻz,.p`XV "Yagns Ӻ K/GKEpc{0:Qݩ )ocm:,CcuHQ;N76:ǜɦDYg?p S[.xMv67:5J6b l?Qeu.]0t~ӱ 78Y-%4pM0= Rlt׈bWjGITY_hX')uTB55,Ht ,^~q:m,qo6iSS |\βA0f57mUE*e'g9QEm,KYq}FF\>H;-Oq+Cd2J|BKS"Mf&}vN{Yz,z# 3Me wau}ˆ8kA(sӛ?5~D76X7M+Pu$j^4f^ Εg8"qn:A7oeO~d&UѢ)H]+ oDQi.<:@xK/!fϘ}rNzǧ$z}!|[-"' V4]A Aqҧ&x$Qcl>'p/ܝhX[dR9e}A\8:7ϫr1R\=ˊt(0}N <ߩY?L@@@@@@@@@@@@@@@@@@@@@@@`$BIENDB`