home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TEGA02.ZIP / CIRCLE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-02-01  |  2.1 KB  |  80 lines
  1. {                                                                             }
  2. {       EGA Graphic Primitive for Turbo Pascal 3.01A, Version 01FEB86.        }
  3. {       (C) 1986 by Kent Cedola, 2015 Meadow Lake Ct., Norfolk, VA, 23518     }
  4. {                                                                             }
  5. {       Please note the current version is in assembler, the below is the     }
  6. {       algorithm used for the high-speed assembler version.  Long integers   }
  7. {       are used instead of real number. (DX:AX).                             }
  8. {                                                                             }
  9. {       See Dr. Dobbs Journal, December 1983, pp. 18. for BASIC source code.  }
  10. {                                                                             }
  11.  
  12. procedure GPCIR(R: Integer);          { Same format for final version }
  13. var
  14.   BE,XD,YD,DX,DY,ER,TX,TY,TB: Real;
  15.   AE,YC,XF1,XF2,YF,X,Y: Integer;
  16. begin
  17.  
  18.   X := GDCUR_X;
  19.   Y := GDCUR_Y;
  20.  
  21.   AE := R;
  22.   BE := R * GDASPC1 div GDASPC2;
  23.  
  24.   YC  := GDCUR_Y;
  25.   XF1 := GDCUR_X;
  26.   XF2 := GDCUR_X;
  27.   YF  := Round(BE);
  28.   XD  := BE * BE;
  29.  
  30.   YD := (2 * BE - 1) * AE * AE;
  31.  
  32.   DX := 2 * BE * BE;
  33.   DY := 2 * AE * AE;
  34.   ER := 0;
  35.  
  36.   GPPLOT(XF1,YC+YF);            { GPPLOT does the clipping for us }
  37.   GPPLOT(XF1,YC-YF);
  38.   GPPLOT(XF2,YC+YF);
  39.   GPPLOT(XF2,YC-YF);
  40.  
  41.   repeat
  42.  
  43.     TX := ER + XD;
  44.     TY := ER - YD;
  45.     TB := ER + XD - YD;
  46.     if (abs(TX) < abs(TY)) and (abs(TX) < abs(TB)) then
  47.       begin
  48.       XF1 := XF1 + 1;
  49.       XF2 := XF2 - 1;
  50.       ER  := TX;
  51.       XD  := XD + DX;
  52.       end
  53.     else if (abs(TY) < abs(TX)) and (abs(TY) < abs(TB)) then
  54.       begin
  55.       YF := YF - 1;
  56.       ER := TY;
  57.       YD := YD - DY;
  58.       end
  59.     else
  60.       begin
  61.       XF1 := XF1 + 1;
  62.       XF2 := XF2 - 1;
  63.       YF  := YF - 1;
  64.       ER  := TB;
  65.       YD  := YD - DY;
  66.       XD  := XD + DX;
  67.       end;
  68.  
  69.     GPPLOT(XF1,YC+YF);
  70.     GPPLOT(XF1,YC-YF);
  71.     GPPLOT(XF2,YC+YF);
  72.     GPPLOT(XF2,YC-YF);
  73.  
  74.   until YF = 0;
  75.  
  76.   GDCUR_X := X;
  77.   GDCUR_Y := Y;
  78.  
  79. end;
  80.