paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 20:49:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

arosunits: Removed Objfpc in all units, changed "array of const" to "array of PtrUInt"

Browse Source 
git-svn-id: trunk@32996 -
This commit is contained in:
marcus 2016-01-24 14:00:54 +00:00
parent 356ab8f63d
commit e8cb0d0415
13 changed files with 470 additions and 682 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
packages/arosunits/src/agraphics.pas
View File

@ -15,9 +15,7 @@
unit agraphics; unit agraphics;
{$mode delphi}{$H+} interface
Interface
uses uses
Exec, Hardware, Utility; Exec, Hardware, Utility;
@ -2200,7 +2198,7 @@ procedure ScrollVPort(Vp: PViewPort); syscall GfxBase 98;
procedure SetABPenDrMd(Rp: PRastPort; APen: LongWord; BPen: LongWord; DrawMode: LongWord); syscall GfxBase 149; procedure SetABPenDrMd(Rp: PRastPort; APen: LongWord; BPen: LongWord; DrawMode: LongWord); syscall GfxBase 149;
procedure SetAPen(Rp: PRastPort; Pen: LongWord); syscall GfxBase 57; procedure SetAPen(Rp: PRastPort; Pen: LongWord); syscall GfxBase 57;
procedure SetBPen(Rp: PRastPort; Pen: LongWord); syscall GfxBase 58; procedure SetBPen(Rp: PRastPort; Pen: LongWord); syscall GfxBase 58;
function SetChipRev(ChipRev: LongWord): LongWord; platform; syscall GfxBase 148; function SetChipRev(ChipRev: LongWord): LongWord; syscall GfxBase 148; platform;
procedure SetCollision(Num: LongWord; Routine: TProcedure; GInfo: PGelsInfo); syscall GfxBase 24; procedure SetCollision(Num: LongWord; Routine: TProcedure; GInfo: PGelsInfo); syscall GfxBase 24;
procedure SetDisplayDriverCallback(CallBack: TDriverNotifyFunc; UserData: APTR); syscall GfxBase 186; procedure SetDisplayDriverCallback(CallBack: TDriverNotifyFunc; UserData: APTR); syscall GfxBase 186;
procedure SetDrMd(Rp: PRastPort; DrawMode: LongWord); syscall GfxBase 59; procedure SetDrMd(Rp: PRastPort; DrawMode: LongWord); syscall GfxBase 59;
@ -2226,7 +2224,7 @@ function TextFit(Rp: PRastPort; const String_: STRPTR; StrLen: LongWord; TextExt
function TextLength(Rp: PRastPort; const string_: STRPTR; Count: LongWord): SmallInt; syscall GfxBase 9; function TextLength(Rp: PRastPort; const string_: STRPTR; Count: LongWord): SmallInt; syscall GfxBase 9;
function UCopperListInit(Ucl: PUCopList; n: SmallInt): PCopList; syscall GfxBase 99; function UCopperListInit(Ucl: PUCopList; n: SmallInt): PCopList; syscall GfxBase 99;
procedure UnlockLayerRom(l: PLayer); syscall GfxBase 73; procedure UnlockLayerRom(l: PLayer); syscall GfxBase 73;
function VBeamPos: LongInt; platform; syscall GfxBase 64; function VBeamPos: LongInt; syscall GfxBase 64; platform;
function VideoControl(Cm: PColorMap; Tags: PTagItem): LongWord; syscall GfxBase 118; unimplemented; function VideoControl(Cm: PColorMap; Tags: PTagItem): LongWord; syscall GfxBase 118; unimplemented;
procedure WaitBlit; syscall GfxBase 38; unimplemented; procedure WaitBlit; syscall GfxBase 38; unimplemented;
procedure WaitBOVP(Vp: PViewPort); syscall GfxBase 67; unimplemented; procedure WaitBOVP(Vp: PViewPort); syscall GfxBase 67; unimplemented;
@ -2242,15 +2240,15 @@ function XorRectRegionND(Reg: PRegion; Rect: PRectangle): PRegion; syscall GfxBa
function XorRegionRegion(SrcRegion: PRegion; DestRegion: PRegion): LongBool; syscall GfxBase 103; function XorRegionRegion(SrcRegion: PRegion; DestRegion: PRegion): LongBool; syscall GfxBase 103;
function XorRegionRegionND(R1: PRegion; R2: PRegion): PRegion; syscall GfxBase 151; function XorRegionRegionND(R1: PRegion; R2: PRegion): PRegion; syscall GfxBase 151;
function BestModeID(Tags: array of const): LongWord; function BestModeID(const Tags: array of PtrUInt): LongWord;
function AllocSpriteData(Bitmap: PBitMap; Tags: array of const): PExtSprite; function AllocSpriteData(Bitmap: PBitMap; const Tags: array of PtrUInt): PExtSprite;
function ChangeExtSprite(Vp: PViewPort; Oldsprite: PExtSprite; NewSprite: PExtSprite; Tags: array of const): LongInt; function ChangeExtSprite(Vp: PViewPort; Oldsprite: PExtSprite; NewSprite: PExtSprite; const Tags: array of PtrUInt): LongInt;
function ExtendFontTags(Font: PTextFont; Tags: array of const): LongWord; function ExtendFontTags(Font: PTextFont; const Tags: array of PtrUInt): LongWord;
function GetExtSprite(Sprite: PExtSprite; Tags: array of const): LongInt; function GetExtSprite(Sprite: PExtSprite; const Tags: array of PtrUInt): LongInt;
procedure GetRPAttrs(Rp: PRastPort; Tags: array of const); procedure GetRPAttrs(Rp: PRastPort; const Tags: array of PtrUInt);
function ObtainBestPen(Cm: PColorMap; r, g, b: LongWord; Tags: array of const): LongInt; function ObtainBestPen(Cm: PColorMap; r, g, b: LongWord; const Tags: array of PtrUInt): LongInt;
procedure SetRPAttrs(Rp: PRastPort; Tags: array of const); procedure SetRPAttrs(Rp: PRastPort; const Tags: array of PtrUInt);
function VideoControlTags(Cm: PColorMap; Tags: array of const): LongWord; unimplemented; function VideoControlTags(Cm: PColorMap; const Tags: array of PtrUInt): LongWord; unimplemented;
// gfxmacros // gfxmacros
@ -2284,80 +2282,50 @@ procedure CEND(c: PUCopList);
implementation implementation
uses function BestModeID(const Tags: array of PtrUInt): LongWord; inline;
tagsarray;
function BestModeID(Tags: array of const): LongWord;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); BestModeID := BestModeIDA(@Tags);
Result := BestModeIDA(GetTagPtr(TagList));
end; end;
function AllocSpriteData(Bitmap: PBitMap; Tags: array of const): PExtSprite; function AllocSpriteData(Bitmap: PBitMap; const Tags: array of PtrUInt): PExtSprite; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); AllocSpriteData := AllocSpriteDataA(Bitmap, @Tags);
Result := AllocSpriteDataA(Bitmap, GetTagPtr(TagList));
end; end;
function ChangeExtSprite(Vp: PViewPort; Oldsprite: PExtSprite; NewSprite: PExtSprite; Tags: array of const): LongInt; function ChangeExtSprite(Vp: PViewPort; Oldsprite: PExtSprite; NewSprite: PExtSprite; const Tags: array of PtrUInt): LongInt; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); ChangeExtSprite := ChangeExtSpriteA(Vp, Oldsprite, NewSprite, @Tags);
Result := ChangeExtSpriteA(Vp, Oldsprite, NewSprite, GetTagPtr(TagList));
end; end;
function ExtendFontTags(Font: PTextFont; Tags: array of const): LongWord; function ExtendFontTags(Font: PTextFont; const Tags: array of PtrUInt): LongWord; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); ExtendFontTags := ExtendFont(Font, @Tags);
Result := ExtendFont(Font, GetTagPtr(TagList));
end; end;
function GetExtSprite(Sprite: PExtSprite; Tags: array of const): LongInt; function GetExtSprite(Sprite: PExtSprite; const Tags: array of PtrUInt): LongInt; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); GetExtSprite := GetExtSpriteA(Sprite, @Tags);
Result := GetExtSpriteA(Sprite, GetTagPtr(TagList));
end; end;
procedure GetRPAttrs(Rp: PRastPort; Tags: array of const); procedure GetRPAttrs(Rp: PRastPort; const Tags: array of PtrUInt); inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); GetRPAttrsA(Rp, @Tags);
GetRPAttrsA(Rp, GetTagPtr(TagList));
end; end;
function ObtainBestPen(Cm: PColorMap; r, g, b: LongWord; Tags: array of const): LongInt; function ObtainBestPen(Cm: PColorMap; r, g, b: LongWord; const Tags: array of PtrUInt): LongInt; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); ObtainBestPen := ObtainBestPenA(Cm, r, g, b, @Tags);
Result := ObtainBestPenA(Cm, r, g, b, GetTagPtr(TagList));
end; end;
procedure SetRPAttrs(Rp: PRastPort; Tags: array of const); procedure SetRPAttrs(Rp: PRastPort; const Tags: array of PtrUInt); inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); SetRPAttrsA(Rp, @Tags);
SetRPAttrsA(Rp, GetTagPtr(TagList));
end; end;
function VideoControlTags(Cm: PColorMap; Tags: array of const): LongWord; function VideoControlTags(Cm: PColorMap; const Tags: array of PtrUInt): LongWord; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags);
{$WARNINGS OFF} // suppress unimplemented Warning {$WARNINGS OFF} // suppress unimplemented Warning
Result := VideoControl(Cm, GetTagPtr(TagList)); VideoControlTags := VideoControl(Cm, @Tags);
{$WARNINGS ON} {$WARNINGS ON}
end; end;
@ -2383,7 +2351,7 @@ end;
function RasSize(w, h: Word): Integer; inline; function RasSize(w, h: Word): Integer; inline;
begin begin
Result := h * (((w + 15) shr 3) and $FFFE); RasSize := h * (((w + 15) shr 3) and $FFFE);
end; end;
function BitmapFlags_are_Extended(f: LongInt): Boolean; inline; function BitmapFlags_are_Extended(f: LongInt): Boolean; inline;
@ -2404,7 +2372,7 @@ end;
function SetAOlPen(Rp: PRastPort; Pen: LongWord): LongWord; inline; function SetAOlPen(Rp: PRastPort; Pen: LongWord): LongWord; inline;
begin begin
Result := SetOutlinePen(Rp, Pen); SetAOlPen := SetOutlinePen(Rp, Pen);
end; end;
procedure BNDRYOFF (w: PRastPort); inline; procedure BNDRYOFF (w: PRastPort); inline;
@ -2446,12 +2414,12 @@ end;
function AreaCircle(Rp: PRastPort; xCenter, yCenter, r: SmallInt): LongWord; inline; function AreaCircle(Rp: PRastPort; xCenter, yCenter, r: SmallInt): LongWord; inline;
begin begin
Result := AreaEllipse(Rp, xCenter, yCenter, r, r); AreaCircle := AreaEllipse(Rp, xCenter, yCenter, r, r);
end; end;
function CINIT(c: PUCopList; n: SmallInt): PCopList; inline; function CINIT(c: PUCopList; n: SmallInt): PCopList; inline;
begin begin
Result := UCopperListInit(c, n); CINIT := UCopperListInit(c, n);
end; end;
procedure CMOVE1(c: PUCopList; a: Pointer; b: LongInt); procedure CMOVE1(c: PUCopList; a: Pointer; b: LongInt);

