glw_imp.pas

delphi编的不错的贪吃蛇

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): GLW_IMP.C                                                         }
{                                                                            }
{ Initial conversion by : YgriK (Igor Karpov) - [e-mail]            }
{ Initial conversion on : 18-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 :                                                               }
{ Updated by :                                                               }
{                                                                            }
{----------------------------------------------------------------------------}

{*
** GLW_IMP.C
**
** This file contains ALL Win32 specific stuff having to do with the
** OpenGL refresh.  When a port is being made the following functions
** must be implemented by the port:
**
** GLimp_EndFrame
** GLimp_Init
** GLimp_Shutdown
** GLimp_SwitchFullscreen
**
*}

unit glw_imp;

interface

uses
  q_shared,
  glw_win,
  qgl_win,
  gl_local;

//NB! none cdecl
function GLimp_SetMode(var pwidth, pheight: integer;
  mode: integer; fullscreen: qboolean): rserr_t;
procedure GLimp_Shutdown;
function GLimp_Init(hinstance: HINST; wndproc: pointer): qboolean; //add info: glw_win.inc: glwstate_t
procedure GLimp_BeginFrame(camera_separation: Single);

//NB! cdecl
procedure GLimp_EndFrame; cdecl;
procedure GLimp_AppActivate(active: qboolean); cdecl;

var
  glw_state: glwstate_t;

implementation

uses
  CPas,
  Windows,
  ref,
  gl_rmain,
  OpenGL;

function GLimp_InitGL: qboolean; forward;

function VerifyDriver: qboolean;
var
  buffer: PChar;
begin
  //strcpy( buffer, PChar(qglGetString(GL_RENDERER)) );
  //strlwr( buffer );
  //if ( strcmp( buffer, 'gdi generic' ) == 0 ) then}

  //Y:
  buffer := PChar(qglGetString(GL_RENDERER));
  if strcmp('gdi generic', buffer) = 0 then
    if (not glw_state.mcd_accelerated) then
    begin
      Result := false;
      Exit;
    end;
  Result := true;
end; //function

{*
** VID_CreateWindow
*}
const
  WINDOW_CLASS_NAME = 'Quake 2 Delphi';
  WINDOW_NAME = 'Quake 2 Delphi';
  WINDOW_STYLE = (WS_OVERLAPPED or WS_BORDER or WS_CAPTION or WS_VISIBLE);

function VID_CreateWindow(width, height: integer; fullscreen: qboolean): qboolean;
var
  wc: WNDCLASS;
  r: TRECT;
  vid_xpos,
    vid_ypos: cvar_p;
  stylebits,
    x, y, w, h,
    exstyle: integer;
