freepascal.compiler/docs/videoex/viddbg.pp

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.