[MacPerl-Toolbox] Prevent application switch?

[kpreid@ibm.net (Kevin Reid)]

Is there a way to temporarily prevent the user from switching
applications while a MacPerl script is running?

I have written a script that hides the menu bar while it's running, and
it gets confused if another application is in front.

Also, is the method I'm using to hide the menu bar OK?


The script:

#!perl -w

# Bouncer v2.0
# by Kevin Reid
#
# Run this in the highest color depth you can.
# To stop, click or press a key.
# 
# Version History
# 2.0
#   * Hides menu bar and cursor
#   * Can be stopped with a keypress
# 1.0
#   * Initial release


use Mac::QuickDraw;
use Mac::Windows;
use Mac::Events;
use Mac::Menus;
use Mac::LowMem;

$color_vel_max = 200; # Maximum color-change speed
$excess = 20;         # Amount by which borders of bounce
                      #   area exceed screen size
$shapes = 2;          # Number of shapes
$points = 3;          # Number of points in each shape
$system_time = 400;   # How (un-)often to let other applications
                      #   do things
$stepmax = 2;         # Line width
$maxvel = $stepmax/2; # Maximum velocity

$do_attract = 0;      
$maxdist = 200;       # Preferred distance between points
$attract_div = .002;  # Strength of attraction

foreach (@ARGV) {
  require $_;
}


$origrgn = CopyRgn(GetGrayRgn());
RectRgn(GetGrayRgn, GetWMgrPort->portRect);

$oheight = LMGetMBarHeight;
LMSetMBarHeight(0);
HideCursor();
DisableItem GetMenu 129;
DisableItem GetMenu 130;

END {
  LMSetMBarHeight($oheight);
  ShowCursor();
  EnableItem GetMenu 129;
  EnableItem GetMenu 130;

  if ($win) {
    SetPort $win->window;
    EraseRect($bbx);
  }

  if ($origrgn) {
    CopyRgn($origrgn, GetGrayRgn);
    DisposeRgn $origrgn;
  }
  $win->dispose if $win;
}


$bbx = InsetRect(GetWMgrPort->portRect, 0, 0);
$bw = $bbx->right - $bbx->left;
$bh = $bbx->bottom - $bbx->top;

$win = new MacColorWindow (
  $bbx,
  'Bouncer',
  1,
  plainDBox,
  1,
);
$win->sethook('drawgrowicon', sub {});
$win->sethook(click => sub {$done = 1});
$win->sethook(key => sub {$done = 1});
SetPort $win->window;
PenSize($stepmax, $stepmax);
RGBBackColor(new RGBColor(0,0,0));

sub getcolor {
  my @colors = ();
  for (qw(R G B)) {
    push @colors, {
      val => rand 65535,
      vel => rand $color_vel_max,
    };
  }
  return \@colors;
}

for (1..$shapes) {
  my @points = ();
  for (1..$points) {
    push @points, {
      xp => rand $bw,
      yp => rand $bh,
      xv => rand $maxvel,
      yv => rand $maxvel,
      id => $#points + 1,
    };
  }
  push @loops, {pts => \@points, col => getcolor()};
}

sub nextp {
  my ($lp, $cur) = @_;
  $cur = -1 if $cur >= $#{$lp->{pts}};
  return $lp->{pts}[$cur + 1];
}

sub prevp {
  my ($lp, $cur) = @_;
  return $lp->{pts}[$cur - 1];
}

for (1..10) {WaitNextEvent}

$tick = 0;
$done = 0;
while (!$done) {
  ++$tick;
  SetPort $win->window;

  foreach $l (@loops) {
    RGBForeColor(new RGBColor(map {$_->{val}} @{$l->{col}}));
    MoveTo($l->{pts}[-1]{xp}, $l->{pts}[-1]{yp});

    foreach $p (@{$l->{pts}}) {
      if ($do_attract) {

        sub attraction {($_[0] / abs $_[0]) * $attract_div}

        my $nxdist = $p->{xp} - nextp($l, $p->{id})->{xp};
        my $nydist = $p->{yp} - nextp($l, $p->{id})->{yp};
        my $pxdist = $p->{xp} - prevp($l, $p->{id})->{xp};
        my $pydist = $p->{yp} - prevp($l, $p->{id})->{yp};

        if (abs $nxdist > $maxdist) {$p->{xv} -= attraction($nxdist)}
        if (abs $nydist > $maxdist) {$p->{yv} -= attraction($nydist)}
        if (abs $pxdist > $maxdist) {$p->{xv} -= attraction($pxdist)}
        if (abs $pydist > $maxdist) {$p->{yv} -= attraction($pydist)}
  
        if (abs $nxdist < $maxdist) {$p->{xv} += attraction($nxdist)}
        if (abs $nydist < $maxdist) {$p->{yv} += attraction($nydist)}
        if (abs $pxdist < $maxdist) {$p->{xv} += attraction($pxdist)}
        if (abs $pydist < $maxdist) {$p->{yv} += attraction($pydist)}

        for (@$p{'xv', 'yv'}) {
          $_ = $maxvel if $_ > $maxvel;
          $_ = -$maxvel if $_ < -$maxvel;
        }
      }

      $p->{xp} += $p->{xv};
      $p->{yp} += $p->{yv};
      if ($p->{xp} > $bw + $excess or $p->{xp} < 0 - $excess) {
        $p->{xv} *= -1;
      }
      if ($p->{yp} > $bh + $excess or $p->{yp} < 0 - $excess) {
        $p->{yv} *= -1;
      }

      #MoveTo($p->{xp}, $p->{yp});
      LineTo($p->{xp}, $p->{yp});
    }

    foreach $c (@{$l->{col}}) {
      $c->{val} += $c->{vel};
      if ($c->{val} > 65535 or $c->{val} < 0) {
        $c->{vel} *= -1;
        redo;
      }
    }
  }


  unless ($tick % $system_time) {
    WaitNextEvent;
  }
}

__END__

-- 
 Kevin Reid: |    Macintosh:      
  "I'm me."  | Think different.
    

==== Want to unsubscribe from this list?
==== Send mail with body "unsubscribe" to macperl-toolbox-request@macperl.org