Well i'm getting closer to my bridge building ideal! Lol. Slowly. Below is the current code I'm using, right click places an imovable point (foundation), middle click creates regular joints, then left click to join the nodes together. Once your ready click start and see how your creation fairs. Nothing is scaled or proportioned correctly and i'm having a heck of a time getting it there. I think i might need to add some form of rotational friction too to give joints the tendency to keep there current form. Hopefully someone eles will be interested and enjoy it.

use strict;
use warnings;

use Tk;
use Tk::WorldCanvas;
use Tk::LabEntry;

use Physics::Springs::Friction;

my $spring_start = undef;    
my $size         =   8;
my $paused       =   1;
my $mass         =  10;
my $k            =   4;
my $sim = Physics::Springs::Friction->new();
$sim->add_friction('stokes', 10);
$sim->add_friction('$F->[1]=-75;',);


use Data::Dumper;

my $mw           = MainWindow->new();
my $menu_bar     = $mw->Frame(-relief => 'groove', -borderwidth =>1
                             )->pack(-side=>'top', -fill => 'x');
my $display_area = $mw->Frame()->pack(-side=>'top',-fill=>'x');
my $worldcanvas  = $display_area->WorldCanvas(-width=>400,-height=>400
+);
                             
$menu_bar->Button(-text=>'Start', -command => sub { $paused = 0; })->p
+ack(-side=>'left');
$menu_bar->Button(-text=>'Pause')->pack(-side=>'left');
$menu_bar->Button(-text    => 'Reset',
                  -command => sub { $sim->clear_particles;
                                    $sim->{_PhSprings_springs} = [];
                                    $sim->{FFORCES} = [];
                                    $spring_start = undef;
                                    $worldcanvas->delete('all'); },

                 )->pack(-side=>'left');
$menu_bar->LabEntry(-label=>'Mass'    , -textvariable=>\$mass)->pack(-
+side=>'left');
$menu_bar->LabEntry(-label=>'Sprink K', -textvariable=>\$k)->pack(-sid
+e=>'left');


my $i = 1;
$worldcanvas->configure(-bandColor => 'purple');
$worldcanvas->CanvasBind('<3>'               => sub {$worldcanvas->Can
+vasFocus;
                                                     $worldcanvas->rub
+berBand(0)
                                                    });

my $s_start; 
$worldcanvas->CanvasBind('<1>' =>
    sub {
        # restore old nodes back to previous selection
        $worldcanvas->itemconfigure('selected',-width=>1);
        $worldcanvas->dtag('selected');
        
        $worldcanvas->addtag('selected', withtag=>'current');
        my @tags = $worldcanvas->itemcget('selected', '-tags');
        my $temp;  #temp spot to sitck new selection
        for (@tags) {
            if( $_ =~ /node_(\d+)/) {
               $temp = $1 
            }
        }
        if (defined $temp) {
            print "Selected '$temp'\n";
            #we just selected something.
            if (!defined $s_start) {
                $s_start = $temp;
            } else {
                $sim->add_spring(k=>$k,p1=>$s_start, p2=>$temp, l=>und
+ef) unless $temp == $s_start;
                $s_start = $temp;
            }
        } else {
            $s_start = undef;
        }
        $worldcanvas->itemconfigure('selected',-width=>3);
        $worldcanvas->raise('node');
        
    }
);
$worldcanvas->CanvasBind('<2>' =>
    sub {
        my ($x,$y) = $worldcanvas->eventLocation;
        
        my $spring_end = $sim->add_particle( x=> $x, y=> $y, z=>0, xv 
+=> 1, yv => 0, m=>$mass);
        my $name = "node_" . $spring_end;
        $worldcanvas->createOval( $x-$size,$y-$size,$x+$size,$y+$size,
+ -fill=>'red', -tag=> ['node',$name]);
        print "Inserting at $name ($x,$y)\n";
        
        #$worldcanvas->update();
        $worldcanvas->raise('node');
        $spring_start = $spring_end;
    }
);

$worldcanvas->CanvasBind('<3>' =>
    sub {
        my ($x,$y) = $worldcanvas->eventLocation;
        
        my $spring_end = $sim->add_particle( x=> $x, y=> $y, z=>0, xv 
+=> 1, yv => 0, m=>10_000_000);
        my $name = "node_" . $spring_end;
        $worldcanvas->createOval( $x-$size,$y-$size,$x+$size,$y+$size,
+ -fill=>'yellow', -tag=> ['node',$name]);
        print "Inserting at $name ($x,$y)\n";
        
        #$worldcanvas->update();
        $worldcanvas->raise('node');
        $spring_start = $spring_end;
    }
);

$worldcanvas->CanvasBind('<Up>' => sub {$worldcanvas->rubberBand(1);})
+;
$worldcanvas->CanvasBind('<Down>' => sub {$worldcanvas->rubberBand(1);
+});
$worldcanvas->CanvasBind('<Left>' => sub {$worldcanvas->rubberBand(1);
+});
$worldcanvas->CanvasBind('<Right>' => sub {$worldcanvas->rubberBand(1)
+;});
$worldcanvas->CanvasBind('<i>' => sub {$worldcanvas->zoom(1.25); $worl
+dcanvas->rubberBand(1);});
$worldcanvas->CanvasBind('<o>' => sub {$worldcanvas->zoom(0.8);  $worl
+dcanvas->rubberBand(1);});
$worldcanvas->pack();
$worldcanvas->CanvasFocus;
$worldcanvas->repeat(100, 
        sub {
            $sim->iterate_step(1) unless $paused;
            foreach my $i (0.. scalar @{ $sim->{p} }-1) {
                my $p = $sim->{p}[$i];
                $worldcanvas->coords("node_$i",  $p->{x} - $size , $p-
+>{y} - $size, $p->{x} + $size , $p->{y} + $size );
            }
            foreach my $spring (@{$sim->{_PhSprings_springs}}) {
                my $p1 = $sim->{p}[$spring->{p1}];
                my $p2 = $sim->{p}[$spring->{p2}];
                my $spring_name = 'spring_' . $spring;
                if ($worldcanvas->find('withtag',$spring_name)) {
                    $worldcanvas->coords($spring_name, $p1->{x}, $p1->
+{y}, $p2->{x}, $p2->{y});
                    #print "$spring_name ", $spring->{strech}, "\n";
                } else {
                    $worldcanvas->createLine($p1->{x}, $p1->{y}, $p2->
+{x}, $p2->{y}, -tag=>$spring_name);
                }
            }        
                
        });
        

MainLoop;
[download]