* many bugs related to floodfill and ellipse fixed

rtl/dos/graph.pp

@@ -253,6 +253,8 @@ var    { X/Y Verhaeltnis des Bildschirm }
        aktbackcolor : longint;
        { Current background color RGB value }
        truebackcolor : longint;
+       { used for fill }
+       colormask : longint;
        { Videospeicherbereiche }
        wbuffer,rbuffer,wrbuffer : ^byte;
        { aktueller Ausgabebereich }
@@ -938,7 +940,10 @@ end.
 
 {
   $Log$
-  Revision 1.10  1998-11-20 10:16:01  pierre
+  Revision 1.11  1998-11-20 18:42:04  pierre
+    * many bugs related to floodfill and ellipse fixed
+
+  Revision 1.10  1998/11/20 10:16:01  pierre
     * Found out the LinerFrameBuffer problem
       Was an alignment problem in VesaInfoBlock (see graph.pp file)
       Compile with -dDEBUG and answer 'y' to 'Use Linear ?' to test

rtl/dos/ppi/arc.ppi

@@ -22,7 +22,8 @@
    const i:Array[0..20]of Byte=
        (0,3,0, 2,3,1, 2,1,0, 0,1,1, 0,3,0, 2,3,1, 2,1,0);
 
-   var counter,index,ofs : integer;
+   var counter,index     : integer;
+       endofs,ofs        : integer;
        xa,ya,xe,ye       : Array[0..2]of Integer;
        xp,yp             : integer;
        xradius,yradius   : word;
@@ -54,7 +55,8 @@
        end;
      repeat
      if (((xp=xe[0]) or (xp=xe[1]) or (xp=xe[2])) and
-         ((yp=ye[0]) or (yp=ye[1]) or (yp=ye[2]))) then
+         ((yp=ye[0]) or (yp=ye[1]) or (yp=ye[2]))) and
+         (ofs=endofs) then
          begin
            putpixeli(xp,yp,aktcolor);
            ready:=true;
@@ -79,6 +81,12 @@
        180..269  : ofs:=2;
        270..359  : ofs:=3;
      end;
+     case beta of
+         0.. 89  : endofs:=0;
+        90..179  : endofs:=1;
+       180..269  : endofs:=2;
+       270..359  : endofs:=3;
+     end;
      xa[1]:=x+round(sin((alpha+90)*Pi/180) * XRadius);
      ya[1]:=y+round(cos((alpha+90)*Pi/180) * YRadius);
      xe[1]:=x+round(sin((beta+90)*Pi/180) * XRadius);
@@ -97,17 +105,26 @@
        DrawArc(i[ofs*3],i[ofs*3+1],i[ofs*3+2]);
        ofs:=(ofs+1) mod 7;
        inc(ofscount);
-     until ready or (ofscount>7);
+     until ready or (ofscount>16);
   end;
 
   procedure PieSlice(X,Y,alpha,beta:integer;Radius: Word);
   var angle : real;
       XRadius, YRadius : word;
+      stline : LineSettingsType;
+      writemode : word;
   begin
      Arc(x,y,alpha,beta,Radius);
+     GetLineSettings(stline);
+     writemode:=aktwritemode;
+     aktwritemode:=normalput;
+     SetLineStyle(SolidLn,0,NormWidth);
      MoveTo(ActArcCoords.xstart,ActArcCoords.ystart);
      LineTo(x,y);
      LineTo(ActArcCoords.xend,ActArcCoords.yend);
+     PutPixeli(ActArcCoords.xstart,ActArcCoords.ystart,aktcolor);
+     PutPixeli(x,y,aktcolor);
+     PutPixeli(ActArcCoords.xend,ActArcCoords.yend,aktcolor);
      alpha:=alpha mod 360; beta:=beta mod 360;
      if alpha<=beta then
        angle:=(alpha+beta)/2
@@ -116,13 +133,33 @@
      { fill from the point in the middle of the slice }
      XRadius:=(Radius*10000) div XAsp;
      YRadius:=(Radius*10000) div YAsp;
