source: trunk/FormMain.pas

Last change on this file was 4, checked in by chronos, 17 months ago
File size: 18.5 KB
Line 
1unit FormMain;
2
3interface
4
5uses
6 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, FileUtil,
7 LazFileUtils;
8
9type
10
11 { TFormMain }
12
13 TFormMain = class(TForm)
14 ButtonProcess: TButton;
15 ButtonBrowse: TButton;
16 EditDir: TEdit;
17 MemoLog: TMemo;
18 procedure ButtonBrowseClick(Sender: TObject);
19 procedure ButtonProcessClick(Sender: TObject);
20 private
21 function StartsWith(Text, What: string): Boolean;
22 function EndsWith(Text, What: string): Boolean;
23 function IsSpecialSymbol(C: Char): Boolean;
24 function IsAlpha(C: Char): Boolean;
25 function IsNumeric(C: Char): Boolean;
26 function IsAlphaNumeric(C: Char): Boolean;
27 function IsAlphaNumericUnderscore(C: Char): Boolean;
28 function ReadIdent(Text: string): string;
29 function ReadIdentBack(Text: string): string;
30 function ReplaceSpecialSymbolNumericAfter(Text: string; OldPattern,
31 NewPattern, NewPattern2: string): string;
32 function ReplaceSpecialSymbolNumericBefore(Text: string; OldPattern,
33 NewPattern, NewPattern2: string): string;
34 function SpaceAround(Text, What: string; Left: Boolean = True; Right: Boolean = True): string;
35 function Replace(Text: string; OldPattern, NewPattern: string): string;
36 function ReplaceIdent(Text: string; OldPattern, NewPattern: string): string;
37 function ReplaceFunction(Text: string; ReturnType: string): string;
38 function ReplaceVariable(Text: string; VarType: string): string;
39 function ReplaceOperator(Text: string; OldOp, NewOp1, NewOp2: string): string;
40 function ReplaceAndClose(Text: string; OldPattern, NewPattern, Close: string;
41 Strip: string = ''): string;
42 function ReplaceSpecialSymbol(Text: string; OldPattern, NewPattern: string): string;
43 function FormatCodeCpp(Text: string): string;
44 function ReadFileContent(FileName: string): string;
45 procedure WriteFileContent(FileName: string; Content: string);
46 end;
47
48var
49 FormMain: TFormMain;
50
51
52implementation
53
54{$R *.lfm}
55
56type
57 TFilterMethod = function (FileName: string): Boolean of object;
58 TFileNameMethod = procedure (FileName: string) of object;
59
60{ TFormMain }
61
62procedure TFormMain.ButtonBrowseClick(Sender: TObject);
63var
64 Dir: string;
65begin
66 if SelectDirectory('Select directory', EditDir.Text, Dir) then
67 EditDir.Text := Dir;
68end;
69
70function TFormMain.IsSpecialSymbol(C: Char): Boolean;
71begin
72 Result := C in ['&', '|', '!', '<', '>', '+', '-', '=', '.', '#', '{', '}',
73 ':'];
74end;
75
76function TFormMain.IsAlpha(C: Char): Boolean;
77begin
78 Result := (C in ['a'..'z']) or (C in ['A'..'Z']);
79end;
80
81function TFormMain.IsNumeric(C: Char): Boolean;
82begin
83 Result := C in ['0'..'9'];
84end;
85
86function TFormMain.IsAlphaNumeric(C: Char): Boolean;
87begin
88 Result := IsAlpha(C) or IsNumeric(C);
89end;
90
91function TFormMain.IsAlphaNumericUnderscore(C: Char): Boolean;
92begin
93 Result := IsAlphaNumeric(C) or (C = '_');
94end;
95
96function TFormMain.ReadIdent(Text: string): string;
97var
98 I: Integer;
99begin
100 Result := '';
101 I := 1;
102 while (I <= Length(Text)) do begin
103 if Text[I] = ' ' then begin
104 end else
105 if (Result = '') and IsAlpha(Text[I]) then begin
106 Result := Result + Text[I];
107 end else
108 if (Result <> '') and IsAlphaNumericUnderscore(Text[I]) then begin
109 Result := Result + Text[I];
110 end else Break;
111 Inc(I);
112 end;
113end;
114
115function TFormMain.ReadIdentBack(Text: string): string;
116var
117 I: Integer;
118begin
119 Result := '';
120 I := Length(Text);
121 while (I > 0) do begin
122 if Text[I] = ' ' then begin
123 end else
124 if (Result = '') and IsAlpha(Text[I]) then begin
125 Result := Text[I] + Result;
126 end else
127 if (Result <> '') and IsAlphaNumericUnderscore(Text[I]) then begin
128 Result := Text[I] + Result;
129 end else Break;
130 Dec(I);
131 end;
132end;
133
134procedure SearchFiles(List: TStrings; Dir: string;
135 FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil);
136var
137 SR: TSearchRec;
138 FullName: string;
139begin
140 List.BeginUpdate;
141 try
142 Dir := IncludeTrailingPathDelimiter(Dir);
143 if FindFirst(Dir + '*', faAnyFile, SR) = 0 then begin
144 try
145 repeat
146 if (SR.Name = '.') or (SR.Name = '..') then Continue;
147 FullName := Dir + SR.Name;
148 if not Assigned(FilterMethod) or (Assigned(FilterMethod) and FilterMethod(FullName)) then begin;
149 if Assigned(FileNameMethod) then
150 FileNameMethod(Dir + SR.Name);
151 List.Add(FullName);
152 end;
153 if (SR.Attr and faDirectory) <> 0 then
154 SearchFiles(List, FullName, FilterMethod, FileNameMethod);
155 until FindNext(SR) <> 0;
156 finally
157 FindClose(SR);
158 end;
159 end;
160 finally
161 List.EndUpdate;
162 end;
163end;
164
165procedure TFormMain.ButtonProcessClick(Sender: TObject);
166var
167 I: Integer;
168 Files: TStringList;
169 FileNameSrc: string;
170 FileNameDst: string;
171 DirSrc: string;
172 DirDst: string;
173 FileExt: string;
174 Content: string;
175 Content2: string;
176begin
177 DirSrc := EditDir.Text;
178 DirDst := ExtractFileDir(DirSrc) + DirectorySeparator + ExtractFileName(DirSrc) + '_';
179 MemoLog.Lines.BeginUpdate;
180 try
181 MemoLog.Lines.Clear;
182 Files := TStringList.Create;
183 SearchFiles(Files, DirSrc, nil, nil);
184
185 for I := 0 to Files.Count - 1 do begin
186 MemoLog.Lines.Add(Files[I]);
187 FileNameSrc := Files[I];
188 if DirectoryExists(FileNameSrc) then continue;
189 if FileExists(FileNameSrc) then begin
190 FileNameDst := DirDst + Copy(FileNameSrc, Length(DirSrc) + 1, MaxInt);
191 ForceDirectories(ExtractFileDir(FileNameDst));
192 FileExt := ExtractFileExt(FileNameSrc);
193 if FileExt = '.cpp' then begin
194 FileNameDst := ExtractFileNameWithoutExt(FileNameDst) + '.pas';
195 DeleteFile(FileNameDst);
196 end;
197 end;
198 end;
199
200 for I := 0 to Files.Count - 1 do begin
201 MemoLog.Lines.Add(Files[I]);
202 FileNameSrc := Files[I];
203 if DirectoryExists(FileNameSrc) then continue;
204 if FileExists(FileNameSrc) then begin
205 FileNameDst := DirDst + Copy(FileNameSrc, Length(DirSrc) + 1, MaxInt);
206 ForceDirectories(ExtractFileDir(FileNameDst));
207 FileExt := ExtractFileExt(FileNameSrc);
208 if FileExt = '.cpp' then begin
209 // Skip for now
210 end else
211 if FileExt = '.h' then begin
212 FileNameDst := ExtractFileNameWithoutExt(FileNameDst) + '.pas';
213 Content := FormatCodeCpp(ReadFileContent(FileNameSrc));
214 Content := 'unit ' + ExtractFileNameOnly(FileNameDst) + ';' + LineEnding +
215 LineEnding + 'interface' + LineEnding + LineEnding + Content;
216 WriteFileContent(FileNameDst, Content);
217 end else
218 CopyFile(FileNameSrc, FileNameDst);
219 end;
220 end;
221
222 // Merge .cpp files
223 for I := 0 to Files.Count - 1 do begin
224 FileNameSrc := Files[I];
225 if DirectoryExists(FileNameSrc) then continue;
226 if FileExists(FileNameSrc) then begin
227 FileNameDst := DirDst + Copy(FileNameSrc, Length(DirSrc) + 1, MaxInt);
228 ForceDirectories(ExtractFileDir(FileNameDst));
229 FileExt := ExtractFileExt(FileNameSrc);
230 if FileExt = '.cpp' then begin
231 FileNameDst := ExtractFileNameWithoutExt(FileNameDst) + '.pas';
232 if FileExists(FileNameDst) then Content := ReadFileContent(FileNameDst)
233 else Content := 'unit ' + ExtractFileNameOnly(FileNameDst) + ';' + LineEnding +
234 LineEnding + 'interface' + LineEnding + LineEnding;
235 Content2 := FormatCodeCpp(ReadFileContent(FileNameSrc));
236 Content := Content + LineEnding + 'implementation' + LineEnding + LineEnding +
237 Content2 + LineEnding + LineEnding + 'end.' + LineEnding;
238 WriteFileContent(FileNameDst, Content);
239 end;
240 end;
241 end;
242 Files.Free;
243 finally
244 MemoLog.Lines.EndUpdate;
245 end;
246end;
247
248function TFormMain.EndsWith(Text, What: string): Boolean;
249begin
250 Result := Copy(Text, Length(Text) - Length(What) + 1, Length(What)) = What;
251end;
252
253function TFormMain.StartsWith(Text, What: string): Boolean;
254begin
255 Result := Copy(Text, 1, Length(What)) = What;
256end;
257
258function TFormMain.SpaceAround(Text, What: string; Left: Boolean = True; Right: Boolean = True): string;
259var
260 I: Integer;
261begin
262 Result := '';
263 while True do begin
264 I := Pos(What, Text);
265 if I > 0 then begin
266 Result := Result + Copy(Text, 1, I - 1);
267 Delete(Text, 1, I - 1);
268 if Left and (Length(Result) >= 1) and (Result[Length(Result)] <> ' ') then begin
269 Result := Result + ' ';
270 end;
271 Result := Result + What;
272 Delete(Text, 1, Length(What));
273 if Right and (Length(Text) >= 1) and (Text[1] <> ' ') then begin
274 Result := Result + ' ';
275 end;
276 end else Break;
277 end;
278 Result := Result + Text;
279end;
280
281function TFormMain.Replace(Text: string; OldPattern, NewPattern: string
282 ): string;
283begin
284 Result := StringReplace(Text, OldPattern, NewPattern, [rfReplaceAll]);
285end;
286
287function TFormMain.ReplaceIdent(Text: string; OldPattern, NewPattern: string
288 ): string;
289var
290 I: Integer;
291 TextBefore: string;
292 TextAfter: string;
293begin
294 Result := '';
295 while True do begin
296 I := Pos(OldPattern, Text);
297 if I > 0 then begin
298 TextBefore := Copy(Text, 1, I - 1);
299 TextAfter := Copy(Text, I + Length(OldPattern), Length(Text));
300 if ((Length(TextBefore) >= 1) and IsAlphaNumeric(TextBefore[Length(TextBefore)]) or
301 ((Length(Result) >= 1) and IsAlphaNumeric(Result[Length(Result)]) and
302 (Copy(Result, Length(Result) - Length(NewPattern) + 1, Length(NewPattern)) <> NewPattern)) or
303 ((Length(TextAfter) >= 1) and IsAlphaNumeric(TextAfter[1])))
304 then begin
305 Result := Result + TextBefore + OldPattern;
306 Delete(Text, 1, Length(TextBefore) + Length(OldPattern));
307 Continue;
308 end;
309 Result := Result + TextBefore + NewPattern;
310 Delete(Text, 1, Length(TextBefore) + Length(OldPattern));
311 end else Break;
312 end;
313 Result := Result + Text;
314end;
315
316function TFormMain.ReplaceFunction(Text: string; ReturnType: string): string;
317var
318 Strip: string;
319 I: Integer;
320begin
321 I := Pos(ReturnType + ' ', Text);
322 if (I > 0) and (Trim(Copy(Text, 1, I - 1)) = '') and (Pos('(', Text) > 0) and (Pos(')', Text) > 0) then begin
323 Strip := ';';
324 if EndsWith(Text, Strip) then
325 Delete(Text, Length(Text) - Length(Strip) + 1, Length(Strip));
326 Result := Copy(Text, 1, I - 1) + 'function' + Copy(Text, I + Length(ReturnType), Length(Text)) + ': ' + ReturnType + ';';
327 end else Result := Text;
328end;
329
330function TFormMain.ReplaceVariable(Text: string; VarType: string): string;
331var
332 I: Integer;
333 Ident: string;
334begin
335 Result := '';
336 while True do begin
337 I := Pos(VarType + ' ', Text);
338 if I > 0 then begin
339 Result := Result + Copy(Text, 1, I - 1);
340 Delete(Text, 1, I - 1 + Length(VarType + ' '));
341 Ident := ReadIdent(Text);
342 if Ident <> '' then begin
343 Result := Result + Ident + ': ' + VarType;
344 Delete(Text, 1, Length(Ident));
345 end else Result := Result + VarType + ' ';
346 end else begin
347 Result := Result + Text;
348 Break;
349 end;
350 end;
351end;
352
353function TFormMain.ReplaceOperator(Text: string; OldOp, NewOp1, NewOp2: string): string;
354var
355 I: Integer;
356 TextBefore: string;
357 TextAfter: string;
358 Ident: string;
359begin
360 I := Pos(OldOp, Text);
361 if I > 0 then begin
362 TextBefore := Copy(Text, 1, I - 1);
363 TextAfter := Copy(Text, I + Length(OldOp), Length(Text));
364 Ident := ReadIdentBack(TextBefore);
365 if Ident <> '' then begin
366 Delete(TextBefore, Length(TextBefore) - Length(Ident) + 1, Length(Ident));
367 Result := TextBefore + Ident + ' ' + NewOp1 + ' ' + Ident + ' ' + NewOp2 + ' ' + TextAfter;
368 end else Result := Text;
369 end else Result := Text;
370end;
371
372function TFormMain.ReplaceAndClose(Text: string; OldPattern, NewPattern,
373 Close: string; Strip: string = ''): string;
374var
375 Found: Boolean;
376begin
377 Found := Pos(OldPattern, Text) > 0;
378 Result := StringReplace(Text, OldPattern, NewPattern, [rfReplaceAll]);
379 if Found then begin
380 if (Strip <> '') and EndsWith(Result, Strip) then
381 Delete(Result, Length(Result) - Length(Strip) + 1, Length(Strip));
382 Result := Result + Close;
383 end;
384end;
385
386function TFormMain.ReplaceSpecialSymbol(Text: string; OldPattern, NewPattern: string): string;
387var
388 I: Integer;
389 TextBefore: string;
390 TextAfter: string;
391begin
392 Result := '';
393 while True do begin
394 I := Pos(OldPattern, Text);
395 if I > 0 then begin
396 TextBefore := Copy(Text, 1, I - 1);
397 TextAfter := Copy(Text, I + Length(OldPattern), Length(Text));
398 if ((Length(TextBefore) >= 1) and IsSpecialSymbol(TextBefore[Length(TextBefore)]) or
399 ((Length(Result) >= 1) and IsSpecialSymbol(Result[Length(Result)]) and
400 (Copy(Result, Length(Result) - Length(NewPattern) + 1, Length(NewPattern)) <> NewPattern)) or
401 ((Length(TextAfter) >= 1) and IsSpecialSymbol(TextAfter[1])))
402 then begin
403 Result := Result + TextBefore + OldPattern;
404 Delete(Text, 1, Length(TextBefore) + Length(OldPattern));
405 Continue;
406 end;
407 Result := Result + TextBefore + NewPattern;
408 Delete(Text, 1, Length(TextBefore) + Length(OldPattern));
409 end else Break;
410 end;
411 Result := Result + Text;
412end;
413
414function TFormMain.ReplaceSpecialSymbolNumericAfter(Text: string; OldPattern, NewPattern, NewPattern2: string): string;
415var
416 I: Integer;
417 TextBefore: string;
418 TextAfter: string;
419begin
420 Result := '';
421 while True do begin
422 I := Pos(OldPattern, Text);
423 if I > 0 then begin
424 TextBefore := Copy(Text, 1, I - 1);
425 TextAfter := Copy(Text, I + Length(OldPattern), Length(Text));
426 if (Length(TextAfter) >= 1) and IsNumeric(TextAfter[1]) then begin
427 Result := Result + TextBefore + NewPattern2;
428 Delete(Text, 1, Length(TextBefore) + Length(OldPattern));
429 end else begin
430 Result := Result + TextBefore + NewPattern;
431 Delete(Text, 1, Length(TextBefore) + Length(OldPattern));
432 end;
433 end else Break;
434 end;
435 Result := Result + Text;
436end;
437
438function TFormMain.ReplaceSpecialSymbolNumericBefore(Text: string; OldPattern,
439 NewPattern, NewPattern2: string): string;
440var
441 I: Integer;
442 TextBefore: string;
443begin
444 Result := '';
445 while True do begin
446 I := Pos(OldPattern, Text);
447 if I > 0 then begin
448 TextBefore := Copy(Text, 1, I - 1);
449 if (Length(TextBefore) >= 1) and IsNumeric(TextBefore[Length(TextBefore)]) then begin
450 Result := Result + TextBefore + NewPattern2;
451 Delete(Text, 1, Length(TextBefore) + Length(OldPattern));
452 end else begin
453 Result := Result + TextBefore + NewPattern;
454 Delete(Text, 1, Length(TextBefore) + Length(OldPattern));
455 end;
456 end else Break;
457 end;
458 Result := Result + Text;
459end;
460
461function TFormMain.FormatCodeCpp(Text: string): string;
462var
463 Lines: TStringList;
464 I: Integer;
465 J: Integer;
466 Line: string;
467const
468 Types: array[0..11] of string = ('Integer', 'Boolean', 'Cardinal', 'Byte',
469 'ShortInt', 'Pointer',
470 'Advances', 'TNewGameData', 'TServerCall', 'TClientCall', 'MyEVOArea',
471 'TileFunction');
472 PascalKeywords: array[0..1] of string = ('object', 'type');
473begin
474 Result := '';
475 Lines := TStringList.Create;
476 try
477 Lines.Text := Text;
478 for I := 0 to Lines.Count - 1 do begin
479 Line := Lines[I];
480 Line := ReplaceSpecialSymbol(Line, '>>', 'shr');
481 Line := ReplaceSpecialSymbol(Line, '<<', 'shl');
482 Line := ReplaceSpecialSymbol(Line, '&&', 'and');
483 Line := ReplaceSpecialSymbol(Line, '||', 'or');
484 Line := ReplaceSpecialSymbol(Line, '&', 'and');
485 Line := ReplaceSpecialSymbol(Line, '|', 'or');
486 Line := ReplaceSpecialSymbol(Line, '!', 'not');
487 Line := ReplaceSpecialSymbol(Line, '!=', '<>');
488 Line := ReplaceSpecialSymbol(Line, '->', '.');
489 Line := ReplaceSpecialSymbol(Line, '::', '.');
490 Line := Replace(Line, 'switch', 'case');
491 Line := Replace(Line, 'unsigned long ', 'Cardinal ');
492 Line := Replace(Line, 'unsigned short ', 'Byte ');
493 Line := Replace(Line, 'unsigned char ', 'Byte ');
494 Line := Replace(Line, 'unsigned int ', 'Cardinal ');
495 Line := Replace(Line, 'int ', 'Integer ');
496 Line := Replace(Line, 'short ', 'ShortInt ');
497 Line := Replace(Line, 'long ', 'Integer ');
498 Line := Replace(Line, 'bool ', 'Boolean ');
499 Line := Replace(Line, 'void *', 'Pointer ');
500 Line := Replace(Line, 'std.ofstream ', 'TStream ');
501 Line := Replace(Line, 'std.ostream ', 'TStream ');
502 Line := ReplaceOperator(Line, '+=', ':=', '+');
503 Line := ReplaceOperator(Line, '-=', ':=', '-');
504 Line := ReplaceOperator(Line, '++', ':=', '+ 1');
505 Line := ReplaceOperator(Line, '++', ':=', '- 1');
506 Line := ReplaceSpecialSymbol(Line, '=', ':=');
507 Line := ReplaceSpecialSymbol(Line, '==', '=');
508 Line := ReplaceSpecialSymbolNumericAfter(Line, '{', 'begin', '(');
509 Line := ReplaceSpecialSymbolNumericBefore(Line, '}', 'end;', ')');
510 Line := ReplaceAndClose(Line, '#include', '{$include', '}');
511 Line := ReplaceAndClose(Line, 'return', 'Exit(', ');', ';');
512 Line := Replace(Line, '0x', '$');
513 Line := Replace(Line, '"', '''');
514 Line := ReplaceAndClose(Line, '#define', '{$define', '}');
515 Line := ReplaceAndClose(Line, '#endif', '{$endif', '}');
516 Line := ReplaceAndClose(Line, '#ifdef', '{$ifdef', '}');
517 Line := ReplaceAndClose(Line, '#ifndef', '{$ifndef', '}');
518 Line := ReplaceAndClose(Line, 'void ', 'procedure ', ';');
519 Line := Replace(Line, 'struct', 'record');
520 Line := Replace(Line, '/*', '(*');
521 Line := Replace(Line, '*/', '*)');
522 Line := Replace(Line, 'const ', '');
523 Line := Replace(Line, ' const', '');
524 Line := Replace(Line, 'mutable ', '');
525 for J := 0 to Length(Types) - 1 do
526 Line := ReplaceFunction(Line, Types[J]);
527 if Pos('function', Line) > 0 then
528 Line := Replace(Line, ',', ';');
529 for J := 0 to Length(Types) - 1 do
530 Line := ReplaceVariable(Line, Types[J]);
531 Line := ReplaceAndClose(Line, 'if (', 'if (', ' then');
532 Line := Replace(Line, '()', '');
533 for J := 0 to Length(PascalKeywords) - 1 do
534 Line := ReplaceIdent(Line, PascalKeywords[J], 'K' + PascalKeywords[J]);
535 //Line := SpaceAround(Line, ':=');
536 //Line := SpaceAround(Line, '+');
537 //Line := SpaceAround(Line, ',', False, True);
538 Lines[I] := Line;
539 end;
540 Result := Lines.Text;
541 finally
542 Lines.Free;
543 end;
544end;
545
546function TFormMain.ReadFileContent(FileName: string): string;
547var
548 Lines: TStringList;
549begin
550 Lines := TStringList.Create;
551 try
552 Lines.LoadFromFile(FileName);
553 Result := Lines.Text;
554 finally
555 Lines.Free;
556 end;
557end;
558
559procedure TFormMain.WriteFileContent(FileName: string; Content: string);
560var
561 Lines: TStringList;
562begin
563 Lines := TStringList.Create;
564 try
565 Lines.Text := Content;
566 Lines.SaveToFile(FileName);
567 finally
568 Lines.Free;
569 end;
570end;
571
572
573end.
574
Note: See TracBrowser for help on using the repository browser.