home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _da891a8c269066570a03ebf4ae70063a < prev    next >
Encoding:
Text File  |  2004-06-01  |  2.3 KB  |  111 lines
  1. package Tk::DragDrop::Rect;
  2. use strict;
  3. use Carp;
  4.  
  5. # Proxy class which represents sites to the dropping side
  6.  
  7. use vars qw($VERSION);
  8. $VERSION = sprintf '4.%03d', q$Revision: #11 $ =~ /\D(\d+)\s*$/;
  9.  
  10. # Some default methods when called site side
  11. # XIDs and viewable-ness from widget
  12.  
  13. # XID of ancestor
  14. sub ancestor { ${shift->widget->toplevel->WindowId} }
  15.  
  16. # XID of site window
  17. sub win      { ${shift->widget->WindowId} }
  18.  
  19. # Is site window mapped
  20. sub viewable { shift->widget->viewable }
  21.  
  22. sub Over
  23. {
  24.  my ($site,$X,$Y) = @_;
  25.  
  26.  my $x = $site->X;
  27.  my $y = $site->Y;
  28.  my $w = $site->width;
  29.  my $h = $site->height;
  30.  my $val = ($X >= $x && $X < ($x + $w) && $Y >= $y && $Y < ($y + $h));
  31.  
  32.  return 0 unless $val;
  33.  
  34.  my $widget = $site->widget;
  35.  
  36.  # Now XTranslateCoords from root window to site window's
  37.  # ancestor. Ancestors final descendant should be the site window.
  38.  # Like $win->containing but avoids a problem that dropper's "token"
  39.  # window may be the toplevel (child of root) that contains X,Y
  40.  # so if that is in another application ->containing does not
  41.  # give us a window.
  42.  my $id = $site->ancestor;
  43.  while (1)
  44.   {
  45.    my $cid = $widget->PointToWindow($X,$Y,$id);
  46.    last unless $cid;
  47.    $id = $cid;
  48.   }
  49.  return ($id == $site->win);
  50. }
  51.  
  52. sub FindSite
  53. {
  54.  my ($class,$widget,$X,$Y) = @_;
  55.  foreach my $site ($class->SiteList($widget))
  56.   {
  57.    return $site if ($site->viewable && $site->Over($X,$Y));
  58.   }
  59.  return undef;
  60. }
  61.  
  62. sub NewDrag
  63. {
  64.  my ($class,$widget) = @_;
  65. }
  66.  
  67. sub Match
  68. {
  69.  my ($site,$other) = @_;
  70.  return 0 unless (defined $other);
  71.  return 1 if ($site == $other);
  72.  return 0 unless (ref($site) eq ref($other));
  73.  for ("$site")
  74.   {
  75.    if (/ARRAY/)
  76.     {
  77.      my $i;
  78.      return 0 unless (@$site == @$other);
  79.      for ($i = 0; $i < @$site; $i++)
  80.       {
  81.        return 0 unless ($site->[$i] == $other->[$i]);
  82.       }
  83.      return 1;
  84.     }
  85.    elsif (/SCALAR/)
  86.     {
  87.      return $site == $other;
  88.     }
  89.    elsif (/HASH/)
  90.     {
  91.      my $key;
  92.      foreach $key (keys %$site)
  93.       {
  94.        return 0 unless exists $other->{$key};
  95.        return 0 unless ($other->{$key} eq $site->{$key});
  96.       }
  97.      foreach $key (keys %$other)
  98.       {
  99.        return 0 unless exists $site->{$key};
  100.        return 0 unless ($other->{$key} eq $site->{$key});
  101.       }
  102.      return 1;
  103.     }
  104.    return 0;
  105.   }
  106.  return 0;
  107. }
  108.  
  109.  
  110. 1;
  111.