1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
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.
|
