Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

PDL 3d image cube

by zentara (Archbishop)
on Dec 26, 2006 at 17:13 UTC ( #591731=snippet: print w/ replies, xml ) Need Help??

Description: 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();

Comment on PDL 3d image cube
Download Code
Re: PDL 3d image cube
by zentara (Archbishop) on Jan 04, 2007 at 21:13 UTC
    The fellow that writes the GD interface to PDL, PDL::IO::GD, (Judd Taylor) has upgraded the PDL cvs to fix the module to use FreeType fonts. SO... yippie... you can do away with the writing of the temp 2d image files to disk, and use inline memory images.

    To get the cvs version of PDL

    cvs -z3 -d:pserver:anonymous@pdl.cvs.sourceforge.net:/cvsroot/pdl co +-P PDL
    then there will be a PDL directory in your homedir.

    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();

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

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://591731]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (8)
As of 2014-11-27 00:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (178 votes), past polls