76
packages/arosunits/src/amigados.pas
View File

@ -23,7 +23,7 @@
{$define AROS_FAST_BPTR} {$define AROS_FAST_BPTR}
unit amigados; unit amigados;
{$mode objfpc}
interface interface
uses uses
@ -2418,10 +2418,10 @@ function WriteChar(c: LongInt): LongInt;
function UnReadChar(c: LongInt): LongInt; function UnReadChar(c: LongInt): LongInt;
// Special functions for var args // Special functions for var args
function AllocDosObjectTags(const Type_: LongWord; const Tags: array of const): APTR; function AllocDosObjectTags(const Type_: LongWord; const Tags: array of PtrUInt): APTR;
function CreateNewProcTags(const Tags: array of const): PProcess; function CreateNewProcTags(const Tags: array of PtrUInt): PProcess;
function NewLoadSegTags(const File_: STRPTR; const Tags: array of const): BPTR; function NewLoadSegTags(const File_: STRPTR; const Tags: array of PtrUInt): BPTR;
function SystemTags(const Command: STRPTR; const Tags: array of const): LongInt; function SystemTags(const Command: STRPTR; const Tags: array of PtrUInt): LongInt;
// elf.h // elf.h
@ -2436,7 +2436,6 @@ function ELF_R_TYPE(i: LongWord): LongWord;
function ELF_R_INFO(Sym: LongWord; Type_: LongWord): LongWord; function ELF_R_INFO(Sym: LongWord; Type_: LongWord): LongWord;
{$endif} {$endif}
const const
BNULL = nil; BNULL = nil;
@ -2445,76 +2444,61 @@ function BADDR(a: BPTR): APTR;
implementation implementation
uses function ELF_ST_TYPE(i: LongWord): LongWord; inline;
tagsarray;
function ELF_ST_TYPE(i: LongWord): LongWord;
begin begin
Result := i and $0F; ELF_ST_TYPE := i and $0F;
end; end;
{$ifdef ELF_64BIT} {$ifdef ELF_64BIT}
function ELF_R_SYM(i: QWord): QWord; function ELF_R_SYM(i: QWord): QWord; inline;
begin begin
Result := i shr 32; ELF_R_SYM := i shr 32;
end; end;
function ELF_R_TYPE(i: QWord): QWord; function ELF_R_TYPE(i: QWord): QWord; inline;
begin begin
Result := i and $ffffffff; ELF_R_TYPE := i and $ffffffff;
end; end;
function ELF_R_INFO(Sym: QWord; Type_: QWord): QWord; function ELF_R_INFO(Sym: QWord; Type_: QWord): QWord; inline;
begin begin
Result := Sym shl 32 + Type_; ELF_R_INFO := Sym shl 32 + Type_;
end; end;
{$else} {$else}
function ELF_R_SYM(i: LongWord): LongWord; function ELF_R_SYM(i: LongWord): LongWord; inline;
begin begin
Result := i shr 8; ELF_R_SYM := i shr 8;
end; end;
function ELF_R_TYPE(i: LongWord): LongWord; function ELF_R_TYPE(i: LongWord): LongWord; inline;
begin begin
Result := i and $ff; ELF_R_TYPE := i and $ff;
end; end;
function ELF_R_INFO(Sym: LongWord; Type_: LongWord): LongWord; function ELF_R_INFO(Sym: LongWord; Type_: LongWord): LongWord; inline;
begin begin
Result := Sym shl 8 + (Type_ and $ff); ELF_R_INFO := Sym shl 8 + (Type_ and $ff);
end; end;
{$endif} {$endif}
function AllocDosObjectTags(const Type_: LongWord; const Tags: array of const): APTR; function AllocDosObjectTags(const Type_: LongWord; const Tags: array of PtrUInt): APTR; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); AllocDosObjectTags := AllocDosObject(Type_, @Tags);
AllocDosObjectTags := AllocDosObject(Type_, GetTagPtr(TagList));
end; end;
function CreateNewProcTags(const Tags: array of const): PProcess; function CreateNewProcTags(const Tags: array of PtrUInt): PProcess; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); CreateNewProcTags := CreateNewProc(@Tags);
CreateNewProcTags := CreateNewProc(GetTagPtr(TagList));
end; end;
function NewLoadSegTags(const File_: STRPTR; const Tags: array of const): BPTR; function NewLoadSegTags(const File_: STRPTR; const Tags: array of PtrUInt): BPTR; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); NewLoadSegTags := NewLoadSeg(File_, @Tags);
NewLoadSegTags := NewLoadSeg(File_, GetTagPtr(TagList));
end; end;
function SystemTags(const Command: STRPTR; const Tags: array of const): LongInt; function SystemTags(const Command: STRPTR; const Tags: array of PtrUInt): LongInt; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); SystemTags := SystemTagList(Command, @Tags);
SystemTags := SystemTagList(Command, GetTagPtr(TagList));
end; end;
function MKBADDR(a: APTR): BPTR; inline; function MKBADDR(a: APTR): BPTR; inline;
@ -2535,17 +2519,17 @@ begin
{$endif} {$endif}
end; end;
function ReadChar(): LongInt; function ReadChar(): LongInt; inline;
begin begin
ReadChar := FGetC(DosInput()); ReadChar := FGetC(DosInput());
end; end;
function WriteChar(c: LongInt): LongInt; function WriteChar(c: LongInt): LongInt; inline;
begin begin
WriteChar := FPutC(DosOutput(), c); WriteChar := FPutC(DosOutput(), c);
end; end;
function UnReadChar(c: LongInt): LongInt; function UnReadChar(c: LongInt): LongInt; inline;
begin begin
UnReadChar := UnGetC(DosInput(),c); UnReadChar := UnGetC(DosInput(),c);
end; end;

