PDL 3d image cube

This is just a little program to demonstrate PDL's ability to project images onto planes in 3d space. I use GD to generate 1..6 images, but you could substitute christmas photos if you wanted. :-) Not useful, it's just for the learning experience. It needs a ttf file , named 'Generic.ttf' in the script directory. It requires TrueColor pngs( no lookup color tables).

#!/usr/bin/perl
use warnings;
use strict;
use PDL::LiteF;
use PDL::Graphics::TriD;    # 3d display
use GD;
use GD::Text::Align;
use PDL::NiceSlice;
use PDL::IO::Pic;

GD::Image->trueColor( 1 );

my $image = new GD::Image( 200, 200 );
my $black  = $image->colorAllocate( 0,   0,   0 );
my $white  = $image->colorAllocate( 255, 255, 255 );
my $red    = $image->colorAllocate( 255, 0,   0 );
my $green  = $image->colorAllocate( 0,   255, 0 );
my $blue   = $image->colorAllocate( 0,   0,   255 );
my $yellow = $image->colorAllocate( 255, 255, 0 );
my $grey   = $image->colorAllocate( 200, 200, 200 );

my $gdt = GD::Text::Align->new(
   $image,
   font   => 'Generic.ttf',
   text   => '',
   color  => $black,
   valign => "center",
   halign => "center",
) or die;

$gdt->set_font( 'Generic.ttf', 150 ) or die;

my %pdls;

my %color = (
   1 => [ 'white',  $white ],
   2 => [ 'red',    $red ],
   3 => [ 'green',  $green ],
   4 => [ 'blue',   $blue ],
   5 => [ 'yellow', $yellow ],
   6 => [ 'grey',   $grey ],
);

foreach my $num ( keys %color ) {
   $image->filledRectangle( 0, 0, 200, 200, $color{ $num }[ 1 ] );
   $gdt->set_text( $num );
   $gdt->draw( 100, 100, 0 ) or die;

   open( GD, "> z-$color{$num}[0].png" ) or die;    #
   binmode GD;
   print GD $image->png;
   close GD;
}

foreach my $num ( keys %color ) {
   $pdls{ $num } = rim( "z-$color{$num}[0].png" );
}

nokeeptwiddling3d();
hold3d();

# side 1 of space
  imagrgb3d $pdls{ 1 }->mv( 2, 0 )->( :, -1 : 0, : )->float / 256,
  #{Points => [[1,0,0],[0,0,0],[0,0,1],[1,0,1]]}; #rotated +90 deg
   { Points => [ [ 1, 0, 1 ], [ 1, 0, 0 ], [ 0, 0, 0 ], [ 0, 0, 1 ] ] 
+};

#side 2 of space
  imagrgb3d $pdls{ 2 }->mv( 2, 0 )->( :, -1 : 0, : )->float / 256,
    { Points => [ [ 0, 0, 0 ], [ 1, 0, 0 ], [ 1, 1, 0 ], [ 0, 1, 0 ] ]
+ };

#side 3 of space
  imagrgb3d $pdls{ 3 }->mv( 2, 0 )->( :, -1 : 0, : )->float / 256,
      { Points => [ [ 1, 0, 0 ], [ 1, 0, 1 ], [ 1, 1, 1 ], [ 1, 1, 0 ]
+ ] };

#side 4 of space
   imagrgb3d $pdls{ 4 }->mv( 2, 0 )->( :, -1 : 0, : )->float / 256,
      #{Points => [[0,0,1],[1,0,1],[1,1,1],[0,1,1]]}; #reversed
      #{Points => [[0,1,1],[1,1,1],[1,0,1],[0,0,1]]}; #upside down
    { Points => [ [ 1, 0, 1 ], [ 0, 0, 1 ], [ 0, 1, 1 ], [ 1, 1, 1 ] ]
+ };   #good

#side 5 of space
    imagrgb3d $pdls{ 5 }->mv( 2, 0 )->( :, -1 : 0, : )->float / 256,
      #{Points => [[0,0,0],[0,0,1],[0,1,1],[0,1,0]]};
      { Points => [ [ 0, 0, 1 ], [ 0, 0, 0 ], [ 0, 1, 0 ], [ 0, 1, 1 ]
+ ] };

