|
|
| Line 104: |
Line 104: |
| | == Hardening trinity == | | == Hardening trinity == |
| | | | |
| − | In order to circumvent some of the inconsistencies and incompatibilities, i needed a solution without tempering with the RTL and/or support units. | + | In order to circumvent some of the inconsistencies and incompatibilities, there was need for a solution without tempering with the RTL and/or default support units. |
| | | | |
| − | So, i invented unit trinity which solves some of the encountered issues (the unit itself is a work in progress). Whether or not it is the right solution to solve things, i don't know. But, i also don't care as things simply needed to be compiled *period*.
| + | That's were unit trinity comes into play, which solves some of the encountered issues (the unit itself is a work in progress). It provides the user with a way to solve things and let sources compile without too much hassle/workarounds. |
| | | | |
| − | Without further ado: Unit Trinity
| + | The latest version of unit trinity is kindly provided by Magorium and can be found [https://github.com/magorium/fpc-triforce/tree/master/Base/Trinity here]. |
| − | | |
| − | <source lang="pascal">
| |
| − | unit trinity; | |
| − | | |
| − | | |
| − | // ---------------------------------------------------------------------------
| |
| − | // Edit Date $ Entry
| |
| − | // ---------------------------------------------------------------------------
| |
| − | // 2015-08-22 $ CoerceMethod()
| |
| − | // $ GetAttr()
| |
| − | // 2015-08-21 $ SetAndTest Longint version
| |
| − | // 2015-08-11 $ SetAttrs()
| |
| − | // $ additional TAG_() functions for Amiga
| |
| − | // $ additional TAG_() functions for MorphOS
| |
| − | // $ array of const for Amiga's DoMethod() instead of LW's
| |
| − | // $ workaround "Conversion between ordinals and pointers
| |
| − | // is not portable" hint messages
| |
| − | // $ Useful MUI text macro's
| |
| − | // 2015-08-06 $ initial release
| |
| − | // ---------------------------------------------------------------------------
| |
| − | | |
| − | | |
| − | {$IFNDEF HASAMIGA}
| |
| − | {$FATAL This source is compatible with Amiga, AROS and MorphOS only !}
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | {$MODE OBJFPC}{$H+}
| |
| − | | |
| − | | |
| − | interface
| |
| − | | |
| − | | |
| − | Uses
| |
| − | Exec, Intuition, Utility;
| |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: Some generic c-helpers, should not be in here at all but convienent
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | function SetAndTest(Var OldValue: pointer; NewValue: pointer) : boolean; overload; inline;
| |
| − | function SetAndTest(Var OldValue: LongWord; NewValue: LongWord): boolean; overload; inline;
| |
| − | function SetAndTest(Var OldValue: LongInt; NewValue: LongInt) : boolean; overload; inline;
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: Hooks -> cross-platform support
| |
| − | // | |
| − | ////////////////////////////////////////////////////////////////////////////// | |
| − | | |
| − | | |
| − | | |
| − | Type
| |
| − | // THookFunction = function(Hook: pHook; obj: PObject_; Msg: Pointer): LongWord;
| |
| − | THookFunction = function(Hook: pHook; obj: APTR; Msg: APTR): LongWord;
| |
| − | | |
| − | Procedure InitHook(Var Hook: THook; Func: THookFunction; Data: APTR);
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: Tags and TagValue's. Array of const = LongInt vs. Array of long
| |
| − | // Cosmetic only e.g. get rid of compiler warnings
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | {$IFDEF AROS}
| |
| − | Function TAG_(TagItem: LongWord): LongInt; overload; inline;
| |
| − | //Function TAG_(TagItem: LongInt ): LongInt; overload; inline;
| |
| − | Function TAG_(TagItem: Pointer ): LongInt; overload; inline;
| |
| − | function TAG_(TagItem: boolean ): LongInt; overload; inline;
| |
| − | {$ENDIF}
| |
| − | {$IFDEF AMIGA}
| |
| − | Function TAG_(TagItem: LongWord): LongInt; overload; inline;
| |
| − | //Function TAG_(TagItem: LongInt ): LongInt; overload; inline;
| |
| − | Function TAG_(TagItem: Pointer ): LongInt; overload; inline;
| |
| − | function TAG_(TagItem: boolean ): LongInt; overload; inline;
| |
| − | {$ENDIF}
| |
| − | {$IFDEF MORPHOS}
| |
| − | //Function TAG_(TagItem: LongWord): LongWord; overload; inline;
| |
| − | Function TAG_(TagItem: LongInt ): LongWord; overload; inline;
| |
| − | Function TAG_(TagItem: Pointer ): LongWord; overload; inline;
| |
| − | function TAG_(TagItem: boolean ): LongWord; overload; inline;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: SetGadgetAttrs(), missing from MorphOS
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | {$IFDEF MORPHOS}
| |
| − | function SetGadgetAttrs(Gadget: PGadget; Window: PWindow; Requester: PRequester; const Tags: array of long): ULONG;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: DoMethod()
| |
| − | // Amiga : Missing
| |
| − | // MorphOS : wrong parameter declaration
| |
| − | // ALL : missing none msg version
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | function DoMethod(obj : pointer; MethodID: ULONG): ULONG; overload;
| |
| − | {$IFDEF AMIGA}
| |
| − | function DoMethod(obj : pointer; MethodID: ULONG; const msg : array of const): ULONG; overload;
| |
| − | {$ENDIF}
| |
| − | {$IFDEF MORPHOS}
| |
| − | function DoMethod(obj : pointer; MethodID: ULONG; const msg : array of ULONG): ULONG; overload;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: DoSuperMethod()
| |
| − | // Amiga : Missing
| |
| − | // MorphOS + AROS : wrong parameter declaration
| |
| − | // ALL : missing none msg version
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | function DoSuperMethod(cl: pointer; obj : pointer; id: LongWord): LongWord; overload;
| |
| − | {$IF DEFINED(AMIGA) or DEFINED(MORPHOS) or DEFINED(AROS)}
| |
| − | function DoSuperMethod(cl: pointer; obj : pointer; id: LongWord; const msg : array of LongWord): longword; overload;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: Structure TWBArg, Missing from MorphOS because of lacking unit
| |
| − | // Workbench
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | {$IFDEF MORPHOS}
| |
| − | Type
| |
| − | PWBArg = ^TWBArg;
| |
| − | TWBArg = Record
| |
| − | wa_lock: BPTR; //* a lock descriptor */
| |
| − | wa_Name: PChar; //* a string relative to that lock */
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: Function SetAttrs(), this varargs version missing from Amiga & MOS
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | {$IFDEF AMIGA}
| |
| − | function SetAttrs(Obj: APTR; tagList: Array of Const): ULONG;
| |
| − | {$ENDIF}
| |
| − | {$IFDEF MORPHOS}
| |
| − | function SetAttrs(Obj: APTR; tagList: Array of DWord): ULONG;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: Useful MUI text macro's. Used other names to avoid conflicts.
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | const
| |
| − | Esc_R = #27#114; // right justified
| |
| − | Esc_C = #27#099; // centered
| |
| − | Esc_L = #27#108; // left justified
| |
| − | Esc_N = #27#110; // normal
| |
| − | Esc_B = #27#098; // bold
| |
| − | Esc_I = #27#105; // italic
| |
| − | Esc_U = #27#117; // underlined
| |
| − | Esc_PT = #27#050; // text pen
| |
| − | Esc_PH = #27#056; // highlight text pen
| |
| − | | |
| − | // Specials
| |
| − | Esc_IMS = #27#073; // Standard MUI Image
| |
| − | Esc_IMC = #27#079; // Created MUI Image
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: CoerceMethos()
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | {$IFDEF MORPHOS}
| |
| − | Type
| |
| − | PBoopsiObject = PObject_;
| |
| − | {$ENDIF}
| |
| − | | |
| − | {$IFDEF AMIGA}
| |
| − | function CoerceMethod(cl: PIClass; Obj: PObject_; MethodID: ULONG): ULONG;
| |
| − | function CoerceMethod(cl: PIClass; Obj: PObject_; MethodID: ULONG; const Msg: array of const): ULONG; overload;
| |
| − | {$ENDIF}
| |
| − | {$IFDEF AROS}
| |
| − | function CoerceMethod(cl: PIClass; Obj: PObject_; MethodID: IPTR): IPTR;
| |
| − | {$ENDIF}
| |
| − | {$IFDEF MORPHOS}
| |
| − | function CoerceMethodA(cl: PIClass; Obj: PObject_; Msg: Pointer): ULONG;
| |
| − | function CoerceMethod(cl: PIClass; Obj: PBoopsiobject; MethodID: ULONG): ULONG;
| |
| − | function CoerceMethod(cl: PIClass; Obj: PBoopsiObject; MethodID: ULONG; const Msg: array of ULONG): ULONG;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: GetAttr() for Morphos, complying to autodocs.
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | {$IFDEF MORPHOS}
| |
| − | function GetAttr(attrID : CARDINAL location 'd0'; object1 : POINTER location 'a0'; storagePtr : PCARDINAL location 'a1') : CARDINAL; SysCall IntuitionBase 654;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic:
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | implementation
| |
| − | | |
| − | | |
| − | {$IFDEF AMIGA}
| |
| − | Uses
| |
| − | AmigaLib, tagsarray;
| |
| − | {$ENDIF}
| |
| − | | |
| − | {$IFDEF MORPHOS}
| |
| − | Uses
| |
| − | AmigaLib;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: Some generic c-helpers, should not be in here
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | function SetAndTest(Var OldValue: pointer; NewValue: pointer): boolean;
| |
| − | begin
| |
| − | OldValue := NewValue;
| |
| − | result := (NewValue <> nil)
| |
| − | end;
| |
| − | | |
| − | function SetAndTest(Var OldValue: LongWord; NewValue: LongWord): boolean;
| |
| − | begin
| |
| − | OldValue := NewValue;
| |
| − | result := (NewValue <> 0)
| |
| − | end;
| |
| − | | |
| − | function SetAndTest(Var OldValue: LongInt; NewValue: LongInt): boolean;
| |
| − | begin
| |
| − | OldValue := NewValue;
| |
| − | result := (NewValue <> 0)
| |
| − | end;
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: Hooks
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | {$IFDEF CPU68}
| |
| − | procedure InitHook(var Hook: THook; Func: THookFunction; Data: APTR);
| |
| − | begin
| |
| − | Hook.h_Entry := @HookEntry;
| |
| − | Hook.h_SubEntry := Func;
| |
| − | Hook.h_Data := Data;
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | {$IFDEF CPU86}
| |
| − | function _hookEntry(h: PHook; obj: PObject_; Msg: Pointer): LongWord; cdecl;
| |
| − | var
| |
| − | Func: THookFunction;
| |
| − | begin
| |
| − | {$PUSH}{$HINTS OFF}
| |
| − | Func := THookFunction(h^.h_SubEntry);
| |
| − | {$POP}
| |
| − | result := Func(h, obj, msg);
| |
| − | end;
| |
| − | | |
| − | procedure InitHook(var Hook: THook; Func: THookFunction; Data: APTR);
| |
| − | begin
| |
| − | {$PUSH}{$HINTS OFF}
| |
| − | Hook.h_Entry := IPTR(@_hookEntry);
| |
| − | Hook.h_SubEntry := IPTR(Func);
| |
| − | {$POP}
| |
| − | Hook.h_Data := Data;
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | {$IFDEF CPUPOWERPC}
| |
| − | procedure InitHook(var Hook: THook; Func: THookFunction; Data: APTR);
| |
| − | const
| |
| − | HOOKENTRY_TRAP: TEmulLibEntry = ( Trap: TRAP_LIB; Extension: 0; Func: @HookEntry );
| |
| − | begin
| |
| − | Hook.h_Entry := @HOOKENTRY_TRAP;
| |
| − | Hook.h_SubEntry := Func;
| |
| − | Hook.h_Data := Data;
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: Tags
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | {$IFDEF AROS}
| |
| − | Function TAG_(TagItem: LongWord): LongInt; inline;
| |
| − | begin
| |
| − | Result := LongInt(TagItem);
| |
| − | end;
| |
| − | | |
| − | Function TAG_(TagItem: LongInt): LongInt; inline;
| |
| − | begin
| |
| − | Result := LongInt(TagItem);
| |
| − | end;
| |
| − | | |
| − | Function TAG_(TagItem: Pointer): LongInt; inline;
| |
| − | begin
| |
| − | {$PUSH}{$HINTS OFF}
| |
| − | Result := LongInt(TagItem);
| |
| − | {$POP}
| |
| − | end;
| |
| − | | |
| − | function TAG_(TagItem: boolean): LongInt; inline;
| |
| − | begin
| |
| − | Result := Ord(TagItem);
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | {$IFDEF AMIGA}
| |
| − | Function TAG_(TagItem: LongWord): LongInt; inline;
| |
| − | begin
| |
| − | Result := LongInt(TagItem);
| |
| − | end;
| |
| − | | |
| − | Function TAG_(TagItem: LongInt): LongInt; inline;
| |
| − | begin
| |
| − | Result := LongInt(TagItem);
| |
| − | end;
| |
| − | | |
| − | Function TAG_(TagItem: Pointer): LongInt; inline;
| |
| − | begin
| |
| − | {$PUSH}{$HINTS OFF}
| |
| − | Result := LongInt(TagItem);
| |
| − | {$POP}
| |
| − | end;
| |
| − | | |
| − | function TAG_(TagItem: boolean): LongInt; inline;
| |
| − | begin
| |
| − | Result := Ord(TagItem);
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | {$IFDEF MORPHOS}
| |
| − | Function TAG_(TagItem: LongInt): LongWord; inline;
| |
| − | begin
| |
| − | Result := LongWord(TagItem);
| |
| − | end;
| |
| − | | |
| − | Function TAG_(TagItem: LongWord): LongWord; inline;
| |
| − | begin
| |
| − | Result := LongWord(TagItem);
| |
| − | end;
| |
| − | | |
| − | Function TAG_(TagItem: Pointer): LongWord; inline;
| |
| − | begin
| |
| − | {$PUSH}{$HINTS OFF}
| |
| − | Result := LongWord(TagItem);
| |
| − | {$POP}
| |
| − | end;
| |
| − | | |
| − | function TAG_(TagItem: boolean): LongWord; inline;
| |
| − | begin
| |
| − | Result := Ord(TagItem);
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: SetGadgetAttrs(), missing from MorphOS
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | {$IFDEF MORPHOS}
| |
| − | function SetGadgetAttrs(Gadget: PGadget; Window: PWindow; Requester: PRequester; const Tags: array of long): ULONG;
| |
| − | begin
| |
| − | result := SetGadgetAttrsA(Gadget, Window, Requester, @Tags[0]);
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: DoMethod()
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | function DoMethod(obj : pointer; MethodID: ULONG): ULONG;
| |
| − | Var
| |
| − | Tags : Array[0..0] of ULONG;
| |
| − | begin
| |
| − | Tags[0] := MethodID;
| |
| − | Result := CALLHOOKPKT(PHook(OCLASS(obj)), obj, @(Tags[0]));
| |
| − | // or should it be: CALLHOOKPKT(PHook(OCLASS(Obj)), Obj, nil);
| |
| − | end;
| |
| − | | |
| − | {$IFDEF AMIGA}
| |
| − | operator := (Src: TVarRec) Dest: LongWord;
| |
| − | begin
| |
| − | Case Src.vtype of
| |
| − | {$PUSH}{$HINTS OFF}
| |
| − | vtinteger : Dest := PtrInt(Src.vinteger);
| |
| − | vtboolean : Dest := PtrInt(Src.vboolean);
| |
| − | vtpchar : Dest := PtrInt(Src.vpchar);
| |
| − | vtchar : Dest := PtrInt(Src.vchar);
| |
| − | vtstring : Dest := PtrInt(PChar(string(Src.vstring^)));
| |
| − | vtpointer : Dest := PtrInt(Src.vpointer);
| |
| − | {$POP}
| |
| − | end;
| |
| − | end;
| |
| − | | |
| − | function DoMethod(obj : pointer; MethodID: ULONG; const msg : array of const): ULONG; overload;
| |
| − | Var
| |
| − | Tags : Array of LongWord; i,n: integer;
| |
| − | begin
| |
| − | SetLength(Tags, Length(msg) + 1);
| |
| − | | |
| − | i := 0;
| |
| − | Tags[i] := MethodID;
| |
| − | | |
| − | for n := low(msg) to high(msg) do
| |
| − | begin
| |
| − | inc(i);
| |
| − | Tags[i] := msg[n]; // See operator
| |
| − | end;
| |
| − | | |
| − | Result := CALLHOOKPKT(PHook(OCLASS(Obj)), Obj, @(Tags[0]));
| |
| − |
| |
| − | SetLength(Tags, 0);
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | {$IFDEF MORPHOS}
| |
| − | function DoMethod(obj : pointer; MethodID: ULONG; const msg : array of ULONG): ULONG; overload;
| |
| − | Var
| |
| − | Tags : Array of LongWord; i,n: integer;
| |
| − | begin
| |
| − | SetLength(Tags, Length(msg) + 1);
| |
| − | | |
| − | i := 0;
| |
| − | Tags[i] := MethodID;
| |
| − | | |
| − | for n := low(msg) to high(msg) do
| |
| − | begin
| |
| − | inc(i);
| |
| − | Tags[i] := msg[n];
| |
| − | end;
| |
| − | | |
| − | Result := CALLHOOKPKT(PHook(OCLASS(Obj)), Obj, @(Tags[0]));
| |
| − | SetLength(Tags, 0);
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: DoSuperMethod()
| |
| − | // Amiga : Missing
| |
| − | // MorphOS + AROS : wrong parameter declaration
| |
| − | // ALL : missing none msg version
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | function DoSuperMethod(cl: pointer; obj : pointer; id: LongWord): LongWord; overload;
| |
| − | Var
| |
| − | Tags : Array[0..0] of LongWord;
| |
| − | begin
| |
| − | Tags[0] := id;
| |
| − | Result := DoSuperMethodA(cl, obj, @tags[0]);
| |
| − | // or should it be: DoSuperMethodA(cl, obj, nil);
| |
| − | end;
| |
| − | | |
| − | | |
| − | | |
| − | {$IF DEFINED(AMIGA) or DEFINED(MORPHOS) or DEFINED(AROS)}
| |
| − | function DoSuperMethod(cl: pointer; obj : pointer; id: LongWord; const msg : array of LongWord): longword; overload;
| |
| − | Var
| |
| − | Tags : Array of LongWord; i,n: integer;
| |
| − | begin
| |
| − | SetLength(Tags, Length(msg) + 1);
| |
| − | | |
| − | i := 0;
| |
| − | Tags[i] := id;
| |
| − | | |
| − | for n := low(msg) to high(msg) do
| |
| − | begin
| |
| − | inc(i);
| |
| − | Tags[i] := msg[n];
| |
| − | end;
| |
| − | | |
| − | Result := DoSuperMethodA(cl, obj, @tags[0]);
| |
| − | SetLength(Tags, 0);
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: SetAttrs()
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | {$IFDEF AMIGA}
| |
| − | function SetAttrs(Obj: APTR; tagList: Array of Const): ULONG;
| |
| − | begin
| |
| − | Result := SetAttrsA(Obj, ReadInTags(tagList));
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | {$IFDEF MORPHOS}
| |
| − | function SetAttrs(Obj: APTR; tagList: Array of DWord): ULONG;
| |
| − | begin
| |
| − | Result := SetAttrsA(Obj, @tagList);
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic: CoerceMethod()
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | | |
| − | {$IFDEF MORPHOS}
| |
| − | {$WARNING MORPHOS implementation of CoerceMethodA() is untested}
| |
| − | function CoerceMethodA(cl: PIClass; Obj: PObject_; Msg: Pointer): ULONG;
| |
| − | begin
| |
| − | If ( (cl <> nil) and (Obj <> nil) )
| |
| − | then result := CALLHOOKPKT(PHook(cl), obj, Msg)
| |
| − | else result := 0;
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | {$IFDEF AMIGA}
| |
| − | function CoerceMethod(cl: PIClass; Obj: PObject_; MethodID: ULONG): ULONG;
| |
| − | {$ENDIF}
| |
| − | {$IFDEF AROS}
| |
| − | function CoerceMethod(cl: PIClass; Obj: PObject_; MethodID: IPTR): IPTR;
| |
| − | {$ENDIF}
| |
| − | {$IFDEF MORPHOS}
| |
| − | function CoerceMethod(cl: PIClass; Obj: PBoopsiobject; MethodID: ULONG): ULONG;
| |
| − | {$ENDIF}
| |
| − | Var
| |
| − | Tags : Array[0..0] of ULONG;
| |
| − | begin
| |
| − | {$IFDEF AROS}
| |
| − | if ( not(obj <> nil) or not (cl <> nil) ) then exit(0);
| |
| − | {$ENDIF}
| |
| − | Tags[0] := MethodID;
| |
| − | Result := CoerceMethodA(cl, Obj, @(Tags[0]));
| |
| − | end;
| |
| − | | |
| − | {$IFDEF AMIGA}
| |
| − | function CoerceMethod(cl: PIClass; Obj: PObject_; MethodID: ULONG; const Msg: array of const): ULONG; overload;
| |
| − | Var
| |
| − | Tags : Array of LongWord; i,n: integer;
| |
| − | begin
| |
| − | SetLength(Tags, Length(Msg) + 1);
| |
| − | | |
| − | i := 0;
| |
| − | Tags[i] := MethodID;
| |
| − | | |
| − | for n := low(Msg) to high(Msg) do
| |
| − | begin
| |
| − | inc(i);
| |
| − | Tags[i] := Msg[n]; // See operator
| |
| − | end;
| |
| − | | |
| − | Result := CoerceMethodA(cl, Obj, @(Tags[0]));
| |
| − |
| |
| − | SetLength(Tags, 0);
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | {$IFDEF MORPHOS}
| |
| − | function CoerceMethod(cl: PIClass; Obj: PBoopsiObject; MethodID: ULONG; const Msg: array of ULONG): ULONG;
| |
| − | Var
| |
| − | Tags : Array of LongWord; i,n: integer;
| |
| − | begin
| |
| − | SetLength(Tags, Length(Msg) + 1);
| |
| − | | |
| − | i := 0;
| |
| − | Tags[i] := MethodID;
| |
| − | | |
| − | for n := low(Msg) to high(Msg) do
| |
| − | begin
| |
| − | inc(i);
| |
| − | Tags[i] := Msg[n];
| |
| − | end;
| |
| − | | |
| − | Result := CoerceMethodA(cl, Obj, @(Tags[0]));
| |
| − | | |
| − | SetLength(Tags, 0);
| |
| − | end;
| |
| − | {$ENDIF}
| |
| − | | |
| − | | |
| − | | |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | //
| |
| − | // Topic:
| |
| − | //
| |
| − | //////////////////////////////////////////////////////////////////////////////
| |
| − | | |
| − | | |
| − | end.
| |
| − | </source>
| |