japhy has asked for the wisdom of the Perl Monks concerning the following question:

I'm working on making the pseudo-3D representation of an area for the Dungeon Construction Kit, and I've run into a problem. The way I'm creating the image is taking a blank canvas in GD and copying images (resized and skewed, painstakingly...) onto the canvas.

The problem I've run into is these images I'm copying onto the canvas aren't ALL necessarily opaque rectangular images. Some of them are meant to have transparent portions. For example, you should be able to see through an archway to the cell behind it. Does anyone know how I can do this? See below for the current code I'm using. Two notes: the math I use, while perhaps confusing to some, is proper and it works; also, be aware that the 'copyResampled' function causes some change in color quality.

#!/usr/bin/perl ### skewing use GD; use strict; use warnings; use constant FINAL => 0; my ($X, $Y) = (256, 256); # all these images are 256x256 my $wood = GD::Image->new("acacia/wallwood.png"); my $ceiling = GD::Image->new("acacia/ceiling.png"); my $rug = GD::Image->new("acacia/floorrug.png"); my $comp = GD::Image->new("acacia/wallcomp.png"); my $arch = GD::Image->new("acacia/wallarch.png"); my $tmp = GD::Image->new(2 * $X, 2 * $Y, 1); $tmp->clip(2 * $X/8, 2 * $Y/8, 2 * $X*7/8, 2 * $Y*7/8); back_wall($tmp, $wood, 3, $_, $X, $Y) for -3 .. 3; ceiling($tmp, $ceiling, 3, $_, $X, $Y) for -4 .. 4; ceiling($tmp, $ceiling, 2, $_, $X, $Y) for -2 .. 2; ceiling($tmp, $ceiling, 1, $_, $X, $Y) for -1 .. 1; floor($tmp, $rug, 3, $_, $X, $Y) for -4 .. 4; floor($tmp, $rug, 2, $_, $X, $Y) for -2 .. 2; floor($tmp, $rug, 1, $_, $X, $Y) for -1 .. 1; side_wall($tmp, $comp, 3, 1, $X, $Y); side_wall($tmp, $comp, 2, -1, $X, $Y); side_wall($tmp, $comp, 2, 1, $X, $Y); side_wall($tmp, $comp, 1, -1, $X, $Y); back_wall($tmp, $arch, 1, 0, $X, $Y); back_wall($tmp, $comp, 1, 1, $X, $Y); my $final = GD::Image->new(2*$X, 2*$Y*3/4, 1); $final->copyResampled( $tmp, (0,0) => (2*$X/8, 2*$Y/8), (2*$X*3/4, 2*$Y*3/4), (2*$X*3/4, 2*$Y*3/4) ); $tmp->setThickness(4); $tmp->rectangle( (2 * $X/8, 2 * $Y/8) => (2 * $X*7/8, 2 * $Y*7/8), $tmp->colorAllocate(255,255,0), ); print $tmp->rgb($tmp->getPixel($X,$Y)); $tmp->transparent($tmp->rgb($tmp->getPixel($X,$Y))); open IMG, '>:raw', 'composite.png' or die $!; binmode IMG; print IMG +(FINAL ? $final : $tmp)->png; close IMG; sub ceiling { my ($dst, $src, $depth, $os, $x, $y) = @_; my $cf = 2 * (2**$depth - 1) / 2**($depth + 1); my $sf = 2 * 1 / 2**$depth; for (0 .. 2 * $y * 1/2**($depth+1) - 1) { $dst->copyResampled( $src, ($x * $cf + $sf * $x * $os + $_*(1 + 2*($os-1)), $y * $cf - ($_ ++ 1)) => (0, $y - 2**$depth * ($_ + 1)), ($x * $sf + 2*$_, 1), ($x, 2**$depth), ); } } sub floor { my ($dst, $src, $depth, $os, $x, $y) = @_; my $cf = (2**$depth - 1) / 2**($depth + 1); my $sf = 2 * 1 / 2**$depth; for (0 .. 2 * $y * 1/2**($depth+1) - 1) { $dst->copyResampled( $src, (2 * $x * $cf + $sf * $x * $os + $_*(1 + 2*($os-1)), 2 * $y * (1 +-$cf) + $_) => (0, 2**$depth * $_), ($x * $sf + 2*$_, 1), ($x, 2**$depth), ); } } sub back_wall { my ($dst, $src, $depth, $os, $x, $y) = @_; my $cf = 2 * (2**$depth - 1) / 2**($depth + 1); my $sf = 2 * 1 / 2**$depth; $dst->copyResampled( $src, ($x * ($cf + $os * $sf), $y * $cf) => (0, 0), ($x * $sf, $y * $sf), ($x, $y), ); } sub side_wall { my ($dst, $src, $depth, $os, $x, $y) = @_; my $cf = (2**$depth - 1) / 2**($depth + 1); my $sf = 2 * 1 / 2**$depth; $os-- if $os > 0; for (0 .. 2 * $x / 2**($depth + 1) - 1) { $dst->copyResampled( $src, (($os < 0 ? -1 : 0) + $sf*$x*$os + 2*$x*(1-$cf) + ($os*2+1)*$_, +2*$y*$cf - $_) => ($os < 0 ? ($x - ($_+1) * 2**$depth) : ($_ * 2**$de +pth), 0), (abs(2*$os + 1), $sf * $y + 2 * $_), (2**$depth, $y) ); } }
_____________________________________________________
Jeff japhy Pinyan, P.L., P.M., P.O.D, X.S.: Perl, regex, and perl hacker
How can we ever be the sold short or the cheated, we who for every service have long ago been overpaid? ~~ Meister Eckhart

