Category : Pascal Source Code
Archive   : QWIK5X.ZIP
Filename : QBENCH.PAS

{ =========================================================================== }
{ Qbench.pas - produces a 'Screens/second' table for ver 5.x, 12-20-88 }
{ QWIK Screen utilities. }
{ This will just give you a good feel for speed. The time is adjusted for }
{ an average 8 second test for each condition - total of 56 seconds. For }
{ more accurate results, change TestTime:=16. Or for a quicker but less }
{ accurate test, change TestTime:=2. }
{ =========================================================================== }

uses CRT,Qwik;

{$i timerd12.inc}

type
Attrs = (Attr,NoAttr);
Procs = (Qwrites,Qfills,Qattrs,Qstores,Qscrolls);

const
TestTime = 8; { TestTime in seconds for each case. 8 gives +/- 1% }

var
Attrib, Count, Screens: integer;
Row, Col, Rows, Cols: byte;
ScrPerSec: array[Qwrites..Qscrolls] of array[Attr..NoAttr] of real;
Strng: string[80];
Proc: Procs;
A: Attrs;
Names: array[Qwrites..Qscrolls] of string[80];
FV: text;
ToDisk: boolean;
Ch: char;

{ Since Zenith doesn't have snow on any CGAs, turn off snow checking }
procedure CheckZenith;
var ZdsRom: array[1..8] of char absolute $F000:$800C;
begin
if Qsnow and (ZdsRom='ZDS CORP') then
begin
Qsnow := false;
CardSnow := false;
end;
end;

procedure ClearScr;
begin
Qfill (1,1,CRTrows,CRTcols,Yellow+BlackBG,' ');
end;

procedure CheckTime;
begin
Strng:='TimerTest ';
for Col:=1 to 3 do Strng:=Strng+Strng;
ClearScr;
timer (start);
for Count:=1 to Screens do
for row:=1 to 25 do
Qwrite (Row,1,Yellow,Strng);
timer (Stop);
Screens:=trunc(Screens*TestTime/ElapsedTime);
end;

procedure AssembleStrng (Proc: Procs; Attrib: integer);
begin
Strng:=Names[Proc];
if Qsnow then
Strng:=Strng+' Wait '
else Strng:=Strng+' No Wait ';
if Attrib=SameAttr then
Strng:=Strng+' No Attr '
else Strng:=Strng+' w/ Attr ';
fillchar (Strng[32],49,byte(Proc)+49);
Strng[0]:=#80;
end;

procedure TimeWriting (Proc: Procs; Attrib: integer);
var A: Attrs;
begin
if Attrib=SameAttr then
begin
Qattr (1,1,CRTrows,CRTcols,LightGray);
A:=NoAttr;
end
else A:=Attr;
AssembleStrng (Proc,Attrib);
case Proc of
Qwrites:
begin
timer (start);
for Count:=1 to Screens do
for Row:=1 to 25 do
Qwrite (Row,1,Attrib,Strng);
timer (Stop);
end;
Qfills:
begin
timer (start);
for Count:=1 to Screens do
Qfill (1,1,25,80,Attrib,'f');
timer (Stop);
end;
Qattrs:
begin
Qfill (1,1,25,80,Attrib,'a');
timer (start);
for Count:=1 to Screens do
Qattr (1,1,25,80,Attrib);
timer (Stop);
end;
end; { Case Proc of }
if ElapsedTime<>0.0 then
ScrPerSec[Proc,A]:=Screens/ElapsedTime;
end;

procedure TimeMoving (Proc: Procs; Attrib: integer);
var ScrArray: array[1..4000] of byte;
begin
AssembleStrng (Proc,Attrib);
for Row:=1 to 25 do
Qwrite (Row,1,Attrib,Strng);
case Proc of
Qstores:
begin
timer (start);
for Count:=1 to Screens do
QstoreToMem (1,1,25,80,ScrArray);
timer (Stop);
end;
Qscrolls:
begin
timer (start);
for Count:=1 to Screens do
QscrollUp (1,1,25,80,SameAttr);
timer (Stop);
end;
end; { Case Proc of }
ScrPerSec[Proc,Attr]:=Screens/ElapsedTime;
end;

begin
CheckZenith;
TextAttr:=Yellow;
ClearScr;
if Qsnow then
begin
Qsnow:=false;
repeat
repeat
QwriteC (12,1,80,-1,'Do you see snow? [Y/N]?');
GotoEos;
until Keypressed;
Ch:=ReadKey;
until Ch in ['Y','y','N','n'];
case upcase(Ch) of
'Y': Qsnow:=true;
'N': begin
QwriteC (10,1,80,-1,'Congratulations! You have a card better');
QwriteC (11,1,80,-1,'than the standard IBM CGA.');
QwriteC (12,1,80,-1,'However, to make it faster, you will need');
QwriteC (13,1,80,-1,'to set Qsnow:=false manually.');
QwriteC (14,1,80,-1,'Please contact us about this.');
QwriteC (16,1,80,-1,'Press any key ...');
GotoRC (16,49);
Ch:=ReadKey;
if Ch=#00 then Ch:=ReadKey;
end;
end;
end;
ClearScr;
QwriteC (12,1,CRTcols,-1,'Data to Screen or Disk [s/d]? ');
GotoEos;
repeat
Ch:=ReadKey;
until Ch in ['S','s','D','d',^M];
if upcase(Ch)='D' then
ToDisk:=true
else ToDisk:=false;
ModCursor (CursorOff);

for Proc:=Qwrites to Qscrolls do
for A:=Attr to NoAttr do
ScrPerSec[Proc,A]:=0.0;

Names[Qwrites ]:= ' Qwrite- ';
Names[Qfills ]:= ' Qfill- ';
Names[Qattrs ]:= ' Qattr- ';
Names[Qstores ]:= ' Qstore- ';
Names[Qscrolls]:= ' Qscroll- ';

if Qsnow then
Screens:=8 { First guess for screens }
else Screens:=80; { First guess for screens }
CheckTime;
TimeWriting (Qwrites ,Yellow);
TimeWriting (Qwrites ,SameAttr);
TimeWriting (Qfills ,Yellow);
TimeWriting (Qfills ,SameAttr);
TimeWriting (Qattrs ,Yellow);
TimeMoving (Qstores ,Yellow);
TimeMoving (Qscrolls,Yellow);

ClearScr;
if ToDisk then
assign (FV,'Qbench.dta')
else assignCRT (FV);
rewrite (FV);
GotoRC (1,1);
writeln (FV,'S C R E E N S / S E C O N D');
writeln (FV,' Chng');
writeln (FV,'Procedure Attr S/sec Typical for these procedures:');
write (FV,'--------- ---- ----- -----------------------------');
writeln (FV,'------------------');
for Proc:=Qwrites to Qfills do
for A:=Attr to NoAttr do
begin
if A=Attr then
write (FV,Names[Proc])
else write (FV,' ');
if A=Attr then
write (FV,'Yes ')
else write (FV,'No ');
write (FV,ScrPerSec[Proc,A]:5:1,' ');
if A=Attr then
case Proc of
Qwrites:
writeln (FV,'Qwrite, QwriteC, QwriteA, QwriteEos, QwriteEosA');
Qfills: writeln (FV,'Qfill, QfillC, QfillEos');
end
else writeln (FV);
end;
for Proc:=Qattrs to Qscrolls do
begin
write (FV,Names[Proc]);
if Proc=Qattrs then
write (FV,'Yes ')
else write (FV,'n/a ');
write (FV,ScrPerSec[Proc,Attr]:5:1,' ');
case Proc of
Qattrs: writeln (FV,'Qattr, QattrEos');
Qstores:
writeln (FV,'QstoreToMem, QstoreToScr, QscrToVscr, QVscrToScr');
Qscrolls:writeln (FV,'QscrollUp, QscrollDown');
end
end;
GotoRC (13,1);
writeln (FV,'SystemID = ',SystemID);
writeln (FV,'CPU ID = ',CpuID);
writeln (FV,'Wait-for-retrace = ',Qsnow);
writeln (FV,'Screens/test = ',Screens);
close (FV);
GotoRC (24,1);
SetCursor (CursorInitial);
end.