+ added some functions missing like sector ellipse getarccoords

    (the filling of sector and ellipse is still buggy
     I use floodfill but sometimes the starting point
     is outside !!)
  * fixed a bug in floodfill for patterns
    (still has problems !!)

rtl/dos/graph.pp

@@ -91,13 +91,18 @@ procedure GetRGBPalette(ColorNum:byte; var RedValue,GreenValue,BlueValue:byte);
 procedure SetRGBPalette(ColorNum,RedValue,GreenValue,BlueValue:byte);
 procedure SetAllPalette(var Palette : PaletteType);
 procedure GetPalette(var Palette : PaletteType);
+procedure SetPalette(ColorNum:word;Color:byte);
 
 { ELLIPSE.PPI }
 procedure FillEllipse(x,y:Integer;XRadius,YRadius:Word);
 procedure Circle(x,y:Integer;Radius:Word);
+procedure Ellipse(x,y,alpha,beta:Integer;XRad,YRad:word);
+procedure Sector(X,Y,alpha,beta:integer;XRadius,YRadius: Word);
 
 { ARC.PPI }
 procedure Arc(x,y,alpha,beta:Integer;Radius:Word);
+procedure GetArcCoords(var ArcCoords:ArcCoordsType);
+procedure PieSlice(X,Y,alpha,beta:integer;Radius: Word);
 
 { COLORS.PPI }
 function  GetBkColor : longint;
@@ -259,6 +264,7 @@ var    { X/Y Verhaeltnis des Bildschirm }
        _graphresult : integer;
        { aktuell eingestellte F�llart }
        aktfillsettings : FillSettingsType;
+       aktfillbkcolor : longint;
        { aktuelles F�llmuster }
        aktfillpattern : FillPatternType;
        { Schreibmodus }
@@ -872,8 +878,8 @@ begin
       _graphresult:=grError;
       exit;
    end;
-  aktwritemode:=(writemode and $7F);
-  if (writemode and $80)<>0 then
+  aktwritemode:=(writemode and $F);
+  if (writemode and BackPut)<>0 then
     ClearText:=true
   else
     ClearText:=false;
@@ -926,7 +932,15 @@ end.
 
 {
   $Log$
-  Revision 1.7  1998-11-18 09:31:29  pierre
+  Revision 1.8  1998-11-19 09:48:45  pierre
+    + added some functions missing like sector ellipse getarccoords
+      (the filling of sector and ellipse is still buggy
+       I use floodfill but sometimes the starting point
+       is outside !!)
+    * fixed a bug in floodfill for patterns
+      (still has problems !!)
+
+  Revision 1.7  1998/11/18 09:31:29  pierre
     * changed color scheme
       all colors are in RGB format if more than 256 colors
     + added 24 and 32 bits per pixel mode

rtl/dos/ppi/arc.ppi

@@ -12,6 +12,11 @@
 
  **********************************************************************}
 
+  procedure GetArcCoords(var ArcCoords:ArcCoordsType);
+    begin
+      ArcCoords:=ActArcCoords;
+    end;
+
   procedure Arc(x,y,alpha,beta:Integer;Radius:word);
 
    const i:Array[0..20]of Byte=
@@ -76,6 +81,12 @@
      ya[1]:=y+round(cos((alpha+90)*Pi/180) * YRadius);
      xe[1]:=x+round(sin((beta+90)*Pi/180) * XRadius);
      ye[1]:=y+round(cos((beta+90)*Pi/180) * YRadius);
+     ActArcCoords.x:=x;
+     ActArcCoords.y:=y;
+     ActArcCoords.xstart:=xa[1];
+     ActArcCoords.ystart:=ya[1];
+     ActArcCoords.xend:=xe[1];
+     ActArcCoords.yend:=ye[1];
      xa[0]:=xa[1]-1; xa[2]:=xa[1]+1; ya[0]:=ya[1]-1; ya[2]:=ya[1]+1;
      xe[0]:=xe[1]-1; xe[2]:=xe[1]+1; ye[0]:=ye[1]-1; ye[2]:=ye[1]+1;
      index:=Calcellipse(x,y,Radius,Radius);
@@ -85,9 +96,31 @@
      until ready;
   end;
 
