1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
{
This program searches for *.bmp files in the current directory and
outputs to stdout the bmp files found as byte array constants.
}
program updatestdimgs;
{$IFDEF FPC}
{$mode delphi}{$H+}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
SysUtils,
CustApp;
const
{$ifdef unix}
bin2obj = 'bin2obj';
{$else}
bin2obj = 'bin2obj.exe';
{$endif}
type
TConvertApp = class(TCustomApplication)
private
FBeVerbose: Boolean;
FBinary: string;
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;
end;
procedure TConvertApp.Usage;
begin
Writeln('Usage : ', ExtractFileName(ParamStr(0)));
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(' -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;
procedure TConvertApp.Verbose(Msg: string; Args: array of const);
begin
if BeVerbose then
Writeln(StdErr, Format(Msg, Args));
end;
procedure TConvertApp.ConvertImage(FN: string);
var
S: string;
iname: string;
begin
Verbose('Converting image : %s', [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..7] of string = (
'help', 'verbose', 'inputdir:', 'output:', 'prefix:', 'unit:', 'mask:');
var
S: string;
begin
S := CheckOptions('hvi:o:p:u:m:', Longopts);
Result := (S = '') and not HasOption('h', 'help');
if not Result then
begin
if (S <> '') then
Writeln(StdErr, 'Error in options: ', S);
Usage;
Exit;
end;
FBeVerbose := HasOption('v', 'verbose');
if HasOption('i', 'inputdir') then
FInputDir := GetOptionValue('i', 'inputdir');
if HasOption('o', 'output') then
FOutputFile := GetOptionValue('o', 'output');
if HasOption('p', 'prefix') then
FPrefix := GetOptionValue('p', 'prefix')
else
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;
begin
StopOnException := True;
if ProcessCommandLine then
ConvertImages;
Terminate;
end;
procedure TConvertApp.ConvertImages;
var
Info: TSearchRec;
f: TextFile;
begin
if (FBinary = '') then
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
ConvertImage(FInputDir + Info.Name);
until FindNext(Info) <> 0;
finally
FindClose(Info);
end;
if FUnitName <> '' then
begin
FUnitCode := FUnitCode + 'end;'+LineEnding+LineEnding+'end.';
Append(f);
WriteLn(f, FUnitCode);
CloseFile(f);
end;
end;
begin
with TConvertApp.Create(nil) do
try
Run
finally
Free;
end;
end.
|
