Tcl/Tk  Prof. Dr. Uwe Schmidt FH Wedel
zurück
Inhaltsverzeichnis

Die Datei: collidingBalls.tcl

weiter
#!/bin/sh
# the next line restarts using wish (anywhere in search path) \
exec wish "$0" "$@"
#
# Colliding Balls
# Author: David Easton
# mods by Jeff Hobbs just to brace expr's (improve speed)
# and clean up some foreach usage
#
package require Tk
#
# Return an entry from the list at random
#
proc randFromList {inputList} {
return [lindex $inputList [expr {int(rand() * [llength $inputList])}]]
}
#
# Given the initial velocities and masses
# calculates velocities following a collision
#
proc postColVels { u1 u2 m1 m2 } {
# No collision if u2 > u1
if { $u2 > $u1 } {
return [list $u1 $u2]
}
set u1 [expr {1.0 * $u1}]
set u2 [expr {1.0 * $u2}]
set m1 [expr {1.0 * $m1}]
set m2 [expr {1.0 * $m2}]
set M [expr {$m1 / $m2}]
set b [expr {($M * $u1) + $u2}]
set c [expr {($M * $u1 * $u1) + ($u2 * $u2)}]
set q [expr {2 * $M * $b}]
set p [expr {4 * $M * $M * $b * $b}]
set r [expr {4 * ($M + ($M * $M)) * (($b * $b) - $c)}]
set s [expr {2 * ($M + ($M * $M))}]
if { $r > $p } {
"No solution"
} else {
set root [expr {sqrt($p -$r)}]
#set v1(1) [expr {($q + $root) / $s}]
set v1(2) [expr {($q - $root) / $s}]
#set v2(1) [expr {$b - ($M * $v1(1))}]
set v2(2) [expr {$b - ($M * $v1(2))}]
# v2 should always be greater than v1
# which means the answer is always v1(2) and v2(2)
return [list $v1(2) $v2(2)]
}
}
proc createBall { tag } {
global State
set radius [expr {int((30 * rand()) + 20)}]
set diam [expr {2 * $radius}]
# Mass is proportional to area
set mass [expr {$radius * $radius}]
set canvasHeight [winfo height $State(canvas)]
set canvasWidth [winfo width $State(canvas)]
set xpos [expr {$radius + int(($canvasWidth - $diam) * rand())}]
set ypos [expr {$radius + int(($canvasHeight - $diam) * rand())}]
set x1 [expr {$xpos - $radius}]
set x2 [expr {$xpos + $radius}]
set y1 [expr {$ypos - $radius}]
set y2 [expr {$ypos + $radius}]
# Random colour
set colList [list red yellow darkgreen green blue lightblue orange pink purple white]
set colour [randFromList $colList]
# Now create ball
set id [$State(canvas) create oval $x1 $y1 $x2 $y2 \
-outline black -fill $colour -tags [list $tag ball]]
set State(id2tag,$id) $tag
set xvel [expr {(rand() * 8.0) -2}]
set yvel [expr {(rand() * 8.0) -2}]
set State(pos,$tag) [list $xpos $ypos]
set State(vel,$tag) [list $xvel $yvel]
set State(rad,$tag) $radius
set State(mass,$tag) $mass
}
#
# Check if we have collided with another ball
#
# Returns: 1 - If there was a collision
# 0 - If no collision
#
proc checkForCollision { tag } {
global State
set didCollide 0
set overlapList {}
foreach {ourX ourY} $State(pos,$tag) {}
set ourId [$State(canvas) find withtag $tag]
set id [$State(canvas) find closest $ourX $ourY $State(rad,$tag) $ourId]
while { $id != $ourId } {
if { [lsearch -glob [$State(canvas) gettags $id] "ball*"] > -1 } {
set didCollide 1
lappend overlapList $id
}
set id [$State(canvas) find closest $ourX $ourY $State(rad,$tag) $id]
}
if { [llength $overlapList] > 0 } {
foreach id $overlapList {
collide $tag $State(id2tag,$id)
}
}
return $didCollide
}
proc moveBalls { } {
global State
set canvasHeight [winfo height $State(canvas)]
set canvasWidth [winfo width $State(canvas)]
foreach ball $State(ballList) {
foreach {xpos ypos} $State(pos,$ball) {xvel yvel} $State(vel,$ball) {}
set xpos [expr {$xpos + $xvel}]
set ypos [expr {$ypos + $yvel}]
$State(canvas) move $ball $xvel $yvel
# Bounce off the edges
foreach {x1 y1 x2 y2} [$State(canvas) bbox $ball] {}
# Left edge
if { $x1 < 0 && $xvel < 0} {
set xvel [expr {-1.0 * $xvel}]
}
if { $x2 > $canvasWidth && $xvel > 0} {
set xvel [expr {-1.0 * $xvel}]
}
if { $y1 < 0 && $yvel < 0} {
set yvel [expr {-1.0 * $yvel}]
}
if { $y2 > $canvasHeight && $yvel > 0} {
set yvel [expr {-1.0 * $yvel}]
}
if {[checkForCollision $ball]} {
# Collided
set State(pos,$ball) [list $xpos $ypos]
} else {
# Update for new position and velocity
set State(pos,$ball) [list $xpos $ypos]
set State(vel,$ball) [list $xvel $yvel]
}
}
after 50 moveBalls
}
proc collide { tag1 tag2 } {
global State
# Get position of each ball
foreach {x1 y1} $State(pos,$tag1) {x2 y2} $State(pos,$tag2) {}
# Always call the ball on the right (2) and the one on the left (1)
if { $x1 > $x2 } {
set temp $tag2
set tag2 $tag1
set tag1 $temp
# Get position of each ball
foreach {x1 y1} $State(pos,$tag1) {x2 y2} $State(pos,$tag2) {}
}
# Get velocity of each ball
foreach {ux1 uy1} $State(vel,$tag1) {ux2 uy2} $State(vel,$tag2) {}
# Work out the angle along the axis of collision
set diffX [expr {1.0 * ($x2 - $x1)}]
set diffY [expr {1.0 * ($y2 - $y1)}]
set phi [expr {atan($diffY / $diffX)}]
# Now work out the velocity parallel and perpendicular
set uparr1 [expr {($ux1 * cos($phi)) + ($uy1 * sin($phi))}]
set uperp1 [expr {($ux1 * sin($phi)) - ($uy1 * cos($phi))}]
set uparr2 [expr {($ux2 * cos($phi)) + ($uy2 * sin($phi))}]
set uperp2 [expr {($ux2 * sin($phi)) - ($uy2 * cos($phi))}]
# If they are not going towards each other, then they will not collide
if { $uparr2 > $uparr1 } {
return
}
set mass1 $State(mass,$tag1)
set mass2 $State(mass,$tag2)
foreach {vparr1 vparr2} [postColVels $uparr1 $uparr2 $mass1 $mass2] {}
# Perpendicular velocites are unchanged
set vperp1 $uperp1
set vperp2 $uperp2
# Now convert back into x and y movements
set vx1 [expr {($vparr1 * cos($phi)) + ($vperp1 * sin($phi))}]
set vy1 [expr {($vparr1 * sin($phi)) - ($vperp1 * cos($phi))}]
set vx2 [expr {($vparr2 * cos($phi)) + ($vperp2 * sin($phi))}]
set vy2 [expr {($vparr2 * sin($phi)) - ($vperp2 * cos($phi))}]
# Update for new velocities
set State(vel,$tag1) [list $vx1 $vy1]
set State(vel,$tag2) [list $vx2 $vy2]
}
# Seed random number generator
expr {srand([clock clicks])}
# Window things
wm title . "Bouncing balls"
# Create canvas
set State(canvas) [canvas .c -width 500 -height 400]
pack $State(canvas) -fill both -expand true
update
# Create balls
set State(ballList) [list ball1 ball2 ball3 ball4 ball5 ball6 ball7 ball8]
foreach ball $State(ballList) {
createBall $ball
}
moveBalls
Seitenanfangzurück
Inhaltsverzeichnis
Letzte Änderung: 30.11.2005
© Prof. Dr. Uwe Schmidt
Prof. Dr. Uwe Schmidt FH Wedel