menu.pas

雷神之锤2(Quake2)Delphi源码

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): menu.c                                                            }
{ Content: Quake2\Client\                                                    }
{                                                                            }
{ Initial conversion by : ???                                                }
{ Initial conversion on :                                                    }
{                                                                            }
{ 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 : 25-jul-2002                                                   }
{ Updated by : Leonel Togniolli ([e-mail])                      }
{ - Fixed the code to make it compile                                        }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{  There are still a lot of bugs and misconversions. Serious need to         }
{ Proofread the whole unit. (large task! <g>)                                }
{----------------------------------------------------------------------------}

unit menu;

interface

uses
  SysUtils,
  Client,
  Common,
  q_shared;

{.$I QMenu.inc} // it's in qmenu.pas

var
  m_main_cursor: Integer;

const
  NUM_CURSOR_FRAMES = 15;

var
  menu_in_sound: PChar = 'misc/menu1.wav';
  menu_move_sound: PChar = 'misc/menu2.wav';
  menu_out_sound: PChar = 'misc/menu3.wav';

procedure M_Menu_Main_f; cdecl;
procedure M_Menu_Game_f; cdecl;
procedure M_Menu_LoadGame_f; cdecl;
procedure M_Menu_SaveGame_f; cdecl;
procedure M_Menu_PlayerConfig_f; cdecl;
procedure M_Menu_DownloadOptions_f; cdecl;
procedure M_Menu_Credits_f; cdecl;
procedure M_Menu_Multiplayer_f; cdecl;
procedure M_Menu_JoinServer_f; cdecl;
procedure M_Menu_AddressBook_f; cdecl;
procedure M_Menu_StartServer_f; cdecl;
procedure M_Menu_DMOptions_f; cdecl;
procedure M_Menu_Video_f; cdecl;
procedure M_Menu_Options_f; cdecl;
procedure M_Menu_Keys_f; cdecl;
procedure M_Menu_Quit_f; cdecl;

procedure M_ForceMenuOff;
procedure M_AddToServerList(Adr: netadr_t; Info: PChar);
procedure M_Init;
procedure M_Keydown(Key: Integer);
procedure M_PopMenu;
procedure M_Draw;


//procedure M_Menu_Credits; where is it?

type
  TKeyFunc = function(Key: Integer): PChar;

var
  m_entersound: qboolean; // play after drawing a frame, so caching
  // won't disrupt the sound
  m_drawfunc: procedure;
  m_keyfunc: TKeyFunc;

  //=======================================
  { Support Routines }

const
  MAX_MENU_DEPTH = 8;
  MAX_DISPLAYNAME = 16;
  MAX_PLAYERMODELS = 1024;

type
  menulayer_t = record
    Draw: TProcedure;
    Key: TKeyFunc;
  end;

var
  m_layers: array[0..MAX_MENU_DEPTH - 1] of menulayer_t;
  m_menudepth: Integer;

type
  playermodelinfo_p = ^playermodelinfo_s;
  playermodelinfo_s = record
    nskins: Integer;
    skindisplaynames: PPCharArray; // was char ** ... PPChar?
    Displayname: array [0..MAX_DISPLAYNAME - 1] of Char;
    Directory: array [0..MAX_QPATH - 1] of Char;
  end;

implementation

uses
  vid_dll,
  CVar,
  cl_main,
  snd_dma,
  keys,
  CPas,
  qmenu,
  q_shwin,
  cmd,
  cl_input,
  cl_view,
  in_win,
  console,
  vid_menu,
  files,
  net_wins,
  ref,
  cl_scrn;

procedure M_Banner(Name: PChar);
var
  w, h: Integer;
begin
  re.DrawGetPicSize(@w, @h, name);
  re.DrawPic(viddef.width div 2 - w div 2, viddef.height div 2 - 110, name);
end;

procedure M_PushMenu(Draw: TProcedure; Key: TKeyFunc);
var
  i: Integer;
