diff --git a/bepascal/source/tools/codegen/Jamfile b/bepascal/source/tools/codegen/Jamfile new file mode 100644 index 0000000..bf68233 --- /dev/null +++ b/bepascal/source/tools/codegen/Jamfile @@ -0,0 +1,23 @@ +# BePascal - A pascal wrapper around the BeOS API +# Copyright (C) 2002-2003 Olivier Coursiere +# Matt Emson +# Eric Jourde +# Oscar Lesta +# +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Library General Public +# License as published by the Free Software Foundation; either +# version 2 of the License, or (at your option) any later version. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Library General Public License for more details. +# +# You should have received a copy of the GNU Library General Public +# License along with this library; if not, write to the Free +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +SubDir BEPASCAL_TOP source tools codegen ; + +SubInclude BEPASCAL_TOP source tools codegen pas ; diff --git a/bepascal/source/tools/codegen/README b/bepascal/source/tools/codegen/README new file mode 100644 index 0000000..d97afb9 --- /dev/null +++ b/bepascal/source/tools/codegen/README @@ -0,0 +1,2 @@ +This tool read XML description of BeAPIs and generate pascal and C/C++ source code +to access this API from pascal source code diff --git a/bepascal/source/tools/codegen/pas/Jamfile b/bepascal/source/tools/codegen/pas/Jamfile new file mode 100644 index 0000000..81e1b2b --- /dev/null +++ b/bepascal/source/tools/codegen/pas/Jamfile @@ -0,0 +1,32 @@ +# BePascal - A pascal wrapper around the BeOS API +# Copyright (C) 2002-2003 Olivier Coursiere +# Matt Emson +# Eric Jourde +# Oscar Lesta +# +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Library General Public +# License as published by the Free Software Foundation; either +# version 2 of the License, or (at your option) any later version. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Library General Public License for more details. +# +# You should have received a copy of the GNU Library General Public +# License along with this library; if not, write to the Free +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +SubDir BEPASCAL_TOP source tools codegen pas ; + +Objects codegen.pp ; + + + + + + + + + diff --git a/bepascal/source/tools/codegen/pas/apireader.pp b/bepascal/source/tools/codegen/pas/apireader.pp new file mode 100644 index 0000000..b522e1d --- /dev/null +++ b/bepascal/source/tools/codegen/pas/apireader.pp @@ -0,0 +1,642 @@ +{ BePascal - A pascal wrapper around the BeOS API + Copyright (C) 2002 Olivier Coursiere + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +unit apireader; + +{$H+} // use AnsiStrings + +interface + +uses + Classes, SysUtils, xmlread, dom; + +const + ImportFuncString = ' cdecl; external BePascalLibName name ''%s_%s'';'; + +type + TNode = class(TObject) + private + function GetCount : integer; + function GetNode(Index : integer) : TNode; + protected + FNode : TDOMNode; + FChildren : TStringList; + public + constructor Create(Node : TDOMNode); virtual; + destructor Destroy; override; + procedure Start; virtual; + procedure Middle; virtual; + procedure Ends; virtual; + property Count : integer read GetCount; + property Nodes[Index : integer] : TNode read GetNode; + end; + TClassess = class; + TDocument = class(TNode) + private + function GetClasses(Index : integer) : TClassess; + protected + public + constructor Create(Node : TDOMNode); override; + procedure Start; override; + procedure Middle; override; + procedure Ends; override; + property Classes[Index : integer] : TClassess read GetClasses; + end; + TClasse = class; + TClassess = class(TNode) + private + function GetClasse(Index : integer) : TClasse; + protected + public + constructor Create(Node : TDOMNode); override; + procedure Start; override; + procedure Middle; override; + procedure Ends; override; + property Classes[Index : integer] : TClasse read GetClasse; + end; + TNamedItem = class(TNode) + private + protected + function GetName : string; + public + property Name : string read GetName; + end; + TFunction = class; + TClasse = class(TNamedItem) + private + function GetFunction(Index : integer) : TFunction; + protected + function GetAncestor : string; + public + constructor Create(Node : TDOMNode); override; + procedure Start; override; + procedure Ends; override; + property Ancestor : string read GetAncestor; + property Functions[Index : integer] : TFunction read GetFunction; + end; + TResultType = class; + TParam = class; + TFunction = class(TNamedItem) + private + FResultType : TResultType; + FClasse : TClasse; + BodyPas : string; + function GetParam(Index : integer) : TParam; + protected + public + constructor Create(Node : TDOMNode); override; + destructor Destroy; override; + function IsConstructor : boolean; + function IsDestructor : boolean; + function HasParams : boolean; + function ProcName : string; + function ProcNameInObject : string; + function SelfParam : string; + function SelfParamImpl : string; + procedure Start; override; + procedure Ends; override; + property ResultType : TResultType read FResultType; + property Params[Index : integer] : TParam read GetParam; + property Classe : TClasse read FClasse; + end; + TTypedItem = class(TNamedItem) + private + protected + function GetType : string; + public + function IsObject : boolean; + property Typ : string read GetType; + end; + TParam = class(TTypedItem) + private + FFunction : TFunction; + protected + public + procedure Middle; override; + property ParentFunction : TFunction read FFunction; + end; + TResultType = class(TNode) + private + protected + function GetType : string; + public + property Typ : string read GetType; + end; + +implementation + +uses + sourcewrite, typmap; + +// Debug proc +procedure NodeInfo(Node : TDOMNode); +begin + WriteLn(Node.NodeName + ',' + Node.NodeValue + ',' + IntToStr(Node.NodeType)); +end; + +constructor TNode.Create(Node : TDOMNode); +begin + inherited Create; + FNode := Node; +end; + +destructor TNode.Destroy; +var + i : integer; +begin + if FChildren <> nil then + begin + for i := 0 to FChildren.Count - 1 do + begin + if FChildren.Objects[i] <> nil then + FChildren.Objects[i].Free; + end; + FChildren.Free; + end; + inherited; +end; + +function TNode.GetCount : integer; +begin + if FChildren <> nil then + Result := FChildren.Count + else + Result := 0; +end; + +function TNode.GetNode(Index : integer) : TNode; +begin + Result := FChildren.Objects[Index] as TNode; +end; + +procedure TNode.Start; +begin + Write('Start : '); + if FNode <> nil then + NodeInfo(FNode); +end; + +procedure TNode.Middle; +var + i : integer; +begin + Write('Middle : '); + if FNode <> nil then + begin + NodeInfo(FNode); + for i := 0 to Count - 1 do + begin + Nodes[i].Start; + Nodes[i].Middle; + Nodes[i].Ends; + end; + end; +end; + +procedure TNode.Ends; +begin + Write('Ends : '); + if FNode <> nil then + NodeInfo(FNode); +end; + +constructor TDocument.Create(Node : TDOMNode); +var + i : integer; + aClasses : TClassess; + List : TStringList; +begin + if Node.HasChildNodes then + begin + List := TStringList.Create; + for i := 0 to Node.ChildNodes.count - 1 do + begin + aClasses := TClassess.Create(Node.ChildNodes.Item[i]); + List.AddObject(IntToStr(i), aClasses); + end; + FChildren := List; + end; +end; + +function TDocument.GetClasses(Index : integer) : TClassess; +begin + Result := FChildren.Objects[Index] as TClassess; +end; + +procedure TDocument.Start; +begin +end; + +procedure TDocument.Middle; +var + i : integer; +begin + for i := 0 to Count - 1 do + begin + Classes[i].Start; + Classes[i].Middle; + Classes[i].Ends; + end; +end; + +procedure TDocument.Ends; +begin +end; + +constructor TClassess.Create(Node : TDOMNode); +var + i : integer; + aClasse : TClasse; + List : TStringList; +begin + inherited; + if Node.HasChildNodes then + begin + List := TStringList.Create; + for i := 0 to Node.ChildNodes.count - 1 do + begin + aClasse := TClasse.Create(Node.ChildNodes.Item[i]); + List.AddObject(aClasse.Name, aClasse); + end; + FChildren := List; + end; +end; + +function TClassess.GetClasse(Index : integer) : TClasse; +begin + Result := FChildren.Objects[Index] as TClasse; +end; + +function TNamedItem.GetName : string; +var + DomNode : TDOMNode; +begin + DomNode := FNode.Attributes.GetNamedItem('NAME'); + if DomNode <> nil then + begin + Result := DomNode.NodeValue; + end; +end; + +procedure TClassess.Start; +begin + SourceWriter.Pas.Add(''); +end; + +procedure TClassess.Middle; +var + i : integer; +begin + for i := 0 to Count - 1 do + begin + Nodes[i].Start; + Nodes[i].Middle; + Nodes[i].Ends; + end; +end; + +procedure TClassess.Ends; +begin +end; + +constructor TClasse.Create(Node : TDOMNode); +var + i : integer; + aFunc : TFunction; + List : TStringList; +begin + inherited; + if Node.HasChildNodes then + begin + List := TStringList.Create; + for i := 0 to Node.ChildNodes.count - 1 do + begin + aFunc := TFunction.Create(Node.ChildNodes.Item[i]); + aFunc.FClasse := Self; + WriteLn(aFunc.Name); + WriteLn(''); + List.AddObject(aFunc.Name, aFunc); + end; + FChildren := List; + end; +end; + +function TClasse.GetAncestor : string; +begin + if FNode.Attributes.GetNamedItem('ANCESTOR') <> nil then + Result := FNode.Attributes.GetNamedItem('ANCESTOR').NodeValue + else + Result := ''; +end; + +function TClasse.GetFunction(Index : integer) : TFunction; +begin + Result := FChildren.Objects[Index] as TFunction; +end; + +procedure TClasse.Start; +begin + with SourceWriter.InterfacePas do + begin + Add('type'); + Add(Format(' %s = class(%s)', [CppToPas(Name + ' *'), CppToPas(Ancestor + ' *')])); + Add(' private'); + Add(' public'); + end; +end; + +procedure TClasse.Ends; +begin + with SourceWriter.InterfacePas do + begin + Add(' end;'); + end; +end; + +constructor TFunction.Create(Node : TDOMNode); +var + i : integer; + aParam : TParam; + List : TStringList; +begin + inherited; + if Node.HasChildNodes then + begin + List := TStringList.Create; + for i := 0 to Node.ChildNodes.count - 1 do + begin + if Node.ChildNodes.Item[i].Attributes.GetNamedItem('NAME') <> nil then + begin + aParam := TParam.Create(Node.ChildNodes.Item[i]); + aParam.FFunction := Self; + WriteLn('Param : ' + aParam.Name + '; ' + 'Type : ' + aParam.Typ); + List.AddObject(aParam.Name, aParam); + end + else + begin + FResultType := TResultType.Create(Node.ChildNodes.Item[i]); + WriteLn('ResultType : ' + FResultType.Typ); + end; + end; + FChildren := List; + end; +end; + +destructor TFunction.Destroy; +begin + if Assigned(FResultType) then + FResultType.Free; + inherited; +end; + +function TFunction.IsConstructor : boolean; +begin + Result := (Name = Classe.Name); +end; + +function TFunction.IsDestructor : boolean; +begin + Result := (Name[1] = '~'); +end; + +function TFunction.GetParam(Index : integer) : TParam; +begin + Result := FChildren.Objects[Index] as TParam; +end; + +function TFunction.HasParams : boolean; +begin + Result := (Count > 0); +end; + +function TFunction.ProcName : string; +begin + if IsConstructor then + Result := 'Create' + else if IsDestructor then + Result := 'Free' + else + Result := Name; +end; + +function TFunction.ProcNameInObject : string; +begin + if IsConstructor then + Result := 'Create' + else if IsDestructor then + Result := 'Destroy' + else + Result := Name; +end; + +function TFunction.SelfParam : string; +begin + if IsConstructor then + Result := '(AObject : TBeObject; ' + else + Result := '(AObject : TCPlusObject; ' +end; + +function TFunction.SelfParamImpl : string; +begin + if IsConstructor then + Result := '(Self, ' + else + Result := '(CPlusObject, ' +end; + +procedure TFunction.Start; +var + EndChar : string; +begin + WriteLn('Function Start'); + if HasParams then + EndChar := '(' + else + EndChar := ''; + with SourceWriter.InterfacePas do + begin + if IsConstructor then + Add(Format(' constructor %s%s', [ProcNameInObject, EndChar])) + else if IsDestructor then + Add(Format(' destructor %s%s', [ProcNameInObject, EndChar])) + else if (ResultType.Typ = '') or (ResultType.Typ = 'void') then + Add(Format(' procedure %s%s', [Name, EndChar])) + else + Add(Format(' function %s%s', [Name, EndChar])); + end; + // Import of C functions + with SourceWriter.ImportFuncsPas do + begin + if ((ResultType.Typ = '') or (ResultType.Typ = 'void')) and + not IsConstructor then + Add(Format('procedure %s_%s%s', [Classe.Name, ProcName, SelfParam])) + else + Add(Format('function %s_%s%s', [Classe.Name, ProcName, SelfParam])); + end; + with SourceWriter.ImplementationPas do + begin + if (ResultType.Typ = '') or (ResultType.Typ = 'void') then + begin + if IsConstructor then + Add(Format('constructor %s.%s%s', [CppToPas(Classe.Name + ' *'), ProcNameInObject, EndChar])) + else if IsDestructor then + Add(Format('destructor %s.%s%s', [CppToPas(Classe.Name + ' *'), ProcNameInObject, EndChar])) + else + Add(Format('procedure %s.%s%s', [CppToPas(Classe.Name + ' *'), ProcName, EndChar])); + end + else + Add(Format('function %s.%s%s', [CppToPas(Classe.Name + ' *'), ProcName, EndChar])); + end; + // Implementation body + if IsConstructor then + BodyPas := Format(' CPlusObject := %s_%s%s', [Classe.Name, ProcName, SelfParamImpl]) + else if (ResultType.Typ = '') or (ResultType.Typ = 'void') then + BodyPas := Format(' %s_%s%s', [Classe.Name, ProcName, SelfParamImpl]) + else + BodyPas := Format(' Result := %s_%s%s', [Classe.Name, ProcName, SelfParamImpl]); +end; + +procedure TFunction.Ends; +var + EndChar : string; + procedure DeleteLastSep(List : TStringList); + var + s : string; + begin + // Delete the last '; ' + s := List.Strings[List.Count - 1]; + System.Delete(s, Length(s) - 1, 2); + List.Strings[List.Count - 1] := s; + end; + procedure AddLastSep(List : TStringList); + var + s : string; + begin + if not((ResultType.Typ = '') or (ResultType.Typ = 'void')) then + begin + WriteLn(ResultType.Typ); + WriteLn(Name); + s := Format('%s%s : %s;', [List.Strings[List.Count - 1], EndChar, CppToPas(ResultType.Typ)]); + List.Strings[List.Count - 1] := s; + end + else if IsConstructor then + begin + WriteLn(ResultType.Typ); + WriteLn(Name); + s := Format('%s%s;', [List.Strings[List.Count - 1], EndChar]); + List.Strings[List.Count - 1] := s; + end + else + List.Strings[List.Count - 1] := Format('%s%s;', [List.Strings[List.Count - 1], EndChar]); + end; +var + s : string; +begin + WriteLn('Function ends'); + if hasParams then + begin + EndChar := ')'; + DeleteLastSep(SourceWriter.InterfacePas); + end + else + begin + EndChar := ''; + end; + AddLastSep(SourceWriter.InterfacePas); + // Import C functions + EndChar := ')'; + DeleteLastSep(SourceWriter.ImportFuncsPas); + AddLastSep(SourceWriter.ImportFuncsPas); + with SourceWriter.ImportFuncsPas do + begin + s := Format('%s' + ImportFuncString, [Strings[Count - 1], Classe.Name, ProcName]); + Strings[Count - 1] := s; + end; + + if hasParams then + begin + EndChar := ')'; + DeleteLastSep(SourceWriter.ImplementationPas); + end + else + begin + EndChar := ''; + end; + AddLastSep(SourceWriter.ImplementationPas); + SourceWriter.ImplementationPas.Add('begin'); + System.Delete(BodyPas, Length(BodyPas) - 1, 2); + SourceWriter.ImplementationPas.Add(BodyPas + ');'); + SourceWriter.ImplementationPas.Add('end;'); + SourceWriter.ImplementationPas.Add(''); +end; + +function TTypedItem.GetType : string; +begin + Result := FNode.Attributes.GetNamedItem('TYPE').NodeValue; +end; + +function TTypedItem.IsObject : boolean; +begin + // The first letter is a 'B' -> this is an object ! + Result := (Typ[1] = 'B'); +end; + +procedure TParam.Middle; + procedure WriteParamImport(List : TStringList); + var + s : string; + begin + WriteLn('WriteParamImport'); + WriteLn(List.Strings[List.Count - 1]); + if IsObject then + begin + WriteLn('IsObject'); + s := Format('%s%s : %s; ', [List.Strings[List.Count - 1], Name, 'TCPlusObject']); + end + else + s := Format('%s%s : %s; ', [List.Strings[List.Count - 1], Name, CppToPas(Typ)]); + List.Strings[List.Count - 1] := s; + WriteLn(List.Strings[List.Count - 1]); + end; + procedure WriteParam(List : TStringList); + var + s : string; + begin + WriteLn(List.Strings[List.Count - 1]); + s := Format('%s%s : %s; ', [List.Strings[List.Count - 1], Name, CppToPas(Typ)]); + List.Strings[List.Count - 1] := s; + WriteLn(List.Strings[List.Count - 1]); + end; +begin + WriteLn('Param Middle'); + WriteParam(SourceWriter.InterfacePas); + WriteParamImport(SourceWriter.ImportFuncsPas); + WriteParam(SourceWriter.ImplementationPas); + if IsObject then + ParentFunction.BodyPas := Format('%s%s.CPlusObject, ', [ParentFunction.BodyPas, Name]) + else + ParentFunction.BodyPas := Format('%s%s, ', [ParentFunction.BodyPas, Name]); +end; + +function TResultType.GetType : string; +begin + Result := FNode.Attributes.GetNamedItem('TYPE').NodeValue; +end; + +end. diff --git a/bepascal/source/tools/codegen/pas/codegen.pp b/bepascal/source/tools/codegen/pas/codegen.pp new file mode 100644 index 0000000..cb881ea --- /dev/null +++ b/bepascal/source/tools/codegen/pas/codegen.pp @@ -0,0 +1,54 @@ +{ BePascal - A pascal wrapper around the BeOS API + Copyright (C) 2002 Olivier Coursiere + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} +program codegen; + +{$H+} // use AnsiStrings + +uses + dom, xmlread, apireader, typmap, codewrite, SysUtils; + +var + aDoc : TXMLDocument; + HooksDoc : TXMLDocument; + Classes, Hooks : TDocument; + SrcGen : TSourceGen; +begin + if ParamCount > 0 then + begin + ReadXMLFile(aDoc, Paramstr(1)); + ReadXMLFile(HooksDoc, 'hooks.xml'); + Classes := TDocument.Create(aDoc); + try + Hooks := TDocument.Create(HooksDoc); + try + SrcGen := TSourceGen.Create(Classes, Hooks, StringReplace(Paramstr(1), '.xml', '', [])); + try + SrcGen.Gen; + WriteLn('After gen'); + finally + SrcGen.Free; + end; + finally + Hooks.Free; + end; + finally + Classes.Free; + end; + end; + +end. diff --git a/bepascal/source/tools/codegen/pas/codewrite.pp b/bepascal/source/tools/codegen/pas/codewrite.pp new file mode 100644 index 0000000..caec720 --- /dev/null +++ b/bepascal/source/tools/codegen/pas/codewrite.pp @@ -0,0 +1,80 @@ +{ BePascal - A pascal wrapper around the BeOS API + Copyright (C) 2002 Olivier Coursiere + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +unit codewrite; + +interface + +{$H+} // use AnsiStrings + +uses + Classes, SysUtils, apireader, sourcewrite; + +type + TSourceGen = class(TObject) + private + FClasses : TDocument; + FHooks : TDocument; + protected + procedure Enum(Node : TNode); + public + constructor Create(Classes, Hooks : TDocument; FileName : string); virtual; + destructor Destroy; override; + procedure Gen; + end; + +implementation + +constructor TSourceGen.Create(Classes, Hooks : TDocument; FileName : string); +begin + inherited Create; + FClasses := Classes; + FHooks := Hooks; + SourceWriter := TSourceWriter.Create(FileName); +end; + +destructor TSourceGen.Destroy; +begin + SourceWriter.Free; + inherited; +end; + +procedure TSourceGen.Gen; +begin + Enum(FClasses); +end; + +procedure TSourceGen.Enum(Node : TNode); +var + i : integer; +begin + if Node <> nil then + begin + for i := 0 to Node.Count - 1 do + begin + Node.Start; + WriteLn('Before Enum'); + Node.Middle; + WriteLn('After enum'); + Node.Ends; + end; + end; +end; + + +end. diff --git a/bepascal/source/tools/codegen/pas/sourcewrite.pp b/bepascal/source/tools/codegen/pas/sourcewrite.pp new file mode 100644 index 0000000..5f580e3 --- /dev/null +++ b/bepascal/source/tools/codegen/pas/sourcewrite.pp @@ -0,0 +1,140 @@ +{ BePascal - A pascal wrapper around the BeOS API + Copyright (C) 2002 Olivier Coursiere + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +unit sourcewrite; + +{$H+} // use AnsiStrings + +interface + +uses + SysUtils, Classes, apireader; + +const + Eol = #10; + CLicense = +'/* BePascal - A pascal wrapper around the BeOS API ' + Eol + +' Copyright (C) 2002 Olivier Coursiere ' + Eol + +' Eric Jourde ' + Eol + +' ' + Eol + +' This library is free software; you can redistribute it and/or ' + Eol + +' modify it under the terms of the GNU Library General Public ' + Eol + +' License as published by the Free Software Foundation; either ' + Eol + +' version 2 of the License, or (at your option) any later version. ' + Eol + +' ' + Eol + +' This library is distributed in the hope that it will be useful, ' + Eol + +' but WITHOUT ANY WARRANTY; without even the implied warranty of ' + Eol + +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ' + Eol + +' Library General Public License for more details. ' + Eol + +' ' + Eol + +' You should have received a copy of the GNU Library General Public ' + Eol + +' License along with this library; if not, write to the Free ' + Eol + +' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ' + Eol + +'*/ '; + PasLicense = +'{ BePascal - A pascal wrapper around the BeOS API ' + Eol + +' Copyright (C) 2002 Olivier Coursiere ' + Eol + +' Eric Jourde ' + Eol + +' ' + Eol + +' This library is free software; you can redistribute it and/or ' + Eol + +' modify it under the terms of the GNU Library General Public ' + Eol + +' License as published by the Free Software Foundation; either ' + Eol + +' version 2 of the License, or (at your option) any later version. ' + Eol + +' ' + Eol + +' This library is distributed in the hope that it will be useful, ' + Eol + +' but WITHOUT ANY WARRANTY; without even the implied warranty of ' + Eol + +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ' + Eol + +' Library General Public License for more details. ' + Eol + +' ' + Eol + +' You should have received a copy of the GNU Library General Public ' + Eol + +' License along with this library; if not, write to the Free ' + Eol + +' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ' + Eol + +'} '; + +type + TSourceWriter = class(TObject) + private + FH : TStringList; + FCpp : TStringList; + FPas : TStringList; + FFileName : string; + FHooks : TDocument; + FInterfacePas : TStringList; + FImplementationPas : TStringList; + FImportFuncsPas : TStringList; + public + constructor Create(FileName : string); virtual; + destructor Destroy; override; + property H : TStringList read FH; + property Cpp : TStringList read FCpp; + property Pas : TStringList read FPas; + property Hooks : TDocument read FHooks write FHooks; + property InterfacePas : TStringList read FInterfacePas; + property ImplementationPas : TStringList read FImplementationPas; + property ImportFuncsPas : TStringList read FImportFuncsPas; + end; + +var + SourceWriter : TSourceWriter; + +implementation + +constructor TSourceWriter.Create(FileName : string); +begin + inherited Create; + FFileName := FileName; + FH := TStringList.Create; + FH.Add(CLicense); + FCpp := TStringList.Create; + FCpp.Add(CLicense); + FPas := TStringList.Create; + FPas.Add(PasLicense); + FPas.Add('unit ' + LowerCase(FFileName) + ';'); + FPas.Add(''); + FPas.Add('interface'); + FPas.Add(''); + FPas.Add('uses'); + FPas.Add(' beobj;'); + FInterfacePas := TStringList.Create; + FImplementationPas := TStringList.Create; + FImportFuncsPas := TStringList.Create; +end; + +destructor TSourceWriter.Destroy; +begin + // Writing files + FH.SaveToFile(FFileName + '.h'); + FH.Free; + FCpp.SaveToFile(FFileName + '.cpp'); + FCpp.Free; + FPas.Add(FInterfacePas.Text); + FPas.Add(FImportFuncsPas.Text); + FPas.Add('implementation'); + FPas.Add(''); + FPas.Add(FImplementationPas.Text); + // write the end of pascal unit + FPas.Add('end.'); + FPas.SaveToFile(LowerCase(FFileName) + '.pp'); + FPas.Free; + FInterfacePas.Free; + FImplementationPas.Free; + FImportFuncsPas.Free; + inherited; +end; + +end. diff --git a/bepascal/source/tools/codegen/pas/typmap.pp b/bepascal/source/tools/codegen/pas/typmap.pp new file mode 100644 index 0000000..83fa180 --- /dev/null +++ b/bepascal/source/tools/codegen/pas/typmap.pp @@ -0,0 +1,51 @@ +unit typmap; + +interface + +uses + SysUtils, Classes; + +function CppToPas(CppType : string) : string; +function PasToCpp(PasType : string) : string; + +implementation + +const + TypMapFileName = 'typemap.txt'; +var + aTypMap : TStringList; + NewTypMap : TStringList; + +function CppToPas(CppType : string) : string; +var + i : integer; +begin + Result := aTypMap.Values[CppType]; + if Result = '' then + begin + if not NewTypMap.Find(CppType + '=', i) then + NewTypMap.Add(CppType + '='); + end; +end; + +function PasToCpp(PasType : string) : string; +begin + // To implement if necessary + Result := ''; +end; + +initialization + aTypMap := TStringList.Create; + aTypMap.LoadFromFile(TypMapFileName); + aTypMap.Sorted := True; + NewTypMap := TStringList.Create; + NewTypMap.Sorted := True; + +finalization +// WriteLn(aTypMap.Text); + aTypMap.SaveToFile(TypMapFileName); + aTypMap.Free; + NewTypMap.SaveToFile(TypMapFileName + '.new'); + NewTypMap.Free; + +end.