-     FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
-       y+round(cos((angle+90)*Pi/180)*YRadius/2),truecolor);
+{$ifdef GraphDebug}
+     Writeln(stderr,'Arc Center ',x,' ',y);
+     Writeln(stderr,'Radii ',xradius,' ',yradius);
+     Writeln(stderr,'Start  ',ActArcCoords.xstart,' ',ActArcCoords.ystart);
+     if not ColorsEqual(truecolor,getpixel(ActArcCoords.xstart,ActArcCoords.ystart)) then
+       Writeln('Start error not set');
+     Writeln(stderr,'End  ',ActArcCoords.xend,' ',ActArcCoords.yend);
+     if not ColorsEqual(truecolor,getpixel(ActArcCoords.xend,ActArcCoords.yend)) then
+       Writeln('End error not set');
+     Writeln(stderr,'Fill start ',x+round(sin((angle+90)*Pi/180)*XRadius/2),' ',
+       y+round(cos((angle+90)*Pi/180)*YRadius/2));
+{$endif GraphDebug}
+     { avoid rounding errors }
+     if abs(ActArcCoords.xstart-ActArcCoords.xend)
+        +abs(ActArcCoords.ystart-ActArcCoords.yend)>2 then
+       FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
+         y+round(cos((angle+90)*Pi/180)*YRadius/2),truecolor);
+     aktwritemode:=writemode;
+     aktlineinfo:=stline;
   end;
 
 {
   $Log$
-  Revision 1.4  1998-11-19 15:09:35  pierre
+  Revision 1.5  1998-11-20 18:42:05  pierre
+    * many bugs related to floodfill and ellipse fixed
+
+  Revision 1.4  1998/11/19 15:09:35  pierre
     * several bugfixes for sector/ellipse/floodfill
     + graphic driver mode const in interface G800x600x256...
     + added backput mode as in linux graph.pp

rtl/dos/ppi/ellipse.ppi

@@ -17,6 +17,7 @@
     function CalcEllipse(x,y:Integer;XRadius,YRadius:word):Integer;
      var aq,bq,xq,yq,abq : Longint;
          xp,yp,count     : integer;
+         i               : integer;
      begin
      {XRadius:=(XRadius*10000) div XAsp;
      YRadius:=(YRadius*10000) div YAsp; }
@@ -32,8 +33,27 @@
       {      umgestellt : X^2 * Y^2 * A^2 * B^2 = A^2*B^2         }
       {      dadurch werden evtuelle Divisionen durch 0 vermieden }
       {      und Integerarithmetik moeglich                       }
-
-    repeat              
+    { was buggy for B=0 !! }
+    if YRadius=0 then
+      begin
+        for i:=0 to XRadius do
+          begin
+             PWord(buffermem)[count  ]:=x + i;
+             PWord(buffermem)[count+1]:=y;
+             PWord(buffermem)[count+2]:=x - i;
+             PWord(buffermem)[count+3]:=y;
+             Count:=Count+4;
+          end;
+        for i:=Xradius-1 downto 1 do
+          begin
+             PWord(buffermem)[count  ]:=x + i;
+             PWord(buffermem)[count+1]:=y;
+             PWord(buffermem)[count+2]:=x - i;
+             PWord(buffermem)[count+3]:=y;
+             Count:=Count+4;
+          end;
+      end
+    else repeat
       PWord(buffermem)[count  ]:=x + xp;
       PWord(buffermem)[count+1]:=y + yp;
       PWord(buffermem)[count+2]:=x - xp;
@@ -111,8 +131,9 @@
    const i:Array[0..20]of Byte=
        (0,3,0, 2,3,1, 2,1,0, 0,1,1, 0,3,0, 2,3,1, 2,1,0);
 
-   var counter,index,ofs : integer;
-       xa,ya,xe,ye       : Array[0..2]of Integer;
+   var counter,index     : integer;
+       ofs,endofs        : integer;
+       xa,ya,xe,ye       : Array[0..2] of Integer;
        xp,yp             : integer;
        xradius,yradius   : word;
        first,ready       : Boolean;
@@ -143,7 +164,8 @@
        end;
      repeat
      if (((xp=xe[0]) or (xp=xe[1]) or (xp=xe[2])) and
-         ((yp=ye[0]) or (yp=ye[1]) or (yp=ye[2]))) then
+         ((yp=ye[0]) or (yp=ye[1]) or (yp=ye[2]))) and
+         (ofs=endofs) then
          begin
            putpixeli(xp,yp,aktcolor);
            ready:=true;
@@ -169,6 +191,12 @@
        180..269  : ofs:=2;
        270..359  : ofs:=3;
      end;
+     case beta of
+         0.. 89  : endofs:=0;
+        90..179  : endofs:=1;
+       180..269  : endofs:=2;
+       270..359  : endofs:=3;
+     end;
      xa[1]:=x+round(sin((alpha+90)*Pi/180) * XRadius);
      ya[1]:=y+round(cos((alpha+90)*Pi/180) * YRadius);
      xe[1]:=x+round(sin((beta+90)*Pi/180) * XRadius);
@@ -187,33 +215,52 @@
        DrawArc(i[ofs*3],i[ofs*3+1],i[ofs*3+2]);
        ofs:=(ofs+1) mod 7;
        inc(ofscount);
