home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tug__002 / atkybd.pas next >
Encoding:
Pascal/Delphi Source File  |  1988-08-08  |  7.0 KB  |  188 lines
  1. {TUG PDS CERT 1.01 (Pascal)
  2.  
  3. ==========================================================================
  4.  
  5.                   TUG PUBLIC DOMAIN SOFTWARE CERTIFICATION
  6.  
  7. The Turbo User Group (TUG) is recognized by Borland International as the
  8. official support organization for Turbo languages.  This file has been
  9. compiled and verified by the TUG library staff.  We are reasonably certain
  10. that the information contained in this file is public domain material, but
  11. it is also subject to any restrictions applied by its author.
  12.  
  13. This diskette contains PROGRAMS and/or DATA determined to be in the PUBLIC
  14. DOMAIN, provided as a service of TUG for the use of its members.  The
  15. Turbo User Group will not be liable for any damages, including any lost
  16. profits, lost savings or other incidental or consequential damages arising
  17. out of the use of or inability to use the contents, even if TUG has been
  18. advised of the possibility of such damages, or for any claim by any
  19. other party.
  20.  
  21. To the best of our knowledge, the routines in this file compile and function
  22. properly in accordance with the information described below.
  23.  
  24. If you discover an error in this file, we would appreciate it if you would
  25. report it to us.  To report bugs, or to request information on membership
  26. in TUG, please contact us at:
  27.  
  28.              Turbo User Group
  29.              PO Box 1510
  30.              Poulsbo, Washington USA  98370
  31.  
  32. --------------------------------------------------------------------------
  33.                        F i l e    I n f o r m a t i o n
  34.  
  35. * DESCRIPTION
  36. Turbo Pascal 4.0 non-resident procedure to change AT class keyboard delay
  37. (.25 - 1.0 sec) and typematic (2 - 30 repeats/sec).
  38.  
  39. * ASSOCIATED FILES
  40.  
  41.  
  42. * CHECKED BY
  43. DRM - 08/08/88
  44.  
  45. * KEYWORDS
  46. TURBO PASCAL V4.0 AT KEYBOARD MODIFICATION
  47.  
  48. ==========================================================================
  49. }
  50. {$M 16324,0,16324}
  51. program atkybd; { Set AT keyboard delay and typematic.  Turbo Pascal 4.0 }
  52.  
  53. { Keying On A Standard, Bob Smith, PC Tech Journal, July 87, p134
  54.   Rev Up The AT Keyboard, Kevin M Crenshaw, PC Tech Journal, May 85, p39
  55.   Speedier AT Keyboard, Robert Patenaude, PC Magazine, Mar 25, 1986, p289}
  56.  
  57. { John Haluska CIS 74000,1106 }
  58.  
  59. const
  60.   DlyVal : array[0..3] of string[3] = ('.25','.5','.75','1.0');
  61.   RepVal : array[0..31] of string[5] = ('30','26.7','24','21.8','20','18.5',
  62.              '17.1','16','15','13.3','12','10.9','10','9.2','8.6','8','7.5',
  63.              '6.7','6','5.5','5','4.6','4.3','4','3.7','3.3','3','2.7','2.5',
  64.              '2,3','2.1','2');
  65. var
  66.   Dly1, Repeat1    : byte;
  67.   Result1,Result2  : integer;
  68.   Error            : byte;
  69.  
  70. {----------------------------------------------------------------------------}
  71. { Set AT Keyboard Delay code 0-3 (.25, .5, .75, or 1 sec) before start of
  72.   Typematic code 0-31 (30, 26.7, 24, 21.8, 20, 18.5, 17.1, 16, 15, 13.3, 12,
  73.   10.9, 10, 9.2, 8.6, 8, 7.5, 6.7, 6, 5.5, 5, 4.6, 4.3, 4.0, 3.7, 3.3, 3, 2.7,
  74.   2.5, 2.3, 2.1 or 2 repeats/sec). Return Error code 0 (Operation successful),
  75.   1 (Invalid Delay and/or Typematic code), 2 (Hardware error or feature not
  76.   supported) }
  77.  
  78. procedure SetATKybdDelayTypematic(Delay,Typematic:byte; var Error: byte);
  79.  
  80. procedure Xmit(Data:byte; var Error:byte);
  81.           {Transmit info to keyboard}
  82. var
  83.   Rdy1        : byte;
  84.   TickCount   : ^longint;
  85.   Tc1         : longint;
  86.  
  87. begin
  88.   Error:=0;
  89.   TickCount := Ptr($40,$6C);   { location of DOS clock }
  90.   Tc1 := TickCount^;           { 18.2 tickcounts/second }
  91.   repeat
  92.     Rdy1 := Port[$64];         { Is data waiting for the controller? }
  93.     if (TickCount^ - Tc1) > 36 then
  94.       begin
  95.         Error:=2; Exit;   { Time out - hardware error or not supported }
  96.       end;
  97.   until Rdy1 and 2 = 0;
  98.   Port[$60] := Data;           { Send data to keyboard }
  99.   Tc1 := TickCount^;
  100.   repeat
  101.     Rdy1 := Port[$64];         { Wait for keyboard to read data }
  102.     if (TickCount^ - Tc1) > 36 then
  103.       begin
  104.         Error:=2; Exit;
  105.       end;
  106.   until Rdy1 and 2 = 0;
  107.   Tc1 := TickCount^;
  108.   repeat
  109.     Rdy1 := Port[$64];         { Wait for keyboard to send ACK }
  110.     if (TickCount^ - Tc1) > 36 then
  111.       begin
  112.         Error:=2; Exit;
  113.       end;
  114.   until Rdy1 and 1 = 0;
  115.   Tc1 := TickCount^;
  116.   repeat until (TickCount^ - Tc1) > 2;
  117.   Rdy1 := Port[$60];
  118.   if Rdy1 <> $FA then Error:=2;   { Was it ACK? }
  119. end; {Xmit}
  120.  
  121. begin
  122.   Error:=0;
  123.   if (Delay<0) or (Delay>3) or (Typematic<0) or (Typematic>31) then
  124.     begin
  125.       Error:=1;  Exit;
  126.     end;
  127.   Xmit($F3,Error);              { send command to set delay and typematic }
  128.   if Error = 2 then Exit;
  129.   Xmit(Delay shl 5 + Typematic,Error);  { send delay and typematic values }
  130. end;{SetATKybdDelayTypematic}
  131. {----------------------------------------------------------------------------}
  132.  
  133. begin
  134.   case ParamCount of
  135.     0: begin
  136. Writeln('                  Set AT Keyboard Delay and Repeat Rate');
  137. Writeln;
  138. Writeln('            Syntax: ATKYBD [Delay Code] [Repeats/Sec Code] ');
  139. Writeln;
  140. Writeln('                   Code  Delay(Sec)    Code  Delay(Sec)');
  141. Writeln('                     0     .25           2      .75 ');
  142. Writeln('                     1     .50*          3     1.00 ');
  143. Writeln;
  144. Writeln('       Code Rep/Sec    Code Rep/Sec    Code Rep/Sec   Code Rep/Sec ');
  145. Writeln;
  146. Writeln('         0    30         8    15        16    7.5      24    3.7 ');
  147. Writeln('         1    26.7       9    13.3      17    6.7      25    3.3 ');
  148. Writeln('         2    24        10    12        18    6        26    3.0 ');
  149. Writeln('         3    21.8      11    10.9*     19    5.5      27    2.7 ');
  150. Writeln('         4    20        12    10        20    5        28    2.5 ');
  151. Writeln('         5    18.5      13     9.2      21    4.6      29    2.3 ');
  152. Writeln('         6    17.1      14     8.6      22    4.3      30    2.1 ');
  153. Writeln('         7    16        15     8.0      23    4.0      31    2.0 ');
  154. Writeln;
  155. Writeln('          * Standard Values');
  156.        end;
  157.     2: begin
  158.          Val(ParamStr(1),Dly1,Result1);
  159.          Val(ParamStr(2),Repeat1,Result2);
  160.          if (Result1 > 0) or (Result2 > 0) then
  161.            begin
  162.              Writeln('Syntax error - Exit Program');  Exit;
  163.            end
  164.          else
  165.            begin
  166.              SetATKybdDelayTypematic(Dly1,Repeat1,Error);
  167.              case Error of
  168.                0: begin
  169.                     Write('AT Keyboard Delay: ',DlyVal[Dly1],' sec.  ');
  170.                     Writeln('Typematic: ',RepVal[Repeat1],' repeats/sec');
  171.                   end;
  172.                1: begin
  173.                     Writeln('Syntax Error - Exit Program'); Exit;
  174.                   end;
  175.                2: begin
  176.                     Write('Hardware error or feature not supported');
  177.                     Writeln(' - Exit Program');  Exit;
  178.                   end;
  179.                end;
  180.            end;
  181.        end;
  182.     else           { 1 or greater than 2 command line parameters }
  183.       begin
  184.         Writeln('Syntax error - Exit Program');  Exit;
  185.       end;
  186.    end;
  187.  end.
  188.