+ added multi page support

rtl/dos/graph.pp

@@ -63,8 +63,11 @@ function  GetY : Integer;
 procedure Bar(x1,y1,x2,y2 : Integer);
 procedure bar3D(x1, y1, x2, y2 : integer;depth : word;top : boolean);
 procedure GetViewSettings(var viewport : ViewPortType);
+function  GetNumberOfPages : word;
 procedure SetActivePage(page : word);
+function  GetActivePage : word;
 procedure SetVisualPage(page : word);
+function  GetVisualPage : word;
 procedure SetWriteMode(WriteMode : integer);
 procedure SetViewPort(x1,y1,x2,y2 : integer;clip : boolean);
 procedure Cleardevice;
@@ -154,6 +157,8 @@ procedure WaitRetrace;
 procedure pixel(offset:longint);
 function  Convert(color:longint):longint;
 function  UnConvert(color:longint):longint;
+function  SetVESADisplayStart(PageNum : word;x,y : integer):Boolean;
+procedure GoodFillPoly(points : word;var polypoints);
 {$endif debug}
 
 {$ifdef Test_linear}
@@ -256,7 +261,13 @@ var    { X/Y Verhaeltnis des Bildschirm }
        { used for fill }
        colormask : longint;
        { Videospeicherbereiche }
-       wbuffer,rbuffer,wrbuffer : ^byte;
+       wbuffer : ^byte;
+       { Offset to current page }
+       AktPageOffset : longint;
+       AktPage : word;
+       AktVisualPage : word;
+       { these are not used !! PM }
+       rbuffer,wrbuffer : ^byte;
        { aktueller Ausgabebereich }
        aktviewport : ViewPortType;
        aktscreen   : ViewPortType;
@@ -296,10 +307,10 @@ var    { X/Y Verhaeltnis des Bildschirm }
        buffersize : longint;
        { in diesem Puffer werden bei SetFillStyle bereits die Pattern in der }
        { zu verwendenden Farbe abgelegt }
-       PatternBuffer : Array[0..63]of LongInt;
+       PatternBuffer : Array [0..63] of LongInt;
 
-       X_Array         : array[0..1280]of LongInt;
-       Y_Array         : array[0..1024]of LongInt;
+       X_Array         : array [0..1280] of LongInt;
+       Y_Array         : array [0..1024] of LongInt;
 
        Sel,Seg      : word;
        VGAInfo      : VGAInfoBlock;
@@ -540,8 +551,8 @@ begin
   aktcolor:=aktbackcolor;
   storewritemode:=aktwritemode;
   aktwritemode:=normalput;
-  ofs1:=Y_ARRAY[aktviewport.y1] + X_ARRAY[aktviewport.x1] ;
-  ofs2:=Y_ARRAY[aktviewport.y1] + X_ARRAY[aktviewport.x2] ;
+  ofs1:=Y_ARRAY[aktviewport.y1] + X_ARRAY[aktviewport.x1];
+  ofs2:=Y_ARRAY[aktviewport.y1] + X_ARRAY[aktviewport.x2];
   for y:=aktviewport.y1 to aktviewport.y2 do
   begin
     bank1:=ofs1 shr winshift;
@@ -691,8 +702,19 @@ begin
      end;
 end;
 
+procedure SetArrays;
+
+  var
+     index:Integer;
+  begin
+     for index:=0 to VESAInfo.XResolution do
+       X_Array[index]:=index * BytesPerPixel;
+     for index:=0 to VESAInfo.YResolution do
+       Y_Array[index]:=index * BytesPerLine + AktPageOffset;
+  end;
+  
 procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;const PathToDriver:String);
-var i,index:Integer;
+var i : Integer;
 begin
     { Pfad zu den Fonts }
     bgipath:=PathToDriver;
@@ -725,12 +747,14 @@ begin
       GetVESAInfo(GraphMode);
       if UseLinearFrameBuffer then
         isgraphmode:=SetVESAMode(GraphMode or EnableLinearFrameBuffer);
-      for index:=0 to VESAInfo.XResolution do X_Array[index]:=index * BytesPerPixel;
-      for index:=0 to VESAInfo.YResolution do Y_Array[index]:=index * BytesPerLine;
+      { set zero page }
+      AktPageOffset:=0;
+      SetActivePage(0);
+      SetVisualPage(0);
+      SetArrays;
       SetGraphBufSize(bufferstandardsize);
       graphdefaults;
       InTempCRTMode:=false;
-
       exit;
     end;
     dec(i);
@@ -741,7 +765,6 @@ end;
 
 procedure SetGraphMode(GraphMode:Integer);
 
-var index:Integer;
 begin
    _graphresult:=grOk;
    if not isgraphmode and not InTempCRTMode then
@@ -756,10 +779,11 @@ begin
            begin
               if UseLinearFrameBuffer then
                 isgraphmode:=SetVESAMode(GraphMode or EnableLinearFrameBuffer);
