home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / cloth.pl < prev    next >
Encoding:
Perl Script  |  2002-11-17  |  962 b   |  66 lines
  1. # Object-oriented Canvas.
  2. #!/usr/local/bin/perl -w
  3. use strict;
  4. use Tk qw(Ev);
  5. use Tk::Cloth;
  6.  
  7. my $mw = Tk::MainWindow->new;
  8.  
  9. my $cloth = $mw->Cloth();
  10.  
  11.  
  12. my $r = $cloth->Rectangle(
  13.     -coords => [0,0,100,100],
  14.     -fill => 'green'
  15. );
  16.  
  17. {
  18.     my($x,$y);
  19.     $r->bind("<ButtonPress-1>", [
  20.     sub {
  21.         shift;
  22.         ($x,$y) = @_
  23.     }, Ev('x'),Ev('y')]
  24.     );
  25.     $r->bind("<B1-Motion>", [
  26.     sub {
  27.         my($r,$X,$Y) = @_;
  28.         $r->move($X-$x,$Y-$y);
  29.         ($x,$y) = ($X,$Y)  
  30.     }, Ev('x'),Ev('y')]
  31.     );
  32. }
  33.  
  34. my $tag = $cloth->Tag;
  35.  
  36. $tag->Oval(
  37.     -coords => [100,0,200,100],
  38.     -fill => 'blue'
  39. );
  40.  
  41. $tag->Oval(
  42.     -coords => [0,200,100,100],
  43.     -fill => 'red'
  44. );
  45.  
  46. {
  47.     my($x,$y);
  48.     $tag->bind("<ButtonPress-1>", [
  49.     sub {
  50.         shift;
  51.         ($x,$y) = @_
  52.     }, Ev('x'),Ev('y')]
  53.     );
  54.     $tag->bind("<B1-Motion>", [
  55.     sub {
  56.         my($r,$X,$Y) = @_;
  57.         $r->move($X-$x,$Y-$y);
  58.         ($x,$y) = ($X,$Y)  
  59.     }, Ev('x'),Ev('y')]
  60.     );
  61. }
  62.  
  63. $cloth->pack(-fill => 'both', -expand => 1);
  64.  
  65. Tk::MainLoop;
  66.