begin
  // Register the frame class
  wc.style := 0;
  wc.lpfnWndProc := {(WNDPROC)} glw_state.wndproc;
  wc.cbClsExtra := 0;
  wc.cbWndExtra := 0;
  wc.hInstance := glw_state.hInstance;
  wc.hIcon := 0;
  wc.hCursor := LoadCursor(0, IDC_ARROW);
  wc.hbrBackground := COLOR_GRAYTEXT;
  wc.lpszMenuName := nil;
  wc.lpszClassName := WINDOW_CLASS_NAME;

  if (RegisterClass(wc) = 0) then
    ri.Sys_Error(ERR_FATAL, 'Couldn''t register window class');

  if (fullscreen) then
  begin
    exstyle := WS_EX_TOPMOST;
    stylebits := WS_POPUP or WS_VISIBLE;
  end
  else
  begin
    exstyle := 0;
    stylebits := WINDOW_STYLE;
  end;

  r.left := 0;
  r.top := 0;
  r.right := width;
  r.bottom := height;

  AdjustWindowRect(r, stylebits, FALSE);

  w := r.right - r.left;
  h := r.bottom - r.top;

  if (fullscreen) then
  begin
    x := 0;
    y := 0;
  end
  else
  begin
    vid_xpos := ri.Cvar_Get('vid_xpos', '0', 0);
    vid_ypos := ri.Cvar_Get('vid_ypos', '0', 0);
    x := Trunc(vid_xpos.value);
    y := Trunc(vid_ypos.value);
  end;

  glw_state.Wnd := CreateWindowEx(exstyle,
    WINDOW_CLASS_NAME,
    WINDOW_NAME,
    stylebits,
    x, y, w, h,
    0,
    0,
    glw_state.hInstance,
    nil);

  if (glw_state.Wnd = 0) then
    ri.Sys_Error(ERR_FATAL, 'Couldn''t create window');

  ShowWindow(glw_state.Wnd, SW_SHOW);
  UpdateWindow(glw_state.Wnd);

  // init all the gl stuff for the window
  if (not GLimp_InitGL()) then
  begin
    ri.Con_Printf(PRINT_ALL, 'VID_CreateWindow() - GLimp_InitGL failed'#10);
    Result := false;
    Exit;
  end;

  SetForegroundWindow(glw_state.Wnd);
  SetFocus(glw_state.Wnd);

  // let the sound and input subsystems know about the new window
  ri.Vid_NewWindow(width, height);

  Result := true;
end;

{*
** GLimp_SetMode
*}

function GLimp_SetMode(var pwidth, pheight: integer;
  mode: integer; fullscreen: qboolean): rserr_t;
var
  width, height,
    bitspixel_: integer;
  dm: DEVMODE;
  dc: HDC;
const
  win_fs: array[{0..1} boolean] of PChar = ('W', 'FS');
begin
  ri.Con_Printf(PRINT_ALL, 'Initializing OpenGL display'#10);

  ri.Con_Printf(PRINT_ALL, '...setting mode %d:', [mode]);

  if (not ri.Vid_GetModeInfo(@width, @height, mode)) then
  begin
    ri.Con_Printf(PRINT_ALL, ' invalid mode'#10);
    Result := rserr_invalid_mode;
    Exit;
  end;

  ri.Con_Printf(PRINT_ALL, '%d %d %s'#10, width, height, win_fs[fullscreen]);

  // destroy the existing window
  if (glw_state.Wnd <> 0) then
    GLimp_Shutdown();

  // do a CDS if needed
  if (fullscreen) then
  begin
    ri.Con_Printf(PRINT_ALL, '...attempting fullscreen'#10);

    memset(@dm, 0, sizeof(dm));

    dm.dmSize := sizeof(dm);

    dm.dmPelsWidth := width;
    dm.dmPelsHeight := height;
    dm.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;

    if (gl_bitdepth.value <> 0) then
    begin
      dm.dmBitsPerPel := Trunc(gl_bitdepth.value);
      dm.dmFields := dm.dmFields or DM_BITSPERPEL;
      ri.Con_Printf(PRINT_ALL, '...using gl_bitdepth of %d'#10, Trunc(gl_bitdepth.value));
    end
    else
    begin
      dc := GetDC(0);
      bitspixel_ := GetDeviceCaps(dc, BITSPIXEL);

      ri.Con_Printf(PRINT_ALL, '...using desktop display depth of %d'#10, bitspixel_);

      ReleaseDC(0, dc);
    end;

    ri.Con_Printf(PRINT_ALL, '...calling CDS: ');
    if (ChangeDisplaySettings(dm, CDS_FULLSCREEN) = DISP_CHANGE_SUCCESSFUL) then
    begin
      pwidth := width;
      pheight := height;

      gl_state.fullscreen := true;

      ri.Con_Printf(PRINT_ALL, 'ok'#10);

      if (not VID_CreateWindow(width, height, true)) then
      begin
        Result := rserr_invalid_mode;
        Exit;
      end;

      Result := rserr_ok;
      Exit;
    end
    else
    begin
      pwidth := width;
      pheight := height;

      ri.Con_Printf(PRINT_ALL, 'failed'#10);

      ri.Con_Printf(PRINT_ALL, '...calling CDS assuming dual monitors:');

      dm.dmPelsWidth := width * 2;
      dm.dmPelsHeight := height;
      dm.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;

      if (gl_bitdepth.value <> 0) then
      begin
        dm.dmBitsPerPel := Trunc(gl_bitdepth.value);
        dm.dmFields := dm.dmFields or DM_BITSPERPEL;
      end;
      {*
      ** our first CDS failed, so maybe we're running on some weird dual monitor
      ** system
      *}
      if (ChangeDisplaySettings({&} dm, CDS_FULLSCREEN) <> DISP_CHANGE_SUCCESSFUL) then
      begin
        ri.Con_Printf(PRINT_ALL, ' failed'#10);

        ri.Con_Printf(PRINT_ALL, '...setting windowed mode'#10);

//Y        ChangeDisplaySettings (0, 0);
        ChangeDisplaySettings(devmode(nil^), 0);

        pwidth := width;
        pheight := height;
        gl_state.fullscreen := false;
        if (not VID_CreateWindow(width, height, false)) then
        begin
          Result := rserr_invalid_mode;
          Exit;
        end;
        Result := rserr_invalid_fullscreen;
        Exit;
      end
      else
      begin
        ri.Con_Printf(PRINT_ALL, ' ok'#10);
        if (not VID_CreateWindow(width, height, true)) then
        begin
          Result := rserr_invalid_mode;
          Exit;
        end;

        gl_state.fullscreen := true;
        Result := rserr_ok;
        Exit;
      end;
    end;
  end
  else
  begin
    ri.Con_Printf(PRINT_ALL, '...setting windowed mode'#10);

//Y:    ChangeDisplaySettings (0, 0);
    ChangeDisplaySettings(devmode(nil^), 0);

    pwidth := width;
    pheight := height;
    gl_state.fullscreen := false;
    if (not VID_CreateWindow(width, height, false)) then
    begin
      Result := rserr_invalid_mode;
      Exit;
    end;
  end;

  Result := rserr_ok;
end;

{*
** GLimp_Shutdown
**
** This routine does all OS specific shutdown procedures for the OpenGL
** subsystem.  Under OpenGL this means NULLing out the current DC and
** HGLRC, deleting the rendering context, and releasing the DC acquired
** for the window.  The state structure is also nulled out.
**
*}