#!/usr/bin/perl -w # alpha.pl: I need to test if I can actually draw semi-transparent # polygons on top of an existing image. use strict; use GD; use Tk; my $trackbase; # main { # Create the base canvas, load and display the background image my $top = MainWindow->new(); $top->title( 'Alpha Test' ); my $playfield = $top->Canvas( -width => 918, -height => 595, ); $trackbase = $playfield->Photo( -file => "../Monaco/Monaco.gif", ); $playfield->createImage( 0, 0, -anchor => 'nw', -image => $trackbase, ); $playfield->Tk::bind( "<Button-1>", [ \&put_alpha, Ev('x'), Ev('y'), $trackbase, ], ); $playfield->pack(); my $msg_window = $top->Label( -background => "black", -foreground => "white", -justify => "left", ); my $done = $top->Button( -text => 'Dismiss', -command => \&done, ); $done->pack( -side => "right" ); $msg_window->pack( -side => "left", -fill => "x", -expand => 1, ); MainLoop(); } sub done { exit; } sub put_alpha ($$$$) { # Need to capture the area under the cursor, merge it with a GD created # object and redisplay it under the cursor. my( undef, $xclick, $yclick, $field ) = @_; my $patch = '';# How do I make GD and Tk talk to each other? $field->copy( $patch, -to => ($xclick - 8, $yclick - 8, $xclick + 7, $yclick + 7)); }