X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fgame%2Fg_menu.pas;h=8b3dc3163d65a40d806a81aacabf4d4a66f34108;hb=8f815647c61a98e32b85066bf245b262694ac634;hp=0ac36062c5aff28f8a8174da449069e367ee87d3;hpb=b93d2d75ccf3cdfb28b1f143d29a0e451ac08735;p=d2df-sdl.git diff --git a/src/game/g_menu.pas b/src/game/g_menu.pas index 0ac3606..8b3dc31 100644 --- a/src/game/g_menu.pas +++ b/src/game/g_menu.pas @@ -1,3 +1,4 @@ +{$MODE DELPHI} unit g_menu; interface @@ -29,10 +30,59 @@ uses g_gui, g_textures, e_graphics, g_main, g_window, g_game, g_map, g_basic, g_console, g_sound, g_gfx, g_player, g_options, e_log, SysUtils, CONFIG, g_playermodel, DateUtils, - MAPSTRUCT, WADEDITOR, Math, WADSTRUCT, g_saveload, + MAPSTRUCT, wadreader, Math, g_saveload, e_textures, GL, GLExt, g_language, g_net, g_netmsg, g_netmaster, g_items, e_input; + +type TYNCallback = procedure (yes:Boolean); + +procedure YNKeyDownProc (win: TGUIWindow; Key: Byte); +begin + if win.UserData = nil then exit; + case Key of + IK_Y, IK_SPACE: TYNCallback(win.UserData)(true); + IK_N: TYNCallback(win.UserData)(false); + end; +end; + +procedure YesButtonCB (ctl: TGUITextButton); +begin + if ctl.UserData = nil then exit; + TYNCallback(ctl.UserData)(true); +end; + +procedure NoButtonCB (ctl: TGUITextButton); +begin + if ctl.UserData = nil then exit; + TYNCallback(ctl.UserData)(false); +end; + +function CreateYNMenu (WinName, Text: String; MaxLen: Word; FontID: DWORD; ActionProc: TYNCallback): TGUIWindow; +var + menu: TGUIMenu; +begin + //if length(Text) = 0 then exit; + Result := TGUIWindow.Create(WinName); + with Result do + begin + //OnKeyDownEx := @YNKeyDownProc; + //UserData := @ActionProc; + menu := TGUIMenu(Result.AddChild(TGUIMenu.Create(gMenuSmallFont, gMenuSmallFont, ''))); + with menu do + begin + Name := '__temp_yes_no_menu:'+WinName; + YesNo := true; + AddText(Text, MaxLen); + with AddButton(nil, _lc[I_MENU_YES]) do begin ProcEx := @YesButtonCB; UserData := @ActionProc; end; + with AddButton(nil, _lc[I_MENU_NO]) do begin ProcEx := @NoButtonCB; UserData := @ActionProc; end; + end; + DefControl := '__temp_yes_no_menu:'+WinName; + SetActive(nil); + end; +end; + + procedure ProcChangeColor(Sender: TGUIControl); forward; procedure ProcSelectModel(Sender: TGUIControl); forward; @@ -725,14 +775,14 @@ var cwdt, chgt: Byte; spc: ShortInt; ID: DWORD; - wad: TWADEditor_1; + wad: TWADFile; cfgdata: Pointer; cfglen: Integer; config: TConfig; begin cfglen := 0; - wad := TWADEditor_1.Create; + wad := TWADFile.Create; if wad.ReadFile(GameWAD) then wad.GetResource('FONTS', cfgres, cfgdata, cfglen); wad.Free(); @@ -760,7 +810,7 @@ var cwdt, chgt: Byte; spc: ShortInt; CharID: DWORD; - wad: TWADEditor_1; + wad: TWADFile; cfgdata, fntdata: Pointer; cfglen, fntlen: Integer; config: TConfig; @@ -770,7 +820,7 @@ begin cfglen := 0; fntlen := 0; - wad := TWADEditor_1.Create; + wad := TWADFile.Create; if wad.ReadFile(GameWAD) then begin wad.GetResource('FONTS', txtres, cfgdata, cfglen); @@ -792,7 +842,7 @@ begin chrwidth := config.ReadInt(IntToStr(a), 'Width', 0); if chrwidth = 0 then Continue; - if e_CreateTextureMemEx(fntdata, CharID, cwdt*(a mod 16), chgt*(a div 16), + if e_CreateTextureMemEx(fntdata, fntlen, CharID, cwdt*(a mod 16), chgt*(a div 16), cwdt, chgt) then e_CharFont_AddChar(FontID, CharID, Chr(a), chrwidth); end; @@ -887,13 +937,13 @@ begin gMusic.Play(); end; -procedure ProcExitMenuKeyDown(Key: Byte); +procedure ProcExitMenuKeyDown (yes: Boolean); var s: ShortString; snd: TPlayableSound; res: Boolean; begin - if Key = IK_Y then + if yes then begin g_Game_StopAllSounds(True); case (Random(18)) of @@ -915,24 +965,18 @@ begin 15: s := 'SOUND_MONSTER_SPIDER_ALERT'; else s := 'SOUND_PLAYER_FALL'; end; - snd := TPlayableSound.Create(); res := snd.SetByName(s); - if not res then - res := snd.SetByName('SOUND_PLAYER_FALL'); - + if not res then res := snd.SetByName('SOUND_PLAYER_FALL'); if res then begin snd.Play(True); - while snd.IsPlaying() do - ; + while snd.IsPlaying() do begin end; end; - g_Game_Quit(); - end - else - if Key = IK_N then - g_GUI_HideWindow(); + exit; + end; + g_GUI_HideWindow(); end; procedure ProcLoadMenu(); @@ -1132,25 +1176,20 @@ begin if Direction = D_LEFT then Direction := D_RIGHT else Direction := D_LEFT; end; -procedure ProcDefaultMenuKeyDown(Key: Byte); +procedure ProcDefaultMenuKeyDown (yes: Boolean); begin - if Key = Ord('y') then + if yes then begin g_Options_SetDefault(); ReadOptions(); - g_GUI_HideWindow(); - end else - if Key = Ord('n') then g_GUI_HideWindow; + end; + g_GUI_HideWindow(); end; -procedure ProcSavedMenuKeyDown(Key: Byte); +procedure ProcSavedMenuKeyDown (yes: Boolean); begin - if Key = Ord('y') then - begin - ReadOptions(); - g_GUI_HideWindow(); - end else - if Key = Ord('n') then g_GUI_HideWindow; + if yes then ReadOptions(); + g_GUI_HideWindow(); end; procedure ProcAuthorsClose(); @@ -1313,16 +1352,14 @@ begin g_Game_Pause(False); end; -procedure ProcRestartMenuKeyDown(Key: Byte); +procedure ProcRestartMenuKeyDown (yes: Boolean); begin - if Key = Ord('y') then g_Game_Restart() - else if Key = Ord('n') then g_GUI_HideWindow; + if yes then g_Game_Restart() else g_GUI_HideWindow; end; -procedure ProcEndMenuKeyDown(Key: Byte); +procedure ProcEndMenuKeyDown (yes: Boolean); begin - if Key = Ord('y') then gExit := EXIT_SIMPLE - else if Key = Ord('n') then g_GUI_HideWindow; + if yes then gExit := EXIT_SIMPLE else g_GUI_HideWindow; end; procedure ProcSetRussianLanguage(); @@ -1585,48 +1622,6 @@ begin ProcApplyOptions(); end; -function CreateYNMenu(Name, Text: String; MaxLen: Word; FontID: DWORD; - KeyDownProc: Pointer): TGUIWindow; -var - a: Integer; - h, _x: Word; - lines: SArray; -begin - Result := TGUIWindow.Create(Name); - - with Result do - begin - OnKeyDown := KeyDownProc; - - lines := GetLines(Text, FontID, MaxLen); - - h := e_CharFont_GetMaxHeight(FontID); - _x := (gScreenHeight div 2)-(h*Length(lines) div 2); - - if lines <> nil then - begin - for a := 0 to High(lines) do - with TGUILabel(Result.AddChild(TGUILabel.Create(lines[a], FontID))) do - begin - X := (gScreenWidth div 2)-(GetWidth div 2); - Y := _x; - Color := _RGB(255, 0, 0); - _x := _x+h; - end; - - with TGUILabel(Result.AddChild(TGUILabel.Create('(Y/N)', FontID))) do - begin - X := (gScreenWidth div 2)-(GetWidth div 2); - Y := _x; - Color := _RGB(255, 0, 0); - end; - end; - - DefControl := ''; - SetActive(nil); - end; -end; - procedure ProcSetFirstRussianLanguage(); begin gLanguage := LANGUAGE_RUSSIAN; @@ -2180,7 +2175,7 @@ begin Sort := True; Dirs := True; - FileMask := '*.wad'; + FileMask := '*.wad|*.pk3|*.zip'; SetBase(MapsDir+'megawads/'); end; @@ -2235,7 +2230,7 @@ begin Sort := True; Dirs := True; - FileMask := '*.wad'; + FileMask := '*.wad|*.pk3|*.zip'; SetBase(MapsDir); end; with AddList(_lc[I_MENU_MAP_RESOURCE], 12, 4) do @@ -2693,6 +2688,13 @@ begin _y := _y+22; end; with TGUILabel(Menu.AddChild(TGUILabel.Create(_lc[I_CREDITS_A_2_1], gMenuSmallFont))) do + begin + Color := _RGB(255, 255, 255); + X := cx+32; + Y := _y; + _y := _y+22; + end; + with TGUILabel(Menu.AddChild(TGUILabel.Create(_lc[I_CREDITS_A_2_2], gMenuSmallFont))) do begin Color := _RGB(255, 255, 255); X := cx+32;