+  procedure PieSlice(X,Y,alpha,beta:integer;Radius: Word);
+  var angle : real;
+  begin
+     Arc(x,y,alpha,beta,Radius);
+     MoveTo(ActArcCoords.xstart,ActArcCoords.ystart);
+     LineTo(x,y);
+     LineTo(ActArcCoords.xend,ActArcCoords.yend);
+     alpha:=alpha mod 360; beta:=beta mod 360;
+     angle:=(alpha+beta)/2;
+     { fill from the point in the middle of the slice }
+     FloodFill(x+round(sin((angle+90)*Pi/180)*Radius/2),
+       y+round(cos((angle+90)*Pi/180)*Radius/2),truecolor);
+  end;
+
 {
   $Log$
-  Revision 1.2  1998-11-18 09:31:30  pierre
+  Revision 1.3  1998-11-19 09:48:46  pierre
+    + added some functions missing like sector ellipse getarccoords
+      (the filling of sector and ellipse is still buggy
+       I use floodfill but sometimes the starting point
+       is outside !!)
+    * fixed a bug in floodfill for patterns
+      (still has problems !!)
+
+  Revision 1.2  1998/11/18 09:31:30  pierre
     * changed color scheme
       all colors are in RGB format if more than 256 colors
     + added 24 and 32 bits per pixel mode

rtl/dos/ppi/ellipse.ppi

@@ -11,6 +11,8 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+    var
+       ActArcCoords : ArcCoordsType;
 
     function CalcEllipse(x,y:Integer;XRadius,YRadius:word):Integer;
      var aq,bq,xq,yq,abq : Longint;
@@ -93,11 +95,113 @@
       while (PWord(buffermem)[index+1]=PWord(buffermem)[index-3]) and
             (index > 4 ) do Index:=Index-4; 
     end;
-    
+
     if (aktColor <> aktFillSettings.Color) or (aktFillSettings.Pattern<>1)
        then _Ellipse(Count);
   end;
-    
+
+
+  { allmost same code than Arc, should be squeezed together !! }
+
+  procedure Ellipse(x,y,alpha,beta:Integer;XRad,YRad:word);
+
+   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;
+       xp,yp             : integer;
+       xradius,yradius   : word;
+       first,ready       : Boolean;
+
+   procedure DrawArc(index1,index2,index3:byte);
+   var ende,incr:integer;
+   begin
+     if index3=0 then begin
+       counter:=index;
+       ende:=0;
+       incr:=-4;
+     end else begin
+       counter:=-4;
+       ende:=index-4;
+       incr:=4;
+     end;
+     if first then begin
+       repeat
+         first:=false;
+         counter:=counter+incr;
+         xp:=PInteger(BufferMem)[counter+index1];
+         yp:=PInteger(BufferMem)[counter+index2];
+       until (counter=ende) or
+         (((xp=xa[0]) or (xp=xa[1]) or (xp=xa[2])) and
+         ((yp=ya[0]) or (yp=ya[1]) or (yp=ya[2])));
+         if Counter=Ende then exit else putpixeli(xp,yp,aktcolor);
+       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
+         begin
+           ready:=true;
+           exit;
+         end;
+       counter:=counter+incr;
+       xp:=PInteger(BufferMem)[counter+index1];
+       yp:=PInteger(BufferMem)[counter+index2];
+       putpixeli(xp,yp,aktcolor);
+     until counter=Ende;
+   end;
+
+   begin
+     first:=true; ready:=false;
+     XRadius:=XRad; YRadius:=YRad;
+
+     alpha:=alpha mod 360; beta:=beta mod 360;
+     case alpha of
+         0.. 89  : ofs:=0;
+        90..179  : ofs:=1;
+       180..269  : ofs:=2;
+       270..359  : ofs:=3;
+     end;
+     x:=x+aktviewport.x1; y:=y+aktviewport.y1;
+     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);
+     ye[1]:=y+round(cos((beta+90)*Pi/180) * YRadius);
+     ActArcCoords.x:=x;
+     ActArcCoords.y:=y;
+     ActArcCoords.xstart:=xa[1];
+     ActArcCoords.ystart:=ya[1];
+     ActArcCoords.xend:=xe[1];
+     ActArcCoords.yend:=ye[1];
+     xa[0]:=xa[1]-1; xa[2]:=xa[1]+1; ya[0]:=ya[1]-1; ya[2]:=ya[1]+1;
+     xe[0]:=xe[1]-1; xe[2]:=xe[1]+1; ye[0]:=ye[1]-1; ye[2]:=ye[1]+1;
+     index:=Calcellipse(x,y,XRadius,YRadius);
+     repeat
+       DrawArc(i[ofs*3],i[ofs*3+1],i[ofs*3+2]);
+       ofs:=(ofs+1) mod 7;
+     until ready;
+  end;
+
+  procedure Sector(X,Y,alpha,beta:integer;XRadius,YRadius: Word);
+  var angle : real;
+  begin
+     Ellipse(x,y,alpha,beta,XRadius,YRadius);
+     MoveTo(ActArcCoords.xstart,ActArcCoords.ystart);
+     LineTo(x,y);
+     LineTo(ActArcCoords.xend,ActArcCoords.yend);
+     alpha:=alpha mod 360; beta:=beta mod 360;
+     angle:=(alpha+beta)/2;
+{$ifdef ExtDebug}
+     Writeln(stderr,'Center ',x,' ',y);
+     Writeln(stderr,'Start  ',ActArcCoords.xstart,' ',ActArcCoords.ystart);
+     Writeln(stderr,'End  ',ActArcCoords.xend,' ',ActArcCoords.yend);
+     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 }
+     FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
+       y+round(cos((angle+90)*Pi/180)*YRadius/2),truecolor);
+  end;
 
   procedure Circle(x,y:integer;radius:word);
   begin