31
packages/arosunits/src/asl.pas
View File

@ -15,12 +15,10 @@
unit asl; unit asl;
{$mode objfpc}
interface interface
uses uses
exec, utility, workbench, agraphics, tagsarray; exec, utility, workbench, agraphics;
const const
ASLNAME: PChar = 'asl.library'; ASLNAME: PChar = 'asl.library';
@ -508,34 +506,25 @@ function RequestFile(FileReq: PFileRequester): LongBool; syscall ASLBase 7;
procedure AbortAslRequest(Requester: Pointer); syscall ASLBase 13; procedure AbortAslRequest(Requester: Pointer); syscall ASLBase 13;
procedure ActivateAslRequest(Requester: Pointer); syscall ASLBase 14; procedure ActivateAslRequest(Requester: Pointer); syscall ASLBase 14;
function AllocAslRequest(ReqType: LongWord; const Tags: array of const): Pointer; function AllocAslRequest(ReqType: LongWord; const Tags: array of PtrUInt): Pointer;
function AslRequest(Requester: Pointer; const Tags: array of const): LongBool; function AslRequest(Requester: Pointer; const Tags: array of PtrUInt): LongBool;
function AslRequestTags(Requester: Pointer; const Tags: array of const): LongBool; function AslRequestTags(Requester: Pointer; const Tags: array of PtrUInt): LongBool;
implementation implementation
function AllocAslRequest(ReqType: LongWord; const Tags: array of const): Pointer; function AllocAslRequest(ReqType: LongWord; const Tags: array of PtrUInt): Pointer; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); AllocAslRequest := AllocAslRequestA(reqType, @Tags);
AllocAslRequest := AllocAslRequestA(reqType , GetTagPtr(TagList));
end; end;
function AslRequest(Requester: Pointer; const Tags: array of const): LongBool; function AslRequest(Requester: Pointer; const Tags: array of PtrUInt): LongBool; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); AslRequest := AslRequestA(Requester, @Tags);
AslRequest := AslRequestA(Requester , GetTagPtr(TagList));
end; end;
function AslRequestTags(Requester: Pointer; const Tags: array of const): LongBool; function AslRequestTags(Requester: Pointer; const Tags: array of PtrUInt): LongBool; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); AslRequestTags := AslRequestA(Requester, @Tags);
AslRequestTags := AslRequestA(Requester , GetTagPtr(TagList));
end; end;
initialization initialization

