sys_win.pas

雷神之锤2(Quake2)Delphi源码

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): sys_win.c                                                         }
{                                                                            }
{ Initial conversion by : Softland ([e-mail])                  }
{ Initial conversion on : 07-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.                       }
{                                                                            }
{----------------------------------------------------------------------------}
{ Updated on : 03-jun-2002                                                   }
{ Updated by : Juha Hartikainen ([e-mail])                        }
{ - Fixed uses clause                                                        }
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{ 1) ?                                                                       }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{ 1) ?                                                                       }
{----------------------------------------------------------------------------}

unit sys_win;

{

Notes:
=====

1. This unit MUST be checked by someone else.

2. I don't know which of the constants, variables, procedures and functions
should remain in the interface part of the unit, and which should be hidden in
the implementation part.

3. I don't know what the conditional symbols, which should be defined for the
compiler, are.

4. parameters of the form "char **args", were converted to this form:
        "var args: PChar"

5. I assume that this unit requires these supposed-to-get-converted units:
        - q_shared.pas
        - qcommon.pas
        - common.pas
        - cl_main.pas
        - files.pas
        - conproc.pas
        - vid_dll.pas
        - q_shwin.pas

}

interface

uses
  Windows,
  q_shared;

const
  MINIMUM_WIN_MEMORY = $0A00000;
  MAXIMUM_WIN_MEMORY = $1000000;
  MAX_NUM_ARGVS = 128;

var
  s_win95  : qboolean;
  starttime: Integer;
  ActiveApp: Integer;
  Minimized: qboolean;
  hinput   : THandle;
  houtput  : THandle;
  sys_msg_time  : Cardinal;
  sys_frame_time: Cardinal;
  qwclsemaphore : THandle;
  argc : Integer;
  argv : array[0..MAX_NUM_ARGVS - 1] of PChar;
  console_text   : array[0..255] of Char;
  console_textlen: Integer;
  game_library: HINST;
  global_hInstance: HINST;

procedure Sys_Error(error: PChar; args: array of const);
procedure Sys_Quit;
function  Sys_ScanForCD: PChar;
procedure Sys_CopyProtect;
procedure Sys_Init;
function  Sys_ConsoleInput: PChar;
procedure Sys_ConsoleOutput(aString: PChar);
procedure Sys_SendKeyEvents;
function  Sys_GetClipboardData: PChar;
procedure Sys_AppActivate;
procedure Sys_Unloadgame;
function  Sys_GetGameAPI(parms: Pointer): Pointer;

procedure WinError;
procedure ParseCommandLine(lpCmdLine: LPSTR);
function  WinMain(hInstance, hPrevInstance: HINST; lpCmdLine: LPSTR; nCmdShow: Integer): Integer; stdcall;

implementation

uses
  SysUtils,
  MMSystem,
  Math,
  Files,
  Common,
  cl_main,
  conproc,
  vid_dll,
  q_shwin;

{ DEFINE DEMO}
{$DEFINE _M_IX86} // ?????

var

  // Those are only used by Sys_ScanForCD.
  cddir: array[0..MAX_OSPATH - 1] of Char;
  done : qboolean;

procedure Sys_Error(error: PChar; args: array of const);
var
  text  : string;
begin
  CL_Shutdown;
  Qcommon_Shutdown;

  // Report error.
  text := Format(error, args);
  MessageBox(0, PChar(text), 'Error', 0 { MB_OK} );

  if qwclsemaphore <> 0 then
    CloseHandle(qwclsemaphore);
  DeinitConProc;

  Halt(1);
end;

procedure Sys_Quit;
begin
  timeEndPeriod(1);
  CL_Shutdown;
  Qcommon_Shutdown;
  CloseHandle(qwclsemaphore);
  if (dedicated <> nil) and (dedicated.value <> 0) then
    FreeConsole;
  DeinitConProc();

  Halt(0);
end;

procedure WinError;
var
  lpMsgBuf: PChar;
