menu.pas

雷神之锤2(Quake2)Delphi源码

    'Inc. Distributed by Activision Inc.',
    'under license. Quake(R) is a',
    'registered trademark of Id Software,',
    'Inc. Quake II Mission Pack 2: Ground',
    'Zero(tm), Quake II(tm), the Id',
    'Software name, the "Q II"(tm) logo',
    'and id(tm) logo are trademarks of Id',
    'Software, Inc. Activision(R) is a',
    'registered trademark of Activision,',
    'Inc. Rogue(R) is a registered',
    'trademark of Rogue Entertainment,',
    'Inc. All other trademarks and trade',
    'names are properties of their',
    'respective owners.', nil
    );

procedure M_Credits_MenuDraw;
var
  i, x, y, j, stringoffset: Integer;
  Bold: QBoolean;
label
  continue_;
begin
  {
  ** draw the credits
  }
  y := viddef.height - ((cls.realtime - credits_start_time) div 40);
  i := 0;
  //while (i < length(Credits)) and (y < viddef.height) do begin
  while (PPCharArray(Credits)[i] <> nil) and (y < viddef.height) do
  begin
    stringoffset := 0;
    bold := False;

    if (y <= -8) then
      goto continue_;

    if (PPCharArray(credits)[i][0] = '+') then
    begin
      bold := True;
      stringoffset := 1;
    end
    else
      StringOffset := 0;

    j := 0;
    // while (j+stringoffset) < length(Credits[i]) do begin
    while PPCharArray(Credits)[i][j + stringoffset] <> #0 do
    begin
      x := (viddef.width - length(PPCharArray(credits)[i]) * 8 - stringoffset * 8) div 2 + (j +
        stringoffset) * 8;

      if bold then
        re.DrawChar(x, y, ord(PPCharArray(credits)[i][j + stringoffset]) + 128)
      else
        re.DrawChar(x, y, Ord(PPCharArray(credits)[i][j + stringoffset]));
      Inc(j); // Last part of C for loop
    end;
  continue_:
    Inc(y, 10);
    Inc(i); // Last part of C for loop
  end;

  if (y < 0) then
    credits_start_time := cls.realtime;
end;

function M_Credits_Key(Key: Integer): PChar;
begin
  case key of
    K_ESCAPE:
      begin
        if (creditsBuffer <> nil) then
          FS_FreeFile(creditsBuffer);
        M_PopMenu();
      end;
  end;

  result := menu_out_sound;
end;

// extern int Developer_searchpath (int who);

procedure M_Menu_Credits_f;
var
  n, count, si: Integer;
  p: PChar;
  isDeveloper: Integer;
