+ SetGraphMode()

+ InitGraph() is now device independant
  + Mode management and some mode constants

rtl/inc/graph/graph.pp

@@ -52,23 +52,6 @@ Unit Graph2;
 {        Menno Victor van der star                      }
 {     (the code has been heavily modified)              }
 {-------------------------------------------------------}
-{ These routine must be hooked for every new platform:  }
-{                                                       }
-{   InitGraph()                                         }
-{   PutPixel()                                          }
-{   DirectPutPixel()                                    }
-{   GetPixel()                                          }
-{   CloseGraph()                                        }
-{   DetectGraph()                                       }
-{   GetModeRange()                                      }
-{   GetPalette()                                        }
-{   RestoreCRTMode()                                    }
-{   SetAllPalette()                                     }
-{   SetGraphMode()                                      }
-{   SetPalette()                                        }
-{   SetVisualPage()                                     }
-{   SetActivePage()                                     }
-{   SetBkColor()                                        }
 {-------------------------------------------------------}
 { For significant speed improvements , is is recommended }
 { that these routines be hooked (otherwise the default,  }
@@ -140,9 +123,9 @@ Unit Graph2;
 {   * Dashed LineStyle exactly like BP version now       }
 {   + Center LineStyle (checked against CGA driver)      }
 {   * GraphDefaults() now resets linepattern array       }
-{ 1st august 1999:                                       }
+{ 1st april  1999:                                       }
 {   + First implementation of FillPoly (incomplete)      }
-{ 2nd august 1999:                                       }
+{ 2nd april  1999:                                       }
 {   * FillPoly did not Reset PatternLine index           }
 {   * FillPoly did not use correct color                 }
 {   * PatternLine was writing modes in reverse direction }
@@ -152,14 +135,14 @@ Unit Graph2;
 {     with either the foreground or background color.    }
 {   * GraphDefaults() would not call SetBkColor()        }
 {   * Fixed some memory leaks in FillPoly()              }
-{ 11th August 1999:                                      }
+{ 11th April  1999:                                      }
 {   * PatternLine() was drawing one pixel less then      }
 {     requested                                          }
-{ 12th August 1999:                                      }
+{ 12th April  1999:                                      }
 {   + FloodFill - first working implementation           }
 {      Horrbly slow even on very fast cpu's              }
 {   + Some suggestions of Thomas implemented             }
-{ 13th August 1999:                                      }
+{ 13th April  1999:                                      }
 {   * FloodFill() vertical index was off by one pixel    }
 {   * FloodFill() would never draw the last line in the  }
 {      list                                              }
@@ -170,17 +153,17 @@ Unit Graph2;
 {   + FillEllipse() initial version                      }
 {   * InternalEllipse() - 0 to 360 now supported as      }
 {     angles.                                            }
-{ 14th August 1999:                                      }
+{ 14th April  1999:                                      }
 {   * mod x = and (x-1)(from Thomas Schatzl) gives a     }
 {     significant speed improvement.                     }
-{ 15th august 1999:                                      }
+{ 15th april  1999:                                      }
 {   + Arc() ok except for Aspect Ratio, which does not   }
 {     give us the correct ratio on a 320x200 screen.     }
 {   + Added FillPoly() from Thomas Schatzl               }
 {   + More hookable routines                             }
-{  16th august 1999:                                     }
+{  16th april  1999:                                     }
 {   + Line() checked ok.                                 }
-{  17th august 1999:                                     }
+{  17th april  1999:                                     }
 {   * GraphDefaults() would not reset CP                 }
 {   + GetX(), GetY(), MoveTo() checked for viewports     }
 {   * OutTextXY() should not update the CP               }
@@ -189,8 +172,14 @@ Unit Graph2;
 {   * Sector() would update the CP by calling LineTo     }
 {   * Bar3D() would update the CP                        }
 {   * PieSlice() would update the CP                     }
-{  18th august 1999:                                     }
+{  18th april  1999:                                     }
 {   + Clipping algorithm                                 }
+{  19th april  1999:                                     }
+{   + Adapterinfo structure                              }
+{  20th april 1999:                                      }
+{   + GetModeName                                        }
+{   + GetGraphMode                                       }
+{   + GetModeRange                                       }
 {--------------------------------------------------------}
 { LEFT TO DO:                                            }
 {   - optimize scaling of stroked fonts                  }
@@ -226,12 +215,6 @@ Interface
        grInvalidFontNum = -14;
        grInvalidVersion = -18;
 
-       { graphic drivers }
-       CurrentDriver = -128;
-       Detect = 0;
-
-       { graph modes }
-       Default = 0;
 
        black = 0;
        blue = 1;
@@ -316,6 +299,25 @@ Interface
        BottomText = 0;
        TopText    = 2;
 
+       { graphic drivers }
+       CurrentDriver = -128;
+       Detect        = 0;
+       LowRes        = 1;
+       HercMono      = 7;
+       VGA           = 9;
+
+       { graph modes }
+       Default = 0;
+
+       { VGA Driver modes }
+       VGALo   = 0;
+       VGAMed  = 1;
+       VGAHi   = 2;
+
+       { Hercules mono card }
+       HercMonoHi = 0;
+
+
 
 
 
@@ -418,9 +420,11 @@ TYPE
 
        { internal routines -- can be hooked for much faster drawing }
 
-       { draw filled horizontal lines using clipping and current color }
+       { draw filled horizontal lines using current color }
+       { on entry coordinates are already clipped.        }
        hlineproc = procedure (x, x2,y : integer);
-       { draw filled vertical line using cliiping and current color    }
+       { on entry coordinates are already clipped.        }
+       { draw filled vertical line using current color    }
        vlineproc = procedure (x,y,y2: integer);
 
        { this routine is used to draw filled patterns for all routines }
@@ -434,13 +438,57 @@ TYPE
 	  YRadius:word; stAngle,EndAngle: word);
 
        { Line routine - draws lines thick/norm widths with current     }
-       { color and line style.                                         }
+       { color and line style - LINE must be clipped here.             }
        lineproc = procedure (X1, Y1, X2, Y2 : Integer);
 
        { this routine is used for FloodFill - it returns an entire      }
        { screen scan line with a word for each pixel in the scanline    }
        getscanlineproc = procedure (Y : integer; var data);
 
+       { this routine actually switches to the desired video mode.     }
+       initmodeproc = procedure;
+
+TYPE
+    {-----------------------------------}
+    { Linked list for mode information  }
+    { This list is set up by one of the }
+    { following routines:               }
+    { It lists all available resolutions}
+    { on this display adapter.          }
+    {-----------------------------------}
+    {   QueryAdapter()                  }
+    {   DetectGraph()                   }
+    {   InitGraph()                     }
+    {-----------------------------------}
+    PModeInfo = ^TModeInfo;
+    TModeInfo = record
+      DriverNumber: Integer;
+      ModeNumber: Integer;
+      MaxColor: Longint;
+      XAspect : Integer;
+      YAspect : Integer;
+      MaxX: Integer;
+      MaxY: Integer;
+      ModeName: String[18];
+      { necessary hooks ... }
+      DirectPutPixel : DefPixelProc;
+      GetPixel       : GetPixelProc;
+      PutPixel       : PutPixelProc;
+      { defaults possible ... }
+      ClearViewPort  : ClrViewProc;
+      PutImage       : PutImageProc;
+      GetImage       : GetImageProc;
+      ImageSize      : ImageSizeProc;
+      GetScanLine    : GetScanLineProc;
+      Line           : LineProc;
+      InternalEllipse: EllipseProc;
+      PatternLine    : PatternLineProc;
+      HLine          : HLineProc;
+      VLine          : VLineProc;
+      InitMode       : InitModeProc;
+      next: PModeInfo;
+    end;
+
 
 
 VAR
@@ -472,6 +520,11 @@ Function  GetMaxX: Integer;
 Function  GetMaxY: Integer;
 Procedure SetViewPort(X1, Y1, X2, Y2: Integer; Clip: Boolean);
 Function  GraphResult: Integer;
+function  GetModeName(ModeNumber: integer): string;
+procedure SetGraphMode(Mode: Integer);
+function GetGraphMode: Integer;
+function GetMaxMode: word;
+procedure GetModeRange(GraphDriver: Integer; var LoMode, HiMode: Integer);
 Function  GetX: Integer;
 Function  GetY: Integer;
 procedure GraphDefaults;
@@ -532,6 +585,7 @@ procedure SetFillPattern(Pattern: FillPatternType; Color: word);
  procedure OutText(const TextString : string);
 
 
+
 Implementation
 
 const
@@ -609,19 +663,27 @@ var
   IsGraphMode : Boolean; { Indicates if we are in graph mode or not }
 
 
+  ArcCall: ArcCoordsType;   { Information on the last call to Arc or Ellipse }
+
   VidMode: Byte;          { Old video mode to restore to }
 
+
+
+var
+
   { ******************** HARDWARE INFORMATION ********************* }
-  BitsPerPixel: word;
+  { Should be set in InitGraph once only.                           }
+  IntCurrentMode : Integer;
+  IntCurrentDriver : Integer;       { Currently loaded driver          }
   XAspect : Integer;
   YAspect : Integer;
   MaxX : Integer;       { Maximum resolution - ABSOLUTE }
   MaxY : Integer;       { Maximum resolution - ABSOLUTE }
-  HardwarePages : byte;
   MaxColor : Longint;
-  ModeName : String;
 
-  ArcCall: ArcCoordsType;   { Information on the last call to Arc or Ellipse }
+  DriverName: String;
+  ModeList : PModeInfo;
+
 
 
 
@@ -1529,13 +1591,75 @@ begin
 end;
 
 
+  Procedure DefaultHooks;
+  {********************************************************}
+  { Procedure DefaultHooks()                               }
+  {--------------------------------------------------------}
+  { Resets all hookable routine either to nil for those    }
+  { which need overrides, and others to defaults.          }
+  { This is called each time SetGraphMode() is called.     }
+  {********************************************************}
+  Begin
+    { All default hooks procedures }
+
+    { required...}
+    DirectPutPixel := nil;
+    PutPixel := nil;
+    GetPixel := nil;
+
+    { optional...}
+    ClearViewPort := ClearViewportDefault;
+    PutImage := DefaultPutImage;
+    GetImage := DefaultGetImage;
+    ImageSize := DefaultImageSize;
+
+    GraphFreeMemPtr := nil;
+    GraphGetMemPtr := nil;
+
+    GetScanLine := GetScanLineDefault;
+    Line := LineDefault;
+    InternalEllipse := InternalEllipseDefault;
+    PatternLine := PatternLineDefault;
+    HLine := HLineDefault;
+    VLine := VLineDefault;
+  end;
+
+  Procedure InitVars;
+  {********************************************************}
+  { Procedure InitVars()                                   }
+  {--------------------------------------------------------}
+  { Resets all internal variables, and resets all          }
+  { overridable routines.                                  }
+  {********************************************************}
+   Begin
+    InstalledFonts := 0;
+    { Install standard fonts }
+    InstallUserFont('TRIP');
+    InstallUserFont('LITT');
+    InstallUserFont('SANS');
+    InstallUserFont('GOTH');
+    ArcCall.X := 0;
+    ArcCall.Y := 0;
+    ArcCall.XStart := 0;
+    ArcCall.YStart := 0;
+    ArcCall.XEnd := 0;
+    ArcCall.YEnd := 0;
+    { Reset to default values }
+    IntCurrentMode := 0;
+    IntCurrentDriver := 0;
+    XAspect := 0;
+    YAspect := 0;
+    MaxX := 0;
+    MaxY := 0;
+    MaxColor := 0;
+    DefaultHooks;
+  end;
 
 
 
 
-
+{$i modes.inc}
-
+{$i graph.inc}
-{$i pc.inc}
 
 
   function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): integer;
