vid_dll.pas

雷神之锤2(Quake2)Delphi源码

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): vid_dll.c                                                         }
{ Content:                                                                   }
{                                                                            }
{ Initial conversion by : Scott Price                                        }
{ Initial conversion on : 12-Jan-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.                       }
{                                                                            }
{----------------------------------------------------------------------------}

unit vid_dll;


interface



{ Main windowed and fullscreen graphics interface module. This module
  is used for both the software and OpenGL rendering versions of the
  Quake refresh engine. }

uses
  { Borland Standard Units }
  Windows,
  Messages,
  MMSystem,
  SysUtils,
  { Own Units }
  Delphi_cdecl_printf,
  ref,
  keys,
  cvar,
  vid_h,
  snd_win,
  in_win,
  cl_scrn,
  Common,
  sys_win,
  q_shared,
  Console,
  snd_dma,
  Client;



{ Defined Constants }
const
  MAXPRINTMSG = 4096;



type
  vidmode_p = ^vidmode_t;
  vidmode_t = packed record
    description: PChar; { const char * }
    width, height: Integer;
    mode: Integer;
  end;
  PVidMode_t = ^vidmode_t;
  TVidMode_T = vidmode_t;



procedure VID_CheckChanges;
procedure VID_Init;
procedure VID_Shutdown;
function MainWndProc(h_Wnd: HWND; uMsg: Cardinal; wParam: WPARAM; lParam: LPARAM): LongInt; cdecl;

// Juha: These are only exported because our Delphi_cdecl_printf.pas needs to call them back.
procedure VID_Printf(print_level: Integer; fmt: PChar; args: array of const);
procedure VID_Error(err_level:integer; fmt:PChar; args: array of const);



(* ==========================================================================
DLL GLUE   // What this Means?
========================================================================== *)