begin
  if (Cvar_VariableValue('maxclients') = 1) and (Com_ServerState() <> 0) then
    Cvar_Set('paused', '1');

  // if this menu is already present, drop back to that level
  // to a procedure stacking menus by hotkeys
  i := 0;
  while i < m_menudepth  do
  begin
    if (@m_layers[i].draw = @draw) and (@m_layers[i].key = @key) then
      m_menudepth := i;
    Inc(i);
  end;

  if (i = m_menudepth) then
  begin
    if (m_menudepth >= MAX_MENU_DEPTH) then
      Com_Error(ERR_FATAL, 'M_PushMenu: MAX_MENU_DEPTH');
    m_layers[m_menudepth].draw := m_drawfunc;
    m_layers[m_menudepth].key := m_keyfunc;
    Inc(m_menudepth);
  end;

  m_drawfunc := draw;
  m_keyfunc := key;

  m_entersound := true;

  cls.key_dest := key_menu;
end;

procedure M_ForceMenuOff;
begin
  m_drawfunc := nil;
  m_keyfunc := nil;
  cls.key_dest := key_game;
  m_menudepth := 0;
  Key_ClearStates();
  Cvar_Set('paused', '0');
end;

procedure M_PopMenu;
begin
  S_StartLocalSound(menu_out_sound);
  if (m_menudepth < 1) then
    Com_Error(ERR_FATAL, 'M_PopMenu: depth < 1');
  Dec(m_menudepth);

  m_drawfunc := m_layers[m_menudepth].draw;
  m_keyfunc := m_layers[m_menudepth].key;

  if m_menudepth = 0 then
    M_ForceMenuOff();
end;

function Default_MenuKey(m: menuframework_p; key: Integer): PChar;
var
  sound: PChar;
  Item: menucommon_p;
begin
  sound := nil;

  if m <> nil then
  begin
    item := Menu_ItemAtCursor(m);
    if item <> nil then
    begin
      if (item^.type_ = MTYPE_FIELD) then
      begin
        if (Field_Key(menufield_p(item), key)) then
        begin
          Result := nil;
          exit;
        end;
      end;
    end;

    case key of
      K_ESCAPE:
        begin
          M_PopMenu();
          Result := menu_out_sound;
          exit;
        end;
      K_KP_UPARROW, K_UPARROW:
        if m <> nil then
        begin
          m^.cursor := m^.cursor - 1;
          Menu_AdjustCursor(m, -1);
          sound := menu_move_sound;
        end;
      K_TAB:
        if m <> nil then
        begin
          m^.cursor := m^.cursor + 1;
          Menu_AdjustCursor(m, 1);
          sound := menu_move_sound;
        end;
      K_KP_DOWNARROW, K_DOWNARROW:
        if m <> nil then
        begin
          m^.cursor := m^.cursor + 1;
          Menu_AdjustCursor(m, 1);
          sound := menu_move_sound;
        end;
      K_KP_LEFTARROW, K_LEFTARROW:
        if m <> nil then
        begin
          Menu_SlideItem(m, -1);
          sound := menu_move_sound;
        end;
      K_KP_RIGHTARROW, K_RIGHTARROW:
        if m <> nil then
        begin
          Menu_SlideItem(m, 1);
          sound := menu_move_sound;
        end;
      K_MOUSE1, K_MOUSE2, K_MOUSE3,
        K_JOY1, K_JOY2, K_JOY3, K_JOY4,
        K_AUX1, K_AUX2, K_AUX3, K_AUX4, K_AUX5,
        K_AUX6, K_AUX7, K_AUX8, K_AUX9, K_AUX10,
        K_AUX11, K_AUX12, K_AUX13, K_AUX14, K_AUX15,
        K_AUX16, K_AUX17, K_AUX18, K_AUX19, K_AUX20,
        K_AUX21, K_AUX22, K_AUX23, K_AUX24, K_AUX25,
        K_AUX26, K_AUX27, K_AUX28, K_AUX29, K_AUX30,
        K_AUX31, K_AUX32,
        K_KP_ENTER, K_ENTER:
        begin
          if m <> nil then
            Menu_SelectItem(m);
          sound := menu_move_sound;
        end;
    end;

    Result := sound;
  end;
end;

