program canon;
{$R+}
{$I GRAPHICS}
var
  ColorMap: Cmap;
  ScrollMap: Smap;
label
  DemoLoop,quit,skip;
const
  black: byte=0;     green: byte=1;     red: byte=2;       yellow: byte=3;
  blue: byte=4;      turquoise: byte=5; redviolet: byte=6; white: byte=7;
  grey: byte=8;      avacado: byte=9;   darkred: byte=10;  orange: byte=11;
  purple: byte=12;   brown: byte=13;    burgandy: byte=14; pink: byte=15;

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);

  clearallplanes;
  {draw terrain}
    my_terrain:=my_x+direction*random(abs(my_x-my_center));
{  My_terrain:=my_x+trunc(direction*(abs(My_x-My_center))*(0.2*random(3)));
  Their_terrain:=their_x+trunc(-direction*(abs(their_x-their_center))*(0.2*random(3)));
 }
    their_terrain:=their_x+-direction*random(abs(their_x-their_center));
  terrainslope:=direction*(their_Y-My_y)/(their_terrain-My_terrain);

  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;

procedure fire;
const
  drag=0.35;
var
  old_ball_x, old_ball_y,i: integer;
  rad_theta: real;
  fly: boolean;
  drag_time: real;
  wind_effect: integer;

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;

    ColorMap[00]:=$00;         ColorMap[16]:=$00;    {  0  black      }
    ColorMap[01]:=$0F;         ColorMap[17]:=$F0;    {  1  green      }
    ColorMap[02]:=$F0;         ColorMap[18]:=$06;    {  2  red        }
    ColorMap[03]:=$FF;         ColorMap[19]:=$F0;    {  3  yellow     }
    ColorMap[04]:=$00;         ColorMap[20]:=$0F;    {  4  blue       }
    ColorMap[05]:=$0F;         ColorMap[21]:=$FD;    {  5  turquoise  }
    ColorMap[06]:=$F0;         ColorMap[22]:=$0F;    {  6  red-violet }
    ColorMap[07]:=$FF;         ColorMap[23]:=$FF;    {  7  white      }
    ColorMap[08]:=$88;         ColorMap[24]:=$88;    {  8  grey       }
    ColorMap[09]:=$58;         ColorMap[25]:=$81;    {  9  avacado    }
    ColorMap[10]:=$90;         ColorMap[26]:=$02;    { 10  dark red   }
    ColorMap[11]:=$F7;         ColorMap[27]:=$70;    { 11  orange     }
    ColorMap[12]:=$80;         ColorMap[28]:=$0B;    { 12  purple     }
    ColorMap[13]:=$B7;         ColorMap[29]:=$75;    { 13  brown      }
    ColorMap[14]:=$B1;         ColorMap[30]:=$16;    { 14  burgandy   }
    ColorMap[15]:=$FB;         ColorMap[31]:=$BB;    { 15  pink       }

    HighResolution:=true;    { Change to 'true' for high resolution demo }
    Ginitialize;              { Initialize                                }
    LoadScrollMap(ScrollMap); { Load scroll map                           }
    LoadColorMap(ColorMap);   { Load color map                            }
    DualMonitor:=false;       { Dual CRTs                                 }
    { end of required initialization }

    ClearAllPlanes;
    Operation(0,15);          { REPLACE write to all planes               }
    Pattern(255,4);           { Draw all lines as solid lines             }
    preblanking:=true;

     for P:=0 to 64 do begin
        V:=Gsine[P];
        sine[P]:=V;
        sine[128-P]:=V;
        sine[128+P]:=-V;
        sine[256-P]:=-V end;

rad_conv:=(pi*2)/360.0;
rad_angle:=0;
for angle:=0 to 180 do
begin
   a_sin[angle]:=sin(rad_angle);
   rad_angle:=rad_angle+rad_conv
end;

Graphicson;

direction:=-1;
repeat
  setup;
  Fire;
until not anymore;

graphicsoff
end.