hedgewars/uKeys.pas
changeset 1 30f2d1037d5d
child 4 bcbd7adb4e4b
equal deleted inserted replaced
0:475c0f2f9d17 1:30f2d1037d5d
       
     1 (*
       
     2  * Hedgewars, a worms-like game
       
     3  * Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>
       
     4  *
       
     5  * Distributed under the terms of the BSD-modified licence:
       
     6  *
       
     7  * Permission is hereby granted, free of charge, to any person obtaining a copy
       
     8  * of this software and associated documentation files (the "Software"), to deal
       
     9  * with the Software without restriction, including without limitation the
       
    10  * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
       
    11  * sell copies of the Software, and to permit persons to whom the Software is
       
    12  * furnished to do so, subject to the following conditions:
       
    13  *
       
    14  * 1. Redistributions of source code must retain the above copyright notice,
       
    15  *    this list of conditions and the following disclaimer.
       
    16  * 2. Redistributions in binary form must reproduce the above copyright notice,
       
    17  *    this list of conditions and the following disclaimer in the documentation
       
    18  *    and/or other materials provided with the distribution.
       
    19  * 3. The name of the author may not be used to endorse or promote products
       
    20  *    derived from this software without specific prior written permission.
       
    21  *
       
    22  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
       
    23  * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
       
    24  * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
       
    25  * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
       
    26  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
       
    27  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
       
    28  * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
       
    29  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
       
    30  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
       
    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
       
    32  *)
       
    33 
       
    34 unit uKeys;
       
    35 interface
       
    36 {$INCLUDE options.inc}
       
    37 
       
    38 function KeyNameToCode(name: string): word;
       
    39 procedure ProcessKbd;
       
    40 procedure ResetKbd;
       
    41 procedure ProcessKbdDemo;
       
    42 procedure InitKbdKeyTable;
       
    43 
       
    44 implementation
       
    45 uses SDLh, uTeams, uConsole, uConsts, uMisc;
       
    46 
       
    47 type TKeyboardState = array[0..322] of Byte;
       
    48 var tkbd: TKeyboardState;
       
    49     KeyNames: array [0..cKeyMaxIndex] of string[15];
       
    50 
       
    51 function KeyNameToCode(name: string): word;
       
    52 begin
       
    53 Result:= cKeyMaxIndex;
       
    54 while (Result>0)and(KeyNames[Result]<>name) do dec(Result)
       
    55 end;
       
    56 
       
    57 procedure ProcessKbd;
       
    58 var  i: integer;
       
    59      s: shortstring;
       
    60      pkbd: PByteArray;
       
    61 begin
       
    62 if (CurrentTeam = nil)
       
    63    or (CurrentTeam.ExtDriven)
       
    64    or (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].BotLevel <> 0) then exit;
       
    65 pkbd:= SDL_GetKeyState(nil);
       
    66 i:= SDL_GetMouseState(nil, nil);
       
    67 pkbd^[1]:= (i and 1);
       
    68 pkbd^[2]:= ((i shl 1) and 1);
       
    69 pkbd^[3]:= ((i shl 2) and 1);
       
    70 for i:= 1 to cKeyMaxIndex do
       
    71     if CurrentTeam.Aliases[i][0]<>#0 then
       
    72        begin
       
    73        if CurrentTeam.Aliases[i][1]='+' then
       
    74           begin
       
    75           if (pkbd^[i] <> 0)and(tkbd[i]  = 0) then ParseCommand(CurrentTeam.Aliases[i]) else
       
    76           if (pkbd^[i] =  0)and(tkbd[i] <> 0) then
       
    77              begin
       
    78              s:= CurrentTeam.Aliases[i];
       
    79              s[1]:= '-';
       
    80              ParseCommand(s)
       
    81              end;
       
    82           end else
       
    83           if (tkbd[i] = 0) and (pkbd^[i] <> 0) then ParseCommand(CurrentTeam.Aliases[i]);
       
    84        tkbd[i]:= pkbd^[i]
       
    85        end
       
    86 end;
       
    87 
       
    88 procedure ProcessKbdDemo;
       
    89 var pkbd: PByteArray;
       
    90 begin
       
    91 pkbd:= PByteArray(SDL_GetKeyState(nil));
       
    92 if pkbd^[27] <> 0 then
       
    93    begin
       
    94    ParseCommand('/quit');
       
    95    end;
       
    96 end;
       
    97 
       
    98 procedure ResetKbd;
       
    99 var i, t: integer;
       
   100     pkbd: PByteArray;
       
   101 begin
       
   102 pkbd:= PByteArray(SDL_GetKeyState(@i));
       
   103 for t:= 0 to Pred(i) do
       
   104     tkbd[i]:= pkbd^[i]
       
   105 end;
       
   106 
       
   107 procedure InitKbdKeyTable;
       
   108 var i, t: integer;
       
   109     s: string[15];
       
   110 begin
       
   111 KeyNames[1]:= 'mousel';
       
   112 KeyNames[2]:= 'mousem';
       
   113 KeyNames[3]:= 'mouser';
       
   114 for i:= 4 to cKeyMaxIndex do
       
   115     begin
       
   116     s:= SDL_GetKeyName(i);
       
   117     if s = 'unknown key' then KeyNames[i]:= ''
       
   118        else begin
       
   119        for t:= 1 to Length(s) do
       
   120            if s[t] = ' ' then s[t]:= '_';
       
   121        KeyNames[i]:= s
       
   122        end;
       
   123     end
       
   124 end;
       
   125 
       
   126 initialization
       
   127 
       
   128 end.