var
  { Structure containing functions exported from refresh DLL }
  re: refexport_t;
  win_noalttab: cvar_p;

  { Console variables that we need to access from this module }
  vid_gamma: cvar_p;
  vid_ref: cvar_p;			{ Name of Refresh DLL loaded }
  vid_xpos: cvar_p;			{ X coordinate of window position }
  vid_ypos: cvar_p;			{ Y coordinate of window position }
  vid_fullscreen: cvar_p;

  { Global variables used internally by this module }
  viddef: viddef_t;				{ global video state; used by other modules }

  cl_hwnd: HWND;            { Main window handle for life of program }


  scantokey: array[0..128-1] of byte = (
//  0           1       2       3       4       5       6       7
//  8           9       A       B       C       D       E       F
	0  ,          27,           byte('1'),    byte('2'),    byte('3'),     byte('4'),    byte('5'),    byte('6'),
	byte('7'),    byte('8'),    byte('9'),    byte('0'),    byte('-'),     byte('='),    K_BACKSPACE,  9, // 0
	byte('q'),    byte('w'),    byte('e'),    byte('r'),    byte('t'),     byte('y'),    byte('u'),    byte('i'),
	byte('o'),    byte('p'),    byte('['),    byte(']'),    13 ,           K_CTRL,       byte('a'),    byte('s'),      // 1
	byte('d'),    byte('f'),    byte('g'),    byte('h'),    byte('j'),     byte('k'),    byte('l'),    byte(';'),
	byte('''') ,  byte('`'),    K_SHIFT,      byte('\'),    byte('z'),     byte('x'),    byte('c'),    byte('v'),      // 2
	byte('b'),    byte('n'),    byte('m'),    byte(','),    byte('.'),     byte('/'),    K_SHIFT,      byte('*'),
	K_ALT,        byte(' '),    0  ,          K_F1,         K_F2,          K_F3,         K_F4,         K_F5,   // 3
	K_F6,         K_F7,         K_F8,         K_F9,         K_F10,         K_PAUSE,      0  ,          K_HOME,
	K_UPARROW,    K_PGUP,       K_KP_MINUS,   K_LEFTARROW,  K_KP_5,        K_RIGHTARROW, K_KP_PLUS,    K_END, //4
	K_DOWNARROW,  K_PGDN,       K_INS,        K_DEL,        0,             0,            0,            K_F11,
	K_F12,        0  ,          0  ,          0  ,          0  ,           0  ,          0  ,          0,        // 5
	0  ,    0  ,    0  ,    0  ,    0  ,    0  ,    0  ,    0,
	0  ,    0  ,    0  ,    0  ,    0  ,    0  ,    0  ,    0,        // 6
	0  ,    0  ,    0  ,    0  ,    0  ,    0  ,    0  ,    0,
	0  ,    0  ,    0  ,    0  ,    0  ,    0  ,    0  ,    0         // 7
  );

  vid_modes: array[0..10] of vidmode_t = (* Initialize the "vid_modes" variable with these values *)
  (
    ( description:'Mode 0: 320x240'; width: 320; height: 240;mode:  0 ),
    ( description:'Mode 1: 400x300'; width: 400; height: 300;mode:  1 ),
    ( description:'Mode 2: 512x384'; width: 512; height: 384;mode:  2 ),
    ( description:'Mode 3: 640x480'; width: 640; height: 480;mode:  3 ),
    ( description:'Mode 4: 800x600'; width: 800; height: 600;mode:  4 ),
    ( description:'Mode 5: 960x720'; width: 960; height: 720;mode:  5 ),
    ( description:'Mode 6: 1024x768'; width: 1024; height: 768;mode:  6 ),
    ( description:'Mode 7: 1152x864'; width: 1152; height: 864;mode:  7 ),
    ( description:'Mode 8: 1280x960'; width: 1280; height: 960;mode:  8 ),
    ( description:'Mode 9: 1600x1200'; width: 1600; height: 1200;mode:  9 ),
	  ( description:'Mode 10: 2048x1536'; width: 2048; height: 1536;mode:  10 )
  );

const
  VID_NUM_MODES = ( sizeof( vid_modes ) / sizeof( vid_modes[0] ) );


implementation

uses
  cd_win,
  cl_main,
  Cmd,
  Files,
  vid_menu,
  CPas;

var
  { Static Variables  ?? }
  MSH_MOUSEWHEEL: Cardinal;
  s_alttab_disabled: qboolean;
  reflib_library: LongWord;		{ Handle to refresh DLL }
  reflib_active: qboolean = False;


  { Static Function Translations }

procedure WIN_DisableAltTab;
var
  old: Boolean;
begin
  if s_alttab_disabled then
     Exit;

  if s_win95 then
     SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @old, 0)
  else begin
       RegisterHotKey(0, 0, MOD_ALT, VK_TAB);
       RegisterHotKey(0, 1, MOD_ALT, VK_RETURN);
  end;

  s_alttab_disabled := True;
end;

procedure WIN_EnableAltTab;
var
  old: Boolean;
begin
  if s_alttab_disabled then begin
     if s_win95 then
        SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, @old, 0)
     else begin
          UnregisterHotKey(0, 0);
          UnregisterHotKey(0, 1);
     end;

     s_alttab_disabled := False;
  end;
end;

  { Other Routines }

procedure VID_Printf(print_level: Integer; fmt: PChar; args: Array of const);
var
  msg: array[0..MAXPRINTMSG-1] of char;
begin
// Sly 04-Jul-2002 This is a problem because the ref DLL calls this function,
// however it is expecting the parameters to be C-like.
  DelphiStrFmt(msg, fmt, args);
  if (print_level=PRINT_ALL) then
    Com_Printf ('%s', [msg])
  else  if (print_level = PRINT_DEVELOPER) then
    Com_DPrintf ('%s', [msg])
  else if (print_level = PRINT_ALERT) then begin
       MessageBox(0, msg, 'PRINT_ALERT', MB_ICONWARNING);
       OutputDebugString(msg);
  end;
end;

procedure VID_Error(err_level:integer; fmt:PChar; args: array of const);
var
  msg: array[0..MAXPRINTMSG-1] of char;
begin
// Sly 04-Jul-2002 This is a problem because the ref DLL calls this function,
// however it is expecting the parameters to be C-like.
  DelphiStrFmt(msg, fmt, args);
  //strcpy(msg, fmt);
  Com_Error (err_level, '%s', [msg]);
end;


(* ============
VID_Restart_f

Console command to re-start the video mode and refresh DLL. We do this
simply by setting the modified flag for the vid_ref variable, which will
cause the entire video mode and refresh DLL to be reset on the next frame.
============ *)
procedure VID_Restart_f; cdecl;
begin
  vid_ref.modified := True;
end;

procedure VID_Front_f; cdecl;
begin
  SetWindowLong(cl_hwnd, GWL_EXSTYLE, WS_EX_TOPMOST);
  SetForegroundWindow(cl_hwnd);
end;

(* =======
MapKey

Map from windows to quake keynums
======= *)

function MapKey(key: Integer): Integer;
var
  iResult: Integer;
  modified: Integer;
  is_extended: qboolean;
begin
  modified := (key shr 16) AND 255;
  is_extended := False;

  if (modified > 127) then begin
     Result := 0;
     Exit;
  end;

  if (key AND (1 shl 24) <> 0) then
     is_extended := True;

  iResult := scantokey[modified];

  if (NOT is_extended) then begin
     case iResult of
       K_HOME:  Result := K_KP_HOME;
       K_UPARROW:  Result := K_KP_UPARROW;
       K_PGUP:  Result := K_KP_PGUP;
       K_LEFTARROW:  Result := K_KP_LEFTARROW;
       K_RIGHTARROW:  Result := K_KP_RIGHTARROW;
       K_END:  Result := K_KP_END;
       K_DOWNARROW:  Result := K_KP_DOWNARROW;
       K_PGDN:  Result := K_KP_PGDN;
       K_INS:  Result := K_KP_INS;
       K_DEL:  Result := K_KP_DEL;
     else
       Result := iResult;
     end;
  end else begin
      case iResult of
        $0D:  Result := K_KP_ENTER;
        $2F:  Result := K_KP_SLASH;
        $AF:  Result := K_KP_PLUS;
      else
        Result := iResult;
      end;
      { TODO:  Looking at the original this might have been:
      case iResult of
        $0D:  begin
          Result := K_KP_ENTER;
          Exit;
        end;
        $2F:  begin
          Result := K_KP_SLASH;
          Exit;
        end;
        $AF:  begin
          Result := K_KP_PLUS;
          Exit;
        end;
      end;

      Result:= iResult; }
  end;
end;

procedure AppActivate(fActive: Boolean; minimize: Boolean);
var
  Minimized: Boolean;
begin
  Minimized := minimize;

  Key_ClearStates;

  { we don't want to act like we're active if we're minimized }
  if (fActive AND (NOT Minimized)) then
     ActiveApp := Integer(True)
  else
     ActiveApp := Integer(False);

  { minimize/restore mouse-capture on demand }
  if (ActiveApp = 0) then begin
     IN_Activate(False);
     CDAudio_Activate(False);
     S_Activate(False);

     if win_noalttab.value <> 0 then
        WIN_EnableAltTab;
  end else begin
      IN_Activate(True);
      CDAudio_Activate(True);
      S_Activate(True);

      if win_noalttab.value <> 0 then
         WIN_DisableAltTab;
  end;
end;


(* ====================
MainWndProc

main window procedure
==================== *)
function MainWndProc(h_Wnd: HWND; uMsg: Cardinal; wParam: WPARAM; lParam: LPARAM): LongInt;
var
//  lRet: LongInt;
  fActive, fMinimized: Integer;
  xPos, yPos, style: Integer;
  temp: Integer;
  r: TRECT;
begin
//  lRet:= 0;

  if (uMsg = MSH_MOUSEWHEEL) then begin
     if (wParam > 0) then begin
        Key_Event(K_MWHEELUP, True, sys_msg_time);
        Key_Event(K_MWHEELUP, False, sys_msg_time);
     end else begin
         Key_Event(K_MWHEELDOWN, True, sys_msg_time);
         Key_Event(K_MWHEELDOWN, False, sys_msg_time);
     end;

     Result:= DefWindowProc(h_Wnd, uMsg, wParam, lParam);
     Exit;
  end;

  { Do what used to be the switch... }