@@ -1945,6 +2069,14 @@ end;
      GetY := CurrentY;
    end;
 
+   Function GetDriverName: string;
+    var
+     mode: PModeInfo;
+    begin
+      GetDriverName:=DriverName;
+    end;
+
+
    procedure graphdefaults;
    { PS: GraphDefaults does not ZERO the ArcCall structure }
    { so a call to GetArcCoords will not change even the    }
@@ -2004,16 +2136,11 @@ end;
       YAsp:=YAspect;
     end;
 
-procedure SetAspectRatio(Xasp, Yasp : word);
+  procedure SetAspectRatio(Xasp, Yasp : word);
-begin
+  begin
     Xaspect:= XAsp;
     YAspect:= YAsp;
-end;
+  end;
-
-
-
-
-
 
 
   procedure SetWriteMode(WriteMode : integer);
@@ -2092,34 +2219,272 @@ end;
 {$i fills.inc}
 {$i text.inc}
 
+   function GetModeName(ModeNumber: integer): string;
+  {********************************************************}
+  { Function GetModeName()                                 }
+  {--------------------------------------------------------}
+  { Checks  the known video list, and returns ModeName     }
+  { string. On error returns an empty string.              }
+  {********************************************************}
+    var
+     mode: PModeInfo;
+    begin
+      mode:=nil;
+      GetModeName:='';
+      { only search in the current driver modes ... }
+      mode:=SearchMode(IntCurrentDriver,ModeNumber);
+      if assigned(mode) then
+          GetModeName:=Mode^.ModeName
+      else
+         _GraphResult := grInvalidMode;
+    end;
+
+   function GetGraphMode: Integer;
+     begin
+      GetGraphMode := IntCurrentMode;
+     end;
+
+   function GetMaxMode: word;
+   { I know , i know, this routine is very slow, and it would }
+   { be much easier to sort the linked list of possible modes }
+   { instead of doing this, but I'm lazy!! And anyways, the   }
+   { speed of the routine here is not that important....      }
+    var
+     i: word;
+     mode: PModeInfo;
+    begin
+      mode:=nil;
+      i:=0;
+      repeat
+        inc(i);
+        { mode 0 always exists... }
+        { start search at 1..     }
+        mode:=SearchMode(IntCurrentDriver,i);
+      until not assigned(mode);
+      GetMaxMode:=i;
+    end;
+
+
+    procedure GetModeRange(GraphDriver: Integer; var LoMode,
+      HiMode: Integer);
+      var
+       i : integer;
+       mode : PModeInfo;
+     begin
+       LoMode:=-1;
+       HiMode:=-1;
+       mode := nil;
+       { First search if the graphics driver is supported ..  }
+       { since mode zero is always supported.. if that driver }
+       { is supported it should return something...           }
+       mode := SearchMode(GraphDriver, 0);
+       { driver not supported...}
+       if not assigned(mode) then exit;
+       { now it exists... find highest available mode... }
+       LoMode := 0;
+       mode:=nil;
+       i:=-1;
+       repeat
+         inc(i);
+         { start search at 0..     }
+         mode:=SearchMode(GraphDriver,i);
+       until not assigned(mode);
+       HiMode := i;
+     end;
+
+
+  procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;
+    const PathToDriver:String);
+  var i,index:Integer;
+     LoMode, HiMode: Integer;
+     CpyMode: Integer;
+  begin
+    { path to the fonts (where they will be searched)...}
+    bgipath:=PathToDriver;
+    if bgipath[length(bgipath)]<>'\' then
+    bgipath:=bgipath+'\';
+
+    { make sure our driver list is setup...}
+    QueryAdapterInfo;
+    SaveVideoState;
+    InitVars;
+    DriverName:=InternalDriverName;   { DOS Graphics driver }
+
+    if (Graphdriver=Detect) then
+      begin
+          HiMode := -1;
+          LoMode := -1;
+          GraphDriver := VGA;
+          { search all possible graphic drivers in ascending order...}
+          { usually the new driver numbers indicate newest hardware...}
+          { Internal driver numbers start at VGA=9 }
+          while (CpyMode<>-1) do
+           begin
+             GetModeRange(GraphDriver,LoMode,HiMode);
+             { save the highest mode possible...}
+             CpyMode:=HiMode;
+             { go to next driver if it exists...}
+             Inc(GraphDriver);
+          end;
+        IntCurrentDriver := GraphDriver;
+        { If this is equal to -1 then no graph mode possible...}
+        if Himode = -1 then
+         begin
+           _GraphResult := grNotDetected;
+           exit;
+         end;
+        { Actually set the graph mode...}
+        SetGraphMode(HiMode);
+      end
+    else
+      begin
+        { Search if that graphics modec actually exists...}
+        if SearchMode(GraphDriver,GraphMode) = nil then
+          begin
+            _GraphResult := grInvalidMode;
+            exit;
+         end
+        else
+         begin
+           IntCurrentDriver := GraphDriver;
+           SetGraphMode(GraphMode);
+         end;
+      end;
+  end;
+
+  procedure SetGraphMode(mode: Integer);
+    var
+     modeinfo: PModeInfo;
+    begin
+      { check if the mode exists... }
+      modeinfo := searchmode(IntcurrentDriver,mode);
+      if not assigned(modeinfo) then
+        begin
+          _GraphResult := grInvalidMode;
+          exit;
+       end;
+    { reset all hooks...}
+    DefaultHooks;
+    { arccall not reset - tested against VGA BGI driver }
+    { Setup all hooks if none, keep old defaults...}
+
+      { required hooks - returns error if no hooks to these }
+      { routines.                                           }
+      if assigned(modeinfo^.DirectPutPixel) then
+         DirectPutPixel := modeinfo^.DirectPutPixel
+      else
+        begin
+         _Graphresult := grInvalidMode;
+         exit;
+       end;
+
+      if assigned(modeinfo^.PutPixel) then
+         PutPixel := modeinfo^.PutPixel
+      else
+        begin
+         _Graphresult := grInvalidMode;
+         exit;
+       end;
+
+      if assigned(modeinfo^.GetPixel) then
+         GetPixel := modeinfo^.GetPixel
+      else
+        begin
+         _Graphresult := grInvalidMode;
+         exit;
+       end;
+
+      { optional hooks. }
+      if assigned(modeinfo^.ClearViewPort) then
+         ClearViewPort := modeinfo^.ClearViewPort;
+      if assigned(modeinfo^.PutImage) then
+         PutImage := modeinfo^.PutImage;
+      if assigned(modeinfo^.GetImage) then
+         GetImage := modeinfo^.GetImage;
+      if assigned(modeinfo^.ImageSize) then
+         ImageSize := modeinfo^.ImageSize;
+      if assigned(modeinfo^.GetScanLine) then
+         GetScanLine := modeinfo^.GetScanLine;
+      if assigned(modeinfo^.Line) then
+         Line := modeinfo^.Line;
+      if assigned(modeinfo^.InternalEllipse) then
+         InternalEllipse := modeinfo^.InternalEllipse;
+      if assigned(modeinfo^.PatternLine) then
+         PatternLine := modeinfo^.PatternLine;
+      if assigned(modeinfo^.HLine) then
+         Hline := modeinfo^.Hline;
+      if assigned(modeinfo^.Vline) then
+         VLine := modeinfo^.VLine;
+      IntCurrentMode := modeinfo^.ModeNumber;
+      IntCurrentDriver := modeinfo^.DriverNumber;
+      XAspect := modeinfo^.XAspect;
+      YAspect := modeinfo^.YAspect;
+      MaxX := modeinfo^.MaxX;
+      MaxY := modeinfo^.MaxY;
+      MaxColor := modeinfo^.MaxColor;
+      { now actually initialize the video mode...}
+      { check first if the routine exists        }
+      if not assigned(modeinfo^.InitMode) then
+        begin
+          _GraphResult := grInvalidMode;
+          exit;
+        end;
+      modeinfo^.InitMode;
+      { It is very important that this call be made }
+      { AFTER the other variables have been setup.  }
+      { Since it calls some routines which rely on  }
+      { those variables.                            }
+      GraphDefaults;
+      SetViewPort(0,0,MaxX,MaxY,TRUE);
+    end;
+
+
+var
+ ExitSave: pointer;
+
+begin
+ ModeList := nil;
+ { This must be called at startup... because GetGraphMode may }
+ { be called even when not in graph mode.                     }
+ QueryAdapterInfo;
+ { This installs an exit procedure which cleans up the mode list...}
+ ExitSave := ExitProc;
+ ExitProc := @CleanMode;
 end.
 
+RestoreCrtMode
 
 
 GetDefaultPalette
 GetPalette
 GetPaletteSize
-
-
 PieSlice
 Sector
 SetActivePage
 SetAllPalette
 SetGraphBufSize
 SetBkColor
-
-
-RestoreCrtMode
-SetGraphMode
 SetPalette
 SetRGBPalette
 SetVisualPage
 DetectGraph
-GetDriverName
+
-GetGraphMode
+{ These routine must be hooked for every new platform:  }
-GetMaxMode
+{                                                       }
-GetModeName
+{   InitGraph()                                         }
-GetModeRange
+{   PutPixel()                                          }
+{   DirectPutPixel()                                    }
+{   GetPixel()                                          }
+{   CloseGraph()                                        }
+
+{   DetectGraph()                                       }
+{   GetPalette()                                        }
+{   SetAllPalette()                                     }
+{   SetPalette()                                        }
+{   SetVisualPage()                                     }
+{   SetActivePage()                                     }
+{   SetBkColor()                                        }
+