#!/usr/bin/perl -w
#
# Displays marbles dropping onto pegs, and bouncing either left or ri
+ght
# at random, to create a bell-shaped curve.
#
# September, 2005 -- by jcn
#
+
##############
### Strict ###
##############
use strict;
use warnings;
+
+
####################
### User-defined ###
####################
+
# Version
my $version = "v1.0 (050908 by jcn)";
+
# Canvas
my $cvcolor = 'peachpuff'; # Canvas background color
+
# Chute
my $chute_dx = 32; # Distance between chute 'posts'
my $chute_dy = 12; # Distance from top of chute to bottom
my $chute_width = 4; # Thickness of each chute 'post'
+
# Pegs
my $npegs = 8; # Number of rows of pegs
my $chute_peg_d = 48; # Distance from chute bottom to first peg
+top
my $peg_dx = 32; # Difference between any 2 cols of pegs
my $peg_dy = 40; # Difference between any 2 rows of pegs
my $peg_r = 3; # Radius of a single peg
+
# Bins
my $peg_bin_d = 8; # Distance from last peg bottom to bin top
my $bin_dy = 128; # Height of a single bin
my $bin_width = 1; # Thickness of each bin 'wall'
+
# Marbles
my $marble_r = 12; # Radius of a single marble
my $marble_delay = 50; # Speed of a marble
my $marble_latency = 4; # Number of ticks between marble drops
+
+
############################
### Calculated variables ###
############################
+
# Bins
my $nbins = ($npegs + 1);
+
# Canvas dimensions
my $cw = 2 * $nbins * $peg_dx;
my $ch = $chute_dy+$chute_peg_d + ($npegs-1) * $peg_dy + $peg_bin_d +
+$bin_dy;
+
# Marbles
my $marble_x = $cw / 2;
my $marble_y = $marble_r;
+
# Bins
my $bin_x = ($cw / 2) - ($peg_dx * ($npegs - 1));
my $bin_y = $ch - $bin_dy;
my $bin_dx = (2 * $peg_dx);
+
# Pegs
my $peg_x = int($cw / 2);
my $peg_y = $chute_dy + $chute_peg_d;
#################
### Libraries ###
#################
use Data::Dumper;
use Tk;
+
+
##################
### Prototypes ###
##################
sub create_gui();
sub init_velocity_vector();
sub update_bin_count($$);
sub fill_bin($$$);
+
+
###############
### Globals ###
###############
my $mw = 0; # Main window object
my @bin_count; # Bin statistics
my @bin_color; # Color of each bin
my @bin_fill; # Fill-color in bin
my @bin_text; # Bin statistic text
my @vvector; # Velocity vector
my $cv_marbles = 0; # Canvas object
my $nm_id = 0; # ID of text for showing total marbles
+
+
####################
### Main program ###
####################
create_gui;
###################
### Subroutines ###
###################
+
#####################
### Marble object ###
#####################
BEGIN {
my $nmarbles = 0; # Total marbles dropped
my %marbles; # Hash for holding individual marbles
+
my $drop_ticks = $marble_latency;
+
sub array_of_half_steps($$) {
my ($ydist, $up_bounce) = @_;
my @steps;
while (1) {
my $nexty = int($ydist / 2);
last unless ($nexty > 1);
if ($up_bounce) {
push @steps, - $nexty;
} else {
unshift @steps, $nexty;
}
$ydist -= $nexty;
}
($ydist > 0) and $steps[0] += $ydist;
return \@steps;
}
+
sub init_velocity_vector() {
my @tmp0;
my $marble_dy = $peg_y - $marble_y - $marble_r - $peg_r / 2;
my $marble_dx = $peg_dx;
my ($pxlist, $pylist, $pdown);
+
$pylist = array_of_half_steps($marble_dy, 0);
map { push @vvector, [ 0, $_ ] } (@$pylist);
+
my $up_dy = int($marble_dy / 2);
$pylist = array_of_half_steps($up_dy, 1);
$pdown = array_of_half_steps($up_dy + $marble_dy, 0);
push @$pylist, @$pdown;
my $nsteps = @$pylist;
my $xinc = int($marble_dx / $nsteps);
my $xextra = $marble_dx - ($nsteps * $xinc);
for (my $i = 0; $i < $nsteps; $i++) {
push @$pxlist, $xinc + (($xextra > 0)? 1: 0);
$xextra--;
}
+
for (my $j = 0; $j < $npegs; $j++) {
push @vvector, 0;
for (my $i = 0; $i < @$pylist; $i++) {
my ($x, $y) = ($pxlist->[$i], $pylist->[$i]);
push @vvector, [ $x, $y ];
}
}
+
my $plast = $vvector[-1];
my ($lastx, $lasty) = ($plast->[0], $plast->[1]);
+
my $bottom_y = $peg_y + ($peg_dy * $npegs);
while ($bottom_y - 2 * $marble_r < $ch) {
push @vvector, [ 0, $lasty *= 2 ];
$bottom_y += $lasty;
}
push @vvector, 0;
}
sub draw_marble($$$) {
my ($x, $y, $c) = @_;
my $ra = $marble_r;
&draw_circle($x-$ra, $y-$ra, $x+$ra, $y+$ra, $c);
}
+
sub new_marble($$$) {
my ($x, $y, $color) = @_;
my $idx = $nmarbles++;
my $old_id = $nm_id;
my $text = sprintf "Marbles: %d", $nmarbles;
$nm_id = $cv_marbles->createText(64, 10, -text => $text);
$old_id and $cv_marbles->delete($old_id);
my $id = draw_marble($x, $y, $color);
my $pmarble = {
'dir' => 1, # Bounce direction (-1 or
+1)
'idx' => $idx, # Index of this marble
'id' => $id, # This marble's id in the
+canvas
'nticks' => 0, # Number of total ticks
'nbounces' => 0, # Number of bounces (on pe
+gs)
'nleft' => 0, # Number of left-bounces
'color' => $color, # Marble color
};
}
+
sub random_color() {
my $r = int rand 256;
my $g = int rand 256;
my $b = int rand 256;
my $color = sprintf "#%02x%02x%02x", $r, $g, $b;
}
+
sub drop_marble() {
my $mx = $marble_x;
my $my = $marble_y;
my $c = random_color;
my $pm = new_marble($mx, $my, $c);
$marbles{$pm->{'idx'}} = $pm;
}
sub move_marble($$$) {
my ($id, $deltax, $deltay) = @_;
$cv_marbles->move($id, $deltax, $deltay);
}
+
sub manage_this_marble($) {
my ($pm) = @_;
my $idx = $pm->{'idx'};
my $id = $pm->{'id'};
my $nticks = $pm->{'nticks'}++;
my $pvec = $vvector[$nticks];
if (!$pvec) {
(++$pm->{'nbounces'} > $npegs) and return 0;
$pm->{'dir'} = (0 == (int(rand(9999)) % 2))? -1: 1;
($pm->{'dir'} < 0) and $pm->{'nleft'}++;
$nticks = $pm->{'nticks'}++;
$pvec = $vvector[$nticks];
}
my $dir = $pm->{'dir'};
my ($dx, $dy) = ($dir * $pvec->[0], $pvec->[1]);
&move_marble($id, $dx, $dy);
return 1;
}
+
sub manage_marbles() {
my @marbles = sort { $a <=> $b } keys %marbles;
for (my $i = 0; $i < @marbles; $i++) {
my $idx = $marbles[$i];
my $pm = $marbles{$idx};
if (!manage_this_marble($pm)) {
$cv_marbles->delete($pm->{'id'});
my $bin_idx = $npegs - $pm->{'nleft'};
my $count = ++$bin_count[$bin_idx];
update_bin_count($bin_idx, $count);
if ($count < $bin_dy) {
fill_bin($bin_idx, $count, $pm->{'color'});
} else {
for (my $i = 0; $i < $nbins; $i++) {
$bin_count[$i] /= 2;
fill_bin($i, $bin_count[$i], $bin_color[$i]);
}
}
delete $marbles{$idx};
}
}
}
+
sub time_passes() {
if (++$drop_ticks >= $marble_latency) {
$drop_ticks = 0;
drop_marble;
}
+
manage_marbles;
}
}
+
+
##################
### GUI object ###
##################
BEGIN {
my $stats_cv = 0; # Statistics canvas
+
sub draw_circle($$$$$) {
my ($x0, $y0, $x1, $y1, $color) = @_;
$cv_marbles->createOval($x0, $y0, $x1, $y1, -fill => $color);
}
+
sub draw_peg($$) {
my ($x, $y) = @_;
my $ra = $peg_r;
my @opts = (-fill => 'black');
$cv_marbles->createOval($x-$ra, $y-$ra, $x+$ra, $y+$ra, @opts)
+;
}
+
sub draw_pegs() {
my $n_pegs_in_row = 1;
my $x0 = $peg_x;
my $y0 = $peg_y;
for (my $i = 0; $i < $npegs; $i++) {
my ($x1, $y1) = ($x0, $y0);
for (my $n = 0; $n < $n_pegs_in_row; $n++) {
draw_peg($x1, $y1);
$x1 += 2 * $peg_dx;
}
$y0 += $peg_dy;
$x0 -= $peg_dx;
++$n_pegs_in_row;
}
}
+
sub draw_chute() {
my ($x0, $x1) = (($cw - $chute_dx) / 2, ($cw + $chute_dx) / 2)
+;
my ($y0, $y1) = (0, $chute_dy);
$cv_marbles->createLine($x0, $y0, $x0, $y1, -width => $chute_w
+idth);
$cv_marbles->createLine($x1, $y0, $x1, $y1, -width => $chute_w
+idth);
}
+
sub fill_bin($$$) {
my ($idx, $count, $color) = @_;
my $old_idx = $bin_fill[$idx];
my $x0 = $idx * $bin_x + 1;
my $x1 = $x0 + $bin_x - 2;
my $y0 = $ch - $count;
my $y1 = $ch;
my @opts = (-fill => $color);
my $id = $cv_marbles->createRectangle($x0, $y0, $x1, $y1, @opt
+s);
$bin_fill[$idx] = $id;
$bin_color[$idx] = $color;
$old_idx and $cv_marbles->delete($old_idx);
}
sub update_bin_count($$) {
my ($idx, $count) = @_;
my $old_idx = $bin_text[$idx];
my $text = sprintf "%d", $count;
my $x = ($idx + 1) * $bin_x - 32;
$bin_text[$idx] = $stats_cv->createText($x, 10, -text => $text
+);
$old_idx and $stats_cv->delete($old_idx);
}
+
sub draw_bins() {
my ($x0, $y0, $y1) = ($bin_x, $bin_y, $ch);
for (my $i = 0; $i < $nbins; $i++) {
$cv_marbles->createLine($x0, $y0, $x0, $y1, -width => $bin
+_width);
$x0 += $bin_dx;
$bin_count[$i] = 0;
$bin_text[$i] = 0;
$bin_fill[$i] = 0;
update_bin_count($i, 0);
}
}
+
sub draw_framework() {
draw_chute;
draw_pegs;
draw_bins;
}
sub create_gui() {
$mw = new MainWindow(-title => "Marbles $version");
$mw->minsize($cw, 50 + $ch);
$mw->maxsize($cw, 50 + $ch);
my $f0 = $mw->Frame->pack(-fill => 'x');
my $f1 = $f0->Frame->pack(-fill => 'x');
my $f2 = $f0->Frame->pack(-fill => 'x');
my $f3 = $f0->Frame->pack(-fill => 'x');
my $b1 = $f1->Button(-text => 'Exit (esc)', -bg => 'green');
$b1->configure(-command => sub { exit });
$b1->pack(-side => 'right');
$mw->bind("<Escape>", sub { $b1->invoke });
my @opts = (-height => $ch, -bg => $cvcolor);
$cv_marbles = $f2->Canvas(-width => $cw, @opts);
$cv_marbles->pack();
$stats_cv = $f3->Canvas(-bg => $cvcolor);
$stats_cv->pack(-fill => 'x');
$mw->repeat($marble_delay, \&time_passes);
draw_framework();
init_velocity_vector;
MainLoop;
}
}
|