24
packages/arosunits/src/clipboard.pas
View File

@ -16,8 +16,7 @@
unit clipboard; unit clipboard;
interface interface
{$H+}
{$mode objfpc}{$H+}
uses exec; uses exec;
@ -74,8 +73,8 @@ type
chm_ClipID : LongInt; { the clip identifier of the new data } chm_ClipID : LongInt; { the clip identifier of the new data }
END; END;
function GetTextFromClip(ClipUnit: Byte): string; function GetTextFromClip(ClipUnit: Byte): AnsiString;
function PutTextToClip(ClipUnit: Byte; Text: string): Boolean; function PutTextToClip(ClipUnit: Byte; Text: AnsiString): Boolean;
implementation implementation
@ -87,7 +86,7 @@ const
ID_FTXT = 1179932756; ID_FTXT = 1179932756;
ID_CHRS = 1128813139; ID_CHRS = 1128813139;
function GetTextFromClip(ClipUnit: Byte): string; function GetTextFromClip(ClipUnit: Byte): AnsiString;
var var
Iff: PIffHandle; Iff: PIffHandle;
Error: LongInt; Error: LongInt;
@ -96,7 +95,7 @@ var
Len: Integer; Len: Integer;
Cu: LongInt; Cu: LongInt;
begin begin
Result := ''; GetTextFromClip := '';
Cu := ClipUnit; Cu := ClipUnit;
Iff := AllocIff; Iff := AllocIff;
if Assigned(Iff) then if Assigned(Iff) then
@ -124,15 +123,12 @@ begin
begin begin
GetMem(Buf, Len + 1); GetMem(Buf, Len + 1);
FillChar(Buf^, Len + 1, #0); FillChar(Buf^, Len + 1, #0);
try
ReadChunkBytes(Iff, Buf, Len); ReadChunkBytes(Iff, Buf, Len);
Result := Result + string(Buf); GetTextFromClip := GetTextFromClip + AnsiString(Buf);
finally
FreeMem(Buf); FreeMem(Buf);
end; end;
end; end;
end; end;
end;
CloseIff(Iff); CloseIff(Iff);
end; end;
CloseClipboard(PClipBoardHandle(iff^.iff_Stream)); CloseClipboard(PClipBoardHandle(iff^.iff_Stream));
@ -141,13 +137,13 @@ begin
end; end;
end; end;
function PutTextToClip(ClipUnit: Byte; Text: string): Boolean; function PutTextToClip(ClipUnit: Byte; Text: AnsiString): Boolean;
var var
Iff: PIffHandle; Iff: PIffHandle;
TText: string; TText: AnsiString;
Len: Integer; Len: Integer;
begin begin
Result := False; PutTextToClip := False;
Iff := AllocIff; Iff := AllocIff;
if Assigned(Iff) then if Assigned(Iff) then
begin begin
@ -163,7 +159,7 @@ begin
begin begin
Len := Length(Text); Len := Length(Text);
TText := Text + #0; TText := Text + #0;
Result := WriteChunkBytes(iff, @(TText[1]), Len) = len; PutTextToClip := WriteChunkBytes(iff, @(TText[1]), Len) = len;
PopChunk(iff); PopChunk(iff);
end; end;
PopChunk(iff); PopChunk(iff);

59
packages/arosunits/src/cybergraphics.pas
View File

@ -14,7 +14,7 @@
**********************************************************************} **********************************************************************}
unit cybergraphics; unit cybergraphics;
{$mode objfpc}
interface interface
uses uses
@ -236,68 +236,47 @@ procedure BltTemplateAlpha(src: APTR; srcx: LongInt; srcmod: LongInt; rp: PRastP
procedure ProcessPixelArray(rp: PRastPort; destX: LongWord; destY: LongWord; sizeX: LongWord; sizeY: LongWord; operation: LongWord; value: LongInt; taglist: PTagItem); syscall CyberGfxBase 38; procedure ProcessPixelArray(rp: PRastPort; destX: LongWord; destY: LongWord; sizeX: LongWord; sizeY: LongWord; operation: LongWord; value: LongInt; taglist: PTagItem); syscall CyberGfxBase 38;
// Functions and procedures with array of const go here // Functions and procedures with array of const go here
function AllocCModeListTags(const ModeListTags: array of const): PList; function AllocCModeListTags(const ModeListTags: array of PtrUInt): PList;
function BestCModeIDTags(const BestModeIDTags: array of const): LongWord; function BestCModeIDTags(const BestModeIDTags: array of PtrUInt): LongWord;
procedure CVideoCtrlTags(ViewPort: PViewPort; const TagList: array of const); procedure CVideoCtrlTags(ViewPort: PViewPort; const TagList: array of PtrUInt);
procedure DoCDrawMethodTags(Hook: PHook; a1arg: PRastPort; const TagList: array of const); procedure DoCDrawMethodTags(Hook: PHook; a1arg: PRastPort; const TagList: array of PtrUInt);
function LockBitMapTags(BitMap: APTR; const TagList: array of const): APTR; function LockBitMapTags(BitMap: APTR; const TagList: array of PtrUInt): APTR;
procedure UnLockBitMapTags(Handle: APTR; const TagList: array of const); procedure UnLockBitMapTags(Handle: APTR; const TagList: array of PtrUInt);
function SHIFT_PIXFMT(fmt: LongInt): LongInt; function SHIFT_PIXFMT(fmt: LongInt): LongInt;
function DOWNSHIFT_PIXFMT(fmt: LongInt): LongInt; function DOWNSHIFT_PIXFMT(fmt: LongInt): LongInt;
implementation implementation
uses
tagsarray;
// Functions and procedures with array of const go here // Functions and procedures with array of const go here
function AllocCModeListTags(const ModeListTags: array of const): PList; function AllocCModeListTags(const ModeListTags: array of PtrUInt): PList; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, ModeListTags); AllocCModeListTags := AllocCModeListTagList(@ModeListTags);
AllocCModeListTags := AllocCModeListTagList(GetTagPtr(TagList));
end; end;
function BestCModeIDTags(const BestModeIDTags: array of const): LongWord; function BestCModeIDTags(const BestModeIDTags: array of PtrUInt): LongWord; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, BestModeIDTags); BestCModeIDTags := BestCModeIDTagList(@BestModeIDTags);
BestCModeIDTags := BestCModeIDTagList(GetTagPtr(TagList));
end; end;
procedure CVideoCtrlTags(ViewPort: PViewPort; const TagList: array of const); procedure CVideoCtrlTags(ViewPort: PViewPort; const TagList: array of PtrUInt); inline;
var
TagsList: TTagsList;
begin begin
AddTags(TagsList, TagList); CVideoCtrlTagList(ViewPort, @TagList);
CVideoCtrlTagList(ViewPort, GetTagPtr(TagsList));
end; end;
procedure DoCDrawMethodTags(Hook: PHook; a1arg: PRastPort; const TagList: array of const); procedure DoCDrawMethodTags(Hook: PHook; a1arg: PRastPort; const TagList: array of PtrUInt); inline;
var
TagsList: TTagsList;
begin begin
AddTags(TagsList, TagList); DoCDrawMethodTagList(Hook, a1arg, @TagList);
DoCDrawMethodTagList(Hook, a1arg, GetTagPtr(TagsList));
end; end;
function LockBitMapTags(BitMap: APTR; const TagList: array of const): APTR; function LockBitMapTags(BitMap: APTR; const TagList: array of PtrUInt): APTR; inline;
var
TagsList: TTagsList;
begin begin
AddTags(TagsList, TagList); LockBitMapTags := LockBitMapTagList(BitMap, @TagList);
LockBitMapTags := LockBitMapTagList(BitMap, GetTagPtr(TagsList));
end; end;
procedure UnLockBitMapTags(Handle: APTR; const TagList: array of const); procedure UnLockBitMapTags(Handle: APTR; const TagList: array of PtrUInt); inline;
var
TagsList: TTagsList;
begin begin
AddTags(TagsList, TagList); UnLockBitMapTagList(Handle, @TagList);
UnLockBitMapTagList(Handle, GetTagPtr(TagsList));
end; end;
function SHIFT_PIXFMT(fmt: LongInt): LongInt; function SHIFT_PIXFMT(fmt: LongInt): LongInt;

