Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
In addition to the Tk suggestion, I would add "use Zinc". Zinc will give you full control over rotations and positional data, and is quite easy to make your robots "objects". Here is a little object "bubbler" that I play with to hone my OO skills with Zinc. You could easily make the "bubbles" into "robots". I make 100 reusable objects, and when they go "off screen", I make them available for reuse. The memory will increase up till the first 100 bubbles are created, then memory increase stops.
#!/usr/bin/perl use Tk; use Tk::Zinc; # there is a penalty for creating objects, a slight overhead # so if you are going to create alot of objects, you must # reuse them....this reconfigures and reuses the bubble objects my $mw = MainWindow->new; $mw->geometry("700x600"); $mw->resizable(0,0); my $launcher; my $zinc = $mw->Zinc(-width => 700, -height => 565, -backcolor => 'black', -borderwidth => 3, -relief => 'sunken')->pack(); #my $zwidth = $zinc->reqwidth; #my $zheight = $zinc->reqheight; #print "$zheight $zwidth\n"; # Then we create a filled rectangle, in which we will display explain +text. $zinc->add('rectangle', 1 , [200, 400, 490, 490], -linewidth => 2, -filled => 1, -fillcolor => 'SkyBlue', -priority => 1, ); my $text = $zinc->add('text', 1, -position => [350, 445], -anchor => 'center', -priority => 3, -width => 200, ); #####setup 100 bubble objects for reuse############################# my %bubs; #reusable object space my @bubjects = (1..100); my @x = (1,-2,3,-4,5, -1,2,-3,4,-5 ); #give random diagonal motion my $count = 0; foreach my $bub (@bubjects){ $count++; $tag = $count; push (@x,shift(@x)); $afterdelay = 1 + int(rand(99)); # Create the 100 ztkbubble object (see Package ztkbubble below) $bubs{$bub} = ZtkBubble->new( -widget => $zinc, -name => $count, -bub => $bub, -tags => $tag, -x => rand 700, -y => 700, -radius => 10 + rand(30), -color => 'green', -dx => $x[0], -dy => -20, -afterdelay => $afterdelay, ); } ########################################################### # Display comment &comment("Strike any key to begin"); # Create Tk binding $mw->Tk::bind('<Key>', \&openmode); my $closebutton = $mw->Button(-text => 'Exit', -command => sub{ if(defined $launcher){$launcher->cancel}; exit(0); })->pack; MainLoop; ##################################################### sub openmode { $mw->Tk::bind('<Key>', \&closemode); &comment("Bubbling!!"); # 50 is about my max on a 800 Mhz K6, adjust accordingly $launcher = $mw->repeat(100,sub{ my $bub = shift @bubjects; $bubs{$bub}->bubble_move(); }); } sub closemode { # and then inform user &comment("We are bubbling baby !!"); } # Just display comment sub comment { my $string = shift; $zinc->itemconfigure($text, -text => $string); } #===================================================================== +======== # Bubble Class #===================================================================== +======== package ZtkBubble; use strict 'vars'; use Carp; #==================== # Object constructor #==================== sub new { my ($class, %arg) = @_; # object attributes my $self = { 'widget' => $arg{-widget}, # widget reference into which +it goes 'name' => $arg{-name}, #identifying name 'bub' => $arg{-bub}, #which reusable bubble space i +t's using 'tags' => $arg{-tags}, # tag object of self 'x' => $arg{-x}, 'y' => $arg{-y}, # origin coordinates 'radius' => $arg{-radius}, # radius 'color' => $arg{-color}, # top Group item 'dx' => $arg{-dx}, # initial x direction 'dy' => $arg{-dy}, # initial y direction 'afterdelay' => $arg{-afterdelay}, # repeater time delay + }; bless $self; # print "just blessed $self\n"; $self->{topgroup} = $self->{widget}->add('group', 1, -priority => 2, -visible => 1); $self->{widget}->coords($self->{topgroup}, [$self->{x},$self->{y}] +); $self->{timer}; #declare variable to store internal timer $self->{'init'} = $self->{widget}->tget( $self->{topgroup} ); # print join ' ',@{ $self->{init} },"\n"; #initial position my $color1 = '#'; for (0 .. 2){ my $rgb = unpack('H*', pack('n', (int(rand(192)+64)))); $rgb =~ s/.+(\w\w)$/$1/; $color1 .= $rgb; } #add items to self group $self->{arc1} = $self->{widget}->add('arc', $self->{topgroup}, [-$self->{radius}, -$self->{radius}, $self->{radi +us}, $self->{radius}], -visible => 1, -filled => 1, -closed => 1, -extent => 360, -pieslice => 1, -fillcolor => $color1, -linewidth => 1, -startangle => 0 , -tags => [$self->{tags},'bubble'], ); $self->{arc2} = $self->{widget}->add('arc', $self->{topgroup}, [-$self->{radius}/2, -$self->{radius}/2, $self->{ +radius}/2, $self->{radius}/2], -visible => 1, -filled => 1, -closed => 1, -extent => 360, -pieslice => 1, -fillcolor => $self->{color}, -linewidth => 1, -startangle => 0 , -tags => [$self,'bubble'], ); # Create the Text item representing the identifier. $self->{txt} = $self->{widget}->add('text', $self->{topgroup}, -position => [0, 0], -anchor => 'center', -text => $self->{'name'}, ); $self->{line} = $self->{widget}->add('curve', $self->{topgroup}, [-$self->{radius}, -$self->{radius},$self->{radiu +s}, $self->{radius}], -visible => 1, -linecolor => 'white', -linewidth => 3, -tags => [$self,'bubble'], ); return $self; } ############################################# sub DESTROY{ my ($self) = @_; print "destroying->",$self,' ', $self->{bub}. "\n"; } ########################################### #================ # Public methods #================ # Start motion of $self sub bubble_move { my $self = shift; $self->_move(); } #================= # Private methods #================= sub _close { my ($self) = @_; my $widget = $self->{widget}; my $group = $self->{topgroup}; my $name = $self->{name}; my $bub = $self->{bub}; my $tag = $self->{tags}; &main::comment("Poof!! name->$name bub#->$bub"); $widget->dtag($tag); $self->{timer}->cancel; push @bubjects, $self->{bub}; #return to pool # $self->DESTROY; #don't use this, since we are reusing them } # Generate motion and rotation animation. sub _move { my ($self) = @_; my $widget = $self->{widget}; my $group = $self->{topgroup}; $widget->translate($group, $self->{'dx'} ,$self->{'dy'}); $self->{x} += $self->{'dx'}; $self->{y} += $self->{'dy'}; #check for side collisions if( ( $self->{x} < 0) or ($self->{x} > $self->{widget}->reqwidth ) +) { $self->{'dx'} *= -2 } #reset bubbles for next run with new name if($self->{y} < -$self->{radius}){ $self->_close(); $self->{widget}->tset( $self->{topgroup} , @{ $self->{ini +t} } ); # print join ' ',@{ $self->{init} },"\n"; $self->{x} = ${ $self->{init} }[4]; $self->{y} = ${ $self->{init} }[5]; # $self->{widget}->coords($self->{topgroup}, [$self->{x}, +$self->{y}]); $self->{name} = $count++; $self->{widget}->itemconfigure($self->{txt}, -text => $se +lf->{'name'} ); return } $widget->rotate($group,.9,$self->{x},$self->{y} ); #use $self->timer instead of anonymous timer, in order to cancel on cl +ose $self->{timer} = $widget->after($self->{afterdelay}, sub { $self->_mov +e() }); } 1;

I'm not really a human, but I play one on earth. flash japh

In reply to Re: Does there exist a simple graphics library that works on Win32? by zentara
in thread Does there exist a simple graphics library that works on Win32? by jryan

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others musing on the Monastery: (4)
As of 2024-03-29 07:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found