-              for index:=0 to VESAInfo.XResolution do
-                X_Array[index]:=index * BytesPerPixel;
-              for index:=0 to VESAInfo.YResolution do
-                Y_Array[index]:=index * BytesPerLine;
+              { set zero page }
+              AktPageOffset:=0;
+              SetActivePage(0);
+              SetVisualPage(0);
+              SetArrays;
               graphdefaults;
               InTempCRTMode:=false;
               exit;
@@ -871,9 +895,25 @@ begin
     begin
       _graphresult:=grNoInitGraph;;
       exit;
+    end
+  else if (Page<VESAInfo.NumberOfPages) and (AktVisualPage<>Page) then
+    begin
+       SetVESADisplayStart(Page,0,0);
+       {SetDisplayPage(Page);}
+       AktVisualPage:=Page;
     end;
 end;
 
+function GetVisualPage : word;
+  begin
+     GetVisualPage:=AktVisualPage;
+  end;
+  
+function GetActivePage : word;
+  begin
+     GetActivePage:=AktPage;
+  end;
+  
 { mehrere Bildschirmseiten werden nicht unterst�tzt }
 { Dummy aus Kompatibilit„tsgr�nden                  }
 procedure SetActivePage(page : word);
@@ -884,9 +924,20 @@ procedure SetActivePage(page : word);
        begin
          _graphresult:=grNoInitGraph;;
           exit;
+       end
+     else  if (Page<VESAInfo.NumberOfPages) and (Page<>AktPage) then
+       begin
+          AktPageOffset:=Page*BytesPerLine*_maxy;
+          AktPage:=Page;
+          SetArrays;
        end;
   end;
 
+function  GetNumberOfPages : word;
+  begin
+     GetNumberOfPages:=VESAInfo.NumberOfPages;
+  end;
+  
 procedure SetWriteMode(WriteMode : integer);
 begin
   _graphresult:=grOk;
@@ -952,11 +1003,17 @@ begin
    rbuffer:=pointer($0);
    wbuffer:=pointer($0);
   end;