begin
  FormatMessage(
    FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM,
    nil,
    GetLastError,
    (SUBLANG_DEFAULT shl 10) or LANG_NEUTRAL,
    PChar(@lpMsgBuf),
    0,
    nil);
  MessageBox(0, lpMsgBuf, 'GetLastError', MB_OK or MB_ICONINFORMATION);
  LocalFree(HLOCAL(lpMsgBuf)); // Frees the buffer allocated by FormatMessage.
end;

function Sys_ScanForCD: PChar;

{$IFNDEF DEMO}

var
  path : string;
  drive: string;

{$ENDIF}

begin

{$IFNDEF DEMO}

  // Don't re-check.
  if done then
  begin
    Result := cddir;
    Exit;
  end;

  // no abort/retry/fail errors
  SetErrorMode(SEM_FAILCRITICALERRORS);

  drive := 'c:\';
  done  := True;

  // Start scanning for the CD-ROM drive on which "quake2.exe" exists.
  while drive[1] <= 'z' do
  begin
    path := drive + 'install\data';
    Move(PChar(path)^, cddir, Length(path));
    if FileExists(path + '\quake2.exe') then
      if GetDriveType(PChar(drive)) = DRIVE_CDROM then
      begin
        Result := cddir;
        Exit;
      end;
    Inc(drive[1]);
  end;

{$ENDIF}

  cddir[0] := #0;
  Result   := nil;
end;

procedure Sys_CopyProtect;

{$IFNDEF DEMO}

var
  cddir: PChar;

{$ENDIF}

begin

{$IFNDEF DEMO}

  cddir := Sys_ScanForCD;
  if cddir^ = #0 then
    Com_Error(ERR_FATAL, 'You must have the Quake2 CD in the drive to play.');

{$ENDIF}

end;

procedure Sys_Init;
var
  vinfo: OSVERSIONINFO;
begin
{$IFDEF neverever} // ?????

  // Mutex will fail if semaphore already exists.
  qwclsemaphore := CreateMutex(nil, False, 'qwcl');
  if qwclsemaphore = 0 then
    Sys_Error('QWCL is already running on this system', []);
  CloseHandle(qwclsemaphore);


  // Allocate a named semaphore on the client,
  // so that the front end can tell if it is alive.
  qwclsemaphore := CreateSemaphore(nil, 0, 1, 'qwcl');

{$ENDIF}

  // Juha: Needed for Delphi.
  Randomize;

  timeBeginPeriod(1);

  // Vhecking version information.
  vinfo.dwOSVersionInfoSize := SizeOf(vinfo);
  if not GetVersionEx(vinfo) then
    Sys_Error('Couldn''t get OS info', []);
  if vinfo.dwMajorVersion < 4 then
    Sys_Error('Quake2 requires windows version 4 or greater', []);
  if vinfo.dwPlatformId = VER_PLATFORM_WIN32s then
    Sys_Error('Quake2 doesn''t run on Win32s', [])
  else if vinfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
    s_win95 := True;

  if dedicated.value <> 0 then
  begin
    if not AllocConsole then
      Sys_Error('Couldn''t create dedicated server console', []);
    hinput  := GetStdHandle(STD_INPUT_HANDLE );
    houtput := GetStdHandle(STD_OUTPUT_HANDLE);
    InitConProc(argc, @argv[0]);
  end;
end;

function Sys_ConsoleInput: PChar;
var
  recs: array[0..1023] of INPUT_RECORD;
  dummy: Integer;
  ch, numread, numevents: Integer;
begin
  Result := nil;
  if (dedicated = nil) or (dedicated.value = 0) then
    Exit;

  while True do
  begin

    // End the loop, if there are no console input events.
    if not GetNumberOfConsoleInputEvents(hinput, Cardinal(numevents)) then
      Sys_Error('Error getting # of console events', []);
    if numevents <= 0 then
      Break;

    // Read console input.
    if not ReadConsoleInput(hinput, recs[0], 1, Cardinal(numread)) then