home *** CD-ROM | disk | FTP | other *** search
/ Aztec Shareware Collection / SIMULATION.ISO / gravwars / gravwars.pas < prev    next >
Pascal/Delphi Source File  |  1989-04-25  |  32KB  |  869 lines
  1. Program GravityWars;
  2. { by Sohrab Ismail-Beigi     Completed 4/23/89
  3.      SYSOP of The 3D Graphics BBS
  4.      300/1200/2400 baud, N-8-1 Full duplex
  5.      (201) 444-4154}
  6.  
  7. {Turbo Pascal 4.0 source code.  Requires VGA 640x480x16 display.}
  8. {Note: pix=pixels in the comments}
  9.  
  10. Uses Crt,Graph;
  11.  
  12. Type
  13.     spacecraft=Record                       {used for ships and pointer}
  14.                  coffx,coffy,r : longint;   {center offsets and radius in pix}
  15.                  imagex,imagey : longint;   {upper left of image}
  16.                  imagepointr   : pointer;   {pointer to image data}
  17.                  imagesize     : word;      {size in bytes}
  18.                end;
  19.     planettype=Record
  20.                  cx,cy,r : longint;         {planet center and radius}
  21.                  d,GM    : real;            {density and G*M product}
  22.                end;
  23.  
  24. Const
  25.      color : array[1..3] of byte=(Red,Green,LightBlue); {colors for planets}
  26.      G=0.1;                                             {gravity constant}
  27.      bhr=15;                                            {black hole radius}
  28.      Esc=#27;                                           {ASCII for Esc}
  29.      Return=#13;                                        { "     "  RETURN}
  30.  
  31. Var
  32.   ship      : array[1..2] of spacecraft;    {2 ships}
  33.   tp,pointr : spacecraft;                   {tp is temporary, 1 pointer}
  34.   pl        : array[1..9] of planettype;    {the 9 planets}
  35.   screen    : Record                        {the game area}
  36.                 sx,ex,sy,ey,cx,cy,lx,ly : longint; {start x/y, end x/y, center}
  37.               end;                                 {x/y, length x/y}
  38.   np,GraphDriver,GraphMode : integer;              {# of planets}
  39.   criticaldist : real;                             {for escape velocity calc}
  40.   playsong  : boolean;                             {play the songs?}
  41.  
  42. Procedure Init;              {initialize everything}
  43. begin
  44.   SetGraphBufSize(10);       {make the buffer big enough for big floodfills}
  45.   GraphDriver:=VGA; GraphMode:=VGAHi;
  46.   InitGraph(GraphDriver,GraphMode,'c:\turbo4');
  47.   SetColor(LightGray); SetFillStyle(SolidFill,LightGray);      {Hull of ships}
  48.   Circle(100,100,9); FloodFill(100,100,LightGray); Bar(77,98,100,102);
  49.   MoveTo(82,98); LineRel(-3,-8); LineRel(-13,0); LineRel(0,-3); LineRel(24,0);
  50.   LineRel(0,3); LineRel(-7,0); LineRel(3,8); FloodFill(83,97,LightGray);
  51.   MoveTo(82,101); LineRel(-3,8); LineRel(-13,0); LineRel(0,3); LineRel(24,0);
  52.   LineRel(0,-3); LineRel(-7,0); LineRel(3,-8); FloodFill(83,103,LightGray);
  53.   MoveTo(200,200); LineRel(5,-5); LineRel(5,5); LineRel(10,0); LineRel(5,-8);
  54.   LineRel(15,0); LineRel(-6,9); LineRel(6,9); LineRel(-15,0); LineRel(-5,-7);
  55.   LineRel(-10,0); LineRel(-5,5); LineRel(-6,-7); LineRel(2,-2);
  56.   FloodFill(201,201,LightGray);
  57.   SetColor(LightRed); SetFillStyle(SolidFill,LightRed); {Red lights on ships}
  58.   Circle(100,100,2); FloodFill(100,100,LightRed);
  59.   Bar(89,87,91,90); Bar(89,109,91,112);
  60.   Bar(224,200,226,203); Bar(240,192,242,194); Bar(240,208,242,210);
  61.   SetColor(Yellow); MoveTo(0,0); LineRel(0,10); MoveTo(0,0); LineRel(10,0);
  62.   MoveTo(0,0); LineRel(15,15);   {pointer}
  63.   tp.imagesize:=ImageSize(0,0,16,16);     {kludge to subdue compiler bug}
  64.   GetMem(tp.imagepointr,tp.imagesize);
  65.   GetImage(0,0,16,16,tp.imagepointr^);
  66.   pointr.imagesize:=ImageSize(0,0,16,16);
  67.   GetMem(pointr.imagepointr,pointr.imagesize);
  68.   GetImage(0,0,16,16,pointr.imagepointr^);           {get pointer}
  69.   pointr.coffx:=7; pointr.coffy:=7; pointr.r:=9;
  70.   ship[1].imagesize:=ImageSize(66,87,110,113);
  71.   GetMem(ship[1].imagepointr,ship[1].imagesize);
  72.   GetImage(66,87,110,113,ship[1].imagepointr^);      {enterprise}
  73.   ship[1].coffx:=22; ship[1].coffy:=13; ship[1].r:=26;
  74.   ship[2].imagesize:=ImageSize(199,192,242,210);
  75.   GetMem(ship[2].imagepointr,ship[2].imagesize);
  76.   GetImage(199,192,242,210,ship[2].imagepointr^);     {klingon}
  77.   ship[2].coffx:=21; ship[2].coffy:=9; ship[2].r:=23;
  78.   ClearDevice;
  79.   screen.sx:=1; screen.ex:=638; screen.sy:=33; screen.ey:=478;
  80.   screen.cx:=(screen.sx+screen.ex) div 2;                 {initialize screen}
  81.   screen.cy:=(screen.sy+screen.ey) div 2;                            {bounds}
  82.   screen.lx:=screen.ex-screen.sx+1;
  83.   screen.ly:=screen.ey-screen.sy+1;
  84.   criticaldist:=2.0*sqrt(sqr(screen.lx)+sqr(screen.ly)); {critical distance}
  85.   playsong:=true;                                    {for escape vel. calc}
  86. end;
  87.  
  88. Procedure Finish;   {free memory and end}
  89. begin
  90.   FreeMem(ship[1].imagepointr,ship[1].imagesize);
  91.   FreeMem(ship[2].imagepointr,ship[2].imagesize);
  92.   FreeMem(pointr.imagepointr,pointr.imagesize);
  93.   FreeMem(tp.imagepointr,tp.imagesize);
  94.   CloseGraph;
  95. end;
  96.  
  97. Function InBounds(cx,cy,r:longint):boolean; {is the point with radius}
  98. begin                                       {completely in screen bounds?}
  99.    InBounds:=true;
  100.    if r<>0 then
  101.      if (cx-r<=screen.sx) or (cx+r>=screen.ex) or
  102.         (cy-r<=screen.sy) or (cy+r>=screen.ey) then
  103.           InBounds:=false
  104.    else
  105.      if (cx-bhr<=screen.sx) or (cx+bhr>=screen.ex) or
  106.         (cy-bhr<=screen.sy) or (cy+bhr>=screen.ey) then
  107.           InBounds:=false;
  108. end;
  109.  
  110. Procedure RandomSetup;   {make a random setup}
  111. var i,j : integer;
  112.     a,b : longint;
  113.     ok  : boolean;
  114. begin
  115.   Randomize;
  116.   np:=Random(9)+1;   {random # of planets 1-9}
  117.   for i:=1 to np do  {pick planet positions}
  118.     Repeat
  119.       ok:=true;
  120.       pl[i].cx:=Random(screen.lx)+screen.sx;
  121.       pl[i].cy:=Random(screen.ly)+screen.sy;
  122.       pl[i].d:=(Random(3)+2)/2.0;
  123.       pl[i].r:=0;
  124.       if Random>0.05 then pl[i].r:=Random(70)+20; {5% chance of blackhole}
  125.       if pl[i].r<>0 then
  126.         pl[i].GM:=G*2*pi*sqr(pl[i].r)*pl[i].d
  127.       else
  128.         pl[i].GM:=G*2*pi*sqr(30)*1.0;
  129.       ok:=InBounds(pl[i].cx,pl[i].cy,pl[i].r);
  130.       if (i>1) and (ok) then          {any collisions with existing planets?}
  131.         for j:=1 to i-1 do
  132.           begin
  133.           if sqrt(sqr(pl[i].cx-pl[j].cx)+sqr(pl[i].cy-pl[j].cy))<=
  134.             pl[i].r+pl[j].r+2*bhr then
  135.                ok:=false;
  136.           end;
  137.     Until ok;
  138.   for i:=1 to 2 do   {pick ship positions}
  139.     Repeat
  140.       ok:=true;
  141.       ship[i].imagex:=Random(screen.lx div 2)+screen.sx; {enterprise to the}
  142.       if i=2 then ship[2].imagex:=ship[i].imagex+screen.lx div 2; {left and}
  143.       ship[i].imagey:=Random(screen.ly)+screen.sy;      {klingon to the right}
  144.       a:=ship[i].imagex+ship[i].coffx; b:=ship[i].imagey+ship[i].coffy;
  145.       ok:=InBounds(a,b,ship[i].r);
  146.       for j:=1 to np do           {any collisions with planets?}
  147.         if sqrt(sqr(a-pl[j].cx)+sqr(b-pl[j].cy))<=pl[j].r+ship[i].r+bhr then
  148.            ok:=false;
  149.     Until ok;
  150. end;
  151.  
  152. Procedure DrawSetup;  {draw current setup}
  153. var i,j : integer;
  154. begin
  155.   ClearDevice;
  156.   SetColor(White);
  157.   Rectangle(screen.sx-1,screen.sy-1,screen.ex-1,screen.ey-1); {game box}
  158.   for i:=1 to 2000 do             {2000 random stars}
  159.     PutPixel(Random(screen.lx)+screen.sx,Random(screen.ly)+screen.sy,White);
  160.   for i:=1 to 2 do  {2 ships}
  161.     PutImage(ship[i].imagex,ship[i].imagey,ship[i].imagepointr^,NormalPut);
  162.   for i:=1 to np do  {np planets}
  163.     if pl[i].r>0 then   {normal}
  164.       begin
  165.         SetColor(color[trunc(pl[i].d*2-1)]);
  166.         Circle(pl[i].cx,pl[i].cy,pl[i].r);
  167.         SetFillStyle(SolidFill,color[trunc(pl[i].d*2-1)]);
  168.         FloodFill(pl[i].cx,pl[i].cy,color[trunc(pl[i].d*2-1)]);
  169.       end
  170.     else               {black hole}
  171.       begin
  172.         SetColor(Black);
  173.         for j:=0 to bhr do
  174.           Circle(pl[i].cx,pl[i].cy,j);
  175.       end;
  176. end;
  177.  
  178. Procedure ClearDialogBox;  {clear text message area}
  179. begin
  180.   SetFillStyle(SolidFill,Black);
  181.   Bar(0,0,screen.ex-1,screen.sy-2);
  182. end;
  183.  
  184. Function GetString:string;  {get a string until RETURN is pressed}
  185. var s : string;
  186.     c : char;
  187. begin
  188.   s:='';
  189.   Repeat
  190.     c:=ReadKey;
  191.     if (c=chr(8)) and (length(s)>0) then          {backspace key}
  192.         begin
  193.           delete(s,length(s),1);
  194.           MoveRel(-8,0);                          {delete last char}
  195.           SetFillStyle(SolidFill,Black);
  196.           Bar(GetX,GetY,GetX+8,GetY+8);
  197.         end
  198.     else if c<>Return then
  199.       begin
  200.         s:=concat(s,c);                           {get and draw char}
  201.         SetColor(LightGray);
  202.         OutText(c);
  203.       end;
  204.   Until c=Return;
  205.   GetString:=s;
  206. end;
  207.  
  208. Procedure PlayGame;
  209. Const number_of_explosion_dots=20;   {# dots for explosion with planet surface}
  210. Var vx,vy,vc,x,y,dt,ax,ay,dx,dy,dr,k : real;
  211.     v0,angle : array[1..2] of real;
  212.     s : string;
  213.     ch : char;
  214.     i,event,player,winner : integer;
  215.     ok,donecritical,offscreen : boolean;
  216.     buffer : array[1..number_of_explosion_dots] of Record  {for explosion}
  217.                                                      x,y,color : integer;
  218.                                                    end;
  219. begin
  220.   v0[1]:=0; v0[2]:=0; angle[1]:=0; angle[2]:=0;
  221.   player:=1;
  222.   donecritical:=false;
  223.   Repeat                               {infinite loop}
  224.     ClearDialogBox;
  225.     SetColor(LightGray);
  226.     str(player,s);
  227.     s:=concat('Player ',s);        {player #}
  228.     OutTextXY(0,0,s);
  229.     Repeat                         {get angle}
  230.       MoveTo(0,10);
  231.       str(angle[player]:3:5,s);
  232.       s:=concat('Angle: [',s,']: ');
  233.       OutText(s);
  234.       s:=GetString;
  235.       if (s[1]='Q') or (s[1]='q') then exit;
  236.       i:=0;
  237.       if s<>'' then Val(s,angle[player],i);
  238.       SetFillStyle(SolidFill,Black);
  239.       ok:=(i=0) and (angle[player]>=0.0) and (angle[player]<=360);
  240.       if not ok then Bar(0,0,screen.ex-1,8);
  241.     Until ok;
  242.     Repeat                        {get initial velocity}
  243.       MoveTo(0,20);
  244.       str(v0[player]:2:5,s);
  245.       s:=concat('Initial Velocity: [',s,']: ');
  246.       OutText(s);
  247.       s:=GetString;
  248.       if (s[1]='Q') or (s[1]='q') then exit;
  249.       i:=0;
  250.       if s<>'' then Val(s,v0[player],i);
  251.       SetFillStyle(SolidFill,Black);
  252.       ok:=(i=0) and (v0[player]>=0.0) and (v0[player]<=10.0);
  253.       if not ok then Bar(0,10,screen.ex-1,18);
  254.     Until ok;
  255.     k:=pi*angle[player]/180.0;   {angle in radians}
  256.     vx:=v0[player]*cos(k);
  257.     vy:=-v0[player]*sin(k);
  258.     x:=ship[player].imagex+ship[player].coffx+ship[player].r*cos(k);
  259.     y:=ship[player].imagey+ship[player].coffy-ship[player].r*sin(k);
  260.     ClearDialogBox;
  261.     MoveTo(round(x),round(y));
  262.     SetColor(White);
  263.     offscreen:=false;
  264.     Repeat                       {calculate and draw trajectory}
  265.       dt:=0.25;                  {time interval [vel. is in pix/time]}
  266.       x:=x+vx*dt; y:=y+vy*dt;
  267.       ax:=0; ay:=0;
  268.       for i:=1 to np do          {calc accel. due to gravity}
  269.         begin
  270.           dx:=x-pl[i].cx; dy:=y-pl[i].cy; dr:=sqrt(sqr(dx)+sqr(dy));
  271.           k:=1/(sqr(dr)*dr);
  272.           if pl[i].r<>0 then       {normal}
  273.             begin
  274.               ax:=ax-pl[i].GM*dx*k;
  275.               ay:=ay-pl[i].GM*dy*k
  276.             end
  277.           else                     {black hole}
  278.             begin
  279.               ax:=ax-pl[i].GM*dx*(k+sqr(k*dr));
  280.               ay:=ay-pl[i].GM*dy*(k+sqr(k*dr));
  281.             end;
  282.         end;
  283.       vx:=vx+ax*dt; vy:=vy+ay*dt;
  284.       event:=0;
  285.       if keypressed then
  286.         event:=1
  287.       else if (x>=screen.sx) and (x<=screen.ex) and        {in screen bounds?}
  288.               (y>=screen.sy) and (y<=screen.ey) then
  289.          begin
  290.            donecritical:=false;
  291.            i:=GetPixel(round(x),round(y));
  292.            if (i=color[1]) or (i=color[2]) or (i=color[3]) or
  293.               (i=LightRed) or (i=LightGray) then event:=2
  294.            else
  295.              if offscreen then
  296.                MoveTo(round(x),round(y))
  297.              else
  298.                LineTo(round(x),round(y));
  299.            offscreen:=false;
  300.          end                                               {off screen}
  301.       else if not donecritical then
  302.         begin
  303.           offscreen:=true;               {offscreen and critical distance}
  304.           dx:=x-screen.cx; dy:=y-screen.cy; dr:=sqrt(sqr(dx)+sqr(dy));
  305.           if dr>=criticaldist then
  306.             begin
  307.               vc:=(dx*vx+dy*vy)/dr;
  308.               k:=0; for i:=1 to np do k:=k+pl[i].GM;
  309.               if 0.5*sqr(vc)>=k/dr then     {do we have escape velocity?}
  310.                 event:=3;
  311.             end;
  312.         end;
  313.     Until event<>0;
  314.     if event=1 then          {a key was pressed for a break}
  315.       begin
  316.         ClearDialogBox;
  317.         ch:=ReadKey; {one already in buffer}
  318.         SetColor(LightGray);
  319.         OutTextXY(0,0,'Break... Esc to break, any other key to continue');
  320.         ch:=ReadKey;
  321.         if ch=Esc then exit;
  322.       end
  323.     else if event=3 then       {missile escaped the universe}
  324.       begin
  325.         ClearDialogBox;
  326.         SetColor(LightGray);
  327.         OutTextXY(0,0,'Missile left the galaxy...');
  328.         delay(2000);
  329.       end
  330.     else           {event=2}   {hit something}
  331.       begin
  332.         if (i=color[1]) or (i=color[2]) or (i=color[3]) then  {hit a planet}
  333.           begin
  334.             for i:=1 to number_of_explosion_dots do     {draw explosion}
  335.               begin
  336.                 buffer[i].x:=trunc(x+20*(Random-0.5));
  337.                 buffer[i].y:=trunc(y+20*(Random-0.5));
  338.                 buffer[i].color:=GetPixel(buffer[i].x,buffer[i].y);
  339.                 PutPixel(buffer[i].x,buffer[i].y,LightRed);
  340.                 delay(25);
  341.               end;
  342.             delay(1000);
  343.             for i:=1 to number_of_explosion_dots do     {erase explosion}
  344.               PutPixel(buffer[i].x,buffer[i].y,buffer[i].color);
  345.           end
  346.         else    {hit a ship!}
  347.           begin
  348.             if sqrt(sqr(x-ship[1].imagex-ship[1].coffx)+ {which one won?}
  349.                     sqr(y-ship[1].imagey-ship[1].coffy))<=ship[1].r+5 then
  350.                       winner:=2
  351.             else winner:=1;
  352.             for event:=1 to 100 do          {flash the screen}
  353.               SetPalette(Black,Random(16));
  354.             SetPalette(Black,Black);
  355.             for i:=1 to 1000 do    {put some white and red points}
  356.               begin
  357.                 k:=Random*2*pi;
  358.                 event:=Random(3);
  359.                 if event=0 then
  360.                   PutPixel(trunc(x+30*Random*cos(k)),trunc(y+30*Random*sin(k)),Black)
  361.                 else if event=1 then
  362.                   PutPixel(trunc(x+30*Random*cos(k)),trunc(y+30*Random*sin(k)),Red)
  363.                 else
  364.                   PutPixel(trunc(x+20*Random*cos(k)),trunc(y+20*Random*sin(k)),White);
  365.               end;
  366.             ClearDialogBox;
  367.             SetColor(LightGray);
  368.             str(winner,s);
  369.             s:=concat('Player ',s,' wins!!!');    {announce}
  370.             OutTextXY(0,0,s);
  371.             if playsong then                      {play a tune}
  372.               begin
  373.                 Sound(440); delay(150);
  374.                 Nosound; delay(50);
  375.                 Sound(440); delay(150);
  376.                 Sound(554); delay(150);
  377.                 Sound(659); delay(350);
  378.                 Sound(554); delay(150);
  379.                 Sound(659); delay(450);
  380.                 Nosound; delay(500);
  381.                 Sound(880); delay(800);
  382.                 Nosound;
  383.               end;
  384.             delay(3000);
  385.             exit;
  386.           end;
  387.       end; {if event=3}
  388.     Inc(player); if player=3 then player:=1;    {next player}
  389.   Until true=false; {infinite loop}
  390. end;
  391.  
  392. Procedure PlayingtheGame;     {playing the game menu}
  393. var option : char;
  394. begin
  395.   Repeat
  396.     ClearDialogBox;
  397.     SetColor(LightGray);
  398.     OutTextXY(0,0,'1. Random setup   2. Play game    Esc quits menu');
  399.     OutTextXY(0,10,'Option: ');
  400.     option:=ReadKey;
  401.     Case option of
  402.       '1' : begin
  403.               ClearDialogBox;
  404.               RandomSetup;
  405.               DrawSetup;
  406.             end;
  407.       '2' : PlayGame;
  408.     end;
  409.   Until option=Esc;
  410. end;
  411.  
  412. Procedure Options;   {options menu}
  413. var option : char;
  414. begin
  415.   Repeat
  416.     ClearDialogBox;
  417.     SetColor(LightGray);
  418.     OutTextXY(0,0,'1. Redraw screen   2. Sound on/off     Esc quits menu');
  419.     OutTextXY(0,10,'Option: ');
  420.     option:=ReadKey;
  421.     Case option of
  422.       '1' : DrawSetUp;
  423.       '2' : playsong:=not playsong;
  424.     end;
  425.   Until option=Esc;
  426. end;
  427.  
  428. Procedure InterpKey(c:char; var x,y,coffx,coffy,r:longint;
  429.                             var jump:integer; var moveit:boolean);
  430. begin              {interprets keys for movement of pointer, mainly to save}
  431.   Case c of                {space due to shared code in many Change routines}
  432.     '+' : if jump<49 then Inc(jump,2);
  433.     '-' : if jump>2 then Dec(jump,2);
  434.     '8' : begin                              {up}
  435.             Dec(y,jump);
  436.             if InBounds(x+coffx,y+coffy,r) then
  437.               moveit:=true
  438.             else
  439.               Inc(y,jump);
  440.           end;
  441.     '2' : begin                              {down}
  442.             Inc(y,jump);
  443.             if InBounds(x+coffx,y+coffy,r) then
  444.               moveit:=true
  445.             else
  446.               Dec(y,jump);
  447.           end;
  448.     '4' : begin                              {left}
  449.             Dec(x,jump);
  450.             if InBounds(x+coffx,y+coffy,r) then
  451.               moveit:=true
  452.             else
  453.               Inc(x,jump);
  454.           end;
  455.     '6' : begin                              {right}
  456.             Inc(x,jump);
  457.             if InBounds(x+coffx,y+coffy,r) then
  458.               moveit:=true
  459.             else
  460.               Dec(x,jump);
  461.           end;
  462.   end; {case c of}
  463. end;
  464.  
  465. Procedure MoveShip;    {move a given ship to a new legal position}
  466. var c : char;
  467.     s,jump,j : integer;
  468.     x,y,xold,yold,a,b : longint;
  469.     legal,moveit : boolean;
  470. begin
  471.   ClearDialogBox;
  472.   SetColor(LightGray);
  473.   OutTextXY(0, 0,'Ships:  1. Enterprise   2. Klingon    Esc aborts');
  474.   OutTextXY(0,10,'Which ship? ');     {get the proper ship}
  475.   Repeat
  476.     c:=ReadKey;
  477.   Until (c='1') or (c='2') or (c=Esc);
  478.   if c=Esc then exit;
  479.   if c='1' then s:=1 else s:=2;
  480.   ClearDialogBox;
  481.   OutTextXY(0, 0,'Use cursors to move ship. (Num Lock on)   Esc aborts');
  482.   OutTextXY(0,10,'Enter to place, + and - to change size of jumps.');
  483.   jump:=30;
  484.   x:=ship[s].imagex; y:=ship[s].imagey;
  485.   Repeat    {loop until Esc or somewhere legal}
  486.     Repeat    {loop until Esc or RETURN}
  487.       Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
  488.                                (c='+') or (c='-') or (c=Return) or (c=Esc);
  489.       moveit:=false; xold:=x; yold:=y;
  490.       InterpKey(c,x,y,ship[s].coffx,ship[s].coffy,ship[s].r,jump,moveit);
  491.       if moveit then  {if can move the image,}
  492.         begin
  493.           PutImage(xold,yold,ship[s].imagepointr^,XORPut); {erase old}
  494.           PutImage(x,y,ship[s].imagepointr^,XORPut);       {draw new}
  495.           moveit:=false;
  496.         end;
  497.     Until (c=Return) or (c=Esc);
  498.     if c=Esc then                     {abort}
  499.       begin
  500.         PutImage(x,y,ship[s].imagepointr^,XORPut);
  501.         PutImage(ship[s].imagex,ship[s].imagey,ship[s].imagepointr^,NormalPut);
  502.         exit;
  503.       end;
  504.     a:=x+ship[s].coffx; b:=y+ship[s].coffy;
  505.     legal:=InBounds(a,b,ship[s].r);     {in bounds?}
  506.     for j:=1 to np do                   {in collision with any planets?}
  507.       if sqrt(sqr(a-pl[j].cx)+sqr(b-pl[j].cy))<=pl[j].r+ship[s].r+bhr then
  508.          legal:=false;
  509.     if not legal then                   {oops! not legal!}
  510.       begin
  511.         SetPalette(Black,White);
  512.         SetFillStyle(SolidFill,Black);
  513.         Bar(0,20,screen.ex,screen.sy-2);
  514.         delay(100);
  515.         SetPalette(Black,Black);
  516.         SetColor(LightGray);
  517.         OutTextXY(0,20,'Illegal ship position!');
  518.       end;
  519.   Until legal;
  520.   ship[s].imagex:=x; ship[s].imagey:=y;    {ok, place it there}
  521. end;
  522.  
  523. Procedure MovePlanet;   {move a planet}
  524. var c : char;
  525.     i,p,jump : integer;
  526.     x,y,xold,yold,minr,t,cxorig,cyorig : longint;
  527.     moveit,legal : boolean;
  528. begin
  529.   ClearDialogBox;
  530.   if np=0 then         {no planets!}
  531.     begin
  532.       OutTextXY(0,0,'No planets to move!');
  533.       delay(2000);
  534.       exit;
  535.     end;
  536.   OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
  537.   OutTextXY(0,10,'Enter to pick planet, + and - to change size of jumps.');
  538.   jump:=30;
  539.   x:=100; y:=100; PutImage(x,y,pointr.imagepointr^,XORPut);
  540.   Repeat    {loop until Esc or RETURN}
  541.     Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
  542.                              (c='+') or (c='-') or (c=Return) or (c=Esc);
  543.     moveit:=false; xold:=x; yold:=y;
  544.     InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
  545.     if moveit then
  546.       begin
  547.         PutImage(xold,yold,pointr.imagepointr^,XORPut);
  548.         PutImage(x,y,pointr.imagepointr^,XORPut);
  549.         moveit:=false;
  550.       end;
  551.   Until (c=Return) or (c=Esc);
  552.   PutImage(x,y,pointr.imagepointr^,XORPut);   {erase pointer}
  553.   if c=Esc then exit;
  554.   p:=0; minr:=trunc(sqrt(sqr(screen.lx)+sqr(screen.ly)));
  555.   for i:=1 to np do   {find the closest planet/black hole}
  556.     begin
  557.       t:=trunc(sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy)));
  558.       if t<minr then begin minr:=t; p:=i; end;
  559.     end;
  560.   SetColor(LightGreen);                      {clear it out}
  561.   Circle(pl[p].cx,pl[p].cy,pl[p].r);
  562.   SetFillStyle(SolidFill,Black);
  563.   FloodFill(pl[p].cx,pl[p].cy,LightGreen);
  564.   SetColor(Black);
  565.   Circle(pl[p].cx,pl[p].cy,pl[p].r);
  566.   ClearDialogBox;
  567.   SetColor(LightGray);
  568.   OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
  569.   OutTextXY(0,10,'Enter to place planet center, + - change size of jumps.');
  570.   jump:=30;
  571.   x:=100; y:=100; PutImage(x,y,pointr.imagepointr^,XORPut);
  572.   cxorig:=pl[p].cx; cyorig:=pl[p].cy;   {save them as they may change later}
  573.   Repeat    {loop until Esc or legal position}
  574.     Repeat
  575.       Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
  576.                                (c='+') or (c='-') or (c=Return) or (c=Esc);
  577.       moveit:=false; xold:=x; yold:=y;
  578.       InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
  579.       if moveit then
  580.         begin
  581.           PutImage(xold,yold,pointr.imagepointr^,XORPut);
  582.           PutImage(x,y,pointr.imagepointr^,XORPut);
  583.           moveit:=false;
  584.         end;
  585.     Until (c=Return) or (c=Esc);
  586.     legal:=true;
  587.     if c<>Esc then    {ok, RETURN pressed}
  588.       begin
  589.         pl[p].cx:=-1000; pl[p].cy:=-1000;  {so it won't collide with itself!}
  590.         for i:=1 to np do   {any collisions with other planets?}
  591.           if sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy))<=pl[i].r+pl[p].r+2*bhr then
  592.             legal:=false;
  593.         for i:=1 to 2 do    {any collisions with other ships?}
  594.           if sqrt(sqr(x-ship[i].imagex-ship[i].coffx)+
  595.                   sqr(y-ship[i].imagey-ship[i].coffy))<=pl[p].r+ship[i].r+bhr
  596.              then legal:=false;
  597.       end;
  598.     if not legal then      {oops!}
  599.       begin
  600.         SetPalette(Black,White);
  601.         SetFillStyle(SolidFill,Black);
  602.         Bar(0,20,screen.ex,screen.sy-2);
  603.         delay(100);
  604.         SetPalette(Black,Black);
  605.         SetColor(LightGray);
  606.         OutTextXY(0,20,'Illegal planet position!');
  607.       end;
  608.   Until legal;
  609.   pl[p].cx:=x; pl[p].cy:=y; {put it there}
  610.   if c=Esc then             {abort and restore}
  611.     begin
  612.       pl[p].cx:=cxorig;
  613.       pl[p].cy:=cyorig;
  614.     end;
  615.   DrawSetUp;                {redraw screen}
  616. end;
  617.  
  618. Procedure MakePlanet;       {make a planet given center and radius}
  619. var c : char;
  620.     i,p,jump : integer;
  621.     x,y,xold,yold : longint;
  622.     moveit,legal : boolean;
  623. begin
  624.   ClearDialogBox;
  625.   if np=9 then       {too many planets already!}
  626.     begin
  627.       OutTextXY(0,0,'Can not make any more planets!');
  628.       delay(2000);
  629.       exit;
  630.     end;
  631.   OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
  632.   OutTextXY(0,10,'Enter to place center, + and - to change size of jumps.');
  633.   jump:=30;
  634.   x:=100; y:=100; PutImage(x,y,pointr.imagepointr^,XORPut);
  635.   Repeat   {loop until a legal center is picked or Esc}
  636.     Repeat
  637.       Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
  638.                                (c='+') or (c='-') or (c=Return) or (c=Esc);
  639.       moveit:=false; xold:=x; yold:=y;
  640.       InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
  641.       if moveit then
  642.         begin
  643.           PutImage(xold,yold,pointr.imagepointr^,XORPut);
  644.           PutImage(x,y,pointr.imagepointr^,XORPut);
  645.           moveit:=false;
  646.         end;
  647.     Until (c=Return) or (c=Esc);
  648.     if c=Esc then exit;
  649.     legal:=true;
  650.     for i:=1 to np do    {any collisions with planets?}
  651.       if sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy))<=pl[i].r+2*bhr then
  652.         legal:=false;
  653.     for i:=1 to 2 do     {any collisions with ships?}
  654.       if sqrt(sqr(x-ship[i].imagex-ship[i].coffx)+
  655.               sqr(y-ship[i].imagey-ship[i].coffy))<=ship[i].r+bhr
  656.          then legal:=false;
  657.     if not legal then                    {uh oh!}
  658.       begin
  659.         SetPalette(Black,White);
  660.         SetFillStyle(SolidFill,Black);
  661.         Bar(0,20,screen.ex,screen.sy-2);
  662.         delay(100);
  663.         SetPalette(Black,Black);
  664.         SetColor(LightGray);
  665.         OutTextXY(0,20,'Illegal planet center!');
  666.       end;
  667.   Until legal;
  668.   p:=np+1; pl[p].cx:=x; pl[p].cy:=y;   {ok, store the info}
  669.   ClearDialogBox;
  670.   OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
  671.   OutTextXY(0,10,'Enter to radius, + and - change size of jumps.');
  672.   jump:=30;
  673.   Repeat     {loop until a legal radius is entered or Esc}
  674.     Repeat
  675.       Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
  676.                                (c='+') or (c='-') or (c=Return) or (c=Esc);
  677.       moveit:=false; xold:=x; yold:=y;
  678.       InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
  679.       if moveit then
  680.         begin
  681.           PutImage(xold,yold,pointr.imagepointr^,XORPut);
  682.           PutImage(x,y,pointr.imagepointr^,XORPut);
  683.           moveit:=false;
  684.         end;
  685.     Until (c=Return) or (c=Esc);
  686.     if c=Esc then exit;
  687.     legal:=true;
  688.     pl[p].r:=round(sqrt(sqr(x-pl[p].cx)+sqr(y-pl[p].cy))); {find radius}
  689.     for i:=1 to np do    {planet collisions?}
  690.       if sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy))<=pl[p].r+pl[i].r+2*bhr then
  691.         legal:=false;
  692.     for i:=1 to 2 do     {ship collisions?}
  693.       if sqrt(sqr(x-ship[i].imagex-ship[i].coffx)+
  694.               sqr(y-ship[i].imagey-ship[i].coffy))<=pl[p].r+ship[i].r+bhr
  695.          then legal:=false;
  696.     if not legal then    {oh no!}
  697.       begin
  698.         SetPalette(Black,White);
  699.         SetFillStyle(SolidFill,Black);
  700.         Bar(0,20,screen.ex,screen.sy-2);
  701.         delay(100);
  702.         SetPalette(Black,Black);
  703.         SetColor(LightGray);
  704.         OutTextXY(0,20,'Illegal planet radius!');
  705.       end;
  706.   Until legal;
  707.   PutImage(x,y,pointr.imagepointr^,XORPut); {kill the pointer}
  708.   Inc(np);    {actually add the new planet info}
  709.   pl[p].d:=1.0; pl[p].GM:=G*2*pi*sqr(pl[p].r)*1.0; {initialize it}
  710.   SetColor(color[1]);                      {draw it}
  711.   Circle(pl[p].cx,pl[p].cy,pl[p].r);
  712.   SetFillStyle(SolidFill,color[1]);
  713.   FloodFill(pl[p].cx,pl[p].cy,color[1]);
  714. end;
  715.  
  716. Procedure ChangePlanet;   {change density [color] of a planet}
  717. var c : char;               {will not change black holes}
  718.     i,p,jump : integer;
  719.     x,y,xold,yold,minr,t : longint;
  720.     moveit,legal : boolean;
  721. begin
  722.   ClearDialogBox;
  723.   legal:=false;
  724.   if np>0 then             {see if any non-black holes exist}
  725.     for i:=1 to np do
  726.       if pl[i].r<>0 then legal:=true;
  727.   if (np=0) or (not legal) then   {sorry!}
  728.     begin
  729.       OutTextXY(0,0,'No planets to change!');
  730.       delay(2000);
  731.       exit;
  732.     end;
  733.   OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
  734.   OutTextXY(0,10,'Enter to pick planet, + and - to change size of jumps.');
  735.   jump:=30;
  736.   x:=100; y:=100; PutImage(x,y,pointr.imagepointr^,XORPut);
  737.   Repeat   {repeat until RETURN or Esc}
  738.     Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
  739.                              (c='+') or (c='-') or (c=Return) or (c=Esc);
  740.     moveit:=false; xold:=x; yold:=y;
  741.     InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
  742.     if moveit then
  743.       begin
  744.         PutImage(xold,yold,pointr.imagepointr^,XORPut);
  745.         PutImage(x,y,pointr.imagepointr^,XORPut);
  746.         moveit:=false;
  747.       end;
  748.   Until (c=Return) or (c=Esc);
  749.   PutImage(x,y,pointr.imagepointr^,XORPut);  {kill the pointer}
  750.   if c=Esc then exit;
  751.   p:=0; minr:=trunc(sqrt(sqr(screen.lx)+sqr(screen.ly)));
  752.   for i:=1 to np do   {find closest non-black hole planet}
  753.     begin
  754.       t:=trunc(sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy)));
  755.       if (t<minr) and (pl[i].r<>0) then begin minr:=t; p:=i; end;
  756.     end;
  757.   ClearDialogBox;
  758.   OutTextXY(0, 0,'Change to: 1. Red   2. Green   3. Blue    Esc aborts');
  759.   OutTextXY(0,10,'Option: ');    {get a density}
  760.   Repeat c:=ReadKey; Until (c='1') or (c='2') or (c='3') or (c=Esc);
  761.   if c=Esc then exit;
  762.   i:=Ord(c)-48;
  763.   pl[p].d:=(i+1)/2.0;       {new density}
  764.   SetColor(color[i]);       {redraw}
  765.   Circle(pl[p].cx,pl[p].cy,pl[p].r);
  766.   SetFillStyle(SolidFill,color[i]);
  767.   FloodFill(pl[p].cx,pl[p].cy,color[i]);
  768. end;
  769.  
  770. Procedure DeletePlanet;   {kill a planet/black hole}
  771. var c : char;
  772.     i,p,jump : integer;
  773.     x,y,xold,yold,minr,t : longint;
  774.     moveit : boolean;
  775. begin
  776.   ClearDialogBox;
  777.   if np=0 then    {nobody there!}
  778.     begin
  779.       OutTextXY(0,0,'No planets to delete!');
  780.       delay(2000);
  781.       exit;
  782.     end;
  783.   OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
  784.   OutTextXY(0,10,'Enter to pick planet, + and - to change size of jumps.');
  785.   jump:=30;
  786.   x:=100; y:=100; PutImage(x,y,pointr.imagepointr^,XORPut);
  787.   Repeat
  788.     Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
  789.                              (c='+') or (c='-') or (c=Return) or (c=Esc);
  790.     moveit:=false; xold:=x; yold:=y;
  791.     InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
  792.     if moveit then
  793.       begin
  794.         PutImage(xold,yold,pointr.imagepointr^,XORPut);
  795.         PutImage(x,y,pointr.imagepointr^,XORPut);
  796.         moveit:=false;
  797.       end;
  798.   Until (c=Return) or (c=Esc);
  799.   PutImage(x,y,pointr.imagepointr^,XORPut);
  800.   if c=Esc then exit;
  801.   p:=0; minr:=trunc(sqrt(sqr(screen.lx)+sqr(screen.ly)));
  802.   for i:=1 to np do  {find the closest planet/black hole}
  803.     begin
  804.       t:=trunc(sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy)));
  805.       if t<minr then begin minr:=t; p:=i; end;
  806.     end;
  807.   if p<9 then           {move everybody above the one deleted one down}
  808.     for i:=p to np-1 do
  809.       pl[i]:=pl[i+1];
  810.   Dec(np);         {delete}
  811.   DrawSetup;       {redraw}
  812. end;
  813.  
  814. Procedure Changes;   {changes menu}
  815. var option : char;
  816. begin
  817.   Repeat
  818.     ClearDialogBox;
  819.     SetColor(LightGray);
  820.     OutTextXY(0, 0,'1. Move ship       2. Move planet    3. Make planet');
  821.     OutTextXY(0,10,'4. Change planet   5. Delete planet     Esc quits menu');
  822.     OutTextXY(0,20,'Option: ');
  823.     option:=ReadKey;
  824.     Case option of
  825.       '1' : MoveShip;
  826.       '2' : MovePlanet;
  827.       '3' : MakePlanet;
  828.       '4' : ChangePlanet;
  829.       '5' : DeletePlanet;
  830.     end;
  831.   Until option=Esc;
  832. end;
  833.  
  834. Procedure MainMenu;   {main menu}
  835. var option : char;
  836. begin
  837.   Repeat
  838.     ClearDialogBox;
  839.     SetColor(LightGray);
  840.     OutTextXY(0,0,'1. Playing the game   2. Options   3. Changes   4. Quit');
  841.     OutTextXY(0,10,'Option: ');
  842.     option:=ReadKey;
  843.     Case option of
  844.       '1' : PlayingtheGame;
  845.       '2' : Options;
  846.       '3' : Changes;
  847.     end;
  848.   Until option='4';
  849. end;
  850.  
  851. Procedure Title;   {title screen and credits}
  852. begin
  853.   SetTextStyle(SansSerifFont,HorizDir,9);
  854.   OutTextXY(25,100,'Gravity Wars');
  855.   SetTextStyle(SansSerifFont,HorizDir,2);
  856.   OutTextXY(300,300,'by Sohrab Ismail-Beigi');
  857.   delay(3000);
  858.   SetTextStyle(DefaultFont,HorizDir,0);
  859. end;
  860.  
  861. BEGIN
  862.   Init;
  863.   Title;
  864.   RandomSetup;
  865.   DrawSetup;
  866.   MainMenu;
  867.   Finish;
  868. END.
  869.