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