#!/usr/bin/perl # fische.pl - kleines Testprogramm fuer Bewegungen im Tk::Canvas # # dubu -at- perl-community.de   06-Sep-2003 use strict; use warnings; use Tk; use Time::HiRes; my $FischZahl = 100; my $CanvasWidth = 400; my $CanvasHeight = 300; my $FischRadius = 3; # MainWindow und Canvas anlegen my $Mw = MainWindow->new (-title => 'Fische'); my $Canvas = $Mw->Canvas (-width => $CanvasWidth,    -height => $CanvasHeight, )->pack; # Fische anlegen my @Fische; for (1 .. $FischZahl) {    # Startposition    my $x = int (rand $CanvasWidth);    my $y = int (rand $CanvasHeight);    # Delta-Bewegungen (+1/0/-1 Pixel)    my ($dx, $dy);    do {        $dx = int(rand 3) - 1;        $dy = int(rand 3) - 1;    } while $dx == 0 && $dy == 0; # nicht stillstehen!    # Farbe des Fisches    my $color = '#' . sprintf ("%06X", int rand 0x1000000);    # Neuen Fisch im Canvas anlegen    my $item = $Canvas->createOval (        $x-$FischRadius, $y-$FischRadius,        $x+$FischRadius, $y+$FischRadius,        -fill => $color,    );    # Neuen Fisch merken    push @Fische, {        x => $x,        y => $y,        dx => $dx,        dy => $dy,        item => $item,    }; } # Zaehler und Zeit zuruecksetzen my $cnt = 0; my $time = Time::HiRes::time(); # Fische schwimmen lassen :-) while (1) {    for (@Fische) {        $Canvas->move ($_->{item}, $_->{dx}, $_->{dy});        # Position mitfuehren (schneller als aus Canvas)        $_->{x} += $_->{dx};        $_->{y} += $_->{dy};        # Am Rand Bewegung umkehren        $_->{dx} = -$_->{dx} if $_->{x} < 0 || $_->{x} > $CanvasWidth;        $_->{dy} = -$_->{dy} if $_->{y} < 0 || $_->{y} > $CanvasHeight;    }    # Grafik-Update "manuell" durchfuehren    $Mw->update;    # Alle 500 Schritte Geschwindigkeit ausrechnen    ++$cnt;    if ($cnt == 500) {        my $newtime = Time::HiRes::time();        printf "%5d fps\n", $cnt/($newtime-$time);        $time = $newtime;        $cnt = 0;    } } # ENDE