Browse Source

* fixed Arc: internallellipse went into an endless loop if StAngle =
EndAngle
* FillEllipse is now much faster: no more floodfill,
InternalEllipseDefault now draws the patternlines immediatety!

Jonas Maebe 26 years ago
parent
commit
66e28ab9c1
1 changed files with 157 additions and 136 deletions
  1. 157 136
      rtl/inc/graph/graph.pp

+ 157 - 136
rtl/inc/graph/graph.pp

@@ -471,7 +471,7 @@ TYPE
        { this routine is used to draw all circles/ellipses/sectors     }
        { this routine is used to draw all circles/ellipses/sectors     }
        { more info... on this later...                                 }
        { more info... on this later...                                 }
        ellipseproc = procedure (X,Y: Integer;XRadius: word;
        ellipseproc = procedure (X,Y: Integer;XRadius: word;
-         YRadius:word; stAngle,EndAngle: word);
+         YRadius:word; stAngle,EndAngle: word; fp: PatternLineProc);
 
 
        { Line routine - draws lines thick/norm widths with current     }
        { Line routine - draws lines thick/norm widths with current     }
        { color and line style - LINE must be clipped here.             }
        { color and line style - LINE must be clipped here.             }
@@ -504,6 +504,7 @@ TYPE
          procedure(ColorNum: integer; var
          procedure(ColorNum: integer; var
             RedValue, GreenValue, BlueValue: Integer);
             RedValue, GreenValue, BlueValue: Integer);
 
 
+
 TYPE
 TYPE
     {-----------------------------------}
     {-----------------------------------}
     { Linked list for mode information  }
     { Linked list for mode information  }
@@ -1270,6 +1271,18 @@ var
  end;  { Line }
  end;  { Line }
 
 
 
 
+  {********************************************************}
+  { Procedure DummyPatternLine()                           }
+  {--------------------------------------------------------}
+  { This is suimply an procedure that does nothing which   }
+  { can be passed as a patternlineproc for non-filled      }
+  { ellipses                                               }
+  {********************************************************}
+  Procedure DummyPatternLine(x1, x2, y: integer); {$ifdef tp} far; {$endif tp}
+  begin
+  end;
+
+
   {********************************************************}
   {********************************************************}
   { Procedure InternalEllipse()                            }
   { Procedure InternalEllipse()                            }
   {--------------------------------------------------------}
   {--------------------------------------------------------}
@@ -1284,13 +1297,15 @@ var
   {  YRadius - Y-Axis radius of ellipse.                   }
   {  YRadius - Y-Axis radius of ellipse.                   }
   {  stAngle, EndAngle: Start angle and end angles of the  }
   {  stAngle, EndAngle: Start angle and end angles of the  }
   {  ellipse (used for partial ellipses and circles)       }
   {  ellipse (used for partial ellipses and circles)       }
+  {  pl: procedure which either draws a patternline (for   }
+  {      FillEllipse) or does nothing (arc etc)            }
   {--------------------------------------------------------}
   {--------------------------------------------------------}
   { NOTE: - uses the current write mode.                   }
   { NOTE: - uses the current write mode.                   }
   {       - Angles must both be between 0 and 360          }
   {       - Angles must both be between 0 and 360          }
   {********************************************************}
   {********************************************************}
 
 
   Procedure InternalEllipseDefault(X,Y: Integer;XRadius: word;
   Procedure InternalEllipseDefault(X,Y: Integer;XRadius: word;
-    YRadius:word; stAngle,EndAngle: word); far;
+    YRadius:word; stAngle,EndAngle: word; pl: PatternLineProc); far;
    var
    var
     j,Delta, DeltaEnd: graph_float;
     j,Delta, DeltaEnd: graph_float;
     NumOfPixels: longint;
     NumOfPixels: longint;
