+ hlinevesa256 and vlinevesa256

  + support for not/xor/or/andput in vesamodes with 32k/64k colors
  * lots of changes to avoid warnings under FPC

rtl/inc/graph/clip.inc

@@ -104,25 +104,25 @@ const
              code:=code1;
             if (code and LEFT) <> 0 then
               begin
-                newy:=y1+trunc((y2-y1)*(xmin-x1)/(x2-x1));
+                newy:=y1+(y2-y1)*(xmin-x1) div (x2-x1);
                 newx:=xmin;
               end
             else
             if (code and RIGHT) <> 0 then
               begin
-                newy:=y1+trunc((y2-y1)*(xmax-x1)/(x2-x1));
+                newy:=y1+(y2-y1)*(xmax-x1) div (x2-x1);
                 newx:=xmax;
               end
             else
             if (code and BOTTOM) <> 0 then
               begin
-                newx:=x1+trunc((x2-x1)* ((ymax-y1) / (y2-y1)));
+                newx:=x1+(x2-x1)* ((ymax-y1) div (y2-y1));
                 newy:=ymax;
               end
             else
             if (code and TOP) <> 0 then
               begin
-                newx:=x1+trunc((x2-x1)*(ymin-y1)/(y2-y1));
+                newx:=x1+(x2-x1)*(ymin-y1) div (y2-y1);
                 newy:=ymin;
               end;
            if (code1 = code) then
