cd_win.pas

雷神之锤2(Quake2)Delphi源码

unit cd_win;

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): cd_win.c                                                          }
{                                                                            }
{ Initial conversion by : Scott Price ([e-mail])           }
{ Initial conversion on : 23-Feb-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                                                              }
{ - Added some units to uses clause to let this compile correctly            }
{ - Fixed miscellannous language errors }
{ - Declared (not yet all) procedures as global in interface section         }
{}
{ Updated on : 04-jun-2002                                                              }
{ Updated by : Juha Hartikainen                                                              }
{ - Declared some functions in interface part}
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{----------------------------------------------------------------------------}

interface


uses { Borland Standard Units }
     Windows,
     MMSystem,
     { Quake 2 Units }
     q_shared,
     vid_dll,
     Common,
     CVar,
     Client;


function CDAudio_Init: Integer;
procedure CDAudio_Pause;
procedure CDAudio_Stop;
procedure CDAudio_Eject;
procedure CDAudio_CloseDoor;
function CDAudio_GetAudioDiskInfo: Integer;
procedure CDAudio_Play2(track: Integer; looping: qboolean);
procedure CDAudio_Play(track: Integer; looping: qboolean);
procedure CDAudio_Activate(active: qboolean);
function CDAudio_MessageHandler(hWin: HWND; uMsg: Cardinal; wParam: WPARAM; lParam: LPARAM): Integer;
procedure CDAudio_Update;
procedure CDAudio_Shutdown;



var
  cd_nocd: cvar_p;
  cd_loopcount: cvar_p;
  cd_looptrack: cvar_p;

  wDeviceID: Cardinal;
  loopcounter: Integer;


implementation

uses SysUtils, Cmd;

var
  { Static Variables }
  cdValid: qboolean = false;
  playing: qboolean = false;
  wasPlaying: qboolean = false;
  initialized: qboolean = false;
  enabled: qboolean = false;
  playLooping: qboolean = false;
  { Byte Array?? }
  remap: array [0..99] of byte;
  playTrack: byte;
  maxTrack: byte;



procedure CDAudio_Eject;
var
  dwReturn: DWORD;
