menu.pas

delphi编的不错的贪吃蛇

    'Creat Studios',
    'Steve Maines',
    '',
    '+ADDITIONAL LEVEL DESIGN',
    'Rich Fleider',
    'Steve Maines',
    'Peter Mack',
    '',
    '+SOUND',
    'James Grunke',
    '',
    '+GROUND ZERO THEME',
    '+AND',
    '+MUSIC BY',
    'Sonic Mayhem',
    '',
    '+VWEP MODELS',
    'Brent "Hentai" Dill',
    '',
    '',
    '',
    '+SPECIAL THANKS',
    '+TO',
    '+OUR FRIENDS AT ID SOFTWARE',
    '',
    'John Carmack',
    'John Cash',
    'Brian Hook',
    'Adrian Carmack',
    'Kevin Cloud',
    'Paul Steed',
    'Tim Willits',
    'Christian Antkow',
    'Paul Jaquays',
    'Brandon James',
    'Todd Hollenshead',
    'Barrett (Bear) Alexander',
    'Katherine Anna Kang',
    'Donna Jackson',
    'Dave "Zoid" Kirsch',
    '',
    '',
    '',
    '+THANKS TO ACTIVISION',
    '+IN PARTICULAR:',
    '',
    'Marty Stratton',
    'Henk Hartong',
    'Mitch Lasky',
    'Steve Rosenthal',
    'Steve Elwell',
    '',
    '+AND THE GAME TESTERS',
    '',
    'The Ranger Clan',
    'Dave "Zoid" Kirsch',
    'Nihilistic Software',
    'Robert Duffy',
    '',
    'And Countless Others',
    '',
    '',
    '',
    'Quake II Mission Pack 2: Ground Zero',
    '(tm) (C)1998 Id Software, Inc. All',
    'Rights Reserved. Developed by Rogue',
    'Entertainment, Inc. for Id Software,',
    '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 (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 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);
    end;
    continue_:
    Inc(y, 10);
    Inc(i);
  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;

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
      // In Delphi conversion we show "our" credits
      //credits := @idcredits;
      credits := @q2d_credits;
    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