Replies are listed 'Best First'.
Re: GD (or something better?) and image transparency
by japhy (Canon) on Feb 24, 2005 at 04:35 UTC
    Update: I think I've solved my own problem. I wasn't using the proper color index to the 'transparent' method.
    _____________________________________________________
    Jeff japhy Pinyan, P.L., P.M., P.O.D, X.S.: Perl, regex, and perl hacker
    How can we ever be the sold short or the cheated, we who for every service have long ago been overpaid? ~~ Meister Eckhart
Re: GD (or something better?) and image transparency
by zentara (Cardinal) on Feb 24, 2005 at 12:39 UTC
    Some of them are meant to have transparent portions

    Zinc can do it. You can put "holes" into objects, and see thru them. What is "on top" is set by a "priority" number. It might help you out later. You can export the zinc canvas to a graphic format, like jpg, with Tk::WinPhoto.

    #!/usr/bin/perl use warnings; use strict; use Tk; use Tk::Zinc; my $motion_flag = 0; my $delay = 50; #adjust for speed of your computer my $mw = MainWindow->new; $mw->geometry("700x600"); $mw->resizable(0,0); my $zinc = $mw->Zinc(-width => 700, -height => 565, -backcolor => 'grey', -borderwidth => 3, -relief => 'sunken', )->pack; # Then we create a gray filled rectangle, in which we will display exp +lain text. $zinc->add('rectangle', 1 , [200, 400, 490, 490], -linewidth => 2, -filled => 1, -fillcolor => 'SkyBlue', ); my $text = $zinc->add('text', 1, -position => [350, 445], -anchor => 'center', -priority => 2 ); #a circle is bounded by a square box, specify 2 diagonal points my $arc1 = $zinc->add('arc', 1, [5,5,65,65], -fillcolor => "yellow", - +filled => 1); #an ellipse is bounded by a rectangle, specify 2 diagonal points my $arc2 = $zinc->add('arc', 1, [70, 5, 95, 65], -fillcolor => "green" +, -filled => 1, -linewidth => 0); #notice you cannot make a see-thru hole in an arc #contour only works for curve items #an ellipse is bounded by a rectangle, specify 2 diagonal points my $arc3 = $zinc->add('arc', 1, [110, 10, 300, 150], -fillcolor => "or +ange", -filled => 1); my $arc3a = $zinc->add('arc', 1, [150, 30, 260, 150], -filled => 1, #-visible => 0 ); $zinc->contour($arc3, 'add', 1, $arc3a); # will not produce a see-thru + because # $arc3 is an arc # #now a see thru-hole can be formed in the curve $arc3b my $arc3b = $zinc->add('curve', 1,[ [360, 10], [650,25], [600,200], [3 +50,250], [400,100] ], -filled => 1, -fillcolor => "green", -closed => 1, -priority => 2); my $arc3c = $zinc->add('arc', 1, [475,40 , 600, 200], -visible => 0); $zinc->contour($arc3b, 'add', 1, $arc3c); # will produce a see-thru b +ecause $arc3b # is a curve my $arc4 = $zinc->add('arc', 1, [300, 75, 400, 175], -fillcolor => "white", -filled => 1, -priority => 1); my $arc5 = $zinc->add('arc', 1, [100,250, 300, 400], -fillcolor => "blue", -filled => 1, -visible => 1, -extent => 90, -startangle => 270, #starts at "North" -pieslice => 1, -priority => 2); # sets it on top layer # Display comment &comment("Hit Enter to begin."); #set key binding $mw->Tk::bind('<Return>', \&start); my $closebutton = $mw->Button(-text => 'Exit', -command => sub{Tk::exi +t(0)}) ->pack; MainLoop; sub start { &comment("Hit Esc to stop."); $motion_flag = 1; $mw->Tk::bind('<Return>', sub{}); &startaction; } sub stopaction{ &comment("Hit Enter to begin"); $motion_flag = 0; $mw->Tk::bind('<Return>', \&start); } sub startaction { $mw->Tk::bind('<Escape>', \&stopaction); $mw->Tk::bind('<Up>', sub{$delay = ($delay -1) unless $delay <= 1 +}); $mw->Tk::bind('<Down>', sub{$delay = ($delay + 1)unless $delay >= +1000} ); $zinc->rotate($arc4,.15,350,281); if($motion_flag == 1){ $zinc->after($delay, sub {startaction()})} else {return} } # Just display comment sub comment { my $string = shift; $zinc->itemconfigure($text, -text => $string); }

    I'm not really a human, but I play one on earth. flash japh