vid_dll.pas

delphi编的不错的贪吃蛇

      begin
        Result := 0;
        Exit;
      end;
    WM_CREATE:
      begin
        cl_hwnd := h_Wnd;

        MSH_MOUSEWHEEL := RegisterWindowMessage('MSWHEEL_ROLLMSG');
        Result := DefWindowProc(h_Wnd, uMsg, wParam, lParam);
        Exit;
      end;
    WM_PAINT:
      begin
        { force entire screen to update next frame }
        SCR_DirtyScreen();
        Result := DefWindowProc(h_Wnd, uMsg, wParam, lParam);
        Exit;
      end;
    WM_DESTROY:
      begin
        { let sound and input know about this? }
        cl_hwnd := 0;

        Result := DefWindowProc(h_Wnd, uMsg, wParam, lParam);
        Exit;
      end;
    WM_ACTIVATE:
      begin
        { KJB: Watch this for problems in fullscreen modes with Alt-tabbing }
        fActive := LongRec(wParam).Lo;
        fMinimized := LongRec(wParam).Hi;

        AppActivate((fActive <> WA_INACTIVE), (fMinimized <> 0));

        if reflib_active then
          re.AppActivate(not (fActive = WA_INACTIVE));

        Result := DefWindowProc(h_Wnd, uMsg, wParam, lParam);
        Exit;
      end;
    WM_MOVE:
      begin
        if (vid_fullscreen.value = 0) then
        begin
          { horizontal position }
          xPos := LongRec(lParam).Lo;
          { vertical position }
          yPos := LongRec(lParam).Hi;

          r.left := 0;
          r.top := 0;
          r.right := 1;
          r.bottom := 1;

          style := GetWindowLong(h_Wnd, GWL_STYLE);
          AdjustWindowRect(r, style, FALSE);

          Cvar_SetValue('vid_xpos', xPos + r.left);
          Cvar_SetValue('vid_ypos', yPos + r.top);
          vid_xpos.modified := False;
          vid_ypos.modified := False;
          if (ActiveApp <> 0) then
            IN_Activate(True);
        end;

        Result := DefWindowProc(h_Wnd, uMsg, wParam, lParam);
        Exit;
      end;
    { this is complicated because Win32 seems to pack multiple mouse events into
      one update sometimes, so we always check all states and look for events }
    WM_LBUTTONDOWN,
      WM_LBUTTONUP,
      WM_RBUTTONDOWN,
      WM_RBUTTONUP,
      WM_MBUTTONDOWN,
      WM_MBUTTONUP,
      WM_MOUSEMOVE:
      begin
        temp := 0;

        if ((wParam and MK_LBUTTON) <> 0) then
          temp := temp or 1;

        if ((wParam and MK_RBUTTON) <> 0) then
          temp := temp or 2;

        if ((wParam and MK_MBUTTON) <> 0) then
          temp := temp or 4;

        IN_MouseEvent(temp);

      end;
    WM_SYSCOMMAND:
      begin
        if (wParam = SC_SCREENSAVE) then
        begin
          Result := 0;
          Exit;
        end;
      end;
    WM_SYSKEYDOWN:
      begin
        if (wParam = 13) then
        begin
          if (vid_fullscreen <> nil) then
            Cvar_SetValue('vid_fullscreen', Integer(not (vid_fullscreen.value <> 0)));

          Result := 0;
          Exit;
        end;
        { fall through }
        { Would seem to go through to the WM_KEYDOWN message, and then break out }
        Key_Event(MapKey(lParam), True, sys_msg_time);
      end;
    WM_KEYDOWN:
      begin
        Key_Event(MapKey(lParam), True, sys_msg_time);
        //Break;
      end;
    WM_SYSKEYUP, WM_KEYUP:
      begin
        Key_Event(MapKey(lParam), False, sys_msg_time);
        //Break;
      end;
    MM_MCINOTIFY:
      begin
        { LONG CDAudio_MessageHandler(HWND hWnd, UINT uMsg, WPARAM wParam, LPARAM lParam); }
        { Remove the definition of this function.  Must be being called from somewhere else }
        {lRet :=} CDAudio_MessageHandler(h_Wnd, uMsg, wParam, lParam);

        //Break;
      end;
  end;

  (* return 0 if handled message, 1 if not *)
  Result := DefWindowProc(h_Wnd, uMsg, wParam, lParam);
