home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / BEEHIVE / UTILITYS / PUDD.ARC / PUDD-07.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-11  |  5KB  |  158 lines
  1. {****************************************************************************}
  2. {*  InBounds will return true if the point specified (x,y) is on the screen *}
  3. {****************************************************************************}
  4. function InBounds(x,y:integer):boolean;
  5. begin
  6.  if (x >= 0) and (x < 640) and (y >= 0) and (y < 240) then
  7.   InBounds := true
  8.  else
  9.   InBounds := false;
  10. end;
  11.  
  12. {****************************************************************************}
  13. {*  Angle will return the angle in radians between the line from point 1 to *}
  14. {*  point 2 and the horizontal axis.  In correspondence with normal geometry }
  15. {*  the angle is measured counterclock-wise.                                *}
  16. {****************************************************************************}
  17. function  Angle(x1,y1,x2,y2 :integer):real;
  18. var theta :real;
  19. begin
  20.  charcolor(1);
  21.  if (xPoz-x1 = 0) then   {....vertical line }
  22.   if (yPoz > y1) then
  23.     theta := 1.5707963          {.......which points up }
  24.   else
  25.     theta := -1.5707936         {.......which points down }
  26.  else
  27.    theta := arctan((2*(yPoz-y1))/(xPoz-x1));
  28.  if (xPoz < x1) then    {....angle is greater than 90 }
  29.   begin
  30.     begin
  31.      theta := 3.1415927 + theta;   {...in The2nd or 3rd quardents }
  32.     end
  33.   end;
  34.  if (theta < 0) then
  35.   theta := theta + 6.2831853;
  36.  angle := theta;
  37. end;
  38.  
  39. {****************************************************************************}
  40. {* vectorPoint will draw a single point which is 'length' away from point  **}
  41. {* x,y at angle 'angle'.                                                   **}
  42. {****************************************************************************}
  43. procedure vectorPoint(x,y:integer;angle,length:real);
  44. var Xpoint,Ypoint     :integer;
  45. begin
  46.  Xpoint := x + round(2 * length * cos(angle));
  47.  Ypoint := y + round(length * sin(angle));
  48.  if InBounds(Xpoint,Ypoint) then
  49.   begin
  50.    Moveto(Xpoint,Ypoint);
  51.    Drawto(Xpoint,Ypoint);
  52.   end;
  53. end;
  54.  
  55. {****************************************************************************}
  56. {*  Arc will draw some or all of a circle                                  **}
  57. {****************************************************************************}
  58. procedure arc(centerX,centerY:integer);
  59. const  MaxReal = 99e30;
  60.        Pi      = 3.141592654;
  61. var X,Y                              :integer;
  62.     The1stAngle, The2ndAngle, radius :real;
  63.     deltaX,deltaY                    :real;
  64.     step                             :real;
  65. begin
  66.  The1stAngle := MaxReal; {...............initalize to some absurd number }
  67.  The2ndAngle := MaxReal;
  68.  repeat
  69.    repeat
  70.     read(kbd,response);
  71.     response := UpCase(response);
  72.     case response of
  73.      'S':SetSpeed(speed);
  74.      '5':SetSpeed(speed);
  75.      '1'..'9':begin
  76.                reInitXhair(size,xpoz,ypoz);
  77.                MoveCross(size,speed,response,xPoz,yPoz);
  78.               end;
  79.     end;     {.....case }
  80.    until pos(response,'S123456789') = 0; {...any key but a curser key }
  81.    if The1stAngle = MaxReal then  {......1st angle still not selected }
  82.     begin
  83.      The1stAngle := angle(centerX,centerY,xPoz,yPoz);
  84.      deltaX := centerX - Xpoz;
  85.      deltaY := 2 * (centerY - Ypoz);
  86.      radius := sqrt(deltaX*deltaX + deltaY*deltaY)/2;
  87.     end
  88.    else
  89.     The2ndAngle := angle(centerX,centerY,xPoz,yPoz); {..select 2nd angle }
  90.  until The2ndAngle <> MaxReal;
  91.  if radius <> 0 then      {..this avoids division by 0 for a radius of r=0 }
  92.    step := 1/(2 * radius) {...........minimum step is a chord of one pixel }
  93.  else
  94.    step := 2*Pi;
  95.  offXhair(size,xPoz,yPoz);
  96.  if (The1stAngle = The2ndAngle) then
  97.   begin
  98.    AlphaMode;
  99.    clrscr;
  100.    gotoXY(20,19);
  101.    write('Do you want ..........');
  102.    gotoXY(22,21);
  103.    write('1) a full circle    ');
  104.    gotoXY(25,22);
  105.    write('or');
  106.    gotoXY(22,23);
  107.    write('2) no circle');
  108.    repeat
  109.     read(kbd,response);
  110.    until (response = '1') or (response = '2');
  111.    initgraph;
  112.    if response = '1' then
  113.     begin
  114.       The1stAngle := The1stAngle - 2 * Pi;
  115.       repeat
  116.         vectorPoint(centerx,centery,The1stAngle,radius);
  117.         The1stAngle := The1stAngle + step;
  118.       until The1stAngle >= The2ndAngle
  119.     end;
  120.   end
  121. else
  122.  begin
  123.    AlphaMode;
  124.    clrscr;
  125.    gotoXY(20,19);
  126.    write('From the first point given on the arc should I draw...');
  127.    gotoXY(22,21);
  128.    write('1) Counter Clockwise');
  129.    gotoXY(25,22);
  130.    write('or');
  131.    gotoXY(22,23);
  132.    write('2) Clockwise');
  133.    repeat
  134.     read(kbd,response);
  135.    until (response = '1') or (response = '2');
  136.    initgraph;
  137.    if response = '1' then
  138.      begin
  139.        if The1stAngle > The2ndAngle then {..set the limit of the loop }
  140.          The2ndAngle := The2ndAngle + (2 * Pi);
  141.        repeat
  142.         vectorPoint(centerx,centery,The1stAngle,radius);
  143.         The1stAngle := The1stAngle + step;
  144.        until The1stAngle >= The2ndAngle;  {..until we reach limit of loop }
  145.      end
  146.    else
  147.     begin
  148.      if The1stAngle < The2ndAngle then
  149.       The2ndAngle := The2ndAngle - 2 * Pi;
  150.       repeat
  151.        vectorPoint(centerx,centery,The1stAngle,radius);
  152.        The1stAngle := The1stAngle - step;
  153.       until The1stAngle <= The2ndAngle;
  154.     end;
  155.  end;
  156. initXhair(size,xPoz,yPoz);
  157. end;
  158.