keys.pas

delphi编的不错的贪吃蛇

}

procedure Key_Console(Key: integer);
var
  cbd: pchar;
  Index: integer;
begin
  case key of
    K_KP_SLASH: key := Ord('/');
    K_KP_MINUS: key := Ord('-');
    K_KP_PLUS: key := Ord('+');
    K_KP_HOME: key := Ord('7');
    K_KP_UPARROW: key := Ord('8');
    K_KP_PGUP: key := Ord('9');
    K_KP_LEFTARROW: key := Ord('4');
    K_KP_5: key := Ord('5');
    K_KP_RIGHTARROW: key := Ord('6');
    K_KP_END: key := Ord('1');
    K_KP_DOWNARROW: key := Ord('2');
    K_KP_PGDN: key := Ord('3');
    K_KP_INS: key := Ord('0');
    K_KP_DEL: key := Ord('.');
  end;                                  {case}

  if ((UpCase(Char(key)) = 'V') and keydown[K_CTRL]) or
    (((key = K_INS) or (key = K_KP_INS)) and keydown[K_SHIFT]) then
  begin
    cbd := Sys_GetClipboardData;
    if cbd <> nil then
    begin
      // TODO : doesnt use the function result!
     //StrScan( cbd, #10#13#08); // strtok( cbd, "\n\r\b" );

      Index := strlen(cbd);
      if Index + key_linepos >= MAXCMDLINE then
        Index := MAXCMDLINE - key_linepos;

      if Index > 0 then
      begin
        cbd[Index] := #0;
        strcat(key_lines[edit_line], cbd);
        Inc(key_linepos, Index);
      end;
      FreeMem(cbd);
    end;
    exit;
  end;

  if (key = Ord('l')) and keydown[K_CTRL] then
  begin
    Cbuf_AddText('clear'#10);
    Exit;
  end;

  if (key = K_ENTER) or (key = K_KP_ENTER) then
  begin
    // backslash text are commands, else chat
    if (key_lines[edit_line][1] = '\') or (key_lines[edit_line][1] = '/') then
      Cbuf_AddText(@key_lines[edit_line][2]) //(key_lines[edit_line]+2)   // skip the >
    else
      Cbuf_AddText(@key_lines[edit_line][1]); //(key_lines[edit_line]+1); // valid command

    Cbuf_AddText(#10);
    Com_Printf('%s'#10, [key_lines[edit_line]]); //  Com_Printf ("%s\n",key_lines[edit_line]);

    edit_line := (edit_line + 1) and 31;
    history_line := edit_line;
    key_lines[edit_line][0] := ']';
    key_linepos := 1;
    if (cls.state = ca_disconnected) then
      // force an update, because the command. may take some time
      SCR_UpdateScreen();
    exit;
  end;

  if key = K_TAB then
  begin                                 // command completion
    CompleteCommand();
    Exit;
  end;

  if (key = K_BACKSPACE) or (key = K_LEFTARROW) or (key = K_KP_LEFTARROW) or
    ((UpCase(char(key)) = 'H') and keydown[K_CTRL]) then
  begin
    if key_linepos > 1 then
      Dec(key_linepos);
    exit;
  end;

  if (key = K_UPARROW) or (key = K_KP_UPARROW) or
    ((char(key) = 'p') and keydown[K_CTRL]) then
  begin
    repeat
      history_line := (history_line - 1) and 31;
    until not ((history_line <> edit_line) and (key_lines[history_line][1] = #0));
    if history_line = edit_line then
      history_line := (edit_line + 1) and 31;
    strcopy(key_lines[edit_line], key_lines[history_line]);
    key_linepos := strlen(key_lines[edit_line]);
    exit;
  end;

  if (key = K_DOWNARROW) or (key = K_KP_DOWNARROW) or
    ((char(key) = 'n') and keydown[K_CTRL]) then
  begin
    if history_line = edit_line then
      exit;
    repeat
      history_line := (history_line + 1) and 31;
    until not ((history_line <> edit_line) and (key_lines[history_line][1] = #0));
    if history_line = edit_line then
    begin
      key_lines[edit_line][0] := ']';
      key_linepos := 1;
    end
    else
    begin
      strcopy(key_lines[edit_line], key_lines[history_line]);
      key_linepos := strlen(key_lines[edit_line]);
    end;
    exit;
  end;

  if (key = K_PGUP) or (key = K_KP_PGUP) then
  begin
    con.display := con.display - 2;
    exit;
  end;

  if (key = K_PGDN) or (key = K_KP_PGDN) then
  begin
    con.display := con.display + 2;
    if (con.display > con.current) then
      con.display := con.current;
    exit;
  end;

  if (key = K_HOME) or (key = K_KP_HOME) then
  begin
    con.display := con.current - con.totallines + 10;
    exit;
  end;

  if (key = K_END) or (key = K_KP_END) then
  begin
    con.display := con.current;
    exit;
  end;

  if (key < 32) or (key > 127) then
    exit;                               // non printable

  if (key_linepos < MAXCMDLINE - 1) then
  begin
    key_lines[edit_line][key_linepos] := Char(key);
    Inc(key_linepos);
    key_lines[edit_line][key_linepos] := #0;
  end;
end;                                    {Key_Console}

//============================================================================

procedure Key_Message(key: integer);
begin
  if (key = K_ENTER) or (key = K_KP_ENTER) then
  begin
    if chat_team then
      Cbuf_AddText('say_team "')
    else
      Cbuf_AddText('say "');
    Cbuf_AddText(chat_buffer);
    Cbuf_AddText('"'#10);
    cls.key_dest := Client.key_game;
    chat_bufferlen := 0;
    chat_buffer[0] := #0;
    exit;
  end;

  if (key = K_ESCAPE) then
  begin
    cls.key_dest := Client.key_game;
    chat_bufferlen := 0;
    chat_buffer[0] := #0;
    exit;
  end;

  if (key < 32) or (key > 127) then
    exit;                               // non printable

  if (key = K_BACKSPACE) then
  begin
    if chat_bufferlen <> 0 then
    begin
      Dec(chat_bufferlen);
      chat_buffer[chat_bufferlen] := #0;
    end;
    exit;
  end;

  if (chat_bufferlen = sizeof(chat_buffer) - 1) then
    exit;                               // all full

  chat_buffer[chat_bufferlen] := Char(key);
  inc(chat_bufferlen);
  chat_buffer[chat_bufferlen] := #0;
end;                                    {Key_Message}

//============================================================================

{
===================
Key_StringToKeynum

Returns a key number to be used to index keybindings[] by looking at
the given string.  Single ascii characters return themselves, while
the K_* names are matched up.
===================
int Key_StringToKeynum (char *str)
}

function Key_StringToKeynum(str: PChar): integer;
var
  kn: keyname_p;
begin
  if (str = nil) or (str[0] = #0) then
  begin
    Result := -1;
    exit;
  end;

  if str[1] = #0 then
  begin
    Result := Ord(str[0]);
    exit;
  end;

  kn := @keynames[0];
  while kn.name <> nil do
  begin
    // TODO -cDependancy : Check to see if Q_strcasecmp is case sensitive
 //   if StrIComp(str,kn.name) = 0 then // case insensitive version
    if StrComp(str, kn.name) = 0 then
    begin
      Result := kn.keynum;
      exit;
    end;
    Inc(kn);
  end;
  Result := -1;
end;                                    {Key_StringToKeynum}

{
===================
Key_KeynumToString

Returns a string (either a single ascii char, or a K_* name) for the
given keynum.
FIXME: handle quote special (general escape sequence?)
===================
char *Key_KeynumToString (int keynum)
}
var                                     // TODO : This Should be replaced with a delphi string!
  tinystr: array[0..1] of char = (' ', ' ');

function Key_KeynumToString(keynum: Integer): Pchar;
var
  kn: keyname_p;
begin
  if (keynum = -1) then
  begin
    result := '<KEY NOT FOUND>';
    exit;
  end;

  if (keynum > 32) and (keynum < 127) then
  begin                                 // printable ascii
    tinystr[0] := Char(keynum);
    tinystr[1] := #0;
    result := tinystr;
    exit;
  end;

  kn := @keynames[0];
  while kn.name <> nil do
  begin
    if keynum = kn.keynum then
    begin
      Result := kn.name;
      exit;
    end;
    Inc(kn);
  end;
  Result := '<UNKNOWN KEYNUM>';
end;                                    {Key_KeynumToString}

{
===================
Key_SetBinding
===================
void Key_SetBinding (int keynum, char *binding)
}

procedure Key_SetBinding(keynum: integer; binding: PChar);
var
  new: Pchar;
  size: integer;
begin
  if keynum = -1 then
    exit;

  // free old bindings
  if keybindings[keynum] <> nil then
  begin
    Z_Free(keybindings[keynum]);
    keybindings[keynum] := nil;
  end;

  // allocate memory for new binding
  size := strlen(binding);
  if size <> 0 then
  begin
    new := Z_Malloc(size + 1);
    strcopy(new, binding);
    new[size] := #0;
    keybindings[keynum] := new;
  end;
end;                                    {Key_SetBinding}

{
===================
Key_Unbind_f
===================
void Key_Unbind_f (void)
}

procedure Key_Unbind_f; cdecl;
var
  B: integer;
  keystr: Pchar;
begin
  if Cmd_Argc <> 2 then
  begin
    Com_Printf('unbind <key> : remove commands from a key'#10, []);
    exit;
  end;

  keystr := Cmd_Argv(1);
  b := Key_StringToKeynum(keystr);
  if b = -1 then
  begin
    Com_Printf('"%d" isn''t a valid key'#10, [keystr]);
    exit;
  end;
  Key_SetBinding(b, '');
end;                                    {Key_Unbind_f}

procedure Key_Unbindall_f; cdecl;
var
  Index: integer;
begin
  for index := 0 to 255 do
    if keybindings[index] <> nil then
      Key_SetBinding(Index, '');
end;                                    {Key_Unbindall_f}

{
===================
Key_Bind_f
===================
void Key_Bind_f (void)
}

procedure Key_Bind_f; cdecl;
var
  index, count, Keynum: integer;
  cmd: array[0..1023] of char;