{$A+,B-,F-,G+,I-,P-,Q-,R-,S-,T-,V-,X+,Y+}
Program H2Pas;
{ Program:   H2PAS
  Version:   1.10
  Purpose:   convert C header files to some kind of Pascal units

  Developer: Peter Sawatzki (ps) (c) 1993
             Buchenhof 3, 58091 Hagen, Germany
 CompuServe: 100031,3002

  revision history:
  date       version  author   modification
  11/03/93   1.00     ps       written
  05/10/94   1.10     ps       add EXEHDR import support
}
Uses
  Objects,
  Strings;

Const
  Version = 'H2Pas v.1.20';
  H2PasIni= 'H2Pas.Ini';
  StdUses: pChar = 'Uses'#13#10+
                   '  Os2Def;';
  HasImports: Boolean = False;
  WhichBlock: (Undefd, InConst, InType, InVar, InFunc) = Undefd;
Var
  DstName,
  Imports: String[67];

  Function WordCount(aStr, Delims: pChar): Integer;
  Var
    Count: Integer;
    EndStr: pChar;
  Begin
    EndStr:= StrEnd(aStr);
    Count:= 0;
    While aStr<=EndStr Do Begin
      While (aStr<=EndStr) And (StrScan(Delims, aStr[0])<>Nil) Do Inc(aStr);
      If aStr<=EndStr Then Inc(Count);
      While (aStr<=EndStr) And (StrScan(Delims, aStr[0])=Nil) Do Inc(aStr)
    End;
    WordCount:= Count
  End;

  Function WordPosition (aStr, Delims: pChar; No: Integer): pChar;
  Var
    Count: Integer;
    EndStr: pChar;
  Begin
    EndStr:= StrEnd(aStr);
    Count:= 0;
    WordPosition:= Nil;
    While (aStr<=EndStr) And (Count<>No) Do Begin
      While (aStr<=EndStr) And (StrScan(Delims, aStr[0])<>Nil) Do Inc(aStr);
      If aStr<=EndStr Then Inc(Count);
      If Count<>No Then
        While (aStr<=EndStr) And (StrScan(Delims, aStr[0])=Nil) Do Inc(aStr)
      Else
        WordPosition:= aStr
    End
  End;

  Function ExtractWord (aDst, aStr, Delims: pChar; No: Integer): pChar;
  Var
    EndStr: pChar;
  Begin
    ExtractWord:= aDst;
    aStr:= WordPosition(aStr, Delims, No);
    If Assigned(aStr) Then Begin
      EndStr:= StrEnd(aStr);
      While (aStr<=EndStr) And (StrScan(Delims, aStr[0])=Nil) Do Begin
        aDst[0]:= aStr[0];
        Inc(aStr);
        Inc(aDst)
      End
    End;
    aDst[0]:= #0
  End;

  Function Trim (aDst, aSrc: pChar): pChar;
  Var
    EndStr: pChar;
  Begin
    Trim:= aDst;
    If Not Assigned(aSrc) Or (aSrc[0]=#0) Then
      aDst[0]:= #0
    Else Begin
      EndStr:= StrEnd(aSrc);
      While (aSrc<=EndStr) And (aSrc[0]<=' ') Do
        Inc(aSrc);
      StrCopy(aDst, aSrc);
      EndStr:= StrEnd(aDst);
      While (EndStr>=aDst) And (EndStr[0]<=' ') Do Begin
        EndStr[0]:= #0;
        Dec(EndStr)
      End
    End
  End;

  Function Pad (aDst, aSrc: pChar; Count: Integer): pChar;
  Begin
    Pad:= aDst;
    If aDst<>aSrc Then
      StrCopy(aDst, aSrc);
    Count:= Count-StrLen(aDst);
    aDst:= StrEnd(aDst);
    While Count>0 Do Begin
      aDst[0]:= ' ';
      Inc(aDst);
      Dec(Count)
    End;
    aDst[0]:= #0
  End;

Function StrIPos(Str1, Str2: PChar): PChar;
Var
  EndStr: pChar;
  Len: Integer;
Begin
  StrIPos:= Nil;
  EndStr:= StrEnd(Str1);
  Len:= StrLen(Str2);
  Repeat
    Str1:= StrScan(Str1, Str2[0]);
    If Str1=Nil Then Exit;
    If StrLIComp(Str1, Str2, Len)=0 Then Begin
      StrIPos:= Str1;
      Exit
    End;
    Inc(Str1)
  Until Str1>EndStr
End;

  Function JustFilename(PathName : string) : string;
  {-Return just the filename of a pathname}
  Var
    I: Word;
  Begin
    I:= Succ(Word(Length(PathName)));
    Repeat
      Dec(I);
    Until (PathName[I] in  ['\', ':', #0]) or (I = 0);
    JustFilename := Copy(PathName, Succ(I), 64);
  End;

  function JustName(PathName : string) : string;
    {-Return just the name (no extension, no path) of a pathname}
  var
    DotPos : Byte;
  begin
    PathName := JustFileName(PathName);
    DotPos := Pos('.', PathName);
    if DotPos > 0 then
      PathName := Copy(PathName, 1, DotPos-1);
    JustName := PathName;
  end;

  Function JustPath(aName: string): string;
  {-Return just the path of a filename}
  Var
    I: Word;
  Begin
    I:= Succ(Word(Length(aName)));
    Repeat
      Dec(I);
    Until (aName[I] in  ['\', ':', #0]) or (I = 0);
    JustPath:= Copy(aName, 1, I)
  End;

  Procedure Fatal (aMsg: pChar);
  Begin
    WriteLn(aMsg);
    Halt(255)
  End;

  Function GetLine (aDst: pChar; Var aFile: Text): pChar;
  Var
    aString: String;
    p,i: Integer;
  Begin
    {$i-}
    ReadLn(aFile, aString);
    If IoResult<>0 Then Fatal('Read error.');
    p:= Pos('//', aString);
    If p>0 Then Begin
      aString[p+1]:= '*';
      aString:= aString+' */'
    End;
    p:= Pos(#9, aString);
    While p>0 Do Begin
      aString[p]:= ' ';
      For i:= 1 To 7-((p-1) Mod 8) Do
        Insert(' ', aString, p);
      p:= Pos(#9, aString)
    End;
    GetLine:= StrPCopy(aDst, aString)
  End;

  Procedure OutLn (Var aFile: Text; OutStr: pChar);
  Var
    oc: Char;
  Begin
    While OutStr[0]<>#0 Do Begin
      oc:= OutStr[0];
      Case oc Of
        '/': If OutStr[1]='*' Then Begin
               oc:= '{';
               Inc(OutStr,1)
             End;
        '*': If OutStr[1]='/' Then Begin
               oc:= '}';
               Inc(OutStr)
             End
      End;
      Write(aFile, oc);
      If IoResult<>0 Then Fatal('Write error.');
      Inc(OutStr)
    End;
    Write(aFile,#13#10);
    If IoResult<>0 Then Fatal('Write error.')
  End;

Procedure HeaderInfo (Var aFile: Text);
Var
  aLine: Array[0..100] Of Char;
Begin
  WriteLn(aFile, '{ Unit: ',DstName);
  WriteLn(aFile, '  Version: 1.00');
  WriteLn(aFile, '  translated from file ',DstName,'.H');
  WriteLn(aFile, '  raw translation using '+Version+', (c) Peter Sawatzki');
  WriteLn(aFile, '  fine tuned by:');
  WriteLn(aFile, '    (fill in)');
  WriteLn(aFile, ' ');
  WriteLn(aFile, '  revision history:');
  WriteLn(aFile, '  Date:    Ver: Author: Mod:');
  WriteLn(aFile, '  xx/xx/94 1.00 <name>  <modification>');
  WriteLn(aFile, '}');
  WriteLn(aFile, 'Unit ',DstName,';');
  WriteLn(aFile, 'Interface');
  If StrLen(StdUses)<>0 Then
    WriteLn(aFile, StdUses);
End;

{-the collection part}
Type
  pImportEntry = ^tImportEntry;
  tImportEntry = Record
    TheName,
    TheDLL,
    TheOrd: pChar
  End;
  pImportCollection = ^tImportCollection;
  tImportCollection = Object(tSortedCollection)
    Function KeyOf(Item: Pointer): Pointer; Virtual;
    Function Compare(Key1, Key2: Pointer): Integer; Virtual;
    Procedure FreeItem(Item: Pointer); Virtual;
  End;

  pTypeMap = ^tTypeMap;
  tTypeMap = Record
    F, T: pChar;
  End;
  pTypeMapCollection = ^tTypeMapCollection;
  tTypeMapCollection = Object(tSortedCollection)
    Function KeyOf(Item: Pointer): Pointer; Virtual;
    Function Compare(Key1, Key2: Pointer): Integer; Virtual;
    Procedure FreeItem(Item: Pointer); Virtual;
  End;

Function tImportCollection.KeyOf(Item: Pointer): Pointer;
Begin
  KeyOf:= pImportEntry(Item)^.TheName
End;

Function tImportCollection.Compare(Key1, Key2: Pointer): Integer;
Begin
  Compare:= StrIComp(Key1, Key2)
End;

Procedure TImportCollection.FreeItem(Item: Pointer);
Begin
  StrDispose(pImportEntry(Item)^.TheName);
  StrDispose(pImportEntry(Item)^.TheDLL);
  StrDispose(pImportEntry(Item)^.TheOrd);
  Dispose(pImportEntry(Item))
End;

Function tTypeMapCollection.KeyOf(Item: Pointer): Pointer;
Begin
  KeyOf:= pTypeMap(Item)^.F
End;

Function tTypeMapCollection.Compare(Key1, Key2: Pointer): Integer;
Begin
  Compare:= StrIComp(Key1, Key2)
End;

Procedure tTypeMapCollection.FreeItem(Item: Pointer);
Begin
  StrDispose(pTypeMap(Item)^.F);
  StrDispose(pTypeMap(Item)^.T);
  Dispose(pTypeMap(Item))
End;

Const
  TheImports: pImportCollection = Nil;
  TheFuncs: pStrCollection = Nil;
  TheStructs: pStrCollection = Nil;
  TheTypeMap: pTypeMapCollection = Nil;
  TheModMap: pStrCollection = Nil;

Procedure CreateCollections;
Begin
  TheImports:= New(pImportCollection, Init(100, 50));
  TheFuncs:= New(pStrCollection, Init(10, 20));
  TheStructs:= New(pStrCollection, Init(10, 20));
  TheTypeMap:= New(pTypeMapCollection, Init(10, 10));
  TheModMap:= New(pStrCollection, Init(10, 10));
End;

Procedure DestroyCollections;
Begin
  If Assigned(TheImports) Then Dispose(TheImports, Done);
  If Assigned(TheFuncs)   Then Dispose(TheFuncs,   Done);
  If Assigned(TheStructs) Then Dispose(TheStructs, Done);
  If Assigned(TheTypeMap) Then Dispose(TheTypeMap, Done);
  If Assigned(TheModMap)  Then Dispose(TheModMap,  Done);
End;

Procedure AddImport (aName, aDLL, anOrd: pChar);
Var
  anEntry: pImportEntry;
Begin
  anEntry:= New(pImportEntry);
  anEntry^.TheName:= StrNew(aName);
  anEntry^.TheDLL:= StrNew(aDLL);
  anEntry^.TheOrd:=  StrNew(anOrd);
  TheImports^.Insert(anEntry)
End;

Procedure AddFunc (aName: pChar);
Begin
  TheFuncs^.Insert(StrNew(aName))
End;

Procedure AddStruct (aName: pChar);
Begin
  TheStructs^.Insert(StrNew(aName))
End;

Procedure AddType (aSrc, aDst: pChar);
Var
  anEntry: pTypeMap;
Begin
  anEntry:= New(pTypeMap);
  anEntry^.F:= StrNew(aSrc);
  anEntry^.T:= StrNew(aDst);
  TheTypeMap^.Insert(anEntry)
End;

Procedure AddMod (aName: pChar);
Begin
  TheModMap^.Insert(StrNew(aName))
End;

Function GetOrdDLL (aName, RetDLL, RetOrd: pChar): Boolean;
Var
  Index: Integer;
Begin
  If TheImports^.Search(aName, Index) Then
    With pImportEntry(TheImports^.At(Index))^ Do Begin
      GetOrdDLL:= True;
      StrCopy(RetDLL, TheDLL);
      StrCopy(RetOrd, TheOrd)
    End
  Else
    GetOrdDLL:= False
End;

Procedure ReadImports (aFileName: String);
Var
  aFile: Text;
  aLine: Array[0..500] Of Char;
  aName,
  aDLL,
  anOrd: Array[0..60] Of Char;
  aWord: Array[0..60] Of Char;
Begin
  {$i-} Assign(aFile, aFileName); Reset(aFile);
  If IoResult<>0 Then Exit;
  HasImports:= True;
  StrCopy(aDLL, '?');
  While Not Eof(aFile) Do Begin
    GetLine(aLine, aFile);
    If StrComp(ExtractWord(aWord, aLine, ' ', 1),'Library:')=0 Then
      ExtractWord(aDLL, aLine, ' ', 2)
    Else
    If StrComp(ExtractWord(aWord, aLine, ' ', 5),'exported,')=0 Then Begin
      ExtractWord(anOrd, aLine, ' ', 1);
      ExtractWord(aName, aLine, ' ', 4);
      AddImport(aName, aDLL, anOrd)
    End
  End;
  Close(aFile)
End;

Procedure ReadIni;
Var
  IniFile: Text;
  aStr: String;
  aLine, Word1, Word2: Array[0..255] Of Char;
  rm: (rmNone, rmTypeMap, rmModMap);
  p: Integer;
Begin
  {$i-}
  Assign(IniFile, H2PasIni); Reset(IniFile);
  If IoResult<>0 Then Begin
    Assign(IniFile, JustPath(ParamStr(0))+'\'+H2PasIni);
    Reset(IniFile);
    If IoResult<>0 Then
      Exit
  End;
  rm:= rmNone;
  While Not Eof(IniFile) Do Begin
    ReadLn(IniFile, aStr);
    p:= Pos(';', aStr); If (p>0) Then aStr[0]:= Chr(p-1);
    StrPCopy(aLine, aStr); Trim(aLine, aLine);
    If StrLen(aLine)=0 Then
      Continue;
    If aLine[0]='[' Then Begin
      If StrIComp(aLine, '[TypeMap]')=0 Then rm:= rmTypeMap Else
      If StrIComp(aLine, '[ModMap]')=0 Then rm:= rmModMap Else
        rm:= rmNone;
      Continue
    End;
    Case rm Of
      rmTypeMap: AddType(Trim(Word1, ExtractWord(Word1, aLine, '=', 1)),
                         Trim(Word2, ExtractWord(Word2, aLine, '=', 2)));
      rmModMap:  AddMod(aLine);
    End
  End;
  Close(IniFile)
End;

Function Modifier (aPart: pChar): Boolean;
Var
  Index: Integer;
Begin
  Modifier:= TheModMap^.Search(aPart, Index)
End;

Function TypeConvert (aDst, aSrc: pChar): pChar;
Var
  aWord: Array[0..79] Of Char;
  i, anInt, anError: Integer;
  aTemp: Array[0..79] Of Char;
  Index: Integer;
Begin
  TypeConvert:= aDst;
  aDst[0]:= #0;
  ExtractWord(aTemp, aSrc, '[]', 2);
  If StrLen(aTemp)>0 Then Begin
    Val(aTemp, anInt, anError);
    If anError=0 Then Begin
      Str(anInt-1:0, aTemp);
      StrCat(StrCat(StrCat(aDst,'Array[0..'), aTemp),'] Of ');
    End Else
      StrCat(StrCat(StrCat(aDst,'?'), aTemp),'?')
  End;
  ExtractWord(aSrc, aSrc, '[]', 1);
  aTemp[0]:= #0;
  For i:= 1 To WordCount(aSrc, ' ') Do
    If Not Modifier(ExtractWord(aWord, aSrc, ' ', i)) Then
      StrCat(StrCat(aTemp, aWord),' ');

  Trim(aTemp, aTemp);
  If TheTypeMap^.Search(@aTemp, Index) Then
    With pTypeMap(TheTypeMap^.At(Index))^ Do
      StrCopy(aTemp, T);
  StrCat(aDst, aTemp)
End;

Const
  IdMax = 50;
Type
  tIdTable = Array[1..IdMax] Of
    Record
      TheId,
      TheType: Array[0..79] Of Char;
      TheComment: Array[0..300] Of Char
    End;
Var
  IdCnt: Integer;
  IdTable: tIdTable;

  Procedure InitId;
  Begin
    IdCnt:= 0
  End;

  Procedure AddId (anId, aType, aComment: pChar);
  Begin
    If IdCnt=IdMax Then Begin
      WriteLn('Error: Id Table full. HALT.');
      Halt(1)
    End;
    Inc(IdCnt);
    With IdTable[IdCnt] Do Begin
      Trim(TheId, anId);
      TypeConvert(TheType, aType);
      Trim(TheComment, aComment)
    End
  End;

  Function ParseComment(Var Inf: Text; InStr, OutStr: pChar): Boolean;
  Var
    aWord: Array[0..40] Of Char;
  Begin
    ParseComment:= False;
    If StrPos(StrLCopy(aWord, InStr, 5),'/*')=Nil Then Exit;
    While StrPos(InStr, '*/')=Nil Do Begin
      StrCat(OutStr, InStr);
      GetLine(InStr, Inf)
    End;
    StrCat(OutStr, InStr);
    ParseComment:= True
  End;

  Function ParseDefine(InStr, OutStr: pChar): Boolean;
  Const
    DefineDelim = ' ';
  Var
    aWord: Array[0..512] Of Char;
    Rest, p: pChar;
    isConst: Boolean;
    i: Integer;
  Begin
    ParseDefine:= False;
    If WordCount(InStr, DefineDelim)<3 Then Exit;
    If  (ExtractWord(aWord, InStr, DefineDelim, 1)<>Nil)
    And (StrIComp(aWord, '#define')=0) Then Begin
      isConst:= False;
      If WhichBlock<>InConst Then
        StrCopy(OutStr,#13#10'Const'#13#10'  ')
      Else
        StrCopy(OutStr,'  ');
      ExtractWord(StrEnd(OutStr), InStr, DefineDelim, 2);
      StrCat(Pad(OutStr, OutStr, 35), '= ');
      Rest:= WordPosition(InStr, DefineDelim, 3);
      StrCopy(aWord, Rest);
      p:= StrPos(aWord,'/*'); If Assigned(p) Then p^:= #0;
      Trim(aWord, aWord);
      If StrLen(aWord)>15 Then Exit;
      p:= StrPos(aWord, '0x');
      While Assigned(p) Do Begin
        isConst:= True;
        p[0]:= ' ';
        p[1]:= '$';
        p:= StrPos(p, '0x')
      End;
      p:= StrScan(aWord, 'L');  {get rid of the f*cking 'L'}
      While Assigned(p) Do Begin
        If (p>aWord) Then Begin
          Dec(p);
          If p^ In ['0'..'9','A'..'F','a'..'f'] Then Begin
            p[1]:= ' ';
            IsConst:= True
          End;
          Inc(p)
        End;
        p:= StrScan(p+1, 'L')
      End;
      If Not IsConst Then
        For i:= 0 To StrLen(aWord)-1 Do
          If aWord[i] In ['0'..'9'] Then Begin
            IsConst:= True;
            Break
          End;
      If Not IsConst Then
        Exit;
      Trim(aWord, aWord);
      StrCat(StrCat(OutStr, aWord), ';');
      p:= StrPos(Rest,'/*');
      If Assigned(p) Then
        StrCat(Pad(OutStr,OutStr, 60), p);
      WhichBlock:= InConst;
      ParseDefine:= True
    End
  End;

  Function ParseStruct(Var Inf: Text; InStr, OutStr: pChar): Boolean;
  Var
    aWord,
    aComment,
    RecComment,
    RecName,
    anId, aType,
    Rest: Array[0..300] Of Char;
    possibleArray: Array[0..60] Of Char;
    p, cp: pChar;
    i: Integer;
  Begin
    ParseStruct:= False;
    If  (StrIComp(ExtractWord(aWord, Instr, ' ', 1), 'struct')<>0)
    And (StrIComp(ExtractWord(aWord, Instr, ' ', 2), 'struct')<>0) Then
      Exit;
    p:= Instr;
    Instr:= StrScan(InStr, '{');
    If Not Assigned(InStr) Then Exit;

    {-try to parse the structure}
    InStr^:= #0;
    ExtractWord(RecName, p, ' ', WordCount(p,' '));
    Inc(InStr);
    Trim(InStr, InStr);
    If (InStr[0]='/') And (InStr[1]='*') Then
      StrCopy(RecComment, InStr)
    Else
      RecComment[0]:= #0;
    InStr:= StrEnd(InStr);
    cp:= InStr;
    Repeat
      GetLine(cp, Inf);
      p:= StrScan(cp, '}');
      cp:= StrEnd(cp);
      cp^:= ' '; Inc(cp); cp^:= #0
    Until Assigned(p);
    If WordCount(p+1,' ;')>0 Then
      ExtractWord(RecName, p+1, ' ;', 1);
    pChar(p-1)^:= #0;
    InitId;
    p:= InStr;
    Repeat
      cp:= p;
      p:= StrScan(p, ';');
      If Assigned(p) Then Begin
        Trim(aWord, ExtractWord(aWord, cp, ';', 1));
        {extract possible comment}
        cp:= StrPos(aWord, '/*');
        If Assigned(cp) Then Begin
          StrCopy(aComment, cp);
          cp^:= #0
        End Else
          aComment[0]:= #0;
        {-extract id and type}
        cp:= WordPosition(aWord, ' *', WordCount(aWord, ' *')); {last word}
        StrCopy(anId, cp);
        ExtractWord(possibleArray, anId,'[]',2);
        ExtractWord(anId, anId, '[]', 1);
        cp^:= #0;
        StrCopy(aType, aWord);
        If StrLen(possibleArray)>0 Then
          StrCat(StrCat(StrCat(aType,'['),possibleArray),']');
        {-extract comment if after ';'}
        Inc(p);
        While p^=' ' Do Inc(p);
        While (p[0]='/') And (p[1]='*') Do Begin
          {append comment}
          cp:= StrEnd(aComment);
          Repeat
            cp^:= p^;