#side 6 of space
  imagrgb3d $pdls{ 6 }->mv( 2, 0 )->( :, -1 : 0, : )->float / 256,
      #{Points => [[0,1,0],[0,1,1],[1,1,1],[1,1,0]]};
      { Points => [ [ 0, 1, 1 ], [ 0, 1, 0 ], [ 1, 1, 0 ], [ 1, 1, 1 ]
+ ] };

keeptwiddling3d();
twiddle3d();
[download]

Comment on PDL 3d image cube Download Code

Replies are listed 'Best First'.

Re: PDL 3d image cube
by zentara (Archbishop) on Jan 04, 2007 at 21:13 UTC

To get the cvs version of PDL

 cvs -z3 -d:pserver:anonymous@pdl.cvs.sourceforge.net:/cvsroot/pdl co 
+-P PDL
[download]

If built succesfully, the following improved image cube will run. Generic.ttf is any truetype font file in the local dir. I copied arial.ttf in.

#!/usr/bin/perl
use warnings;
use strict;
use PDL::LiteF;
use PDL::Graphics::TriD;    # Need this to display
use PDL::NiceSlice;
use PDL::IO::GD;

my $image = PDL::IO::GD->new( { x => 200, y => 200, true_color => 1 } 
+);

# Allocate some colors:
#
my $black  = $image->ColorAllocate( 0,   0,   0 );
my $white  = $image->ColorAllocate( 255, 255, 255 );
my $red    = $image->ColorAllocate( 255, 0,   0 );
my $green  = $image->ColorAllocate( 0,   255, 0 );
my $blue   = $image->ColorAllocate( 0,   0,   255 );
my $yellow = $image->ColorAllocate( 255, 255, 0 );
my $grey   = $image->ColorAllocate( 200, 200, 200 );

my %pdls;
my %color = (
   1 => [ 'white',  $white ],
   2 => [ 'red',    $red ],
   3 => [ 'green',  $green ],
   4 => [ 'blue',   $blue ],
   5 => [ 'yellow', $yellow ],
   6 => [ 'grey',   $grey ],
);

foreach my $num ( keys %color ) {
   $image->FilledRectangle( 0, 0, 200, 200, $color{ $num }[ 1 ] );

# Add some text:
   my @brect;
   $image->StringFT( \@brect, $black, "./Generic.ttf", 120, 0, 50, 150
+, $num );

   $pdls{ $num } = $image->to_pdl();
}

nokeeptwiddling3d();
hold3d();

# side 1 of space
imagrgb3d $pdls{ 1 }->mv( 2, 0 )->( :, -1 : 0, : )->float / 256,
 { Points => [ [ 0, 0, 1 ], [ 0, 0, 0 ], [ 1, 0, 0 ], [ 1, 0, 1 ] ] };

#side 2 of space
imagrgb3d $pdls{ 2 }->mv( 2, 0 )->( :, -1 : 0, : )->float / 256,
 { Points => [ [ 0, 1, 0 ], [ 1, 1, 0 ], [ 1, 0, 0 ], [ 0, 0, 0 ] ] };

#side 3 of space
imagrgb3d $pdls{ 3 }->mv( 2, 0 )->( :, -1 : 0, : )->float / 256,
 { Points => [ [ 1, 1, 0 ], [ 1, 1, 1 ], [ 1, 0, 1 ], [ 1, 0, 0 ] ] };

#side 4 of space
imagrgb3d $pdls{ 4 }->mv( 2, 0 )->( :, -1 : 0, : )->float / 256,
 { Points => [ [ 1, 1, 1 ], [ 0, 1, 1 ], [ 0, 0, 1 ], [ 1, 0, 1 ] ] };
+    #good

#side 5 of space
imagrgb3d $pdls{ 5 }->mv( 2, 0 )->( :, -1 : 0, : )->float / 256,

#      {Points => [[0,0,0],[0,0,1],[0,1,1],[0,1,0]]};
 { Points => [ [ 0, 1, 1 ], [ 0, 1, 0 ], [ 0, 0, 0 ], [ 0, 0, 1 ] ] };

#side 6 of space
imagrgb3d $pdls{ 6 }->mv( 2, 0 )->( :, -1 : 0, : )->float / 256,
 { Points => [ [ 1, 1, 1 ], [ 1, 1, 0 ], [ 0, 1, 0 ], [ 0, 1, 1 ] ] };

keeptwiddling3d();
twiddle3d();
[download]

I'm not really a human, but I play one on earth. Cogito ergo sum a bum

[reply]
[d/l]
[select]


P is for Practical
	PerlMonks