X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fgame%2Fg_gui.pas;h=3ab72ed3526569938e387df6d6999539d7231804;hb=f356426288dc03a804636aaa21c0d7e049e628ac;hp=494839e01324c73d6281594ff0db2a9c60d54d49;hpb=d92a9e2807dda8a533def35afa801ed975920885;p=d2df-sdl.git diff --git a/src/game/g_gui.pas b/src/game/g_gui.pas index 494839e..3ab72ed 100644 --- a/src/game/g_gui.pas +++ b/src/game/g_gui.pas @@ -2,8 +2,7 @@ * * 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 3 of the License, or - * (at your option) any later version. + * the Free Software Foundation, version 3 of the License ONLY. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -402,6 +401,7 @@ type procedure OnMessage(var Msg: TMessage); override; procedure Draw(); override; procedure AddItem(Item: String); + function ItemExists (item: String): Boolean; procedure SelectItem(Item: String); procedure Clear(); function GetWidth(): Integer; override; @@ -421,22 +421,21 @@ type TGUIFileListBox = class(TGUIListBox) private - FBasePath: String; - FPath: String; + FSubPath: String; FFileMask: String; FDirs: Boolean; + FBaseList: SSArray; // highter index have highter priority - procedure OpenDir(path: String); + procedure ScanDirs; public - procedure OnMessage(var Msg: TMessage); override; - procedure SetBase(path: String); + procedure OnMessage (var Msg: TMessage); override; + procedure SetBase (dirs: SSArray; path: String = ''); function SelectedItem(): String; - procedure UpdateFileList(); + procedure UpdateFileList; property Dirs: Boolean read FDirs write FDirs; property FileMask: String read FFileMask write FFileMask; - property Path: String read FPath; end; TGUIMemo = class(TGUIControl) @@ -467,13 +466,14 @@ type private FButtons: array of TGUITextButton; FHeader: TGUILabel; + FLogo: DWord; FIndex: Integer; FFontID: DWORD; FCounter: Byte; FMarkerID1: DWORD; FMarkerID2: DWORD; public - constructor Create(FontID: DWORD; Header: string); + constructor Create(FontID: DWORD; Logo, Header: string); destructor Destroy; override; procedure OnMessage(var Msg: TMessage); override; function AddButton(fProc: Pointer; Caption: string; ShowWindow: string = ''): TGUITextButton; @@ -550,9 +550,8 @@ procedure g_GUI_LoadMenuPos(); implementation uses - {$INCLUDE ../nogl/noGLuses.inc} - g_textures, g_sound, SysUtils, - g_game, Math, StrUtils, g_player, g_options, + g_textures, g_sound, SysUtils, e_res, + g_game, Math, StrUtils, g_player, g_options, r_playermodel, g_map, g_weapons, xdynrec, wadreader; @@ -560,6 +559,59 @@ var Box: Array [0..8] of DWORD; Saved_Windows: SSArray; +function GetLines (Text: string; FontID: DWORD; MaxWidth: Word): SSArray; + var i, j, len, lines: Integer; + + function GetLine (j, i: Integer): String; + begin + result := Copy(text, j, i - j + 1); + end; + + function GetWidth (j, i: Integer): Integer; + var w, h: Word; + begin + e_CharFont_GetSize(FontID, GetLine(j, i), w, h); + result := w + end; + +begin + result := nil; lines := 0; + j := 1; i := 1; len := Length(Text); + // e_LogWritefln('GetLines @%s len=%s [%s]', [MaxWidth, len, Text]); + while j <= len do + begin + (* --- Get longest possible sequence --- *) + while (i + 1 <= len) and (GetWidth(j, i + 1) <= MaxWidth) do Inc(i); + (* --- Do not include part of word --- *) + if (i < len) and (text[i] <> ' ') then + while (i >= j) and (text[i] <> ' ') do Dec(i); + (* --- Do not include spaces --- *) + while (i >= j) and (text[i] = ' ') do Dec(i); + (* --- Add line --- *) + SetLength(result, lines + 1); + result[lines] := GetLine(j, i); + // e_LogWritefln(' -> (%s:%s::%s) [%s]', [j, i, GetWidth(j, i), result[lines]]); + Inc(lines); + (* --- Skip spaces --- *) + while (i <= len) and (text[i] = ' ') do Inc(i); + j := i + 2; + end; +end; + +procedure Sort (var a: SSArray); + var i, j: Integer; s: string; +begin + if a = nil then Exit; + + for i := High(a) downto Low(a) do + for j := Low(a) to High(a) - 1 do + if LowerCase(a[j]) > LowerCase(a[j + 1]) then + begin + s := a[j]; + a[j] := a[j + 1]; + a[j + 1] := s; + end; +end; procedure g_GUI_Init(); begin @@ -814,12 +866,21 @@ procedure TGUIWindow.Draw; var i: Integer; ID: DWORD; + tw, th: Word; begin - if FBackTexture <> '' then + if FBackTexture <> '' then // Here goes code duplication from g_game.pas:DrawMenuBackground() if g_Texture_Get(FBackTexture, ID) then - e_DrawSize(ID, 0, 0, 0, False, False, gScreenWidth, gScreenHeight) + begin + e_Clear(0, 0, 0); + e_GetTextureSize(ID, @tw, @th); + if tw = th then + tw := round(tw * 1.333 * (gScreenHeight / th)) + else + tw := trunc(tw * (gScreenHeight / th)); + e_DrawSize(ID, (gScreenWidth - tw) div 2, 0, 0, False, False, tw, gScreenHeight); + end else - e_Clear(GL_COLOR_BUFFER_BIT, 0.5, 0.5, 0.5); + e_Clear(0.5, 0.5, 0.5); // small hack here if FName = 'AuthorsMenu' then @@ -1025,6 +1086,7 @@ function TGUIMainMenu.AddButton(fProc: Pointer; Caption: string; ShowWindow: str var a, _x: Integer; h, hh: Word; + lh: Word = 0; begin FIndex := 0; @@ -1044,18 +1106,21 @@ begin if FButtons[a] <> nil then _x := Min(_x, (gScreenWidth div 2)-(FButtons[a].GetWidth div 2)); - hh := FHeader.GetHeight; + if FLogo <> 0 then e_GetTextureSize(FLogo, nil, @lh); + hh := FButtons[High(FButtons)].GetHeight; - h := hh*(2+Length(FButtons))+MAINMENU_SPACE*(Length(FButtons)-1); - h := (gScreenHeight div 2)-(h div 2); + if FLogo <> 0 then h := lh + hh * (1 + Length(FButtons)) + MAINMENU_SPACE * (Length(FButtons) - 1) + else h := hh * (2 + Length(FButtons)) + MAINMENU_SPACE * (Length(FButtons) - 1); + h := (gScreenHeight div 2) - (h div 2); - with FHeader do + if FHeader <> nil then with FHeader do begin FX := _x; FY := h; end; - Inc(h, hh*2); + if FLogo <> 0 then Inc(h, lh) + else Inc(h, hh*2); for a := 0 to High(FButtons) do begin @@ -1078,7 +1143,7 @@ begin FButtons[High(FButtons)] := nil; end; -constructor TGUIMainMenu.Create(FontID: DWORD; Header: string); +constructor TGUIMainMenu.Create(FontID: DWORD; Logo, Header: string); begin inherited Create(); @@ -1089,12 +1154,15 @@ begin g_Texture_Get(MAINMENU_MARKER1, FMarkerID1); g_Texture_Get(MAINMENU_MARKER2, FMarkerID2); - FHeader := TGUILabel.Create(Header, FFontID); - with FHeader do + if not g_Texture_Get(Logo, FLogo) then begin - FColor := MAINMENU_HEADER_COLOR; - FX := (gScreenWidth div 2)-(GetWidth div 2); - FY := (gScreenHeight div 2)-(GetHeight div 2); + FHeader := TGUILabel.Create(Header, FFontID); + with FHeader do + begin + FColor := MAINMENU_HEADER_COLOR; + FX := (gScreenWidth div 2)-(GetWidth div 2); + FY := (gScreenHeight div 2)-(GetHeight div 2); + end; end; end; @@ -1114,10 +1182,16 @@ end; procedure TGUIMainMenu.Draw; var a: Integer; + w, h: Word; + begin inherited; - FHeader.Draw; + if FHeader <> nil then FHeader.Draw + else begin + e_GetTextureSize(FLogo, @w, @h); + e_Draw(FLogo, ((gScreenWidth div 2) - (w div 2)), FButtons[0].FY - FButtons[0].GetHeight - h, 0, True, False); + end; if FButtons <> nil then begin @@ -2204,21 +2278,25 @@ begin else FIndex := 0; + g_Sound_PlayEx(SCROLL_ADDSOUND); + if @FOnChangeEvent <> nil then FOnChangeEvent(Self); end; - IK_LEFT, IK_KPLEFT, VK_LEFT, - JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT: - begin - if FIndex > 0 then - Dec(FIndex) - else - FIndex := High(FItems); + IK_LEFT, IK_KPLEFT, VK_LEFT, + JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT: + begin + if FIndex > 0 then + Dec(FIndex) + else + FIndex := High(FItems); - if @FOnChangeEvent <> nil then - FOnChangeEvent(Self); - end; + g_Sound_PlayEx(SCROLL_SUBSOUND); + + if @FOnChangeEvent <> nil then + FOnChangeEvent(Self); + end; end; end; end; @@ -2336,7 +2414,7 @@ begin end; end; - g_GUIGrabInput := FWindow.FActiveControl = Self; + g_GUIGrabInput := (@FOnEnterEvent = nil) and (FWindow.FActiveControl = Self); g_Touch_ShowKeyboard(g_GUIGrabInput) end; @@ -2461,7 +2539,7 @@ begin else if FIsQuery then begin case wParam of - IK_ENTER, IK_KPRETURN, VK_FIRSTKEY..VK_LASTKEY, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: // Not '' then FKey := wParam; @@ -2629,7 +2707,7 @@ begin else if FIsQuery then begin case wParam of - IK_ENTER, IK_KPRETURN, VK_FIRSTKEY..VK_LASTKEY, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: // Not '' then begin @@ -2668,7 +2746,8 @@ begin DrawBox(FX, FY, 4, 4); - if FModel <> nil then FModel.Draw(FX+4, FY+4); + if FModel <> nil then + r_PlayerModel_Draw(FModel, FX+4, FY+4); end; procedure TGUIModelView.NextAnim(); @@ -2958,10 +3037,18 @@ begin SetLength(FItems, Length(FItems)+1); FItems[High(FItems)] := Item; - if FSort then g_Basic.Sort(FItems); + if FSort then g_gui.Sort(FItems); +end; + +function TGUIListBox.ItemExists (item: String): Boolean; + var i: Integer; +begin + i := 0; + while (i <= High(FItems)) and (FItems[i] <> item) do Inc(i); + result := i <= High(FItems) end; -procedure TGUIListBox.Clear(); +procedure TGUIListBox.Clear; begin FItems := nil; @@ -3105,7 +3192,7 @@ begin FStartLine := 0; FIndex := -1; - if FSort then g_Basic.Sort(FItems); + if FSort then g_gui.Sort(FItems); end; procedure TGUIListBox.SelectItem(Item: String); @@ -3151,7 +3238,7 @@ end; procedure TGUIFileListBox.OnMessage(var Msg: TMessage); var - a, b: Integer; + a, b: Integer; s: AnsiString; begin if not FEnabled then Exit; @@ -3234,7 +3321,18 @@ begin begin if FItems[FIndex][1] = #29 then // Ïàïêà begin - OpenDir(FPath+Copy(FItems[FIndex], 2, 255)); + if FItems[FIndex] = #29 + '..' then + begin + e_LogWritefln('TGUIFileListBox: Upper dir "%s" -> "%s"', [FSubPath, e_UpperDir(FSubPath)]); + FSubPath := e_UpperDir(FSubPath) + end + else + begin + s := Copy(AnsiString(FItems[FIndex]), 2); + e_LogWritefln('TGUIFileListBox: Enter dir "%s" -> "%s"', [FSubPath, e_CatPath(FSubPath, s)]); + FSubPath := e_CatPath(FSubPath, s); + end; + ScanDirs; FIndex := 0; Exit; end; @@ -3267,70 +3365,78 @@ begin end; end; -procedure TGUIFileListBox.OpenDir(path: String); -var - SR: TSearchRec; - i: Integer; - sm, sc: string; +procedure TGUIFileListBox.ScanDirs; + var i, j: Integer; path: AnsiString; SR: TSearchRec; sm, sc: String; begin - Clear(); + Clear; - path := IncludeTrailingPathDelimiter(path); - path := ExpandFileName(path); - - // Êàòàëîãè: - if FDirs then + i := High(FBaseList); + while i >= 0 do begin - if FindFirst(path+'*', faDirectory, SR) = 0 then - repeat - if not LongBool(SR.Attr and faDirectory) then - Continue; - if (SR.Name = '.') or - ((SR.Name = '..') and (path = ExpandFileName(FBasePath))) then - Continue; - - AddItem(#1 + SR.Name); - until FindNext(SR) <> 0; - - FindClose(SR); + path := e_CatPath(FBaseList[i], FSubPath); + if FDirs then + begin + if FindFirst(path + '/' + '*', faDirectory, SR) = 0 then + begin + repeat + if LongBool(SR.Attr and faDirectory) then + if (SR.Name <> '.') and ((FSubPath <> '') or (SR.Name <> '..')) then + if Self.ItemExists(#1 + SR.Name) = false then + Self.AddItem(#1 + SR.Name) + until FindNext(SR) <> 0 + end; + FindClose(SR) + end; + Dec(i) end; - // Ôàéëû: - sm := FFileMask; - while sm <> '' do + i := High(FBaseList); + while i >= 0 do begin - i := Pos('|', sm); - if i = 0 then i := length(sm)+1; - sc := Copy(sm, 1, i-1); - Delete(sm, 1, i); - if FindFirst(path+sc, faAnyFile, SR) = 0 then repeat AddItem(SR.Name); until FindNext(SR) <> 0; - FindClose(SR); + path := e_CatPath(FBaseList[i], FSubPath); + sm := FFileMask; + while sm <> '' do + begin + j := Pos('|', sm); + if j = 0 then + j := length(sm) + 1; + sc := Copy(sm, 1, j - 1); + Delete(sm, 1, j); + if FindFirst(path + '/' + sc, faAnyFile, SR) = 0 then + begin + repeat + if Self.ItemExists(SR.Name) = false then + AddItem(SR.Name) + until FindNext(SR) <> 0 + end; + FindClose(SR) + end; + Dec(i) end; for i := 0 to High(FItems) do if FItems[i][1] = #1 then FItems[i][1] := #29; - - FPath := path; end; -procedure TGUIFileListBox.SetBase(path: String); +procedure TGUIFileListBox.SetBase (dirs: SSArray; path: String = ''); begin - FBasePath := path; - OpenDir(FBasePath); + FBaseList := dirs; + FSubPath := path; + ScanDirs end; -function TGUIFileListBox.SelectedItem(): String; +function TGUIFileListBox.SelectedItem (): String; + var s: AnsiString; begin - Result := ''; - - if (FIndex = -1) or (FItems = nil) or - (FIndex > High(FItems)) or - (FItems[FIndex][1] = '/') or - (FItems[FIndex][1] = '\') then - Exit; - - Result := FPath + FItems[FIndex]; + result := ''; + if (FIndex >= 0) and (FIndex <= High(FItems)) and (FItems[FIndex][1] <> '/') and (FItems[FIndex][1] <> '\') then + begin + s := e_CatPath(FSubPath, FItems[FIndex]); + if e_FindResource(FBaseList, s) = true then + result := ExpandFileName(s) + end; + e_LogWritefln('TGUIFileListBox.SelectedItem -> "%s"', [result]); end; procedure TGUIFileListBox.UpdateFileList(); @@ -3345,7 +3451,8 @@ begin else fn := FItems[FIndex]; - OpenDir(FPath); +// OpenDir(FPath); + ScanDirs; if fn <> '' then SelectItem(fn);