Merge pull request #211 from Dgby714/master

Fix for simba crash when compiling Lape scripts.

Units/MMLAddon/LPInc/Classes/MML/lptclient.pas

@@ -141,17 +141,17 @@ procedure Register_TClient(Compiler: TLapeCompiler);
 begin
   with Compiler do
   begin
-    addClass(Compiler, 'TClient', 'TObject');
+    addClass('TClient');
 
     addGlobalType('procedure(s: string)', 'TWriteLnProc');
 
-    addClassVar(Compiler, 'TClient', 'IOManager', 'TIOManager', @TClient_IOManager_Read, @TClient_IOManager_Write);
-    addClassVar(Compiler, 'TClient', 'MFiles', 'TMFiles', @TClient_MFiles_Read, @TClient_MFiles_Write);
-    addClassVar(Compiler, 'TClient', 'MFinder', 'TMFinder', @TClient_MFinder_Read, @TClient_MFinder_Write);
-    addClassVar(Compiler, 'TClient', 'MBitmaps', 'TMBitmaps', @TClient_MBitmaps_Read, @TClient_MBitmaps_Write);
-    addClassVar(Compiler, 'TClient', 'MDTMs', 'TMDTMS', @TClient_MDTMs_Read, @TClient_MDTMs_Write);
-    addClassVar(Compiler, 'TClient', 'MOCR', 'TMOCR', @TClient_MOCR_Read, @TClient_MOCR_Write);
-    addClassVar(Compiler, 'TClient', 'WriteLnProc', 'TWriteLnProc', @TClient_WritelnProc_Read, @TClient_WritelnProc_Write);
+    addClassVar('TClient', 'IOManager', 'TIOManager', @TClient_IOManager_Read, @TClient_IOManager_Write);
+    addClassVar('TClient', 'MFiles', 'TMFiles', @TClient_MFiles_Read, @TClient_MFiles_Write);
+    addClassVar('TClient', 'MFinder', 'TMFinder', @TClient_MFinder_Read, @TClient_MFinder_Write);
+    addClassVar('TClient', 'MBitmaps', 'TMBitmaps', @TClient_MBitmaps_Read, @TClient_MBitmaps_Write);
+    addClassVar('TClient', 'MDTMs', 'TMDTMS', @TClient_MDTMs_Read, @TClient_MDTMs_Write);
+    addClassVar('TClient', 'MOCR', 'TMOCR', @TClient_MOCR_Read, @TClient_MOCR_Write);
+    addClassVar('TClient', 'WriteLnProc', 'TWriteLnProc', @TClient_WritelnProc_Read, @TClient_WritelnProc_Write);
     addGlobalFunc('procedure TClient.WriteLn(s : string);', @TClient_WriteLn);
     addGlobalFunc('procedure TClient.Init(const plugin_dir: string = ''''; const UseIOManager: TIOManager = nil);', @TClient_Init);
     addGlobalFunc('procedure TClient.Free();', @TClient_Free);

Units/MMLAddon/LPInc/Classes/MML/lptiomanager_abstract.pas

@@ -304,7 +304,7 @@ procedure Register_TIOManager_Abstract(Compiler: TLapeCompiler);
 begin
   with Compiler do
   begin
-    addClass(Compiler, 'TIOManager_Abstract', 'TObject');
+    addClass('TIOManager_Abstract');
 
     //addGlobalFunc('procedure TIOManager_Abstract.Init(); overload;', @TIOManager_Abstract_Init);
     //addGlobalFunc('procedure TIOManager_Abstract.Init(plugin_dir: string); overload;', @TIOManager_Abstract_InitEx);

Units/MMLAddon/LPInc/Classes/MML/lptiomanager_windows.pas

@@ -66,7 +66,7 @@ procedure Register_TIOManager(Compiler: TLapeCompiler);
 begin
   with Compiler do
   begin
-    addClass(Compiler, 'TIOManager', 'TIOManager_Abstract');
+    addClass('TIOManager', 'TIOManager_Abstract');
 
     addGlobalType('UInt32', 'TNativeWindow');
 

Units/MMLAddon/LPInc/Classes/MML/lptmbitmaps.pas

@@ -97,7 +97,7 @@ procedure Register_TMBitmaps(Compiler: TLapeCompiler);
 begin
   with Compiler do
   begin
-    addClass(Compiler, 'TMBitmaps', 'TObject');
+    addClass('TMBitmaps');
 
     addGlobalFunc('function TMBitmaps.GetBMP(Index : integer): TMufasaBitmap;', @TMBitmaps_GetBMP);
     addGlobalFunc('function TMBitmaps.CreateBMP(w, h: integer): Integer;', @TMBitmaps_CreateBMP);

Units/MMLAddon/LPInc/Classes/MML/lptmdtm.pas

@@ -139,14 +139,14 @@ procedure Register_TMDTM(Compiler: TLapeCompiler);
 begin
   with Compiler do
   begin
-    addClass(Compiler, 'TMDTM', 'TObject');
+    addClass('TMDTM');
 
     addGlobalType('record x, y, c, t, asz: integer; bp: boolean; end;', 'TMDTMPoint');
     addGlobalType('^TMDTMPoint', 'PMDTMPoint');
     addGlobalType('array of TMDTMPoint;', 'TMDTMPointArray');
 
-    addClassVar(Compiler, 'TMDTM', 'Name', 'string', @TMDTM_Name_Read, @TMDTM_Name_Write);
-    addClassVar(Compiler, 'TMDTM', 'Index', 'integer', @TMDTM_Index_Read, @TMDTM_Index_Write);
+    addClassVar('TMDTM', 'Name', 'string', @TMDTM_Name_Read, @TMDTM_Name_Write);
+    addClassVar('TMDTM', 'Index', 'integer', @TMDTM_Index_Read, @TMDTM_Index_Write);
     addGlobalFunc('function TMDTM.ToString(): string;', @TMDTM_ToString);
     addGlobalFunc('function TMDTM.SaveToFile(const FileName : string): boolean;', @TMDTM_SaveToFile);
     addGlobalFunc('function TMDTM.LoadFromString(const s : string): boolean;', @TMDTM_LoadFromString);
@@ -156,9 +156,9 @@ procedure Register_TMDTM(Compiler: TLapeCompiler);
     addGlobalFunc('procedure TMDTM.SwapPoint(p1, p2: integer);', @TMDTM_SwapPoint);
     addGlobalFunc('procedure TMDTM.MovePoint(fromIndex, toIndex: integer);', @TMDTM_MovePoint);
     addGlobalFunc('function TMDTM.AddPoint(Point: TMDTMPoint): integer;', @TMDTM_AddPoint);
-    addClassVar(Compiler, 'TMDTM', 'PPoints', 'PMDTMPoint', @TMDTM_PPoints_Read, nil);
-    addClassVar(Compiler, 'TMDTM', 'Count', 'integer', @TMDTM_Count_Read, @TMDTM_Count_Write);
-    addClassVar(Compiler, 'TMDTM', 'Points', 'TMDTMPointArray', @TMDTM_Points_Read, nil);
+    addClassVar('TMDTM', 'PPoints', 'PMDTMPoint', @TMDTM_PPoints_Read);
+    addClassVar('TMDTM', 'Count', 'integer', @TMDTM_Count_Read, @TMDTM_Count_Write);
+    addClassVar('TMDTM', 'Points', 'TMDTMPointArray', @TMDTM_Points_Read);
     addGlobalFunc('procedure TMDTM.Init();', @TMDTM_Init);
     addGlobalFunc('procedure TMDTM.Free();', @TMDTM_Free);
   end;

Units/MMLAddon/LPInc/Classes/MML/lptmdtms.pas

@@ -74,7 +74,7 @@ procedure Register_TMDTMS(Compiler: TLapeCompiler);
 begin
   with Compiler do
   begin
-    addClass(Compiler, 'TMDTMS', 'TObject');
+    addClass('TMDTMS');
 
     addGlobalType('record x, y, Color, Tolerance, AreaSize, AreaShape: UInt32; end;', 'TSDTMPointDef');
     addGlobalType('array of TSDTMPointDef;', 'TSDTMPointDefArray');

Units/MMLAddon/LPInc/Classes/MML/lptmfiles.pas

@@ -159,10 +159,10 @@ procedure Register_TMFiles(Compiler: TLapeCompiler);
 begin
   with Compiler do
   begin
-    addClass(Compiler, 'TMFiles', 'TObject');
+    addClass('TMFiles');
 
-    //addClassVar(Compiler, 'TMFiles', 'OpenFileEvent', 'TOpenFileEvent', @TMFiles_OpenFileEvent_Read, @TMFiles_OpenFileEvent_Write);
-    //addClassVar(Compiler, 'TMFiles', 'WriteFileEvent', 'TWriteFileEvent', @TMFiles_WriteFileEvent_Read, @TMFiles_WriteFileEvent_Write);
+    //addClassVar('TMFiles', 'OpenFileEvent', 'TOpenFileEvent', @TMFiles_OpenFileEvent_Read, @TMFiles_OpenFileEvent_Write);
+    //addClassVar('TMFiles', 'WriteFileEvent', 'TWriteFileEvent', @TMFiles_WriteFileEvent_Read, @TMFiles_WriteFileEvent_Write);
 
     addGlobalFunc('function TMFiles.CreateFile(Path: string): Integer;', @TMFiles_CreateFile);
     addGlobalFunc('function TMFiles.OpenFile(Path: string; Shared: Boolean): Integer;', @TMFiles_OpenFile);

Units/MMLAddon/LPInc/Classes/MML/lptmfinder.pas

@@ -273,13 +273,13 @@ procedure Register_TMFinder(Compiler: TLapeCompiler);
 begin
   with Compiler do
   begin
-    addClass(Compiler, 'TMFinder', 'TObject');
+    addClass('TMFinder');
 
     addGlobalType('Pointer', 'TCTSInfo');
     addGlobalType('array of TCTSInfo', 'TCTSInfoArray');
     addGlobalType('array of TCTSInfoArray', 'TCTSInfo2DArray');
 
-    addClassVar(Compiler, 'TMFinder', 'WarnOnly', 'boolean', @TMFinder_WarnOnly_Read, @TMFinder_WarnOnly_Write);
+    addClassVar('TMFinder', 'WarnOnly', 'boolean', @TMFinder_WarnOnly_Read, @TMFinder_WarnOnly_Write);
     addGlobalFunc('procedure TMFinder.DefaultOperations(var xs,ys,xe,ye : integer);', @TMFinder_DefaultOperations);
     addGlobalFunc('function TMFinder.CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;', @TMFinder_CountColorTolerance);
     addGlobalFunc('function TMFinder.CountColor(Color, xs, ys, xe, ye: Integer): Integer;', @TMFinder_CountColor);

Units/MMLAddon/LPInc/Classes/MML/lptmfont.pas

@@ -66,14 +66,14 @@ procedure Register_TMFont(Compiler: TLapeCompiler);
 begin
   with Compiler do
   begin
-    addClass(Compiler, 'TMFont', 'TObject');
+    addClass('TMFont');
 
     addGlobalType('record xoff, yoff, width, height, index: Int32; inited: boolean; end;', 'TOCRGlyphMetric');
     addGlobalType('record ascii: array[0..255] of TOCRGlyphMetric; pos: T2DIntegerArray; pos_adj: array of Double; neg: T2DIntegerArray; neg_adj: array of Double; map: array of char; width, height, max_width, max_height, inputs, outputs: integer; end;', 'TOCRData');
     addGlobalType('array of TOCRData', 'TOCRDataArray');
 
-    addClassVar(Compiler, 'TMFont', 'Name', 'String', @TMFont_Name_Read, @TMFont_Name_Write);
-    addClassVar(Compiler, 'TMFont', 'Data', 'TOcrData', @TMFont_Data_Read, @TMFont_Data_Write);
+    addClassVar('TMFont', 'Name', 'String', @TMFont_Name_Read, @TMFont_Name_Write);
+    addClassVar('TMFont', 'Data', 'TOcrData', @TMFont_Data_Read, @TMFont_Data_Write);
     addGlobalFunc('procedure TMFont.Init();', @TMFont_Init);
     addGlobalFunc('function TMFont.Copy(): TMFont;', @TMFont_Copy);
     addGlobalFunc('procedure TMFont.Free();', @TMFont_Free);

Units/MMLAddon/LPInc/Classes/MML/lptmfonts.pas

@@ -86,7 +86,7 @@ procedure Register_TMFonts(Compiler: TLapeCompiler);
 begin
   with Compiler do
   begin
-    addClass(Compiler, 'TMFonts', 'TObject');
+    addClass('TMFonts');
 
     addGlobalFunc('procedure TMFonts.Init(Owner : TObject);', @TMFonts_Init);
     addGlobalFunc('function TMFonts.GetFont(const Name: String): TOcrData;', @TMFonts_GetFont);
@@ -95,7 +95,7 @@ procedure Register_TMFonts(Compiler: TLapeCompiler);
     addGlobalFunc('function TMFonts.LoadSystemFont(const SysFont : TFont; const FontName : string): boolean;', @TMFonts_LoadSystemFont);
     addGlobalFunc('function TMFonts.Copy(Owner : TObject): TMFonts;', @TMFonts_Copy);
     addGlobalFunc('function TMFonts.Count(): integer;', @TMFonts_Count);
-    addClassVar(Compiler, 'TMFonts', 'Path', 'string', @TMFonts_Path_Read, @TMFonts_Path_Write);
+    addClassVar('TMFonts', 'Path', 'string', @TMFonts_Path_Read, @TMFonts_Path_Write);
     addGlobalFunc('procedure TMFonts.Free();', @TMFonts_Free);
   end;
 end;

Units/MMLAddon/LPInc/Classes/MML/lptmocr.pas

@@ -157,7 +157,7 @@ procedure Register_TMOCR(Compiler: TLapeCompiler);
 begin
   with Compiler do
   begin
-    addClass(Compiler, 'TMOCR', 'TObject');
+    addClass('TMOCR');
 
     addGlobalFunc('procedure TMOCR.Init(Owner: TObject);', @TMOCR_Init);
     addGlobalFunc('function TMOCR.InitTOCR(const path: string): boolean;', @TMOCR_InitTOCR);
@@ -178,7 +178,7 @@ procedure Register_TMOCR(Compiler: TLapeCompiler);
     addGlobalFunc('function TMOCR.TextToFontTPA(Text, font: String; out w, h: integer): TPointArray;', @TMOCR_TextToFontTPA);
     addGlobalFunc('function TMOCR.TextToFontBitmap(Text, font: String): TMufasaBitmap;', @TMOCR_TextToFontBitmap);
     addGlobalFunc('function TMOCR.TextToMask(Text, font: String): TMask;', @TMOCR_TextToMask);
-    addClassVar(Compiler, 'TMOCR', 'Fonts', 'TMFonts', @TMOCR_Fonts_Read, @TMOCR_Fonts_Write);
+    addClassVar('TMOCR', 'Fonts', 'TMFonts', @TMOCR_Fonts_Read, @TMOCR_Fonts_Write);
     addGlobalFunc('procedure TMOCR.Free();', @TMOCR_Free);
   end;
 end;

Units/MMLAddon/LPInc/Classes/MML/lptmufasabitmap.pas

@@ -419,7 +419,7 @@ procedure Register_TMufasaBitmap(Compiler: TLapeCompiler);
 begin
   with Compiler do
   begin
-    addClass(Compiler, 'TMufasaBitmap', 'TObject');
+    addClass('TMufasaBitmap');
 
     addGlobalType('packed record B, G, R: UInt32; end;', 'TRGB24');
     addGlobalType('^TRGB24', 'PRGB24');
@@ -436,13 +436,13 @@ procedure Register_TMufasaBitmap(Compiler: TLapeCompiler);
     addGlobalType('array of array of THSL', 'T2DHSLArray');
     addGlobalType('^T2DHSLArray', 'P2DHSLArray');
 
-    addClassVar(Compiler, 'TMufasaBitmap', 'Data', 'PRGB32', @TMufasaBitmap_FData_Read, @TMufasaBitmap_FData_Write);
-    addClassVar(Compiler, 'TMufasaBitmap', 'Name', 'string', @TMufasaBitmap_Name_Read, @TMufasaBitmap_Name_Write);
-    addClassVar(Compiler, 'TMufasaBitmap', 'Index', 'integer', @TMufasaBitmap_Index_Read, @TMufasaBitmap_Index_Write);
+    addClassVar('TMufasaBitmap', 'Data', 'PRGB32', @TMufasaBitmap_FData_Read, @TMufasaBitmap_FData_Write);
+    addClassVar('TMufasaBitmap', 'Name', 'string', @TMufasaBitmap_Name_Read, @TMufasaBitmap_Name_Write);
+    addClassVar('TMufasaBitmap', 'Index', 'integer', @TMufasaBitmap_Index_Read, @TMufasaBitmap_Index_Write);
     addGlobalFunc('procedure TMufasaBitmap.SetSize(AWidth,AHeight : integer);', @TMufasaBitmap_SetSize);
     addGlobalFunc('procedure TMufasaBitmap.StretchResize(AWidth,AHeight : integer);', @TMufasaBitmap_StretchResize);
-    addClassVar(Compiler, 'TMufasaBitmap', 'Width', 'Integer', @TMufasaBitmap_Width_Read, nil);
-    addClassVar(Compiler, 'TMufasaBitmap', 'Height', 'Integer', @TMufasaBitmap_Height_Read, nil);
+    addClassVar('TMufasaBitmap', 'Width', 'Integer', @TMufasaBitmap_Width_Read);
+    addClassVar('TMufasaBitmap', 'Height', 'Integer', @TMufasaBitmap_Height_Read);
     addGlobalFunc('procedure TMufasaBitmap.SetPersistentMemory(mem: PtrUInt; awidth, aheight: integer);', @TMufasaBitmap_SetPersistentMemory);
     addGlobalFunc('procedure TMufasaBitmap.ResetPersistentMemory();', @TMufasaBitmap_ResetPersistentMemory);
     addGlobalFunc('function TMufasaBitmap.PointInBitmap(x,y : integer): boolean;', @TMufasaBitmap_PointInBitmap);
@@ -492,9 +492,9 @@ procedure Register_TMufasaBitmap(Compiler: TLapeCompiler);
     addGlobalFunc('function TMufasaBitmap.CreateTMask(): TMask;', @TMufasaBitmap_CreateTMask);
     addGlobalFunc('procedure TMufasaBitmap.SetTransparentColor(Col : TColor);', @TMufasaBitmap_SetTransparentColor);
     addGlobalFunc('function TMufasaBitmap.GetTransparentColor(): TColor;', @TMufasaBitmap_GetTransparentColor);
-    addClassVar(Compiler, 'TMufasaBitmap', 'TransparentColorSet', 'boolean', @TMufasaBitmap_TransparentColorSet_Read, nil);
+    addClassVar('TMufasaBitmap', 'TransparentColorSet', 'boolean', @TMufasaBitmap_TransparentColorSet_Read, nil);
     addGlobalFunc('procedure TMufasaBitmap.SetAlphaValue(const value : byte);', @TMufasaBitmap_SetAlphaValue);
-    addClassVar(Compiler, 'TMufasaBitmap', 'List', 'TObject', @TMufasaBitmap_List_Read, @TMufasaBitmap_List_Write);
+    addClassVar('TMufasaBitmap', 'List', 'TObject', @TMufasaBitmap_List_Read, @TMufasaBitmap_List_Write);
     addGlobalFunc('procedure TMufasaBitmap.Init(List: TObject = nil);', @TMufasaBitmap_Init);
     addGlobalFunc('procedure TMufasaBitmap.Free();', @TMufasaBitmap_Free);
   end;

Units/MMLAddon/LPInc/Classes/MML/lptobject.pas

@@ -34,7 +34,7 @@ procedure Register_TObject(Compiler: TLapeCompiler);
 begin
   with Compiler do
   begin
-    addClass(Compiler, 'TObject', 'Pointer');
+    addClass('TObject', 'Pointer');
 
     addGlobalFunc('procedure TObject.Init();', @TObject_Init);
     addGlobalFunc('procedure TObject.Free();', @TObject_Free);

Units/MMLAddon/LPInc/Classes/MML/lpttarget.pas

@@ -188,7 +188,7 @@ procedure Register_TTarget(Compiler: TLapeCompiler);
 begin
   with Compiler do
   begin
-    addClass(Compiler, 'TTarget', 'TObject');
+    addClass('TTarget');
 
     addGlobalType('record Ptr: PRGB32; IncPtrWith: integer; RowLen: integer; end;', 'TRetData');
 

Units/MMLAddon/LPInc/Classes/lpclasshelper.pas

@@ -8,42 +8,27 @@ interface
 uses
   Classes, SysUtils, lpcompiler, lptypes, lpvartypes;
 
-procedure addClass(const Compiler: TLapeCompiler; const Name: string; const Parent: string = 'TObject');
-procedure addClassVar(const Compiler: TLapeCompiler; const Obj, Item, Typ: string; const Read: Pointer; const Write: Pointer = nil);
+type
+  TLapeCompilerHelper = class helper for TLapeCompiler
+  public
+    procedure addClass(const Name: string; const Parent: string = 'TObject');
+    procedure addClassVar(const Obj, Item, Typ: string; const Read: Pointer; const Write: Pointer = nil);
+  end;
 
 implementation
 
-procedure addClass(const Compiler: TLapeCompiler; const Name: string; const Parent: string = 'TObject');
-var
-  ParentType, ClassType: TLapeType;
+procedure TLapeCompilerHelper.addClass(const Name: string; const Parent: string = 'TObject');
 begin
-  {$IFDEF SIMBA_VERBOSE}
-  WriteLn(Format('Creating type "%s" from "%s".', [Name, Parent]));
-  {$ENDIF}
-
-  ParentType := Compiler.getGlobalType(Parent);
-  if (not Assigned(ParentType)) then
-    ParentType := Compiler.getBaseType(Parent);
-    if (not Assigned(ParentType)) then
-      raise Exception.CreateFmt('Invalid Type "%s".', [Parent]);
-
-  ClassType := ParentType.CreateCopy(True);
-  if (not Assigned(ClassType)) then
-    raise Exception.CreateFmt('Problem creating copy of type "%s".', [Parent]);
-
-  Compiler.addGlobalType(ClassType, Name);
+  addGlobalType(Format('type %s', [Parent]), Name);
 end;
 
-procedure addClassVar(const Compiler: TLapeCompiler; const Obj, Item, Typ: string; const Read: Pointer; const Write: Pointer = nil);
+procedure TLapeCompilerHelper.addClassVar(const Obj, Item, Typ: string; const Read: Pointer; const Write: Pointer = nil);
 begin
-  with Compiler do
-  begin
-    if (Assigned(Read)) then
-      addGlobalFunc(format('function %s.get%s(): %s;', [Obj, Item, Typ]), Read);
+  if (Assigned(Read)) then
+    addGlobalFunc(Format('function %s.get%s(): %s;', [Obj, Item, Typ]), Read);
 
-    if (Assigned(Write)) then
-      addGlobalFunc(format('procedure %s.set%s(const value: %s);', [Obj, Item, Typ]), Write);
-  end;
+  if (Assigned(Write)) then
+    addGlobalFunc(Format('procedure %s.set%s(const value: %s);', [Obj, Item, Typ]), Write);
 end;
 
 end.