view release on metacpan or  search on metacpan

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

	    -command => sub {
	        # Only start if we haven't done so before
	        _draw($app) if $app->{started} == 0;
	    }
	);
	$button->pack( -fill => 'x', -expand => 0, -side => 'top' );
	
	my $cloth = $top->Scrolled('Cloth', -scrollbars => 'se');
	#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;