{
========
M_DrawCharacter

Draws one solid graphics character
cx and cy are in 320*240 coordinates, and will be centered on
higher res screens.
========
}

procedure M_DrawCharacter(cx, cy, num: Integer);
begin
  re.DrawChar(cx + ((viddef.width - 320) shr 1), cy + ((viddef.height - 240) shr 1), num);
end;

procedure M_Print(cx, cy: integer; str: PChar);
begin
  while str^ <> #0 do
  begin
    M_DrawCharacter(cx, cy, Byte(str^) + 128);
    Inc(str);
    Inc(cx, 8);
  end;
end;

procedure M_PrintWhite(cx, cy: integer; str: PChar);
begin
  while str^ <> #0 do
  begin
    M_DrawCharacter(cx, cy, Byte(str^));
    Inc(str);
    Inc(cx, 8);
  end;
end;

procedure M_DrawPic(x, y: integer; pic: PChar);
begin
  re.DrawPic(x + ((viddef.width - 320) shr 1), y + ((viddef.height - 240) shr 1), pic);
end;

{
=======
M_DrawCursor

Draws an animating cursor with the point at
x,y.  The pic will extend to the left of x,
and both above and below y.
=======
}
var
  mdc_cached: qboolean = false; // was "static qboolean cached" in procedure

procedure M_DrawCursor(x, y, f: Integer);
var
  cursorname: array[0..80-1] of Char;
  i: Integer;
begin
  if not mdc_cached then
  begin
    for i := 0 to NUM_CURSOR_FRAMES - 1 do
    begin
      Com_sprintf(cursorname, sizeof(cursorname), 'm_cursor%d', [i]);
      re.RegisterPic(cursorname);
    end;
    mdc_cached := true;
  end;

  Com_sprintf(cursorname, sizeof(cursorname), 'm_cursor%d', [f]);
  re.DrawPic(x, y, cursorname);
end;

procedure M_DrawTextBox(x, y, width, lines: Integer);
var
  cx, cy, n: Integer;
begin
  // draw left side
  cx := x;
  cy := y;
  M_DrawCharacter(cx, cy, 1);
  for n := 0 to lines - 1 do
  begin
    Inc(cy, 8);
    M_DrawCharacter(cx, cy, 4);
  end;
  M_DrawCharacter(cx, cy + 8, 7);

  // draw middle
  Inc(cx, 8);
  while (width > 0) do
  begin
    cy := y;
    M_DrawCharacter(cx, cy, 2);
    for n := 0 to lines - 1 do
    begin
      Inc(cy, 8);
      M_DrawCharacter(cx, cy, 5);
    end;
    M_DrawCharacter(cx, cy + 8, 8);
    Dec(width);
    Inc(cx, 8);
  end;

  // draw right side
  cy := y;
  M_DrawCharacter(cx, cy, 3);
  for n := 0 to lines - 1 do
  begin
    Inc(cy, 8);
    M_DrawCharacter(cx, cy, 6);
  end;
  M_DrawCharacter(cx, cy + 8, 9);
end;

{
====================================

MAIN MENU

====================================
}
const
  MAIN_ITEMS = 5;

procedure M_Main_Draw;
var
  i, w, h, ystart, xoffset, widest, totalheight: Integer;
  litname: array [0..80-1] of Char;
const
  names: array[0..4] of PChar = (
    'm_main_game',
    'm_main_multiplayer',
    'm_main_options',
    'm_main_video',
    'm_main_quit');
begin
  widest := -1;
  totalheight := 0;

  for i := 0 to 4 do
  begin
    re.DrawGetPicSize(@w, @h, names[i]);
    if (w > widest) then
      widest := w;
    Inc(totalheight, (h + 12));
  end;

  ystart := (viddef.height div 2 - 110);
  xoffset := (viddef.width - widest + 70) div 2;

  for i := 0 to 4 do
  begin
    if (i <> m_main_cursor) then
      re.DrawPic(xoffset, ystart + i * 40 + 13, names[i]);
  end;
  strcpy(litname, names[m_main_cursor]);
  strcat(litname, '_sel');
  re.DrawPic(xoffset, ystart + m_main_cursor * 40 + 13, litname);