var
one_char:char;
wind,charge,terrainslope,time:real;
theta,ball_x,ball_y,P,Q,R,S,errors,angle: integer;
sine: array[0..256] of real;
rad_conv,rad_angle,V: real;
a_sin: array [0..180] of real;
My_terrain, Their_terrain, direction,Their_X, Their_Y, My_X, My_Y: integer;
function KBDkill: boolean;
var
C: char;
begin
if KeyPressed then
begin
read(kbd,C,C);
if C=' ' then KBDkill:=false else KBDkill:=true
end
else KBDkill:=false
end;
function anymore: boolean;
var
answer: longstring;
begin
charcursor(10,10);
cursoron;
charscale(5,7,6,14);
repeat
answer:='More? ';
drawstring(answer);
conread(answer,1);
answer[1]:=Upcase(answer[1]);
until (answer[1]='Y') or (answer[1]='N');
anymore:=(Upcase(answer[1])='Y');
end;
procedure setup;
const
left=300;
right=600;
var
my_center, their_center:integer;
arrow: longstring;
begin
Direction:=-direction;
If direction=1 then
begin
My_center:=300;
their_center:=600
end
else
begin
their_center:=300;
My_center:=600
end;
if random<0.5 then
My_x:=My_center+random(120)
else
My_x:=My_center-random(120);
if random<0.5 then
My_y:=198+random(40)
else
My_y:=198-random(40);
if random<0.5 then
Their_x:=Their_center+random(120)
else
Their_x:=Their_center-random(120);
if random<0.5 then
Their_y:=198+random(40)
else
Their_y:=198-random(40);
if random<0.5 then
wind:=random(40)
else
wind:=-random(40);
if direction=1 then
begin
drawline(100,my_y,My_terrain,my_y);
drawline(My_terrain,my_y,their_terrain,their_y);
drawline(Their_terrain,their_y,799,their_y);
end
else
begin
drawline(799,my_y,My_terrain,my_y);
drawline(My_terrain,my_y,Their_terrain,their_y);
drawline(Their_terrain,their_y,100,their_y);
end;
drawbar(My_x-4,my_x+4,My_y-8,my_y);
drawbar(Their_x-4,their_x+4,their_y-8,their_y);
cursoroff;
charcursor(390,120);
charscale(10,12,20,24);
if direction=1 then arrow:='->'
else arrow:='<-';
drawstring(arrow);
charscale(6,7,10,12);
charcursor(390,30);
if wind<0 then
begin
str(-wind:2:0,arrow);
arrow:=concat(concat('<-wind: ',arrow),' mph')
end
else
begin
str(wind:2:0,arrow);
arrow:=concat(concat('wind: ',arrow),' mph->');
end;
drawstring(arrow);
end;
procedure get_input;
var
question,answer: longstring;
code: integer;
begin
charscale(5,7,6,14);
cursoron;
repeat
question:='Angle[0-180]? ';
charcursor(600,10);
drawstring(question);
question:='Angle[0-180]? ';
charcursor(600,10);
drawstring(question);
conread(answer,3);
if length(answer)=0 then theta:=-1
else Val(answer,theta,code);
until (code=0) and ((theta>=0) and (theta<=180)) ;
repeat
question:='Charge[1-1000]? ';
charcursor(600,40);
drawstring(question);
question:='Charge[1-1000]? ';
charcursor(600,40);
drawstring(question);
conread(answer,4);
if length(answer)=0 then charge:=-1
else Val(answer,charge,code);
until (code=0) and ((charge>0) and (charge<=1000));
end;
function signum(x: real): integer;
begin
if x<0 then signum:=-1
else if x=0 then signum:=0
else signum:=1
end;
function inbound(x,y: integer): boolean;
begin
inbound:=(((x<799) and (x>0)) and (y>0) and (y<240))
end;
begin
wind:=wind*1.5;
wind_effect:=signum(wind)*signum(direction);
repeat
get_input;
rad_theta:=theta*rad_conv;
old_ball_x:=my_x;
old_ball_y:=My_y;
ball_x:=my_x+direction;
ball_y:=my_y-1;
fly:=true;
time:=0.01;
while fly do
begin
drag_time:=1-exp(-drag*time);
ball_x:=My_x+trunc((direction*charge*
(cos(rad_theta)/drag)*drag_time)+
wind_effect*(sin(rad_theta)*abs(wind)*drag)/20);
charge:=charge+wind_effect*(abs(wind)*drag)/20;
ball_y:=My_y-trunc((-32.2*time/drag)+(1/drag)*((charge*sin(rad_theta))+32.2/drag)
*drag_time);
if inbound(ball_x,ball_y) then drawline(old_ball_x,old_ball_y,ball_x,ball_y);
if direction=1 then
begin
if (ball_x<=My_terrain) and (ball_y>My_y) then
begin
{ writeln(lst,'stop 1'); }
fly:=false;
end
else if (ball_x>=Their_terrain) and (ball_y>their_y) then
begin
{ writeln(lst,'stop 2'); }
fly:=false;
end
else if (ball_x>My_Terrain) and (ball_x<their_terrain) then
if terrainslope<((ball_y-My_y)/(ball_x-My_Terrain)) then
begin
{ writeln(lst,'stop 3'); }
fly:=false;
end
end
else
begin
if (ball_x>My_terrain) and (ball_y>My_y) then
begin
{ writeln(lst,'stop 4'); }
fly:=false
end
else if (ball_x<Their_terrain) and (ball_y>their_y) then
begin
fly:=false;
{ writeln(lst,'stop 5'); }
end
else if (ball_x<My_terrain) and (ball_x>their_terrain)
then
if terrainslope<((ball_y-My_y)/-(ball_x-My_Terrain)) then
begin
{ writeln(lst,'stop 6'); }
fly:=false;
end
end;
if (ball_y>240) or (ball_x>800) or (ball_x<1) then
begin
{ writeln(lst,'stop 7'); }
fly:=false;
end;
time:=time+0.05;
old_ball_x:=ball_x;
old_ball_y:=ball_y
end;
until (ball_x<their_x+4) and (ball_x>their_x-4);
operation(2,15);
for i:=1 to 15 do
drawarc(Their_x,Their_y,i,0,128);
operation(0,15);
end;
procedure instruct;
begin
Clrscr;
writeln(' Canon is a DEC RAINBOW High Resolution game which simulates the');
writeln('firing of a canon. It is much like the usual BASIC games, with the');
writeln('addition of a wind factor, somewhat more enhanced terrain, and of');
writeln('course, hi-res graphics to trace out the path of the shot.');
writeln;
writeln(' The object is to destroy the enemy''s fort by bombarding it and ');
writeln('hitting the munitions dump at it''s center. For now, his scientific');
writeln('evolution has not developed balistics, so you are at a decided advantage');
writeln('To wit, he won''t shoot back at you.');
writeln;
writeln(' The screen will show the terrain (two plateaus) with fortresses');
writeln('(currently rectangles). You are shooting in the direction of the arrow');
writeln('which appears roughly centerscreen. The wind direction and velocity');
writeln('is indicated at the top center of the screen. You are prompted (in the ');
writeln('upper right corner) for the angle to tilt the cannon and then the charge');
writeln('to put in with the shot. The angle is in the range 0 (horizontal towards');
writeln('the enemy fort) to 180 (horizontal away from the enemy). The charge is ');
writeln('a value in the range 1 to 1000. Usually a value from 100-300 is in order.');
writeln('Input the values, followed by RETURN. If you use all the digits allowed');
writeln('you won''t need to press return. The game re-prompts if you enter an');
writeln('invalid value.');
writeln(' Press any key to continue....');
read(kbd,one_char);
Clrscr;
writeln(' Through trial and error you should be able to gauge the proper input');
writeln('that will land the projectile on it''s target. After you enter the charge');
writeln('value, the projectile is fired, and you see a trace of it''s motion in the ');
writeln('sky. You are encouraged to make whistling noises that increase in pitch');
writeln('with the height of the projectile, it helps heighten the drama.');
writeln;
writeln(' If you miss, you will be re-prompted for the next set of angle and charge');
writeln('settings. When you hit the target, a mushroom-like cloud will billow');
writeln('forth from the enemy''s fort. You will be prompted (in the upper left hand');
writeln('corner of the screen) to see if you want to play more. Answer either');
writeln('with a Y or N (no carriage return necessary).');
writeln;
writeln(' If the projectile goes off the screen horizontally, the simulation');
writeln('will stop. If it goes off vertically, the simulation continues and the ');
writeln('projectile will reappear on the downside as long as it doesn''t break the');
writeln('horizontal rule.');
writeln;
writeln(' To stave off boredom, the terrain will change and the arrow (indicating ');
writeln('the direction that you shoot, remember) will reverse for the next game');
writeln(' Press any key to continue....');
read(kbd,one_char);
Clrscr;
end;
begin { required initialization }
Write('Welcome to Canon. Instructions?[Y/N] ');
read(kbd,one_char);
one_char:=Upcase(one_char);
writeln(one_char);
while not (one_char in ['Y','N']) do
begin
write('Instructions?[Y/N] ');
read(kbd,one_char);
one_char:=Upcase(one_char);
writeln(one_char);
end;
if one_char='Y' then instruct;
writeln('Initializing...please wait...');
for P:=0 to 64 do Gsine[P]:=sin(P*0.0245437); { used by DrawArc }
LeftMargin:=15;RightMargin:=15; { used by DrawString }
TopMargin:=10;BottomMargin:=10; { used by DrawString }
for P:=0 to 255 do ScrollMap[P]:=P;
