home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / GAMEKIT.ZIP / GAMES.PAS next >
Encoding:
Pascal/Delphi Source File  |  1992-10-18  |  6.9 KB  |  234 lines
  1. {$F+}
  2. unit games;
  3.  
  4. interface
  5.  
  6. { constants for scan codes of various keys }
  7.  
  8. const escscan: byte = $01;
  9.       backscan: byte = $0e;
  10.       ctrlscan: byte = $1d;
  11.       lshscan: byte = $2a;
  12.       capscan: byte = $3a;
  13.       f1scan: byte = $3b;
  14.       f2scan: byte = $3c;
  15.       f3scan: byte = $3d;
  16.       f4scan: byte = $3e;
  17.       f5scan: byte = $3f;
  18.       f6scan: byte = $40;
  19.       f7scan: byte = $41;
  20.       f8scan: byte = $42;
  21.       f9scan: byte = $43;
  22.       f10scan: byte = $44;
  23.       f11scan: byte = $d9;
  24.       f12scan: byte = $da;
  25.       scrlscan: byte = $46;
  26.       tabscan: byte = $0f;
  27.       entscan: byte = $1c;
  28.       rshscan: byte = $36;
  29.       prtscan: byte = $37;
  30.       altscan: byte = $38;
  31.       homescan: byte = $47;
  32.       upscan: byte = $48;
  33.       pgupscan: byte = $49;
  34.       minscan: byte = $4a;
  35.       leftscan: byte = $4b;
  36.       midscan: byte = $4c;
  37.       rightscan: byte = $4d;
  38.       plusscan: byte = $4e;
  39.       endscan: byte = $4f;
  40.       downscan: byte = $50;
  41.       pgdnscan: byte = $51;
  42.       insscan: byte = $52;
  43.       delscan: byte = $53;
  44.       numscan: byte = $45;
  45.  
  46. { arrays that record keyboard status }
  47.  
  48. var keydown, wasdown: array[0..127] of boolean;
  49.  
  50. { procedures/functions you may call }
  51.  
  52. procedure initnewkeyint;
  53. procedure setoldkeyint;
  54. procedure clearwasdownarray;
  55. procedure initnewtimint;
  56. procedure setoldtimint;
  57. procedure initnewbrkint;
  58. procedure setoldbrkint;
  59. function scanof(chartoscan: char): byte;
  60. procedure tickwait(time2wait: byte);
  61.  
  62. { }
  63. implementation
  64. uses dos;
  65.  
  66. { pointers to old interrupt routines }
  67.  
  68. var oldkbdint, oldtimint, oldbrkint: pointer;
  69.     cloktick: byte; { counter to count clock "ticks" }
  70. { }
  71. procedure sti;
  72. inline($fb);    { STI: set interrupt flag }
  73. { }
  74. procedure cli;
  75. inline($fa);    { CLI: clear interrupt flag -- not used }
  76. { }
  77. procedure calloldint(sub: pointer);
  78.  
  79. { calls old interrupt routine so that your programs don't deprive the computer
  80.   of any vital functions -- kudos to Stephen O'Brien and "Turbo Pascal 6.0:
  81.   The Complete Reference" for including this inline code on page 407 }
  82.  
  83. begin
  84.   inline($9c/           { PUSHF }
  85.          $ff/$5e/$06)   { CALL DWORD PTR [BP+6] }
  86.   end;
  87. { }
  88. procedure newkbdint; interrupt;   { new keyboard handler }
  89. begin
  90.   keydown[port[$60] mod 128] := (port[$60] < 128);  { key is down if value of
  91.                                                       60h is less than 128 --
  92.                                                       record current status }
  93.   if port[$60] < 128 then wasdown[port[$60]] := true; { update WASDOWN if the
  94.                                                         key is currently
  95.                                                         depressed }
  96.   calloldint(oldkbdint);                              { call old interrupt }
  97.   mem[$0040:$001a] := mem[$0040:$001c];   { Clear keyboard buffer: the buffer
  98.                                             is a ring buffer, where the com-
  99.                                             puter keeps track of the location
  100.                                             of the next character in the buffer
  101.                                             end the final character in the
  102.                                             buffer.  To clear the buffer, set
  103.                                             the two equal to each other. }
  104.   sti
  105.   end;
  106. { }
  107. procedure initnewkeyint;      { set new keyboard interrupt }
  108. var keycnt: byte;
  109. begin
  110.   for keycnt := 0 to 127 do begin   { reset arrays to all "False" }
  111.     keydown[keycnt] := false;
  112.     wasdown[keycnt] := false
  113.     end;
  114.   getintvec($09, oldkbdint);        { record location of old keyboard int }
  115.   setintvec($09, addr(newkbdint));  { this line installs the new interrupt }
  116.   sti
  117.   end;
  118. { }
  119. procedure setoldkeyint;           { reset old interrupt }
  120. begin
  121.   setintvec($09, oldkbdint);
  122.   sti
  123.   end;
  124. { }
  125. procedure clearwasdownarray;      { set all values in WASDOWN to "False" }
  126. var cnter: byte;
  127. begin
  128.   for cnter := 0 to 127 do wasdown[cnter] := false
  129.   end;
  130. { }
  131. function scanof(chartoscan: char): byte;  { return scan code corresponding
  132.                                             to a character }
  133. var tempbyte: byte;
  134. begin
  135.   tempbyte := 0;
  136.   case upcase(chartoscan) of
  137.     '!', '1': tempbyte := $02;
  138.     '@', '2': tempbyte := $03;
  139.     '#', '3': tempbyte := $04;
  140.     '$', '4': tempbyte := $05;
  141.     '%', '5': tempbyte := $06;
  142.     '^', '6': tempbyte := $07;
  143.     '&', '7': tempbyte := $08;
  144.     '*', '8': tempbyte := $09;
  145.     '(', '9': tempbyte := $0a;
  146.     ')', '0': tempbyte := $0b;
  147.     '_', '-': tempbyte := $0c;
  148.     '+', '=': tempbyte := $0d;
  149.     'A': tempbyte := $1e;
  150.     'S': tempbyte := $1f;
  151.     'D': tempbyte := $20;
  152.     'F': tempbyte := $21;
  153.     'G': tempbyte := $22;
  154.     'H': tempbyte := $23;
  155.     'J': tempbyte := $24;
  156.     'K': tempbyte := $25;
  157.     'L': tempbyte := $26;
  158.     ':', ';': tempbyte := $27;
  159.     '"', '''': tempbyte := $28;
  160.     '~', '`': tempbyte := $29;
  161.     ' ': tempbyte := $39;
  162.     'Q': tempbyte := $10;
  163.     'W': tempbyte := $11;
  164.     'E': tempbyte := $12;
  165.     'R': tempbyte := $13;
  166.     'T': tempbyte := $14;
  167.     'Y': tempbyte := $15;
  168.     'U': tempbyte := $16;
  169.     'I': tempbyte := $17;
  170.     'O': tempbyte := $18;
  171.     'P': tempbyte := $19;
  172.     '{', '[': tempbyte := $1a;
  173.     '}', ']': tempbyte := $1b;
  174.     '|', '\': tempbyte := $2b;
  175.     'Z': tempbyte := $2c;
  176.     'X': tempbyte := $2d;
  177.     'C': tempbyte := $2e;
  178.     'V': tempbyte := $2f;
  179.     'B': tempbyte := $30;
  180.     'N': tempbyte := $31;
  181.     'M': tempbyte := $32;
  182.     '<', ',': tempbyte := $33;
  183.     '>', '.': tempbyte := $34;
  184.     '?', '/': tempbyte := $35
  185.     end;
  186.   scanof := tempbyte
  187.   end;
  188. { }
  189. procedure newtimint; interrupt;   { new timer interrupt }
  190. begin
  191.   calloldint(oldtimint);          { call old timer interrupt }
  192.   cloktick := cloktick + 1        { update "tick" counter }
  193.   end;
  194. { }
  195. procedure initnewtimint;              { set up new timer interrupt }
  196. begin
  197.   getintvec($1c, oldtimint);          { record location of old interrupt }
  198.   setintvec($1c, addr(newtimint));    { install new interrupt procedure }
  199.   cloktick := 0;                      { set counter to 0 }
  200.   sti
  201.   end;
  202. { }
  203. procedure setoldtimint;               { reset old timer }
  204. begin
  205.   setintvec($1c, oldtimint);
  206.   sti
  207.   end;
  208. { }
  209. procedure tickwait(time2wait: byte);    { do nothing until counter reaches
  210.                                           certain value }
  211. begin
  212.   repeat until cloktick >= time2wait;
  213.   cloktick := 0                         { reset counter }
  214.   end;
  215. { }
  216. procedure newbrkint; interrupt;   { new "Ctrl-Break" interrupt: does nothing }
  217. begin 
  218.   sti
  219.   end;
  220. { }
  221. procedure setoldbrkint;           { reset old "Ctrl-Break" interrupt }
  222. begin
  223.   setintvec($1b, oldbrkint);
  224.   sti
  225.   end;
  226. { }
  227. procedure initnewbrkint;              { install new "Ctrl-Break" interrupt }
  228. begin
  229.   getintvec($1b, oldbrkint);          { get old interrupt location }
  230.   setintvec($1b, addr(newbrkint));    { set up new interrupt procedure }
  231.   sti
  232.   end;
  233.  
  234. end.