begin
  isDeveloper := 0;

  creditsBuffer := '';
  count := FS_LoadFile('credits', @creditsBuffer);
  if (count <> -1) then
  begin
    p := creditsBuffer;
    si := 0; // String index
    n := 0;
    for n := 0 to 254 do
    begin
      creditsIndex[n] := p[si];
      while not (p[si] in [#13, #10]) do
      begin // \r and \n
        Inc(si); //	p++;
        Dec(Count);
        if (count = 0) then
          Break;
      end;
      {  if (p[si] = '\r') then begin
          *p++ := 0;
          if (--count = 0)
           break;
         end;}
      p[si] := #0;
      Inc(si); // *p++ := 0;
      Dec(Count);
      if (count = 0) then
        Break;
    end;
    Inc(n);
    creditsIndex[n] := #0; // Dangerous!
    credits := @creditsIndex; // ?? What should this do?
  end
  else
  begin
    isdeveloper := Developer_searchpath(1);

    case isdeveloper of
      1: credits := @xatcredits; // xatrix
      2: credits := @roguecredits; // Rogue
    else
      credits := @idcredits;
    end;

    credits_start_time := cls.realtime;
    M_PushMenu(@M_Credits_MenuDraw, @M_Credits_Key);
  end;
end;

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

  GAME MENU

  =======================================
  }

  // All vars static

var
  m_game_cursor: Integer;

  s_game_menu: menuframework_s;
  s_easy_game_action,
  s_medium_game_action,
  s_hard_game_action,
  s_load_game_action,
  s_save_game_action,
  s_credits_action: MenuAction_s;
  s_blankline: menuseparator_s;

procedure StartGame; // static
begin
  // disable updates and start the cinematic going
  cl.servercount := -1;
  M_ForceMenuOff();
  Cvar_SetValue('deathmatch', 0);
  Cvar_SetValue('coop', 0);

  Cvar_SetValue('gamerules', 0); //PGM

  Cbuf_AddText('loading ; killserver ; wait ; newgame'#10);
  cls.key_dest := key_game;
end;

procedure EasyGameFunc(Data: Pointer); // static
begin
  Cvar_ForceSet('skill', '0');
  StartGame();
end;

procedure MediumGameFunc(Data: Pointer); // static
begin
  Cvar_ForceSet('skill', '1');
  StartGame();
end;

procedure HardGameFunc(Data: Pointer); // static
begin
  Cvar_ForceSet('skill', '2');
  StartGame();
end;

procedure LoadGameFunc(Data: Pointer); // static
begin
  M_Menu_LoadGame_f();
end;

procedure SaveGameFunc(Data: Pointer); // static
begin
  M_Menu_SaveGame_f();
end;

procedure CreditsFunc(Data: Pointer); // static
begin
  M_Menu_Credits_f();
end;

procedure Game_MenuInit;
const
  Difficulty_names : array[0..3] of PChar =
    ('Easy', 'Medium', 'Hard', nil);
begin
  s_game_menu.x := viddef.width div 2;
  s_game_menu.nitems := 0;

  s_easy_game_action.generic.type_ := MTYPE_ACTION;
  s_easy_game_action.generic.flags := QMF_LEFT_JUSTIFY;
  s_easy_game_action.generic.x := 0;
  s_easy_game_action.generic.y := 0;
  s_easy_game_action.generic.name := 'easy';
  s_easy_game_action.generic.callback := EasyGameFunc;

  s_medium_game_action.generic.type_ := MTYPE_ACTION;
  s_medium_game_action.generic.flags := QMF_LEFT_JUSTIFY;
  s_medium_game_action.generic.x := 0;
  s_medium_game_action.generic.y := 10;
  s_medium_game_action.generic.name := 'medium';
  s_medium_game_action.generic.callback := MediumGameFunc;

  s_hard_game_action.generic.type_ := MTYPE_ACTION;
  s_hard_game_action.generic.flags := QMF_LEFT_JUSTIFY;
  s_hard_game_action.generic.x := 0;
  s_hard_game_action.generic.y := 20;
  s_hard_game_action.generic.name := 'hard';
  s_hard_game_action.generic.callback := HardGameFunc;

  s_blankline.generic.type_ := MTYPE_SEPARATOR;

  s_load_game_action.generic.type_ := MTYPE_ACTION;
  s_load_game_action.generic.flags := QMF_LEFT_JUSTIFY;
  s_load_game_action.generic.x := 0;
  s_load_game_action.generic.y := 40;
  s_load_game_action.generic.name := 'load game';
  s_load_game_action.generic.callback := LoadGameFunc;

  s_save_game_action.generic.type_ := MTYPE_ACTION;
  s_save_game_action.generic.flags := QMF_LEFT_JUSTIFY;
  s_save_game_action.generic.x := 0;
  s_save_game_action.generic.y := 50;
  s_save_game_action.generic.name := 'save game';
  s_save_game_action.generic.callback := SaveGameFunc;

  s_credits_action.generic.type_ := MTYPE_ACTION;
  s_credits_action.generic.flags := QMF_LEFT_JUSTIFY;
  s_credits_action.generic.x := 0;
  s_credits_action.generic.y := 60;
  s_credits_action.generic.name := 'credits';
  s_credits_action.generic.callback := CreditsFunc;

  Menu_AddItem(@s_game_menu, @s_easy_game_action);
  Menu_AddItem(@s_game_menu, @s_medium_game_action);
  Menu_AddItem(@s_game_menu, @s_hard_game_action);
  Menu_AddItem(@s_game_menu, @s_blankline);
  Menu_AddItem(@s_game_menu, @s_load_game_action);
  Menu_AddItem(@s_game_menu, @s_save_game_action);
  Menu_AddItem(@s_game_menu, @s_blankline);
  Menu_AddItem(@s_game_menu, @s_credits_action);

  Menu_Center(@s_game_menu);
end;

procedure Game_MenuDraw;
begin
  M_Banner('m_banner_game');
  Menu_AdjustCursor(@s_game_menu, 1);
  Menu_Draw(@s_game_menu);
end;

function Game_MenuKey(Key: Integer):PChar;
begin
  result := Default_MenuKey(@s_game_menu, key);
end;

procedure M_Menu_Game_f;
begin
  Game_MenuInit();
  M_PushMenu(@Game_MenuDraw, @Game_MenuKey);
  m_game_cursor := 1;
end;

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

LOADGAME MENU

=======================================
}

const
  MAX_SAVEGAMES = 15;

var
  // These vars static
  s_loadgame_menu: menuframework_s;
  s_loadgame_actions: array[0..MAX_SAVEGAMES - 1] of menuaction_s;

  s_savegame_menu : menuframework_s;
  s_savegame_actions: array[0..MAX_SAVEGAMES - 1] of menuaction_s;

  // These not static
  m_savestrings: array[0..MAX_SAVEGAMES - 1,0..31] of char;
  m_savevalid: array[0..MAX_SAVEGAMES - 1] of QBoolean;

procedure Create_Savestrings;
var
  i, f: Integer; // f was FILE *
  name: array[0..MAX_OSPATH-1] of char;
begin
  for i := 0 to MAX_SAVEGAMES - 1 do
  begin
    Com_sprintf(name, sizeof(name), '%s/save/save%d/server.ssv', [FS_Gamedir(),
      i]);
    f := FileOpen(name, fmOpenRead);
    if f < 0 then
    begin
      m_savestrings[i] := '<EMPTY>';
      m_savevalid[i] := False;
    end
    else
    begin
      FS_Read(@m_savestrings[i], sizeof(m_savestrings[i]), f);
      FileClose(f);
      m_savevalid[i] := True;
    end;
  end;
end;

procedure LoadGameCallback(Self: Pointer);
var
  a: MenuAction_p;
begin
  a := menuaction_p(self);

  if (m_savevalid[a^.generic.localdata[0]]) then
    Cbuf_AddText(va('load save%d'#10, [a^.generic.localdata[0]]));
  M_ForceMenuOff();
end;

procedure LoadGame_MenuInit;
var
  i: Integer;
begin
  s_loadgame_menu.x := viddef.Width div 2 - 120;
  s_loadgame_menu.y := viddef.Height div 2 - 58;
  s_loadgame_menu.nitems := 0;

  Create_Savestrings();

  for i := 0 to MAX_SAVEGAMES - 1 do
  begin
    s_loadgame_actions[i].generic.name := m_savestrings[i];
    s_loadgame_actions[i].generic.flags := QMF_LEFT_JUSTIFY;
    s_loadgame_actions[i].generic.localdata[0] := i;
    s_loadgame_actions[i].generic.callback := LoadGameCallback;

    s_loadgame_actions[i].generic.x := 0;
    s_loadgame_actions[i].generic.y := (i) * 10;
    if (i > 0) then // separate from autosave
      s_loadgame_actions[i].generic.y := s_loadgame_actions[i].generic.y + 10;

    s_loadgame_actions[i].generic.type_ := MTYPE_ACTION;

    Menu_AddItem(@s_loadgame_menu, @s_loadgame_actions[i]);
  end;
end;

procedure LoadGame_MenuDraw;
begin
  M_Banner('m_banner_load_game');
  //Menu_AdjustCursor( @s_loadgame_menu, 1 );
  Menu_Draw(@s_loadgame_menu);
end;

function LoadGame_MenuKey(Key: Integer): PChar;
begin
  if key in [K_ESCAPE, K_ENTER] then
  begin
    s_savegame_menu.cursor := s_loadgame_menu.cursor - 1;
    if (s_savegame_menu.cursor < 0) then
      s_savegame_menu.cursor := 0;
  end;
  result := Default_MenuKey(@s_loadgame_menu, key);
end;

procedure M_Menu_LoadGame_f;
begin
  LoadGame_MenuInit();
  M_PushMenu(@LoadGame_MenuDraw, @LoadGame_MenuKey);
end;

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

SAVEGAME MENU

=======================================
}

procedure SaveGameCallback(Self: Pointer);
var
  a: MenuAction_p;
begin
  a := menuaction_p(self);

  Cbuf_AddText(va('save save%d'#10, [a^.generic.localdata[0]]));
  M_ForceMenuOff();
end;

procedure SaveGame_MenuDraw;
begin
  M_Banner('m_banner_save_game');
  Menu_AdjustCursor(@s_savegame_menu, 1);
  Menu_Draw(@s_savegame_menu);
end;

procedure SaveGame_MenuInit;
var
  i: Integer;
begin
  s_savegame_menu.x := viddef.Width div 2 - 120;
  s_savegame_menu.y := viddef.Height div 2 - 58;
  s_savegame_menu.nitems := 0;

  Create_Savestrings();

  // don't include the autosave slot
  for i := 0 to MAX_SAVEGAMES - 2 do
  begin
    s_savegame_actions[i].generic.name := m_savestrings[i + 1];
    s_savegame_actions[i].generic.localdata[0] := i + 1;
    s_savegame_actions[i].generic.flags := QMF_LEFT_JUSTIFY;
    s_savegame_actions[i].generic.callback := SaveGameCallback;

    s_savegame_actions[i].generic.x := 0;
    s_savegame_actions[i].generic.y := (i) * 10;

    s_savegame_actions[i]