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