view release on metacpan or  search on metacpan

lib/App/Physics/ParticleMotion.pm  view on Meta::CPAN

	#my $cloth = $top->Cloth;
	$cloth->configure( -scrollregion => [-10000, -10000, 10000, 10000] );
	$cloth->configure( -height => 600, -width => 800 );
	$cloth->pack( -fill => 'both', -expand => 1, -side => 'top' );
	$app->{cloth} = $cloth;
	
	# Math::Project3D is meant to project arbitrary functions. If we
	# want to project discrete data, we just use the current contents
	# of three variables as functions.
	$proj->new_function( 'x,y,z', '$x', '$y', '$z' );
	$app->{axis} = [];
	
	# Run the sub for the first time.
	_draw_axis($app);
	
	# Print starting coordinates to file if required
	if ( defined $out_file ) {
	    foreach my $p_no ( 0 .. $#particles ) {
	        my @proj = @y[ $dimensions * $p_no .. $dimensions * ( $p_no + 1 ) - 1 ];
	        push @proj, (0) x ( 3 - scalar(@proj) ) if @proj != 3;
    	    print( $out_filehandle ( $p_no + 1 ) . " 0 @proj\n" );
	    }
	}
	
	# Run the TK MainLoop
	MainLoop;
}


# main routine that doesn't end.
sub _draw {
	my $app = shift;
	$app->{started} = 0;
	
	my $trace = $app->{trace};
	my $cloth = $app->{cloth};
	my $epsilon = $app->{epsilon};
	my @functions = @{$app->{functions}};
	my @particles = @{$app->{particles}};
	my $particles = scalar @particles;
	my $dimensions = $app->{dimensions};
	my $out_file = $app->{out_file};
	my $out_filehandle = $app->{out_filehandle};
	my $displayscale = $app->{displayscale};
	my $time_warp = $app->{time_warp};
	my @y = @{$app->{y}};
	my $proj = $app->{proj};

	# Starting time and time steps. $dt will be adjusted by the integrator
	my $t = 0;
	my $dt = 0.1;

    # @prevlines holds line objects from the previous iterations.
    my @prevlines = ();

    # Previous values for line drawing
    my @prev_x = ();
    my @prev_y = ();

    # Start time of the simulation for speed adjustment on fast systems
    my $timeref = time();

    # main loop
    while (1) {

        # Delete old lines if we don't want to keep traces.
        # Change their color otherwise
        if ( not $trace ) {
            $cloth->delete($_) foreach @prevlines;
            @prevlines = ();
        }
        else {
            $_->configure( -state => 'disabled' ) foreach @prevlines;

            # Won't have to keep the objects around for modification:
            @prevlines = ();
        }

        # Integrate the next step. (I'm open for speed improvements!)
        ( $t, $dt, @y ) = Math::RungeKutta::rk4_auto(
            \@y,
            sub {
                my $t    = shift;
                my @dydt = @_[ @_ / 2 .. $#_ ];
                foreach ( 0 .. $#functions ) {
                    push @dydt, $functions[$_]->( $t, @_ );
                }
                return @dydt;
            },
            $t,
            $dt,
            $epsilon
        );

        # Project and draw
        foreach my $p_no ( 0 .. $particles - 1 ) {
            my @proj =
              @y[ $dimensions * $p_no .. $dimensions * ( $p_no + 1 ) - 1 ];
            push @proj, (0) x ( 3 - scalar(@proj) ) if @proj != 3;

            # File output
            print( $out_filehandle ( $p_no + 1 ) . " $t @proj\n" )
              if defined $out_file;

            my ( $x, $y ) = $proj->project(@proj);

            if ( defined $prev_x[$p_no] ) {
                my $coords =
                  [ _transform( $app, $prev_x[$p_no], $prev_y[$p_no], $x, $y ) ];
                @$coords = map { int $_ } @$coords;
                $coords->[2] -= 1 while abs( $coords->[0] - $coords->[2] ) < 1;
                $coords->[3] -= 1 while abs( $coords->[1] - $coords->[3] ) < 1;

                my $line = $cloth->Line(
                    -coords       => $coords,
                    -fill         => $particles[$p_no]{color},
                    -disabledfill => $particles[$p_no]{colort},
                );
                push @prevlines, $line;    # if not $trace;
            }
            $prev_x[$p_no] = $x;
	        $prev_y[$p_no] = $y;
        }

        # Speed control.
        DoOneEvent(DONT_WAIT);
        my $endtime = $timeref + $t / $time_warp;
        while ( $endtime > time() ) {
            sleep(0.01);
            DoOneEvent(DONT_WAIT);
        }
    }
}





# transform calculates the window coordinates from the
# relative coordinates of the projected plane
sub _transform {
	my $app = shift;
	my $cloth = $app->{cloth};
	my $displayscale = $app->{displayscale};
    my $y_max_half = $cloth->cget('-height') / 2;
    my $x_max_half = $cloth->cget('-width') / 2;
    my @res;
    while (@_) {
        push @res, $x_max_half + shift(@_) * $displayscale,
          $y_max_half - shift(@_) * $displayscale;
    }
    return @res;
}

# draw_axis draws the n axis' as Tk::Cloth::Line objects.
sub _draw_axis {
	my $app = shift;
	my $axis = $app->{axis};
	my $proj = $app->{proj};
	my $dimensions = $app->{dimensions};
	my $axiscolor = $app->{axiscolor};
	my $cloth = $app->{cloth};
	my $displayscale = $app->{displayscale};
    my $max = 20000;
    $_->delete() foreach @$axis;
    foreach my $dim ( 0 .. $dimensions - 1 ) {
        my ( $x1, $y1 ) =
        	$proj->project( map { $_ == $dim ? -$max / $displayscale : 0 }
             0 .. 2 );
        my ( $x2, $y2 ) =
        	$proj->project( map { $_ == $dim ? $max / $displayscale : 0 }
             0 .. 2 );
		push @$axis,
	        $cloth->Line(
              -coords => [ _transform( $app, $x1, $y1, $x2, $y2 ) ],
              -fill   => $axiscolor,
        	);
    }
}


1;
__END__

=head1 NAME

App::Physics::ParticleMotion - Simulations from Differential Equations