62
packages/arosunits/src/diskfont.pas
View File

@ -15,73 +15,59 @@
unit diskfont; unit diskfont;
{$mode objfpc} interface
INTERFACE
uses exec, agraphics,utility; uses exec, agraphics,utility;
const const
MAXFONTPATH = 256; MAXFONTPATH = 256;
type type
PFontContents = ^TFontContents;
pFontContents = ^tFontContents; TFontContents = record
tFontContents = record fc_FileName: array[0..MAXFONTPATH - 1] of Char;
fc_FileName : Array [0..MAXFONTPATH-1] of Char;
fc_YSize: Word; fc_YSize: Word;
fc_Style: Byte; fc_Style: Byte;
fc_Flags: Byte; fc_Flags: Byte;
end; end;
PTFontContents = ^TTFontContents;
pTFontContents = ^tTFontContents; TTFontContents = record
tTFontContents = record tfc_FileName: array[0..MAXFONTPATH - 3] of Char;
tfc_FileName : Array[0..MAXFONTPATH-3] of Char;
tfc_TagCount: Word; tfc_TagCount: Word;
tfc_YSize: Word; tfc_YSize: Word;
tfc_Style, tfc_Style,
tfc_Flags: Byte; tfc_Flags: Byte;
END; end;
const const
FCH_ID = $0f00; FCH_ID = $0f00;
TFCH_ID = $0f02; TFCH_ID = $0f02;
OFCH_ID = $0f03; OFCH_ID = $0f03;
type type
PFontContentsHeader = ^TFontContentsHeader;
pFontContentsHeader = ^tFontContentsHeader; TFontContentsHeader = record
tFontContentsHeader = record
fch_FileID: Word; fch_FileID: Word;
fch_NumEntries: Word; fch_NumEntries: Word;
end; end;
const const
DFH_ID = $0f80; DFH_ID = $0f80;
MAXFONTNAME = 32; MAXFONTNAME = 32;
type type
PDiskFontHeader = ^TDiskFontHeader;
pDiskFontHeader = ^tDiskFontHeader; TDiskFontHeader = record
tDiskFontHeader = record dfh_DF: TNode;
dfh_DF : tNode;
dfh_FileID: Word; dfh_FileID: Word;
dfh_Revision: Word; dfh_Revision: Word;
dfh_Segment: Longint; dfh_Segment: Longint;
dfh_Name : Array [0..MAXFONTNAME-1] of Char; dfh_Name: array [0..MAXFONTNAME-1] of Char;
dfh_TF : tTextFont; dfh_TF: TTextFont;
end; end;
const const
AFB_MEMORY = 0; AFB_MEMORY = 0;
AFF_MEMORY = 1; AFF_MEMORY = 1;
AFB_DISK = 1; AFB_DISK = 1;
@ -93,23 +79,21 @@ const
AFB_TAGGED = 16; AFB_TAGGED = 16;
AFF_TAGGED = $10000; AFF_TAGGED = $10000;
type type
PAvailFonts = ^TAvailFonts;
pAvailFonts = ^tAvailFonts; TAvailFonts = record
tAvailFonts = record
af_Type: Word; af_Type: Word;
af_Attr : tTextAttr; af_Attr: TTextAttr;
end; end;
pTAvailFonts = ^tTAvailFonts; PTAvailFonts = ^TTAvailFonts;
tTAvailFonts = record TTAvailFonts = record
taf_Type: Word; taf_Type: Word;
taf_Attr : tTTextAttr; taf_Attr: TTTextAttr;
end; end;
pAvailFontsHeader = ^tAvailFontsHeader; PAvailFontsHeader = ^TAvailFontsHeader;
tAvailFontsHeader = record TAvailFontsHeader = record
afh_NumEntries: Word; afh_NumEntries: Word;
end; end;