begin
  dwReturn := mciSendCommand(wDeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
  if dwReturn <> 0 then
    Com_DPrintf('MCI_SET_DOOR_OPEN failed (%d)'#10, [dwReturn]);
end;

procedure CDAudio_CloseDoor;
var
  dwReturn: DWORD;
begin
  dwReturn := mciSendCommand(wDeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
  if dwReturn <> 0 then
    Com_DPrintf('MCI_SET_DOOR_CLOSED failed (%d)'#10, [dwReturn]);
end;

function CDAudio_GetAudioDiskInfo: Integer;
var
  dwReturn: DWORD;
  mciStatusParms: MCI_STATUS_PARMS;
begin
  Result := -1;
  cdValid := false;

  mciStatusParms.dwItem := MCI_STATUS_READY;
  dwReturn := mciSendCommand(wDeviceID, MCI_STATUS, MCI_STATUS_ITEM OR MCI_WAIT, DWORD(@mciStatusParms));
  if (dwReturn <> 0) then
  begin
    Com_DPrintf('CDAudio: drive ready test - get status failed'#10, []);
    Exit;
  end;
  if (mciStatusParms.dwReturn = 0) then
  begin
    Com_DPrintf('CDAudio: drive not ready'#10, []);
    Exit;
  end;

  mciStatusParms.dwItem := MCI_STATUS_NUMBER_OF_TRACKS;
  dwReturn := mciSendCommand(wDeviceID, MCI_STATUS, MCI_STATUS_ITEM OR MCI_WAIT, dword(@mciStatusParms));
  if (dwReturn <> 0) then
  begin
    Com_DPrintf('CDAudio: get tracks - status failed'#10, []);
    Exit;
  end;
  if (mciStatusParms.dwReturn < 1) then
  begin
    Com_DPrintf('CDAudio: no music tracks'#10, []);
    Exit;
  end;

  cdValid := true;
  maxTrack := mciStatusParms.dwReturn;

  Result := 0;
end;

procedure CDAudio_Play2(track: Integer; looping: qboolean);
var
  dwReturn: DWORD;
  mciPlayParms: MCI_PLAY_PARMS;
  mciStatusParms: MCI_STATUS_PARMS;
begin
  if (NOT enabled) then
    Exit;

  if (NOT cdValid) then
  begin
    CDAudio_GetAudioDiskInfo;
    if (NOT cdValid) then
      Exit;
  end;

  track := remap[track];

  if (track < 1) OR (track > maxTrack) then begin
    CDAudio_Stop;
    Exit;
  end;

  { don't try to play a non-audio track }
  mciStatusParms.dwItem := MCI_CDA_STATUS_TYPE_TRACK;
  mciStatusParms.dwTrack := track;
  dwReturn := mciSendCommand(wDeviceID, MCI_STATUS, MCI_STATUS_ITEM OR MCI_TRACK OR MCI_WAIT, dword(@mciStatusParms));
  if (dwReturn <> 0) then
  begin
    Com_DPrintf('MCI_STATUS failed (%d)'#10, [dwReturn]);
    Exit;
  end;
  if (mciStatusParms.dwReturn <> MCI_CDA_TRACK_AUDIO) then
  begin
    Com_Printf('CDAudio: track %d is not audio'#10, [track]);
    Exit;
  end;

  { get the length of the track to be played }
  mciStatusParms.dwItem := MCI_STATUS_LENGTH;
  mciStatusParms.dwTrack := track;
  dwReturn := mciSendCommand(wDeviceID, MCI_STATUS, MCI_STATUS_ITEM OR MCI_TRACK OR MCI_WAIT, dword(@mciStatusParms));
  if (dwReturn <> 0) then
  begin
    Com_DPrintf('MCI_STATUS failed (%d)'#10, [dwReturn]);
    Exit;
  end;

  if (playing) then
  begin
    if (playTrack = track) then
      Exit;

    CDAudio_Stop;
  end;

  mciPlayParms.dwFrom := MCI_MAKE_TMSF(track, 0, 0, 0);
  mciPlayParms.dwTo := (mciStatusParms.dwReturn shl 8) OR Cardinal(track);
  mciPlayParms.dwCallback := cl_hwnd;

  dwReturn := mciSendCommand(wDeviceID, MCI_PLAY, MCI_NOTIFY OR MCI_FROM OR MCI_TO, dword(@mciPlayParms));
  if (dwReturn <> 0) then
  begin
    Com_DPrintf('CDAudio: MCI_PLAY failed (%d)', [dwReturn]);
    Exit;
  end;

  playLooping := looping;
  playTrack := track;
  playing := true;

  if Cvar_VariableValue('cd_nocd')<>0 then
    CDAudio_Pause;
end;

procedure CDAudio_Play(track: Integer; looping: qboolean);
begin
  { set a loop counter so that this track will change to the looptrack later }
  loopcounter := 0;
  CDAudio_Play2(track, looping);
end;

procedure CDAudio_Stop;
var
  dwReturn: DWORD;
begin
  if (NOT enabled) then
    Exit;

  if (NOT playing) then
    Exit;

  dwReturn := mciSendCommand(wDeviceID, MCI_STOP, 0, 0);
  if (dwReturn <> 0) then
    Com_DPrintf('MCI_STOP failed (%d)', [dwReturn]);

  wasPlaying := false;
  playing := false;
end;

procedure CDAudio_Pause;
var
  dwReturn: DWORD;
  mciGenericParms: MCI_GENERIC_PARMS;
begin
  if (NOT enabled) then
    Exit;

  if (NOT playing) then
    Exit;

  mciGenericParms.dwCallback := cl_hwnd;
  dwReturn := mciSendCommand(wDeviceID, MCI_PAUSE, 0, dword(@mciGenericParms));
  if (dwReturn <> 0) then
    Com_DPrintf('MCI_PAUSE failed (%d)', [dwReturn]);

  wasPlaying := playing;
  playing := false;
end;

procedure CDAudio_Resume;
var
  dwReturn: DWORD;
  mciPlayParms: MCI_PLAY_PARMS;
begin
  if (NOT enabled) then
    Exit;

  if (NOT cdValid) then
    Exit;

  if (NOT wasPlaying) then
    Exit;

  mciPlayParms.dwFrom := MCI_MAKE_TMSF(playTrack, 0, 0, 0);
  mciPlayParms.dwTo := MCI_MAKE_TMSF(playTrack + 1, 0, 0, 0);
  mciPlayParms.dwCallback := cl_hwnd;
  dwReturn := mciSendCommand(wDeviceID, MCI_PLAY, MCI_TO OR MCI_NOTIFY, dword(@mciPlayParms));