"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Graphics/TriD/TriD/GL.pm" between
PDL-2.076.tar.gz and PDL-2.077.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

GL.pm  (PDL-2.076):GL.pm  (PDL-2.077)
skipping to change at line 67 skipping to change at line 67
} }
print "EGENLIST $lno\n" if($PDL::Graphics::TriD::verbose); print "EGENLIST $lno\n" if($PDL::Graphics::TriD::verbose);
# pdltotrianglemesh($pdl, 0, 1, 0, ($pdl->{Dims}[1]-1)*$mult); # pdltotrianglemesh($pdl, 0, 1, 0, ($pdl->{Dims}[1]-1)*$mult);
glEndList(); glEndList();
print "VALID1 $this\n" if($PDL::Graphics::TriD::verbose); print "VALID1 $this\n" if($PDL::Graphics::TriD::verbose);
$this->{ValidList} = 1; $this->{ValidList} = 1;
} }
sub PDL::Graphics::TriD::Object::gl_call_list { sub PDL::Graphics::TriD::Object::gl_call_list {
my($this) = @_; my($this) = @_;
print "CALLIST ",$this->{List},"!\n" if($PDL::Graphics::TriD::verbose); print "CALLIST ",$this->{List}//'undef',"!\n" if($PDL::Graphics::TriD::ve rbose);
print "CHECKVALID $this\n" if($PDL::Graphics::TriD::verbose); print "CHECKVALID $this\n" if($PDL::Graphics::TriD::verbose);
$this->gl_update_list if !$this->{ValidList};
if(!$this->{ValidList}) {
$this->gl_update_list();
}
glCallList($this->{List}); glCallList($this->{List});
if ($PDL::Graphics::TriD::any_cannots) { if ($PDL::Graphics::TriD::any_cannots) {
for(@{$this->{Objects}}) { for(@{$this->{Objects}}) {
if($_->cannot_mklist()) { if($_->cannot_mklist()) {
print ref($_)," cannot mklist\n";
print ref($_)," cannot mklist\n";
$_->togl(); $_->togl();
} }
} }
} }
} }
sub PDL::Graphics::TriD::Object::delete_displist { sub PDL::Graphics::TriD::Object::delete_displist {
my($this) = @_; my($this) = @_;
if($this->{List}) { if($this->{List}) {
glDeleteLists($this->{List},1); glDeleteLists($this->{List},1);
skipping to change at line 107 skipping to change at line 102
} }
sub PDL::Graphics::TriD::BoundingBox::togl { sub PDL::Graphics::TriD::BoundingBox::togl {
my($this) = @_; my($this) = @_;
$this = $this->{Box}; $this = $this->{Box};
glDisable(GL_LIGHTING); glDisable(GL_LIGHTING);
glColor3d(1,1,1); glColor3d(1,1,1);
glBegin(GL_LINES); glBegin(GL_LINES);
for([0,4,2],[0,1,2],[0,1,5],[0,4,5],[0,4,2],[3,4,2], for([0,4,2],[0,1,2],[0,1,5],[0,4,5],[0,4,2],[3,4,2],
[3,1,2],[3,1,5],[3,4,5],[3,4,2]) { [3,1,2],[3,1,5],[3,4,5],[3,4,2]) {
&glVertex3d(@{$this}[@$_]); glVertex3d(@{$this}[@$_]);
} }
glEnd(); glEnd();
glBegin(GL_LINE_STRIP); glBegin(GL_LINE_STRIP);
for([0,1,2],[3,1,2],[0,1,5],[3,1,5],[0,4,5],[3,4,5]) { for([0,1,2],[3,1,2],[0,1,5],[3,1,5],[0,4,5],[3,4,5]) {
&glVertex3d(@{$this}[@$_]); glVertex3d(@{$this}[@$_]);
} }
glEnd(); glEnd();
glEnable(GL_LIGHTING); glEnable(GL_LIGHTING);
} }
sub PDL::Graphics::TriD::Graph::togl { sub PDL::Graphics::TriD::Graph::togl {
my($this) = @_; my($this) = @_;
# print "TOGL Axis\n"; $this->{Axis}{$_}->togl_axis($this) for grep $_ ne "Default", keys %{$thi
for(keys %{$this->{Axis}}) { s->{Axis}};
if($_ eq "Default") {next} $this->{Data}{$_}->togl_graph($this,$this->get_points($_)) for keys %{$th
$this->{Axis}{$_}->togl_axis($this); is->{Data}};
}
# print "TOGL DATA\n";
for(keys %{$this->{Data}}) {
# print "TOGL $_, $this->{Data}{$_} $this->{Data}{$_}{Options}{LineWid
th}\n";
$this->{Data}{$_}->togl_graph($this,$this->get_points($_));
}
} }
use PDL; use PDL;
sub PDL::Graphics::TriD::CylindricalEquidistantAxes::togl_axis { sub PDL::Graphics::TriD::CylindricalEquidistantAxes::togl_axis {
my($this,$graph) = @_; my($this,$graph) = @_;
my $fontbase = $PDL::Graphics::TriD::GL::fontbase; my $fontbase = $PDL::Graphics::TriD::GL::fontbase;
my (@nadd,@nc,@ns); my (@nadd,@nc,@ns);
for my $dim (0..1) { for my $dim (0..1) {
my $width = $this->{Scale}[$dim][1]-$this->{Scale}[$dim][0]; my $width = $this->{Scale}[$dim][1]-$this->{Scale}[$dim][0];
if($width > 100){ if($width > 100){
$nadd[$dim] = 10; $nadd[$dim] = 10;
}elsif($width>30){ }elsif($width>30){
$nadd[$dim] = 5; $nadd[$dim] = 5;
}elsif($width>20){ }elsif($width>20){
$nadd[$dim] = 2; $nadd[$dim] = 2;
}else{ }else{
$nadd[$dim] = 1; $nadd[$dim] = 1;
} }
$nc[$dim] = int($this->{Scale}[$dim][0]/$nadd[$dim])*$nadd[$dim]; $nc[$dim] = int($this->{Scale}[$dim][0]/$nadd[$dim])*$nadd[$dim];
$ns[$dim] = int($width/$nadd[$dim])+1; $ns[$dim] = int($width/$nadd[$dim])+1;
} }
# can be changed to topo heights? # can be changed to topo heights?
my $verts = zeroes(3,$ns[0],$ns[1]); my $verts = zeroes(3,$ns[0],$ns[1]);
(my $t = $verts->slice("2")) .= 1012.5; (my $t = $verts->slice("2")) .= 1012.5;
($t = $verts->slice("0")) .= $verts->ylinvals($nc[0],$nc[0]+$nadd[0]*($ns [0]-1)); ($t = $verts->slice("0")) .= $verts->ylinvals($nc[0],$nc[0]+$nadd[0]*($ns [0]-1));
($t = $verts->slice("1")) .= $verts->zlinvals($nc[1],$nc[1]+$nadd[1]*($ns [1]-1)); ($t = $verts->slice("1")) .= $verts->zlinvals($nc[1],$nc[1]+$nadd[1]*($ns [1]-1));
my $tverts = zeroes(3,$ns[0],$ns[1]); my $tverts = zeroes(3,$ns[0],$ns[1]);
$tverts = $this->transform($tverts,$verts,[0,1,2]); $tverts = $this->transform($tverts,$verts,[0,1,2]);
glDisable(GL_LIGHTING); glDisable(GL_LIGHTING);
glColor3d(1,1,1); glColor3d(1,1,1);
for(my $j=0;$j<$tverts->getdim(2)-1;$j++){ for(my $j=0;$j<$tverts->getdim(2)-1;$j++){
my $j1=$j+1; my $j1=$j+1;
glBegin(GL_LINES); glBegin(GL_LINES);
for(my $i=0;$i<$tverts->getdim(1)-1;$i++){ for(my $i=0;$i<$tverts->getdim(1)-1;$i++){
my $i1=$i+1; my $i1=$i+1;
glVertex2f($tverts->at(0,$i,$j),$tverts->at(1,$i,$j)); glVertex2f($tverts->at(0,$i,$j),$tverts->at(1,$i,$j));
glVertex2f($tverts->at(0,$i1,$j),$tverts->at(1,$i1,$j)); glVertex2f($tverts->at(0,$i1,$j),$tverts->at(1,$i1,$j));
glVertex2f($tverts->at(0,$i1,$j),$tverts->at(1,$i1,$j)); glVertex2f($tverts->at(0,$i1,$j),$tverts->at(1,$i1,$j));
glVertex2f($tverts->at(0,$i1,$j1),$tverts->at(1,$i1,$j1)); glVertex2f($tverts->at(0,$i1,$j1),$tverts->at(1,$i1,$j1));
glVertex2f($tverts->at(0,$i1,$j1),$tverts->at(1,$i1,$j1)); glVertex2f($tverts->at(0,$i1,$j1),$tverts->at(1,$i1,$j1));
glVertex2f($tverts->at(0,$i,$j1),$tverts->at(1,$i,$j1)); glVertex2f($tverts->at(0,$i,$j1),$tverts->at(1,$i,$j1));
glVertex2f($tverts->at(0,$i,$j1),$tverts->at(1,$i,$j1)); glVertex2f($tverts->at(0,$i,$j1),$tverts->at(1,$i,$j1));
glVertex2f($tverts->at(0,$i,$j),$tverts->at(1,$i,$j)); glVertex2f($tverts->at(0,$i,$j),$tverts->at(1,$i,$j));
} }
glEnd(); glEnd();
} }
glEnable(GL_LIGHTING); glEnable(GL_LIGHTING);
} }
sub PDL::Graphics::TriD::EuclidAxes::togl_axis { sub PDL::Graphics::TriD::EuclidAxes::togl_axis {
my($this,$graph) = @_; my($this,$graph) = @_;
print "togl_axis: got object type " . ref($this) . "\n" if $PDL::Graphic
print "togl_axis: got object type " . ref($this) . "\n" if $PDL::debug_t s::TriD::verbose;
rid;
# print "TOGLAX\n";
my $fontbase = $PDL::Graphics::TriD::GL::fontbase; my $fontbase = $PDL::Graphics::TriD::GL::fontbase;
# print "TOGL EUCLID\n"; glLineWidth(1); # ought to be user defined
glLineWidth(1); # ought to be user defined
glDisable(GL_LIGHTING); glDisable(GL_LIGHTING);
my $ndiv = 4;
my $line_coord = zeroes(3,3)->append(my $id3 = identity(3));
my $starts = zeroes($ndiv+1)->xlinvals(0,1)->transpose->append(zeroes(2,$
ndiv+1));
my $ends = $starts + append(0, ones 2) * -0.1;
my $dupseq = sequence(3)->dummy(0,$ndiv+1)->flat;
$_ = $_->dup(1,3)->rotate($dupseq) for $starts, $ends;
$line_coord = $line_coord->glue(1, $starts->append($ends));
my $axisvals = zeroes(3,$ndiv+1)->ylinvals($this->{Scale}->dog)->transpos
e->flat->transpose;
my @label = map [@$_[0..2], sprintf "%.3f", $_->[3]], @{ $ends->append($a
xisvals)->unpdl };
my $dim = 0; push @label, map [@$_, $this->{Names}[$dim++]], @{ ($id3*1.1
)->unpdl };
glColor3d(1,1,1); glColor3d(1,1,1);
glBegin(GL_LINES); for (@label) {
my $dim; glRasterPos3f(@$_[0..2]);
for $dim (0..2) {
glVertex3f(0,0,0);
&glVertex3f(map {$_==$dim} 0..2);
}
glEnd();
for $dim (0..2) {
my @coords = (0,0,0);
my @coords0 = (0,0,0);
for(0..2) {if($dim != $_) {
$coords[$_] -= 0.1;
}
}
my $s = $this->{Scale}[$dim];
my $ndiv = 3;
my $radd = 1.0/$ndiv;
my $nadd = ($s->[1]-$s->[0])/$ndiv;
my $nc = $s->[0];
for(0..$ndiv) {
&glRasterPos3f(@coords);
if ( done_glutInit() ) {
glutBitmapString($fontbase, sprintf("%.3f",$nc));
} else {
OpenGL::glpPrintString($fontbase, sprintf("%.3f",$nc))
;
}
glBegin(GL_LINES);
&glVertex3f(@coords0);
&glVertex3f(@coords);
glEnd();
# print "PUT: $nc\n";
$coords[$dim] += $radd;
$coords0[$dim] += $radd;
$nc += $nadd;
}
$coords0[$dim] = 1.1;
&glRasterPos3f(@coords0);
if ( done_glutInit() ) { if ( done_glutInit() ) {
glutBitmapString($fontbase, $this->{Names}[$dim]); glutBitmapString($fontbase, $_->[3]);
} else { } else {
OpenGL::glpPrintString($fontbase, $this->{Names}[$dim]); OpenGL::glpPrintString($fontbase, $_->[3]);
} }
} }
PDL::gl_lines_nc($line_coord->splitdim(0,3)->clump(1,2));
glEnable(GL_LIGHTING); glEnable(GL_LIGHTING);
} }
use POSIX qw//; use POSIX qw//;
sub PDL::Graphics::TriD::Quaternion::togl { sub PDL::Graphics::TriD::Quaternion::togl {
my($this) = @_; my($this) = @_;
if(abs($this->[0]) == 1) { return ; } if(abs($this->[0]) == 1) { return ; }
if(abs($this->[0]) >= 1) { if(abs($this->[0]) >= 1) {
# die "Unnormalized Quaternion!\n";
$this->normalize_this(); $this->normalize_this();
} }
&glRotatef(2*POSIX::acos($this->[0])/3.14*180, @{$this}[1..3]); glRotatef(2*POSIX::acos($this->[0])/3.14*180, @{$this}[1..3]);
} }
################################## ##################################
# Graph Objects # Graph Objects
#
#
sub PDL::Graphics::TriD::GObject::togl { sub PDL::Graphics::TriD::GObject::togl {
$_[0]->gdraw($_[0]->{Points}); $_[0]->gdraw($_[0]->{Points});
} }
# (this,graphs,points) # (this,graphs,points)
sub PDL::Graphics::TriD::GObject::togl_graph { sub PDL::Graphics::TriD::GObject::togl_graph {
# print "TOGLGRAPH: $_[0]\n";
$_[0]->gdraw($_[2]); $_[0]->gdraw($_[2]);
} }
sub PDL::Graphics::TriD::Points::gdraw { sub PDL::Graphics::TriD::Points::gdraw {
my($this,$points) = @_; my($this,$points) = @_;
# print "DRAWPOINTS: \n",$points;
$this->glOptions(); $this->glOptions();
glDisable(GL_LIGHTING); glDisable(GL_LIGHTING);
PDL::gl_points($points,$this->{Colors}); PDL::gl_points_col($points,$this->{Colors});
glEnable(GL_LIGHTING); glEnable(GL_LIGHTING);
} }
sub PDL::gl_spheres { sub PDL::gl_spheres {
my ($coords,$colors) = @_; my ($coords,$colors) = @_;
for (my $np=0; $np<$coords->dim(1); $np++) { for (my $np=0; $np<$coords->dim(1); $np++) {
glPushMatrix(); glPushMatrix();
my ($x,$y,$z) = ($coords->slice(":,($np)"))->float->list; my ($x,$y,$z) = ($coords->slice(":,($np)"))->float->list;
glTranslatef($x,$y,$z); glTranslatef($x,$y,$z);
glutSolidSphere(0.025,15,15); glutSolidSphere(0.025,15,15);
skipping to change at line 306 skipping to change at line 245
sub PDL::Graphics::TriD::Spheres::gdraw { sub PDL::Graphics::TriD::Spheres::gdraw {
my($this,$points) = @_; my($this,$points) = @_;
$this->glOptions(); $this->glOptions();
glShadeModel(GL_SMOOTH); glShadeModel(GL_SMOOTH);
PDL::gl_spheres($points,$this->{Colors}); PDL::gl_spheres($points,$this->{Colors});
} }
sub PDL::Graphics::TriD::Lattice::gdraw { sub PDL::Graphics::TriD::Lattice::gdraw {
my($this,$points) = @_; my($this,$points) = @_;
$this->glOptions(); $this->glOptions();
glDisable(GL_LIGHTING); glDisable(GL_LIGHTING);
PDL::gl_line_strip($points,$this->{Colors}); PDL::gl_line_strip_col($points,$this->{Colors});
PDL::gl_line_strip($points->xchg(1,2),$this->{Colors}->xchg(1,2)); PDL::gl_line_strip_col($points->xchg(1,2),$this->{Colors}->xchg(1,2));
glEnable(GL_LIGHTING); glEnable(GL_LIGHTING);
} }
sub PDL::Graphics::TriD::LineStrip::gdraw { sub PDL::Graphics::TriD::LineStrip::gdraw {
my($this,$points) = @_; my($this,$points) = @_;
$this->glOptions(); $this->glOptions();
glDisable(GL_LIGHTING); glDisable(GL_LIGHTING);
PDL::gl_line_strip($points,$this->{Colors}); PDL::gl_line_strip_col($points,$this->{Colors});
glEnable(GL_LIGHTING); glEnable(GL_LIGHTING);
} }
sub PDL::Graphics::TriD::Lines::gdraw { sub PDL::Graphics::TriD::Lines::gdraw {
my($this,$points) = @_; my($this,$points) = @_;
$this->glOptions(); $this->glOptions();
glDisable(GL_LIGHTING); glDisable(GL_LIGHTING);
PDL::gl_lines($points,$this->{Colors}); PDL::gl_lines_col($points,$this->{Colors});
glEnable(GL_LIGHTING); glEnable(GL_LIGHTING);
} }
sub PDL::Graphics::TriD::GObject::glOptions { sub PDL::Graphics::TriD::GObject::glOptions {
my ($this) = @_; my ($this) = @_;
glLineWidth($this->{Options}{LineWidth} || 1);
if($this->{Options}{LineWidth}){ glPointSize($this->{Options}{PointSize} || 1);
glLineWidth($this->{Options}{LineWidth});
}else{
glLineWidth(1);
}
if($this->{Options}{PointSize}){
glPointSize($this->{Options}{PointSize});
}else{
glPointSize(1);
}
} }
sub PDL::Graphics::TriD::Contours::gdraw { sub PDL::Graphics::TriD::Contours::gdraw {
my($this,$points) = @_; my($this,$points) = @_;
$this->glOptions(); $this->glOptions();
glDisable(GL_LIGHTING); glDisable(GL_LIGHTING);
my $pcnt=0; my $pcnt=0;
my $i=0; my $i=0;
foreach (grep defined, @{$this->{ContourSegCnt}}){
foreach(@{$this->{ContourSegCnt}}){ my $colors = $this->{Colors};
my $colors; $colors = $colors->slice(":,($i)") if $colors->getndims==2;
if($this->{Colors}->getndims==2){ PDL::gl_lines_col($points->slice(":,$pcnt:$_"),$colors);
$colors = $this->{Colors}->slice(":,($i)"); $i++;
}else{ $pcnt=$_+1;
$colors = $this->{Colors};
}
next unless(defined $_);
PDL::gl_lines($points->slice(":,$pcnt:$_"),$colors);
$i++;
$pcnt=$_+1;
} }
if(defined $this->{Labels}){ if(defined $this->{Labels}){
glColor3d(1,1,1); glColor3d(1,1,1);
my $seg = sprintf(":,%d:%d",$this->{Labels}[0],$this->{Labels}[1]); my $seg = sprintf(":,%d:%d",$this->{Labels}[0],$this->{Labels}[1]);
PDL::Graphics::OpenGLQ::gl_texts($points->slice($seg), PDL::Graphics::OpenGLQ::gl_texts($points->slice($seg),
$this->{Options}{Font}
$this->{Options}{Font} ,$this->{LabelStrings});
,$this->{LabelStrings});
} }
glEnable(GL_LIGHTING); glEnable(GL_LIGHTING);
} }
sub PDL::Graphics::TriD::SLattice::gdraw { sub PDL::Graphics::TriD::SLattice::gdraw {
my($this,$points) = @_; my($this,$points) = @_;
$this->glOptions(); $this->glOptions();
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT); glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
glDisable(GL_LIGHTING); glDisable(GL_LIGHTING);
# By-vertex doesn't make sense otherwise. # By-vertex doesn't make sense otherwise.
glShadeModel (GL_SMOOTH); glShadeModel (GL_SMOOTH);
my @sls1 = (":,0:-2,0:-2", my @sls1 = (":,0:-2,0:-2",
":,1:-1,0:-2", ":,1:-1,0:-2",
":,0:-2,1:-1"); ":,0:-2,1:-1");
my @sls2 = (":,1:-1,1:-1", my @sls2 = (":,1:-1,1:-1",
":,0:-2,1:-1", ":,0:-2,1:-1",
":,1:-1,0:-2" ":,1:-1,0:-2"
); );
PDL::gl_triangles( PDL::gl_triangles(
(map {$points->slice($_)} @sls1), (map {$points->slice($_)} @sls1),
(map {$this->{Colors}->slice($_)} @sls1) (map {$this->{Colors}->slice($_)} @sls1)
); );
PDL::gl_triangles( PDL::gl_triangles(
(map {$points->slice($_)} @sls2), (map {$points->slice($_)} @sls2),
(map {$this->{Colors}->slice($_)} @sls2) (map {$this->{Colors}->slice($_)} @sls2)
); );
if ($this->{Options}{Lines}) { if ($this->{Options}{Lines}) {
my $black = PDL->pdl(0,0,0)->dummy(1)->dummy(1); glColor3f(0,0,0);
PDL::gl_line_strip($points,$black); PDL::gl_line_strip_nc($points);
PDL::gl_line_strip($points->xchg(1,2),$black); PDL::gl_line_strip_nc($points->xchg(1,2));
} }
glPopAttrib(); glPopAttrib();
} }
sub PDL::Graphics::TriD::SCLattice::gdraw { sub PDL::Graphics::TriD::SCLattice::gdraw {
my($this,$points) = @_; my($this,$points) = @_;
$this->glOptions(); $this->glOptions();
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT); glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
glDisable(GL_LIGHTING); glDisable(GL_LIGHTING);
# By-vertex doesn't make sense otherwise. # By-vertex doesn't make sense otherwise.
glShadeModel (GL_FLAT); glShadeModel(GL_FLAT);
my @sls1 = (":,0:-2,0:-2", my @sls1 = (":,0:-2,0:-2",
":,1:-1,0:-2", ":,1:-1,0:-2",
":,0:-2,1:-1"); ":,0:-2,1:-1");
my @sls2 = (":,1:-1,1:-1", my @sls2 = (":,1:-1,1:-1",
":,0:-2,1:-1", ":,0:-2,1:-1",
":,1:-1,0:-2" ":,1:-1,0:-2"
); );
PDL::gl_triangles( PDL::gl_triangles(
(map {$points->slice($_)} @sls1), (map {$points->slice($_)} @sls1),
(map {$this->{Colors}} @sls1) (map {$this->{Colors}} @sls1)
); );
PDL::gl_triangles( PDL::gl_triangles(
(map {$points->slice($_)} @sls2), (map {$points->slice($_)} @sls2),
(map {$this->{Colors}} @sls2) (map {$this->{Colors}} @sls2)
); );
if ($this->{Options}{Lines}) { if ($this->{Options}{Lines}) {
my $black = PDL->pdl(0,0,0)->dummy(1)->dummy(1); glColor3f(0,0,0);
PDL::gl_line_strip($points,$black); PDL::gl_line_strip_nc($points);
PDL::gl_line_strip($points->xchg(1,2),$black); PDL::gl_line_strip_nc($points->xchg(1,2));
} }
glPopAttrib(); glPopAttrib();
} }
sub PDL::Graphics::TriD::SLattice_S::gdraw { sub PDL::Graphics::TriD::SLattice_S::gdraw {
my($this,$points) = @_; my($this,$points) = @_;
$this->glOptions(); $this->glOptions();
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT); glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
# For some reason, we need to set this here as well. # For some reason, we need to set this here as well.
glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE); glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE);
# By-vertex doesn't make sense otherwise. # By-vertex doesn't make sense otherwise.
glShadeModel (GL_SMOOTH); glShadeModel (GL_SMOOTH);
my @sls1 = (":,0:-2,0:-2", my @sls1 = (":,0:-2,0:-2",
":,1:-1,0:-2", ":,1:-1,0:-2",
":,0:-2,1:-1"); ":,0:-2,1:-1");
my @sls2 = (":,1:-1,1:-1", my @sls2 = (":,1:-1,1:-1",
":,0:-2,1:-1", ":,0:-2,1:-1",
skipping to change at line 492 skipping to change at line 402
(map {$points->slice($_)} @sls1), (map {$points->slice($_)} @sls1),
(map {$this->{Colors}->slice($_)} @sls1) (map {$this->{Colors}->slice($_)} @sls1)
); );
&$f( &$f(
(map {$points->slice($_)} @sls2), (map {$points->slice($_)} @sls2),
(map {$this->{Colors}->slice($_)} @sls2) (map {$this->{Colors}->slice($_)} @sls2)
); );
} }
glDisable(GL_LIGHTING); glDisable(GL_LIGHTING);
if ($this->{Options}{Lines}) { if ($this->{Options}{Lines}) {
my $black = PDL->pdl(0,0,0)->dummy(1)->dummy(1); glColor3f(0,0,0);
PDL::gl_line_strip($points,$black); PDL::gl_line_strip_nc($points);
PDL::gl_line_strip($points->xchg(1,2),$black); PDL::gl_line_strip_nc($points->xchg(1,2));
} }
glPopAttrib(); glPopAttrib();
} }
####################################################################
################### JNK 15mar11 added section start ################
sub PDL::Graphics::TriD::STrigrid_S::gdraw { sub PDL::Graphics::TriD::STrigrid_S::gdraw {
my($this,$points) = @_; my($this,$points) = @_;
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT); glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
# For some reason, we need to set this here as well. # For some reason, we need to set this here as well.
glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE); glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE);
# By-vertex doesn't make sense otherwise. # By-vertex doesn't make sense otherwise.
glShadeModel (GL_SMOOTH); glShadeModel(GL_SMOOTH);
my @sls = (":,(0)",":,(1)",":,(2)"); my @sls = (":,(0)",":,(1)",":,(2)");
my $idx = [0,1,2,0]; # for lines, below my $idx = [0,1,2,0]; # for lines, below
if ($this->{Options}{Smooth}) { if ($this->{Options}{Smooth}) {
$this->{Normals}=$this->smoothn($this->{Points}) $this->{Normals} //= $this->smoothn($this->{Points});
unless defined($this->{Normals});
my $f=(!$this->{Options}{Material}?\&PDL::gl_triangles_wn my $f=(!$this->{Options}{Material}?\&PDL::gl_triangles_wn
:\&PDL::gl_triangles_wn_mat); :\&PDL::gl_triangles_wn_mat);
my $tmpn=$this->{Normals}->dice_axis(1,$this->{Faceidx}->clump(-1)) my $tmpn=$this->{Normals}->dice_axis(1,$this->{Faceidx}->clump(-1))
->splitdim(1,($this->{Faceidx}->dims)[0]); ->splitdim(1,($this->{Faceidx}->dims)[0]);
my @args=((map {$this->{Faces}->slice($_)} @sls), # faces is a slice of po ints my @args=((map {$this->{Faces}->slice($_)} @sls), # faces is a slice of po ints
(map {$tmpn->slice($_)} @sls), (map {$tmpn->slice($_)} @sls),
(map {$this->{Colors}->slice($_)} @sls) );&$f(@args); } (map {$this->{Colors}->slice($_)} @sls) );&$f(@args);
else { } else {
my $f=(!$this->{Options}{Material}?\&PDL::gl_triangles_n my $f=(!$this->{Options}{Material}?\&PDL::gl_triangles_n
:\&PDL::gl_triangles_n_mat); :\&PDL::gl_triangles_n_mat);
&$f( (map {$this->{Faces}->slice($_)} @sls), # faces is a slice of points &$f( (map {$this->{Faces}->slice($_)} @sls), # faces is a slice of points
(map {$this->{Colors}->slice($_)} @sls) ); } (map {$this->{Colors}->slice($_)} @sls) );
}
glDisable(GL_LIGHTING); glDisable(GL_LIGHTING);
if ($this->{Options}{Lines}) { if ($this->{Options}{Lines}) {
my $black = PDL->pdl(0,0,0)->dummy(1)->dummy(1); glColor3f(0,0,0);
PDL::gl_lines($this->{Faces}->dice_axis(1,$idx),$black); } glPopAttrib(); } PDL::gl_lines_nc($this->{Faces}->dice_axis(1,$idx));
}
glPopAttrib();
}
sub PDL::Graphics::TriD::STrigrid::gdraw { sub PDL::Graphics::TriD::STrigrid::gdraw {
my($this,$points) = @_; my($this,$points) = @_;
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT); glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
glDisable(GL_LIGHTING); glDisable(GL_LIGHTING);
# By-vertex doesn't make sense otherwise. # By-vertex doesn't make sense otherwise.
glShadeModel (GL_SMOOTH); glShadeModel (GL_SMOOTH);
my @sls = (":,(0)",":,(1)",":,(2)"); my @sls = (":,(0)",":,(1)",":,(2)");
my $idx = [0,1,2,0]; my $idx = [0,1,2,0];
PDL::gl_triangles( PDL::gl_triangles(
(map {$this->{Faces}->slice($_)} @sls), # faces is a slice of points (map {$this->{Faces}->slice($_)} @sls), # faces is a slice of points
(map {$this->{Colors}->slice($_)} @sls)); (map {$this->{Colors}->slice($_)} @sls));
if ($this->{Options}{Lines}) { if ($this->{Options}{Lines}) {
my $black = PDL->pdl(0,0,0)->dummy(1)->dummy(1); glColor3f(0,0,0);
PDL::gl_lines($this->{Faces}->dice_axis(1,$idx),$black); } PDL::gl_lines_nc($this->{Faces}->dice_axis(1,$idx));
glPopAttrib(); } }
################### JNK 15mar11 added section finis ################ glPopAttrib();
#################################################################### }
################################## ##################################
# PDL::Graphics::TriD::Image # PDL::Graphics::TriD::Image
#
#
sub PDL::Graphics::TriD::Image::togl { sub PDL::Graphics::TriD::Image::togl {
# glDisable(GL_LIGHTING);
#
# A special construct which always faces the display and takes the entire window # A special construct which always faces the display and takes the entire window
#
glMatrixMode(GL_MODELVIEW); glMatrixMode(GL_MODELVIEW);
glLoadIdentity(); glLoadIdentity();
glMatrixMode(GL_PROJECTION); glMatrixMode(GL_PROJECTION);
glLoadIdentity(); glLoadIdentity();
gluOrtho2D(0,1,0,1); gluOrtho2D(0,1,0,1);
&PDL::Graphics::TriD::Image::togl_graph; &PDL::Graphics::TriD::Image::togl_graph;
} }
sub PDL::Graphics::TriD::Image::togl_graph { sub PDL::Graphics::TriD::Image::togl_graph {
$_[0]->gdraw(); $_[0]->gdraw();
} }
# The quick method is to use texturing for the good effect. # The quick method is to use texturing for the good effect.
sub PDL::Graphics::TriD::Image::gdraw { sub PDL::Graphics::TriD::Image::gdraw {
my($this,$vert) = @_; my($this,$vert) = @_;
my ($p,$xd,$yd,$txd,$tyd) = $this->flatten(1); # do binary alignment my ($p,$xd,$yd,$txd,$tyd) = $this->flatten(1); # do binary alignment
glColor3d(1,1,1); glColor3d(1,1,1);
glTexImage2D_s(GL_TEXTURE_2D, 0, GL_RGB, $txd, $tyd, 0, GL_RGB, GL_FLOA T, $p->get_dataref()); glTexImage2D_s(GL_TEXTURE_2D, 0, GL_RGB, $txd, $tyd, 0, GL_RGB, GL_FLOA T, $p->get_dataref());
glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST ); glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST );
glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST ); glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST );
glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT ); glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT );
glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT ); glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT );
glDisable(GL_LIGHTING); glDisable(GL_LIGHTING);
glNormal3d(0,0,1); glNormal3d(0,0,1);
glEnable(GL_TEXTURE_2D); glEnable(GL_TEXTURE_2D);
glBegin(GL_QUADS); glBegin(GL_QUADS);
my @texvert = ( my @texvert = (
[0,0], [0,0],
[$xd/$txd, 0], [$xd/$txd, 0],
[$xd/$txd, $yd/$tyd], [$xd/$txd, $yd/$tyd],
[0, $yd/$tyd] [0, $yd/$tyd]
); );
if(!defined $vert) {$vert = $this->{Points}} if(!defined $vert) {$vert = $this->{Points}}
for(0..3) { for(0..3) {
&glTexCoord2f(@{$texvert[$_]}); glTexCoord2f(@{$texvert[$_]});
&glVertex3f($vert->slice(":,($_)")->list); glVertex3f($vert->slice(":,($_)")->list);
} }
glEnd(); glEnd();
glEnable(GL_LIGHTING); glEnable(GL_LIGHTING);
glDisable(GL_TEXTURE_2D); glDisable(GL_TEXTURE_2D);
} }
sub PDL::Graphics::TriD::SimpleController::togl { sub PDL::Graphics::TriD::SimpleController::togl {
my($this) = @_; my($this) = @_;
$this->{CRotation}->togl(); $this->{CRotation}->togl();
glTranslatef(0,0,-$this->{CDistance}); glTranslatef(0,0,-$this->{CDistance});
$this->{WRotation}->togl(); $this->{WRotation}->togl();
&glTranslatef(map {-$_} @{$this->{WOrigin}}); glTranslatef(map {-$_} @{$this->{WOrigin}});
} }
############################################## ##############################################
#
# A window with mouse control over rotation. # A window with mouse control over rotation.
#
#
package PDL::Graphics::TriD::Window; package PDL::Graphics::TriD::Window;
use OpenGL qw/ :glfunctions :glconstants :glxconstants /; use OpenGL qw/ :glfunctions :glconstants :glxconstants /;
use OpenGL::GLUT qw( :all ); use OpenGL::GLUT qw( :all );
use PDL::Graphics::OpenGL::Perl::OpenGL; use PDL::Graphics::OpenGL::Perl::OpenGL;
use base qw/PDL::Graphics::TriD::Object/; use base qw/PDL::Graphics::TriD::Object/;
use fields qw/Ev Width Height Interactive _GLObject use fields qw/Ev Width Height Interactive _GLObject
_ViewPorts _CurrentViewPort /; _ViewPorts _CurrentViewPort /;
sub i_keep_list {return 1} # For Object, so I will be notified of changes. sub i_keep_list {return 1} # For Object, so I will be notified of changes.
use strict; use strict;
sub gdriver { sub gdriver {
my($this, $options) = @_; my($this, $options) = @_;
print "GL gdriver...\n" if($PDL::Graphics::TriD::verbose);
print "GL gdriver...\n" if($PDL::debug_trid);
if(defined $this->{_GLObject}){ if(defined $this->{_GLObject}){
print "WARNING: Graphics Driver already defined for this window \n"; print "WARNING: Graphics Driver already defined for this window \n";
return; return;
} }
my @db = OpenGL::GLX_DOUBLEBUFFER; my @db = OpenGL::GLX_DOUBLEBUFFER;
if($PDL::Graphics::TriD::offline) {$options->{x} = -1; @db=()} if($PDL::Graphics::TriD::offline) {$options->{x} = -1; @db=()}
$options->{attributes} = [GLX_RGBA, @db, $options->{attributes} = [GLX_RGBA, @db,
GLX_RED_SIZE,1, GLX_RED_SIZE,1,
GLX_GREEN_SIZE,1, GLX_GREEN_SIZE,1,
GLX_BLUE_SIZE,1, GLX_BLUE_SIZE,1,
GLX_DEPTH_SIZE,1, GLX_DEPTH_SIZE,1,
# Alpha size? # Alpha size?
] unless defined $options->{attributes}; ] unless defined $options->{attributes};
$options->{mask} = (KeyPressMask | ButtonPressMask | $options->{mask} = (KeyPressMask | ButtonPressMask |
ButtonMotionMask | ButtonReleaseMask | ButtonMotionMask | ButtonReleaseMask |
ExposureMask | StructureNotifyMask | ExposureMask | StructureNotifyMask |
PointerMotionMask) unless defined $options->{mask}; PointerMotionMask) unless defined $options->{mask};
print "STARTING OPENGL $options->{width} $options->{height}\n" if($PDL::Graphi cs::TriD::verbose); print "STARTING OPENGL $options->{width} $options->{height}\n" if($PDL::Graphi cs::TriD::verbose);
print "gdriver: Calling OpengGL::OO($options)...\n" if ($PDL::Graphics::TriD::
print "gdriver: Calling OpengGL::OO($options)...\n" if ($PDL::debug_trid); verbose);
$this->{_GLObject}= new PDL::Graphics::OpenGL::OO($options); $this->{_GLObject}= new PDL::Graphics::OpenGL::OO($options);
if (exists $this->{_GLObject}->{glutwindow}) { if (exists $this->{_GLObject}->{glutwindow}) {
if ($PDL::debug_trid) { if ($PDL::Graphics::TriD::verbose) {
print "gdriver: Got OpenGL::OO object(GLUT window ID# " . $this->{_GLObj ect}->{glutwindow} . ")\n"; print "gdriver: Got OpenGL::OO object(GLUT window ID# " . $this->{_GLObj ect}->{glutwindow} . ")\n";
} }
$this->{_GLObject}->{winobjects}->[$this->{_GLObject}->{glutwindow}] = $thi s; # circular ref $this->{_GLObject}->{winobjects}->[$this->{_GLObject}->{glutwindow}] = $thi s; # circular ref
} }
print "gdriver: Calling glClearColor...\n" if ($PDL::Graphics::TriD::verbose);
#glpOpenWindow(%$options);
print "gdriver: Calling glClearColor...\n" if ($PDL::debug_trid);
glClearColor(0,0,0,1); glClearColor(0,0,0,1);
print "gdriver: Calling glpRasterFont...\n" if ($PDL::Graphics::TriD::verbose)
print "gdriver: Calling glpRasterFont...\n" if ($PDL::debug_trid); ;
if ( $this->{_GLObject}->{window_type} eq 'glut' ) { if ( $this->{_GLObject}->{window_type} eq 'glut' ) {
print STDERR "gdriver: window_type => 'glut' so not actually setting the ra sterfont\n" if ($PDL::debug_trid); print STDERR "gdriver: window_type => 'glut' so not actually setting the ra sterfont\n" if ($PDL::Graphics::TriD::verbose);
eval '$PDL::Graphics::TriD::GL::fontbase = GLUT_BITMAP_8_BY_13'; eval '$PDL::Graphics::TriD::GL::fontbase = GLUT_BITMAP_8_BY_13';
} else { } else {
# NOTE: glpRasterFont() will die() if the requested font cannot be found # NOTE: glpRasterFont() will die() if the requested font cannot be found
# The new POGL+GLUT TriD implementation uses the builtin GLUT defined # The new POGL+GLUT TriD implementation uses the builtin GLUT defined
# fonts and does not have this failure mode. # fonts and does not have this failure mode.
my $lb = eval { $this->{_GLObject}->glpRasterFont( ($ENV{PDL_3D_FONT} or " 5x8"), 0, 256 ) }; my $lb = eval { $this->{_GLObject}->glpRasterFont( ($ENV{PDL_3D_FONT} or " 5x8"), 0, 256 ) };
if ( $@ ) { if ( $@ ) {
die "glpRasterFont: unable to load font '%s', please set PDL_3D_FONT to an existing X11 font."; die "glpRasterFont: unable to load font '%s', please set PDL_3D_FONT to an existing X11 font.";
} }
$PDL::Graphics::TriD::GL::fontbase = $lb $PDL::Graphics::TriD::GL::fontbase = $lb
} }
# glDisable(GL_DITHER); glShadeModel(GL_FLAT);
glShadeModel (GL_FLAT);
glEnable(GL_DEPTH_TEST); glEnable(GL_DEPTH_TEST);
glEnable(GL_NORMALIZE); glEnable(GL_NORMALIZE);
glEnable(GL_LIGHTING); glEnable(GL_LIGHTING);
glEnable(GL_LIGHT0); glEnable(GL_LIGHT0);
glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE); glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE);
# Will this bring us trouble?
# if(defined *PDL::Graphics::TriD::GL::Window::glPolygonOffsetEXT{CODE}) {
# glEnable(GL_POLYGON_OFFSET_EXT);
# glPolygonOffsetEXT(0.0000000000001,0.000002);
# }
# Inherits attributes of Object class
# my $this = $type->SUPER::new();
# $this->reshape($options->{width},$options->{height});
my $light = pack "f*",1.0,1.0,1.0,0.0; my $light = pack "f*",1.0,1.0,1.0,0.0;
glLightfv_s(GL_LIGHT0,GL_POSITION,$light); glLightfv_s(GL_LIGHT0,GL_POSITION,$light);
glColor3f(1,1,1); glColor3f(1,1,1);
# $this->{Interactive} = 1;
print "STARTED OPENGL!\n" if($PDL::Graphics::TriD::verbose); print "STARTED OPENGL!\n" if($PDL::Graphics::TriD::verbose);
if($PDL::Graphics::TriD::offline) { if($PDL::Graphics::TriD::offline) {
$this->doconfig($options->{width}, $options->{height}); $this->doconfig($options->{width}, $options->{height});
} }
return 1; # Interactive Window return 1; # Interactive Window
} }
sub ev_defaults{ sub ev_defaults{
return { ConfigureNotify => \&doconfig, return { ConfigureNotify => \&doconfig,
MotionNotify => \&domotion, MotionNotify => \&domotion,
} }
} }
sub reshape { sub reshape {
my($this,$x,$y) = @_; my($this,$x,$y) = @_;
my $pw = $this->{Width}; my $pw = $this->{Width};
my $ph = $this->{Height}; my $ph = $this->{Height};
$this->{Width} = $x; $this->{Height} = $y; $this->{Width} = $x; $this->{Height} = $y;
for my $vp (@{$this->{_ViewPorts}}){ for my $vp (@{$this->{_ViewPorts}}){
my $nw = $vp->{W} + ($x-$pw) * $vp->{W}/$pw; my $nw = $vp->{W} + ($x-$pw) * $vp->{W}/$pw;
my $nx0 = $vp->{X0} + ($x-$pw) * $vp->{X0}/$pw; my $nx0 = $vp->{X0} + ($x-$pw) * $vp->{X0}/$pw;
my $nh = $vp->{H} + ($y-$ph) * $vp->{H}/$ph; my $nh = $vp->{H} + ($y-$ph) * $vp->{H}/$ph;
my $ny0 = $vp->{Y0} + ($y-$ph) * $vp->{Y0}/$ph; my $ny0 = $vp->{Y0} + ($y-$ph) * $vp->{Y0}/$ph;
print "reshape: resizing viewport to $nx0,$ny0,$nw,$nh\n" if($PDL::Grap hics::TriD::verbose); print "reshape: resizing viewport to $nx0,$ny0,$nw,$nh\n" if($PDL::Grap hics::TriD::verbose);
$vp->resize($nx0,$ny0,$nw,$nh); $vp->resize($nx0,$ny0,$nw,$nh);
} }
} }
sub get_size { sub get_size {
my $this=shift; my $this=shift;
return ($this->{Width},$this->{Height}); return ($this->{Width},$this->{Height});
} }
sub twiddle { sub twiddle {
my($this,$getout,$dontshow) = @_; my($this,$getout,$dontshow) = @_;
my (@e); my (@e);
my $quit; my $quit;
if($PDL::Graphics::TriD::offline) { if($PDL::Graphics::TriD::offline) {
$PDL::Graphics::TriD::offlineindex ++; $PDL::Graphics::TriD::offlineindex ++;
$this->display(); $this->display();
require PDL::IO::Pic; require PDL::IO::Pic;
wpic($this->read_picture(),"PDL_$PDL::Graphics::TriD::offlineindex.jpg") ; wpic($this->read_picture(),"PDL_$PDL::Graphics::TriD::offlineindex.jpg") ;
return; return;
} }
if ($getout and $dontshow) { return if $getout and $dontshow and !$this->{_GLObject}->XPending;
if ( !$this->{_GLObject}->XPending() ) { $getout //= !($PDL::Graphics::TriD::keeptwiddling && $PDL::Graphics::TriD::kee
return; ptwiddling);
}
}
if(!defined $getout) {
$getout = not ($PDL::Graphics::TriD::keeptwiddling && $PDL::Graphics::Tr
iD::keeptwiddling);
}
$this->display(); $this->display();
TWIDLOOP: while(1) { TWIDLOOP: while(1) {
print "EVENT!\n" if($PDL::Graphics::TriD::verbose); print "EVENT!\n" if($PDL::Graphics::TriD::verbose);
my $hap = 0; my $hap = 0;
my $gotev = 0; my $gotev = 0;
# Run a MainLoop event if GLUT windows # Run a MainLoop event if GLUT windows
# this pumps the system allowing callbacks to populate # this pumps the system allowing callbacks to populate
# the fake XEvent queue. # the fake XEvent queue.
# #
glutMainLoopEvent() if $this->{_GLObject}->{window_type} eq 'glut' and not $this->{_GLObject}->XPending(); glutMainLoopEvent() if $this->{_GLObject}->{window_type} eq 'glut' and not $this->{_GLObject}->XPending();
if ($this->{_GLObject}->XPending() or !$getout) { if ($this->{_GLObject}->XPending() or !$getout) {
@e = $this->{_GLObject}->glpXNextEvent(); @e = $this->{_GLObject}->glpXNextEvent();
$gotev=1; $gotev=1;
} }
print "e= ".join(",",@e)."\n" if($PDL::Graphics::TriD::verbose); print "e= ".join(",",@e)."\n" if($PDL::Graphics::TriD::verbose);
if(@e){ if(@e){
if ($e[0] == VisibilityNotify || $e[0] == Expose) { if ($e[0] == VisibilityNotify || $e[0] == Expose) {
$hap = 1; $hap = 1;
} elsif ($e[0] == ConfigureNotify) { } elsif ($e[0] == ConfigureNotify) {
print "CONFIGNOTIFE\n" if($PDL::Graphics::TriD::verbose); print "CONFIGNOTIFE\n" if($PDL::Graphics::TriD::verbose);
$this->reshape($e[1],$e[2]); $this->reshape($e[1],$e[2]);
$hap=1; $hap=1;
} elsif ($e[0] == DestroyNotify) { } elsif ($e[0] == DestroyNotify) {
print "DESTROYNOTIFE\n" if $PDL::Graphics::TriD::verbose; print "DESTROYNOTIFE\n" if $PDL::Graphics::TriD::verbose;
$quit = 1; $quit = 1;
$hap=1; $hap=1;
undef $this->{_GLObject}; $this->close;
$PDL::Graphics::TriD::cur = $PDL::Graphics::TriD::current_windo
w = undef;
last TWIDLOOP; last TWIDLOOP;
} elsif($e[0] == KeyPress) { } elsif($e[0] == KeyPress) {
print "KEYPRESS: '$e[1]'\n" if($PDL::Graphics::TriD::verbose); print "KEYPRESS: '$e[1]'\n" if($PDL::Graphics::TriD::verbose);
if((lc $e[1]) eq "q") { if((lc $e[1]) eq "q") {
$quit = 1; $quit = 1;
} }
if((lc $e[1]) eq "c") { if((lc $e[1]) eq "c") {
$quit = 2; $quit = 2;
} }
if((lc $e[1]) eq "q" and not $getout) { if((lc $e[1]) eq "q" and not $getout) {
last TWIDLOOP; last TWIDLOOP;
} }
$hap=1; $hap=1;
} }
} }
if($gotev){ if($gotev){
# print "HANDLING $this->{EHandler}\n"; # print "HANDLING $this->{EHandler}\n";
foreach my $vp (@{$this->{_ViewPorts}}) { foreach my $vp (@{$this->{_ViewPorts}}) {
if(defined($vp->{EHandler})) { if(defined($vp->{EHandler})) {
$hap += $vp->{EHandler}->event(@e) || 0; $hap += $vp->{EHandler}->event(@e) || 0;
} }
} }
} }
if(! $this->{_GLObject}->XPending()) { if(! $this->{_GLObject}->XPending()) {
if($hap) { if($hap) {
$this->display(); $this->display();
} }
if($getout) {last TWIDLOOP} if($getout) {last TWIDLOOP}
} }
@e = (); @e = ();
} }
print "STOPTWIDDLE\n" if($PDL::Graphics::TriD::verbose); print "STOPTWIDDLE\n" if($PDL::Graphics::TriD::verbose);
return $quit; return $quit;
} }
sub close {
my ($this, $close_window) = @_;
print "CLOSE\n" if $PDL::Graphics::TriD::verbose;
undef $this->{_GLObject};
$PDL::Graphics::TriD::current_window = undef;
}
sub setlist { my($this,$list) = @_; sub setlist { my($this,$list) = @_;
$this->{List} = $list; $this->{List} = $list;
} }
# Resize window. # Resize window.
sub doconfig { sub doconfig {
my($this,$x,$y) = @_; my($this,$x,$y) = @_;
$this->reshape($x,$y); $this->reshape($x,$y);
print "CONFIGURENOTIFY\n" if($PDL::Graphics::TriD::verbose); print "CONFIGURENOTIFY\n" if($PDL::Graphics::TriD::verbose);
} }
sub domotion { sub domotion {
my($this) = @_; my($this) = @_;
print "MOTIONENOTIFY\n" if($PDL::Graphics::TriD::verbose); print "MOTIONENOTIFY\n" if($PDL::Graphics::TriD::verbose);
} }
sub display { sub display {
my($this) = @_; my($this) = @_;
return unless defined($this); return unless defined($this);
# set GLUT context to current window (for multiwindow support)
# set GLUT context to current window (for multiwindow support
if ( $this->{_GLObject}->{window_type} eq 'glut' ) { if ( $this->{_GLObject}->{window_type} eq 'glut' ) {
glutSetWindow($this->{_GLObject}->{glutwindow}); glutSetWindow($this->{_GLObject}->{glutwindow});
} }
print "display: calling glClear()\n" if ($PDL::Graphics::TriD::verbose); print "display: calling glClear()\n" if ($PDL::Graphics::TriD::verbose);
glClear(GL_COLOR_BUFFER_BIT|GL_DEPTH_BUFFER_BIT); glClear(GL_COLOR_BUFFER_BIT|GL_DEPTH_BUFFER_BIT);
glMatrixMode(GL_MODELVIEW); glMatrixMode(GL_MODELVIEW);
for my $vp (@{$this->{_ViewPorts}}) { for my $vp (@{$this->{_ViewPorts}}) {
glPushMatrix(); glPushMatrix();
$vp->do_perspective(); $vp->do_perspective();
if($vp->{Transformer}) { if($vp->{Transformer}) {
print "display: transforming viewport!\n" if ($PDL::Graphics::Tri D::verbose); print "display: transforming viewport!\n" if ($PDL::Graphics::Tri D::verbose);
$vp->{Transformer}->togl(); $vp->{Transformer}->togl();
} }
glTranslatef(-1,-1,-1);
glScalef(2,2,2); # double the scale in each direction ?
$vp->gl_call_list(); $vp->gl_call_list();
glPopMatrix(); glPopMatrix();
} }
print "display: SwapBuffers() call on return\n" if ($PDL::Graphics::TriD::verb ose); print "display: SwapBuffers() call on return\n" if ($PDL::Graphics::TriD::verb ose);
if ( $this->{_GLObject}->{window_type} eq 'glut' ) { # need to make method ca ll if ( $this->{_GLObject}->{window_type} eq 'glut' ) { # need to make method ca ll
glutSwapBuffers(); glutSwapBuffers();
} elsif ( $this->{_GLObject}->{window_type} eq 'x11' ) { # need to make metho d call } elsif ( $this->{_GLObject}->{window_type} eq 'x11' ) { # need to make metho d call
$this->{_GLObject}->glXSwapBuffers(); $this->{_GLObject}->glXSwapBuffers();
} else { } else {
print "display: got object with inconsistent _GLObject info\n"; print "display: got object with inconsistent _GLObject info\n";
} }
# $this->{Angle}+= 3;
} }
# should this reallyt be in viewport? # should this really be in viewport?
sub read_picture { sub read_picture {
my($this) = @_; my($this) = @_;
my($w,$h) = @{$this}{qw/Width Height/}; my($w,$h) = @{$this}{qw/Width Height/};
my $res = PDL->zeroes(PDL::byte,3,$w,$h); my $res = PDL->zeroes(PDL::byte,3,$w,$h);
glPixelStorei(GL_UNPACK_ALIGNMENT,1); glPixelStorei(GL_UNPACK_ALIGNMENT,1);
glPixelStorei(GL_PACK_ALIGNMENT,1); glPixelStorei(GL_PACK_ALIGNMENT,1);
glReadPixels_s(0,0,$w,$h,GL_RGB,GL_UNSIGNED_BYTE,$res->get_dataref); glReadPixels_s(0,0,$w,$h,GL_RGB,GL_UNSIGNED_BYTE,$res->get_dataref);
return $res; return $res;
} }
skipping to change at line 938 skipping to change at line 784
$self->{X} = -1; $self->{X} = -1;
$self->{Y} = -1; $self->{Y} = -1;
$self->{Buttons} = []; $self->{Buttons} = [];
$self->{VP} = $vp; $self->{VP} = $vp;
$self; $self;
} }
sub event { sub event {
my($this,$type,@args) = @_; my($this,$type,@args) = @_;
print "EH: ",ref($this)," $type (",join(",",@args),")\n" if($PDL::Graphics::Tr iD::verbose); print "EH: ",ref($this)," $type (",join(",",@args),")\n" if($PDL::Graphics::Tr iD::verbose);
my $retval; my $retval;
if($type == MotionNotify) { if($type == MotionNotify) {
my $but = -1; my $but = -1;
SWITCH: { SWITCH: {
$but = 0, last SWITCH if ($args[0] & (Button1Mask)); $but = 0, last SWITCH if ($args[0] & (Button1Mask));
$but = 1, last SWITCH if ($args[0] & (Button2Mask)); $but = 1, last SWITCH if ($args[0] & (Button2Mask));
$but = 2, last SWITCH if ($args[0] & (Button3Mask)); $but = 2, last SWITCH if ($args[0] & (Button3Mask));
print "No button pressed...\n" if($PDL::Graphics::TriD::verbose); print "No button pressed...\n" if($PDL::Graphics::TriD::verbose);
goto NOBUT; goto NOBUT;
} }
print "MOTION $but $args[0]\n" if($PDL::Graphics::TriD::verbose); print "MOTION $but $args[0]\n" if($PDL::Graphics::TriD::verbose);
if($this->{Buttons}[$but]) { if($this->{Buttons}[$but]) {
if($this->{VP}->{Active}){ if($this->{VP}->{Active}){
print "calling ".($this->{Buttons}[$but])."->mouse_moved ($this ->{X},$this->{Y},$args[1],$args[2])...\n" if($PDL::Graphics::TriD::verbose); print "calling ".($this->{Buttons}[$but])."->mouse_moved ($this ->{X},$this->{Y},$args[1],$args[2])...\n" if($PDL::Graphics::TriD::verbose);
$retval = $this->{Buttons}[$but]->mouse_moved( $retval = $this->{Buttons}[$but]->mouse_moved(
$this->{X},$this- >{Y}, $this->{X},$this- >{Y},
$args[1],$args[2] ); $args[1],$args[2] );
} }
} }
$this->{X} = $args[1]; $this->{Y} = $args[2]; $this->{X} = $args[1]; $this->{Y} = $args[2];
NOBUT: NOBUT:
} elsif($type == ButtonPress) { } elsif($type == ButtonPress) {
my $but = $args[0]-1; my $but = $args[0]-1;
print "BUTTONPRESS $but\n" if($PDL::Graphics::TriD::verbose); print "BUTTONPRESS $but\n" if($PDL::Graphics::TriD::verbose);
$this->{X} = $args[1]; $this->{Y} = $args[2]; $this->{X} = $args[1]; $this->{Y} = $args[2];
$retval = $this->{Buttons}[$but]->ButtonPress($args[1],$args[2]) $retval = $this->{Buttons}[$but]->ButtonPress($args[1],$args[2])
if($this->{Buttons}[$but]); if($this->{Buttons}[$but]);
} elsif($type == ButtonRelease) { } elsif($type == ButtonRelease) {
my $but = $args[0]-1; my $but = $args[0]-1;
print "BUTTONRELEASE $but\n" if($PDL::Graphics::TriD::verbose); print "BUTTONRELEASE $but\n" if($PDL::Graphics::TriD::verbose);
$retval = $this->{Buttons}[$but]->ButtonRelease($args[1],$args[2]) $retval = $this->{Buttons}[$but]->ButtonRelease($args[1],$args[2])
if($this->{Buttons}[$but]); if($this->{Buttons}[$but]);
} elsif($type== ConfigureNotify) { } elsif($type== ConfigureNotify) {
# Kludge to force reshape of the viewport associated with the window -CD # Kludge to force reshape of the viewport associated with the window -CD
print "ConfigureNotify (".join(",",@args).")\n" if($PDL::Graphics::TriD: :verbose); print "ConfigureNotify (".join(",",@args).")\n" if($PDL::Graphics::TriD: :verbose);
print "viewport is $this->{VP}\n" if($PDL::Graphics::TriD::verbose); print "viewport is $this->{VP}\n" if($PDL::Graphics::TriD::verbose);
# $retval = $this->reshape(@args);
} }
$retval; $retval;
} }
sub set_button { sub set_button {
my($this,$butno,$act) = @_; my($this,$butno,$act) = @_;
$this->{Buttons}[$butno] = $act; $this->{Buttons}[$butno] = $act;
} }
###################################################################### ######################################################################
skipping to change at line 1012 skipping to change at line 846
use fields qw/X0 Y0 W H Transformer EHandler Active ResizeCommands use fields qw/X0 Y0 W H Transformer EHandler Active ResizeCommands
DefMaterial AspectRatio Graphs/; DefMaterial AspectRatio Graphs/;
use OpenGL qw/ :glfunctions :glconstants :glufunctions /; use OpenGL qw/ :glfunctions :glconstants :glufunctions /;
use OpenGL::GLUT qw( :all ); use OpenGL::GLUT qw( :all );
use PDL::Graphics::OpenGL::Perl::OpenGL; use PDL::Graphics::OpenGL::Perl::OpenGL;
use PDL::Graphics::OpenGLQ; use PDL::Graphics::OpenGLQ;
sub highlight { sub highlight {
my ($vp) = @_; my ($vp) = @_;
my $pts = new PDL [[0,0,0], my $pts = new PDL [[0,0,0],
[$vp->{W},0,0], [$vp->{W},0,0],
[$vp->{W},$vp->{H},0], [$vp->{W},$vp->{H},0],
[0,$vp->{H},0], [0,$vp->{H},0],
[0,0,0]]; [0,0,0]];
my $colors;
$colors = PDL->ones(3,5);
glDisable(GL_LIGHTING); glDisable(GL_LIGHTING);
glMatrixMode(GL_MODELVIEW); glMatrixMode(GL_MODELVIEW);
glLoadIdentity(); glLoadIdentity();
glMatrixMode(GL_PROJECTION); glMatrixMode(GL_PROJECTION);
glLoadIdentity(); glLoadIdentity();
gluOrtho2D(0,$vp->{W},0,$vp->{H}); gluOrtho2D(0,$vp->{W},0,$vp->{H});
glLineWidth(4); glLineWidth(4);
glColor3f(1,1,1);
gl_line_strip($pts,$colors); gl_line_strip_nc($pts);
glLineWidth(1); glLineWidth(1);
glEnable(GL_LIGHTING); glEnable(GL_LIGHTING);
} }
sub do_perspective { sub do_perspective {
my($this) = @_; my($this) = @_;
print "do_perspective ",$this->{W}," ",$this->{H} ,"\n" if($PDL::Graphics ::TriD::verbose); print "do_perspective ",$this->{W}," ",$this->{H} ,"\n" if($PDL::Graphics ::TriD::verbose);
print Carp::longmess() if $PDL::Graphics::TriD::verbose>1;
if($PDL::Graphics::TriD::verbose>1){
my ($i,$package,$filename,$line);
$i = 0;
do {
($package,$filename,$line) = caller($i++);
print "$package ($filename, line $line)\n";
} while($package);
print "\n";
}
unless($this->{W}>0 and $this->{H}>0) {return;} unless($this->{W}>0 and $this->{H}>0) {return;}
# if($this->{W}==0 or $this->{H}==0) {return;}
$this->{AspectRatio} = (1.0*$this->{W})/$this->{H}; $this->{AspectRatio} = (1.0*$this->{W})/$this->{H};
# glResizeBuffers();
glViewport($this->{X0},$this->{Y0},$this->{W},$this->{H}); glViewport($this->{X0},$this->{Y0},$this->{W},$this->{H});
$this->highlight() if($this->{Active}); $this->highlight() if($this->{Active});
glMatrixMode(GL_PROJECTION); glMatrixMode(GL_PROJECTION);
glLoadIdentity(); glLoadIdentity();
gluPerspective(40.0, $this->{AspectRatio} , 0.1, 200000.0); gluPerspective(40.0, $this->{AspectRatio} , 0.1, 200000.0);
glMatrixMode(GL_MODELVIEW); glMatrixMode(GL_MODELVIEW);
glLoadIdentity (); glLoadIdentity ();
} }
############### ###############
# #
# Because of the way GL does texturing, this must be the very last thing # Because of the way GL does texturing, this must be the very last thing
# in the object stack before the actual surface. There must not be any # in the object stack before the actual surface. There must not be any
# transformations after this. # transformations after this.
 End of changes. 139 change blocks. 
296 lines changed or deleted 106 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)