[Previous][Up] Reference for unit 'video' (#rtl)

Writing a custom video driver

Writing a custom video driver is not difficult, and generally means implementing a couple of functions, which whould be registered with the SetVideoDriver function. The various functions that can be implemented are located in the TVideoDriver record:

TVideoDriver = Record
  InitDriver        : Procedure;
  DoneDriver        : Procedure;
  UpdateScreen      : Procedure(Force : Boolean);
  ClearScreen       : Procedure;
  SetVideoMode      : Function (Const Mode : TVideoMode) : Boolean;
  GetVideoModeCount : Function : Word;
  GetVideoModeData  : Function(Index : Word; Var Data : TVideoMode) : Boolean;
  SetCursorPos      : procedure (NewCursorX, NewCursorY: Word);
  GetCursorType     : function : Word;
  SetCursorType     : procedure (NewType: Word);
  GetCapabilities   : Function : Word;
end;

Not all of these functions must be implemented. In fact, the only absolutely necessary function to write a functioning driver is the UpdateScreen function. The general calls in the Video unit will check which functionality is implemented by the driver.

The functionality of these calls is the same as the functionality of the calls in the video unit, so the expected behaviour can be found in the previous section. Some of the calls, however, need some additional remarks.

InitDriver
Called by InitVideo, this function should initialize any data structures needed for the functionality of the driver, maybe do some screen initializations. The function is guaranteed to be called only once; It can only be called again after a call to DoneVideo. The variables ScreenWidth and ScreenHeight should be initialized correctly after a call to this function, as the InitVideo call will initialize the VideoBuf and OldVideoBuf arrays based on their values.
DoneDriver
This should clean up any structures that have been initialized in the InitDriver function. It should possibly also restore the screen as it was before the driver was initialized. The VideoBuf and OldVideoBuf arrays will be disposed of by the general DoneVideo call.
UpdateScreen
This is the only required function of the driver. It should update the screen based on the VideoBuf array's contents. It can optimize this process by comparing the values with values in the OldVideoBuf array. After updating the screen, the UpdateScreen procedure should update the OldVideoBuf by itself. If the Force parameter is True, the whole screen should be updated, not just the changed values.
ClearScreen
If there is a faster way to clear the screen than to write spaces in all character cells, then it can be implemented here. If the driver does not implement this function, then the general routines will write spaces in all video cells, and will call UpdateScreen(True).
SetVideoMode
Should set the desired video mode, if available. It should return True if the mode was set, False if not.
GetVideoModeCount
Should return the number of supported video modes. If no modes are supported, this function should not be implemented; the general routines will return 1. (for the current mode)
GetVideoModeData
Should return the data for the Index-th mode; Index is zero based. The function should return true if the data was returned correctly, false if Index contains an invalid index. If this is not implemented, then the general routine will return the current video mode when Index equals 0.
GetCapabilities
If this function is not implemented, zero (i.e. no capabilities) will be returned by the general function.

The following unit shows how to override a video driver, with a driver that writes debug information to a file. The unit can be used in any of the demonstration programs, by simply including it in the uses clause. Setting DetailedVideoLogging to True will create a more detailed log (but will also slow down functioning)

Example

unit viddbg;

Interface

uses video;


Procedure StartVideoLogging;
Procedure StopVideoLogging;
Function  IsVideoLogging : Boolean;
Procedure  SetVideoLogFileName(FileName : String);

Const
  DetailedVideoLogging : Boolean = False;

Implementation

uses sysutils,keyboard;

var
  NewVideoDriver,
  OldVideoDriver : TVideoDriver;
  Active,Logging : Boolean;
  LogFileName : String;
  VideoLog : Text;

Function TimeStamp : String;

begin
  TimeStamp:=FormatDateTime('hh:nn:ss',Time());
end;

Procedure StartVideoLogging;

begin
  Logging:=True;
  Writeln(VideoLog,'Start logging video operations at: ',TimeStamp);
end;

Procedure StopVideoLogging;

begin
  Writeln(VideoLog,'Stop logging video operations at: ',TimeStamp);
  Logging:=False;
end;

Function IsVideoLogging : Boolean;

begin
  IsVideoLogging:=Logging;
end;

Var
  ColUpd,RowUpd : Array[0..1024] of Integer;

Procedure DumpScreenStatistics(Force : Boolean);

Var
  I,Count : Integer;

begin
  If Force then
    Write(VideoLog,'forced ');
  Writeln(VideoLog,'video update at ',TimeStamp,' : ');
  FillChar(Colupd,SizeOf(ColUpd),#0);
  FillChar(Rowupd,SizeOf(RowUpd),#0);
  Count:=0;
  For I:=0 to VideoBufSize div SizeOf(TVideoCell) do
    begin
    If VideoBuf^[i]<>OldVideoBuf^[i] then
      begin
      Inc(Count);
      Inc(ColUpd[I mod ScreenWidth]);
      Inc(RowUpd[I div ScreenHeight]);
      end;
    end;
  Write(VideoLog,Count,' videocells differed divided over ');
  Count:=0;
  For I:=0 to ScreenWidth-1 do
    If ColUpd[I]<>0 then
      Inc(Count);
  Write(VideoLog,Count,' columns and ');
  Count:=0;
  For I:=0 to ScreenHeight-1 do
    If RowUpd[I]<>0 then
      Inc(Count);
  Writeln(VideoLog,Count,' rows.');
  If DetailedVideoLogging Then
   begin
   For I:=0 to ScreenWidth-1 do
     If (ColUpd[I]<>0) then
       Writeln(VideoLog,'Col ',i,' : ',ColUpd[I]:3,' rows changed');
   For I:=0 to ScreenHeight-1 do
     If (RowUpd[I]<>0) then
       Writeln(VideoLog,'Row ',i,' : ',RowUpd[I]:3,' colums changed');
   end;
end;

Procedure LogUpdateScreen(Force : Boolean);

begin
  If Logging then
    DumpScreenStatistics(Force);
  OldVideoDriver.UpdateScreen(Force);
end;

Procedure LogInitVideo;

begin
  OldVideoDriver.InitDriver();
  Assign(VideoLog,logFileName);
  Rewrite(VideoLog);
  Active:=True;
  StartVideoLogging;
end;

Procedure LogDoneVideo;

begin
  StopVideoLogging;
  Close(VideoLog);
  Active:=False;
  OldVideoDriver.DoneDriver();
end;

Procedure SetVideoLogFileName(FileName : String);

begin
  If Not Active then
    LogFileName:=FileName;
end;

Initialization
  GetVideoDriver(OldVideoDriver);
  NewVideoDriver:=OldVideoDriver;
  NewVideoDriver.UpdateScreen:=@LogUpdateScreen;
  NewVideoDriver.InitDriver:=@LogInitVideo;
  NewVideoDriver.DoneDriver:=@LogDoneVideo;
  LogFileName:='Video.log';
  Logging:=False;
  SetVideoDriver(NewVideoDriver);
end.

Documentation generated on: May 14 2021