diff options
Diffstat (limited to 'images')
| -rwxr-xr-x | images/stdimg_updatew.bat | 4 | ||||
| -rw-r--r-- | images/updatestdimgs.pas | 90 |
2 files changed, 75 insertions, 19 deletions
diff --git a/images/stdimg_updatew.bat b/images/stdimg_updatew.bat index 64996667..aee458b9 100755 --- a/images/stdimg_updatew.bat +++ b/images/stdimg_updatew.bat @@ -1 +1,3 @@ -updatestdimgs > ../src/corelib/stdimages.inc +if not exist updatestdimgs.exe fpc -O2 -Xs -XX -Sh -FUunits -oupdatestdimgs.exe updatestdimgs.pas +if exist updatestdimgs.exe updatestdimgs.exe --prefix=stdimg > ../src/corelib/stdimages.inc +pause diff --git a/images/updatestdimgs.pas b/images/updatestdimgs.pas index 16180727..bd3ef8bc 100644 --- a/images/updatestdimgs.pas +++ b/images/updatestdimgs.pas @@ -29,17 +29,20 @@ type FOutputFile: string; FInputDir: string; FPrefix: string; + FUnitName: string; + FUnitCode: string; + FMaskSamplePos: string; public - procedure Usage; - procedure Verbose(Msg: string; Args: array of const); - procedure ConvertImage(FN: string); - procedure ConvertImages; - function ProcessCommandLine: Boolean; - procedure DoRun; override; - property BeVerbose: Boolean read FBeVerbose; - property InputDir: string read FInputDir; - property OutputFile: string read FOutputFile; - property Prefix: string read FPrefix; + procedure Usage; + procedure Verbose(Msg: string; Args: array of const); + procedure ConvertImage(FN: string); + procedure ConvertImages; + function ProcessCommandLine: Boolean; + procedure DoRun; override; + property BeVerbose: Boolean read FBeVerbose; + property InputDir: string read FInputDir; + property OutputFile: string read FOutputFile; + property Prefix: string read FPrefix; end; @@ -49,7 +52,10 @@ type Writeln(' -h --help This help screen'); Writeln(' -i --inputdir=NNN Search files in dir NNN'); Writeln(' -o --output=NNN Write output in file NNN'); - Writeln(' -p --prefix=NNN Prefix constant names with NNN'); + Writeln(' -p --prefix=NNN Prefix constant names with NNN'); + Writeln(' -u --unit=NNN Create a complete unit named NNN'); + Writeln(' -m --mask=X,Y When using -u switch, set the position '); + Writeln(' of the pixel containing transparent color'); Writeln(' -v --verbose Be verbose'); end; @@ -62,23 +68,32 @@ type procedure TConvertApp.ConvertImage(FN: string); var S: string; + iname: string; begin Verbose('Converting image : %s', [FN]); - S := FPrefix + ChangeFileExt(FN, ''); + iname := ChangeFileExt(FN, ''); + S := FPrefix + '_' + iname; if (FOutputFile <> '') then ExecuteProcess(FBinary, ['-o', FOutputFile, '-c', S, FN]) else ExecuteProcess(FBinary, ['-c', S, FN]); + + if FUnitName <> '' then + FUnitCode := FUnitCode + + ' fpgImages.AddMaskedBMP(' +LineEnding+ + ' '''+FPrefix+'.'+iname+''',' +LineEnding+ + ' @'+S+',' +LineEnding+ + ' sizeof('+S+'), '+FMaskSamplePos+');' +LineEnding+LineEnding; end; function TConvertApp.ProcessCommandLine: Boolean; const - Longopts: array[1..5] of string = ( - 'help', 'verbose', 'inputdir', 'output:', 'prefix:'); + Longopts: array[1..7] of string = ( + 'help', 'verbose', 'inputdir:', 'output:', 'prefix:', 'unit:', 'mask:'); var S: string; begin - S := CheckOptions('hvi:o:p:', Longopts); + S := CheckOptions('hvi:o:p:u:m:', Longopts); Result := (S = '') and not HasOption('h', 'help'); if not Result then begin @@ -87,7 +102,7 @@ type Usage; Exit; end; - FBeVerbose := HasOption('v'); + FBeVerbose := HasOption('v', 'verbose'); if HasOption('i', 'inputdir') then FInputDir := GetOptionValue('i', 'inputdir'); if HasOption('o', 'output') then @@ -95,7 +110,18 @@ type if HasOption('p', 'prefix') then FPrefix := GetOptionValue('p', 'prefix') else - FPrefix := 'stdimg_'; + FPrefix := 'usr'; + + if HasOption('u', 'unit') then + if FOutputFile <> '' then + FUnitName := ChangeFileExt(FOutputFile, '') + else + FUnitName := GetOptionValue('u', 'unit'); + + if HasOption('m', 'mask') then + FMaskSamplePos := GetOptionValue('m', 'mask') + else + FMaskSamplePos := '0,0'; end; procedure TConvertApp.DoRun; @@ -109,11 +135,31 @@ type procedure TConvertApp.ConvertImages; var Info: TSearchRec; + f: TextFile; begin if (FBinary = '') then - FBinary := FileSearch('bin2obj', GetEnvironmentVariable('PATH')); + FBinary := FileSearch(bin2obj, GetEnvironmentVariable('PATH')); if (FInputDir <> '') then FInputDir := IncludeTrailingPathDelimiter(FInputDir); + + if FUnitName <> '' then + begin + FUnitCode := 'unit '+ FUnitName +';' +LineEnding+LineEnding+ + '{$mode objfpc}{$H+}' +LineEnding+LineEnding+ + 'interface' +LineEnding+LineEnding+ + 'uses' +LineEnding+ + ' fpgfx;' +LineEnding+LineEnding+ + 'procedure InitializeCustomImages;'+LineEnding+LineEnding+ + 'implementation'; + AssignFile(f, FOutputFile); + Rewrite(f); + WriteLn(f, FUnitCode); + CloseFile(f); + FUnitCode := LineEnding+ + 'procedure InitializeCustomImages;'+LineEnding+ + 'begin' +LineEnding; + end; + if FindFirst(FInputDir + '*.bmp', faAnyFile, Info) = 0 then try repeat @@ -122,6 +168,14 @@ type finally FindClose(Info); end; + + if FUnitName <> '' then + begin + FUnitCode := FUnitCode + 'end;'+LineEnding+LineEnding+'end.'; + Append(f); + WriteLn(f, FUnitCode); + CloseFile(f); + end; end; begin |