@@ -112,7 +216,15 @@
  
 {
   $Log$
-  Revision 1.2  1998-11-18 09:31:32  pierre
+  Revision 1.3  1998-11-19 09:48:47  pierre
+    + added some functions missing like sector ellipse getarccoords
+      (the filling of sector and ellipse is still buggy
+       I use floodfill but sometimes the starting point
+       is outside !!)
+    * fixed a bug in floodfill for patterns
+      (still has problems !!)
+
+  Revision 1.2  1998/11/18 09:31:32  pierre
     * changed color scheme
       all colors are in RGB format if more than 256 colors
     + added 24 and 32 bits per pixel mode

rtl/dos/ppi/fill.ppi

@@ -12,34 +12,65 @@
 
  **********************************************************************}
 
+{$ifopt S+}
+{$define StackCkeckOn}
+{$endif opt S+}
+
 procedure floodfill(x,y:integer; border:longint);
 
 var bordercol     : longint;
-    fillcol       : longint;
+    fillcol,fillbkcol : longint;
     viewport      : viewporttype;
     offset        : longint;
-    
+    test_bkfill   : boolean;
+
+{$S+}
+{ Fill is very recursive !! }
+{ And it fails sometimes !! }
+
 procedure fill(x,y:integer);
 var start,ende,xx : integer;
     col           : longint;
  
 begin  
+{$ifdef ExtDebug}
+     Writeln(stderr,'Fill ',x,' ',y);
+{$endif def ExtDebug}
   xx:=x; col:=getpixel(xx,y);
-  if col=bordercol then exit;
-  while (col<>bordercol) and (xx >= viewport.x1) and (col<>fillcol)
+{$ifdef ExtDebug}
+     Writeln(stderr,'Fill ',x,' ',y,' ',col);
+{$endif def ExtDebug}
+  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);
     end;
-  start:=xx+1; 
+  if (col<>bordercol) and (col<>fillcol) and
+     (not test_bkfill or (col<>fillbkcol)) then
+    start:=xx
+  else
+    start:=xx+1;
 
   xx:=x+1; col:=getpixel(xx,y);
-  while (col<>bordercol) and (xx <= viewport.x2) and (col<>fillcol)
+  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);
     end;
-  ende:=xx-1;
+  if (col<>bordercol) and (col<>fillcol) and
+     (not test_bkfill or (col<>fillbkcol)) then
+    ende:=xx
+  else
+    ende:=xx-1;
 
+{$ifdef ExtDebug}
+     Writeln(stderr,'Pattern ',start,' ',ende,' ',y);
+{$endif def ExtDebug}
   patternline(start,ende,y);
+{$ifdef ExtDebug}
+     Writeln(stderr,'Fill  after Patterline ',x,' ',y,' ',getpixel(x,y));
+{$endif def ExtDebug}
   offset:=(y * _maxy + start) shr 8;
   
   if (y > viewport.y1)
@@ -47,7 +78,8 @@ begin
     xx:=start;
     repeat
       col:=getpixel(xx,y-1);
-      if (col<>bordercol) and (col<>fillcol)
+      if (col<>bordercol) and (col<>fillcol) and
+         (not test_bkfill or (col<>fillbkcol)) 
       then begin
         fill(xx,y-1);
         break;
