PDL-Graphics-TriD-2.102/0000755000175000017500000000000014776144103014470 5ustar osboxesosboxesPDL-Graphics-TriD-2.102/demos/0000755000175000017500000000000014776144103015577 5ustar osboxesosboxesPDL-Graphics-TriD-2.102/demos/testimg.p0000644000175000017500000000127414723755526017451 0ustar osboxesosboxesuse PDL;
use PDL::Graphics::TriD;
use PDL::Graphics::TriD::Image;
$PDL::Graphics::TriD::verbose //= 0;
my $win = PDL::Graphics::TriD::get_current_window();
my $graph = PDL::Graphics::TriD::Graph->new;
$graph->default_axes;
# Here we show an 8-dimensional (!!!!!) RGB image to test Image.pm
my $r = zeroes(4,5,6,7,2,2,2,2)+0.1;
my $g = zeroes(4,5,6,7,2,2,2,2);
my $b = zeroes(4,5,6,7,2,2,2,2);
(my $tmp = $r->slice(":,:,2,2")) .= 1;
($tmp = $r->slice(":,:,:,1")) .= 0.5;
($tmp = $g->slice("2,:,1,2")) .= 1;
($tmp = $b->slice("2,3,1,:")) .= 1;
$graph->add_dataseries(PDL::Graphics::TriD::Image->new([$r,$g,$b]));
$graph->scalethings;
$win->clear_objects;
$win->add_object($graph);
$win->twiddle;
PDL-Graphics-TriD-2.102/demos/test4.p0000644000175000017500000000202314776030722017021 0ustar osboxesosboxesuse PDL;
use PDL::Graphics::TriD;
use PDL::Graphics::TriD::Image;
use PDL::IO::Pic;
$s = 10;
$k = zeroes($s,$s);
$x = $k->xvals();
random($k->inplace); $x += $k;
$y = $k->yvals();
random($k->inplace); $y += $k;
random($k->inplace);
$z = $k;
$x /= $s; $y /= $s; $z /= $s;
$pa = PDL::Graphics::TriD::Lattice->new([$x,$y,$z]);
$pb = PDL::Graphics::TriD::Points->new([$x,$y,$z+1]);
$win = PDL::Graphics::TriD::get_current_window();
$win->clear_objects();
$win->add_object($pa);
$win->add_object($pb);
$nx = zeroes(3,20);
$nc = zeroes(3,20);
random($nx->inplace);
random($nc->inplace);
use OpenGL qw(:all);
glShadeModel (&GL_SMOOTH);
$win->add_object(TOBJ->new);
$win->twiddle();
package TOBJ;
our @ISA; BEGIN { @ISA = qw/PDL::Graphics::TriD::Object/ }
use PDL::Graphics::OpenGLQ;
sub new {
bless {},$_[0];
}
sub togl {
OpenGL::glDisable(&OpenGL::GL_LIGHTING);
PDL::gl_line_strip_col($::nx,$::nc);
OpenGL::glColor3f(1,0,1);
gl_texts(PDL->pdl(0,0,0.5), ["HELLO HELLO HELLO GLWORLD!!!"]);
OpenGL::glEnable(&OpenGL::GL_LIGHTING);
}
PDL-Graphics-TriD-2.102/demos/test5.p0000644000175000017500000000212114723755526017031 0ustar osboxesosboxesuse strict;
use warnings;
use PDL;
use PDL::Graphics::TriD;
use PDL::Graphics::TriD::Graph;
my $size = 30;
my $y = PDL->zeroes(3,$size,$size);
axisvalues($y->slice("(0)")->inplace);
axisvalues($y->slice("(1)")->transpose->inplace);
$y /= $size;
random($y->slice("(2)")->inplace);
(my $tmp = $y->slice("(2)")) /= 5;
my $c = PDL->zeroes(3,$size,$size);
random($c->inplace);
my @objs = (
['Lattice'],
['SCLattice'],
['SLattice'],
['SLattice_S', {Smooth=>0}],
['SLattice_S'],
);
my $i = 0;
@objs = map [$i++, @$_], @objs;
my ($below_obj, $above_obj) = map [$_, 'Lines'], -1, 0+@objs;
sub mk_trid { "PDL::Graphics::TriD::$_[1]"->new($y+pdl(0,0,$_[0]),$c,$_[2]) }
my $win = PDL::Graphics::TriD::get_current_window();
my $g = PDL::Graphics::TriD::Graph->new;
my @all = [map mk_trid(@$_), $below_obj, @objs, $above_obj];
push @all, map [map mk_trid(@$_), $below_obj, $_, $above_obj], @objs;
for my $these (@all) {
$g->clear_data;
$win->clear_viewport;
$g->default_axes;
$g->add_dataseries($_) for @$these;
$g->scalethings;
$win->clear_objects;
$win->add_object($g);
$win->twiddle;
}
PDL-Graphics-TriD-2.102/demos/tvrml2.p0000644000175000017500000000342014775155512017212 0ustar osboxesosboxesBEGIN {
$PDL::Graphics::TriD::device = "VRML";
print "====================================\n";
print " VRML not available...stopping demo \n";
print "====================================\n";
exit;
}
BEGIN{
PDL::Graphics::VRMLNode->import();
PDL::Graphics::VRMLProto->import();
}
use PDL::Graphics::TriD;
use PDL::LiteF;
use Carp;
$SIG{__DIE__} = sub {print Carp::longmess(@_); die;};
$set = tridsettings();
$set->browser_com('netscape/unix');
#$set->set(Compress => 1);
$nx = 20;
$t = (xvals zeroes $nx+1,$nx+1)/$nx;
$u = (yvals zeroes $nx+1,$nx+1)/$nx;
$x = sin($u*15 + $t * 3)/2+0.5 + 5*($t-0.5)**2;
$cx = PDL->zeroes(3,$nx+1,$nx+1);
random($cx->inplace);
$pdl = PDL->zeroes(3,20);
$pdl->inplace->random;
$cols = PDL->zeroes(3,20);
$cols->inplace->random;
$g = PDL::Graphics::TriD::get_new_graph;
$name = $g->add_dataseries(PDL::Graphics::TriD::Points->new($pdl,$cols));
$g->bind_default($name);
$name = $g->add_dataseries(PDL::Graphics::TriD::Lattice->new([SURF2D,$x]));
$g->bind_default($name);
$name = $g->add_dataseries(PDL::Graphics::TriD::SLattice_S->new([SURF2D,$x+1],$cx,
{Smooth=>1,Lines=>0}));
$g->bind_default($name);
$g->scalethings();
$win = PDL::Graphics::TriD::get_current_window();
require PDL::Graphics::VRML::Protos;
PDL::Graphics::VRML::Protos->import();
#$win->{VRMLTop}->register_proto(PDL::Graphics::VRML::Protos::PDLBlockText10());
#$win->{VRMLTop}->uses('PDLBlockText10');
#$win->current_viewport()->add_object(PDL::Graphics::TriD::VRMLObject->new(
# vrn(Transform,
# translation => '0 0 -1',
# children =>
# [PDL::Graphics::VRMLNode->new('PDLBlockText10')
# ]
# )
# ));
$win->display('netscape');
exit;
PDL-Graphics-TriD-2.102/demos/test7.p0000644000175000017500000000123114723755526017034 0ustar osboxesosboxesuse blib;
use Carp;
$SIG{__DIE__} = sub {die Carp::longmess(@_);};
use PDL;
use PDL::Graphics::TriD;
$nx = 20;
$t = (xvals zeroes $nx+1,$nx+1)/$nx;
$u = (yvals zeroes $nx+1,$nx+1)/$nx;
$x = sin($u*15 + $t * 3)/2+0.5 + 5*($t-0.5)**2;
# Need to specify type first because points doesn't default to anything
points3d([SURF2D,$x]);
line3d([SURF2D,$x]);
mesh3d([$x]);
imag3d([$x],{Lines => 0});
imag3d([$x],{Lines => 0, Smooth => 1});
imag3d([$x]);
# Then, see the same image twice...
my $ox = $x->dummy(2,2)->zvals; # 0 for first, 1 for second surface.
imag3d([$x * ($ox-0.5) + $ox ],{Smooth => 1});
imag3d([$x * ($ox-0.5) + $ox ],{Lines => 0,Smooth => 1});
PDL-Graphics-TriD-2.102/demos/tvrml.p0000644000175000017500000000256614723755526017146 0ustar osboxesosboxesBEGIN {
$PDL::Graphics::TriD::device = "VRML";
print "====================================\n";
print " VRML not available...stopping demo \n";
print "====================================\n";
exit;
}
use PDL::Graphics::TriD;
use PDL::LiteF;
use Carp;
$PDL::Graphics::TriD::verbose //= 0;
$SIG{__DIE__} = sub {print Carp::longmess(@_); die;};
$set = tridsettings();
$set->browser_com('netscape/unix');
$nx = 5;
$t = (xvals zeroes $nx+1,$nx+1)/$nx;
$u = (yvals zeroes $nx+1,$nx+1)/$nx;
$x = sin($u*15 + $t * 3)/2+0.5 + 5*($t-0.5)**2;
$cx = PDL->zeroes(3,$nx+1,$nx+1);
random($cx->inplace);
$pdl = PDL->zeroes(3,20);
$pdl->inplace->random;
$cols = PDL->zeroes(3,20);
$cols->inplace->random;
$g = PDL::Graphics::TriD::get_new_graph;
$name = $g->add_dataseries(PDL::Graphics::TriD::Points->new($pdl,$cols));
$g->bind_default($name);
$name = $g->add_dataseries(PDL::Graphics::TriD::Lattice->new([SURF2D,$x]));
$g->bind_default($name);
$name = $g->add_dataseries(PDL::Graphics::TriD::SLattice_S->new([SURF2D,$x+1],$cx,
{Smooth=>1,Lines=>0}));
$g->bind_default($name);
$g->scalethings();
describe3d('A simple test of
the current PDL 3D
VRML module');
$win = PDL::Graphics::TriD::get_current_window();
use PDL::Graphics::TriD::Logo;
$win->add_object(PDL::Graphics::TriD::Logo->new);
#use Data::Dumper;
#my $out = Dumper($win);
#print $out;
$win->display('netscape');
PDL-Graphics-TriD-2.102/demos/DemoTkTriD.pm0000644000175000017500000002457014775155512020120 0ustar osboxesosboxespackage PDL::Demos::TkTriD_demo;
use PDL;
use PDL::Graphics::TriD;
use PDL::Graphics::TriD::Contours;
use PDL::Graphics::TriD::GL;
use Tk;
use PDL::Graphics::TriD::Tk;
use strict;
my $TriDW; # declare the graph object in main, defined in initialize
use PDL::Demos;
sub info {('3dtk', 'Tk graphics (requires Tk)')}
sub demo {[actnw => q|
# starting up the Tk GUI demo app
|.__PACKAGE__.q|::run();
|]}
#BEGIN{
# if(defined $PDL::Graphics::TriD::cur){
# print "Configuration error in TkTriD demo\n";
# print "This demo cannot be run after you have loaded TriD\n";
# print "Please restart perldl then try again.\n";
# exit;
# }
#}
sub run {
my $MW = MainWindow->new();
my $bframe = $MW->Frame()->pack(-side=>'top',-fill=>'x');
# This is the TriD Tk widget it is a Tk Frame widget and has all of the
# attributes of a Frame
$TriDW = $MW->Tk( )->pack(-expand=>1,
-fill=>'both');
#
# The exit button
#
my $e_button = $bframe->Button(-text => "Exit",
-command => sub { exit }
)->pack(-side=>'right',-anchor=>'nw',-fill=>'y');
#
# The other menus
#
my $menus=
[{Name=>'Simple',
Type=>'radio',
Options=>["Off","B&W","Color"],
Command=>\&linedemos,
Value=>'Off'},
{Name=>'Surface',
Type=>'radio',
Options=>["Off","Points","Lines","Lattice"],
Command=>\&Linesdemos,
Value=>'Off'},
{Name=>'Volume',
Type=>'radio',
Options=>["Off","Colors","Lighting"],
Command=>\&Torusdemos,
Value=>'Lighting'},
{Name=>'Contours',
Type=>'radio',
Options=>["Off","2DB&W","2DColor","3DColor"],
Command=>\&Contourdemos,
Value=>'Off'},
{Name=>'Object View',
Type=>'command',
Options=>['Top','East','South'],
Command=>\&setview},
{Name=>'ViewPorts',
Type=>'command',
Options=>['Split Horizontal','Split Vertical',
'Un-Split (Save This)','Un-Split (Save Others)'],
Command=>\&setviewports},
{Name=>'Focus',
Type=>'radio',
Options=>["Pointer","DoubleClick"],
Command=>\&setfocusstyle,
Value=>'Pointer'}
];
foreach my $menu (@$menus){
my $mew = $bframe->Menubutton(-text=>$menu->{Name},
-relief=>'raised'
)->pack(-side=>'left');
if($menu->{Type} eq "radio"){
foreach(@{$menu->{Options}}){
$mew->radiobutton(-label=> $_,
-value=> $_,
-variable=> \$menu->{Value},
-command=> [$menu->{Command},$_] );
}
}elsif($menu->{Type} eq "command"){
foreach(@{$menu->{Options}}){
if(/^Un-Split/){
$mew->AddItems(["command" => $_,
-state => 'disabled',
-command=> [$menu->{Command},$mew,$_] ]);
}else{
$mew->AddItems(["command" => $_,
-command=> [$menu->{Command},$mew,$_] ]);
}
}
}
}
#
# Sets a default focus style for viewport
#
setfocusstyle('Pointer');
#
# This sets the graphic that will be displayed when the window is first opened
#
$e_button->bind("",[ sub { my $but = shift;
Torusdemos();
$but->bind("",'') }]);
$TriDW->MainLoop;
}
sub linedemos{
my($bh,$demo) = @_;
$demo=$bh unless(ref($bh));
return unless defined $TriDW->{GLwin};
my $graph;
$graph = $TriDW->{GLwin}->current_viewport->graph();
$demo="B&W" unless(defined $demo);
unless(defined $graph){
# define the graph object
$graph = PDL::Graphics::TriD::Graph->new;
$graph->default_axes();
}
$graph->delete_data("LinesB&W");
$graph->delete_data("LinesColor");
if($demo ne "Off"){
my $data;
my $size = 25;
my $cz = (xvals zeroes $size+1) / $size; # interval 0..1
my $cx = 0.5+sin($cz*12.6)/2; # Corkscrew
my $cy = 0.5+cos($cz*12.6)/2;
if($demo eq "B&W"){
$graph->delete_data("LinesColor");
$data=PDL::Graphics::TriD::LineStrip->new([$cx,$cy,$cz]);
}elsif($demo eq "Color"){
$graph->delete_data("LinesB&W");
my $r = sin($cz*6.3)/2 + 0.5;
my $g = cos($cz*6.3)/2 + 0.5;
my $b = $cz;
$data=PDL::Graphics::TriD::LineStrip->new([$cx,$cy,$cz],[$r,$g,$b]);
}
$graph->add_dataseries($data,"Lines$demo");
}
$graph->scalethings();
$TriDW->current_viewport()->delete_graph($graph);
$TriDW->current_viewport()->graph($graph);
$TriDW->refresh();
}
sub Linesdemos{
my($bh,$demo) = @_;
$demo=$bh unless(ref($bh));
return unless defined $TriDW->{GLwin};
my $graph;
$graph = $TriDW->{GLwin}->current_viewport->graph();
$demo="Lattice" unless(defined $demo);
unless(defined $graph){
# define the graph object
$graph = PDL::Graphics::TriD::Graph->new;
$graph->default_axes();
}
$graph->delete_data("LinesPoints");
$graph->delete_data("LinesLines");
$graph->delete_data("LinesLattice");
if($demo ne "Off"){
my $data;
my $size = 25;
my($x,$y,$z);
$x = (xvals zeroes $size+1,$size+1) / $size;
$y = (yvals zeroes $size+1,$size+1) / $size;
$z = 0.5 + 0.5 * (sin($x*6.3) * sin($y*6.3)) ** 3;
if($demo eq "Lines"){
$data=PDL::Graphics::TriD::LineStrip->new([$x,$y,$z],[$x,$y,$z]);
}elsif($demo eq "Lattice"){
$data=PDL::Graphics::TriD::Lattice->new([$x,$y,$z],[$x,$y,$z]);
}elsif($demo eq "Points"){
$data=PDL::Graphics::TriD::Points->new([$x,$y,$z],[$x,$y,$z]);
}
$graph->add_dataseries($data,"Lines$demo");
}
$graph->scalethings();
$TriDW->current_viewport()->delete_graph($graph);
$TriDW->current_viewport()->graph($graph);
$TriDW->refresh();
}
# Options=>["Off","2DB&W","2DColor","3DColor"],
sub Contourdemos{
my($bh,$demo) = @_;
$demo=$bh unless(ref($bh));
return unless defined $TriDW->{GLwin};
my $graph;
$graph = $TriDW->{GLwin}->current_viewport->graph();
$demo="3DColor" unless(defined $demo);
unless(defined $graph){
# define the graph object
$graph = PDL::Graphics::TriD::Graph->new;
$graph->default_axes();
}
$graph->delete_data("Contours2DB&W");
$graph->delete_data("Contours2DColor");
$graph->delete_data("Contours3DColor");
if($demo ne "Off"){
my $data;
my $size = 25;
my($x,$y,$z);
$x = (xvals zeroes $size,$size) / $size;
$y = (yvals zeroes $size,$size) / $size;
$z = (sin($x*6.3) * sin($y*6.3)) ** 3;
if($demo eq "2DB&W"){
$data=PDL::Graphics::TriD::Contours->new($z,[$z->xvals/$size,$z->yvals/$size,0]);
}elsif($demo eq "2DColor"){
$data=PDL::Graphics::TriD::Contours->new($z,[$z->xvals/$size,$z->yvals/$size,0]);
$data->set_colortable(\&PDL::Graphics::TriD::Contours::coldhot_colortable);
}elsif($demo eq "3DColor"){
$data=PDL::Graphics::TriD::Contours->new($z,[$z->xvals/$size,$z->yvals/$size,$z]);
$data->set_colortable(\&PDL::Graphics::TriD::Contours::coldhot_colortable);
}
$data->addlabels(2,5);
$graph->add_dataseries($data,"Contours$demo");
}
$graph->scalethings();
$TriDW->current_viewport()->delete_graph($graph);
$TriDW->current_viewport()->graph($graph);
$TriDW->refresh();
}
sub Torusdemos{
my($bh,$demo) = @_;
$demo=$bh unless(ref($bh));
return unless defined $TriDW->{GLwin};
my $graph;
$graph = $TriDW->{GLwin}->current_viewport->graph();
$demo="Lighting" unless defined $demo;
unless(defined $graph){
# define the graph object
$graph = PDL::Graphics::TriD::Graph->new;
$graph->default_axes();
}
$graph->delete_data("TorusColors");
$graph->delete_data("TorusLighting");
if($demo ne "Off"){
my $data;
my $s=40;
my $x=zeroes 2*$s,$s/2;
my $t=$x->xlinvals(0,6.284);
my $u=$x->ylinvals(0,6.284);
my $o=0.5;
my $i=0.1;
my $v=$o+$i*sin$u;
my $x = $v*sin $t;
my $y = $v*cos $t;
my $z = $i*cos($u)+$o*sin(3*$t);
if($demo eq "Colors"){
$data=PDL::Graphics::TriD::SLattice->new([$x,$y,$z],
[0.5*(1+sin $t),0.5*(1+cos $t),0.25*(2+cos($u)+sin(3*$t))]);
}else{
$data=PDL::Graphics::TriD::SLattice_S->new([$x,$y,$z]);
}
$graph->add_dataseries($data,"Torus$demo");
}
$graph->scalethings();
$TriDW->current_viewport()->delete_graph($graph);
$TriDW->current_viewport()->graph($graph);
$TriDW->refresh();
}
#
# restore the image view to a known value
#
sub setview{
my($menu,$view) = @_;
my $transformer = $TriDW->current_viewport()->setview($view);
$TriDW->refresh();
}
sub setviewports{
my($menu,$request) = @_;
# print "svp $request\n";
my $vp = $TriDW->current_viewport();
my $nvp;
if($request eq 'Split Horizontal'){
$nvp=$TriDW->new_viewport($vp->{X0}+$vp->{W}/2,$vp->{Y0},$vp->{W}/2,$vp->{H});
$vp->resize($vp->{X0},$vp->{Y0},$vp->{W}/2,$vp->{H});
}elsif($request eq 'Split Vertical'){
$nvp=$TriDW->new_viewport($vp->{X0},$vp->{Y0}+$vp->{H}/2,$vp->{W},$vp->{H}/2);
$vp->resize($vp->{X0},$vp->{Y0},$vp->{W},$vp->{H}/2);
}elsif($request eq 'Un-Split (Save This)'){
my $cnt=0;
foreach (@{$TriDW->viewports()}){
if(defined $_ && $_ != $vp){
$TriDW->clear_viewport($cnt);
}
$cnt++;
}
$vp->resize(0,0,$TriDW->{GLwin}{Width},$TriDW->{GLwin}{Height});
}elsif($request eq 'Un-Split (Save Others)'){
if($vp->{W} < $TriDW->{GLwin}{Width}){
my $x0 = $vp->{X0};
my $x1 = $vp->{X0}+$vp->{W};
foreach (@{$TriDW->viewports()}){
if(($_->{X0} == $x1) || ($_->{X0}+$_->{W} == $x0)){
$x0 = $_->{X0} if($x0>$_->{X0});
$_->resize(min($x0,$_->{X0}),$_->{Y0},$_->{W}+$vp->{W},$_->{H});
}
}
}
$TriDW->clear_viewport($vp);
}
if($#{$TriDW->viewports()} > 0){
$menu->entryconfigure('Un-Split (Save This)', -state=>'normal');
$menu->entryconfigure('Un-Split (Save Others)', -state=>'normal');
}else{
$menu->entryconfigure('Un-Split (Save This)', -state=>'disabled');
$menu->entryconfigure('Un-Split (Save Others)', -state=>'disabled');
}
}
sub setfocusstyle{
my($fs) = @_;
if($fs eq 'Pointer'){
$TriDW->bind("",[ \&setfocus, Ev('x'),Ev('y')]);
$TriDW->bind("",'');
}else{
$TriDW->bind("",'');
$TriDW->bind("",[ \&setfocus, Ev('x'),Ev('y')]);
}
}
sub setfocus{
my($this,$x,$y)=@_;
$y = $TriDW->{GLwin}{Height}-$y;
my $num=0;
foreach my $vp (@{$TriDW->{GLwin}->viewports()}){
if($vp->{X0}+4 <= $x && $vp->{X0}+$vp->{W}-4>=$x
&& $vp->{Y0}+4 <= $y && $vp->{Y0}+$vp->{H}-4>=$y ){
next if($vp->{Active}==1);
$vp->{Active} = 1;
$TriDW->{GLwin}->current_viewport($num);
$TriDW->refresh();
}else{
$vp->{Active} = 0;
}
$num++;
}
}
# This way, it can be invoked as "perl -MPDL::Demos::Tk" or as
# "perl path/to/Tk.pm"
if ($0 eq '-' or $0 eq __FILE__) {
run;
exit;
}
1;
PDL-Graphics-TriD-2.102/META.json0000644000175000017500000000304414776144103016112 0ustar osboxesosboxes{
"abstract" : "unknown",
"author" : [
"PerlDL Developers "
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 7.72, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "PDL-Graphics-TriD",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0",
"OpenGL" : "0.7004",
"PDL" : "2.096"
}
},
"runtime" : {
"requires" : {
"OpenGL" : "0.7004",
"OpenGL::GLFW" : "0.0402",
"PDL" : "2.096"
}
},
"test" : {
"requires" : {
"Test::More" : "0.88"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/PDLPorters/PDL-Graphics-TriD/issues"
},
"homepage" : "http://pdl.perl.org/",
"repository" : {
"type" : "git",
"url" : "git://github.com/PDLPorters/PDL-Graphics-TriD.git",
"web" : "https://github.com/PDLPorters/PDL-Graphics-TriD"
},
"x_IRC" : "irc://irc.perl.org/#pdl"
},
"version" : "2.102",
"x_serialization_backend" : "JSON::PP version 4.04"
}
PDL-Graphics-TriD-2.102/MANIFEST.SKIP0000644000175000017500000000114214776030722016365 0ustar osboxesosboxes\.DS_Store
%$
-stamp$
.*/TAGS$
.*Version_check$
.*\#$
.*\.0$
.*\.orig$
.*\.rej$
\.swp$
.exe$
/\.\#.*
/pm_to_blib$
/tmp.*
MANIFEST\.bak$
MANIFEST\.old
META\.json
META\.yml
Makefile$
Makefile\.aperl
Makefile\.old
\.(tmp|new|diff|ori)$
\.BAK$
\.bck$
\.bs
\.bundle$
\.inlinewith
\.inlinepdlpp
\.pptest
\.lck$
\.m$
\.o$
\.out$
\.patch$
\.so$
\.tar\.gz$
\b_eumm/
lib/PDL/Graphics/OpenGLQ(\.(pm|xs|c)$|-pp-)
lib/PDL/Graphics/TriD/Rout(\.(pm|xs|c)$|-pp-)
lib/PDL/Graphics/TriD/Tk.pm$
^\.git
\.gitignore$
^blib/
^pm_to_blib$
~$
^xt/
^\.github/
^\.cirrus\.yml
cover_db/
^nytprof(/|\.out)
\.gc(ov|no|da)$
pp-\w*\.c$
PDL-Graphics-TriD-2.102/t/0000755000175000017500000000000014776144103014733 5ustar osboxesosboxesPDL-Graphics-TriD-2.102/t/arcball.t0000644000175000017500000000553414775155512016534 0ustar osboxesosboxesuse strict;
use warnings;
use Test::More;
use PDL::Graphics::TriD::ArcBall;
use PDL::LiteF;
use Test::PDL;
{package FakeWindow; sub new {bless {W=>$_[1],H=>$_[2]}} sub add_resizecommand {} }
sub is_qua {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($got, $exp) = map PDL->pdl(@$_), @_;
is_pdl $got, $exp;
}
sub mousemove {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($qc, $x0, $y0, $x1, $y1, $exp) = @_;
my @quat = @{$qc->{Quat}};
$qc->mouse_moved($x0, $y0, $x1, $y1);
is_qua $qc->{Quat}, $exp;
@{$qc->{Quat}} = @quat;
}
my $win = FakeWindow->new(100,100);
my $arcball = PDL::Graphics::TriD::ArcBall->new($win);
isa_ok $arcball, 'PDL::Graphics::TriD::ArcBall';
$arcball->set_wh(100,100);
is_qua $arcball->xy2qua(50,50), [0,0,0,1];
is_qua $arcball->xy2qua(25,25), [0,-0.5,0.5,0.707106];
is_qua $arcball->xy2qua(25,50), [0,-0.5,0,0.866025];
is_qua $arcball->xy2qua(25,75), [0,-0.5,-0.5,0.707106];
is_qua $arcball->xy2qua(75,25), [0,0.5,0.5,0.707106];
is_qua $arcball->xy2qua(75,50), [0,0.5,0,0.866025];
is_qua $arcball->xy2qua(75,75), [0,0.5,-0.5,0.707106];
mousemove $arcball, 50, 50, 50, 50, [1,0,0,0];
mousemove $arcball, 50, 50, 25, 25, [0.707106,-0.5,-0.5,0];
my $arccone = PDL::Graphics::TriD::ArcCone->new($win);
isa_ok $arccone, 'PDL::Graphics::TriD::ArcCone';
$arccone->set_wh(100,100);
is_qua $arccone->xy2qua(50,50), [0,0,0,1];
is_qua $arccone->xy2qua(25,25), [0,-0.653281,0.653281,0.382683];
is_qua $arccone->xy2qua(25,50), [0,-0.707106,0,0.707106];
is_qua $arccone->xy2qua(25,75), [0,-0.653281,-0.653281,0.382683];
is_qua $arccone->xy2qua(75,25), [0,0.653281,0.653281,0.382683];
is_qua $arccone->xy2qua(75,50), [0,0.707106,0,0.707106];
is_qua $arccone->xy2qua(75,75), [0,0.653281,-0.653281,0.382683];
mousemove $arccone, 50, 50, 50, 50, [1,0,0,0];
mousemove $arccone, 50, 50, 25, 25, [0.382683,-0.653281,-0.653281,0];
my $arcbowl = PDL::Graphics::TriD::ArcBowl->new($win);
isa_ok $arcbowl, 'PDL::Graphics::TriD::ArcBowl';
$arcbowl->set_wh(100,100);
is_qua $arcbowl->xy2qua(50,50), [0,0,0,1];
is_qua $arcbowl->xy2qua(25,25), [0,-0.598834,0.598834,0.531784];
is_qua $arcbowl->xy2qua(25,50), [0,-0.577350,0,0.816496];
is_qua $arcbowl->xy2qua(25,75), [0,-0.598834,-0.598834,0.531784];
is_qua $arcbowl->xy2qua(75,75), [0,0.598834,-0.598834,0.531784];
is_qua $arcbowl->xy2qua(75,50), [0,0.577350,0,0.816496];
is_qua $arcbowl->xy2qua(75,75), [0,0.598834,-0.598834,0.531784];
mousemove $arcbowl, 50, 50, 50, 50, [1,0,0,0];
mousemove $arcbowl, 50, 50, 25, 25, [0.531784,-0.598834,-0.598834,0];
my $orbiter = PDL::Graphics::TriD::Orbiter->new($win);
isa_ok $orbiter, 'PDL::Graphics::TriD::Orbiter';
$orbiter->set_wh(100,100);
mousemove $orbiter, 50, 50, 50, 50, [1,0,0,0];
mousemove $orbiter, 25, 25, 25, 25, [1,0,0,0];
mousemove $orbiter, 50, 50, 25, 25, [0.5,-0.5,-0.5,-0.5];
mousemove $orbiter, 25, 25, 0, 0, [0.5,-0.5,-0.5,-0.5];
done_testing;
PDL-Graphics-TriD-2.102/t/quaternion.t0000644000175000017500000000315014775155512017311 0ustar osboxesosboxesuse strict;
use warnings;
use Test::More;
use PDL::Graphics::TriD::Quaternion;
use PDL::LiteF;
use Test::PDL;
sub is_qua {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($got, $exp) = map PDL->pdl(@$_), @_;
is_pdl $got, $exp;
}
my $q = PDL::Graphics::TriD::Quaternion->new(0,0,0,1);
isa_ok $q, 'PDL::Graphics::TriD::Quaternion';
is_qua $q, [0,0,0,1];
is_qua +PDL::Graphics::TriD::Quaternion->new(0,0,0,2)->normalise, [0,0,0,1];
my ($q1, $q2) = map PDL::Graphics::TriD::Quaternion->new(@$_), [1,2,3,4], [5,6,7,8];
is_qua $q1->multiply($q2), my $q1_q2 = [
5-12-21-32, # $a0*$b0 - $a1*$b1 - $a2*$b2 - $a3*$b3,
6+10+24-28, # $a0*$b1 + $b0*$a1 + $a2*$b3 - $a3*$b2,
7+15+24-16, # $a0*$b2 + $b0*$a2 + $a3*$b1 - $a1*$b3,
8+20+14-18, # $a0*$b3 + $b0*$a3 + $a1*$b2 - $a2*$b1
];
is_qua $q1 * $q2, $q1_q2;
is_qua $q1->invert, my $q1_inv = [0.033333,-0.066666,-0.1,-0.133333];
is_qua !$q1, $q1_inv;
is_qua 1 / $q1, $q1_inv;
is_qua $q1 / 4, [0.25,0.5,0.75,1];
is_qua $q1 / !$q2, $q1_q2;
is_qua $q2 * 2, [10,12,14,16];
is_qua 2 * $q2, [10,12,14,16];
is_qua $q2 + 2, [7,6,7,8];
is_qua 2 + $q2, [7,6,7,8];
is_qua $q1 + $q2, [6,8,10,12];
my $q2_copy = $q2->copy;
$q2_copy += 2;
is_qua $q2_copy, [7,6,7,8];
$q2_copy /= 2;
is_qua $q2_copy, [3.5,3,3.5,4];
my $q3 = PDL::Graphics::TriD::Quaternion->new(2,0,0,0);
is_qua $q3, [2,0,0,0];
$q3 .= [3,4,5,6];
is_qua $q3, [3,4,5,6];
$q3 .= $q2;
is_qua $q3, [5,6,7,8];
my $this = {Quat=>$q3};
$this->{Quat} .= $q2;
my $q4 = $q1->copy;
is_qua $q4, [1,2,3,4];
$q4 *= 2;
is_qua $q4, [2,4,6,8];
$q4 *= [0.5,0,0,0];
is_qua $q4, [1,2,3,4];
$q4 *= $q2;
is_qua $q4, $q1_q2;
done_testing;
PDL-Graphics-TriD-2.102/GENERATED/0000755000175000017500000000000014776144103015766 5ustar osboxesosboxesPDL-Graphics-TriD-2.102/GENERATED/PDL/0000755000175000017500000000000014776144103016405 5ustar osboxesosboxesPDL-Graphics-TriD-2.102/GENERATED/PDL/Graphics/0000755000175000017500000000000014776144104020146 5ustar osboxesosboxesPDL-Graphics-TriD-2.102/GENERATED/PDL/Graphics/OpenGLQ.pm0000644000175000017500000000356414776144104021761 0ustar osboxesosboxes#
# GENERATED WITH PDL::PP from lib/PDL/Graphics/OpenGLQ.pd! Don't modify!
#
package PDL::Graphics::OpenGLQ;
our @EXPORT_OK = qw(gl_spheres gl_line_strip_col gl_line_strip_nc gl_lines_col gl_lines_nc gl_points_col gl_points_nc gl_texts gl_triangles_mat gl_triangles_n_mat gl_triangles_wn_mat gl_triangles gl_triangles_n gl_triangles_wn gl_arrows );
our %EXPORT_TAGS = (Func=>\@EXPORT_OK);
use PDL::Core;
use PDL::Exporter;
use DynaLoader;
our @ISA = ( 'PDL::Exporter','DynaLoader' );
push @PDL::Core::PP, __PACKAGE__;
bootstrap PDL::Graphics::OpenGLQ ;
#line 11 "lib/PDL/Graphics/OpenGLQ.pd"
=head1 NAME
PDL::Graphics::OpenGLQ - quick routines to plot lots of stuff from ndarrays.
=head1 SYNOPSIS
only for internal use - see source
=head1 DESCRIPTION
only for internal use - see source
=head1 AUTHOR
Copyright (C) 1997,1998 Tuomas J. Lukka.
All rights reserved. There is no warranty. You are allowed
to redistribute this software / documentation under certain
conditions. For details, see the file COPYING in the PDL
distribution. If this file is separated from the PDL distribution,
the copyright notice should be included in the file.
=cut
#line 51 "lib/PDL/Graphics/OpenGLQ.pm"
*gl_spheres = \&PDL::gl_spheres;
*gl_line_strip_col = \&PDL::gl_line_strip_col;
*gl_line_strip_nc = \&PDL::gl_line_strip_nc;
*gl_lines_col = \&PDL::gl_lines_col;
*gl_lines_nc = \&PDL::gl_lines_nc;
*gl_points_col = \&PDL::gl_points_col;
*gl_points_nc = \&PDL::gl_points_nc;
*gl_texts = \&PDL::gl_texts;
*gl_triangles_mat = \&PDL::gl_triangles_mat;
*gl_triangles_n_mat = \&PDL::gl_triangles_n_mat;
*gl_triangles_wn_mat = \&PDL::gl_triangles_wn_mat;
*gl_triangles = \&PDL::gl_triangles;
*gl_triangles_n = \&PDL::gl_triangles_n;
*gl_triangles_wn = \&PDL::gl_triangles_wn;
*gl_arrows = \&PDL::gl_arrows;
# Exit with OK status
1;
PDL-Graphics-TriD-2.102/GENERATED/PDL/Graphics/TriD/0000755000175000017500000000000014776144104021010 5ustar osboxesosboxesPDL-Graphics-TriD-2.102/GENERATED/PDL/Graphics/TriD/Rout.pm0000644000175000017500000000333314776144104022301 0ustar osboxesosboxes#
# GENERATED WITH PDL::PP from lib/PDL/Graphics/TriD/Rout.pd! Don't modify!
#
package PDL::Graphics::TriD::Rout;
our @EXPORT_OK = qw(vrmlcoordsvert );
our %EXPORT_TAGS = (Func=>\@EXPORT_OK);
use PDL::Core;
use PDL::Exporter;
use DynaLoader;
our @ISA = ( 'PDL::Exporter','DynaLoader' );
push @PDL::Core::PP, __PACKAGE__;
bootstrap PDL::Graphics::TriD::Rout ;
#line 4 "lib/PDL/Graphics/TriD/Rout.pd"
use strict;
use warnings;
=head1 NAME
PDL::Graphics::TriD::Rout - Helper routines for Three-dimensional graphics
=head1 DESCRIPTION
This module is for miscellaneous PP-defined utility routines for
the PDL::Graphics::TriD module.
#line 40 "lib/PDL/Graphics/TriD/Rout.pm"
=head1 FUNCTIONS
=cut
=head2 vrmlcoordsvert
=for sig
Signature: (vertices(n=3); char* space; PerlIO *fp)
Types: (float double)
=for usage
vrmlcoordsvert($vertices, $space, $fp); # all arguments given
$vertices->vrmlcoordsvert($space, $fp); # method call
=for ref
info not available
=pod
Broadcasts over its inputs.
=for bad
C does not process bad values.
It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
=cut
*vrmlcoordsvert = \&PDL::vrmlcoordsvert;
#line 40 "lib/PDL/Graphics/TriD/Rout.pd"
=head1 AUTHOR
Copyright (C) 2000 James P. Edwards
Copyright (C) 1997 Tuomas J. Lukka.
All rights reserved. There is no warranty. You are allowed
to redistribute this software / documentation under certain
conditions. For details, see the file COPYING in the PDL
distribution. If this file is separated from the PDL distribution,
the copyright notice should be included in the file.
=cut
#line 103 "lib/PDL/Graphics/TriD/Rout.pm"
# Exit with OK status
1;
PDL-Graphics-TriD-2.102/META.yml0000644000175000017500000000154014776144103015741 0ustar osboxesosboxes---
abstract: unknown
author:
- 'PerlDL Developers '
build_requires:
ExtUtils::MakeMaker: '0'
Test::More: '0.88'
configure_requires:
ExtUtils::MakeMaker: '0'
OpenGL: '0.7004'
PDL: '2.096'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 7.72, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: PDL-Graphics-TriD
no_index:
directory:
- t
- inc
requires:
OpenGL: '0.7004'
OpenGL::GLFW: '0.0402'
PDL: '2.096'
resources:
IRC: irc://irc.perl.org/#pdl
bugtracker: https://github.com/PDLPorters/PDL-Graphics-TriD/issues
homepage: http://pdl.perl.org/
repository: git://github.com/PDLPorters/PDL-Graphics-TriD.git
version: '2.102'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
PDL-Graphics-TriD-2.102/Changes0000644000175000017500000000135414776144034015771 0ustar osboxesosboxes2.102 2025-04-11
- fix scrolling out with mousewheel/double-touch-scroll in GLUT
- add support for POGL_WINDOW_TYPE of glfw, which is now default
- add own text rendering, now Helvetica
- add own sphere-rendering, removing dependency on GLUT
2.101 2025-04-08
- non-trivial tests added
- add overloads of ::Quaternion
- change mouse control from ArcBall-like to orbiting-camera-like
- convert event-handling from X-windows style to generic
2.100 2025-01-16
- adjust MathGraph and Labels so Debian packaging is happy
2.099 2025-01-06
- add licence information
2.098 2024-01-04
- Graphics::TriD::Rout::{combcoords,attract,repulse} moved to ImageND
2.097 2024-12-09
- install pdldoc, add repo metadata
2.096 2024-12-04
- split out from PDL 2.095
PDL-Graphics-TriD-2.102/lib/0000755000175000017500000000000014776144103015236 5ustar osboxesosboxesPDL-Graphics-TriD-2.102/lib/PDL/0000755000175000017500000000000014776144103015655 5ustar osboxesosboxesPDL-Graphics-TriD-2.102/lib/PDL/Demos/0000755000175000017500000000000014776144103016724 5ustar osboxesosboxesPDL-Graphics-TriD-2.102/lib/PDL/Demos/TriDGallery.pm0000644000175000017500000001603014775155512021451 0ustar osboxesosboxes# Copyright (C) 1998 Tuomas J. Lukka.
# All rights reserved, except redistribution
# with PDL under the PDL License permitted.
package PDL::Demos::TriDGallery;
use PDL::Graphics::TriD;
use PDL::Graphics::TriD::Image;
sub info {('3dgal', 'the 3D gallery: make cool images with 3-line scripts')}
sub init {'
use PDL::Graphics::TriD;
use PDL::Graphics::TriD::Image;
'}
my @demo = (
[comment => q|
Welcome to the TriD Gallery
The following selection of scripts demonstrates that you
can generate interesting images with PDL (and the TriD
modules) with just a few lines of code.
Scripts accepted for this category:
1) Must be legal Perl with a recent PDL version - may come with
a patch to PDL if the patch is general enough to be included
in the next release and usable outside the demo (e.g.
$x=mandelbrot($c) is NOT), i.e. you can introduce new
commands
2) Must create an interesting image when fed to PDL
If you have an interesting new TriD demo,
submit it to the PDL mailing list (pdl-general@lists.sourceforge.net)
or on a GitHub issue (https://github.com/PDLPorters/pdl/issues)
and there is a good chance it will soon be included in the gallery
Press 'q' in the graphics window for the next screen.
Rotate the image by pressing mouse button one and
dragging in the graphics window.
Zoom in/out by pressing MB3 and drag up/down.
|],
[actnw => q|
$|.__PACKAGE__.q|::we_opened = !defined $PDL::Graphics::TriD::current_window;
# B/W Mandelbrot... [Tjl]
use PDL; use PDL::Graphics::TriD; # NOTE all demos need this, only showing once
$s=150;$x=zeroes $s,$s;$r=$x->xlinvals(-1.5,0.5);$i=$x->ylinvals(-1,1);
$t=$r;$u=$i;
for(0..12){$q=$r**2-$i**2+$t;$h=2*$r*$i+$u;($r,$i)=map{$_->clip(-5,5)}($q,$h);}
imagrgb[($r**2+$i**2)>2.0];
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Greyscale Mandelbrot [Tjl]
$x=zeroes 300,300; $r=$x->xlinvals(-1.5, 0.5);
$i=$x->ylinvals(-1,1); $t=$r; $u=$i;
for(1..30){
$q=$r**2-$i**2+$t; $h=2*$r*$i+$u;
$d=$r**2+$i**2; $x=lclip($x,$_*($d>2.0)*($x==0));
($r,$i)=map $_->clip(-5,5), $q, $h;
}
imagrgb[$x/30];
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Color Mandelbrot anim [Tjl]
nokeeptwiddling3d();
$x=zeroes 300,300;
$t=$r=$x->xlinvals(-1.5,0.5);
$u=$i=$x->ylinvals(-1,1);
for(1..30) {
$q=$r**2-$i**2+$t; $h=2*$r*$i+$u; $d=$r**2+$i**2;
$x=lclip($x,$_*($d>2.0)*($x==0));
($r,$i)=map $_->clip(-5,5), $q,$h;
imagrgb[($x==0)*($r/2+0.75),($x==0)*($i+1)/2,$x/30];
}
keeptwiddling3d();
twiddle3d();
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Neat variation of color mandelbrot
sub f {return abs(sin($_[0]*30))}
$x=zeroes 300,300;
$r=$x->xlinvals(-1.5, 0.5); $i=$x->ylinvals(-1,1); $t=$r; $u=$i;
nokeeptwiddling3d();
for(1..30) {
$q=$r**2-$i**2+$t;
$h=2*$r*$i+$u; $d=$r**2+$i**2; $x=lclip($x,$_*($d>2.0)*($x==0));
($r,$i)=map $_->clip(-5,5), $q,$h;
imagrgb[f(($x==0)*($r/2+0.75)),f(($x==0)*($i+1)/2),$x/30];
}
keeptwiddling3d();
twiddle3d();
|],
[actnw => q|
# Torus... (barrel) [Tjl]
$s=40;$x=zeroes $s,$s;$t=$x->xlinvals(0,6.284);
$u=$x->ylinvals(0,6.284);$o=5;$i=1;$v=$o+$i*sin$u;
imag3d([$v*sin$t,$v*cos$t,$i*cos$u]);
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Ripply torus [Tjl]
$s=40; $x=zeroes 2*$s,$s/2; $t=$x->xlinvals(0,6.284);
$u=$x->ylinvals(0,6.284); $o=5; $i=1; $v=$o+$i*sin $u;
imag3d([$v*sin$t,$v*cos$t,$i*cos($u)+$o*sin(3*$t)]);
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Ripply torus distorted [Tjl]
$s=40;$x=zeroes 2*$s,$s/2;$t=$x->xlinvals(0,6.284);$u=$x->ylinvals(0,
6.284); $o=5;$i=1;$v=$o-$o/2*sin(3*$t)+$i*sin$u;
imag3d([$v*sin$t,$v*cos$t,$i*cos($u)+$o*sin(3*$t)]);
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# 3D cardioid [Tjl]
use PDL::Graphics::TriD::Polygonize;
imag3d PDL::Graphics::TriD::StupidPolygonize::stupidpolygonize(
float(0,0,0), 5, 50, 10, sub {
my($x,$y,$z) = $_[0]->mv(0,-1)->dog;
1 - ($x**2 + 1.5*$y**2 + 0.3 * $z**2 + 5*($x**2-$y)**2);
}), {Lines => 0};
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Volume rendering [Robin Williams]
$y=zeroes(50,50,50); $y=sin(0.3*$y->rvals)*cos(0.3*$y->xvals); $c=0;
$x=byte($y>$c);
foreach(1,2,4) {
$t=($x->slice("0:-2")<<$_); $t+=$x->slice("1:-1"); $x = $t->mv(0,2);
}
points3d [whichND(($x != 0) & ($x != 255))->transpose->dog];
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# one possible addition to volume rendering...
$y=zeroes(50,50,50); $y=sin(0.3*$y->rvals)*cos(0.3*$y->xvals); $c=0;
$x=byte($y>$c);
foreach (1,2,4) {
$t= $x->slice("0:-2")<<$_;
$t+=$x->slice("1:-1");
$x = $t->mv(0,2);
}
points3d[map $_+$_->float->random, whichND(($x!=0)&($x != 255))->transpose->dog];
|],
# use PDL; use PDL::Image2D; use PDL::Graphics::TriD;nokeeptwiddling3d;
# $d=byte(random(zeroes(90,90))>0.5);do{$k=byte [[1,1,1],[1,0,1],[1,1,1]];
# imagrgb[$d]if($k++%2); $s=conv2d($d,$k)/8;$i=90*90*random(50);$t=$d->
# clump(2)-> index($i);$t.=($s->clump(2)->index($i)>.5);}while(!twiddle3d)
[actnw => q~
# Fractal mountain range [Tuomas Lukka]
use PDL::Image2D;
$k=ones(5,5) / 25; $x=5; $y=ones(1,1)/2;
for(1..7) {
$c=$y->dupN(2,2)->copy;
$c+=$x*$c->random; $x/=3;
$y=conv2d($c,$k); imag3d[$y],{Lines => 0, Smooth => 0};
}
# [press 'q' in the graphics window to iterate (runs 7 times)]
~],
[actnw => q~
# Electron simulation by Mark Baker: https://perlmonks.org/?node_id=963819
nokeeptwiddling3d;
$c = 0;
do {
$n = 6.28 * ++$c;
$x = $c*rvals((zeros(9000))*$c);
$cz = -1**$x*$c;
$cy = -1**$x*sin$x*$c;
$cx = -1**$c*rvals($x)*$c;
$w = $cz-$cy-$cx;
$g = sin($w);
$r = cos($cy+$c+$cz);
$b = cos($w);
$i = ($cz-$cx-$cy);
$q = $i*$n;
points3d [ $b*sin($q), $r*cos($q), $g*sin$q], [$g,$b,$r];
} while (!twiddle3d); # exit from loop when 'q' pressed
keeptwiddling3d(); # restore waiting for user to press 'q'
~],
[actnw => q~
# Game of life [Robin Williams (edited by Tjl)]
use PDL::Image2D;
$d=byte(random(zeroes(40,40))>0.85); $k=byte [[1,1,1],[1,0,1],[1,1,1]];
nokeeptwiddling3d;
do {
imagrgb [$d]; $s=conv2d($d,$k);
$d&=($s<4); $d&=($s>1); $d|=($s==3);
} while (!twiddle3d);
keeptwiddling3d();
~],
[actnw => q|
# We hope you did like that and got a feeling of
# the power of PDL.
# Now it's up to you to submit even better TriD demos.
close3d() if $|.__PACKAGE__.q|::we_opened;
|],
);
sub demo { @demo }
my @disabled = (
[actnw => q|
# Lucy deconvolution (AJ 79, 745) [Robin Williams (=> TriD by Tjl)]
nokeeptwiddling3d();
sub smth {use PDL::Image2D; conv2d($_[0],exp(-(rvals ones(3,3))**2));}
$x=rfits("m51.fits")->float; $c=$d=avg($x)+0*$x;
while(max $c>1.1) {$c=smth($x/smth($d));$d*=$c;imagrgb[$d/850];}
keeptwiddling3d();
twiddle3d();
# [press 'q' in the graphics window when done]
|],
[actnw => q~
# Dewdney's voters (parallelized) [Tjl, inspired by the above 'life']
use PDL::Image2D;
nokeeptwiddling3d;
$d=byte(random(zeroes(100,100))>0.5); $k=float [[1,1,1],[1,0,1],[1,1,1]];
do{
imagrgb[$d];
$s=conv2d($d,$k)/8;
$r = $s->float->random;
$e = ($s>$r);
$d .= $e;
} while(!twiddle3d);
keeptwiddling3d();
~],
);
1;
PDL-Graphics-TriD-2.102/lib/PDL/Demos/TriD2.pm0000644000175000017500000000625314775155512020221 0ustar osboxesosboxes# Copyright (C) 1998 Tuomas J. Lukka.
# All rights reserved, except redistribution
# with PDL under the PDL License permitted.
package PDL::Demos::TriD2;
use PDL::Graphics::TriD;
use PDL::Graphics::TriD::Image;
sub info {('3d2', '3d demo, part 2. (Somewhat memory-intensive)')}
sub init {'
use PDL::Graphics::TriD;
'}
my @demo = (
[comment => q|
Welcome to a short tour of the more esoteric capabilities of
PDL::Graphics::TriD.
As in '3d', press 'q' in the graphics window for the next
screen. Rotate the image by pressing mouse button one and
dragging in the graphics window.
Note that the script must start with
use PDL;
use PDL::Graphics::TriD;
to work.
|],
[actnw => q|
# See if we had a 3D window open already
$|.__PACKAGE__.q|::we_opened = !defined $PDL::Graphics::TriD::current_window;
# Number of subdivisions for lines / surfaces.
$size = 25;
$r = (xvals zeroes $size+1,$size+1) / $size;
$g = (yvals zeroes $size+1,$size+1) / $size;
$b = ((sin($r*6.3) * sin($g*6.3)) ** 3)/2 + 0.5; # Bumps
imagrgb [$r,$g,$b]; # Draw an image
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# How about this?
imagrgb3d([$r,$g,$b]); # Draw an image on the lower plane
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Let's add the real image on top of this...
hold3d();
imag3d([$r,$g,$b+0.1], [$r,$g,$b]);
# For the next demo, please rotate this so that much
# of the image is visible.
# Don't make your window too big or you might run out of memory
# at the next step.
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Warning: your mileage will vary based on which
# OpenGL implementation you are using :(
# Let's grab this picture...
$pic = grabpic3d();
# Lighten it up a bit so you see the background,
# black on black is confusing
$l = 0.3;
sub lighten { $_[0] = ($_[0] + $l) / (1 + $l) }
lighten($pic);
# And plot it in the picture ;) ;)
hold3d(); # You remember, we leave the previous one in...
$o0 = imagrgb3d($pic, {Points => [[0,0,0],[0,1,0],[0,1,1],[0,0,1]]});
# Because we have the data in $pic, we could just as easily
# save it in a jpeg using the PDL::IO::Pic module - or read
# it from one.
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# That was fun - let's do that again!
$pic1 = grabpic3d();
lighten($pic1); # Lighten it up
# And plot it in the picture ;) ;)
hold3d(); # You remember, we leave the previous one in...
$o1 = imagrgb3d($pic1, {Points => [[0,0,0],[1,0,0],[1,0,1],[0,0,1]]});
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Now, let's update them in real time!
nokeeptwiddling3d(); # Don't wait for user while drawing
while(1) {
$p = grabpic3d();
$p = ($p + $l) / (1 + $l);
$pic .= $p; $pic1 .= $p;
$_->data_changed for $o0, $o1;
last if twiddle3d(); # exit from loop when 'q' pressed
}
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Finally, leave 3d in a sane state
keeptwiddling3d(); # Don't wait for user while drawing
release3d();
# close 3D window if we opened it
close3d() if $|.__PACKAGE__.q|::we_opened;
|],
);
sub demo { @demo }
1;
PDL-Graphics-TriD-2.102/lib/PDL/Demos/TriD1.pm0000644000175000017500000002113214775155512020211 0ustar osboxesosboxes# Copyright (C) 1998 Tuomas J. Lukka.
# All rights reserved, except redistribution
# with PDL under the PDL License permitted.
package PDL::Demos::TriD1;
use PDL::Graphics::TriD;
use Carp;
require File::Spec;
my @f = qw(PDL IO STL owl.stl);
our $owlfile = undef;
foreach my $path ( @INC ) {
my $file = File::Spec->catfile( $path, @f );
if ( -f $file ) { $owlfile = $file; last; }
}
sub info {('3d', '3d demo (requires TriD with OpenGL or Mesa)')}
sub init {'
use PDL::Graphics::TriD;
'}
my @demo = (
[comment => q|
Welcome to a short tour of the capabilities of
PDL::Graphics::TriD.
Press 'q' in the graphics window for the next screen.
Rotate the image by pressing mouse button one and
dragging in the graphics window.
Zoom in/out by pressing MB3 and drag up/down.
Note that a standalone TriD script must start with
use PDL;
use PDL::Graphics::TriD;
to work properly.
|],
[actnw => q|
# See if we had a 3D window open already
$|.__PACKAGE__.q|::we_opened = !defined $PDL::Graphics::TriD::current_window;
$vertices = pdl([ [0,0,-1], [1,0,-1], [0.5,1,-1], [0.5,0.5,0] ]);
$faceidx = pdl([ [0,2,1], [0,1,3], [0,3,2], [1,2,3] ]);
# show the vertex and face normal vectors on a triangular grid
trigrid3d($vertices,$faceidx,{ShowNormals=>1});
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Show a PDL logo
use PDL::Constants qw(PI);
require PDL::Graphics::TriD::Logo;
$vertices = $PDL::Graphics::TriD::Logo::POINTS;
$faceidx = $PDL::Graphics::TriD::Logo::FACES;
$rotate_m = pdl [1,0,0],[0,0,1],[0,-1,0]; # top towards X axis
$c22 = cos(PI/8); $s22 = sin(PI/8);
$rot22 = pdl [$c22,$s22,0],[-$s22,$c22,0],[0,0,1]; # +22deg about vert
$vertices = ($vertices x $rotate_m x $rot22);
trigrid3d($vertices,$faceidx);
# [press 'q' in the graphics window when done]
|],
(!defined $owlfile ? () : [actnw => q|
# Show an owl loaded from an STL file
use PDL::IO::STL;
($vertices, $faceidx) = rstl $|.__PACKAGE__.q|::owlfile;
trigrid3d($vertices,$faceidx);
# [press 'q' in the graphics window when done]
|]),
[actnw => q|
# Number of subdivisions for lines / surfaces.
$size = 25;
$cz = (xvals zeroes $size+1) / $size; # interval 0..1
$cx = sin($cz*12.6); # Corkscrew
$cy = cos($cz*12.6);
line3d [$cx,$cy,$cz]; # Draw a line
# [press 'q' in the graphics window when done]
|],
[actnw => q|
$r = sin($cz*6.3)/2 + 0.5;
$g = cos($cz*6.3)/2 + 0.5;
$b = $cz;
line3d [$cx,$cy,$cz], [$r,$g,$b]; # Draw a colored line
# [press 'q' in the graphics window when done]
|],
[actnw => q|
$x = (xvals zeroes $size+1,$size+1) / $size;
$y = (yvals zeroes $size+1,$size+1) / $size;
$z = 0.5 + 0.5 * (sin($x*6.3) * sin($y*6.3)) ** 3; # Bumps
line3d [$x,$y,$z]; # Draw several lines
# [press 'q' in the graphics window when done]
|],
[actnw => q|
$r = $x;
$g = $y;
$b = $z;
line3d [$x,$y,$z], [$r,$g,$b]; # Draw several colored lines
# [press 'q' in the graphics window when done]
|],
[actnw => q|
lattice3d [$x,$y,$z], [$r,$g,$b]; # Draw a colored lattice
# [press 'q' in the graphics window when done]
|],
[actnw => q|
points3d [$x,$y,$z], [$r,$g,$b], {PointSize=>4}; # Draw colored points
# [press 'q' in the graphics window when done]
|],
[actnw => q|
imag3d_ns [$x,$y,$z], [$r,$g,$b]; # Draw a colored surface
# [press 'q' in the graphics window when done]
|],
[actnw => q|
imag3d [$x,$y,$z]; # Draw a shaded surface
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Draw a shaded, coloured, unsmoothed (default is on) surface
imag3d [$x,$y,$z], [$x,$y,$z], { Smooth => 0 };
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Draw a shaded, coloured, smoothed (the default) surface
imag3d [$x,$y,$z], [$x,$y,$z];
# [press 'q' in the graphics window when done]
|],
[actnw => q|
hold3d(); # Leave the previous object in..
imag3d_ns [$x,$y,$z+1], [$r,$g,$b];
# ...and draw a colored surface on top of it...
# [press 'q' in the graphics window when done]
|],
[actnw => q|
lattice3d [$x,$y,$z-1], [$r,$g,$b];
# ...and draw a colored lattice under it...
# [press 'q' in the graphics window when done]
|],
[actnw => q|
contour3d($z, [$x,$y,$z-1]);
# ...and draw contours on that
# [press 'q' in the graphics window when done]
|],
[actnw => q|
nokeeptwiddling3d(); # Don't wait for user while drawing
for(-2,-1,0,1,2) {
line3d [$cx,$cy,$cz+$_]; # ... and corkscrews...
}
keeptwiddling3d(); # Do wait for user while drawing...
twiddle3d(); # and actually, wait right now.
release3d();
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# The reason for the [] around $x,$y,$z:
# 1. You can give all the coordinates and colors in one ndarray.
$c = (zeroes 3,$size+1) / $size;
$coords =
sin((3+3*xvals $c)*yvals $c);
$colors = $coords;
line3d $coords, $colors; # Draw a curved line, colored
# (this works also for lattices, etc.)
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# 2. You can use defaults inside the brackets:
lattice3d [$z], [$r]; # Note: no $x, $y, and $r is greyscale
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# 3. You can plot in certain other systems as defaults
imag3d_ns [POLAR2D, $z], [$r, $g, $b]; # Draw the familiar
# bumpy surface in polar
# coordinates
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Show graph-evolver
use PDL::Graphics::TriD::MathGraph;
use PDL::Graphics::TriD::Labels;
my @coords = ([0,-1,0], [-1,-1,-2], [3,5,2],
[2,1,-3], [1,3,1], [1,1,2]);
my $from = PDL->pdl(indx, [0,1,2,3,4,4,4,5,5,5]);
my $to = PDL->pdl(indx, [1,2,3,1,0,2,3,0,1,2]);
my @names = map ' '.join(",",@$_), @coords;
my $e = PDL::GraphEvolver->new(pdl(@coords));
$e->set_links($from,$to,PDL->ones(1));
my $c = $e->getcoords;
my $graph = PDL::Graphics::TriD::get_new_graph(); # also clears
hold3d();
nokeeptwiddling3d();
PDL::Graphics::TriD::graph_object(
my $lab = PDL::Graphics::TriD::Labels->new($c,{Strings => \@names}));
PDL::Graphics::TriD::graph_object(
my $lin = PDL::Graphics::TriD::MathGraph->new(
$c, {From => $from, To => $to}));
PDL::Graphics::TriD::graph_object(
my $sph = PDL::Graphics::TriD::Spheres->new($c));
my $ind = 0;
while(1) {
$e->step();
if(++$ind%2 == 0) {
$_->data_changed for $lab, $lin, $sph;
$graph->scalethings() if (($ind % 200) == 0 or 1);
last if twiddle3d();
}
}
keeptwiddling3d();
release3d();
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Show the world!
use PDL::Transform::Cartography;
eval { # this is in case no NetPBM, i.e. can't load Earth images
$radius = earth_shape();
$e_i = earth_image('day')->float / float(255);
$rgbrad = $e_i->mv(2,0)->append($radius->dummy(0));
$shrink = 2.5; # how much to shrink by
$new_x = int($e_i->dim(0) / $shrink);
$rgbrad2 = $rgbrad->mv(0,2)->match([$new_x,int($new_x/2),4])->mv(2,0); # shrink
($rgb, $rad) = map $rgbrad2->slice($_), '0:2', '3';
($w, $h) = map $rgbrad2->dim($_), 1, 2;
$lonlat = cat(meshgrid(
zeroes($w)->xlinvals(-PI,PI), zeroes($h)->xlinvals(-PI/2,PI/2)
))->mv(-1,0);
$lonlatrad = $lonlat->append($rad);
$sph = t_spherical()->inverse()->apply($lonlatrad);
imag3d($sph, $rgb, {Lines=>0});
};
# [press 'q' in the graphics window when done]
|],
[actnw => q|
return if !defined $rgbrad; # failed to load
# Show off the world!
# The Earth's radius doesn't proportionally vary much,
# but let's exaggerate it to prove we have height information!
$lonlatrad->slice('2') -= 1;
$lonlatrad->slice('2') *= 1000;
$lonlatrad->slice('2') += 1;
$sph = t_spherical()->inverse()->apply($lonlatrad);
imag3d($sph, $rgb, {Lines=>0});
# [press 'q' in the graphics window when done]
|],
[actnw => q|
return if !defined $rgbrad; # failed to load
# Now zoom in over Europe
($lats, $lons) = map $_ / 180, pdl(22, 72), pdl(-10, 40);
$latinds = indx(($lats + 0.5) * $rgbrad->dim(2));
$loninds = indx((($lons + 1) / 2) * $rgbrad->dim(1));
$rgbrad3 = $rgbrad->slice(':', map [$_->list], $loninds, $latinds)->sever; # zoom
$lonlat3 = cat(meshgrid(
zeroes($rgbrad3->dim(1))->xlinvals($lons->list),
zeroes($rgbrad3->dim(2))->xlinvals($lats->list),
))->mv(-1,0);
($rgb3, $rad3) = map $rgbrad3->slice($_), '0:2', '3';
$lonlatrad3 = $lonlat3->append($rad3);
$lonlatrad3->slice('2') -= 1;
$lonlatrad3->slice('2') *= 100; # exaggerate terrain but less
$lonlatrad3->slice('2') += 1;
$sph = t_spherical()->inverse()->apply($lonlatrad3);
imag3d($sph, $rgb3, {Lines=>0});
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# '3d2' contains some of the more special constructions available
# in the PDL::Graphics::TriD modules.
# close 3D window if we opened it
close3d() if $|.__PACKAGE__.q|::we_opened;
|],
);
sub demo { @demo }
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/0000755000175000017500000000000014776144103017415 5ustar osboxesosboxesPDL-Graphics-TriD-2.102/lib/PDL/Graphics/OpenGLQ-sphere.c0000644000175000017500000004716414776031760022332 0ustar osboxesosboxes/*
* Copyright (c) 1999-2000 by Pawel W. Olszta
* Written by Pawel W. Olszta,
*
* Permission is hereby granted, free of charge, to any person obtaining a
* copy of this software and associated documentation files (the "Software"),
* to deal in the Software without restriction, including without limitation
* the rights to use, copy, modify, merge, publish, distribute, sublicense,
* and/or sell copies of the Software, and to permit persons to whom the
* Software is furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included
* in all copies or substantial portions of the Sotware.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
* OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
* PAWEL W. OLSZTA BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
* IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
* CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
*/
#include
#include
#include
#ifdef __APPLE__
#include
#else
#include
#endif
/*
* A note: We do not use the GLuint data type for vertex index arrays
* in this code as Open GL ES1 only supports GLushort. This affects the
* cylindrical objects only (Torus, Sphere, Cylinder and Cone) and limits
* their number of vertices to 65535 (2^16-1). That's about 256*256
* subdivisions, which is sufficient for just about any usage case, so
* I am not going to worry about it for now.
* One could do compile time detection of the gluint type through CMake,
* but it is likely that we'll eventually move to runtime selection
* of OpenGL or GLES1/2, which would make that strategy useless...
*/
/* declare for drawing using the different OpenGL versions here so we can
have a nice code order below */
#ifndef GL_VERSION_1_1
static void fghDrawGeometrySolid10(GLfloat *varr, GLfloat *narr, GLfloat *tarr,
GLsizei nverts, GLushort *iarr, GLsizei nparts, GLsizei npartverts);
#endif
static void fghDrawGeometrySolid11(GLfloat *vertices, GLfloat *normals, GLfloat *textcs, GLsizei numVertices,
GLushort *vertIdxs, GLsizei numParts, GLsizei numVertIdxsPerPart);
static void fghDrawGeometrySolid20(GLfloat *vertices, GLfloat *normals, GLfloat *textcs, GLsizei numVertices,
GLushort *vertIdxs, GLsizei numParts, GLsizei numVertIdxsPerPart,
GLint attribute_v_coord, GLint attribute_v_normal, GLint attribute_v_texture);
/* Drawing geometry:
* Explanation of the functions has to be separate for the polyhedra and
* the non-polyhedra (objects with a circular cross-section).
* Non-polyhedra:
* - We have implemented the sphere, cylinder, cone, and torus.
* - All shapes are characterized by two parameters: the number of
* subdivisions along two axes used to construct the shape's vertices
* (e.g. stacks and slices for the sphere).
* As different subdivisions are most suitable for different shapes,
* and are thus also named differently, I won't provide general comments
* on them here.
* - Solids are drawn using glDrawArrays and GL_TRIANGLE_STRIP. Each
* strip covers one revolution around one of the two subdivision axes
* of the shape.
*/
/* Draw the geometric shape with filled triangles
*
* Arguments:
* GLfloat *vertices, GLfloat *normals, GLfloat *textcs, GLsizei numVertices
* The vertex coordinate, normal and texture coordinate buffers, and the
* number of entries in those
* GLushort *vertIdxs
* a vertex indices buffer, optional (not passed for the polyhedra with
* triangular faces)
* GLsizei numParts, GLsizei numVertPerPart
* polyhedra: not used for polyhedra with triangular faces
(numEdgePerFace==3), as each vertex+normal pair is drawn only once,
so no vertex indices are used.
Else, the shape was triangulated (DECOMPOSE_TO_TRIANGLE), leading to
reuse of some vertex+normal pairs, and thus the need to draw with
glDrawElements. numParts is always 1 in this case (we can draw the
whole object with one call to glDrawElements as the vertex index
array contains separate triangles), and numVertPerPart indicates
the number of vertex indices in the vertex array.
* non-polyhedra: number of parts (GL_TRIANGLE_STRIPs) to be drawn
separately (numParts calls to glDrawElements) to create the object.
numVertPerPart indicates the number of vertex indices to be
processed at each draw call.
* numParts * numVertPerPart gives the number of entries in the vertex
* array vertIdxs
*/
void fghDrawGeometrySolid(GLfloat *vertices, GLfloat *normals, GLfloat *textcs, GLsizei numVertices,
GLushort *vertIdxs, GLsizei numParts, GLsizei numVertIdxsPerPart)
{
GLint attribute_v_coord, attribute_v_normal, attribute_v_texture;
#if 0 /* hook for shader stuff */
if(win) {
attribute_v_coord = win->Window.attribute_v_coord;
attribute_v_normal = win->Window.attribute_v_normal;
attribute_v_texture = win->Window.attribute_v_texture;
} else
#endif
attribute_v_coord = attribute_v_normal = attribute_v_texture = -1;
#if 0 /* shader stuff */
if (fgState.HasOpenGL20 && (attribute_v_coord != -1 || attribute_v_normal != -1))
{
/* User requested a 2.0 draw */
fghDrawGeometrySolid20(vertices, normals, textcs, numVertices,
vertIdxs, numParts, numVertIdxsPerPart,
attribute_v_coord, attribute_v_normal, attribute_v_texture);
}
else
#endif
{
fghDrawGeometrySolid11(vertices, normals, textcs, numVertices,
vertIdxs, numParts, numVertIdxsPerPart);
}
}
#ifndef GL_VERSION_1_1
static void fghDrawGeometrySolid10(GLfloat *varr, GLfloat *narr, GLfloat *tarr,
GLsizei nverts, GLushort *iarr, GLsizei nparts, GLsizei npartverts)
{
int i, j;
GLfloat *vptr, *nptr, *tptr;
GLushort *iptr;
if(!iarr) {
vptr = varr;
nptr = narr;
tptr = tarr;
glBegin(GL_TRIANGLES);
for(i=0; i 1) {
for(i=0; i1)
for (i=0; i= 2.0 */
static void fghDrawGeometrySolid20(GLfloat *vertices, GLfloat *normals, GLfloat *textcs, GLsizei numVertices,
GLushort *vertIdxs, GLsizei numParts, GLsizei numVertIdxsPerPart,
GLint attribute_v_coord, GLint attribute_v_normal, GLint attribute_v_texture)
{
#if defined(GL_VERSION_1_1) || defined(GL_VERSION_ES_CM_1_0)
GLuint vbo_coords = 0, vbo_normals = 0, vbo_textcs = 0, ibo_elements = 0;
GLsizei numVertIdxs = numParts * numVertIdxsPerPart;
int i;
if (numVertices > 0 && attribute_v_coord != -1) {
glGenBuffers(1, &vbo_coords);
glBindBuffer(GL_ARRAY_BUFFER, vbo_coords);
glBufferData(GL_ARRAY_BUFFER, numVertices * 3 * sizeof(vertices[0]),
vertices, GL_STATIC_DRAW);
glBindBuffer(GL_ARRAY_BUFFER, 0);
}
if (numVertices > 0 && attribute_v_normal != -1) {
glGenBuffers(1, &vbo_normals);
glBindBuffer(GL_ARRAY_BUFFER, vbo_normals);
glBufferData(GL_ARRAY_BUFFER, numVertices * 3 * sizeof(normals[0]),
normals, GL_STATIC_DRAW);
glBindBuffer(GL_ARRAY_BUFFER, 0);
}
if (numVertices > 0 && attribute_v_texture != -1 && textcs) {
glGenBuffers(1, &vbo_textcs);
glBindBuffer(GL_ARRAY_BUFFER, vbo_textcs);
glBufferData(GL_ARRAY_BUFFER, numVertices * 2 * sizeof(textcs[0]),
textcs, GL_STATIC_DRAW);
glBindBuffer(GL_ARRAY_BUFFER, 0);
}
if (vertIdxs != NULL) {
glGenBuffers(1, &ibo_elements);
glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, ibo_elements);
glBufferData(GL_ELEMENT_ARRAY_BUFFER, numVertIdxs * sizeof(vertIdxs[0]),
vertIdxs, GL_STATIC_DRAW);
glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, 0);
}
if (vbo_coords) {
glEnableVertexAttribArray(attribute_v_coord);
glBindBuffer(GL_ARRAY_BUFFER, vbo_coords);
glVertexAttribPointer(
attribute_v_coord, /* attribute */
3, /* number of elements per vertex, here (x,y,z) */
GL_FLOAT, /* the type of each element */
GL_FALSE, /* take our values as-is */
0, /* no extra data between each position */
0 /* offset of first element */
);
glBindBuffer(GL_ARRAY_BUFFER, 0);
};
if (vbo_normals) {
glEnableVertexAttribArray(attribute_v_normal);
glBindBuffer(GL_ARRAY_BUFFER, vbo_normals);
glVertexAttribPointer(
attribute_v_normal, /* attribute */
3, /* number of elements per vertex, here (x,y,z) */
GL_FLOAT, /* the type of each element */
GL_FALSE, /* take our values as-is */
0, /* no extra data between each position */
0 /* offset of first element */
);
glBindBuffer(GL_ARRAY_BUFFER, 0);
};
if (vbo_textcs) {
glEnableVertexAttribArray(attribute_v_texture);
glBindBuffer(GL_ARRAY_BUFFER, vbo_textcs);
glVertexAttribPointer(
attribute_v_texture,/* attribute */
2, /* number of elements per vertex, here (s,t) */
GL_FLOAT, /* the type of each element */
GL_FALSE, /* take our values as-is */
0, /* no extra data between each position */
0 /* offset of first element */
);
glBindBuffer(GL_ARRAY_BUFFER, 0);
};
if (vertIdxs == NULL) {
glDrawArrays(GL_TRIANGLES, 0, numVertices);
} else {
glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, ibo_elements);
if (numParts>1) {
for (i=0; i 65535)
/*
* limit of glushort, that's 256*256 subdivisions, should be enough in practice. See note above
*/
return "fghGenerateSphere: too many slices or stacks requested, indices will wrap";
/* precompute values on unit circle */
char *err = fghCircleTable(&sint1,&cost1,-slices,GL_FALSE);
if (err) return err;
err = fghCircleTable(&sint2,&cost2, stacks,GL_TRUE);
if (err) return err;
/* Allocate vertex and normal buffers, bail out if memory allocation fails */
*vertices = malloc((*nVert)*3*sizeof(GLfloat));
*normals = malloc((*nVert)*3*sizeof(GLfloat));
if (!(*vertices) || !(*normals))
{
free(*vertices);
free(*normals);
return "Failed to allocate memory in fghGenerateSphere";
}
/* top */
(*vertices)[0] = 0.f;
(*vertices)[1] = 0.f;
(*vertices)[2] = radius;
(*normals )[0] = 0.f;
(*normals )[1] = 0.f;
(*normals )[2] = 1.f;
idx = 3;
/* each stack */
for( i=1; i
*
* Permission is hereby granted, free of charge, to any person obtaining a
* copy of this software and associated documentation files (the "Software"),
* to deal in the Software without restriction, including without limitation
* the rights to use, copy, modify, merge, publish, distribute, sublicense,
* and/or sell copies of the Software, and to permit persons to whom the
* Software is furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included
* in all copies or substantial portions of the Sotware.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
* OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
* PAWEL W. OLSZTA BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
* IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
* CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
*/
#include
#ifdef __APPLE__
#include
#else
#include
#endif
/* The bitmap font structure */
typedef struct tagSFG_Font SFG_Font;
struct tagSFG_Font
{
char* Name; /* The source font name */
int Quantity; /* Number of chars in font */
int Height; /* Height of the characters */
const GLubyte** Characters; /* The characters mapping */
float xorig, yorig; /* Relative origin of the character */
};
/*
* The following bitmapped fonts are defined in this file:
*
* 1. fgFontHelvetica12
* -adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1
*/
/*
static const GLubyte Helvetica12_Character_000[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_001[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_002[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_003[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_004[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_005[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_006[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_007[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_008[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_009[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_010[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_011[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_012[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_013[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_014[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_015[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_016[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_017[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_018[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_019[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_020[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_021[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_022[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_023[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_024[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_025[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_026[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_027[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_028[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_029[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_030[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_031[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
*/
static const GLubyte Helvetica12_Character_032[] = { 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_033[] = { 3, 0, 0, 0, 0, 64, 0, 64, 64, 64, 64, 64, 64, 64, 0, 0, 0};
static const GLubyte Helvetica12_Character_034[] = { 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 80, 80, 80, 0, 0, 0};
static const GLubyte Helvetica12_Character_035[] = { 7, 0, 0, 0, 0, 80, 80, 80,252, 40,252, 40, 40, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_036[] = { 7, 0, 0, 0, 16, 56, 84, 84, 20, 56, 80, 84, 56, 16, 0, 0, 0};
static const GLubyte Helvetica12_Character_037[] = { 11, 0, 0, 0, 0, 0, 0, 0, 0, 17,128, 10, 64, 10, 64, 9,128, 4, 0, 52, 0, 74, 0, 74, 0, 49, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_038[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 57, 0, 70, 0, 66, 0, 69, 0, 40, 0, 24, 0, 36, 0, 36, 0, 24, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_039[] = { 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 64, 32, 96, 0, 0, 0};
static const GLubyte Helvetica12_Character_040[] = { 4, 0, 16, 32, 32, 64, 64, 64, 64, 64, 64, 32, 32, 16, 0, 0, 0};
static const GLubyte Helvetica12_Character_041[] = { 4, 0,128, 64, 64, 32, 32, 32, 32, 32, 32, 64, 64,128, 0, 0, 0};
static const GLubyte Helvetica12_Character_042[] = { 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 80, 32, 80, 0, 0, 0};
static const GLubyte Helvetica12_Character_043[] = { 7, 0, 0, 0, 0, 0, 16, 16,124, 16, 16, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_044[] = { 4, 0, 0, 64, 32, 32, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_045[] = { 8, 0, 0, 0, 0, 0, 0, 0,124, 0, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_046[] = { 3, 0, 0, 0, 0, 64, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_047[] = { 4, 0, 0, 0, 0,128,128, 64, 64, 64, 32, 32, 16, 16, 0, 0, 0};
static const GLubyte Helvetica12_Character_048[] = { 7, 0, 0, 0, 0, 56, 68, 68, 68, 68, 68, 68, 68, 56, 0, 0, 0};
static const GLubyte Helvetica12_Character_049[] = { 7, 0, 0, 0, 0, 16, 16, 16, 16, 16, 16, 16,112, 16, 0, 0, 0};
static const GLubyte Helvetica12_Character_050[] = { 7, 0, 0, 0, 0,124, 64, 64, 32, 16, 8, 4, 68, 56, 0, 0, 0};
static const GLubyte Helvetica12_Character_051[] = { 7, 0, 0, 0, 0, 56, 68, 68, 4, 4, 24, 4, 68, 56, 0, 0, 0};
static const GLubyte Helvetica12_Character_052[] = { 7, 0, 0, 0, 0, 8, 8,252,136, 72, 40, 40, 24, 8, 0, 0, 0};
static const GLubyte Helvetica12_Character_053[] = { 7, 0, 0, 0, 0, 56, 68, 68, 4, 4,120, 64, 64,124, 0, 0, 0};
static const GLubyte Helvetica12_Character_054[] = { 7, 0, 0, 0, 0, 56, 68, 68, 68,100, 88, 64, 68, 56, 0, 0, 0};
static const GLubyte Helvetica12_Character_055[] = { 7, 0, 0, 0, 0, 32, 32, 16, 16, 16, 8, 8, 4,124, 0, 0, 0};
static const GLubyte Helvetica12_Character_056[] = { 7, 0, 0, 0, 0, 56, 68, 68, 68, 68, 56, 68, 68, 56, 0, 0, 0};
static const GLubyte Helvetica12_Character_057[] = { 7, 0, 0, 0, 0, 56, 68, 4, 4, 60, 68, 68, 68, 56, 0, 0, 0};
static const GLubyte Helvetica12_Character_058[] = { 3, 0, 0, 0, 0, 64, 0, 0, 0, 0, 64, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_059[] = { 3, 0, 0,128, 64, 64, 0, 0, 0, 0, 64, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_060[] = { 7, 0, 0, 0, 0, 0, 12, 48,192, 48, 12, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_061[] = { 7, 0, 0, 0, 0, 0, 0,124, 0,124, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_062[] = { 7, 0, 0, 0, 0, 0, 96, 24, 6, 24, 96, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_063[] = { 7, 0, 0, 0, 0, 16, 0, 16, 16, 8, 8, 68, 68, 56, 0, 0, 0};
static const GLubyte Helvetica12_Character_064[] = { 12, 0, 0, 0, 0, 0, 0, 31, 0, 32, 0, 77,128, 83, 64, 81, 32, 81, 32, 73, 32, 38,160, 48, 64, 15,128, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_065[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 65, 0, 65, 0, 65, 0, 62, 0, 34, 0, 34, 0, 20, 0, 20, 0, 8, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_066[] = { 8, 0, 0, 0, 0,124, 66, 66, 66,124, 66, 66, 66,124, 0, 0, 0};
static const GLubyte Helvetica12_Character_067[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 30, 0, 33, 0, 64, 0, 64, 0, 64, 0, 64, 0, 64, 0, 33, 0, 30, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_068[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0,124, 0, 66, 0, 65, 0, 65, 0, 65, 0, 65, 0, 65, 0, 66, 0,124, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_069[] = { 8, 0, 0, 0, 0,126, 64, 64, 64,126, 64, 64, 64,126, 0, 0, 0};
static const GLubyte Helvetica12_Character_070[] = { 8, 0, 0, 0, 0, 64, 64, 64, 64,124, 64, 64, 64,126, 0, 0, 0};
static const GLubyte Helvetica12_Character_071[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 29, 0, 35, 0, 65, 0, 65, 0, 71, 0, 64, 0, 64, 0, 33, 0, 30, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_072[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 65, 0, 65, 0, 65, 0, 65, 0,127, 0, 65, 0, 65, 0, 65, 0, 65, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_073[] = { 3, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64, 64, 64, 0, 0, 0};
static const GLubyte Helvetica12_Character_074[] = { 7, 0, 0, 0, 0, 56, 68, 68, 4, 4, 4, 4, 4, 4, 0, 0, 0};
static const GLubyte Helvetica12_Character_075[] = { 8, 0, 0, 0, 0, 65, 66, 68, 72,112, 80, 72, 68, 66, 0, 0, 0};
static const GLubyte Helvetica12_Character_076[] = { 7, 0, 0, 0, 0,124, 64, 64, 64, 64, 64, 64, 64, 64, 0, 0, 0};
static const GLubyte Helvetica12_Character_077[] = { 11, 0, 0, 0, 0, 0, 0, 0, 0, 68, 64, 68, 64, 74, 64, 74, 64, 81, 64, 81, 64, 96,192, 96,192, 64, 64, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_078[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 65, 0, 67, 0, 69, 0, 69, 0, 73, 0, 81, 0, 81, 0, 97, 0, 65, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_079[] = { 10, 0, 0, 0, 0, 0, 0, 0, 0, 30, 0, 33, 0, 64,128, 64,128, 64,128, 64,128, 64,128, 33, 0, 30, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_080[] = { 8, 0, 0, 0, 0, 64, 64, 64, 64,124, 66, 66, 66,124, 0, 0, 0};
static const GLubyte Helvetica12_Character_081[] = { 10, 0, 0, 0, 0, 0, 0, 0, 0, 30,128, 33, 0, 66,128, 68,128, 64,128, 64,128, 64,128, 33, 0, 30, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_082[] = { 8, 0, 0, 0, 0, 66, 66, 66, 68,124, 66, 66, 66,124, 0, 0, 0};
static const GLubyte Helvetica12_Character_083[] = { 8, 0, 0, 0, 0, 60, 66, 66, 2, 12, 48, 64, 66, 60, 0, 0, 0};
static const GLubyte Helvetica12_Character_084[] = { 7, 0, 0, 0, 0, 16, 16, 16, 16, 16, 16, 16, 16,254, 0, 0, 0};
static const GLubyte Helvetica12_Character_085[] = { 8, 0, 0, 0, 0, 60, 66, 66, 66, 66, 66, 66, 66, 66, 0, 0, 0};
static const GLubyte Helvetica12_Character_086[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 8, 0, 20, 0, 20, 0, 34, 0, 34, 0, 34, 0, 65, 0, 65, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_087[] = { 11, 0, 0, 0, 0, 0, 0, 0, 0, 17, 0, 17, 0, 17, 0, 42,128, 42,128, 36,128, 68, 64, 68, 64, 68, 64, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_088[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 65, 0, 34, 0, 34, 0, 20, 0, 8, 0, 20, 0, 34, 0, 34, 0, 65, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_089[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 8, 0, 8, 0, 8, 0, 20, 0, 34, 0, 34, 0, 65, 0, 65, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_090[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0,127, 0, 64, 0, 32, 0, 16, 0, 8, 0, 4, 0, 2, 0, 1, 0,127, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_091[] = { 3, 0, 96, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 96, 0, 0, 0};
static const GLubyte Helvetica12_Character_092[] = { 4, 0, 0, 0, 0, 16, 16, 32, 32, 32, 64, 64,128,128, 0, 0, 0};
static const GLubyte Helvetica12_Character_093[] = { 3, 0,192, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,192, 0, 0, 0};
static const GLubyte Helvetica12_Character_094[] = { 6, 0, 0, 0, 0, 0, 0, 0, 0, 0,136, 80, 32, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_095[] = { 7, 0, 0,254, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_096[] = { 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,192,128, 64, 0, 0, 0};
static const GLubyte Helvetica12_Character_097[] = { 7, 0, 0, 0, 0, 58, 68, 68, 60, 4, 68, 56, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_098[] = { 7, 0, 0, 0, 0, 88,100, 68, 68, 68,100, 88, 64, 64, 0, 0, 0};
static const GLubyte Helvetica12_Character_099[] = { 7, 0, 0, 0, 0, 56, 68, 64, 64, 64, 68, 56, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_100[] = { 7, 0, 0, 0, 0, 52, 76, 68, 68, 68, 76, 52, 4, 4, 0, 0, 0};
static const GLubyte Helvetica12_Character_101[] = { 7, 0, 0, 0, 0, 56, 68, 64,124, 68, 68, 56, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_102[] = { 3, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64,224, 64, 48, 0, 0, 0};
static const GLubyte Helvetica12_Character_103[] = { 7, 0, 56, 68, 4, 52, 76, 68, 68, 68, 76, 52, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_104[] = { 7, 0, 0, 0, 0, 68, 68, 68, 68, 68,100, 88, 64, 64, 0, 0, 0};
static const GLubyte Helvetica12_Character_105[] = { 3, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64, 0, 64, 0, 0, 0};
static const GLubyte Helvetica12_Character_106[] = { 3, 0,128, 64, 64, 64, 64, 64, 64, 64, 64, 64, 0, 64, 0, 0, 0};
static const GLubyte Helvetica12_Character_107[] = { 6, 0, 0, 0, 0, 68, 72, 80, 96, 96, 80, 72, 64, 64, 0, 0, 0};
static const GLubyte Helvetica12_Character_108[] = { 3, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64, 64, 64, 0, 0, 0};
static const GLubyte Helvetica12_Character_109[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 73, 0, 73, 0, 73, 0, 73, 0, 73, 0,109, 0, 82, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_110[] = { 7, 0, 0, 0, 0, 68, 68, 68, 68, 68,100, 88, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_111[] = { 7, 0, 0, 0, 0, 56, 68, 68, 68, 68, 68, 56, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_112[] = { 7, 0, 64, 64, 64, 88,100, 68, 68, 68,100, 88, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_113[] = { 7, 0, 4, 4, 4, 52, 76, 68, 68, 68, 76, 52, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_114[] = { 4, 0, 0, 0, 0, 64, 64, 64, 64, 64, 96, 80, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_115[] = { 6, 0, 0, 0, 0, 48, 72, 8, 48, 64, 72, 48, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_116[] = { 3, 0, 0, 0, 0, 96, 64, 64, 64, 64, 64,224, 64, 64, 0, 0, 0};
static const GLubyte Helvetica12_Character_117[] = { 7, 0, 0, 0, 0, 52, 76, 68, 68, 68, 68, 68, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_118[] = { 7, 0, 0, 0, 0, 16, 16, 40, 40, 68, 68, 68, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_119[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 34, 0, 34, 0, 85, 0, 73, 0, 73, 0,136,128,136,128, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_120[] = { 6, 0, 0, 0, 0,132,132, 72, 48, 48, 72,132, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_121[] = { 7, 0, 64, 32, 16, 16, 40, 40, 72, 68, 68, 68, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_122[] = { 6, 0, 0, 0, 0,120, 64, 32, 32, 16, 8,120, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_123[] = { 4, 0, 48, 64, 64, 64, 64, 64,128, 64, 64, 64, 64, 48, 0, 0, 0};
static const GLubyte Helvetica12_Character_124[] = { 3, 0, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 0, 0, 0};
static const GLubyte Helvetica12_Character_125[] = { 4, 0,192, 32, 32, 32, 32, 32, 16, 32, 32, 32, 32,192, 0, 0, 0};
static const GLubyte Helvetica12_Character_126[] = { 7, 0, 0, 0, 0, 0, 0, 0,152,100, 0, 0, 0, 0, 0, 0, 0};
/*
static const GLubyte Helvetica12_Character_127[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_128[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_129[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_130[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_131[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_132[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_133[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_134[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_135[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_136[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_137[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_138[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_139[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_140[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_141[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_142[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_143[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_144[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_145[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_146[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_147[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_148[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_149[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_150[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_151[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_152[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_153[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_154[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_155[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_156[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_157[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_158[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_159[] = { 12, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 65, 0, 0, 0, 85, 0, 0, 0, 0, 0, 0, 0};
*/
static const GLubyte Helvetica12_Character_160[] = { 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_161[] = { 3, 0, 64, 64, 64, 64, 64, 64, 64, 64, 0, 64, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_162[] = { 7, 0, 0, 0, 32, 56,100, 80, 80, 80, 84, 56, 8, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_163[] = { 7, 0, 0, 0, 0, 88, 36, 16, 16,120, 32, 32, 36, 24, 0, 0, 0};
static const GLubyte Helvetica12_Character_164[] = { 7, 0, 0, 0, 0, 0,132,120, 72, 72,120,132, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_165[] = { 7, 0, 0, 0, 0, 16, 16,124, 16,124, 16, 40, 68, 68, 0, 0, 0};
static const GLubyte Helvetica12_Character_166[] = { 3, 0, 0, 64, 64, 64, 64, 0, 0, 0, 64, 64, 64, 64, 0, 0, 0};
static const GLubyte Helvetica12_Character_167[] = { 6, 0,112,136, 8, 48, 72,136,136,144, 96,128,136,112, 0, 0, 0};
static const GLubyte Helvetica12_Character_168[] = { 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,160, 0, 0, 0};
static const GLubyte Helvetica12_Character_169[] = { 11, 0, 0, 0, 0, 0, 0, 0, 0, 31, 0, 32,128, 78, 64, 81, 64, 80, 64, 81, 64, 78, 64, 32,128, 31, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_170[] = { 5, 0, 0, 0, 0, 0, 0, 0, 0,112, 0, 80, 16,112, 0, 0, 0};
static const GLubyte Helvetica12_Character_171[] = { 7, 0, 0, 0, 0, 0, 20, 40, 80, 40, 20, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_172[] = { 8, 0, 0, 0, 0, 0, 0, 2, 2, 2,126, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_173[] = { 5, 0, 0, 0, 0, 0, 0, 0,240, 0, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_174[] = { 11, 0, 0, 0, 0, 0, 0, 0, 0, 31, 0, 32,128, 74, 64, 74, 64, 76, 64, 74, 64, 78, 64, 32,128, 31, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_175[] = { 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,240, 0, 0, 0};
static const GLubyte Helvetica12_Character_176[] = { 5, 0, 0, 0, 0, 0, 0, 0, 0, 96,144,144, 96, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_177[] = { 7, 0, 0, 0, 0,124, 0, 16, 16,124, 16, 16, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_178[] = { 4, 0, 0, 0, 0, 0, 0, 0,240, 64, 32,144, 96, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_179[] = { 4, 0, 0, 0, 0, 0, 0, 0,192, 32, 64, 32,224, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_180[] = { 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,128, 64, 0, 0};
static const GLubyte Helvetica12_Character_181[] = { 7, 0, 64, 64, 64,116, 76, 68, 68, 68, 68, 68, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_182[] = { 7, 0, 40, 40, 40, 40, 40, 40,104,232,232,232,104, 60, 0, 0, 0};
static const GLubyte Helvetica12_Character_183[] = { 3, 0, 0, 0, 0, 0, 0, 0, 64, 0, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_184[] = { 3, 0,192, 32, 32, 64, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_185[] = { 4, 0, 0, 0, 0, 0, 0, 0, 32, 32, 32, 96, 32, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_186[] = { 5, 0, 0, 0, 0, 0, 0, 0, 0,112, 0,112, 80,112, 0, 0, 0};
static const GLubyte Helvetica12_Character_187[] = { 7, 0, 0, 0, 0, 0, 80, 40, 20, 40, 80, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_188[] = { 10, 0, 0, 0, 0, 0, 0, 0, 0, 65, 0, 39,128, 21, 0, 19, 0, 73, 0, 68, 0, 68, 0,194, 0, 65, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_189[] = { 10, 0, 0, 0, 0, 0, 0, 0, 0, 71,128, 34, 0, 17, 0, 20,128, 75, 0, 72, 0, 68, 0,194, 0, 65, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_190[] = { 10, 0, 0, 0, 0, 0, 0, 0, 0, 33, 0, 23,128, 21, 0, 11, 0,201, 0, 36, 0, 68, 0, 34, 0,225, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_191[] = { 7, 0, 56, 68, 68, 32, 32, 16, 16, 0, 16, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_192[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 65, 0, 65, 0, 65, 0, 62, 0, 34, 0, 34, 0, 20, 0, 8, 0, 8, 0, 0, 0, 8, 0, 16, 0};
static const GLubyte Helvetica12_Character_193[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 65, 0, 65, 0, 65, 0, 62, 0, 34, 0, 34, 0, 20, 0, 8, 0, 8, 0, 0, 0, 8, 0, 4, 0};
static const GLubyte Helvetica12_Character_194[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 65, 0, 65, 0, 65, 0, 62, 0, 34, 0, 34, 0, 20, 0, 8, 0, 8, 0, 0, 0, 20, 0, 8, 0};
static const GLubyte Helvetica12_Character_195[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 65, 0, 65, 0, 65, 0, 62, 0, 34, 0, 34, 0, 20, 0, 8, 0, 8, 0, 0, 0, 20, 0, 10, 0};
static const GLubyte Helvetica12_Character_196[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 65, 0, 65, 0, 65, 0, 62, 0, 34, 0, 34, 0, 20, 0, 8, 0, 8, 0, 0, 0, 20, 0, 0, 0};
static const GLubyte Helvetica12_Character_197[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 65, 0, 65, 0, 65, 0, 62, 0, 34, 0, 34, 0, 20, 0, 8, 0, 8, 0, 8, 0, 20, 0, 8, 0};
static const GLubyte Helvetica12_Character_198[] = { 11, 0, 0, 0, 0, 0, 0, 0, 0, 71,192, 68, 0, 68, 0, 60, 0, 39,192, 36, 0, 20, 0, 20, 0, 15,192, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_199[] = { 9, 0, 0, 24, 0, 4, 0, 4, 0, 30, 0, 33, 0, 64, 0, 64, 0, 64, 0, 64, 0, 64, 0, 33, 0, 30, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_200[] = { 8, 0, 0, 0, 0,126, 64, 64, 64,126, 64, 64, 64,126, 0, 8, 16};
static const GLubyte Helvetica12_Character_201[] = { 8, 0, 0, 0, 0,126, 64, 64, 64,126, 64, 64, 64,126, 0, 8, 4};
static const GLubyte Helvetica12_Character_202[] = { 8, 0, 0, 0, 0,126, 64, 64, 64,126, 64, 64, 64,126, 0, 20, 8};
static const GLubyte Helvetica12_Character_203[] = { 8, 0, 0, 0, 0,126, 64, 64, 64,126, 64, 64, 64,126, 0, 20, 0};
static const GLubyte Helvetica12_Character_204[] = { 3, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64, 64, 64, 0, 64,128};
static const GLubyte Helvetica12_Character_205[] = { 3, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64, 64, 64, 0, 64, 32};
static const GLubyte Helvetica12_Character_206[] = { 3, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64, 64, 64, 0,160, 64};
static const GLubyte Helvetica12_Character_207[] = { 3, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64, 64, 64, 0,160, 0};
static const GLubyte Helvetica12_Character_208[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0,124, 0, 66, 0, 65, 0, 65, 0,241, 0, 65, 0, 65, 0, 66, 0,124, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_209[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 65, 0, 67, 0, 69, 0, 69, 0, 73, 0, 81, 0, 81, 0, 97, 0, 65, 0, 0, 0, 20, 0, 10, 0};
static const GLubyte Helvetica12_Character_210[] = { 10, 0, 0, 0, 0, 0, 0, 0, 0, 30, 0, 33, 0, 64,128, 64,128, 64,128, 64,128, 64,128, 33, 0, 30, 0, 0, 0, 4, 0, 8, 0};
static const GLubyte Helvetica12_Character_211[] = { 10, 0, 0, 0, 0, 0, 0, 0, 0, 30, 0, 33, 0, 64,128, 64,128, 64,128, 64,128, 64,128, 33, 0, 30, 0, 0, 0, 4, 0, 2, 0};
static const GLubyte Helvetica12_Character_212[] = { 10, 0, 0, 0, 0, 0, 0, 0, 0, 30, 0, 33, 0, 64,128, 64,128, 64,128, 64,128, 64,128, 33, 0, 30, 0, 0, 0, 10, 0, 4, 0};
static const GLubyte Helvetica12_Character_213[] = { 10, 0, 0, 0, 0, 0, 0, 0, 0, 30, 0, 33, 0, 64,128, 64,128, 64,128, 64,128, 64,128, 33, 0, 30, 0, 0, 0, 20, 0, 10, 0};
static const GLubyte Helvetica12_Character_214[] = { 10, 0, 0, 0, 0, 0, 0, 0, 0, 30, 0, 33, 0, 64,128, 64,128, 64,128, 64,128, 64,128, 33, 0, 30, 0, 0, 0, 18, 0, 0, 0};
static const GLubyte Helvetica12_Character_215[] = { 7, 0, 0, 0, 0, 0, 68, 40, 16, 40, 68, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_216[] = { 10, 0, 0, 0, 0, 0, 0,128, 0, 94, 0, 33, 0, 80,128, 72,128, 68,128, 68,128, 66,128, 33, 0, 30,128, 0, 64, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_217[] = { 8, 0, 0, 0, 0, 60, 66, 66, 66, 66, 66, 66, 66, 66, 0, 8, 16};
static const GLubyte Helvetica12_Character_218[] = { 8, 0, 0, 0, 0, 60, 66, 66, 66, 66, 66, 66, 66, 66, 0, 8, 4};
static const GLubyte Helvetica12_Character_219[] = { 8, 0, 0, 0, 0, 60, 66, 66, 66, 66, 66, 66, 66, 66, 0, 20, 8};
static const GLubyte Helvetica12_Character_220[] = { 8, 0, 0, 0, 0, 60, 66, 66, 66, 66, 66, 66, 66, 66, 0, 36, 0};
static const GLubyte Helvetica12_Character_221[] = { 9, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 8, 0, 8, 0, 8, 0, 20, 0, 34, 0, 34, 0, 65, 0, 65, 0, 0, 0, 8, 0, 4, 0};
static const GLubyte Helvetica12_Character_222[] = { 8, 0, 0, 0, 0, 64, 64,124, 66, 66, 66,124, 64, 64, 0, 0, 0};
static const GLubyte Helvetica12_Character_223[] = { 7, 0, 0, 0, 0, 88, 68, 68, 68, 88, 68, 68, 68, 56, 0, 0, 0};
static const GLubyte Helvetica12_Character_224[] = { 7, 0, 0, 0, 0, 58, 68, 68, 60, 4, 68, 56, 0, 8, 16, 0, 0};
static const GLubyte Helvetica12_Character_225[] = { 7, 0, 0, 0, 0, 58, 68, 68, 60, 4, 68, 56, 0, 16, 8, 0, 0};
static const GLubyte Helvetica12_Character_226[] = { 7, 0, 0, 0, 0, 58, 68, 68, 60, 4, 68, 56, 0, 40, 16, 0, 0};
static const GLubyte Helvetica12_Character_227[] = { 7, 0, 0, 0, 0, 58, 68, 68, 60, 4, 68, 56, 0, 40, 20, 0, 0};
static const GLubyte Helvetica12_Character_228[] = { 7, 0, 0, 0, 0, 58, 68, 68, 60, 4, 68, 56, 0, 40, 0, 0, 0};
static const GLubyte Helvetica12_Character_229[] = { 7, 0, 0, 0, 0, 58, 68, 68, 60, 4, 68, 56, 24, 36, 24, 0, 0};
static const GLubyte Helvetica12_Character_230[] = { 11, 0, 0, 0, 0, 0, 0, 0, 0, 59,128, 68, 64, 68, 0, 63,192, 4, 64, 68, 64, 59,128, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_231[] = { 7, 0, 48, 8, 16, 56, 68, 64, 64, 64, 68, 56, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_232[] = { 7, 0, 0, 0, 0, 56, 68, 64,124, 68, 68, 56, 0, 16, 32, 0, 0};
static const GLubyte Helvetica12_Character_233[] = { 7, 0, 0, 0, 0, 56, 68, 64,124, 68, 68, 56, 0, 16, 8, 0, 0};
static const GLubyte Helvetica12_Character_234[] = { 7, 0, 0, 0, 0, 56, 68, 64,124, 68, 68, 56, 0, 40, 16, 0, 0};
static const GLubyte Helvetica12_Character_235[] = { 7, 0, 0, 0, 0, 56, 68, 64,124, 68, 68, 56, 0, 40, 0, 0, 0};
static const GLubyte Helvetica12_Character_236[] = { 3, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64, 0, 64,128, 0, 0};
static const GLubyte Helvetica12_Character_237[] = { 3, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64, 0, 64, 32, 0, 0};
static const GLubyte Helvetica12_Character_238[] = { 3, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64, 0,160, 64, 0, 0};
static const GLubyte Helvetica12_Character_239[] = { 3, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64, 0,160, 0, 0, 0};
static const GLubyte Helvetica12_Character_240[] = { 7, 0, 0, 0, 0, 56, 68, 68, 68, 68, 60, 4, 40, 24, 52, 0, 0};
static const GLubyte Helvetica12_Character_241[] = { 7, 0, 0, 0, 0, 68, 68, 68, 68, 68,100, 88, 0, 40, 20, 0, 0};
static const GLubyte Helvetica12_Character_242[] = { 7, 0, 0, 0, 0, 56, 68, 68, 68, 68, 68, 56, 0, 16, 32, 0, 0};
static const GLubyte Helvetica12_Character_243[] = { 7, 0, 0, 0, 0, 56, 68, 68, 68, 68, 68, 56, 0, 16, 8, 0, 0};
static const GLubyte Helvetica12_Character_244[] = { 7, 0, 0, 0, 0, 56, 68, 68, 68, 68, 68, 56, 0, 40, 16, 0, 0};
static const GLubyte Helvetica12_Character_245[] = { 7, 0, 0, 0, 0, 56, 68, 68, 68, 68, 68, 56, 0, 40, 20, 0, 0};
static const GLubyte Helvetica12_Character_246[] = { 7, 0, 0, 0, 0, 56, 68, 68, 68, 68, 68, 56, 0, 40, 0, 0, 0};
static const GLubyte Helvetica12_Character_247[] = { 7, 0, 0, 0, 0, 0, 16, 0,124, 0, 16, 0, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_248[] = { 7, 0, 0, 0, 0,184, 68,100, 84, 76, 68, 58, 0, 0, 0, 0, 0};
static const GLubyte Helvetica12_Character_249[] = { 7, 0, 0, 0, 0, 52, 76, 68, 68, 68, 68, 68, 0, 16, 32, 0, 0};
static const GLubyte Helvetica12_Character_250[] = { 7, 0, 0, 0, 0, 52, 76, 68, 68, 68, 68, 68, 0, 16, 8, 0, 0};
static const GLubyte Helvetica12_Character_251[] = { 7, 0, 0, 0, 0, 52, 76, 68, 68, 68, 68, 68, 0, 40, 16, 0, 0};
static const GLubyte Helvetica12_Character_252[] = { 7, 0, 0, 0, 0, 52, 76, 68, 68, 68, 68, 68, 0, 40, 0, 0, 0};
static const GLubyte Helvetica12_Character_253[] = { 7, 0, 64, 32, 16, 16, 40, 40, 72, 68, 68, 68, 0, 16, 8, 0, 0};
static const GLubyte Helvetica12_Character_254[] = { 7, 0, 64, 64, 64, 88,100, 68, 68, 68,100, 88, 64, 64, 0, 0, 0};
static const GLubyte Helvetica12_Character_255[] = { 7, 0, 96, 16, 16, 16, 24, 40, 40, 36, 68, 68, 0, 40, 0, 0, 0};
/* The font characters mapping: */
static const GLubyte* Helvetica12_Character_Map[] = {Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,
Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,
Helvetica12_Character_032,Helvetica12_Character_033,Helvetica12_Character_034,Helvetica12_Character_035,Helvetica12_Character_036,Helvetica12_Character_037,Helvetica12_Character_038,Helvetica12_Character_039,Helvetica12_Character_040,Helvetica12_Character_041,Helvetica12_Character_042,Helvetica12_Character_043,Helvetica12_Character_044,Helvetica12_Character_045,Helvetica12_Character_046,Helvetica12_Character_047,
Helvetica12_Character_048,Helvetica12_Character_049,Helvetica12_Character_050,Helvetica12_Character_051,Helvetica12_Character_052,Helvetica12_Character_053,Helvetica12_Character_054,Helvetica12_Character_055,Helvetica12_Character_056,Helvetica12_Character_057,Helvetica12_Character_058,Helvetica12_Character_059,Helvetica12_Character_060,Helvetica12_Character_061,Helvetica12_Character_062,Helvetica12_Character_063,
Helvetica12_Character_064,Helvetica12_Character_065,Helvetica12_Character_066,Helvetica12_Character_067,Helvetica12_Character_068,Helvetica12_Character_069,Helvetica12_Character_070,Helvetica12_Character_071,Helvetica12_Character_072,Helvetica12_Character_073,Helvetica12_Character_074,Helvetica12_Character_075,Helvetica12_Character_076,Helvetica12_Character_077,Helvetica12_Character_078,Helvetica12_Character_079,
Helvetica12_Character_080,Helvetica12_Character_081,Helvetica12_Character_082,Helvetica12_Character_083,Helvetica12_Character_084,Helvetica12_Character_085,Helvetica12_Character_086,Helvetica12_Character_087,Helvetica12_Character_088,Helvetica12_Character_089,Helvetica12_Character_090,Helvetica12_Character_091,Helvetica12_Character_092,Helvetica12_Character_093,Helvetica12_Character_094,Helvetica12_Character_095,
Helvetica12_Character_096,Helvetica12_Character_097,Helvetica12_Character_098,Helvetica12_Character_099,Helvetica12_Character_100,Helvetica12_Character_101,Helvetica12_Character_102,Helvetica12_Character_103,Helvetica12_Character_104,Helvetica12_Character_105,Helvetica12_Character_106,Helvetica12_Character_107,Helvetica12_Character_108,Helvetica12_Character_109,Helvetica12_Character_110,Helvetica12_Character_111,
Helvetica12_Character_112,Helvetica12_Character_113,Helvetica12_Character_114,Helvetica12_Character_115,Helvetica12_Character_116,Helvetica12_Character_117,Helvetica12_Character_118,Helvetica12_Character_119,Helvetica12_Character_120,Helvetica12_Character_121,Helvetica12_Character_122,Helvetica12_Character_123,Helvetica12_Character_124,Helvetica12_Character_125,Helvetica12_Character_126,Helvetica12_Character_032,
Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,
Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,Helvetica12_Character_032,
Helvetica12_Character_160,Helvetica12_Character_161,Helvetica12_Character_162,Helvetica12_Character_163,Helvetica12_Character_164,Helvetica12_Character_165,Helvetica12_Character_166,Helvetica12_Character_167,Helvetica12_Character_168,Helvetica12_Character_169,Helvetica12_Character_170,Helvetica12_Character_171,Helvetica12_Character_172,Helvetica12_Character_173,Helvetica12_Character_174,Helvetica12_Character_175,
Helvetica12_Character_176,Helvetica12_Character_177,Helvetica12_Character_178,Helvetica12_Character_179,Helvetica12_Character_180,Helvetica12_Character_181,Helvetica12_Character_182,Helvetica12_Character_183,Helvetica12_Character_184,Helvetica12_Character_185,Helvetica12_Character_186,Helvetica12_Character_187,Helvetica12_Character_188,Helvetica12_Character_189,Helvetica12_Character_190,Helvetica12_Character_191,
Helvetica12_Character_192,Helvetica12_Character_193,Helvetica12_Character_194,Helvetica12_Character_195,Helvetica12_Character_196,Helvetica12_Character_197,Helvetica12_Character_198,Helvetica12_Character_199,Helvetica12_Character_200,Helvetica12_Character_201,Helvetica12_Character_202,Helvetica12_Character_203,Helvetica12_Character_204,Helvetica12_Character_205,Helvetica12_Character_206,Helvetica12_Character_207,
Helvetica12_Character_208,Helvetica12_Character_209,Helvetica12_Character_210,Helvetica12_Character_211,Helvetica12_Character_212,Helvetica12_Character_213,Helvetica12_Character_214,Helvetica12_Character_215,Helvetica12_Character_216,Helvetica12_Character_217,Helvetica12_Character_218,Helvetica12_Character_219,Helvetica12_Character_220,Helvetica12_Character_221,Helvetica12_Character_222,Helvetica12_Character_223,
Helvetica12_Character_224,Helvetica12_Character_225,Helvetica12_Character_226,Helvetica12_Character_227,Helvetica12_Character_228,Helvetica12_Character_229,Helvetica12_Character_230,Helvetica12_Character_231,Helvetica12_Character_232,Helvetica12_Character_233,Helvetica12_Character_234,Helvetica12_Character_235,Helvetica12_Character_236,Helvetica12_Character_237,Helvetica12_Character_238,Helvetica12_Character_239,
Helvetica12_Character_240,Helvetica12_Character_241,Helvetica12_Character_242,Helvetica12_Character_243,Helvetica12_Character_244,Helvetica12_Character_245,Helvetica12_Character_246,Helvetica12_Character_247,Helvetica12_Character_248,Helvetica12_Character_249,Helvetica12_Character_250,Helvetica12_Character_251,Helvetica12_Character_252,Helvetica12_Character_253,Helvetica12_Character_254,Helvetica12_Character_255,NULL};
/* The font structure: */
static SFG_Font fgFontHelvetica12 = { "-adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1", 256, 16, Helvetica12_Character_Map, 0, 4 };
void pdl_3d_bitmapString( const unsigned char *string )
{
unsigned char c;
float x = 0.0f ;
SFG_Font* font = &fgFontHelvetica12;
if ( !string || ! *string )
return;
#ifdef GL_VERSION_1_1
glPushClientAttrib( GL_CLIENT_PIXEL_STORE_BIT );
#else
{
GLint swbytes, lsbfirst, rowlen, skiprows, skippix, align;
glGetIntegerv(GL_UNPACK_SWAP_BYTES, &swbytes);
glGetIntegerv(GL_UNPACK_LSB_FIRST, &lsbfirst);
glGetIntegerv(GL_UNPACK_ROW_LENGTH, &rowlen);
glGetIntegerv(GL_UNPACK_SKIP_ROWS, &skiprows);
glGetIntegerv(GL_UNPACK_SKIP_PIXELS, &skippix);
glGetIntegerv(GL_UNPACK_ALIGNMENT, &align);
#endif
glPixelStorei( GL_UNPACK_SWAP_BYTES, GL_FALSE );
glPixelStorei( GL_UNPACK_LSB_FIRST, GL_FALSE );
glPixelStorei( GL_UNPACK_ROW_LENGTH, 0 );
glPixelStorei( GL_UNPACK_SKIP_ROWS, 0 );
glPixelStorei( GL_UNPACK_SKIP_PIXELS, 0 );
glPixelStorei( GL_UNPACK_ALIGNMENT, 1 );
/*
* Step through the string, drawing each character.
* A newline will simply translate the next character's insertion
* point back to the start of the line and down one line.
*/
while( ( c = *string++) )
if( c == '\n' )
{
glBitmap ( 0, 0, 0, 0, -x, (float) -font->Height, NULL );
x = 0.0f;
}
else /* Not an EOL, draw the bitmap character */
{
const GLubyte* face = font->Characters[ c ];
glBitmap(
face[ 0 ], font->Height, /* Bitmap's width and height */
font->xorig, font->yorig, /* The origin in the font glyph */
( float )( face[ 0 ] ), 0.0, /* The raster advance; inc. x,y */
( face + 1 ) /* The packed bitmap data... */
);
x += ( float )( face[ 0 ] );
}
#ifdef GL_VERSION_1_1
glPopClientAttrib();
#else
glPixelStorei(GL_UNPACK_SWAP_BYTES, swbytes);
glPixelStorei(GL_UNPACK_LSB_FIRST, lsbfirst);
glPixelStorei(GL_UNPACK_ROW_LENGTH, rowlen);
glPixelStorei(GL_UNPACK_SKIP_ROWS, skiprows);
glPixelStorei(GL_UNPACK_SKIP_PIXELS, skippix);
glPixelStorei(GL_UNPACK_ALIGNMENT, align);
}
#endif
}
/*
* Return the width of a string drawn using a bitmap font
*/
int pdl_3d_bitmapLength( const unsigned char* string )
{
unsigned char c;
int length = 0, this_line_length = 0;
SFG_Font* font = &fgFontHelvetica12;
if ( !string || ! *string )
return 0;
while( ( c = *string++) )
{
if( c != '\n' )/* Not an EOL, increment length of line */
this_line_length += *( font->Characters[ c ]);
else /* EOL; reset the length of this line */
{
if( length < this_line_length )
length = this_line_length;
this_line_length = 0;
}
}
if ( length < this_line_length )
length = this_line_length;
return length;
}
/*
* Returns the height of a bitmap font
*/
int pdl_3d_bitmapHeight( void )
{
SFG_Font* font = &fgFontHelvetica12;
return font->Height;
}
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/VRML.pm0000644000175000017500000002000514775155512020535 0ustar osboxesosboxes# XXXXX print methods need to be changed to
# reduce memory consumption
###################
#
# VRMLProto
package PDL::Graphics::VRMLProto;
use strict;
use warnings;
use Exporter;
use PDL::Core '';
our @ISA = qw/ Exporter /;
our @EXPORT = qw/ vrp fv3f fmstr /;
sub new {
my $type = shift;
my ($name,$fields,$node) = @_;
my $this = bless {},$type;
$this->{Name} = $name;
$this->{Fields} = $fields;
$this->{Node} = $node;
return $this;
}
sub vrp {
return PDL::Graphics::VRMLProto->new(@_);
}
sub fv3f {
my ($name,$def) = @_;
return ["field SFVec3f", "$name", "$def"];
}
sub fmstr {
my ($name,$def) = @_;
return ["field MFString", "$name", defined $def ? "$def" : "[]"];
}
sub to_text {
my $this = shift;
my $text = "PROTO $this->{Name} [\n";
for (@{$this->{Fields}}) {
$text .= " $_->[0] $_->[1]\t$_->[2]\n";
}
$text .= "]\n{\n";
$text .= $this->{Node}->to_text;
return $text . "}\n";
}
#####################
#
# VRMLNode
package PDL::Graphics::VRMLNode;
use Exporter;
our @ISA = qw/ Exporter /;
our @EXPORT = qw/ vrn vrml3v /;
our @EXPORT_OK = qw/ tabs postfix prefix /;
sub vrn {
return PDL::Graphics::VRMLNode->new(@_);
}
sub new {
my $type = shift;
my $title = shift;
my $this = bless {},$type;
$this->{'Container'} = {};
$this->{'Title'} = $title;
$this->add(@_);
return $this;
}
sub add {
my ($this,%items) = @_;
@{$this->{Container}}{keys %items} = values %items;
return $this;
}
sub add_children {
my ($this) = shift;
for(@_) {
push @{$this->{Container}{children}}, $_;
}
}
sub to_text {
my $this = shift;
my $level = $#_ > -1 ? shift : 1;
my $text = $this->prefix($level);
my($k,$v);
while (($k,$v) = each %{$this->{Container}}) {
$text .= tabs($level) . "$k".
(ref $v ?
ref $v eq "ARRAY" ?
$this->array_out($v,$level+1) :
(" ".$v->to_text($level+1)) :
"\t$v\n");
}
return $text.$this->postfix($level);
}
sub array_out {
my ($this,$array,$level) = @_;
my $text = " [\n";
for (@$array) {
$text .= tabs($level) . (ref $_ ?
$_->to_text($level+1) : "$_,\n")
}
$text .= tabs($level-1) . "]\n";
return $text;
}
sub prefix {
return $_[0]->{Title}." {\n";
}
sub postfix {
return "\t"x($_[1]-1)."}\n";
}
sub tabs {
return "\t"x$_[0];
}
sub vrml3v {
my $list = shift;
return sprintf '%.3f %.3f %.3f', @{$list}[0..2];
}
#################
#
# VRMLPdlNode
package PDL::Graphics::VRMLPdlNode;
our @ISA = qw/ PDL::Graphics::VRMLNode /;
use PDL::Lite;
use PDL::Core qw(barf broadcast_define over);
use PDL::Dbg;
PDL::Graphics::VRMLNode->import(qw/tabs vrml3v postfix prefix/);
sub new {
my ($type,$points,$colors,$options) = @_;
my $this = bless {},$type;
$this->{'Points'} = $points;
$this->{'Colors'} = $colors;
$this->checkoptions($options);
return $this;
}
sub checkoptions {
my ($this,$options) = @_;
my $aopts = $this->getvopts();
for (keys %$aopts) {
$this->{$_} = !defined($options->{$_}) ? $aopts->{$_} : delete $options->{$_};
}
if (keys %$options) {
barf "Invalid options left: ".(join ',',%$options);
}
}
sub getvopts {
my ($this) = @_;
return {Title => 'PointSet',
PerVertex => 0,
Lighting => 0,
Surface => 0,
Lines => 1,
Smooth => 0,
IsLattice => 0,
DefColors => 0};
}
sub to_text {
my $this = shift;
my $level = $#_ > -1 ? shift : 1;
my $text = $this->prefix($level);
my ($vtxt,$vidx,$ctxt,$extra,$useidx) = ("","","","",0);
if ($this->{Title} eq 'PointSet') {
coords($this->{Points},$this->{Colors},\$vtxt,\$ctxt,tabs($level+2));
} elsif ($this->{Title} eq 'IndexedLineSet') {
my @dims = $this->{Points}->dims;
shift @dims;
my $cols = $this->{Colors};
my $seq = PDL->sequence(@dims);
require PDL::Dbg;
local $PDL::debug = 0;
$cols = pdl(0,0,0)->dummy(1)->dummy(2)->px
if $this->{IsLattice} && $this->{Surface} && $this->{Lines};
lines($this->{Points},$cols,$seq,
\$vtxt,\$ctxt,\$vidx,tabs($level+1));
lines($this->{Points}->xchg(1,2),$cols->xchg(1,2),
$seq->transpose,undef,\$ctxt,\$vidx,
tabs($level+1)) if $this->{IsLattice};
$useidx = 1;
} elsif ($this->{Title} eq 'IndexedFaceSet') {
my @dims = $this->{Points}->dims;
shift @dims;
my @sls1 = ("0:-2,0:-2",
"1:-1,0:-2",
"0:-2,1:-1");
my @sls2 = ("1:-1,1:-1",
"0:-2,1:-1",
"1:-1,0:-2"
);
my $seq = PDL->sequence(@dims);
coords($this->{Points},$this->{Colors},\$vtxt,\$ctxt,tabs($level+2));
triangles((map {$seq->slice($_)} @sls1),\$vidx,tabs($level+1));
triangles((map {$seq->slice($_)} @sls2),\$vidx,tabs($level+1));
$useidx = 1;
$extra = tabs($level)."colorPerVertex\tTRUE\n".
tabs($level)."solid\tFALSE\n";
$extra .= tabs($level)."creaseAngle\t3.14\n" if $this->{Smooth};
}
$text .= vprefix('coord',$level).$vtxt.vpostfix('coord',$level);
$text .= vprefix('index',$level).$vidx.vpostfix('index',$level)
if $useidx;
$text .= vprefix('color',$level).$ctxt.vpostfix('color',$level)
unless $this->{DefColors};
return $text.$extra.$this->postfix($level);
}
sub vprefix {
my ($type,$level) = @_;
return tabs($level) . "coord Coordinate {\n" . tabs($level+1) .
"point [\n" if $type eq 'coord';
return tabs($level) . "color Color {\n" . tabs($level+1) .
"color [\n" if $type eq 'color';
return tabs($level) . "coordIndex [\n" if $type eq 'index';
}
sub vpostfix {
my ($type,$level) = @_;
return tabs($level+1)."]\n".tabs($level)."}\n" unless $type eq 'index';
return tabs($level)."]\n";
}
broadcast_define 'coords(vertices(n=3); colors(n)) NOtherPars => 3',
over {
${$_[2]} .= $_[4] . sprintf("%.3f %.3f %.3f,\n",$_[0]->list);
${$_[3]} .= $_[4] . sprintf("%.3f %.3f %.3f,\n",$_[1]->list);
};
broadcast_define 'v3array(vecs(n=3)) NOtherPars => 2',
over {
${$_[1]} .= $_[2] . sprintf("%.3f %.3f %.3f,\n",$_[0]->list);
};
broadcast_define 'lines(vertices(n=3,m); colors(n,m); index(m))'.
'NOtherPars => 4',
over {
my ($lines,$cols,$index,$vt,$ct,$it,$sp) = @_;
v3array($lines,$vt,$sp."\t") if defined $vt;
v3array($cols,$ct,$sp."\t") if defined $ct;
$$it .= $sp.join(',',$index->list).",-1,\n" if defined $it;
};
broadcast_define 'triangles(inda();indb();indc()), NOtherPars => 2',
over {
${$_[3]} .= $_[4].join(',',map {$_->at} @_[0..2]).",-1,\n";
};
#####################
#
# VRML
package PDL::Graphics::VRML;
use PDL::Core '';
%PDL::Graphics::VRML::Protos = ();
sub new {
my ($type,$title,$info) = @_;
my $this = bless {},$type;
$this->{Header} = '#VRML V2.0 utf8';
$this->{Info} = PDL::Graphics::VRMLNode->new('WorldInfo',
'title' => $title,
'info' => $info);
$this->{NaviInfo} = PDL::Graphics::VRMLNode->new('NavigationInfo',
'type' => '["EXAMINE", "ANY"]');
$this->{Protos} = {};
$this->{Uses} = {};
$this->{Scene} = undef;
return $this;
}
sub register_proto {
my ($this,@protos) = @_;
for (@protos) {
barf "proto already registered"
if defined $PDL::Graphics::VRML::Protos{$_->{Name}};
$PDL::Graphics::VRML::Protos{$_->{Name}} = $_;
}
}
sub set_vrml {
print "set_vrml ",ref($_[0]),"\n";
$_[0]->{Scene} = $_[1];
}
sub uses {
$_[0]->{Uses}->{$_[1]} = 1;
}
sub ensure_protos {
my $this = shift;
for (sort keys %{$this->{Uses}}) {
barf "unknown Prototype $_" unless defined $PDL::Graphics::VRML::Protos{$_};
delete $this->{Uses}->{$_};
$this->add_proto($PDL::Graphics::VRML::Protos{$_});
}
}
sub add_proto {
my ($this,$proto) = @_;
$this->{Protos}->{$proto->{Name}} = $proto
unless exists $this->{Protos}->{$proto->{Name}};
return $this;
}
sub print {
my $this = shift;
if ($#_ > -1) {
my $file = ($_[0] =~ /^\s*[|>]/ ? '' : '>') .$_[0];
open VRML,"$file" or barf "can't open $file";
} else { *VRML = *STDOUT }
print VRML "$this->{Header}\n";
print VRML $this->{Info}->to_text;
print VRML $this->{NaviInfo}->to_text;
for (sort keys %{$this->{Protos}}) { print VRML $this->{Protos}->{$_}->to_text }
barf "no scene hierarchy" unless defined $this->{Scene};
print VRML $this->{Scene}->to_text;
close VRML if $#_ > -1;
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/VRML/0000755000175000017500000000000014776144103020175 5ustar osboxesosboxesPDL-Graphics-TriD-2.102/lib/PDL/Graphics/VRML/Protos.pm0000644000175000017500000000251314775155512022027 0ustar osboxesosboxespackage PDL::Graphics::VRML::Protos;
use strict;
use warnings;
PDL::Graphics::VRMLNode->import();
PDL::Graphics::VRMLProto->import();
sub PDLBlockText10 {
vrp('PDLBlockText10',
[fv3f('position',"0 0 0"),
fv3f('size',"1 1 0.1"),
fmstr('text','["TESTING PDL","TEXTBLOCK","LONG LONG LONG LONG LONG TEXT","Short","FOOOOOOOOOOOOOOOO"]')],
vrn('Transform',
'translation' => 'IS position',
'scale' => 'IS size',
'children' => [
vrn('Transform',
translation => '0 0 -0.55',
'children' => [vrn('Shape',
geometry => vrn('Box', size => '1 1 0.45'),
appearance => vrn('Appearance',
material => vrn('Material',
diffuseColor => '0.9 0.9 0.9',
ambientIntensity => '0.1'
)
)
)]
),
vrn('Transform',
translation => '-0.45 0.35 0',
scale => '0.9 0.9 0',
children => [
vrn('Shape',
geometry => vrn('Text',
string => 'IS text',
maxExtent => '1.0',
fontStyle =>
vrn('FontStyle',
size => '0.075',
spacing => '1.33',
justify => 'end'
),
),
appearance => vrn('Appearance',
material => vrn('Material',
diffuseColor => '0 0 0',
ambientIntensity => '0'
)
)
)
])
]
)
);
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/0000755000175000017500000000000014776144103020257 5ustar osboxesosboxesPDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/Image.pm0000644000175000017500000000575014775155512021653 0ustar osboxesosboxes# What makes this complicated is that we want
# imag(3,x,y,z,q,d,f)
# appear in one 2D image, flattened out appropriately, with
# one black space between the subimages.
# The X coordinate will be ((x+1)*z+1)*d and the
# Y coordinate ((y+1)*q+1)*f. We need to use splitdim to obtain
# an ndarray of the imag dimensions from the flat ndarray.
package PDL::Graphics::TriD::Image;
use strict;
use warnings;
our @ISA=qw/PDL::Graphics::TriD::Object/;
use PDL::Lite;
my $defaultvert = PDL->pdl([
[0,0,0],
[1,0,0],
[1,1,0],
[0,1,0]
]);
# r,g,b = 0..1
sub new {
my($type,$color,$opts) = @_;
my $im = PDL::Graphics::TriD::realcoords('COLOR',$color);
my $this = {
Im => $im,
Opts => $opts,
Points => $defaultvert,
};
if(defined $opts->{Points}) {
$this->{Points} = $opts->{Points};
if("ARRAY" eq ref $this->{Points}) {
$this->{Points} = PDL->pdl($this->{Points});
}
}
bless $this,$type;
}
sub get_points {
return $_[0]->{Points};
}
# In the future, have this happen automatically by the ndarrays.
sub data_changed {
my($this) = @_;
$this->changed;
}
# ND ndarray -> 2D
sub flatten {
my ($this,$bin_align) = @_;
my @dims = $this->{Im}->dims;
shift @dims; # get rid of the '3'
my $xd = $dims[0]; my $yd = $dims[1];
my $xdr = $xd; my $ydr = $yd;
# Calculate the whole width of the image.
my $ind = 0;
my $xm = 0; my $ym = 0;
for(@dims[2..$#dims]) {
if($ind % 2 == 0) {
$xd ++; # = $dims[$ind-2];
$xd *= $_;
$xdr ++;
$xdr *= $_;
# $xd --; # = $dims[$ind-2];
$xm++;
} else {
$yd ++; # = $dims[$ind-2];
$yd *= $_;
$ydr ++;
$ydr *= $_;
# $yd --; # = $dims[$ind-2];
$ym++;
}
$ind++;
}
$xd -= $xm; $yd -= $ym;
# R because the final texture must be 2**x-aligned ;(
my ($txd ,$tyd, $xxd, $yyd);
if ($bin_align) {
for($txd = 0; $txd < 12 and 2**$txd < $xdr; $txd++) {};
for($tyd = 0; $tyd < 12 and 2**$tyd < $ydr; $tyd++) {};
$txd = 2**$txd; $tyd = 2**$tyd;
$xxd = ($xdr > $txd ? $xdr : $txd);
$yyd = ($ydr > $tyd ? $ydr : $tyd);
if($#dims > 1) {
# print "XALL: $xd $yd $xdr $ydr $txd $tyd\n";
# print "DIMS: ",(join ',',$this->{Im}->dims),"\n";
}
# $PDL::debug=1;
} else {
$xxd=$txd=$xdr; $yyd=$tyd=$ydr;
}
my $p = PDL->zeroes(PDL::float(),3,$xxd,$yyd);
if(defined $this->{Opts}{Bg}) {
$p .= $this->{Opts}{Bg};
}
# print "MKFOOP\n";
my $foop = $p->slice(":,0:".($xdr-1).",0:".($ydr-1));
$ind = $#dims;
my $firstx = 1;
my $firsty = 1;
my $spi;
for(@dims[reverse(2..$#dims)]) {
if($ind % 2 == 0) {
$spi = $foop->getdim(1)/$_;
$foop = $foop->splitdim(1,$spi)->slice(":,0:-2")->
mv(2,3);
} else {
$spi = $foop->getdim(2)/$_;
$foop = $foop->splitdim(2,$spi)->slice(":,:,0:-2");
}
# print "IND+\n";
$ind++; # Just to keep even/odd correct
}
# $foop->dump;
print "ASSGNFOOP!\n" if $PDL::debug;
$foop .= $this->{Im};
# print "P: $p\n";
return wantarray() ? ($p,$xd,$yd,$txd,$tyd) : $p;
}
sub toimage {
# initially very simple implementation
my ($this) = @_;
return $this->flatten(0);
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/TextObjects.pm0000644000175000017500000000065214775155512023063 0ustar osboxesosboxes# These objects contain textual descriptions of the graph.
# Placed suitably in relation to origin to be used with a graph.
package PDL::Graphics::TriD::Description;
use strict;
use warnings;
our @ISA=qw/PDL::Graphics::TriD::Object/;
sub new {
my($type,$text) = @_;
local $_ = $text;
s/\\/\\\\/g;
s/"/\\"/g;
my $this = bless {
TText => "[".(join ',',map {"\"$_\""} split "\n",$_)."]"
},$type;
return $this;
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/Labels.pm0000644000175000017500000000232414776030722022021 0ustar osboxesosboxes=head1 NAME
PDL::Graphics::TriD::Labels - Text tools
=head1 SYNOPSIS
my $l = PDL::Graphics::TriD::Labels->new($lablepoints,
{Strings=>$strlist});
=head1 WARNING
This module is experimental and the interface will probably change.
=head1 DESCRIPTION
This module is used to write Labels on the graphs of TriD
=head1 AUTHOR
Copyright (C) 1997 Tuomas J. Lukka (lukka@husc.harvard.edu).
2000 James P. Edwards (jedwards@inmet.gov.br)
All rights reserved. There is no warranty. You are allowed
to redistribute this software / documentation under certain
conditions. For details, see the file COPYING in the PDL
distribution. If this file is separated from the PDL distribution,
the copyright notice should be included in the file.
=cut
package PDL::Graphics::TriD::Labels;
use strict;
use warnings;
use OpenGL qw/ :glfunctions :glconstants /;
use PDL::Graphics::OpenGLQ;
use PDL::Graphics::TriD::Objects;
use base qw/PDL::Graphics::TriD::GObject/;
sub gdraw {
my ($this,$points) = @_;
glDisable(&GL_LIGHTING);
glColor3d(1,1,1);
PDL::Graphics::OpenGLQ::gl_texts($points,@{$this->{Options}}{qw(Strings)});
glEnable(&GL_LIGHTING);
}
sub get_valid_options {
return {UseDefcols => 0, Strings => []}
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/VRML.pm0000644000175000017500000005001314775155512021401 0ustar osboxesosboxes=head1 NAME
PDL::Graphics::TriD::VRML -- TriD VRML backend
=head1 SYNOPSIS
BEGIN { $PDL::Graphics::TriD::device = "VRML"; }
use PDL::Graphics::TriD;
use PDL::LiteF;
# set some vrml parameters
my $set = tridsettings(); # get the defaults
$set->browser_com('netscape/unix');
$set->compress();
$set->file('/www-serv/vrml/dynamic_scene.wrl.gz');
line3d([$x,$y,$z]); # plot some lines and view the scene with a browser
=head1 DESCRIPTION
This module implements the VRML for PDL::Graphics::TriD (the generic
3D plotting interface for PDL). You can use this backend either (a)
for generating 3D graphics on your machine which can be directly
viewed with a VRML browser or (b) generate dynamic VRML worlds to
distribute over the web.
With VRML, you can generate objects for everyone to see with e.g.
Silicon Graphics' Cosmo Player. You can find out more about VRML
at C or C
=cut
package PDL::Graphics::TriD::VRML;
use strict;
use warnings;
use PDL::Core ''; # barf
use PDL::Graphics::VRML;
use PDL::LiteF;
PDL::Graphics::VRMLNode->import();
PDL::Graphics::VRMLProto->import();
$PDL::homepageURL = 'http://pdl.perl.org/';
sub PDL::Graphics::TriD::Logo::tovrml {
my ($this) = @_;
my ($p,$tri) = ("","");
PDL::Graphics::VRMLPdlNode::v3array($this->{Points},\$p,"");
PDL::Graphics::VRMLPdlNode::triangles((map
{$this->{Index}->slice("($_)")} (0..2)),\$tri,"");
my $indface = vrn('IndexedFaceSet',
'coord' => vrn('Coordinate',
'point' => "[ $p ]"),
'coordIndex' => "[ $tri ]",
'solid' => 'TRUE');
return vrn('Transform',
'children' => [vrn('Anchor',
'description' => "\"The PDL Homepage\"",
'url' => "\"$PDL::homepageURL\"",
'children' =>
vrn('Shape',
'appearance' =>
vrn('Appearance',
'material' =>
$this->{Material}->tovrml),
'geometry' => $indface)),
vrn('Viewpoint',
position => '0 0 25',
description => "\"PDL Logo\""
)
],
'translation' => vrml3v($this->{Pos}),
'scale' => vrml3v([map {$this->{Size}} (0..2)]));
}
sub PDL::Graphics::TriD::Description::tovrml {
my($this) = @_;
# print "DESCRTIPTION : TOVRML\n";
return vrn('Transform',
rotation => '1 0.1 0 1.1',
translation => '1.5 0 0.5',
children => [
vrn('Shape',
geometry => vrn('Text',
string => $this->{TText},
fontStyle => vrn('FontStyle',
'family' => "\"SANS\"",
size => '0.075',
spacing => '1.33',
justify => '["BEGIN","MIDDLE"]'
),
),
appearance => vrn('Appearance',
material => vrn('Material',
diffuseColor => '0.9 0.9 0.9',
ambientIntensity => '0.1'
)
)
),
vrn('Viewpoint',
position => '0 0 3',
description => "\"Description\""
)
]
);
}
sub PDL::Graphics::VRML::vrmltext {
my ($this,$text,$coords) = @_;
$this->uses('TriDGraphText');
return vrn('TriDGraphText',
'text' => "\"$text\"",
'position' => vrml3v($coords));
}
sub PDL::Graphics::TriD::Material::tovrml {
my $this = shift;
my $ambi = (pdl(@{$this->{Ambient}})**2)->sum /
(pdl(@{$this->{Diffuse}})**2)->sum;
$ambi = sqrt($ambi);
PDL::Graphics::VRMLNode->new('Material',
'diffuseColor' => vrml3v($this->{Diffuse}),
'emissiveColor' => vrml3v($this->{Emissive}),
'shininess' => $this->{Shine},
'ambientIntensity' => $ambi,
'specularColor' => vrml3v($this->{Specular}),
);
}
sub PDL::Graphics::TriD::Scale::tovrml {my ($this) = @_;
print "Scale ",(join ',',@{$this->{Args}}),"\n";
PDL::Graphics::VRMLNode->new('Transform',
'scale',vrml3v(@{$this->{Args}}));
}
sub PDL::Graphics::TriD::Translation::tovrml {
my ($this) = @_;
PDL::Graphics::VRMLNode->new('Transform',
'translation',vrml3v(@{$this->{Args}}));
}
# XXXXX this has to be fixed -> wrap in one transform + children
sub PDL::Graphics::TriD::Transformation::tovrml {
my($this) = @_;
my @nodes = map {$_->tovrml()} @{$this->{Transforms}};
push @nodes,$this->SUPER::tovrml();
}
sub PDL::Graphics::TriD::Quaternion::tovrml {my($this) = @_;
if(abs($this->[0]) == 1) { return ; }
if(abs($this->[0]) >= 1) {
# die "Unnormalised Quaternion!\n";
$this->normalise;
}
PDL::Graphics::VRMLNode->new('Transform',
'rotation',vrml3v(@{$this}[1..3])." $this->[0]");
}
# this 'poor mans viewport' implementation makes an image from its objects
# and writes it as a gif file
sub PDL::Graphics::TriD::ViewPort::togif_vp {
require PDL::IO::Pic;
my ($this,$win,$rec,$file) = @_;
my $p;
# this needs more thinking
for (@{$this->{Objects}}) {
barf "can't display object type" unless $_->can('toimage');
$p = $_->toimage;
}
$p->wpic($file);
}
sub PDL::Graphics::TriD::GObject::tovrml {
return $_[0]->vdraw($_[0]->{Points});
}
sub PDL::Graphics::TriD::GObject::tovrml_graph {
return $_[0]->vdraw($_[2]);
}
sub PDL::Graphics::TriD::Points::vdraw {
my($this,$points) = @_;
PDL::Graphics::VRMLNode->new('Shape',
'geometry' =>
PDL::Graphics::VRMLPdlNode->new($points,$this->{Colors},
{Title => 'PointSet',
DefColors => $this->defcols}));
}
sub PDL::Graphics::TriD::LineStrip::vdraw {
my($this,$points) = @_;
PDL::Graphics::VRMLNode->new('Shape',
'geometry' =>
PDL::Graphics::VRMLPdlNode->new($points,$this->{Colors},
{Title => 'IndexedLineSet',
DefColors => $this->defcols}));
}
sub PDL::Graphics::TriD::Lattice::vdraw {
my($this,$points) = @_;
PDL::Graphics::VRMLNode->new('Shape',
'geometry' =>
PDL::Graphics::VRMLPdlNode->new($points,$this->{Colors},
{Title => 'IndexedLineSet',
DefColors => $this->defcols,
IsLattice => 1}));
}
sub PDL::Graphics::TriD::SLattice::vdraw {
my($this,$points) = @_;
my $children = [vrn('Shape',
'geometry' =>
PDL::Graphics::VRMLPdlNode->new($points,$this->{Colors},
{Title => 'IndexedFaceSet',
DefColors => $this->defcols,
IsLattice => 1,
}))];
push @$children, vrn('Shape',
'geometry' =>
PDL::Graphics::VRMLPdlNode->new($points,$this->{Colors},
{Title => 'IndexedLineSet',
DefColors => 0,
Surface => 1,
Lines => 1,
IsLattice => 1,
}))
if $this->{Options}->{Lines};
vrn('Group',
'children' => $children);
}
sub PDL::Graphics::TriD::SLattice_S::vdraw {
my($this,$points) = @_;
my $vp = &PDL::Graphics::TriD::get_current_window()->current_viewport;
my $mat = $vp->{DefMaterial}->tovrml;
my $children = [vrn('Shape',
'appearance' => vrn('Appearance',
'material' => $mat),
'geometry' =>
PDL::Graphics::VRMLPdlNode->new($points,$this->{Colors},
{Title => 'IndexedFaceSet',
DefColors => 1,
IsLattice => 1,
Smooth => $this->{Options}->{Smooth},
}))];
push @$children, vrn('Shape',
'geometry' =>
PDL::Graphics::VRMLPdlNode->new($points,$this->{Colors},
{Title => 'IndexedLineSet',
DefColors => 0,
Surface => 1,
Lines => 1,
IsLattice => 1,
}))
if $this->{Options}->{Lines};
vrn('Group',
'children' => $children);
}
##################################
# PDL::Graphics::TriD::Image
#
#
sub PDL::Graphics::TriD::Image::tovrml {
$_[0]->vdraw();
}
sub PDL::Graphics::TriD::Image::tovrml_graph {
&PDL::Graphics::TriD::Image::tovrml;
}
# The quick method is to use texturing for the good effect.
# XXXXXXXXXXXX wpic currently rescales $im 0..255, that's not correct (in $url->save)! fix
sub PDL::Graphics::TriD::Image::vdraw {
my ($this,$vert) = @_;
my $p = $this->flatten(0); # no binary alignment
if(!defined $vert) {$vert = $this->{Points}}
my $url = PDL::Graphics::TriD::VRML::URL->new('image/JPG');
$url->save($p);
vrn('Shape',
'appearance' => vrn('Appearance',
'texture' => vrn('ImageTexture',
'url' => '"'.$url->totext.'"')),
'geometry' =>
vrn('IndexedFaceSet',
'coord' => vrn('Coordinate',
'point' =>
[map {vrml3v([$vert->slice(":,($_)")->list])}
(0..3)]),
'coordIndex' => '[0, 1, 2, 3, -1]',
'solid' => 'FALSE'),
);
}
sub PDL::Graphics::TriD::Graph::tovrml {
my($this) = @_;
my @children = ();
for(sort keys %{$this->{Axis}}) {
if($_ eq "Default") {next}
push @children, @{$this->{Axis}{$_}->tovrml_axis($this)};
}
for(sort keys %{$this->{Data}}) {
push @children,
$this->{Data}{$_}->tovrml_graph($this,$this->get_points($_));
}
return vrn('Group', 'children' => [@children]);
}
sub PDL::Graphics::TriD::EuclidAxes::tovrml_axis {
my($this,$graph) = @_;
my $vrml = $PDL::Graphics::VRML::current_window;
my $lset = vrn('Shape',
'geometry' => vrn('IndexedLineSet',
'coord',
vrn('Coordinate',
'point',["0 0 0",
"1 0 0",
"0 1 0",
"0 0 1"]),
'coordIndex',["0,1,-1",
"0,2,-1",
"0,3,-1"]));
my ($vert,$indx,$j) = ([],[],0);
my @children = ($lset);
for my $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) {
push @children, $vrml->vrmltext(sprintf("%.3f",$nc),[@coords]);
push @$vert,(vrml3v([@coords0]),vrml3v([@coords]));
push @$indx,$j++.", ".$j++.", -1";
$coords[$dim] += $radd;
$coords0[$dim] += $radd;
$nc += $nadd;
}
$coords0[$dim] = 1.1;
push @children, $vrml->vrmltext($this->{Names}[$dim],[@coords0]);
}
push @children, vrn('Shape',
'geometry' => vrn('IndexedLineSet',
'coord' =>
vrn('Coordinate',
'point' => $vert),
'coordIndex' => $indx));
return [@children];
}
sub PDL::Graphics::TriD::SimpleController::tovrml {
# World origin is disregarded XXXXXXX
my $this = shift;
my $inv = PDL::Graphics::TriD::Quaternion->new(@{$this->{WRotation}});
$inv->invert_rotation_this;
my $pos = $inv->rotate([0,0,1]);
# print "SC: POS0:",(join ',',@$pos),"\n";
for (@$pos) { $_ *= $this->{CDistance}}
# print "SC: POS:",(join ',',@$pos),"\n";
# ASSUME CRotation 0 for now
return vrn('Viewpoint',
'position' => vrml3v($pos),
# 'orientation' => vrml3v(@{$this->{CRotation}}[1..3]).
# " $this->{CRotation}->[0]",
'orientation' => vrml3v([@{$inv}[1..3]])." ".
-atan2(sqrt(1-$this->{WRotation}[0]**2),
$this->{WRotation}[0]),
'description' => "\"Home\"");
}
package #split this line so the
# CPAN indexer doesn't complain
Win32;
sub Win32::fn_win32_format {
my ($file) = @_;
$file =~ s|\\|/|g;
$file = "//$file" if $file =~ m|^[a-z,A-Z]+:|;
return $file;
}
package # hide from PAUSE
Win32::DDE::Netscape;
use PDL::Core ''; # barf
require Win32::DDE::Client if $^O =~ /win32/i;
sub checkerr {
my $this = shift;
if ($this->Error) {
print Win32::DDE::ErrorText($this->Error), "\n# ",
$this->ErrorText;
barf "client: couldn't connect to netscape";
}
return $this;
}
sub activate {
my $client = Win32::DDE::Client->new('Netscape','WWW_Activate');
checkerr($client);
$client->Request('0xFFFFFFFF,0x0');
barf "can't disconnect" unless $client->Disconnect;
}
sub geturl {
my ($url) = @_;
my $client = Win32::DDE::Client->new('Netscape','WWW_OpenURL');
checkerr($client);
my $status = $client->Request("\"$url\",,0xFFFFFFFF,0x1");
barf "can't disconnect" unless $client->Disconnect;
}
package PDL::Graphics::TriD::VRML::Parameter;
use PDL::Core ''; # barf
sub new {
my ($type,%hash) = @_;
bless {Mode => 'VRML', %hash},$type;
}
sub gifmode {
my ($this) = @_;
$this->{Mode} = 'GIF';
}
sub vrmlmode {
my ($this) = @_;
$this->{Mode} = 'VRML';
}
sub set {
my ($this,%hash) = @_;
@$this{keys %hash} = values %hash;
return $this;
}
sub browser {
my ($this) = @_;
$this->{'Browser'} = $_[1] if $#_ > 0;
return $this->{'Browser'};
}
sub file {
my ($this) = @_;
if ($#_ > 0) {
$this->{'GifFile'} = $_[1];
$this->{'GifFile'} =~ s/[.][^.]+$/.gif/;
$this->{'HTMLFile'} = $_[1];
$this->{'HTMLFile'} =~ s/[.][^.]+$/.html/;
$this->{'File'} = $_[1];
$this->{'File'} =~ s/[.][^.]+$/.wrl/;
}
if ($this->{Mode} eq 'VRML') {
return $this->{'File'};
} elsif ($this->{Mode} eq 'GIF') {
return $this->{'HTMLFile'};
} else {
barf "wfile error: unknown mode";
}
}
sub wfile {
my ($this) = @_;
my $file = $this->{Mode} eq 'GIF' ? $this->{GifFile} : $this->{File};
if (defined $this->{Compress} && $this->{Compress}) {
$file .= '.gz' unless $file =~ /[.]gz$/; $this->file($file);
$file = '|gzip -c' . ($file =~ /^\s*>/ ? '' : '>') . $file;
}
return $file;
}
$PDL::Graphics::TriD::VRML::Parameter::lastfile = '';
my %subs = (
'netscape/unix' =>
sub {my $file = $_[0]->file; my $cmd;
if ($file eq
$PDL::Graphics::TriD::VRML::Parameter::lastfile)
{ $cmd = 'reload' }
else { my $target = $#_ > 0 ? "#$_[1]" : '';
$cmd = "openURL(file:$file$target)"}
system('netscape','-remote',$cmd);
$PDL::Graphics::TriD::VRML::Parameter::lastfile = $file},
'netscape/win32' =>
sub {my $file = $_[0]->file; $file = Win32::fn_win32_format $file;
Win32::DDE::Netscape::activate;
my $target = $#_ > 0 ? "#$_[1]" : '';
Win32::DDE::Netscape::geturl("file:$file$target");
},
'none' => sub {print STDERR "not sending it anywhere\n"},
);
sub browser_com {
my ($this,$browser) = @_;
barf("unknown browser '$browser'") unless defined $subs{$browser};
$this->{'Browser'} = $subs{$browser};
}
sub send_to_browser {my $this=$_[0]; &{$this->{'Browser'}}(@_)
if defined $this->{'Browser'}}
package PDL::Graphics::TriD::VRML::URL;
use PDL::Core ''; # barf
require File::Temp;
my %types = (
'image/JPG' => {'save' => sub {local $PDL::debug=0; $_[1]->wpic($_[0]->wfile)},
'ext' => 'jpg',
'setup' => sub {require PDL::IO::Pic},
},
);
my $urlnum = 0;
sub new {
my ($type,$mime) = @_;
my $this = bless {},$type;
barf "unknown mime type '$mime'" unless defined $types{$mime};
$this->{'Type'} = $types{$mime};
&{$this->{'Type'}->{'setup'}} if defined $this->{'Type'}->{'setup'};
$this->{'Binding'} = 'local';
$this->{'Filestem'} = File::Temp::tempdir(CLEANUP=>1) . "/tridim_$urlnum";
$urlnum++;
return $this;
}
sub wfile {
my ($this) = @_;
return $this->{'Filestem'}.'.'.$this->{'Type'}->{'ext'};
}
sub totext {
my ($this) = @_;
my $proto;
if ($this->{'Binding'} eq 'local') { $proto = 'file' }
elsif ($this->{'Binding'} eq 'publish') {
$proto = 'http'; barf "not yet implemented" }
else { barf "unknown binding" }
return "$proto:".$this->wfile;
}
sub save { &{$_[0]->{Type}->{save}}(@_) }
package PDL::Graphics::TriD::VRML;
$PDL::Graphics::VRML::current_window = undef;
# set up the default parameters for VRML
my $tmpdir = File::Temp::tempdir(CLEANUP=>1);
my $tmpname = "$tmpdir/tridvrml_$$.wrl";
my $para = $PDL::Graphics::TriD::Settings =
PDL::Graphics::TriD::VRML::Parameter->new() ;
$para->file($tmpname);
$para->browser_com($^O =~ /win32/i ? 'netscape/win32' : 'none');
package PDL::Graphics::TriD::VRMLObject;
use base qw/PDL::Graphics::TriD::Object/;
use fields qw/Node/;
sub new {
my($type,$node) = @_;
my $this = $type->SUPER::new();
$this->{Node} = $node;
return $this;
}
sub tovrml {
return $_[0]->{Node};
}
#package PDL::Graphics::TriD::VRML::Window;
package PDL::Graphics::TriD::Window;
use PDL::Graphics::TriD::SimpleController;
PDL::Graphics::VRMLNode->import();
PDL::Graphics::VRMLProto->import();
use PDL::Core ''; # barf
use base qw/PDL::Graphics::TriD::Object/;
use fields qw/Width Height Interactive _ViewPorts _CurrentViewPort
VRMLTop DefMaterial/;
use strict;
$PDL::Graphics::TriD::VRML::fontstyle = $PDL::Graphics::TriD::VRML::fontstyle;
sub gdriver {
my($this) = @_;
require PDL if not defined $PDL::VERSION;
$this->{Width} = 300; $this->{Height} = 300;
$this->{VRMLTop} = PDL::Graphics::VRML->new("\"PDL::Graphics::TriD::VRML Scene\"",
["\"generated by the PDL::Graphics::TriD module\"",
"\"version $PDL::VERSION\""]);
my $fontstyle = PDL::Graphics::VRMLNode->new('FontStyle',
'size' => 0.04,
'family' => "\"SANS\"",
'justify' => "\"MIDDLE\"");
$PDL::Graphics::TriD::VRML::fontstyle = $fontstyle;
$this->{VRMLTop}->add_proto(PDL::Graphics::TriD::SimpleController->new->tovrml);
$PDL::Graphics::VRML::current_window = $this->{VRMLTop};
$this->{VRMLTop}->register_proto(
vrp('TriDGraphText',
[fv3f('position',"0 0 0"),
fmstr('text')],
vrn('Transform',
'translation' => "IS position",
'children' =>
[vrn('Billboard',
'axisOfRotation' => '0 0 0',
'children' =>
[vrn('Shape',
'geometry' =>
vrn('Text',
'string' => "IS text",
'fontStyle' => $fontstyle))])])));
return 0;
}
#sub set_material {
# $_[0]->{DefMaterial} = $_[1];
#}
# we only allow [0,0,1,1] viewports and just write a gif of the write size
# for any children
sub new_viewport {
my($this,$x0,$y0,$x1,$y1) = @_;
# print STDERR "Installing new viewport\n";
barf "only allowing [0,1,0,1] viewports with VRML backend"
if abs(PDL->pdl($x0,$y0,$x1-1,$y1-1))->max > 0.01;
my $vp = PDL::Graphics::TriD::ViewPort->new($x0,$y0,$x1,$y1);
push @{$this->{_ViewPorts}},$vp;
return $vp;
}
sub clear_viewports {
my($this) = @_;
$this->{_ViewPorts} = [];
}
sub display {
my $this = shift;
my $vrmlparam = $PDL::Graphics::TriD::Settings;
# if (@{$this->{_ViewPorts}}) {
if (0) {
# show the image
$vrmlparam->gifmode();
# print STDERR "writing a GIF image\n";
# print STDERR "Filename: ",$vrmlparam->wfile,"\n";
for(@{$this->{_ViewPorts}}) {
$_->togif_vp($this,$_,$vrmlparam->wfile);
}
my ($hfile,$gfile) = ($vrmlparam->file,$vrmlparam->wfile);
$hfile = '>'.$hfile unless $hfile =~ /^\s*[>|]/;
$gfile = Win32::fn_win32_format($gfile) if $^O =~ /win32/i;
open HTML, $hfile or barf "couldn't open html file $hfile";
print HTML <<"EOH";
PDL::Graphics::TriD Display
{H}
WIDTH=$this->{W}>
EOH
close HTML;
$vrmlparam->send_to_browser();
} else {
# a 'normal' world
# print STDERR "printing a VRML world\n";
# print STDERR "Filename: ",$vrmlparam->wfile,"\n";
my $vp = $this->current_viewport;
$vp->tovrml;
if ($vp->{Transformer}) {
$this->{VRMLTop}->addview($vp->{Transformer}->tovrml)
}
$this->{VRMLTop}->ensure_protos();
# use Data::Dumper;
# my $out = Dumper($this->{VRML});
# print $out;
$this->{VRMLTop}->set_vrml($vp->{VRML});
$vrmlparam->vrmlmode();
local $| = 1;
print "*********starting output\n";
$this->{VRMLTop}->print($vrmlparam->wfile);
print "*********finished output\n";
$vrmlparam->send_to_browser('Home'); #XXX make target selectable
}
}
$PDL::Graphics::TriD::keeptwiddling = $PDL::Graphics::TriD::keeptwiddling;
sub twiddle {
my $this = shift;
if ($PDL::Graphics::TriD::keeptwiddling) {
$this->display();
print "---- (press enter)";
<>
}
# should probably wait for input of character 'q' ?
}
package PDL::Graphics::TriD::ViewPort;
use base qw/PDL::Graphics::TriD::Object/;
use fields qw/X0 Y0 W H Transformer EHandler Active ResizeCommands
DefMaterial AspectRatio Graphs/;
1;
=head1 BUGS
Probably incomplete/buggy implementation of some TriD features.
=head1 AUTHOR
Copyright (C) 1997, 1998 Christian Soeller (c.soeller@auckland.ac.nz).
All rights reserved. There is no warranty. You are allowed
to redistribute this software / documentation under certain
conditions. For details, see the file COPYING in the PDL
distribution. If this file is separated from the PDL distribution,
the copyright notice should be included in the file.
=cut
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/SimpleController.pm0000644000175000017500000000271014775155512024117 0ustar osboxesosboxes##############################################
# A quaternion-based controller framework with the following transformations:
# 1. world "origin". This is what the world revolves around
# 2. world "rotation" at origin.
# 3. camera "distance" along z axis after that (camera looks
# at negative z axis).
# 4. camera "rotation" after that (not always usable).
package PDL::Graphics::TriD::SimpleController;
use strict;
use warnings;
use fields qw/WOrigin WRotation CDistance CRotation/;
sub new{
my ($class) = @_;
my $self = fields::new($class);
$self->reset();
$self;
}
sub normalize { my($this) = @_;
$this->{WRotation}->normalise;
$this->{CRotation}->normalise;
}
sub reset {
my($this) = @_;
$this->{WOrigin} = [0.5,0.5,0.5];
$this->{WRotation} = PDL::Graphics::TriD::Quaternion->new(
0.715, -0.613, -0.204, -0.272); # isometric-ish like gnuplot
$this->{CDistance} = 2.5;
$this->{CRotation} = PDL::Graphics::TriD::Quaternion->new(1,0,0,0);
}
sub set {
my($this,$options) = @_;
foreach my $what (keys %$options){
if($what =~ /Rotation/){
$this->{$what}[0] = $options->{$what}[0];
$this->{$what}[1] = $options->{$what}[1];
$this->{$what}[2] = $options->{$what}[2];
$this->{$what}[3] = $options->{$what}[3];
}elsif($what eq 'WOrigin'){
$this->{$what}[0] = $options->{$what}[0];
$this->{$what}[1] = $options->{$what}[1];
$this->{$what}[2] = $options->{$what}[2];
}else{
$this->{$what} = $options->{$what};
}
}
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/ButtonControl.pm0000644000175000017500000000506314775155512023442 0ustar osboxesosboxes#!/usr/bin/perl
#
# PDL::Graphics::TriD::ButtonControl - This package simply defines
# default event handler subroutines. $Revision$
#
# James P. Edwards
# Instituto Nacional de Meteorologia
# Brasilia, DF, Brasil
# jedwards@inmet.gov.br
#
# This distribution is free software; you can
# redistribute it and/or modify it under the same terms as Perl itself.
#
=head1 NAME
PDL::Graphics::TriD::ButtonControl - default event handler subroutines
=head1 FUNCTIONS
=head2 new()
=for ref
Bless an oject into the class ButtonControl, expects the associated
Window object to be supplied as an argument.
=for usage
The ButtonControl class is a base class which all TriD event
controllers should inherit from. By itself it does not do much. It
defines ButtonPress and ButtonRelease functions which are expected by
the Event loop.
=cut
package PDL::Graphics::TriD::ButtonControl;
use strict;
use warnings;
use fields qw/Win W H SC/;
$PDL::Graphics::TriD::verbose //= 0;
sub new {
my ($class,$win) = @_;
my $self = fields::new($class);
$self->{Win} = $win;
$self;
}
=head2 mouse_moved
=for ref
A do-nothing function to prevent errors if not defined in a subclass
=cut
sub mouse_moved{
print "mouse_moved @_\n" if $PDL::Graphics::TriD::verbose;
}
=head2 ButtonRelease
=for ref
A do nothing function to prevent errors if not defined in a subclass
=cut
sub ButtonRelease{
my ($this,$x,$y) = @_;
print "ButtonRelease @_\n" if $PDL::Graphics::TriD::verbose;
$this->{Win}{Active} = 0;
}
=head2 ButtonPress
=for ref
Activates the viewport the mouse is inside when pressed
=cut
$PDL::Graphics::TriD::current_window = $PDL::Graphics::TriD::current_window; # warnings
sub ButtonPress{
my ($this,$x,$y) = @_;
print "ButtonPress @_ ",ref($this->{Win}),"\n" if $PDL::Graphics::TriD::verbose;
#
# GL (0,0) point is Lower left X and Tk is upper left.
#
$y = $PDL::Graphics::TriD::current_window->{Height}-$y;
# print "$x $y ",$this->{Win}{X0}," ",$this->{Win}{Y0}," ",$this->{Win}{W}," ",$this->{Win}{H},"\n";
if($this->{Win}{X0} <= $x && $this->{Win}{X0}+$this->{Win}{W}>=$x
&& $this->{Win}{Y0} <= $y && $this->{Win}{Y0}+$this->{Win}{H}>=$y ){
$this->{Win}{Active} = 1;
}
}
=head2 set_wh
=for ref
Define the width and Height of the window for button control
=cut
sub set_wh {
my($this,$w,$h) = @_;
print ref($this)," $w,$h\n" if $PDL::Graphics::TriD::verbose;
$this->{W} = $w;
$this->{H} = $h;
$w = 0 unless defined $w;
$h = 0 unless defined $h;
if($w > $h) {
$this->{SC} = $h/2;
} else {
$this->{SC} = $w/2;
}
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/GL.pm0000644000175000017500000006440214776143612021131 0ustar osboxesosboxesuse strict;
use warnings;
no warnings 'redefine';
use OpenGL qw/ :glfunctions :glconstants gluPerspective gluOrtho2D /;
use PDL::Core qw(barf);
sub PDL::Graphics::TriD::Material::togl{
my $this = shift;
my $shin = pack "f*",$this->{Shine};
glMaterialfv(GL_FRONT_AND_BACK,GL_SHININESS,$shin);
my $spec = pack "f*",@{$this->{Specular}};
glMaterialfv(GL_FRONT_AND_BACK,GL_SPECULAR,$spec);
my $amb = pack "f*",@{$this->{Ambient}};
glMaterialfv(GL_FRONT_AND_BACK,GL_AMBIENT,$amb);
my $diff = pack "f*",@{$this->{Diffuse}};
glMaterialfv(GL_FRONT_AND_BACK,GL_DIFFUSE,$diff);
}
$PDL::Graphics::TriD::verbose //= 0;
sub PDL::Graphics::TriD::Object::gl_update_list {
my($this) = @_;
glDeleteLists($this->{List},1) if $this->{List};
$this->{List} = my $lno = glGenLists(1);
print "GENLIST $lno\n" if($PDL::Graphics::TriD::verbose);
glNewList($lno,GL_COMPILE);
eval {
my @objs = @{$this->{Objects}};
$_->togl() for @objs;
print "EGENLIST $lno\n" if($PDL::Graphics::TriD::verbose);
};
{ local $@; glEndList(); }
die if $@;
print "VALID1 $this\n" if($PDL::Graphics::TriD::verbose);
$this->{ValidList} = 1;
}
sub PDL::Graphics::TriD::Object::gl_call_list {
my($this) = @_;
print "CALLIST ",$this->{List}//'undef',"!\n" if $PDL::Graphics::TriD::verbose;
print "CHECKVALID $this=$this->{ValidList}\n" if $PDL::Graphics::TriD::verbose;
$this->gl_update_list if !$this->{ValidList};
glCallList($this->{List});
}
sub PDL::Graphics::TriD::Object::delete_displist {
my($this) = @_;
return if !$this->{List};
glDeleteLists($this->{List},1);
delete @$this{qw(List ValidList)};
}
sub PDL::Graphics::TriD::Object::togl { $_->togl for @{$_[0]->{Objects}} }
my @bb1 = ([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]);
my @bb2 = ([0,1,2],[3,1,2],[0,1,5],[3,1,5],[0,4,5],[3,4,5]);
sub PDL::Graphics::TriD::BoundingBox::togl {
my($this) = @_;
$this = $this->{Box};
glDisable(GL_LIGHTING);
glColor3d(1,1,1);
glBegin(GL_LINES);
glVertex3d(@{$this}[@$_]) for @bb1;
glEnd();
glBegin(GL_LINE_STRIP);
glVertex3d(@{$this}[@$_]) for @bb2;
glEnd();
glEnable(GL_LIGHTING);
}
sub PDL::Graphics::TriD::Graph::togl {
my($this) = @_;
$this->{Axis}{$_}->togl_axis($this) for grep $_ ne "Default", keys %{$this->{Axis}};
$this->{Data}{$_}->togl_graph($this,$this->get_points($_)) for keys %{$this->{Data}};
}
use PDL;
sub PDL::Graphics::TriD::CylindricalEquidistantAxes::togl_axis {
my($this,$graph) = @_;
my (@nadd,@nc,@ns);
for my $dim (0..1) {
my $width = $this->{Scale}[$dim][1]-$this->{Scale}[$dim][0];
if($width > 100){
$nadd[$dim] = 10;
}elsif($width>30){
$nadd[$dim] = 5;
}elsif($width>20){
$nadd[$dim] = 2;
}else{
$nadd[$dim] = 1;
}
$nc[$dim] = int($this->{Scale}[$dim][0]/$nadd[$dim])*$nadd[$dim];
$ns[$dim] = int($width/$nadd[$dim])+1;
}
# can be changed to topo heights?
my $verts = zeroes(3,$ns[0],$ns[1]);
(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("1")) .= $verts->zlinvals($nc[1],$nc[1]+$nadd[1]*($ns[1]-1));
my $tverts = zeroes(3,$ns[0],$ns[1]);
$tverts = $this->transform($tverts,$verts,[0,1,2]);
glDisable(GL_LIGHTING);
glColor3d(1,1,1);
for(my $j=0;$j<$tverts->getdim(2)-1;$j++){
my $j1=$j+1;
glBegin(GL_LINES);
for(my $i=0;$i<$tverts->getdim(1)-1;$i++){
my $i1=$i+1;
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,$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,$j),$tverts->at(1,$i,$j));
}
glEnd();
}
glEnable(GL_LIGHTING);
}
sub PDL::Graphics::TriD::EuclidAxes::togl_axis {
my($this,$graph) = @_;
print "togl_axis: got object type " . ref($this) . "\n" if $PDL::Graphics::TriD::verbose;
glLineWidth(1); # ought to be user defined
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)->transpose->flat->transpose;
my @label = map sprintf("%.3f", $_), @{ $axisvals->flat->unpdl };
push @label, @{$this->{Names}};
glColor3d(1,1,1);
PDL::Graphics::OpenGLQ::gl_texts($ends->glue(1, $id3), \@label);
PDL::gl_lines_nc($line_coord->splitdim(0,3)->clump(1,2));
glEnable(GL_LIGHTING);
}
use POSIX qw//;
sub PDL::Graphics::TriD::Quaternion::togl {
my($this) = @_;
if(abs($this->[0]) == 1) { return ; }
if(abs($this->[0]) >= 1) {
$this->normalise;
}
glRotatef(2*POSIX::acos($this->[0])/3.14*180, @{$this}[1..3]);
}
##################################
# Graph Objects
sub PDL::Graphics::TriD::GObject::togl {
$_[0]->gdraw($_[0]->{Points});
}
# (this,graphs,points)
sub PDL::Graphics::TriD::GObject::togl_graph {
$_[0]->gdraw($_[2]);
}
sub PDL::Graphics::TriD::Points::gdraw {
my($this,$points) = @_;
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
$this->glOptions;
glDisable(GL_LIGHTING);
eval {
PDL::gl_points_col($points,$this->{Colors});
};
{ local $@; glPopAttrib(); }
die if $@;
}
sub PDL::Graphics::TriD::Spheres::gdraw {
my($this,$points) = @_;
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
$this->glOptions;
glEnable(GL_LIGHTING);
glShadeModel(GL_SMOOTH);
eval {
PDL::gl_spheres($points, 0.025, 15, 15);
};
{ local $@; glPopAttrib(); }
die if $@;
}
sub PDL::Graphics::TriD::Lattice::gdraw {
my($this,$points) = @_;
barf "Need 3D points AND colours"
if grep $_->ndims < 3, $points, $this->{Colors};
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
$this->glOptions;
glDisable(GL_LIGHTING);
eval {
PDL::gl_line_strip_col($points,$this->{Colors});
PDL::gl_line_strip_col($points->xchg(1,2),$this->{Colors}->xchg(1,2));
};
{ local $@; glPopAttrib(); }
die if $@;
}
sub PDL::Graphics::TriD::LineStrip::gdraw {
my($this,$points) = @_;
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
$this->glOptions;
glDisable(GL_LIGHTING);
eval {
PDL::gl_line_strip_col($points,$this->{Colors});
};
{ local $@; glPopAttrib(); }
die if $@;
}
sub PDL::Graphics::TriD::Lines::gdraw {
my($this,$points) = @_;
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
$this->glOptions;
glDisable(GL_LIGHTING);
eval {
PDL::gl_lines_col($points,$this->{Colors});
};
{ local $@; glPopAttrib(); }
die if $@;
}
sub PDL::Graphics::TriD::GObject::glOptions {
my ($this) = @_;
glLineWidth($this->{Options}{LineWidth} || 1);
glPointSize($this->{Options}{PointSize} || 1);
glEnable(GL_DEPTH_TEST); # moved here from gdriver else GLFW evaporates it
glEnable(GL_LIGHTING);
glEnable(GL_LIGHT0);
glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE);
glLightfv_s(GL_LIGHT0,GL_POSITION,pack "f*",1.0,1.0,1.0,0.0);
}
sub PDL::Graphics::TriD::GObject::_lattice_lines {
my ($this, $points) = @_;
glDisable(GL_LIGHTING);
glColor3f(0,0,0);
PDL::gl_line_strip_nc($points);
PDL::gl_line_strip_nc($points->xchg(1,2));
}
sub PDL::Graphics::TriD::Contours::gdraw {
my ($this,$points) = @_;
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
$this->glOptions;
glDisable(GL_LIGHTING);
eval {
my $pi = $this->{PathIndex};
my ($pcnt, $i, $thisind) = (0, 0, 0);
for my $ie (grep defined, @{$this->{ContourPathIndexEnd}}) {
my $colors = $this->{Colors};
$colors = $colors->slice(":,($i)") if $colors->getndims==2;
my $this_pi = $pi->slice("$pcnt:$ie");
for ($this_pi->list) {
PDL::gl_line_strip_col($points->slice(",$thisind:$_"), $colors);
$thisind = $_ + 1;
}
$i++;
$pcnt=$ie+1;
}
if (defined $this->{Labels}){
glColor3d(1,1,1);
my $seg = sprintf ":,%d:%d",$this->{Labels}[0],$this->{Labels}[1];
PDL::Graphics::OpenGLQ::gl_texts($points->slice($seg),
$this->{LabelStrings});
}
};
{ local $@; glPopAttrib(); }
die if $@;
}
my @sls1 = (
":,0:-2,0:-2",
":,1:-1,0:-2",
":,0:-2,1:-1");
my @sls2 = (
":,1:-1,1:-1",
":,0:-2,1:-1",
":,1:-1,0:-2");
sub _lattice_slice {
my ($f, @pdls) = @_;
for my $s (\@sls1, \@sls2) {
my @args;
for my $p (@pdls) {
push @args, map $p->slice($_), @$s;
}
&$f(@args);
}
}
sub PDL::Graphics::TriD::SLattice::gdraw {
my($this,$points) = @_;
barf "Need 3D points"
if grep $_->ndims < 3, $points;
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
$this->glOptions;
glDisable(GL_LIGHTING);
glShadeModel(GL_SMOOTH); # By-vertex doesn't make sense otherwise.
eval {
_lattice_slice(\&PDL::gl_triangles, $points, $this->{Colors});
$this->_lattice_lines($points) if $this->{Options}{Lines};
};
{ local $@; glPopAttrib(); }
die if $@;
}
sub PDL::Graphics::TriD::SCLattice::gdraw {
my($this,$points) = @_;
barf "Need 3D points"
if grep $_->ndims < 3, $points;
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
$this->glOptions;
glDisable(GL_LIGHTING);
glShadeModel(GL_FLAT); # By-vertex doesn't make sense otherwise.
eval {
_lattice_slice(\&PDL::gl_triangles, $points, $this->{Colors});
$this->_lattice_lines($points) if $this->{Options}{Lines};
};
{ local $@; glPopAttrib(); }
die if $@;
}
sub PDL::Graphics::TriD::SLattice_S::gdraw {
my($this,$points) = @_;
barf "Need 3D points"
if grep $_->ndims < 3, $points;
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
$this->glOptions;
glShadeModel(GL_SMOOTH); # By-vertex doesn't make sense otherwise.
eval {
my $f = 'PDL::gl_triangles_';
$f .= 'w' if $this->{Options}{Smooth};
$f .= 'n_mat';
{ no strict 'refs'; $f = \&$f; }
my @pdls = $points;
push @pdls, $this->{Normals} if $this->{Options}{Smooth};
push @pdls, $this->{Colors};
_lattice_slice($f, @pdls);
$this->_lattice_lines($points) if $this->{Options}{Lines};
if ($this->{Options}{ShowNormals}) {
die "No normals to show!" if !defined $this->{Normals};
my $arrows = $points->append($points + $this->{Normals}*0.1)->splitdim(0,3);
glDisable(GL_LIGHTING);
glColor3d(1,1,1);
PDL::Graphics::OpenGLQ::gl_arrows($arrows, 0, 1, 0.5, 0.02);
}
};
{ local $@; glPopAttrib(); }
die if $@;
}
sub PDL::Graphics::TriD::STrigrid_S::gdraw {
my($this,$points) = @_;
my $faces = $points->dice_axis(1,$this->{Faceidx}->flat)->splitdim(1,3);
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
$this->glOptions;
eval {
glShadeModel(GL_SMOOTH); # By-vertex doesn't make sense otherwise.
my @sls = (":,(0)",":,(1)",":,(2)");
my $idx = [0,1,2,0]; # for lines, below
if ($this->{Options}{Smooth}) {
my $tmpn=$this->{Normals}->dice_axis(1,$this->{Faceidx}->flat)
->splitdim(1,$this->{Faceidx}->dim(0));
PDL::gl_triangles_wn_mat(map $_->mv(1,-1)->dog, $faces, $tmpn, $this->{Colors});
if ($this->{Options}{ShowNormals}) {
my $arrows = $points->append($points + $this->{Normals}*0.1)->splitdim(0,3);
glDisable(GL_LIGHTING);
glColor3d(1,1,1);
PDL::Graphics::OpenGLQ::gl_arrows($arrows, 0, 1, 0.5, 0.02);
my $facecentres = $faces->transpose->avgover;
my $facearrows = $facecentres->append($facecentres + $this->{FaceNormals}*0.1)->splitdim(0,3);
glColor3d(0.5,0.5,0.5);
PDL::Graphics::OpenGLQ::gl_arrows($facearrows, 0, 1, 0.5, 0.02);
}
} else {
PDL::gl_triangles_n_mat(map $_->mv(1,-1)->dog, $faces, $this->{Colors});
}
if ($this->{Options}{Lines}) {
glDisable(GL_LIGHTING);
glColor3f(0,0,0);
PDL::gl_lines_nc($this->{Faces}->dice_axis(1,$idx));
}
};
{ local $@; glPopAttrib(); }
die if $@;
}
sub PDL::Graphics::TriD::STrigrid::gdraw {
my($this,$points) = @_;
my $faces = $points->dice_axis(1,$this->{Faceidx}->flat)->splitdim(1,3);
# faces is 3D pdl slices of points, giving cart coords of face verts
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
$this->glOptions;
eval {
glDisable(GL_LIGHTING);
glShadeModel(GL_SMOOTH); # By-vertex doesn't make sense otherwise.
PDL::gl_triangles(map $_->mv(1,-1)->dog, $faces, $this->{Colors});
if ($this->{Options}{Lines}) {
glColor3f(0,0,0);
PDL::gl_lines_nc($faces->dice_axis(1, [0,1,2,0]));
}
};
{ local $@; glPopAttrib(); }
die if $@;
}
##################################
# PDL::Graphics::TriD::Image
sub PDL::Graphics::TriD::Image::togl {
# A special construct which always faces the display and takes the entire window
glMatrixMode(GL_MODELVIEW);
glLoadIdentity();
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
gluOrtho2D(0,1,0,1);
&PDL::Graphics::TriD::Image::togl_graph;
}
sub PDL::Graphics::TriD::Image::togl_graph {
$_[0]->gdraw();
}
# The quick method is to use texturing for the good effect.
sub PDL::Graphics::TriD::Image::gdraw {
my($this,$vert) = @_;
my ($p,$xd,$yd,$txd,$tyd) = $this->flatten(1); # do binary alignment
if(!defined $vert) {$vert = $this->{Points}}
barf "Need 3,4 vert"
if grep $_->dim(1) < 4 || $_->dim(0) != 3, $vert;
glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
glColor3d(1,1,1);
glTexImage2D_s(GL_TEXTURE_2D, 0, GL_RGB, $txd, $tyd, 0, GL_RGB, GL_FLOAT, $p->get_dataref());
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_WRAP_S, GL_REPEAT );
glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT );
glDisable(GL_LIGHTING);
glNormal3d(0,0,1);
glEnable(GL_TEXTURE_2D);
glBegin(GL_QUADS);
eval {
my @texvert = (
[0,0],
[$xd/$txd, 0],
[$xd/$txd, $yd/$tyd],
[0, $yd/$tyd]
);
for(0..3) {
glTexCoord2f(@{$texvert[$_]});
glVertex3f($vert->slice(":,($_)")->list);
}
};
{ local $@; glEnd(); glPopAttrib(); }
die if $@;
}
sub PDL::Graphics::TriD::SimpleController::togl {
my($this) = @_;
$this->{CRotation}->togl();
glTranslatef(0,0,-$this->{CDistance});
$this->{WRotation}->togl();
glTranslatef(map {-$_} @{$this->{WOrigin}});
}
##############################################
# A window with mouse control over rotation.
package PDL::Graphics::TriD::Window;
use OpenGL qw/ :glfunctions :glconstants /;
use base qw/PDL::Graphics::TriD::Object/;
use fields qw/Ev Width Height Interactive _GLObject
_ViewPorts _CurrentViewPort /;
sub gdriver {
my($this, $options) = @_;
print "GL gdriver...\n" if($PDL::Graphics::TriD::verbose);
if(defined $this->{_GLObject}){
print "WARNING: Graphics Driver already defined for this window \n";
return;
}
my $window_type = $ENV{POGL_WINDOW_TYPE} || 'glfw';
my $gl_class = $window_type =~ /x11/i ? 'PDL::Graphics::TriD::GL::GLX' :
$window_type =~ /glut/i ? 'PDL::Graphics::TriD::GL::GLUT' :
'PDL::Graphics::TriD::GL::GLFW';
(my $file = $gl_class) =~ s#::#/#g; require "$file.pm";
print "gdriver: Calling $gl_class(@$options{qw(width height)})\n" if $PDL::Graphics::TriD::verbose;
$this->{_GLObject} = $gl_class->new($options, $this);
print "gdriver: Calling glClearColor...\n" if $PDL::Graphics::TriD::verbose;
glClearColor(0,0,0,1);
glShadeModel(GL_FLAT);
glEnable(GL_NORMALIZE);
glColor3f(1,1,1);
print "STARTED OPENGL!\n" if $PDL::Graphics::TriD::verbose;
if($PDL::Graphics::TriD::offline) {
$this->doconfig($options->{width}, $options->{height});
}
return 1; # Interactive Window
}
sub ev_defaults{
return { ConfigureNotify => \&doconfig,
MotionNotify => \&domotion,
}
}
sub reshape {
my($this,$x,$y) = @_;
my $pw = $this->{Width};
my $ph = $this->{Height};
$this->{Width} = $x; $this->{Height} = $y;
for my $vp (@{$this->{_ViewPorts}}){
my $nw = $vp->{W} + ($x-$pw) * $vp->{W}/$pw;
my $nx0 = $vp->{X0} + ($x-$pw) * $vp->{X0}/$pw;
my $nh = $vp->{H} + ($y-$ph) * $vp->{H}/$ph;
my $ny0 = $vp->{Y0} + ($y-$ph) * $vp->{Y0}/$ph;
print "reshape: resizing viewport to $nx0,$ny0,$nw,$nh\n" if($PDL::Graphics::TriD::verbose);
$vp->resize($nx0,$ny0,$nw,$nh);
}
}
sub twiddle {
my($this,$getout,$dontshow) = @_;
my (@e);
my $quit;
if ($PDL::Graphics::TriD::offline) {
$PDL::Graphics::TriD::offlineindex ++;
$this->display();
require PDL::IO::Pic;
wpic($this->read_picture(),"PDL_$PDL::Graphics::TriD::offlineindex.jpg");
return;
}
return if $getout and $dontshow and !$this->{_GLObject}->event_pending;
$getout //= !($PDL::Graphics::TriD::keeptwiddling && $PDL::Graphics::TriD::keeptwiddling);
$this->display();
TWIDLOOP: while(1) {
print "EVENT!\n" if $PDL::Graphics::TriD::verbose;
my $hap = 0;
my $gotev = 0;
if ($this->{_GLObject}->event_pending or !$getout) {
@e = $this->{_GLObject}->next_event;
$gotev=1;
}
print "e= ".join(",",$e[0]//'undef',@e[1..$#e])."\n" if $PDL::Graphics::TriD::verbose;
if (@e and defined $e[0]) {
if ($e[0] eq 'visible') {
$hap = 1;
} elsif ($e[0] eq 'reshape') {
print "CONFIGNOTIFE\n" if $PDL::Graphics::TriD::verbose;
$this->reshape(@e[1,2]);
$hap=1;
} elsif ($e[0] eq 'destroy') {
print "DESTROYNOTIFE\n" if $PDL::Graphics::TriD::verbose;
$quit = 1;
$hap=1;
$this->close;
last TWIDLOOP;
} elsif ($e[0] eq 'keypress') {
print "KEYPRESS: '$e[1]'\n" if $PDL::Graphics::TriD::verbose;
if (lc($e[1]) eq "q") {
$quit = 1;
last TWIDLOOP if not $getout;
}
if (lc($e[1]) eq "c") {
$quit = 2;
}
$hap=1;
}
}
if ($gotev) {
foreach my $vp (@{$this->{_ViewPorts}}) {
if (defined($vp->{EHandler})) {
$hap += $vp->{EHandler}->event(@e) || 0;
}
}
}
if (!$this->{_GLObject}->event_pending) {
$this->display if $hap;
last TWIDLOOP if $getout;
}
@e = ();
}
print "STOPTWIDDLE\n" if $PDL::Graphics::TriD::verbose;
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;
}
# Resize window.
sub doconfig {
my($this,$x,$y) = @_;
$this->reshape($x,$y);
print "CONFIGURENOTIFY\n" if($PDL::Graphics::TriD::verbose);
}
sub domotion {
my($this) = @_;
print "MOTIONENOTIFY\n" if($PDL::Graphics::TriD::verbose);
}
sub display {
my($this) = @_;
return unless defined($this);
$this->{_GLObject}->set_window; # for multiwindow support
print "display: calling glClear()\n" if ($PDL::Graphics::TriD::verbose);
glClear(GL_COLOR_BUFFER_BIT|GL_DEPTH_BUFFER_BIT);
glMatrixMode(GL_MODELVIEW);
for my $vp (@{$this->{_ViewPorts}}) {
glPushMatrix();
$vp->do_perspective();
if($vp->{Transformer}) {
print "display: transforming viewport!\n" if ($PDL::Graphics::TriD::verbose);
$vp->{Transformer}->togl();
}
$vp->gl_call_list();
glPopMatrix();
}
$this->{_GLObject}->swap_buffers;
print "display: after SwapBuffers\n" if $PDL::Graphics::TriD::verbose;
}
# should this really be in viewport?
sub read_picture {
my($this) = @_;
my($w,$h) = @{$this}{qw/Width Height/};
my $res = PDL->zeroes(PDL::byte,3,$w,$h);
glPixelStorei(GL_UNPACK_ALIGNMENT,1);
glPixelStorei(GL_PACK_ALIGNMENT,1);
glReadPixels_s(0,0,$w,$h,GL_RGB,GL_UNSIGNED_BYTE,$res->get_dataref);
return $res;
}
######################################################################
######################################################################
# EVENT HANDLER MINIPACKAGE FOLLOWS!
package PDL::Graphics::TriD::EventHandler;
use OpenGL qw(
ConfigureNotify MotionNotify DestroyNotify
ButtonPress ButtonRelease Button1Mask Button2Mask Button3Mask Button4Mask
);
use fields qw/X Y Buttons VP/;
sub new {
my $class = shift;
my $vp = shift;
my $self = fields::new($class);
$self->{X} = -1;
$self->{Y} = -1;
$self->{Buttons} = [];
$self->{VP} = $vp;
$self;
}
sub event {
my($this,$type,@args) = @_;
print "EH: ",ref($this)," $type (",join(",",@args),")\n" if $PDL::Graphics::TriD::verbose;
return if !defined $type;
my $retval;
if ($type eq 'motion') {
return if (my $but = $args[0]) < 0;
print "MOTION $args[0]\n" if $PDL::Graphics::TriD::verbose;
if ($this->{Buttons}[$but] and $this->{VP}->{Active}) {
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(@$this{qw(X Y)}, @args[1,2]);
}
@$this{qw(X Y)} = @args[1,2];
} elsif ($type eq 'buttonpress') {
my $but = $args[0]-1;
print "BUTTONPRESS $but\n" if $PDL::Graphics::TriD::verbose;
@$this{qw(X Y)} = @args[1,2];
$retval = $this->{Buttons}[$but]->ButtonPress(@args[1,2])
if $this->{Buttons}[$but];
} elsif ($type eq 'buttonrelease') {
my $but = $args[0]-1;
print "BUTTONRELEASE $but\n" if $PDL::Graphics::TriD::verbose;
$retval = $this->{Buttons}[$but]->ButtonRelease($args[1],$args[2])
if $this->{Buttons}[$but];
} elsif ($type eq 'reshape') {
# Kludge to force reshape of the viewport associated with the window -CD
print "ConfigureNotify (".join(",",@args).")\n" if $PDL::Graphics::TriD::verbose;
print "viewport is $this->{VP}\n" if $PDL::Graphics::TriD::verbose;
}
$retval;
}
sub set_button {
my($this,$butno,$act) = @_;
$this->{Buttons}[$butno] = $act;
}
######################################################################
######################################################################
# VIEWPORT MINI_PACKAGE FOLLOWS!
package PDL::Graphics::TriD::ViewPort;
use OpenGL qw/ :glfunctions :glconstants :glufunctions /;
use PDL::Graphics::OpenGLQ;
sub highlight {
my ($vp) = @_;
my $pts = PDL->new([[0,0,0],
[$vp->{W},0,0],
[$vp->{W},$vp->{H},0],
[0,$vp->{H},0],
[0,0,0]]);
glDisable(GL_LIGHTING);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity();
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
gluOrtho2D(0,$vp->{W},0,$vp->{H});
glLineWidth(4);
glColor3f(1,1,1);
gl_line_strip_nc($pts);
glLineWidth(1);
glEnable(GL_LIGHTING);
}
sub do_perspective {
my($this) = @_;
print "do_perspective ",$this->{W}," ",$this->{H} ,"\n" if $PDL::Graphics::TriD::verbose;
print Carp::longmess() if $PDL::Graphics::TriD::verbose>1;
unless($this->{W}>0 and $this->{H}>0) {return;}
$this->{AspectRatio} = (1.0*$this->{W})/$this->{H};
glViewport($this->{X0},$this->{Y0},$this->{W},$this->{H});
$this->highlight if $this->{Active};
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
gluPerspective(40.0, $this->{AspectRatio} , 0.1, 200000.0);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity ();
}
package PDL::Graphics::TriD::GL;
use OpenGL ();
use strict;
use warnings;
use PDL::Graphics::TriD::Window qw();
use PDL::Options;
$PDL::Graphics::TriD::verbose //= 0;
# This is a list of all the fields of the opengl object
#use fields qw/Display Window Context Options GL_Vendor GL_Version GL_Renderer/;
=head1 NAME
PDL::Graphics::TriD::GL - PDL TriD OpenGL interface using POGL
=head1 DESCRIPTION
This module provides the glue between the Perl
OpenGL functions and the API defined by the internal
PDL::Graphics::OpenGL one. It also supports any
miscellaneous OpenGL or GUI related functionality to
support PDL::Graphics::TriD refactoring.
It defines an interface that subclasses will conform to, implementing
support for GLFW, GLUT, X11+GLX, etc, as the mechanism for creating windows
and graphics contexts.
=head1 CONFIG
Defaults to using L - override by setting the environment
variable C to C, C , or the default is C.
This is implemented by C.
=head2 new
=for ref
Returns a new OpenGL object.
=for usage
new($class,$options,[$window_type])
Attributes are specified in the $options field; the 3d $window_type is optionsl. The attributes are:
=over
=item x,y - the position of the upper left corner of the window (0,0)
=item width,height - the width and height of the window in pixels (500,500)
=item parent - the parent under which the new window should be opened (root)
=item mask - the user interface mask (StructureNotifyMask)
=item attributes - attributes to pass to glXChooseVisual
=back
Allowed 3d window types, case insensitive, are:
=over
=item glfw - use Perl OpenGL bindings and GLFW windows (no Tk)
=item glut - use Perl OpenGL bindings and GLUT windows (no Tk)
=item x11 - use Perl OpenGL (POGL) bindings with X11
=back
=cut
sub new {
my($class,$options,$window_obj) = @_;
my $opt = PDL::Options->new(default_options());
$opt->incremental(1);
$opt->options($options) if(defined $options);
my $p = $opt->options;
bless {Options => $p}, ref($class)||$class;
}
=head2 default_options
default options for object oriented methods
=cut
sub default_options{
{ 'x' => 0,
'y' => 0,
'width' => 500,
'height'=> 500,
'parent'=> 0,
'mask' => eval '&OpenGL::StructureNotifyMask',
'steal' => 0,
'attributes' => eval '[ &OpenGL::GLX_DOUBLEBUFFER, &OpenGL::GLX_RGBA ]',
}
}
=head2 swap_buffers
OO interface to swapping frame buffers
=cut
sub swap_buffers {
my ($this) = @_;
die "swap_buffers: got object with inconsistent _GLObject info\n";
}
=head2 set_window
OO interface to setting the display window (if appropriate)
=cut
sub set_window {
my ($this) = @_;
}
=head1 AUTHOR
Chris Marshall, C<< >>
=head1 BUGS
Bugs and feature requests may be submitted through the PDL GitHub
project page at L .
=head1 SUPPORT
PDL uses a mailing list support model. The Perldl mailing list
is the best for questions, problems, and feature discussions with
other PDL users and PDL developers.
To subscribe see the page at L
=head1 ACKNOWLEDGEMENTS
TBD including PDL TriD developers and POGL developers...thanks to all.
=head1 COPYRIGHT & LICENSE
Copyright 2009 Chris Marshall.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/SimpleScaler.pm0000644000175000017500000000227514775155512023213 0ustar osboxesosboxes# a very simple unsophisticated scaler that
# takes advantage of the nice infrastructure provided by TJL
# controls 3-D window scaling
# when you drag the mouse in the display window.
package PDL::Graphics::TriD::SimpleScaler;
use strict;
use warnings;
use base qw/PDL::Graphics::TriD::ButtonControl/;
use fields qw/DistRef/;
$PDL::Graphics::TriD::verbose //= 0;
sub new {
my($type,$win,$dist) = @_;
my $this = $type->SUPER::new( $win);
$this->{DistRef} = $dist;
$win->add_resizecommand(sub {print "Resized window: ",join(",",@_),"\n" if $PDL::Graphics::TriD::verbose; $this->set_wh(@_); });
return $this;
}
# coordinates normalised relative to center
sub xy2norm {
my($this,$x,$y) = @_;
print "xy2norm: this->{W}=$this->{W}; this->{H}=$this->{H}; this->{SC}=$this->{SC}\n" if($PDL::Graphics::TriD::verbose);
$x -= $this->{W}/2; $y -= $this->{H}/2;
$x /= $this->{SC}; $y /= $this->{SC};
return ($x,$y);
}
sub mouse_moved {
my($this,$x0,$y0,$x1,$y1) = @_;
${$this->{DistRef}} *=
$this->xy2fac($this->xy2norm($x0,$y0),$this->xy2norm($x1,$y1));
}
# x,y to distance from center
sub xy2fac {
my($this,$x0,$y0,$x1,$y1) = @_;
my $dy = $y0-$y1;
return $dy>0 ? 1+2*$dy : 1/(1-2*$dy);
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/Quaternion.pm0000644000175000017500000000612614775155512022754 0ustar osboxesosboxes##############################################
#
# Quaternions... inefficiently.
#
# Should probably use PDL and C... ?
#
# Stored as [c,x,y,z].
#
# XXX REMEMBER!!!! First component = cos(angle/2), *NOT* cos(angle)
package PDL::Graphics::TriD::Quaternion;
use strict;
use warnings;
sub _scalar_wrap {
my ($v) = @_;
return PDL::Graphics::TriD::Quaternion->new($v,0,0,0) if !ref $v;
return PDL::Graphics::TriD::Quaternion->new(@$v) if ref $v eq 'ARRAY';
$v;
}
use overload
'=' => sub {$_[0]}, # without this, `$this->{Quat} .= $q` errors
'.=' => sub {
my ($a1, $a2) = @_;
$a1->set(_scalar_wrap $a2);
},
'+' => sub {
my ($a1, $a2, $swap) = @_;
$a1->add(_scalar_wrap $a2);
},
'*' => sub {
my ($a1, $a2, $swap) = @_;
$a2 = _scalar_wrap $a2;
($a2, $a1) = ($a1, $a2) if $swap;
$a1->multiply($a2);
},
'/' => sub {
my ($a1, $a2, $swap) = @_;
$a2 = _scalar_wrap $a2;
($a2, $a1) = ($a1, $a2) if $swap;
$a1->multiply($a2->invert);
},
'!' => \&invert,
'""' => sub { ref($_[0])."->new(".join(',', @{$_[0]}).")" };
sub new {
my($type,$c,$x,$y,$z) = @_;
my $this;
if(ref($type)){
$this = $type;
}else{
$this = bless [$c,$x,$y,$z],$type;
}
return $this;
}
sub copy {
PDL::Graphics::TriD::Quaternion->new(@{$_[0]});
}
sub new_vrmlrot {
my($type,$x,$y,$z,$c) = @_;
my $l = sqrt($x**2+$y**2+$z**2);
my $this = bless [cos($c/2),map {sin($c/2)*$_/$l} $x,$y,$z],$type;
$this->normalise;
}
sub to_vrmlrot {
my($this) = @_;
my $d = POSIX::acos($this->[0]);
if(abs($d) < 0.0000001) {
return [0,0,1,0];
}
return [(map {$_/sin($d)} @{$this}[1..3]),2*$d];
}
sub multiply {
my($this,$with) = @_;
return PDL::Graphics::TriD::Quaternion->new(
$this->[0] * $with->[0]
- $this->[1] * $with->[1]
- $this->[2] * $with->[2]
- $this->[3] * $with->[3],
$this->[0] * $with->[1]
+ $this->[1] * $with->[0]
+ $this->[2] * $with->[3]
- $this->[3] * $with->[2],
$this->[0] * $with->[2]
- $this->[1] * $with->[3]
+ $this->[2] * $with->[0]
+ $this->[3] * $with->[1],
$this->[0] * $with->[3]
+ $this->[1] * $with->[2]
- $this->[2] * $with->[1]
+ $this->[3] * $with->[0],
);
}
sub set {
my($this,$new) = @_;
@$this = @$new;
$this;
}
sub add {
my($this,$with) = @_;
PDL::Graphics::TriD::Quaternion->new(map $this->[$_]+$with->[$_], 0..3);
}
sub abssq {
my($this) = @_;
return $this->[0] ** 2 +
$this->[1] ** 2 +
$this->[2] ** 2 +
$this->[3] ** 2 ;
}
sub invert {
my($this) = @_;
my $abssq = $this->abssq();
return PDL::Graphics::TriD::Quaternion->new(
1/$abssq * $this->[0] ,
-1/$abssq * $this->[1] ,
-1/$abssq * $this->[2] ,
-1/$abssq * $this->[3] );
}
sub invert_rotation_this {
my($this) = @_;
$this->[0] = - $this->[0];
}
sub normalise {
my($this) = @_;
my $abs = sqrt($this->abssq);
@$this = map $_/$abs, @$this;
$this;
}
sub rotate {
my($this,$vec) = @_;
my $q = PDL::Graphics::TriD::Quaternion->new(0,@$vec);
my $m = $this->multiply($q->multiply($this->invert));
return [@$m[1..3]];
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/ScrollButtonScaler.pm0000644000175000017500000000154014775155512024406 0ustar osboxesosboxes## ScrollButtonScaler -- this is the module that enables support
## for middle button scrollwheels to zoom in and out of the display
## window. Scrolling forward zooms in, while scrolling backwards zooms
## out.
package PDL::Graphics::TriD::ScrollButtonScaler;
use base qw/PDL::Graphics::TriD::ButtonControl/;
use fields qw/DistRef Zoom/;
sub new {
my($type,$win,$dist,$zoom) = @_;
my $this = $type->SUPER::new($win);
$this->{DistRef} = $dist;
$this->{Zoom} = $zoom; # multiplier for zooming
# >1 zooms out, <1 zooms in
return $this;
}
sub ButtonRelease{
my ($this,$x,$y) = @_;
print "ButtonRelease @_\n" if $PDL::Graphics::TriD::verbose;
${$this->{DistRef}} *= $this->{Zoom};
1;
}
sub ButtonPress{
my ($this,$x,$y) = @_;
print "ButtonPress @_ ",ref($this->{Win}),"\n" if $PDL::Graphics::TriD::verbose;
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/Window.pm0000644000175000017500000001317614775155512022101 0ustar osboxesosboxes# The PDL::Graphics::TriD::Window is already partially defined in
# the appropriate gdriver (GL or VRML) items defined here are common
# to both
package PDL::Graphics::TriD::Window;
use strict;
use warnings;
use PDL::Graphics::TriD::ViewPort;
use Data::Dumper;
$PDL::Graphics::TriD::verbose //= 0;
sub new {
my($arg,$options) = @_;
print "PDL::Graphics::TriD::Window - calling SUPER::new...\n" if($PDL::Graphics::TriD::verbose);
my $this = $arg->SUPER::new();
print "PDL::Graphics::TriD::Window - got back $this\n" if($PDL::Graphics::TriD::verbose);
# Make sure the Graphics has been initialized
$options->{width} = 600 unless defined $options->{width};
$options->{height} = 600 unless defined $options->{height};
$this->{Width} = $options->{width};
$this->{Height} = $options->{height};
print "PDL::Graphics::TriD::Window: calling gdriver....\n" if($PDL::Graphics::TriD::verbose);
$this->{Interactive} = $this->gdriver($options);
print "PDL::Graphics::TriD::Window: gdriver gave back $this->{Interactive}....\n" if($PDL::Graphics::TriD::verbose);
# set default values
if($this->{Interactive}){
print "\tIt's interactive... calling ev_defaults...\n" if($PDL::Graphics::TriD::verbose);
$this->{Ev} = $this->ev_defaults();
print "\tcalling new_viewport...\n" if($PDL::Graphics::TriD::verbose);
$this->new_viewport(0,0,$this->{Width},$this->{Height});
}else{
$this->new_viewport(0,0,1,1);
}
$this->current_viewport(0);
return($this);
}
#
# adds to all viewports
#
sub add_object {
my($this,$object) = @_;
# print "add_object ",ref($this),"\n";
for(@{$this->{_ViewPorts}}) {
$_->add_object($object);
}
}
sub new_viewport {
my($this,$x0,$y0,$x1,$y1, $options) = @_;
my $vp = PDL::Graphics::TriD::ViewPort->new($x0,$y0,$x1,$y1);
print "Adding viewport $x0,$y0,$x1,$y1\n" if $PDL::Graphics::TriD::verbose;
push @{$this->{_ViewPorts}}, $vp;
if ($this->{Interactive}) {
# set a default controller
use PDL::Graphics::TriD::ArcBall;
use PDL::Graphics::TriD::SimpleScaler;
use PDL::Graphics::TriD::ScrollButtonScaler;
use PDL::Graphics::TriD::SimpleController;
if (defined($PDL::Graphics::TriD::offline) and $PDL::Graphics::TriD::offline==1 ) {
eval "use PDL::Graphics::TriD::VRML";
} else {
eval "use PDL::Graphics::TriD::GL";
}
my $ev = $options->{EHandler} // PDL::Graphics::TriD::EventHandler->new($vp);
my $cont = $options->{Transformer} // PDL::Graphics::TriD::SimpleController->new;
$vp->transformer($cont);
if (ref($ev)) {
$ev->set_button(0,PDL::Graphics::TriD::Orbiter->new($vp, 0, $cont->{WRotation}));
$ev->set_button(2,PDL::Graphics::TriD::SimpleScaler->new($vp, \$cont->{CDistance}));
$ev->set_button(3,PDL::Graphics::TriD::ScrollButtonScaler->new($vp, \$cont->{CDistance}, 0.9));
$ev->set_button(4,PDL::Graphics::TriD::ScrollButtonScaler->new($vp, \$cont->{CDistance}, 1.1));
$vp->eventhandler($ev);
}
}
print "new_viewport: ",ref($vp)," ",$#{$this->{_ViewPorts}},"\n" if $PDL::Graphics::TriD::verbose;
return $vp;
}
sub resize_viewport {
my($this,$x0,$y0,$x1,$y1,$vpnum) = @_;
$vpnum = $this->{_CurrentViewPort} unless(defined $vpnum);
my $vp;
if(defined($this->{_ViewPorts}[$vpnum])){
$vp = $this->{_ViewPorts}[$vpnum]->resize($x0,$y0,$x1,$y1);
}
return $vp;
}
sub current_viewport {
my($this,$num) = @_;
if(defined $num){
if(ref($num)){
my $cnt=0;
foreach (@{$this->{_ViewPorts}}){
if($num == $_){
$this->{_CurrentViewPort} = $cnt;
$_->{Active}=1;
}elsif(defined $_){
$_->{Active}=0;
}
$cnt++;
}
}else{
if(defined $this->{_ViewPorts}[$num]){
$this->{_CurrentViewPort} = $num;
$this->{_ViewPorts}[$num]->{Active}=1;
}else{
print "ERROR: ViewPort $num undefined\n";
}
}
}
return $this->{_ViewPorts}[$this->{_CurrentViewPort}];
}
sub viewports {
my ($this) = shift;
return $this->{_ViewPorts};
}
sub _vp_num_fromref {
my ($this,$vp) = @_;
if(! defined $vp){
$vp = $this->{_CurrentViewPort};
}elsif(ref($vp)){
my $cnt=0;
foreach(@{$this->{_ViewPorts}}){
last if($vp == $_);
$cnt++;
}
$vp = $cnt;
}
return $vp;
}
sub delete_viewport {
my($this, $vp) = @_;
my $cnt;
if(($cnt=$#{$this->{_ViewPorts}})<= 0){
print "WARNING: Cannot delete final viewport - request ignored\n";
return;
}
$vp = $this->_vp_num_fromref($vp);
$this->{_ViewPorts}[$vp]->DESTROY();
splice(@{$this->{_ViewPorts}},$vp,1);
if($vp == $cnt){
$this->current_viewport($vp-1);
}
}
sub clear_viewports {
my($this) = @_;
foreach(@{$this->{_ViewPorts}}){
$_->clear_objects();
}
}
sub clear_viewport {
my($this, $vp) = @_;
my $cnt;
$vp = $this->_vp_num_fromref($vp);
$this->{_ViewPorts}[$vp]->clear_objects();
}
sub set_eventhandler {
my($this,$handler) = @_;
$this->{EHandler} = $handler;
# for(@{$this->{_ViewPorts}}) {
# $_->eventhandler($handler);
# }
}
#sub set_transformer {
# my($this,$transformer) = @_;
#
# for(@{$this->{_ViewPorts}}) {
# $_->transformer($transformer);
# }
#}
sub AUTOLOAD {
my ($self,@args)=@_;
use vars qw($AUTOLOAD);
my $sub = $AUTOLOAD;
return if $sub =~ /::DESTROY$/;
# If an unrecognized function is called for window it trys to apply it
# to all of the defined ViewPorts
$sub =~ s/.*:://;
print "AUTOLOAD: $sub at ",__FILE__," line ", __LINE__ ,".\n"
if($PDL::Graphics::TriD::verbose);
print "Window AUTOLOADing '$sub': self=$self, args='".join("','",@args),"'\n" if($PDL::Graphics::TriD::verbose);
if($sub =~ /^gl/ && defined $self->{_GLObject}){
return $self->{_GLObject}->$sub(@args);
}
for(@{$self->{_ViewPorts}}) {
next unless defined $_;
$_->$sub(@args);
}
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/ArcBall.pm0000644000175000017500000000701614775155512022126 0ustar osboxesosboxes###################################################
#
# ArcBall.pm
#
# From Graphics Gems IV.
#
# This is an example of the controller class:
# the routines set_wh and mouse_moved are the standard routines.
#
# This needs a faster implementation (?)
package PDL::Graphics::TriD::QuaterController;
use strict;
use warnings;
use PDL::Graphics::TriD::Quaternion;
use base qw(PDL::Graphics::TriD::ButtonControl);
use fields qw /Inv Quat/;
use constant PI => 3.14159265358979323846264338327950288;
$PDL::Graphics::TriD::verbose //= 0;
sub new {
my($type,$win,$inv,$quat) = @_;
my $this = $type->SUPER::new($win);
$this->{Inv} = $inv;
$this->{Quat} = (defined($quat) ? $quat :
PDL::Graphics::TriD::Quaternion->new(1,0,0,0));
$win->add_resizecommand(sub {$this->set_wh(@_)});
$this;
}
# setup for subclasses
sub mouse_moved {
my($this,$x0,$y0,$x1,$y1) = @_;
# Copy the size of the owning viewport to our size, in case it changed
@$this{qw(H W)} = @{$this->{Win}}{qw(H W)};
if ($PDL::Graphics::TriD::verbose) {
print "QuaterController: mouse-moved: $this: $x0,$y0,$x1,$y1,$this->{W},$this->{H},$this->{SC}\n";
if ($PDL::Graphics::TriD::verbose > 1) {
print "\tthis is:\n";
foreach my $k(sort keys %$this) {
print "\t$k\t=>\t$this->{$k}\n";
}
}
}
}
# Original ArcBall
#
package PDL::Graphics::TriD::ArcBall;
use base qw/PDL::Graphics::TriD::QuaterController/;
sub xy2qua {
my($this,$x,$y) = @_;
$x -= $this->{W}/2; $y -= $this->{H}/2;
$y = -$y;
return $this->normxy2qua($x,$y);
}
sub mouse_moved {
my($this,$x0,$y0,$x1,$y1) = @_;
$this->SUPER::mouse_moved($x0,$y0,$x1,$y1);
# Convert both to quaternions.
my $arc = $this->xy2qua($x1,$y1) / $this->xy2qua($x0,$y0);
if ($this->{Inv}) {
$arc->invert_rotation_this();
}
$this->{Quat} .= $arc * $this->{Quat};
1; # signals a refresh
}
sub get_z {
my ($this, $dist) = @_;
sqrt(1-$dist**2);
}
# x,y to unit quaternion on the sphere.
sub normxy2qua {
my($this,$x,$y) = @_;
$x /= $this->{SC}; $y /= $this->{SC};
my $dist = sqrt ($x ** 2 + $y ** 2);
if ($dist > 1.0) {$x /= $dist; $y /= $dist; $dist = 1.0;}
my $z = $this->get_z($dist);
PDL::Graphics::TriD::Quaternion->new(0,$x,$y,$z)->normalise;
}
# Tjl's version: a cone - more even change of
package PDL::Graphics::TriD::ArcCone;
use base qw/PDL::Graphics::TriD::ArcBall/;
sub get_z {
my ($this, $dist) = @_;
1-$dist;
}
# Tjl's version2: a bowl -- angle is proportional to displacement.
package PDL::Graphics::TriD::ArcBowl;
use base qw/PDL::Graphics::TriD::ArcBall/;
BEGIN { *PI = \&PDL::Graphics::TriD::QuaterController::PI; }
sub get_z {
my ($this, $dist) = @_;
cos($dist*PI/2);
}
package PDL::Graphics::TriD::Orbiter;
use base qw/PDL::Graphics::TriD::QuaterController/;
BEGIN { *PI = \&PDL::Graphics::TriD::QuaterController::PI; }
# we rotate about our space's "Z" because that's what we made vertical
# this is different from the OpenGL Z axis which is towards the viewer
sub mouse_moved {
my($this,$x0,$y0,$x1,$y1) = @_;
$this->SUPER::mouse_moved($x0,$y0,$x1,$y1);
my ($dx, $dy) = ($x1-$x0, $y1-$y0);
$dx /= $this->{W}/2; $dy /= $this->{H}/2; # scale to whole window not SC
my ($x_rad, $y_rad) = map PI*$_, $dx, $dy;
my $q_horiz = PDL::Graphics::TriD::Quaternion->new(cos $x_rad/2, 0, 0, sin $x_rad/2);
my $q_vert = PDL::Graphics::TriD::Quaternion->new(cos $y_rad/2, sin $y_rad/2, 0, 0);
if ($this->{Inv}) {
$_->invert_rotation_this for $q_horiz, $q_vert;
}
$this->{Quat} .= $q_vert * $this->{Quat} * $q_horiz;
1; # signals a refresh
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/Object.pm0000644000175000017500000000364414775155512022037 0ustar osboxesosboxespackage PDL::Graphics::TriD::Object;
use strict;
use warnings;
use fields qw(Objects ValidList ChangedSub List VRML);
$PDL::Graphics::TriD::verbose //= 0;
sub new{
my $class = shift;
my $self = fields::new($class);
$self;
}
sub clear_objects {
my($this) = @_;
$this->{Objects} = [];
$this->{ValidList} = 0;
}
sub delete_object {
my($this,$object) = @_;
return unless(defined $object && defined $this->{Objects});
for(0..$#{$this->{Objects}}){
if($object == $this->{Objects}[$_]){
splice(@{$this->{Objects}},$_,1);
redo;
}
}
}
# XXXXXXXXX sub {} makes all these objects and this window immortal!
sub add_object {
my($this,$object) = @_;
push @{$this->{Objects}},$object;
$this->{ValidList} = 0;
for(@{$this->{ChangedSub}}) {
$object->add_changedsub($_);
}
$object->add_changedsub(sub {$this->changed_from_above()});
}
sub changed_from_above {
my($this) = @_;
print "CHANGED_FROM_ABOVE\n" if $PDL::Graphics::TriD::verbose;
$this->changed;
}
sub add_changedsub {
my($this,$chsub) = @_;
push @{$this->{ChangedSub}}, $chsub;
for (@{$this->{Objects}}) {
$_->add_changedsub($chsub);
}
}
sub clear {
my($this) = @_;
# print "Clear: $this\n";
for(@{$this->{Objects}}) {
$_->clear();
}
$this->delete_displist();
delete $this->{ChangedSub};
delete $this->{Objects};
}
sub changed {
my($this) = @_;
print "VALID0 $this\n" if $PDL::Graphics::TriD::verbose;
$this->{ValidList} = 0;
$_->($this) for @{$this->{ChangedSub}};
}
sub vrml_update {
my ($this) = @_;
use PDL::Graphics::VRML;
$this->{VRML} = PDL::Graphics::VRMLNode->new('Transform',
'translation' => "-1 -1 -1",
'scale' => "2 2 2");
$this->{ValidList} = 1;
}
sub tovrml {
my($this) = @_;
print ref($this)," valid=",$this->{ValidList}," tovrml\n";
if (!$this->{ValidList}) {
$this->vrml_update();
}
$this->{VRML}->add('children',
[map {$_->tovrml()} @{$this->{Objects}}]);
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/MathGraph.pm0000644000175000017500000000437714775155512022510 0ustar osboxesosboxes=head1 NAME
PDL::Graphics::TriD::MathGraph -- Mathematical Graph objects for PDL
=head1 SYNOPSIS
see the file Demos/TriD/tmathgraph.p in the PDL distribution.
=head1 WARNING
This module is experimental and the interface will probably change.
=head1 DESCRIPTION
This module exists for plotting mathematical graphs (consisting
of nodes and arcs between them) in 3D and optimizing the placement of
the nodes so that the graph is visualizable in a clear way.
=head1 AUTHOR
Copyright (C) 1997 Tuomas J. Lukka (lukka@husc.harvard.edu).
All rights reserved. There is no warranty. You are allowed
to redistribute this software / documentation under certain
conditions. For details, see the file COPYING in the PDL
distribution. If this file is separated from the PDL distribution,
the copyright notice should be included in the file.
=cut
package PDL::Graphics::TriD::MathGraph;
use strict;
use warnings;
use PDL::Graphics::TriD::Objects;
use base qw/PDL::Graphics::TriD::GObject/;
use OpenGL qw(:all);
sub gdraw {
my($this,$points) = @_;
glDisable(&GL_LIGHTING);
glColor3d(@{$this->{Options}{Color}});
PDL::Graphics::OpenGLQ::gl_arrows($points,@{$this->{Options}}{qw(From To
ArrowLen ArrowWidth)});
glEnable(&GL_LIGHTING);
}
sub get_valid_options {
return {UseDefcols => 0,From => [],To => [],Color => [1,1,1],
ArrowWidth => 0.02, ArrowLen => 0.1}
}
package PDL::GraphEvolver;
use PDL::Lite;
use PDL::ImageND ":Func";
sub new {
my($type,$coords) = @_;
bless {Coords => $coords,
BoxSize => 3, DMult => 5000,
A => -100.0, B => -5, C => -0.1, D => 0.01,
M => 30, MS => 1,
},$type;
}
sub set_links { my $this = shift; @$this{qw(From To Strength)} = @_; }
sub set_fixed { my $this = shift; @$this{qw(FInd FCoord)} = @_; }
sub step {
my($this) = @_;
my $c = $this->{Coords};
my $velr = repulse($c,@$this{qw(BoxSize DMult A B C D)});
my $vela = attract($c,@$this{qw(From To Strength M MS)});
my $tst = 0.10;
$this->{Velo} = ($this->{Velo}//0) + $tst * 0.02 * ($velr + $vela);
$this->{Velo} *=
(0.92*50/(50+$this->{Velo}->magnover->dummy(0)))**$tst;
$c += $tst * 0.05 * $this->{Velo};
$c->transpose->index($this->{FInd}->dummy(0)) .= $this->{FCoord}
if (defined $this->{FInd});
print "C: $c\n" if $PDL::Graphics::TriD::verbose;
}
sub getcoords {$_[0]{Coords}}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/Rout.pd0000644000175000017500000000233014775155512021540 0ustar osboxesosboxesuse strict;
use warnings;
pp_addpm({At=>'Top'},<<'EOD');
use strict;
use warnings;
=head1 NAME
PDL::Graphics::TriD::Rout - Helper routines for Three-dimensional graphics
=head1 DESCRIPTION
This module is for miscellaneous PP-defined utility routines for
the PDL::Graphics::TriD module.
EOD
sub trid {
my ($par,$ind) = @_;
join ',', map {"\$$par($ind => $_)"} (0..2);
}
pp_def('vrmlcoordsvert',
Pars => 'vertices(n=3)',
OtherPars => 'char* space; PerlIO *fp',
GenericTypes => ['F','D'],
Code => q@
PDL_Byte *buf, *bp;
char *spc = $COMP(space);
char formchar = $TFD(' ','l');
char formatstr[25];
sprintf(formatstr,"%s%%.3%cf %%.3%cf %%.3%cf,\n",spc,
formchar,formchar,formchar);
broadcastloop %{
PerlIO_printf($COMP(fp),formatstr,@.trid('vertices','n').');
%}'
);
pp_addpm({At=>'Bot'},<<'EOD');
=head1 AUTHOR
Copyright (C) 2000 James P. Edwards
Copyright (C) 1997 Tuomas J. Lukka.
All rights reserved. There is no warranty. You are allowed
to redistribute this software / documentation under certain
conditions. For details, see the file COPYING in the PDL
distribution. If this file is separated from the PDL distribution,
the copyright notice should be included in the file.
=cut
EOD
pp_done();
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/Objects.pm0000644000175000017500000002023714776121007022210 0ustar osboxesosboxes=encoding UTF-8
=head1 NAME
PDL::Graphics::TriD::Objects - Simple Graph Objects for TriD
=head1 SYNOPSIS
use PDL::Graphics::TriD::Objects;
This provides the following class hierarchy:
PDL::Graphics::TriD::GObject (abstract) base class
├ PDL::Graphics::TriD::Points individual points
├ PDL::Graphics::TriD::Spheres fat 3D points :)
├ PDL::Graphics::TriD::Lines separate lines
├ PDL::Graphics::TriD::LineStrip continuous paths
├ PDL::Graphics::TriD::STrigrid polygons
│ └ PDL::Graphics::TriD::STrigrid_S polygons with normals
â”” PDL::Graphics::TriD::GObject_Lattice (abstract) base class
├ PDL::Graphics::TriD::SCLattice colored lattice
├ PDL::Graphics::TriD::SLattice ...with color per vertex
â”” PDL::Graphics::TriD::SLattice_S ...and with normals
=head1 DESCRIPTION
This module contains a collection of classes which represent graph
objects. It is for internal use and not meant to be used by PDL
users. GObjects can be either stand-alone or in Graphs, scaled
properly. All the points used by the object must be in the member
{Points}. I guess we can afford to force data to be copied (X,Y,Z) ->
(Points)...
=head1 OBJECTS
=head2 PDL::Graphics::TriD::GObject
Inherits from base PDL::Graphics::TriD::Object and adds fields Points,
Colors and Options.
=cut
package PDL::Graphics::TriD::GObject;
use strict;
use warnings;
use base qw/PDL::Graphics::TriD::Object/;
use fields qw/Points Colors Options/;
$PDL::Graphics::TriD::verbose //= 0;
sub new {
my($type,$points,$colors,$options) = @_;
print "GObject new.. calling SUPER::new...\n" if($PDL::Graphics::TriD::verbose);
my $this = $type->SUPER::new();
print "GObject new - back (SUPER::new returned $this)\n" if($PDL::Graphics::TriD::verbose);
if(!defined $options and ref $colors eq "HASH") {
$options = $colors;
undef $colors;
}
$options = { $options ? %$options : () };
$options->{UseDefcols} = 1 if !defined $colors; # for VRML efficiency
$this->{Options} = $options;
$this->check_options;
print "GObject new - calling realcoords\n" if($PDL::Graphics::TriD::verbose);
$this->{Points} = $points = PDL::Graphics::TriD::realcoords($type->r_type,$points);
print "GObject new - back from realcoords\n" if($PDL::Graphics::TriD::verbose);
$this->{Colors} = defined $colors
? PDL::Graphics::TriD::realcoords("COLOR",$colors)
: $this->cdummies(PDL->pdl(1,1,1),$points);
print "GObject new - returning\n" if($PDL::Graphics::TriD::verbose);
return $this;
}
sub check_options {
my($this) = @_;
my $opts = $this->get_valid_options();
$this->{Options} = $opts, return if !$this->{Options};
print "FETCHOPT: $this ".(join ',',%$opts)."\n" if $PDL::Graphics::TriD::verbose;
my %newopts = (%$opts, %{$this->{Options}});
my @invalid = grep !exists $opts->{$_}, keys %newopts;
die "Invalid options left: @invalid" if @invalid;
$this->{Options} = \%newopts;
}
sub set_colors {
my($this,$colors) = @_;
if(ref($colors) eq "ARRAY"){
$colors = PDL::Graphics::TriD::realcoords("COLOR",$colors);
}
$this->{Colors}=$colors;
$this->data_changed;
}
sub get_valid_options { +{UseDefcols => 0} }
sub get_points { $_[0]{Points} }
sub cdummies { $_[1] }
sub r_type { "" }
sub defcols { $_[0]{Options}{UseDefcols} }
# In the future, have this happen automatically by the ndarrays.
sub data_changed {
my($this) = @_;
$this->changed;
}
package PDL::Graphics::TriD::Points;
use base qw/PDL::Graphics::TriD::GObject/;
sub get_valid_options {
return {UseDefcols => 0, PointSize=> 1};
}
package PDL::Graphics::TriD::Spheres;
use base qw/PDL::Graphics::TriD::GObject/;
# need to add radius
sub get_valid_options {
+{UseDefcols => 0, PointSize=> 1}
}
package PDL::Graphics::TriD::Lines;
use base qw/PDL::Graphics::TriD::GObject/;
sub cdummies { return $_[1]->dummy(1); }
sub r_type { return "SURF2D";}
sub get_valid_options { return {UseDefcols => 0, LineWidth => 1}; }
package PDL::Graphics::TriD::LineStrip;
use base qw/PDL::Graphics::TriD::GObject/;
sub cdummies { return $_[1]->dummy(1); }
sub r_type { return "SURF2D";}
sub get_valid_options { return {UseDefcols => 0, LineWidth => 1}; }
package PDL::Graphics::TriD::STrigrid;
use base qw/PDL::Graphics::TriD::GObject/;
sub new {
my($type,$points,$faceidx,$colors,$options) = @_;
# faceidx is 2D pdl of indices into points for each face
if(!defined $options and ref $colors eq "HASH") {
$options = $colors;undef $colors; }
$points = PDL::Graphics::TriD::realcoords($type->r_type,$points);
my $faces = $points->dice_axis(1,$faceidx->flat)->splitdim(1,3);
# faces is 3D pdl slices of points, giving cart coords of face verts
if(!defined $colors) { $colors = PDL->pdl(0.8,0.8,0.8);
$colors = $type->cdummies($colors,$faces);
$options->{ UseDefcols } = 1; } # for VRML efficiency
else { $colors = PDL::Graphics::TriD::realcoords("COLOR",$colors); }
my $this = bless { Points => $points, Faceidx => $faceidx, Faces => $faces,
Colors => $colors, Options => $options},$type;
$this->check_options;
$this;
}
sub get_valid_options { { UseDefcols => 0, Lines => 1 } }
sub cdummies { # called with (type,colors,faces)
return $_[1]->dummy(1,$_[2]->getdim(2))->dummy(1,$_[2]->getdim(1)); }
package PDL::Graphics::TriD::STrigrid_S;
use base qw/PDL::Graphics::TriD::STrigrid/;
sub new {
my $this = shift->SUPER::new(@_);
$this->{Normals} //= $this->smoothn if $this->{Options}{Smooth};
$this;
}
sub get_valid_options { { UseDefcols=>0, Lines=>0, Smooth=>1, ShowNormals=>0 } }
sub smoothn { my ($this) = @_;
my ($points, $faces, $faceidx) = @$this{qw(Points Faces Faceidx)};
my @p = $faces->mv(1,-1)->dog;
my $fn = ($p[1]-$p[0])->crossp($p[2]-$p[1])->norm; # flat faces, >= 3 points
$this->{FaceNormals} = $fn if $this->{Options}{ShowNormals};
PDL::cat(
map $fn->dice_axis(1,($faceidx==$_)->whichND->slice('(1)'))->mv(1,0)->sumover->norm,
0..($points->dim(1)-1) );
}
package PDL::Graphics::TriD::GObject_Lattice;
use base qw/PDL::Graphics::TriD::GObject/;
sub r_type {return "SURF2D";}
sub get_valid_options { return {UseDefcols=>0, Lines=>1}; }
package PDL::Graphics::TriD::Lattice;
use base qw/PDL::Graphics::TriD::GObject_Lattice/;
sub cdummies { return $_[1]->dummy(1)->dummy(1); }
# colors associated with surfaces
package PDL::Graphics::TriD::SCLattice;
use base qw/PDL::Graphics::TriD::GObject_Lattice/;
sub cdummies { return $_[1]->dummy(1,$_[2]->getdim(2)-1)
-> dummy(1,$_[2]->getdim(1)-1); }
# colors associated with vertices, smooth
package PDL::Graphics::TriD::SLattice;
use base qw/PDL::Graphics::TriD::GObject_Lattice/;
sub cdummies { return $_[1]->dummy(1,$_[2]->getdim(2))
-> dummy(1,$_[2]->getdim(1)); }
# colors associated with vertices
package PDL::Graphics::TriD::SLattice_S;
use base qw/PDL::Graphics::TriD::GObject_Lattice/;
use fields qw/Normals/;
sub cdummies {
$_[1]->slice(":," . join ',', map "*$_", ($_[2]->dims)[1,2])
}
sub get_valid_options {
{UseDefcols=>0, Lines=>1, Smooth=>1, ShowNormals=>0}
}
sub new {
my ($class,$points,$colors,$options) = @_;
my $this = $class->SUPER::new($points,$colors,$options);
$this->{Normals} //= $this->smoothn($this->{Points}) if $this->{Options}{Smooth};
$this;
}
# calculate smooth normals
sub smoothn {
my ($this,$p) = @_;
# coords of parallel sides (left and right via 'lags')
my $trip = $p->lags(1,1,2)->slice(':,:,:,1:-1') -
$p->lags(1,1,2)->slice(':,:,:,0:-2');
# coords of diagonals with dim 2 having original and reflected diags
my $tmp;
my $trid = ($p->slice(':,0:-2,1:-1')-$p->slice(':,1:-1,0:-2'))
->dummy(2,2);
# $ortho is a (3D,x-1,left/right triangle,y-1) array that enumerates
# all triangles
my $ortho = $trip->crossp($trid);
$ortho->norm($ortho); # normalise inplace
# now add to vertices to smooth
my $aver = ref($p)->zeroes($p->dims);
# step 1, upper right tri0, upper left tri1
($tmp=$aver->lags(1,1,2)->slice(':,:,:,1:-1')) += $ortho;
# step 2, lower right tri0, lower left tri1
($tmp=$aver->lags(1,1,2)->slice(':,:,:,0:-2')) += $ortho;
# step 3, upper left tri0
($tmp=$aver->slice(':,0:-2,1:-1')) += $ortho->slice(':,:,(0)');
# step 4, lower right tri1
($tmp=$aver->slice(':,1:-1,0:-2')) += $ortho->slice(':,:,(1)');
$aver->norm($aver);
return $aver;
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/Logo.pm0000644000175000017500000003164614775155512021534 0ustar osboxesosboxespackage PDL::Graphics::TriD::Logo;
use strict;
use warnings;
use PDL::Lite;
our @ISA=qw/PDL::Graphics::TriD::Object/;
our $POINTS = PDL->pdl([
[ 0.843, 0.852, 0],
[ 0.843, 0.852, -1],
[ 1.227, 0.891, 0],
[ 1.227, 0.891, -1],
[ 1.56, 1.071, 0],
[ 1.56, 1.071, -1],
[ 1.722, 1.488, 0],
[ 1.722, 1.488, -1],
[ 1.656, 1.776, 0],
[ 1.656, 1.776, -1],
[ 1.488, 1.956, 0],
[ 1.488, 1.956, -1],
[ 0.942, 2.076, 0],
[ 0.942, 2.076, -1],
[ 0.105, 2.076, 0],
[ 0.105, 2.076, -1],
[ 0.105, 1.989, 0],
[ 0.105, 1.989, -1],
[ 0.339, 1.95, 0],
[ 0.339, 1.95, -1],
[ 0.375, 1.797, 0],
[ 0.375, 1.797, -1],
[ 0.375, 0.279, 0],
[ 0.375, 0.279, -1],
[ 0.339, 0.126, 0],
[ 0.339, 0.126, -1],
[ 0.105, 0.087, 0],
[ 0.105, 0.087, -1],
[ 0.105, 0, 0],
[ 0.105, 0, -1],
[ 0.99, 0, 0],
[ 0.99, 0, -1],
[ 0.99, 0.087, 0],
[ 0.99, 0.087, -1],
[ 0.714, 0.126, 0],
[ 0.714, 0.126, -1],
[ 0.672, 0.279, 0],
[ 0.672, 0.279, -1],
[ 0.672, 0.852, 0],
[ 0.672, 0.852, -1],
[ 0.714, 1.947, 0],
[ 0.714, 1.947, -1],
[ 0.9, 1.971, 0],
[ 0.9, 1.971, -1],
[ 1.266, 1.842, 0],
[ 1.266, 1.842, -1],
[ 1.398, 1.467, 0],
[ 1.398, 1.467, -1],
[ 1.242, 1.071, 0],
[ 1.242, 1.071, -1],
[ 0.894, 0.957, 0],
[ 0.894, 0.957, -1],
[ 0.717, 0.975, 0],
[ 0.717, 0.975, -1],
[ 0.672, 1.074, 0],
[ 0.672, 1.074, -1],
[ 0.672, 1.86, 0],
[ 0.672, 1.86, -1],
[ 2.526, 1.944, 0],
[ 2.526, 1.944, -1],
[ 2.82, 1.971, 0],
[ 2.82, 1.971, -1],
[ 3.222, 1.896, 0],
[ 3.222, 1.896, -1],
[ 3.48, 1.701, 0],
[ 3.48, 1.701, -1],
[ 3.657, 1.062, 0],
[ 3.657, 1.062, -1],
[ 3.591, 0.594, 0],
[ 3.591, 0.594, -1],
[ 3.411, 0.3, 0],
[ 3.411, 0.3, -1],
[ 3.132, 0.147, 0],
[ 3.132, 0.147, -1],
[ 2.784, 0.105, 0],
[ 2.784, 0.105, -1],
[ 2.529, 0.15, 0],
[ 2.529, 0.15, -1],
[ 2.472, 0.375, 0],
[ 2.472, 0.375, -1],
[ 2.472, 1.8, 0],
[ 2.472, 1.8, -1],
[ 1.905, 1.989, 0],
[ 1.905, 1.989, -1],
[ 2.139, 1.95, 0],
[ 2.139, 1.95, -1],
[ 2.175, 1.797, 0],
[ 2.175, 1.797, -1],
[ 2.175, 0.279, 0],
[ 2.175, 0.279, -1],
[ 2.139, 0.126, 0],
[ 2.139, 0.126, -1],
[ 1.905, 0.087, 0],
[ 1.905, 0.087, -1],
[ 1.905, 0, 0],
[ 1.905, 0, -1],
[ 2.841, 0, 0],
[ 2.841, 0, -1],
[ 3.603, 0.192, 0],
[ 3.603, 0.192, -1],
[ 3.882, 0.522, 0],
[ 3.882, 0.522, -1],
[ 3.993, 1.074, 0],
[ 3.993, 1.074, -1],
[ 3.927, 1.491, 0],
[ 3.927, 1.491, -1],
[ 3.723, 1.815, 0],
[ 3.723, 1.815, -1],
[ 3.375, 2.013, 0],
[ 3.375, 2.013, -1],
[ 2.901, 2.076, 0],
[ 2.901, 2.076, -1],
[ 1.905, 2.076, 0],
[ 1.905, 2.076, -1],
[ 4.848, 1.95, 0],
[ 4.848, 1.95, -1],
[ 5.097, 1.989, 0],
[ 5.097, 1.989, -1],
[ 5.097, 2.076, 0],
[ 5.097, 2.076, -1],
[ 4.242, 2.076, 0],
[ 4.242, 2.076, -1],
[ 4.242, 1.989, 0],
[ 4.242, 1.989, -1],
[ 4.476, 1.95, 0],
[ 4.476, 1.95, -1],
[ 4.512, 1.797, 0],
[ 4.512, 1.797, -1],
[ 4.512, 0.279, 0],
[ 4.512, 0.279, -1],
[ 4.476, 0.126, 0],
[ 4.476, 0.126, -1],
[ 4.242, 0.087, 0],
[ 4.242, 0.087, -1],
[ 4.242, 0, 0],
[ 4.242, 0, -1],
[ 5.799, 0, 0],
[ 5.799, 0, -1],
[ 5.835, 0.537, 0],
[ 5.835, 0.537, -1],
[ 5.745, 0.537, 0],
[ 5.745, 0.537, -1],
[ 5.571, 0.174, 0],
[ 5.571, 0.174, -1],
[ 5.205, 0.105, 0],
[ 5.205, 0.105, -1],
[ 4.884, 0.135, 0],
[ 4.884, 0.135, -1],
[ 4.809, 0.36, 0],
[ 4.809, 0.36, -1],
[ 4.809, 1.797, 0],
[ 4.809, 1.797, -1]]);
our $FACES = PDL->pdl([
[ 0, 1, 2],
[ 3, 2, 1],
[ 2, 3, 4],
[ 5, 4, 3],
[ 4, 5, 6],
[ 7, 6, 5],
[ 6, 7, 8],
[ 9, 8, 7],
[ 8, 9, 10],
[ 11, 10, 9],
[ 10, 11, 12],
[ 13, 12, 11],
[ 12, 13, 14],
[ 15, 14, 13],
[ 14, 15, 16],
[ 17, 16, 15],
[ 16, 17, 18],
[ 19, 18, 17],
[ 18, 19, 20],
[ 21, 20, 19],
[ 20, 21, 22],
[ 23, 22, 21],
[ 22, 23, 24],
[ 25, 24, 23],
[ 24, 25, 26],
[ 27, 26, 25],
[ 26, 27, 28],
[ 29, 28, 27],
[ 28, 29, 30],
[ 31, 30, 29],
[ 30, 31, 32],
[ 33, 32, 31],
[ 32, 33, 34],
[ 35, 34, 33],
[ 34, 35, 36],
[ 37, 36, 35],
[ 36, 37, 38],
[ 39, 38, 37],
[ 38, 39, 0],
[ 1, 0, 39],
[ 40, 41, 42],
[ 43, 42, 41],
[ 42, 43, 44],
[ 45, 44, 43],
[ 44, 45, 46],
[ 47, 46, 45],
[ 46, 47, 48],
[ 49, 48, 47],
[ 48, 49, 50],
[ 51, 50, 49],
[ 50, 51, 52],
[ 53, 52, 51],
[ 52, 53, 54],
[ 55, 54, 53],
[ 54, 55, 56],
[ 57, 56, 55],
[ 56, 57, 40],
[ 41, 40, 57],
[ 58, 59, 60],
[ 61, 60, 59],
[ 60, 61, 62],
[ 63, 62, 61],
[ 62, 63, 64],
[ 65, 64, 63],
[ 64, 65, 66],
[ 67, 66, 65],
[ 66, 67, 68],
[ 69, 68, 67],
[ 68, 69, 70],
[ 71, 70, 69],
[ 70, 71, 72],
[ 73, 72, 71],
[ 72, 73, 74],
[ 75, 74, 73],
[ 74, 75, 76],
[ 77, 76, 75],
[ 76, 77, 78],
[ 79, 78, 77],
[ 78, 79, 80],
[ 81, 80, 79],
[ 80, 81, 58],
[ 59, 58, 81],
[ 82, 83, 84],
[ 85, 84, 83],
[ 84, 85, 86],
[ 87, 86, 85],
[ 86, 87, 88],
[ 89, 88, 87],
[ 88, 89, 90],
[ 91, 90, 89],
[ 90, 91, 92],
[ 93, 92, 91],
[ 92, 93, 94],
[ 95, 94, 93],
[ 94, 95, 96],
[ 97, 96, 95],
[ 96, 97, 98],
[ 99, 98, 97],
[ 98, 99,100],
[101,100, 99],
[100,101,102],
[103,102,101],
[102,103,104],
[105,104,103],
[104,105,106],
[107,106,105],
[106,107,108],
[109,108,107],
[108,109,110],
[111,110,109],
[110,111,112],
[113,112,111],
[112,113, 82],
[ 83, 82,113],
[114,115,116],
[117,116,115],
[116,117,118],
[119,118,117],
[118,119,120],
[121,120,119],
[120,121,122],
[123,122,121],
[122,123,124],
[125,124,123],
[124,125,126],
[127,126,125],
[126,127,128],
[129,128,127],
[128,129,130],
[131,130,129],
[130,131,132],
[133,132,131],
[132,133,134],
[135,134,133],
[134,135,136],
[137,136,135],
[136,137,138],
[139,138,137],
[138,139,140],
[141,140,139],
[140,141,142],
[143,142,141],
[142,143,144],
[145,144,143],
[144,145,146],
[147,146,145],
[146,147,148],
[149,148,147],
[148,149,150],
[151,150,149],
[150,151,114],
[115,114,151],
[ 13, 43, 41],
[ 13, 45, 43],
[ 11, 45, 13],
[ 11, 47, 45],
[ 5, 47, 11],
[ 5, 49, 47],
[ 3, 49, 5],
[ 3, 51, 49],
[ 1, 51, 3],
[ 1, 53, 51],
[ 39, 53, 1],
[ 39, 55, 53],
[ 57, 55, 39],
[ 57, 39, 37],
[ 21, 57, 37],
[ 23, 21, 37],
[ 35, 23, 37],
[ 21, 41, 57],
[ 21, 13, 41],
[ 19, 13, 21],
[ 19, 15, 13],
[ 17, 15, 19],
[ 5, 11, 9],
[ 7, 5, 9],
[ 35, 33, 31],
[ 23, 35, 31],
[ 25, 23, 31],
[ 27, 25, 31],
[ 29, 27, 31],
[111, 61, 59],
[111, 63, 61],
[109, 63,111],
[109, 65, 63],
[107, 65,109],
[107, 67, 65],
[101, 67,107],
[101, 99, 67],
[ 97, 75, 73],
[ 97, 77, 75],
[ 89, 77, 97],
[ 89, 79, 77],
[ 87, 79, 89],
[ 87, 81, 79],
[ 59, 81, 87],
[ 59, 87, 85],
[111, 59, 85],
[113,111, 85],
[ 83,113, 85],
[101,107,105],
[103,101,105],
[ 69, 67, 99],
[ 71, 69, 99],
[ 73, 71, 99],
[ 97, 73, 99],
[ 91, 89, 97],
[ 93, 91, 97],
[ 95, 93, 97],
[125,121,119],
[127,125,119],
[115,127,119],
[117,115,119],
[149,127,151],
[149,129,127],
[147,129,149],
[147,131,129],
[137,131,147],
[137,133,131],
[135,133,137],
[141,139,137],
[143,141,137],
[145,143,137],
[147,145,137],
[123,121,125],
[151,127,115],
[ 40, 42, 12],
[ 12, 42, 44],
[ 12, 44, 10],
[ 10, 44, 46],
[ 10, 46, 4],
[ 4, 46, 48],
[ 4, 48, 2],
[ 2, 48, 50],
[ 2, 50, 0],
[ 0, 50, 52],
[ 0, 52, 38],
[ 38, 52, 54],
[ 38, 54, 56],
[ 36, 38, 56],
[ 36, 56, 20],
[ 36, 20, 22],
[ 36, 22, 34],
[ 56, 40, 20],
[ 20, 40, 12],
[ 20, 12, 18],
[ 18, 12, 14],
[ 18, 14, 16],
[ 8, 10, 4],
[ 8, 4, 6],
[ 30, 32, 34],
[ 30, 34, 22],
[ 30, 22, 24],
[ 30, 24, 26],
[ 30, 26, 28],
[ 58, 60,110],
[110, 60, 62],
[110, 62,108],
[108, 62, 64],
[108, 64,106],
[106, 64, 66],
[106, 66,100],
[100, 66, 98],
[ 72, 74, 96],
[ 96, 74, 76],
[ 96, 76, 88],
[ 88, 76, 78],
[ 88, 78, 86],
[ 86, 78, 80],
[ 86, 80, 58],
[ 84, 86, 58],
[ 84, 58,110],
[ 84,110,112],
[ 84,112, 82],
[104,106,100],
[104,100,102],
[ 98, 66, 68],
[ 98, 68, 70],
[ 98, 70, 72],
[ 98, 72, 96],
[ 96, 88, 90],
[ 96, 90, 92],
[ 96, 92, 94],
[118,120,124],
[118,124,126],
[118,126,114],
[118,114,116],
[150,126,148],
[148,126,128],
[148,128,146],
[146,128,130],
[146,130,136],
[136,130,132],
[136,132,134],
[136,138,140],
[136,140,142],
[136,142,144],
[136,144,146],
[124,120,122],
[114,126,150]]);
sub new {
my ($type,$pos,$size) = @_;
bless {
Points => $POINTS->copy,
Index => $FACES->copy,
Material => PDL::Graphics::TriD::Material->new(
Shine => 0.212766,
Specular =>[0.753217,0.934416,1],
Ambient =>[0,0,0],
Diffuse =>[0.09855,0.153113,0.191489],
Emissive =>[0, 0, 0]),
Pos => $pos // [0,1.2,0],
Size => $size // 0.1,
}, $type;
}
1;
# ***add these lines to, e.g. tvrml2.pl
#
# use PDL::Graphics::TriD::Logo;
# $win->add_object(PDL::Graphics::TriD::Logo->new);
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/Graph.pm0000644000175000017500000002276314775155512021675 0ustar osboxesosboxespackage PDL::Graphics::TriD::Graph;
=head1 NAME
PDL::Graphics::TriD::Graph - PDL 3D graph object with axes
=head1 SYNOPSIS
use PDL::Graphics::TriD;
use PDL::Graphics::TriD::Graph;
$g = PDL::Graphics::TriD::Graph->new;
$g->default_axes;
$g->add_dataseries(PDL::Graphics::TriD::Lattice->new($y,$c), "lat0");
$g->bind_default("lat0");
$g->add_dataseries(PDL::Graphics::TriD::LineStrip->new($y+pdl(0,0,1),$c), "lat1");
$g->bind_default("lat1");
$g->scalethings;
$win = PDL::Graphics::TriD::get_current_window();
$win->clear_objects;
$win->add_object($g);
$win->twiddle;
=cut
use strict;
use warnings;
use base qw/PDL::Graphics::TriD::Object/;
use PDL::LiteF; # XXX F needed?
use fields qw(Data DataBind UnBound DefaultAxes Axis );
sub add_dataseries {
my($this,$data,$name) = @_;
if(!defined $name) {
$name = "Data0";
while(defined $this->{Data}{$name}) {$name++;}
}
$this->{Data}{$name} = $data;
$this->{DataBind}{$name} = [];
$this->{UnBound}{$name} = 1;
$this->add_object($data);
$this->changed();
return $name;
}
sub bind_data {
my($this,$dser,$axes,$axis) = @_;
push @{$this->{DataBind}{$dser}},[$axis,$axes];
delete $this->{UnBound}{$dser};
$this->changed();
}
sub bind_default {
my($this,$dser,$axes) = @_;
$axes //= $this->{DefaultAxes};
$this->{DataBind}{$dser} = [['Default',$axes]];
delete $this->{UnBound}{$dser};
}
sub set_axis {
my($this,$axis,$name) = @_;
$this->{Axis}{$name} = $axis;
$this->changed();
}
# Bind all unbound things here...
sub scalethings {
my($this) = @_;
$this->bind_default($_) for keys %{$this->{UnBound}};
$_->init_scale() for values %{$this->{Axis}};
my ($k,$v);
while(($k,$v) = each %{$this->{DataBind}}) {
$this->{Axis}{$_->[0]}->add_scale($this->{Data}{$k}->get_points(), $_->[1]) for @$v;
}
$_->finish_scale() for values %{$this->{Axis}};
}
sub get_points {
my($this,$name) = @_;
# print Dumper($this->{Axis});
my $d = $this->{Data}{$name}->get_points();
my @ddims = $d->dims; shift @ddims;
my $p = PDL->zeroes(PDL::float(),3,@ddims);
my $pnew;
for(@{$this->{DataBind}{$name}}) {
defined($this->{Axis}{$_->[0]}) or die("Axis not defined: $_->[0]");
# Transform can return the same or a different ndarray.
$p = $pnew = $this->{Axis}{$_->[0]}->transform($p,$d,$_->[1]);
}
return $pnew;
}
sub clear_data {
my($this) = @_;
$this->{$_} = {} for qw(Data DataBind UnBound);
$this->changed;
}
sub delete_data {
my($this,$name) = @_;
delete $this->{$_}{$name} for qw(Data DataBind UnBound);
$this->changed;
}
sub default_axes {
my($this) = @_;
$this->set_axis(PDL::Graphics::TriD::EuclidAxes->new(),"Euclid3");
$this->set_default_axis("Euclid3",[0,1,2]);
}
sub set_default_axis {
my($this,$name,$axes) = @_;
$this->{Axis}{Default} = $this->{Axis}{$name};
$this->{DefaultAxes} = $axes;
}
sub changed {}
package PDL::Graphics::TriD::EuclidAxes;
sub new {
my($type) = @_; bless {Names => [qw(X Y Z)]},$type;
}
sub init_scale {
my($this) = @_;
$this->{Scale} = undef;
}
sub add_scale {
my($this,$data,$inds) = @_;
$data = $data->dice_axis(0, $inds);
my $to_minmax = $data->clump(1..$data->ndims-1); # xyz,...
$to_minmax = $to_minmax->glue(1, $this->{Scale}); # include old min/max
my ($mins, $maxes) = $to_minmax->transpose->minmaxover; # each is xyz
$this->{Scale} = PDL->pdl($mins, $maxes); # xyz,minmax
}
sub finish_scale {
my($this) = @_;
# Normalize the smallest differences away.
my ($min, $max) = $this->{Scale}->dog;
my $diff = $max - $min;
my ($got_smalldiff, $got_bigdiff) = PDL::which_both(abs($diff) < 1e-6);
$max->dice_axis(0, $got_smalldiff) .= $min->dice_axis(0, $got_smalldiff) + 1;
my ($min_big, $max_big, $shift) = map $_->dice_axis(0, $got_bigdiff), $min, $max, $diff;
$shift = $shift * 0.05; # don't mutate
$min_big -= $shift, $max_big += $shift;
}
# Add 0..1 to each axis.
sub transform {
my($this,$point,$data,$inds) = @_;
my ($min, $max) = map $this->{Scale}->slice("0:$#$inds,$_"), 0, 1;
(my $tmp = $point->slice("0:$#$inds")) +=
($data->dice_axis(0, $inds) - $min) / ($max - $min);
return $point;
}
# projects from the sphere to a cylinder
package PDL::Graphics::TriD::CylindricalEquidistantAxes;
use PDL::Core '';
sub new {
my($type) = @_;
bless {Names => [qw(LON LAT Pressure)]},$type;
}
sub init_scale {
my($this) = @_;
$this->{Scale} = [];
}
sub add_scale {
my($this,$data,$inds) = @_;
my $i = 0;
for(@$inds) {
my $d = $data->slice("($_)");
my $max = $d->max->sclr;
my $min = $d->min->sclr;
if($i==1){
if($max > 89.9999 or $min < -89.9999){
barf "Error in Latitude $max $min\n";
}
}
elsif($i==2){
$max = 1012.5 if($max<1012.5);
$min = 100 if($min>100);
}
if(!defined $this->{Scale}[$i]) {
$this->{Scale}[$i] = [$min,$max];
} else {
if($min < $this->{Scale}[$i][0]) {
$this->{Scale}[$i][0] = $min;
}
if($max > $this->{Scale}[$i][1]) {
$this->{Scale}[$i][1] = $max;
}
}
$i++;
}
# Should make the projection center an option
$this->{Center} = [$this->{Scale}[0][0]+($this->{Scale}[0][1]-$this->{Scale}[0][0])/2,
0];
}
sub finish_scale {
my($this) = @_;
my @dist;
# Normalize the smallest differences away.
for(@{$this->{Scale}}) {
if(abs($_->[0] - $_->[1]) < 0.000001) {
$_->[1] = $_->[0] + 1;
}
push(@dist,$_->[1]-$_->[0]);
}
# for the z coordinate reverse the min and max values
my $max = $this->{Scale}[2][0];
if($max < $this->{Scale}[2][1]){
$this->{Scale}[2][0] = $this->{Scale}[2][1];
$this->{Scale}[2][1] = $max;
}
# Normalize longitude and latitude scale
if($dist[1] > $dist[0]){
$this->{Scale}[0][0] -= ($dist[1]-$dist[0])/2;
$this->{Scale}[0][1] += ($dist[1]-$dist[0])/2;
}elsif($dist[0] > $dist[1] && $dist[0]<90){
$this->{Scale}[1][0] -= ($dist[0]-$dist[1])/2;
$this->{Scale}[1][1] += ($dist[0]-$dist[1])/2;
}elsif($dist[0] > $dist[1]){
$this->{Scale}[1][0] -= (90-$dist[1])/2;
$this->{Scale}[1][1] += (90-$dist[1])/2;
}
}
sub transform {
my($this,$point,$data,$inds) = @_;
my $i = 0;
if($#$inds!=2){
barf("Wrong number of arguments to transform $this\n");
exit;
}
my $pio180 = 0.017453292;
(my $tmp1 = $point->slice("(0)")) +=
0.5+($data->slice("($inds->[0])")-$this->{Center}[0]) /
($this->{Scale}[0][1] - $this->{Scale}[0][0])
*cos($data->slice("($inds->[1])")*$pio180);
(my $tmp2 = $point->slice("(1)")) +=
0.5+($data->slice("($inds->[1])")-$this->{Center}[1]) /
($this->{Scale}[1][1] - $this->{Scale}[1][0]);
(my $tmp3 = $point->slice("(2)")) .=
log($data->slice("($inds->[2])")/1012.5)/log($this->{Scale}[2][1]/1012.5);
return $point;
}
package PDL::Graphics::TriD::PolarStereoAxes;
use PDL::Core '';
sub new {
my($type) = @_;
bless {Names => [qw(LONGITUDE LATITUDE HEIGHT)]},$type;
}
sub init_scale {
my($this) = @_;
$this->{Scale} = [];
}
sub add_scale {
my($this,$data,$inds) = @_;
my $i = 0;
for(@$inds) {
my $d = $data->slice("($_)");
my $max = $d->max->sclr;
my $min = $d->min->sclr;
if($i==1){
if($max > 89.9999 or $min < -89.9999){
barf "Error in Latitude $max $min\n";
}
}
elsif($i==2){
$max = 1012.5 if($max<1012.5);
$min = 100 if($min>100);
}
if(!defined $this->{Scale}[$i]) {
$this->{Scale}[$i] = [$min,$max];
} else {
if($min < $this->{Scale}[$i][0]) {
$this->{Scale}[$i][0] = $min;
}
if($max > $this->{Scale}[$i][1]) {
$this->{Scale}[$i][1] = $max;
}
}
$i++;
}
$this->{Center} = [$this->{Scale}[0][0]+($this->{Scale}[0][1]-$this->{Scale}[0][0])/2,
$this->{Scale}[1][0]+($this->{Scale}[1][1]-$this->{Scale}[1][0])/2];
}
sub finish_scale {
my($this) = @_;
my @dist;
# Normalize the smallest differences away.
for(@{$this->{Scale}}) {
if(abs($_->[0] - $_->[1]) < 0.000001) {
$_->[1] = $_->[0] + 1;
}
push(@dist,$_->[1]-$_->[0]);
}
# for the z coordinate reverse the min and max values
my $max = $this->{Scale}[2][0];
if($max < $this->{Scale}[2][1]){
$this->{Scale}[2][0] = $this->{Scale}[2][1];
$this->{Scale}[2][1] = $max;
}
# Normalize longitude and latitude scale
if($dist[1] > $dist[0]){
$this->{Scale}[0][0] -= ($dist[1]-$dist[0])/2;
$this->{Scale}[0][1] += ($dist[1]-$dist[0])/2;
}elsif($dist[0] > $dist[1] && $dist[0]<90){
$this->{Scale}[1][0] -= ($dist[0]-$dist[1])/2;
$this->{Scale}[1][1] += ($dist[0]-$dist[1])/2;
}elsif($dist[0] > $dist[1]){
$this->{Scale}[1][0] -= (90-$dist[1])/2;
$this->{Scale}[1][1] += (90-$dist[1])/2;
}
}
sub transform {
my($this,$point,$data,$inds) = @_;
my $i = 0;
if($#$inds!=2){
barf("Wrong number of arguments to transform $this\n");
exit;
}
my $pio180 = 0.017453292;
(my $tmp1 = $point->slice("(0)")) +=
0.5+($data->slice("($inds->[0])")-$this->{Center}[0]) /
($this->{Scale}[0][1] - $this->{Scale}[0][0])
*cos($data->slice("($inds->[1])")*$pio180);
(my $tmp2 = $point->slice("(1)")) +=
0.5+($data->slice("($inds->[1])")-$this->{Center}[1]) /
($this->{Scale}[1][1] - $this->{Scale}[1][0])
*cos($data->slice("($inds->[1])")*$pio180);
# Longitude transformation
# (my $tmp = $point->slice("(0)")) =
# ($this->{Center}[0]-$point->slice("(0)"))*cos($data->slice("(1)"));
# Latitude transformation
# (my $tmp = $point->slice("(1)")) =
# ($this->{Center}[1]-$data->slice("(1)"))*cos($data->slice("(1)"));
# Vertical transformation
# -7.2*log($data->slice("(2)")/1012.5
(my $tmp3 = $point->slice("(2)")) .=
log($data->slice("($inds->[2])")/1012.5)/log($this->{Scale}[2][1]/1012.5);
return $point;
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/Polygonize.pm0000644000175000017500000000515314775155512022765 0ustar osboxesosboxes# XXXX NOTHING BUT stupidpolygonize WORKS!!!!
package PDL::Graphics::TriD::StupidPolygonize;
use strict;
use warnings;
use PDL::Core '';
# A very simplistic polygonizer...
# Center = positive, outside = negative.
sub stupidpolygonize {
my($center, $initrad, $npatches, $nrounds, $func) = @_;
my $x = PDL->zeroes(PDL::float(),3,$npatches,$npatches);
my $mult = 2*3.14 / ($npatches-1);
my $ya = ($x->slice("(0)"))->xvals;
$ya *= $mult;
my $za = ($x->slice("(0)"))->yvals;
$za *= $mult/2;
$za -= 3.14/2;
(my $tmp0 = $x->slice("(0)")) += cos($ya);
(my $tmp1 = $x->slice("(1)")) += sin($ya);
(my $tmp01 = $x->slice("0:1")) *= cos($za)->dummy(0);
(my $tmp2 = $x->slice("(2)")) += sin($za);
my $add = $x->copy;
$x *= $initrad;
$x += $center;
my $cur = $initrad;
my $inita = $x->copy;
for(1..$nrounds) {
$cur /= 2;
my $vp = $func->($x);
my $vps = ($vp > 0);
$vps -= 0.5; $vps *= 2;
$x += $vps->dummy(0) * $cur * $add;
}
return $x;
}
sub polygonizeraw {
my($data,$coords) = @_;
}
sub contours {
}
package PDL::Graphics::TriD::ContourPolygonize;
#
# First compute contours.
use vars qw/$cube $cents/;
$cube = PDL->pdl([
[-1,-1,-1],
[-1,-1,1],
[-1,1,-1],
[-1,1,1],
[1,-1,-1],
[1,-1,1],
[1,1,-1],
[1,1,1]
]);
$cents = PDL->pdl([
[0,0,-1],
[0,0,1],
[0,-1,0],
[0,1,0],
[-1,0,0],
[1,0,0],
]);
sub contourpolygonize {
my($in,$oscale,$scale,$func) = @_;
my $ccube = $cube * $oscale;
my $maxstep=0;
while(($func->($ccube)>=0)->sum->sclr > 0) {
$ccube *= 1.5;
if($maxstep ++ > 30) {
die("Too far inside");
}
}
# Now, we have a situation with a cube that has inside a I point
# and as corners O points. This does not guarantee that we have all
# the surface but it's enough for now.
}
#############
#sub trianglepolygonize {
#
# find_3nn(
#}
package PDL::Graphics::TriD::Polygonize;
use PDL::Core '';
# Inside positive, outside negative!
#
# XXX DOESN'T WORK
sub polygonize {
my($inv,$outv,$cubesize,$func) = @_;
barf "Must be positive" if $cubesize <= 0;
my $iv = $func->($inv);
my $ov = $func->($outv);
my $s;
# Find a close enough point to zero.
while(((sqrt(($iv-$ov))**2))->sum->sclr > $cubesize) {
my $s = $iv + $ov; $s /= 2;
my $v = $func->($s);
$v->sum->sclr < 0 ?
$ov = $s :
$iv = $s;
}
# Correct the smaller distance to cubesize.
$iv = $ov + ($iv-$ov) * $cubesize / sqrt(($iv-$ov)**2)
# If it went outside, do it the other way around.
# if($func->($iv)->sum->sclr < 0) {
# $ov = $iv + ($ov-$iv) * $cubesize / sqrt(($iv-$ov)**2)
# }
# Now, |$iv-$ov| = $cubesize
# Make the first cube
# Then, start the cubes march.
}
# Cube coordinates.
sub marchcubes {
my($init) = @_;
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/ViewPort.pm0000644000175000017500000000425714775155512022411 0ustar osboxesosboxes#
# The PDL::Graphics::TriD::ViewPort is already partially defined in
# the appropriate gdriver (GL or VRML), items defined here are common
# to both
#
package PDL::Graphics::TriD::ViewPort;
use strict;
use warnings;
use base qw/PDL::Graphics::TriD::Object/;
use fields qw/X0 Y0 W H Transformer EHandler Active ResizeCommands
DefMaterial AspectRatio Graphs/;
$PDL::Graphics::TriD::verbose //= 0;
sub new {
my($type,$x0,$y0,$w,$h) = @_;
my $this= $type->SUPER::new();
$this->{X0} = $x0;
$this->{Y0} = $y0;
$this->{W} = $w;
$this->{H} = $h;
$this->{DefMaterial} = PDL::Graphics::TriD::Material->new;
return $this;
}
sub graph {
my($this,$graph) = @_;
if(defined($graph)){
$this->add_object($graph);
push(@{$this->{Graphs}},$graph);
}elsif(defined $this->{Graphs}){
$graph = $this->{Graphs}[0];
}
return($graph);
}
sub delete_graph {
my($this,$graph) = @_;
$this->delete_object($graph);
for(0..$#{$this->{Graphs}}){
if($graph == $this->{Graphs}[$_]){
splice(@{$this->{Graphs}},$_,1);
redo;
}
}
}
sub resize {
my($this,$x0,$y0,$w,$h) = @_;
$this->{X0} = $x0;
$this->{Y0} = $y0;
$this->{W} = $w;
$this->{H} = $h;
return $this;
}
sub add_resizecommand {
my($this,$com) = @_;
push @{$this->{ResizeCommands}},$com;
print "ARC: $this->{W},$this->{H}\n" if($PDL::Graphics::TriD::verbose);
&$com($this->{W},$this->{H});
}
sub set_material {
$_[0]->{DefMaterial} = $_[1];
}
sub eventhandler {
my ($this,$eh) = @_;
if(defined $eh){
$this->{EHandler} = $eh;
}
return $this->{EHandler};
}
sub set_transformer {
$_[0]->transformer($_[1]);
}
sub transformer {
my ($this,$t) = @_;
if(defined $t){
$this->{Transformer} = $t;
}
return $this->{Transformer};
}
#
# restore the image view to a known value
#
sub setview{
my($vp,$view) = @_;
my $transformer = $vp->transformer();
if(ref($view) eq "ARRAY"){
$transformer->set({WRotation=>$view});
}elsif($view eq "Top"){
$transformer->set({WRotation=>[1,0,0,0]});
}elsif($view eq "East"){
$transformer->set({WRotation=>[0.5,-0.5,-0.5,-0.5]});
}elsif($view eq "South"){
$transformer->set({WRotation=>[0.6,-0.6,0,0]});
}
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/GL/0000755000175000017500000000000014776144103020561 5ustar osboxesosboxesPDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/GL/GLFW.pm0000644000175000017500000001155614776143612021672 0ustar osboxesosboxespackage PDL::Graphics::TriD::GL::GLFW;
use strict;
use warnings;
use OpenGL::GLFW qw( :all );
our @ISA = qw(PDL::Graphics::TriD::GL);
my ($window_seq, @fakeXEvents, %winObjects) = 0;
sub new {
my ($class,$options,$window_obj) = @_;
my $self = $class->SUPER::new($options,$window_obj);
print STDERR "Creating GLFW OO window\n" if $PDL::Graphics::TriD::verbose;
glfwSetErrorCallback(\&_error_callback);
die "Failed to initialise GLFW" if glfwInit() != GLFW_TRUE;
$self->{xevents} = \@fakeXEvents;
$self->{winobjects} = \%winObjects;
my $p = $self->{Options};
glfwWindowHint(GLFW_SCALE_FRAMEBUFFER, GLFW_FALSE);
die "GLFW failed to create window"
if !defined(my $glfwin = $self->{glfwwindow} = glfwCreateWindow(@$p{qw(width height)}, "GLFW TriD", NULL, NULL));
$self->{window_seq} = ++$window_seq;
glfwSetWindowTitle($glfwin, "GLFW TriD #$self->{window_seq}");
glfwSetWindowSizeCallback($glfwin, \&_fake_ConfigureNotify);
glfwSetWindowCloseCallback($glfwin, \&_fake_exit_handler);
glfwSetCharCallback($glfwin, \&_fake_KeyPress);
glfwSetMouseButtonCallback($glfwin, \&_fake_button_event);
glfwSetScrollCallback($glfwin, \&_fake_scroll_event);
glfwSetCursorPosCallback($glfwin, \&_fake_MotionNotify);
glfwSetWindowRefreshCallback($glfwin,\&_display_wrapper);
glfwShowWindow($glfwin);
if ($PDL::Graphics::TriD::verbose) {
print "gdriver: Got TriD::GL object(GLFW window ID#$self->{window_seq} " . $self->{glfwwindow} . ")\n";
}
$self->{winobjects}->{$self->{glfwwindow}} = $window_obj; # circular ref
$self;
}
END { glfwSetErrorCallback(undef); glfwTerminate(); }
sub _error_callback {
my ($err_code, $err_str) = @_;
warn "GLFW error $err_code: $err_str";
}
sub DESTROY {
my ($self) = @_;
print __PACKAGE__."::DESTROY called (win=$self->{glfwwindow})\n" if $PDL::Graphics::TriD::verbose;
@{ $self->{xevents} } = ();
return if !defined $self->{glfwwindow};
glfwDestroyWindow($self->{glfwwindow}); # removes callbacks
delete $self->{glfwwindow};
}
sub _display_wrapper {
my ($win) = @_;
if ( defined($win) and defined($winObjects{$win}) ) {
$winObjects{$win}->display;
}
}
sub _fake_exit_handler {
my ($win) = shift;
print "_fake_exit_handler: clicked for window $win\n" if $PDL::Graphics::TriD::verbose;
push @fakeXEvents, [ 'destroy', @_ ];
}
sub _fake_ConfigureNotify {
print "_fake_ConfigureNotify: got (@_)\n" if $PDL::Graphics::TriD::verbose;
push @fakeXEvents, [ 'reshape', @_[1,2] ];
}
sub _fake_KeyPress {
print "_fake_KeyPress: got (@_)\n" if $PDL::Graphics::TriD::verbose;
push @fakeXEvents, [ 'keypress', chr($_[1]) ];
}
{
my @button_to_mask = (1<<8, 1<<9, 1<<10);
my $fake_mouse_state = 0;
my ($lastx, $lasty);
sub _fake_button_event {
print "_fake_button_event: got (@_)\n" if $PDL::Graphics::TriD::verbose;
my ($win, $button, $action) = @_;
my $but = $button == GLFW_MOUSE_BUTTON_LEFT ? 0 :
$button == GLFW_MOUSE_BUTTON_MIDDLE ? 1 :
$button == GLFW_MOUSE_BUTTON_RIGHT ? 2 :
return;
my $ev = $action == GLFW_PRESS ? 'buttonpress' :
$action == GLFW_RELEASE ? 'buttonrelease' :
return;
my $mask = $button_to_mask[$but];
if ( $ev eq 'buttonpress' ) { # a press
$fake_mouse_state |= $mask;
} elsif ( $_[1] == 1 ) { # a release
$fake_mouse_state &= ~$mask;
}
push @fakeXEvents, [ $ev, $but+1, $lastx, $lasty ];
}
sub _fake_scroll_event {
print "_fake_scroll_event: got (@_)\n" if $PDL::Graphics::TriD::verbose;
my ($win, $xoffset, $yoffset) = @_;
my $but = $yoffset > 0 ? 3 : 4;
push @fakeXEvents, [ 'buttonpress', $but+1, $lastx, $lasty ];
push @fakeXEvents, [ 'buttonrelease', $but+1, $lastx, $lasty ];
}
sub _fake_MotionNotify {
print "_fake_MotionNotify: got (@_)\n" if $PDL::Graphics::TriD::verbose;
my ($win, $xpos, $ypos) = @_;
my $but = -1;
SWITCH: {
for (0..2) {
$but = $_, last SWITCH if $fake_mouse_state & $button_to_mask[$_];
}
print "No button pressed...\n" if $PDL::Graphics::TriD::verbose;
}
($lastx, $lasty) = ($xpos, $ypos);
return if $but < 0;
push @fakeXEvents, [ 'motion', $but, $xpos, $ypos ];
}
}
sub event_pending {
my($self) = @_;
# monitor state of @fakeXEvents, return number on queue
glfwPollEvents() if !@{$self->{xevents}};
print STDERR "OO::event_pending: have " . scalar( @{$self->{xevents}} ) . " xevents\n" if $PDL::Graphics::TriD::verbose > 1;
scalar @{$self->{xevents}};
}
sub next_event {
my($self) = @_;
glfwWaitEvents() while !@{$self->{xevents}}; # not all GLFW events are ours
# Extract first event from fake event queue and return
@{ shift @{$self->{xevents}} };
}
sub swap_buffers {
my ($this) = @_;
glfwSwapBuffers($this->{glfwwindow});
}
sub set_window {
my ($this) = @_;
# set context to current window (for multiwindow support)
glfwMakeContextCurrent($this->{glfwwindow});
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/GL/GLX.pm0000644000175000017500000000377314776030722021564 0ustar osboxesosboxespackage PDL::Graphics::TriD::GL::GLX;
use strict;
use warnings;
use OpenGL qw/ :glxconstants /;
our @ISA = qw(PDL::Graphics::TriD::GL);
sub new {
my ($class,$options,$window_obj) = @_;
my @db = OpenGL::GLX_DOUBLEBUFFER;
if ($PDL::Graphics::TriD::offline) {$options->{x} = -1; @db=()}
$options->{attributes} = [GLX_RGBA, @db,
GLX_RED_SIZE,1,
GLX_GREEN_SIZE,1,
GLX_BLUE_SIZE,1,
GLX_DEPTH_SIZE,1,
# Alpha size?
] unless defined $options->{attributes};
$options->{mask} = (KeyPressMask | ButtonPressMask |
ButtonMotionMask | ButtonReleaseMask |
ExposureMask | StructureNotifyMask |
PointerMotionMask) unless defined $options->{mask};
my $self = $class->SUPER::new($options,$window_obj);
print STDERR "Creating X11 OO window\n" if $PDL::Graphics::TriD::verbose;
my $p = $self->{Options};
my $win = OpenGL::glpcOpenWindow(
$p->{x},$p->{y},$p->{width},$p->{height},
$p->{parent},$p->{mask}, $p->{steal}, @{$p->{attributes}});
@$self{keys %$win} = values %$win;
$self;
}
sub event_pending {
my ($self) = @_;
OpenGL::XPending($self->{Display});
}
my %ev2str = (
VisibilityNotify() => 'visible',
Expose() => 'visible',
ConfigureNotify() => 'reshape',
DestroyNotify() => 'destroy',
KeyPress() => 'keypress',
MotionNotify() => 'motion',
ButtonPress() => 'buttonpress',
ButtonRelease() => 'buttonrelease',
);
sub next_event {
my ($self) = @_;
my @e = OpenGL::glpXNextEvent($self->{Display});
if ($e[0] == MotionNotify) {
my $but = -1;
SWITCH: {
$but = 0, last SWITCH if $e[1] & Button1Mask;
$but = 1, last SWITCH if $e[1] & Button2Mask;
$but = 2, last SWITCH if $e[1] & Button3Mask;
$but = 3, last SWITCH if $e[1] & Button4Mask;
print "No button pressed...\n" if $PDL::Graphics::TriD::verbose;
}
$e[1] = $but;
}
$e[0] = $ev2str{$e[0]};
@e;
}
sub swap_buffers {
my ($this) = @_;
OpenGL::glXSwapBuffers($this->{Window},$this->{Display}); # Notice win and display reversed [sic]
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/GL/GLUT.pm0000644000175000017500000001421614776030722021677 0ustar osboxesosboxespackage PDL::Graphics::TriD::GL::GLUT;
use strict;
use warnings;
use OpenGL::GLUT qw( :all );
use OpenGL::Config;
our @ISA = qw(PDL::Graphics::TriD::GL);
my (@fakeXEvents, @winObjects);
sub new {
my ($class,$options,$window_obj) = @_;
my $self = $class->SUPER::new($options,$window_obj);
print STDERR "Creating GLUT OO window\n" if $PDL::Graphics::TriD::verbose;
glutInit() unless done_glutInit(); # make sure glut is initialized
$self->{xevents} = \@fakeXEvents;
$self->{winobjects} = \@winObjects;
$self->_init_glut_window($window_obj);
$self;
}
sub _init_glut_window {
my ($self, $window_obj) = @_;
my $p = $self->{Options};
OpenGL::GLUT::glutInitWindowPosition( $p->{x}, $p->{y} );
OpenGL::GLUT::glutInitWindowSize( $p->{width}, $p->{height} );
OpenGL::GLUT::glutInitDisplayMode( OpenGL::GLUT::GLUT_RGBA() | OpenGL::GLUT::GLUT_DOUBLE() | OpenGL::GLUT::GLUT_DEPTH() ); # hardwire for now
if ($^O ne 'MSWin32' and not $OpenGL::Config->{DEFINE} =~ /-DHAVE_W32API/) { # skip these MODE checks on win32, they don't work
if (not OpenGL::GLUT::glutGet(OpenGL::GLUT::GLUT_DISPLAY_MODE_POSSIBLE()))
{
warn "glutInitDisplayMode(GLUT_RGBA | GLUT_DOUBLE | GLUT_DEPTH | GLUT_ALPHA) not possible";
warn "...trying without GLUT_ALPHA";
# try without GLUT_ALPHA
OpenGL::GLUT::glutInitDisplayMode( OpenGL::GLUT::GLUT_RGBA() | OpenGL::GLUT::GLUT_DOUBLE() | OpenGL::GLUT::GLUT_DEPTH() );
if ( not OpenGL::GLUT::glutGet( OpenGL::GLUT::GLUT_DISPLAY_MODE_POSSIBLE() ) )
{
die "display mode not possible";
}
}
}
$self->{glutwindow} = OpenGL::GLUT::glutCreateWindow( "GLUT TriD" );
OpenGL::GLUT::glutSetWindowTitle("GLUT TriD #$self->{glutwindow}");
OpenGL::GLUT::glutReshapeFunc( \&_pdl_fake_ConfigureNotify );
OpenGL::GLUT::glutCloseFunc( \&_pdl_fake_exit_handler );
OpenGL::GLUT::glutKeyboardFunc( \&_pdl_fake_KeyPress );
OpenGL::GLUT::glutMouseFunc( \&_pdl_fake_button_event );
OpenGL::GLUT::glutMotionFunc( \&_pdl_fake_MotionNotify );
OpenGL::GLUT::glutDisplayFunc( \&_pdl_display_wrapper );
OpenGL::GLUT::glutSetOption(OpenGL::GLUT::GLUT_ACTION_ON_WINDOW_CLOSE(), OpenGL::GLUT::GLUT_ACTION_GLUTMAINLOOP_RETURNS()) if OpenGL::GLUT::_have_freeglut();
OpenGL::GLUT::glutMainLoopEvent(); # pump event loop so window appears
if ($PDL::Graphics::TriD::verbose) {
print "gdriver: Got TriD::GL object(GLUT window ID# " . $self->{glutwindow} . ")\n";
}
$self->{winobjects}->[$self->{glutwindow}] = $window_obj; # circular ref
}
sub DESTROY {
my ($self) = @_;
return if !OpenGL::GLUT::done_glutInit();
print __PACKAGE__."::DESTROY called (win=$self->{glutwindow}), GLUT says ", OpenGL::GLUT::glutGetWindow(), "\n" if $PDL::Graphics::TriD::verbose;
OpenGL::GLUT::glutMainLoopEvent(); # pump to deal with any clicking "X"
if (!OpenGL::GLUT::glutGetWindow()) {
# "X" was clicked, clear queue then stop
@{ $self->{xevents} } = ();
OpenGL::GLUT::glutMainLoopEvent(); # pump once
return;
}
OpenGL::GLUT::glutSetWindow($self->{glutwindow});
OpenGL::GLUT::glutReshapeFunc();
OpenGL::GLUT::glutCloseFunc();
OpenGL::GLUT::glutKeyboardFunc();
OpenGL::GLUT::glutMouseFunc();
OpenGL::GLUT::glutMotionFunc();
OpenGL::GLUT::glutDestroyWindow($self->{glutwindow});
OpenGL::GLUT::glutMainLoopEvent() for 1..2; # pump so window gets actually closed
delete $self->{glutwindow};
}
sub _pdl_display_wrapper {
my ($win) = OpenGL::GLUT::glutGetWindow();
if ( defined($win) and defined($winObjects[$win]) ) {
$winObjects[$win]->display();
}
}
sub _pdl_fake_exit_handler {
my ($win) = shift;
print "_pdl_fake_exit_handler: clicked for window $win\n" if $PDL::Graphics::TriD::verbose;
push @fakeXEvents, [ 'destroy', @_ ];
}
sub _pdl_fake_ConfigureNotify {
print "_pdl_fake_ConfigureNotify: got (@_)\n" if $PDL::Graphics::TriD::verbose;
OpenGL::GLUT::glutPostRedisplay();
push @fakeXEvents, [ 'reshape', @_ ];
}
sub _pdl_fake_KeyPress {
print "_pdl_fake_KeyPress: got (@_)\n" if $PDL::Graphics::TriD::verbose;
push @fakeXEvents, [ 'keypress', chr($_[0]) ];
}
{
my @button_to_mask = (1<<8, 1<<9, 1<<10, 1<<11, 1<<12);
my $fake_mouse_state = 16; # default have EnterWindowMask set;
my $last_fake_mouse_state;
sub _pdl_fake_button_event {
print "_pdl_fake_button_event: got (@_)\n" if $PDL::Graphics::TriD::verbose;
$last_fake_mouse_state = $fake_mouse_state;
my $mask = $button_to_mask[$_[0]];
return if !defined $mask; # MacOS sometimes gives button ID 5
if ( $_[1] == 0 ) { # a press
$fake_mouse_state |= $mask;
push @fakeXEvents, [ 'buttonpress', $_[0]+1, @_[2,3], -1, -1, $last_fake_mouse_state ];
} elsif ( $_[1] == 1 ) { # a release
$fake_mouse_state &= ~$mask;
push @fakeXEvents, [ 'buttonrelease', $_[0]+1 , @_[2,3], -1, -1, $last_fake_mouse_state ];
} else {
die "ERROR: _pdl_fake_button_event got unexpected value!";
}
}
sub _pdl_fake_MotionNotify {
print "_pdl_fake_MotionNotify: got (@_)\n" if $PDL::Graphics::TriD::verbose;
my $but = -1;
SWITCH: {
for (0..4) {
$but = $_, last SWITCH if $fake_mouse_state & $button_to_mask[$_];
}
print "No button pressed...\n" if $PDL::Graphics::TriD::verbose;
}
push @fakeXEvents, [ 'motion', $but, @_ ];
}
}
sub event_pending {
my($self) = @_;
# monitor state of @fakeXEvents, return number on queue
OpenGL::GLUT::glutMainLoopEvent() if !@{$self->{xevents}};
print STDERR "OO::event_pending: have " . scalar( @{$self->{xevents}} ) . " xevents\n" if $PDL::Graphics::TriD::verbose > 1;
scalar( @{$self->{xevents}} );
}
sub next_event {
my($self) = @_;
while ( !scalar( @{$self->{xevents}} ) ) {
# If no events, we keep pumping the event loop
OpenGL::GLUT::glutMainLoopEvent();
}
# Extract first event from fake event queue and return
@{ shift @{$self->{xevents}} };
}
sub swap_buffers {
my ($this) = @_;
OpenGL::GLUT::glutSwapBuffers();
}
sub set_window {
my ($this) = @_;
# set GLUT context to current window (for multiwindow support)
OpenGL::GLUT::glutSetWindow($this->{glutwindow});
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD/Contours.pm0000644000175000017500000002042614776030722022436 0ustar osboxesosboxes=head1 NAME
PDL::Graphics::TriD::Contours - 3D Surface contours for TriD
=head1 SYNOPSIS
=for usage
# A simple contour plot in black and white
use PDL::Graphics::TriD;
use PDL::Graphics::TriD::Contours;
$size = 25;
$x = (xvals zeroes $size,$size) / $size;
$y = (yvals zeroes $size,$size) / $size;
$z = (sin($x*6.3) * sin($y*6.3)) ** 3;
$data=PDL::Graphics::TriD::Contours->new($z,
[$z->xvals/$size,$z->yvals/$size,0]);
PDL::Graphics::TriD::graph_object($data)
=cut
package PDL::Graphics::TriD::Contours;
use strict;
use warnings;
use PDL;
use PDL::ImageND;
use PDL::Graphics::TriD;
use PDL::Graphics::TriD::Labels;
use base qw/PDL::Graphics::TriD::GObject/;
use fields qw/PathIndex ContourPathIndexEnd Labels LabelStrings/;
$PDL::Graphics::TriD::verbose //= 0;
=head1 FUNCTIONS
=head2 new()
=for ref
Define a new contour plot for TriD.
=for example
$data=PDL::Graphics::TriD::Contours->new($d,[$x,$y,$z],[$r,$g,$b],$options);
where $d is a 2D pdl of data to be contoured. [$x,$y,$z] define a 3D
map of $d into the visualization space [$r,$g,$b] is an optional [3,1]
ndarray specifying the contour color and $options is a hash reference to
a list of options documented below. Contours can also be coloured by
value using the set_color_table function.
=for opt
ContourInt => 0.7 # explicitly set a contour interval
ContourMin => 0.0 # explicitly set a contour minimum
ContourMax => 10.0 # explicitly set a contour maximum
ContourVals => $pdl # explicitly set all contour values
Label => [1,5,$myfont] # see addlabels below
If ContourVals is specified ContourInt, ContourMin, and ContourMax
are ignored. If no options are specified, the algorithm tries to
choose values based on the data supplied.
=cut
sub new{
my($type,$data,$points,$colors,$options) = @_;
if(! defined $points){
$points = [$data->xvals,$data->yvals,$data->zvals];
}
if(ref($colors) eq "HASH"){
$options=$colors ;
undef $colors;
}
$colors = PDL::Graphics::TriD::realcoords("COLOR",pdl[1,1,1]) unless defined $colors;
my $this = $type->SUPER::new($points,$colors,$options);
my $fac=1;
my ($min,$max) = $data->minmax;
unless(defined $this->{Options}{ContourMin}){
while($fac*($max-$min)<10){
$fac*=10;
}
$this->{Options}{ContourMin} = int($fac*$min) == $fac*$min ? $min : int($fac*$min+1)/$fac;
print "ContourMin = ",$this->{Options}{ContourMin},"\n"
if $PDL::Graphics::TriD::verbose;
}
unless(defined $this->{Options}{ContourMax} &&
$this->{Options}{ContourMax} > $this->{Options}{ContourMin} ){
if(defined $this->{Options}{ContourInt}){
$this->{Options}{ContourMax} = $this->{Options}{ContourMin};
while($this->{Options}{ContourMax}+$this->{Options}{ContourInt} < $max){
$this->{Options}{ContourMax}= $this->{Options}{ContourMax}+$this->{Options}{ContourInt};
}
}else{
$this->{Options}{ContourMax} = int($fac*$max) == $fac*$max ? $max : (int($fac*$max)-1)/$fac;
}
print "ContourMax = ",$this->{Options}{ContourMax},"\n"
if $PDL::Graphics::TriD::verbose;
}
unless(defined $this->{Options}{ContourInt} && $this->{Options}{ContourInt}>0){
$this->{Options}{ContourInt} = int($fac*($this->{Options}{ContourMax}-$this->{Options}{ContourMin}))/(10*$fac);
print "ContourInt = ",$this->{Options}{ContourInt},"\n"
if($PDL::Graphics::TriD::verbose);
}
#
# The user could also name cvals
#
my $cvals;
if (!defined($this->{Options}{ContourVals}) || $this->{Options}{ContourVals}->isempty){
$cvals=zeroes(int(($this->{Options}{ContourMax}-$this->{Options}{ContourMin})/$this->{Options}{ContourInt}+1));
$cvals = $cvals->xlinvals($this->{Options}{ContourMin},$this->{Options}{ContourMax});
}else{
$cvals = $this->{Options}{ContourVals};
$this->{Options}{ContourMax}=$cvals->max->sclr;
$this->{Options}{ContourMin}=$cvals->min->sclr;
}
$this->{Options}{ContourVals} = $cvals;
print "Cvals = $cvals\n" if $PDL::Graphics::TriD::verbose;
my ($pi, $p) = contour_polylines($cvals,$data,$this->{Points});
$_ = PDL->null for @$this{qw(Points PathIndex)};
my ($pcnt, $pval) = (0,0);
for (my $i=0; $i<$cvals->nelem; $i++) {
my $this_pi = $pi->slice(",($i)");
next if $this_pi->at(0) == -1;
my $thispi_maxind = $this_pi->maximum_ind->sclr;
$this_pi = $this_pi->slice("0:$thispi_maxind");
my $thispi_maxval = $this_pi->at($thispi_maxind);
$this->{PathIndex} = $this->{PathIndex}->append($this_pi+$pval);
$this->{Points} = $this->{Points}->glue(1,$p->slice(":,0:$thispi_maxval,($i)"));
$this->{ContourPathIndexEnd}[$i] = $pcnt = $pcnt+$thispi_maxind;
$pcnt += 1; $pval += $thispi_maxval + 1;
}
$this->addlabels($this->{Options}{Labels}) if defined $this->{Options}{Labels};
return $this;
}
sub get_valid_options{
return{ ContourInt => undef,
ContourMin => undef,
ContourMax=> undef,
ContourVals=> pdl->null,
UseDefcols=>1,
Labels=> undef}
}
=head2 addlabels()
=for ref
Add labels to a contour plot
=for usage
$contour->addlabels($labelint,$segint);
$labelint is the integer interval between labeled contours. If you
have 8 contour levels and specify $labelint=3 addlabels will attempt
to label the 1st, 4th, and 7th contours. $labelint defaults to 1.
$segint specifies the density of labels on a single contour
level. Each contour level consists of a number of connected
line segments, $segint defines how many of these segments get labels.
$segint defaults to 5, that is every fifth line segment will be labeled.
=cut
sub addlabels{
my ($self,$labelint, $segint) = @_;
$labelint = 1 unless(defined $labelint);
$segint = 5 unless(defined $segint);
my $cnt=0;
my $strlist;
my $lp=pdl->null;
my $pcnt = 0;
my $offset = pdl[0.5,0.5,0.5];
for(my $i=0; $i<= $#{$self->{ContourSegCnt}}; $i++){
next unless defined $self->{ContourSegCnt}[$i];
$cnt = $self->{ContourSegCnt}[$i];
my $val = $self->{Options}{ContourVals}->slice("($i)");
my $leg = $self->{Points}->slice(":,$pcnt:$cnt");
$pcnt=$cnt+1;
next if($i % $labelint);
for(my $j=0; $j< $leg->getdim(1); $j+=2){
next if(($j/2) % $segint);
my $j1=$j+1;
my $lp2 = $leg->slice(":,($j)") +
$offset*($leg->slice(":,($j1)") -
$leg->slice(":,($j)"));
$lp = $lp->append($lp2);
# need a label string for each point
push(@$strlist,$val);
}
}
if($lp->nelem>0){
$self->{Points} = $self->{Points}->transpose
->append($lp->reshape(3,$lp->nelem/3)->transpose)->transpose;
$self->{Labels} = [$cnt+1,$cnt+$lp->nelem/3];
$self->{LabelStrings} = $strlist;
}
}
=head2 set_colortable($table)
=for ref
Sets contour level colors based on the color table.
=for usage
$table is passed in as either an ndarray of [3,n] colors, where n is the
number of contour levels, or as a reference to a function which
expects the number of contour levels as an argument and returns a
[3,n] ndarray. It should be straight forward to use the
L tables in a function which subsets the 256
colors supplied by the look up table into the number of colors needed
by Contours.
=cut
sub set_colortable{
my($self,$table) = @_;
my $colors;
if(ref($table) eq "CODE"){
my $min = $self->{Options}{ContourMin};
my $max = $self->{Options}{ContourMax};
my $int = $self->{Options}{ContourInt};
my $ncolors=($max-$min)/$int+1;
$colors= &$table($ncolors);
}else{
$colors = $table;
}
if($colors->getdim(0)!=3){
$colors->reshape(3,$colors->nelem/3);
}
print "Color info ",$self->{Colors}->info," ",$colors->info,"\n" if($PDL::Graphics::TriD::verbose);
$self->{Colors} = $colors;
}
=head2 coldhot_colortable()
=for ref
A simple colortable function for use with the set_colortable function.
=for usage
coldhot_colortable defines a blue red spectrum of colors where the
smallest contour value is blue, the highest is red and the others are
shades in between.
=cut
sub coldhot_colortable{
my($ncolors) = @_;
my $colorpdl;
# 0 red, 1 green, 2 blue
for(my $i=0;$i<$ncolors;$i++){
my $color = zeroes(float,3);
(my $t = $color->slice("0")) .= 0.75*($i)/$ncolors;
($t = $color->slice("2")) .= 0.75*($ncolors-$i)/$ncolors;
if($i==0){
$colorpdl = $color;
}else{
$colorpdl = $colorpdl->append($color);
}
}
return $colorpdl;
}
1;
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/OpenGLQ.pd0000644000175000017500000001747414776122010021215 0ustar osboxesosboxesuse strict;
use warnings;
use PDL::Types qw(types ppdefs_all);
{ no warnings 'once'; # pass info back to Makefile.PL
$PDL::Core::Dev::EXTRAS{$::PDLMOD}{OBJECT} .= join '', map " $::PDLBASE-$_\$(OBJ_EXT)", qw(font sphere);
}
my $F = ['F'];
pp_addpm({At=>'Top'},<<'EOD');
=head1 NAME
PDL::Graphics::OpenGLQ - quick routines to plot lots of stuff from ndarrays.
=head1 SYNOPSIS
only for internal use - see source
=head1 DESCRIPTION
only for internal use - see source
=head1 AUTHOR
Copyright (C) 1997,1998 Tuomas J. Lukka.
All rights reserved. There is no warranty. You are allowed
to redistribute this software / documentation under certain
conditions. For details, see the file COPYING in the PDL
distribution. If this file is separated from the PDL distribution,
the copyright notice should be included in the file.
=cut
EOD
pp_addhdr('
#ifdef __APPLE__
#include
#else
#include
#endif
');
my @internal = (Doc => 'internal', NoPthread => 1);
pp_def(
'gl_spheres',
GenericTypes => $F,
Pars => 'coords(tri=3,n);',
OtherPars => 'double radius; int slices; int stacks;',
CHeader => "char *pdl_3d_solidSphere(double radius, GLint slices, GLint stacks);\n",
Code => '
float oldcoord0 = 0.0, oldcoord1 = 0.0, oldcoord2 = 0.0;
glPushMatrix();
loop(n) %{
glTranslatef(
$coords(tri=>0) - oldcoord0,
$coords(tri=>1) - oldcoord1,
$coords(tri=>2) - oldcoord2
);
char *err = pdl_3d_solidSphere($COMP(radius), $COMP(slices), $COMP(stacks));
if (err) $CROAK("%s", err);
oldcoord0 = $coords(tri=>0), oldcoord1 = $coords(tri=>1), oldcoord2 = $coords(tri=>2);
%}
glPopMatrix();
',
@internal
);
sub TRI { my $par = join '', @_; join ',', map "$par(tri => $_)", 0..2 }
sub make_tri { shift()."(".TRI(@_).");\n" }
sub COLOR { make_tri("glColor3f",'$colors',@_) }
sub VERTEX { make_tri("glVertex3f",'$coords',@_) }
sub NORMAL { make_tri("glNormal3f",'$norm',@_) }
sub RPOS { make_tri("glRasterPos3f",'$coords',@_) }
sub ADCOLOR { "
{
GLfloat ad[] = { ".TRI('$colors'.$_[0]).",1.0 };
glMaterialfv(GL_FRONT_AND_BACK,GL_DIFFUSE, ad);
}
" }
sub make_func {
my ($name) = @_;
for (['_col', ' colors(tri,n);', COLOR().VERTEX()], ['_nc', '', VERTEX()]) {
pp_def(lc($name).$_->[0],
GenericTypes => $F,
Pars => 'coords(tri=3,n);'.$_->[1],
Code => '
glBegin('.uc($name).');
loop(n) %{'.$_->[2].'%}
glEnd();
',
@internal
);
}
}
make_func($_) for qw(gl_line_strip gl_lines gl_points);
pp_def(
'gl_texts',
GenericTypes => $F,
Pars => 'coords(tri,x); ',
OtherPars => 'SV *arr',
CHeader => "void pdl_3d_bitmapString( const unsigned char *string );\n",
Code => '
SV *sv = $COMP(arr);
if (!(SvROK(sv) && SvTYPE(SvRV(sv))==SVt_PVAV))
$CROAK("gl_texts requires an array ref");
AV *arr = (AV *)SvRV(sv);
loop(x) %{
SV *elem = *(av_fetch(arr, x, 0));
if (!elem) continue;
char *str = SvPV_nolen(elem);
'.RPOS().'
pdl_3d_bitmapString((const unsigned char *)str);
%}
',
@internal
);
for my $m (
{Suf => '_mat',
Func => \&ADCOLOR},
{Suf => '',
Func => \&COLOR},
) {
for(
{Name => 'gl_triangles',
NormalCode => ''},
{Name => 'gl_triangles_n',
NormalInit => '
tmp1[0] = $coordsb(tri => 0) - $coordsa(tri => 0);
tmp1[1] = $coordsb(tri => 1) - $coordsa(tri => 1);
tmp1[2] = $coordsb(tri => 2) - $coordsa(tri => 2);
tmp2[0] = $coordsc(tri => 0) - $coordsa(tri => 0);
tmp2[1] = $coordsc(tri => 1) - $coordsa(tri => 1);
tmp2[2] = $coordsc(tri => 2) - $coordsa(tri => 2);
tmp3[0] = tmp1[1]*tmp2[2] - tmp2[1]*tmp1[2];
tmp3[1] = -(tmp1[0]*tmp2[2] - tmp2[0]*tmp1[2]);
tmp3[2] = tmp1[0]*tmp2[1] - tmp2[0]*tmp1[1];
magn = sqrt(tmp3[0]*tmp3[0] + tmp3[1]*tmp3[1] + tmp3[2]*tmp3[2]);
tmp3[0] = tmp3[0] / magn;
tmp3[1] = tmp3[1] / magn;
tmp3[2] = tmp3[2] / magn;',
NormalCode => '
glNormal3f(tmp3[0], tmp3[1], tmp3[2]);
'
},
{Name => 'gl_triangles_wn',
NormalArgs => 'norma(tri); normb(tri); normc(tri);',
(map {("NormalCode".($_ eq 'A'?'':$_),NORMAL(lc $_))} ('A'..'C')),
}) {
# This may be suboptimal but should still be fast enough..
# We only do triangles with this.
pp_def(
$_->{Name}.$m->{Suf},
GenericTypes => $F,
Pars => 'coordsa(tri=3); coordsb(tri); coordsc(tri);'.
($_->{NormalArgs}//'').
'colorsa(tri); colorsb(tri); colorsc(tri);',
Code => '
float tmp1[3], tmp2[3], tmp3[3], magn;
glBegin(GL_TRIANGLES);
broadcastloop %{'.
($_->{NormalInit}//"\n").
($_->{NormalCode}//'').
&{$m->{Func}}("a").VERTEX("a").
($_->{NormalCodeB}//'').
&{$m->{Func}}("b").VERTEX("b").
($_->{NormalCodeC}//'').
$m->{Func}->("c").VERTEX("c").'
%}
glEnd();
',
@internal
);
}
}
pp_def('gl_arrows',
Pars => 'coords(tri=3,n); indx indsa(); indx indsb();',
OtherPars => 'float headlen; float width;',
Code => '
float hl = $COMP(headlen);
float w = $COMP(width);
float tmp2[3] = { 0.000001, -0.0001, 1 };
broadcastloop %{
PDL_Indx a = $indsa(), b = $indsb();
float tmp1[3];
float norm[3];
float norm2[3];
float normlen,origlen,norm2len;
tmp1[0] = $coords(tri => 0, n => a) -
$coords(tri => 0, n => b);
tmp1[1] = $coords(tri => 1, n => a) -
$coords(tri => 1, n => b);
tmp1[2] = $coords(tri => 2, n => a) -
$coords(tri => 2, n => b);
float partback[3];
partback[0] = $coords(tri => 0, n => b) + hl*tmp1[0];
partback[1] = $coords(tri => 1, n => b) + hl*tmp1[1];
partback[2] = $coords(tri => 2, n => b) + hl*tmp1[2];
norm[0] = tmp1[1]*tmp2[2] - tmp2[1]*tmp1[2];
norm[1] = -(tmp1[0]*tmp2[2] - tmp2[0]*tmp1[2]);
norm[2] = tmp1[0]*tmp2[1] - tmp2[0]*tmp1[1];
norm2[0] = tmp1[1]*norm[2] - norm[1]*tmp1[2];
norm2[1] = -(tmp1[0]*norm[2] - norm[0]*tmp1[2]);
norm2[2] = tmp1[0]*norm[1] - norm[0]*tmp1[1];
normlen = sqrt(norm[0] * norm[0] +
norm[1] * norm[1] + norm[2] * norm[2]);
norm2len = sqrt(norm2[0] * norm2[0] +
norm2[1] * norm2[1] + norm2[2] * norm2[2]);
origlen = sqrt(tmp1[0] * tmp1[0] +
tmp1[1] * tmp1[1] + tmp1[2] * tmp1[2]);
norm[0] *= w/normlen;
norm[1] *= w/normlen;
norm[2] *= w/normlen;
norm2[0] *= w/norm2len;
norm2[1] *= w/norm2len;
norm2[2] *= w/norm2len;
tmp1[0] /= origlen;
tmp1[1] /= origlen;
tmp1[2] /= origlen;
glBegin(GL_LINES);
glVertex3d( $coords(tri => 0, n => a) ,
$coords(tri => 1, n => a) ,
$coords(tri => 2, n => a) );
glVertex3d( $coords(tri => 0, n => b) ,
$coords(tri => 1, n => b) ,
$coords(tri => 2, n => b) );
glEnd();
if(w!=0) {
glBegin(GL_TRIANGLES);
glVertex3d( $coords(tri => 0, n => b) ,
$coords(tri => 1, n => b) ,
$coords(tri => 2, n => b) );
glVertex3d( partback[0] + norm[0],
partback[1] + norm[1],
partback[2] + norm[2]);
glVertex3d( partback[0] + norm2[0],
partback[1] + norm2[1],
partback[2] + norm2[2]);
glVertex3d( $coords(tri => 0, n => b) ,
$coords(tri => 1, n => b) ,
$coords(tri => 2, n => b) );
glVertex3d( partback[0] - norm[0],
partback[1] - norm[1],
partback[2] - norm[2]);
glVertex3d( partback[0] - norm2[0],
partback[1] - norm2[1],
partback[2] - norm2[2]);
glVertex3d( $coords(tri => 0, n => b) ,
$coords(tri => 1, n => b) ,
$coords(tri => 2, n => b) );
glVertex3d( partback[0] + norm2[0],
partback[1] + norm2[1],
partback[2] + norm2[2]);
glVertex3d( partback[0] - norm[0],
partback[1] - norm[1],
partback[2] - norm[2]);
glVertex3d( $coords(tri => 0, n => b) ,
$coords(tri => 1, n => b) ,
$coords(tri => 2, n => b) );
glVertex3d( partback[0] - norm2[0],
partback[1] - norm2[1],
partback[2] - norm2[2]);
glVertex3d( partback[0] + norm[0],
partback[1] + norm[1],
partback[2] + norm[2]);
glEnd();
}
%}
',
@internal
);
pp_done();
PDL-Graphics-TriD-2.102/lib/PDL/Graphics/TriD.pm0000644000175000017500000007302114776143777020640 0ustar osboxesosboxes=head1 NAME
PDL::Graphics::TriD - PDL 3D interface
=head1 SYNOPSIS
use PDL::Graphics::TriD;
# Generate a somewhat interesting sequence of points:
$t = sequence(100)/10;
$x = sin($t); $y = cos($t), $z = $t;
$coords = cat($x, $y, $z)->transpose;
my $red = cos(2*$t); my $green = sin($t); my $blue = $t;
$colors = cat($red, $green, $blue)->transpose;
# After each graph, let the user rotate and
# wait for them to press 'q', then make new graph
line3d($coords); # $coords = (3,n,...)
line3d($coords,$colors); # $colors = (3,n,...)
line3d([$x,$y,$z]);
# Generate a somewhat interesting sequence of surfaces
$surf1 = (rvals(100, 100) / 50)**2 + sin(xvals(100, 100) / 10);
$surf2 = sqrt(rvals(zeroes(50,50))/2);
$x = sin($surface); $y = cos($surface), $z = $surface;
$coords = cat($x, $y, $z)->transpose;
$red = cos(2*$surface); $green = sin($surface); $blue = $surface;
$colors = cat($red, $green, $blue)->transpose;
imagrgb([$red,$green,$blue]); # 2-d ndarrays
lattice3d([$surf1]);
points3d([$x,$y,$z]);
spheres3d([$x,$y,$z]); # preliminary implementation
hold3d(); # the following graphs are on top of each other and the previous
line3d([$x,$y,$z]);
line3d([$x,$y,$z+1]);
$pic = grabpic3d(); # Returns the picture in a (3,$x,$y) float ndarray (0..1).
release3d(); # the next graph will again wipe out things.
=head1 DESCRIPTION
This module implements a generic 3D plotting interface for PDL.
Points, lines and surfaces (among other objects) are supported.
With OpenGL, it is easy to manipulate the resulting 3D objects
with the mouse in real time - this helps data visualization a lot.
=for comment
With VRML, you can generate objects for everyone to see with e.g.
Silicon Graphics' Cosmo Player. You can find out more about VRML
at C or C
=head1 SELECTING A DEVICE
The default device for TriD is currently OpenGL.
You can specify a different device either in your program
or in the environment variable C.
The one specified in the program takes priority.
The currently available devices are
=over 8
=item GL
OpenGL
=item GLpic
OpenGL but off-line (pixmap) rendering and writing to
a graphics file.
=item VRML (I< Not available this release >)
VRML objects rendering. This writes a VRML file describing the
scene. This VRML file can then be read with a browser.
=back
=head1 ONLINE AND OFFLINE VISUALIZATION
TriD offers both on- and off-line visualization.
Currently the interface w.r.t. this division is still much
in motion.
For OpenGL you can select either on- or off-line rendering.
VRML is currently always offline (this may change later,
if someone bothers to write the java(script) code to contact
PDL and wait for the next PDL image over the network.
=head1 COORDINATE SPECIFICATIONS
Specifying a set of coordinates is generally a context-dependent operation.
For a traditional 3D surface plot, you'll want two of the coordinates
to have just the xvals and yvals of the ndarray, respectively.
For a line, you would generally want to have one coordinate held
at zero and the other advancing.
This module tries to make a reasonable way of specifying the context
while letting you do whatever you want by overriding the default
interpretation.
The alternative syntaxes for specifying a set of coordinates (or colors) are
$ndarray # MUST have 3 as first dim.
[$ndarray]
[$ndarray1,$ndarray2]
[$ndarray1,$ndarray2,$ndarray3]
[CONTEXT,$ndarray]
[CONTEXT,$ndarray1,$ndarray2]
[CONTEXT,$ndarray1,$ndarray2,$ndarray3]
where C is a string describing in which context you wish these
ndarrays to be interpreted. Each routine specifies a default context
which is explained in the routines documentation.
Context is usually used only to understand what the user wants
when they specify less than 3 ndarrays.
The following contexts are currently supported:
=over 8
=item SURF2D
A 2-D lattice. C< [$ndarray] > is interpreted as the Z coordinate over
a lattice over the first dimension. Equivalent to
C<< [$ndarray->xvals, $ndarray->yvals, $ndarray] >>.
=item POLAR2D
A 2-D polar coordinate system. C< [$ndarray] > is interpreted as the
z coordinate over theta and r (theta = the first dimension of the ndarray).
=item COLOR
A set of colors. C< [$ndarray] > is interpreted as grayscale color
(equivalent to C< [$ndarray,$ndarray,$ndarray] >).
=item LINE
A line made of 1 or 2 coordinates. C< [$ndarray] > is interpreted as
C<< [$ndarray->xvals,$ndarray,0] >>. C< [$ndarray1,$ndarray2] > is interpreted as
C<< [$ndarray1,$ndarray2,$ndarray1->xvals] >>.
=back
What makes contexts useful is that if you want to plot points
instead of the full surface you plotted with
imag3d([$zcoords]);
you don't need to start thinking about where to plot the points:
points3d([SURF2D,$zcoords]);
will do exactly the same.
=head2 Wrapping your head around 3d surface specifications
Let's begin by thinking about how you might make a 2d data plot.
If you sampled your data at regular intervals, you would have
a time series y(t) = (y0, y1, y2, ...). You could plot y vs t
by computing t0 = 0, t1 = dt, t2 = 2 * dt, and then plotting
(t0, y0), (t1, y1), etc.
Next suppose that you measured x(t) and y(t). You can still
plot y vs t, but you can also plot y vs x by plotting (x0, y0),
(x1, y1), etc. The x-values don't have to increase monotonically:
they could back-track on each other, for example, like the
latitude and longitude of a boat on a lake. If you use plplot,
you would plot this data using
C<< $pl->xyplot($x, $y, PLOTTYPE => 'POINTS') >>.
Good. Now let's add a third coordinate, z(t). If you actually
sampled x and y at regular intervals, so that x and y lie on a
grid, then you can construct a grid for z(x, y), and you would
get a surface. This is the situation in which you would use
C.
Of course, your data is not required to be regularly gridded.
You could, for example, be measuring the flight path of a bat
flying after mosquitos, which could be wheeling and arching
all over the space. This is what you might plot using
C. You could plot the trajectories of
multiple bats, in which case C<$x>, C<$y>, and C<$z> would have
multiple columns, but in general you wouldn't expect them to be
coordinated.
More generally, each coordinate is expected to be arranged in a 3D
fashion, similar to C<3,x,y>. The "3" is the actual 3D coordinates of
each point. The "x,y" help with gridding, because each point at C
is expected to have as geographical neighbours C, C,
C, C, and the grid polygon-building relies on that.
This is how, and why, the 3D earth in C arranges its data.
use PDL;
use PDL::Graphics::TriD;
# Draw out a trajectory in three-space
$t = sequence(100)/10;
$x = sin($t); $y = cos($t); $z = $t;
# Plot the trajectory as (x(t), y(t), z(t))
print "using line3d to plot a trajectory (press q when you're done twiddling)\n";
line3d [$x,$y,$z];
# If you give it a single ndarray, it expects
# the data to look like
# ((x1, y1, z1), (x2, y2, z2), ...)
# which is why we have to do the exchange:
$coords = cat($x, $y, $z)->transpose;
print "again, with a different coordinate syntax (press q when you're done twiddling)\n";
line3d $coords;
# Draw a regularly-gridded surface:
$surface = sqrt(rvals(zeroes(50,50))/2);
print "draw a mesh of a regularly-gridded surface using mesh3d\n";
mesh3d [$surface];
print "draw a regularly-gridded surface using imag3d\n";
imag3d [$surface], {Lines=>0};
# Draw a mobius strip:
$two_pi = 8 * atan2(1,1);
$t = sequence(51) / 50 * $two_pi;
# We want three paths:
$mobius1_x = cos($t) + 0.5 * sin($t/2);
$mobius2_x = cos($t);
$mobius3_x = cos($t) - 0.5 * sin($t/2);
$mobius1_y = sin($t) + 0.5 * sin($t/2);
$mobius2_y = sin($t);
$mobius3_y = sin($t) - 0.5 * sin($t/2);
$mobius1_z = $t - $two_pi/2;
$mobius2_z = zeroes($t);
$mobius3_z = $two_pi/2 - $t;
$mobius_x = cat($mobius1_x, $mobius2_x, $mobius3_x);
$mobius_y = cat($mobius1_y, $mobius2_y, $mobius3_y);
$mobius_z = cat($mobius1_z, $mobius2_z, $mobius3_z);
$mobius_surface = cat($mobius_x, $mobius_y, $mobius_z)->mv(2,0);
print "A mobius strip using line3d one way\n";
line3d $mobius_surface;
print "A mobius strip using line3d the other way\n";
line3d $mobius_surface->xchg(1,2);
print "A mobius strip using mesh3d\n";
mesh3d $mobius_surface;
print "The same mobius strip using imag3d\n";
imag3d $mobius_surface, {Lines => 0};
=head1 SIMPLE ROUTINES
Because using the whole object-oriented interface for doing
all your work might be cumbersome, the following shortcut
routines are supported:
=head1 FUNCTIONS
=head2 line3d
=for ref
3D line plot, defined by a variety of contexts.
Implemented by L.
=for usage
line3d ndarray(3,x), {OPTIONS}
line3d [CONTEXT], {OPTIONS}
=for example
Example:
pdl> line3d [sqrt(rvals(zeroes(50,50))/2)]
- Lines on surface
pdl> line3d [$x,$y,$z]
- Lines over X, Y, Z
pdl> line3d $coords
- Lines over the 3D coordinates in $coords.
Note: line plots differ from mesh plots in that lines
only go in one direction. If this is unclear try both!
See module documentation for more information on
contexts and options
=head2 line3d_segs
=for ref
3D line plot of non-continuous segments, defined by a variety of contexts.
Implemented by L. Handles pairs of vertices
as produced by L.
=for usage
line3d_segs ndarray(3,x), {OPTIONS}
line3d_segs [CONTEXT], {OPTIONS}
=for example
use PDL::ImageND
$size = 5;
$x = xvals($size+1,$size+1) / $size;
$y = yvals($size+1,$size+1) / $size;
$z = 0.5 + 0.5 * (sin($x*6.3) * sin($y*6.3)) ** 3;
$points = cat($x,$y,$z)->mv(-1,0)
($segs, $cnt) = contour_segments(pdl(0.203,0.276), $z, $points)
$segs = $segs->slice(',0:'.$cnt->max)
line3d_segs $segs
=head2 imag3d
=for ref
3D rendered image plot, defined by a variety of contexts
Implemented by L.
The variant, C, is implemented by L.
=for usage
imag3d ndarray(3,x,y), {OPTIONS}
imag3d [ndarray,...], {OPTIONS}
=for example
Example:
pdl> imag3d [sqrt(rvals(zeroes(50,50))/2)], {Lines=>0};
- Rendered image of surface
See module documentation for more information on
contexts and options
=head2 mesh3d
=for ref
3D mesh plot, defined by a variety of contexts
Implemented by L.
=for usage
mesh3d ndarray(3,x,y), {OPTIONS}
mesh3d [ndarray,...], {OPTIONS}
=for example
Example:
pdl> mesh3d [sqrt(rvals(zeroes(50,50))/2)]
- mesh of surface
Note: a mesh is defined by two sets of lines at
right-angles (i.e. this is how is differs from
line3d).
See module documentation for more information on
contexts and options
=head2 lattice3d
=for ref
alias for mesh3d
=head2 trigrid3d
Show a triangular mesh, giving C<$vertices> and C<$faceidx> which is
a series of triplets of indices into the vertices, each describing
one triangle. The order of points matters for the shading - the normal
vector points towards the clockface if the points go clockwise.
Options: C (on by default), C (off by default),
C (off by default, useful for debugging).
Implemented by L.
=head2 trigrid3d_ns
Like L, but without shading or normals.
Implemented by L.
=head2 points3d
=for ref
3D points plot, defined by a variety of contexts
Implemented by L.
=for usage
points3d ndarray(3), {OPTIONS}
points3d [ndarray,...], {OPTIONS}
=for example
Example:
pdl> points3d [sqrt(rvals(zeroes(50,50))/2)];
- points on surface
See module documentation for more information on
contexts and options
=head2 spheres3d
=for ref
3D spheres plot (preliminary implementation)
This is a preliminary implementation as a proof of
concept. It has fixed radii for the spheres being
drawn and no control of color or transparency.
Implemented by L.
=for usage
spheres3d ndarray(3), {OPTIONS}
spheres3d [ndarray,...], {OPTIONS}
=for example
Example:
pdl> spheres3d ndcoords(10,10,10)->clump(1,2,3)
- lattice of spheres at coordinates on 10x10x10 grid
=head2 imagrgb
=for ref
2D RGB image plot (see also imag2d)
Implemented by L.
=for usage
imagrgb ndarray(3,x,y), {OPTIONS}
imagrgb [ndarray,...], {OPTIONS}
This would be used to plot an image, specifying
red, green and blue values at each point. Note:
contexts are very useful here as there are many
ways one might want to do this.
=for example
e.g.
pdl> $x=sqrt(rvals(zeroes(50,50))/2)
pdl> imagrgb [0.5*sin(8*$x)+0.5,0.5*cos(8*$x)+0.5,0.5*cos(4*$x)+0.5]
=head2 imagrgb3d
=for ref
2D RGB image plot as an object inside a 3D space
Implemented by L.
=for usage
imagrgb3d ndarray(3,x,y), {OPTIONS}
imagrgb3d [ndarray,...], {OPTIONS}
The ndarray gives the colors. The option allowed is Points,
which should give 4 3D coordinates for the corners of the polygon,
either as an ndarray or as array ref.
The default is [[0,0,0],[1,0,0],[1,1,0],[0,1,0]].
=for example
e.g.
pdl> imagrgb3d $colors, {Points => [[0,0,0],[1,0,0],[1,0,1],[0,0,1]]};
- plot on XZ plane instead of XY.
=head2 grabpic3d
=for ref
Grab a 3D image from the screen.
=for usage
$pic = grabpic3d();
The returned ndarray has dimensions (3,$x,$y) and is of type float
(currently). XXX This should be altered later.
=head2 contour3d
=for usage
contour3d $d,[$x,$y,$z],[$r,$g,$b], {OPTIONS}
where C<$d> is a 2D pdl of data to be contoured. C<[$x,$y,$z]> define a 3D
map of C<$d> into the visualization space. C<[$r,$g,$b]> is an optional C<[3,1]>
ndarray specifying the contour color and C<$options> is a hash reference to
a list of options documented below. Contours can also be coloured by
value using the set_color_table function.
Implemented by L.
=head2 hold3d, release3d
=for ref
Keep / don't keep the previous objects when plotting new 3D objects
=for usage
hold3d();
release3d();
or
hold3d(1);
hold3d(0);
=head2 keeptwiddling3d, nokeeptwiddling3d
=for ref
Wait / don't wait for 'q' after displaying a 3D image.
Usually, when showing 3D images, the user is given a chance
to rotate it and then press 'q' for the next image. However,
sometimes (for e.g. animation) this is undesirable and it is
more desirable to just run one step of the event loop at
a time.
=for usage
keeptwiddling3d();
nokeeptwiddling3d();
or
keeptwiddling3d(1);
keeptwiddling3d(0);
When an image is added to the screen, keep twiddling it until
user explicitly presses 'q'.
=for example
keeptwiddling3d();
imag3d(..);
nokeeptwiddling3d();
$o = imag3d($c);
do {
$c .= nextfunc($c);
$o->data_changed;
} while(!twiddle3d()); # animate one step, then iterate
keeptwiddling3d();
twiddle3d(); # wait one last time
=head2 twiddle3d
=for ref
Wait for the user to rotate the image in 3D space.
Let the user rotate the image in 3D space, either for one step
or until they press 'q', depending on the 'keeptwiddling3d'
setting. If 'keeptwiddling3d' is not set the routine returns
immediately and indicates that a 'q' event was received by
returning 1. If the only events received were mouse events,
returns 0.
=head2 close3d
=for ref
Close the currently-open 3D window.
=head1 CONCEPTS
The key concepts (object types) of TriD are explained in the following:
=head2 Object
In this 3D abstraction, everything that you can "draw"
without using indices is an Object. That is, if you have a surface,
each vertex is not an object and neither is each segment of a long
curve. The whole curve (or a set of curves) is the lowest level Object.
Transformations and groups of Objects are also Objects.
A Window is simply an Object that has subobjects.
=head2 Twiddling
Because there is no eventloop in Perl yet and because it would
be hassleful to do otherwise, it is currently not possible to
e.g. rotate objects with your mouse when the console is expecting
input or the program is doing other things. Therefore, you need
to explicitly say "$window->twiddle()" in order to display anything.
=head1 OBJECTS
The following types of objects are currently supported.
Those that do not have a calling sequence described here should
have their own manual pages.
There are objects that are not mentioned here; they are either internal
to PDL3D or in rapidly changing states. If you use them, you do so at
your own risk.
The syntax C here means that you create
an object like
$c = PDL::Graphics::TriD::Scale->new($x,$y,$z);
=head2 PDL::Graphics::TriD::LineStrip
This is just a line or a set of lines. The arguments are 3 1-or-more-D
ndarrays which describe the vertices of a continuous line and an
optional color ndarray (which is 1-D also and simply
defines the color between red and blue. This will probably change).
=head2 PDL::Graphics::TriD::Lines
This is just a line or a set of lines. The arguments are 3 1-or-more-D
ndarrays where each contiguous pair of vertices describe a line segment
and an optional color ndarray (which is 1-D also and simply
defines the color between red and blue. This will probably change).
=head2 PDL::Graphics::TriD::Image
This is a 2-dimensional RGB image consisting of colored
rectangles. With OpenGL, this is implemented by texturing so this should
be relatively memory and execution-time-friendly.
=head2 PDL::Graphics::TriD::Lattice
This is a 2-D set of points connected by lines in 3-space.
The constructor takes as arguments 3 2-dimensional ndarrays.
=head2 PDL::Graphics::TriD::Points
This is simply a set of points in 3-space. Takes as arguments
the x, y and z coordinates of the points as ndarrays.
=head2 PDL::Graphics::TriD::Scale(x,y,z)
Self-explanatory
=head2 PDL::Graphics::TriD::Translation(x,y,z)
Ditto
=head2 PDL::Graphics::TriD::Quaternion(c,x,y,z)
One way of representing rotations is with quaternions. See the appropriate
man page.
=head2 PDL::Graphics::TriD::ViewPort
This is a special class: in order to obtain a new viewport, you
need to have an earlier viewport on hand. The usage is:
$new_vp = $old_vp->new_viewport($x0,$y0,$x1,$y1);
where $x0 etc are the coordinates of the upper left and lower right
corners of the new viewport inside the previous (relative
to the previous viewport in the (0,1) range.
Every implementation-level window object should implement the new_viewport
method.
=cut
#KGB: NEEDS DOCS ON COMMON OPTIONS!!!!!
# List of global variables
#
# $PDL::Graphics::TriD::offline
# $PDL::Graphics::TriD::Settings
$PDL::Graphics::TriD::verbose //= 0;
# $PDL::Graphics::TriD::keeptwiddling
# $PDL::Graphics::TriD::only_one
# $PDL::Graphics::TriD::current_window
#
# '
package PDL::Graphics::TriD;
use strict;
use warnings;
use PDL::Exporter;
use PDL::Core ''; # barf
our @ISA = qw/PDL::Exporter/;
our @EXPORT_OK = qw/imag3d_ns imag3d line3d mesh3d lattice3d points3d
trigrid3d trigrid3d_ns line3d_segs
contour3d spheres3d describe3d imagrgb imagrgb3d hold3d release3d
keeptwiddling3d nokeeptwiddling3d close3d
twiddle3d grabpic3d tridsettings/;
our %EXPORT_TAGS = (Func=>\@EXPORT_OK);
our $verbose;
our $VERSION = '2.102';
use PDL::Graphics::TriD::Object;
use PDL::Graphics::TriD::Window;
use PDL::Graphics::TriD::ViewPort;
use PDL::Graphics::TriD::Graph;
use PDL::Graphics::TriD::Quaternion;
use PDL::Graphics::TriD::Objects;
use PDL::ImageND;
# Then, see which display method are we using:
$PDL::Graphics::TriD::device = $PDL::Graphics::TriD::device;
BEGIN {
my $dev = $PDL::Graphics::TriD::device; # First, take it from this variable.
$dev ||= $::ENV{PDL_3D_DEVICE};
if(!defined $dev) {
# warn "Default PDL 3D device is GL (OpenGL):
# Set PDL_3D_DEVICE=GL in your environment in order not to see this warning.
# You must have OpenGL or Mesa installed and the PDL::Graphics::OpenGL extension
# compiled. Otherwise you will get strange warnings.";
$dev = "GL"; # default GL works on all platforms now
}
my $dv;
# The following is just a sanity check.
for($dev) {
(/^GL$/ and $dv="PDL::Graphics::TriD::GL") or
(/^GLpic$/ and $dv="PDL::Graphics::TriD::GL" and $PDL::Graphics::TriD::offline=1) or
(/^VRML$/ and $dv="PDL::Graphics::TriD::VRML" and $PDL::Graphics::TriD::offline=1) or
(barf "Invalid PDL 3D device '$_' specified!");
}
my $mod = $dv;
$mod =~ s|::|/|g;
print "dev = $dev mod=$mod\n" if($verbose);
require "$mod.pm";
$dv->import;
my $verbose;
}
# currently only used by VRML backend
$PDL::Graphics::TriD::Settings = $PDL::Graphics::TriD::Settings;
sub tridsettings {return $PDL::Graphics::TriD::Settings}
# Allowable forms:
# x(3,..) [x(..),y(..),z(..)]
sub realcoords {
my($type,$c) = @_;
if(ref $c ne "ARRAY") {
if($c->getdim(0) != 3) {
barf "If one ndarray given for coordinate, must be (3,...) or have default interpretation";
}
return $c ;
}
my @c = @$c;
if(!ref $c[0]) {$type = shift @c}
if(!@c || @c>3) {
barf "Must have 1..3 array members for coordinates";
}
if(@c == 1 and $type eq "SURF2D") {
# surf2d -> this is z axis
@c = ($c[0]->xvals,$c[0]->yvals,$c[0]);
} elsif(@c == 1 and $type eq "POLAR2D") {
my $t = 6.283 * $c[0]->xvals / ($c[0]->getdim(0)-1);
my $r = $c[0]->yvals / ($c[0]->getdim(1)-1);
@c = ($r * sin($t), $r * cos($t), $c[0]);
} elsif(@c == 1 and $type eq "COLOR") {
# color -> 1 ndarray = grayscale
@c = @c[0,0,0];
} elsif(@c == 1 and $type eq "LINE") {
@c = ($c[0]->xvals, $c[0], 0);
} elsif(@c == 2 and $type eq "LINE") {
@c = (@c[0,1], $c[0]->xvals);
}
# XXX
if(@c != 3) {
barf("Must have 3 coordinates if no interpretation (here '$type')");
}
# allow a constant (either pdl or not) to be introduced in one dimension
foreach(0..2) {
if(ref($c[$_]) ne "PDL" or $c[$_]->nelem==1){
$c[$_] = $c[$_]*(PDL->ones($c[($_+1)%3]->dims));
}
}
my $g = PDL::ImageND::combcoords(@c);
$g->dump if $PDL::Graphics::TriD::verbose;
return $g;
}
sub checkargs {
if(ref $_[$#_] eq "HASH" and $PDL::Graphics::TriD::verbose) {
print "enter checkargs \n";
for(['KeepTwiddling',\&keeptwiddling3d]) {
print "checkargs >$_<\n";
if(defined $_[$#_]{$_->[0]}) {
&{$_->[1]}(delete $_[$#_]{$_->[0]});
}
}
}
}
*keeptwiddling3d=*keeptwiddling3d=\&PDL::keeptwiddling3d;
sub PDL::keeptwiddling3d {
$PDL::Graphics::TriD::keeptwiddling = $_[0] // 1;
}
*nokeeptwiddling3d=*nokeeptwiddling3d=\&PDL::nokeeptwiddling3d;
sub PDL::nokeeptwiddling3d {
$PDL::Graphics::TriD::keeptwiddling = 0 ;
}
keeptwiddling3d();
*twiddle3d = *twiddle3d = *PDL::twiddle3d = \&twiddle_current;
*close3d = *close3d = \&PDL::close3d;
sub PDL::close3d {
return if !ref $PDL::Graphics::TriD::current_window;
return if !$PDL::Graphics::TriD::current_window->can('close');
$PDL::Graphics::TriD::current_window->close;
}
sub graph_object {
my($obj) = @_;
if(!defined $obj or !ref $obj) {
barf("Invalid object to TriD::graph_object");
}
print "graph_object: calling get_new_graph\n" if($PDL::Graphics::TriD::verbose);
my $g = get_new_graph();
print "graph_object: back from get_new_graph\n" if($PDL::Graphics::TriD::verbose);
my $name = $g->add_dataseries($obj);
$g->bind_default($name);
$g->scalethings();
print "ADDED TO GRAPH: '$name'\n" if $PDL::Graphics::TriD::verbose;
twiddle_current();
return $obj;
}
# Plotting routines that use the whole viewport
*describe3d=*describe3d=\&PDL::describe3d;
sub PDL::describe3d {
require PDL::Graphics::TriD::TextObjects;
my ($text) = @_;
my $win = PDL::Graphics::TriD::get_current_window();
my $imag = PDL::Graphics::TriD::Description->new($text);
$win->add_object($imag);
# $win->twiddle();
}
*imagrgb=*imagrgb=\&PDL::imagrgb;
sub PDL::imagrgb {
require PDL::Graphics::TriD::Image;
my (@data) = @_; &checkargs;
my $win = PDL::Graphics::TriD::get_current_window();
my $imag = PDL::Graphics::TriD::Image->new(@data);
$win->clear_viewports();
$win->current_viewport()->add_object($imag);
$win->twiddle();
}
# Plotting routines that use the 3D graph
# Call: line3d([$x,$y,$z],[$color]);
*line3d=*line3d=\&PDL::line3d;
sub PDL::line3d {
&checkargs;
my $obj = PDL::Graphics::TriD::LineStrip->new(@_);
print "line3d: object is $obj\n" if($PDL::Graphics::TriD::verbose);
graph_object($obj);
}
*line3d_segs=*line3d_segs=\&PDL::line3d_segs;
sub PDL::line3d_segs {
&checkargs;
my $obj = PDL::Graphics::TriD::Lines->new(@_);
print "line3d_segs: object is $obj\n" if($PDL::Graphics::TriD::verbose);
graph_object($obj);
}
*contour3d=*contour3d=\&PDL::contour3d;
sub PDL::contour3d {
&checkargs;
require PDL::Graphics::TriD::Contours;
graph_object(PDL::Graphics::TriD::Contours->new(@_));
}
# XXX Should enable different positioning...
*imagrgb3d=*imagrgb3d=\&PDL::imagrgb3d;
sub PDL::imagrgb3d { &checkargs;
require PDL::Graphics::TriD::Image;
graph_object(PDL::Graphics::TriD::Image->new(@_));
}
*imag3d_ns=*imag3d_ns=\&PDL::imag3d_ns;
sub PDL::imag3d_ns { &checkargs;
graph_object(PDL::Graphics::TriD::SLattice->new(@_));
}
*imag3d=*imag3d=\&PDL::imag3d;
sub PDL::imag3d { &checkargs;
graph_object(PDL::Graphics::TriD::SLattice_S->new(@_));
}
*trigrid3d=*trigrid3d=\&PDL::trigrid3d;
sub PDL::trigrid3d { &checkargs;
graph_object(PDL::Graphics::TriD::STrigrid_S->new(@_)); }
*trigrid3d_ns=*trigrid3d_ns=\&PDL::trigrid3d_ns;
sub PDL::trigrid3d_ns { &checkargs;
graph_object(PDL::Graphics::TriD::STrigrid->new(@_)); }
*mesh3d=*mesh3d=\&PDL::mesh3d;
*lattice3d=*lattice3d=\&PDL::mesh3d;
*PDL::lattice3d=*PDL::lattice3d=\&PDL::mesh3d;
sub PDL::mesh3d { &checkargs;
graph_object(PDL::Graphics::TriD::Lattice->new(@_));
}
*points3d=*points3d=\&PDL::points3d;
sub PDL::points3d { &checkargs;
graph_object(PDL::Graphics::TriD::Points->new(@_));
}
*spheres3d=*spheres3d=\&PDL::spheres3d;
sub PDL::spheres3d { &checkargs;
graph_object(PDL::Graphics::TriD::Spheres->new(@_));
}
*grabpic3d=*grabpic3d=\&PDL::grabpic3d;
sub PDL::grabpic3d {
my $win = PDL::Graphics::TriD::get_current_window();
barf "backend doesn't support grabbing the rendered scene"
unless $win->can('read_picture');
my $pic = $win->read_picture();
return ($pic->float) / 255;
}
$PDL::Graphics::TriD::only_one = 1;
sub PDL::hold3d {$PDL::Graphics::TriD::only_one = !($_[0] // 1);}
sub PDL::release3d {$PDL::Graphics::TriD::only_one = 1;}
*hold3d=*hold3d=\&PDL::hold3d;
*release3d=*release3d=\&PDL::release3d;
sub get_new_graph {
print "get_new_graph: calling PDL::Graphics::TriD::get_current_window...\n" if($PDL::Graphics::TriD::verbose);
my $win = PDL::Graphics::TriD::get_current_window();
print "get_new_graph: calling get_current_graph...\n" if($PDL::Graphics::TriD::verbose);
my $g = get_current_graph($win);
print "get_new_graph: back get_current_graph returned $g...\n" if($PDL::Graphics::TriD::verbose);
if ($PDL::Graphics::TriD::only_one) {
$g->clear_data;
$win->clear_viewport;
}
$g->default_axes;
$win->add_object($g);
return $g;
}
sub get_current_graph {
my $win = shift;
my $g = $win->current_viewport()->graph();
if(!defined $g) {
$g = PDL::Graphics::TriD::Graph->new;
$g->default_axes();
$win->current_viewport()->graph($g);
}
return $g;
}
sub get_current_window {
my $opts = shift @_;
my $win = $PDL::Graphics::TriD::current_window;
if(!defined $win) {
print "get_current_window - creating window...\n" if($PDL::Graphics::TriD::verbose);
$PDL::Graphics::TriD::current_window = $win = PDL::Graphics::TriD::Window->new($opts);
print "get_current_window - calling set_material...\n" if($PDL::Graphics::TriD::verbose);
$win->set_material(PDL::Graphics::TriD::Material->new);
}
return $PDL::Graphics::TriD::current_window;
}
sub twiddle_current { get_current_window()->twiddle() }
###################################
#
#
package PDL::Graphics::TriD::Material;
sub new {
my ($type,%ops) = @_;
my $this = bless {}, $type;
for (['Shine',40],
['Specular',[1,1,0.3,0]],
['Ambient',[0.3,1,1,0]],
['Diffuse',[1,0.3,1,0]],
['Emissive',[0,0,0]]) {
if (!defined $ops{$_->[0]}) {
$this->{$_->[0]} = $_->[1];
} else {
$this->{$_->[0]} = $ops{$_->[0]};
}
}
return $this;
}
package PDL::Graphics::TriD::BoundingBox;
use base qw/PDL::Graphics::TriD::Object/;
use fields qw/Box/;
sub new {
my($type,$x0,$y0,$z0,$x1,$y1,$z1) = @_;
my $this = $type->SUPER::new();
$this->{Box} = [$x0,$y0,$z0,$x1,$y1,$z1];
}
sub normalize {my($this,$x0,$y0,$z0,$x1,$y1,$z1) = @_;
$this = $this->{Box};
my $trans = PDL::Graphics::TriD::Transformation->new();
my $sx = ($x1-$x0)/($this->[3]-$this->[0]);
my $sy = ($y1-$y0)/($this->[4]-$this->[1]);
my $sz = ($z1-$z0)/($this->[5]-$this->[2]);
$trans->add_transformation(
PDL::Graphics::TriD::Translation->new(
($x0-$this->[0]*$sx),
($y0-$this->[1]*$sy),
($z0-$this->[2]*$sz)
));
$trans->add_transformation(PDL::Graphics::TriD::Scale->new($sx,$sy,$sz));
return $trans;
}
package PDL::Graphics::TriD::OneTransformation;
use fields qw/Args/;
sub new {
my($type,@args) = @_;
my $this = fields::new($type);
$this->{Args} = [@args];
$this;
}
package PDL::Graphics::TriD::Scale;
use base qw/PDL::Graphics::TriD::OneTransformation/;
package PDL::Graphics::TriD::Translation;
use base qw/PDL::Graphics::TriD::OneTransformation/;
package PDL::Graphics::TriD::Transformation;
use base qw/PDL::Graphics::TriD::Object/;
sub add_transformation {
my($this,$trans) = @_;
push @{$this->{Transforms}},$trans;
}
=head1 AUTHOR
Copyright (C) 1997 Tuomas J. Lukka (lukka@husc.harvard.edu). Documentation
contributions from Karl Glazebrook (kgb@aaoepp.aao.gov.au).
All rights reserved. There is no warranty. You are allowed
to redistribute this software / documentation under certain
conditions. For details, see the file COPYING in the PDL
distribution. If this file is separated from the PDL distribution,
the copyright notice should be included in the file.
=cut
1;
PDL-Graphics-TriD-2.102/MANIFEST0000644000175000017500000000322114776144104015620 0ustar osboxesosboxesChanges
demos/DemoTkTriD.pm
demos/test4.p
demos/test5.p
demos/test7.p
demos/testimg.p
demos/tvrml.p
demos/tvrml2.p
lib/PDL/Demos/TriD1.pm
lib/PDL/Demos/TriD2.pm
lib/PDL/Demos/TriDGallery.pm
lib/PDL/Graphics/OpenGLQ-font.c
lib/PDL/Graphics/OpenGLQ-sphere.c
lib/PDL/Graphics/OpenGLQ.pd
lib/PDL/Graphics/TriD.pm
lib/PDL/Graphics/TriD/ArcBall.pm
lib/PDL/Graphics/TriD/ButtonControl.pm
lib/PDL/Graphics/TriD/Contours.pm
lib/PDL/Graphics/TriD/GL.pm
lib/PDL/Graphics/TriD/GL/GLFW.pm
lib/PDL/Graphics/TriD/GL/GLUT.pm
lib/PDL/Graphics/TriD/GL/GLX.pm
lib/PDL/Graphics/TriD/Graph.pm
lib/PDL/Graphics/TriD/Image.pm
lib/PDL/Graphics/TriD/Labels.pm
lib/PDL/Graphics/TriD/Logo.pm
lib/PDL/Graphics/TriD/MathGraph.pm
lib/PDL/Graphics/TriD/Object.pm
lib/PDL/Graphics/TriD/Objects.pm
lib/PDL/Graphics/TriD/Polygonize.pm
lib/PDL/Graphics/TriD/Quaternion.pm
lib/PDL/Graphics/TriD/Rout.pd
lib/PDL/Graphics/TriD/ScrollButtonScaler.pm
lib/PDL/Graphics/TriD/SimpleController.pm
lib/PDL/Graphics/TriD/SimpleScaler.pm
lib/PDL/Graphics/TriD/TextObjects.pm
lib/PDL/Graphics/TriD/ViewPort.pm
lib/PDL/Graphics/TriD/VRML.pm
lib/PDL/Graphics/TriD/Window.pm
lib/PDL/Graphics/VRML.pm
lib/PDL/Graphics/VRML/Protos.pm
Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
t/arcball.t
t/quaternion.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
GENERATED/PDL/Graphics/OpenGLQ.pm mod=PDL::Graphics::OpenGLQ pd=lib/PDL/Graphics/OpenGLQ.pd (added by pdlpp_mkgen)
GENERATED/PDL/Graphics/TriD/Rout.pm mod=PDL::Graphics::TriD::Rout pd=lib/PDL/Graphics/TriD/Rout.pd (added by pdlpp_mkgen)
PDL-Graphics-TriD-2.102/Makefile.PL0000644000175000017500000000325614776143612016454 0ustar osboxesosboxesuse strict;
use warnings;
use ExtUtils::MakeMaker;
use PDL::Core::Dev;
use OpenGL::Config;
my ($def, $inc, $libs) = ('', '', '');
$libs = $OpenGL::Config->{LIBS} if $OpenGL::Config->{LIBS};
$def .= ' '.$OpenGL::Config->{DEFINE} if $OpenGL::Config->{DEFINE};
$inc .= ' '.$OpenGL::Config->{INC} if $OpenGL::Config->{INC};
if($^O eq 'MSWin32') {
$def .= ' -DGLUT_DISABLE_ATEXIT_HACK'; # else get errors about PerlProc_exit on at least Strawberry Perl 5.32
}
$libs .= ' -lm';
my $package_name = "PDL::Graphics::TriD";
(my $repo = $package_name) =~ s#::#-#g;
$repo = "PDLPorters/$repo";
WriteMakefile (
NAME => $package_name,
AUTHOR => 'PerlDL Developers ',
LICENSE=> "perl",
VERSION_FROM => 'lib/PDL/Graphics/TriD.pm',
CONFIGURE_REQUIRES => {
'ExtUtils::MakeMaker' => 0,
'PDL' => '2.096',
'OpenGL' => '0.7004',
},
PREREQ_PM => {
'PDL' => '2.096',
'OpenGL' => '0.7004',
'OpenGL::GLFW' => '0.0402',
},
TEST_REQUIRES => {
'Test::More' => '0.88',
},
!$def ? () : (DEFINE => $def),
!$inc ? () : (INC => $inc),
LIBS => [$libs],
META_MERGE => {
"meta-spec" => { version => 2 },
resources => {
homepage => 'http://pdl.perl.org/',
bugtracker => {web=>"https://github.com/$repo/issues"},
repository => {
url => "git://github.com/$repo.git",
type => 'git',
web => "https://github.com/$repo",
},
x_IRC => 'irc://irc.perl.org/#pdl',
},
},
);
{
my @pd_srcs;
package MY; # so that "SUPER" works right
sub init_PM {
my ($self) = @_;
$self->SUPER::init_PM;
@pd_srcs = ::pdlpp_eumm_update_deep($self);
}
sub postamble { ::pdlpp_postamble(@pd_srcs) }
}