Skip to content

Commit 1189d90

Browse files
mohawk2mohawk2
committed
make Arrows container of Lines and Triangles
1 parent cdb3376 commit 1189d90

File tree

2 files changed

+66
-19
lines changed

2 files changed

+66
-19
lines changed

‎lib/PDL/Graphics/TriD/GL.pm‎

Lines changed: 19 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -188,7 +188,7 @@ sub PDL::Graphics::TriD::Lattice::gdraw {
188188
my $arrows = $points_clumped->append($points_clumped + $this->{VertexNormals}*0.1)->splitdim(0,3)->clump(1,2);
189189
glDisable(GL_LIGHTING);
190190
my ($tv, $ti) = PDL::Graphics::OpenGLQ::gen_arrowheads($arrows,sequence(ulong,2,$points_clumped->dim(1))->t->dog,
191-
0.5, 0.02);
191+
0.5, 0.2);
192192
PDL::gl_triangles($tv->dice_axis(1,$ti)->splitdim(1,3), [1,1,1]);
193193
PDL::gl_lines_col($arrows,[1,1,1]);
194194
}
@@ -197,23 +197,28 @@ sub PDL::Graphics::TriD::Lattice::gdraw {
197197
my $facearrows = $facecentres->append($facecentres + $this->{FaceNormals}*0.1)->splitdim(0,3)->clump(1,2);
198198
glDisable(GL_LIGHTING);
199199
my ($tv, $ti) = PDL::Graphics::OpenGLQ::gen_arrowheads($facearrows,sequence(ulong,2,$facecentres->dim(1))->t->dog,
200-
0.5, 0.02);
200+
0.5, 0.2);
201201
PDL::gl_triangles($tv->dice_axis(1,$ti)->splitdim(1,3), [0.5,0.5,0.5]);
202202
PDL::gl_lines_col($facearrows,[0.5,0.5,0.5]);
203203
}
204204
}
205205
}
206206

207-
sub PDL::Graphics::TriD::Arrows::gdraw {
208-
my($this,$points) = @_;
209-
my $opts = $this->{Options};
210-
glColor3d(@{$opts->{Color}});
211-
my ($from, $to) = @$opts{qw(From To)};
212-
my ($tv, $ti) = PDL::Graphics::OpenGLQ::gen_arrowheads($points,$from,$to,
213-
@$opts{qw(ArrowLen ArrowWidth)});
214-
PDL::gl_triangles($tv->dice_axis(1,$ti)->splitdim(1,3), $opts->{Color});
215-
my $lines = $points->dice_axis(1,$from)->append($points->dice_axis(1,$to))->splitdim(0,3);
216-
PDL::gl_lines_col($lines,$opts->{Color});
207+
sub PDL::Graphics::TriD::Triangles::gdraw {
208+
my ($this,$points) = @_;
209+
my $options = $this->{Options};
210+
my $shading = $options->{Shading};
211+
my $colours = $this->{Colors}->clump(1..$this->{Colors}->ndims-1)->dice_axis(1,$this->{Faceidx}->flat)->splitdim(1,3);
212+
glShadeModel($shading == 1 ? GL_FLAT : GL_SMOOTH) if $shading;
213+
my $f = 'PDL::gl_triangles';
214+
$f .= '_wn' if $shading > 2;
215+
{ no strict 'refs'; $f = \&$f; }
216+
if ($shading > 2) { glColorMaterial(GL_FRONT_AND_BACK,GL_DIFFUSE); glEnable(GL_COLOR_MATERIAL); }
217+
my $tmpn = $shading <= 2 ? undef : $options->{Smooth}
218+
? $this->{VertexNormals}->dice_axis(1,$this->{Faceidx}->flat)
219+
->splitdim(1,$this->{Faceidx}->dim(0)) : $this->{FaceNormals}->dummy(1,3);
220+
$f->($points->dice_axis(1,$this->{Faceidx})->splitdim(1,3), $shading > 2 ? $tmpn : (), $colours);
221+
if ($shading > 2) { glDisable(GL_COLOR_MATERIAL); }
217222
}
218223

219224
sub PDL::Graphics::TriD::LineStrip::gdraw {
@@ -270,7 +275,7 @@ sub PDL::Graphics::TriD::Trigrid::gdraw {
270275
my $arrows = $points->append($points + $this->{VertexNormals}*0.1)->splitdim(0,3)->clump(1,2);
271276
glDisable(GL_LIGHTING);
272277
my ($tv, $ti) = PDL::Graphics::OpenGLQ::gen_arrowheads($arrows,sequence(ulong,2,$points->dim(1))->t->dog,
273-
0.5, 0.02);
278+
0.5, 0.2);
274279
PDL::gl_triangles($tv->dice_axis(1,$ti)->splitdim(1,3), [1,1,1]);
275280
PDL::gl_lines_col($arrows,[1,1,1]);
276281
}
@@ -279,7 +284,7 @@ sub PDL::Graphics::TriD::Trigrid::gdraw {
279284
my $facearrows = $facecentres->append($facecentres + $this->{FaceNormals}*0.1)->splitdim(0,3)->clump(1,2);
280285
glDisable(GL_LIGHTING);
281286
my ($tv, $ti) = PDL::Graphics::OpenGLQ::gen_arrowheads($facearrows,sequence(ulong,2,$facecentres->dim(1))->t->dog,
282-
0.5, 0.02);
287+
0.5, 0.2);
283288
PDL::gl_triangles($tv->dice_axis(1,$ti)->splitdim(1,3), [0.5,0.5,0.5]);
284289
PDL::gl_lines_col($facearrows,[0.5,0.5,0.5]);
285290
}