@@ -1302,7 +1317,25 @@ var
     DeltaAngle: word;
     DeltaAngle: word;
     xtemp, ytemp, xp, yp, xm, ym: integer;
     xtemp, ytemp, xp, yp, xm, ym: integer;
     q1p, q2p, q3p, q4p: PointType;
     q1p, q2p, q3p, q4p: PointType;
+    BackupColor, OldLineWidth: word;
   Begin
   Begin
+   If LineInfo.ThickNess = ThickWidth Then
+    { first draw the two outer ellipses using normwidth and no filling (JM) }
+     Begin
+       OldLineWidth := LineInfo.Thickness;
+       LineInfo.Thickness := NormWidth;
+       InternalEllipseDefault(x,y,XRadius+2,YRadius+2,StAngle,EndAngle,
+                              {$ifdef fpc}@{$endif fpc}DummyPatternLine);
+       InternalEllipseDefault(x,y,XRadius+1,YRadius+1,StAngle,EndAngle,
+                              {$ifdef fpc}@{$endif fpc}DummyPatternLine);
+       { restore line thickness }
+       LineInfo.Thickness := OldLineWidth;
+     End;
+   { Get End and Start points into the ArcCall information record }
+   ArcCall.X := X;
+   ArcCall.Y := Y;
+   { for restoring after PatternLine }
+   BackupColor := CurrentColor;
    With q1p Do
    With q1p Do
      Begin
      Begin
        x := $7fff;
        x := $7fff;