22
packages/arosunits/src/icon.pas
View File

@ -15,8 +15,6 @@
unit icon; unit icon;
{$mode delphi}
interface interface
uses uses
@ -248,43 +246,43 @@ procedure ChangeToSelectedIconColor(Cr: Pointer); syscall IconBase 33; //TODO: p
{macros} {macros}
function PACK_ICON_ASPECT_RATIO(Num, Den: LongInt): LongInt; function PACK_ICON_ASPECT_RATIO(Num, Den: LongInt): LongInt;
procedure UNPACK_ICON_ASPECT_RATIO(Aspect: LongInt; out Num, Den: LongInt); procedure UNPACK_ICON_ASPECT_RATIO(Aspect: LongInt; var Num, Den: LongInt);
type type
TToolTypeArray= array of string; TToolTypeArray= array of AnsiString;
function GetToolTypes(Filename: string): TToolTypeArray; function GetToolTypes(Filename: AnsiString): TToolTypeArray;
implementation implementation
function GetToolTypes(Filename: string): TToolTypeArray; function GetToolTypes(Filename: AnsiString): TToolTypeArray;
var var
DObj: PDiskObject; DObj: PDiskObject;
Tooltype: PPChar; Tooltype: PPChar;
Idx: Integer; Idx: Integer;
begin begin
SetLength(Result, 0); SetLength(GetToolTypes, 0);
DObj := GetDiskObject(PChar(FileName)); DObj := GetDiskObject(PChar(FileName));
if not Assigned(Dobj) then if not Assigned(Dobj) then
Exit; Exit;
Tooltype := DObj^.do_Tooltypes; Tooltype := DObj^.do_Tooltypes;
while Assigned(ToolType^) do while Assigned(ToolType^) do
begin begin
Idx := Length(Result); Idx := Length(GetToolTypes);
SetLength(Result, Idx + 1); SetLength(GetToolTypes, Idx + 1);
Result[Idx] := ToolType^; GetToolTypes[Idx] := ToolType^;
Inc(ToolType); Inc(ToolType);
end; end;
FreeDiskObject(DObj); FreeDiskObject(DObj);
end; end;
function PACK_ICON_ASPECT_RATIO(Num, Den: LongInt): LongInt; function PACK_ICON_ASPECT_RATIO(Num, Den: LongInt): LongInt; inline;
begin begin
PACK_ICON_ASPECT_RATIO := (Num shl 4) or Den; PACK_ICON_ASPECT_RATIO := (Num shl 4) or Den;
end; end;
procedure UNPACK_ICON_ASPECT_RATIO(Aspect: LongInt; out Num, Den: LongInt); procedure UNPACK_ICON_ASPECT_RATIO(Aspect: LongInt; var Num, Den: LongInt); inline;
begin begin
Num := (Aspect shr 4) and $F; Num := (Aspect shr 4) and $F;
Den := Aspect and $15; Den := Aspect and $15;

5
packages/arosunits/src/iffparse.pas
View File

@ -17,11 +17,8 @@ unit iffparse;
interface interface
{$mode objfpc}
uses exec, clipboard, utility; uses exec, clipboard, utility;
const const
IFFPARSENAME : PChar = 'iffparse.library'; IFFPARSENAME : PChar = 'iffparse.library';
@ -259,7 +256,7 @@ function Make_ID(str: String): LongInt;
implementation implementation
function Make_ID(str: String): LongInt; function Make_ID(str: String): LongInt; inline;
begin begin
Make_ID:= (LongInt(Ord(Str[1])) shl 24) or Make_ID:= (LongInt(Ord(Str[1])) shl 24) or
(LongInt(Ord(Str[2])) shl 16 ) or (LongInt(Ord(Str[2])) shl 16 ) or

201
packages/arosunits/src/intuition.pas
View File

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

4
packages/arosunits/src/keymap.pas
View File

@ -16,9 +16,7 @@
unit Keymap; unit Keymap;
INTERFACE interface
{$mode objfpc}
uses exec, inputevent; uses exec, inputevent;

49
packages/arosunits/src/mui.pas
View File

