home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / turbopas / qwik42.arc / QBENCH.PAS < prev    next >
Pascal/Delphi Source File  |  1988-10-01  |  7KB  |  254 lines
  1. { =========================================================================== }
  2. { Qbench.pas - produces a 'Screens/second' table for        ver 4.2, 10-01-88 }
  3. {              QWIK Screen utilities.                                         }
  4. { I'm not trying to support this program, so don't expect it to be perfect.   }
  5. { It will just give you a good feel for speed.  The time is adjusted for      }
  6. { an average 8 second test for each condition - total of 56 seconds.  For     }
  7. { more accurate results, change TestTime:=16.  Or for a quicker but less      }
  8. { accurate test, change TestTime:=2.                                          }
  9. { =========================================================================== }
  10.  
  11. uses CRT,Qwik;
  12.  
  13. {$i timerd12.inc}
  14.  
  15. type
  16.   Attrs = (Attr,NoAttr);
  17.   Procs = (Qwrites,Qfills,Qattrs,Qstores,Qscrolls);
  18.  
  19. const
  20.   TestTime = 8;  { TestTime in seconds for each case.  8 gives +/- 1% }
  21.  
  22. var
  23.   Attrib, Count, Screens: integer;
  24.   Row, Col, Rows, Cols: byte;
  25.   ScrPerSec: array[Qwrites..Qscrolls] of array[Attr..NoAttr] of real;
  26.   Strng:     string[80];
  27.   Proc:      Procs;
  28.   A:         Attrs;
  29.   Names:     array[Qwrites..Qscrolls] of string[80];
  30.   FV:        text;
  31.   ToDisk:    boolean;
  32.   Ch:        char;
  33.  
  34. { Since Zenith doesn't have snow on any CGAs, turn off snow checking }
  35. procedure CheckZenith;
  36. var  ZdsRom: array[1..8] of char absolute $F000:$800C;
  37. begin
  38.   if Qsnow and (ZdsRom='ZDS CORP') then
  39.     begin
  40.       Qsnow    := false;
  41.       CardSnow := false;
  42.     end;
  43. end;
  44.  
  45. procedure ClearScr;
  46. begin
  47.   Qfill  (1,1,CRTrows,CRTcols,Yellow+BlackBG,' ');
  48. end;
  49.  
  50. procedure CheckTime;
  51. begin
  52.   Strng:='TimerTest ';
  53.   for Col:=1 to 3 do Strng:=Strng+Strng;
  54.   ClearScr;
  55.   timer (start);
  56.   for Count:=1 to Screens do
  57.     for row:=1 to 25 do
  58.       Qwrite (Row,1,Yellow,Strng);
  59.   timer (Stop);
  60.   Screens:=trunc(Screens*TestTime/ElapsedTime);
  61. end;
  62.  
  63. procedure AssembleStrng (Proc: Procs; Attrib: integer);
  64. begin
  65.   Strng:=Names[Proc];
  66.   if Qsnow then
  67.        Strng:=Strng+' Wait    '
  68.   else Strng:=Strng+' No Wait ';
  69.   if Attrib=SameAttr then
  70.        Strng:=Strng+' No Attr  '
  71.   else Strng:=Strng+' w/ Attr  ';
  72.   fillchar (Strng[32],49,byte(Proc)+49);
  73.   Strng[0]:=#80;
  74. end;
  75.  
  76. procedure TimeWriting (Proc: Procs; Attrib: integer);
  77. var  A: Attrs;
  78. begin
  79.   if Attrib=SameAttr then
  80.     begin
  81.       Qattr (1,1,CRTrows,CRTcols,LightGray);
  82.       A:=NoAttr;
  83.     end
  84.   else A:=Attr;
  85.   AssembleStrng (Proc,Attrib);
  86.   case Proc of
  87.     Qwrites:
  88.        begin
  89.          timer (start);
  90.          for Count:=1 to Screens do
  91.            for Row:=1 to 25 do
  92.              Qwrite (Row,1,Attrib,Strng);
  93.          timer (Stop);
  94.        end;
  95.     Qfills:
  96.        begin
  97.          timer (start);
  98.          for Count:=1 to Screens do
  99.            Qfill (1,1,25,80,Attrib,'f');
  100.          timer (Stop);
  101.        end;
  102.     Qattrs:
  103.        begin
  104.          Qfill (1,1,25,80,Attrib,'a');
  105.          timer (start);
  106.          for Count:=1 to Screens do
  107.            Qattr (1,1,25,80,Attrib);
  108.          timer (Stop);
  109.        end;
  110.     end;  { Case Proc of }
  111.   if ElapsedTime<>0.0 then
  112.     ScrPerSec[Proc,A]:=Screens/ElapsedTime;
  113. end;
  114.  
  115. procedure TimeMoving (Proc: Procs; Attrib: integer);
  116. var  ScrArray:  array[1..4000] of byte;
  117. begin
  118.   AssembleStrng (Proc,Attrib);
  119.   for Row:=1 to 25 do
  120.     Qwrite (Row,1,Attrib,Strng);
  121.   case Proc of
  122.     Qstores:
  123.        begin
  124.          timer (start);
  125.          for Count:=1 to Screens do
  126.            QstoreToMem (1,1,25,80,ScrArray);
  127.          timer (Stop);
  128.        end;
  129.     Qscrolls:
  130.        begin
  131.          timer (start);
  132.          for Count:=1 to Screens do
  133.            QscrollUp (1,1,25,80,SameAttr);
  134.          timer (Stop);
  135.        end;
  136.   end;  { Case Proc of }
  137.   ScrPerSec[Proc,Attr]:=Screens/ElapsedTime;
  138. end;
  139.  
  140. begin
  141.   CheckZenith;
  142.   TextAttr:=Yellow;
  143.   ClearScr;
  144.   if Qsnow then
  145.     begin
  146.       Qsnow:=false;
  147.       repeat
  148.         repeat
  149.           QwriteC (12,1,80,-1,'Do you see snow? [Y/N]?');
  150.           GotoEos;
  151.         until Keypressed;
  152.         Ch:=ReadKey;
  153.       until Ch in ['Y','y','N','n'];
  154.       case upcase(Ch) of
  155.         'Y': Qsnow:=true;
  156.         'N': begin
  157.                QwriteC (10,1,80,-1,'Congratulations!  You have a card better');
  158.                QwriteC (11,1,80,-1,'than the standard IBM CGA.');
  159.                QwriteC (12,1,80,-1,'However, to make it faster, you will need');
  160.                QwriteC (13,1,80,-1,'to set Qsnow:=false manually.');
  161.                QwriteC (14,1,80,-1,'Please contact me about this.');
  162.                QwriteC (16,1,80,-1,'Press any key ...');
  163.                GotoRC  (16,49);
  164.                Ch:=ReadKey;
  165.                if Ch=#00 then Ch:=ReadKey;
  166.              end;
  167.       end;
  168.     end;
  169.   ClearScr;
  170.   QwriteC (12,1,CRTcols,-1,'Data to Screen or Disk [s/d]? ');
  171.   GotoEos;
  172.   repeat
  173.     Ch:=ReadKey;
  174.   until Ch in ['S','s','D','d',^M];
  175.   if upcase(Ch)='D' then
  176.        ToDisk:=true
  177.   else ToDisk:=false;
  178.   ModCursor (CursorOff);
  179.  
  180.   for Proc:=Qwrites to Qscrolls do
  181.     for A:=Attr to NoAttr do
  182.       ScrPerSec[Proc,A]:=0.0;
  183.  
  184.   Names[Qwrites ]:= ' Qwrite-     ';
  185.   Names[Qfills  ]:= ' Qfill-      ';
  186.   Names[Qattrs  ]:= ' Qattr-      ';
  187.   Names[Qstores ]:= ' Qstore-     ';
  188.   Names[Qscrolls]:= ' Qscroll-    ';
  189.  
  190.   if Qsnow then
  191.        Screens:=8    { First guess for screens }
  192.   else Screens:=80;  { First guess for screens }
  193.   CheckTime;
  194.   TimeWriting (Qwrites ,Yellow);
  195.   TimeWriting (Qwrites ,SameAttr);
  196.   TimeWriting (Qfills  ,Yellow);
  197.   TimeWriting (Qfills  ,SameAttr);
  198.   TimeWriting (Qattrs  ,Yellow);
  199.   TimeMoving  (Qstores ,Yellow);
  200.   TimeMoving  (Qscrolls,Yellow);
  201.  
  202.   ClearScr;
  203.   if ToDisk then
  204.        assign    (FV,'Qbench.dta')
  205.   else assignCRT (FV);
  206.   rewrite (FV);
  207.   GotoRC (1,1);
  208.   writeln (FV,'S C R E E N S / S E C O N D');
  209.   writeln (FV,'             Chng');
  210.   writeln (FV,'Procedure    Attr S/sec  Typical for these procedures:');
  211.   write   (FV,'---------    ---- -----  -----------------------------');
  212.   writeln (FV,'------------------');
  213.   for Proc:=Qwrites to Qfills do
  214.   for A:=Attr to NoAttr do
  215.     begin
  216.       if A=Attr then
  217.            write (FV,Names[Proc])
  218.       else write (FV,'             ');
  219.       if A=Attr then
  220.            write (FV,'Yes  ')
  221.       else write (FV,'No   ');
  222.       write (FV,ScrPerSec[Proc,A]:5:1,'  ');
  223.       if A=Attr then
  224.         case Proc of
  225.           Qwrites:
  226.             writeln (FV,'Qwrite, QwriteC, QwriteA, QwriteEos, QwriteEosA');
  227.           Qfills:  writeln (FV,'Qfill, QfillC, QfillEos');
  228.         end
  229.       else writeln (FV);
  230.     end;
  231.   for Proc:=Qattrs to Qscrolls do
  232.     begin
  233.       write (FV,Names[Proc]);
  234.       if Proc=Qattrs then
  235.            write (FV,'Yes  ')
  236.       else write (FV,'n/a  ');
  237.       write (FV,ScrPerSec[Proc,Attr]:5:1,'  ');
  238.       case Proc of
  239.         Qattrs:  writeln (FV,'Qattr, QattrEos');
  240.         Qstores:
  241.           writeln (FV,'QstoreToMem, QstoreToScr, QscrToVscr, QVscrToScr');
  242.         Qscrolls:writeln (FV,'QscrollUp, QscrollDown');
  243.       end
  244.     end;
  245.   GotoRC  (13,1);
  246.   writeln (FV,'SystemID         = ',SystemID);
  247.   writeln (FV,'CPU ID           = ',CpuID);
  248.   writeln (FV,'Wait-for-retrace = ',Qsnow);
  249.   writeln (FV,'Screens/test     = ',Screens);
  250.   close   (FV);
  251.   GotoRC  (24,1);
  252.   SetCursor (CursorInitial);
  253. end.
  254.