@@ -1339,121 +1372,90 @@ var
      end;
      end;
    { calculate difference of angle now so we don't always have to calculate it }
    { calculate difference of angle now so we don't always have to calculate it }
    DeltaAngle:= EndAngle-StAngle;
    DeltaAngle:= EndAngle-StAngle;
-   if LineInfo.Thickness=NormWidth then
+   { approximate the number of pixels required by using the circumference }
+   { equation of an ellipse.                                              }
+   { In the worst case, we have to calculate everything from the }
+   { quadrant, so divide the circumference value by 4 (JM)       }
+   NumOfPixels:=(8 div 4)*Round(2.5*sqrt((sqr(XRadius)+sqr(YRadius)) div 2));
+   { Calculate the angle precision required }
+   { Note: to get the same precision as before, we have to divide by an }
+   { extra 4 (JM)                                                       }
+   Delta := DeltaAngle / (NumOfPixels*4);
+   { Adjust for screen aspect ratio }
+   XRadius:=(longint(XRadius)*10000) div XAspect;
+   YRadius:=(longint(YRadius)*10000) div YAspect;
+   { removed from inner loop to make faster }
+   ConvFac:=Pi/180.0;
+   { store some arccall info }
+   TempTerm := (Delta+StAngle)*ConvFac;
+   ArcCall.XStart := round(XRadius*Cos(TempTerm)) + X;
+   ArcCall.XEnd := ArcCall.XStart;
+   ArcCall.YStart := round(YRadius*Sin(TempTerm+Pi)) + Y;
+   ArcCall.YEnd := ArcCall.YStart;
+   { otherwise we get an endless loop }
+   If DeltaAngle = 0 Then
      Begin
      Begin
-       { approximate the number of pixels required by using the circumference }
-       { equation of an ellipse.                                              }
-       { In the worst case, we have to calculate everything from the }
-       { quadrant, so divide the circumference value by 4 (JM)       }
-       NumOfPixels:=(8 div 4)*Round(2.5*sqrt((sqr(XRadius)+sqr(YRadius)) div 2));
-       { Calculate the angle precision required }
-       { Note: to get the same precision as before, we have to divide by an }
-       { extra 4 (JM)                                                       }
-       Delta := DeltaAngle / (NumOfPixels*4);
-       { Adjust for screen aspect ratio }
-       XRadius:=(longint(XRadius)*10000) div XAspect;
-       YRadius:=(longint(YRadius)*10000) div YAspect;
-       { removed from inner loop to make faster }
-       ConvFac:=Pi/180.0;
-       { store some arccall info }
-       { Initial counter value }
-       TempTerm := (Delta+StAngle)*ConvFac;
-       ArcCall.XStart := round(XRadius*Cos(TempTerm)) + X;
-       ArcCall.XEnd := ArcCall.XStart;
-       ArcCall.YStart := round(YRadius*Sin(TempTerm+Pi)) + Y;
-       ArcCall.YEnd := ArcCall.YStart;
-
-       { convert the DeltaAngle to the new boundaries (JM) }
-       j := Delta;
-       DeltaAngle := 90;
-       { calculate stop position (JM)}
-       DeltaEnd := j + DeltaAngle;
-       Repeat
-             { this is used by both sin and cos }
-             TempTerm := j*ConvFac;
-             { Calculate points }
-             xtemp := round(XRadius*Cos(TempTerm));
-             ytemp := round(YRadius*Sin(TempTerm+Pi));
-
-             xp := x + xtemp;
-             xm := x - xtemp;
-             yp := y + ytemp;
-             ym := y - ytemp;
-             If (j >= StAngle) and (j <= EndAngle) then
-               begin
-                 q1p.x := xp;
-                 q1p.y := yp;
-                 PutPixel(xp,yp,CurrentColor);
-               end;
-             If ((180-j) >= StAngle) and ((180-j) <= EndAngle) then
-               begin
-                 If (q2p.x = $7fff) then
-                   Begin
-                     q2p.x := xm;
-                     q2p.y := yp;
-                   End;
-                 PutPixel(xm,yp,CurrentColor);
-               end;
-             If ((j+180) >= StAngle) and ((j+180) <= EndAngle) then
-               begin
-                 q3p.x := xm;
-                 q3p.y := ym;
-                 PutPixel(xm,ym,CurrentColor);
-               end;
-             If ((360-j) >= StAngle) and ((360-j) <= EndAngle) then
-               begin
-                 If (q4p.x = $7fff) then
-                   Begin
-                     q4p.x := xp;
-                     q4p.y := ym;
-                   End;
-                 PutPixel(xp,ym,CurrentColor);
-               end;
-             j:=j+Delta;
-       Until j > (DeltaEnd);
-     end
-   else
-   {******************************************}
-   {  CIRCLE OR ELLIPSE WITH THICKNESS=3      }
-   {******************************************}
-    Begin
-      Writeln('thickness 3');
-      NumOfPix[1]:=2*Round(2.5*sqrt((sqr(XRadius)+sqr(YRadius)) div 2));
-      NumOfPix[0]:=2*Round(2.5*sqrt((sqr(XRadius-1)+sqr(YRadius-1)) div 2));
-      NumOfPix[2]:=2*Round(2.5*sqrt((sqr(XRadius+1)+sqr(YRadius+1)) div 2));
-      { removed from inner loop to make faster }
-      ConvFac:=Pi/180.0;
-      for Count:=0 to 2 do
-        Begin
-          aval:=XRadius+Count-1;
-          bval:=YRadius+Count-1;
-          Delta := DeltaAngle / (4*NumOfPix[Count]);
-          aval:= (longint(aval)*10000) div XAspect;
-          bval:= (longint(bval)*10000) div YAspect;
-          j:=Delta+Stangle;
-{ store some ArcCall info }
-          TempTerm := j*ConvFac;
-          ArcCall.XStart := round(aval*Cos(TempTerm)) + X;
-          ArcCall.YStart := round(bval*Sin(TempTerm)) + Y;
-{ plot ellipse }
-          Repeat
-            { this used by both sin and cos }
-            TempTerm := j*ConvFac;
-            xtemp:=round(aval*Cos(TempTerm));
-            ytemp:=round(bval*Sin(TempTerm));
-            PutPixel(x+xtemp,y+ytemp,CurrentColor);
-            PutPixel(x+xtemp,y-ytemp,CurrentColor);
-            PutPixel(x-xtemp,y+ytemp,CurrentColor);
-            PutPixel(x-xtemp,y-ytemp,CurrentColor);
-            j:=j+Delta;
-          Until j > (DeltaAngle/4);
-        end;
-    end;
-   {******************************************}
-   {  NOW ALL PIXEL POINTS ARE IN BUFFER      }
-   {  plot them all to the screen             }
-   {******************************************}
-   Count:=0;
+       Line(x,y,ArcCall.XStart,ArcCall.YStart);
+       exit
+     End;
+   { Always just go over the first 90 degrees. Could be optimized a   }
+   { bit if StAngle and EndAngle lie in the same quadrant, left as an }
+   { execrise for the reader :) (JM)                                  }
+   j := 0;
+   DeltaAngle := 90;
+   { calculate stop position (JM)}
+   DeltaEnd := j + DeltaAngle;
+   Repeat
+         { this is used by both sin and cos }
+         TempTerm := j*ConvFac;
+         { Calculate points }
+         xtemp := round(XRadius*Cos(TempTerm));
+         ytemp := round(YRadius*Sin(TempTerm+Pi));
+
+         xp := x + xtemp;
+         xm := x - xtemp;
+         yp := y + ytemp;
+         ym := y - ytemp;
+         If (j >= StAngle) and (j <= EndAngle) then
+           begin
+             q1p.x := xp;
+             q1p.y := yp;
+             PutPixel(xp,yp,CurrentColor);
+           end;
+         If ((180-j) >= StAngle) and ((180-j) <= EndAngle) then
+           begin
+             If (q2p.x = $7fff) then
+               Begin
+                 q2p.x := xm;
+                 q2p.y := yp;
+               End;
+             PutPixel(xm,yp,CurrentColor);
+           end;
+         If ((j+180) >= StAngle) and ((j+180) <= EndAngle) then
+           begin
+             q3p.x := xm;
+             q3p.y := ym;
+             PutPixel(xm,ym,CurrentColor);
+           end;
+         If ((360-j) >= StAngle) and ((360-j) <= EndAngle) then
+           begin
+             If (q4p.x = $7fff) then
+               Begin
+                 q4p.x := xp;
+                 q4p.y := ym;
+               End;
+             PutPixel(xp,ym,CurrentColor);
+           end;
+         If xp-xm >2 then
+           begin
+             CurrentColor := FillSettings.Color;
+             pl(xm+1,xp-1,yp);
+             pl(xm+1,xp-1,ym);
+             CurrentColor := BackupColor;
+           end;
+         j:=j+Delta;
+   Until j > (DeltaEnd);
+   { get the end of the arc (JM) }
    If q4p.x <> $7fff Then
    If q4p.x <> $7fff Then
      Begin
      Begin
        ArcCall.XEnd := q4p.x;
        ArcCall.XEnd := q4p.x;
@@ -1474,10 +1476,6 @@ var
        ArcCall.XEnd := q1p.x;
        ArcCall.XEnd := q1p.x;
        ArcCall.YEnd := q1p.y
        ArcCall.YEnd := q1p.y
      End;
      End;
-   { Get End and Start points into the ArcCall information record }
-   ArcCall.X := X;
-   ArcCall.Y := Y;
-
   end;
   end;
 
 
 
 
@@ -2092,7 +2090,6 @@ end;
 { ----------------------------------------------------------------- }
 { ----------------------------------------------------------------- }
 
 
 
 
-
   Procedure Arc(X,Y : Integer; StAngle,EndAngle,Radius: word);
   Procedure Arc(X,Y : Integer; StAngle,EndAngle,Radius: word);
 
 
    var
    var
@@ -2120,14 +2117,22 @@ end;
      OldWriteMode := CurrentWriteMode;
      OldWriteMode := CurrentWriteMode;
      if (LineInfo.Thickness = NormWidth) then
      if (LineInfo.Thickness = NormWidth) then
        CurrentWriteMode := NormalPut;
        CurrentWriteMode := NormalPut;
-     InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle);
+{$ifdef fpc}
+     InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle,@DummyPatternLine);
+{$else fpc}
+     InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle,DummyPatternLine);
+{$endif fpc}
      CurrentWriteMode := OldWriteMode;
      CurrentWriteMode := OldWriteMode;
    end;
    end;
 
 
 
 
  procedure Ellipse(X,Y : Integer; stAngle, EndAngle: word; XRadius,YRadius: word);
  procedure Ellipse(X,Y : Integer; stAngle, EndAngle: word; XRadius,YRadius: word);
   Begin
   Begin