@ -12,7 +12,6 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************} **********************************************************************}
{$mode objfpc}
{$packrecords C} {$packrecords C}
unit mui; unit mui;
@ -3763,17 +3762,14 @@ function MUIV_Window_Width_Screen(p: LongInt): LongInt;
// Functions and procedures with array of const go here // Functions and procedures with array of const go here
function MUI_AllocAslRequestTags(ReqTyp: Longword; const Tags: array of const): Pointer; function MUI_AllocAslRequestTags(ReqTyp: Longword; const Tags: array of PtrUInt): Pointer;
function MUI_AslRequestTags(req: Pointer; const Tags : array of const): LongBool; function MUI_AslRequestTags(req: Pointer; const Tags : array of PtrUInt): LongBool;
function MUI_MakeObject(_type: LongInt; const Params : array of const): PLongWord; function MUI_MakeObject(_Type: LongInt; const Params : array of PtrUInt): PObject_;
function MUI_NewObject(a0arg: PCHAR; const Tags: array of const): PLongWord; function MUI_NewObject(a0arg: PChar; const Tags: array of PtrUInt): PObject_;
function MUI_Request(App: Pointer; Win: Pointer; Flags: LongWord; Title: PChar; Gadgets: PChar; Format: PChar; const Params: array of const): LongInt; function MUI_Request(App: Pointer; win: Pointer; Flags: LongWord; Title: PChar; Gadgets: PChar; Format: PChar; const Params: Array Of PtrUInt): LongInt;
implementation implementation
uses
tagsarray, longarray;
function MUINotifyData(Obj: APTR): PMUI_NotifyData; inline; function MUINotifyData(Obj: APTR): PMUI_NotifyData; inline;
begin begin
MUINotifyData := PMUI_NotifyData(@P__dummyAreaData__(Obj)^.mnd); MUINotifyData := PMUI_NotifyData(@P__dummyAreaData__(Obj)^.mnd);
@ -4043,44 +4039,29 @@ end;
// Functions and procedures with array of const go here // Functions and procedures with array of const go here
function MUI_AllocAslRequestTags(ReqTyp : longword; const tags : Array Of Const) : Pointer; function MUI_AllocAslRequestTags(ReqTyp : longword; const Tags: array of PtrUInt) : Pointer; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); MUI_AllocAslRequestTags := MUI_AllocAslRequest(ReqTyp, @Tags);
MUI_AllocAslRequestTags := MUI_AllocAslRequest(ReqTyp, GetTagPtr(TagList));
end; end;
function MUI_AslRequestTags(req : Pointer; const tags : Array Of Const) : LongBool; function MUI_AslRequestTags(Req: Pointer; const Tags: array of PtrUInt) : LongBool; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); MUI_AslRequestTags := MUI_AslRequest(Req, @Tags);
MUI_AslRequestTags := MUI_AslRequest(req, GetTagPtr(TagList));
end; end;
function MUI_MakeObject(_type : LongInt; const params : Array Of Const) : pLongWord; function MUI_MakeObject(_Type : LongInt; const Params: array of PtrUInt): PObject_; inline;
var
Args: TArgList;
begin begin
AddArguments(Args, params); MUI_MakeObject := MUI_MakeObjectA(_Type, @Params);
MUI_MakeObject := MUI_MakeObjectA(_type, GetArgPtr(Args));
end; end;
function MUI_NewObject(a0arg : pCHAR; const tags : Array Of Const) : pLongWord; function MUI_NewObject(a0arg: PChar; const Tags: array of PtrUInt): PObject_; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); MUI_NewObject := MUI_NewObjectA(a0arg , @Tags);
MUI_NewObject := MUI_NewObjectA(a0arg , GetTagPtr(TagList));
end; end;
function MUI_Request(app : Pointer; win : Pointer; flags : longword; title : pCHAR; gadgets : pCHAR; format : pCHAR; const params : Array Of Const) : LongInt; function MUI_Request(App: Pointer; win: Pointer; Flags: LongWord; Title: PChar; Gadgets: PChar; Format: PChar; const Params: Array Of PtrUInt): LongInt;
var
Args: TArgList;
begin begin
AddArguments(Args, params); MUI_Request := MUI_RequestA(App, Win, Flags, Title, Gadgets, Format, @Params);
MUI_Request := MUI_RequestA(app , win , flags , title , gadgets , format , GetArgPtr(Args));
end; end;
const const

26
packages/arosunits/src/utility.pas
View File

@ -14,7 +14,6 @@
**********************************************************************} **********************************************************************}
unit utility; unit utility;
{$mode objfpc}{$H+}
{$PACKRECORDS C} {$PACKRECORDS C}
interface interface
@ -253,41 +252,32 @@ function UnpackStructureTags(Pack: APTR; PackTable: PLongWord; TagList: PTagItem
function CALLHOOKPKT_(Hook: PHook; Object_: APTR; Message: APTR): IPTR; inline; function CALLHOOKPKT_(Hook: PHook; Object_: APTR; Message: APTR): IPTR; inline;
// VarArgs Versions // VarArgs Versions
function AllocNamedObject(const Name: STRPTR; const Tags: array of const): PNamedObject; function AllocNamedObject(const Name: STRPTR; const Tags: array of PtrUInt): PNamedObject;
function CallHook(Hook: PHook; Object_: APTR; const Params: array of const): IPTR; function CallHook(Hook: PHook; Object_: APTR; const Params: array of PtrUInt): IPTR;
implementation implementation
uses function AllocNamedObject(const Name: STRPTR; const Tags: array of PtrUInt): PNamedObject; inline;
tagsarray,longarray;
function AllocNamedObject(const Name: STRPTR; const Tags: array of const): PNamedObject;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); AllocNamedObject := AllocNamedObjectA(Name, @Tags);
Result := AllocNamedObjectA(Name, GetTagPtr(TagList));
end; end;
function CallHook(Hook: PHook; Object_: APTR; const Params: array of const): IPTR; function CallHook(Hook: PHook; Object_: APTR; const Params: array of PtrUInt): IPTR; inline;
var
Args: TArgList;
begin begin
AddArguments(Args, params); CallHook := CallHookPkt(Hook, Object_ , @Params);
CallHook := CallHookPkt(Hook, Object_ , GetArgPtr(Args));
end; end;
function CALLHOOKPKT_(Hook: PHook; Object_: APTR; Message: APTR): IPTR; function CALLHOOKPKT_(Hook: PHook; Object_: APTR; Message: APTR): IPTR;
var var
FuncPtr: THookFunctionProc; FuncPtr: THookFunctionProc;
begin begin
Result := 0; CALLHOOKPKT_ := 0;
if (Hook = nil) or (Object_ = nil) or (Message = nil) then if (Hook = nil) or (Object_ = nil) or (Message = nil) then
Exit; Exit;
if (Hook^.h_Entry = 0) then if (Hook^.h_Entry = 0) then
Exit; Exit;
FuncPtr := THookFunctionProc(Hook^.h_Entry); FuncPtr := THookFunctionProc(Hook^.h_Entry);
Result := FuncPtr(Hook, Object_, Message); CALLHOOKPKT_ := FuncPtr(Hook, Object_, Message);
end; end;
end. end.

77
packages/arosunits/src/workbench.pas
View File

