* move graph.inc to the target dir

rtl/inc/graph/dpmi.inc → rtl/go32v2/dpmi.inc

@@ -45,7 +45,10 @@ asm
 
 {
 $Log$
-Revision 1.2  1999-07-12 13:27:10  jonas
+Revision 1.1  1999-11-08 11:15:21  peter
+  * move graph.inc to the target dir
+
+Revision 1.2  1999/07/12 13:27:10  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/graph.inc → rtl/go32v2/graph.inc

@@ -2,6 +2,10 @@
      $Id$
 }
 
+{$ifdef DPMI}
+{$i vesah.inc}
+{$endif DPMI}
+
 {$ifndef fpc}
   {$ifndef noasmgraph}
     {$define asmgraph}
@@ -2460,7 +2464,10 @@ const CrtAddress: word = 0;
 
 {
 $Log$
-Revision 1.26  1999-11-05 12:18:23  jonas
+Revision 1.1  1999-11-08 11:15:21  peter
+  * move graph.inc to the target dir
+
+Revision 1.26  1999/11/05 12:18:23  jonas
   * fixed pascal version of (direct)putpixelx
 
 Revision 1.25  1999/11/03 20:23:01  florian

rtl/go32v2/graph.pp

@@ -1,1077 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993-98 by Florian Klaempf & Gernot Tenchio
-    members of the Free Pascal development team.
-
-    Graph unit for BP7 compatible RTL
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-unit GRAPH;
-
-{ there are some problems with ranges in this file !! (PM) }
-{$R-}
-{$Q-}
-{ $DEFINE DEBUG}
-
-{$ifdef DEBUG}
-{$define TEST_24BPP}
-{$define Test_Linear}
-{$endif DEBUG}
-
-{ Output to AT&T for as }
-{$OUTPUT_FORMAT AS}
-
-{ Use the direct assembler parser }
-{$ASMMODE DIRECT}
-
-{ Don't use smartlinking, because of the direct assembler that is used }
-{$SMARTLINK OFF}
-
-interface
-
-uses go32,mmx;
-
-{$I GLOBAL.PPI}
-{$I STDCOLOR.PPI}
-
-procedure CloseGraph;
-function  GraphResult : Integer;
-procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;const PathToDriver:String);
-procedure SetGraphMode(GraphMode : integer);
-procedure GraphDefaults;
-procedure RestoreCRTMode;
-procedure SetGraphBufSize(BufSize : longint);
-function  RegisterBGIdriver(driver : pointer) : integer;
-function  InstallUserDriver(const DriverFileName : string;AutoDetectPtr : pointer) : integer;
-function  GetDriverName: String;
-function  GetModeName(Mode:Integer):String;
-function  GetGraphMode:Integer;
-procedure GetAspectRatio(var _Xasp,_Yasp : word);
-procedure SetAspectRatio(_Xasp,_Yasp : word);
-function GraphErrorMsg(ErrorCode: Integer): string;
-
-function  GetMaxMode : Integer;
-function  GetMaxX : Integer;
-function  GetMaxY : Integer;
-function  GetX : Integer;
-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;
-procedure ClearViewport;
-procedure Rectangle(x1,y1,x2,y2 : integer);
-
-{ PIXEL.PPI }
-function  GetPixel(x,y : integer):longint;
-procedure PutPixel(x,y : integer; Colour: longint);
-
-{ LINE.PPI }
-procedure Line(x1,y1,x2,y2 : integer);
-procedure LineTo(x,y : integer);
-procedure LineRel(dx,dy : integer);
-procedure MoveTo(x,y : integer);
-procedure MoveRel(dx,dy : integer);
-procedure GetLineSettings(var LineInfo : LineSettingsType);
-procedure SetLineStyle(LineStyle : word;pattern : word;thickness : word);
-
-procedure DrawPoly(points : word;var polypoints);
-
-{ PALETTE.PPI }
-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;
-function  GetColor : longint;
-function  GetMaxColor : longint;
-procedure SetColor(Color : longint);
-procedure SetBkColor(Color : longint);
-
-{ FILL.PPI }
-procedure FloodFill(x,y:integer; Border:longint);
-procedure GetFillSettings(var FillInfo : FillSettingsType);
-procedure GetFillPattern(var FillPattern : FillPatternType);
-procedure SetFillStyle(pattern : word;color : longint);
-procedure SetFillPattern(pattern : FillPatternType;color : longint);
-{ just dummy not implemented yet }
-procedure FillPoly(points : word;var polypoints);
-
-{ IMAGE.PPI }
-function  ImageSize(x1,y1,x2,y2 : integer) : longint;
-procedure GetImage(x1,y1,x2,y2 : integer;var BitMap);
-procedure PutImage(x,y : integer;var BitMap;BitBlt : word);
-
-{ TEXT.PPI }
-procedure GetTextSettings(var TextInfo : TextSettingsType);
-procedure OutText(const TextString : string);
-procedure OutTextXY(x,y : integer;const TextString : string);
-procedure OutText(const Charakter : char);
-procedure OutTextXY(x,y : integer;const Charakter : char);
-procedure SetTextJustify(horiz,vert : word);
-procedure SetTextStyle(Font, Direction : word; CharSize : word);
-procedure SetUserCharSize(Multx,Divx,Multy,Divy : word);
-function  TextHeight(const TextString : string) : word;
-function  TextWidth(const TextString : string) : word;
-function  RegisterBGIfont(font : pointer) : integer;
-function  InstallUserFont(const FontFileName : string) : integer;
-
-{ extended non Borland-compatible }
-
-{ TRIANGLE.PPI }
-procedure FillTriangle(A,B,C:Pointtype);
-
-{ to compare colors on different resolutions }
-function ColorsEqual(c1,c2 : longint) : boolean;
-{ this will return true if the two colors will appear
-  equal in the current video mode }
-
-procedure WaitRetrace;
-{$ifdef debug}
-procedure pixel(offset:longint);
-function  Convert(color:longint):longint;
-function  UnConvert(color:longint):longint;
-function  SetVESADisplayStart(PageNum : word;x,y : integer):Boolean;
-{$endif debug}
-
-{$ifdef Test_linear}
-  const
-     UseLinear : boolean = false;
-     (* Bug was due to alignment problem in  VesaInfoBlock !!
-     { the two below are the settings the work for ATI 3D Rage Pro !! }
-     switch_physical_address : boolean = true;*)
-{$endif Test_linear}
-
-{$I MODES.PPI}
-
-implementation
-
-{$ASMMODE DIRECT}
-
-type
-  PString=^String;
-  PInteger=^integer;
-  PWord=^word;
-  PLong=^longint;
-
-  VgaInfoBlock = record
-    VESASignature: array[1..4]of Char;
-    VESAloVersion: Byte;
-    VESAhiVersion: Byte;
-    OEMStringPtr : longint;
-    Capabilities : longint;
-    VideoModePtr : longint;
-    TotalMem     : word;
-  { VESA 2.0 }
-    OEMversion   : word;
-    VendorPtr    : longint;
-    ProductPtr   : longint;
-    RevisionPtr  : longint;
-    filler       : Array[1..478]of Byte;
-  end;
-
-  VesaInfoBlock=record
-    ModeAttributes : word; { pos 0 }
-    WinAAttributes : byte; { pos 2 }
-    WinBAttributes : byte; { pos 3 }
-    WinGranularity : word; { pos 4 }
-    WinSize        : word; { pos 6 }
-    segWINA        : word; { pos 8 }
-    segWINB        : word; { pos $A }
-    RealWinFuncPtr : longint; { pos $C }
-    BPL            : word; { pos $10 }
-  { VESA 1.2 }
-    XResolution    : word; { pos $12 }
-    YResolution    : word; { pos $14 }
-    XCharSize      : byte; { pos $16 }
-    YCharSize      : byte; { pos $17 }
-    MumberOfPlanes : byte; { pos $18 }
-    BitsPerPixel   : byte; { pos $19 }
-    NumberOfBanks  : byte; { pos $1A }
-    MemoryModel    : byte; { pos $1B }
-    BankSize       : byte; { pos $1C }
-    NumberOfPages  : byte; { pos $1D }
-    reserved       : byte; { pos $1E }
-    rm_size        : byte; { pos $1F }
-    rf_pos         : byte; { pos $20 }
-    gm_size        : byte; { pos $21 }
-    gf_pos         : byte; { pos $22 }
-    bm_size        : byte; { pos $23 }
-    bf_pos         : byte; { pos $24 }
-    (* res_mask       : word; { pos $25 }
-      here there was an alignment problem !!
-      with default alignment
-      res_mask was shifted to $26
-      and after PhysAddress to $2A !!! PM *)
-    res_size       : byte;
-    res_pos        : byte;
-    DirectColorInfo: byte; { pos $27 }
-  { VESA 2.0 }
-    PhysAddress    : longint; { pos $28 }
-    OffscreenPtr   : longint; { pos $2C }
-    OffscreenMem   : word; { pos $30 }
-    reserved2      : Array[1..458]of Byte; { pos $32 }
-   end;
-
-const
-     CheckRange    : Boolean=true;
-     isVESA2       : Boolean=false;
-     core          : longint=$E0000000;
-
-var    { X/Y Verhaeltnis des Bildschirm }
-       AspectRatio  : real;
-       XAsp , YAsp  : Word;
-       { Zeilen & Spalten des aktuellen Graphikmoduses }
-       _maxx,_maxy : longint;
-       { Current color internal format (depending on bitsperpixel) }
-       aktcolor : longint;
-       { Current color RGB value }
-       truecolor : longint;
-       { Current background color internal format (depending on bitsperpixel) }
-       aktbackcolor : longint;
-       { Current background color RGB value }
-       truebackcolor : longint;
-       { used for fill }
-       colormask : longint;
-       { Videospeicherbereiche }
-       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;
-       { der Graphikmodus, der beim Start gesetzt war }
-       startmode : byte;
-       { mode before RestoreCRTMode was called
-         used by getGraphMode PM }
-       oldCRTMode : integer;
-       InTempCRTMode : boolean;
-
-       { Position des Graphikcursors }
-       curx,cury : longint;
-       { true, wenn die Routinen des Graphikpaketes verwendet werden d�rfen }
-       isgraphmode : boolean;
-       { Einstellung zum Linien zeichnen }
-       aktlineinfo : LineSettingsType;
-       { Fehlercode, wird von graphresult zur�ckgegeben }
-       _graphresult : integer;
-       { aktuell eingestellte F�llart }
-       aktfillsettings : FillSettingsType;
-       aktfillbkcolor : longint;
-       { aktuelles F�llmuster }
-       aktfillpattern : FillPatternType;
-       { Schreibmodus }
-       aktwritemode : word;
-       { put background color around text }
-       ClearText : boolean;
-       { Schrifteinstellung }
-       akttextinfo : TextSettingsType;
-       { momentan gesetzte Textskalierungswerte }
-       aktmultx,aktdivx,aktmulty,aktdivy : word;
-       { Pfad zu den Fonts }
-       bgipath : string;
-       { Pointer auf Hilfsspeicher }
-       buffermem : pointer;
-       { momentane GrӇe des Buffer }
-       buffersize : longint;
-       { in diesem Puffer werden bei SetFillStyle bereits die Pattern in der }
-       { zu verwendenden Farbe abgelegt }
-       PatternBuffer : Array [0..63] of LongInt;
-
-       X_Array         : array [0..1280] of LongInt;
-       Y_Array         : array [0..1024] of LongInt;
-
-       Sel,Seg      : word;
-       VGAInfo      : VGAInfoBlock;
-       VESAInfo     : VESAInfoBlock;
-   { Selectors for Protected Mode }
-       seg_WRITE    : word;
-       seg_READ     : word;
-   { linear Frame Buffer }
-       LinearFrameBufferSupported : boolean;
-       FrameBufferLinearAddress : longint;
-       UseLinearFrameBuffer : Boolean;
-   const
-       EnableLinearFrameBuffer = $4000;
-   { Registers for RealModeInterrupts in DPMI-Mode }
-   var
-       dregs        : TRealRegs;
-       { read and write bank are allways equal !! }
-       A_Bank       : longint;
-       AW_window    : longint;
-       AR_Window    : longint;
-       same_window  : boolean;
-   const
-       AWindow = 0;
-       BWindow = 1;
-
-   { Variables for Bankswitching }
-   var
-       BytesPerLine : longint;
-       BytesPerPixel: Word;
-       WinSize      : longint;   { Expample $0x00010000 . $0x00008000 }
-       WinLoMask    : longint;   {          $0x0000FFFF   $0x00007FFF }
-       WinLoMaskMinusPixelSize : longint;   {          $0x0000FFFF   $0x00007FFF }
-       WinShift     : byte;
-       GranShift    : byte;
-       Granular     : longint;
-       Granularity  : longint;
-       bankswitchptr :pointer;
-       isDPMI        :Boolean;
-       SwitchCS,SwitchIP : word;
-
-
-function ColorsEqual(c1,c2 : longint) : boolean;
-Begin
-  ColorsEqual:=((BytesPerPixel=1) and ((c1 and $FF)=(c2 and $FF))) or
-         ((GetMaxColor=$7FFF) and ((c1 and $F8F8F8)=(c2 and $F8F8F8))) or
-         ((GetMaxColor=$FFFF) and ((c1 and $F8FCF8)=(c2 and $F8FCF8))) or
-         ((BytesPerPixel>2) and ((c1 and $FFFFFF)=(c2 and $FFFFFF)));
-End;
-
-function GraphErrorMsg(ErrorCode: Integer): string;
-Begin
- GraphErrorMsg:='';
- case ErrorCode of
-  grOk,grFileNotFound,grInvalidDriver: exit;
-  grNoInitGraph: GraphErrorMsg:='Graphics driver not installed';
-  grNotDetected: GraphErrorMsg:='Graphics hardware not detected';
-  grNoLoadMem,grNoScanMem,grNoFloodMem: GraphErrorMsg := 'Not enough memory for graphics';
-  grNoFontMem: GraphErrorMsg := 'Not enough memory to load font';
-  grFontNotFound: GraphErrorMsg:= 'Font file not found';
-  grInvalidMode: GraphErrorMsg := 'Invalid graphics mode';
-  grError: GraphErrorMsg:='Graphics error';
-  grIoError: GraphErrorMsg:='Graphics I/O error';
-  grInvalidFont,grInvalidFontNum: GraphErrorMsg := 'Invalid font';
-  grInvalidVersion: GraphErrorMsg:='Invalid driver version';
- end;
-end;
-
-
-
-procedure GraphFault(ErrString:String);
-begin
-  CloseGraph;
-  writeln('Error in Unit VESA: ',ErrString);
-  halt;
-end;
-
-{$I MOVE.PPI}
-{$I IBM.PPI}
-
-procedure WaitRetrace;
-begin
-  asm
-    cli
-    movw  $0x03Da,%dx
-.LWaitNotHSyncLoop:
-    inb   %dx,%al
-    testb $0x8,%al
-    jnz   .LWaitNotHSyncLoop
-.LWaitHSyncLoop:
-    inb   %dx,%al
-    testb $0x8,%al
-    jz    .LWaitHSyncLoop
-    sti
-  end;
-end;
-
-
-{$I COLORS.PPI}
-
-procedure graphdefaults;
-      begin
-         _graphresult:=grOk;
-         if not isgraphmode then
-           begin
-              _graphresult:=grnoinitgraph;
-              exit;
-           end;
-         { Linientyp }
-         aktlineinfo.linestyle:=solidln;
-         aktlineinfo.thickness:=normwidth;
-
-
-         { std colors }
-         setstdcolors;
-         { Zeichenfarbe }
-         setcolor(white);
-         setbkcolor(black);
-
-         { F�llmuster }
-         setfillstyle(solidfill,white);
-         { necessary to load patternbuffer !! (PM)
-         aktfillsettings.color:=white;
-         aktfillsettings.pattern:=solidfill;      }
-
-         { Viewport setzen }
-         aktviewport.clip:=true;
-         aktviewport.x1:=0;
-         aktviewport.y1:=0;
-         aktviewport.x2:=_maxx-1;
-         aktviewport.y2:=_maxy-1;
-
-         aktscreen:=aktviewport;
-
-         { normaler Schreibmodus }
-         setwritemode(normalput);
-
-         { Schriftart einstellen }
-         akttextinfo.font:=DefaultFont;
-         akttextinfo.direction:=HorizDir;
-         akttextinfo.charsize:=1;
-         akttextinfo.horiz:=LeftText;
-         akttextinfo.vert:=TopText;
-
-         { VergrӇerungsfaktoren}
-         XAsp:=10000; YAsp:=10000;
-         aspectratio:=1;
-      end;
-
-{ ############################################################### }
-{ #################  Ende der internen Routinen  ################ }
-{ ############################################################### }
-
-{$I PALETTE.PPI}
-{$I PIXEL.PPI}
-{$I LINE.PPI}
-{$I ELLIPSE.PPI}
-{$I TRIANGLE.PPI}
-{$I ARC.PPI}
-{$I IMAGE.PPI}
-{$I TEXT.PPI}
-{$I FILL.PPI}
-
-function GetDrivername:String;
-begin
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;
-      Exit;
-    end;
-  GetDriverName:=('internal VESA-Driver');
-end;
-
-function GetModeName(Mode:Integer):String;
-var s1,s2,s3:string;
-begin
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;
-      Exit;
-    end;
-  str(_maxx,s1);
-  str(_maxy,s2);
-  str(getmaxcolor+1,s3);
-  GetModeName:=('VESA '+s1+'x'+s2+'x'+s3);
-end;
-
-function GetGraphMode:Integer;
-begin
-  if InTempCRTMode then
-    begin
-       GetGraphMode:=oldCRTMode;
-       exit;
-    end;
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;
-      GetGraphMode:=grNoInitGraph;
-      Exit;
-    end;
-  GetGraphMode:=GetVesaMode;
-end;
-
-procedure ClearViewport;
-var bank1,bank2,diff,c:longint;
-    ofs1,ofs2         :longint;
-    y : integer;
-    storewritemode : word;
-
-begin
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;
-      Exit;
-    end;
-  c:=aktcolor;
-  aktcolor:=aktbackcolor;
-  storewritemode:=aktwritemode;
-  aktwritemode:=normalput;
-  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;
-    bank2:=ofs2 shr winshift;
-    if bank1 <> A_BANK then
-    begin
-      Switchbank(bank1);
-    end;
-    if bank1 <> bank2 then
-    begin
-      diff:=((bank2 shl winshift)-ofs1) div BytesPerPixel;
-      horizontalline(aktviewport.x1, aktviewport.x1+diff-1, y);
-      Switchbank(bank2);
-      horizontalline(aktviewport.x1+diff, aktviewport.x2, y);
-    end else horizontalline(aktviewport.x1, aktviewport.x2, y);
-    ofs1:=ofs1 + BytesPerLine;
-    ofs2:=ofs2 + BytesPerLine;
-  end;
-  aktwritemode:=storewritemode;
-  aktcolor:=c;
-end;
-
-procedure GetAspectRatio(var _Xasp,_Yasp : word);
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-    begin
-      _graphresult:=grnoinitgraph;
-      exit;
-    end;
-    _XAsp:=XAsp; _YAsp:=YAsp;
-end;
-
-procedure SetAspectRatio(_Xasp, _Yasp : word);
-begin
-  _graphresult:=grOk;
-    if not isgraphmode then
-      begin
-        _graphresult:=grnoinitgraph;
-        exit;
-      end;
-    Xasp:=_XAsp; YAsp:=_YAsp;
-end;
-
-
-procedure ClearDevice;
-var Viewport:ViewportType;
-begin
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;
-      Exit;
-    end;
-  Viewport:=aktviewport;
-  SetViewport(0,0,_maxx-1,_maxy-1,Clipon);
-  ClearViewport;
-  aktviewport:=viewport;
-end;
-
-procedure Rectangle(x1,y1,x2,y2:integer);
-begin
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;
-      Exit;
-    end;
-  Line(x1,y1,x2,y1);
-  Line(x1,y1,x1,y2);
-  Line(x2,y1,x2,y2);
-  Line(x1,y2,x2,y2);
-end;
-
-procedure Bar(x1,y1,x2,y2:integer);
-var y               : Integer;
-    origcolor       : longint;
-    origlinesettings: Linesettingstype;
-begin
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;
-      Exit;
-    end;
-  origlinesettings:=aktlineinfo;
-  origcolor:=aktcolor;
-  aktlineinfo.linestyle:=solidln;
-  aktlineinfo.thickness:=normwidth;
-  case aktfillsettings.pattern of
-     emptyfill : begin
-           aktcolor:=aktbackcolor;
-           for y:=y1 to y2 do line(x1,y,x2,y);
-         end;
-     solidfill : begin
-           aktcolor:=aktfillsettings.color;
-           for y:=y1 to y2 do line(x1,y,x2,y);
-         end;
-     else for y:=y1 to y2 do patternline(x1,x2,y);
-  end;
-  aktcolor:=origcolor;
-  aktlineinfo:=origlinesettings;
-end;
-
-procedure bar3D(x1, y1, x2, y2 : integer;depth : word;top : boolean);
-begin
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;
-      Exit;
-    end;
-  Bar(x1,y1,x2,y2);
-  Rectangle(x1,y1,x2,y2);
-  if top then begin
-    Moveto(x1,y1);
-    Lineto(x1+depth,y1-depth);
-    Lineto(x2+depth,y1-depth);
-    Lineto(x2,y1);
-  end;
-  Moveto(x2+depth,y1-depth);
-  Lineto(x2+depth,y2-depth);
-  Lineto(x2,y2);
-end;
-
-procedure SetGraphBufSize(BufSize : longint);
-begin
-  if assigned(buffermem) then
-  freemem(buffermem,buffersize);
-  getmem(buffermem,bufsize);
-  if not assigned(buffermem) then
-    buffersize:=0
-  else buffersize:=bufsize;
-end;
-
-const
-  { Vorgabegr”áe f�r Hilfsspeicher }
-  bufferstandardsize = 64*8196;      { 0,5 MB }
-
-procedure CloseGraph;
-begin
-  if isgraphmode then
-    begin
-       SetVESAMode(startmode);
-       { DoneVESA; only in exitproc !! PM }
-       isgraphmode:=false;
-       if assigned(buffermem) then
-         freemem(buffermem,buffersize);
-       buffermem:=nil;
-       buffersize:=0;
-     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 : Integer;
-begin
-    { Pfad zu den Fonts }
-    bgipath:=PathToDriver;
-    if bgipath[length(bgipath)]<>'\' then
-    bgipath:=bgipath+'\';
-  if Graphdriver=detect then GraphMode:=GetMaxMode;
-    { Standardfonts installieren }
-    InstallUserFont('TRIP');
-    InstallUserFont('LITT');
-    InstallUserFont('SANS');
-    InstallUserFont('GOTH');
-    InstallUserFont('SCRI');
-    InstallUserFont('SIMP');
-    InstallUserFont('TSCR');
-    InstallUserFont('LCOM');
-    InstallUserFont('EURO');
-    InstallUserFont('BOLD');
-
-    GetVESAInfo(GraphMode);
-{$IFDEF DEBUG}
-   {$I VESADEB.PPI}
-{$ENDIF}
-  for i:=VESANumber downto 0 do
-    if GraphMode=VESAModes[i] then break;
-  { the modes can be refused due to the monitor ? }
-  { that happens by me at home Pierre Muller      }
-  while i>=0 do begin
-    isgraphmode:=SetVESAMode(GraphMode);
-    if isgraphmode then begin
-      GetVESAInfo(GraphMode);
-      if UseLinearFrameBuffer then
-        isgraphmode:=SetVESAMode(GraphMode or EnableLinearFrameBuffer);
-      { set zero page }
-      AktPageOffset:=0;
-      SetActivePage(0);
-      SetVisualPage(0);
-      SetArrays;
-      SetGraphBufSize(bufferstandardsize);
-      graphdefaults;
-      InTempCRTMode:=false;
-      exit;
-    end;
-    dec(i);
-    GraphMode:=VESAModes[i];
-  end;
-  _graphresult:=grInvalidMode
-end;
-
-procedure SetGraphMode(GraphMode:Integer);
-
-begin
-   _graphresult:=grOk;
-   if not isgraphmode and not InTempCRTMode then
-    begin
-      _graphresult:=grNoInitGraph;
-      Exit;
-    end;
-    if GetVesaInfo(GraphMode) then
-      begin
-         isgraphmode:=SetVESAMode(GraphMode);
-         if isgraphmode then
-           begin
-              if UseLinearFrameBuffer then
-                isgraphmode:=SetVESAMode(GraphMode or EnableLinearFrameBuffer);
-              { set zero page }
-              AktPageOffset:=0;
-              SetActivePage(0);
-              SetVisualPage(0);
-              SetArrays;
-              graphdefaults;
-              InTempCRTMode:=false;
-              exit;
-           end;
-      end;
-    _graphresult:=grInvalidMode;
-end;
-
-function RegisterBGIdriver(driver : pointer) : integer;
-begin
-   RegisterBGIdriver:=grerror;
-end;
-
-function InstallUserDriver(const DriverFileName : string;AutoDetectPtr : pointer) : integer;
-begin
-   installuserdriver:=grerror;
-end;
-
-function GetMaxMode:Integer;
-var i:Byte;
-begin
-  for i:=VESANumber downto 0 do
-    if GetVesaInfo(VESAModes[i]) then
-    begin
-       GetMaxMode:=VESAModes[i];
-       Exit;
-    end;
-end;
-
-function GetMaxX:Integer;
-begin
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;
-      Exit;
-    end;
-    GetMaxX:=VESAInfo.XResolution-1;
-end;
-
-function GetMaxY:Integer;
-begin
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;
-      Exit;
-    end;
-    GetMaxY:=VESAInfo.YResolution-1;
-end;
-
-function GetX : integer;
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-   begin
-     _graphresult:=grNoInitGraph;
-     Exit;
-   end;
-   GetX:=curx;
-end;
-
-function GetY : integer;
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-   begin
-     _graphresult:=grNoInitGraph;
-     Exit;
-   end;
-GetY:=cury;
-end;
-
-procedure SetViewPort(x1,y1,x2,y2 : integer;clip : boolean);
-
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;
-      exit;
-    end;
-  { Daten �berpr�fen }
-  if (x1<0) or (y1<0) or (x2>=_maxx) or (y2>=_maxy) then exit;
-  aktviewport.x1:=x1;
-  aktviewport.y1:=y1;
-  aktviewport.x2:=x2;
-  aktviewport.y2:=y2;
-  aktviewport.clip:=clip;
-end;
-
-procedure GetViewSettings(var viewport : ViewPortType);
-
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-    begin
-    _graphresult:=grNoInitGraph;
-    exit;
-  end;
-  viewport:=aktviewport;
-end;
-
-{ mehrere Bildschirmseiten werden nicht unterst�tzt }
-{ Dummy aus Kompatibilit„tsgr�nden                  }
-procedure SetVisualPage(page : word);
-
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-    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);
-
-  begin
-     _graphresult:=grOk;
-     if not isgraphmode then
-       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;
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;;
-      exit;
-    end;
-  if ((writemode and 7)<>xorput) and ((writemode and 7)<>normalput) then
-   begin
-      _graphresult:=grError;
-      exit;
-   end;
-  aktwritemode:=(writemode and 7);
-  if (writemode and BackPut)<>0 then
-    ClearText:=true
-  else
-    ClearText:=false;
-end;
-
-function GraphResult:Integer;
-begin
-  GraphResult:=_graphresult;
-end;
-
-procedure RestoreCRTMode;
-begin
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;
-      Exit;
-    end;
-  OldCRTMode:=GetGraphMode;
-  InTempCRTMode:=true;
-  SetVESAMode(startmode);
-  isgraphmode:=false;
-end;
-
-var PrevExitProc : pointer;
-
-procedure GraphExit;
-begin
-  ExitProc:=PrevExitProc;
-  CloseGraph;
-  DoneVesa; { frees the ldt descriptors seg_read and seg_write !! }
-end;
-
-begin
-  InitVESA;
-  if not DetectVESA then
-    GraphFault('VESA-BIOS not found...');
-  startmode:=GetVESAMode;
-  PrevExitProc:=ExitProc;
-  ExitProc:=@GraphExit;
-  bankswitchptr:=@switchbank;
-  Getdefaultfont;
-  if not isDPMI then begin
-   wrbuffer:=pointer($D0000000);
-   rbuffer:=pointer($D0200000);
-   wbuffer:=pointer($D0200000);
-  end else begin
-   wrbuffer:=pointer($0);
-   rbuffer:=pointer($0);
-   wbuffer:=pointer($0);
-  end;
-  AktPageOffset:=0;
-  AktPage:=0;
-  AktVisualPage:=0;
-end.
-
-{
-  $Log$
-  Revision 1.6  1999-09-08 18:55:29  peter
-    - graphget/freememptr
-
-  Revision 1.5  1999/05/04 17:17:31  florian
-    * some explicit language removed
-
-  Revision 1.4  1999/04/08 12:23:00  peter
-    * removed os.inc
-
-  Revision 1.3  1999/03/02 13:56:34  peter
-    * use ATT assembler in profile
-    * use AS output in graph
-
-  Revision 1.2  1999/02/01 13:19:01  pierre
-   * getgraphmode returns -1 if not in graphic mode
-
-  Revision 1.1  1998/12/21 13:07:03  peter
-    * use -FE
-
-  Revision 1.15  1998/12/15 22:42:50  peter
-    * removed temp symbols
-
-  Revision 1.14  1998/11/25 22:59:23  pierre
-   * fillpoly works
-
-  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
-    + VertDir for default font added
-    * RestoreCRTMode corrected
-
-  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
-
-  Revision 1.9  1998/11/19 15:09:33  pierre
-    * several bugfixes for sector/ellipse/floodfill
-    + graphic driver mode const in interface G800x600x256...
-    + added backput mode as in linux graph.pp
-      (clears the background of textoutput)
-
-  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
-      (compile with -dDEBUG)
-      24 bit mode with banked still as problems on pixels across
-      the bank boundary, but works in LinearFrameBufferMode
-      Look at install/demo/nmandel.pp
-
-  Revision 1.6  1998/10/22 09:44:57  pierre
-   * PatternBuffer was not set on entry !!
-
-  Revision 1.5  1998/09/16 16:47:25  peter
-    * merged fixes
-
-  Revision 1.4.2.1  1998/09/16 16:15:41  peter
-    * no smartlinking!
-
-  Revision 1.4  1998/05/31 14:18:14  peter
-    * force att or direct assembling
-    * cleanup of some files
-
-  Revision 1.3  1998/05/22 00:39:23  peter
-    * go32v1, go32v2 recompiles with the new objects
-    * remake3 works again with go32v2
-    - removed some "optimizes" from daniel which were wrong
-
-}

rtl/go32v2/ppi/arc.ppi

@@ -1,218 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-  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=
-       (0,3,0, 2,3,1, 2,1,0, 0,1,1, 0,3,0, 2,3,1, 2,1,0);
-
-   var counter,index     : integer;
-       endofs,ofs        : integer;
-       xa,ya,xe,ye       : Array[0..2]of Integer;
-       xp,yp             : integer;
-       xradius,yradius   : word;
-       first,ready       : Boolean;
-       ofscount          : byte;
-
-   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]))) and
-         ((ofs mod 4)=endofs) then
-         begin
-           putpixeli(xp,yp,aktcolor);
-           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:=(Radius*10000) div XAsp;
-     YRadius:=(Radius*10000) div YAsp;
-
-     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;
-     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);
-     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);
-     ofscount:=0;
-     repeat
-       DrawArc(i[ofs*3],i[ofs*3+1],i[ofs*3+2]);
-       ofs:=(ofs+1) mod 7;
-       inc(ofscount);
-     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
-     else
-       angle:=(alpha-360+beta)/2;
-     { fill from the point in the middle of the slice }
-     XRadius:=(Radius*10000) div XAsp;
-     YRadius:=(Radius*10000) div YAsp;
-{$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.1  1998-12-21 13:07:03  peter
-    * use -FE
-
-  Revision 1.6  1998/11/23 10:04:17  pierre
-    * pieslice and sector work now !!
-    * bugs in text writing removed
-    + scaling for defaultfont added
-    + VertDir for default font added
-    * RestoreCRTMode corrected
-
-  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
-      (clears the background of textoutput)
-
-  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
-      (compile with -dDEBUG)
-      24 bit mode with banked still as problems on pixels across
-      the bank boundary, but works in LinearFrameBufferMode
-      Look at install/demo/nmandel.pp
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.3  1998/01/26 11:58:53  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/arc.ppi
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:27;  author: michael;  state: Exp;  lines: +13 -0
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/colors.ppi

@@ -1,216 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-{ COLORS.PPI }
-
-{ GetBkColor , SetBkColor , GetColor , SetColor , GetMaxColor }
-
-
-function Convert(Color:longint):longint;
-var c,r,g,b:longint;
-begin
-  if BytesPerPixel = 1 then
-    begin
-       if (Color and $FF000000)=0 then
-       begin
-         C:=Color and $FF;
-         Convert:=(C shl 24) + (C shl 16) + (C shl 8) + C;
-       end else
-       begin
-         SetRGBPalette(((Color and $FF000000) shr 24),
-                       ((Color and $00FF0000) shr 16),
-                       ((Color and $0000FF00) shr 8),
-                        (Color and $000000FF));
-         C:=(Color and $FF000000);
-         Convert:=(C shr 24) + (C shr 16) + (C shr 8) + C;
-       end;
-    end else if BytesPerPixel>2 then
-      Convert:=Color and $FFFFFF
-    else
-    begin
-       R:=(Color and $00FF0000) shr (24-VESAInfo.rm_size);
-       G:=(Color and $0000FF00) shr (16-VESAInfo.gm_size);
-       B:=(Color and $000000FF) shr (8-VESAInfo.bm_size);
-       C:=(R shl VESAInfo.rf_pos) or (G shl VESAInfo.gf_pos) or
-          (B shl VESAInfo.bf_pos);
-       if BytesPerPixel = 2 then
-         Convert:=(C shl 16) or C;
-    end;
-end;
-
-function Unconvert(Color:longint):longint;
-var c,r,g,b:longint;
-begin
-  if BytesPerPixel=1 then
-    begin
-       UnConvert:=Color and $FF;
-    end
-  else if BytesPerPixel>2 then
-    Unconvert:=Color and $FFFFFF
-  else
-    begin
-       C:=Color shr VesaInfo.bf_pos;
-       b:= C and ( (1 shl (VesaInfo.bm_size))-1);
-       b:= b shl (8-VesaInfo.bm_size);
-       C:=Color shr VesaInfo.gf_pos;
-       g:= C and ( (1 shl (VesaInfo.gm_size))-1);
-       g:= g shl (8-VesaInfo.gm_size);
-       C:=Color shr VesaInfo.rf_pos;
-       r:= C and ( (1 shl (VesaInfo.rm_size))-1);
-       r:= r shl (8-VesaInfo.rm_size);
-       Unconvert:= r*$10000+g*$100+b;
-    end;
-end;
-
-function GetColor : longint;
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;
-      exit;
-    end;
-  getcolor:=truecolor;
-end;
-
-{ ----------------------------------------------------------------------- }
-
-procedure SetColor(color : Longint);
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-    begin
-    _graphresult:=grNoInitGraph;
-  exit;
-  end;
-  truecolor:=color;
-  aktcolor:=convert(Color);
-end;
-
-{ ----------------------------------------------------------------------- }
-
-function GetBkColor : longint;
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;
-      exit;
-    end;
-  getbkcolor:=truebackcolor;
-end;
-
-procedure SetBkColor(Color : longint);
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;
-      exit;
-    end;
-  truebackcolor:=color;
-  aktbackcolor:=convert(Color);
-end;
-
-function  GetMaxColor : longint;
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-    begin
-      _graphresult:=grNoInitGraph;;
-      exit;
-    end;
-  getmaxcolor:=(1 shl VESAInfo.BitsPerPixel)-1;
-end;
-
-  procedure setstdcolors;
-
-    begin
-       if bytesperpixel>1 then
-         begin
-            black := stdcolors[0];
-            blue  := stdcolors[1];
-            green := stdcolors[2];
-            cyan  := stdcolors[3];
-            red   := stdcolors[4];
-            magenta := stdcolors[5];
-            brown := stdcolors[6];
-            lightgray := stdcolors[7];
-            darkgray := stdcolors[8];
-            lightblue := stdcolors[9];
-            lightgreen := stdcolors[10];
-            lightcyan := stdcolors[11];
-            lightred := stdcolors[12];
-            lightmagenta := stdcolors[13];
-            yellow := stdcolors[14];
-            white := stdcolors[15];
-         end
-       else
-         begin
-            black := 0;
-            blue  := 1;
-            green := 2;
-            cyan  := 3;
-            red   := 4;
-            magenta := 5;
-            brown := 6;
-            lightgray := 7;
-            darkgray := 8;
-            lightblue := 9;
-            lightgreen := 10;
-            lightcyan := 11;
-            lightred := 12;
-            lightmagenta := 13;
-            yellow := 14;
-            white := 15;
-         end;
-  end;
-
-{
-  $Log$
-  Revision 1.1  1998-12-21 13:07:03  peter
-    * use -FE
-
-  Revision 1.2  1998/11/18 09:31:31  pierre
-    * changed color scheme
-      all colors are in RGB format if more than 256 colors
-    + added 24 and 32 bits per pixel mode
-      (compile with -dDEBUG)
-      24 bit mode with banked still as problems on pixels across
-      the bank boundary, but works in LinearFrameBufferMode
-      Look at install/demo/nmandel.pp
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.3  1998/01/26 11:57:43  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/colors.ppi
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:28;  author: michael;  state: Exp;  lines: +13 -0
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/dpmi2raw.ppi

@@ -1,56 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-procedure Get_RAW_Switch_Address;
-begin
-  asm
-    movw  $0x306,%ax
-    int   $0x31
-    shll  $0x10,%ebx
-    movw  %cx,%bx
-    movl  %ebx,_SWITCHRAW2DPMI
-    movl  %edi,_SWITCHDPMI2RAW
-    movw  %si,_SWITCHSEG
-  end;
-end;
-
-{
-  $Log$
-  Revision 1.1  1998-12-21 13:07:03  peter
-    * use -FE
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.3  1998/01/26 11:57:47  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/dpmi2raw.ppi
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:28;  author: michael;  state: Exp;  lines: +14 -0
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/ellipse.ppi

@@ -1,342 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    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;
-         xp,yp,count     : integer;
-         i               : integer;
-     begin
-     {XRadius:=(XRadius*10000) div XAsp;
-     YRadius:=(YRadius*10000) div YAsp; }
-     { must be changed before !! }
-     aq :=XRadius * XRadius;
-     bq :=YRadius * YRadius;
-     abq:=aq * bq;
-     yp:=YRadius;
-     xp:=0;
-     count:=0;
-
-      { Berechnung nach : X^2 / A^2 + Y^2 / B^2 = 1               }
-      {      umgestellt : X^2 * Y^2 * A^2 * B^2 = A^2*B^2         }
-      {      dadurch werden evtuelle Divisionen durch 0 vermieden }
-      {      und Integerarithmetik moeglich                       }
-    { 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;
-      PWord(buffermem)[count+3]:=y - yp;
-      xq:=xp * xp; yq:=yp * yp;
-      if xq * bq + yq * aq >= abq then yp:=yp-1 else xp:=xp+1;
-      Count:=Count+4;
-    until yp < 0;
-    CalcEllipse:=Count;
-  end;
-
-  Procedure _Ellipse(Count:Integer);
-    const aq:Integer=0;
-    begin
-
-    { Das Zeichnen der Ellipse erfolgt in zwei Schleifen, um systematisch }
-    { von oben nach unten zu zeichnen und somit ein staendiges Bank-      }
-    { umschalten zu verhindern }
-
-    while aq <> count do begin
-      PutPixeli( PWord(buffermem)[aq]  ,PWord(buffermem)[aq+3],aktcolor);
-      PutPixeli( PWord(buffermem)[aq+2],PWord(buffermem)[aq+3],aktcolor);
-      aq:=aq+4;
-    end;
-    while aq <> 0 do begin
-      aq:=aq-4;
-      PutPixeli( PWord(buffermem)[aq]  ,PWord(buffermem)[aq+1],aktcolor);
-      PutPixeli( PWord(buffermem)[aq+2],PWord(buffermem)[aq+1],aktcolor);
-    end;
-  end;
-
-  Procedure Fillellipse(x,y:Integer;XRadius,YRadius:word);
-    var Count,index:Word;
-        Count8:Word;
-        begin
-         _graphresult:=grOk;
-         if not isgraphmode then
-           begin
-              _graphresult:=grnoinitgraph;
-              exit;
-           end;
-
-    XRadius:=(XRadius*10000) div XAsp;
-    YRadius:=(YRadius*10000) div YAsp;
-    Count:=CalcEllipse(x,y,XRadius,YRadius);
-    if Count=0 then exit;
-    Count8:=Count-8;
-    index:=0;
-
-    while index < count do begin
-      while (PWord(buffermem)[index+1]=PWord(buffermem)[index+5]) and
-            (index < count8) do Index:=Index+4;
-      PatternLine(PWord(buffermem)[index],PWord(buffermem)[index+2],
-                  PWord(buffermem)[index+3]);
-      Index:=Index+4;
-    end;
-
-    while index > 0 do begin
-      index:=index-4;
-      PatternLine(PWord(buffermem)[index],PWord(buffermem)[index+2],
-                  PWord(buffermem)[index+1]);
-      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     : integer;
-       ofs,endofs        : integer;
-       xa,ya,xe,ye       : Array[0..2] of Integer;
-       xp,yp             : integer;
-       xradius,yradius   : word;
-       first,ready       : Boolean;
-       ofscount          : byte;
-
-   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]))) and
-         ((ofs mod 4)=endofs) then
-         begin
-           putpixeli(xp,yp,aktcolor);
-           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;
-     XRadius:=(XRadius*10000) div XAsp;
-     YRadius:=(YRadius*10000) div YAsp;
-
-     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;
-     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);
-     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);
-     ofscount:=0;
-     repeat
-       DrawArc(i[ofs*3],i[ofs*3+1],i[ofs*3+2]);
-       ofs:=(ofs+1) mod 7;
-       inc(ofscount);
-     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;
-     { 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 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);
-  var
-     xradius,yradius : word;
-  begin
-    _graphresult:=grOk;
-    if not isgraphmode then
-      begin
-        _graphresult:=grnoinitgraph;
-        exit;
-      end;
-     XRadius:=(Radius*10000) div XAsp;
-     YRadius:=(Radius*10000) div YAsp;
-    _Ellipse(CalcEllipse(x,y,xradius,yradius));
-  end;
-
-{
-  $Log$
-  Revision 1.1  1998-12-21 13:07:03  peter
-    * use -FE
-
-  Revision 1.6  1998/11/23 10:04:18  pierre
-    * pieslice and sector work now !!
-    * bugs in text writing removed
-    + scaling for defaultfont added
-    + VertDir for default font added
-    * RestoreCRTMode corrected
-
-  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
-      (clears the background of textoutput)
-
-  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
-      (compile with -dDEBUG)
-      24 bit mode with banked still as problems on pixels across
-      the bank boundary, but works in LinearFrameBufferMode
-      Look at install/demo/nmandel.pp
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.3  1998/01/26 11:57:54  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/ellipse.ppi
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:29;  author: michael;  state: Exp;  lines: +13 -1
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/fill.ppi

@@ -1,475 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$ifopt S+}
-{$define StackCkeckOn}
-{$endif opt S+}
-
-procedure floodfill(x,y:integer; border:longint);
-
-var bordercol     : 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 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:=getpixeli(xx,y);
-    end;
-  if (col<>bordercol) and (col<>fillcol) and
-     (not test_bkfill or (col<>fillbkcol)) then
-    start:=xx
-  else
-    start:=xx+1;
-
-  xx:=x;
-  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:=getpixeli(xx,y);
-    end;
-  if (col<>bordercol) and (col<>fillcol) and
-     (not test_bkfill or (col<>fillbkcol)) then
-    ende:=xx
-  else
-    ende:=xx-1;
-
-{$ifdef GraphDebug}
-     Writeln(stderr,'Pattern ',start,' ',ende,' ',y);
-{$endif def GraphDebug}
-  patternline(start,ende,y);
-{$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:=getpixeli(xx,y-1);
-      if (col<>bordercol) and (col<>fillcol) and
-         (not test_bkfill or (col<>fillbkcol))
-      then begin
-        fill(xx,y-1);
-        break;
-      end;
-      xx:=xx+1;
-    until xx > ende;
-  end;
-
-  if (y<viewport.y2) then
-   begin
-    xx:=start;
-    repeat
-      col:=getpixeli(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;
-
-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;
-
-  if (x>viewport.x2) or (x<viewport.x1) or
-     (y>viewport.y2) or (y<viewport.y1) then
-    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;
-       test_bkfill:=false;
-    end
-  else if aktfillsettings.pattern=solidfill then
-     test_bkfill:=false
-  else
-    test_bkfill:=true;
-{$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;
-
-{$ifndef StackCkeckOn}
-{$S-} { return to normal state }
-{$else }
-{$undef StackCheckOn}
-{$endif }
-
-procedure GetFillSettings(var Fillinfo:Fillsettingstype);
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-    begin
-      _graphresult:=grnoinitgraph;
-      exit;
-    end;
-  Fillinfo:=aktfillsettings;
-  Fillinfo.color:=unconvert(aktfillsettings.color);
-end;
-
-procedure GetFillPattern(var FillPattern:FillPatternType);
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-    begin
-      _graphresult:=grnoinitgraph;
-      exit;
-    end;
-  FillPattern:=aktfillpattern;
-end;
-
-procedure SetFillPattern(pattern : FillPatternType;color : longint);
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-    begin
-      _graphresult:=grnoinitgraph;
-      exit;
-    end;
-  fillpattern[12]:=pattern;
-  SetFillStyle(12,color);
-end;
-
-procedure SetFillStyle(pattern : word ;color : longint);
-var i,j:Integer;
-    mask:Byte;
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-    begin
-      _graphresult:=grnoinitgraph;
-      exit;
-    end;
-    { g�ltige Paramter ? }
-  if (pattern<0) or (pattern>12) then
-    begin
-      _graphresult:=grError;
-      exit;
-    end;
-    { Muster laden }
-  aktfillpattern:=fillpattern[pattern];
-  aktfillsettings.pattern:=pattern;
-  aktfillsettings.color:=convert(color);
-  aktfillbkcolor:=aktbackcolor;
-  i:=1; j:=0;
-  repeat
-    mask:=$80;
-      repeat
-        if (aktfillpattern[i] and mask) = 0
-          then PatternBuffer[j]:=aktbackcolor else PatternBuffer[j]:=aktfillsettings.color;
-           mask:=mask shr 1;
-           j:=j+1;
-      until mask=0;
-      i:=i+1;
-  until i > 8;
-end;
-
-procedure GetLineSettings(var LineInfo : LineSettingsType);
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-    begin
-      _graphresult:=grnoinitgraph;
-      exit;
-    end;
-  lineinfo:=aktlineinfo;
-end;
-
-{ this procedure is rather confuse
-  but I admit that I wrote it by try-error !! PM }
-
-procedure FillPoly(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;
-                      use_in_line : boolean;
-                    End;
-     LineSegmentInfoArray = Array[0..0] of TLineSegmentInfo;
-
- var
-     xmin,xmax,ymin,ymax : longint;
-     x1,x2,y1,y2,y,xdeb  : longint;
-     i,j,curx,cury       : longint;
-     newvalue            : longint;
-     LineInfo            : ^LineSegmentInfoArray;
-     PreviousInside,inside,side : boolean;
-     viewport            : viewporttype;
-begin
-   GetMem(LineInfo,(points+1)*SizeOf(TlineSegmentInfo));
-   xmax:=$80000000;xmin:=$7fffffff;
-   ymax:=$80000000;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 }
-
-     side:=true;
-     for i:=0 to points-1 do
-       begin
-          cury:=LineInfo^[i].ymin;
-          newvalue:=LineInfo^[i].xcoef*(xmin-1)+
-               LineInfo^[i].ycoef*cury+LineInfo^[i]._const;
-          if (newvalue<0) then
-            side:=not side;
-       end;
-   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 GraphDebug}
-       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 GraphDebug}
-       Writeln(stderr,'Rectangle (',xmin,',',ymin,'),(',xmax,',',ymax,')');
-{$endif def GraphDebug}
-
-   for cury:=ymin to ymax do
-     begin
-        xdeb:=xmin;
-        PreviousInside:=true;
-        for i:=0 to points-1 do
-          begin
-             if cury<LineInfo^[i].ymin then
-               y:=LineInfo^[i].ymin
-             else if cury>LineInfo^[i].ymax then
-               y:=LineInfo^[i].ymax
-             else
-               y:=cury;
-             newvalue:=LineInfo^[i].xcoef*(xmin-1)+
-               LineInfo^[i].ycoef*y+LineInfo^[i]._const;
-             LineInfo^[i].lastvalue:=newvalue;
-             if (newvalue<0) then
-               PreviousInside:=not PreviousInside;
-             if (cury<LineInfo^[i].ymin) or (cury>=LineInfo^[i].ymax) then
-               LineInfo^[i].use_in_line:=false
-             else
-               LineInfo^[i].use_in_line:=true;
-          end;
-        PreviousInside:=(side<>PreviousInside);
-        inside:=PreviousInside;
-        for curx:=xmin to xmax do
-           begin
-              for i:=0 to points-1 do
-                if LineInfo^[i].use_in_line then
-                  begin
-                     newvalue:=LineInfo^[i].lastvalue+LineInfo^[i].xcoef;
-                     if ((LineInfo^[i].lastvalue<0) and (newvalue>=0)) or
-                        ((LineInfo^[i].lastvalue>0) and (newvalue<=0)) then
-                       begin
-                          inside:=not inside;
-{$ifdef GraphDebug}
-                          Writeln(stderr,'Line ',i,' crossed (',curx,',',cury,')');
-                          Writeln(stderr,'Line x*',LineInfo^[i].xcoef,'+y*',
-                            LineInfo^[i].ycoef,'+',LineInfo^[i]._const,'=0');
-                          Writeln(stderr,'Old ',LineInfo^[i].lastvalue,' new ',newvalue);
-{$endif def GraphDebug}
-                       end;
-                     LineInfo^[i].lastvalue:=newvalue;
-                  end;
-              if inside<>PreviousInside then
-                if inside then
-                  xdeb:=curx
-                else
-                  begin
-                     patternline(xdeb,curx,cury);
-{$ifdef GraphDebug}
-                     Writeln(stderr,'Pattern (',xdeb,',',curx,') at ',cury);
-{$endif def GraphDebug}
-                  end;
-              PreviousInside:=inside;
-           end;
-        if inside then
-          begin
-             patternline(xdeb,xmax,cury);
-{$ifdef GraphDebug}
-             Writeln(stderr,'Pattern (',xdeb,',',xmax,') at ',cury);
-{$endif def GraphDebug}
-          end;
-     end;
-
-   FreeMem(LineInfo,(points+1)*SizeOf(TlineSegmentInfo));
-   { simply call drawpoly instead (PM) }
-   DrawPoly(points,polypoints);
-end;
-
-
-{
-  $Log$
-  Revision 1.1  1998-12-21 13:07:03  peter
-    * use -FE
-
-  Revision 1.8  1998/11/25 22:59:24  pierre
-   * fillpoly works
-
-  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
-    * several bugfixes for sector/ellipse/floodfill
-    + graphic driver mode const in interface G800x600x256...
-    + added backput mode as in linux graph.pp
-      (clears the background of textoutput)
-
-  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)
-      Simply make a floodfill from the barycenter !
-    * some 24BPP code changed (still does not work for my S3VBE program !)
-
-  Revision 1.2  1998/11/18 09:31:33  pierre
-    * changed color scheme
-      all colors are in RGB format if more than 256 colors
-    + added 24 and 32 bits per pixel mode
-      (compile with -dDEBUG)
-      24 bit mode with banked still as problems on pixels across
-      the bank boundary, but works in LinearFrameBufferMode
-      Look at install/demo/nmandel.pp
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.3  1998/01/26 11:57:57  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/fill.ppi
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:29;  author: michael;  state: Exp;  lines: +13 -1
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/font.ppi

@@ -1,85 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-var
-   defaultfontdata : array[0..2047] of byte;
-
-function getfontpointer(b : byte):longint;
-  begin
-    dregs.RealSS:=0;
-    dregs.RealSP:=0;
-    dregs.RealEAX:=$1130;
-    dregs.RealEBX:=longint(b shl 8);
-    RealIntr($10,dregs);
-    getfontpointer:=(longint(dregs.RealES) shl 4) + dregs.RealEBP and $FFFF;
-  end;
-
-procedure getdefaultfont;
-  var Sel : Word;
-      linaddr : longint;
-
-  begin
-    { 8x8-Defaultfont aus BIOS laden }
-    if isDPMI then begin
-      SEL:=allocate_ldt_descriptors(1);
-      linaddr:=getfontpointer(3);
-      { I got problems because the fonts were at real mode segment $ffff
-      so the address is above 1Mo and thus not locked !! }
-      if linaddr+1024>$100000 then
-        linaddr:=get_linear_addr(linaddr,1024);
-      Set_segment_base_address(SEL,linaddr);
-      Set_segment_limit(SEL,1024);
-      movelong(sel,@defaultfontdata[0],$3FF);
-      linaddr:=getfontpointer(4);
-      if linaddr+1024>$100000 then
-        linaddr:=get_linear_addr(linaddr,1024);
-      Set_segment_base_address(SEL,linaddr);
-      Set_segment_limit(SEL,1024);
-      movelong(sel,@defaultfontdata[1024],$3FF);
-      free_ldt_descriptor(SEL);
-    end else begin
-      move(pointer(getfontpointer(3)+core)^,defaultfontdata[0],1024);
-      move(pointer(getfontpointer(4)+core)^,defaultfontdata[1024],1024);
-    end;
-  end;
-
-{
-  $Log$
-  Revision 1.1  1998-12-21 13:07:03  peter
-    * use -FE
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.3  1998/01/26 11:58:02  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/font.ppi
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:29;  author: michael;  state: Exp;  lines: +14 -0
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/global.ppi

@@ -1,277 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-{$PACKRECORDS NORMAL}
-
-    const
-       { error codes }
-       grOk =  0;
-       grNoInitGraph = -1;
-       grNotDetected = -2;
-       grFileNotFound = -3;
-       grInvalidDriver = -4;
-       grNoLoadMem = -5;
-       grNoScanMem = -6;
-       grNoFloodMem = -7;
-       grFontNotFound = -8;
-       grNoFontMem = -9;
-       grInvalidMode = -10;
-       grError = -11;
-       grIOerror = -12;
-       grInvalidFont = -13;
-       grInvalidFontNum = -14;
-       grInvalidVersion = -18;
-
-       { graphic drivers }
-       CurrentDriver = -128;
-       Detect = 0;
-
-       { graph modes }
-       Default = 0;
-
-       { Farben f�r setpalette und setallpalette }
-       black : longint = 0;
-       blue  : longint = 1;
-       green : longint = 2;
-       cyan  : longint = 3;
-       red   : longint = 4;
-       magenta : longint = 5;
-       brown : longint = 6;
-       lightgray : longint = 7;
-       darkgray : longint = 8;
-       lightblue : longint = 9;
-       lightgreen : longint = 10;
-       lightcyan : longint = 11;
-       lightred : longint = 12;
-       lightmagenta : longint = 13;
-       yellow : longint = 14;
-       white : longint = 15;
-
-       { Linenart f�r Get/SetLineStyle: }
-       SolidLn = 0;
-       DottedLn = 1;
-       CenterLn = 2;
-       DashedLn = 3;
-       UserBitLn = 4;
-
-       NormWidth = 1;
-       ThickWidth = 3;
-
-       { Set/GetTextStyle Konstanten: }
-       DefaultFont = 0;
-       TriplexFont = 1;
-       SmallFont = 2;
-       SansSerifFont = 3;
-       GothicFont = 4;
-       ScriptFont = 5;
-       SimpleFont = 6;
-       TSCRFont = 7;
-       LCOMFont = 8;
-       EuroFont = 9;
-       BoldFont = 10;
-
-       HorizDir = 0;
-       VertDir = 1;
-
-       UserCharSize = 0;
-
-       ClipOn = true;
-       ClipOff = false;
-
-       { Bar3D constants }
-       TopOn = true;
-       TopOff = false;
-
-       { fill pattern for Get/SetFillStyle: }
-       EmptyFill = 0;
-       SolidFill = 1;
-       LineFill = 2;
-       LtSlashFill = 3;
-       SlashFill = 4;
-       BkSlashFill = 5;
-       LtBkSlashFill = 6;
-       HatchFill = 7;
-       XHatchFill = 8;
-       InterleaveFill = 9;
-       WideDotFill = 10;
-       CloseDotFill = 11;
-       UserFill = 12;
-
-       { bitblt operators  }
-       NormalPut     = 0;
-       CopyPut       = 0;
-       XORPut        = 1;
-       OrPut         = 2;
-       AndPut        = 3;
-       NotPut        = 4;
-       BackPut       = 8;
-
-       { SetTextJustify constants }
-       LeftText   = 0;
-       CenterText = 1;
-       RightText  = 2;
-
-       BottomText = 0;
-       TopText    = 2;
-
-    type
-       RGBColor = record
-         r,g,b,i : byte;
-       end;
-
-       PaletteType = record
-          Size   : integer;
-          Colors : array[0..767]of Byte;
-       end;
-
-       LineSettingsType = record
-          linestyle : word;
-          pattern : word;
-          thickness : word;
-       end;
-
-       TextSettingsType = record
-          font : word;
-          direction : word;
-          charsize : word;
-          horiz : word;
-          vert : word;
-       end;
-
-       FillSettingsType = record
-          pattern : word;
-          color : longint;
-       end;
-
-       FillPatternType = array[1..8] of byte;
-
-       PointType = record
-          x,y : integer;
-       end;
-
-       ViewPortType = record
-          x1,y1,x2,y2 : integer;
-          Clip : boolean;
-       end;
-
-       ArcCoordsType = record
-          x,y : integer;
-          xstart,ystart : integer;
-          xend,yend : integer;
-       end;
-
-  const
-       fillpattern : array[0..12] of FillPatternType = (
-           ($00,$00,$00,$00,$00,$00,$00,$00),     { Hintergrundfarbe }
-           ($ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff),     { Vordergrundfarbe }
-           ($ff,$ff,$00,$00,$ff,$ff,$00,$00),     { === }
-           ($01,$02,$04,$08,$10,$20,$40,$80),     { /// }
-           ($07,$0e,$1c,$38,$70,$e0,$c1,$83),     { /// als dicke Linien }
-           ($07,$83,$c1,$e0,$70,$38,$1c,$0e),     { \\\ als dicke Linien }
-           ($5a,$2d,$96,$4b,$a5,$d2,$69,$b4),     { \ \\ \ }
-           ($ff,$88,$88,$88,$ff,$88,$88,$88),     { K„stchen }
-           ($18,$24,$42,$81,$81,$42,$24,$18),     { Rauten }
-           ($cc,$33,$cc,$33,$cc,$33,$cc,$33),     { "Mauermuster" }
-           ($80,$00,$08,$00,$80,$00,$08,$00),     { weit auseinanderliegende Punkte }
-           ($88,$00,$22,$00,$88,$00,$22,$00),     { dichte Punkte}
-           (0,0,0,0,0,0,0,0)                      { benutzerdefiniert }
-          );
-
-  G640x400x256      = $100;
-  G640x480x256      = $101;
-  G800x600x256      = $103;
-  G1024x768x256     = $105;
-
-  G1280x1024x256    = $107;   { Additional modes. }
-
-  G640x480x32K      = $110;
-  G640x480x64K      = $111;
-  G640x480x16M      = $112;
-
-  G800x600x32K      = $113;
-  G800x600x64K      = $114;
-  G800x600x16M      = $115;
-
-  G1024x768x32K     = $116;
-  G1024x768x64K     = $117;
-  G1024x768x16M     = $118;
-
-  G1280x1024x32K    = $119;
-  G1280x1024x64K    = $11A;
-  G1280x1024x16M    = $11B;
-
-(*   G320x200x16M32    = 33;       { 32-bit per pixel modes. }
-  G640x480x16M32    = 34;
-  G800x600x16M32    = 35;
-  G1024x768x16M32   = 36;
-  G1280x1024x16M32  = 37; *)
-
-{
-  $Log$
-  Revision 1.1  1998-12-21 13:07:03  peter
-    * use -FE
-
-  Revision 1.5  1998/11/19 15:09:38  pierre
-    * several bugfixes for sector/ellipse/floodfill
-    + graphic driver mode const in interface G800x600x256...
-    + added backput mode as in linux graph.pp
-      (clears the background of textoutput)
-
-  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
-      (compile with -dDEBUG)
-      24 bit mode with banked still as problems on pixels across
-      the bank boundary, but works in LinearFrameBufferMode
-      Look at install/demo/nmandel.pp
-
-  Revision 1.2  1998/03/26 10:41:15  florian
-    * some warnings fixed
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.4  1998/03/03 22:48:42  florian
-    + graph.drawpoly procedure
-    + putimage with xorput uses mmx if available
-
-  Revision 1.3  1998/01/26 11:58:05  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/global.ppi
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:30;  author: michael;  state: Exp;  lines: +13 -0
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/ibm.ppi

@@ -1,406 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-function DetectVESA:Boolean;
-var Result_:longint;
-begin
-  Result_:=Global_dos_alloc($0200);
-     Sel:=word(Result_);
-     Seg:=word(Result_ shr 16);
-     dregs.RealSP:=0;      dregs.RealSS:=0;
-     dregs.RealES:=Seg;    dregs.RealEDI:=0;
-     dregs.RealEAX:=$4F00; RealIntr($10,dregs);
-     if isDPMI
-       then MoveLong(sel,@VGAInfo,256)
-       else Move(pointer((seg shl 4)+core)^,VGAInfo,256);
-  global_dos_free(sel);
-  DetectVesa:=(dregs.RealEAX and $FF=$4F);
-  isVESA2:=VGAInfo.VESAHiVersion=2;
-end;
-
-function GetVESAInfo( Mode : WORD ):Boolean;
-var Result_:longint;
-    St : string;
-{$ifdef Test_linear}
-    Temp : longint;
-{$endif Test_linear}
-    
-begin
-  Result_:=Global_dos_alloc($0200);
-     Sel:=word(Result_);
-     Seg:=word(Result_ shr 16);
-     dregs.RealECX:=mode;
-     dregs.RealSP:=0;      dregs.RealSS:=0;
-     dregs.RealES:=Seg;    dregs.RealEDI:=0;
-     dregs.RealEAX:=$4F01; RealIntr($10,dregs);
-     if isDPMI
-       then MoveLong(sel,@VESAInfo,256)
-       else Move(Pointer((seg shl 4)+core)^,VESAINFO,256);
-  global_dos_free(sel);
-
-  { this is wrong because AH is set to one if mode not detected !!!
-  if (dregs.RealEAX and $ff) =$4F then  must be replaced by }
-  if (dregs.RealEAX and $1ff) =$4F then
-    begin
-      GetVESAInfo:=true;
-      { mode is supported only if bit 0 in modeAttributes is set }
-      if (VESAInfo.ModeAttributes and 1)=0 then
-        GetVESAInfo:=false;
-      BytesPerLine:=VESAInfo.BPL;
-      case VESAInfo.BitsPerPixel of
-       8     : begin
-                  BytesPerPixel:=1;
-                  ColorMask:=$ff;
-               end;
-       15,16 : begin
-                  BytesPerPixel:=2;
-                  ColorMask:=$ffff;
-               end;
-{$ifdef TEST_24BPP}
-       24    : begin
-                  BytesPerPixel:=3;
-                  ColorMask:=$ffffff;
-               end;
-       32    : begin
-                  BytesPerPixel:=4;
-                  ColorMask:=$ffffff;
-               end;
-{$endif TEST_24BPP}
-       else    begin
-               str(VESAInfo.BitsPerPixel,St);
-               GraphFault(St+'-Bit Mode not implemented !');
-               exit;
-               end;
-      end;
-     _maxx:=VESAInfo.XResolution;
-     _maxy:=VESAInfo.YResolution;
-
-{$ifdef TEST_24BPP}
-     { problem with pseudo 32 bit modes !! }
-     if BytesPerPixel*VESAInfo.XResolution<>BytesPerLine then
-       begin
-          GraphFault('Unconsistant VESA data');
-          { GetVesaInfo:=False; }
-          BytesPerPixel:=BytesPerLine div VESAInfo.XResolution;
-       end;
-{$endif TEST_24BPP}
-     WinSize:=VESAInfo.Winsize*1024;
-     WinLoMask:=WinSize-1;
-     case VESAInfo.WinSize of
-        64 : WinShift:=16;      { x div 65536 = x shr 16 }
-        32 : WinShift:=15;      { x div 32768 = x shr 15 }
-        16 : WinShift:=14;      { ... }
-         8 : WinShift:=13;
-         4 : WinShift:=12;
-         2 : WinShift:=11;
-         1 : WinShift:=10;
-     end;
-     Granularity:=VESAInfo.WinGranularity;
-     Granular:=VESAInfo.WinSize div Granularity;
-     case Granular of
-       256 : GranShift:=8;
-       128 : GranShift:=7;
-        64 : GranShift:=6;
-        32 : GranShift:=5;
-        16 : GranShift:=4;
-         8 : GranShift:=3;
-         4 : GranShift:=2;
-         2 : GranShift:=1;
-         1 : GranShift:=0;
-     end;
-     (* { on my ATI rage pro card these field are zeroed !! (PM) }
-
-     if VesaInfo.rf_pos=VesaInfo.bf_pos then
-       begin
-         VesaInfo.rm_size:=VESAInfo.BitsPerPixel div 3;
-         VesaInfo.bm_size:=VESAInfo.BitsPerPixel div 3;
-         VesaInfo.gm_size:=VESAInfo.BitsPerPixel -2*VesaInfo.bm_size;
-         VesaInfo.bf_pos:=0;
-         VesaInfo.gf_pos:=VesaInfo.bm_size;
-         VesaInfo.rf_pos:=VesaInfo.bm_size+VesaInfo.gm_size;
-       end;   *)
-
-     if isDPMI then begin
-       set_segment_base_address(seg_write,$A000 shl 4);
-       set_segment_limit(seg_write,$FFFF);
-       set_segment_base_address(seg_read,$A000 shl 4);
-       set_segment_limit(seg_read,$FFFF);
-     end;
-     { read and write window can be different !!! PM }
-     if ((VESAInfo.WinAAttributes and 5)=5) then
-       AW_Window:=AWindow
-     else if ((VESAInfo.WinBAttributes and 5)=5) then
-       AW_Window:=BWindow
-     else GraphFault('No write window !! ');
-     if ((VESAInfo.WinAAttributes and 3)=3) then
-       AR_Window:=AWindow
-     else if ((VESAInfo.WinBAttributes and 3)=3) then
-       AR_Window:=BWindow
-     else GraphFault('No read window !! ');
-     if AW_Window=AR_Window then
-       same_window:=true
-     else
-       same_window:=false;
-
-      if (VESAInfo.ModeAttributes and $80)=$80 then
-        LinearFrameBufferSupported:=true
-      else
-        LinearFrameBufferSupported:=false;
-
-{$ifdef Test_linear}
-      (* bug was due to alignment problem in VesaInfoBlock !! PM
-      { try to swap the FrameBuffer Physical Address }
-      if switch_physical_address then
-        begin
-           w:=VESAInfo.PhysAddress and $FFFF;
-           VESAInfo.PhysAddress:=(w shl 16) or (VESAInfo.PhysAddress shr 16);
-        end; *)
-      If LinearFrameBufferSupported then
-        begin
-           FrameBufferLinearAddress:=Get_linear_addr(VESAInfo.PhysAddress and $FFFF0000,VGAInfo.TotalMem shl 16);
-           if int31error<>0 then
-             writeln(stderr,'Error in get linear address for ',hexstr(VESAInfo.PhysAddress,8));
-        end
-      else
-{$endif Test_linear}
-        FrameBufferLinearAddress:=$A0000;
-
-{$ifdef Test_linear}
-      If isDPMI and LinearFrameBufferSupported and UseLinear then
-        UseLinearFrameBuffer:=true
-      else
-        UseLinearFrameBuffer:=false;
-     if UseLinearFrameBuffer then
-       begin
-          set_segment_base_address(seg_write,FrameBufferLinearAddress);
-          set_segment_limit(seg_write,(VGAInfo.TotalMem shl 16)-1);
-          set_segment_base_address(seg_read,FrameBufferLinearAddress);
-          set_segment_limit(seg_read,(VGAInfo.TotalMem shl 16)-1);
-          WinSize:=(VGAInfo.TotalMem shl 16);
-          WinLoMask:=(VGAInfo.TotalMem shl 16)-1;
-          WinShift:=15;
-          Temp:=VGAInfo.TotalMem;
-          while Temp>0 do
-            begin
-               inc(WinShift);
-               Temp:=Temp shr 1;
-            end;
-       end;
-{$endif Test_linear}
-     SwitchCS:=hi(VESAInfo.RealWinFuncPtr);
-     SwitchIP:=lo(VESAInfo.RealWinFuncPtr);
-     { usefull for boundary problems }
-     if BytesPerPixel=3 then
-       WinLoMaskMinusPixelSize:=WinLoMask-4
-     else
-       WinLoMaskMinusPixelSize:=WinLoMask-BytesPerPixel;
-   end else GetVESAInfo:=false;
-end;
-
-function SetVESAMode(Mode:WORD):Boolean;
-begin
-  dregs.RealEBX:=Mode;
-  dregs.RealSP:=0;      dregs.RealSS:=0;
-  dregs.RealEAX:=$4F02; RealIntr($10,dregs);
-  { idem as above !!! }
-  if (dregs.RealEAX and $1FF) <> $4F then begin
-    writeln('Couldn''t initialize VESAMode ',HexStr(mode,4));
-    SetVESAMode:=false;
-  end
-  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;
-  dregs.RealEAX:=$4F03; RealIntr($10,dregs);
-  GetVESAMode:=lo(dregs.RealEBX);
-end;
-
-procedure InitVESA;
-var RM:Word;
-begin
-  isDPMI:=false;
-  rm:=get_run_mode;
-{$ifdef Debug}
-  case rm of
-    0 : writeln('unknown mode');
-    1 : writeln('RAW mode');
-    2 : writeln('XMS detected');
-    3 : writeln('VCPI detected');
-    4 : writeln('DPMI detected');
-  end; { case }
-{$endif Debug}
-  if rm=4 then
-    isDPMI:=true;
-  if isDPMI then begin
-    seg_write:=allocate_ldt_descriptors(1);
-    seg_read:=allocate_ldt_descriptors(1);
-  end else begin
-    seg_write:=get_DS;
-    seg_read:=get_DS;
-  end;
-end;
-
-procedure DoneVESA;
-begin
-  if isDPMI then begin
-    free_ldt_descriptor(seg_read);
-    free_ldt_descriptor(seg_write);
-  end;
-end;
-
-procedure Switchbank(bank:longint);
-begin
-  with dregs do
-    begin
-       a_bank:=bank;
-       realedx:=bank shl granshift;
-       realcs:=switchcs;
-       realip:=switchip;
-       realebx:=aw_window;
-       realss:=0;
-       realsp:=0;
-    end;
-  asm
-     leal   _DREGS,%edi
-     xorl   %ecx,%ecx
-     movl   %ecx,%ebx
-     movw   $0x0301,%ax
-     int    $0x31
-  end;
-  if not same_window then
-   with dregs do
-    begin
-       realedx:=bank shl granshift;
-       realcs:=switchcs;
-       realip:=switchip;
-       realebx:=ar_window;
-       realss:=0;
-       realsp:=0;
-       asm
-         leal   _DREGS,%edi
-         xorl   %ecx,%ecx
-         movl   %ecx,%ebx
-         movw   $0x0301,%ax
-         int    $0x31
-       end;
-  end;
-end;
-
-
-{
-  $Log$
-  Revision 1.3  1999-05-04 17:17:32  florian
-    * some explicit language removed
-
-  Revision 1.2  1998/12/21 14:06:03  pierre
-  * var declaration was missing ??
-
-  Revision 1.1  1998/12/21 13:07:03  peter
-    * use -FE
-
-  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
-    * 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
-
-  Revision 1.4  1998/11/18 12:12:54  pierre
-   * WinShift was wrong for LinearBuffer
-
-  Revision 1.3  1998/11/18 09:31:35  pierre
-    * changed color scheme
-      all colors are in RGB format if more than 256 colors
-    + added 24 and 32 bits per pixel mode
-      (compile with -dDEBUG)
-      24 bit mode with banked still as problems on pixels across
-      the bank boundary, but works in LinearFrameBufferMode
-      Look at install/demo/nmandel.pp
-
-  Revision 1.2  1998/10/09 10:26:36  peter
-    * rename result -> result_
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.6  1998/01/26 11:58:09  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/ibm.ppi
-  description:
-  ----------------------------
-  revision 1.5
-  date: 1997/12/11 11:26:54;  author: pierre;  state: Exp;  lines: +165 -165
-     *  forgot dtou !!
-  ----------------------------
-  revision 1.4
-  date: 1997/12/11 11:24:19;  author: pierre;  state: Exp;  lines: +165 -165
-      * bug in string at line 103 corrected
-  ----------------------------
-  revision 1.3
-  date: 1997/12/04 08:52:35;  author: florian;  state: Exp;  lines: +4 -4
-  + vesa mode 1280x1024x256 added
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:30;  author: michael;  state: Exp;  lines: +13 -1
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/image.ppi

@@ -1,236 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-procedure GetImage(x1,y1,x2,y2 : integer;var BitMap);
-
-var
-  i,linesize,target  : longint;
-  ofs1,ofs2,bank1,bank2,diff : longint;
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-  begin
-    _graphresult:=grnoinitgraph;
-    exit;
-  end;
-
-x1:=x1+aktviewport.x1;
-y1:=y1+aktviewport.y1;
-x2:=x2+aktviewport.x1;
-y2:=y2+aktviewport.y1;
-
-if (x1>_maxx) or (y1>_maxy) or (x2<0) or (y2<0) then exit;
-
-target:=longint(@bitmap)+4;
-pinteger(@bitmap)^:=x2-x1+1;
-pinteger(@bitmap+2)^:=y2-y1+1;
-linesize:=(x2-x1+1)*BytesPerPixel;
-
-for i:=y1 to y2 do
-  begin
-    ofs1:=Y_ARRAY[i]+X_ARRAY[x1];
-    ofs2:=Y_ARRAY[i]+X_ARRAY[x2];
-    bank1:=ofs1 shr WinShift;
-    bank2:=ofs2 shr WinShift;
-    if bank1 <> A_BANK then
-      begin
-        Switchbank(bank1);
-      end;
-    if bank1=bank2
-      then ScreenToMem(ofs1 and WinLoMask,target,linesize)
-      else begin
-        diff:=(bank2 shl winshift)-ofs2;
-        ScreenToMem(ofs1 and WinLoMask,target,diff-BytesPerPixel);
-        Switchbank(bank2);
-        ScreenToMem((ofs1+diff) and WinLoMask,target+diff,linesize-diff);
-      end;
-    target:=target+linesize;
-  end;
-end;
-
-procedure PutImage(x,y : integer;var BitMap;BitBlt : word);
-
-      var
-         height,width : integer;
-         diff         : integer;
-         increment,i  : longint;
-         source,o1,o2 : longint;
-         offset       : longint;
-         viewport     : viewporttype;
-      begin
-         _graphresult:=grOk;
-         if not isgraphmode then
-           begin
-              _graphresult:=grnoinitgraph;
-              exit;
-           end;
-
-         source:=longint(@bitmap)+4;
-         Width:=pinteger(@bitmap)^;
-         Increment:=longint(Width);
-         height:=pinteger(@bitmap+2)^;
-         { wenn ausserhalb des Screens Procedur verlassen }
-         x:=x+aktviewport.x1;
-         y:=y+aktviewport.y1;
-
-         if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
-         if (x > viewport.x2 ) or
-             (y > viewport.y2 ) or
-              (x+Increment < viewport.x1) or
-               (y+height < viewport.y1) then exit;
-
-           { Clip oben }
-           if y < viewport.y1 then
-             begin
-               diff:=viewport.y1-y;
-               height:=height-diff;
-               source:=source+Increment*diff;
-               y:=viewport.y1;
-             end;
-           { Clip unten }
-
-           if y+height > viewport.y2 then
-               height:=viewport.y2-y;
-
-           { Clip links }
-           if x < viewport.x1 then
-             begin
-               diff:=viewport.x1-x;
-               Width:=Increment-diff;
-               source:=source+diff;
-               x:=viewport.x1;
-             end;
-
-           { clip rechts }
-           if x+width > viewport.x2 then
-             begin
-               diff:=x+width-viewport.x2;
-               Width:=Increment-diff;
-             end;
-
- Increment:=Increment*BytesPerPixel;
- Width:=Width*BytesPerPixel;
- for i:=y to y+height-1 do
-   begin
-     offset:=Y_ARRAY[i] + X_ARRAY[x];
-     o1:=offset shr winshift;
-     o2:=( offset + width ) shr winshift;
-     if o1 <> A_BANK then
-       begin
-         Switchbank(o1);
-       end;
-     if o1 = o2 then
-     begin
-       case bitblt of
-         normalput : MemToScreen (source,offset and WinLoMask,width);
-         andput    : MemAndScreen(source,offset and WinLoMask,width);
-         orput     : MemOrScreen (source,offset and WinLoMask,width);
-         xorput    : MemXorScreen(source,offset and WinLoMask,width);
-         notput    : MemNotScreen(source,offset and WinLoMask,width);
-       end;
-     end else begin
-     { Bankswitching }
-       diff:=((o2 shl winshift)-offset);
-       case bitblt of
-         normalput : begin
-                      MemToScreen (source,offset and WinLoMask,diff-BytesPerPixel);
-                      Switchbank(o2);
-                      MemToScreen (source+diff,(offset+diff) and WinLoMask,width-diff);
-                     end;
-         andput    : begin
-                      MemAndScreen (source,offset and WinLoMask,diff-BytesPerPixel);
-                      Switchbank(o2);
-                      MemAndScreen (source+diff,(offset+diff) and WinLoMask,width-diff);
-                     end;
-         orput     : begin
-                      MemOrScreen (source,offset and WinLoMask,diff-BytesPerPixel);
-                      Switchbank(o2);
-                      MemOrScreen (source++diff,(offset+diff) and WinLoMask,width-diff);
-                     end;
-         xorput    : begin
-                      MemXorScreen(source,offset and WinLoMask,diff-BytesPerPixel);
-                      Switchbank(o2);
-                      MemXorScreen(source+diff,(offset+diff) and WinLoMask,width-diff);
-                     end;
-         notput    : begin
-                      MemNotScreen(source,offset and WinLoMask,diff-BytesPerPixel);
-                      Switchbank(o2);
-                      MemNotScreen(source+diff,(offset+diff) and WinLoMask,width-diff);
-                     end;
-       end; { case }
-     end; { else }
-     source:=source+Increment;
- end; { for i }
- { clear the mmx state }
- if is_mmx_cpu then
-   emms;
-end;
-
-
-    function ImageSize(x1,y1,x2,y2 : integer) : longint;
-
-      begin
-         _graphresult:=grOk;
-         ImageSize:=(x2-x1+1)*(y2-y1+1)*BytesPerPixel+4;
-         { 4 bytes for Height and width in words at the beginning }
-      end;
-
-
-
-{
-  $Log$
-  Revision 1.1  1998-12-21 13:07:03  peter
-    * use -FE
-
-  Revision 1.2  1998/11/18 09:31:36  pierre
-    * changed color scheme
-      all colors are in RGB format if more than 256 colors
-    + added 24 and 32 bits per pixel mode
-      (compile with -dDEBUG)
-      24 bit mode with banked still as problems on pixels across
-      the bank boundary, but works in LinearFrameBufferMode
-      Look at install/demo/nmandel.pp
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.5  1998/03/03 22:48:42  florian
-    + graph.drawpoly procedure
-    + putimage with xorput uses mmx if available
-
-  Revision 1.4  1998/01/26 11:58:14  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/image.ppi
-  description:
-  ----------------------------
-  revision 1.3
-  date: 1997/12/19 11:47:08;  author: florian;  state: Exp;  lines: +3 -3
-  *** empty log message ***
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:30;  author: michael;  state: Exp;  lines: +13 -1
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/line.ppi

@@ -1,702 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-procedure DrawPattern(x1,x2,y:integer);
-begin
-  if BytesPerPixel=3 then
-   { big problem one point can be across boundary !! }
-   begin
-     if ((Y_Array[y]+X_array[x1]) and winlomask)+3 > winlomask then
-       begin
-         { special point !! }
-         { not implemented yet !! }
-         inc(x1);
-       end;
-   end;
-
-  asm
-    movswl x1,%ebx
-    movswl x2,%ecx
-    movswl y,%edx
-    subl   %ebx,%ecx
-    incl   %ecx
-    movl   _X_ARRAY(,%ebx,4),%eax
-    movl   _Y_ARRAY(,%edx,4),%edi       // { Offset in %edi }
-    addl   %eax,%edi
-    andl   _WINLOMASK,%edi
-    andl   $0x7,%edx                    // { y and $7                }
-    shll   $0x5,%edx                    // { y * 8 * sizeof(longint) }
-    leal   _PATTERNBUFFER,%esi          //
-    addl   %edx,%esi                    // { Offset in Patternbuffer }
-    movl   $0x7,%edx
-    addl   _WBUFFER,%edi
-    pushw  %es
-    movw   _SEG_WRITE,%ax
-    movw   %ax,%es
-    testw  $1,_AKTWRITEMODE
-    jnz    .Lpl_xord
- .Lpl_movd:
-    cmpw   $2,_BYTESPERPIXEL
-    je     .Lpl_movdw
-    jb     .Lpl_movdb
-
-{$ifdef TEST_24BPP}
-    cmpw   $3,_BYTESPERPIXEL
-    je     .Lpl_movd24BPP
- .align 4,0x90
- .Lpl_movd32BPP:
-    andl   $7,%ebx
-    movl   (%esi,%ebx,4),%eax
-    movl   %eax,%es:(%edi)
-    addl   $4,%edi
-    { should not be necessary !! }
-    cmpl   _WINLOMASKMINUSPIXELSIZE,%edi
-    ja     .Lpl_d_exit
-    incl   %ebx
-    decl   %ecx
-    jnz    .Lpl_movd32BPP
-    jz     .Lpl_d_exit
- .align 4,0x90
- .Lpl_movd24BPP:
-    andl   $7,%ebx
-    movl   (%esi,%ebx,4),%eax
-    andl   $0x00FFFFFF,%eax
-    movl   %es:(%edi),%edx
-    andl   $0xFF000000,%edx
-    orl    %edx,%eax
-    movl   %eax,%es:(%edi)
-    addl   $3,%edi
-    cmpl   _WINLOMASKMINUSPIXELSIZE,%edi
-    ja     .Lpl_d_exit
-    incl   %ebx
-    decl   %ecx
-    jnz    .Lpl_movd24BPP
-    jz     .Lpl_d_exit
-{$endif TEST_24BPP}
- .align 4,0x90
- .Lpl_movdb:
-    andl   %edx,%ebx
-    movb   (%esi,%ebx,4),%al
-    movb   %al,%es:(%edi)
-    incl   %edi
-    incl   %ebx
-    decl   %ecx
-    jnz    .Lpl_movdb
-    jz     .Lpl_d_exit
-
- .align 4,0x90
- .Lpl_movdw:
-    andl   %edx,%ebx
-    movw   (%esi,%ebx,4),%ax
-    movw   %ax,%es:(%edi)
-    addl   $2,%edi
-    incl   %ebx
-    decl   %ecx
-    jnz    .Lpl_movdw
-    jz     .Lpl_d_exit
- .Lpl_xord:
-    cmpw   $2,_BYTESPERPIXEL
-    je     .Lpl_xordw
-    jb     .Lpl_xordb
-
-{$ifdef TEST_24BPP}
-    cmpw   $3,_BYTESPERPIXEL
-    je     .Lpl_xord24BPP
- .align 4,0x90
- .Lpl_xord32BPP:
-    andl   $7,%ebx
-    movl   (%esi,%ebx,4),%eax
-    movl   %es:(%edi),%edx
-    xorl   %edx,%eax
-    movl   %eax,%es:(%edi)
-    addl   $4,%edi
-    cmpl   _WINLOMASKMINUSPIXELSIZE,%edi
-    ja     .Lpl_d_exit
-    incl   %ebx
-    decl   %ecx
-    jnz    .Lpl_xord32BPP
-    jz     .Lpl_d_exit
- .align 4,0x90
- .Lpl_xord24BPP:
-    andl   $7,%ebx
-    movl   (%esi,%ebx,4),%eax
-    andl   $0x00FFFFFF,%eax
-    movl   %es:(%edi),%edx
-    xorl   %edx,%eax
-    movl   %eax,%es:(%edi)
-    addl   $3,%edi
-    cmpl   _WINLOMASKMINUSPIXELSIZE,%edi
-    ja     .Lpl_d_exit
-    incl   %ebx
-    decl   %ecx
-    jnz    .Lpl_xord24BPP
-    jz     .Lpl_d_exit
-{$endif TEST_24BPP}
- .align 4,0x90
- .Lpl_xordb:
-    andl   %edx,%ebx
-    movb   (%esi,%ebx,4),%al
-    xorb   %al,%es:(%edi)
-    incl   %edi
-    incl   %ebx
-    decl   %ecx
-    jnz    .Lpl_xordb
-    jz     .Lpl_d_exit
- .align 4,0x90
- .Lpl_xordw:
-    andl   %edx,%ebx
-    movw   (%esi,%ebx,4),%ax
-    xorw   %ax,%es:(%edi)
-    addl   $2,%edi
-    incl   %ebx
-    decl   %ecx
-    jnz    .Lpl_xordw
- .Lpl_d_exit:
-    popw   %es
- .Lpl_exit:
- end;
-end;
-
-procedure PatternLine(x1,x2,y:integer);
-var bank1,bank2    : longint;
-    ofs1,ofs2      : longint;
-    diff           : integer;
-    viewport       : ViewPortType;
-begin
-  x1:= x1 + aktviewport.x1 ;
-  y:=  y +  aktviewport.y1 ;
-  x2:= x2 + aktviewport.x1 ;
-
-  if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
-  if (y < viewport.y1) or (y > viewport.y2) then exit;
-  if x1 > x2 then begin diff:=x2; x2:=x1; x1:=diff; end;
-  if (x1> viewport.x2) or (x2< viewport.x1) then exit;
-  if x1 < viewport.x1 then x1:=viewport.x1;
-  if x2 > viewport.x2 then x2:=viewport.x2;
-  ofs1:= Y_ARRAY[y];
-  ofs2:= ofs1 + X_ARRAY[x2];
-  ofs1:= ofs1 + X_ARRAY[x1];
-  bank1:=ofs1 shr winshift;
-  bank2:=ofs2 shr winshift;
-  if bank1 <> A_BANK then
-  begin
-    Switchbank(bank1);
-  end;
-  if bank1 <> bank2 then begin
-     diff:=(((bank2 shl winshift)-ofs1) div BytesPerPixel)+x1;
-     DrawPattern(x1,diff-1,y);
-     Switchbank(bank2);
-     DrawPattern(diff,x2,y);
-  end else DrawPattern(x1,x2,y);
-end;
-
-
-procedure HorizontalLine(x1,x2,y:integer);
-{ without bankswitching }
-{ nothing for 24BPP yet (PM) }
-{$ifdef TEST_24BPP}
-var i,j : longint;
-{$endif TEST_24BPP}
-begin
-{$ifdef TEST_24BPP}
-  if BytesPerPixel=3 then
-   { big problem one point can be across boundary !! }
-   begin
-     if ((Y_Array[y]+X_array[x1]) and winlomask)+3 > winlomask then
-       begin
-         { special point !! }
-         { not implemented yet !! }
-         inc(x1);
-       end;
-     j:=Y_array[y]+X_array[x1];
-     for i:=x1 to x2 do
-       begin
-          if aktwritemode=normalput then
-            pixel(j)
-          else
-            begin
-              putpixeli(i,y,aktcolor xor getpixel(i,y));
-            end;
-         inc(j,3);
-       end;
-      exit;
-   end;
-{$endif TEST_24BPP}
-
-  asm
-    movw   %es,%dx
-    movzwl y,%ebx
-    movzwl x1,%eax
-    movzwl x2,%ecx
-    incl   %ecx
-    movl   _X_ARRAY(,%eax,4),%eax
-    movl   _X_ARRAY(,%ecx,4),%ecx
-    movl   _Y_ARRAY(,%ebx,4),%edi       // { Offset in %edi }
-    subl   %eax,%ecx                    // { Counter }
-    addl   %eax,%edi
-    andl   _WINLOMASK,%edi
-    movl   _AKTCOLOR,%eax
-    movzwl _AKTWRITEMODE,%esi
-    addl   _WBUFFER,%edi
-    movw   _SEG_WRITE,%bx
-    movw   %bx,%es
-    testl  %esi,%esi                    // { Writemode ?       }
-    jnz    .Lhl_xor
-    shrl   %ecx
-    jnc    .L_movw
-    stosb
- .L_movw:
-    shrl   %ecx
-    jnc    .L_movd
-    stosw
- .L_movd:
-    rep
-    stosl
-    jmp    .Lhl_exit
-
- .Lhl_xor:   // -------------------------------------------------
-
-    movl   $4,%esi
-    shrl   %ecx
-    jnc    .Lhl_xorw
-    xorb   %al,%es:(%edi)
-    incl   %edi
- .Lhl_xorw:
-    shrl   %ecx
-    jnc    .Lhl_xord
-    xorw   %ax,%es:(%edi)
-    addl   $2,%edi
- .Lhl_xord:
-    jecxz  .Lhl_exit
- .align 4,0x90
- .Lhl_xorloop:
-    xorl   %eax,%es:(%edi)
-    addl   %esi,%edi
-    decl   %ecx
-    jnz    .Lhl_xorloop
- .Lhl_exit:
-    movw   %dx,%es
- end;
-end;
-
-procedure Line(x1,y1,x2,y2: integer);
-var dx,dy,d        : longint;
-    i,j            : integer;
-    ofs,ofs2       : longint;
-    i1,i2,ix       : longint;
-    x,y            : Integer;
-    flag,dontcheck : Boolean;
-    viewport       : ViewPortType;
-begin
-
-  x1:= x1 + aktviewport.x1 ;
-  y1:= y1 + aktviewport.y1 ;
-  x2:= x2 + aktviewport.x1 ;
-  y2:= y2 + aktviewport.y1 ;
-  if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
-
-  { ************ Horizontalline ************** }
-
-  if y1=y2 then begin
-    if x1>x2 then begin d:=x1; x1:=x2; x2:=d; end;
-    if aktlineinfo.thickness=3 then y1:=y1-1;
-    i:=0;
-    if x1 < viewport.x1 then x1:=viewport.x1;
-    if x2 > viewport.x2 then x2:=viewport.x2;
-    if (y1 > viewport.y2) or (x1 > x2 ) then exit;
-    repeat
-      if (y1 >= viewport.y1) and (y1 <=viewport.y2)
-      then begin
-        ofs:= Y_ARRAY[y1];
-        ofs2:=ofs+X_ARRAY[x2];
-        ofs:= ofs+X_ARRAY[x1];
-        i1:=ofs shr winshift; i2:=ofs2 shr winshift;
-        if i1 <> a_bank then
-          begin
-            switchbank(i1);
-          end;
-        if i1=i2 then Horizontalline(x1,x2,y1)
-          else
-            begin
-            dx:=((i2 shl winshift)-ofs) div BytesPerPixel;
-            horizontalline(x1,x1+dx-1,y1);
-            Switchbank(i2);
-            horizontalline(dx+x1,x2,y1);
-          end;
-      end;
-      i:=i+1; y1:=y1+1;
-    until i=aktlineinfo.thickness;
-    exit;
-  end;
-
-  { *********** End Horizontalline *********** }
-
-  if y1 > y2 then begin
-    x:=x1; x1:=x2; x2:=x;
-    y:=y1; y1:=y2; y2:=y;
-  end;
-
-  { ************** Verticalline ************** }
-
-  if x1=x2 then
-  begin
-    if y1 < viewport.y1 then y1:=viewport.y1;
-    if y2 > viewport.y2 then y2:=viewport.y2;
-    if ( y1 > y2) or (x1 < viewport.x1) or (x1 > viewport.x2) then exit;
-    ofs:= Y_Array[y2]+X_Array[x1];
-    ofs2:=Y_Array[y1]+X_Array[x1];
-    while ofs >= ofs2 do begin
-       pixel(ofs);
-       if aktlineinfo.thickness=3 then begin
-         if x1>viewport.x1 then pixel(ofs-1);
-         if x1<viewport.x2 then pixel(ofs+1);
-       end;
-       ofs:=ofs-BytesPerLine;
-    end;
-    exit;
-  end;
-
-  { ************ End Verticalline ************ }
-
-  dy:=y2-y1;
-  dx:=abs(x2-x1);
-  if x1>x2 then ix:=-1 else ix:= 1;
-  if dx<dy then begin d:=dx; dx:=dy; dy:=d; Flag:=true end else Flag:=false;
-  i1:=dy shl 1;
-   d:=i1 - dx;
-  i2:=(dx shl 1)-i1;
-
-  { for 24BPP use slow checking code,easy and poor implementation ! PM }
-dontcheck:=(y1>=viewport.y1) and (y2<=viewport.y2) and
-           (x1>=viewport.x1) and (x1<=viewport.x2) and
-           (x2>=viewport.x1) and (x2<=viewport.x2) and
-           (BytesPerPixel<3);
-
-if aktlineinfo.thickness=3 then
-
-    { *************************************** }
-    { **** Thickness=3 with rangechecking *** }
-    { *************************************** }
-
-begin
-  repeat
-    for i:=y1-1 to y1+1 do
-      for j:=x1-1 to x1+1 do
-      if (i>=viewport.y1) and (j>=viewport.x1) and
-         (j<=viewport.x2) and (i<=viewport.y2) then pixel(X_ARRAY[j]+Y_ARRAY[i]);
-    if d < 0
-    then begin
-      if Flag then y1:=y1+1 else x1:=x1+ix;
-      d:=d+i1;
-    end
-    else begin
-      d:=d-i2; x1:=x1+ix; y1:=y1+1;
-    end;
-  dx:=dx-1;
-  until ( dx=0 ) or ( y1 > viewport.y2 )
-end else
-  if dontcheck then
-
-    { *************************************** }
-    { ** Thickness=1 without rangechecking ** }
-    { *************************************** }
-
-    begin
-    asm
-     pushw  %gs
-     movw   _SEG_WRITE,%ax
-     movw   %ax,%gs                   // { ScreenSelector }
-
-  // selfmodify to speedup Code
-     xorl   %ebx,%ebx
-     movl   ix,%eax
-     testl  %eax,%eax
-     jns    line1_inc
-     movl   $0x08,%ebx
-   line1_inc:
-     addl   $0x43,%ebx                // Opcode incl %ebx
-     movb   %bl,inc_dec1
-     movb   %bl,inc_dec2
-     movl   i1,%eax
-     movl   %eax,i1long1
-     movl   %eax,i1long2
-     movl   i2,%eax
-     movl   %eax,i2long
-     movl   _WBUFFER,%eax
-     movl   %eax,.Lwbuffer
-     movzbl _WINSHIFT,%eax
-     movb   %al,.Lwinshift
-     movl   _WINLOMASK,%eax
-     movl   %eax,.Lwinlomask
-     movb   $0x90,operandprefix       // Opcade nop
-     testw  $1,_AKTWRITEMODE
-     jnz    line1XOR
-     movb   $0x88,linemode            // Opcode movb
-     jmp    linedepth
-    line1XOR:
-      movb   $0x30,linemode           // Opcode xorb
-    linedepth:
-      testw  $1,_BYTESPERPIXEL
-      jnz    is_byte
-      movb   $0x66,operandprefix      // Prefix for operandsize
-      incb   linemode                 // incr. for wordacces
-    is_byte:
-      movl   dx,%ecx
-      movl   _AKTCOLOR,%eax
-      movzwl y1,%esi
-      movzwl x1,%ebx
-      movswl d,%edx
-   //----------------//
-   //  Linemainloop  //
-   //----------------//
-.align 4,0x90
-line1_loop:
-      pushl  %ecx
-      pushl  %eax
-      movl   _Y_ARRAY(,%esi,4),%edi
-      addl   _X_ARRAY(,%ebx,4),%edi
-      movl   %edi,%eax
-      .byte 0x81,0xe7                 // andl ..,%edi
-    .Lwinlomask:                        //
-      .long 0x88888888                // _WINLOMASK
-      .byte 0xc1,0xe8                 // shrl ..,%eax
-    .Lwinshift:                         //
-      .byte 0x88                      // _WINSHIFT
-
-      pushl  %edi
-      cmpl   _A_BANK,%eax
-      je     line1_dontswitch
-
-      pushl  %ebx
-      pushl  %edx
-      pushl  %esi
-      pushl  %eax
-      movl   _BANKSWITCHPTR,%eax
-      call   %eax
-      popl   %esi
-      popl   %edx
-      popl   %ebx
-.align 4,0x90
-line1_dontswitch:
-      popl   %edi
-      popl   %eax
-      popl   %ecx
-     .byte   0x81,0xc7                 // addl ..,%edi
-    .Lwbuffer:                           //
-     .long   0x88888888                // _WBUFFER
-    operandprefix:
-     .byte   0x90                      // Operandprefix (nop for Byte,$66 for Word)
-     .byte   0x65                      // Segmentprefix %gs:
-    linemode:
-     .byte   0x88,0x07                 // modified OpCode<movb,xorb...>,%edi
-      decl   %ecx
-      jz     line1_end
-      testl  %edx,%edx                 // { if d < 0 then }
-      jns    is_positive
-      testb  $1,flag                   // { if flag then }
-      jz     no_flag
-      incl   %esi                      // { y1:=y1+1  }
-     .byte   0x81,0xc2
-    i1long1:
-     .long   0x88888888                // { d:=d+i1   }
-      jmp    line1_loop
-.align 4,0x90
-no_flag:
-    inc_dec1:
-     .byte   0x88                      // { x1:=x1+ix }
-     .byte   0x81,0xc2
-    i1long2:
-     .long   0x88888888                // { d:=d+i1   }
-      jmp    line1_loop
-.align 4,0x90
-is_positive:
-    inc_dec2:
-     .byte   0x88                      // { x1:=x1+ix }
-      incl   %esi                      // { y1:=y1+1  }
-     .byte   0x81,0xea
-    i2long:
-     .long   0x88888888                // { d:=d-i2   }
-      jmp    line1_loop
-line1_end:
-      popw   %gs
-    end;
-  end else
-
-    { *************************************** }
-    { **** Thickness=1 with rangechecking *** }
-    { *************************************** }
-
-    begin
-    repeat
-      if y1 > viewport.y2 then exit;
-      if (y1>=viewport.y1) and (x1>=viewport.x1) and
-         (x1<=viewport.x2) then pixel(Y_ARRAY[y1]+X_ARRAY[x1]);
-      if d < 0
-      then begin
-        if Flag then y1:=y1+1 else x1:=x1+ix;
-        d:=d+i1;
-      end
-      else begin
-        d:=d-i2; x1:=x1+ix; y1:=y1+1;
-      end;
-    dx:=dx-1;
-    until  dx=0 ;
-  end;
-end;
-
-procedure MoveTo(x,y : integer);
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-     begin
-       _graphresult:=grnoinitgraph;
-       exit;
-     end;
-  curx:=x;
-  cury:=y;
-end;
-
-procedure MoveRel(dx,dy : integer);
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-     begin
-       _graphresult:=grnoinitgraph;
-       exit;
-     end;
-  curx:=curx+dx;
-  cury:=cury+dy;
-end;
-
-procedure LineTo(x,y : integer);
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-     begin
-       _graphresult:=grnoinitgraph;
-       exit;
-     end;
-  Line(curx,cury,x,y);
-  MoveTo(x,y);
-end;
-
-procedure LineRel(dx,dy : integer);
-begin
-  _graphresult:=grOk;
-  if not isgraphmode then
-     begin
-       _graphresult:=grnoinitgraph;
-     exit;
-   end;
-  Line(curx,cury,curx+dx,cury+dy);
-  curx:=curx+dx;
-  cury:=cury+dy;
-end;
-
-procedure SetLineStyle(LineStyle : word;pattern : word;thickness : word);
-const
-  linepatterns : array[0..3] of word =
-  ($ffff,$aaaa,$fafa,$ffff);
-
-begin
-  if (linestyle<0) or (linestyle>4) or
-     ((thickness<>1) and (thickness<>3)) then
-     begin
-       _graphresult:=grerror;
-       exit;
-     end;
-     aktlineinfo.linestyle:=linestyle;
-     if aktlineinfo.linestyle=UserBitLn then
-       aktlineinfo.pattern:=pattern
-     else
-       aktlineinfo.pattern:=linepatterns[aktlineinfo.linestyle];
-     aktlineinfo.thickness:=thickness;
-end;
-
-    procedure DrawPoly(points : word;var polypoints);
-
-      type
-         ppointtype = ^pointtype;
-
-      var
-         i : longint;
-
-      begin
-         _graphresult:=grOk;
-         if not isgraphmode then
-           begin
-              _graphresult:=grnoinitgraph;
-              exit;
-           end;
-         line(ppointtype(@polypoints)[points-1].x,
-              ppointtype(@polypoints)[points-1].y,
-              ppointtype(@polypoints)[0].x,
-              ppointtype(@polypoints)[0].y);
-         for i:=0 to points-2 do
-           line(ppointtype(@polypoints)[i].x,
-                ppointtype(@polypoints)[i].y,
-                ppointtype(@polypoints)[i+1].x,
-                ppointtype(@polypoints)[i+1].y);
-      end;
-
-{
-  $Log$
-  Revision 1.1  1998-12-21 13:07:03  peter
-    * use -FE
-
-  Revision 1.4  1998/11/18 13:23:35  pierre
-    * floodfill got into an infinite loop !!
-    + added partial support for fillpoly
-      (still wrong if the polygon is not convex)
-      Simply make a floodfill from the barycenter !
-    * some 24BPP code changed (still does not work for my S3VBE program !)
-
-  Revision 1.3  1998/11/18 09:31:37  pierre
-    * changed color scheme
-      all colors are in RGB format if more than 256 colors
-    + added 24 and 32 bits per pixel mode
-      (compile with -dDEBUG)
-      24 bit mode with banked still as problems on pixels across
-      the bank boundary, but works in LinearFrameBufferMode
-      Look at install/demo/nmandel.pp
-
-  Revision 1.2  1998/09/02 08:16:00  pierre
-    * local asm labels with global variable names removed !!
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.4  1998/03/03 22:48:43  florian
-    + graph.drawpoly procedure
-    + putimage with xorput uses mmx if available
-
-  Revision 1.3  1998/01/26 11:58:18  michael
-  + Added log at the end
-
-  Working file: rtl/dos/ppi/line.ppi
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:31;  author: michael;  state: Exp;  lines: +14 -0
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/modes.ppi

@@ -1,98 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-const
-{$ifndef TEST_24BPP}
-   VESANumber=13;
-{$else TEST_24BPP}
-   VESANumber=17;
-{$endif TEST_24BPP}
-      VESAModes : Array[0..VESANumber-1] of word=
-      ( $100    {   640x400x256 }
-       ,$101    {   640x480x256 }
-       ,$110    {   640x480x32K }
-       ,$111    {   640x480x64k }
-       ,$103    {   800x600x256 }
-       ,$113    {   800x600x32k }
-       ,$114    {   800x600x64k }
-       ,$105    {  1024x768x256 }
-       ,$116    {  1024x768x32k }
-       ,$117    {  1024x768x64k }
-       ,$107    { 1280x1024x256 }
-       ,$119    { 1280x1024x32K }
-       ,$11A    { 1280x1024x64K }
-{$ifdef TEST_24BPP}
-       ,$112    {   640x480x16M }
-       ,$115    {   800x600x16M }
-       ,$118    {  1024x768x16M }
-       ,$11B    { 1280x1024x16M }
-{$endif TEST_24BPP}
-       );
-
-
-{
-  $Log$
-  Revision 1.1  1998-12-21 13:07:04  peter
-    * use -FE
-
-  Revision 1.4  1998/11/19 15:09:39  pierre
-    * several bugfixes for sector/ellipse/floodfill
-    + graphic driver mode const in interface G800x600x256...
-    + added backput mode as in linux graph.pp
-      (clears the background of textoutput)
-
-  Revision 1.3  1998/11/18 09:34:36  pierre
-   * wrong VesaNumber with 24 bit modes
-
-  Revision 1.2  1998/11/18 09:31:38  pierre
-    * changed color scheme
-      all colors are in RGB format if more than 256 colors
-    + added 24 and 32 bits per pixel mode
-      (compile with -dDEBUG)
-      24 bit mode with banked still as problems on pixels across
-      the bank boundary, but works in LinearFrameBufferMode
-      Look at install/demo/nmandel.pp
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.5  1998/01/26 11:58:22  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/modes.ppi
-  description:
-  ----------------------------
-  revision 1.4
-  date: 1997/12/04 08:52:35;  author: florian;  state: Exp;  lines: +14 -13
-  + vesa mode 1280x1024x256 added
-  ----------------------------
-  revision 1.3
-  date: 1997/12/03 15:24:20;  author: florian;  state: Exp;  lines: +2 -2
-  Graph.SetGraphMode for DOS added
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:31;  author: michael;  state: Exp;  lines: +14 -0
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/move.ppi

@@ -1,289 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-procedure MoveLong(selector:word;dst:pointer;cnt:longint);
-begin
-  asm
-    movw    %fs,%dx
-    movw    selector,%ax
-    movw    %ax,%fs
-    xorl    %esi,%esi
-    movl    DST,%edi
-    movl    CNT,%ecx
-    shrl    $0x2,%ecx
-  MOVE1:
-    movl    %fs:(%esi,%ecx,4),%eax
-    movl    %eax,(%edi,%ecx,4)
-    decl    %ecx
-    jns     MOVE1
-    movw    %dx,%fs
-  end;
-end;
-
-procedure ScreenToMem(Source,Target,Counter:longint);
-begin
-  asm
-    pushw  %ds
-    movl   counter,%ecx
-    movl   %ecx,%ebx
-    shrl   $0x2,%ecx
-    andl   $0x3,%ebx
-    movl   target,%edi
-    movl   source,%esi
-    addl   _WBUFFER,%esi
-    movw   _SEG_WRITE,%ax
-    movw   %ax,%ds
-    rep
-    movsl
-    movl   %ebx,%ecx
-    rep
-    movsb
-    popw   %ds
-  end;
-end;
-
-procedure MemToScreen(Source,Target,Counter:longint);
-begin
-  asm
-    movw   %es,%dx
-    movl   counter,%ecx
-    movl   %ecx,%ebx
-    shrl   $0x2,%ecx
-    andl   $0x3,%ebx
-    movl   target,%edi
-    movl   source,%esi
-    addl   _WBUFFER,%edi
-    movw   _SEG_WRITE,%ax
-    movw   %ax,%es
-    rep
-    movsl
-    movl   %ebx,%ecx
-    rep
-    movsb
-    movw   %dx,%es
-  end;
-end;
-
-procedure MemAndScreen(Source,Target,Counter:longint);
-begin
-  asm
-    pushw  %es
-    movl   counter,%ecx
-    movl   %ecx,%ebx
-    shrl   $0x2,%ecx
-    andl   $0x3,%ebx
-    movl   target,%edi
-    movl   source,%esi
-    movl   $4,%edx
-    addl   _WBUFFER,%edi
-    movw   _SEG_WRITE,%ax
-    movw   %ax,%es
-mas_lloop:
-    movl   (%esi),%eax
-    andl   %eax,%es:(%edi)
-    addl   %edx,%edi
-    addl   %edx,%esi
-    decl   %ecx
-    jnz    mas_lloop
-    orl    %ebx,%ecx
-    jz     mas_end
-mas_bloop:
-    movb   (%esi),%al
-    andb   %al,%es:(%edi)
-    incl   %esi
-    incl   %edi
-    decl   %ecx
-    jnz    mas_bloop
-mas_end:
-    popw   %es
-  end;
-end;
-
-procedure MemOrScreen(Source,Target,Counter:longint);
-begin
-  asm
-    pushw  %es
-    movl   counter,%ecx
-    movl   %ecx,%ebx
-    shrl   $0x2,%ecx
-    andl   $0x3,%ebx
-    movl   target,%edi
-    movl   source,%esi
-    addl   _WBUFFER,%edi
-    movw   _SEG_WRITE,%ax
-    movw   %ax,%es
-mos_lloop:
-    movl   (%esi),%eax
-    orl    %eax,%es:(%edi)
-    addl   $4,%edi
-    addl   $4,%esi
-    decl   %ecx
-    jnz    mos_lloop
-    orl    %ebx,%ecx
-    jz     mos_end
-mos_bloop:
-    movb   (%esi),%al
-    orb    %al,%es:(%edi)
-    incl   %esi
-    incl   %edi
-    decl   %ecx
-    jnz    mos_bloop
-mos_end:
-    popw   %es
-  end;
-end;
-
-procedure MemXorScreen(Source,Target,Counter:longint);
-begin
-  if is_mmx_cpu and (counter>50) then
-    asm
-       movw   %es,%dx
-       movl   counter,%ecx
-       movl   %ecx,%ebx
-       shrl   $0x3,%ecx
-       andl   $0x7,%ebx
-       movl   target,%edi
-       movl   source,%esi
-       addl   _WBUFFER,%edi
-       movw   _SEG_WRITE,%ax
-       movw   %ax,%es
-       jecxz  mmxmxs_b
-   mmxmxs_lloop:
-       movq   (%esi),%mm0
-       addl   $8,%esi
-       pxor   %es:(%edi),%mm0
-       movq   %mm0,%es:(%edi)
-       addl   $8,%edi
-       decl   %ecx
-       jnz    mmxmxs_lloop
-   mmxmxs_b:
-       orl    %ebx,%ecx
-       jz     mmxmxs_end
-   mmxmxs_bloop:
-       movb   (%esi),%al
-       xorb   %al,%es:(%edi)
-       incl   %esi
-       incl   %edi
-       decl   %ecx
-       jnz    mmxmxs_bloop
-   mmxmxs_end:
-       movw   %dx,%es
-    end
-  else
-    asm
-      movw   %es,%dx
-      movl   counter,%ecx
-      movl   %ecx,%ebx
-      shrl   $0x2,%ecx
-      andl   $0x3,%ebx
-      movl   target,%edi
-      movl   source,%esi
-      addl   _WBUFFER,%edi
-      movw   _SEG_WRITE,%ax
-      movw   %ax,%es
-      jecxz  mxs_b
-  mxs_lloop:
-      movl   (%esi),%eax
-      xorl   %eax,%es:(%edi)
-      addl   $4,%edi
-      addl   $4,%esi
-      decl   %ecx
-      jnz    mxs_lloop
-  mxs_b:
-      orl    %ebx,%ecx
-      jz     mxs_end
-  mxs_bloop:
-      movb   (%esi),%al
-      xorb   %al,%es:(%edi)
-      incl   %esi
-      incl   %edi
-      decl   %ecx
-      jnz    mxs_bloop
-  mxs_end:
-      movw   %dx,%es
-    end;
-end;
-
-procedure MemNotScreen(Source,Target,Counter:longint);
-begin
-  asm
-    pushw  %es
-    movl   counter,%ecx
-    movl   %ecx,%ebx
-    shrl   $0x2,%ecx
-    andl   $0x3,%ebx
-    movl   target,%edi
-    movl   source,%esi
-    addl   _WBUFFER,%edi
-    movw   _SEG_WRITE,%ax
-    movw   %ax,%es
-    jecxz  mns_b
-mns_lloop:
-    movl   (%esi),%eax
-    notl   %eax
-    movl   %eax,%es:(%edi)
-    addl   $4,%edi
-    addl   $4,%esi
-    decl   %ecx
-    jnz    mns_lloop
-mns_b:
-    orl    %ebx,%ecx
-    jz     mns_end
-mns_bloop:
-    movb   (%esi),%al
-    notb   %al
-    movb   %al,%es:(%edi)
-    incl   %esi
-    incl   %edi
-    decl   %ecx
-    jnz    mns_bloop
-mns_end:
-    popw   %es
-  end;
-end;
-
-
-{
-  $Log$
-  Revision 1.1  1998-12-21 13:07:04  peter
-    * use -FE
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.4  1998/03/03 22:48:43  florian
-    + graph.drawpoly procedure
-    + putimage with xorput uses mmx if available
-
-  Revision 1.3  1998/01/26 11:58:25  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/move.ppi
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:32;  author: michael;  state: Exp;  lines: +14 -0
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/palette.ppi

@@ -1,160 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{ GetRGBPalette,SetRGBPalette,SetAllPalette,GetPalette }
-
-{ Bei saemtlichen Palettefunktionen nicht auf Grafikmodus testen }
-{ funktionieren auch im TextModus }
-
-procedure SetAllPalette(var Palette:PaletteType);
-begin
-  asm
-    movl  Palette,%esi
-    movl  $767,%ecx
-    xorl  %eax,%eax
-    movl  $2,%ebx
-    movw  $0x03c8,%dx
-    outb  %al,%dx
-    incw  %dx
-sp_loop:
-    movb  (%esi,%ebx,1),%al
-    shrb  $2,%al
-    outb  %al,%dx
-    incl  %ebx
-    decl  %ecx
-    jnz   sp_loop
-  end;
-end;
-
-procedure SetRGBPalette(ColorNum,RedValue,GreenValue,BlueValue:byte);
-begin
-  asm
-    movw  $0x3c8,%DX
-    movb  ColorNum,%al
-    outb  %AL,%DX
-    incw  %DX
-    movb  RedValue,%al
-    shrb  $2,%al
-    outb  %AL,%DX
-    movb  GreenValue,%al
-    shrb  $2,%al
-    outb  %AL,%DX
-    movb  BlueValue,%al
-    shrb  $2,%al
-    outb  %AL,%DX
-  end;
-end;
-
-procedure GetRGBPalette(ColorNum:byte; var RedValue,GreenValue,BlueValue:byte);
-begin
-  asm
-    movw  $0x3c7,%DX
-    movb  ColorNum,%ax
-    outb  %AL,%DX
-    addw  $2,%DX
-    xorl  %eax,%eax
-    inb   %DX,%AL
-    shlb  $2,%al
-    movb  %al,RedValue
-    inb   %DX,%AL
-    shlb  $2,%al
-    movb  %al,GreenValue
-    inb   %DX,%AL
-    shlb  $2,%al
-    movb  %al,BlueValue
-  end;
-end;
-
-procedure Getpalette(var Palette:PaletteType);
-begin
-  asm
-    movl   palette,%edi
-    movw   $0,(%edi)
-    cmpl   $2,_BYTESPERPIXEL
-    jge    gp_end
-    movw   $0x100,(%edi)
-    movl   $767,%ecx
-    xorl   %eax,%eax
-    movl   $2,%ebx
-    movl   $0x03c7,%dx
-    outb   %al,%dx
-    addw   $2,%dx
-gp_loop:
-    inb    %dx,%al
-    shlb   $2,%al
-    movb   %al,(%edi,%ebx,1)
-    incl   %ebx
-    decl   %ecx
-    jnz    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.1  1998-12-21 13:07:04  peter
-    * use -FE
-
-  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
-      (compile with -dDEBUG)
-      24 bit mode with banked still as problems on pixels across
-      the bank boundary, but works in LinearFrameBufferMode
-      Look at install/demo/nmandel.pp
-
-  Revision 1.2  1998/07/18 21:29:59  carl
-    * bugfix of palette setting with wrong asm counter
-      (from Ingemar Ragnemalm)
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.3  1998/01/26 11:58:29  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/palette.ppi
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:32;  author: michael;  state: Exp;  lines: +13 -1
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/pixel.ppi

@@ -1,338 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
- { internal put pixel with colour in internal format }
-procedure putpixeli(x,y:integer;colour:longint);
-var viewport:viewporttype;
-begin
-if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
-  asm
-      xorl   %eax,%eax
-      movl   %eax,%ebx
-      movw   x,%bx
-      movw   y,%ax
-      addw   _AKTVIEWPORT,%bx
-      addw   _AKTVIEWPORT+2,%ax
-(*      cmpw   viewport,%bx
-      jl     p_exit                        // wenn x < x1 Ende
-      cmpw   -8(%ebp),%bx
-      jg     p_exit                        // wenn x > x2 Ende
-      cmpw   -10(%ebp),%ax
-      jl     p_exit                        // wenn y < y1 Ende
-      cmpw   -6(%ebp),%ax
-      jg     p_exit                        // wenn y > y2 Ende
-       assumes wrong placement of viewport !!! PM *)
-      lea    viewport,%edx
-      cmpw   (%edx),%bx
-      jl     p_exit                        // wenn x < x1 Ende
-      cmpw   4(%edx),%bx
-      jg     p_exit                        // wenn x > x2 Ende
-      cmpw   2(%edx),%ax
-      jl     p_exit                        // wenn y < y1 Ende
-      cmpw   6(%edx),%ax
-      jg     p_exit                        // wenn y > y2 Ende
-      movl   _Y_ARRAY(,%eax,4),%eax
-      addl   _X_ARRAY(,%ebx,4),%eax
-      movl   %eax,%esi
-      movzbl _WINSHIFT,%ecx                // { offset / winsize        }
-      shrl   %cl,%eax                      //
-      cmpl   _A_BANK,%eax                 // { same bank ?             }
-      je     p_dont_switch                 // { yep                     }
-      pushl  %esi
-      pushl  %eax                          //
-      movl   _BANKSWITCHPTR,%eax           // { switchbank              }
-      call   %eax                          //
-      popl   %esi
-  p_dont_switch:
-      andl   _WINLOMASK,%esi
-      movl   colour,%eax
-      addl   _WBUFFER,%esi
-      movw   _SEG_WRITE,%bx
-      movw   _BYTESPERPIXEL,%cx
-      movw   %bx,%gs
-      cmpl   $2,%ecx
-      je     pp_16BPP
-      jb     pp_8BPP
-{$ifdef TEST_24BPP}
-      cmpl   $3,%ecx
-      je     pp_24BPP
-  pp_32BPP:
-      movl   %eax,%gs:(%esi)
-      jmp    pp_exit
-  pp_24BPP:
-      movl   _WINLOMASKMINUSPIXELSIZE,%edi
-      cmpl   %edi,%esi
-      ja     pp_exit
-      movl   %gs:(%esi),%edi
-      andl   $0xFF000000,%edi
-      andl   $0x00FFFFFF,%eax
-      orl    %edi,%eax
-      movl   %eax,%gs:(%esi)
-      jmp    pp_exit
-{$endif TEST_24BPP}
-  pp_8BPP:
-      movb   %al,%gs:(%esi)
-      jmp    pp_exit
-  pp_16BPP:
-      movw   %ax,%gs:(%esi)
-  pp_exit:
-      (* movw   %dx,%ds use %gs now
-      does not need to be kept constant PM *)
-  p_exit:
-  end;
-end; { proc }
-
-procedure putpixel(x,y:integer;colour:longint);
-begin
-  colour:=convert(colour);
-  putpixeli(x,y,colour);
-end;
-
-procedure pixel(offset:longint);
- { wird nur intern aufgerufen, umrechnung auf Viewport und Range- }
- { checking muessen von aufrufender Routine bereits erledigt sein }
- { Bankswitching wird durchgefuehrt }
- begin
-   asm
-      movl   offset,%eax
-      movl   %eax,%esi
-      movzbl _WINSHIFT,%ecx                // { offset / winsize        }
-      shrl   %cl,%eax                      //
-      cmpl   _A_BANK,%eax                 // { same bank ?             }
-      je     dont_switch                   // { yep                     }
-      pushl  %esi
-      pushl  %eax                          //
-      movl   _BANKSWITCHPTR,%eax           // { switchbank              }
-      call   %eax                          //
-      popl   %esi
- dont_switch:
-      movl   _WINLOMASK,%eax
-      andl   %eax,%esi
-      movl   _AKTCOLOR,%eax
-      movzwl _AKTWRITEMODE,%ecx
-      movw   _BYTESPERPIXEL,%bx
-      addl   _WBUFFER,%esi
-      movw   _SEG_WRITE,%dx
-      movw   %dx,%gs
-      testl  %ecx,%ecx
-      jz     dmove
-      cmpl   $2,%ebx
-      je     dxor16BPP
-      jb     dxor8BPP
-{$ifdef TEST_24BPP}
-      cmpl   $3,%ebx
-      je     dxor24BPP
- dxor32BPP:
-      movl   %gs:(%esi),%edx
-      xorl   %edx,%eax
-      movl   %eax,%gs:(%esi)
-      jmp    pd_exit
- dxor24BPP:
-      movl   _WINLOMASKMINUSPIXELSIZE,%ecx
-      cmpl   %ecx,%esi
-      ja     pd_exit
-      movl   %gs:(%esi),%edx
-      andl   $0x00FFFFFF,%eax
-      xorl   %edx,%eax
-      movl   %eax,%gs:(%esi)
-      jmp    pd_exit
-{$endif TEST_24BPP}
- dxor8BPP:
-      xorb   %al,%gs:(%esi)
-      jmp    pd_exit
- dxor16BPP:
-      xorw   %ax,%gs:(%esi)
-      jmp    pd_exit
- dmove:
-      cmpl   $2,%ebx
-      je    dmove16BPP
-      jb    dmove8BPP
-{$ifdef TEST_24BPP}
-      cmpl   $3,%ebx
-      je     dmove24BPP
- dmove32BPP:
-      movl   %eax,%gs:(%esi)
-      jmp    pd_exit
- dmove24BPP:
-      movl   _WINLOMASKMINUSPIXELSIZE,%ecx
-      cmpl   %ecx,%esi
-      ja     pd_exit
-      movl   %gs:(%esi),%edx
-      andl   $0xFF000000,%edx
-      andl   $0x00FFFFFF,%eax
-      orl    %edx,%eax
-      movl   %eax,%gs:(%esi)
-      jmp    pd_exit
-{$endif TEST_24BPP}
- dmove8BPP:
-      movb   %al,%gs:(%esi)
-      jmp    pd_exit
- dmove16BPP:
-      movw   %ax,%gs:(%esi)
- pd_exit:
-   end;
-end; { proc }
-
-function getpixeli(x,y:integer):longint;
-var viewport:viewporttype;
-    col : longint;
-begin
-if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
-  asm
-      movswl x,%ebx
-      movswl y,%eax
-      addw   _AKTVIEWPORT,%bx
-      addw   _AKTVIEWPORT+2,%ax
-(*      cmpw   viewport,%bx
-      jl     gp_exit                        // wenn x < x1 Ende
-      cmpw   -8(%ebp),%bx
-      jg     gp_exit                        // wenn x > x2 Ende
-      cmpw   -10(%ebp),%ax
-      jl     gp_exit                        // wenn y < y1 Ende
-      cmpw   -6(%ebp),%ax
-      jg     gp_exit                        // wenn y > y2 Ende
-      same error : viewport is assumed to be at -12
-      that depends on alignment settings !! PM *)
-      lea    viewport,%edx
-      cmpw   (%edx),%bx
-      jl     gp_eexit                        // wenn x < x1 Ende
-      cmpw   4(%edx),%bx
-      jg     gp_eexit                        // wenn x > x2 Ende
-      cmpw   2(%edx),%ax
-      jl     gp_eexit                        // wenn y < y1 Ende
-      cmpw   6(%edx),%ax
-      jg     gp_eexit                        // wenn y > y2 Ende
-      movl   _Y_ARRAY(,%eax,4),%eax
-      addl   _X_ARRAY(,%ebx,4),%eax
-      movl   %eax,%esi
-      movzbl _WINSHIFT,%ecx                // { offset / winsize        }
-      shrl   %cl,%eax                      //
-      cmpl   _A_BANK,%eax                  // { same bank ?             }
-      je     g_dont_switch                 // { yep                     }
-      pushl  %esi                          // { save Offset             }
-      pushl  %eax                          //
-      movl   _BANKSWITCHPTR,%eax           // { switchbank              }
-      call   %eax                          //
-      popl   %esi                          // { restore Offset          }
-  g_dont_switch:
-      movl   _WINLOMASK,%eax
-      andl   %eax,%esi
-      xorl   %eax,%eax
-      movzwl _BYTESPERPIXEL,%edx
-      addl   _WBUFFER,%esi
-      movw   _SEG_READ,%bx
-      movw   %bx,%gs
-      cmpl   $2,%edx                       // { 1 or 2 BytesPerPixel ? }
-      je     g_16BPP
-      jb     g_8BPP
-{$ifdef TEST_24BPP}
-      cmpl   $3,%edx                       // { 1 or 2 BytesPerPixel ? }
-      je     g_24BPP
-  g_32BPP:
-      movl   %gs:(%esi),%eax
-      andl   $0x00FFFFFF,%eax
-      jmp    g_Result
-  g_24BPP:
-      movl   _WINLOMASKMINUSPIXELSIZE,%edi
-      cmpl   %edi,%esi
-      ja     g_ErrorResult
-      movl   %gs:(%esi),%eax
-      andl   $0x00FFFFFF,%eax
-      jmp    g_Result
-  g_ErrorResult:
-      movl   $-3,%edi
-      addl   _WINLOMASK,%edi
-      cmpl   %edi,%esi
-      ja     g_nohope
-      decl   %esi
-      movl   %gs:(%esi),%eax
-      shrl   $8,%eax
-      jmp    g_Result
-  g_nohope:
-      movl   $0xABCDEF,%eax
-      jmp    g_Result
-{$endif TEST_24BPP}
-  g_16BPP:
-      movzwl %gs:(%esi),%eax
-      jmp    g_Result
-  g_8BPP:
-      movzbl %gs:(%esi),%eax
-      jmp    g_Result
-  gp_eexit:
-      xorl   %eax,%eax
-      jmp    gp_exit
-  g_Result:
-  gp_exit:
-      movl   %eax,col
-  end;
-  getpixeli:=col;
-end; { proc getpixeli }
-
-function getpixel(x,y:integer):longint;
-begin
-    getpixel:=unconvert(getpixeli(x,y));
-end; { proc }
-
-
-{
-  $Log$
-  Revision 1.1  1998-12-21 13:07:04  peter
-    * use -FE
-
-  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)
-      Simply make a floodfill from the barycenter !
-    * some 24BPP code changed (still does not work for my S3VBE program !)
-
-  Revision 1.3  1998/11/18 09:31:40  pierre
-    * changed color scheme
-      all colors are in RGB format if more than 256 colors
-    + added 24 and 32 bits per pixel mode
-      (compile with -dDEBUG)
-      24 bit mode with banked still as problems on pixels across
-      the bank boundary, but works in LinearFrameBufferMode
-      Look at install/demo/nmandel.pp
-
-  Revision 1.2  1998/10/22 08:22:06  pierre
-   * mandel problem fixed !!
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.3  1998/01/26 11:58:33  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/pixel.ppi
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:32;  author: michael;  state: Exp;  lines: +13 -1
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/stdcolor.ppi

@@ -1,119 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-const stdColors:array[0..255]of longint=
-(
-$00000000,$010000A8,$0200A800,$0300A8A8,
-$04A80000,$05A800A8,$06A85400,$07A8A8A8,
-$08545454,$095454FC,$0A54FC54,$0B54FCFC,
-$0CFC5454,$0DFC54FC,$0EFCFC54,$0FFCFCFC,
-$10000000,$11141414,$12202020,$132C2C2C,
-$14383838,$15444444,$16505050,$17606060,
-$18707070,$19808080,$1A909090,$1BA0A0A0,
-$1CB4B4B4,$1DC8C8C8,$1EE0E0E0,$1FFCFCFC,
-$200000FC,$214000FC,$227C00FC,$23BC00FC,
-$24FC00FC,$25FC00BC,$26FC007C,$27FC0040,
-$28FC0000,$29FC4000,$2AFC7C00,$2BFCBC00,
-$2CFCFC00,$2DBCFC00,$2E7CFC00,$2F40FC00,
-$3000FC00,$3100FC40,$3200FC7C,$3300FCBC,
-$3400FCFC,$3500BCFC,$36007CFC,$370040FC,
-$387C7CFC,$399C7CFC,$3ABC7CFC,$3BDC7CFC,
-$3CFC7CFC,$3DFC7CDC,$3EFC7CBC,$3FFC7C9C,
-$40FC7C7C,$41FC9C7C,$42FCBC7C,$43FCDC7C,
-$44FCFC7C,$45DCFC7C,$46BCFC7C,$479CFC7C,
-$487CFC7C,$497CFC9C,$4A7CFCBC,$4B7CFCDC,
-$4C7CFCFC,$4D7CDCFC,$4E7CBCFC,$4F7C9CFC,
-$50B4B4FC,$51C4B4FC,$52D8B4FC,$53E8B4FC,
-$54FCB4FC,$55FCB4E8,$56FCB4D8,$57FCB4C4,
-$58FCB4B4,$59FCC4B4,$5AFCD8B4,$5BFCE8B4,
-$5CFCFCB4,$5DE8FCB4,$5ED8FCB4,$5FC4FCB4,
-$60B4FCB4,$61B4FCC4,$62B4FCD8,$63B4FCE8,
-$64B4FCFC,$65B4E8FC,$66B4D8FC,$67B4C4FC,
-$68000070,$691C0070,$6A380070,$6B540070,
-$6C700070,$6D700054,$6E700038,$6F70001C,
-$70700000,$71701C00,$72703800,$73705400,
-$74707000,$75547000,$76387000,$771C7000,
-$78007000,$7900701C,$7A007038,$7B007054,
-$7C007070,$7D005470,$7E003870,$7F001C70,
-$80383870,$81443870,$82543870,$83603870,
-$84703870,$85703860,$86703854,$87703844,
-$88703838,$89704438,$8A705438,$8B706038,
-$8C707038,$8D607038,$8E547038,$8F447038,
-$90387038,$91387044,$92387054,$93387060,
-$94387070,$95386070,$96385470,$97384470,
-$98505070,$99585070,$9A605070,$9B685070,
-$9C705070,$9D705068,$9E705060,$9F705058,
-$A0705050,$A1705850,$A2706050,$A3706850,
-$A4707050,$A5687050,$A6607050,$A7587050,
-$A8507050,$A9507058,$AA507060,$AB507068,
-$AC507070,$AD506870,$AE506070,$AF505870,
-$B0000040,$B1100040,$B2200040,$B3300040,
-$B4400040,$B5400030,$B6400020,$B7400010,
-$B8400000,$B9401000,$BA402000,$BB403000,
-$BC404000,$BD304000,$BE204000,$BF104000,
-$C0004000,$C1004010,$C2004020,$C3004030,
-$C4004040,$C5003040,$C6002040,$C7001040,
-$C8202040,$C9282040,$CA302040,$CB382040,
-$CC402040,$CD402038,$CE402030,$CF402028,
-$D0402020,$D1402820,$D2403020,$D3403820,
-$D4404020,$D5384020,$D6304020,$D7284020,
-$D8204020,$D9204028,$DA204030,$DB204038,
-$DC204040,$DD203840,$DE203040,$DF202840,
-$E02C2C40,$E1302C40,$E2342C40,$E33C2C40,
-$E4402C40,$E5402C3C,$E6402C34,$E7402C30,
-$E8402C2C,$E940302C,$EA40342C,$EB403C2C,
-$EC40402C,$ED3C402C,$EE34402C,$EF30402C,
-$F02C402C,$F12C4030,$F22C4034,$F32C403C,
-$F42C4040,$F52C3C40,$F62C3440,$F72C3040,
-$F8000000,$F9000000,$FA000000,$FB000000,
-$FC000000,$FD000000,$FE000000,$FF000000
-);
-
-{
-  $Log$
-  Revision 1.1  1998-12-21 13:07:04  peter
-    * use -FE
-
-  Revision 1.2  1998/11/18 09:31:41  pierre
-    * changed color scheme
-      all colors are in RGB format if more than 256 colors
-    + added 24 and 32 bits per pixel mode
-      (compile with -dDEBUG)
-      24 bit mode with banked still as problems on pixels across
-      the bank boundary, but works in LinearFrameBufferMode
-      Look at install/demo/nmandel.pp
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.3  1998/01/26 11:58:38  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/stdcolor.ppi
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:33;  author: michael;  state: Exp;  lines: +13 -0
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/text.ppi

@@ -1,528 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{***************************************************************************}
-{                               Textausgabe                                 }
-{***************************************************************************}
-
-    const
-       { maximal 16 Vektorfonts unterst�tzen }
-       { um mehr Fonts laden zu k”nnen, muá  }
-       { diese Variable erh”ht werden        }
-       maxfonts = 16;
-       fontdivs:array[0..maxfonts]of integer=
-       (1,4,3,4,4,4,4,4,4,3,3,1,1,1,1,1,1);
-
-    type
-       pbyte = ^byte;
-
-    {$PACKRECORDS 1}
-       pfontdata = ^tfontdata;
-
-       tfontdata = record
-          filetyp              : char;
-          nr_chars             : word;
-          undefined1           : byte;
-          value_first_char     : byte;
-          undefined2           : array[1..3] of byte;
-          dist_origin_top      : shortint;
-          dist_origin_baseline : shortint;
-          dist_origin_bottom   : shortint;
-          undefined3           : array[1..5] of byte;
-       end;
-
-    {$PACKRECORDS NORMAL}
-
-       tfontrec = record
-          name : string[8];
-          data : pointer;
-          header : pfontdata;
-          offsets : pword;
-          widths : pbyte;
-          instr : pbyte;
-       end;
-
-    var
-       fonts : array[1..maxfonts] of tfontrec;
-       installedfonts : longint;
-
-{$I FONT.PPI}
-
-    { gibt true zur�ck, wenn p auf eine g�ltige Fontdatei zeigt }
-
-    function testfont(p : pointer) : boolean;
-
-      begin
-         testfont:=(pchar(p)^='P') and
-          (pchar(p+1)^='K') and
-          (pchar(p+2)^=#8) and
-          (pchar(p+3)^=#8);
-      end;
-
-    { setzt die Hilfsdaten f�r den Font mit der Nr. font }
-    { der Zeiger data muá schon gesetzt sein             }
-
-    function setupfont(font : word) : integer;
-
-      begin
-         setupfont:=grOK;
-         fonts[font].header:=fonts[font].data+$80;
-         if fonts[font].header^.filetyp<>'+' then
-           begin
-              setupfont:=grInvalidFont;
-              exit;
-           end;
-         fonts[font].offsets:=fonts[font].data+$90;
-         fonts[font].widths:=pbyte(fonts[font].offsets+fonts[font].header^.nr_chars*2);
-         fonts[font].instr:=fonts[font].widths+fonts[font].header^.nr_chars;
-      end;
-
-    function InstallUserFont(const FontFileName : string) : integer;
-
-      begin
-         _graphresult:=grOk;
-         { es muá kein Graphikmodus gesetzt sein! }
-         { ist noch Platz f�r einen Font ? }
-         if installedfonts=maxfonts then
-           begin
-              _graphresult:=grError;
-              exit;
-           end;
-         inc(installedfonts);
-         fonts[installedfonts].name:=FontFileName;
-         fonts[installedfonts].data:=nil;
-         InstallUserFont:=installedfonts;
-      end;
-
-    function RegisterBGIfont(font : pointer) : integer;
-
-      var
-         hp : pbyte;
-         b : word;
-         name : string[12];
-
-      begin
-         { noch nicht garantiert, daá alles klappt }
-         RegisterBGIfont:=grInvalidFontNum;
-         { es muá kein Graphikmodus gesetzt sein! }
-         if testfont(font) then
-           begin
-              hp:=pbyte(font);
-              { Ende des Textheaders suchen }
-              while hp^<>$1a do
-                hp:=hp+1;
-              { auf Start des Names springen }
-              hp:=hp+3;
-              { Namen lesen }
-              name:='';
-              for b:=0 to 3 do
-                name:=name+char((hp+b)^);
-              { richtigen Font suchen }
-              for b:=1 to installedfonts do
-                begin
-                   if fonts[b].name=name then
-                     begin
-                        fonts[b].data:=font;
-                        RegisterBGIfont:=grOK;
-                        RegisterBGIfont:=setupfont(b);
-                     end;
-                end;
-           end
-         else
-           RegisterBGIFont:=grInvalidFont;
-      end;
-
-    procedure GetTextSettings(var TextInfo : TextSettingsType);
-
-      begin
-         _graphresult:=grOk;
-         if not isgraphmode then
-           begin
-              _graphresult:=grnoinitgraph;
-              exit;
-           end;
-         textinfo:=akttextinfo;
-      end;
-
-    procedure OutText(const TextString : string);
-      var x,y:integer;
-      begin
-         _graphresult:=grOk;
-         if not isgraphmode then
-           begin
-              _graphresult:=grnoinitgraph;
-              exit;
-           end;
-         x:=curx; y:=cury;
-         OutTextXY(curx,cury,TextString);
-         { wenn horizontal und linksb�ndig ausgegeben wird, dann }
-         { Grafikcursor nachf�hren }
-         if (akttextinfo.direction=HorizDir) and
-           (akttextinfo.horiz=LeftText) then
-               inc(x,textwidth(TextString));
-         curx:=x; cury:=y;   { LineTo manipuliert den GrafikCursor !! }
-      end;
-
-    procedure outtext(const charakter : char);
-    var s:string;
-        x,y:integer;
-    begin
-      s:=charakter;
-      _graphresult:=grOk;
-         if not isgraphmode then
-           begin
-              _graphresult:=grnoinitgraph;
-              exit;
-           end;
-         x:=curx; y:=cury;
-         OutTextXY(curx,cury,s);
-         { wenn horizontal und linksb�ndig ausgegeben wird, dann }
-         { Grafikcursor nachf�hren }
-         { if (akttextinfo.direction=HorizDir) and
-           (akttextinfo.horiz=LeftText) then }
-               inc(x,textwidth(s));
-         curx:=x; cury:=y;   { LineTo manipuliert den GrafikCursor !! }
-    end;
-
-    procedure OutTextXY(x,y : integer;const TextString : string);
-
-      var
-         b1,b2         : shortint;
-         c,instr,mask  : byte;
-         i,j,jj,k,l    : longint;
-         oldvalues     : linesettingstype;
-         nextpos       : word;
-         xpos,ypos,offs: longint;
-         FontPtr       : Pointer;
-      begin
-         _graphresult:=grOk;
-         if not isgraphmode then
-           begin
-              _graphresult:=grnoinitgraph;
-              exit;
-           end;
-
-         { wirkliche x- und y-Startposition berechnen }
-         if akttextinfo.direction=horizdir then
-         begin
-           case akttextinfo.horiz of
-                centertext : XPos:=(textwidth(textstring) shr 1);
-                lefttext   : XPos:=0;
-                righttext  : XPos:=textwidth(textstring);
-           end;
-           case akttextinfo.vert of
-               centertext : YPos:=(textheight(textstring) shr 1);
-               bottomtext : YPos:=0;
-               toptext    : YPos:=textheight(textstring);
-           end;
-         end else
-         begin
-           case akttextinfo.horiz of
-                centertext : XPos:=(textheight(textstring) shr 1);
-                lefttext   : XPos:=0;
-                righttext  : XPos:=textheight(textstring);
-           end;
-           case akttextinfo.vert of
-               centertext : YPos:=(textwidth(textstring) shr 1);
-               bottomtext : YPos:=0;
-               toptext    : YPos:=textwidth(textstring);
-           end;
-         end;
-         X:=X-XPos;
-         Y:=Y+YPos;
-         XPos:=X; YPos:=Y;
-
-         if akttextinfo.font=DefaultFont then begin
-           if akttextinfo.direction=horizdir then
-             ypos:=ypos-6*akttextinfo.charsize
-           {else
-             xpos:=xpos-6*akttextinfo.charsize};
-           (* c:=textwidth(textstring) div 8 - 1; { Charcounter }
-             gave wrong values if charsize<>1 PM *)
-           c:=length(textstring); { Charcounter }
-           FontPtr:=@defaultfontdata;
-
-           for i:=1 to c do begin
-             offs:=ord(textString[i]) shl 3;   { Offset des Chars in Data }
-             for j:=0 to 7 do begin
-               mask:=$80;
-               b1:=defaultfontdata[offs+j];    { Offset der Charzeile }
-               jj:=j*akttextinfo.charsize;
-               if akttextinfo.direction=horizdir then
-                 xpos:=x+((i-1) shl 3)*akttextinfo.charsize
-               else
-                 ypos:=y-((i-1) shl 3)*akttextinfo.charsize;
-               for k:=0 to {7}8*akttextinfo.charsize-1 do
-                 begin
-                 if (b1 and mask) <> 0 then
-                   for l:=0 to akttextinfo.charsize-1 do
-                     if akttextinfo.direction=horizdir then
-                       putpixeli(xpos+k,jj+ypos+l,aktcolor)
-                     else
-                       putpixeli(xpos+jj+l,ypos-k,aktcolor)
-                 else if ClearText then
-                   for l:=0 to akttextinfo.charsize-1 do
-                     if akttextinfo.direction=horizdir then
-                       putpixeli(xpos+k,jj+ypos+l,aktbackcolor)
-                     else
-                       putpixeli(xpos+jj+l,ypos-k,aktbackcolor);
-                 if (k mod akttextinfo.charsize) = akttextinfo.charsize-1 then
-                   mask:=mask shr 1;
-               end;
-             end;
-           end;
-         end else
-
-           begin
-              { Linienstil setzen }
-              getlinesettings(oldvalues);
-              setlinestyle(solidln,oldvalues.pattern,normwidth);
-              if akttextinfo.direction=vertdir then xpos:=xpos + Textheight(textstring);
-              curx:=xpos; cury:=ypos; x:=xpos; y:=ypos;
-              for i:=1 to length(textstring) do
-                begin
-                   c:=byte(textstring[i]);
-                   c:=c-fonts[akttextinfo.font].header^.value_first_char;
-                   { definiertes Zeichen ? }
-                   if (c<0) or (c>=fonts[akttextinfo.font].header^.nr_chars) then continue;
-                   nextpos:=fonts[akttextinfo.font].offsets[c];
-                   while true do
-                     begin
-                         b1:=fonts[akttextinfo.font].instr[nextpos];
-                         nextpos:=nextpos+1;
-                         b2:=fonts[akttextinfo.font].instr[nextpos];
-                         nextpos:=nextpos+1;
-                         instr:=((b1 and $80) shr 6)+((b2 and $80) shr 7);
-                         b1:=b1 and $7f;
-                         b2:=b2 and $7f;
-                         { Vorzeichen erweitern }
-                         if (b1 and $40)<>0 then b1:=b1 or $80;
-                         if (b2 and $40)<>0 then b2:=b2 or $80;
-                         { neue Stiftposition berechnen und skalieren }
-                         if akttextinfo.direction=VertDir then
-                           begin
-                             xpos:=x-((b2*aktmultx) div aktdivx);
-                             ypos:=y-((b1*aktmulty) div aktdivy);
-                           end
-                         else
-                           begin
-                             xpos:=x+((b1*aktmultx) div aktdivx) ;
-                             ypos:=y-((b2*aktmulty) div aktdivy) ;
-                           end;
-                         case instr of
-                            0 : break;
-                            2 : begin curx:=xpos; cury:=ypos; end;
-                            3 : begin line(curx,cury,xpos,ypos);
-                                      curx:=xpos; cury:=ypos;
-                                end;
-                         end;
-                     end;
-                   if akttextinfo.direction=VertDir then
-                     y:=y-(fonts[akttextinfo.font].widths[c]*aktmultx div aktdivx)
-                   else
-                     x:=x+(fonts[akttextinfo.font].widths[c]*aktmultx div aktdivx) ;
-                end;
-              setlinestyle( oldvalues.linestyle, oldvalues.pattern, oldvalues.thickness);
-           end;
-      end;
-
-    procedure outtextxy(x,y: Integer;const charakter : char);
-    var s:string;
-    begin
-      s:=charakter;
-      outtextXY(x,y,s);
-    end;
-
-    function TextHeight(const TextString : string) : word;
-
-      begin
-         _graphresult:=grOk;
-         if not isgraphmode then
-           begin
-              _graphresult:=grnoinitgraph;
-              exit;
-           end;
-         if akttextinfo.font=DefaultFont
-            then TextHeight:=6+akttextinfo.charsize
-            else
-              TextHeight:=(((fonts[akttextinfo.font].header^.dist_origin_top-
-                fonts[akttextinfo.font].header^.dist_origin_bottom) * aktmulty) div aktdivy) ;
-      end;
-
-    function TextWidth(const TextString : string) : word;
-      var i,x : Integer;
-          c   : byte;
-      begin
-         _graphresult:=grOk;  x:=0;
-         if not isgraphmode then
-           begin
-              _graphresult:=grnoinitgraph;
-              exit;
-           end;
-         if akttextinfo.font = Defaultfont then
-            TextWidth:=length(TextString)*8*akttextinfo.charsize
-            else begin
-               for i:=1 to length(TextString) do begin
-                   c:=byte(textstring[i]);
-                   dec(c,fonts[akttextinfo.font].header^.value_first_char);
-                   { definiertes Zeichen ? }
-                   if (c<0) or (c>=fonts[akttextinfo.font].header^.nr_chars) then
-                     continue;
-                   x:=x+fonts[akttextinfo.font].widths[c];
-               end;
-            TextWidth:=((x * aktmultx) div aktdivx) ;
-            end;
-      end;
-
-    procedure SetTextJustify(horiz,vert : word);
-
-      begin
-         _graphresult:=grOk;
-         if not isgraphmode then
-           begin
-              _graphresult:=grnoinitgraph;
-              exit;
-           end;
-         if (horiz<0) or (horiz>2) or
-            (vert<0) or (vert>2) then
-           begin
-              _graphresult:=grError;
-              exit;
-           end;
-         akttextinfo.horiz:=horiz;
-         akttextinfo.vert:=vert;
-      end;
-
-    procedure SetTextStyle(font,direction : word;charsize : word);
-
-      var
-         f : file;
-
-      begin
-         _graphresult:=grOk;
-         if not isgraphmode then
-           begin
-              _graphresult:=grnoinitgraph;
-              exit;
-           end;
-         { Parameter auf G�ltigkeit �berpr�fen }
-         if font>installedfonts then
-           begin
-              _graphresult:=grInvalidFontNum;
-              exit;
-           end;
-         akttextinfo.font:=font;
-         if (direction<>HorizDir) and (direction<>VertDir) then
-           direction:=HorizDir;
-         akttextinfo.direction:=direction;
-         akttextinfo.charsize:=charsize;
-         if (charsize <> usercharsize) then begin
-            aktmultx:=charsize;
-            aktdivx:=fontdivs[font];
-            aktmulty:=charsize;
-            aktdivy:=fontdivs[font];
-         end;
-         { Fontdatei laden ? }
-         if (font>0) and not assigned(fonts[font].data) then
-           begin
-              assign(f,bgipath+fonts[font].name+'.CHR');
-              reset(f,1);
-              if ioresult<>0 then
-                begin
-                   _graphresult:=grFontNotFound;
-                   akttextinfo.font:=DefaultFont;
-                   exit;
-                end;
-              getmem(fonts[font].data,filesize(f));
-              if not assigned(fonts[font].data) then
-                begin
-                   _graphresult:=grNoFontMem;
-                   akttextinfo.font:=DefaultFont;
-                   exit;
-                end;
-              blockread(f,fonts[font].data^,filesize(f));
-
-              if testfont(fonts[font].data) then
-                _graphresult:=setupfont(font)
-              else
-                begin
-                   _graphresult:=grInvalidFont;
-                   akttextinfo.font:=DefaultFont;
-                   freemem(fonts[font].data,filesize(f));
-                end;
-              close(f);
-           end;
-      end;
-
-    procedure SetUserCharSize(Multx,Divx,Multy,Divy : word);
-
-      begin
-         _graphresult:=grOk;
-         if not isgraphmode then
-           begin
-              _graphresult:=grnoinitgraph;
-              exit;
-           end;
-         aktmultx:=Multx;
-         aktdivx:=Divx;
-         aktmulty:=Multy;
-         aktdivy:=Divy;
-      end;
-
-
-{
-  $Log$
-  Revision 1.1  1998-12-21 13:07:05  peter
-    * use -FE
-
-  Revision 1.3  1998/11/23 10:04:19  pierre
-    * pieslice and sector work now !!
-    * bugs in text writing removed
-    + scaling for defaultfont added
-    + VertDir for default font added
-    * RestoreCRTMode corrected
-
-  Revision 1.2  1998/11/18 09:31:42  pierre
-    * changed color scheme
-      all colors are in RGB format if more than 256 colors
-    + added 24 and 32 bits per pixel mode
-      (compile with -dDEBUG)
-      24 bit mode with banked still as problems on pixels across
-      the bank boundary, but works in LinearFrameBufferMode
-      Look at install/demo/nmandel.pp
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.3  1998/01/26 11:58:41  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/text.ppi
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:34;  author: michael;  state: Exp;  lines: +14 -0
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/triangle.ppi

@@ -1,85 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-procedure Triangle(A,B,C:PointType);
-
-var temp : PointType;
-    yc,yl    : Integer;
-    x1,x2,x3 : Integer;
-    y1,y2,y3 : Integer;
-begin
-  if B.Y < A.Y then begin Temp:=A; A:=B; B:=Temp; end;
-  if C.Y < B.Y then begin Temp:=B; B:=C; C:=Temp; end;
-  if B.Y < A.Y then begin Temp:=A; A:=B; B:=Temp; end;
-  x1:=b.x-a.x;  y1:=b.y-a.y;
-  x2:=c.x-b.x;  y2:=c.y-b.y;
-  x3:=c.x-a.x;  y3:=c.y-a.y;
-  yl:=b.y-a.y;
-  if y1 <> 0 then
-    for yc:=0 to y1 do
-    begin
-      patternline(a.x + yc * x1 div y1,a.x+ yc * x3 div y3,a.y+yc);
-    end;
-  if y2 <> 0 then
-    for yc:=0 to y2 do
-    begin
-      patternline(c.x - yc * x2 div y2,c.x - yc * x3 div y3,c.y-yc);
-    end;
-end;
-
-procedure Filltriangle(A,B,C:PointType);
-begin
-  _graphresult:=grOK;
-  if not isgraphmode then
-  begin
-    _graphresult:=grnoinitgraph;
-    exit;
-  end;
-  Triangle(A,B,C);
-  if (aktcolor<>aktfillsettings.color) or (aktfillsettings.pattern<>1) then
-  begin
-    line(a.x,a.y,b.x,b.y);
-    line(b.x,b.y,c.x,c.y);
-    line(c.x,c.y,a.x,a.y);
-  end;
-end;
-{
-  $Log$
-  Revision 1.1  1998-12-21 13:07:05  peter
-    * use -FE
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.3  1998/01/26 11:58:45  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/triangle.ppi
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:34;  author: michael;  state: Exp;  lines: +13 -1
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:52;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:52;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/go32v2/ppi/vesadeb.ppi

@@ -1,124 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{ VESADEB.INC - contains Debuginformations for the VESA.PPU }
-
-    writeln('VESA-Signature   : ',
-      VGAInfo.VESASignature[1],VGAInfo.VESASignature[2],VGAInfo.VESASignature[3],
-      VGAInfo.VESASignature[4],VGAInfo.VESAhiVersion,'.',VGAInfo.VESAloVersion);
-    writeln('Memory installed : ',VGAInfo.Totalmem * 64,'K');
-    writeln('startmode = ',HexStr(StartMode,4));
-    write('Mode $',HexStr(GraphMode,4),'            : ');
-      if (VESAInfo.ModeAttributes and 1)=0 then write('not '); writeln('supported');
-    writeln('Resolution            : ',VESAInfo.XResolution,'x',VESAInfo.YResolution);
-    write('optional Informations : ');
-      if (VESAInfo.ModeAttributes and 2)=0 then write('not '); writeln('available');
-    write('BIOS Output           : ');
-      if (VESAInfo.ModeAttributes and 4)=0 then write('not '); writeln('supported');
-    write('Mode                  : ');
-      if (VESAInfo.ModeAttributes and 8)<>0 then write('colour, ') else write('monochrom, ');
-      if (VESAInfo.ModeAttributes and $10)<>0 then writeln('graphic') else writeln('text');
-    if VGAInfo.VESAhiVersion=2 then begin
-      write('Mode VGA-compatible   : ');
-      if (VESAInfo.ModeAttributes and $20)<>0 then writeln('no') else writeln('yes');
-      write('Bankswitching         : ');
-      if (VESAInfo.ModeAttributes and $40)<>0 then write('not '); Writeln('supported');
-      write('linear FrameBuffer    : ');
-      if (VESAInfo.ModeAttributes and $80)=0 then write('not supported') else
-       begin Writeln('supported');
-             Writeln('PhysBaseAddress at : 0x',HexStr(VESAInfo.PhysAddress,8));
-             Writeln('LinearBase at      : 0x',Hexstr(Get_linear_addr(VESAInfo.PhysAddress,VGAInfo.TotalMem shl 16),8));
-             Writeln('OffscreenOffset    : 0x',HexStr(VESAInfo.OffScreenPtr,8));
-             Writeln('OffscreenMem       : ',VESAInfo.OffScreenMem,'KB');
-       end;
-      if (VESAInfo.ModeAttributes and $200)<>0 then
-         write('(VBE/AF v1.0P) application must call EnableDirectAccess '+
-           'before calling bank-switching functions');
-    end;
-    writeln;
-    writeln('BankSwitchRoutine at: ',HexStr(VESAInfo.RealWinFuncPtr,8));
-    write('WindowA: read: '); if (VESAInfo.WinAAttributes and 3)=3 then write('yes')else write('no ');
-    write('    write: ');     if (VESAInfo.WinAAttributes and 5)=5 then write('yes')else write('no ');
-    writeln('   Segment:  ',HexStr(VESAInfo.segWinA,4));
-    write('WindowB: read: '); if (VESAInfo.WinBAttributes and 3)=3 then write('yes')else write('no ');
-    write('    write: ');     if (VESAInfo.WinBAttributes and 5)=5 then write('yes')else write('no ');
-    writeln('   Segment:  ',HexStr(VESAInfo.segWinB,4));
-    writeln('Granularity  : ',VESAInfo.WinGranularity);
-    writeln('WinSize      : ',Winsize,' KByte  WinShift : ',WinShift);
-    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));
-         writeln(' linear limit: ',hexstr(get_segment_limit(seg_write),8));
-      end;
-    if not same_window then
-      begin
-         write('Read selector linear base: ',hexstr(get_segment_base_address(seg_read),8));
-         writeln(' linear limit: ',hexstr(get_segment_limit(seg_read),8));
-      end;
-{$ifndef FPC_PROFILE}
-    readln;
-{$endif not FPC_PROFILE}
-
-{
-  $Log$
-  Revision 1.1  1998-12-21 13:07:05  peter
-    * use -FE
-
-  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)
-      Simply make a floodfill from the barycenter !
-    * some 24BPP code changed (still does not work for my S3VBE program !)
-
-  Revision 1.2  1998/11/18 09:31:43  pierre
-    * changed color scheme
-      all colors are in RGB format if more than 256 colors
-    + added 24 and 32 bits per pixel mode
-      (compile with -dDEBUG)
-      24 bit mode with banked still as problems on pixels across
-      the bank boundary, but works in LinearFrameBufferMode
-      Look at install/demo/nmandel.pp
-
-  Revision 1.1.1.1  1998/03/25 11:18:42  root
-  * Restored version
-
-  Revision 1.3  1998/01/26 11:58:49  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/ppi/vesadeb.ppi
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:21:35;  author: michael;  state: Exp;  lines: +14 -0
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:52;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:52;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

rtl/inc/graph/vesa.inc → rtl/go32v2/vesa.inc

@@ -1938,7 +1938,10 @@ end;
 
 {
 $Log$
-Revision 1.21  1999-11-03 20:23:01  florian
+Revision 1.1  1999-11-08 11:15:21  peter
+  * move graph.inc to the target dir
+
+Revision 1.21  1999/11/03 20:23:01  florian
   + first release of win32 gui support
 
 Revision 1.20  1999/10/24 15:50:23  carl

rtl/inc/graph/vesah.inc → rtl/go32v2/vesah.inc

@@ -64,7 +64,10 @@ var
                           { initialized in QueryAdapterInfo in graph.inc }
 {
   $Log$
-  Revision 1.2  1999-09-26 13:31:07  jonas
+  Revision 1.1  1999-11-08 11:15:21  peter
+    * move graph.inc to the target dir
+
+  Revision 1.2  1999/09/26 13:31:07  jonas
     * changed name of modeinfo variable to vesamodeinfo and fixed
       associated errors (fillchar(modeinfo,sizeof(tmodeinfo),#0) instead
       of sizeof(TVesamodeinfo) etc)

rtl/inc/graph/graph.pp

@@ -2124,19 +2124,8 @@ end;
 
 {$i modes.inc}
 {$i palette.inc}
-
-{$ifdef win32}
-{$i win32.inc}
-{$else win32}
-
-{$ifdef DPMI}
-{$i vesah.inc}
-{$endif DPMI}
-
 {$i graph.inc}
 
-{$endif win32}
-
   function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): integer;
    begin
      _graphResult := grError;
@@ -2972,7 +2961,10 @@ SetGraphBufSize
 
 {
   $Log$
-  Revision 1.34  1999-11-03 20:23:01  florian
+  Revision 1.35  1999-11-08 11:15:22  peter
+    * move graph.inc to the target dir
+
+  Revision 1.34  1999/11/03 20:23:01  florian
     + first release of win32 gui support
 
   Revision 1.33  1999/10/17 10:20:13  jonas

rtl/inc/graph/win32.inc → rtl/win32/graph.inc

@@ -521,7 +521,10 @@ function queryadapterinfo : pmodeinfo;
 
 {
   $Log$
-  Revision 1.1  1999-11-03 20:23:02  florian
+  Revision 1.1  1999-11-08 11:15:22  peter
+    * move graph.inc to the target dir
+
+  Revision 1.1  1999/11/03 20:23:02  florian
     + first release of win32 gui support
 
 }