1#!/usr/bin/perl -Tw
2#use diagnostics;
3#
4# Convert Pascal code to something that Doxygen can understand
5#
6# This version is proof of concept, and may/maynot work, as it's my first perl script...
7#
8# Darren Bowles       18th June 2002
9#
10# TODO
11# handle constructor / destructor
12# const's within functions shouldn't be documented.
13# handle override, safecall etc.
14# cr/lf issues between linux / windows.
15# handle type<cr>  x = y;
16# handle class function
17# handle dispinterface
18# TLB's not handled well.
19
20# done in this version
21#   process function/procedure merged into build_line
22#   obsolete function removed
23#   started on handle class function, interface, dispinterface, TLB
24
25use Getopt::Std;
26use Getopt::Long;
27GetOptions('help', \$help, 'list=s', \$list, 'file=s', \$fle);
28
29if ($help || !($fle | $list))
30{
31  print "pas2dox -h/--help -f/--file singlefile.pas -l/--list listoffiles\n";
32  exit 0;
33}
34
35die "No Files Specified" if (!$list & !$fle);
36
37if ($fle)
38{
39  process_file ($fle);
40};
41
42if ($list)
43{
44  process_list ($list);
45};
46
47print STDERR "\tDone...\n";
48
49# =================================================================================
50# functions
51# =================================================================================
52
53sub tidy_line
54{
55  my $str = shift;
56  return $str;
57}
58
59# =================================================================================
60# tidy up line, i.e. remove spaces, tabs and newlines
61sub tidy_line2
62{
63  my $str = shift;
64
65# remove tabs and newlines
66  $str =~ s/\t|\n//g;
67
68  while ( $str =~ /  / )
69  {
70    $str =~ s/  / /g;
71  }
72  return $str;
73}
74
75# =================================================================================
76# process class block
77sub process_class
78{
79  my $line = shift;
80#$newline .= "processing class line $line\n";
81
82SWITCH: for (tidy_line($line))
83        {
84# handle comments
85          m/^\/\// && do
86          {
87            $newline .= "$line\n";
88            last;
89          };
90
91          /(private|protected|public)/i && do
92          {
93            # output keyword as lowercase
94            $newline .= lc ($1);
95            $newline .= " : \n";
96            last;
97          };
98
99# special handling of published
100          m/published/i && do
101          {
102            $newline .= "// published: \n";
103            last;
104          };
105
106# todo Not sure how to handle property yet
107#property x : type read fx write fy;
108          m/^property/i && do
109          {
110#property MessageListThread: TMessageListThread read oMessageListThread write oMessageListThread;
111            $newline .= "// property = $line\n";
112            #if ( $line =~ /(property)(.*)(:)(.*)(read)(.*)(write)(.*)/i )
113            if ( $line =~ /(property)(.*)(:)(.*)( read)(.*)( write)(.*)(;)/i )
114            {
115              $newline .= "$4 $2;\n";
116            }
117#property x : type read or write f;
118            elsif ($line =~ /(property)(.*)(:)(.*)( read| write)(.*)/i )
119            {
120#$newline .= "pf1 - 1-$1,\n2-$2,\n3-$3,\n4-$4,\n5-$5,\n6-$6,\n7-$7,\n8-$8,\n9-$9,\n10-$10\n";
121              $newline .= "$4 $2;\n";
122            }
123            else
124            {
125# FIX : does get here if property is in the line
126# i.e. procedure xxxPropertyxxx(const Propertyxxx: type;
127#        out x: type; out b: type); safecall;
128
129              $newline .= "// should not get here -> ";
130              $newline .= $line;
131            }
132            last;
133          };
134
135# end of class
136          /end;/i && do
137          {
138            $state = $DO_DEFAULT;
139            $newline .= "};\n";
140            last;
141          };
142
143          /function/i && do
144          {
145#$newline .= "processing a function\n";
146            $state = $DO_CLASSFUNCTION;
147            $function = 1;
148            if ( build_line ($line, "1", 1) == 1)
149            {
150              $function = 1;
151              $split_line = 1;
152            }
153            else
154            {
155              $function = 0;
156              $split_line = 0;
157            }
158
159            last;
160          };
161
162          /procedure/i && do
163          {
164            $state = $DO_CLASSPROCEDURE;
165            $procedure = 1;
166            if ( build_line ($line, "1", 0) == 1)
167            {
168              $procedure = 1;
169              $split_line = 1;
170            }
171            else
172            {
173              $procedure = 0;
174              $split_line = 0;
175            }
176
177            last;
178          };
179
180
181          /dispinterface/i && do
182          {
183            if ( $line =~ /(.*)(\=)(.*)/ )
184            {
185              $newline .= "dispinterface $1;\n";
186            }
187
188            last;
189          };
190
191          #      x = interface(IDispatch)
192      /(.*)(\=)(.*)(interface)([^(]*)(.*\()(.*)(\))(.*)/i && do
193      {
194        $newline .= "interface $1 : $7\n{\n";
195
196        last;
197      };
198
199      /(.*)(\=)(.*)(interface)(.*)(;)/i && do
200      {
201        $newline .= "interface $1;\n";
202        last;
203      };
204
205
206
207# X : Y;
208          /(.*)(:)(.*)(;)(.*)/ && do
209          {
210            $newline .= "$3 $1;";
211
212# add untrimmed comments
213            $comments = $line;
214            $comments =~ /(.*)(;)(.*)/;
215
216            $newline .= "$3\n";
217
218            last;
219          };
220
221# get rid of {} style commenting
222          $line =~ s/{\/\// /;
223          $line =~ s/}//;
224
225          $newline .= "//<?> $line\n";
226  }
227}
228
229# =================================================================================
230# Parse function line
231sub parse_function
232{
233#  $newline .= "parsing function\n";
234#  $newline .= "\n>> $funcline<<\n";
235
236  # remove safecall line
237  $funcline =~ s/safecall\;//;
238
239  $mline = "";
240
241  # function a.b(x, y : type) : type;
242  if ( tidy_line($funcline) =~ /(function)(.*)(\.)([^(]*)(.*\()(.*)(\))(.*\:)(.*)(;)/i )
243  {
244    $mline = func1($funcline);
245  }
246  # function b(x, y : type) : type;
247  elsif ( tidy_line($funcline) =~ /(function)(.*)(\()(.*)(\))(.*\:)(.*)(;)/i )
248  {
249    $mline = func2($funcline);
250  }
251  # function a.b : type;
252  elsif ( tidy_line($funcline) =~ /(function)(.*)(\.)(.*)(:)(.*)(;)/i )
253  {
254    $mline = func3($funcline);
255  }
256  # function a.b;
257  elsif ( tidy_line($funcline) =~ /(function)(.*)(\.)(.*)(;)/i )
258  {
259    $mline = func4($funcline);
260  }
261  # function a : type;
262  elsif ( tidy_line($funcline) =~ /(function)(.*)(:)(.*)(;)/i )
263  {
264    $mline = func5($funcline);
265  }
266  # function x;
267  else
268  {
269$newline .= $funcline;
270    $mline = func6($funcline);
271  }
272
273  $newline .= $mline;
274  $funcline = "";
275}
276
277# =================================================================================
278# Build up a func/proc line
279sub build_line
280{
281  my $line = shift;
282  $type = shift;
283  my $buildtype = shift;  # are we building a function or procedure
284
285    chomp($line);
286    # TODO pretty sure i was stripping out ^M's here... code broke on
287    # windows, so commented out...
288    #  $line =~ s///;
289
290#$newline .= "build_line = $line\n";
291
292  # Are we processing a func or proc?
293  if ( $function == 1 | $procedure == 1)
294  {
295    # are we working on a split function?
296    if ( $split_line == 1 )
297    {
298      # we have ended the parameter list on this line
299      #  or we have already reached the endparameters )
300      if ( $line =~ /\)/ | $end_parameter == 1 )
301      {
302        $end_parameter = 1;
303        # have we got the end of the function?
304        if ( $line =~ /\;/ )
305        {
306          $funcline .= $line;
307
308          # now we need to parse the full function declaration
309
310          if ( $buildtype == 1 )
311          {
312            parse_function;
313            $function = 0;
314          }
315          else
316          {
317            parse_procedure();
318            $procedure = 0;
319          }
320
321          $funcline = "";
322          return 0;
323        }
324        # not at end of declaration yet.
325        else
326        {
327          $funcline .= $line;
328          return 1;
329        }
330      }
331      # not end of parameter list yet.
332      else
333      {
334        $funcline .= $line;
335        return 1;
336      }
337    }
338    # Process first line of the function
339    else
340    {
341      # we have started parameter list
342      if ( $line =~ /\(/ )
343      {
344        # starting the parameter list
345        $end_parameter = 0;
346
347        # we have ended the parameter list on this line
348        if ( $line =~ /\)/ )
349        {
350          $end_parameter = 1;
351
352          # have we got a semicolon on this line?
353          if ( $line =~ /;/ )
354          {
355            $funcline .= $line;
356
357            if ( $buildtype == 1 )
358            {
359              parse_function;
360            }
361            else
362            {
363              parse_procedure();
364            }
365          }
366          # we have a multiline declaration
367          else
368          {
369            $split_line = 1;
370            $funcline .= $line;
371            return 1;
372          }
373        }
374        # line didn't have an ending ), so we must be split over multiple lines
375        else
376        {
377          $split_line = 1;
378          $funcline .= $line;
379          return 1;
380        }
381      }
382      # parameter list not started on this line
383      else
384      {
385        # have we got a semicolon on this line?
386        if ( $line =~ /;/ )
387        {
388          $funcline .= $line;
389
390          if ( $buildtype == 1 )
391          {
392            parse_function;
393          }
394          else
395          {
396            parse_procedure();
397          }
398        }
399        # we have a multiline declaration
400        else
401        {
402          $split_line = 1;
403          $funcline .= $line;
404          return 1;
405        }
406      }
407    }
408  }
409
410  $newline .= $funcline;
411
412  if ( $buildtype == 1 )
413  {
414    $function = 0;
415  }
416  else
417  {
418    $procedure = 0;
419  }
420
421  $funcline = "";
422  return 0;
423}
424
425# =================================================================================
426# process parameters
427sub process_params
428{
429
430  my $str = shift;
431
432#  $newline .= "// >> $str <<\n";
433
434
435# split parameters out
436
437  @a = split(/;/, $str);
438
439  $cur = 0;
440chomp @a;
441  foreach $z (@a)
442  {
443# x, y, x : type;
444
445
446    $z =~ /([^:]*)(:)(.*)/;
447    $typ = $3;
448
449# now sort out any comma'd parameters
450
451    @p1 = split(/,/, $1);
452
453    $v = 0;
454    foreach $t (@p1)
455    {
456      $mline .= $typ;
457      $mline .= " ";
458      $mline .= $t;
459
460      if ( $v < $#p1 )
461      {
462        $mline .= ", ";
463      }
464
465      $v++;
466
467    }
468
469    if ( $cur < $#a )
470    {
471      $mline .= ", ";
472    }
473
474    $cur++;
475  }
476
477}
478
479# =================================================================================
480#  function class.name(x, y : type) : type;
481sub func1
482{
483 my $funcline = shift;
484
485  tidy_line($funcline) =~ /(function)(.*)(\.)([^(]*)(.*\()(.*)(\))(.*\:)(.*)(;)/i;
486
487    $mline .= "// function class.name(x, y : type) : type\n";
488#$newline .= "pf0 - 1-$1,\n2-$2,\n3-$3,\n4-$4,\n5-$5,\n6-$6,\n7-$7,\n8-$8,\n9-$9,\n10-$10\n";
489    $mline .= $9;
490    $mline .= " ";
491    $mline .= $2;
492    $mline .= "::";
493    $mline .= $4;
494    $mline .= "(";
495
496    $v = $6;
497
498    process_params ($v);
499
500    $mline .= ")";
501
502    $function = 0;
503    if ( $type == 0)
504    {
505      if ( $implementation == 0 )
506      {
507        $mline .= ";";
508      }
509
510      $mline .= "\n";
511      $state = $DO_DEFAULT;
512    }
513    else
514    {
515      $mline .= ";\n";
516      $state = $DO_CLASS;
517    }
518
519    #      $newline .= $mline;
520    #    $funcline = "";
521
522    return $mline;
523}
524
525# =================================================================================
526# function b(x, y : type) : type;
527sub func2
528{
529  my $funcline = shift;
530  tidy_line($funcline) =~ /(function)(.*)(\()(.*)(\))(.*\:)(.*)(;)/i;
531
532  $mline = "// function b(x, y : type) : type;\n";
533  $mline .= "$7 $2 (";
534  $v = $4;
535
536  process_params($v);
537
538  $mline .= ")";
539
540  $function = 0;
541  if ( $type == 0)
542  {
543    if ( $implementation == 0 )
544    {
545      $mline .= ";";
546    }
547
548    $mline .= "\n";
549    $state = $DO_DEFAULT;
550  }
551  else
552  {
553    $mline .= ";\n";
554    $state = $DO_CLASS;
555  }
556
557  return $mline;
558
559}
560
561# =================================================================================
562# function a.b : type;
563sub func3
564{
565  my $funcline = shift;
566
567  tidy_line($funcline) =~ /(function)(.*)(\.)(.*)(:)(.*)(;)/i;
568
569  #$newline .= "func3 - 1-$1,\n2-$2,\n3-$3,\n4-$4,\n5-$5,\n6-$6,\n7-$7,\n8-$8,\n9-$9,\n10-$10\n";
570
571  $mline = "// function a.b : type;\n";
572  $mline .= "$6 $2::$4 ()";
573
574  $function = 0;
575  if ( $type == 0)
576  {
577    if ( $implementation == 0 )
578    {
579      $mline .= ";";
580    }
581
582    $mline .= "\n";
583    $state = $DO_DEFAULT;
584  }
585  else
586  {
587    $mline .= ";\n";
588    $state = $DO_CLASS;
589  }
590
591  return $mline;
592}
593
594# =================================================================================
595# function a.b;
596sub func4
597{
598  my $funcline = shift;
599
600  tidy_line($funcline) =~ /(function)(.*)(\.)(.*)(;)/i;
601
602  #$newline .= "pf0 - 1-$1,\n2-$2,\n3-$3,\n4-$4,\n5-$5,\n6-$6,\n7-$7,\n8-$8,\n9-$9,\n10-$10\n";
603
604  $mline = "// function a.b;\n";
605  $mline .= "void $2::$4 ()";
606
607  $function = 0;
608  if ( $type == 0)
609  {
610    if ( $implementation == 0 )
611    {
612      $mline .= ";";
613    }
614
615    $mline .= "\n";
616    $state = $DO_DEFAULT;
617  }
618  else
619  {
620    $mline .= ";\n";
621    $state = $DO_CLASS;
622  }
623
624
625  return $mline;
626
627}
628
629# =================================================================================
630# function a : type;
631sub func5
632{
633  my $funcline = shift;
634
635  tidy_line($funcline) =~ /(function)(.*)(:)(.*)(;)/i;
636
637  $mline = "// function a : type;\n";
638  $mline .= "$4 $2()";
639
640  $function = 0;
641  if ( $type == 0)
642  {
643    if ( $implementation == 0 )
644    {
645      $mline .= ";";
646    }
647
648    $mline .= "\n";
649    $state = $DO_DEFAULT;
650  }
651  else
652  {
653    $mline .= ";\n";
654    $state = $DO_CLASS;
655  }
656
657  return $mline;
658}
659
660# =================================================================================
661# function x;
662sub func6
663{
664  my $funcline = shift;
665
666  tidy_line($funcline) =~ /(function)(.*)(;)/i;
667
668  $mline = "// function x;\n";
669#  $newline .= "func6 - 1-$1,\n2-$2,\n3-$3,\n4-$4,\n5-$5,\n6-$6,\n7-$7,\n8-$8,\n9-$9,\n10-$10\n";
670  $mline .= "void $2 ()";
671
672  $function = 0;
673  if ( $type == 0)
674  {
675    if ( $implementation == 0 )
676    {
677      $mline .= ";";
678    }
679
680    $mline .= "\n";
681    $state = $DO_DEFAULT;
682  }
683  else
684  {
685    $mline .= ";\n";
686    $state = $DO_CLASS;
687  }
688
689  return $mline;
690}
691# =================================================================================
692
693
694# =================================================================================
695# Parse procedure line
696sub parse_procedure
697{
698#  $newline .= "parsing procedure\n";
699#  $newline .= "\n>> $funcline<<\n";
700
701# procedure a.b(x, y : type);
702# procedure b(x, y : type);
703# procedure a.b;
704# procedure a;
705
706# remove safecall line
707  $funcline =~ s/safecall\;//;
708
709  $mline = "";
710
711  # procedure a.b(x, y : type);
712  if ( tidy_line($funcline) =~ /(procedure)(.*)(\.)([^(]*)(.*\()(.*)(\))(.*)(;)/i )
713  {
714    $mline = proc1($funcline);
715  }
716  # procedure b(x, y : type);
717  elsif ( tidy_line($funcline) =~ /(procedure)(.*)(\()(.*)(\))(.*)(;)/i )
718  {
719    $mline = proc2($funcline);
720  }
721  # procedure a.b;
722  elsif ( tidy_line($funcline) =~ /(procedure)(.*)(\.)(.*)(;)/i )
723  {
724    $mline = proc3($funcline);
725  }
726  # procedure a;
727  else
728  {
729    $mline = proc4($funcline);
730  }
731
732  $newline .= $mline;
733  $funcline = "";
734}
735
736
737
738# =================================================================================
739# procedure a.b(x, y : type);
740sub proc1
741{
742  my $funcline = shift;
743
744  tidy_line($funcline) =~ /(procedure)(.*)(\.)([^(]*)(.*\()(.*)(\))(.*)(;)/i;
745
746  $mline = "// procedure a.b(x, y : type);\n";
747#$newline .= "pf0 - 1-$1,\n2-$2,\n3-$3,\n4-$4,\n5-$5,\n6-$6,\n7-$7,\n8-$8,\n9-$9,\n10-$10\n";
748  $mline .= "void $2::$4 (";
749
750  $v = $6;
751  process_params($v);
752
753  $mline .= ")";
754
755  $procedure = 0;
756  if ( $type == 0)
757  {
758
759    if ( $implementation == 0 )
760    {
761      $mline .= ";";
762    }
763
764    $mline .= "\n";
765    $state = $DO_DEFAULT;
766  }
767  else
768  {
769    $mline .= ";\n";
770    $state = $DO_CLASS;
771  }
772
773  return $mline;
774}
775
776
777# =================================================================================
778# procedure b(x, y : type);
779sub proc2
780{
781  my $funcline = shift;
782
783  tidy_line($funcline) =~ /(procedure)(.*)(\()(.*)(\))(.*)(;)/i;
784
785  $mline = "// procedure b(x, y : type);\n";
786#$newline .= "pf0 - 1-$1,\n2-$2,\n3-$3,\n4-$4,\n5-$5,\n6-$6,\n7-$7,\n8-$8,\n9-$9,\n10-$10\n";
787
788  $mline .= "void $2 (";
789
790  $v = $4;
791# --- processing for COM stuff
792  $v =~ s/ out / \[out\] /g;
793# ---
794
795  process_params($v);
796
797  $mline .= ")";
798
799  $procedure = 0;
800  if ( $type == 0)
801  {
802
803    if ( $implementation == 0 )
804    {
805      $mline .= ";";
806    }
807
808    $mline .= "\n";
809    $state = $DO_DEFAULT;
810  }
811  else
812  {
813    $mline .= ";\n";
814    $state = $DO_CLASS;
815  }
816
817  return $mline;
818}
819
820# =================================================================================
821# procedure a.b;
822sub proc3
823{
824  my $funcline = shift;
825
826  tidy_line($funcline) =~ /(procedure)(.*)(\.)(.*)(;)/i;
827
828  $mline = "// procedure a.b;\n";
829#$newline .= "pf0 - 1-$1,\n2-$2,\n3-$3,\n4-$4,\n5-$5,\n6-$6,\n7-$7,\n8-$8,\n9-$9,\n10-$10\n";
830  $mline .= "void $2::$4 ()";
831
832  $procedure = 0;
833  if ( $type == 0)
834  {
835
836    if ( $implementation == 0 )
837    {
838      $mline .= ";";
839    }
840
841    $mline .= "\n";
842    $state = $DO_DEFAULT;
843  }
844  else
845  {
846    $mline .= ";\n";
847    $state = $DO_CLASS;
848  }
849
850  return $mline;
851}
852
853
854# =================================================================================
855# procedure a;
856sub proc4
857{
858  my $funcline = shift;
859
860  tidy_line($funcline) =~ /(procedure)(.*)(;)/i;
861
862  $mline = "// procedure a;\n";
863#$newline .= "pf0 - 1-$1,\n2-$2,\n3-$3,\n4-$4,\n5-$5,\n6-$6,\n7-$7,\n8-$8,\n9-$9,\n10-$10\n";
864  $mline .= "void $2 ()";
865
866  $procedure = 0;
867  if ( $type == 0)
868  {
869    if ( $implementation == 0 )
870    {
871      $mline .= ";";
872    }
873
874    $mline .= "\n";
875    $state = $DO_DEFAULT;
876  }
877  else
878  {
879    $mline .= ";\n";
880    $state = $DO_CLASS;
881  }
882
883  return $mline;
884}
885
886# =================================================================================
887sub process_file
888{
889  my $fle = shift;
890  open (CFG, $fle);
891  print STDERR "Analyzing $fle\n";
892
893  analyse_file ($fle);
894}
895
896# =================================================================================
897sub process_list
898{
899  my $list = shift;
900
901  #open the file to read the list of projects from
902  open (FILE, "<$list");
903
904  # while we still have files to iterate through
905  open (FILE, "<$list");
906
907  print STDERR "Analyzing list $list...\n";
908
909  while ($fle = <FILE> )
910  {
911    process_file ($fle);
912  }
913
914  close (FILE);
915}
916
917sub analyse_file
918{
919  my $fle = shift;
920
921  if ( $fle =~ /(.*)\.(.+)$/ )
922  {
923    $name = $1;
924    # $2 will hold the extension, TODO convert .pas files only.
925  }
926
927  print STDERR "\tConverting file $fle";
928
929# open file for output
930
931  $outname = $name;
932  $outname .= ".";
933  $outname .= "cpp";
934
935  open (OUT, ">$outname");
936
937# reset flags
938
939  $newline = "";        # line to be generated
940  $funcline = "";       # function line being generated
941  $block_cnt = 0;       # block counter
942  $skip = 1;            # skip lines
943  $function = 0;        # processing function
944  $procedure = 0;       # processing procedure
945  $split_line = 0;      # func/proc split over multiple lines
946  $implementation = 0;  # implementation not reached yet
947
948  $DO_DEFAULT = 1;
949  $DO_BLOCK = 2;
950  $DO_CLASS = 3;
951  $DO_CONST = 4;
952  $DO_FUNCTION = 5;
953  $DO_PROCEDURE = 6;
954  $DO_CLASSFUNCTION = 7;
955  $DO_CLASSPROCEDURE = 8;
956  $DO_DISPINTERFACE = 9;
957
958  $state = $DO_DEFAULT;
959
960  while ( $line = <CFG> )
961  {
962LOOP:
963  {
964#   $newline .= "$function, $split_line, $state, line = $line\n";
965    if ( $state == $DO_DEFAULT )
966    {
967# Ignore comments
968      if ( $line =~ m/^\/\// )
969      {
970        $newline .= $line;
971        last;
972      }
973      elsif ( $line =~ /(.*{)(.*)(.*})/ )
974      {
975        $newline .= "/*$2*/\n";
976        $skip = 1;
977        last;
978      }
979      elsif ( $line =~ /(.*{)(.*)/ )
980      {
981        $newline .= "/* $2";
982        $skip = 1;
983        last;
984      }
985      elsif ( $line =~ /(.*})/ )
986      {
987        $newline .= "$1 */\n";
988        $skip = 0;
989        last;
990      }
991      elsif( $line =~ m/^type/i )
992      {
993        $skip = 0;
994      }
995      elsif ( $line =~ m/^constructor/i )
996      {
997        $skip = 1;
998      }
999      elsif ( $line =~ m/destructor/i )
1000      {
1001        $skip = 1;
1002      }
1003      elsif ( $line =~ m/^const/i )
1004      {
1005        $state = $DO_CONST;
1006        $skip = 1;
1007      }
1008      elsif ( tidy_line($line) =~ m/^begin/i )			    # process begin block
1009      {
1010        $skip = 0;
1011        $state = $DO_BLOCK;
1012        $block_cnt++;
1013        $newline .= "{\n";
1014      }
1015      elsif ( tidy_line($line) =~ m/^var/i )           # variable block
1016      {
1017        $state = $DO_DEFAULT;
1018        $skip = 1;
1019      }
1020      elsif ( tidy_line($line) =~ m/^implementation/i )
1021      {
1022        $state = $DO_DEFAULT;
1023        $skip = 0;
1024        $implementation = 1;
1025        last;
1026      }
1027      elsif ( tidy_line($line) =~ m/^function/i )
1028      {
1029        $state = $DO_FUNCTION;
1030        $function = 1;
1031      }
1032      elsif ( tidy_line($line) =~ /class/i )
1033      {
1034        if ( tidy_line($line) =~ m/^class/i )
1035        {
1036          if ( tidy_line($line) =~ /class function/i )
1037          {
1038            $line =~ s/class //g;
1039            $state = $DO_FUNCTION;
1040            $function = 1;
1041          }
1042          else
1043          {
1044            $state = $DO_CLASS;
1045          }
1046        }
1047        elsif ( tidy_line($line) =~ /(.*)(\=)(.*)(class)/i )
1048        {
1049#$newline .= "aclass $1\n{\n";
1050          $state = $DO_CLASS;
1051        }
1052
1053      }
1054      elsif ( tidy_line($line) =~ m/^procedure/i )
1055      {
1056        $state = $DO_PROCEDURE;
1057        $procedure = 1;
1058      }
1059      elsif ( tidy_line($line) =~ /dispinterface/i )
1060      {
1061        if ( tidy_line($line) =~ /(.*)(\=)(.*)(;)/ )
1062        {
1063          $newline .= "$3 $1;\n";
1064          last;
1065        }
1066        else
1067        {
1068          if ( tidy_line($line) =~ /(.*)(\=)(.*)/ )
1069          {
1070            $newline .= "dispinterface $1\n{\n";
1071          }
1072
1073          $state = $DO_CLASS;
1074          last LOOP;
1075        }
1076      }
1077      elsif ( tidy_line($line) =~ /interface/i )
1078      {
1079#$newline .= "// 2 >>> $line\n";
1080
1081        if ( tidy_line($line) =~ /(.*)(\=)(.*)(;)/i )
1082        {
1083          $newline .= "interface $1;\n";
1084        }
1085        elsif ( tidy_line($line) =~ /^interface/i )
1086        {
1087          $newline .= "// interface ignored\n";
1088        }
1089        elsif ( tidy_line($line) =~ /(.*)(\=)(.*)(interface)([^(]*)(.*\()(.*)(\))(.*)/i )
1090        {
1091          $newline .= "interface $1 : $7\n{\n";
1092          $state = $DO_CLASS;
1093        }
1094        else
1095        {
1096#$newline .= ">>> 1 - $line\n";
1097$state = $DO_CLASS;
1098          last LOOP;
1099        }
1100
1101        last;
1102#$state = $DO_CLASS;
1103      }
1104
1105
1106
1107# Working on a function
1108      if ( $state == $DO_FUNCTION )
1109      {
1110#$newline .= "about to process a function\n";
1111        if ( build_line ($line, "0", 1) == 1 )
1112        {
1113          $function = 1;
1114          $split_line = 1;
1115        }
1116        else
1117        {
1118          $function = 0;
1119          $split_line = 0;
1120        }
1121        last LOOP;
1122      };
1123
1124# Working on a procedure
1125      if ( $state == $DO_PROCEDURE )
1126      {
1127        if ( build_line ($line, "0", 0) == 1 )
1128        {
1129          $procedure = 1;
1130          $split_line = 1;
1131        }
1132        else
1133        {
1134          $procedure = 0;
1135          $split_line = 0;
1136        }
1137        last LOOP;
1138      };
1139
1140#$newline .= "about to do block - $line\n";
1141      if ( $block_cnt == 0)
1142      {
1143        if ( $skip == 0 )
1144        {
1145          if ( $line =~ /(^.*)( = class)()(.*)$/i) # class definition
1146          {
1147            $newline .= "class ";
1148            $newline .= $1;
1149            $newline .= ":";
1150            $newline .= $4;
1151            $newline .= "{\n";
1152            $state = $DO_CLASS;
1153          }
1154          else        # Get rid of { } style commenting
1155          {
1156            $line =~ s/{/\/\/\/ /;
1157            $line =~ s/}//;
1158
1159            if ( tidy_line($line) =~ m/procedure/i )
1160            {
1161              build_line ($line, "1", 0);
1162            }
1163            else
1164            {
1165              if ( tidy_line($line) =~ m/^\/\// )
1166              {
1167                $newline .= $line;
1168              }
1169              else
1170              {
1171                $newline .= "// > $line";
1172              }
1173            }
1174          }
1175        }
1176      }
1177
1178      last LOOP;
1179    };
1180
1181
1182    if ( $state == $DO_BLOCK )
1183    {
1184      if ( $line =~ m/^end/i )				# end block
1185      {
1186        $state = $DO_DEFAULT;
1187        $block_cnt--;
1188        $newline .= "}";
1189        $newline .= "\n";
1190      }
1191
1192      last LOOP;
1193    };
1194
1195    if ( $state == $DO_CONST )
1196    {
1197#NAME = 'SOMETHING';
1198      if ( $line =~ /([^=]*)(.*=)(.*)(;)(.*)/i )
1199      {
1200        $newline .= "#define ";
1201        $newline .= $1;
1202        $newline .= " ";
1203        $newline .= $3;
1204        $newline .= ";\n";
1205      }
1206      else
1207      {
1208        $newline .= "// const error - ";
1209#      $newline .= $line;
1210        $state = $DO_DEFAULT;
1211        $skip = 0;
1212      }
1213
1214      last LOOP;
1215    };
1216
1217# Working on a class structure
1218    if ( $state == $DO_CLASS )
1219    {
1220#$newline .= "then got here - $line \n";
1221      process_class ($line);
1222
1223      last LOOP;
1224    };
1225
1226# working on function split over lines
1227    if ( $state == $DO_FUNCTION )
1228    {
1229      if ( build_line ($line, "0", 1) == 0)
1230      {
1231        $function = 0;
1232        $split_line = 0;
1233        $state = $DO_DEFAULT;
1234      }
1235    };
1236
1237# working on class function declaration, split over lines
1238    if ( $state == $DO_CLASSFUNCTION )
1239    {
1240      if ( build_line ($line, "1", 1) == 0)
1241      {
1242        $function = 0;
1243        $split_line = 0;
1244        $state = $DO_CLASS;
1245      }
1246    };
1247
1248# working on procedure split over lines
1249    if ( $state == $DO_PROCEDURE )
1250    {
1251      if ( build_line ($line, "0", 0) == 0)
1252      {
1253        $procedure = 0;
1254        $split_line = 0;
1255        $state = $DO_DEFAULT;
1256      }
1257    };
1258
1259
1260# working on class procedure declaration, split over lines
1261    if ( $state == $DO_CLASSPROCEDURE )
1262    {
1263      if ( build_line ($line, "1", 0) == 0)
1264      {
1265        $procedure = 0;
1266        $split_line = 0;
1267        $state = $DO_CLASS;
1268      }
1269    };
1270}
1271}
1272
1273print OUT $newline;
1274close (OUT);
1275
1276
1277}
1278