+  AktPageOffset:=0;
+  AktPage:=0;
+  AktVisualPage:=0;
 end.
 
 {
   $Log$
-  Revision 1.12  1998-11-23 10:04:16  pierre
+  Revision 1.13  1998-11-25 13:04:43  pierre
+    + added multi page support
+
+  Revision 1.12  1998/11/23 10:04:16  pierre
     * pieslice and sector work now !!
     * bugs in text writing removed
     + scaling for defaultfont added

rtl/dos/ppi/fill.ppi

@@ -266,10 +266,140 @@ begin
    floodfill(xm,ym,truecolor);
 end;
 
+procedure GoodFillPoly(points : word;var polypoints);
+{$R-}
+ type PointTypeArray = Array[0..0] of PointType;
+
+      { Used to find the horizontal lines that
+        must be filled }
+      TLineSegmentInfo = Record
+                      {range for check }
+                      ymin,ymax,
+                      { line equation consts }
+                      xcoef,ycoef,_const,
+                      lastvalue : longint;
+                    End;
+     LineSegmentInfoArray = Array[0..0] of TLineSegmentInfo;
+     
+ var
+     xmin,xmax,ymin,ymax : longint;
+     x1,x2,y1,y2,xdeb    : longint;
+     i,j,curx,cury       : longint;
+     newvalue            : longint;
+     LineInfo            : ^LineSegmentInfoArray;
+     oldinside,inside    : boolean;
+     viewport            : viewporttype;
+begin
+   GetMem(LineInfo,(points+1)*SizeOf(TlineSegmentInfo));
+   xmax:=$8000000;xmin:=$7fffffff;
+   ymax:=$8000000;ymin:=$7fffffff;
+   for i:=0 to points-1 do
+     begin
+        if i=points-1 then
+          j:=0
+        else
+          j:=i+1;
+        x1:=PointTypeArray(polypoints)[i].x;
+        y1:=PointTypeArray(polypoints)[i].y;
+        x2:=PointTypeArray(polypoints)[j].x;
+        y2:=PointTypeArray(polypoints)[j].y;
+        if x1>xmax then
+          xmax:=x1;
+        if x1<xmin then
+          xmin:=x1;
+        if y1>ymax then
+          ymax:=y1;
+        if y1<ymin then
+          ymin:=y1;
+        if y1<y2 then
+          begin
+             LineInfo^[i].ymin:=y1;
+             LineInfo^[i].ymax:=y2;
+          end
+        else
+          begin
+             LineInfo^[i].ymin:=y2;
+             LineInfo^[i].ymax:=y1;
+          end;
+        LineInfo^[i].xcoef:=y2-y1;
+        LineInfo^[i].ycoef:=x1-x2;
+        LineInfo^[i]._const:=y1*x2-x1*y2;
+     end; { setting of LineInfo }
+
+   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;
+ 
+{$ifdef Debug}
+       Writeln(stderr,'Rectangle (',xmin,',',ymin,'),(',xmax,',',ymax,')');
+{$endif def GraphDebug}
+   if xmin<0 then xmin:=0;
+   if ymin<0 then ymin:=0;
+   if xmax>viewport.x2 then xmax:=viewport.x2;
+   if ymax>viewport.y2 then ymax:=viewport.y2;
+{$ifdef Debug}
+       Writeln(stderr,'Rectangle (',xmin,',',ymin,'),(',xmax,',',ymax,')');
+{$endif def GraphDebug}
+
+   for cury:=ymin to ymax do
+     begin
+        xdeb:=xmin;
+        oldinside:=true;
+        for i:=0 to points-1 do
+          if (cury>=LineInfo^[i].ymin) and (cury<LineInfo^[i].ymax) then
+            begin
+               LineInfo^[i].lastvalue:=LineInfo^[i].xcoef*(xmin-1)+
+                 LineInfo^[i].ycoef*cury+LineInfo^[i]._const;
+               if LineInfo^[i].lastvalue<0 then
+                 oldinside:=not oldinside;
+            end;
+        inside:=oldinside;
+        for curx:=xmin to xmax do
+           begin
+              for i:=0 to points-1 do
+                if (cury>=LineInfo^[i].ymin) and (cury<LineInfo^[i].ymax) then
+                  begin
+                     newvalue:=LineInfo^[i].lastvalue+LineInfo^[i].xcoef;
+                     if LineInfo^[i].lastvalue*newvalue<0 then
+                       inside:=not inside;
+                     LineInfo^[i].lastvalue:=newvalue;
+                  end;
+              if inside<>oldinside then
+                if inside then
+                  xdeb:=curx
+                else
+                  begin
+                     patternline(xdeb,curx,cury);
+{$ifdef Debug}
+                     Writeln(stderr,'Pattern (',xdeb,',',curx,') at ',cury);
+{$endif def GraphDebug}
+                  end;
+              oldinside:=inside;
+           end;
+        if inside then
+          begin
+             patternline(xdeb,xmax,cury);
+{$ifdef Debug}
+             Writeln(stderr,'Pattern (',xdeb,',',xmax,') at ',cury);
+{$endif def GraphDebug}
+          end;
+     end;
+       
+   { simply call drawpoly instead (PM) }
+   DrawPoly(points,polypoints);
+end;
+
 
 {
   $Log$
-  Revision 1.6  1998-11-20 18:42:07  pierre
+  Revision 1.7  1998-11-25 13:04:44  pierre
+    + added multi page support
+
+  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

rtl/dos/ppi/ibm.ppi

@@ -219,6 +219,37 @@ begin
   else SetVESAMode:=true;
 end;
 
+procedure SetDisplayPage(PageNum : word);
+
+  begin
+     dregs.RealSP:=0;      dregs.RealSS:=0;
+     dregs.RealEAX:=$0500+(PageNum and $FF);
+     RealIntr($10,dregs);
+  end;
+  
+function SetVESADisplayStart(PageNum : word;x,y : integer):Boolean;
+begin
+  if PageNum>VesaInfo.NumberOfPages then
+    PageNum:=0;
+{$ifdef DEBUG}
+  if PageNum>0 then
+    writeln(stderr,'Setting Display Page ',PageNum);
+{$endif DEBUG}
+  dregs.RealEBX:=0{ $80 for Wait for retrace };
+  dregs.RealECX:=x;
+  dregs.RealEDX:=y+PageNum*_maxy;
+  dregs.RealSP:=0;      dregs.RealSS:=0;
+  dregs.RealEAX:=$4F07; RealIntr($10,dregs);
+  { idem as above !!! }
+  if (dregs.RealEAX and $1FF) <> $4F then
+    begin
+       writeln(stderr,'Set Display start error');
+       SetVESADisplayStart:=false;
+    end
+  else
+    SetVESADisplayStart:=true;
+end;
+
 function GetVESAMode:Integer;
 begin
   dregs.RealSP:=0;      dregs.RealSS:=0;
@@ -300,7 +331,10 @@ end;
 
 {
   $Log$
-  Revision 1.6  1998-11-20 18:42:08  pierre
+  Revision 1.7  1998-11-25 13:04:46  pierre
+    + added multi page support
+
+  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

rtl/dos/ppi/vesadeb.ppi

@@ -56,8 +56,10 @@
     writeln('   Segment:  ',HexStr(VESAInfo.segWinB,4));
     writeln('Granularity  : ',VESAInfo.WinGranularity);
     writeln('WinSize      : ',Winsize,' KByte  WinShift : ',WinShift);
-    writeln('BytesPerLine : ',BytesPerLine);
-    writeln('BytesPerPixel: ',BytesPerPixel);
+    write('BytesPerLine : ',BytesPerLine:4);
+    writeln(' BytesPerPixel: ',BytesPerPixel);
+    writeln('Number of pages: ',VESAInfo.NumberOfPages);
+
     if isDPMI then
       begin
          write('Write selector linear base: ',hexstr(get_segment_base_address(seg_write),8));
@@ -74,7 +76,10 @@
  
 {
   $Log$
-  Revision 1.3  1998-11-18 13:23:37  pierre
+  Revision 1.4  1998-11-25 13:04:47  pierre
+    + added multi page support
+
+  Revision 1.3  1998/11/18 13:23:37  pierre
     * floodfill got into an infinite loop !!
     + added partial support for fillpoly
       (still wrong if the polygon is not convex)