@@ -142,7 +142,12 @@ end;
 
 {
 $Log$
-Revision 1.4  1999-09-12 17:28:59  jonas
+Revision 1.5  1999-09-18 22:21:09  jonas
+  + hlinevesa256 and vlinevesa256
+  + support for not/xor/or/andput in vesamodes with 32k/64k colors
+  * lots of changes to avoid warnings under FPC
+
+Revision 1.4  1999/09/12 17:28:59  jonas
   * several changes to internalellipse to make it faster
     and to make sure it updates the ArcCall correctly
     (not yet done for width = 3)

rtl/inc/graph/fills.inc

@@ -114,13 +114,13 @@ type
 var
         ptable : ppointarray; { pointer to points list }
 
-function compare_ind(u, v : pointer) : graph_int; far;
+function compare_ind(u, v : pointer) : graph_int; {$ifndef fpc} far; {$endif fpc}
 begin
         if (ptable^[pint(u)^].y <= ptable^[pint(v)^].y) then compare_ind := -1
         else compare_ind := 1;
 end;
 
-function compare_active(u, v : pointer) : graph_int; far;
+function compare_active(u, v : pointer) : graph_int; {$ifndef fpc} far; {$endif fpc}
 begin
         if (pedge(u)^.x <= pedge(v)^.x) then compare_active := -1
         else compare_active := 1;
@@ -492,7 +492,12 @@ var
 
 {
 $Log$
-Revision 1.7  1999-09-17 13:58:31  jonas
+Revision 1.8  1999-09-18 22:21:09  jonas
+  + hlinevesa256 and vlinevesa256
+  + support for not/xor/or/andput in vesamodes with 32k/64k colors
+  * lots of changes to avoid warnings under FPC
+
+Revision 1.7  1999/09/17 13:58:31  jonas
 * another fix for a case where internalellipsedefault went haywire
 * sector() and pieslice() fully implemented!
 * small change to prevent buffer overflow with floodfill

rtl/inc/graph/graph.inc

@@ -145,7 +145,7 @@ CONST
  {*                     4-bit planar VGA mode routines                   *}
  {************************************************************************}
 
-  Procedure Init640x200x16; far; assembler;
+  Procedure Init640x200x16; {$ifndef fpc}far;{$endif fpc} assembler;
   { must also clear the screen...}
    asm
      mov ax,000Eh
@@ -159,7 +159,7 @@ CONST
    end;
 
 
-   Procedure Init640x350x16; far; assembler;
+   Procedure Init640x350x16; {$ifndef fpc}far;{$endif fpc} assembler;
   { must also clear the screen...}
     asm
       mov ax,0010h
@@ -172,7 +172,7 @@ CONST
 {$endif fpc}
     end;
 
-  procedure Init640x480x16; far; assembler;
+  procedure Init640x480x16; {$ifndef fpc}far;{$endif fpc} assembler;
   { must also clear the screen...}
     asm
       mov  ax,0012h
@@ -185,7 +185,7 @@ CONST
 {$endif fpc}
     end;
 
- Procedure PutPixel16(X,Y : Integer; Pixel: Word); far;
+ Procedure PutPixel16(X,Y : Integer; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
 {$ifndef asmgraph}
  var offset: word;
      dummy: byte;
@@ -290,7 +290,7 @@ CONST
    end;
 
 
- Function GetPixel16(X,Y: Integer):word; far;
+ Function GetPixel16(X,Y: Integer):word; {$ifndef fpc}far;{$endif fpc}
 {$ifndef asmgraph}
  Var dummy, offset: Word;
      shift: byte;
@@ -448,7 +448,7 @@ CONST
   end;
 
 
- Procedure DirectPutPixel16(X,Y : Integer); far;
+ Procedure DirectPutPixel16(X,Y : Integer); {$ifndef fpc}far;{$endif fpc}
  { x,y -> must be in global coordinates. No clipping. }
   var
    color: word;
@@ -589,7 +589,7 @@ CONST
  end;
 
 {$ifndef tp}
-  procedure HLine16(x,x2,y: integer); far;
+  procedure HLine16(x,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
 
    var
       xtmp: integer;
@@ -716,7 +716,7 @@ CONST
     port[$3cf]:=0;
    end;
 
-  procedure VLine16(x,y,y2: integer); far;
+  procedure VLine16(x,y,y2: integer); {$ifndef fpc}far;{$endif fpc}
 
    var
      ytmp: integer;
@@ -797,20 +797,20 @@ CONST
 {$endif tp}
 
 
- procedure SetVisual480(page: word); far;
+ procedure SetVisual480(page: word); {$ifndef fpc}far;{$endif fpc}
  { no page flipping support in 640x480 mode }
   begin
     VideoOfs := 0;
   end;
 
- procedure SetActive480(page: word); far;
+ procedure SetActive480(page: word); {$ifndef fpc}far;{$endif fpc}
  { no page flipping support in 640x480 mode }
   begin
     VideoOfs := 0;
   end;
 
 
- procedure SetVisual200(page: word); far;
+ procedure SetVisual200(page: word); {$ifndef fpc}far;{$endif fpc}
   { two page support... }
   begin
     if page > HardwarePages then exit;
@@ -839,7 +839,7 @@ CONST
     end;
   end;
 
- procedure SetActive200(page: word); far;
+ procedure SetActive200(page: word); {$ifndef fpc}far;{$endif fpc}
   { two page support... }
   begin
     case page of
@@ -851,7 +851,7 @@ CONST
     end;
   end;
 
- procedure SetVisual350(page: word); far;
+ procedure SetVisual350(page: word); {$ifndef fpc}far;{$endif fpc}
   { one page support... }
   begin
     if page > HardwarePages then exit;
@@ -868,7 +868,7 @@ CONST
     end;
   end;
 
- procedure SetActive350(page: word); far;
+ procedure SetActive350(page: word); {$ifndef fpc}far;{$endif fpc}
   { one page support... }
   begin
     case page of
@@ -887,7 +887,7 @@ CONST
  {*                     320x200x256c Routines                            *}
  {************************************************************************}
 
- Procedure Init320; far; assembler;
+ Procedure Init320; {$ifndef fpc}far;{$endif fpc} assembler;
   asm
     mov ax,0013h
 {$ifdef fpc}
@@ -899,7 +899,7 @@ CONST
 {$endif fpc}
   end;
 
- Procedure PutPixel320(X,Y : Integer; Pixel: Word); far;
+ Procedure PutPixel320(X,Y : Integer; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
  { x,y -> must be in local coordinates. Clipping if required. }
   Begin
     X:= X + StartXViewPort;
@@ -941,7 +941,7 @@ CONST
   end;
 
 
- Function GetPixel320(X,Y: Integer):word; far;
+ Function GetPixel320(X,Y: Integer):word; {$ifndef fpc}far;{$endif fpc}
   Begin
    X:= X + StartXViewPort;
    Y:= Y + StartYViewPort;
@@ -975,7 +975,7 @@ CONST
   end;
 
 
- Procedure DirectPutPixel320(X,Y : Integer); far;
+ Procedure DirectPutPixel320(X,Y : Integer); {$ifndef fpc}far;{$endif fpc}
  { x,y -> must be in global coordinates. No clipping. }
 {$ifndef asmgraph}
  var offset: word;
@@ -1027,12 +1027,12 @@ CONST
 {$endif asmgraph}
 
 
- procedure SetVisual320(page: word); far;
+ procedure SetVisual320(page: word); {$ifndef fpc}far;{$endif fpc}
   { no page support... }
   begin
   end;
 
- procedure SetActive320(page: word); far;
+ procedure SetActive320(page: word); {$ifndef fpc}far;{$endif fpc}
   { no page support... }
   begin
    VideoOfs := 0;
@@ -1043,7 +1043,7 @@ CONST
  {************************************************************************}
 const CrtAddress: word = 0;
 
- procedure InitModeX; far;
+ procedure InitModeX; {$ifndef fpc}far;{$endif fpc}
   begin
    asm
      {see if we are using color-/monochorme display}
@@ -1115,7 +1115,7 @@ const CrtAddress: word = 0;
  end;
 
 
- Function GetPixelX(X,Y: Integer): word; far;
+ Function GetPixelX(X,Y: Integer): word; {$ifndef fpc}far;{$endif fpc}
 {$ifndef asmgraph}
  var offset: word;
 {$endif asmgraph}
@@ -1182,7 +1182,7 @@ const CrtAddress: word = 0;
 {$endif asmgraph}
  end;
 
- procedure SetVisualX(page: word); far;
+ procedure SetVisualX(page: word); {$ifndef fpc}far;{$endif fpc}
   { 4 page support... }
 
    Procedure SetVisibleStart(AOffset: word); Assembler;
@@ -1238,7 +1238,7 @@ const CrtAddress: word = 0;
     end;
   end;
 
- procedure SetActiveX(page: word); far;
+ procedure SetActiveX(page: word); {$ifndef fpc}far;{$endif fpc}
   { 4 page support... }
   begin
    case page of
@@ -1251,7 +1251,7 @@ const CrtAddress: word = 0;
    end;
   end;
 
- Procedure PutPixelX(X,Y: Integer; color:word); far;
+ Procedure PutPixelX(X,Y: Integer; color:word); {$ifndef fpc}far;{$endif fpc}
 {$ifndef asmgraph}
  var offset: word;
      dummy: byte;
@@ -1309,7 +1309,7 @@ const CrtAddress: word = 0;
   end;
 
 
- Procedure DirectPutPixelX(X,Y: Integer); far;
+ Procedure DirectPutPixelX(X,Y: Integer); {$ifndef fpc}far;{$endif fpc}
  { x,y -> must be in global coordinates. No clipping. }
 {$ifndef asmgraph}
  Var offset: Word;
@@ -1375,7 +1375,7 @@ const CrtAddress: word = 0;
 {$IFDEF DPMI}
   RealStateSeg: word;    { Real segment of saved video state }
 
- Procedure SaveStateVGA;
+ Procedure SaveStateVGA; {$ifndef fpc}far;{$endif fpc}
  var
   PtrLong: longint;
   regs: TDPMIRegisters;
@@ -1442,7 +1442,7 @@ const CrtAddress: word = 0;
       end;
   end;
 
- procedure RestoreStateVGA;
+ procedure RestoreStateVGA; {$ifndef fpc}far;{$endif fpc}
   var
    regs:TDPMIRegisters;
   begin
@@ -1493,7 +1493,7 @@ const CrtAddress: word = 0;
       {**************************************************************}
 
 
- Procedure SaveStateVGA; far;
+ Procedure SaveStateVGA; far; 
   begin
     SavePtr := nil;
     SaveSupported := FALSE;
@@ -1568,7 +1568,7 @@ const CrtAddress: word = 0;
 
    { VGA is never a direct color mode, so no need to check ... }
    Procedure SetVGARGBPalette(ColorNum, RedValue, GreenValue,
-      BlueValue : Integer); far; assembler;
+      BlueValue : Integer); {$ifndef fpc}far;{$endif fpc} assembler;
     asm
       { on some hardware - there is a snow like effect       }
       { when changing the palette register directly          }
@@ -1609,7 +1609,7 @@ const CrtAddress: word = 0;
 
    { VGA is never a direct color mode, so no need to check ... }
   Procedure GetVGARGBPalette(ColorNum: integer; Var
-      RedValue, GreenValue, BlueValue : integer); far;
+      RedValue, GreenValue, BlueValue : integer); {$ifndef fpc}far;{$endif fpc}
    begin
      Port[$03C7] := ColorNum;
      { we must convert to lsb values... because the vga uses the 6 msb bits }
@@ -2015,6 +2015,8 @@ const CrtAddress: word = 0;
              mode.InitMode := Init640x400x256;
              mode.SetVisualPage := SetVisualVESA;
              mode.SetActivePage := SetActiveVESA;
+             mode.hline := HLineVESA256;
+             mode.vline := VLineVESA256;
 {$else fpc}
              mode.DirectPutPixel:=@DirectPutPixVESA256;
              mode.PutPixel:=@PutPixVESA256;
@@ -2024,6 +2026,8 @@ const CrtAddress: word = 0;
              mode.InitMode := @Init640x400x256;
              mode.SetVisualPage := @SetVisualVESA;
              mode.SetActivePage := @SetActiveVESA;
+             mode.hline := @HLineVESA256;
+             mode.vline := @VLineVESA256;
 {$endif fpc}
              mode.XAspect := 10000;
              mode.YAspect := 10000;
@@ -2051,6 +2055,8 @@ const CrtAddress: word = 0;
              mode.InitMode := Init640x480x256;
              mode.SetVisualPage := SetVisualVESA;
              mode.SetActivePage := SetActiveVESA;
+             mode.hline := HLineVESA256;
+             mode.vline := VLineVESA256;
 {$else fpc}
              mode.DirectPutPixel:=@DirectPutPixVESA256;
              mode.PutPixel:=@PutPixVESA256;
@@ -2060,6 +2066,8 @@ const CrtAddress: word = 0;
              mode.InitMode := @Init640x480x256;
              mode.SetVisualPage := @SetVisualVESA;
              mode.SetActivePage := @SetActiveVESA;
+             mode.hline := @HLineVESA256;
+             mode.hline := @HLineVESA256;
 {$endif fpc}
              mode.XAspect := 10000;
              mode.YAspect := 10000;
@@ -2199,6 +2207,8 @@ const CrtAddress: word = 0;
              mode.InitMode := Init800x600x256;
              mode.SetVisualPage := SetVisualVESA;
              mode.SetActivePage := SetActiveVESA;
+             mode.hline := HLineVESA256;
+             mode.vline := VLineVESA256;
 {$else fpc}
              mode.DirectPutPixel:=@DirectPutPixVESA256;
              mode.PutPixel:=@PutPixVESA256;
@@ -2208,6 +2218,8 @@ const CrtAddress: word = 0;
              mode.InitMode := @Init800x600x256;
              mode.SetVisualPage := @SetVisualVESA;
              mode.SetActivePage := @SetActiveVESA;
+             mode.hline := @HLineVESA256;
+             mode.vline := @VLineVESA256;
 {$endif fpc}
              mode.XAspect := 10000;
              mode.YAspect := 10000;
@@ -2347,6 +2359,8 @@ const CrtAddress: word = 0;
              mode.InitMode := Init1024x768x256;
              mode.SetVisualPage := SetVisualVESA;
              mode.SetActivePage := SetActiveVESA;
+             mode.hline := HLineVESA256;
+             mode.vline := VLineVESA256;
 {$else fpc}
              mode.DirectPutPixel:=@DirectPutPixVESA256;
              mode.PutPixel:=@PutPixVESA256;
@@ -2356,6 +2370,8 @@ const CrtAddress: word = 0;
              mode.InitMode := @Init1024x768x256;
              mode.SetVisualPage := @SetVisualVESA;
              mode.SetActivePage := @SetActiveVESA;
+             mode.vline := @VLineVESA256;
+             mode.hline := @HLineVESA256;
 {$endif fpc}
              mode.XAspect := 10000;
              mode.YAspect := 10000;
@@ -2495,6 +2511,8 @@ const CrtAddress: word = 0;
              mode.GetRGBPalette := GetVESARGBPalette;
              mode.SetVisualPage := SetVisualVESA;
              mode.SetActivePage := SetActiveVESA;
+             mode.hline := HLineVESA256;
+             mode.vline := VLineVESA256;
 {$else fpc}
              mode.DirectPutPixel:=@DirectPutPixVESA256;
              mode.PutPixel:=@PutPixVESA256;
@@ -2504,6 +2522,8 @@ const CrtAddress: word = 0;
              mode.GetRGBPalette := @GetVESARGBPalette;
              mode.SetVisualPage := @SetVisualVESA;
              mode.SetActivePage := @SetActiveVESA;
+             mode.vline := @VLineVESA256;
+             mode.hline := @HLineVESA256;
 {$endif fpc}
              mode.XAspect := 10000;
              mode.YAspect := 10000;
@@ -2588,7 +2608,12 @@ const CrtAddress: word = 0;
 
 {
 $Log$
-Revision 1.13  1999-09-18 16:03:36  jonas
+Revision 1.14  1999-09-18 22:21:09  jonas
+  + hlinevesa256 and vlinevesa256
+  + support for not/xor/or/andput in vesamodes with 32k/64k colors
+  * lots of changes to avoid warnings under FPC
+
+Revision 1.13  1999/09/18 16:03:36  jonas
   * graph.pp: removed pieslice and sector from ToDo list
   * closegraph: exits now immidiately if isgraphmode = false (caused
     RTE 204 with VESA enabled if you set exitproc to call closegraph
@@ -2622,7 +2647,7 @@ Revision 1.9  1999/08/01 14:50:51  jonas
 
 Revision 1.8  1999/07/18 15:07:19  jonas
   + xor-, and and- orput support for VESA256 modes
-  * compile with -dlogging if you wnt some info to be logged to grlog.txt
+  * compile with -dlogging if you want some info to be logged to grlog.txt
 
 Revision 1.7  1999/07/14 18:18:02  florian
   * cosmetic changes
@@ -2642,7 +2667,7 @@ Revision 1.4  1999/07/12 13:27:08  jonas
   * only dispose vesainfo at closegrph if a vesa card was detected
   * changed int32 to longint (int32 is not declared under FPC)
   * changed the declaration of almost every procedure in graph.inc to
-    "far;" becquse otherwise you can't assign them to procvars under TP
+    "far;" because otherwise you can't assign them to procvars under TP
     real mode (but unexplainable "data segnment too large" errors prevent
     it from working under real mode anyway)
 

rtl/inc/graph/graph.pp

@@ -37,8 +37,6 @@ Unit Graph;
 {    returns an error.                                  }
 { - DrawPoly XORPut mode is not exactly the same as in  }
 {   the TP graph unit.                                  }
-{ - FillEllipse does not support XORPut mode with a     }
-{   bounded FloodFill. Mode is always CopyPut mode.     }
 { - Imagesize returns a longint instead of a word       }
 { - ImageSize cannot return an error value              }
 {-------------------------------------------------------}
@@ -48,7 +46,9 @@ Unit Graph;
 {   Pierre Mueller      - major bugfixes                }
 {   Carl Eric Codere    - complete rewrite              }
 {   Thomas Schatzl      - optimizations,routines and    }
-{ Credits (external):       suggestions.                }
+{                           suggestions.                }
+{   Jonas Maebe         - bugfixes and optimizations    }
+{ Credits (external):                                   }
 {   - Original FloodFill code by                        }
 {        Menno Victor van der star                      }
 {     (the code has been heavily modified)              }
@@ -810,7 +810,7 @@ var
 
   {$i clip.inc}
 
-  procedure HLineDefault(x,x2,y: integer); far;
+  procedure HLineDefault(x,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
 
    var
     xtmp: integer;
@@ -838,7 +838,7 @@ var
    end;
 
 
-  procedure VLineDefault(x,y,y2: integer); far;
+  procedure VLineDefault(x,y,y2: integer); {$ifndef fpc}far;{$endif fpc}
 
    var
     Col: word;
@@ -865,7 +865,7 @@ var
   End;
 
 
-  procedure LineDefault(X1, Y1, X2, Y2: Integer); far;
+  procedure LineDefault(X1, Y1, X2, Y2: Integer); {$ifndef fpc}far;{$endif fpc}
 
   var X, Y :           Integer;
       deltax, deltay : Integer;
@@ -1305,7 +1305,7 @@ var
   {********************************************************}
 
   Procedure InternalEllipseDefault(X,Y: Integer;XRadius: word;
-    YRadius:word; stAngle,EndAngle: word; pl: PatternLineProc); far;
+    YRadius:word; stAngle,EndAngle: word; pl: PatternLineProc); {$ifndef fpc}far;{$endif fpc}
    var
     j, Delta, DeltaEnd: graph_float;
     NumOfPixels: longint;
@@ -1371,7 +1371,7 @@ var
    { quadrant, so divide the circumference value by 4 (JM)       }
    NumOfPixels:=(8 div 4)*Round(2*sqrt((sqr(XRadius)+sqr(YRadius)) div 2));
    { Calculate the angle precision required }
-   Delta := 90 / (NumOfPixels);
+   Delta := 90.0 / (NumOfPixels);
    { Adjust for screen aspect ratio }
    XRadius:=(longint(XRadius)*10000) div XAspect;
    YRadius:=(longint(YRadius)*10000) div YAspect;
@@ -1576,7 +1576,7 @@ Begin
   End;
 End;
   *)
-  procedure PatternLineDefault(x1,x2,y: integer); far;
+  procedure PatternLineDefault(x1,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
   {********************************************************}
   { Draws a horizontal patterned line according to the     }
   { current Fill Settings.                                 }
@@ -1745,7 +1745,7 @@ End;
 {--------------------------------------------------------------------------}
 
 
-Procedure ClearViewPortDefault; far;
+Procedure ClearViewPortDefault; {$ifndef fpc}far;{$endif fpc}
 var
  j: integer;
  OldWriteMode, OldCurColor: word;
@@ -1843,7 +1843,7 @@ end;
 {--------------------------------------------------------------------------}
 
 
-  Procedure GetScanlineDefault (Y : Integer; Var Data); far;
+  Procedure GetScanlineDefault (Y : Integer; Var Data); {$ifndef fpc}far;{$endif fpc}
   {**********************************************************}
   { Procedure GetScanLine()                                  }
   {----------------------------------------------------------}
@@ -1863,14 +1863,14 @@ end;
 
 
 
-Function DefaultImageSize(X1,Y1,X2,Y2: Integer): longint; far;
+Function DefaultImageSize(X1,Y1,X2,Y2: Integer): longint; {$ifndef fpc}far;{$endif fpc}
 Begin
   { each pixel uses two bytes, to enable modes with colors up to 64K }
   { to work.                                                         }
   DefaultImageSize := 12 + (((X2-X1)*(Y2-Y1))*2);
 end;
 
-Procedure DefaultPutImage(X,Y: Integer; var Bitmap; BitBlt: Word); far;
+Procedure DefaultPutImage(X,Y: Integer; var Bitmap; BitBlt: Word); {$ifndef fpc}far;{$endif fpc}
 type
   pt = array[0..32000] of word;
   ptw = array[0..3] of longint;
@@ -1905,7 +1905,7 @@ Begin
 end;
 
 
-Procedure DefaultGetImage(X1,Y1,X2,Y2: Integer; Var Bitmap); far;
+Procedure DefaultGetImage(X1,Y1,X2,Y2: Integer; Var Bitmap); {$ifndef fpc}far;{$endif fpc}
 type
   pt = array[0..32000] of word;
   ptw = array[0..3] of longint;
@@ -1947,12 +1947,12 @@ end;
    end;
 
 
-  procedure SetVisualPageDefault(page : word); far;
+  procedure SetVisualPageDefault(page : word); {$ifndef fpc}far;{$endif fpc}
    begin
    end;
 
 
-  procedure SetActivePageDefault(page : word); far;
+  procedure SetActivePageDefault(page : word); {$ifndef fpc}far;{$endif fpc}
    begin
    end;
 
@@ -2160,7 +2160,6 @@ end;
 
  procedure SectorPL(x1,x2,y: Integer); {$ifndef fpc}far;{$endif fpc}
  var plx1, plx2: integer;
-{!!!!!!!!!!!!!!!}
 {$ifdef sectorpldebug}
      t : text;
 {$endif sectorpldebug}
@@ -2187,24 +2186,24 @@ end;
            If (ArcCall.YStart-ArcCall.Y) = 0 then
              begin
                append(t);
-               writeln('bug1');
+               writeln(t,'bug1');
                close(t);
                runerror(202);
              end;
 {$endif sectorpldebug}
-           plx1 := Round((y-ArcCall.Y)/(ArcCall.YStart-ArcCall.Y)*
-                   (ArcCall.XStart-ArcCall.X))+ArcCall.X;
+           plx1 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
+                   div (ArcCall.YStart-ArcCall.Y)+ArcCall.X;
 {$ifdef sectorpldebug}
            If (ArcCall.YEnd-ArcCall.Y) = 0 then
              begin
                append(t);
-               writeln('bug2');
+               writeln(t,'bug2');
                close(t);
                runerror(202);
              end;
 {$endif sectorpldebug}
-           plx2 := Round((y-ArcCall.Y)/(ArcCall.YEnd-ArcCall.Y)*
-                   (ArcCall.XEnd-ArcCall.X))+ArcCall.X;
+           plx2 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
+                   div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X;
            If plx1 > plx2 then
              begin
                plx1 := plx1 xor plx2;
@@ -2230,13 +2229,13 @@ end;
              If (ArcCall.YEnd-ArcCall.Y) = 0 then
                begin
                  append(t);
-                 writeln('bug3');
+                 writeln(t,'bug3');
                  close(t);
                  runerror(202);
                end;
 {$endif sectorpldebug}
-             plx1 := Round((y-ArcCall.Y)/(ArcCall.YEnd-ArcCall.Y)*
-                     (ArcCall.XEnd-ArcCall.X))+ArcCall.X
+             plx1 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
+                     div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X
            end
          else if (y > ArcCall.Y) then
            begin
@@ -2244,13 +2243,13 @@ end;
              If (ArcCall.YStart-ArcCall.Y) = 0 then
                begin
                  append(t);
-                 writeln('bug4');
+                 writeln(t,'bug4');
                  close(t);
                  runerror(202);
                end;
 {$endif sectorpldebug}
-             plx1 := Round((y-ArcCall.Y)/(ArcCall.YStart-ArcCall.Y)*
-                     (ArcCall.XStart-ArcCall.X))+ArcCall.X
+             plx1 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
+                     div (ArcCall.YStart-ArcCall.Y)+ArcCall.X
              end
          else plx1 := ArcCall.X;
          plx2 := x2;
@@ -2272,13 +2271,13 @@ end;
              If (ArcCall.YStart-ArcCall.Y) = 0 then
                begin
                  append(t);
-                 writeln('bug5');
+                 writeln(t,'bug5');
                  close(t);
                  runerror(202);
                end;
 {$endif sectorpldebug}
-             plx2 := Round((y-ArcCall.Y)/(ArcCall.YStart-ArcCall.Y)*
-                     (ArcCall.XStart-ArcCall.X))+ArcCall.X
+             plx2 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
+                     div (ArcCall.YStart-ArcCall.Y)+ArcCall.X
            end
          else if (y > ArcCall.Y) then
            begin
@@ -2286,13 +2285,13 @@ end;
              If (ArcCall.YEnd-ArcCall.Y) = 0 then
                begin
                  append(t);
-                 writeln('bug6');
+                 writeln(t,'bug6');
                  close(t);
                  runerror(202);
                end;
 {$endif sectorpldebug}
-             plx2 := Round((y-ArcCall.Y)/(ArcCall.YEnd-ArcCall.Y)*
-                     (ArcCall.XEnd-ArcCall.X))+ArcCall.X
+             plx2 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
+                     div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X
            end
          else plx2 := ArcCall.X;
          plx1 := x1;
@@ -2877,7 +2876,12 @@ DetectGraph
 
 {
   $Log$
-  Revision 1.24  1999-09-18 16:03:37  jonas
+  Revision 1.25  1999-09-18 22:21:10  jonas
+    + hlinevesa256 and vlinevesa256
+    + support for not/xor/or/andput in vesamodes with 32k/64k colors
+    * lots of changes to avoid warnings under FPC
+
+  Revision 1.24  1999/09/18 16:03:37  jonas
     * graph.pp: removed pieslice and sector from ToDo list
     * closegraph: exits now immidiately if isgraphmode = false (caused
       RTE 204 with VESA enabled if you set exitproc to call closegraph

rtl/inc/graph/modes.inc

@@ -87,7 +87,7 @@
     end;
 
 
-   procedure cleanmode;far;
+   procedure cleanmode; {$ifndef fpc}far;{$endif fpc}
   {********************************************************}
   { Procedure CleanMode()                                  }
   {--------------------------------------------------------}
@@ -317,7 +317,12 @@
 
 {
 $Log$
-Revision 1.7  1999-07-12 13:27:14  jonas
+Revision 1.8  1999-09-18 22:21:11  jonas
+  + hlinevesa256 and vlinevesa256
+  + support for not/xor/or/andput in vesamodes with 32k/64k colors
+  * lots of changes to avoid warnings under FPC
+
+Revision 1.7  1999/07/12 13:27:14  jonas
   + added Log and Id tags
   * added first FPC support, only VGA works to some extend for now
   * use -dasmgraph to use assembler routines, otherwise Pascal

rtl/inc/graph/vesa.inc

@@ -400,7 +400,7 @@ end;
      { check if this is the current bank... if so do nothing. }
      if BankNr = CurrentReadBank then exit;
 {$ifdef logging}
-     LogLn('Setting read bank to '+strf(BankNr));
+{     LogLn('Setting read bank to '+strf(BankNr));}
 {$endif logging}
      CurrentReadBank := BankNr;          { save current bank number     }
      BankNr := BankNr shl BankShift;     { adjust to window granularity }
@@ -418,7 +418,7 @@ end;
      { check if this is the current bank... if so do nothing. }
      if BankNr = CurrentWriteBank then exit;
 {$ifdef logging}
-     LogLn('Setting write bank to '+strf(BankNr));
+{     LogLn('Setting write bank to '+strf(BankNr));}
 {$endif logging}
      CurrentWriteBank := BankNr;          { save current bank number     }
      BankNr := BankNr shl BankShift;     { adjust to window granularity }
@@ -435,7 +435,7 @@ end;
  {*                     8-bit pixels VESA mode routines                  *}
  {************************************************************************}
 
-  procedure PutPixVESA256(x, y : integer; color : word); far;
+  procedure PutPixVESA256(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
   var
      bank : word;
      offs : longint;
@@ -455,10 +455,11 @@ end;
      mem[WinWriteSeg : word(offs)] := byte(color)
   end;
 
-  procedure DirectPutPixVESA256(x, y : integer); far;
+  procedure DirectPutPixVESA256(x, y : integer); {$ifndef fpc}far;{$endif fpc}
   var
      bank : word;
      offs : longint;
+     col : byte;
   begin
      offs := longint(y) * BytesPerLine + x;
      SetWriteBank(integer(offs shr 16));
@@ -477,14 +478,18 @@ end;
          Begin
            SetReadBank(integer(offs shr 16));
            mem[WinWriteSeg : word(offs)] := mem[WinReadSeg : word(offs)] or byte(currentcolor);
-         End;
-       NormalPut:
-         mem[WinWriteSeg : word(offs)] := byte(currentcolor)
-      else mem[WinWriteSeg : word(offs)] := byte(CurrentColor);
-   End;
+         End
+       else
+         Begin
+           If CurrentWriteMode <> NotPut then
+             col := Byte(CurrentColor)
+           else col := Not(Byte(CurrentColor));
+           mem[WinWriteSeg : word(offs)] := Col;
+         End
+     End;
   end;
 
-  function GetPixVESA256(x, y : integer): word; far;
+  function GetPixVESA256(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
   var
      bank : word;
      offs : longint;
@@ -496,11 +501,439 @@ end;
      GetPixVESA256:=mem[WinReadSeg : word(offs)];
   end;
 
+  procedure HLineVESA256(x,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
+
+   var Offs: Longint;
+       mask, l, bankrest: longint;
+       curbank, hlength: integer;
+   Begin
+    { must we swap the values? }
+    if x > x2 then
+      Begin
+        x := x xor x2;
+        x2 := x xor x2;
+        x:= x xor x2;
+      end;
+    { First convert to global coordinates }
+    X   := X + StartXViewPort;
+    X2  := X2 + StartXViewPort;
+    Y   := Y + StartYViewPort;
+    if ClipPixels then
+      Begin
+         if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
+                StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+            exit;
+      end;
+    {$ifdef logging}
+    LogLn('hline '+strf(x)+' - '+strf(x2)+' on '+strf(y)+' in mode '+strf(currentwritemode));
+    {$endif logging}
+    HLength := x2 - x + 1;
+    {$ifdef logging}
+    LogLn('length: '+strf(hlength));
+    {$endif logging}
+    if HLength>0 then
+      begin
+         Offs:=Longint(y)*bytesperline+x;
+         {$ifdef logging}
+         LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
+         {$endif logging}
+         Mask := byte(CurrentColor)+byte(CurrentColor) shl 8;
+         Mask := Mask + Mask shl 16;
+         Case CurrentWriteMode of
+           AndPut:
+             Begin
+               Repeat
+                 curbank := integer(offs shr 16);
+                 SetWriteBank(curbank);
+                 SetReadBank(curbank);
+                 {$ifdef logging}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+                 {$endif logging}
+                 If HLength > 3 Then
+                 { allign target }
+                   Begin
+                     l := 0;
+                     If (offs and 3) <> 0 then
+                     { this cannot go past a window boundary bacause the }
+                     { size of a window is always a multiple of 4        }
+                       Begin
+                         {$ifdef logging}
+                         LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
+                         {$endif logging}
+                         for l := 1 to 4-(offs and 3) do
+                           Mem[WinWriteSeg:word(offs)+l-1] :=
+                             Mem[WinReadSeg:word(offs)+l-1] And Byte(CurrentColor);
+                       End;
+                     Dec(HLength, l);
+                     inc(offs, l);
+                     {$ifdef logging}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                     { offs is now 4-bytes alligned }
+                     If HLength <= ($10000-(Offs and $ffff)) Then
+                        bankrest := HLength
+                     else {the rest won't fit anymore in the current window }
+                       bankrest := $10000 - (Offs and $ffff);
+                     {$ifdef logging}
+                     LogLn('Rest to be drawn in this window: '+strf(bankrest));
+                     {$endif logging}
+                     For l := 0 to (Bankrest div 4)-1 Do
+                       MemL[WinWriteSeg:word(offs)+l*4] :=
+                         MemL[WinReadSeg:word(offs)+l*4] And Mask;
+                     inc(offs,l*4+4);
+                     dec(hlength,l*4+4);
+                     {$ifdef logging}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                   End
+                 Else
+                   Begin
+                     {$ifdef logging}
+                     LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
+                     {$endif logging}
+                     x := offs mod bytesperline;
+                     For l := 0 to HLength - 1 do
+                       DirectPutPixVESA256(x+l,y);
+                     HLength := 0
+                   End
+               Until HLength = 0;
+             End;
+           XorPut:
+             Begin
+               Repeat
+                 curbank := integer(offs shr 16);
+                 SetWriteBank(curbank);
+                 SetReadBank(curbank);
+                 {$ifdef logging}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+                 {$endif logging}
+                 If HLength > 3 Then
+                 { allign target }
+                   Begin
+                     l := 0;
+                     If (offs and 3) <> 0 then
+                     { this cannot go past a window boundary bacause the }
+                     { size of a window is always a multiple of 4        }
+                       Begin
+                         {$ifdef logging}
+                         LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
+                         {$endif logging}
+                         for l := 1 to 4-(offs and 3) do
+                           Mem[WinWriteSeg:word(offs)+l-1] :=
+                             Mem[WinReadSeg:word(offs)+l-1] Xor Byte(CurrentColor);
+                       End;
+                     Dec(HLength, l);
+                     inc(offs, l);
+                     {$ifdef logging}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                     { offs is now 4-bytes alligned }
+                     If HLength <= ($10000-(Offs and $ffff)) Then
+                        bankrest := HLength
+                     else {the rest won't fit anymore in the current window }
+                       bankrest := $10000 - (Offs and $ffff);
+                     {$ifdef logging}
+                     LogLn('Rest to be drawn in this window: '+strf(bankrest));
+                     {$endif logging}
+                     For l := 0 to (Bankrest div 4)-1 Do
+                       MemL[WinWriteSeg:word(offs)+l*4] :=
+                         MemL[WinReadSeg:word(offs)+l*4] Xor Mask;
+                     inc(offs,l*4+4);
+                     dec(hlength,l*4+4);
+                     {$ifdef logging}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                   End
+                 Else
+                   Begin
+                     {$ifdef logging}
+                     LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
+                     {$endif logging}
+                     x := offs mod bytesperline;
+                     For l := 0 to HLength - 1 do
+                       DirectPutPixVESA256(x+l,y);
+                     HLength := 0
+                   End
+               Until HLength = 0;
+             End;
+           OrPut:
+             Begin
+               Repeat
+                 curbank := integer(offs shr 16);
+                 SetWriteBank(curbank);
+                 SetReadBank(curbank);
+                 {$ifdef logging}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+                 {$endif logging}
+                 If HLength > 3 Then
+                 { allign target }
+                   Begin
+                     l := 0;
+                     If (offs and 3) <> 0 then
+                     { this cannot go past a window boundary bacause the }
+                     { size of a window is always a multiple of 4        }
+                       Begin
+                         {$ifdef logging}
+                         LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
+                         {$endif logging}
+                         for l := 1 to 4-(offs and 3) do
+                           Mem[WinWriteSeg:word(offs)+l-1] :=
+                             Mem[WinReadSeg:word(offs)+l-1] Or Byte(CurrentColor);
+                       End;
+                     Dec(HLength, l);
+                     inc(offs, l);
+                     {$ifdef logging}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                     { offs is now 4-bytes alligned }
+                     If HLength <= ($10000-(Offs and $ffff)) Then
+                        bankrest := HLength
+                     else {the rest won't fit anymore in the current window }
+                       bankrest := $10000 - (Offs and $ffff);
+                     {$ifdef logging}
+                     LogLn('Rest to be drawn in this window: '+strf(bankrest));
+                     {$endif logging}
+                     For l := 0 to (Bankrest div 4)-1 Do
+                       MemL[WinWriteSeg:offs+l*4] :=
+                         MemL[WinReadSeg:word(offs)+l*4] Or Mask;
+                     inc(offs,l*4+4);
+                     dec(hlength,l*4+4);
+                     {$ifdef logging}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                   End
+                 Else
+                   Begin
+                     {$ifdef logging}
+                     LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
+                     {$endif logging}
+                     x := offs mod bytesperline;
+                     For l := 0 to HLength - 1 do
+                       DirectPutPixVESA256(x+l,y);
+                     HLength := 0
+                   End
+               Until HLength = 0;
+             End
+           Else
+             Begin
+               If CurrentWriteMode = NotPut Then
+                 Mask := Not(Mask);
+               Repeat
+                 curbank := integer(offs shr 16);
+                 SetWriteBank(curbank);
+                 {$ifdef logging}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8)+' -- '+strf(offs));
+                 {$endif logging}
+                 If HLength > 3 Then
+                 { allign target }
+                   Begin
+                     l := 0;
+                     If (offs and 3) <> 0 then
+                     { this cannot go past a window boundary bacause the }
+                     { size of a window is always a multiple of 4        }
+                       Begin
+                         {$ifdef logging}
+                         LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
+                         {$endif logging}
+                         for l := 1 to 4-(offs and 3) do
+                           Mem[WinWriteSeg:word(offs)+l-1] := Byte(Mask);
+                       End;
+                     Dec(HLength, l);
+                     inc(offs, l);
+                     {$ifdef logging}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                     { offs is now 4-bytes alligned }
+                     If HLength <= ($10000-(Offs and $ffff)) Then
+                        bankrest := HLength
+                     else {the rest won't fit anymore in the current window }
+                       bankrest := $10000 - (Offs and $ffff);
+                     {$ifdef logging}
+                     LogLn('Rest to be drawn in this window: '+strf(bankrest)+' -- '+hexstr(bankrest,8));
+                     {$endif logging}
+                     For l := 0 to (Bankrest div 4)-1 Do
+                       MemL[WinWriteSeg:word(offs)+l*4] := Mask;
+                     inc(offs,l*4+4);
+                     dec(hlength,l*4+4);
+                     {$ifdef logging}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                   End
+                 Else
+                   Begin
+                     {$ifdef logging}
+                     LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
+                     {$endif logging}
+                     x := offs mod bytesperline;
+                     For l := 0 to HLength - 1 do
+                       DirectPutPixVESA256(x+l,y);
+                     HLength := 0
+                   End
+               Until HLength = 0;
+             End;
+         End;
+       end;
+   end;
+
+  procedure VLineVESA256(x,y,y2: integer); {$ifndef fpc}far;{$endif fpc}
+
+   var Offs: Longint;
+       l, bankrest: longint;
+       curbank, vlength: integer;
+       col: byte;
+   Begin
+    { must we swap the values? }
+    if y > y2 then
+      Begin
+        y := y xor y2;
+        y2 := y xor y2;
+        y:= y xor y2;
+      end;
+    { First convert to global coordinates }
+    X   := X + StartXViewPort;
+    Y   := Y + StartYViewPort;
+    Y2  := Y2 + StartYViewPort;
+    if ClipPixels then
+      Begin
+         if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
+                StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+            exit;
+      end;
+    {$ifdef logging}
+    LogLn('vline '+strf(y)+' - '+strf(y2)+' on '+strf(x)+' in mode '+strf(currentwritemode));
+    {$endif logging}
+    VLength := y2 - y + 1;
+    {$ifdef logging}
+    LogLn('length: '+strf(vlength));
+    {$endif logging}
+    if VLength>0 then
+      begin
+         Offs:=Longint(y)*bytesperline+x;
+         {$ifdef logging}
+         LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
+         {$endif logging}
+         Case CurrentWriteMode of
+           AndPut:
+             Begin
+               Repeat
+                 curbank := integer(offs shr 16);
+                 SetWriteBank(curbank);
+                 SetReadBank(curbank);
+                 {$ifdef logging}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+                 {$endif logging}
+                 If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
+                   bankrest := VLength
+                 else {the rest won't fit anymore in the current window }
+                   bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
+                 {$ifdef logging}
+                 LogLn('Rest to be drawn in this window: '+strf(bankrest));
+                 {$endif logging}
+                 For l := 0 to Bankrest-1 Do
+                   begin
+                     Mem[WinWriteSeg:word(offs)] :=
+                       Mem[WinReadSeg:word(offs)] And Byte(CurrentColor);
+                     inc(offs,bytesperline);
+                   end;
+                 dec(VLength,l+1);
+                 {$ifdef logging}
+                 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                 {$endif logging}
+               Until VLength = 0;
+             End;
+           XorPut:
+             Begin
+               Repeat
+                 curbank := integer(offs shr 16);
+                 SetWriteBank(curbank);
+                 SetReadBank(curbank);
+                 {$ifdef logging}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+                 {$endif logging}
+                 If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
+                   bankrest := VLength
+                 else {the rest won't fit anymore in the current window }
+                   bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
+                 {$ifdef logging}
+                 LogLn('Rest to be drawn in this window: '+strf(bankrest));
+                 {$endif logging}
+                 For l := 0 to Bankrest-1 Do
+                   begin
+                     Mem[WinWriteSeg:word(offs)] :=
+                       Mem[WinReadSeg:word(offs)] Xor Byte(CurrentColor);
+                     inc(offs,bytesperline);
+                   end;
+                 dec(VLength,l+1);
+                 {$ifdef logging}
+                 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                 {$endif logging}
+               Until VLength = 0;
+             End;
+           OrPut:
+             Begin
+               Repeat
+                 curbank := integer(offs shr 16);
+                 SetWriteBank(curbank);
+                 SetReadBank(curbank);
+                 {$ifdef logging}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+                 {$endif logging}
+                 If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
+                   bankrest := VLength
+                 else {the rest won't fit anymore in the current window }
+                   bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
+                 {$ifdef logging}
+                 LogLn('Rest to be drawn in this window: '+strf(bankrest));
+                 {$endif logging}
+                 For l := 0 to Bankrest-1 Do
+                   begin
+                     Mem[WinWriteSeg:word(offs)] :=
+                       Mem[WinReadSeg:word(offs)] Or Byte(CurrentColor);
+                     inc(offs,bytesperline);
+                   end;
+                 dec(VLength,l+1);
+                 {$ifdef logging}
+                 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                 {$endif logging}
+               Until VLength = 0;
+             End;
+           Else
+             Begin
+               If CurrentWriteMode = NotPut Then
+                 Col := Not(CurrentColor);
+               Repeat
+                 curbank := integer(offs shr 16);
+                 SetWriteBank(curbank);
+                 {$ifdef logging}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+                 {$endif logging}
+                 If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
+                   bankrest := VLength
+                 else {the rest won't fit anymore in the current window }
+                   bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
+                 {$ifdef logging}
+                 LogLn('Rest to be drawn in this window: '+strf(bankrest));
+                 {$endif logging}
+                 For l := 0 to Bankrest-1 Do
+                   begin
+                     Mem[WinWriteSeg:word(offs)] := Col;
+                     inc(offs,bytesperline);
+                   end;
+                 dec(VLength,l+1);
+                 {$ifdef logging}
+                 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                 {$endif logging}
+               Until VLength = 0;
+             End;
+         End;
+       end;
+   end;
+
  {************************************************************************}
  {*                    15/16bit pixels VESA mode routines                *}
  {************************************************************************}
 
-  procedure PutPixVESA32k(x, y : integer; color : word); far;
+  procedure PutPixVESA32k(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
   var
      bank : word;
      offs : longint;
@@ -520,7 +953,7 @@ end;
      memW[WinWriteSeg : word(offs)] := color;
   end;
 
-  procedure PutPixVESA64k(x, y : integer; color : word); far;
+  procedure PutPixVESA64k(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
   var
      bank : word;
      offs : longint;
@@ -540,7 +973,7 @@ end;
     memW[WinWriteSeg : word(offs)] := color;
   end;
 
-  function GetPixVESA32k(x, y : integer): word; far;
+  function GetPixVESA32k(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
   var
      bank : word;
      offs : longint;
@@ -552,7 +985,7 @@ end;
      GetPixVESA32k:=memW[WinReadSeg : word(offs)];
   end;
 
-  function GetPixVESA64k(x, y : integer): word; far;
+  function GetPixVESA64k(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
   var
      bank : word;
      offs : longint;
@@ -564,31 +997,77 @@ end;
      GetPixVESA64k:=memW[WinReadSeg : word(offs)];
   end;
 
-  procedure DirectPutPixVESA32k(x, y : integer); far;
+  procedure DirectPutPixVESA32k(x, y : integer); {$ifndef fpc}far;{$endif fpc}
   var
-     bank : word;
+     bank, col : word;
      offs : longint;
   begin
      offs := longint(y) * BytesPerLine + 2*x;
      SetWriteBank(integer((offs shr 16) and $ff));
-     memW[WinWriteSeg : word(offs)] := CurrentColor;
+     Case CurrentWriteMode of
+       XorPut:
+         Begin
+           SetReadBank(integer(offs shr 16));
+           memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] xor currentcolor;
+         End;
+       AndPut:
+         Begin
+           SetReadBank(integer(offs shr 16));
+           memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] And currentcolor;
+         End;
+       OrPut:
+         Begin
+           SetReadBank(integer(offs shr 16));
+           memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] or currentcolor;
+         End
+       else
+         Begin
+           If CurrentWriteMode <> NotPut Then
+             col := Byte(CurrentColor)
+           Else col := Not(CurrentColor);
+           memW[WinWriteSeg : word(offs)] := Col;
+         End
+     End;
   end;
 
-  procedure DirectPutPixVESA64k(x, y : integer); far;
+  procedure DirectPutPixVESA64k(x, y : integer); {$ifndef fpc}far;{$endif fpc}
   var
-     bank : word;
+     bank, Col : word;
      offs : longint;
   begin
      offs := longint(y) * BytesPerLine + 2*x;
      SetWriteBank(integer(offs shr 16));
-     memW[WinWriteSeg : word(offs)] := CurrentColor;
+     Case CurrentWriteMode of
+       XorPut:
+         Begin
+           SetReadBank(integer(offs shr 16));
+           memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] xor currentcolor;
+         End;
+       AndPut:
+         Begin
+           SetReadBank(integer(offs shr 16));
+           memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] And currentcolor;
+         End;
+       OrPut:
+         Begin
+           SetReadBank(integer(offs shr 16));
+           memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] or currentcolor;
+         End
+       Else
+         Begin
+           If CurrentWriteMode <> NotPut Then
+             col := Byte(CurrentColor)
+           Else col := Not(CurrentColor);
+           memW[WinWriteSeg : word(offs)] := Col;
+         End
+     End;
   end;
 
  {************************************************************************}
  {*                     4-bit pixels VESA mode routines                  *}
  {************************************************************************}
 
-  procedure PutPixVESA16(x, y : integer; color : word); far;
+  procedure PutPixVESA16(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
     var
      bank : word;
      offs : longint;
@@ -621,7 +1100,7 @@ end;
      { }
   end;
 
-  procedure DirectPutPixVESA16(x, y : integer); far;
+  procedure DirectPutPixVESA16(x, y : integer); {$ifndef fpc}far;{$endif fpc}
     var
      bank : word;
      offs : longint;
@@ -1132,89 +1611,89 @@ end;
  {*                     VESA Modes inits                                 *}
  {************************************************************************}
 
- procedure Init1280x1024x64k; far;
+ procedure Init1280x1024x64k; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVesaMode(m1280x1024x64k);
   end;
 
- procedure Init1280x1024x32k; far;
+ procedure Init1280x1024x32k; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVESAMode(m1280x1024x32k);
   end;
 
- procedure Init1280x1024x256; far;
+ procedure Init1280x1024x256; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVESAMode(m1280x1024x256);
   end;
 
 
- procedure Init1280x1024x16; far;
+ procedure Init1280x1024x16; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVESAMode(m1280x1024x16);
   end;
 
- procedure Init1024x768x64k; far;
+ procedure Init1024x768x64k; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVESAMode(m1024x768x64k);
   end;
 
- procedure Init640x480x32k; far;
+ procedure Init640x480x32k; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVESAMode(m640x480x32k);
   end;
 
- procedure Init1024x768x256; far;
+ procedure Init1024x768x256; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVESAMode(m1024x768x256);
   end;
 
- procedure Init1024x768x16; far;
+ procedure Init1024x768x16; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVESAMode(m1024x768x16);
   end;
 
- procedure Init800x600x64k; far;
+ procedure Init800x600x64k; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVESAMode(m800x600x64k);
   end;
 
- procedure Init800x600x32k; far;
+ procedure Init800x600x32k; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVESAMode(m800x600x32k);
   end;
 
- procedure Init800x600x256; far;
+ procedure Init800x600x256; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVESAMode(m800x600x256);
   end;
 
- procedure Init800x600x16; far;
+ procedure Init800x600x16; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVesaMode(m800x600x16);
   end;
 
- procedure Init640x480x64k; far;
+ procedure Init640x480x64k; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVESAMode(m640x480x64k);
   end;
 
 
- procedure Init640x480x256; far;
+ procedure Init640x480x256; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVESAMode(m640x480x256);
   end;
 
- procedure Init640x400x256; far;
+ procedure Init640x400x256; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVESAMode(m640x400x256);
   end;
 
- procedure Init320x200x64k; far;
+ procedure Init320x200x64k; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVESAMode(m320x200x64k);
   end;
 
- procedure Init320x200x32k; far;
+ procedure Init320x200x32k; {$ifndef fpc}far;{$endif fpc}
   begin
     SetVESAMode(m320x200x32k);
   end;
@@ -1222,7 +1701,7 @@ end;
 
 {$IFDEF DPMI}
 
- Procedure SaveStateVESA;
+ Procedure SaveStateVESA; {$ifndef fpc}far;{$endif fpc}
  var
   PtrLong: longint;
   regs: TDPMIRegisters;
@@ -1299,7 +1778,7 @@ end;
       end;
   end;
 
- procedure RestoreStateVESA;
+ procedure RestoreStateVESA; {$ifndef fpc}far;{$endif fpc}
   var
    regs:TDPMIRegisters;
   begin
@@ -1429,20 +1908,25 @@ end;
  { Note: These routines, according  to the VBE3 specification, will NOT   }
  { work with the 24 bpp modes, because of the alignment.                  }
  {************************************************************************}
- procedure SetVisualVESA(page: word); far;
+ procedure SetVisualVESA(page: word); {$ifndef fpc}far;{$endif fpc}
   { two page support... }
   begin
     if page > HardwarePages then exit;
   end;
 
- procedure SetActiveVESA(page: word); far;
+ procedure SetActiveVESA(page: word); {$ifndef fpc}far;{$endif fpc}
   { two page support... }
   begin
   end;
 
 {
 $Log$
-Revision 1.11  1999-09-15 11:40:30  jonas
+Revision 1.12  1999-09-18 22:21:11  jonas
+  + hlinevesa256 and vlinevesa256
+  + support for not/xor/or/andput in vesamodes with 32k/64k colors
+  * lots of changes to avoid warnings under FPC
+
+Revision 1.11  1999/09/15 11:40:30  jonas
   * fixed PutPixVESA256
 
 Revision 1.10  1999/09/11 19:43:02  jonas