Stars of Shareware: Programmierung/SOURCE.mdf/programm/msdos/pascal/video/video.pas

Pascal/Delphi Source File | 1994-03-09 | 32.1 KB | 835 lines

{*********************************************************}
{*                   VIDEO.PAS 1.00                      *}
{*        Copyright (c) T P Systems, Inc. 1994.          *}
{*                  All rights reserved.                 *}
{*********************************************************}

(*
    Implements a VideoManager object for handling EGA, VGA and SVGA modes.

    CAUTION: This is an experimental unit and still has some problems.
    VideoManager has a problem in restoring SVGA modes. I don't know
    whether this is a bug in my code or a problem with the VESA
    implementations I have tested. Any help in sorting this out would be
    appreciated.

    There are no screen writing methods which makes the use of graphics
    modes problematical at this point.

    There are no palette handling methods so attributes in graphics modes
    may not turn out to be what you intended.

    Remember there is no cursor in graphics modes and you have to specifically
    emulate one if a cursor is important.  There seems to be a problem in
    cursor positioning when in SVGA modes.

*)

{$A-,B-,E+,F+,I-,N-,O+,R-,S-,V-,X+}

Unit Video;

interface

uses
  OpConst,
  OpString,
  OpInline,
  OpCrt,
  OpRoot,
  Dos,
  TsVga,
  TsSvga;

type

  SetModeFunc       = function(Mode: word; Clear: boolean): word;
  ReturnModeFunc    = function(var Mode: word): word;
  ReturnBufSizeFunc = function(var Size: word; States: word): word;
  SaveStateFunc     = function(Buf: pointer; States: word): word;
  RestoreStateFunc  = function(Buf: pointer; States: word): word;

const
  {VideoManager Option Flags -- first 4 options are not supported on EGA}
  vmClearDisplay        = $0001; {if set video display memory cleared on}
                                 {mode set - always cleared on EGA}
  vmPreservePalette     = $0002; {if set palette is preserved on mode set}
  vmSaveStateOnInit     = $0004; {if set saves initial state if possible}
  vmRestoreStateOnDone  = $0008; {if set restores initial state if possible}
  vmEnableHiBackground  = $0010; {if set turns blink bit off}
  vmDisregardVesa       = $0020; {if set forces manager to treat display
                                  as standard Vga even if Vesa installed}

  {the following option should not be set by user}
  vmIsVesa              = $8000; {if set VESA is installed}

{***************************************************************

  VideoManager -- a descendant of Root to manage mode and font changes
  for EGA, VGA and SVGA adapters.  It is intended primarily for applications
  that need to present text in either text modes or graphics modes.
  Checks for and uses VESA standard if installed. All font files must have the
  name D:\Dir\8xNSuffix.Ext. The user may specify all elements except for the
  8xN term where N is the height of the font. A single font directory, suffix
  and extension may be specified. The object is primarily designed to handle
  setting video modes for character based applications (text or graphics
  modes), saving and restoring the video states on VGA and SVGA adapters to
  take maximum advantage of the VGA standards. The saving and restoring
  facilites are not supported on EGA. The general design philosophy is to use
  the highest level routine available for the purpose at hand. This is to
  insure no problems with unusual environments.

  Example of usage:

  var VM : VideoManager;

  if (CurrentDisplay = EGA) or (CurrentDisplay = VGA) then begin
    if not VM.Init(vmClearDisplay, '', '', '', ssAllSvga) then begin
      WriteLn('VideoManager initialization failed with error ',InitStatus
      Exit;
    end;
    with VM do begin
      if not SetScreenResolution(40, 100, 0, true, false) then
        WriteLn('SetScreenResolution failed with error', GetStatus);
    end;
  end else begin
    ...handle other cases...
  end;
  VM.Done;

  Enhancements: 1) a descendant that provided screen writing methods
                   independent of mode (text or graphics) which could
                   somehow be integrated with Opro's FastWrite routines
                   (replacing them as necessary) would be very useful.
                2) think about incorporating Borland's BGI drivers for the
                   graphics text writing.
                3) Support for EGA is weak for several reasons: not really
                   interested, adpater has fewer capabilities, and don't
                   have a model for testing.
                4) Palette handling methods should be added.
                5) Take advantage of additional 256 font characters for
                   a total of 512 characters for special effects.

