in_win.pas

delphi编的不错的贪吃蛇

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): in_win.c                                                          }
{ Content: Quake2\Win32\ support for qhost                                   }
{                                                                            }
{ Initial conversion by : andre                                              }
{ Initial conversion on : 02-May-2002                                        }
{                                                                            }
{ This File contains part of convertion of Quake2 source to ObjectPascal.    }
{ More information about this project can be found at:                       }
{ http://www.sulaco.co.za/quake2/                                            }
{                                                                            }
{ Copyright (C) 1997-2001 Id Software, Inc.                                  }
{                                                                            }
{ This program is free software; you can redistribute it and/or              }
{ modify it under the terms of the GNU General Public License                }
{ as published by the Free Software Foundation; either version 2             }
{ of the License, or (at your option) any later version.                     }
{                                                                            }
{ This program is distributed in the hope that it will be useful,            }
{ but WITHOUT ANY WARRANTY; without even the implied warranty of             }
{ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                       }
{                                                                            }
{ See the GNU General Public License for more details.                       }
{                                                                            }
{----------------------------------------------------------------------------}
{ * Updated:                                                                 }
{ 03-jun-2002 Juha Hartikainen ([e-mail])                         }
{ - Added missing units to uses clause.					     }
{}
{ 06-jun-2002 Juha Hartikainen ([e-mail])                         }
{ - Finished conversion.					     }
{----------------------------------------------------------------------------}

unit in_win;

// in_win.c -- windows 95 mouse and joystick code
// 02/21/97 JCB Added extended DirectInput code to support external controllers.

//------------------------------------------------------------------------------
// translated by andre: all my comments are marked with (andre),
//                      other comments are original
//------------------------------------------------------------------------------

interface

uses
  q_shared,
  CPas,
  CVar;

procedure IN_Activate(active: qboolean);
procedure IN_Frame;
procedure IN_Commands;
procedure IN_Init;
procedure IN_MouseEvent(mstate: Integer);
procedure IN_Move(cmd: usercmd_p);
procedure IN_Shutdown;

var
  in_joystick: cvar_p;

implementation

uses
  client,
  sys_win,
  cl_input,
  cl_main,
  vid_dll,
  keys,
  common,
  MMSystem,
  Windows,
  Types,
  Cmd;

// joystick defines and variables
// where should defines be moved?
const
  JOY_ABSOLUTE_AXIS = $00000000;        // control like a joystick
  JOY_RELATIVE_AXIS = $00000010;        // control like a mouse, spinner, trackball
  JOY_MAX_AXES = 6;                     // X, Y, Z, R, U, V
  JOY_AXIS_X = 0;
  JOY_AXIS_Y = 1;
  JOY_AXIS_Z = 2;
  JOY_AXIS_R = 3;
  JOY_AXIS_U = 4;
  JOY_AXIS_V = 5;

type
  _ControlList = (AxisNada = 0, AxisForward, AxisLook, AxisSide, AxisTurn, AxisUp);

const
  dwAxisFlags: array[0..JOY_MAX_AXES - 1] of DWord =
  (
    JOY_RETURNX, JOY_RETURNY, JOY_RETURNZ, JOY_RETURNR, JOY_RETURNU, JOY_RETURNV
    );

var
  dwAxisMap: array[0..JOY_MAX_AXES - 1] of DWord;
  dwControlMap: array[0..JOY_MAX_AXES - 1] of DWord;
  pdwRawValue: array[0..JOY_MAX_AXES - 1] of PDWord;

  in_mouse: cvar_p;

  // none of these cvars are saved over a session
  // this means that advanced controller configuration needs to be executed
  // each time.  this avoids any problems with getting back to a default usage
  // or when changing from one controller to another.  this way at least something
  // works.
  joy_name: cvar_p;
  joy_advanced: cvar_p;
  joy_advaxisx: cvar_p;
  joy_advaxisy: cvar_p;
  joy_advaxisz: cvar_p;
  joy_advaxisr: cvar_p;
  joy_advaxisu: cvar_p;
  joy_advaxisv: cvar_p;
  joy_forwardthreshold: cvar_p;
  joy_sidethreshold: cvar_p;
  joy_pitchthreshold: cvar_p;
  joy_yawthreshold: cvar_p;
  joy_forwardsensitivity: cvar_p;
  joy_sidesensitivity: cvar_p;
  joy_pitchsensitivity: cvar_p;
  joy_yawsensitivity: cvar_p;
  joy_upthreshold: cvar_p;
  joy_upsensitivity: cvar_p;

  joy_avail, joy_advancedinit, joy_haspov: qboolean;
  joy_oldbuttonstate, joy_oldpovstate: DWORD;

  joy_id: Integer;
  joy_flags: DWORD;
  joy_numbuttons: DWORD;

  ji: JOYINFOEX;

  in_appactive: qboolean;

  // forward-referenced functions
procedure IN_StartupJoystick; forward;

procedure Joy_AdvancedUpdate_f; cdecl; forward;
procedure IN_JoyMove(cmd: usercmd_p); forward;

(*
============================================================

  MOUSE CONTROL

============================================================
*)

// mouse variables
var
  m_filter: cvar_p;
  mlooking: qboolean;

procedure IN_MLookDown; cdecl;
begin
  mlooking := true;
end;

procedure IN_MLookUp; cdecl;
begin
  mlooking := false;
  if (freelook^.value = 0) and (lookspring^.value <> 0) then
    IN_CenterView;
end;

var
  mouse_buttons: Integer;
  mouse_oldbuttonstate: Integer;
  current_pos: TPoint;
  mouse_x, mouse_y,
    old_mouse_x, old_mouse_y,
    mx_accum, my_accum: Integer;

  old_x, old_y: Integer;

  mouseactive: qboolean;                // false when not focus app

  restore_spi: qboolean;
  mouseinitialized: qboolean;
  mouseparmsvalid: qboolean;

  window_center_x,
    window_center_y: Integer;
  window_rect: TRECT;

const
  originalmouseparms: array[0..2] of integer = (0, 0, 1);
  newmouseparms: array[0..2] of integer = (0, 0, 1);

  (*
  ===========
  IN_ActivateMouse

  Called when the window gains focus or changes in some way
  ===========
  *)

procedure IN_ActivateMouse;
var
  width, height: Integer;
begin
  if not mouseinitialized then
    exit;
  if (in_mouse^.value = 0) then
  begin
    mouseactive := false;
    exit;
  end;
  if mouseactive then
    exit;

  mouseactive := true;

  if mouseparmsvalid then
    restore_spi := SystemParametersInfo(SPI_SETMOUSE, 0, @newmouseparms, 0);

  width := GetSystemMetrics(SM_CXSCREEN);
  height := GetSystemMetrics(SM_CYSCREEN);

  GetWindowRect(cl_hwnd, window_rect);
  if window_rect.left < 0 then
    window_rect.left := 0;
  if window_rect.top < 0 then
    window_rect.top := 0;
  if window_rect.right >= width then
    window_rect.right := width - 1;
  if window_rect.bottom >= height - 1 then
    window_rect.bottom := height - 1;

  window_center_x := (window_rect.right + window_rect.left) div 2;
  window_center_y := (window_rect.top + window_rect.bottom) div 2;

  SetCursorPos(window_center_x, window_center_y);

  old_x := window_center_x;
  old_y := window_center_y;

  SetCapture(cl_hwnd);
  ClipCursor(@window_rect);
  while ShowCursor(FALSE) >= 0 do
    ;
end;

(*
===========
IN_DeactivateMouse

Called when the window loses focus
===========
*)

procedure IN_DeactivateMouse;
begin
  if not mouseinitialized then
    exit;
  if not mouseactive then
    exit;

  if restore_spi then
    SystemParametersInfo(SPI_SETMOUSE, 0, @originalmouseparms, 0);

  mouseactive := false;

  ClipCursor(NULL);
  ReleaseCapture;
  while (ShowCursor(TRUE) < 0) do
    ;
end;

(*
===========
IN_StartupMouse
===========
*)

procedure IN_StartupMouse;
var
  cv: cvar_p;
begin
  cv := Cvar_Get('in_initmouse', '1', CVAR_NOSET);
  if (cv^.value = 0) then
    exit;

  mouseinitialized := true;
  mouseparmsvalid := SystemParametersInfo(SPI_GETMOUSE, 0, @originalmouseparms, 0);
  mouse_buttons := 3;
end;

(*
===========
IN_MouseEvent
===========
*)

procedure IN_MouseEvent(mstate: Integer);
var
  i: Integer;
begin
  if not mouseinitialized then
    exit;

  // perform button actions
  for i := 0 to mouse_buttons - 1 do
  begin
    if ((mstate and (1 shl i)) <> 0) and
      not ((mouse_oldbuttonstate and (1 shl i)) <> 0) then
    begin
      keys.Key_Event(K_MOUSE1 + i, true, sys_msg_time);
    end;

    if not ((mstate and (1 shl i)) <> 0) and
      ((mouse_oldbuttonstate and (1 shl i)) <> 0) then
    begin
      keys.Key_Event(K_MOUSE1 + i, false, sys_msg_time);
    end;
  end;

  mouse_oldbuttonstate := mstate;
end;

(*
===========
IN_MouseMove
===========
*)

procedure IN_MouseMove(cmd: usercmd_p);
var
  mx, my: Integer;
begin
  if not mouseactive then
    exit;

  // find mouse movement
  if not GetCursorPos(current_pos) then
    exit;

  mx := current_pos.x - window_center_x;
  my := current_pos.y - window_center_y;

  if (m_filter^.value <> 0) then
  begin
    mouse_x := (mx + old_mouse_x) div 2;
    mouse_y := (my + old_mouse_y) div 2;
  end
  else
  begin
    mouse_x := mx;
    mouse_y := my;
  end;

  old_mouse_x := mx;
  old_mouse_y := my;

  mouse_x := Round(mouse_x * sensitivity^.value);
  mouse_y := Round(mouse_y * sensitivity^.value);
  if ((in_strafe.state and 1 <> 0) or
    ((lookstrafe.value <> 0) and mlooking)) then
    cmd^.sidemove := Round(cmd^.sidemove + (m_side^.value * mouse_x))
  else
    cl.viewangles[YAW] := cl.viewangles[YAW] - (m_yaw^.value * mouse_x);

  if ((mlooking or (freelook.value <> 0)) and
    not (in_strafe.state and 1 <> 0)) then
  begin
    cl.viewangles[PITCH] := cl.viewangles[PITCH] + (m_pitch^.value * mouse_y);
  end
  else
  begin
    cmd^.forwardmove := Round(cmd^.forwardmove - (m_forward^.value * mouse_y));
  end;

  // force the mouse to the center, so there's room to move
  if (mx <> 0) or (my <> 0) then
    SetCursorPos(window_center_x, window_center_y);
end;

(*
=========================================================================

VIEW CENTERING

=========================================================================
*)

var
  v_centermove: cvar_p;
  v_centerspeed: cvar_p;

  (*
  ===========
  IN_Init
  ===========
  *)

procedure IN_Init;
begin
  // mouse variables
  m_filter := Cvar_Get('m_filter', '0', 0);
  in_mouse := Cvar_Get('in_mouse', '1', CVAR_ARCHIVE);

  // joystick variables
  in_joystick := Cvar_Get('in_joystick', '0', CVAR_ARCHIVE);
  joy_name := Cvar_Get('joy_name', 'joystick', 0);
  joy_advanced := Cvar_Get('joy_advanced', '0', 0);
  joy_advaxisx := Cvar_Get('joy_advaxisx', '0', 0);
  joy_advaxisy := Cvar_Get('joy_advaxisy', '0', 0);
  joy_advaxisz := Cvar_Get('joy_advaxisz', '0', 0);
  joy_advaxisr := Cvar_Get('joy_advaxisr', '0', 0);
  joy_advaxisu := Cvar_Get('joy_advaxisu', '0', 0);
  joy_advaxisv := Cvar_Get('joy_advaxisv', '0', 0);
  joy_forwardthreshold := Cvar_Get('joy_forwardthreshold', '0.15', 0);
  joy_sidethreshold := Cvar_Get('joy_sidethreshold', '0.15', 0);
  joy_upthreshold := Cvar_Get('joy_upthreshold', '0.15', 0);
  joy_pitchthreshold := Cvar_Get('joy_pitchthreshold', '0.15', 0);
  joy_yawthreshold := Cvar_Get('joy_yawthreshold', '0.15', 0);
  joy_forwardsensitivity := Cvar_Get('joy_forwardsensitivity', '-1', 0);
  joy_sidesensitivity := Cvar_Get('joy_sidesensitivity', '-1', 0);
  joy_upsensitivity := Cvar_Get('joy_upsensitivity', '-1', 0);
  joy_pitchsensitivity := Cvar_Get('joy_pitchsensitivity', '1', 0);
  joy_yawsensitivity := Cvar_Get('joy_yawsensitivity', '-1', 0);
  // centering
  v_centermove := Cvar_Get('v_centermove', '0.15', 0);
  v_centerspeed := Cvar_Get('v_centerspeed', '500', 0);

  Cmd_AddCommand('+mlook', IN_MLookDown);
  Cmd_AddCommand('-mlook', IN_MLookUp);

  Cmd_AddCommand('joy_advancedupdate', Joy_AdvancedUpdate_f);

  IN_StartupMouse();
  IN_StartupJoystick();
end;

(*
===========
IN_Shutdown
===========
*)

procedure IN_Shutdown;
begin
  IN_DeactivateMouse;
end;

(*
===========
IN_Activate

Called when the main window gains or loses focus.
The window may have been destroyed and recreated
between a deactivate and an activate.
===========
*)

procedure IN_Activate(active: qboolean);
begin
  in_appactive := active;
  mouseactive := not active;            // force a new window check or turn off
end;

(*
==================
IN_Frame

Called every frame, even if not generating commands
==================
*)

procedure IN_Frame;