sys_win.pas

雷神之锤2(Quake2)Delphi源码

      Sys_Error('Error reading console input', []);
    if numread <> 1 then
      Sys_Error('Couldn''t read console input', []);

    // Process console input.
    if recs[0].EventType = KEY_EVENT then
      if not recs[0].Event.KeyEvent.bKeyDown then
        begin
          ch := Integer(recs[0].Event.KeyEvent.AsciiChar);
          case ch of
            13: // Pressed key = [Enter]
            begin
              WriteFile(houtput, #13#10, 2, Cardinal(dummy), nil);
              if console_textlen <> 0 then
              begin
                console_text[console_textlen] := #0;
                console_textlen := 0;
                Result := console_text;
                Exit;
              end;
            end;
            08: // Pressed key = [BACK SPACE]
            if console_textlen > 0 then
            begin
              Dec(console_textlen);
              WriteFile(houtput, #8#32#8, 3, Cardinal(dummy), nil);
            end;
            else // Otherwise
              if ch >= 32 then
                if console_textlen < (SizeOf(console_textlen) - 2) then
                begin
                  WriteFile(houtput, ch, 1, Cardinal(dummy), nil);
                  console_text[console_textlen] := Chr(ch);
                  Inc(console_textlen);
                end;
          end;
        end;
  end;
end;

procedure Sys_ConsoleOutput(aString: PChar);
var
  dummy: Integer;
  text: array[0..255] of Char;
begin
  if (dedicated = nil) or (dedicated.value = 0) then
    Exit;

  // Erase what currently appears on the console's command line.
  if console_textlen <> 0 then
  begin
    text[0] := #13;
    FillChar(text[1], console_textlen, ' ');
    text[console_textlen + 1] := #13;
    text[console_textlen + 2] := #0;
    WriteFile(houtput, text, console_textlen + 2, Cardinal(dummy), nil);
  end;

  // Output the string.
  WriteFile(houtput, aString^, StrLen(aString), Cardinal(dummy), nil);

  // Re-type what has been erased.
  if console_textlen <> 0 then
    WriteFile(houtput, console_text, console_textlen, Cardinal(dummy), nil);
end;

procedure Sys_SendKeyEvents;
var
  aMsg: TMSG;
begin
  while PeekMessage(aMsg, 0, 0, 0, PM_NOREMOVE) do
  begin
    if not GetMessage(aMsg, 0, 0, 0) then
      Sys_Quit;
    sys_msg_time := aMsg.time;
    TranslateMessage(aMsg);
    DispatchMessage(aMsg);
  end;
  sys_frame_time := timeGetTime;
end;

function Sys_GetClipboardData: PChar;
var
  data: PChar;
  cliptext: PChar;
  hClipboardData: THandle;
begin
  data := nil;
  if OpenClipboard(0) then
  begin
    hClipboardData := GetClipboardData(CF_TEXT);
    if hClipboardData <> 0 then
    begin
      cliptext := GlobalLock(hClipboardData);
      if cliptext <> nil then
      begin
        GetMem(data, GlobalSize(hClipboardData) + 1);
        StrCopy(data, cliptext);
        GlobalUnlock(hClipboardData);
      end;
    end;
    CloseClipboard;
  end;
  Result := data;
end;

procedure Sys_AppActivate;
begin
  ShowWindow(cl_hwnd, SW_RESTORE);
  SetForegroundWindow(cl_hwnd);
end;

procedure Sys_Unloadgame;
begin
  if not FreeLibrary(game_library) then
    Com_Error(ERR_FATAL, 'FreeLibrary failed for game library');
  game_library := 0;
end;

function Sys_GetGameAPI(parms: Pointer): Pointer;
var
  GetGameAPI: function(parms: Pointer): Pointer; cdecl;
  name: array[0..MAX_OSPATH - 1] of Char;
  cwd : array[0..MAX_OSPATH - 1] of Char;
  path: PChar;

const
  gamename: PChar = 'gamex86.dll';
{$IFDEF NDEBUG}
  debugdir: PChar = 'release';
{$ELSE}
  debugdir: PChar = 'debug';
{$ENDIF}


begin
  if game_library <> 0 then
    Com_Error(ERR_FATAL, 'Sys_GetGameAPI without Sys_UnloadingGame');

  // Check the current debug directory first, for development purposes.
  GetCurrentDirectory(SizeOf(cwd), @cwd);
  Com_sprintf(name, SizeOf(name), '%s/%s/%s', [cwd, debugdir, gamename]);
  game_library := LoadLibrary(name);
  if game_library <> 0 then
    Com_DPrintf('LoadLibrary (%s)'#10, [name])
  else
  begin

{$IFDEF DEBUG}

    // Not found? Check the current directory, for other development purposes
    Com_sprintf(name, SizeOf(name), '%s/%s', [cwd, gamename]);
    game_library := LoadLibrary(name);
    if game_library <> 0 then
      Com_DPrintf('LoadLibrary (%s)'#10, [name])
    else

{$ENDIF}

    begin

      // Still not found? Run through the search paths
      path := nil;
      while True do
      begin
        path := FS_NextPath(path);
        if path = nil then
        begin
          Result := nil;
          Exit;
        end;
        Com_sprintf(name, SizeOf(name), '%s/%s', [path, gamename]);
        game_library := LoadLibrary(name);
        if game_library <> 0 then
        begin
          Com_DPrintf('LoadLibrary (%s)'#10, [name]);
          Break;
        end;
      end;

    end;

  end;

  // Gets here, if the library was found.
  GetGameAPI := GetProcAddress(game_library, 'GetGameAPI');
  if not Assigned(GetGameAPI) then
  begin
    Sys_Unloadgame;
    Result := nil;
    Exit;
  end;

  Result := GetGameAPI(parms);
end;

procedure ParseCommandLine(lpCmdLine: LPSTR);
begin
  argc := 1;
  argv[0] := 'exe';

  // This is to break the command line string down to one or more sub-strings,
  // so that each sub-string contains one argument.
  // In addition, it calculates the number of the arguments.
  while (lpCmdLine^ <> #0) and (argc < MAX_NUM_ARGVS) do
  begin
    // Skip "white-space" to the first/next argument.
    while (lpCmdLine^ <> #0) and ((Ord(lpCmdLine^) <= 32) or (Ord(lpCmdLine^) > 126)) do
      Inc(Integer(lpCmdLine));

    // Check to see if it's the end of the command line.
    if lpCmdLine^ <> #0 then
    begin
      // Keep a new reference (pointer) to the argument
      argv[argc] := lpCmdLine;
      Inc(argc);

      // Skip the argument to the next white space.
      while (lpCmdLine^ <> #0) and ((Ord(lpCmdLine^) > 32) or (Ord(lpCmdLine^) <= 126)) do
        Inc(Integer(lpCmdLine));

      // Split the command line between the arguments,
      // by placing a zero after the end of each argument.
      if lpCmdLine^ <> #0 then
      begin
        lpCmdLine^ := #0;
        Inc(Integer(lpCmdLine));
      end;
    end;
  end;
end;

function WinMain(hInstance, hPrevInstance: HINST; lpCmdLine: LPSTR; nCmdShow: Integer): Integer; stdcall;
var
  aMsg: TMSG;
  time, oldtime, newtime: Integer;
  cddir: PChar;
  i: Integer;
begin

  // This is to make sure that previous instances do not exist.
  if hPrevInstance <> 0 then
  begin
    Result := 0;
    Exit;
  end;

  global_hInstance := hInstance;
  ParseCommandLine(lpCmdLine);
  cddir := Sys_ScanForCD;

  if (cddir <> nil) and (argc < MAX_NUM_ARGVS - 3) then
  begin
    i := 0;

    // Search for "cddir" in the command line.
    while i < argc do
    begin
      if StrComp(argv[i], 'cddir') = 0 then
        Break;
      i := i + 1;
    end;

    // If "cddir" is not in the command line,
    // add the following arguments: "+set", "cddir" and the value of cddir.
    if i = argc then
    begin
      argv[argc] := '+set' ; Inc(argc);
      argv[argc] := 'cddir'; Inc(argc);
      argv[argc] :=  cddir ; Inc(argc);
    end;
  end;

  // Initialize Quake2.
  Qcommon_Init(argc, @argv[0]);
  oldtime := Sys_Milliseconds;

  // The main window message loop.
  while True do
  begin
    if Minimized or ((dedicated <> nil) and (dedicated.value <> 0)) then
      Sleep(1);

    // Process messages.
    while PeekMessage(aMsg, 0, 0, 0, PM_NOREMOVE) do
    begin
      if not GetMessage(aMsg, 0, 0, 0) then
        Com_Quit;
      sys_msg_time := aMsg.time;
      TranslateMessage(aMsg);
      DispatchMessage(aMsg);
    end;

    // Wait more than 1 ms.
    repeat
      newtime := Sys_Milliseconds;
      time := newtime - oldtime;
    until time >= 1;

    {
    Con_Printf('time:%5.2f - %5.2f = %5.2f'#10, [newtime, oldtime, time]);
    SetExceptionMask([exDenormalized, exOverflow, exUnderflow, exPrecision]);
    }

    SetPrecisionMode(pmExtended);
    Qcommon_Frame(time);

    oldtime := newtime;
  end;
  
  Result := 1;
end;

end.