end;

function VID_GetModeInfo(width, height: PInteger; mode: integer): qboolean; cdecl;
begin
  if (mode < 0) or (mode >= VID_NUM_MODES) then
  begin
    Result := False;
    Exit;
  end;

  width^ := vid_modes[mode].width;
  height^ := vid_modes[mode].height;

  Result := True;
end;

(*** VID_UpdateWindowPosAndSize ***)

procedure VID_UpdateWindowPosAndSize(x, y: Integer); cdecl;
var
  r: TRECT;
  style, w, h: Integer;
begin
  r.left := 0;
  r.top := 0;
  r.right := viddef.width;
  r.bottom := viddef.height;

  style := GetWindowLong(cl_hwnd, GWL_STYLE);
  AdjustWindowRect(r, style, FALSE);

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

  MoveWindow(cl_hwnd, Round(vid_xpos.value), Round(vid_ypos.value), w, h, TRUE);
end;

(*** VID_NewWindow ***)

procedure VID_NewWindow(width, height: Integer); cdecl;
begin
  viddef.width := width;
  viddef.height := height;

  cl.force_refdef := True;              { can't use a paused refdef }
end;

procedure VID_FreeReflib;
begin
  if (not FreeLibrary(reflib_library)) then
    Com_Error(ERR_FATAL, 'Reflib FreeLibrary failed', []);

  { ORIGINAL:  memset(@re, 0, sizeof(re)); }
  FillChar(re, SizeOf(re), 0);

  reflib_library := 0;
  reflib_active := False;
end;

(* ==============
VID_LoadRefresh
============== *)

function VID_LoadRefresh(name: PChar): qboolean; cdecl;
var
  ri: refimport_t;
  GetRefAPI: GetRefAPI_t;
begin
  if (reflib_active) then
  begin
    re.Shutdown;
    VID_FreeReflib;
  end;

  Com_Printf('------- Loading %s -------'#10, [name]);

  reflib_library := LoadLibrary(name);
  if (reflib_library = 0) then
  begin
    Com_Printf('LoadLibrary("%s") failed'#10, [name]);

    Result := False;
    Exit;
  end;

  ri.Cmd_AddCommand := Cmd_AddCommand;
  ri.Cmd_RemoveCommand := Cmd_RemoveCommand;
  ri.Cmd_Argc := Cmd_Argc;
  ri.Cmd_Argv := Cmd_Argv;
  ri.Cmd_ExecuteText := Cbuf_ExecuteText;
  ri.Con_Printf := VID_Printf_cdecl;
  ri.Sys_Error := VID_Error_cdecl;
  ri.FS_LoadFile := FS_LoadFile;
  ri.FS_FreeFile := FS_FreeFile;
  ri.FS_Gamedir := FS_Gamedir;
  ri.Cvar_Get := Cvar_Get;
  ri.Cvar_Set := Cvar_Set;
  ri.Cvar_SetValue := Cvar_SetValue;
  ri.Vid_GetModeInfo := VID_GetModeInfo;
  ri.Vid_MenuInit := VID_MenuInit;
  ri.Vid_NewWindow := VID_NewWindow;

  { ORIGINAL:     if ( ( GetRefAPI = (void *) GetProcAddress( reflib_library, "GetRefAPI" ) ) == 0 )  }
  GetRefApi := GetProcAddress(reflib_library, 'GetRefAPI');
  if not Assigned(GetRefApi) then
    Com_Error(ERR_FATAL, 'GetProcAddress failed on %s', [name]);

  re := GetRefAPI(ri);

  if (re.api_version <> API_VERSION) then
  begin
    VID_FreeReflib;
    Com_Error(ERR_FATAL, '%s has incompatible api_version', [name]);
  end;

  if (re.Init(global_hInstance, @MainWndProc) = -1) then
  begin
    re.Shutdown;
    VID_FreeReflib;
    Result := False;
    Exit;
  end;

  Com_Printf('------------------------------------'#10, []);
  reflib_active := True;

  //======
  //PGM
  vidref_val := VIDREF_OTHER;
  if Assigned(vid_ref) then
  begin
    if (StrComp(vid_ref.string_, 'gl') = 0) then
      vidref_val := VIDREF_GL
    else if (StrComp(vid_ref.string_, 'soft') = 0) then
      vidref_val := VIDREF_SOFT;
  end;
  //PGM
  //======

  Result := True;
end;

{*
============
VID_CheckChanges

This function gets called once just before drawing each frame, and it's sole purpose in life
is to check to see if any of the video mode parameters have changed, and if they have to
update the rendering DLL and/or video mode to match.
============
*}

procedure VID_CheckChanges;
var
  name: array[0..100 - 1] of Char;
begin
  if (win_noalttab.modified) then
  begin
    if (win_noalttab.value <> 0) then
      WIN_DisableAltTab
    else
      WIN_EnableAltTab;

    win_noalttab.modified := False;
  end;

  if (vid_ref.modified) then
  begin
    cl.force_refdef := True;            { can't use a paused refdef }
    S_StopAllSounds;
  end;

  while (vid_ref.modified) do
  begin
    (*** refresh has changed ***)
    vid_ref.modified := False;
    vid_fullscreen.modified := True;
    cl.refresh_prepped := False;
    cls.disable_screen := Integer(True);

    Com_sprintf(name, SizeOf(name), 'ref_%s.dll', [vid_ref.string_]);

    if (not VID_LoadRefresh(name)) then
    begin
      if (CompareStr(vid_ref.string_, 'soft') = 0) then
        Com_Error(ERR_FATAL, 'Couldn''t fall back to software refresh!', []);

      Cvar_Set('vid_ref', 'soft');

      (*** drop the console if we fail to load a refresh ***)
      if (cls.key_dest <> key_console) then
        Con_ToggleConsole_f;
    end;

    cls.disable_screen := Integer(False);
  end;

  (*** update our window position ***)
  if (vid_xpos.modified or vid_ypos.modified) then
  begin
    if (vid_fullscreen.value = 0) then
      VID_UpdateWindowPosAndSize(Round(vid_xpos.value), Round(vid_ypos.value));

    vid_xpos.modified := False;
    vid_ypos.modified := False;
  end;
end;

(* ============
VID_Init
============ *)

procedure VID_Init;
begin
  { Create the video variables so we know how to start the graphics drivers }
  vid_ref := Cvar_Get('vid_ref', 'soft', CVAR_ARCHIVE);
  vid_xpos := Cvar_Get('vid_xpos', '3', CVAR_ARCHIVE);
  vid_ypos := Cvar_Get('vid_ypos', '22', CVAR_ARCHIVE);
  vid_fullscreen := Cvar_Get('vid_fullscreen', '0', CVAR_ARCHIVE);
  vid_gamma := Cvar_Get('vid_gamma', '1', CVAR_ARCHIVE);
  win_noalttab := Cvar_Get('win_noalttab', '0', CVAR_ARCHIVE);

  { Add some console commands that we want to handle }
  Cmd_AddCommand('vid_restart', @VID_Restart_f);
  Cmd_AddCommand('vid_front', @VID_Front_f);

  (*
  ** this is a gross hack but necessary to clamp the mode for 3Dfx
  *)
(*
  {
          cvar_t *gl_driver = Cvar_Get( "gl_driver", "opengl32", 0 );
          cvar_t *gl_mode = Cvar_Get( "gl_mode", "3", 0 );

          if ( stricmp( gl_driver->string, "3dfxgl" ) == 0 )
          {
                  Cvar_SetValue( "gl_mode", 3 );
                  viddef.width  = 640;
                  viddef.height = 480;
          }
  }
*)

  { Disable the 3Dfx splash screen }
  Windows.SetEnvironmentVariable('FX_GLIDE_NO_SPLASH', '0');

  { Start the graphics mode and load refresh DLL }
  VID_CheckChanges;
end;

(* ============
VID_Shutdown
============ *)

procedure VID_Shutdown;
begin
  if (reflib_active) then
  begin
    re.Shutdown;
    VID_FreeReflib;
  end;
end;

end.