-    InternalEllipse(X,Y,XRadius,YRadius,stAngle,EndAngle);
+{$ifdef fpc}
+     InternalEllipse(X,Y,XRadius,YRadius,StAngle,Endangle,@DummyPatternLine);
+{$else fpc}
+     InternalEllipse(X,Y,XRadius,YRadius,StAngle,Endangle,DummyPatternLine);
+{$endif fpc}
   end;
   end;
 
 
 
 
@@ -2153,9 +2158,14 @@ end;
     { only normal put supported }
     { only normal put supported }
     OldWriteMode := CurrentWriteMode;
     OldWriteMode := CurrentWriteMode;
     CurrentWriteMode := NormalPut;
     CurrentWriteMode := NormalPut;
-    InternalEllipse(X,Y,XRadius+1,YRadius+1,0,360);
     if (XRadius > 0) and (YRadius > 0) then
     if (XRadius > 0) and (YRadius > 0) then
-      FloodFill(X,Y,CurrentColor);
+      InternalEllipse(X,Y,XRadius,YRadius,0,360,PatternLine)
+    Else
+{$ifdef fpc}
+      InternalEllipse(X,Y,XRadius+1,YRadius+1,0,60,@DummyPatternLine);
+{$else fpc}
+      InternalEllipse(X,Y,XRadius+1,YRadius+1,0,60,DummyPatternLine);
+{$endif fpc}
     { restore old write mode }
     { restore old write mode }
     CurrentWriteMode := OldWriteMode;
     CurrentWriteMode := OldWriteMode;
   end;
   end;
