mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 06:29:16 +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)
|
$(MAKETEX) $(TEXOBJECTS)
|
||||||
|
|
||||||
clean :
|
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
|
$(OBJECTS): %: %.pp vidutil.ppu
|
||||||
$(PP) $(PPOPTS) $*
|
$(PP) $(PPOPTS) $*
|
||||||
|
@ -1,6 +1,7 @@
|
|||||||
This directory contains the examples for the video unit documentation.
|
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.
|
ex1.pp demonstrates the vidutil unit.
|
||||||
ex2.pp contains an example of the SetCursorPos function.
|
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