***************************************************************}

type
  VideoManagerPtr = ^VideoManager;
  VideoManager = object(Root)
    vmOptions          : word;
    vmLastError        : word;
    vmCurScrMode       : ScreenModeRec;
    vmFontDir          : DirStr;  {dir for font files - defaults to same as program}
    vmFontSuffix       : NameStr; {suffix to be appended to '8xN' - defaults to blank}
    vmFontExt          : ExtStr;  {extension of font files including '.'- defaults to blank}
    vmVgaState         : VgaStatePtr;
    vmVgaInfo          : VgaInfoBlockPtr; {only valid during Init}
    vmModeTable        : ModeNumTablePtr;
    vmVgaModeInfo      : ModeInfoBlockPtr;
    vmStates           : word;
    vmUserModes        : ScreenModeArPtr;
    vmSaveBuffer       : pointer;
    vmSaveBufLen       : word;
    vmFontBuffer       : pointer;
    vmFontBufLen       : word;

    vmSetModeFunc      : SetModeFunc;
    vmReturnModeFunc   : ReturnModeFunc;
    vmReturnBufSizeFunc: ReturnBufSizeFunc;
    vmSaveStateFunc    : SaveStateFunc;
    vmRestoreStateFunc : RestoreStateFunc;
    vmWinProc          : SvgaWinProc;


    constructor Init(Options: word; FontDir: DirStr; FontSuffix: NameStr;
                     FontExt: ExtStr; States: word; UserModes: ScreenModeArPtr);
      {-Initializes VideoManager.  Options are selected from the VideoManager
        options above.  FontDir, FontSuffix, and FontExt may be specified or
        blank.  If FontDir is blank, font files are expected to be in same
        directory as one from which program was loaded.  States is a bit
        mapped value using Save State masks in VGA unit.  If ssSvgaAll is
        specified and VESA is not supported, it is adjusted accordingly.
        VESA is checked for and the appropriate functions are assigned the
        various methods.  If a VGA or above is found, the appropriate info
        block or state table are filled in. vmCurScrMode is updated.
        If vmSaveStateOnInit in Options
        is set, the states specified in States are saved on all but EGA.}

    destructor Done; virtual;
      {-If vmSaveStateOnInit and vmRestoreStateOnDone are set in Options,
        the initial state is restored.  All allocated data structures are
        deallocated.}

    function SetScreenResolution(Rows, Cols: byte; Mode: word;
                                 UserFont, TextOnly: boolean): boolean;
      {-This is primary method for users and does most of the work for
        which the object was created.  If SvgaMode is 0, the appropriate
        ScreenModeArrays in VGA unit (StdEgaModes, SplEgaModes, StdVgaModes
        SplVgaModes) are checked to locate a mode with the specifed Rows and
        Cols.  If special fonts are not available, only the standard modes
        can be used.  If UserFont is true, even if the mode is a standard
        mode, the appropriate special font in the font directory will be
        used.  If the mode is a special mode, a special font will be used
        regardless of the setting of UserFont.  This methods sets the
        appropriate scan lines, video mode, and font to achieve the requested
        resolution.  Before exiting ReturnCurMode is called to set all of
        the relevant data structures.  If Mode is not 0, that mode is set
        regardless of Rows and Cols values; however an attempt is made to
        achieve the specified Rows and Cols by selecting the appropriate
        font if possible.  If UserFont is true, the appropriate special font
        will be loaded even though a ROM based font exists.  If TextOnly is
        true, only text modes will be used. Returns true if successful. If
        returns false, check GetStatus for error.}

    function GetStatus: word;
      {-Returns last error and resets error variable to zero.}

    procedure OptionsOn(Options: word);

    procedure OptionsOff(Options: word);

    function OptionIsOn(Options: word): boolean;

    function FindScreenMode(var ScrMode: ScreenModeRec;
                            TextOnly: boolean): boolean;
      {-Searches StdXxxModes, SplXxxModes, StdSvgaModes and vmUserModes for
      matching resolution and video mode if smVidMode is non-zero in the
      incoming ScrMode. smRows and smCols must be non-zero to distinguish
      exactly which screen mode is wanted. Returns true if one is found with
      the rest of ScrMode filled in. If no matching mode is found, returns
      false.  The screen mode arrays are searched in the order listed above.}

    function ReturnInfo(Mode: word): EnhDisplayType;
      {-Returns type of display: eEGA, eVGA, eVESA.  If eEGA, nothing else is
        returned.  If eVGA, the VgaStateTable pointed to by vmVgaState
        will be filled in.  If eVESA, in addition to the VgaStateTable the
        ModeInfoBlock pointed to by vmVgaModeInfo will also be filled in.
        Be sure to check miModeAttrs to see if optional date in ModeInfoBlock
        is present before trying to use it.
        GetStatus should be checked afterward to make sure there was no
        error.}

    function SetMode(Mode: word): boolean;
      {-Sets specified mode.  Returns true if successful.  Status should be
        checked with GetStatus if it returns false.  GetStatus will return
        ecVgaFuncFailed or ecSvgaFuncFailed.
        Video display memory clearing, blink setting and palette preserving
        depends on setting of Options. ReturnCurMode is called at end to make
        sure data structures are current.}

    function ReturnCurMode: word;
      {-Returns current video mode and sets data structures.}

    function SaveState: boolean;
      {-Determines size of required save buffer depending on options specified
        in States argument at initialization, allocates buffer and saves
        states.  Returns true if successful.  This facility is not supported
        on EGA's and will return false in that case.}

    function RestoreState: boolean;
      {-Restores states previously saved with SaveState.  Will fail if states
        not previously saved.}

    function SetFont(FontName: string; ScrMode: ScreenModeRec): boolean; virtual;
      {-Used to load a font.  If FontName is blank a standard ROM based
        font of appropriate size will be loaded. Otherwise FontName must
        identify a complete font file of the appropriate size
        for the current video mode and scan lines.  If the font buffer is
        allocated, it will be deallocated if necessary and a new one of
        appropriate size will be allocated.  Returns true if successful;
        otherwise check GetStatus.}


    {*** Internal methods that should not be necessary to use externally ***}

    function ReturnSaveBufferSize: word;
      {-Returns status and size of save state buffer in Size (in bytes).  Must be
        called before SaveVgaState to get size of required buffer. States is
        bit mapped to indicate which states are to be saved.  See bit masks above.}

  end;


{**********************************************************}

implementation

{*** VideoManager Methods ***}

constructor VideoManager.Init(Options: word; FontDir: DirStr;
                              FontSuffix: NameStr;
                              FontExt: ExtStr; States: word;
                              UserModes: ScreenModeArPtr);
  {-Initializes VideoManager.  Options are selected from the VideoManager
    options above.  FontDir, FontSuffix, and FontExt may be specified or
    blank.  If FontDir is blank, font files are expected to be in same
    directory as one from which program was loaded.  States is a bit
    mapped value using Save State masks in VGA unit.  If ssSvgaAll is
    specified and VESA is not supported, it is adjusted accordingly.
    VESA is checked for and the appropriate functions are assigned the
    various methods.  If a VGA or above is found, the appropriate info
    block or state table is filled in. If vmSaveStateOnInit in Options
    is set, the states specified in States are saved on all but EGA.}
begin
  if not Root.Init then
    Fail;
  vmOptions          := Options;
  if OptionIsOn(vmRestoreStateOnDone) and
    (not OptionIsOn(vmSaveStateOnInit)) then begin
    InitStatus := ecBadParam;
    Fail;
  end;
  if OptionIsOn(vmSaveStateOnInit) and (CurrentDisplay = EGA) then
    OptionsOff(vmSaveStateOnInit+vmRestoreStateOnDone);
  OptionsOff(vmIsVesa);
  vmLastError        := 0;
  FillChar(vmCurScrMode, SizeOf(ScreenModeRec), 0);
  vmFontDir          := FontDir;
  if vmFontDir = '' then
    vmFontDir := JustPathName(FExpand(ParamStr(0)));
  vmFontSuffix       := FontSuffix;
  if Length(vmFontSuffix) > 4 then begin
    InitStatus := ecBadParam;
    Fail;
  end;
  vmFontExt          := FontExt;
  vmStates           := States;
  vmUserModes        := UserModes;
  vmVgaState         := nil;
  vmVgaInfo          := nil;
  vmModeTable        := nil;
  vmVgaModeInfo      := nil;
  vmSaveBuffer       := nil;
  vmSaveBufLen       := 0;
  vmFontBuffer       := nil;
  vmFontBufLen       := 0;

  case CurrentDisplay of
    EGA : begin
      vmSetModeFunc := SetVgaMode;
      vmReturnModeFunc := ReturnCurVgaMode;
      OptionsOff(vmSaveStateOnInit+vmRestoreStateOnDone);
      OptionsOn(vmClearDisplay);
    end;
    VGA : begin
      if not OptionIsOn(vmDisregardVesa) then begin
        if not GetMemCheck(vmVgaInfo, SizeOf(VgaInfoBlock)) then begin
          InitStatus := ecOutOfMemory;
          Fail;
        end;
        vmLastError := ReturnSvgaInfo(vmVgaInfo);
      end;
      if OptionIsOn(vmDisregardVesa) or
         (vmLastError = ecVesaNotSupported) or
         (vmVgaInfo^.viSign <> VesaSignature)  then begin
        vmSetModeFunc    := SetVgaMode;
        vmReturnModeFunc := ReturnCurVgaMode;
        vmReturnBufSizeFunc := ReturnVgaSaveBufferSize;
        vmSaveStateFunc  := SaveVgaState;
        vmRestoreStateFunc := RestoreVgaState;
        vmStates := vmStates and not ssSvga;
        FreeMemCheck(vmVgaInfo, SizeOf(VgaInfoBlock));
      end else begin
        OptionsOn(vmIsVesa);
        vmSetModeFunc    := SetSvgaMode;
        vmReturnModeFunc := ReturnCurSvgaMode;
        vmReturnBufSizeFunc := ReturnSvgaSaveBufferSize;
        vmSaveStateFunc  := SaveSvgaState;
        vmRestoreStateFunc := RestoreSvgaState;
        vmModeTable := vmVgaInfo^.viModes;
        FreeMemCheck(vmVgaInfo, SizeOf(VgaInfoBlock));
        if not GetMemCheck(vmVgaModeInfo, SizeOf(ModeInfoBlock)) then begin
          InitStatus := ecOutOfMemory;
          Done;
          Fail;
        end;
      end;
      if not GetMemCheck(vmVgaState, SizeOf(VgaStateTable)) then begin
        InitStatus := ecOutOfMemory;
        Done;
        Fail;
      end;
      vmLastError := 0;
      if OptionIsOn(vmSaveStateOnInit) then begin
        if not SaveState then begin
          InitStatus := GetStatus;
          Done;
          Fail;
        end;
      end;
    end;
  end;
  if ReturnCurMode = $FFFF then begin
    InitStatus := GetStatus;
    Done;
    Fail;
  end;
  OrigBlinkOff := CurBlinkOff;
  CurBlinkOff := OptionIsOn(vmEnableHiBackground);
  SetBlink(not CurBlinkOff);
end;

destructor VideoManager.Done;
  {-If vmSaveStateOnInit and vmRestoreStateOnDone are set in Options,
    the initial state is restored.  All allocated data structures are
    deallocated.}
begin
  if OptionIsOn(vmRestoreStateOnDone) and (vmSaveBuffer <> nil) then
    RestoreState;
  FreeMemCheck(vmVgaState, SizeOf(VgaStateTable));
  FreeMemCheck(vmVgaInfo, SizeOf(VgaInfoBlock));
  FreeMemCheck(vmVgaModeInfo, SizeOf(ModeInfoBlock));
  FreeMemCheck(vmSaveBuffer, vmSaveBufLen);
  FreeMemCheck(vmFontBuffer, vmFontBufLen);
  Root.Done;
end;

function VideoManager.SetScreenResolution(Rows, Cols: byte; Mode: word;
                                          UserFont, TextOnly: boolean): boolean;
  {-This is primary method for users and does most of the work for
    which the object was created.  If SvgaMode is 0, the appropriate
    ScreenModeArrays in VGA unit (StdEgaModes, SplEgaModes, StdVgaModes
    SplVgaModes) are checked to locate a mode with the specifed Rows and
    Cols.  If special fonts are not available, only the standard modes
    can be used.  If UserFont is true, even if the mode is a standard
    mode, the appropriate special font in the font directory will be
    used.  If the mode is a special mode, a special font will be used
    regardless of the setting of UserFont.  This methods sets the
    appropriate scan lines, video mode, and font to achieve the requested
    resolution.  Before exiting ReturnCurMode is called to set all of
    the relevant data structures.  If Mode is not 0, that mode is set
    regardless of Rows and Cols values; however an attempt is made to
    achieve the specified Rows and Cols by selecting the appropriate
    font if possible.  If UserFont is true, the appropriate special font
    will be loaded even though a ROM based font exists.  If TextOnly is
    true, only text modes will be used. Returns true if successful. If
    returns false, check GetStatus for error.}

var
  ScrMode : ScreenModeRec;
  Standard : boolean;
  FontName : PathStr;
  SvgaInfo : ModeInfoBlock;
begin
  SetScreenResolution := false;
  with ScrMode do begin
    smRows := Rows;
    smCols := Cols;
    smVidMode := Mode;
    if Mode = 0 then begin
      if not FindScreenMode(ScrMode, TextOnly) then begin
        vmLastError := ecScrResolNotSupported;
        Exit;
      end;
    end else begin
      if not FindScreenMode(ScrMode, TextOnly) then begin
        if Mode > $FF then begin
          if not OptionIsOn(vmIsVesa) then begin
            vmLastError := ecVesaNotSupported;
            Exit;
          end;
          if not FindSvgaMode(Mode, vmModeTable) then begin
            vmLastError := ecScrResolNotSupported;
            Exit;
          end;
          vmLastError := ReturnSvgaModeInfo(Mode, @SvgaInfo);
          if vmLastError <> 0 then Exit;
          with SvgaInfo do begin
            if not FlagIsSet(miModeAttrs, miHardwareSupport) then begin
              vmLastError := ecScrResolNotSupported;
              Exit;
            end;
            smIsText := not FlagIsSet(miModeAttrs, miGraphicsMode);
            if FlagIsSet(miModeAttrs, miOptDataAvail) then begin
              smFontSize := miYFontSize;
              if smIsText then begin
                smRows   := miYResolution;
                smCols   := miXResolution;
              end else begin
                smRows   := Byte(miYResolution div miYFontSize);
                smCols   := Byte(miXResolution div miXFontSize);
              end;
              smPixH     := miYResolution;
              smPixW     := miXResolution;
              smColors   := 1 shl miBitsPerPixel;
            end else begin
              vmLastError := ecScrResolNotSupported;
              Exit;
            end;
          end;
        end else begin
          vmLastError := ecScrResolNotSupported;
          Exit;
        end;
      end;
    end;
    case CurrentDisplay of
      EGA : Standard := smFontSize in StdEgaFonts;
      VGA : begin
        Standard := smFontSize in StdVgaFonts;
        if smIsText then begin
          vmLastError := SetScanLines(smPixH);
          if vmLastError <> 0 then Exit;
        end;
      end;
    end;
    if not SetMode(smVidMode) then Exit;
    if (Standard and (not UserFont)) then
      FontName := ''
    else begin
      FontName := AddBackSlash(vmFontDir)+'8x'+Long2Str(smFontSize)+
        vmFontSuffix+vmFontExt;
    end;
    if not SetFont(FontName, ScrMode) then Exit;
    SetScreenResolution := (ReturnCurMode = smVidMode);
  end;
end;

  {need to think about cursor and key repeat rate}
(*
    if IsText then begin
      {make sure we have a good text cursor}
      case Rows of
        25 : if CurrentDisplay = EGA then
             begin CH := $0B; CL := $0C; end else {VGA}
             begin CH := $0D; CL := $0E; end;
        43 : begin CH := $05; CL := $07; end;
        50 : begin CH := $05; CL := $07; end;
        else CH := 0;
      end;
      if CH <> 0 then begin
        AH := $01;
        Intr($10, Regs);
        end;
    end else begin
      {There is no cursor in graphics modes; however DV generates one }
      {and subsequent DV windows opened have a cursor in standard modes.}
    end;
*)

function VideoManager.GetStatus: word;
  {-Returns last error and resets error variable to zero.}
begin
  GetStatus := vmLastError;
  vmLastError := 0;
end;

procedure VideoManager.OptionsOn(Options: word);
begin
  vmOptions := vmOptions or Options;
end;

procedure VideoManager.OptionsOff(Options: word);
begin
  vmOptions := vmOptions and not Options;
end;

function VideoManager.OptionIsOn(Options: word): boolean;
begin
  OptionIsOn := FlagIsSet(vmOptions, Options);
end;

function VideoManager.FindScreenMode(var ScrMode: ScreenModeRec;
                                     TextOnly: boolean): boolean;
  {-Searches StdXxxModes, SplXxxModes and vmUserModes for matching resolution
    and video mode if smVidMode is non-zero in the incoming ScrMode. smRows
    and smCols must be non-zero to distinguish exactly which screen mode is
    wanted.  Returns true if one is found with the rest of ScrMode filled in.
    If no matching mode is found, returns false.}
var
  Mode : word;
begin
  FindScreenMode := false;
  case CurrentDisplay of
    EGA : begin
      if ReturnScreenMode(@StdEgaModes, ScrMode) then begin
        FindScreenMode := true;
        Exit;
      end;
      if ReturnScreenMode(@SplEgaModes, ScrMode) then begin
        FindScreenMode := true;
        Exit;
      end;
    end;
    VGA : begin
      Mode := ScrMode.smVidMode;
      if ReturnScreenMode(@StdVgaModes, ScrMode) then begin
        if ((not TextOnly) or (TextOnly and ScrMode.smIsText)) then begin
          FindScreenMode := true;
          Exit;
        end;
        ScrMode.smVidMode := Mode;
      end;
      if ReturnScreenMode(@SplVgaModes, ScrMode) then begin
        if ((not TextOnly) or (TextOnly and ScrMode.smIsText)) then begin
          FindScreenMode := true;
          Exit;
        end;
        ScrMode.smVidMode := Mode;
      end;
      if OptionIsOn(vmIsVesa) and ReturnScreenMode(@StdSvgaModes, ScrMode) then begin
        if ((not TextOnly) or (TextOnly and ScrMode.smIsText)) then begin
          if FindSvgaMode(Mode, vmModeTable) then begin
            FindScreenMode := true;
            Exit;
          end;
        end;
        ScrMode.smVidMode := Mode;
      end;
      if (vmUserModes <> nil) and ReturnScreenMode(vmUserModes, ScrMode) then begin
        if ((not TextOnly) or (TextOnly and ScrMode.smIsText)) then begin
          FindScreenMode := true;
          Exit;
        end;
      end;
    end;
  end;
end;

function VideoManager.ReturnInfo(Mode: word): EnhDisplayType;
  {-Returns type of display: eEGA, eVGA, eVESA.  If eEGA, nothing else is
    returned.  If eVGA, the VgaStateTable pointed to by vmVgaState
    will be filled in.  If eVESA, in addition to the VgaStateTable the
    ModeInfoBlock pointed to by vmVgaModeInfo will also be filled in.
    GetStatus should be checked afterward to make sure there was no
    error.}
begin
  ReturnInfo := eEGA;
  if CurrentDisplay = EGA then Exit;
  if OptionIsOn(vmIsVesa) then begin
    vmLastError := ReturnSvgaModeInfo(Mode, vmVgaModeInfo);
    case vmLastError of
      0 : begin
        vmWinProc := vmVgaModeInfo^.miWinProc;
        ReturnInfo := eVESA;
      end;
      ecVesaNotSupported : Exit;
      ecVesaFuncFailed   : ReturnInfo := eVGA;  {not a VESA SVGA mode}
    end;
  end else
    ReturnInfo := eVGA;
  vmLastError := ReturnVgaInfo(vmVgaState);
end;

function VideoManager.SetMode(Mode: word): boolean;
  {-Sets specified mode.  Returns true if successful.  Status should be
    checked with GetStatus if it returns false.  GetStatus will return
    ecVgaFuncFailed or ecSvgaFuncFailed.
    Video display memory clearing and palette preserving depends on
    setting of Options.}
var
  MI : ModeInfoBlock;
begin
  SetMode := false;
  if (OptionIsOn(vmIsVesa) and (Mode > $FF))then begin
    if not FindSvgaMode(Mode, vmModeTable) then begin
      vmLastError := ecVesaModeNotSupported;
      Exit;
    end;
    vmLastError := ReturnSvgaModeInfo(Mode, @MI);
    if vmLastError <> 0 then Exit;
    if not FlagIsSet(MI.miModeAttrs, miHardwareSupport) then begin
      vmLastError := ecVesaModeNotSupported;
      Exit;
    end;
  end;
  if (CurrentDisplay = VGA) then begin
    vmLastError := PreservePalette(OptionIsOn(vmPreservePalette));
    if vmLastError <> 0 then Exit;
  end;
  vmLastError := vmSetModeFunc(Mode, OptionIsOn(vmClearDisplay));
  if vmLastError <> 0 then Exit;
  SetMode := true;
end;

function VideoManager.ReturnCurMode: word;
  {-Returns current video mode and updates vmCurScrMode as well as global
    variables CurVideoMode, CurScreenRows and CurScreenCols. If VESA is
    installed, it also updates the ModeInfoBlock pointed to by vmVgaModeInfo.
    If it fails for any reason, it returns mode $FFFF and GetStatus should
    be checked.}
var
  Mode : word;
  P : pointer;
  Disp : EnhDisplayType;
begin
  ReturnCurMode := $FFFF;
  vmLastError := vmReturnModeFunc(Mode);
  if vmLastError <> 0 then Exit;
  with vmCurScrMode do begin
    smVidMode := Mode;
    Disp := ReturnInfo(Mode);
    if vmLastError <> 0 then Exit;
    with vmVgaState^, vmVgaModeInfo^ do begin
      case Disp of
        eEGA : begin
          smIsText   := (Byte(Mode) in StdTextModes);
          smFontSize := BiosCharH;
          smRows     := BiosRows+1;
          smCols     := BiosCols;
          smPixW     := 0;      {do not have good way of getting this}
          if smIsText then
            smPixH := 350
          else
            smPixH := 0;
          {smColors := need way of getting this}
        end;
        eVGA : begin
          smIsText   := (vsAddr <> $A000);  {this is not exactly true}
          smFontSize := vsCharHigh;
          smRows     := vsRows;
          smCols     := vsCols;
          smPixW     := 0;  {do not have good way of getting this}
          if smIsText then
            smPixH := ScanLines[vsNrScanLns]
          else
            smPixH := 0;    {do not have good way of getting this}
          smColors := vsNrColors;
          CurBlinkOff := (not FlagIsSet(vsMiscInfo, vsBlink));
        end;
        eVESA : begin
          smIsText   := (not FlagIsSet(miModeAttrs, miGraphicsMode));
          if FlagIsSet(miModeAttrs, miOptDataAvail) then begin
            smFontSize := miYFontSize;
            if smIsText then begin
              smRows     := miYResolution;
              smCols     := miXResolution;
            end else begin
              smRows     := Byte(miYResolution div miYFontSize);
              smCols     := Byte(miXResolution div miXFontSize);
            end;
            smPixW     := miXResolution;
            smPixH     := miYResolution;
            smColors   := 1 shl miBitsPerPixel;
          end else begin
            smFontSize := vsCharHigh;
            smRows     := vsRows;
            smCols     := vsCols;
            smPixW     := 0;
            if smIsText then
              smPixH := ScanLines[vsNrScanLns]
            else
              smPixH := 0;
            smColors := vsNrColors;
          end;
          CurBlinkOff := (not FlagIsSet(vsMiscInfo, vsBlink));
        end;
      end;
    end;
    CurScreenRows := smRows;
    CurScreenCols := smCols;
    CurVideoMode  := Mode;
  end;
  ReturnCurMode := Mode;
end;

function VideoManager.SaveState: boolean;
  {-Determines size of required save buffer depending on options specified
    in States argument at initialization, allocates buffer and saves
    states.  Returns true if successful.  This facility is not supported
    on EGA's and will return false in that case.}
var
  Bytes : word;
begin
  SaveState := false;
  if CurrentDisplay = EGA then Exit;
  Bytes := ReturnSaveBufferSize;
  if vmLastError <> 0 then Exit;
  if not GetMemCheck(vmSaveBuffer, Bytes) then begin
    vmLastError := ecOutOfMemory;
    Exit;
  end;
  DisableVideoRefresh(true);
  vmSaveBufLen := Bytes;
  {saving the Svga state if you are not in one seems to cause a problem}
  if vmCurScrMode.smVidMode < $100 then
    ClearFlag(vmStates, ssSvga);
  vmLastError := vmSaveStateFunc(vmSaveBuffer, vmStates);
  if vmLastError <> 0 then Exit;
  {Phoenix AT Systems BIOS reference says saving modifies video registers}
  vmLastError := vmRestoreStateFunc(vmSaveBuffer, vmStates);
  DisableVideoRefresh(false);
  SaveState := (vmLastError = 0);
end;

function VideoManager.RestoreState: boolean;
  {-Restores states previously saved with SaveState.  Will fail if states
    not previously saved.}
var
  FontName : PathStr;
begin
  RestoreState := false;
  if CurrentDisplay = EGA then Exit;
  if vmSaveBuffer = nil then begin
    vmLastError := ecStateNotSaved;
    Exit;
  end;
  DisableVideoRefresh(true);
  vmLastError := vmRestoreStateFunc(vmSaveBuffer, vmStates);
  FreeMemCheck(vmSaveBuffer, vmSaveBufLen);
  {unfortunately the restore functions do not restore a non-standard font}
  {so must do it separately}
  ReturnCurMode;
  with vmCurScrMode do
    if smFontSize in StdVgaFonts then
      FontName := ''
    else
      FontName := AddBackSlash(vmFontDir)+'8x'+Long2Str(smFontSize)+vmFontExt;
  SetFont(FontName, vmCurScrMode);
  {at least on some systems video refresh is disabled in the above steps}
  DisableVideoRefresh(false);
  RestoreState := (vmLastError = 0);
end;

function VideoManager.SetFont(FontName: string; ScrMode: ScreenModeRec): boolean;
  {-Used to load a font.  If FontName is blank a standard ROM based
    font of appropriate size will be loaded. Otherwise FontName must
    identify a complete font file of the appropriate size
    for the current video mode and scan lines.  If the font buffer is
    allocated, it will be deallocated if necessary and a new one of
    appropriate size will be allocated.  Returns true if successful;
    otherwise check GetStatus.}
begin
  SetFont := false;
  with ScrMode do begin
    if vmFontBuffer <> nil then begin
      if (vmFontBufLen div 256) <> smFontSize then
        FreeMemCheck(vmFontBuffer, vmFontBufLen);
    end;
    if vmFontBuffer = nil then begin
      vmFontBufLen := Word(256)*smFontSize;
      if not GetMemCheck(vmFontBuffer, vmFontBufLen) then begin
        vmLastError := ecOutOfMemory;
        Exit;
      end;
    end;
    vmLastError := SetVgaFont(FontName, ScrMode, vmFontBuffer);
    if vmLastError <> 0 then begin
      FreeMemCheck(vmFontBuffer, vmFontBufLen);
      Exit;
    end;
    if smIsText then
      FreeMemCheck(vmFontBuffer, vmFontBufLen);
  end;
  SetFont := true;
end;

{*** Internal methods that should not be necessary to use externally ***}

function VideoManager.ReturnSaveBufferSize: word;
  {-Returns size of save state buffer in bytes.  Called internally by
    SaveState to get size of required buffer. Uses value of vmStates to
    determine which states are to be saved.}
var
  Size : word;
begin
  ReturnSaveBufferSize := 0;
  if CurrentDisplay = EGA then Exit;
  vmLastError := vmReturnBufSizeFunc(Size, vmStates);
  if vmLastError <> 0 then Exit;
  ReturnSaveBufferSize := Size;
end;

{**********************************************************}

end.