-     until ready or (ofscount>7);
+     until ready or (ofscount>16);
   end;
 
   procedure Sector(X,Y,alpha,beta:integer;XRadius,YRadius: Word);
   var angle : real;
+      stline : LineSettingsType;
+      writemode : word;
   begin
      Ellipse(x,y,alpha,beta,XRadius,YRadius);
+     GetLineSettings(stline);
+     SetLineStyle(SolidLn,0,NormWidth);
+     writemode:=aktwritemode;
+     aktwritemode:=normalput;
      MoveTo(ActArcCoords.xstart,ActArcCoords.ystart);
      LineTo(x,y);
      LineTo(ActArcCoords.xend,ActArcCoords.yend);
+     PutPixeli(ActArcCoords.xstart,ActArcCoords.ystart,aktcolor);
+     PutPixeli(x,y,aktcolor);
+     PutPixeli(ActArcCoords.xend,ActArcCoords.yend,aktcolor);
      alpha:=alpha mod 360; beta:=beta mod 360;
      if alpha<=beta then
        angle:=(alpha+beta)/2
      else
        angle:=(alpha-360+beta)/2;
-{$ifdef ExtDebug}
-     Writeln(stderr,'Center ',x,' ',y);
+     { fill from the point in the middle of the slice }
+     XRadius:=(XRadius*10000) div XAsp;
+     YRadius:=(YRadius*10000) div YAsp;
+{$ifdef GraphDebug}
+     Writeln(stderr,'Sector Center ',x,' ',y);
+     Writeln(stderr,'Radii ',xradius,' ',yradius);
      Writeln(stderr,'Start  ',ActArcCoords.xstart,' ',ActArcCoords.ystart);
+     if not ColorsEqual(truecolor,getpixel(ActArcCoords.xstart,ActArcCoords.ystart)) then
+       Writeln('Start error not set');
      Writeln(stderr,'End  ',ActArcCoords.xend,' ',ActArcCoords.yend);
+     if not ColorsEqual(truecolor,getpixel(ActArcCoords.xend,ActArcCoords.yend)) then
+       Writeln('End error not set');
      Writeln(stderr,'Fill start ',x+round(sin((angle+90)*Pi/180)*XRadius/2),' ',
        y+round(cos((angle+90)*Pi/180)*YRadius/2));
-{$endif ExtDebug}
-     { fill from the point in the middle of the slice }
-     XRadius:=(XRadius*10000) div XAsp;
-     YRadius:=(YRadius*10000) div YAsp;
-     FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
-       y+round(cos((angle+90)*Pi/180)*YRadius/2),truecolor);
+{$endif GraphDebug}
+     { avoid rounding errors }
+     if abs(ActArcCoords.xstart-ActArcCoords.xend)
+        +abs(ActArcCoords.ystart-ActArcCoords.yend)>2 then
+       FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
+         y+round(cos((angle+90)*Pi/180)*YRadius/2),truecolor);
+     aktwritemode:=writemode;
+     aktlineinfo:=stline;
   end;
 
   procedure Circle(x,y:integer;radius:word);
