123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964 |
- {
- 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.
- [email protected]
- }
- {$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 *)
|