@@ -2194,7 +2204,11 @@ end;
              OldWriteMode := CurrentWriteMode;
              OldWriteMode := CurrentWriteMode;
              CurrentWriteMode := CopyPut;
              CurrentWriteMode := CopyPut;
        end;
        end;
-     InternalEllipse(X,Y,Radius,Radius,0,360);
+{$ifdef fpc}
+     InternalEllipse(X,Y,Radius,Radius,0,360,@DummyPatternLine);
+{$else fpc}
+     InternalEllipse(X,Y,Radius,Radius,0,360,DummyPatternLine);
+{$endif fpc}
      if LineInfo.Thickness = Normwidth then
      if LineInfo.Thickness = Normwidth then
          CurrentWriteMode := OldWriteMode;
          CurrentWriteMode := OldWriteMode;
      { restore arc information }
      { restore arc information }
@@ -2220,16 +2234,16 @@ end;
      PutPixel(x,y,CurrentColor);
      PutPixel(x,y,CurrentColor);
      PutPixel(ArcCall.xend,ArcCall.yend,CurrentColor);
      PutPixel(ArcCall.xend,ArcCall.yend,CurrentColor);
      stangle:=Stangle mod 360; EndAngle:=Endangle mod 360;
      stangle:=Stangle mod 360; EndAngle:=Endangle mod 360;
-     if stAngle<=Endangle then
+{     if stAngle<=Endangle then}
        Angle:=(stAngle+EndAngle) div 2
        Angle:=(stAngle+EndAngle) div 2
