HW4
Screen shot of HW 4:
Zipped version of hw4.stl
Code of hw4.stl:
program hw4; -- SETL interactive interface example 1
use tkw, random_pak; -- use the main widget class
-- ball_data stores all info about the balls:
-- color, current x & y coords of the center,
-- x & y coords of the center 1 sec ago, mass.
-- Based on this data we can compute momentum
-- and speed (for bouncing).
var ball_types := {
{"red", {-100,-100,-100,-100}, 1.0},
{"blue",{-100,-100,-100,-100}, 1.5},
{"green", {-100,-100,-100,-100}, 2.0},
{"black", {-100,-100,-100,-100}, 5.0}
};
var colors := ["red", "white", "blue", "black"];
var canvas_width := 600, canvas_height := 400, diam := 10;
var gravity := 10.0;
var elasticity := 0.9; -- a number in 0..1 telling how much of the enegry
-- does the ball looses with every jump off the ground
var immobility_counter := 0; -- if same coord pattern repeats - ball is immobile, remove it
var imctr_x:=0, imctr_y:=0; -- coords used in determining immobility
var ca; -- canvas
var icons; -- list of icons
var GLOBAL_DEBUG := 0; -- debug level
-- use images instead of the balls!
--MyImage := Tk("image","myball.gif");
--MyBall := Canvas("image",MyImage);
var balls := {}; -- array of ball_data-like items - 1 for each ball on screen
var Tk,blue_circ,red_circ,num_steps := 0; -- globalize for use in procedure below
var rand_handle, rn; -- handle for random integers; rand number
rand_handle := Start_Random(canvas_width, OM); -- create a stream of random numbers
Tk := tkw(); -- create the Tk interpreter
bu := Tk("button","Go"); bu("side") := "top"; -- create a button
bu{OM} := new_ball; -- clicking the button starts the animation
URLIcon := Tk("image","icon_url.gif");
RMIcon := Tk("image","icon_rm.gif");
GIFIcon := Tk("image","icon_image.gif");
icons := [URLIcon, RMIcon, GIFIcon]; -- image of a ball
-- create a canvas
ca := Tk("canvas",str(canvas_width)+","+str(canvas_height)); ca("side") := "top"; ca("background"):= "white";
--blue_circ := ca("oval","-100,-100,-140,-140"); blue_circ("fill") := "blue"; -- insert the circles
--red_circ := ca("oval","-400,-100,-440,-140"); red_circ("fill") := "red";
Tk.mainloop(); -- enter the Tk main loop
-- starts the new series of balsl animation
procedure new_ball();
init_ball(); -- show a ball in random place, gets passed a rnd num in 1..4
end new_ball;
-- start the movement of 2 new balls
procedure init_ball();
var x1, x2, y1, y2, r := diam, coords1, coords2, color;
var mass := 0.0;
var diff, aball;
-- create random parameters for the new ball
-- current coords
x1 := random(rand_handle); -- 0..600
--y1 := canvas_height - fix(0.6666 * float(random(rand_handle))); -- 0..400 translated into screen Y coords
y1 := fix(0.6666 * float(random(rand_handle))); -- 0..400 translated into screen Y coords
coords1 := str(x1) + "," + str(y1) + "," + str(x1+r) + "," + str(y1+r);
-- prev coords, should be close by
diff := random(rand_handle)/30 - 10; -- makes diff bet -10 and 10
x2 := x1 + diff; -- near by
diff := random(rand_handle)/30 - 10; -- makes diff bet -10 and 10
y2 := y1 + diff; -- 0..400
coords2 := str(x2) + "," + str(y2) + "," + str(x2+r) + "," + str(y2+r);
color := colors(random(rand_handle)/200 + 1);
mass := float(random(rand_handle))/60.0;
-- new ball's index in the tuple of balls
num_balls := #balls;
num_balls := num_balls + 1;
-- set up info for the new ball
--aball := ca("oval",str(x1) + "," + str(y1) + "," + str(x2) + "," + str(y2));
--aball("fill") := color;
aball := ca("image",icons(random(rand_handle)/200+1)); -- load random image
aball("coords") := str(x1) + "," + str(y1);
balls(aball) := [color, x1, y1, x2, y2, mass];
debug(1, str(num_balls) + "Init: ball=" + str(aball) + "; coords: " + str(balls(num_balls)) );
--ndebug(1, aball);
--ndebug(1, "; coords: ");
--debug(1, balls(aball)); -- debug
animate();
end init_ball;
-- advance the animation and return true, or false if finished
procedure animate();
var color, x, y, x0, y0, mass := 0.0; -- ball data
var new_x, new_y;
var temp_x, temp_y; -- used in swapping coords
if #(circles := domain(balls)) = 0 then return; end if; -- teminate if no cir
-- go through all balls on screen, i is current image
-- move them according to their velocities and gravity
for i in circles loop
[color, x, y, x0, y0, mass] := balls(i);
debug(1, "Existing coords: (" + str(color) + "," + str(x) + "," +
str(y) + "," + str(x0) + "," + str(y0) + "," + str(mass) + ")");
-- delete balls rolled beyond the screen
if x > canvas_width+diam then balls(i) := OM; i.delete(); continue; end if;
if x < -diam then balls(i) := OM; i.delete(); continue; end if;
-- movement in the gravitational field of the planet
-- happens according to the following cooords eqations:
-- x(i+1) = 2*x(i) - x(i-1);
-- y(i+1) = canvas_height - (2 * y(i) - y(i-1) - a/2), where a is
-- deceleration, +10 m/(s*s)
-- so, advance position and apply gravity
new_x := 2*x - x0;
new_y := 2*y - y0 - fix(gravity/2.0);
debug(1, "Old: (" + str(x) + "," + str(y) + ")"); -- new coords
x0:=x; y0:=y; x:=new_x; y:=new_y;
debug(1, "; so: (" + str(x) + "," + str(y) + "," + str(x0) + "," + str(y0) + ")");
-- bounce off boundaries
-- bottom border: swap y0 and y
if y < diam then
ndebug(1, "bottom:");
temp_y:=y;
y:=y0;
y0:=temp_y; -- swapped!
ndebug(1, "Swapped: (" + str(x) + "," + str(y) + "," + str(x0) + "," + str(y0) + ")");
y:=fix(float(y0) + float(abs(y-y0))*elasticity); -- make the bounce non-absolutely elastic
ndebug(1, "upper: " + str(y));
if y < diam then y0 +:= diam-y; y := diam; end if;
debug(1, "(" + str(x) + "," + str(y) + "," + str(x0) + "," + str(y0) + ")");
end if;
-- right border: swap x0 and x
if x > (canvas_width-diam) then
debug(1, "right: ");
temp_x:=x;
--x:=x0;
x:=fix(float(temp_x) - float(abs(temp_x-x0))*elasticity*0.3);
x0:=temp_x;
debug(1, "(" + str(x) + "," + str(y) + "," + str(x0) + "," + str(y0) + ")");
end if;
-- left border: swap x0 and x
if x < diam then
debug(1, "left:(" + str(x) + "," + str(y) + "," + str(x0) + "," + str(y0) + ")");
temp_x:=x;
x:=x0;
x0:=temp_x;
debug(1, "Swapped:(" + str(x) + "," + str(y) + "," + str(x0) + "," + str(y0) + ")");
x:=fix(float(x0) + float(abs(x-x0))*elasticity*0.3);
if x < diam then x0 +:= diam-x; x := diam; end if;
debug(1, "Adjusted: (" + str(x) + "," + str(y) + "," + str(x0) + "," + str(y0) + ")");
end if;
-- immobility conditions:
-- if current coords are the same for 4 times - immobile
--debug(1, "imctr coords: (" + str(imctr_x) + "," + str(imctr_y) + "), current coors: (" + str(x) + "," + str(y) + "), imctr=" + str(immobility_counter));
if imctr_x = x and imctr_y = y then immobility_counter +:= 1; end if;
if immobility_counter = 4 then immobility_counter := 0; balls(i) := OM; i.delete(); continue; end if;
if imctr_x /= x or imctr_y /= y then imctr_x := x; imctr_y := y; immobility_counter := 0; end if;
debug(1, "Old before collision: (" + str(x0) + "," + str(y0) + ")"); -- new coords
-- bounce off others: if centers are within a distance [diam], and
-- motion is bringing them together, then
-- reflect component of motion along line thru centers
--for [circ2,[v2_x,v2_y,p2_x,p2_y]] in balls | circ2 /= i loop
--for [color2,x2,y2,x20,y20,mass2] in balls | circ2 /= i loop
for i2 in circles | i2 /= i loop
debug(1, "Ball " + str(i) + " colliding with " + str(i2));
[color2,x2,y2,x20,y20,mass2] := balls(i2);
if (diff_x := x - x2) * diff_x + (diff_y := y - y2) * diff_y > diam*diam then continue; end if;
-- determine new coords of 2 balls after councing against each other
-- pass new & old coords and mass for this ball and ball2
[new_x, new_y, new_x2, new_y2] := reflected_coords(float(x),
float(y),
float(x0),
float(y0),
mass,
float(x2),
float(y2),
float(x20),
float(y20),
mass2);
-- c0onvert float results into int for usage below
[new_x, new_y, new_x2, new_y2] := [fix(new_x), fix(new_y), fix(new_x2), fix(new_y2)];
balls(i2) := [color, new_x2, new_y2, x2, y2, mass2];
[x,y,x0,y0] := [new_x,new_y,x,y]; -- set new & old coords for this ball i
end loop;
debug(1, "Old after collision: (" + str(x0) + "," + str(y0) + ")"); -- new coords
balls(i) := [color, x, y, x0, y0, mass]; -- note new circle data
-- reposition the circle
-- make sure that all Y coords are transformed into the screen
-- coords according to the formula:
-- Y scr = canvas_height - Y
--i("coords") := str(x - diam) + "," + str(canvas_height - y + diam) + "," + str(x + diam) + "," + str(400 - y - diam);
i("coords") := str(x) + "," + str(canvas_height - y);
end loop;
Tk.createtimer(1,animate);
end animate;
-- debug methods
procedure debug(debug_level, msg);
if debug_level <= GLOBAL_DEBUG then print(msg); end if;
end debug;
procedure ndebug(debug_level, msg);
if debug_level <= GLOBAL_DEBUG then nprint(msg); end if;
end ndebug;
procedure reflected_coords(x1,y1,x10,y10,m1,x2,y2,x20,y20,m2);
var v1, v2; -- speeds befor ecollision
var v1_prime, v2_prime; -- speeds after collision
var ret_x1, ret_y1, retx2, ret_y2; -- return coords of 2 balls
var A, B, C; -- helper vars, to simplify equations
var DD; -- discriminant squared
-- first we calc everything for x axis,
-- so v1 and v2 are actually projections of
-- real vector velocities of 2 balls on x axis
v1 := x1-x10;
v2 := x2-x20;
A := v1 + (m2*v2)/m1;
B := -m2/m1;
C := m1*v1*v1 + m2*v2*v2;
DD := 4.0*m1*m1*A*A*B*B - 4.0*(m2 + m1*B*B)*(m1*A*A - C);
if DD < 0.0 then
ret_x1 := x1;
ret_x2 := x2;
end if; -- discr < 0, return same coords
if DD = 0.0 then
v2_prime := -m1*A*B / (m2 + m1*B*B);
v1_prime := A + B*v2_prime;
ret_x1 := v1_prime + x10;
ret_x2 := v2_prime + x20;
end if;
if DD > 0.0 then
-- first root of square equation
v2_prime := ( -2.0*m1*A*B + sqrt(DD) ) / (2.0*(m2 + m1*B*B));
v1_prime := A + B*v2_prime;
ret_x1 := v1_prime + x10;
ret_x2 := v2_prime + x20;
-- ignore 2nd root for now
-- second root of square equation
--v2_prime := ( -2*m1*A*B - sqrt(DD) ) / (2*(m2 + m1*B*B));
--v1_prime := A + B*v2_prime;
-- use the coords that are closer to the original coords
--if ret_x1 > v1_prime + x10 then ret_x1 := v1_prime + x10; end if;
--if ret_x2 > v2_prime + x20 then ret_x2 := v2_prime + x20; end if;
end if;
-- then we calc everything for y axis,
-- so v1 and v2 are actually projections of
-- real vector velocities of 2 balls on y axis
v1 := y1-y10;
v2 := y2-y20;
A := v1 + (m2*v2)/m1;
B := m2/m1;
C := m1*v1*v1 + m2*v2*v2;
DD := 4.0*m1*m1*A*A*B*B - 4.0*(m2 + m1*B*B)*(m1*A*A - C);
if DD < 0.0 then
ret_y1 := y1;
ret_y2 := y2;
end if; -- discr < 0, return same coords
if DD = 0.0 then
v2_prime := -m1*A*B / (m2 + m1*B*B);
v1_prime := A + B*v2_prime;
ret_y1 := v1_prime + y10;
ret_y2 := v2_prime + y20;
end if;
if DD > 0.0 then
-- first root of square equation
v2_prime := ( -2.0*m1*A*B + sqrt(DD) ) / (2.0*(m2 + m1*B*B));
v1_prime := A + B*v2_prime;
ret_y1 := v1_prime + y10;
ret_y2 := v2_prime + y20;
-- ignore 2nd root for now
-- second root of square equation
--v2_prime := ( -2*m1*A*B - sqrt(DD) ) / (2*(m2 + m1*B*B));
--v1_prime := A + B*v2_prime;
-- use the coords that are closer to the original coords
--if ret_x1 > v1_prime + x10 then ret_x1 := v1_prime + x10; end if;
--if ret_x2 > v2_prime + x20 then ret_x2 := v2_prime + x20; end if;
end if;
return [ret_x1,ret_y1,ret_x2,ret_y2];
end reflected_coords;
end hw4;
Go back