{
This file is part of the Free Pascal run time library.
A file in Amiga system run time library.
Copyright (c) 2001-2003 by Nils Sjoholm
member of the Amiga RTL development team.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{
History:
First version of unit Picasso96Api
27 Feb. 2001.
Updated to fpc 1.0.7
08 Jan 2003
Added the defines use_amiga_smartlink and
use_auto_openlib.
12 Jan 2003.
Changed cardinal > longword.
Changed startcode for unit.
11 Feb 2003.
nils.sjoholm@mailbox.swipnet.se
}
{$mode objfpc}
{$I useamigasmartlink.inc}
{$ifdef use_amiga_smartlink}
{$smartlink on}
{$endif use_amiga_smartlink}
UNIT PICASSO96API;
INTERFACE
USES Exec, utility, graphics, intuition;
{ Picasso96.h -- include File
(C) Copyright 1996-98 Alexander Kneer & Tobias Abt
All Rights Reserved.
}
const
PICASSO96APINAME : PChar = 'Picasso96API.library';
{************************************************************************}
{ Types for RGBFormat used
}
type
RGBFTYPE = (
RGBFB_NONE,
RGBFB_CLUT,
RGBFB_R8G8B8,
RGBFB_B8G8R8,
RGBFB_R5G6B5PC,
RGBFB_R5G5B5PC,
RGBFB_A8R8G8B8,
RGBFB_A8B8G8R8,
RGBFB_R8G8B8A8,
RGBFB_B8G8R8A8,
RGBFB_R5G6B5,
RGBFB_R5G5B5,
RGBFB_B5G6R5PC,
RGBFB_B5G5R5PC,
RGBFB_Y4U2V2,
RGBFB_Y4U1V1,
RGBFB_MaxFormats);
const
RGBFF_NONE = 1 shl 0;
RGBFF_CLUT = 1 shl 1;
RGBFF_R8G8B8 = 1 shl 2;
RGBFF_B8G8R8 = 1 shl 3;
RGBFF_R5G6B5PC = 1 shl 4;
RGBFF_R5G5B5PC = 1 shl 5;
RGBFF_A8R8G8B8 = 1 shl 6;
RGBFF_A8B8G8R8 = 1 shl 7;
RGBFF_R8G8B8A8 = 1 shl 8;
RGBFF_B8G8R8A8 = 1 shl 9;
RGBFF_R5G6B5 = 1 shl 10;
RGBFF_R5G5B5 = 1 shl 11;
RGBFF_B5G6R5PC = 1 shl 12;
RGBFF_B5G5R5PC = 1 shl 13;
RGBFF_Y4U2V2 = 1 shl 14;
RGBFF_Y4U1V1 = 1 shl 15;
RGBFF_HICOLOR = ((((RGBFF_R5G6B5PC or RGBFF_R5G5B5PC) or RGBFF_R5G6B5) or RGBFF_R5G5B5) or RGBFF_B5G6R5PC) or RGBFF_B5G5R5PC;
RGBFF_TRUECOLOR = RGBFF_R8G8B8 or RGBFF_B8G8R8;
RGBFF_TRUEALPHA = ((RGBFF_A8R8G8B8 or RGBFF_A8B8G8R8) or RGBFF_R8G8B8A8) or RGBFF_B8G8R8A8;
{ }
{ Flags for p96AllocBitMap
}
BMF_USERPRIVATE = $8000;
{ private user bitmap that will never
be put to a board, but may be used as a temporary render buffer and accessed
with OS blit functions, too. Bitmaps allocated with this flag do not need to
be locked. }
{ }
{ Attributes for p96GetBitMapAttr
}
P96BMA_WIDTH = 0;
P96BMA_HEIGHT = 1;
P96BMA_DEPTH = 2;
P96BMA_MEMORY = 3;
P96BMA_BYTESPERROW = 4;
P96BMA_BYTESPERPIXEL = 5;
P96BMA_BITSPERPIXEL = 6;
P96BMA_RGBFORMAT = 7;
P96BMA_ISP96 = 8;
P96BMA_ISONBOARD = 9;
P96BMA_BOARDMEMBASE = 10;
P96BMA_BOARDIOBASE = 11;
P96BMA_BOARDMEMIOBASE = 12;
{ }
{ Attributes for p96GetModeIDAttr
}
P96IDA_WIDTH = 0;
P96IDA_HEIGHT = 1;
P96IDA_DEPTH = 2;
P96IDA_BYTESPERPIXEL = 3;
P96IDA_BITSPERPIXEL = 4;
P96IDA_RGBFORMAT = 5;
P96IDA_ISP96 = 6;
P96IDA_BOARDNUMBER = 7;
P96IDA_STDBYTESPERROW = 8;
P96IDA_BOARDNAME = 9;
P96IDA_COMPATIBLEFORMATS = 10;
P96IDA_VIDEOCOMPATIBLE = 11;
P96IDA_PABLOIVCOMPATIBLE = 12;
P96IDA_PALOMAIVCOMPATIBLE = 13;
{ }
{ Tags for p96BestModeIDTagList
}
P96BIDTAG_Dummy = TAG_USER + 96;
P96BIDTAG_FormatsAllowed = P96BIDTAG_Dummy + $0001;
P96BIDTAG_FormatsForbidden = P96BIDTAG_Dummy + $0002;
P96BIDTAG_NominalWidth = P96BIDTAG_Dummy + $0003;
P96BIDTAG_NominalHeight = P96BIDTAG_Dummy + $0004;
P96BIDTAG_Depth = P96BIDTAG_Dummy + $0005;
P96BIDTAG_VideoCompatible = P96BIDTAG_Dummy + $0006;
P96BIDTAG_PabloIVCompatible = P96BIDTAG_Dummy + $0007;
P96BIDTAG_PalomaIVCompatible = P96BIDTAG_Dummy + $0008;
{ }
{ Tags for p96RequestModeIDTagList
}
P96MA_Dummy = (TAG_USER + $10000) + 96;
P96MA_MinWidth = P96MA_Dummy + $0001;
P96MA_MinHeight = P96MA_Dummy + $0002;
P96MA_MinDepth = P96MA_Dummy + $0003;
P96MA_MaxWidth = P96MA_Dummy + $0004;
P96MA_MaxHeight = P96MA_Dummy + $0005;
P96MA_MaxDepth = P96MA_Dummy + $0006;
P96MA_DisplayID = P96MA_Dummy + $0007;
P96MA_FormatsAllowed = P96MA_Dummy + $0008;
P96MA_FormatsForbidden = P96MA_Dummy + $0009;
P96MA_WindowTitle = P96MA_Dummy + $000a;
P96MA_OKText = P96MA_Dummy + $000b;
P96MA_CancelText = P96MA_Dummy + $000c;
P96MA_Window = P96MA_Dummy + $000d;
P96MA_PubScreenName = P96MA_Dummy + $000e;
P96MA_Screen = P96MA_Dummy + $000f;
P96MA_VideoCompatible = P96MA_Dummy + $0010;
P96MA_PabloIVCompatible = P96MA_Dummy + $0011;
P96MA_PalomaIVCompatible = P96MA_Dummy + $0012;
{ }
{ Tags for p96OpenScreenTagList
}
P96SA_Dummy = (TAG_USER + $20000) + 96;
P96SA_Left = P96SA_Dummy + $0001;
P96SA_Top = P96SA_Dummy + $0002;
P96SA_Width = P96SA_Dummy + $0003;
P96SA_Height = P96SA_Dummy + $0004;
P96SA_Depth = P96SA_Dummy + $0005;
P96SA_DetailPen = P96SA_Dummy + $0006;
P96SA_BlockPen = P96SA_Dummy + $0007;
P96SA_Title = P96SA_Dummy + $0008;
P96SA_Colors = P96SA_Dummy + $0009;
P96SA_ErrorCode = P96SA_Dummy + $000a;
P96SA_Font = P96SA_Dummy + $000b;
P96SA_SysFont = P96SA_Dummy + $000c;
P96SA_Type = P96SA_Dummy + $000d;
P96SA_BitMap = P96SA_Dummy + $000e;
P96SA_PubName = P96SA_Dummy + $000f;
P96SA_PubSig = P96SA_Dummy + $0010;
P96SA_PubTask = P96SA_Dummy + $0011;
P96SA_DisplayID = P96SA_Dummy + $0012;
P96SA_DClip = P96SA_Dummy + $0013;
P96SA_ShowTitle = P96SA_Dummy + $0014;
P96SA_Behind = P96SA_Dummy + $0015;
P96SA_Quiet = P96SA_Dummy + $0016;
P96SA_AutoScroll = P96SA_Dummy + $0017;
P96SA_Pens = P96SA_Dummy + $0018;
P96SA_SharePens = P96SA_Dummy + $0019;
P96SA_BackFill = P96SA_Dummy + $001a;
P96SA_Colors32 = P96SA_Dummy + $001b;
P96SA_VideoControl = P96SA_Dummy + $001c;
P96SA_RGBFormat = P96SA_Dummy + $001d;
P96SA_NoSprite = P96SA_Dummy + $001e;
P96SA_NoMemory = P96SA_Dummy + $001f;
P96SA_RenderFunc = P96SA_Dummy + $0020;
P96SA_SaveFunc = P96SA_Dummy + $0021;
P96SA_UserData = P96SA_Dummy + $0022;
P96SA_Alignment = P96SA_Dummy + $0023;
P96SA_FixedScreen = P96SA_Dummy + $0024;
P96SA_Exclusive = P96SA_Dummy + $0025;
P96SA_ConstantBytesPerRow = P96SA_Dummy + $0026;
{ }
{
}
MODENAMELENGTH = 48;
type
pubyte = ^ubyte;
PP96Mode = ^TP96Mode;
TP96Mode = record
Node : tNode;
Description : array[0..(MODENAMELENGTH)-1] of char;
Width : UWORD;
Height : UWORD;
Depth : UWORD;
DisplayID : ULONG;
end;
{ }
{ Structure to describe graphics data
short description of the entries:
Memory: pointer to graphics data
BytesPerRow: distance in bytes between one pixel and its neighbour up
or down.
pad: private, not used.
RGBFormat: RGBFormat of the data.
}
PRenderInfo = ^TRenderInfo;
TRenderInfo = record
Memory : APTR;
BytesPerRow : WORD;
pad : WORD;
RGBFormat : RGBFTYPE;
end;
{ }
{ Structure for p96WriteTrueColorData() and p96ReadTrueColorData()
short description of the entries:
PixelDistance: distance in bytes between the red (must be the same as
for the green or blue) component of one pixel and its
next neighbour to the left or right.
BytesPerRow: distance in bytes between the red (must be the same as
for the green or blue) component of one pixel and its
next neighbour up or down.
RedData: pointer to the red component of the upper left pixel.
GreenData, BlueData: the same as above.
examples (for an array width of 640 pixels):
a) separate arrays for each color:
(1, 640, red, green, blue );
b) plain 24 bit RGB data:
(3, 640 3, array, array+1, array+2 );
c) 24 bit data, arranged as ARGB:
(4, 640 4, array+1, array+2, array+3 );
}
PTrueColorInfo = ^TTrueColorInfo;
TTrueColorInfo = record
PixelDistance : ULONG;
BytesPerRow : ULONG;
RedData : PUBYTE;
GreenData : PUBYTE;
BlueData : PUBYTE;
end;
{ }
{ Tags for PIPs
}
const
P96PIP_Dummy = (TAG_USER + $30000) + 96;
{ RGBFTYPE (I) }
P96PIP_SourceFormat = P96PIP_Dummy + 1;
{ struct BitMap (G) }
P96PIP_SourceBitMap = P96PIP_Dummy + 2;
{ struct RastPort (G) }
P96PIP_SourceRPort = P96PIP_Dummy + 3;
{ ULONG (I) }
P96PIP_SourceWidth = P96PIP_Dummy + 4;
{ ULONG (I) }
P96PIP_SourceHeight = P96PIP_Dummy + 5;
{ ULONG (I) default: PIPT_MemoryWindow }
P96PIP_Type = P96PIP_Dummy + 6;
{ LONG (I) }
P96PIP_ErrorCode = P96PIP_Dummy + 7;
{ ULONG (IGS) default: 0 }
P96PIP_Brightness = P96PIP_Dummy + 8;
{ ULONG (I) default: 0 }
P96PIP_Left = P96PIP_Dummy + 9;
{ ULONG (I) default: 0 }
P96PIP_Top = P96PIP_Dummy + 10;
{ ULONG (I) default: inner width of window }
P96PIP_Width = P96PIP_Dummy + 11;
{ ULONG (I) default: inner height of window }
P96PIP_Height = P96PIP_Dummy + 12;
{ ULONG (I) default: PIPRel_Width|PIPRel_Height }
P96PIP_Relativity = P96PIP_Dummy + 13;
{ struct ColorSpec (IS)
ti_Data is an array of struct ColorSpec,
terminated by ColorIndex = -1. Specifies
initial screen palette colors.
Also see P96PIP_Colors32.
This only works with CLUT PIPs on non-CLUT
screens. For CLUT PIPs on CLUT screens the
PIP colors share the screen palette.
}
P96PIP_Colors = P96PIP_Dummy + 14;
{ ULONG (IS)
Tag to set the palette colors at 32 bits-per-gun.
ti_Data is a pointer to a table to be passed to
the graphics.library/LoadRGB32() function.
This format supports both runs of color
registers and sparse registers. See the
autodoc for that function for full details.
Any color set here has precedence over
the same register set by P96PIP_Colors.
This only works with CLUT PIPs on non-CLUT
screens. For CLUT PIPs on CLUT screens the
PIP colors share the screen palette.
}
P96PIP_Colors32 = P96PIP_Dummy + 15;
P96PIP_NoMemory = P96PIP_Dummy + 16;
P96PIP_RenderFunc = P96PIP_Dummy + 17;
P96PIP_SaveFunc = P96PIP_Dummy + 18;
P96PIP_UserData = P96PIP_Dummy + 19;
P96PIP_Alignment = P96PIP_Dummy + 20;
P96PIP_ConstantBytesPerRow = P96PIP_Dummy + 21;
P96PIP_AllowCropping = P96PIP_Dummy + 22;
P96PIP_InitialIntScaling = P96PIP_Dummy + 23;
PIPT_MemoryWindow = 0;
PIPT_VideoWindow = 1;
PIPT_NUMTYPES = 2;
P96PIPT_MemoryWindow = PIPT_MemoryWindow;
P96PIPT_VideoWindow = PIPT_VideoWindow;
{ P96PIP_Left is relative to the right side (negative value) }
PIPRel_Right = 1;
{ P96PIP_Top is relative to the bottom (negative value) }
PIPRel_Bottom = 2;
{ P96PIP_Width is amount of pixels not used by PIP at the
right side of the window (negative value) }
PIPRel_Width = 4;
{ P96PIP_Height is amount of pixels not used by PIP at the
window bottom (negative value) }
PIPRel_Height = 8;
{ couldn't get normal memory }
PIPERR_NOMEMORY = 1;
{ Failed to attach to a screen }
PIPERR_ATTACHFAIL = 2;
{ PIP not available for other reason }
PIPERR_NOTAVAILABLE = 3;
{ couldn't get a free pen for occlusion }
PIPERR_OUTOFPENS = 4;
{ type, width, height or format invalid }
PIPERR_BADDIMENSIONS = 5;
{ couldn't open window }
PIPERR_NOWINDOW = 6;
{ specified alignment is not ok }
PIPERR_BADALIGNMENT = 7;
{ pip would be cropped, but isn't allowed to }
PIPERR_CROPPED = 8;
{ }
{ Tags for P96GetRTGDataTagList
}
P96RD_Dummy = (TAG_USER + $40000) + 96;
P96RD_NumberOfBoards = P96RD_Dummy + 1;
{ }
{ Tags for P96GetBoardDataTagList
}
P96BD_Dummy = (TAG_USER + $50000) + 96;
P96BD_BoardName = P96BD_Dummy + 1;
P96BD_ChipName = P96BD_Dummy + 2;
P96BD_TotalMemory = P96BD_Dummy + 4;
P96BD_FreeMemory = P96BD_Dummy + 5;
P96BD_LargestFreeMemory = P96BD_Dummy + 6;
P96BD_MonitorSwitch = P96BD_Dummy + 7;
P96BD_RGBFormats = P96BD_Dummy + 8;
P96BD_MemoryClock = P96BD_Dummy + 9;
{ }
{ }
VAR P96Base : pLibrary;
FUNCTION p96AllocBitMap(SizeX : Ulong; SizeY : Ulong; Depth : Ulong; Flags : Ulong; Friend : pBitMap; RGBFormat : RGBFTYPE) : pBitMap;
PROCEDURE p96FreeBitMap(BitMap : pBitMap);
FUNCTION p96GetBitMapAttr(BitMap : pBitMap; Attribute : Ulong) : Ulong;
FUNCTION p96LockBitMap(BitMap : pBitMap; Buffer : pCHAR; Size : Ulong) : LONGINT;
PROCEDURE p96UnlockBitMap(BitMap : pBitMap; Lock : LONGINT);
FUNCTION p96BestModeIDTagList(Tags : pTagItem) : Ulong;
FUNCTION p96RequestModeIDTagList(Tags : pTagItem) : Ulong;
FUNCTION p96AllocModeListTagList(Tags : pTagItem) : pList;
PROCEDURE p96FreeModeList(List : pList);
FUNCTION p96GetModeIDAttr(Mode : Ulong; Attribute : Ulong) : Ulong;
FUNCTION p96OpenScreenTagList(Tags : pTagItem) : pScreen;
FUNCTION p96CloseScreen(Screen : pScreen) : BOOLEAN;
PROCEDURE p96WritePixelArray(ri : pRenderInfo; SrcX : WORD; SrcY : WORD; rp : pRastPort; DestX : WORD; DestY : WORD; SizeX : WORD; SizeY : WORD);
PROCEDURE p96ReadPixelArray(ri : pRenderInfo; DestX : WORD; DestY : WORD; rp : pRastPort; SrcX : WORD; SrcY : WORD; SizeX : WORD; SizeY : WORD);
FUNCTION p96WritePixel(rp : pRastPort; x : WORD; y : WORD; color : Ulong) : Ulong;
FUNCTION p96ReadPixel(rp : pRastPort; x : WORD; y : WORD) : Ulong;
PROCEDURE p96RectFill(rp : pRastPort; MinX : WORD; MinY : WORD; MaxX : WORD; MaxY : WORD; color : Ulong);
PROCEDURE p96WriteTrueColorData(tci : pTrueColorInfo; SrcX : WORD; SrcY : WORD; rp : pRastPort; DestX : WORD; DestY : WORD; SizeX : WORD; SizeY : WORD);
PROCEDURE p96ReadTrueColorData(tci : pTrueColorInfo; DestX : WORD; DestY : WORD; rp : pRastPort; SrcX : WORD; SrcY : WORD; SizeX : WORD; SizeY : WORD);
FUNCTION p96PIP_OpenTagList(Tags : pTagItem) : pWindow;
FUNCTION p96PIP_Close(Window : pWindow) : BOOLEAN;
FUNCTION p96PIP_SetTagList(Window : pWindow; Tags : pTagItem) : LONGINT;
FUNCTION p96PIP_GetTagList(Window : pWindow; Tags : pTagItem) : LONGINT;
FUNCTION p96GetRTGDataTagList(Tags : pTagItem) : LONGINT;
FUNCTION p96GetBoardDataTagList(Board : Ulong; Tags : pTagItem) : LONGINT;
FUNCTION p96EncodeColor(RGBFormat : RGBFTYPE; Color : Ulong) : Ulong;
{
Functions and procedures with array of const go here
}
FUNCTION p96BestModeIDTags(const Tags : Array Of Const) : longword;
FUNCTION p96RequestModeIDTags(const Tags : Array Of Const) : longword;
FUNCTION p96AllocModeListTags(const Tags : Array Of Const) : pList;
FUNCTION p96OpenScreenTags(const Tags : Array Of Const) : pScreen;
FUNCTION p96PIP_OpenTags(const Tags : Array Of Const) : pWindow;
FUNCTION p96PIP_SetTags(Window : pWindow; const Tags : Array Of Const) : LONGINT;
FUNCTION p96PIP_GetTags(Window : pWindow; const Tags : Array Of Const) : LONGINT;
FUNCTION p96GetRTGDataTags(const Tags : Array Of Const) : LONGINT;
FUNCTION p96GetBoardDataTags(Board : longword; const Tags : Array Of Const) : LONGINT;
{You can remove this include and use a define instead}
{$I useautoopenlib.inc}
{$ifdef use_init_openlib}
procedure InitPICASSO96APILibrary;
{$endif use_init_openlib}
{This is a variable that knows how the unit is compiled}
var
PICASSO96APIIsCompiledHow : longint;
IMPLEMENTATION
uses
{$ifndef dont_use_openlib}
msgbox,
{$endif dont_use_openlib}
tagsarray;
FUNCTION p96AllocBitMap(SizeX : Ulong; SizeY : Ulong; Depth : Ulong; Flags : Ulong; Friend : pBitMap; RGBFormat : RGBFTYPE) : pBitMap;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVE.L SizeX,D0
MOVE.L SizeY,D1
MOVE.L Depth,D2
MOVE.L Flags,D3
MOVEA.L Friend,A0
MOVE.L RGBFormat,D7
MOVEA.L P96Base,A6
JSR -030(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE p96FreeBitMap(BitMap : pBitMap);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L BitMap,A0
MOVEA.L P96Base,A6
JSR -036(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION p96GetBitMapAttr(BitMap : pBitMap; Attribute : Ulong) : Ulong;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L BitMap,A0
MOVE.L Attribute,D0
MOVEA.L P96Base,A6
JSR -042(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION p96LockBitMap(BitMap : pBitMap; Buffer : pCHAR; Size : Ulong) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L BitMap,A0
MOVEA.L Buffer,A1
MOVE.L Size,D0
MOVEA.L P96Base,A6
JSR -048(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE p96UnlockBitMap(BitMap : pBitMap; Lock : LONGINT);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L BitMap,A0
MOVE.L Lock,D0
MOVEA.L P96Base,A6
JSR -054(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION p96BestModeIDTagList(Tags : pTagItem) : Ulong;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L Tags,A0
MOVEA.L P96Base,A6
JSR -060(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION p96RequestModeIDTagList(Tags : pTagItem) : Ulong;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L Tags,A0
MOVEA.L P96Base,A6
JSR -066(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION p96AllocModeListTagList(Tags : pTagItem) : pList;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L Tags,A0
MOVEA.L P96Base,A6
JSR -072(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE p96FreeModeList(List : pList);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L List,A0
MOVEA.L P96Base,A6
JSR -078(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION p96GetModeIDAttr(Mode : Ulong; Attribute : Ulong) : Ulong;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVE.L Mode,D0
MOVE.L Attribute,D1
MOVEA.L P96Base,A6
JSR -084(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION p96OpenScreenTagList(Tags : pTagItem) : pScreen;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L Tags,A0
MOVEA.L P96Base,A6
JSR -090(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION p96CloseScreen(Screen : pScreen) : BOOLEAN;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L Screen,A0
MOVEA.L P96Base,A6
JSR -096(A6)
MOVEA.L (A7)+,A6
TST.W D0
BEQ.B @end
MOVEQ #1,D0
@end: MOVE.B D0,@RESULT
END;
END;
PROCEDURE p96WritePixelArray(ri : pRenderInfo; SrcX : WORD; SrcY : WORD; rp : pRastPort; DestX : WORD; DestY : WORD; SizeX : WORD; SizeY : WORD);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L ri,A0
MOVE.L SrcX,D0
MOVE.L SrcY,D1
MOVEA.L rp,A1
MOVE.L DestX,D2
MOVE.L DestY,D3
MOVE.L SizeX,D4
MOVE.L SizeY,D5
MOVEA.L P96Base,A6
JSR -102(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE p96ReadPixelArray(ri : pRenderInfo; DestX : WORD; DestY : WORD; rp : pRastPort; SrcX : WORD; SrcY : WORD; SizeX : WORD; SizeY : WORD);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L ri,A0
MOVE.L DestX,D0
MOVE.L DestY,D1
MOVEA.L rp,A1
MOVE.L SrcX,D2
MOVE.L SrcY,D3
MOVE.L SizeX,D4
MOVE.L SizeY,D5
MOVEA.L P96Base,A6
JSR -108(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION p96WritePixel(rp : pRastPort; x : WORD; y : WORD; color : Ulong) : Ulong;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L rp,A1
MOVE.L x,D0
MOVE.L y,D1
MOVE.L color,D2
MOVEA.L P96Base,A6
JSR -114(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION p96ReadPixel(rp : pRastPort; x : WORD; y : WORD) : Ulong;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L rp,A1
MOVE.L x,D0
MOVE.L y,D1
MOVEA.L P96Base,A6
JSR -120(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE p96RectFill(rp : pRastPort; MinX : WORD; MinY : WORD; MaxX : WORD; MaxY : WORD; color : Ulong);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L rp,A1
MOVE.L MinX,D0
MOVE.L MinY,D1
MOVE.L MaxX,D2
MOVE.L MaxY,D3
MOVE.L color,D4
MOVEA.L P96Base,A6
JSR -126(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE p96WriteTrueColorData(tci : pTrueColorInfo; SrcX : WORD; SrcY : WORD; rp : pRastPort; DestX : WORD; DestY : WORD; SizeX : WORD; SizeY : WORD);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L tci,A0
MOVE.L SrcX,D0
MOVE.L SrcY,D1
MOVEA.L rp,A1
MOVE.L DestX,D2
MOVE.L DestY,D3
MOVE.L SizeX,D4
MOVE.L SizeY,D5
MOVEA.L P96Base,A6
JSR -132(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE p96ReadTrueColorData(tci : pTrueColorInfo; DestX : WORD; DestY : WORD; rp : pRastPort; SrcX : WORD; SrcY : WORD; SizeX : WORD; SizeY : WORD);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L tci,A0
MOVE.L DestX,D0
MOVE.L DestY,D1
MOVEA.L rp,A1
MOVE.L SrcX,D2
MOVE.L SrcY,D3
MOVE.L SizeX,D4
MOVE.L SizeY,D5
MOVEA.L P96Base,A6
JSR -138(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION p96PIP_OpenTagList(Tags : pTagItem) : pWindow;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L Tags,A0
MOVEA.L P96Base,A6
JSR -144(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION p96PIP_Close(Window : pWindow) : BOOLEAN;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L Window,A0
MOVEA.L P96Base,A6
JSR -150(A6)
MOVEA.L (A7)+,A6
TST.W D0
BEQ.B @end
MOVEQ #1,D0
@end: MOVE.B D0,@RESULT
END;
END;
FUNCTION p96PIP_SetTagList(Window : pWindow; Tags : pTagItem) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L Window,A0
MOVEA.L Tags,A1
MOVEA.L P96Base,A6
JSR -156(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION p96PIP_GetTagList(Window : pWindow; Tags : pTagItem) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L Window,A0
MOVEA.L Tags,A1
MOVEA.L P96Base,A6
JSR -162(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION p96GetRTGDataTagList(Tags : pTagItem) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L Tags,A0
MOVEA.L P96Base,A6
JSR -180(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION p96GetBoardDataTagList(Board : Ulong; Tags : pTagItem) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVE.L Board,D0
MOVEA.L Tags,A0
MOVEA.L P96Base,A6
JSR -186(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION p96EncodeColor(RGBFormat : RGBFTYPE; Color : Ulong) : Ulong;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVE.L RGBFormat,D0
MOVE.L Color,D1
MOVEA.L P96Base,A6
JSR -192(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
{
Functions and procedures with array of const go here
}
FUNCTION p96BestModeIDTags(const Tags : Array Of Const) : longword;
begin
p96BestModeIDTags := p96BestModeIDTagList(readintags(Tags));
end;
FUNCTION p96RequestModeIDTags(const Tags : Array Of Const) : longword;
begin
p96RequestModeIDTags := p96RequestModeIDTagList(readintags(Tags));
end;
FUNCTION p96AllocModeListTags(const Tags : Array Of Const) : pList;
begin
p96AllocModeListTags := p96AllocModeListTagList(readintags(Tags));
end;
FUNCTION p96OpenScreenTags(const Tags : Array Of Const) : pScreen;
begin
p96OpenScreenTags := p96OpenScreenTagList(readintags(Tags));
end;
FUNCTION p96PIP_OpenTags(const Tags : Array Of Const) : pWindow;
begin
p96PIP_OpenTags := p96PIP_OpenTagList(readintags(Tags));
end;
FUNCTION p96PIP_SetTags(Window : pWindow; const Tags : Array Of Const) : LONGINT;
begin
p96PIP_SetTags := p96PIP_SetTagList(Window , readintags(Tags));
end;
FUNCTION p96PIP_GetTags(Window : pWindow; const Tags : Array Of Const) : LONGINT;
begin
p96PIP_GetTags := p96PIP_GetTagList(Window , readintags(Tags));
end;
FUNCTION p96GetRTGDataTags(const Tags : Array Of Const) : LONGINT;
begin
p96GetRTGDataTags := p96GetRTGDataTagList(readintags(Tags));
end;
FUNCTION p96GetBoardDataTags(Board : longword; const Tags : Array Of Const) : LONGINT;
begin
p96GetBoardDataTags := p96GetBoardDataTagList(Board , readintags(Tags));
end;
const
{ Change VERSION and LIBVERSION to proper values }
VERSION : string[2] = '0';
LIBVERSION : longword = 0;
{$ifdef use_init_openlib}
{$Info Compiling initopening of picasso96api.library}
{$Info don't forget to use InitPICASSO96APILibrary in the beginning of your program}
var
picasso96api_exit : Pointer;
procedure Closepicasso96apiLibrary;
begin
ExitProc := picasso96api_exit;
if P96Base <> nil then begin
CloseLibrary(P96Base);
P96Base := nil;
end;
end;
procedure InitPICASSO96APILibrary;
begin
P96Base := nil;
P96Base := OpenLibrary(PICASSO96APINAME,LIBVERSION);
if P96Base <> nil then begin
picasso96api_exit := ExitProc;
ExitProc := @Closepicasso96apiLibrary;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open picasso96api.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end;
end;
begin
PICASSO96APIIsCompiledHow := 2;
{$endif use_init_openlib}
{$ifdef use_auto_openlib}
{$Info Compiling autoopening of picasso96api.library}
var
picasso96api_exit : Pointer;
procedure Closepicasso96apiLibrary;
begin
ExitProc := picasso96api_exit;
if P96Base <> nil then begin
CloseLibrary(P96Base);
P96Base := nil;
end;
end;
begin
P96Base := nil;
P96Base := OpenLibrary(PICASSO96APINAME,LIBVERSION);
if P96Base <> nil then begin
picasso96api_exit := ExitProc;
ExitProc := @Closepicasso96apiLibrary;
PICASSO96APIIsCompiledHow := 1;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open picasso96api.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end;
{$endif use_auto_openlib}
{$ifdef dont_use_openlib}
begin
PICASSO96APIIsCompiledHow := 3;
{$Warning No autoopening of picasso96api.library compiled}
{$Warning Make sure you open picasso96api.library yourself}
{$endif dont_use_openlib}
END. (* UNIT PICASSO96API *)
{
$Log
}
syntax highlighted by Code2HTML, v. 0.9.1