Commit 679032bd authored by Kirinn's avatar Kirinn

sakuconfig: Move font preferences into sakuconfig

parent e6bbfb8a
......@@ -646,7 +646,7 @@ var i, j : dword;
begin
i := SDL_InitSubSystem(initsys);
if i <> 0 then begin
LogError('Failed to init ' + sysnamu + ': ' + strdec(i) + ' ' + SDL_GetError);
LogError(strcat('Failed to init %: % %', [sysnamu, i, SDL_GetError]));
inc(j);
exit;
end;
......@@ -717,7 +717,7 @@ begin
//ReadSeenGFX;
preference.ReadConfig;
if length(fontlist) = 0 then begin
if length(preference.fontList) = 0 then begin
LogError('Failed to find font files.');
exit;
end;
......
......@@ -373,30 +373,31 @@ var fontnum : dword;
minx, maxx : longint;
facenamu : PChar;
begin
fontnum := IsFontLangInList(languagelist[boxLanguage]);
if fontnum >= dword(length(fontlist)) then begin
fontnum := preference.GetFontListIndex(languagelist[boxLanguage]);
if fontnum >= dword(length(preference.fontList)) then begin
LogError('No font for ' + languagelist[boxLanguage]);
fontnum := 0;
end;
if font.sdlHandle <> NIL then TTF_CloseFont(font.sdlHandle);
font.sdlHandle := TTF_OpenFont(@fontlist[fontnum].fontfile[1], heightp);
if font.sdlHandle = NIL then
LogError('Failed to open font ' + fontlist[fontnum].fontfile + ': ' + TTF_GetError)
else begin
font.heightp := TTF_FontHeight(font.sdlHandle);
// Lineskip is sometimes greater than font height, sometimes less. If it is less, rows overlap each other, which is
// a rendering nuisance. We'll use a script-customisable linespacing instead.
//fontheightp := TTF_FontLineSkip(font.sdlHandle);
font.exwidthp := font.heightp;
if TTF_GlyphMetrics(font.sdlHandle, ord('x'), @minx, @maxx, NIL, NIL, NIL) = 0 then
font.exwidthp := maxx - minx;
facenamu := TTF_FontFaceFamilyName(font.sdlHandle);
log(strcat('Box % (%): % %px -> got %px, ex-width %..%',
[boxIndex, languagelist[boxLanguage], facenamu, heightp, font.heightp, minx, maxx]));
facenamu := '';
end;
font.heightp_requested := heightp;
font.sdlHandle := TTF_OpenFont(@preference.fontList[fontnum].fontFile[1], heightp);
if font.sdlHandle = NIL then begin
LogError(strcat('Failed to open font %: %', [preference.fontList[fontnum].fontFile, TTF_GetError]));
exit;
end;
font.heightp := TTF_FontHeight(font.sdlHandle);
// Lineskip is sometimes greater than font height, sometimes less. If it is less, rows overlap each other, which is
// a rendering nuisance. We'll use a script-customisable linespacing instead.
//fontheightp := TTF_FontLineSkip(font.sdlHandle);
font.exwidthp := font.heightp;
if TTF_GlyphMetrics(font.sdlHandle, ord('x'), @minx, @maxx, NIL, NIL, NIL) = 0 then
font.exwidthp := maxx - minx;
facenamu := TTF_FontFaceFamilyName(font.sdlHandle);
log(strcat('Box % (%): % %px -> got %px, ex-width %..%',
[boxIndex, languagelist[boxLanguage], facenamu, heightp, font.heightp, minx, maxx]));
facenamu := '';
end;
{$else}
begin
......
......@@ -273,13 +273,6 @@ var gamevar : record
activeTextInput : byte; // 0 = no; +1 for each box accepting text input
end;
// Font preferences.
var fontList : array of record {$note todo: move fontList into sakuconfig}
fontLang : UTF8string;
fontMatch : UTF8string;
fontFile : UTF8string;
end;
{$include sakuchoicematic-header.pas}
// BGRA buffer for the full game window: windowSize.w * windowSize.h * 4
......
This diff is collapsed.
......@@ -17,7 +17,7 @@
{ along with SuperSakura. If not, see <https://www.gnu.org/licenses/>. }
{ }
var mv_MainWinH : PSDL_Window;
var mv_MainWinH : PSDL_Window; {$note todo: these go in rendermatic}
mv_RendererH : PSDL_Renderer;
mv_MainTexH : PSDL_Texture;
mv_GamepadH : PSDL_GameController;
......@@ -39,141 +39,3 @@ begin
SDL_SetWindowTitle(mv_MainWinH, NIL);
end;
function CompStrFast(const str1, str2 : UTF8string) : boolean;
begin
CompStrFast := FALSE;
if length(str1) <> length(str2) then exit;
if (length(str1) = 0)
or (str1[1] = str2[1])
or (byte(str1[1]) in [65..90, 97..122])
and (byte(str2[1]) in [65..90, 97..122])
and (byte(str1[1]) or $20 = byte(str2[1]) or $20)
then
if lowercase(str1) = lowercase(str2) then CompStrFast := TRUE;
end;
function FindFont(fontmatch : UTF8string) : UTF8string;
// Attempts to locate a .ttf or .otf file for the given font match. Returns the exact font path if found, otherwise an empty
// string.
var sysfontdir : array of UTF8string;
filudir, filuext, foundindir : UTF8string;
filusr : TSearchRec;
i : dword;
searchresult : longint;
procedure _LookAtDir(dirnamu : UTF8string; const filunamu : UTF8string);
var looksr : TSearchRec;
lookres : longint;
begin
log('Looking for ' + dirnamu + filunamu);
lookres := FindFirst(dirnamu + filunamu, faReadOnly, looksr);
while lookres = 0 do begin
filuext := lowercase(ExtractFileExt(looksr.Name));
if (filuext = '.ttf') or (filuext = '.otf') or (filuext = '.ttc') or (filuext = '.fon') then begin
log('found ' + dirnamu + looksr.Name);
if (FindFont = '') or (looksr.Name < FindFont) then begin
foundindir := dirnamu;
FindFont := looksr.Name;
end;
end;
lookres := FindNext(looksr);
end;
FindClose(looksr);
// Also check sub-directories.
lookres := FindFirst(dirnamu + '*', faDirectory or faReadOnly, looksr);
while lookres = 0 do begin
if (looksr.Attr and faDirectory <> 0) and (looksr.Name[1] <> '.') then
_LookAtDir(dirnamu + looksr.Name + DirectorySeparator, filunamu);
lookres := FindNext(looksr);
end;
FindClose(looksr);
end;
begin
FindFont := ''; foundindir := '';
log('Trying to match font: ' + fontmatch);
if pos(DirectorySeparator, fontmatch) <> 0 then begin
// Fontmatch contains an explicit directory. Just look there.
filudir := ExtractFilePath(fontmatch);
searchresult := FindFirst(fontmatch, faReadOnly, filusr);
log('Looking in ' + filudir);
while searchresult = 0 do begin
filuext := lowercase(ExtractFileExt(filusr.Name));
if (filuext = '.ttf') or (filuext = '.otf') or (filuext = '.fon') then begin
log('found ' + filudir + filusr.Name);
if (FindFont = '') or (filusr.Name < FindFont) then begin
FindFont := filusr.Name;
foundindir := filudir;
end;
end;
searchresult := FindNext(filusr);
end;
FindClose(filusr);
end
else begin
// Fontmatch doesn't contain a directory, need to figure it out.
{$ifdef WINDOWS}
setlength(sysfontdir, 1);
sysfontdir[0] := GetEnvironmentVariable('SystemRoot');
if sysfontdir[0] = '' then sysfontdir[0] := GetEnvironmentVariable('windir');
if sysfontdir[0] = '' then sysfontdir[0] := 'C:\WINDOWS';
sysfontdir[0] := sysfontdir[0] + '\Fonts\';
{$else}
setlength(sysfontdir, 4);
sysfontdir[0] := '~/.local/share/fonts/';
sysfontdir[1] := '~/.fonts/';
sysfontdir[2] := '/usr/local/share/fonts/';
sysfontdir[3] := '/usr/share/fonts/';
{$endif}
for i := 0 to high(sysfontdir) do _LookAtDir(sysfontdir[i], fontmatch);
end;
if FindFont = '' then
log('No match :(')
else begin
FindFont := foundindir + FindFont;
log('Using ' + FindFont);
end;
end;
function IsFontLangInList(const lang : UTF8string) : dword;
// Returns the given language's fontlist[] index if it exists, or a value out of range otherwise.
begin
IsFontLangInList := 0;
while IsFontLangInList < dword(length(fontList)) do begin
if CompStrFast(lang, fontList[IsFontLangInList].fontLang) then exit;
inc(IsFontLangInList);
end;
end;
function AddFontLang(const lang : UTF8string; matchstr : UTF8string) : boolean;
// Tries to find a matching font and adds it to fontlist[]. Returns true if successful.
var findres : UTF8string;
begin
AddFontLang := FALSE;
// Remove double-quotes, if they are present for some reason.
if (matchstr[1] = '"') and (matchstr[length(matchstr)] = '"') then
matchstr := copy(matchstr, 2, length(matchstr) - 2);
// Try to find the font file!
findres := FindFont(matchstr);
if (findres = '') and (matchstr[length(matchstr)] <> '*') then begin
matchstr := matchstr + '*';
findres := FindFont(matchstr);
end;
{$ifndef WINDOWS}
if (findres = '') and (byte(matchstr[1]) in [97..122]) then begin
// Try again but with a capital first letter!
byte(matchstr[1]) := byte(matchstr[1]) - $20;
findres := FindFont(matchstr);
end;
{$endif}
if findres <> '' then begin
AddFontLang := TRUE;
setlength(fontList, length(fontList) + 1);
with fontList[length(fontList) - 1] do begin
fontLang := lang;
fontMatch := matchstr;
fontFile := findres;
end;
end;
end;
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment