home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / ASM / QWIK41.ZIP / QBENCH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-01  |  7.5 KB  |  271 lines
  1. { Qbench.pas - produces a 'Screens/second' table for        ver 4.1, 05-01-88 }
  2. {              QWIK Screen utilities.                                         }
  3. { I'm not trying to support this program, so don't expect it to be perfect.
  4.   It will just give you a good feel for speed.  The time is adjusted for
  5.   an average 8 second test for each condition - total of 112 seconds.  For
  6.   more accurate results, change TestTime:=16.  Or for a quicker but less
  7.   accurate test, change TestTime:=1.  The Q*More procedures are not tested
  8.   since they yield about the same results as their "non-More" counterparts. }
  9.  
  10. uses CRT,Qwik;
  11. {$i timerd12.inc}
  12.  
  13. type
  14.   Attrs = (Attr,NoAttr);
  15.  
  16. const
  17.   Procs = 9;
  18.   TestTime = 8;  { TestTime in seconds for each case.  8 gives +/- 1% }
  19.  
  20. var
  21.   Attrib, Count, Screens: integer;
  22.   OldCursor:  word;
  23.   Row, Col, Rows, Cols, ProcNumber: byte;
  24.   ScrPerSec: array[1..Procs] of array[Attr..NoAttr] of real;
  25.   Strng:     string[80];
  26.   A:         Attrs;
  27.   ScrArray:  array[1..4000] of byte;
  28.   Names:     array[1..Procs] of string[80];
  29.   FV:        text;
  30.   ToDisk:    boolean;
  31.   Ch:        char;
  32.  
  33. procedure CheckCursor;
  34. var CursorMode: integer absolute $0040:$0060;
  35. begin
  36.   if ActiveDispDev=MdaMono then
  37.     if CursorMode=$0607 then
  38.       CursorChange($0B0C,OldCursor);
  39. end;
  40.  
  41. procedure CheckTime;
  42. begin
  43.   Strng:='TimerTest ';
  44.   for Col:=1 to 3 do Strng:=Strng+Strng;
  45.   Qfill  (1,1,25,80,14,' ');
  46.   timer (start);
  47.   for Count:=1 to Screens do
  48.     for row:=1 to 25 do
  49.       Qwrite (Row,1,14,Strng);
  50.   timer (Stop);
  51.   Screens:=trunc(Screens*TestTime/ElapsedTime);
  52. end;
  53.  
  54. procedure WritesFillsProcedures (ProcNumber: byte);
  55. begin
  56.   case ProcNumber of
  57.     1: begin
  58.          timer (start);
  59.          for Count:=1 to Screens do
  60.            for Row:=1 to 25 do
  61.              Qwrite (Row,1,Attrib,Strng);
  62.          timer (Stop);
  63.        end;
  64.     2: begin
  65.          timer (start);
  66.          for Count:=1 to Screens do
  67.            for Row:=1 to 25 do
  68.              QwriteC (Row,1,80,Attrib,Strng);
  69.          timer (Stop);
  70.        end;
  71.     3: begin
  72.          timer (start);
  73.          for Count:=1 to Screens do
  74.            for Row:=1 to 25 do
  75.              QwriteA (Row,1,Attrib,80,Strng[1]);
  76.          timer (Stop);
  77.        end;
  78.     4: begin
  79.          timer (start);
  80.          for Count:=1 to Screens do
  81.            QfillC (1,1,80,25,80,Attrib,'C');
  82.          timer (Stop);
  83.        end;
  84.     5: begin
  85.          timer (start);
  86.          for Count:=1 to Screens do
  87.            Qfill (1,1,25,80,Attrib,'F');
  88.          timer (Stop);
  89.        end;
  90.      end;  { Case ProcNumber of }
  91.   if Attrib>=0 then
  92.     case ProcNumber of
  93.       6: begin
  94.            Qfill (1,1,25,80,Attrib,'a');
  95.            timer (start);
  96.            for Count:=1 to Screens do
  97.              Qattr (1,1,25,80,Attrib);
  98.            timer (Stop);
  99.          end;
  100.       7: begin
  101.            Qfill (1,1,25,80,Attrib,'c');
  102.            timer (start);
  103.            for Count:=1 to Screens do
  104.              QattrC (1,1,80,25,80,Attrib);
  105.            timer (Stop);
  106.          end;
  107.     end;  { Case ProcNumber of }
  108.   if ElapsedTime<>0.0 then
  109.   ScrPerSec[ProcNumber,A]:=Screens/ElapsedTime;
  110. end;
  111.  
  112. procedure StoresProcedures (ProcNumber: byte);
  113. begin
  114.   for Row:=1 to 25 do
  115.     Qwrite (Row,1,Attrib,Strng);
  116.   case ProcNumber of
  117.     8: begin
  118.          timer (start);
  119.          for Count:=1 to Screens do
  120.            QstoreToMem (1,1,25,80,ScrArray);
  121.          timer (Stop);
  122.        end;
  123.     9: begin
  124.          QstoreToMem (1,1,25,80,ScrArray);
  125.          timer (start);
  126.          for Count:=1 to Screens do
  127.            QstoreToScr (1,1,25,80,ScrArray);
  128.          timer (Stop);
  129.        end;
  130.   end;  { Case ProcNumber of }
  131.   ScrPerSec[ProcNumber,A]:=Screens/ElapsedTime;
  132. end;
  133.  
  134. procedure LoopWritesFills (At: Attrs; Att: integer);
  135. begin
  136.   A:=At;
  137.   Attrib:=Att;
  138.   for ProcNumber:=1 to 7 do
  139.     begin
  140.       Strng:=Names[ProcNumber];
  141.       if Qsnow then
  142.            Strng:=Strng+' Wait    '
  143.       else Strng:=Strng+' No Wait ';
  144.       if A=Attr then
  145.            Strng:=Strng+' w/Attr  '
  146.       else Strng:=Strng+' No Attr ';
  147.       fillchar (Strng[32],49,ProcNumber+48);
  148.       Strng[0]:=#80;
  149.       WritesFillsProcedures (ProcNumber);
  150.     end;
  151. end;
  152.  
  153. procedure LoopStores (At: Attrs; Att: integer);
  154. begin
  155.   A:=At;
  156.   Attrib:=Att;
  157.   for ProcNumber:=8 to 9 do
  158.     begin
  159.       Strng:=Names[ProcNumber];
  160.       if Qsnow then
  161.            Strng:=Strng+' Wait    '
  162.       else Strng:=Strng+' No Wait ';
  163.       Strng:=Strng+' w/Attr  ';
  164.       fillchar (Strng[32],49,ProcNumber+48);
  165.       Strng[0]:=#80;
  166.       StoresProcedures (ProcNumber);
  167.     end;
  168. end;
  169.  
  170. begin
  171.   Qfill  (1,1,25,80,14,' ');
  172.   if Qsnow then
  173.     begin
  174.       Qsnow:=false;
  175.       GotoRC (12,52);
  176.       repeat
  177.         repeat
  178.           QwriteC (12,1,80,-1,'Do you see snow? [Y/N]?');
  179.         until Keypressed;
  180.         Ch:=ReadKey;
  181.       until Ch in ['Y','y','N','n'];
  182.       case upcase(Ch) of
  183.         'Y': Qsnow:=true;
  184.         'N': begin
  185.                QwriteC (10,1,80,-1,'Congratulations!  You have a card better');
  186.                QwriteC (11,1,80,-1,'than the standard IBM CGA.');
  187.                QwriteC (12,1,80,-1,'However, to make it faster, you will need');
  188.                QwriteC (13,1,80,-1,'to set Qsnow:=false manually.');
  189.                QwriteC (14,1,80,-1,'Please contact me about this.');
  190.                QwriteC (16,1,80,-1,'Press any key ...');
  191.                GotoRC  (16,49);
  192.                Ch:=ReadKey;
  193.                if Ch=#00 then Ch:=ReadKey;
  194.              end;
  195.       end;
  196.     end;
  197.   Qfill   (1,1,25,80,14,' ');
  198.   QwriteC (12,1,80,-1,'Data to Screen or Disk [s/d]?');
  199.   GotoRC  (12,55);
  200.   repeat
  201.     Ch:=ReadKey;
  202.   until Ch in ['S','s','D','d',^M];
  203.   if upcase(Ch)='D' then
  204.        ToDisk:=true
  205.   else ToDisk:=false;
  206.   CheckCursor;
  207.   CursorOff;
  208.   Qfill (1,1,1,80,14,' ');
  209.  
  210.   for ProcNumber:=1 to Procs do
  211.     for A:= Attr to NoAttr do
  212.       ScrPerSec[ProcNumber,A]:=0.0;
  213.  
  214.   Names[1]:= ' Qwrite      ';
  215.   Names[2]:= ' QwriteC     ';
  216.   Names[3]:= ' QwriteA     ';
  217.   Names[4]:= ' QfillC      ';
  218.   Names[5]:= ' Qfill       ';
  219.   Names[6]:= ' Qattr       ';
  220.   Names[7]:= ' QattrC      ';
  221.   Names[8]:= ' QstoreToMem ';
  222.   Names[9]:= ' QstoreToScr ';
  223.  
  224.   if Qsnow then
  225.        Screens:=8    { First guess for screens }
  226.   else Screens:=80;  { First guess for screens }
  227.   CheckTime;
  228.   LoopWritesFills (Attr, 14);
  229.   LoopStores      (Attr, 14);
  230.   Qattr           (1,1,25,80,7);
  231.   LoopWritesFills (NoAttr, -1);
  232.  
  233.   Qfill (1,1,25,80,14,' ');
  234.   if ToDisk then
  235.        assign    (FV,'Qbench.dta')
  236.   else assignCRT (FV);
  237.   rewrite (FV);
  238.   GotoRC (1,1);
  239.   writeln (FV,'S C R E E N S / S E C O N D');
  240.   writeln (FV,'             Chng');
  241.   writeln (FV,'Procedure    Attr S/sec');
  242.   writeln (FV,'---------    ---- -----');
  243.   for ProcNumber:=1 to 5 do
  244.   for A:=Attr to NoAttr do
  245.     begin
  246.       if A=Attr then
  247.            write (FV,Names[ProcNumber])
  248.       else write (FV,'             ');
  249.       if A=Attr then
  250.            write (FV,'Yes  ')
  251.       else write (FV,'No   ');
  252.       writeln (FV,ScrPerSec[ProcNumber,A]:5:1);
  253.     end;
  254.   for ProcNumber:=6 to 9 do
  255.     begin
  256.       write (FV,Names[ProcNumber]);
  257.       if ProcNumber<10 then
  258.            write (FV,'Yes  ')
  259.       else write (FV,'n/a  ');
  260.       writeln (FV,ScrPerSec[ProcNumber,Attr]:5:1);
  261.     end;
  262.   GotoRC  (21,1);
  263.   writeln (FV,'SystemID         = ',SystemID);
  264.   writeln (FV,'SubModelID       = ',SubmodelID);
  265.   writeln (FV,'Wait-for-retrace = ',Qsnow);
  266.   writeln (FV,'Screens/test     = ',Screens);
  267.   close   (FV);
  268.   GotoRC  (24,1);
  269.   CursorOn;
  270. end.
  271.