X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fgame%2Fg_basic.pas;h=1ed87abd9145fba8dbf04b0875b590d38dbb7d2f;hb=3c277b2aaae8425a26b2d3badc2f6bf5ad2fd817;hp=e5ef3d9c28acdff92c10e22ddf19ef8beb635e92;hpb=d3967cf39bf31bc5573af05576457ccfce96e9ea;p=d2df-sdl.git diff --git a/src/game/g_basic.pas b/src/game/g_basic.pas index e5ef3d9..1ed87ab 100644 --- a/src/game/g_basic.pas +++ b/src/game/g_basic.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 @@ -90,6 +89,7 @@ procedure SortSArray(var S: SSArray); function b_Text_Format(S: string): string; function b_Text_Unformat(S: string): string; function b_Text_Wrap(S: string; LineLen: Integer): string; +function b_Text_LineCount(S: string): Integer; var gmon_dbg_los_enabled: Boolean = true; @@ -628,118 +628,38 @@ begin end; end; -{function GetLines(Text: string; MaxChars: Word): SSArray; -var - a: Integer; - b: array of string; - str: string; -begin - Text := Trim(Text); - - while Pos(' ', Text) <> 0 do Text := AnsiReplaceStr(Text, ' ', ' '); - - while Text <> '' do - begin - SetLength(b, Length(b)+1); - b[High(b)] := GetStr(Text); - end; - - a := 0; - while True do - begin - if a > High(b) then Break; - - str := b[a]; - a := a+1; - - if Length(str) >= MaxChars then - begin - while str <> '' do - begin - SetLength(Result, Length(Result)+1); - Result[High(Result)] := Copy(str, 1, MaxChars); - Delete(str, 1, MaxChars); - end; - - Continue; - end; - - while (a <= High(b)) and (Length(str+' '+b[a]) <= MaxChars) do - begin - str := str+' '+b[a]; - a := a+1; - end; - - SetLength(Result, Length(Result)+1); - Result[High(Result)] := str; - end; -end;} - -function GetLines(Text: string; FontID: DWORD; MaxWidth: Word): SSArray; - -function TextLen(Text: string): Word; -var - h: Word; -begin - e_CharFont_GetSize(FontID, Text, Result, h); -end; - -var - a, c: Integer; - b: array of string; - str: string; +function GetLines (Text: string; FontID: DWORD; MaxWidth: Word): SSArray; + var i, j, len, lines: Integer; w, cw, ch: Word; skip: Boolean; begin - SetLength(Result, 0); - SetLength(b, 0); - - Text := Trim(Text); - -// Óäàëÿåì ìíîæåñòâåííûå ïðîáåëû: - while Pos(' ', Text) <> 0 do - Text := AnsiReplaceStr(Text, ' ', ' '); - - while Text <> '' do + result := nil; lines := 0; w := 0; + j := 1; i := 1; len := Length(Text); + while i <= len do begin - SetLength(b, Length(b)+1); - b[High(b)] := GetStr(Text); - end; - - a := 0; - while True do - begin - if a > High(b) then - Break; - - str := b[a]; - a := a+1; - - if TextLen(str) > MaxWidth then - begin // Òåêóùàÿ ñòðîêà ñëèøêîì äëèííàÿ => ðàçáèâàåì - while str <> '' do + e_CharFont_GetSize(FontID, '' + Text[i], cw, ch); + if (i >= len) or (w + cw >= MaxWidth) then + begin + skip := (i < len) and (Text[i] <> ' '); + if skip then begin - SetLength(Result, Length(Result)+1); - - c := 0; - while (c < Length(str)) and - (TextLen(Copy(str, 1, c+1)) < MaxWidth) do - c := c+1; - - Result[High(Result)] := Copy(str, 1, c); - Delete(str, 1, c); + // alt: while (i >= j) and (Text[i] <> ' ') do Dec(i); + while (i <= len) and (Text[i] <> ' ') do Inc(i); end; - end - else // Ñòðîêà íîðìàëüíîé äëèíû => ñîåäèíÿåì ñî ñëåäóþùèìè - begin - while (a <= High(b)) and - (TextLen(str+' '+b[a]) < MaxWidth) do + while (i >= j) and (Text[i] = ' ') do Dec(i); + (* --- *) + SetLength(result, lines + 1); + result[lines] := Copy(Text, j, i - j + 1); + Inc(lines); + (* --- *) + if skip then begin - str := str+' '+b[a]; - a := a + 1; + while (i <= len) and (Text[i] = ' ') do Inc(i); + Inc(i); end; - - SetLength(Result, Length(Result)+1); - Result[High(Result)] := str; + j := i + 1; + w := 0 end; + Inc(w, cw); + Inc(i) end; end; @@ -1180,4 +1100,14 @@ begin Result := WrapText(S, ''#10, [#10, ' ', '-'], LineLen); end; +function b_Text_LineCount(S: string): Integer; +var + I: Integer; +begin + Result := IfThen(S = '', 0, 1); + for I := 1 to High(S) do + if S[I] = #10 then + Inc(Result); +end; + end.