@@ -61,7 +93,9 @@ begin
     xx:=start;
     repeat
       col:=getpixel(xx,y+1);
-      if (col<>bordercol) and (col<>fillcol) then fill(xx,y+1);
+      if (col<>bordercol) and (col<>fillcol) and
+         (not test_bkfill or (col<>fillbkcol)) then
+        fill(xx,y+1);
       xx:=xx+1;
     until xx > ende;
   end;
@@ -75,27 +109,49 @@ begin
   viewport.y2:=viewport.y2-viewport.y1;
   viewport.x1:=0;
   viewport.y1:=0;
-  bordercol:=convert(border);            
+  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;
+  
+  if aktfillsettings.pattern=emptyfill then
+    begin
+       fillcol:=fillbkcol;
+       test_bkfill:=false;
+    end
+  else if aktfillsettings.pattern=solidfill then
+     test_bkfill:=false
+  else
+    test_bkfill:=true;
+{$ifdef ExtDebug}
+     Writeln(stderr,'Fillcol ',fillcol,' bordercol',bordercol);
+{$endif def ExtDebug}
   fill(x,y);
 end;
 
+{$ifndef StackCkeckOn}
+{$S-} { return to normal state }
+{$else }
+{$undef StackCheckOn}
+{$endif }
+
 procedure GetFillSettings(var Fillinfo:Fillsettingstype);
 begin
   _graphresult:=grOk;
@@ -151,6 +207,7 @@ begin
   aktfillpattern:=fillpattern[pattern];
   aktfillsettings.pattern:=pattern;
   aktfillsettings.color:=convert(color);
+  aktfillbkcolor:=aktbackcolor;
   i:=1; j:=0;
   repeat
     mask:=$80;
@@ -201,7 +258,15 @@ end;
 
 {
   $Log$
-  Revision 1.3  1998-11-18 13:23:34  pierre
+  Revision 1.4  1998-11-19 09:48:48  pierre
+    + added some functions missing like sector ellipse getarccoords
+      (the filling of sector and ellipse is still buggy
+       I use floodfill but sometimes the starting point
+       is outside !!)
+    * fixed a bug in floodfill for patterns
+      (still has problems !!)
+
+  Revision 1.3  1998/11/18 13:23:34  pierre
     * floodfill got into an infinite loop !!
     + added partial support for fillpoly
       (still wrong if the polygon is not convex)

rtl/dos/ppi/global.ppi

@@ -114,7 +114,7 @@
        OrPut         = 2;
        AndPut        = 3;
        NotPut        = 4;
-       ClearTextPut  = $80;
+       BackPut       = 8;
 
        { SetTextJustify constants }
        LeftText   = 0;
@@ -189,7 +189,15 @@
 
 {
   $Log$
-  Revision 1.3  1998-11-18 09:31:34  pierre
+  Revision 1.4  1998-11-19 09:48:50  pierre
+    + added some functions missing like sector ellipse getarccoords
+      (the filling of sector and ellipse is still buggy
+       I use floodfill but sometimes the starting point
+       is outside !!)
+    * fixed a bug in floodfill for patterns
+      (still has problems !!)
+
+  Revision 1.3  1998/11/18 09:31:34  pierre
     * changed color scheme
       all colors are in RGB format if more than 256 colors
     + added 24 and 32 bits per pixel mode

rtl/dos/ppi/palette.ppi

@@ -100,9 +100,25 @@ gp_loop:
 gp_end:
   end;
 end;
+
+procedure SetPalette(ColorNum:word;Color:byte);
+
+  begin
+     SetRGBPalette(ColorNum,(StdColors[Color] shr 16) and $FF,
+       (StdColors[Color]  shr 8) and $FF,StdColors[Color] and $FF);
+  end;
+
 {
   $Log$
-  Revision 1.3  1998-11-18 09:31:39  pierre
+  Revision 1.4  1998-11-19 09:48:51  pierre
+    + added some functions missing like sector ellipse getarccoords
+      (the filling of sector and ellipse is still buggy
+       I use floodfill but sometimes the starting point
+       is outside !!)
+    * fixed a bug in floodfill for patterns
+      (still has problems !!)
+
+  Revision 1.3  1998/11/18 09:31:39  pierre
     * changed color scheme
       all colors are in RGB format if more than 256 colors
     + added 24 and 32 bits per pixel mode