@@ -233,7 +280,10 @@
  
 {
   $Log$
-  Revision 1.4  1998-11-19 15:09:36  pierre
+  Revision 1.5  1998-11-20 18:42:06  pierre
+    * many bugs related to floodfill and ellipse fixed
+
+  Revision 1.4  1998/11/19 15:09:36  pierre
     * several bugfixes for sector/ellipse/floodfill
     + graphic driver mode const in interface G800x600x256...
     + added backput mode as in linux graph.pp

rtl/dos/ppi/fill.ppi

@@ -33,17 +33,25 @@ var start,ende,xx : integer;
     col           : longint;
  
 begin  
-  xx:=x; col:=getpixel(xx,y);
-{$ifdef ExtDebug}
-     Writeln(stderr,'Fill ',x,' ',y,' ',col);
-{$endif def ExtDebug}
+{$ifdef GraphDebug}
+  if (x>viewport.x2) or (x<viewport.x1) or
+     (y>viewport.y2) or (y<viewport.y1) then
+    begin
+       Writeln(stderr,'Wrong value in Fill(',x,',',y,')');
+       exit;
+    end;
+{$endif def GraphDebug}
+  xx:=x; col:=getpixeli(xx,y);
+{$ifdef GraphDebug}
+     Writeln(stderr,'Fill ',x,' ',y,' ',hexstr(col,8));
+{$endif def GraphDebug}
   if (col=bordercol) or (col=fillcol) or
      (test_bkfill and (col=fillbkcol)) then
     exit;
   while (col<>bordercol) and (xx > viewport.x1) and
      (col<>fillcol) and (not test_bkfill or (col<>fillbkcol))
     do begin
-      xx:=xx-1; col:=getpixel(xx,y);
+      xx:=xx-1; col:=getpixeli(xx,y);
     end;
   if (col<>bordercol) and (col<>fillcol) and
      (not test_bkfill or (col<>fillbkcol)) then
@@ -52,11 +60,11 @@ begin
     start:=xx+1;
 
   xx:=x;
-  col:=getpixel(xx,y);
+  col:=getpixeli(xx,y);
   while (col<>bordercol) and (xx < viewport.x2) and (col<>fillcol)
       and (not test_bkfill or (col<>fillbkcol)) 
     do begin
-      xx:=xx+1; col:=getpixel(xx,y);
+      xx:=xx+1; col:=getpixeli(xx,y);
     end;
   if (col<>bordercol) and (col<>fillcol) and
      (not test_bkfill or (col<>fillbkcol)) then
@@ -64,20 +72,20 @@ begin
   else
     ende:=xx-1;
 
-{$ifdef ExtDebug}
+{$ifdef GraphDebug}
      Writeln(stderr,'Pattern ',start,' ',ende,' ',y);
-{$endif def ExtDebug}
+{$endif def GraphDebug}
   patternline(start,ende,y);
-{$ifdef ExtDebug}
-     Writeln(stderr,'Fill  after Patterline ',x,' ',y,' ',getpixel(x,y));
-{$endif def ExtDebug}
+{$ifdef GraphDebug}
+     Writeln(stderr,'Fill  after Patterline ',x,' ',y,' ',hexstr(getpixel(x,y),8));
+{$endif def GraphDebug}
   offset:=(y * _maxy + start) shr 8;
   
   if (y > viewport.y1)
   then begin
     xx:=start;
     repeat
-      col:=getpixel(xx,y-1);
+      col:=getpixeli(xx,y-1);
       if (col<>bordercol) and (col<>fillcol) and
          (not test_bkfill or (col<>fillbkcol)) 
       then begin
@@ -92,7 +100,7 @@ begin
    begin
     xx:=start;
     repeat
-      col:=getpixel(xx,y+1);
+      col:=getpixeli(xx,y+1);
       if (col<>bordercol) and (col<>fillcol) and
          (not test_bkfill or (col<>fillbkcol)) then
         fill(xx,y+1);
@@ -103,39 +111,35 @@ begin
 end;
 
 begin
+{$ifdef GraphDebug}
+     Writeln(stderr,'FloodFill start ',x,' ',y);
+{$endif def GraphDebug}
+  {$ifdef NOFILL}
+  exit;
+  {$endif NOFILL}
   {fillchar(buffermem^,buffersize,0);
     not used !! }
   if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
+  { reject invalid points !! }
+
   viewport.x2:=viewport.x2-viewport.x1;
   viewport.y2:=viewport.y2-viewport.y1;
   viewport.x1:=0;
   viewport.y1:=0;
-  { reject invalid points !! }
+
   if (x>viewport.x2) or (x<viewport.x1) or
      (y>viewport.y2) or (y<viewport.y1) then
-    exit;
-  bordercol:=convert(border);
-  if BytesPerPixel=1
-  then begin
-    bordercol:=bordercol and $FF;
-    fillcol:=aktfillsettings.color and $FF;
-    fillbkCol:=aktfillbkcolor and $FF;
-  end
-{$ifdef TEST_24BPP}
-  else if BytesPerPixel>=3
-  then begin
-    bordercol:=bordercol and $FFFFFF;
-    fillcol:=aktfillsettings.color and $FFFFFF;
-    fillbkCol:=aktfillbkcolor and $FFFFFF;
-  end
-{$endif TEST_24BPP}
-  else if BytesPerPixel=2
-  then begin
-    bordercol:=bordercol and $FFFF;
-    fillcol:=aktfillsettings.color and $FFFF;
-    fillbkCol:=aktfillbkcolor and $FFFF;
-  end;
-  
+    begin
+{$ifdef GraphDebug}
+       Writeln(stderr,'Error Wrong values for FloodFill');
+       Writeln(stderr,'xmax ',viewport.x2);
+       Writeln(stderr,'ymax ',viewport.y2);
+{$endif def GraphDebug}
+       exit;
+    end;
+  bordercol:=convert(border) and ColorMask;
+  fillcol:=aktfillsettings.color and ColorMask;
+  fillbkCol:=aktfillbkcolor and ColorMask;
   if aktfillsettings.pattern=emptyfill then
     begin
        fillcol:=fillbkcol;
@@ -145,10 +149,11 @@ begin
      test_bkfill:=false
   else
     test_bkfill:=true;
-{$ifdef ExtDebug}
-     Writeln(stderr,'FloodFill(',x,',',y,') Fillcol ',fillcol);
-     Writeln(stderr,' bordercol ',bordercol,' fillbkcol ',fillbkcol);
-{$endif def ExtDebug}
+{$ifdef GraphDebug}
+     Writeln(stderr,'FloodFill(',x,',',y,') Fillcol ',hexstr(unconvert(fillcol),8));
+     Writeln(stderr,' bordercol ',hexstr(unconvert(bordercol),8),
+       ' fillbkcol ',hexstr(unconvert(fillbkcol),8));
+{$endif def GraphDebug}
   fill(x,y);
 end;
 
@@ -264,7 +269,10 @@ end;
 
 {
   $Log$
-  Revision 1.5  1998-11-19 15:09:37  pierre
+  Revision 1.6  1998-11-20 18:42:07  pierre
+    * many bugs related to floodfill and ellipse fixed
+
+  Revision 1.5  1998/11/19 15:09:37  pierre
     * several bugfixes for sector/ellipse/floodfill
     + graphic driver mode const in interface G800x600x256...
     + added backput mode as in linux graph.pp

rtl/dos/ppi/ibm.ppi

@@ -57,14 +57,22 @@ begin
         GetVESAInfo:=false;
       BytesPerLine:=VESAInfo.BPL;
       case VESAInfo.BitsPerPixel of
-       8     : BytesPerPixel:=1;
-       15,16 : BytesPerPixel:=2;
+       8     : begin
+                  BytesPerPixel:=1;
+                  ColorMask:=$ff;
+               end;
+       15,16 : begin
+                  BytesPerPixel:=2;
+                  ColorMask:=$ffff;
+               end;
 {$ifdef TEST_24BPP}
        24    : begin
-               BytesPerPixel:=3;
+                  BytesPerPixel:=3;
+                  ColorMask:=$ffffff;
                end;
        32    : begin
-               BytesPerPixel:=4;
+                  BytesPerPixel:=4;
+                  ColorMask:=$ffffff;
                end;
 {$endif TEST_24BPP}
        else    begin
@@ -292,7 +300,10 @@ end;
 
 {
   $Log$
-  Revision 1.5  1998-11-20 10:16:02  pierre
+  Revision 1.6  1998-11-20 18:42:08  pierre
+    * many bugs related to floodfill and ellipse fixed
+
+  Revision 1.5  1998/11/20 10:16:02  pierre
     * Found out the LinerFrameBuffer problem
       Was an alignment problem in VesaInfoBlock (see graph.pp file)
       Compile with -dDEBUG and answer 'y' to 'Use Linear ?' to test

rtl/dos/ppi/pixel.ppi

@@ -184,7 +184,7 @@ procedure pixel(offset:longint);
    end; 
 end; { proc }
 
-function getpixel(x,y:integer):longint;
+function getpixeli(x,y:integer):longint;
 var viewport:viewporttype;
     col : longint;
 begin
@@ -241,6 +241,7 @@ if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
       je     g_24BPP
   g_32BPP:
       movl   %gs:(%esi),%eax
+      andl   $0x00FFFFFF,%eax
       jmp    g_Result
   g_24BPP:
       movl   _WINLOMASKMINUSPIXELSIZE,%edi
@@ -263,10 +264,10 @@ if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
       jmp    g_Result
 {$endif TEST_24BPP}
   g_16BPP:
-      movw   %gs:(%esi),%ax
+      movzwl %gs:(%esi),%eax
       jmp    g_Result
   g_8BPP:    
-      movb   %gs:(%esi),%al
+      movzbl %gs:(%esi),%eax
       jmp    g_Result
   gp_eexit:
       xorl   %eax,%eax
@@ -275,13 +276,21 @@ if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
   gp_exit:
       movl   %eax,col
   end;
-    getpixel:=unconvert(col);
+  getpixeli:=col;
+end; { proc getpixeli }
+
+function getpixel(x,y:integer):longint;
+begin
+    getpixel:=unconvert(getpixeli(x,y));
 end; { proc }
 
 
 {
   $Log$
-  Revision 1.4  1998-11-18 13:23:36  pierre
+  Revision 1.5  1998-11-20 18:42:09  pierre
+    * many bugs related to floodfill and ellipse fixed
+
+  Revision 1.4  1998/11/18 13:23:36  pierre
     * floodfill got into an infinite loop !!
     + added partial support for fillpoly
       (still wrong if the polygon is not convex)