{
This file is part of the Free Pascal run time library.
A file in Amiga system run time library.
Copyright (c) 1998-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:
Added the defines use_amiga_smartlink and
use_auto_openlib. Implemented autoopening
of the library.
14 Jan 2003.
Update for AmigaOS 3.9.
Changed start code for unit.
06 Feb 2003.
Changed integer > smallint,
cardinal > longword.
09 Feb 2003.
nils.sjoholm@mailbox.swipnet.se
}
{$I useamigasmartlink.inc}
{$ifdef use_amiga_smartlink}
{$smartlink on}
{$endif use_amiga_smartlink}
UNIT layers;
INTERFACE
USES exec, graphics, utility;
const
LAYERSIMPLE = 1;
LAYERSMART = 2;
LAYERSUPER = 4;
LAYERUPDATING = $10;
LAYERBACKDROP = $40;
LAYERREFRESH = $80;
LAYER_CLIPRECTS_LOST = $100; { during BeginUpdate }
{ or during layerop }
{ this happens if out of memory }
LMN_REGION = -1;
type
pLayer_Info = ^tLayer_Info;
tLayer_Info = record
top_layer : pLayer;
check_lp : pLayer; { !! Private !! }
obs : pClipRect;
FreeClipRects : pClipRect; { !! Private !! }
PrivateReserve1, { !! Private !! }
PrivateReserve2 : Longint; { !! Private !! }
Lock : tSignalSemaphore; { !! Private !! }
gs_Head : tMinList; { !! Private !! }
PrivateReserve3 : smallint; { !! Private !! }
PrivateReserve4 : Pointer; { !! Private !! }
Flags : WORD;
fatten_count : Shortint; { !! Private !! }
LockLayersCount : Shortint; { !! Private !! }
PrivateReserve5 : smallint; { !! Private !! }
BlankHook, { !! Private !! }
LayerInfo_extra : Pointer; { !! Private !! }
end;
const
NEWLAYERINFO_CALLED = 1;
{
* LAYERS_NOBACKFILL is the value needed to get no backfill hook
* LAYERS_BACKFILL is the value needed to get the default backfill hook
}
LAYERS_NOBACKFILL = 1;
LAYERS_BACKFILL = 0;
LAYERSNAME : PChar = 'layers.library';
VAR LayersBase : pLibrary;
FUNCTION BeginUpdate(l : pLayer) : LONGINT;
FUNCTION BehindLayer(dummy : LONGINT; layer : pLayer) : LONGINT;
FUNCTION CreateBehindHookLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; hook : pHook; bm2 : pBitMap) : pLayer;
FUNCTION CreateBehindLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; bm2 : pBitMap) : pLayer;
FUNCTION CreateUpfrontHookLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; hook : pHook; bm2 : pBitMap) : pLayer;
FUNCTION CreateUpfrontLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; bm2 : pBitMap) : pLayer;
FUNCTION DeleteLayer(dummy : LONGINT; layer : pLayer) : LONGINT;
PROCEDURE DisposeLayerInfo(li : pLayer_Info);
PROCEDURE DoHookClipRects(hook : pHook; rport : pRastPort;const rect : pRectangle);
PROCEDURE EndUpdate(layer : pLayer; flag : ULONG);
FUNCTION FattenLayerInfo(li : pLayer_Info) : LONGINT;
PROCEDURE InitLayers(li : pLayer_Info);
FUNCTION InstallClipRegion(layer : pLayer;const region : pRegion) : pRegion;
FUNCTION InstallLayerHook(layer : pLayer; hook : pHook) : pHook;
FUNCTION InstallLayerInfoHook(li : pLayer_Info;const hook : pHook) : pHook;
PROCEDURE LockLayer(dummy : LONGINT; layer : pLayer);
PROCEDURE LockLayerInfo(li : pLayer_Info);
PROCEDURE LockLayers(li : pLayer_Info);
FUNCTION MoveLayer(dummy : LONGINT; layer : pLayer; dx : LONGINT; dy : LONGINT) : LONGINT;
FUNCTION MoveLayerInFrontOf(layer_to_move : pLayer; other_layer : pLayer) : LONGINT;
FUNCTION MoveSizeLayer(layer : pLayer; dx : LONGINT; dy : LONGINT; dw : LONGINT; dh : LONGINT) : LONGINT;
FUNCTION NewLayerInfo : pLayer_Info;
PROCEDURE ScrollLayer(dummy : LONGINT; layer : pLayer; dx : LONGINT; dy : LONGINT);
FUNCTION SizeLayer(dummy : LONGINT; layer : pLayer; dx : LONGINT; dy : LONGINT) : LONGINT;
PROCEDURE SortLayerCR(layer : pLayer; dx : LONGINT; dy : LONGINT);
PROCEDURE SwapBitsRastPortClipRect(rp : pRastPort; cr : pClipRect);
PROCEDURE ThinLayerInfo(li : pLayer_Info);
PROCEDURE UnlockLayer(layer : pLayer);
PROCEDURE UnlockLayerInfo(li : pLayer_Info);
PROCEDURE UnlockLayers(li : pLayer_Info);
FUNCTION UpfrontLayer(dummy : LONGINT; layer : pLayer) : LONGINT;
FUNCTION WhichLayer(li : pLayer_Info; x : LONGINT; y : LONGINT) : pLayer;
{Here we read how to compile this unit}
{You can remove this include and use a define instead}
{$I useautoopenlib.inc}
{$ifdef use_init_openlib}
procedure InitLAYERSLibrary;
{$endif use_init_openlib}
{This is a variable that knows how the unit is compiled}
var
LAYERSIsCompiledHow : longint;
IMPLEMENTATION
uses
{$ifndef dont_use_openlib}
msgbox;
{$endif dont_use_openlib}
FUNCTION BeginUpdate(l : pLayer) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L l,A0
MOVEA.L LayersBase,A6
JSR -078(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION BehindLayer(dummy : LONGINT; layer : pLayer) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L dummy,A0
MOVEA.L layer,A1
MOVEA.L LayersBase,A6
JSR -054(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION CreateBehindHookLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; hook : pHook; bm2 : pBitMap) : pLayer;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L li,A0
MOVEA.L bm,A1
MOVE.L x0,D0
MOVE.L y0,D1
MOVE.L x1,D2
MOVE.L y1,D3
MOVE.L flags,D4
MOVEA.L hook,A3
MOVEA.L bm2,A2
MOVEA.L LayersBase,A6
JSR -192(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION CreateBehindLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; bm2 : pBitMap) : pLayer;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L li,A0
MOVEA.L bm,A1
MOVE.L x0,D0
MOVE.L y0,D1
MOVE.L x1,D2
MOVE.L y1,D3
MOVE.L flags,D4
MOVEA.L bm2,A2
MOVEA.L LayersBase,A6
JSR -042(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION CreateUpfrontHookLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; hook : pHook; bm2 : pBitMap) : pLayer;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L li,A0
MOVEA.L bm,A1
MOVE.L x0,D0
MOVE.L y0,D1
MOVE.L x1,D2
MOVE.L y1,D3
MOVE.L flags,D4
MOVEA.L hook,A3
MOVEA.L bm2,A2
MOVEA.L LayersBase,A6
JSR -186(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION CreateUpfrontLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; bm2 : pBitMap) : pLayer;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L li,A0
MOVEA.L bm,A1
MOVE.L x0,D0
MOVE.L y0,D1
MOVE.L x1,D2
MOVE.L y1,D3
MOVE.L flags,D4
MOVEA.L bm2,A2
MOVEA.L LayersBase,A6
JSR -036(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION DeleteLayer(dummy : LONGINT; layer : pLayer) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L dummy,A0
MOVEA.L layer,A1
MOVEA.L LayersBase,A6
JSR -090(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE DisposeLayerInfo(li : pLayer_Info);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L li,A0
MOVEA.L LayersBase,A6
JSR -150(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE DoHookClipRects(hook : pHook; rport : pRastPort;const rect : pRectangle);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L hook,A0
MOVEA.L rport,A1
MOVEA.L rect,A2
MOVEA.L LayersBase,A6
JSR -216(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE EndUpdate(layer : pLayer; flag : ULONG);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L layer,A0
MOVE.L flag,D0
MOVEA.L LayersBase,A6
JSR -084(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION FattenLayerInfo(li : pLayer_Info) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L li,A0
MOVEA.L LayersBase,A6
JSR -156(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE InitLayers(li : pLayer_Info);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L li,A0
MOVEA.L LayersBase,A6
JSR -030(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION InstallClipRegion(layer : pLayer;const region : pRegion) : pRegion;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L layer,A0
MOVEA.L region,A1
MOVEA.L LayersBase,A6
JSR -174(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION InstallLayerHook(layer : pLayer; hook : pHook) : pHook;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L layer,A0
MOVEA.L hook,A1
MOVEA.L LayersBase,A6
JSR -198(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION InstallLayerInfoHook(li : pLayer_Info;const hook : pHook) : pHook;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L li,A0
MOVEA.L hook,A1
MOVEA.L LayersBase,A6
JSR -204(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE LockLayer(dummy : LONGINT; layer : pLayer);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L dummy,A0
MOVEA.L layer,A1
MOVEA.L LayersBase,A6
JSR -096(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE LockLayerInfo(li : pLayer_Info);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L li,A0
MOVEA.L LayersBase,A6
JSR -120(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE LockLayers(li : pLayer_Info);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L li,A0
MOVEA.L LayersBase,A6
JSR -108(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION MoveLayer(dummy : LONGINT; layer : pLayer; dx : LONGINT; dy : LONGINT) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L dummy,A0
MOVEA.L layer,A1
MOVE.L dx,D0
MOVE.L dy,D1
MOVEA.L LayersBase,A6
JSR -060(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION MoveLayerInFrontOf(layer_to_move : pLayer; other_layer : pLayer) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L layer_to_move,A0
MOVEA.L other_layer,A1
MOVEA.L LayersBase,A6
JSR -168(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION MoveSizeLayer(layer : pLayer; dx : LONGINT; dy : LONGINT; dw : LONGINT; dh : LONGINT) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L layer,A0
MOVE.L dx,D0
MOVE.L dy,D1
MOVE.L dw,D2
MOVE.L dh,D3
MOVEA.L LayersBase,A6
JSR -180(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION NewLayerInfo : pLayer_Info;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L LayersBase,A6
JSR -144(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE ScrollLayer(dummy : LONGINT; layer : pLayer; dx : LONGINT; dy : LONGINT);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L dummy,A0
MOVEA.L layer,A1
MOVE.L dx,D0
MOVE.L dy,D1
MOVEA.L LayersBase,A6
JSR -072(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION SizeLayer(dummy : LONGINT; layer : pLayer; dx : LONGINT; dy : LONGINT) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L dummy,A0
MOVEA.L layer,A1
MOVE.L dx,D0
MOVE.L dy,D1
MOVEA.L LayersBase,A6
JSR -066(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE SortLayerCR(layer : pLayer; dx : LONGINT; dy : LONGINT);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L layer,A0
MOVE.L dx,D0
MOVE.L dy,D1
MOVEA.L LayersBase,A6
JSR -210(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE SwapBitsRastPortClipRect(rp : pRastPort; cr : pClipRect);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L rp,A0
MOVEA.L cr,A1
MOVEA.L LayersBase,A6
JSR -126(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE ThinLayerInfo(li : pLayer_Info);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L li,A0
MOVEA.L LayersBase,A6
JSR -162(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE UnlockLayer(layer : pLayer);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L layer,A0
MOVEA.L LayersBase,A6
JSR -102(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE UnlockLayerInfo(li : pLayer_Info);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L li,A0
MOVEA.L LayersBase,A6
JSR -138(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE UnlockLayers(li : pLayer_Info);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L li,A0
MOVEA.L LayersBase,A6
JSR -114(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION UpfrontLayer(dummy : LONGINT; layer : pLayer) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L dummy,A0
MOVEA.L layer,A1
MOVEA.L LayersBase,A6
JSR -048(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION WhichLayer(li : pLayer_Info; x : LONGINT; y : LONGINT) : pLayer;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L li,A0
MOVE.L x,D0
MOVE.L y,D1
MOVEA.L LayersBase,A6
JSR -132(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
const
{ Change VERSION and LIBVERSION to proper values }
VERSION : string[2] = '0';
LIBVERSION : longword = 0;
{$ifdef use_init_openlib}
{$Info Compiling initopening of layers.library}
{$Info don't forget to use InitLAYERSLibrary in the beginning of your program}
var
layers_exit : Pointer;
procedure CloselayersLibrary;
begin
ExitProc := layers_exit;
if LayersBase <> nil then begin
CloseLibrary(LayersBase);
LayersBase := nil;
end;
end;
procedure InitLAYERSLibrary;
begin
LayersBase := nil;
LayersBase := OpenLibrary(LAYERSNAME,LIBVERSION);
if LayersBase <> nil then begin
layers_exit := ExitProc;
ExitProc := @CloselayersLibrary;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open layers.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end;
end;
begin
LAYERSIsCompiledHow := 2;
{$endif use_init_openlib}
{$ifdef use_auto_openlib}
{$Info Compiling autoopening of layers.library}
var
layers_exit : Pointer;
procedure CloselayersLibrary;
begin
ExitProc := layers_exit;
if LayersBase <> nil then begin
CloseLibrary(LayersBase);
LayersBase := nil;
end;
end;
begin
LayersBase := nil;
LayersBase := OpenLibrary(LAYERSNAME,LIBVERSION);
if LayersBase <> nil then begin
layers_exit := ExitProc;
ExitProc := @CloselayersLibrary;
LAYERSIsCompiledHow := 1;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open layers.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end;
{$endif use_auto_openlib}
{$ifdef dont_use_openlib}
begin
LAYERSIsCompiledHow := 3;
{$Warning No autoopening of layers.library compiled}
{$Warning Make sure you open layers.library yourself}
{$endif dont_use_openlib}
END. (* UNIT LAYERS *)
{
$Log: layers.pas,v $
Revision 1.5 2003/02/10 17:59:46 nils
* fixes for delphi mode
Revision 1.4 2003/02/07 20:48:36 nils
* update for amigaos 3.9
* changed startcode for library
Revision 1.3 2003/01/14 18:46:04 nils
* added defines use_amia_smartlink and use_auto_openlib
* implemented autoopening of library
Revision 1.2 2002/11/19 18:47:46 nils
* update check internal log
}
syntax highlighted by Code2HTML, v. 0.9.1