@ -13,11 +13,8 @@
**********************************************************************} **********************************************************************}
unit Workbench; unit Workbench;
{$MODE OBJFPC} {$H+}
{$PACKRECORDS C} {$PACKRECORDS C}
Interface Interface
Uses Uses
@ -588,90 +585,64 @@ function SendAppWindowMessage(Win: PWindow; NumFiles: LongWord; Files: PPChar; C
function GetNextAppIcon(LastDiskObj: PDiskObject; Text_: PChar): PDiskObject; syscall WorkbenchBase 27; function GetNextAppIcon(LastDiskObj: PDiskObject; Text_: PChar): PDiskObject; syscall WorkbenchBase 27;
// varargs versions: // varargs versions:
function AddAppIcon(ID: LongWord; UserData: LongWord; Text_: PChar; MsgPort: PMsgPort; Lock: BPTR; DiskObj: PDiskObject; const Tags: array of const): PAppIcon; function AddAppIcon(ID: LongWord; UserData: LongWord; Text_: PChar; MsgPort: PMsgPort; Lock: BPTR; DiskObj: PDiskObject; const Tags: array of PtrUInt): PAppIcon;
function AddAppMenuItem(ID: LongWord; UserData: LongWord; Text_: APTR; MsgPort: PMsgPort; const Tags: array of const): PAppMenuItem; function AddAppMenuItem(ID: LongWord; UserData: LongWord; Text_: APTR; MsgPort: PMsgPort; const Tags: array of PtrUInt): PAppMenuItem;
function AddAppWindow(ID: LongWord; UserData: LongWord; Window: PWindow; MsgPort: PMsgPort; const Tags: array of const): PAppWindow; function AddAppWindow(ID: LongWord; UserData: LongWord; Window: PWindow; MsgPort: PMsgPort; const Tags: array of PtrUInt): PAppWindow;
function AddAppWindowDropZone(Aw: PAppWindow; ID: LongWord; UserData: LongWord; const Tags: array of const): PAppWindowDropZone; function AddAppWindowDropZone(Aw: PAppWindow; ID: LongWord; UserData: LongWord; const Tags: array of PtrUInt): PAppWindowDropZone;
function CloseWorkbenchObject(Name: STRPTR; const Tags: array of const): LongBool; unimplemented; function CloseWorkbenchObject(Name: STRPTR; const Tags: array of PtrUInt): LongBool; unimplemented;
function MakeWorkbenchObjectVisible(Name: STRPTR; const Tags: array of const): LongBool; unimplemented; function MakeWorkbenchObjectVisible(Name: STRPTR; const Tags: array of PtrUInt): LongBool; unimplemented;
function OpenWorkbenchObject(Name: STRPTR; const Tags: array of const): LongBool; function OpenWorkbenchObject(Name: STRPTR; const Tags: array of PtrUInt): LongBool;
function WorkbenchControl(Name: STRPTR; const Tags: array of const): LongBool; function WorkbenchControl(Name: STRPTR; const Tags: array of PtrUInt): LongBool;
implementation implementation
uses
TagsArray;
// varargs versions: // varargs versions:
function AddAppIcon(ID: LongWord; UserData: LongWord; Text_: PChar; MsgPort: PMsgPort; Lock: BPTR; DiskObj: PDiskObject; const Tags: array of const): PAppIcon; function AddAppIcon(ID: LongWord; UserData: LongWord; Text_: PChar; MsgPort: PMsgPort; Lock: BPTR; DiskObj: PDiskObject; const Tags: array of PtrUInt): PAppIcon; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); AddAppIcon := AddAppIconA(ID, UserData, Text_, MsgPort, Lock, DiskObj, @Tags);
AddAppIcon := AddAppIconA(ID, UserData, Text_, MsgPort, Lock, DiskObj, GetTagPtr(TagList));
end; end;
function AddAppMenuItem(ID: LongWord; UserData: LongWord; Text_: APTR; MsgPort: PMsgPort; const Tags: array of const): PAppMenuItem; function AddAppMenuItem(ID: LongWord; UserData: LongWord; Text_: APTR; MsgPort: PMsgPort; const Tags: array of PtrUInt): PAppMenuItem; inline;
var
TagList: TTagsList;
begin begin
AddAppMenuItem := AddAppMenuItemA(ID, UserData, Text_, MsgPort, GetTagPtr(TagList)); AddAppMenuItem := AddAppMenuItemA(ID, UserData, Text_, MsgPort, @Tags);
end; end;
function AddAppWindow(ID: LongWord; UserData: LongWord; Window: PWindow; MsgPort: PMsgPort; const Tags: array of const): PAppWindow; function AddAppWindow(ID: LongWord; UserData: LongWord; Window: PWindow; MsgPort: PMsgPort; const Tags: array of PtrUInt): PAppWindow; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); AddAppWindow := AddAppWindowA(ID, UserData, Window, MsgPort, @Tags);
AddAppWindow := AddAppWindowA(ID, UserData, Window, MsgPort, GetTagPtr(TagList));
end; end;
function AddAppWindowDropZone(Aw: PAppWindow; ID: LongWord; UserData: LongWord; const Tags: array of const): PAppWindowDropZone; function AddAppWindowDropZone(Aw: PAppWindow; ID: LongWord; UserData: LongWord; const Tags: array of PtrUInt): PAppWindowDropZone; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); AddAppWindowDropZone := AddAppWindowDropZoneA(Aw, ID, UserData, @Tags);
AddAppWindowDropZone := AddAppWindowDropZoneA(Aw, ID, UserData, GetTagPtr(TagList));
end; end;
function CloseWorkbenchObject(Name: STRPTR; const Tags: array of const): LongBool; function CloseWorkbenchObject(Name: STRPTR; const Tags: array of PtrUInt): LongBool; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); CloseWorkbenchObject := CloseWorkbenchObjectA(Name, @Tags);
CloseWorkbenchObject := CloseWorkbenchObjectA(Name, GetTagPtr(TagList));
end; end;
function MakeWorkbenchObjectVisible(Name: STRPTR; const Tags: array of const): LongBool; function MakeWorkbenchObjectVisible(Name: STRPTR; const Tags: array of PtrUInt): LongBool; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); MakeWorkbenchObjectVisible := MakeWorkbenchObjectVisibleA(Name, @Tags);
MakeWorkbenchObjectVisible := MakeWorkbenchObjectVisibleA(Name, GetTagPtr(TagList));
end; end;
function OpenWorkbenchObject(Name: STRPTR; const Tags: array of const): LongBool; function OpenWorkbenchObject(Name: STRPTR; const Tags: array of PtrUInt): LongBool; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); OpenWorkbenchObject := OpenWorkbenchObjectA(Name, @Tags);
OpenWorkbenchObject := OpenWorkbenchObjectA(Name, GetTagPtr(TagList));
end; end;
function WorkbenchControl(Name: STRPTR; const Tags: array of const): LongBool; function WorkbenchControl(Name: STRPTR; const Tags: array of PtrUInt): LongBool; inline;
var
TagList: TTagsList;
begin begin
AddTags(TagList, Tags); WorkbenchControl := WorkbenchControlA(Name, @Tags);
WorkbenchControl := WorkbenchControlA(Name, GetTagPtr(TagList));
end; end;