|
@@ -14,8 +14,6 @@
|
|
|
**********************************************************************}
|
|
|
unit Intuition;
|
|
|
|
|
|
-{$mode objfpc}
|
|
|
-
|
|
|
{$define INTUI_V36_NAMES_ONLY}
|
|
|
|
|
|
interface
|
|
@@ -3339,25 +3337,25 @@ procedure WindowToFront(Window: PWindow); syscall IntuitionBase 52;
|
|
|
procedure ZipWindow(Window: PWindow); syscall IntuitionBase 84;
|
|
|
|
|
|
// VarArgs Versions
|
|
|
-function SetAttrs(Obj: APTR; const Tags: array of const): LongWord;
|
|
|
-function NewObject(ClassPtr: PIClass; ClassID: PChar; const Tags: array of const): APTR;
|
|
|
-function BuildEasyRequest(Window: PWindow; EasyStruct: PEasyStruct; IDCMP: LongWord; const Args: array of const): PWindow;
|
|
|
-function DoGadgetMethod(Gad: PGadget; Win: PWindow; Req: PRequester; const Args: array of const): IPTR;
|
|
|
-function EasyRequest(Window: PWindow; EasyStruct: PEasyStruct; IDCMP_Ptr: PLongWord; const Args: array of const): LongInt;
|
|
|
-function OpenScreenTags(NewScreen: PNewScreen; const Tags: array of const): PScreen;
|
|
|
-function OpenWindowTags(NewWindow: PNewWindow; const Tags: array of const): PWindow;
|
|
|
-function SetGadgetAttrs(Gadget: PGadget; Window: PWindow; Requester: PRequester; const Tags: array of const): IPTR;
|
|
|
-procedure SetWindowPointer(Win: PWindow; const Tags: array of const);
|
|
|
+function SetAttrs(Obj: APTR; const Tags: array of PtrUInt): LongWord;
|
|
|
+function NewObject(ClassPtr: PIClass; ClassID: PChar; const Tags: array of PtrUInt): APTR;
|
|
|
+function BuildEasyRequest(Window: PWindow; EasyStruct: PEasyStruct; IDCMP: LongWord; const Args: array of PtrUInt): PWindow;
|
|
|
+function DoGadgetMethod(Gad: PGadget; Win: PWindow; Req: PRequester; const Args: array of PtrUInt): IPTR;
|
|
|
+function EasyRequest(Window: PWindow; EasyStruct: PEasyStruct; IDCMP_Ptr: PLongWord; const Args: array of PtrUInt): LongInt;
|
|
|
+function OpenScreenTags(NewScreen: PNewScreen; const Tags: array of PtrUInt): PScreen;
|
|
|
+function OpenWindowTags(NewWindow: PNewWindow; const Tags: array of PtrUInt): PWindow;
|
|
|
+function SetGadgetAttrs(Gadget: PGadget; Window: PWindow; Requester: PRequester; const Tags: array of PtrUInt): IPTR;
|
|
|
+procedure SetWindowPointer(Win: PWindow; const Tags: array of PtrUInt);
|
|
|
|
|
|
// Function wrapper
|
|
|
function SetSuperAttrsA(cl: PIClass; Obj: PObject_; TagList: PTagItem): IPTR;
|
|
|
-function SetSuperAttrs(cl: PIClass; Obj: PObject_; Tags: array of const): IPTR;
|
|
|
+function SetSuperAttrs(cl: PIClass; Obj: PObject_; const Tags: array of PtrUInt): IPTR;
|
|
|
function DoMethodA(Obj: PObject_; Message: APTR): IPTR;
|
|
|
-function DoMethod(Obj: PObject_; MethodID: LongWord; Args: array of const): IPTR;
|
|
|
+function DoMethod(Obj: PObject_; const Args: array of PtrUInt): IPTR;
|
|
|
function CoerceMethodA(cl: PIClass; Obj: PObject_; Message: APTR): IPTR;
|
|
|
-function CoerceMethod(cl: PIClass; Obj: PObject_; MethodID: LongWord; const Args: array of const): IPTR;
|
|
|
+function CoerceMethod(cl: PIClass; Obj: PObject_; const Args: array of PtrUInt): IPTR;
|
|
|
function DoSuperMethodA(cl: PIClass; Obj: PObject_; Message: APTR): IPTR;
|
|
|
-function DoSuperMethod(cl: PIClass; Obj: PObject_; Args: array of const): IPTR;
|
|
|
+function DoSuperMethod(cl: PIClass; Obj: PObject_; const Args: array of PtrUInt): IPTR;
|
|
|
|
|
|
function Has_Children(Win: PWindow): Boolean;
|
|
|
function Is_Children(Win: PWindow): Boolean;
|
|
@@ -3391,154 +3389,110 @@ function SHAKNUM(x: Word): Word;
|
|
|
|
|
|
implementation
|
|
|
|
|
|
-uses
|
|
|
- tagsarray, longarray;
|
|
|
-
|
|
|
-function SetAttrs(Obj: APTR; const Tags: array of const): LongWord;
|
|
|
-var
|
|
|
- TagList: TTagsList;
|
|
|
+function SetAttrs(Obj: APTR; const Tags: array of PtrUInt): LongWord; inline;
|
|
|
begin
|
|
|
- AddTags(TagList, Tags);
|
|
|
- Result := SetAttrsA(Obj, GetTagPtr(TagList));
|
|
|
+ SetAttrs := SetAttrsA(Obj, @Tags);
|
|
|
end;
|
|
|
|
|
|
-function NewObject(ClassPtr: PIClass; ClassID: PChar; const Tags: array of const): APTR;
|
|
|
-var
|
|
|
- TagList: TTagsList;
|
|
|
+function NewObject(ClassPtr: PIClass; ClassID: PChar; const Tags: array of PtrUInt): APTR; inline;
|
|
|
begin
|
|
|
- AddTags(TagList, Tags);
|
|
|
- Result := NewObjectA(ClassPtr, ClassID, GetTagPtr(TagList));
|
|
|
+ NewObject := NewObjectA(ClassPtr, ClassID, @Tags);
|
|
|
end;
|
|
|
|
|
|
-function BuildEasyRequest(Window: PWindow; EasyStruct: PEasyStruct; IDCMP: LongWord; const Args: array of const): PWindow;
|
|
|
-var
|
|
|
- ArgList: TArgList;
|
|
|
+function BuildEasyRequest(Window: PWindow; EasyStruct: PEasyStruct; IDCMP: LongWord; const Args: array of PtrUInt): PWindow; inline;
|
|
|
begin
|
|
|
- AddArguments(ArgList, Args);
|
|
|
- Result := BuildEasyRequestArgs(Window, EasyStruct, IDCMP, GetArgPtr(ArgList));
|
|
|
+ BuildEasyRequest := BuildEasyRequestArgs(Window, EasyStruct, IDCMP, @Args);
|
|
|
end;
|
|
|
|
|
|
-function DoGadgetMethod(Gad: PGadget; Win: PWindow; Req: PRequester; const Args: array of const): IPTR;
|
|
|
-var
|
|
|
- ArgList: TArgList;
|
|
|
+function DoGadgetMethod(Gad: PGadget; Win: PWindow; Req: PRequester; const Args: array of PtrUInt): IPTR; inline;
|
|
|
begin
|
|
|
- AddArguments(ArgList, Args);
|
|
|
{$ifdef i386}
|
|
|
- Result := DoGadgetMethodA(Gad, Win, Req, TMsg(ArgList));
|
|
|
+ DoGadgetMethod := DoGadgetMethodA(Gad, Win, Req, TMsg(@Args));
|
|
|
{$else}
|
|
|
{$warning fix me!}
|
|
|
{$endif}
|
|
|
end;
|
|
|
|
|
|
-function EasyRequest(Window: PWindow; EasyStruct: PEasyStruct; IDCMP_Ptr: PLongWord; const Args: array of const): LongInt;
|
|
|
-var
|
|
|
- ArgList: TArgList;
|
|
|
+function EasyRequest(Window: PWindow; EasyStruct: PEasyStruct; IDCMP_Ptr: PLongWord; const Args: array of PtrUInt): LongInt; inline;
|
|
|
begin
|
|
|
- AddArguments(ArgList, Args);
|
|
|
- Result := EasyRequestArgs(Window, EasyStruct, IDCMP_Ptr, @(ArgList[0]));
|
|
|
+ EasyRequest := EasyRequestArgs(Window, EasyStruct, IDCMP_Ptr, @Args);
|
|
|
end;
|
|
|
|
|
|
-function OpenScreenTags(NewScreen: PNewScreen; const Tags: array of const): PScreen;
|
|
|
-var
|
|
|
- TagList: TTagsList;
|
|
|
+function OpenScreenTags(NewScreen: PNewScreen; const Tags: array of PtrUInt): PScreen; inline;
|
|
|
begin
|
|
|
- AddTags(TagList, Tags);
|
|
|
- Result := OpenScreenTagList(NewScreen, GetTagPtr(TagList));
|
|
|
+ OpenScreenTags := OpenScreenTagList(NewScreen, @Tags);
|
|
|
end;
|
|
|
|
|
|
-function OpenWindowTags(NewWindow: PNewWindow; const Tags: array of const): PWindow;
|
|
|
-var
|
|
|
- TagList: TTagsList;
|
|
|
+function OpenWindowTags(NewWindow: PNewWindow; const Tags: array of PtrUInt): PWindow; inline;
|
|
|
begin
|
|
|
- AddTags(TagList, Tags);
|
|
|
- Result := OpenWindowTagList(NewWindow, GetTagPtr(TagList));
|
|
|
+ OpenWindowTags := OpenWindowTagList(NewWindow, @Tags);
|
|
|
end;
|
|
|
|
|
|
-function SetGadgetAttrs(Gadget: PGadget; Window: PWindow; Requester: PRequester; const Tags: array of const): IPTR;
|
|
|
-var
|
|
|
- TagList: TTagsList;
|
|
|
+function SetGadgetAttrs(Gadget: PGadget; Window: PWindow; Requester: PRequester; const Tags: array of PtrUInt): IPTR; inline;
|
|
|
begin
|
|
|
- AddTags(TagList, Tags);
|
|
|
- Result := SetGadgetAttrsA(Gadget, Window, Requester, GetTagPtr(TagList));
|
|
|
+ SetGadgetAttrs := SetGadgetAttrsA(Gadget, Window, Requester, @Tags);
|
|
|
end;
|
|
|
|
|
|
-procedure SetWindowPointer(Win: PWindow; const Tags: array of const);
|
|
|
-var
|
|
|
- TagList: TTagsList;
|
|
|
+procedure SetWindowPointer(Win: PWindow; const Tags: array of PtrUInt); inline;
|
|
|
begin
|
|
|
- AddTags(TagList, Tags);
|
|
|
- SetWindowPointerA(Win, GetTagPtr(TagList));
|
|
|
+ SetWindowPointerA(Win, @Tags);
|
|
|
end;
|
|
|
|
|
|
// Functions wrapper
|
|
|
|
|
|
-function DoMethodA(Obj: PObject_; Message: APTR): IPTR;
|
|
|
+function DoMethodA(Obj: PObject_; Message: APTR): IPTR; inline;
|
|
|
begin
|
|
|
- Result := 0;
|
|
|
+ DoMethodA := 0;
|
|
|
if Obj = nil then
|
|
|
Exit;
|
|
|
- Result := CALLHOOKPKT_(PHook(OCLASS(Obj)), Obj, Message);
|
|
|
+ DoMethodA := CALLHOOKPKT_(PHook(OCLASS(Obj)), Obj, Message);
|
|
|
end;
|
|
|
|
|
|
-function DoMethod(Obj: PObject_; MethodID: LongWord; Args: array of const): IPTR;
|
|
|
-var
|
|
|
- ArgList: TArgList;
|
|
|
+function DoMethod(Obj: PObject_; const Args: array of PtrUInt): IPTR; inline;
|
|
|
begin
|
|
|
- Result := 0;
|
|
|
+ DoMethod := 0;
|
|
|
if obj = nil then
|
|
|
Exit;
|
|
|
- AddArguments(ArgList, [MethodID]);
|
|
|
- AddArguments(ArgList, Args);
|
|
|
- Result := CALLHOOKPKT_(PHook(OCLASS(Obj)), Obj, @(ArgList[0]));
|
|
|
+ DoMethod := CALLHOOKPKT_(PHook(OCLASS(Obj)), Obj, @Args);
|
|
|
end;
|
|
|
|
|
|
-function DoSuperMethodA(cl: PIClass; Obj: PObject_; Message: APTR): IPTR;
|
|
|
+function DoSuperMethodA(cl: PIClass; Obj: PObject_; Message: APTR): IPTR; inline;
|
|
|
begin
|
|
|
- Result := 0;
|
|
|
+ DoSuperMethodA := 0;
|
|
|
if (cl = nil) or (obj = nil) then
|
|
|
Exit;
|
|
|
- Result := CALLHOOKPKT_(PHook(cl^.cl_Super), Obj, Message);
|
|
|
+ DoSuperMethodA := CALLHOOKPKT_(PHook(cl^.cl_Super), Obj, Message);
|
|
|
end;
|
|
|
|
|
|
-function DoSuperMethod(cl: PIClass; Obj: PObject_; Args: array of const): IPTR;
|
|
|
-var
|
|
|
- ArgList: TArgList;
|
|
|
+function DoSuperMethod(cl: PIClass; Obj: PObject_; const Args: array of PtrUInt): IPTR; inline;
|
|
|
begin
|
|
|
- Result := 0;
|
|
|
+ DoSuperMethod := 0;
|
|
|
if (cl = nil) or (obj = nil) then
|
|
|
Exit;
|
|
|
- AddArguments(ArgList, Args);
|
|
|
- Result := CALLHOOKPKT_(PHook(cl^.cl_Super), Obj, @(ArgList[0]));
|
|
|
+ DoSuperMethod := CALLHOOKPKT_(PHook(cl^.cl_Super), Obj, @Args);
|
|
|
end;
|
|
|
|
|
|
-function CoerceMethodA(cl: PIClass; Obj: PObject_; Message: APTR): IPTR;
|
|
|
+function CoerceMethodA(cl: PIClass; Obj: PObject_; Message: APTR): IPTR; inline;
|
|
|
begin
|
|
|
- Result := 0;
|
|
|
+ CoerceMethodA := 0;
|
|
|
if (cl = nil) or (obj = nil) then
|
|
|
Exit;
|
|
|
- Result := CALLHOOKPKT_(PHook(cl), Obj, Message);
|
|
|
+ CoerceMethodA := CALLHOOKPKT_(PHook(cl), Obj, Message);
|
|
|
end;
|
|
|
|
|
|
-function CoerceMethod(cl: PIClass; Obj: PObject_; MethodID: LongWord; const Args: array of const): IPTR;
|
|
|
-var
|
|
|
- ArgList: TArgList;
|
|
|
+function CoerceMethod(cl: PIClass; Obj: PObject_; const Args: array of PtrUInt): IPTR; inline;
|
|
|
begin
|
|
|
- AddArguments(ArgList,[MethodID]);
|
|
|
- AddArguments(ArgList, Args);
|
|
|
- Result := CoerceMethodA(cl, Obj, @(ArgList[0]));
|
|
|
+ CoerceMethod := CoerceMethodA(cl, Obj, @Args);
|
|
|
end;
|
|
|
|
|
|
-
|
|
|
-function SetSuperAttrs(cl: PIClass; Obj: PObject_; Tags: array of const): IPTR;
|
|
|
+function SetSuperAttrs(cl: PIClass; Obj: PObject_; const Tags: array of PtrUInt): IPTR;
|
|
|
var
|
|
|
- TagList: TTagsList;
|
|
|
ops: TopSet;
|
|
|
begin
|
|
|
- AddTags(TagList, Tags);
|
|
|
ops.MethodID := OM_SET;
|
|
|
- ops.ops_AttrList := GetTagPtr(TagList);
|
|
|
+ ops.ops_AttrList := @Tags;
|
|
|
ops.ops_GInfo := nil;
|
|
|
- Result := DoSuperMethodA(cl, obj, @ops);
|
|
|
+ SetSuperAttrs := DoSuperMethodA(cl, obj, @ops);
|
|
|
end;
|
|
|
|
|
|
function SetSuperAttrsA(cl: PIClass; Obj: PObject_; TagList: PTagItem): IPTR;
|
|
@@ -3548,21 +3502,20 @@ begin
|
|
|
ops.MethodID := OM_SET;
|
|
|
ops.ops_AttrList := TagList;
|
|
|
ops.ops_GInfo := nil;
|
|
|
- Result := DoSuperMethodA(cl, obj, @ops);
|
|
|
+ SetSuperAttrsA := DoSuperMethodA(cl, obj, @ops);
|
|
|
end;
|
|
|
|
|
|
-
|
|
|
-function INST_DATA(Cl: PIClass; O: P_Object): Pointer;
|
|
|
+function INST_DATA(Cl: PIClass; O: P_Object): Pointer; inline;
|
|
|
begin
|
|
|
INST_DATA := Pointer(PtrUInt(O) + Cl^.cl_InstOffset);
|
|
|
end;
|
|
|
|
|
|
-function SIZEOF_INSTANCE(Cl: PIClass): LongInt;
|
|
|
+function SIZEOF_INSTANCE(Cl: PIClass): LongInt; inline;
|
|
|
begin
|
|
|
SIZEOF_INSTANCE := Cl^.cl_InstOffset + Cl^.cl_InstSize + SizeOf(T_Object);
|
|
|
end;
|
|
|
|
|
|
-function BASEOBJECT(O: P_Object): Pointer;
|
|
|
+function BASEOBJECT(O: P_Object): Pointer; inline;
|
|
|
begin
|
|
|
BASEOBJECT := Pointer(PtrUInt(O) + SizeOf(T_Object));
|
|
|
end;
|
|
@@ -3587,17 +3540,17 @@ begin
|
|
|
SHIFTITEM := (N and $3f) shl 5
|
|
|
end;
|
|
|
|
|
|
-function SHIFTMENU(N: SmallInt): Word;
|
|
|
+function SHIFTMENU(N: SmallInt): Word; inline;
|
|
|
begin
|
|
|
SHIFTMENU := N and $1f
|
|
|
end;
|
|
|
|
|
|
-function SHIFTSUB(N: SmallInt): Word;
|
|
|
+function SHIFTSUB(N: SmallInt): Word; inline;
|
|
|
begin
|
|
|
SHIFTSUB := (N and $1f) shl 11
|
|
|
end;
|
|
|
|
|
|
-function FULLMENUNUM(Menu, Item, Sub: SmallInt): Word;
|
|
|
+function FULLMENUNUM(Menu, Item, Sub: SmallInt): Word; inline;
|
|
|
begin
|
|
|
FULLMENUNUM := ((Sub and $1f) shl 11) or ((Item and $3f) shl 5) or (Menu and $1f);
|
|
|
end;
|
|
@@ -3608,84 +3561,84 @@ end;
|
|
|
in pascal, of course!
|
|
|
}
|
|
|
|
|
|
-function IM_BGPEN(Im: PImage): Byte;
|
|
|
+function IM_BGPEN(Im: PImage): Byte; inline;
|
|
|
begin
|
|
|
IM_BGPEN := Im^.PlaneOnOff;
|
|
|
end;
|
|
|
|
|
|
-function IM_BOX(Im: PImage): PIBox;
|
|
|
+function IM_BOX(Im: PImage): PIBox; inline;
|
|
|
begin
|
|
|
IM_BOX := PIBox(@Im^.LeftEdge);
|
|
|
END;
|
|
|
|
|
|
-function IM_FGPEN (Im: PImage): Byte;
|
|
|
+function IM_FGPEN (Im: PImage): Byte; inline;
|
|
|
begin
|
|
|
IM_FGPEN := Im^.PlanePick;
|
|
|
end;
|
|
|
|
|
|
-function GADGET_BOX(G: PGadget): PIBox;
|
|
|
+function GADGET_BOX(G: PGadget): PIBox; inline;
|
|
|
begin
|
|
|
GADGET_BOX := PIBox(@G^.LeftEdge);
|
|
|
end;
|
|
|
|
|
|
-function CUSTOM_HOOK (Gadget: PGadget): PHook;
|
|
|
+function CUSTOM_HOOK (Gadget: PGadget): PHook; inline;
|
|
|
begin
|
|
|
CUSTOM_HOOK := PHook(Gadget^.MutualExclude);
|
|
|
end;
|
|
|
|
|
|
-function ITEMNUM(N: Word): Word;
|
|
|
+function ITEMNUM(N: Word): Word; inline;
|
|
|
begin
|
|
|
ITEMNUM := (N shr 5) and $3F
|
|
|
end;
|
|
|
|
|
|
-function MENUNUM(N: Word): Word;
|
|
|
+function MENUNUM(N: Word): Word; inline;
|
|
|
begin
|
|
|
MENUNUM := N and $1f
|
|
|
end;
|
|
|
|
|
|
-function SUBNUM(N: Word): Word;
|
|
|
+function SUBNUM(N: Word): Word; inline;
|
|
|
begin
|
|
|
SUBNUM := (N shr 11) and $1f
|
|
|
end;
|
|
|
|
|
|
-function IAM_Resolution(x, y: Word): LongWord;
|
|
|
+function IAM_Resolution(x, y: Word): LongWord; inline;
|
|
|
begin
|
|
|
- Result := (x shl 16) or y;
|
|
|
+ IAM_Resolution := (x shl 16) or y;
|
|
|
end;
|
|
|
|
|
|
-function SRBNUM(x: Word): Word;
|
|
|
+function SRBNUM(x: Word): Word; inline;
|
|
|
begin
|
|
|
SRBNUM := $08 - (x shr 4);
|
|
|
end;
|
|
|
|
|
|
-function SWBNUM(x: Word): Word;
|
|
|
+function SWBNUM(x: Word): Word; inline;
|
|
|
begin
|
|
|
SWBNUM := $08 - (x and $0f);
|
|
|
end;
|
|
|
|
|
|
-function SSBNUM(x: Word): Word;
|
|
|
+function SSBNUM(x: Word): Word; inline;
|
|
|
begin
|
|
|
SSBNUM := $01 + (x shr 4);
|
|
|
end;
|
|
|
|
|
|
-function SPARNUM(x: Word): Word;
|
|
|
+function SPARNUM(x: Word): Word; inline;
|
|
|
begin
|
|
|
SPARNUM := x shr 4;
|
|
|
end;
|
|
|
|
|
|
-function SHAKNUM(x: Word): Word;
|
|
|
+function SHAKNUM(x: Word): Word; inline;
|
|
|
begin
|
|
|
SHAKNUM := x and $0f;
|
|
|
end;
|
|
|
|
|
|
-function Has_Children(Win: PWindow): Boolean;
|
|
|
+function Has_Children(Win: PWindow): Boolean; inline;
|
|
|
begin
|
|
|
- Result := Assigned(Win^.FirstChild);
|
|
|
+ Has_Children := Assigned(Win^.FirstChild);
|
|
|
end;
|
|
|
|
|
|
-function Is_Children(Win: PWindow): Boolean;
|
|
|
+function Is_Children(Win: PWindow): Boolean; inline;
|
|
|
begin
|
|
|
- Result := Assigned(Win^.Parent2);
|
|
|
+ Is_Children := Assigned(Win^.Parent2);
|
|
|
end;
|
|
|
|
|
|
initialization
|