mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 13:45:58 +02:00
+ Added example of custom video driver
This commit is contained in:
parent
4b6709ce41
commit
ef8e984bcb
@ -46,7 +46,8 @@ onetex : tex
|
||||
$(MAKETEX) $(TEXOBJECTS)
|
||||
|
||||
clean :
|
||||
rm -f *.o *.s $(OBJECTS) $(TEXOBJECTS) vidutil.ppu vidutil.o
|
||||
rm -f *.o *.s $(OBJECTS) $(TEXOBJECTS)
|
||||
rm -f vidutil.ppu vidutil.o viddbg.ppu viddbg.o Video.log
|
||||
|
||||
$(OBJECTS): %: %.pp vidutil.ppu
|
||||
$(PP) $(PPOPTS) $*
|
||||
|
@ -1,6 +1,7 @@
|
||||
This directory contains the examples for the video unit documentation.
|
||||
|
||||
vidutil.pp Containst the textout function.
|
||||
vidutil.pp Contains the textout function.
|
||||
viddbg.pp contains an example of how to write a custom video driver.
|
||||
|
||||
ex1.pp demonstrates the vidutil unit.
|
||||
ex2.pp contains an example of the SetCursorPos function.
|
||||
|
142
docs/videoex/viddbg.pp
Normal file
142
docs/videoex/viddbg.pp
Normal file
@ -0,0 +1,142 @@
|
||||
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.
|
Loading…
Reference in New Issue
Block a user