/packages/amunits/src/coreunits/layers.pas
Pascal | 657 lines | 529 code | 65 blank | 63 comment | 6 complexity | 8aecdf8ea9f3ff982ebce37b5c1c0de3 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
1{ 2 This file is part of the Free Pascal run time library. 3 4 A file in Amiga system run time library. 5 Copyright (c) 1998-2003 by Nils Sjoholm 6 member of the Amiga RTL development team. 7 8 See the file COPYING.FPC, included in this distribution, 9 for details about the copyright. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 14 15 **********************************************************************} 16{ 17 History: 18 19 Added the defines use_amiga_smartlink and 20 use_auto_openlib. Implemented autoopening 21 of the library. 22 14 Jan 2003. 23 24 Update for AmigaOS 3.9. 25 Changed start code for unit. 26 06 Feb 2003. 27 28 Changed integer > smallint, 29 cardinal > longword. 30 09 Feb 2003. 31 32 nils.sjoholm@mailbox.swipnet.se 33} 34 35{$I useamigasmartlink.inc} 36{$ifdef use_amiga_smartlink} 37 {$smartlink on} 38{$endif use_amiga_smartlink} 39 40UNIT layers; 41 42INTERFACE 43USES exec, graphics, utility; 44 45const 46 47 LAYERSIMPLE = 1; 48 LAYERSMART = 2; 49 LAYERSUPER = 4; 50 LAYERUPDATING = $10; 51 LAYERBACKDROP = $40; 52 LAYERREFRESH = $80; 53 LAYER_CLIPRECTS_LOST = $100; { during BeginUpdate } 54 { or during layerop } 55 { this happens if out of memory } 56 LMN_REGION = -1; 57 58type 59 pLayer_Info = ^tLayer_Info; 60 tLayer_Info = record 61 top_layer : pLayer; 62 check_lp : pLayer; { !! Private !! } 63 obs : pClipRect; 64 FreeClipRects : pClipRect; { !! Private !! } 65 PrivateReserve1, { !! Private !! } 66 PrivateReserve2 : Longint; { !! Private !! } 67 Lock : tSignalSemaphore; { !! Private !! } 68 gs_Head : tMinList; { !! Private !! } 69 PrivateReserve3 : smallint; { !! Private !! } 70 PrivateReserve4 : Pointer; { !! Private !! } 71 Flags : WORD; 72 fatten_count : Shortint; { !! Private !! } 73 LockLayersCount : Shortint; { !! Private !! } 74 PrivateReserve5 : smallint; { !! Private !! } 75 BlankHook, { !! Private !! } 76 LayerInfo_extra : Pointer; { !! Private !! } 77 end; 78 79const 80 NEWLAYERINFO_CALLED = 1; 81 82{ 83 * LAYERS_NOBACKFILL is the value needed to get no backfill hook 84 * LAYERS_BACKFILL is the value needed to get the default backfill hook 85 } 86 LAYERS_NOBACKFILL = 1; 87 LAYERS_BACKFILL = 0; 88 89 LAYERSNAME : PChar = 'layers.library'; 90 91VAR LayersBase : pLibrary; 92 93FUNCTION BeginUpdate(l : pLayer) : LONGINT; 94FUNCTION BehindLayer(dummy : LONGINT; layer : pLayer) : LONGINT; 95FUNCTION CreateBehindHookLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; hook : pHook; bm2 : pBitMap) : pLayer; 96FUNCTION CreateBehindLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; bm2 : pBitMap) : pLayer; 97FUNCTION CreateUpfrontHookLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; hook : pHook; bm2 : pBitMap) : pLayer; 98FUNCTION CreateUpfrontLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; bm2 : pBitMap) : pLayer; 99FUNCTION DeleteLayer(dummy : LONGINT; layer : pLayer) : LONGINT; 100PROCEDURE DisposeLayerInfo(li : pLayer_Info); 101PROCEDURE DoHookClipRects(hook : pHook; rport : pRastPort;const rect : pRectangle); 102PROCEDURE EndUpdate(layer : pLayer; flag : ULONG); 103FUNCTION FattenLayerInfo(li : pLayer_Info) : LONGINT; 104PROCEDURE InitLayers(li : pLayer_Info); 105FUNCTION InstallClipRegion(layer : pLayer;const region : pRegion) : pRegion; 106FUNCTION InstallLayerHook(layer : pLayer; hook : pHook) : pHook; 107FUNCTION InstallLayerInfoHook(li : pLayer_Info;const hook : pHook) : pHook; 108PROCEDURE LockLayer(dummy : LONGINT; layer : pLayer); 109PROCEDURE LockLayerInfo(li : pLayer_Info); 110PROCEDURE LockLayers(li : pLayer_Info); 111FUNCTION MoveLayer(dummy : LONGINT; layer : pLayer; dx : LONGINT; dy : LONGINT) : LONGINT; 112FUNCTION MoveLayerInFrontOf(layer_to_move : pLayer; other_layer : pLayer) : LONGINT; 113FUNCTION MoveSizeLayer(layer : pLayer; dx : LONGINT; dy : LONGINT; dw : LONGINT; dh : LONGINT) : LONGINT; 114FUNCTION NewLayerInfo : pLayer_Info; 115PROCEDURE ScrollLayer(dummy : LONGINT; layer : pLayer; dx : LONGINT; dy : LONGINT); 116FUNCTION SizeLayer(dummy : LONGINT; layer : pLayer; dx : LONGINT; dy : LONGINT) : LONGINT; 117PROCEDURE SortLayerCR(layer : pLayer; dx : LONGINT; dy : LONGINT); 118PROCEDURE SwapBitsRastPortClipRect(rp : pRastPort; cr : pClipRect); 119PROCEDURE ThinLayerInfo(li : pLayer_Info); 120PROCEDURE UnlockLayer(layer : pLayer); 121PROCEDURE UnlockLayerInfo(li : pLayer_Info); 122PROCEDURE UnlockLayers(li : pLayer_Info); 123FUNCTION UpfrontLayer(dummy : LONGINT; layer : pLayer) : LONGINT; 124FUNCTION WhichLayer(li : pLayer_Info; x : LONGINT; y : LONGINT) : pLayer; 125 126{Here we read how to compile this unit} 127{You can remove this include and use a define instead} 128{$I useautoopenlib.inc} 129{$ifdef use_init_openlib} 130procedure InitLAYERSLibrary; 131{$endif use_init_openlib} 132 133{This is a variable that knows how the unit is compiled} 134var 135 LAYERSIsCompiledHow : longint; 136 137IMPLEMENTATION 138 139uses 140{$ifndef dont_use_openlib} 141msgbox; 142{$endif dont_use_openlib} 143 144FUNCTION BeginUpdate(l : pLayer) : LONGINT; 145BEGIN 146 ASM 147 MOVE.L A6,-(A7) 148 MOVEA.L l,A0 149 MOVEA.L LayersBase,A6 150 JSR -078(A6) 151 MOVEA.L (A7)+,A6 152 MOVE.L D0,@RESULT 153 END; 154END; 155 156FUNCTION BehindLayer(dummy : LONGINT; layer : pLayer) : LONGINT; 157BEGIN 158 ASM 159 MOVE.L A6,-(A7) 160 MOVEA.L dummy,A0 161 MOVEA.L layer,A1 162 MOVEA.L LayersBase,A6 163 JSR -054(A6) 164 MOVEA.L (A7)+,A6 165 MOVE.L D0,@RESULT 166 END; 167END; 168 169FUNCTION CreateBehindHookLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; hook : pHook; bm2 : pBitMap) : pLayer; 170BEGIN 171 ASM 172 MOVE.L A6,-(A7) 173 MOVEA.L li,A0 174 MOVEA.L bm,A1 175 MOVE.L x0,D0 176 MOVE.L y0,D1 177 MOVE.L x1,D2 178 MOVE.L y1,D3 179 MOVE.L flags,D4 180 MOVEA.L hook,A3 181 MOVEA.L bm2,A2 182 MOVEA.L LayersBase,A6 183 JSR -192(A6) 184 MOVEA.L (A7)+,A6 185 MOVE.L D0,@RESULT 186 END; 187END; 188 189FUNCTION CreateBehindLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; bm2 : pBitMap) : pLayer; 190BEGIN 191 ASM 192 MOVE.L A6,-(A7) 193 MOVEA.L li,A0 194 MOVEA.L bm,A1 195 MOVE.L x0,D0 196 MOVE.L y0,D1 197 MOVE.L x1,D2 198 MOVE.L y1,D3 199 MOVE.L flags,D4 200 MOVEA.L bm2,A2 201 MOVEA.L LayersBase,A6 202 JSR -042(A6) 203 MOVEA.L (A7)+,A6 204 MOVE.L D0,@RESULT 205 END; 206END; 207 208FUNCTION CreateUpfrontHookLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; hook : pHook; bm2 : pBitMap) : pLayer; 209BEGIN 210 ASM 211 MOVE.L A6,-(A7) 212 MOVEA.L li,A0 213 MOVEA.L bm,A1 214 MOVE.L x0,D0 215 MOVE.L y0,D1 216 MOVE.L x1,D2 217 MOVE.L y1,D3 218 MOVE.L flags,D4 219 MOVEA.L hook,A3 220 MOVEA.L bm2,A2 221 MOVEA.L LayersBase,A6 222 JSR -186(A6) 223 MOVEA.L (A7)+,A6 224 MOVE.L D0,@RESULT 225 END; 226END; 227 228FUNCTION CreateUpfrontLayer(li : pLayer_Info; bm : pBitMap; x0 : LONGINT; y0 : LONGINT; x1 : LONGINT; y1 : LONGINT; flags : LONGINT; bm2 : pBitMap) : pLayer; 229BEGIN 230 ASM 231 MOVE.L A6,-(A7) 232 MOVEA.L li,A0 233 MOVEA.L bm,A1 234 MOVE.L x0,D0 235 MOVE.L y0,D1 236 MOVE.L x1,D2 237 MOVE.L y1,D3 238 MOVE.L flags,D4 239 MOVEA.L bm2,A2 240 MOVEA.L LayersBase,A6 241 JSR -036(A6) 242 MOVEA.L (A7)+,A6 243 MOVE.L D0,@RESULT 244 END; 245END; 246 247FUNCTION DeleteLayer(dummy : LONGINT; layer : pLayer) : LONGINT; 248BEGIN 249 ASM 250 MOVE.L A6,-(A7) 251 MOVEA.L dummy,A0 252 MOVEA.L layer,A1 253 MOVEA.L LayersBase,A6 254 JSR -090(A6) 255 MOVEA.L (A7)+,A6 256 MOVE.L D0,@RESULT 257 END; 258END; 259 260PROCEDURE DisposeLayerInfo(li : pLayer_Info); 261BEGIN 262 ASM 263 MOVE.L A6,-(A7) 264 MOVEA.L li,A0 265 MOVEA.L LayersBase,A6 266 JSR -150(A6) 267 MOVEA.L (A7)+,A6 268 END; 269END; 270 271PROCEDURE DoHookClipRects(hook : pHook; rport : pRastPort;const rect : pRectangle); 272BEGIN 273 ASM 274 MOVE.L A6,-(A7) 275 MOVEA.L hook,A0 276 MOVEA.L rport,A1 277 MOVEA.L rect,A2 278 MOVEA.L LayersBase,A6 279 JSR -216(A6) 280 MOVEA.L (A7)+,A6 281 END; 282END; 283 284PROCEDURE EndUpdate(layer : pLayer; flag : ULONG); 285BEGIN 286 ASM 287 MOVE.L A6,-(A7) 288 MOVEA.L layer,A0 289 MOVE.L flag,D0 290 MOVEA.L LayersBase,A6 291 JSR -084(A6) 292 MOVEA.L (A7)+,A6 293 END; 294END; 295 296FUNCTION FattenLayerInfo(li : pLayer_Info) : LONGINT; 297BEGIN 298 ASM 299 MOVE.L A6,-(A7) 300 MOVEA.L li,A0 301 MOVEA.L LayersBase,A6 302 JSR -156(A6) 303 MOVEA.L (A7)+,A6 304 MOVE.L D0,@RESULT 305 END; 306END; 307 308PROCEDURE InitLayers(li : pLayer_Info); 309BEGIN 310 ASM 311 MOVE.L A6,-(A7) 312 MOVEA.L li,A0 313 MOVEA.L LayersBase,A6 314 JSR -030(A6) 315 MOVEA.L (A7)+,A6 316 END; 317END; 318 319FUNCTION InstallClipRegion(layer : pLayer;const region : pRegion) : pRegion; 320BEGIN 321 ASM 322 MOVE.L A6,-(A7) 323 MOVEA.L layer,A0 324 MOVEA.L region,A1 325 MOVEA.L LayersBase,A6 326 JSR -174(A6) 327 MOVEA.L (A7)+,A6 328 MOVE.L D0,@RESULT 329 END; 330END; 331 332FUNCTION InstallLayerHook(layer : pLayer; hook : pHook) : pHook; 333BEGIN 334 ASM 335 MOVE.L A6,-(A7) 336 MOVEA.L layer,A0 337 MOVEA.L hook,A1 338 MOVEA.L LayersBase,A6 339 JSR -198(A6) 340 MOVEA.L (A7)+,A6 341 MOVE.L D0,@RESULT 342 END; 343END; 344 345FUNCTION InstallLayerInfoHook(li : pLayer_Info;const hook : pHook) : pHook; 346BEGIN 347 ASM 348 MOVE.L A6,-(A7) 349 MOVEA.L li,A0 350 MOVEA.L hook,A1 351 MOVEA.L LayersBase,A6 352 JSR -204(A6) 353 MOVEA.L (A7)+,A6 354 MOVE.L D0,@RESULT 355 END; 356END; 357 358PROCEDURE LockLayer(dummy : LONGINT; layer : pLayer); 359BEGIN 360 ASM 361 MOVE.L A6,-(A7) 362 MOVEA.L dummy,A0 363 MOVEA.L layer,A1 364 MOVEA.L LayersBase,A6 365 JSR -096(A6) 366 MOVEA.L (A7)+,A6 367 END; 368END; 369 370PROCEDURE LockLayerInfo(li : pLayer_Info); 371BEGIN 372 ASM 373 MOVE.L A6,-(A7) 374 MOVEA.L li,A0 375 MOVEA.L LayersBase,A6 376 JSR -120(A6) 377 MOVEA.L (A7)+,A6 378 END; 379END; 380 381PROCEDURE LockLayers(li : pLayer_Info); 382BEGIN 383 ASM 384 MOVE.L A6,-(A7) 385 MOVEA.L li,A0 386 MOVEA.L LayersBase,A6 387 JSR -108(A6) 388 MOVEA.L (A7)+,A6 389 END; 390END; 391 392FUNCTION MoveLayer(dummy : LONGINT; layer : pLayer; dx : LONGINT; dy : LONGINT) : LONGINT; 393BEGIN 394 ASM 395 MOVE.L A6,-(A7) 396 MOVEA.L dummy,A0 397 MOVEA.L layer,A1 398 MOVE.L dx,D0 399 MOVE.L dy,D1 400 MOVEA.L LayersBase,A6 401 JSR -060(A6) 402 MOVEA.L (A7)+,A6 403 MOVE.L D0,@RESULT 404 END; 405END; 406 407FUNCTION MoveLayerInFrontOf(layer_to_move : pLayer; other_layer : pLayer) : LONGINT; 408BEGIN 409 ASM 410 MOVE.L A6,-(A7) 411 MOVEA.L layer_to_move,A0 412 MOVEA.L other_layer,A1 413 MOVEA.L LayersBase,A6 414 JSR -168(A6) 415 MOVEA.L (A7)+,A6 416 MOVE.L D0,@RESULT 417 END; 418END; 419 420FUNCTION MoveSizeLayer(layer : pLayer; dx : LONGINT; dy : LONGINT; dw : LONGINT; dh : LONGINT) : LONGINT; 421BEGIN 422 ASM 423 MOVE.L A6,-(A7) 424 MOVEA.L layer,A0 425 MOVE.L dx,D0 426 MOVE.L dy,D1 427 MOVE.L dw,D2 428 MOVE.L dh,D3 429 MOVEA.L LayersBase,A6 430 JSR -180(A6) 431 MOVEA.L (A7)+,A6 432 MOVE.L D0,@RESULT 433 END; 434END; 435 436FUNCTION NewLayerInfo : pLayer_Info; 437BEGIN 438 ASM 439 MOVE.L A6,-(A7) 440 MOVEA.L LayersBase,A6 441 JSR -144(A6) 442 MOVEA.L (A7)+,A6 443 MOVE.L D0,@RESULT 444 END; 445END; 446 447PROCEDURE ScrollLayer(dummy : LONGINT; layer : pLayer; dx : LONGINT; dy : LONGINT); 448BEGIN 449 ASM 450 MOVE.L A6,-(A7) 451 MOVEA.L dummy,A0 452 MOVEA.L layer,A1 453 MOVE.L dx,D0 454 MOVE.L dy,D1 455 MOVEA.L LayersBase,A6 456 JSR -072(A6) 457 MOVEA.L (A7)+,A6 458 END; 459END; 460 461FUNCTION SizeLayer(dummy : LONGINT; layer : pLayer; dx : LONGINT; dy : LONGINT) : LONGINT; 462BEGIN 463 ASM 464 MOVE.L A6,-(A7) 465 MOVEA.L dummy,A0 466 MOVEA.L layer,A1 467 MOVE.L dx,D0 468 MOVE.L dy,D1 469 MOVEA.L LayersBase,A6 470 JSR -066(A6) 471 MOVEA.L (A7)+,A6 472 MOVE.L D0,@RESULT 473 END; 474END; 475 476PROCEDURE SortLayerCR(layer : pLayer; dx : LONGINT; dy : LONGINT); 477BEGIN 478 ASM 479 MOVE.L A6,-(A7) 480 MOVEA.L layer,A0 481 MOVE.L dx,D0 482 MOVE.L dy,D1 483 MOVEA.L LayersBase,A6 484 JSR -210(A6) 485 MOVEA.L (A7)+,A6 486 END; 487END; 488 489PROCEDURE SwapBitsRastPortClipRect(rp : pRastPort; cr : pClipRect); 490BEGIN 491 ASM 492 MOVE.L A6,-(A7) 493 MOVEA.L rp,A0 494 MOVEA.L cr,A1 495 MOVEA.L LayersBase,A6 496 JSR -126(A6) 497 MOVEA.L (A7)+,A6 498 END; 499END; 500 501PROCEDURE ThinLayerInfo(li : pLayer_Info); 502BEGIN 503 ASM 504 MOVE.L A6,-(A7) 505 MOVEA.L li,A0 506 MOVEA.L LayersBase,A6 507 JSR -162(A6) 508 MOVEA.L (A7)+,A6 509 END; 510END; 511 512PROCEDURE UnlockLayer(layer : pLayer); 513BEGIN 514 ASM 515 MOVE.L A6,-(A7) 516 MOVEA.L layer,A0 517 MOVEA.L LayersBase,A6 518 JSR -102(A6) 519 MOVEA.L (A7)+,A6 520 END; 521END; 522 523PROCEDURE UnlockLayerInfo(li : pLayer_Info); 524BEGIN 525 ASM 526 MOVE.L A6,-(A7) 527 MOVEA.L li,A0 528 MOVEA.L LayersBase,A6 529 JSR -138(A6) 530 MOVEA.L (A7)+,A6 531 END; 532END; 533 534PROCEDURE UnlockLayers(li : pLayer_Info); 535BEGIN 536 ASM 537 MOVE.L A6,-(A7) 538 MOVEA.L li,A0 539 MOVEA.L LayersBase,A6 540 JSR -114(A6) 541 MOVEA.L (A7)+,A6 542 END; 543END; 544 545FUNCTION UpfrontLayer(dummy : LONGINT; layer : pLayer) : LONGINT; 546BEGIN 547 ASM 548 MOVE.L A6,-(A7) 549 MOVEA.L dummy,A0 550 MOVEA.L layer,A1 551 MOVEA.L LayersBase,A6 552 JSR -048(A6) 553 MOVEA.L (A7)+,A6 554 MOVE.L D0,@RESULT 555 END; 556END; 557 558FUNCTION WhichLayer(li : pLayer_Info; x : LONGINT; y : LONGINT) : pLayer; 559BEGIN 560 ASM 561 MOVE.L A6,-(A7) 562 MOVEA.L li,A0 563 MOVE.L x,D0 564 MOVE.L y,D1 565 MOVEA.L LayersBase,A6 566 JSR -132(A6) 567 MOVEA.L (A7)+,A6 568 MOVE.L D0,@RESULT 569 END; 570END; 571 572const 573 { Change VERSION and LIBVERSION to proper values } 574 575 VERSION : string[2] = '0'; 576 LIBVERSION : longword = 0; 577 578{$ifdef use_init_openlib} 579 {$Info Compiling initopening of layers.library} 580 {$Info don't forget to use InitLAYERSLibrary in the beginning of your program} 581 582var 583 layers_exit : Pointer; 584 585procedure CloselayersLibrary; 586begin 587 ExitProc := layers_exit; 588 if LayersBase <> nil then begin 589 CloseLibrary(LayersBase); 590 LayersBase := nil; 591 end; 592end; 593 594procedure InitLAYERSLibrary; 595begin 596 LayersBase := nil; 597 LayersBase := OpenLibrary(LAYERSNAME,LIBVERSION); 598 if LayersBase <> nil then begin 599 layers_exit := ExitProc; 600 ExitProc := @CloselayersLibrary; 601 end else begin 602 MessageBox('FPC Pascal Error', 603 'Can''t open layers.library version ' + VERSION + #10 + 604 'Deallocating resources and closing down', 605 'Oops'); 606 halt(20); 607 end; 608end; 609 610begin 611 LAYERSIsCompiledHow := 2; 612{$endif use_init_openlib} 613 614{$ifdef use_auto_openlib} 615 {$Info Compiling autoopening of layers.library} 616 617var 618 layers_exit : Pointer; 619 620procedure CloselayersLibrary; 621begin 622 ExitProc := layers_exit; 623 if LayersBase <> nil then begin 624 CloseLibrary(LayersBase); 625 LayersBase := nil; 626 end; 627end; 628 629begin 630 LayersBase := nil; 631 LayersBase := OpenLibrary(LAYERSNAME,LIBVERSION); 632 if LayersBase <> nil then begin 633 layers_exit := ExitProc; 634 ExitProc := @CloselayersLibrary; 635 LAYERSIsCompiledHow := 1; 636 end else begin 637 MessageBox('FPC Pascal Error', 638 'Can''t open layers.library version ' + VERSION + #10 + 639 'Deallocating resources and closing down', 640 'Oops'); 641 halt(20); 642 end; 643 644{$endif use_auto_openlib} 645 646{$ifdef dont_use_openlib} 647begin 648 LAYERSIsCompiledHow := 3; 649 {$Warning No autoopening of layers.library compiled} 650 {$Warning Make sure you open layers.library yourself} 651{$endif dont_use_openlib} 652 653 654END. (* UNIT LAYERS *) 655 656 657