Re: [MacPerl] Volve

[ajf@afco.demon.co.uk (Alan Fry)]

Re: kpreid@ibm.net (Kevin Reid) 4 Dec 1998 00:47:39 -0500

Fun, fun, fun!

The window doesn't update properly though when covered and uncovered.
Windows.pm calls an EraseRect() for the update region which just blacks out
the area because there is no 'redraw' procedure available to it.

The problem can be resolved by creating and storing the image offscreen. On
update the stored pixmap can be transferred to the window en bloc.

It makes such a nice example of the advantage (sometimes) of offscreen
drawing I hope Kevin will forgive me for tinkering with his script. I hope
it is of some interest and not too long for anyone.

Alan Fry

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

#!perl -w

# Volve v1.0
# by Kevin Reid <kpreid@ibm.net>
#
# Slowly changing colors.
#
# This program may be freely distributed, and you may
# use code from it, as long as my name stays on it.

# Revision history
#
# 1.0
#   First release.
# Offscreen version Alan Fry <ajf@afco.demon.co.uk> 05-Dec-1998
# 19-May-98 versions of QuickDraw and QDOffscreen necessary

use Mac::Windows;
use Mac::QuickDraw;
use Mac::QDOffscreen;
use Mac::Events;
use strict;

my (@set, $wrect, $junkrgn, $win_r, $win, $ptr, $time);
my ($offP, $offD, $gWorld, $srce, $dest, $origP, $origD, $pixMap);

# Try changing these:
sub Width ()      {100}     # width of window
sub Height ()     {200}     # height of window
sub WobbleAmp ()  {2}       # horizontal wobble parameters
sub WobbleFreq () {1}
sub Scroll ()     {-1}      # scroll speed and direction

sub CThird () {65535 / 3}
sub DrawPos () {Scroll < 0 ? Height - 1 : 0}

@set = (0) x Width;
$wrect = new Rect (0, 0, Width, Height);  # rectangle to scroll
$junkrgn = NewRgn;                        # dummy for ScrollRect

$win_r = ltwh(200, 150, Width, Height);
$win = new MacColorWindow ($win_r, "Volve", 1, 4, 1);
$ptr = $win->window;
$win->sethook(drawgrowicon => sub {});
$win->sethook('redraw', \&transfer);

set_gWorld();

while ($win->window) {
    WaitNextEvent;
    $time++;
    change_colours();
    plot_points();
}

sub change_colours {
    my ($d);
    for ($d = 1; $d < Width - 1; $d++) {
        my $avg = ($set[$d-1] + $set[$d] + $set[$d+1]) / 3;
        my $diff = $avg - $set[$d];
        my $change = $diff * .4 + (rand > .995 ? (rand() - .5) * 40 : 0);
        $set[$d] += $change;
    }
}

sub plot_points {
    my ($d);
    SetGWorld($offP, $offD);
    ScrollRect($wrect, sin($time / WobbleFreq) * WobbleAmp, Scroll, $junkrgn);
    for ($d = 0; $d < Width; $d++) {
        my $cv = $set[$d] * 6553;
        SetCPixel $d, DrawPos, new RGBColor (
            ($cv) % 65535,
            ($cv + CThird) % 65535,
            ($cv + CThird*2) % 65535,
       );
    }
    restore_gWorld();
}

sub transfer {
    CopyBits($gWorld->portBits, $ptr->portBits, $srce, $dest, 0);
}

sub set_gWorld {
    ($origP, $origD) = GetGWorld();
    $gWorld = NewGWorld(0, $ptr->portRect);
    SetGWorld($gWorld);
    ($offP, $offD) = GetGWorld();
    $pixMap = GetGWorldPixMap($gWorld);
    LockPixels($pixMap);
    RGBBackColor(new RGBColor(0,0,0)); # set black background
    EraseRect($gWorld->portRect)
}

sub restore_gWorld {
    SetGWorld($origP, $origD);
    SetPort $ptr;
    $srce = $gWorld->portRect;
    $dest = $ptr->portRect;
    $win->redraw;
}

sub ltwh {
    new Rect ($_[0], $_[1], $_[0] + $_[2], $_[1] + $_[3])
    # for specifying rectangles as left, top, width, height
}

END {
   $win->dispose          if defined $win;
   UnlockPixels($pixMap)  if defined $pixMap;
   DisposeGWorld($gWorld) if defined $gWorld;
   DisposeRgn $junkrgn;
}

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-



***** Want to unsubscribe from this list?
***** Send mail with body "unsubscribe" to mac-perl-request@iis.ee.ethz.ch