‎lib/PDL/Graphics/TriD/Objects.pm‎

Lines changed: 47 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -10,17 +10,18 @@ PDL::Graphics::TriD::Objects - Simple Graph Objects for TriD
1010
1111
This provides the following class hierarchy:
1212
13-
PDL::Graphics::TriD::Object base class
14-
└ PDL::Graphics::TriD::GObject (abstract) base class
13+
PDL::Graphics::TriD::Object base class for containers
14+
├ PDL::Graphics::TriD::Arrows lines with arrowheads
15+
└ PDL::Graphics::TriD::GObject (abstract) base class for drawables
1516
1617
PDL::Graphics::TriD::GObject (abstract) base class for drawables
1718
├ PDL::Graphics::TriD::Points individual points
1819
├ PDL::Graphics::TriD::Spheres fat 3D points :)
1920
├ PDL::Graphics::TriD::Lines separate lines
2021
├ PDL::Graphics::TriD::LineStrip continuous paths
2122
├ PDL::Graphics::TriD::Trigrid polygons
23+
├ PDL::Graphics::TriD::Triangles just polygons
2224
├ PDL::Graphics::TriD::Lattice colored lattice, maybe filled/shaded
23-
├ PDL::Graphics::TriD::Arrows lines with arrowheads
2425
└ PDL::Graphics::TriD::Labels text labels
2526
2627
=head1 DESCRIPTION
@@ -145,6 +146,31 @@ sub get_valid_options { +{
145146
}}
146147
sub cdummies { $_[1]->dummy(1,$_[2]->getdim(1)); }
147148

149+
package PDL::Graphics::TriD::Triangles;
150+
use base qw/PDL::Graphics::TriD::GObject/;
151+
use fields qw/Faceidx FaceNormals VertexNormals/;
152+
use PDL::Graphics::OpenGLQ;
153+
sub new {
154+
my $options = ref($_[-1]) eq 'HASH' ? pop : {};
155+
my ($type,$points,$faceidx,$colors) = @_;
156+
my $this = $type->SUPER::new($points,$colors,$options);
157+
$faceidx = $this->{Faceidx} = $faceidx->ulong; # (3,nfaces) indices
158+
$options = $this->{Options};
159+
if ($options->{Shading}) {
160+
my ($fn, $vn) = triangle_normals($this->{Points}, $faceidx);
161+
$this->{VertexNormals} = $vn if $options->{Smooth};
162+
$this->{FaceNormals} = $fn if !$options->{Smooth};
163+
}
164+
$this;
165+
}
166+
sub get_valid_options { +{
167+
UseDefcols => 0,
168+
Shading => 1, # 0=no shading, 1=flat colour per triangle, 2=smooth colour per vertex, 3=colors associated with vertices
169+
Smooth => 0,
170+
Lighting => 0,
171+
}}
172+
sub cdummies { $_[1]->dummy(1,$_[2]->getdim(1)); }
173+
148174
# lattice -> triangle vertices:
149175
# 4 5 6 7 -> formula: origin coords + sequence of orig size minus top+right
150176
# 0 1 2 3 4,0,1,1,5,4 5,1,2,2,6,5 6,2,3,3,7,6
@@ -197,15 +223,31 @@ sub set_labels {
197223
}
198224

199225
package PDL::Graphics::TriD::Arrows;
200-
use base qw/PDL::Graphics::TriD::GObject/;
226+
use base qw/PDL::Graphics::TriD::Object/;
227+
sub r_type { return "";}
201228
sub get_valid_options { +{
202229
UseDefcols => 0,
203230
From => [],
204231
To => [],
205232
ArrowWidth => 0.02,
206233
ArrowLen => 0.1,
207234
Lighting => 0,
208-
Color => [1,1,1],
209235
}}
236+
sub new {
237+
my $options = ref($_[-1]) eq 'HASH' ? pop : $_[0]->get_valid_options;
238+
my ($class, $points, $colors) = @_;
239+
my $this = $class->SUPER::new($options);
240+
$options = $this->{Options};
241+
my ($from, $to, $w, $hl) = delete @$options{qw(From To ArrowWidth ArrowLen)};
242+
$points = PDL::Graphics::TriD::realcoords($class->r_type,$points);
243+
$this->add_object(PDL::Graphics::TriD::Lines->new(
244+
$points->dice_axis(1,$from)->flowing->append($points->dice_axis(1,$to))->splitdim(0,3),
245+
$colors, $options
246+
));
247+
my ($tv, $ti) = PDL::Graphics::OpenGLQ::gen_arrowheads($points->flowing,$from,$to,
248+
$hl, $w);
249+
$this->add_object(PDL::Graphics::TriD::Triangles->new($tv, $ti, $colors, { %$options, Shading=>0 }));
250+
$this;
251+
}
210252

211253
1;

0 commit comments

Comments
 (0)