procedure Gravity_Pull (XG, YG : int, var VX, VY : real4, G,
X, Y : real4)
if Y > YG then
VY := VY - G
else
VY := VY + G
end if
% uncomment this section to allow the balls to orbit on the x-axis as well
% if X > XG then
% VX := VX - G
% else
% VX := VX + G
% end if
%
end Gravity_Pull
procedure Gravity_Fall (X, Y : real4, var VX, VY : real4, Ground : int,
BF, G : real4)
VY := VY - G
if Y <= Ground then
VY := - (VY / BF)
end if
if X > maxx or X < 1 then
VX := -VX
end if
end Gravity_Fall
procedure Wall_Bounce (X, Y : real4, var VX, VY : real4)
if X < 1 or X > maxx then
VX := -VX
end if
if Y < 1 or Y > maxy then
VY := -VY
end if
end Wall_Bounce
const NUM_OF_OBS := 400
type ORB_RECORD :
record
VX, VY,
XW, YW : real4
end record
type ORB_ARRAY : array 1 .. NUM_OF_OBS of ORB_RECORD
const G := .64 % gravity
const FORCE := 10 % the force given to the object when launched
% change these consts to change the colors of the
%projectiles
const C1 := 8
const LENGTH := 3
const C2 := 0
setscreen ("graphics:max,max,nobuttonbar,offscreenonly")
var XM, YM, Click : int
% var XW, YW, VY, VX : array 1 .. NUM_OF_OBS of real4
var Orbs : ORB_ARRAY
var Angle : real4
var Key : array char of boolean
var Clicked : boolean
var DropNum, FireCount : nat
var Water : real4
Water := 1
Angle := 0
for W : 1 .. NUM_OF_OBS
Orbs (W).XW := Rand.Int (1, maxx)
Orbs (W).YW := Rand.Int (1, maxy)
Orbs (W).VY := 0
Orbs (W).VX := 0
end for
Clicked := false
DropNum := 1
FireCount := 1
colorback (7)
loop
cls
drawfilloval (maxx div 2, maxy div 2, 50, 50, 0)
Input.KeyDown (Key)
mousewhere (XM, YM, Click)
if Key (KEY_RIGHT_ARROW) then
Angle := Angle + 1
elsif
Key (KEY_LEFT_ARROW) then
Angle := Angle - 1
end if
if Angle > 360 then
Angle := 0
elsif Angle < 0 then
Angle := 360
end if
if Click = 1 then
Orbs (DropNum).XW := XM
Orbs (DropNum).YW := YM
Orbs (DropNum).VY := round (sind (Angle) * FORCE)
Orbs (DropNum).VX := round (cosd (Angle) * FORCE)
FireCount := 0
if DropNum < NUM_OF_OBS then
DropNum := DropNum + 1
else
DropNum := 1
end if
Clicked := true
end if
for W : 1 .. NUM_OF_OBS
Orbs (W).XW := Orbs (W).XW + Orbs (W).VX
Orbs (W).YW := Orbs (W).YW + Orbs (W).VY
Wall_Bounce (Orbs (W).XW, Orbs (W).YW, Orbs (W).VX, Orbs (W).VY)
% comment or uncomment the followning subprograms for
% different gravity options
Gravity_Pull (maxx div 2, maxy div 2, Orbs (W).VX, Orbs (W).VY,
G, Orbs (W).XW, Orbs (W).YW)
%Gravity_Fall (Orbs (W).XW, Orbs (W).YW, Orbs (W).VX, Orbs (W).VY,
% 1, 1.5, G)
drawfilloval (round (Orbs (W).XW - (Orbs (W).VX * LENGTH)),
round (Orbs (W).YW - (Orbs (W).VY * LENGTH)),
5, 5, 12)
% bellow are some different options for drawing lines based on
% the x/y cords
% drawline (1, round (Orbs (W).YW), maxx, round (Orbs (W).YW), 12)
% drawline (round (Orbs (W).XW), 1, round (Orbs (W).XW), maxy, 12)
% drawline (round (Orbs (W).XW), round (Orbs (W).YW), maxx div 2,
% maxy div 2, 9)
end for
drawline (XM, YM, XM + round (cosd (Angle) * 15),
YM + round (sind (Angle) * 15), 12)
drawfilloval (XM, YM, 5, 5, 12)
put DropNum
View.Update
end loop
|