-     else
-       angle:=(stAngle-360+EndAngle) div 2;
+{     else
+       angle:=(stAngle-360+EndAngle) div 2};
      { fill from the point in the middle of the slice }
      { fill from the point in the middle of the slice }
      XRadius:=(longint(XRadius)*10000) div XAspect;
      XRadius:=(longint(XRadius)*10000) div XAspect;
      YRadius:=(longint(YRadius)*10000) div YAspect;
      YRadius:=(longint(YRadius)*10000) div YAspect;
      { avoid rounding errors }
      { avoid rounding errors }
-     if abs(ArcCall.xstart-ArcCall.xend)
-        +abs(ArcCall.ystart-ArcCall.yend)>2 then
+     if (abs(ArcCall.xstart-ArcCall.xend)
+        +abs(ArcCall.ystart-ArcCall.yend)>2) then
        FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
        FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
          y+round(cos((angle+90)*Pi/180)*YRadius/2),CurrentColor);
          y+round(cos((angle+90)*Pi/180)*YRadius/2),CurrentColor);
      CurrentWriteMode := writemode;
      CurrentWriteMode := writemode;
@@ -2624,6 +2638,7 @@ end;
       XRadius, YRadius : word;
       XRadius, YRadius : word;
       writemode : word;
       writemode : word;
   begin
   begin
+     writemode := currentwritemode;
      Arc(x,y,StAngle,EndAngle,Radius);
      Arc(x,y,StAngle,EndAngle,Radius);
      Line(ArcCall.XStart, ArcCall.YStart, x,y);
      Line(ArcCall.XStart, ArcCall.YStart, x,y);
      Line(x,y, ArcCall.XEnd, ArcCall.YEnd);
      Line(x,y, ArcCall.XEnd, ArcCall.YEnd);
@@ -2636,16 +2651,16 @@ end;
      if Stangle<=Endangle then
      if Stangle<=Endangle then
        angle:=(StAngle+EndAngle) div 2
        angle:=(StAngle+EndAngle) div 2
      else
      else
-       angle:=(Stangle-360+Endangle) div 2;
+       angle:=(StAngle-360+EndAngle) div 2;
      { fill from the point in the middle of the slice }
      { fill from the point in the middle of the slice }
      XRadius:=(longint(Radius)*10000) div XAspect;
      XRadius:=(longint(Radius)*10000) div XAspect;
      YRadius:=(longint(Radius)*10000) div YAspect;
      YRadius:=(longint(Radius)*10000) div YAspect;
      { avoid rounding errors }
      { avoid rounding errors }
      if abs(ArcCall.xstart-ArcCall.xend)
      if abs(ArcCall.xstart-ArcCall.xend)
         +abs(ArcCall.ystart-ArcCall.yend)>2 then
         +abs(ArcCall.ystart-ArcCall.yend)>2 then
-{       FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
-         y+round(cos((angle+90)*Pi/180)*YRadius/2),truecolor);}
-{     CurrentWriteMode := writemode;}
+       floodfill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
+         y+round(cos((angle)*Pi/180)*YRadius/2),FillSettings.Color);
+     CurrentWriteMode := writemode;
   end;
   end;
 
 
 {$i fills.inc}
 {$i fills.inc}
@@ -2773,7 +2788,13 @@ DetectGraph
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.20  1999-09-12 17:29:00  jonas
+  Revision 1.21  1999-09-13 12:49:08  jonas
+    * fixed Arc: internallellipse went into an endless loop if StAngle =
+      EndAngle
+    * FillEllipse is now much faster: no more floodfill,
+      InternalEllipseDefault now draws the patternlines immediatety!
+
+  Revision 1.20  1999/09/12 17:29:00  jonas
     * several changes to internalellipse to make it faster
     * several changes to internalellipse to make it faster
       and to make sure it updates the ArcCall correctly
       and to make sure it updates the ArcCall correctly
       (not yet done for width = 3)
       (not yet done for width = 3)