Changeset 33 for trunk/LocalPlayer/IsoEngine.pas
- Timestamp:
- Jan 8, 2017, 11:42:00 PM (7 years ago)
- File:
-
- 1 edited
-
trunk/LocalPlayer/IsoEngine.pas (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/LocalPlayer/IsoEngine.pas
r28 r33 360 360 if Border then 361 361 inc(TSpriteSize[i].Left); 362 until not Border or 363 (TSpriteSize[i].Left = xxt * 2 - 1); 362 until not Border or (TSpriteSize[i].Left = xxt * 2 - 1); 364 363 TSpriteSize[i].Top := 0; 365 364 repeat … … 371 370 if Border then 372 371 inc(TSpriteSize[i].Top); 373 until not Border or 374 (TSpriteSize[i].Top = yyt * 3 - 1); 372 until not Border or (TSpriteSize[i].Top = yyt * 3 - 1); 375 373 TSpriteSize[i].Right := xxt * 2; 376 374 repeat … … 382 380 if Border then 383 381 dec(TSpriteSize[i].Right); 384 until not Border or 385 (TSpriteSize[i].Right = TSpriteSize[i].Left); 382 until not Border or (TSpriteSize[i].Right = TSpriteSize[i].Left); 386 383 TSpriteSize[i].Bottom := yyt * 3; 387 384 repeat 388 385 Border := true; 389 386 for x := 0 to xxt * 2 - 1 do 390 if MaskLine[TSpriteSize[i].Bottom - 1]^ 391 [1 + xSrc * (xxt * 2 + 1) + x,0] = 0 then392 387 if MaskLine[TSpriteSize[i].Bottom - 1]^[1 + xSrc * (xxt * 2 + 1) + x, 388 0] = 0 then 389 Border := false; 393 390 if Border then 394 391 dec(TSpriteSize[i].Bottom); 395 until not Border or 396 (TSpriteSize[i].Bottom = TSpriteSize[i].Top); 392 until not Border or (TSpriteSize[i].Bottom = TSpriteSize[i].Top); 397 393 end 398 394 end; … … 409 405 end; 410 406 411 procedure Done; 407 procedure Done; 408 begin 409 NoMap.Free; 410 NoMap := nil; 411 LandPatch.Free; 412 LandPatch := nil; 413 OceanPatch.Free; 414 OceanPatch := nil; 415 Borders.Free; 416 Borders := nil; 417 end; 418 419 procedure Reset; 420 begin 421 BordersOK := 0; 422 end; 423 424 constructor TIsoMap.Create; 425 begin 426 inherited; 427 FLeft := 0; 428 FTop := 0; 429 FRight := 0; 430 FBottom := 0; 431 AttLoc := -1; 432 DefLoc := -1; 433 FAdviceLoc := -1; 434 end; 435 436 procedure TIsoMap.SetOutput(Output: TBitmap); 437 begin 438 FOutput := Output; 439 FLeft := 0; 440 FTop := 0; 441 FRight := FOutput.Width; 442 FBottom := FOutput.Height; 443 end; 444 445 procedure TIsoMap.SetPaintBounds(Left, Top, Right, Bottom: integer); 446 begin 447 FLeft := Left; 448 FTop := Top; 449 FRight := Right; 450 FBottom := Bottom; 451 end; 452 453 procedure TIsoMap.FillRect(x, y, Width, Height, Color: integer); 454 begin 455 if x < FLeft then 456 begin 457 Width := Width - (FLeft - x); 458 x := FLeft 459 end; 460 if y < FTop then 461 begin 462 Height := Height - (FTop - y); 463 y := FTop 464 end; 465 if x + Width >= FRight then 466 Width := FRight - x; 467 if y + Height >= FBottom then 468 Height := FBottom - y; 469 if (Width <= 0) or (Height <= 0) then 470 exit; 471 472 with FOutput.Canvas do 473 begin 474 Brush.Color := Color; 475 FillRect(Rect(x, y, x + Width, y + Height)); 476 Brush.Style := bsClear; 477 end 478 end; 479 480 procedure TIsoMap.Textout(x, y, Color: integer; const s: string); 481 begin 482 FOutput.Canvas.Font.Color := Color; 483 FOutput.Canvas.TextRect(Rect(FLeft, FTop, FRight, FBottom), x, y, s) 484 end; 485 486 procedure TIsoMap.BitBlt(Src: TBitmap; x, y, Width, Height, xSrc, ySrc, 487 Rop: integer); 488 begin 489 if x < FLeft then 490 begin 491 Width := Width - (FLeft - x); 492 xSrc := xSrc + (FLeft - x); 493 x := FLeft 494 end; 495 if y < FTop then 496 begin 497 Height := Height - (FTop - y); 498 ySrc := ySrc + (FTop - y); 499 y := FTop 500 end; 501 if x + Width >= FRight then 502 Width := FRight - x; 503 if y + Height >= FBottom then 504 Height := FBottom - y; 505 if (Width <= 0) or (Height <= 0) then 506 exit; 507 508 LCLIntf.BitBlt(FOutput.Canvas.Handle, x, y, Width, Height, Src.Canvas.Handle, 509 xSrc, ySrc, Rop); 510 end; 511 512 procedure TIsoMap.Sprite(HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 513 begin 514 BitBlt(GrExt[HGr].Mask, xDst, yDst, Width, Height, xGr, yGr, SRCAND); 515 BitBlt(GrExt[HGr].Data, xDst, yDst, Width, Height, xGr, yGr, SRCPAINT); 516 end; 517 518 procedure TIsoMap.TSprite(xDst, yDst, grix: integer; 519 PureBlack: boolean = false); 520 var 521 Width, Height, xSrc, ySrc: integer; 522 begin 523 Width := TSpriteSize[grix].Right - TSpriteSize[grix].Left; 524 Height := TSpriteSize[grix].Bottom - TSpriteSize[grix].Top; 525 xSrc := 1 + grix mod 9 * (xxt * 2 + 1) + TSpriteSize[grix].Left; 526 ySrc := 1 + grix div 9 * (yyt * 3 + 1) + TSpriteSize[grix].Top; 527 xDst := xDst + TSpriteSize[grix].Left; 528 yDst := yDst - yyt + TSpriteSize[grix].Top; 529 if xDst < FLeft then 530 begin 531 Width := Width - (FLeft - xDst); 532 xSrc := xSrc + (FLeft - xDst); 533 xDst := FLeft 534 end; 535 if yDst < FTop then 536 begin 537 Height := Height - (FTop - yDst); 538 ySrc := ySrc + (FTop - yDst); 539 yDst := FTop 540 end; 541 if xDst + Width >= FRight then 542 Width := FRight - xDst; 543 if yDst + Height >= FBottom then 544 Height := FBottom - yDst; 545 if (Width <= 0) or (Height <= 0) then 546 exit; 547 548 LCLIntf.BitBlt(OutDC, xDst, yDst, Width, Height, MaskDC, xSrc, ySrc, SRCAND); 549 if not PureBlack then 550 LCLIntf.BitBlt(OutDC, xDst, yDst, Width, Height, DataDC, xSrc, ySrc, 551 SRCPAINT); 552 end; 553 554 procedure TIsoMap.PaintUnit(x, y: integer; const UnitInfo: TUnitInfo; 555 Status: integer); 556 var 557 xsh, ysh, xGr, yGr, j, mixShow: integer; 558 begin 559 with UnitInfo do 560 if (Owner = me) or (emix <> $FFFF) then 561 begin 562 if Job = jCity then 563 mixShow := -1 // building site 564 else 565 mixShow := mix; 566 if (Tribe[Owner].ModelPicture[mixShow].HGr = 0) and 567 (@OnInitEnemyModel <> nil) then 568 if not OnInitEnemyModel(emix) then 569 exit; 570 xsh := Tribe[Owner].ModelPicture[mixShow].xShield; 571 ysh := Tribe[Owner].ModelPicture[mixShow].yShield; 572 {$IFNDEF SCR} if Status and usStay <> 0 then 573 j := 19 574 else if Status and usRecover <> 0 then 575 j := 16 576 else if Status and (usGoto or usEnhance) = usGoto or usEnhance then 577 j := 18 578 else if Status and usEnhance <> 0 then 579 j := 17 580 else if Status and usGoto <> 0 then 581 j := 20 582 else {$ENDIF} if Job = jCity then 583 j := jNone 584 else 585 j := Job; 586 if Flags and unMulti <> 0 then 587 Sprite(Tribe[Owner].symHGr, x + xsh - 1 + 4, y + ysh - 2, 14, 12, 588 33 + Tribe[Owner].sympix mod 10 * 65, 589 1 + Tribe[Owner].sympix div 10 * 49); 590 Sprite(Tribe[Owner].symHGr, x + xsh - 1, y + ysh - 2, 14, 12, 591 18 + Tribe[Owner].sympix mod 10 * 65, 592 1 + Tribe[Owner].sympix div 10 * 49); 593 FillRect(x + xsh, y + ysh + 5, 1 + Health * 11 div 100, 3, 594 ColorOfHealth(Health)); 595 if j > 0 then 596 begin 597 xGr := 121 + j mod 7 * 9; 598 yGr := 1 + j div 7 * 9; 599 BitBlt(GrExt[HGrSystem].Mask, x + xsh + 3, y + ysh + 9, 8, 8, xGr, 600 yGr, SRCAND); 601 Sprite(HGrSystem, x + xsh + 2, y + ysh + 8, 8, 8, xGr, yGr); 602 end; 603 with Tribe[Owner].ModelPicture[mixShow] do 604 Sprite(HGr, x, y, 64, 48, pix mod 10 * 65 + 1, pix div 10 * 49 + 1); 605 if Flags and unFortified <> 0 then 606 begin 607 { OutDC:=FOutput.Canvas.Handle; 608 DataDC:=GrExt[HGrTerrain].Data.Canvas.Handle; 609 MaskDC:=GrExt[HGrTerrain].Mask.Canvas.Handle; 610 TSprite(x,y+16,12*9+7); } 611 Sprite(HGrStdUnits, x, y, xxu * 2, yyu * 2, 1 + 6 * (xxu * 2 + 1), 1); 612 end 613 end 614 end; { PaintUnit } 615 616 procedure TIsoMap.PaintCity(x, y: integer; const CityInfo: TCityInfo; 617 accessory: boolean); 618 var 619 age, cHGr, cpix, xGr, xShield, yShield, LabelTextColor, LabelLength: integer; 620 cpic: TCityPicture; 621 s: string; 622 begin 623 age := GetAge(CityInfo.Owner); 624 if CityInfo.size < 5 then 625 xGr := 0 626 else if CityInfo.size < 9 then 627 xGr := 1 628 else if CityInfo.size < 13 then 629 xGr := 2 630 else 631 xGr := 3; 632 Tribe[CityInfo.Owner].InitAge(age); 633 if age < 2 then 634 begin 635 cHGr := Tribe[CityInfo.Owner].cHGr; 636 cpix := Tribe[CityInfo.Owner].cpix; 637 if (ciWalled and CityInfo.Flags = 0) or 638 (GrExt[cHGr].Data.Canvas.Pixels[(xGr + 4) * 65, cpix * 49 + 48] = $00FFFF) 639 then 640 Sprite(cHGr, x - xxc, y - 2 * yyc, xxc * 2, yyc * 3, 641 xGr * (xxc * 2 + 1) + 1, 1 + cpix * (yyc * 3 + 1)); 642 if ciWalled and CityInfo.Flags <> 0 then 643 Sprite(cHGr, x - xxc, y - 2 * yyc, xxc * 2, yyc * 3, 644 (xGr + 4) * (xxc * 2 + 1) + 1, 1 + cpix * (yyc * 3 + 1)); 645 end 646 else 647 begin 648 if ciWalled and CityInfo.Flags <> 0 then 649 Sprite(HGrCities, x - xxt, y - 2 * yyt, 2 * xxt, 3 * yyt, 650 (xGr + 4) * (2 * xxt + 1) + 1, 1 + (age - 2) * (3 * yyt + 1)) 651 else 652 Sprite(HGrCities, x - xxt, y - 2 * yyt, 2 * xxt, 3 * yyt, 653 xGr * (2 * xxt + 1) + 1, 1 + (age - 2) * (3 * yyt + 1)); 654 end; 655 656 if not accessory then 657 exit; 658 659 { if ciCapital and CityInfo.Flags<>0 then 660 Sprite(Tribe[CityInfo.Owner].symHGr,x+cpic.xf,y-13+cpic.yf,13,14, 661 1+Tribe[CityInfo.Owner].sympix mod 10 *65, 662 1+Tribe[CityInfo.Owner].sympix div 10 *49); {capital -- paint flag } 663 664 if MyMap[CityInfo.Loc] and fObserved <> 0 then 665 begin 666 if age < 2 then 667 begin 668 cpic := Tribe[CityInfo.Owner].CityPicture[xGr]; 669 xShield := x - xxc + cpic.xShield; 670 yShield := y - 2 * yyc + cpic.yShield; 671 end 672 else 673 begin 674 cpic := CitiesPictures[age, xGr]; 675 xShield := x - xxt + cpic.xShield; 676 yShield := y - 2 * yyt + cpic.yShield; 677 end; 678 s := IntToStr(CityInfo.size); 679 LabelLength := FOutput.Canvas.TextWidth(s); 680 FillRect(xShield, yShield, LabelLength + 4, 16, $000000); 681 if MyMap[CityInfo.Loc] and (fUnit or fObserved) = fObserved then 682 // empty city 683 LabelTextColor := Tribe[CityInfo.Owner].Color 684 else 685 begin 686 FillRect(xShield + 1, yShield + 1, LabelLength + 2, 14, 687 Tribe[CityInfo.Owner].Color); 688 LabelTextColor := $000000; 689 end; 690 Textout(xShield + 2, yShield - 1, LabelTextColor, s); 691 end 692 end; { PaintCity } 693 694 function PoleTile(Loc: integer): integer; 695 begin { virtual pole tile } 696 result := fUNKNOWN; 697 if Loc < -2 * G.lx then 698 else if Loc < -G.lx then 699 begin 700 if (MyMap[dLoc(Loc, 0, 2)] and fTerrain <> fUNKNOWN) and 701 (MyMap[dLoc(Loc, -2, 2)] and fTerrain <> fUNKNOWN) and 702 (MyMap[dLoc(Loc, 2, 2)] and fTerrain <> fUNKNOWN) then 703 result := fArctic; 704 if (MyMap[dLoc(Loc, 0, 2)] and fObserved <> 0) and 705 (MyMap[dLoc(Loc, -2, 2)] and fObserved <> 0) and 706 (MyMap[dLoc(Loc, 2, 2)] and fObserved <> 0) then 707 result := result or fObserved 708 end 709 else if Loc < 0 then 710 begin 711 if (MyMap[dLoc(Loc, -1, 1)] and fTerrain <> fUNKNOWN) and 712 (MyMap[dLoc(Loc, 1, 1)] and fTerrain <> fUNKNOWN) then 713 result := fArctic; 714 if (MyMap[dLoc(Loc, -1, 1)] and fObserved <> 0) and 715 (MyMap[dLoc(Loc, 1, 1)] and fObserved <> 0) then 716 result := result or fObserved 717 end 718 else if Loc < G.lx * (G.ly + 1) then 719 begin 720 if (MyMap[dLoc(Loc, -1, -1)] and fTerrain <> fUNKNOWN) and 721 (MyMap[dLoc(Loc, 1, -1)] and fTerrain <> fUNKNOWN) then 722 result := fArctic; 723 if (MyMap[dLoc(Loc, -1, -1)] and fObserved <> 0) and 724 (MyMap[dLoc(Loc, 1, -1)] and fObserved <> 0) then 725 result := result or fObserved 726 end 727 else if Loc < G.lx * (G.ly + 2) then 728 begin 729 if (MyMap[dLoc(Loc, 0, -2)] and fTerrain <> fUNKNOWN) and 730 (MyMap[dLoc(Loc, -2, -2)] and fTerrain <> fUNKNOWN) and 731 (MyMap[dLoc(Loc, 2, -2)] and fTerrain <> fUNKNOWN) then 732 result := fArctic; 733 if (MyMap[dLoc(Loc, 0, -2)] and fObserved <> 0) and 734 (MyMap[dLoc(Loc, -2, -2)] and fObserved <> 0) and 735 (MyMap[dLoc(Loc, 2, -2)] and fObserved <> 0) then 736 result := result or fObserved 737 end 738 end; 739 740 const 741 Dirx: array [0 .. 7] of integer = (1, 2, 1, 0, -1, -2, -1, 0); 742 Diry: array [0 .. 7] of integer = (-1, 0, 1, 2, 1, 0, -1, -2); 743 744 function TIsoMap.Connection4(Loc, Mask, Value: integer): integer; 745 begin 746 result := 0; 747 if dLoc(Loc, 1, -1) >= 0 then 748 begin 749 if MyMap[dLoc(Loc, 1, -1)] and Mask = Cardinal(Value) then 750 inc(result, 1); 751 if MyMap[dLoc(Loc, -1, -1)] and Mask = Cardinal(Value) then 752 inc(result, 8); 753 end; 754 if dLoc(Loc, 1, 1) < G.lx * G.ly then 755 begin 756 if MyMap[dLoc(Loc, 1, 1)] and Mask = Cardinal(Value) then 757 inc(result, 2); 758 if MyMap[dLoc(Loc, -1, 1)] and Mask = Cardinal(Value) then 759 inc(result, 4); 760 end 761 end; 762 763 function TIsoMap.Connection8(Loc, Mask: integer): integer; 764 var 765 Dir, ConnLoc: integer; 766 begin 767 result := 0; 768 for Dir := 0 to 7 do 769 begin 770 ConnLoc := dLoc(Loc, Dirx[Dir], Diry[Dir]); 771 if (ConnLoc >= 0) and (ConnLoc < G.lx * G.ly) and 772 (MyMap[ConnLoc] and Mask <> 0) then 773 inc(result, 1 shl Dir); 774 end 775 end; 776 777 function TIsoMap.OceanConnection(Loc: integer): integer; 778 var 779 Dir, ConnLoc: integer; 780 begin 781 result := 0; 782 for Dir := 0 to 7 do 783 begin 784 ConnLoc := dLoc(Loc, Dirx[Dir], Diry[Dir]); 785 if (ConnLoc < 0) or (ConnLoc >= G.lx * G.ly) or 786 ((MyMap[ConnLoc] - 2) and fTerrain < 13) then 787 inc(result, 1 shl Dir); 788 end 789 end; 790 791 procedure TIsoMap.PaintShore(x, y, Loc: integer); 792 var 793 Conn, Tile: integer; 794 begin 795 if (y <= FTop - yyt * 2) or (y > FBottom) or (x <= FLeft - xxt * 2) or 796 (x > FRight) then 797 exit; 798 if (Loc < 0) or (Loc >= G.lx * G.ly) then 799 exit; 800 Tile := MyMap[Loc]; 801 if Tile and fTerrain >= fGrass then 802 exit; 803 Conn := OceanConnection(Loc); 804 if Conn = 0 then 805 exit; 806 807 BitBlt(GrExt[HGrTerrain].Data, x + xxt div 2, y, xxt, yyt, 808 1 + (Conn shr 6 + Conn and 1 shl 2) * (xxt * 2 + 1), 809 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 810 BitBlt(GrExt[HGrTerrain].Data, x + xxt, y + yyt div 2, xxt, yyt, 811 1 + (Conn and 7) * (xxt * 2 + 1) + xxt, 812 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 813 BitBlt(GrExt[HGrTerrain].Data, x + xxt div 2, y + yyt, xxt, yyt, 814 1 + (Conn shr 2 and 7) * (xxt * 2 + 1) + xxt, 815 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 816 BitBlt(GrExt[HGrTerrain].Data, x, y + yyt div 2, xxt, yyt, 817 1 + (Conn shr 4 and 7) * (xxt * 2 + 1), 818 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 819 Conn := Connection4(Loc, fTerrain, fUNKNOWN); { dither to black } 820 if Conn and 1 <> 0 then 821 BitBlt(GrExt[HGrTerrain].Mask, x + xxt, y, xxt, yyt, 1 + 7 * (xxt * 2 + 1) + 822 xxt, 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 823 if Conn and 2 <> 0 then 824 BitBlt(GrExt[HGrTerrain].Mask, x + xxt, y + yyt, xxt, yyt, 825 1 + 7 * (xxt * 2 + 1) + xxt, 1 + yyt * 2 + 15 * (yyt * 3 + 1), SRCAND); 826 if Conn and 4 <> 0 then 827 BitBlt(GrExt[HGrTerrain].Mask, x, y + yyt, xxt, yyt, 1 + 7 * (xxt * 2 + 1), 828 1 + yyt * 2 + 15 * (yyt * 3 + 1), SRCAND); 829 if Conn and 8 <> 0 then 830 BitBlt(GrExt[HGrTerrain].Mask, x, y, xxt, yyt, 1 + 7 * (xxt * 2 + 1), 831 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 832 end; 833 834 procedure TIsoMap.PaintTileExtraTerrain(x, y, Loc: integer); 835 var 836 Dir, Conn, RRConn, yGr, Tile, yLoc: integer; 837 begin 838 if (Loc < 0) or (Loc >= G.lx * G.ly) or (y <= -yyt * 2) or 839 (y > FOutput.Height) or (x <= -xxt * 2) or (x > FOutput.Width) then 840 exit; 841 Tile := MyMap[Loc]; 842 if Tile and fTerrain = fForest then 843 begin 844 yLoc := Loc div G.lx; 845 if IsJungle(yLoc) then 846 yGr := 18 847 else 848 yGr := 3; 849 Conn := Connection4(Loc, fTerrain, Tile and fTerrain); 850 if (yLoc = (G.ly - 2) div 4) or (G.ly - 1 - yLoc = (G.ly + 2) div 4) then 851 Conn := Conn and not 6 // no connection to south 852 else if (yLoc = (G.ly + 2) div 4) or (G.ly - 1 - yLoc = (G.ly - 2) div 4) 853 then 854 Conn := Conn and not 9; // no connection to north 855 TSprite(x, y, Conn mod 8 + (yGr + Conn div 8) * 9); 856 end 857 else if Tile and fTerrain in [fHills, fMountains, fForest] then 858 begin 859 yGr := 3 + 2 * (Tile and fTerrain - fForest); 860 Conn := Connection4(Loc, fTerrain, Tile and fTerrain); 861 TSprite(x, y, Conn mod 8 + (yGr + Conn div 8) * 9); 862 end 863 else if Tile and fDeadLands <> 0 then 864 TSprite(x, y, 2 * 9 + 6); 865 866 if ShowObjects then 867 begin 868 if Tile and fTerImp = tiFarm then 869 TSprite(x, y, 109) { farmland } 870 else if Tile and fTerImp = tiIrrigation then 871 TSprite(x, y, 108); // irrigation 872 end; 873 if Tile and fRiver <> 0 then 874 begin 875 Conn := Connection4(Loc, fRiver, fRiver) or 876 Connection4(Loc, fTerrain, fShore) or Connection4(Loc, fTerrain, 877 fUNKNOWN); 878 TSprite(x, y, Conn mod 8 + (13 + Conn div 8) * 9); 879 end; 880 881 if Tile and fTerrain < fGrass then 882 begin 883 Conn := Connection4(Loc, fRiver, fRiver); 884 for Dir := 0 to 3 do 885 if Conn and (1 shl Dir) <> 0 then { river mouths } 886 TSprite(x, y, 15 * 9 + Dir); 887 if ShowObjects then 888 begin 889 Conn := Connection8(Loc, fCanal); 890 for Dir := 0 to 7 do 891 if Conn and (1 shl Dir) <> 0 then { canal mouths } 892 TSprite(x, y, 20 * 9 + 1 + Dir); 893 end 894 end; 895 896 if ShowObjects then 897 begin 898 if (Tile and fCanal <> 0) or (Tile and fCity <> 0) then 899 begin // paint canal connections 900 Conn := Connection8(Loc, fCanal or fCity); 901 if Tile and fCanal <> 0 then 902 Conn := Conn or ($FF - OceanConnection(Loc)); 903 if Conn = 0 then 904 begin 905 if Tile and fCanal <> 0 then 906 TSprite(x, y, 99) 907 end 908 else 909 for Dir := 0 to 7 do 910 if (1 shl Dir) and Conn <> 0 then 911 TSprite(x, y, 100 + Dir); 912 end; 913 if Tile and (fRR or fCity) <> 0 then 914 RRConn := Connection8(Loc, fRR or fCity) 915 else 916 RRConn := 0; 917 if Tile and (fRoad or fRR or fCity) <> 0 then 918 begin // paint road connections 919 Conn := Connection8(Loc, fRoad or fRR or fCity) and not RRConn; 920 if (Conn = 0) and (Tile and (fRR or fCity) = 0) then 921 TSprite(x, y, 81) 922 else if Conn > 0 then 923 for Dir := 0 to 7 do 924 if (1 shl Dir) and Conn <> 0 then 925 TSprite(x, y, 82 + Dir); 926 end; 927 // paint railroad connections 928 if (Tile and fRR <> 0) and (RRConn = 0) then 929 TSprite(x, y, 90) 930 else if RRConn > 0 then 931 for Dir := 0 to 7 do 932 if (1 shl Dir) and RRConn <> 0 then 933 TSprite(x, y, 91 + Dir); 934 end; 935 end; 936 937 // (x,y) is top left pixel of (2*xxt,3*yyt) rectangle 938 procedure TIsoMap.PaintTileObjects(x, y, Loc, CityLoc, CityOwner: integer; 939 UseBlink: boolean); 940 type 941 TLine = array [0 .. 9 * 65, 0 .. 2] of Byte; 942 var 943 p1, p2, uix, cix, dy, Loc1, Tile, Multi, Destination: integer; 944 CityInfo: TCityInfo; 945 UnitInfo: TUnitInfo; 946 fog: boolean; 947 948 procedure NameCity; 949 var 950 cix, xs, w: integer; 951 BehindCityInfo: TCityInfo; 952 s: string; 953 IsCapital: boolean; 954 begin 955 BehindCityInfo.Loc := Loc - 2 * G.lx; 956 if ShowCityNames and (Options and (1 shl moEditMode) = 0) and 957 (BehindCityInfo.Loc >= 0) and (BehindCityInfo.Loc < G.lx * G.ly) and 958 (MyMap[BehindCityInfo.Loc] and fCity <> 0) then 959 begin 960 GetCityInfo(BehindCityInfo.Loc, cix, BehindCityInfo); 961 IsCapital := BehindCityInfo.Flags and ciCapital <> 0; 962 { if Showuix and (cix>=0) then s:=IntToStr(cix) 963 else } s := CityName(BehindCityInfo.ID); 964 w := FOutput.Canvas.TextWidth(s); 965 xs := x + xxt - (w + 1) div 2; 966 if IsCapital then 967 FOutput.Canvas.Font.Style := FOutput.Canvas.Font.Style + [fsUnderline]; 968 Textout(xs + 1, y - 9, $000000, s); 969 Textout(xs, y - 10, $FFFFFF, s); 970 if IsCapital then 971 FOutput.Canvas.Font.Style := FOutput.Canvas.Font.Style - [fsUnderline]; 972 end; 973 end; 974 975 procedure ShowSpacePort; 976 begin 977 if ShowObjects and (Options and (1 shl moEditMode) = 0) and 978 (Tile and fCity <> 0) and (CityInfo.Flags and ciSpacePort <> 0) then 979 TSprite(x + xxt, y - 6, 12 * 9 + 5); 980 end; 981 982 procedure PaintBorder; 983 var 984 dx, dy: integer; 985 Line: ^TLine; 986 begin 987 if ShowBorder and (Loc >= 0) and (Loc < G.lx * G.ly) and 988 (Tile and fTerrain <> fUNKNOWN) then 989 begin 990 p1 := MyRO.Territory[Loc]; 991 if (p1 >= 0) and (ShowMyBorder or (p1 <> me)) then 992 begin 993 if BordersOK and (1 shl p1) = 0 then 412 994 begin 413 NoMap.Free; 414 NoMap := nil; 415 LandPatch.Free; 416 LandPatch := nil; 417 OceanPatch.Free; 418 OceanPatch := nil; 419 Borders.Free; 420 Borders := nil; 995 LCLIntf.BitBlt(Borders.Canvas.Handle, 0, p1 * (yyt * 2), xxt * 2, 996 yyt * 2, GrExt[HGrTerrain].Data.Canvas.Handle, 997 1 + 8 * (xxt * 2 + 1), 1 + yyt + 16 * (yyt * 3 + 1), SRCCOPY); 998 Borders.BeginUpdate; 999 for dy := 0 to yyt * 2 - 1 do 1000 begin 1001 Line := Borders.ScanLine[p1 * (yyt * 2) + dy]; 1002 for dx := 0 to xxt * 2 - 1 do 1003 if Line[dx, 0] = 99 then 1004 begin 1005 Line[dx, 0] := Tribe[p1].Color shr 16 and $FF; 1006 Line[dx, 1] := Tribe[p1].Color shr 8 and $FF; 1007 Line[dx, 2] := Tribe[p1].Color and $FF; 1008 end 1009 end; 1010 Borders.EndUpdate; 1011 BordersOK := BordersOK or 1 shl p1; 421 1012 end; 422 423 procedure Reset; 1013 for dy := 0 to 1 do 1014 for dx := 0 to 1 do 1015 begin 1016 Loc1 := dLoc(Loc, dx * 2 - 1, dy * 2 - 1); 1017 begin 1018 if (Loc1 < 0) or (Loc1 >= G.lx * G.ly) then 1019 p2 := -1 1020 else if MyMap[Loc1] and fTerrain = fUNKNOWN then 1021 p2 := p1 1022 else 1023 p2 := MyRO.Territory[Loc1]; 1024 if p2 <> p1 then 1025 begin 1026 BitBlt(GrExt[HGrTerrain].Mask, x + dx * xxt, y + dy * yyt, xxt, 1027 yyt, 1 + 8 * (xxt * 2 + 1) + dx * xxt, 1028 1 + yyt + 16 * (yyt * 3 + 1) + dy * yyt, SRCAND); 1029 BitBlt(Borders, x + dx * xxt, y + dy * yyt, xxt, yyt, dx * xxt, 1030 p1 * (yyt * 2) + dy * yyt, SRCPAINT); 1031 end 1032 end; 1033 end 1034 end 1035 end; 1036 end; 1037 1038 begin 1039 if (Loc < 0) or (Loc >= G.lx * G.ly) then 1040 Tile := PoleTile(Loc) 1041 else 1042 Tile := MyMap[Loc]; 1043 if ShowObjects and (Options and (1 shl moEditMode) = 0) and 1044 (Tile and fCity <> 0) then 1045 GetCityInfo(Loc, cix, CityInfo); 1046 if (y <= FTop - yyt * 2) or (y > FBottom) or (x <= FLeft - xxt * 2) or 1047 (x > FRight) then 1048 begin 1049 NameCity; 1050 ShowSpacePort; 1051 exit; 1052 end; 1053 if Tile and fTerrain = fUNKNOWN then 1054 begin 1055 NameCity; 1056 ShowSpacePort; 1057 exit 1058 end; { square not discovered } 1059 1060 if not(FoW and (Tile and fObserved = 0)) then 1061 PaintBorder; 1062 1063 if (Loc >= 0) and (Loc < G.lx * G.ly) and (Loc = FAdviceLoc) then 1064 TSprite(x, y, 7 + 9 * 2); 1065 1066 if (Loc >= 0) and (Loc < G.lx * G.ly) and (Tile and fSpecial <> 0) 1067 then { special ressources } 1068 begin 1069 dy := Loc div G.lx; 1070 if Tile and fTerrain < fForest then 1071 TSprite(x, y, Tile and fTerrain + (Tile and fSpecial shr 5) * 9) 1072 else if (Tile and fTerrain = fForest) and IsJungle(dy) then 1073 TSprite(x, y, 8 + 17 * 9 + (Tile and fSpecial shr 5) * 9) 1074 else 1075 TSprite(x, y, 8 + 2 * 9 + ((Tile and fTerrain - fForest) * 2 + Tile and 1076 fSpecial shr 5) * 9); 1077 end; 1078 1079 if ShowObjects then 1080 begin 1081 if Tile and fTerImp = tiMine then 1082 TSprite(x, y, 2 + 9 * 12); 1083 if Tile and fTerImp = tiBase then 1084 TSprite(x, y, 4 + 9 * 12); 1085 if Tile and fPoll <> 0 then 1086 TSprite(x, y, 6 + 9 * 12); 1087 if Tile and fTerImp = tiFort then 1088 begin 1089 TSprite(x, y, 7 + 9 * 12); 1090 if Tile and fObserved = 0 then 1091 TSprite(x, y, 3 + 9 * 12); 1092 end; 1093 end; 1094 if Tile and fDeadLands <> 0 then 1095 TSprite(x, y, (12 + Tile shr 25 and 3) * 9 + 8); 1096 1097 if Options and (1 shl moEditMode) <> 0 then 1098 fog := (Loc < 0) or (Loc >= G.lx * G.ly) 1099 // else if CityLoc>=0 then 1100 // fog:= (Loc<0) or (Loc>=G.lx*G.ly) or (Distance(Loc,CityLoc)>5) 1101 else if ShowGrWall then 1102 fog := Tile and fGrWall = 0 1103 else 1104 fog := FoW and (Tile and fObserved = 0); 1105 if fog and ShowObjects then 1106 if Loc < -G.lx then 1107 Sprite(HGrTerrain, x, y + yyt, xxt * 2, yyt, 1 + 6 * (xxt * 2 + 1), 1108 1 + yyt * 2 + 15 * (yyt * 3 + 1)) 1109 else if Loc >= G.lx * (G.ly + 1) then 1110 Sprite(HGrTerrain, x, y, xxt * 2, yyt, 1 + 6 * (xxt * 2 + 1), 1111 1 + yyt + 15 * (yyt * 3 + 1)) 1112 else 1113 TSprite(x, y, 6 + 9 * 15, xxt <> 33); 1114 1115 if FoW and (Tile and fObserved = 0) then 1116 PaintBorder; 1117 1118 {$IFNDEF SCR} 1119 // paint goto destination mark 1120 if DestinationMarkON and (CityOwner < 0) and (UnFocus >= 0) and 1121 (MyUn[UnFocus].Status and usGoto <> 0) then 1122 begin 1123 Destination := MyUn[UnFocus].Status shr 16; 1124 if (Destination = Loc) and (Destination <> MyUn[UnFocus].Loc) then 1125 if not UseBlink or BlinkOn then 1126 TSprite(x, y, 8 + 9 * 1) 1127 else 1128 TSprite(x, y, 8 + 9 * 2) 1129 end; 1130 {$ENDIF} 1131 if Options and (1 shl moEditMode) <> 0 then 1132 begin 1133 if Tile and fPrefStartPos <> 0 then 1134 TSprite(x, y, 0 + 9 * 1) 1135 else if Tile and fStartPos <> 0 then 1136 TSprite(x, y, 0 + 9 * 2); 1137 end 1138 else if ShowObjects then 1139 begin 1140 { if (CityLoc<0) and (UnFocus>=0) and (Loc=MyUn[UnFocus].Loc) then 1141 if BlinkOn then TSprite(x,y,8+9*0) 1142 else TSprite(x,y,8+9*1); } 1143 1144 NameCity; 1145 ShowSpacePort; 1146 if Tile and fCity <> 0 then 1147 PaintCity(x + xxt, y + yyt, CityInfo, CityOwner < 0); 1148 1149 if (Tile and fUnit <> 0) and (Loc <> AttLoc) and 1150 ((Loc <> DefLoc) or (DefHealth <> 0)) 1151 {$IFNDEF SCR} and ((CityOwner >= 0) or (UnFocus < 0) or not UseBlink or 1152 BlinkOn or (Loc <> MyUn[UnFocus].Loc)){$ENDIF} 1153 and ((Tile and fCity <> fCity) or (Loc = DefLoc) 1154 {$IFNDEF SCR} or (not UseBlink or BlinkOn) and (UnFocus >= 0) and 1155 (Loc = MyUn[UnFocus].Loc){$ENDIF}) then 1156 begin { unit } 1157 GetUnitInfo(Loc, uix, UnitInfo); 1158 if (Loc = DefLoc) and (DefHealth >= 0) then 1159 UnitInfo.Health := DefHealth; 1160 if (UnitInfo.Owner <> CityOwner) and 1161 not((CityOwner = me) and (MyRO.Treaty[UnitInfo.Owner] = trAlliance)) 1162 then 1163 {$IFNDEF SCR} if (UnFocus >= 0) and (Loc = MyUn[UnFocus].Loc) then { active unit } 424 1164 begin 425 BordersOK := 0; 1165 Multi := UnitInfo.Flags and unMulti; 1166 MakeUnitInfo(me, MyUn[UnFocus], UnitInfo); 1167 UnitInfo.Flags := UnitInfo.Flags or Multi; 1168 PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), UnitInfo, 1169 MyUn[UnFocus].Status); 1170 end 1171 else if UnitInfo.Owner = me then 1172 begin 1173 if ClientMode = cMovieTurn then 1174 PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), UnitInfo, 0) 1175 // status is not set with precise timing during loading 1176 else 1177 PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), UnitInfo, 1178 MyUn[uix].Status); 1179 // if Showuix then Textout(x+16,y+5,$80FF00,IntToStr(uix)); 1180 end 1181 else {$ENDIF} PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), UnitInfo, 0); 1182 end 1183 else if Tile and fHiddenUnit <> 0 then 1184 Sprite(HGrStdUnits, x + (xxt - xxu), y + (yyt - yyu_anchor), xxu * 2, 1185 yyu * 2, 1 + 5 * (xxu * 2 + 1), 1) 1186 else if Tile and fStealthUnit <> 0 then 1187 Sprite(HGrStdUnits, x + (xxt - xxu), y + (yyt - yyu_anchor), xxu * 2, 1188 yyu * 2, 1 + 5 * (xxu * 2 + 1), 1 + 1 * (yyu * 2 + 1)) 1189 end; 1190 1191 if ShowObjects and (Tile and fTerImp = tiFort) and (Tile and fObserved <> 0) 1192 then 1193 TSprite(x, y, 3 + 9 * 12); 1194 1195 if (Loc >= 0) and (Loc < G.lx * G.ly) then 1196 if ShowLoc then 1197 Textout(x + xxt - 16, y + yyt - 9, $FFFF00, IntToStr(Loc)) 1198 else if ShowDebug and (DebugMap <> nil) and (Loc >= 0) and 1199 (Loc < G.lx * G.ly) and (DebugMap[Loc] <> 0) then 1200 Textout(x + xxt - 16, y + yyt - 9, $00E0FF, 1201 IntToStr(integer(DebugMap[Loc]))) 1202 end; { PaintTileObjects } 1203 1204 procedure TIsoMap.PaintGrid(x, y, nx, ny: integer); 1205 1206 procedure ClippedLine(dx0, dy0: integer; mirror: boolean); 1207 var 1208 x0, x1, dxmin, dymin, dxmax, dymax, n: integer; 1209 begin 1210 with FOutput.Canvas do 1211 begin 1212 dxmin := (FLeft - x) div xxt; 1213 dymin := (RealTop - y) div yyt; 1214 dxmax := (FRight - x - 1) div xxt + 1; 1215 dymax := (RealBottom - y - 1) div yyt + 1; 1216 n := dymax - dy0; 1217 if mirror then 1218 begin 1219 if dx0 - dxmin < n then 1220 n := dx0 - dxmin; 1221 if dx0 > dxmax then 1222 begin 1223 n := n - (dx0 - dxmax); 1224 dy0 := dy0 + (dx0 - dxmax); 1225 dx0 := dxmax 426 1226 end; 427 428 constructor TIsoMap.Create; 1227 if dy0 < dymin then 429 1228 begin 430 inherited; 431 FLeft := 0; 432 FTop := 0; 433 FRight := 0; 434 FBottom := 0; 435 AttLoc := -1; 436 DefLoc := -1; 437 FAdviceLoc := -1; 1229 n := n - (dymin - dy0); 1230 dx0 := dx0 - (dymin - dy0); 1231 dy0 := dymin 438 1232 end; 439 440 procedure TIsoMap.SetOutput(Output: TBitmap); 1233 end 1234 else 1235 begin 1236 if dxmax - dx0 < n then 1237 n := dxmax - dx0; 1238 if dx0 < dxmin then 441 1239 begin 442 FOutput := Output; 443 FLeft := 0; 444 FTop := 0; 445 FRight := FOutput.Width; 446 FBottom := FOutput.Height; 1240 n := n - (dxmin - dx0); 1241 dy0 := dy0 + (dxmin - dx0); 1242 dx0 := dxmin 447 1243 end; 448 449 procedure TIsoMap.SetPaintBounds(Left, Top, Right, Bottom: integer); 1244 if dy0 < dymin then 450 1245 begin 451 FLeft := Left; 452 FTop := Top; 453 FRight := Right; 454 FBottom := Bottom; 1246 n := n - (dymin - dy0); 1247 dx0 := dx0 + (dymin - dy0); 1248 dy0 := dymin 455 1249 end; 456 457 procedure TIsoMap.FillRect(x, y, Width, Height, Color: integer); 458 begin 459 if x < FLeft then 1250 end; 1251 if n <= 0 then 1252 exit; 1253 if mirror then 1254 begin 1255 x0 := x + dx0 * xxt - 1; 1256 x1 := x + (dx0 - n) * xxt - 1; 1257 end 1258 else 1259 begin 1260 x0 := x + dx0 * xxt; 1261 x1 := x + (dx0 + n) * xxt; 1262 end; 1263 moveto(x0, y + dy0 * yyt); 1264 lineto(x1, y + (dy0 + n) * yyt); 1265 end 1266 end; 1267 1268 var 1269 i: integer; 1270 begin 1271 FOutput.Canvas.pen.Color := $000000; // $FF shl (8*random(3)); 1272 for i := 0 to nx div 2 do 1273 ClippedLine(i * 2, 0, false); 1274 for i := 1 to (nx + 1) div 2 do 1275 ClippedLine(i * 2, 0, true); 1276 for i := 0 to ny div 2 do 1277 begin 1278 ClippedLine(0, 2 * i + 2, false); 1279 ClippedLine(nx + 1, 2 * i + 1 + nx and 1, true); 1280 end; 1281 end; 1282 1283 procedure TIsoMap.Paint(x, y, Loc, nx, ny, CityLoc, CityOwner: integer; 1284 UseBlink: boolean; CityAllowClick: boolean); 1285 1286 function IsShoreTile(Loc: integer): boolean; 1287 const 1288 Dirx: array [0 .. 7] of integer = (1, 2, 1, 0, -1, -2, -1, 0); 1289 Diry: array [0 .. 7] of integer = (-1, 0, 1, 2, 1, 0, -1, -2); 1290 var 1291 Dir, ConnLoc: integer; 1292 begin 1293 result := false; 1294 for Dir := 0 to 7 do 1295 begin 1296 ConnLoc := dLoc(Loc, Dirx[Dir], Diry[Dir]); 1297 if (ConnLoc < 0) or (ConnLoc >= G.lx * G.ly) or 1298 ((MyMap[ConnLoc] - 2) and fTerrain < 13) then 1299 result := true 1300 end 1301 end; 1302 1303 procedure ShadeOutside(x0, y0, x1, y1, xm, ym: integer); 1304 const 1305 rShade = 3.75; 1306 1307 procedure MakeDark(Line: pointer; length: integer); 1308 type 1309 TCardArray = array [0 .. 9999] of Cardinal; 1310 PCardArray = ^TCardArray; 1311 TByteArray = array [0 .. 9999] of Byte; 1312 PByteArray = ^TByteArray; 1313 var 1314 i, rest: integer; 1315 begin 1316 for i := length * 3 div 4 - 1 downto 0 do 1317 PCardArray(Line)[i] := PCardArray(Line)[i] shr 1 and $7F7F7F7F; 1318 rest := (length * 3 div 4) * 4; 1319 for i := length * 3 mod 4 - 1 downto 0 do 1320 PByteArray(Line)[rest + i] := PByteArray(Line)[rest + i] shr 1 and $7F; 1321 end; 1322 1323 type 1324 TLine = array [0 .. 99999, 0 .. 2] of Byte; 1325 var 1326 y, wBright: integer; 1327 y_n, w_n: single; 1328 Line: ^TLine; 1329 begin 1330 FOutput.BeginUpdate; 1331 for y := y0 to y1 - 1 do 1332 begin 1333 Line := FOutput.ScanLine[y]; 1334 y_n := (y - ym) / yyt; 1335 if abs(y_n) < rShade then 1336 begin 1337 w_n := sqrt(sqr(rShade) - sqr(y_n)); 1338 wBright := trunc(w_n * xxt + 0.5); 1339 MakeDark(@Line[x0], xm - x0 - wBright); 1340 MakeDark(@Line[xm + wBright], x1 - xm - wBright); 1341 end 1342 else 1343 MakeDark(@Line[x0], x1 - x0); 1344 end; 1345 FOutput.EndUpdate; 1346 end; 1347 1348 procedure CityGrid(xm, ym: integer); 1349 var 1350 i: integer; 1351 begin 1352 with FOutput.Canvas do 1353 begin 1354 if CityAllowClick then 1355 pen.Color := $FFFFFF 1356 else 1357 pen.Color := $000000; 1358 pen.Width := 1; 1359 for i := 0 to 3 do 1360 begin 1361 moveto(xm - xxt * (4 - i), ym + yyt * (1 + i)); 1362 lineto(xm + xxt * (1 + i), ym - yyt * (4 - i)); 1363 moveto(xm - xxt * (4 - i), ym - yyt * (1 + i)); 1364 lineto(xm + xxt * (1 + i), ym + yyt * (4 - i)); 1365 end; 1366 moveto(xm - xxt * 4, ym + yyt * 1); 1367 lineto(xm - xxt * 1, ym + yyt * 4); 1368 moveto(xm + xxt * 1, ym + yyt * 4); 1369 lineto(xm + xxt * 4, ym + yyt * 1); 1370 moveto(xm - xxt * 4, ym - yyt * 1); 1371 lineto(xm - xxt * 1, ym - yyt * 4); 1372 moveto(xm + xxt * 1, ym - yyt * 4); 1373 lineto(xm + xxt * 4, ym - yyt * 1); 1374 pen.Width := 1; 1375 end 1376 end; 1377 1378 var 1379 dx, dy, xm, ym, ALoc, BLoc, ATer, BTer, Aix, bix: integer; 1380 begin 1381 FoW := true; 1382 ShowLoc := Options and (1 shl moLocCodes) <> 0; 1383 ShowDebug := pDebugMap >= 0; 1384 ShowObjects := (CityOwner >= 0) or (Options and (1 shl moBareTerrain) = 0); 1385 ShowCityNames := ShowObjects and (CityOwner < 0) and 1386 (Options and (1 shl moCityNames) <> 0); 1387 ShowBorder := true; 1388 ShowMyBorder := CityOwner < 0; 1389 ShowGrWall := (CityOwner < 0) and (Options and (1 shl moGreatWall) <> 0); 1390 if ShowDebug then 1391 Server(sGetDebugMap, me, pDebugMap, DebugMap) 1392 else 1393 DebugMap := nil; 1394 with FOutput.Canvas do 1395 begin 1396 RealTop := y - ((Loc + 12345 * G.lx) div G.lx - 12345) * yyt; 1397 RealBottom := y + (G.ly - ((Loc + 12345 * G.lx) div G.lx - 12345) + 1398 3) * yyt; 1399 Brush.Color := EmptySpaceColor; 1400 if RealTop > FTop then 1401 FillRect(Rect(FLeft, FTop, FRight, RealTop)) 1402 else 1403 RealTop := FTop; 1404 if RealBottom < FBottom then 1405 FillRect(Rect(FLeft, RealBottom, FRight, FBottom)) 1406 else 1407 RealBottom := FBottom; 1408 Brush.Color := $000000; 1409 FillRect(Rect(FLeft, RealTop, FRight, RealBottom)); 1410 Brush.Style := bsClear; 1411 end; 1412 1413 for dy := 0 to ny + 1 do 1414 if (Loc + dy * G.lx >= 0) and (Loc + (dy - 3) * G.lx < G.lx * G.ly) then 1415 for dx := 0 to nx do 1416 begin 1417 ALoc := dLoc(Loc, dx - (dy + dx) and 1, dy - 2); 1418 BLoc := dLoc(Loc, dx - (dy + dx + 1) and 1, dy - 1); 1419 if (ALoc < 0) or (ALoc >= G.lx * G.ly) then 1420 ATer := PoleTile(ALoc) and fTerrain 1421 else 1422 ATer := MyMap[ALoc] and fTerrain; 1423 if (BLoc < 0) or (BLoc >= G.lx * G.ly) then 1424 BTer := PoleTile(BLoc) and fTerrain 1425 else 1426 BTer := MyMap[BLoc] and fTerrain; 1427 1428 if (ATer <> fUNKNOWN) or (BTer <> fUNKNOWN) then 1429 if ((ATer < fGrass) or (ATer = fUNKNOWN)) and 1430 ((BTer < fGrass) or (BTer = fUNKNOWN)) then 460 1431 begin 461 Width := Width - (FLeft - x); 462 x := FLeft 463 end; 464 if y < FTop then 465 begin 466 Height := Height - (FTop - y); 467 y := FTop 468 end; 469 if x + Width >= FRight then 470 Width := FRight - x; 471 if y + Height >= FBottom then 472 Height := FBottom - y; 473 if (Width <= 0) or (Height <= 0) then 474 exit; 475 476 with FOutput.Canvas do 477 begin 478 Brush.Color := Color; 479 FillRect(Rect(x, y, x + Width, y + Height)); 480 Brush.Style := bsClear; 481 end 482 end; 483 484 procedure TIsoMap.Textout(x, y, Color: integer; const s: string); 485 begin 486 FOutput.Canvas.Font.Color := Color; 487 FOutput.Canvas.TextRect(Rect(FLeft, FTop, FRight, FBottom), x, y, s) 488 end; 489 490 procedure TIsoMap.BitBlt(Src: TBitmap; x, y, Width, Height, xSrc, ySrc, 491 Rop: integer); 492 begin 493 if x < FLeft then 494 begin 495 Width := Width - (FLeft - x); 496 xSrc := xSrc + (FLeft - x); 497 x := FLeft 498 end; 499 if y < FTop then 500 begin 501 Height := Height - (FTop - y); 502 ySrc := ySrc + (FTop - y); 503 y := FTop 504 end; 505 if x + Width >= FRight then 506 Width := FRight - x; 507 if y + Height >= FBottom then 508 Height := FBottom - y; 509 if (Width <= 0) or (Height <= 0) then 510 exit; 511 512 LCLIntf.BitBlt(FOutput.Canvas.Handle, x, y, Width, Height, 513 Src.Canvas.Handle, xSrc, ySrc, Rop); 514 end; 515 516 procedure TIsoMap.Sprite(HGr, xDst, yDst, Width, Height, xGr, 517 yGr: integer); 518 begin 519 BitBlt(GrExt[HGr].Mask, xDst, yDst, Width, Height, xGr, yGr, SRCAND); 520 BitBlt(GrExt[HGr].Data, xDst, yDst, Width, Height, xGr, yGr, 521 SRCPAINT); 522 end; 523 524 procedure TIsoMap.TSprite(xDst, yDst, grix: integer; 525 PureBlack: boolean = false); 526 var 527 Width, Height, xSrc, ySrc: integer; 528 begin 529 Width := TSpriteSize[grix].Right - TSpriteSize[grix].Left; 530 Height := TSpriteSize[grix].Bottom - TSpriteSize[grix].Top; 531 xSrc := 1 + grix mod 9 * (xxt * 2 + 1) + TSpriteSize[grix].Left; 532 ySrc := 1 + grix div 9 * (yyt * 3 + 1) + TSpriteSize[grix].Top; 533 xDst := xDst + TSpriteSize[grix].Left; 534 yDst := yDst - yyt + TSpriteSize[grix].Top; 535 if xDst < FLeft then 536 begin 537 Width := Width - (FLeft - xDst); 538 xSrc := xSrc + (FLeft - xDst); 539 xDst := FLeft 540 end; 541 if yDst < FTop then 542 begin 543 Height := Height - (FTop - yDst); 544 ySrc := ySrc + (FTop - yDst); 545 yDst := FTop 546 end; 547 if xDst + Width >= FRight then 548 Width := FRight - xDst; 549 if yDst + Height >= FBottom then 550 Height := FBottom - yDst; 551 if (Width <= 0) or (Height <= 0) then 552 exit; 553 554 LCLIntf.BitBlt(OutDC, xDst, yDst, Width, Height, MaskDC, xSrc, 555 ySrc, SRCAND); 556 if not PureBlack then 557 LCLIntf.BitBlt(OutDC, xDst, yDst, Width, Height, DataDC, xSrc, ySrc, 558 SRCPAINT); 559 end; 560 561 procedure TIsoMap.PaintUnit(x, y: integer; const UnitInfo: TUnitInfo; 562 Status: integer); 563 var 564 xsh, ysh, xGr, yGr, j, mixShow: integer; 565 begin 566 with UnitInfo do 567 if (Owner = me) or (emix <> $FFFF) then 1432 if ATer = fUNKNOWN then 1433 Aix := 0 1434 else if IsShoreTile(ALoc) then 1435 if ATer = fOcean then 1436 Aix := -1 1437 else 1438 Aix := 1 1439 else 1440 Aix := ATer + 2; 1441 if BTer = fUNKNOWN then 1442 bix := 0 1443 else if IsShoreTile(BLoc) then 1444 if BTer = fOcean then 1445 bix := -1 1446 else 1447 bix := 1 1448 else 1449 bix := BTer + 2; 1450 if (Aix > 1) or (bix > 1) then 568 1451 begin 569 if Job = jCity then 570 mixShow := -1 // building site 571 else 572 mixShow := mix; 573 if (Tribe[Owner].ModelPicture[mixShow].HGr = 0) and 574 (@OnInitEnemyModel <> nil) then 575 if not OnInitEnemyModel(emix) then 576 exit; 577 xsh := Tribe[Owner].ModelPicture[mixShow].xShield; 578 ysh := Tribe[Owner].ModelPicture[mixShow].yShield; 579 {$IFNDEF SCR} if Status and usStay <> 0 then 580 j := 19 581 else if Status and usRecover <> 0 then 582 j := 16 583 else if Status and (usGoto or usEnhance) = usGoto or usEnhance 584 then 585 j := 18 586 else if Status and usEnhance <> 0 then 587 j := 17 588 else if Status and usGoto <> 0 then 589 j := 20 590 else {$ENDIF} if Job = jCity then 591 j := jNone 1452 if Aix = -1 then 1453 if bix = fOcean + 2 then 1454 begin 1455 Aix := 0; 1456 bix := 0 1457 end 592 1458 else 593 j := Job; 594 if Flags and unMulti <> 0 then 595 Sprite(Tribe[Owner].symHGr, x + xsh - 1 + 4, y + ysh - 2, 14, 596 12, 33 + Tribe[Owner].sympix mod 10 * 65, 597 1 + Tribe[Owner].sympix div 10 * 49); 598 Sprite(Tribe[Owner].symHGr, x + xsh - 1, y + ysh - 2, 14, 12, 599 18 + Tribe[Owner].sympix mod 10 * 65, 600 1 + Tribe[Owner].sympix div 10 * 49); 601 FillRect(x + xsh, y + ysh + 5, 1 + Health * 11 div 100, 3, 602 ColorOfHealth(Health)); 603 if j > 0 then 604 begin 605 xGr := 121 + j mod 7 * 9; 606 yGr := 1 + j div 7 * 9; 607 BitBlt(GrExt[HGrSystem].Mask, x + xsh + 3, y + ysh + 9, 8, 8, 608 xGr, yGr, SRCAND); 609 Sprite(HGrSystem, x + xsh + 2, y + ysh + 8, 8, 8, xGr, yGr); 610 end; 611 with Tribe[Owner].ModelPicture[mixShow] do 612 Sprite(HGr, x, y, 64, 48, pix mod 10 * 65 + 1, 613 pix div 10 * 49 + 1); 614 if Flags and unFortified <> 0 then 615 begin 616 { OutDC:=FOutput.Canvas.Handle; 617 DataDC:=GrExt[HGrTerrain].Data.Canvas.Handle; 618 MaskDC:=GrExt[HGrTerrain].Mask.Canvas.Handle; 619 TSprite(x,y+16,12*9+7); } 620 Sprite(HGrStdUnits, x, y, xxu * 2, yyu * 2, 621 1 + 6 * (xxu * 2 + 1), 1); 622 end 1459 begin 1460 Aix := 0; 1461 bix := 1 1462 end 1463 else if bix = -1 then 1464 if Aix = fOcean + 2 then 1465 begin 1466 Aix := 1; 1467 bix := 1 1468 end 1469 else 1470 begin 1471 Aix := 1; 1472 bix := 0 1473 end; 1474 BitBlt(OceanPatch, x + dx * xxt, y + dy * yyt, xxt, yyt, 1475 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY) 623 1476 end 624 end; { PaintUnit }625 626 procedure TIsoMap.PaintCity(x, y: integer; const CityInfo: TCityInfo;627 accessory: boolean);628 var629 age, cHGr, cpix, xGr, xShield, yShield, LabelTextColor,630 LabelLength: integer;631 cpic: TCityPicture;632 s: string;633 begin634 age := GetAge(CityInfo.Owner);635 if CityInfo.size < 5 then636 xGr := 0637 else if CityInfo.size < 9 then638 xGr := 1639 else if CityInfo.size < 13 then640 xGr := 2641 else642 xGr := 3;643 Tribe[CityInfo.Owner].InitAge(age);644 if age < 2 then645 begin646 cHGr := Tribe[CityInfo.Owner].cHGr;647 cpix := Tribe[CityInfo.Owner].cpix;648 if (ciWalled and CityInfo.Flags = 0) or649 (GrExt[cHGr].Data.Canvas.Pixels[(xGr + 4) * 65, cpix * 49 + 48]650 = $00FFFF) then651 Sprite(cHGr, x - xxc, y - 2 * yyc, xxc * 2, yyc * 3,652 xGr * (xxc * 2 + 1) + 1, 1 + cpix * (yyc * 3 + 1));653 if ciWalled and CityInfo.Flags <> 0 then654 Sprite(cHGr, x - xxc, y - 2 * yyc, xxc * 2, yyc * 3,655 (xGr + 4) * (xxc * 2 + 1) + 1, 1 + cpix * (yyc * 3 + 1));656 1477 end 657 1478 else 658 1479 begin 659 if ciWalled and CityInfo.Flags <> 0 then 660 Sprite(HGrCities, x - xxt, y - 2 * yyt, 2 * xxt, 3 * yyt, 661 (xGr + 4) * (2 * xxt + 1) + 1, 1 + (age - 2) * (3 * yyt + 1)) 1480 if ATer = fUNKNOWN then 1481 Aix := 0 1482 else if (ALoc >= 0) and (ALoc < G.lx * G.ly) and 1483 (MyMap[ALoc] and fDeadLands <> 0) then 1484 Aix := -2 1485 else if ATer = fOcean then 1486 Aix := -1 1487 else if ATer = fShore then 1488 Aix := 1 1489 else if ATer >= fForest then 1490 Aix := 8 662 1491 else 663 Sprite(HGrCities, x - xxt, y - 2 * yyt, 2 * xxt, 3 * yyt,664 xGr * (2 * xxt + 1) + 1, 1 + (age - 2) * (3 * yyt + 1));665 end;666 667 if not accessorythen668 exit;669 670 { if ciCapital and CityInfo.Flags<>0 then671 Sprite(Tribe[CityInfo.Owner].symHGr,x+cpic.xf,y-13+cpic.yf,13,14,672 1+Tribe[CityInfo.Owner].sympix mod 10 *65,673 1+Tribe[CityInfo.Owner].sympix div 10 *49); {capital -- paint flag }674 675 if MyMap[CityInfo.Loc] and fObserved <> 0 then676 begin677 if age < 2then1492 Aix := ATer; 1493 if BTer = fUNKNOWN then 1494 bix := 0 1495 else if (BLoc >= 0) and (BLoc < G.lx * G.ly) and 1496 (MyMap[BLoc] and fDeadLands <> 0) then 1497 bix := -2 1498 else if BTer = fOcean then 1499 bix := -1 1500 else if BTer = fShore then 1501 bix := 1 1502 else if BTer >= fForest then 1503 bix := 8 1504 else 1505 bix := BTer; 1506 if (Aix = -2) and (bix = -2) then 678 1507 begin 679 cpic := Tribe[CityInfo.Owner].CityPicture[xGr]; 680 xShield := x - xxc + cpic.xShield; 681 yShield := y - 2 * yyc + cpic.yShield; 1508 Aix := fDesert; 1509 bix := fDesert 682 1510 end 1511 else if Aix = -2 then 1512 if bix < 2 then 1513 Aix := 8 1514 else 1515 Aix := bix 1516 else if bix = -2 then 1517 if Aix < 2 then 1518 bix := 8 1519 else 1520 bix := Aix; 1521 if Aix = -1 then 1522 BitBlt(GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, xxt, 1523 yyt, 1 + 6 * (xxt * 2 + 1) + (dx + dy + 1) and 1 * xxt, 1 + yyt, 1524 SRCCOPY) // arctic <-> ocean 1525 else if bix = -1 then 1526 BitBlt(GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, xxt, 1527 yyt, 1 + 6 * (xxt * 2 + 1) + xxt - (dx + dy + 1) and 1 * xxt, 1528 1 + yyt * 2, SRCCOPY) // arctic <-> ocean 683 1529 else 684 begin 685 cpic := CitiesPictures[age, xGr]; 686 xShield := x - xxt + cpic.xShield; 687 yShield := y - 2 * yyt + cpic.yShield; 688 end; 689 s := IntToStr(CityInfo.size); 690 LabelLength := FOutput.Canvas.TextWidth(s); 691 FillRect(xShield, yShield, LabelLength + 4, 16, $000000); 692 if MyMap[CityInfo.Loc] and (fUnit or fObserved) = fObserved then 693 // empty city 694 LabelTextColor := Tribe[CityInfo.Owner].Color 695 else 696 begin 697 FillRect(xShield + 1, yShield + 1, LabelLength + 2, 14, 698 Tribe[CityInfo.Owner].Color); 699 LabelTextColor := $000000; 700 end; 701 Textout(xShield + 2, yShield - 1, LabelTextColor, s); 1530 BitBlt(LandPatch, x + dx * xxt, y + dy * yyt, xxt, yyt, 1531 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY) 702 1532 end 703 end; { PaintCity } 704 705 function PoleTile(Loc: integer): integer; 706 begin { virtual pole tile } 707 result := fUNKNOWN; 708 if Loc < -2 * G.lx then 709 else if Loc < -G.lx then 710 begin 711 if (MyMap[dLoc(Loc, 0, 2)] and fTerrain <> fUNKNOWN) and 712 (MyMap[dLoc(Loc, -2, 2)] and fTerrain <> fUNKNOWN) and 713 (MyMap[dLoc(Loc, 2, 2)] and fTerrain <> fUNKNOWN) then 714 result := fArctic; 715 if (MyMap[dLoc(Loc, 0, 2)] and fObserved <> 0) and 716 (MyMap[dLoc(Loc, -2, 2)] and fObserved <> 0) and 717 (MyMap[dLoc(Loc, 2, 2)] and fObserved <> 0) then 718 result := result or fObserved 719 end 720 else if Loc < 0 then 721 begin 722 if (MyMap[dLoc(Loc, -1, 1)] and fTerrain <> fUNKNOWN) and 723 (MyMap[dLoc(Loc, 1, 1)] and fTerrain <> fUNKNOWN) then 724 result := fArctic; 725 if (MyMap[dLoc(Loc, -1, 1)] and fObserved <> 0) and 726 (MyMap[dLoc(Loc, 1, 1)] and fObserved <> 0) then 727 result := result or fObserved 728 end 729 else if Loc < G.lx * (G.ly + 1) then 730 begin 731 if (MyMap[dLoc(Loc, -1, -1)] and fTerrain <> fUNKNOWN) and 732 (MyMap[dLoc(Loc, 1, -1)] and fTerrain <> fUNKNOWN) then 733 result := fArctic; 734 if (MyMap[dLoc(Loc, -1, -1)] and fObserved <> 0) and 735 (MyMap[dLoc(Loc, 1, -1)] and fObserved <> 0) then 736 result := result or fObserved 737 end 738 else if Loc < G.lx * (G.ly + 2) then 739 begin 740 if (MyMap[dLoc(Loc, 0, -2)] and fTerrain <> fUNKNOWN) and 741 (MyMap[dLoc(Loc, -2, -2)] and fTerrain <> fUNKNOWN) and 742 (MyMap[dLoc(Loc, 2, -2)] and fTerrain <> fUNKNOWN) then 743 result := fArctic; 744 if (MyMap[dLoc(Loc, 0, -2)] and fObserved <> 0) and 745 (MyMap[dLoc(Loc, -2, -2)] and fObserved <> 0) and 746 (MyMap[dLoc(Loc, 2, -2)] and fObserved <> 0) then 747 result := result or fObserved 748 end 1533 end; 1534 1535 OutDC := FOutput.Canvas.Handle; 1536 DataDC := GrExt[HGrTerrain].Data.Canvas.Handle; 1537 MaskDC := GrExt[HGrTerrain].Mask.Canvas.Handle; 1538 for dy := -2 to ny + 1 do 1539 for dx := -1 to nx do 1540 if (dx + dy) and 1 = 0 then 1541 PaintShore(x + xxt * dx, y + yyt + yyt * dy, dLoc(Loc, dx, dy)); 1542 for dy := -2 to ny + 1 do 1543 for dx := -1 to nx do 1544 if (dx + dy) and 1 = 0 then 1545 PaintTileExtraTerrain(x + xxt * dx, y + yyt + yyt * dy, 1546 dLoc(Loc, dx, dy)); 1547 if CityOwner >= 0 then 1548 begin 1549 for dy := -2 to ny + 1 do 1550 for dx := -2 to nx + 1 do 1551 if (dx + dy) and 1 = 0 then 1552 begin 1553 ALoc := dLoc(Loc, dx, dy); 1554 if Distance(ALoc, CityLoc) > 5 then 1555 PaintTileObjects(x + xxt * dx, y + yyt + yyt * dy, ALoc, CityLoc, 1556 CityOwner, UseBlink); 749 1557 end; 750 751 const 752 Dirx: array [0 .. 7] of integer = (1, 2, 1, 0, -1, -2, -1, 0); 753 Diry: array [0 .. 7] of integer = (-1, 0, 1, 2, 1, 0, -1, -2); 754 755 function TIsoMap.Connection4(Loc, Mask, Value: integer): integer; 1558 dx := ((CityLoc mod G.lx * 2 + CityLoc div G.lx and 1) - 1559 ((Loc + 666 * G.lx) mod G.lx * 2 + (Loc + 666 * G.lx) div G.lx and 1) + 3 1560 * G.lx) mod (2 * G.lx) - G.lx; 1561 dy := CityLoc div G.lx - (Loc + 666 * G.lx) div G.lx + 666; 1562 xm := x + (dx + 1) * xxt; 1563 ym := y + (dy + 1) * yyt + yyt; 1564 ShadeOutside(FLeft, FTop, FRight, FBottom, xm, ym); 1565 CityGrid(xm, ym); 1566 for dy := -2 to ny + 1 do 1567 for dx := -2 to nx + 1 do 1568 if (dx + dy) and 1 = 0 then 756 1569 begin 757 result := 0; 758 if dLoc(Loc, 1, -1) >= 0 then 759 begin 760 if MyMap[dLoc(Loc, 1, -1)] and Mask = Cardinal(Value) then 761 inc(result, 1); 762 if MyMap[dLoc(Loc, -1, -1)] and Mask = Cardinal(Value) then 763 inc(result, 8); 764 end; 765 if dLoc(Loc, 1, 1) < G.lx * G.ly then 766 begin 767 if MyMap[dLoc(Loc, 1, 1)] and Mask = Cardinal(Value) then 768 inc(result, 2); 769 if MyMap[dLoc(Loc, -1, 1)] and Mask = Cardinal(Value) then 770 inc(result, 4); 771 end 1570 ALoc := dLoc(Loc, dx, dy); 1571 if Distance(ALoc, CityLoc) <= 5 then 1572 PaintTileObjects(x + xxt * dx, y + yyt + yyt * dy, ALoc, CityLoc, 1573 CityOwner, UseBlink); 772 1574 end; 773 774 function TIsoMap.Connection8(Loc, Mask: integer): integer; 775 var 776 Dir, ConnLoc: integer; 777 begin 778 result := 0; 779 for Dir := 0 to 7 do 780 begin 781 ConnLoc := dLoc(Loc, Dirx[Dir], Diry[Dir]); 782 if (ConnLoc >= 0) and (ConnLoc < G.lx * G.ly) and 783 (MyMap[ConnLoc] and Mask <> 0) then 784 inc(result, 1 shl Dir); 785 end 786 end; 787 788 function TIsoMap.OceanConnection(Loc: integer): integer; 789 var 790 Dir, ConnLoc: integer; 791 begin 792 result := 0; 793 for Dir := 0 to 7 do 794 begin 795 ConnLoc := dLoc(Loc, Dirx[Dir], Diry[Dir]); 796 if (ConnLoc < 0) or (ConnLoc >= G.lx * G.ly) or 797 ((MyMap[ConnLoc] - 2) and fTerrain < 13) then 798 inc(result, 1 shl Dir); 799 end 800 end; 801 802 procedure TIsoMap.PaintShore(x, y, Loc: integer); 803 var 804 Conn, Tile: integer; 805 begin 806 if (y <= FTop - yyt * 2) or (y > FBottom) or (x <= FLeft - xxt * 2) or 807 (x > FRight) then 808 exit; 809 if (Loc < 0) or (Loc >= G.lx * G.ly) then 810 exit; 811 Tile := MyMap[Loc]; 812 if Tile and fTerrain >= fGrass then 813 exit; 814 Conn := OceanConnection(Loc); 815 if Conn = 0 then 816 exit; 817 818 BitBlt(GrExt[HGrTerrain].Data, x + xxt div 2, y, xxt, yyt, 819 1 + (Conn shr 6 + Conn and 1 shl 2) * (xxt * 2 + 1), 820 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 821 BitBlt(GrExt[HGrTerrain].Data, x + xxt, y + yyt div 2, xxt, yyt, 822 1 + (Conn and 7) * (xxt * 2 + 1) + xxt, 823 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 824 BitBlt(GrExt[HGrTerrain].Data, x + xxt div 2, y + yyt, xxt, yyt, 825 1 + (Conn shr 2 and 7) * (xxt * 2 + 1) + xxt, 826 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 827 BitBlt(GrExt[HGrTerrain].Data, x, y + yyt div 2, xxt, yyt, 828 1 + (Conn shr 4 and 7) * (xxt * 2 + 1), 829 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 830 Conn := Connection4(Loc, fTerrain, fUNKNOWN); { dither to black } 831 if Conn and 1 <> 0 then 832 BitBlt(GrExt[HGrTerrain].Mask, x + xxt, y, xxt, yyt, 833 1 + 7 * (xxt * 2 + 1) + xxt, 834 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 835 if Conn and 2 <> 0 then 836 BitBlt(GrExt[HGrTerrain].Mask, x + xxt, y + yyt, xxt, yyt, 837 1 + 7 * (xxt * 2 + 1) + xxt, 1 + yyt * 2 + 15 * 838 (yyt * 3 + 1), SRCAND); 839 if Conn and 4 <> 0 then 840 BitBlt(GrExt[HGrTerrain].Mask, x, y + yyt, xxt, yyt, 841 1 + 7 * (xxt * 2 + 1), 1 + yyt * 2 + 15 * (yyt * 3 + 1), SRCAND); 842 if Conn and 8 <> 0 then 843 BitBlt(GrExt[HGrTerrain].Mask, x, y, xxt, yyt, 844 1 + 7 * (xxt * 2 + 1), 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 845 end; 846 847 procedure TIsoMap.PaintTileExtraTerrain(x, y, Loc: integer); 848 var 849 Dir, Conn, RRConn, yGr, Tile, yLoc: integer; 850 begin 851 if (Loc < 0) or (Loc >= G.lx * G.ly) or (y <= -yyt * 2) or 852 (y > FOutput.Height) or (x <= -xxt * 2) or (x > FOutput.Width) then 853 exit; 854 Tile := MyMap[Loc]; 855 if Tile and fTerrain = fForest then 856 begin 857 yLoc := Loc div G.lx; 858 if IsJungle(yLoc) then 859 yGr := 18 860 else 861 yGr := 3; 862 Conn := Connection4(Loc, fTerrain, Tile and fTerrain); 863 if (yLoc = (G.ly - 2) div 4) or (G.ly - 1 - yLoc = (G.ly + 2) div 4) 864 then 865 Conn := Conn and not 6 // no connection to south 866 else if (yLoc = (G.ly + 2) div 4) or 867 (G.ly - 1 - yLoc = (G.ly - 2) div 4) then 868 Conn := Conn and not 9; // no connection to north 869 TSprite(x, y, Conn mod 8 + (yGr + Conn div 8) * 9); 870 end 871 else if Tile and fTerrain in [fHills, fMountains, fForest] then 872 begin 873 yGr := 3 + 2 * (Tile and fTerrain - fForest); 874 Conn := Connection4(Loc, fTerrain, Tile and fTerrain); 875 TSprite(x, y, Conn mod 8 + (yGr + Conn div 8) * 9); 876 end 877 else if Tile and fDeadLands <> 0 then 878 TSprite(x, y, 2 * 9 + 6); 879 880 if ShowObjects then 881 begin 882 if Tile and fTerImp = tiFarm then 883 TSprite(x, y, 109) { farmland } 884 else if Tile and fTerImp = tiIrrigation then 885 TSprite(x, y, 108); // irrigation 886 end; 887 if Tile and fRiver <> 0 then 888 begin 889 Conn := Connection4(Loc, fRiver, fRiver) or 890 Connection4(Loc, fTerrain, fShore) or 891 Connection4(Loc, fTerrain, fUNKNOWN); 892 TSprite(x, y, Conn mod 8 + (13 + Conn div 8) * 9); 893 end; 894 895 if Tile and fTerrain < fGrass then 896 begin 897 Conn := Connection4(Loc, fRiver, fRiver); 898 for Dir := 0 to 3 do 899 if Conn and (1 shl Dir) <> 0 then { river mouths } 900 TSprite(x, y, 15 * 9 + Dir); 901 if ShowObjects then 902 begin 903 Conn := Connection8(Loc, fCanal); 904 for Dir := 0 to 7 do 905 if Conn and (1 shl Dir) <> 0 then { canal mouths } 906 TSprite(x, y, 20 * 9 + 1 + Dir); 907 end 908 end; 909 910 if ShowObjects then 911 begin 912 if (Tile and fCanal <> 0) or (Tile and fCity <> 0) then 913 begin // paint canal connections 914 Conn := Connection8(Loc, fCanal or fCity); 915 if Tile and fCanal <> 0 then 916 Conn := Conn or ($FF - OceanConnection(Loc)); 917 if Conn = 0 then 918 begin 919 if Tile and fCanal <> 0 then 920 TSprite(x, y, 99) 921 end 922 else 923 for Dir := 0 to 7 do 924 if (1 shl Dir) and Conn <> 0 then 925 TSprite(x, y, 100 + Dir); 926 end; 927 if Tile and (fRR or fCity) <> 0 then 928 RRConn := Connection8(Loc, fRR or fCity) 929 else 930 RRConn := 0; 931 if Tile and (fRoad or fRR or fCity) <> 0 then 932 begin // paint road connections 933 Conn := Connection8(Loc, fRoad or fRR or fCity) and not RRConn; 934 if (Conn = 0) and (Tile and (fRR or fCity) = 0) then 935 TSprite(x, y, 81) 936 else if Conn > 0 then 937 for Dir := 0 to 7 do 938 if (1 shl Dir) and Conn <> 0 then 939 TSprite(x, y, 82 + Dir); 940 end; 941 // paint railroad connections 942 if (Tile and fRR <> 0) and (RRConn = 0) then 943 TSprite(x, y, 90) 944 else if RRConn > 0 then 945 for Dir := 0 to 7 do 946 if (1 shl Dir) and RRConn <> 0 then 947 TSprite(x, y, 91 + Dir); 948 end; 949 end; 950 951 // (x,y) is top left pixel of (2*xxt,3*yyt) rectangle 952 procedure TIsoMap.PaintTileObjects(x, y, Loc, CityLoc, 953 CityOwner: integer; UseBlink: boolean); 954 type 955 TLine = array [0 .. 9 * 65, 0 .. 2] of Byte; 956 var 957 p1, p2, uix, cix, dy, Loc1, Tile, Multi, Destination: integer; 958 CityInfo: TCityInfo; 959 UnitInfo: TUnitInfo; 960 fog: boolean; 961 962 procedure NameCity; 963 var 964 cix, xs, w: integer; 965 BehindCityInfo: TCityInfo; 966 s: string; 967 IsCapital: boolean; 968 begin 969 BehindCityInfo.Loc := Loc - 2 * G.lx; 970 if ShowCityNames and (Options and (1 shl moEditMode) = 0) and 971 (BehindCityInfo.Loc >= 0) and (BehindCityInfo.Loc < G.lx * G.ly) 972 and (MyMap[BehindCityInfo.Loc] and fCity <> 0) then 973 begin 974 GetCityInfo(BehindCityInfo.Loc, cix, BehindCityInfo); 975 IsCapital := BehindCityInfo.Flags and ciCapital <> 0; 976 { if Showuix and (cix>=0) then s:=IntToStr(cix) 977 else } s := CityName(BehindCityInfo.ID); 978 w := FOutput.Canvas.TextWidth(s); 979 xs := x + xxt - (w + 1) div 2; 980 if IsCapital then 981 FOutput.Canvas.Font.Style := FOutput.Canvas.Font.Style + 982 [fsUnderline]; 983 Textout(xs + 1, y - 9, $000000, s); 984 Textout(xs, y - 10, $FFFFFF, s); 985 if IsCapital then 986 FOutput.Canvas.Font.Style := FOutput.Canvas.Font.Style - 987 [fsUnderline]; 988 end; 989 end; 990 991 procedure ShowSpacePort; 992 begin 993 if ShowObjects and (Options and (1 shl moEditMode) = 0) and 994 (Tile and fCity <> 0) and (CityInfo.Flags and ciSpacePort <> 0) 995 then 996 TSprite(x + xxt, y - 6, 12 * 9 + 5); 997 end; 998 999 procedure PaintBorder; 1000 var 1001 dx, dy: integer; 1002 Line: ^TLine; 1003 begin 1004 if ShowBorder and (Loc >= 0) and (Loc < G.lx * G.ly) and 1005 (Tile and fTerrain <> fUNKNOWN) then 1006 begin 1007 p1 := MyRO.Territory[Loc]; 1008 if (p1 >= 0) and (ShowMyBorder or (p1 <> me)) then 1009 begin 1010 if BordersOK and (1 shl p1) = 0 then 1011 begin 1012 LCLIntf.BitBlt(Borders.Canvas.Handle, 0, p1 * (yyt * 2), 1013 xxt * 2, yyt * 2, GrExt[HGrTerrain].Data.Canvas.Handle, 1014 1 + 8 * (xxt * 2 + 1), 1015 1 + yyt + 16 * (yyt * 3 + 1), SRCCOPY); 1016 Borders.BeginUpdate; 1017 for dy := 0 to yyt * 2 - 1 do 1018 begin 1019 Line := Borders.ScanLine[p1 * (yyt * 2) + dy]; 1020 for dx := 0 to xxt * 2 - 1 do 1021 if Line[dx, 0] = 99 then 1022 begin 1023 Line[dx, 0] := Tribe[p1].Color shr 16 and $FF; 1024 Line[dx, 1] := Tribe[p1].Color shr 8 and $FF; 1025 Line[dx, 2] := Tribe[p1].Color and $FF; 1026 end 1027 end; 1028 Borders.EndUpdate; 1029 BordersOK := BordersOK or 1 shl p1; 1030 end; 1031 for dy := 0 to 1 do 1032 for dx := 0 to 1 do 1033 begin 1034 Loc1 := dLoc(Loc, dx * 2 - 1, dy * 2 - 1); 1035 begin 1036 if (Loc1 < 0) or (Loc1 >= G.lx * G.ly) then 1037 p2 := -1 1038 else if MyMap[Loc1] and fTerrain = fUNKNOWN then 1039 p2 := p1 1040 else 1041 p2 := MyRO.Territory[Loc1]; 1042 if p2 <> p1 then 1043 begin 1044 BitBlt(GrExt[HGrTerrain].Mask, x + dx * xxt, 1045 y + dy * yyt, xxt, yyt, 1 + 8 * (xxt * 2 + 1) + dx * 1046 xxt, 1 + yyt + 16 * (yyt * 3 + 1) + dy * yyt, SRCAND); 1047 BitBlt(Borders, x + dx * xxt, y + dy * yyt, xxt, yyt, 1048 dx * xxt, p1 * (yyt * 2) + dy * yyt, SRCPAINT); 1049 end 1050 end; 1051 end 1052 end 1053 end; 1054 end; 1055 1056 begin 1057 if (Loc < 0) or (Loc >= G.lx * G.ly) then 1058 Tile := PoleTile(Loc) 1059 else 1060 Tile := MyMap[Loc]; 1061 if ShowObjects and (Options and (1 shl moEditMode) = 0) and 1062 (Tile and fCity <> 0) then 1063 GetCityInfo(Loc, cix, CityInfo); 1064 if (y <= FTop - yyt * 2) or (y > FBottom) or (x <= FLeft - xxt * 2) or 1065 (x > FRight) then 1066 begin 1067 NameCity; 1068 ShowSpacePort; 1069 exit; 1070 end; 1071 if Tile and fTerrain = fUNKNOWN then 1072 begin 1073 NameCity; 1074 ShowSpacePort; 1075 exit 1076 end; { square not discovered } 1077 1078 if not(FoW and (Tile and fObserved = 0)) then 1079 PaintBorder; 1080 1081 if (Loc >= 0) and (Loc < G.lx * G.ly) and (Loc = FAdviceLoc) then 1082 TSprite(x, y, 7 + 9 * 2); 1083 1084 if (Loc >= 0) and (Loc < G.lx * G.ly) and (Tile and fSpecial <> 0) 1085 then { special ressources } 1086 begin 1087 dy := Loc div G.lx; 1088 if Tile and fTerrain < fForest then 1089 TSprite(x, y, Tile and fTerrain + (Tile and fSpecial shr 5) * 9) 1090 else if (Tile and fTerrain = fForest) and IsJungle(dy) then 1091 TSprite(x, y, 8 + 17 * 9 + (Tile and fSpecial shr 5) * 9) 1092 else 1093 TSprite(x, y, 8 + 2 * 9 + ((Tile and fTerrain - fForest) * 2 + 1094 Tile and fSpecial shr 5) * 9); 1095 end; 1096 1097 if ShowObjects then 1098 begin 1099 if Tile and fTerImp = tiMine then 1100 TSprite(x, y, 2 + 9 * 12); 1101 if Tile and fTerImp = tiBase then 1102 TSprite(x, y, 4 + 9 * 12); 1103 if Tile and fPoll <> 0 then 1104 TSprite(x, y, 6 + 9 * 12); 1105 if Tile and fTerImp = tiFort then 1106 begin 1107 TSprite(x, y, 7 + 9 * 12); 1108 if Tile and fObserved = 0 then 1109 TSprite(x, y, 3 + 9 * 12); 1110 end; 1111 end; 1112 if Tile and fDeadLands <> 0 then 1113 TSprite(x, y, (12 + Tile shr 25 and 3) * 9 + 8); 1114 1115 if Options and (1 shl moEditMode) <> 0 then 1116 fog := (Loc < 0) or (Loc >= G.lx * G.ly) 1117 // else if CityLoc>=0 then 1118 // fog:= (Loc<0) or (Loc>=G.lx*G.ly) or (Distance(Loc,CityLoc)>5) 1119 else if ShowGrWall then 1120 fog := Tile and fGrWall = 0 1121 else 1122 fog := FoW and (Tile and fObserved = 0); 1123 if fog and ShowObjects then 1124 if Loc < -G.lx then 1125 Sprite(HGrTerrain, x, y + yyt, xxt * 2, yyt, 1126 1 + 6 * (xxt * 2 + 1), 1 + yyt * 2 + 15 * (yyt * 3 + 1)) 1127 else if Loc >= G.lx * (G.ly + 1) then 1128 Sprite(HGrTerrain, x, y, xxt * 2, yyt, 1 + 6 * (xxt * 2 + 1), 1129 1 + yyt + 15 * (yyt * 3 + 1)) 1130 else 1131 TSprite(x, y, 6 + 9 * 15, xxt <> 33); 1132 1133 if FoW and (Tile and fObserved = 0) then 1134 PaintBorder; 1135 1136 {$IFNDEF SCR} 1137 // paint goto destination mark 1138 if DestinationMarkON and (CityOwner < 0) and (UnFocus >= 0) and 1139 (MyUn[UnFocus].Status and usGoto <> 0) then 1140 begin 1141 Destination := MyUn[UnFocus].Status shr 16; 1142 if (Destination = Loc) and (Destination <> MyUn[UnFocus].Loc) then 1143 if not UseBlink or BlinkOn then 1144 TSprite(x, y, 8 + 9 * 1) 1145 else 1146 TSprite(x, y, 8 + 9 * 2) 1147 end; 1148 {$ENDIF} 1149 if Options and (1 shl moEditMode) <> 0 then 1150 begin 1151 if Tile and fPrefStartPos <> 0 then 1152 TSprite(x, y, 0 + 9 * 1) 1153 else if Tile and fStartPos <> 0 then 1154 TSprite(x, y, 0 + 9 * 2); 1155 end 1156 else if ShowObjects then 1157 begin 1158 { if (CityLoc<0) and (UnFocus>=0) and (Loc=MyUn[UnFocus].Loc) then 1159 if BlinkOn then TSprite(x,y,8+9*0) 1160 else TSprite(x,y,8+9*1); } 1161 1162 NameCity; 1163 ShowSpacePort; 1164 if Tile and fCity <> 0 then 1165 PaintCity(x + xxt, y + yyt, CityInfo, CityOwner < 0); 1166 1167 if (Tile and fUnit <> 0) and (Loc <> AttLoc) and 1168 ((Loc <> DefLoc) or (DefHealth <> 0)) 1169 {$IFNDEF SCR} and ((CityOwner >= 0) or (UnFocus < 0) or not UseBlink or 1170 BlinkOn or (Loc <> MyUn[UnFocus].Loc)){$ENDIF} 1171 and ((Tile and fCity <> fCity) or (Loc = DefLoc) 1172 {$IFNDEF SCR} or (not UseBlink or BlinkOn) and (UnFocus >= 0) and 1173 (Loc = MyUn[UnFocus].Loc){$ENDIF}) then 1174 begin { unit } 1175 GetUnitInfo(Loc, uix, UnitInfo); 1176 if (Loc = DefLoc) and (DefHealth >= 0) then 1177 UnitInfo.Health := DefHealth; 1178 if (UnitInfo.Owner <> CityOwner) and 1179 not((CityOwner = me) and 1180 (MyRO.Treaty[UnitInfo.Owner] = trAlliance)) then 1181 {$IFNDEF SCR} if (UnFocus >= 0) and (Loc = MyUn[UnFocus].Loc) then { active unit } 1182 begin 1183 Multi := UnitInfo.Flags and unMulti; 1184 MakeUnitInfo(me, MyUn[UnFocus], UnitInfo); 1185 UnitInfo.Flags := UnitInfo.Flags or Multi; 1186 PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), UnitInfo, 1187 MyUn[UnFocus].Status); 1188 end 1189 else if UnitInfo.Owner = me then 1190 begin 1191 if ClientMode = cMovieTurn then 1192 PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), 1193 UnitInfo, 0) 1194 // status is not set with precise timing during loading 1195 else 1196 PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), UnitInfo, 1197 MyUn[uix].Status); 1198 // if Showuix then Textout(x+16,y+5,$80FF00,IntToStr(uix)); 1199 end 1200 else {$ENDIF} PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), UnitInfo, 0); 1201 end 1202 else if Tile and fHiddenUnit <> 0 then 1203 Sprite(HGrStdUnits, x + (xxt - xxu), y + (yyt - yyu_anchor), 1204 xxu * 2, yyu * 2, 1 + 5 * (xxu * 2 + 1), 1) 1205 else if Tile and fStealthUnit <> 0 then 1206 Sprite(HGrStdUnits, x + (xxt - xxu), y + (yyt - yyu_anchor), 1207 xxu * 2, yyu * 2, 1 + 5 * (xxu * 2 + 1), 1 + 1 * (yyu * 2 + 1)) 1208 end; 1209 1210 if ShowObjects and (Tile and fTerImp = tiFort) and 1211 (Tile and fObserved <> 0) then 1212 TSprite(x, y, 3 + 9 * 12); 1213 1214 if (Loc >= 0) and (Loc < G.lx * G.ly) then 1215 if ShowLoc then 1216 Textout(x + xxt - 16, y + yyt - 9, $FFFF00, IntToStr(Loc)) 1217 else if ShowDebug and (DebugMap <> nil) and (Loc >= 0) and 1218 (Loc < G.lx * G.ly) and (DebugMap[Loc] <> 0) then 1219 Textout(x + xxt - 16, y + yyt - 9, $00E0FF, 1220 IntToStr(integer(DebugMap[Loc]))) 1221 end; { PaintTileObjects } 1222 1223 procedure TIsoMap.PaintGrid(x, y, nx, ny: integer); 1224 1225 procedure ClippedLine(dx0, dy0: integer; mirror: boolean); 1226 var 1227 x0, x1, dxmin, dymin, dxmax, dymax, n: integer; 1228 begin 1229 with FOutput.Canvas do 1230 begin 1231 dxmin := (FLeft - x) div xxt; 1232 dymin := (RealTop - y) div yyt; 1233 dxmax := (FRight - x - 1) div xxt + 1; 1234 dymax := (RealBottom - y - 1) div yyt + 1; 1235 n := dymax - dy0; 1236 if mirror then 1237 begin 1238 if dx0 - dxmin < n then 1239 n := dx0 - dxmin; 1240 if dx0 > dxmax then 1241 begin 1242 n := n - (dx0 - dxmax); 1243 dy0 := dy0 + (dx0 - dxmax); 1244 dx0 := dxmax 1245 end; 1246 if dy0 < dymin then 1247 begin 1248 n := n - (dymin - dy0); 1249 dx0 := dx0 - (dymin - dy0); 1250 dy0 := dymin 1251 end; 1252 end 1253 else 1254 begin 1255 if dxmax - dx0 < n then 1256 n := dxmax - dx0; 1257 if dx0 < dxmin then 1258 begin 1259 n := n - (dxmin - dx0); 1260 dy0 := dy0 + (dxmin - dx0); 1261 dx0 := dxmin 1262 end; 1263 if dy0 < dymin then 1264 begin 1265 n := n - (dymin - dy0); 1266 dx0 := dx0 + (dymin - dy0); 1267 dy0 := dymin 1268 end; 1269 end; 1270 if n <= 0 then 1271 exit; 1272 if mirror then 1273 begin 1274 x0 := x + dx0 * xxt - 1; 1275 x1 := x + (dx0 - n) * xxt - 1; 1276 end 1277 else 1278 begin 1279 x0 := x + dx0 * xxt; 1280 x1 := x + (dx0 + n) * xxt; 1281 end; 1282 moveto(x0, y + dy0 * yyt); 1283 lineto(x1, y + (dy0 + n) * yyt); 1284 end 1285 end; 1286 1287 var 1288 i: integer; 1289 begin 1290 FOutput.Canvas.pen.Color := $000000; // $FF shl (8*random(3)); 1291 for i := 0 to nx div 2 do 1292 ClippedLine(i * 2, 0, false); 1293 for i := 1 to (nx + 1) div 2 do 1294 ClippedLine(i * 2, 0, true); 1295 for i := 0 to ny div 2 do 1296 begin 1297 ClippedLine(0, 2 * i + 2, false); 1298 ClippedLine(nx + 1, 2 * i + 1 + nx and 1, true); 1299 end; 1300 end; 1301 1302 procedure TIsoMap.Paint(x, y, Loc, nx, ny, CityLoc, CityOwner: integer; 1303 UseBlink: boolean; CityAllowClick: boolean); 1304 1305 function IsShoreTile(Loc: integer): boolean; 1306 const 1307 Dirx: array [0 .. 7] of integer = (1, 2, 1, 0, -1, -2, -1, 0); 1308 Diry: array [0 .. 7] of integer = (-1, 0, 1, 2, 1, 0, -1, -2); 1309 var 1310 Dir, ConnLoc: integer; 1311 begin 1312 result := false; 1313 for Dir := 0 to 7 do 1314 begin 1315 ConnLoc := dLoc(Loc, Dirx[Dir], Diry[Dir]); 1316 if (ConnLoc < 0) or (ConnLoc >= G.lx * G.ly) or 1317 ((MyMap[ConnLoc] - 2) and fTerrain < 13) then 1318 result := true 1319 end 1320 end; 1321 1322 procedure ShadeOutside(x0, y0, x1, y1, xm, ym: integer); 1323 const 1324 rShade = 3.75; 1325 1326 procedure MakeDark(Line: pointer; length: integer); 1327 type 1328 TCardArray = array [0 .. 9999] of Cardinal; 1329 PCardArray = ^TCardArray; 1330 TByteArray = array [0 .. 9999] of Byte; 1331 PByteArray = ^TByteArray; 1332 var 1333 i, rest: integer; 1334 begin 1335 for i := length * 3 div 4 - 1 downto 0 do 1336 PCardArray(Line)[i] := PCardArray(Line)[i] shr 1 and $7F7F7F7F; 1337 rest := (length * 3 div 4) * 4; 1338 for i := length * 3 mod 4 - 1 downto 0 do 1339 PByteArray(Line)[rest + i] := PByteArray(Line) 1340 [rest + i] shr 1 and $7F; 1341 end; 1342 1343 type 1344 TLine = array [0 .. 99999, 0 .. 2] of Byte; 1345 var 1346 y, wBright: integer; 1347 y_n, w_n: single; 1348 Line: ^TLine; 1349 begin 1350 FOutput.BeginUpdate; 1351 for y := y0 to y1 - 1 do 1352 begin 1353 Line := FOutput.ScanLine[y]; 1354 y_n := (y - ym) / yyt; 1355 if abs(y_n) < rShade then 1356 begin 1357 w_n := sqrt(sqr(rShade) - sqr(y_n)); 1358 wBright := trunc(w_n * xxt + 0.5); 1359 MakeDark(@Line[x0], xm - x0 - wBright); 1360 MakeDark(@Line[xm + wBright], x1 - xm - wBright); 1361 end 1362 else 1363 MakeDark(@Line[x0], x1 - x0); 1364 end; 1365 FOutput.EndUpdate; 1366 end; 1367 1368 procedure CityGrid(xm, ym: integer); 1369 var 1370 i: integer; 1371 begin 1372 with FOutput.Canvas do 1373 begin 1374 if CityAllowClick then 1375 pen.Color := $FFFFFF 1376 else 1377 pen.Color := $000000; 1378 pen.Width := 1; 1379 for i := 0 to 3 do 1380 begin 1381 moveto(xm - xxt * (4 - i), ym + yyt * (1 + i)); 1382 lineto(xm + xxt * (1 + i), ym - yyt * (4 - i)); 1383 moveto(xm - xxt * (4 - i), ym - yyt * (1 + i)); 1384 lineto(xm + xxt * (1 + i), ym + yyt * (4 - i)); 1385 end; 1386 moveto(xm - xxt * 4, ym + yyt * 1); 1387 lineto(xm - xxt * 1, ym + yyt * 4); 1388 moveto(xm + xxt * 1, ym + yyt * 4); 1389 lineto(xm + xxt * 4, ym + yyt * 1); 1390 moveto(xm - xxt * 4, ym - yyt * 1); 1391 lineto(xm - xxt * 1, ym - yyt * 4); 1392 moveto(xm + xxt * 1, ym - yyt * 4); 1393 lineto(xm + xxt * 4, ym - yyt * 1); 1394 pen.Width := 1; 1395 end 1396 end; 1397 1398 var 1399 dx, dy, xm, ym, ALoc, BLoc, ATer, BTer, Aix, bix: integer; 1400 begin 1401 FoW := true; 1402 ShowLoc := Options and (1 shl moLocCodes) <> 0; 1403 ShowDebug := pDebugMap >= 0; 1404 ShowObjects := (CityOwner >= 0) or 1405 (Options and (1 shl moBareTerrain) = 0); 1406 ShowCityNames := ShowObjects and (CityOwner < 0) and 1407 (Options and (1 shl moCityNames) <> 0); 1408 ShowBorder := true; 1409 ShowMyBorder := CityOwner < 0; 1410 ShowGrWall := (CityOwner < 0) and 1411 (Options and (1 shl moGreatWall) <> 0); 1412 if ShowDebug then 1413 Server(sGetDebugMap, me, pDebugMap, DebugMap) 1414 else 1415 DebugMap := nil; 1416 with FOutput.Canvas do 1417 begin 1418 RealTop := y - ((Loc + 12345 * G.lx) div G.lx - 12345) * yyt; 1419 RealBottom := y + 1420 (G.ly - ((Loc + 12345 * G.lx) div G.lx - 12345) + 3) * yyt; 1421 Brush.Color := EmptySpaceColor; 1422 if RealTop > FTop then 1423 FillRect(Rect(FLeft, FTop, FRight, RealTop)) 1424 else 1425 RealTop := FTop; 1426 if RealBottom < FBottom then 1427 FillRect(Rect(FLeft, RealBottom, FRight, FBottom)) 1428 else 1429 RealBottom := FBottom; 1430 Brush.Color := $000000; 1431 FillRect(Rect(FLeft, RealTop, FRight, RealBottom)); 1432 Brush.Style := bsClear; 1433 end; 1434 1435 for dy := 0 to ny + 1 do 1436 if (Loc + dy * G.lx >= 0) and (Loc + (dy - 3) * G.lx < G.lx * G.ly) 1437 then 1438 for dx := 0 to nx do 1439 begin 1440 ALoc := dLoc(Loc, dx - (dy + dx) and 1, dy - 2); 1441 BLoc := dLoc(Loc, dx - (dy + dx + 1) and 1, dy - 1); 1442 if (ALoc < 0) or (ALoc >= G.lx * G.ly) then 1443 ATer := PoleTile(ALoc) and fTerrain 1444 else 1445 ATer := MyMap[ALoc] and fTerrain; 1446 if (BLoc < 0) or (BLoc >= G.lx * G.ly) then 1447 BTer := PoleTile(BLoc) and fTerrain 1448 else 1449 BTer := MyMap[BLoc] and fTerrain; 1450 1451 if (ATer <> fUNKNOWN) or (BTer <> fUNKNOWN) then 1452 if ((ATer < fGrass) or (ATer = fUNKNOWN)) and 1453 ((BTer < fGrass) or (BTer = fUNKNOWN)) then 1454 begin 1455 if ATer = fUNKNOWN then 1456 Aix := 0 1457 else if IsShoreTile(ALoc) then 1458 if ATer = fOcean then 1459 Aix := -1 1460 else 1461 Aix := 1 1462 else 1463 Aix := ATer + 2; 1464 if BTer = fUNKNOWN then 1465 bix := 0 1466 else if IsShoreTile(BLoc) then 1467 if BTer = fOcean then 1468 bix := -1 1469 else 1470 bix := 1 1471 else 1472 bix := BTer + 2; 1473 if (Aix > 1) or (bix > 1) then 1474 begin 1475 if Aix = -1 then 1476 if bix = fOcean + 2 then 1477 begin 1478 Aix := 0; 1479 bix := 0 1480 end 1481 else 1482 begin 1483 Aix := 0; 1484 bix := 1 1485 end 1486 else if bix = -1 then 1487 if Aix = fOcean + 2 then 1488 begin 1489 Aix := 1; 1490 bix := 1 1491 end 1492 else 1493 begin 1494 Aix := 1; 1495 bix := 0 1496 end; 1497 BitBlt(OceanPatch, x + dx * xxt, y + dy * yyt, xxt, yyt, 1498 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, 1499 bix * yyt, SRCCOPY) 1500 end 1501 end 1502 else 1503 begin 1504 if ATer = fUNKNOWN then 1505 Aix := 0 1506 else if (ALoc >= 0) and (ALoc < G.lx * G.ly) and 1507 (MyMap[ALoc] and fDeadLands <> 0) then 1508 Aix := -2 1509 else if ATer = fOcean then 1510 Aix := -1 1511 else if ATer = fShore then 1512 Aix := 1 1513 else if ATer >= fForest then 1514 Aix := 8 1515 else 1516 Aix := ATer; 1517 if BTer = fUNKNOWN then 1518 bix := 0 1519 else if (BLoc >= 0) and (BLoc < G.lx * G.ly) and 1520 (MyMap[BLoc] and fDeadLands <> 0) then 1521 bix := -2 1522 else if BTer = fOcean then 1523 bix := -1 1524 else if BTer = fShore then 1525 bix := 1 1526 else if BTer >= fForest then 1527 bix := 8 1528 else 1529 bix := BTer; 1530 if (Aix = -2) and (bix = -2) then 1531 begin 1532 Aix := fDesert; 1533 bix := fDesert 1534 end 1535 else if Aix = -2 then 1536 if bix < 2 then 1537 Aix := 8 1538 else 1539 Aix := bix 1540 else if bix = -2 then 1541 if Aix < 2 then 1542 bix := 8 1543 else 1544 bix := Aix; 1545 if Aix = -1 then 1546 BitBlt(GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, 1547 xxt, yyt, 1 + 6 * (xxt * 2 + 1) + (dx + dy + 1) and 1548 1 * xxt, 1 + yyt, SRCCOPY) // arctic <-> ocean 1549 else if bix = -1 then 1550 BitBlt(GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, 1551 xxt, yyt, 1 + 6 * (xxt * 2 + 1) + xxt - (dx + dy + 1) 1552 and 1 * xxt, 1 + yyt * 2, SRCCOPY) // arctic <-> ocean 1553 else 1554 BitBlt(LandPatch, x + dx * xxt, y + dy * yyt, xxt, yyt, 1555 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, 1556 bix * yyt, SRCCOPY) 1557 end 1558 end; 1559 1560 OutDC := FOutput.Canvas.Handle; 1561 DataDC := GrExt[HGrTerrain].Data.Canvas.Handle; 1562 MaskDC := GrExt[HGrTerrain].Mask.Canvas.Handle; 1563 for dy := -2 to ny + 1 do 1564 for dx := -1 to nx do 1565 if (dx + dy) and 1 = 0 then 1566 PaintShore(x + xxt * dx, y + yyt + yyt * dy, dLoc(Loc, dx, dy)); 1567 for dy := -2 to ny + 1 do 1568 for dx := -1 to nx do 1569 if (dx + dy) and 1 = 0 then 1570 PaintTileExtraTerrain(x + xxt * dx, y + yyt + yyt * dy, 1571 dLoc(Loc, dx, dy)); 1572 if CityOwner >= 0 then 1573 begin 1574 for dy := -2 to ny + 1 do 1575 for dx := -2 to nx + 1 do 1576 if (dx + dy) and 1 = 0 then 1577 begin 1578 ALoc := dLoc(Loc, dx, dy); 1579 if Distance(ALoc, CityLoc) > 5 then 1580 PaintTileObjects(x + xxt * dx, y + yyt + yyt * dy, ALoc, 1581 CityLoc, CityOwner, UseBlink); 1582 end; 1583 dx := ((CityLoc mod G.lx * 2 + CityLoc div G.lx and 1) - 1584 ((Loc + 666 * G.lx) mod G.lx * 2 + (Loc + 666 * G.lx) div G.lx and 1585 1) + 3 * G.lx) mod (2 * G.lx) - G.lx; 1586 dy := CityLoc div G.lx - (Loc + 666 * G.lx) div G.lx + 666; 1587 xm := x + (dx + 1) * xxt; 1588 ym := y + (dy + 1) * yyt + yyt; 1589 ShadeOutside(FLeft, FTop, FRight, FBottom, xm, ym); 1590 CityGrid(xm, ym); 1591 for dy := -2 to ny + 1 do 1592 for dx := -2 to nx + 1 do 1593 if (dx + dy) and 1 = 0 then 1594 begin 1595 ALoc := dLoc(Loc, dx, dy); 1596 if Distance(ALoc, CityLoc) <= 5 then 1597 PaintTileObjects(x + xxt * dx, y + yyt + yyt * dy, ALoc, 1598 CityLoc, CityOwner, UseBlink); 1599 end; 1600 end 1601 else 1602 begin 1603 if ShowLoc or (Options and (1 shl moEditMode) <> 0) or 1604 (Options and (1 shl moGrid) <> 0) then 1605 PaintGrid(x, y, nx, ny); 1606 for dy := -2 to ny + 1 do 1607 for dx := -2 to nx + 1 do 1608 if (dx + dy) and 1 = 0 then 1609 PaintTileObjects(x + xxt * dx, y + yyt + yyt * dy, 1610 dLoc(Loc, dx, dy), CityLoc, CityOwner, UseBlink); 1611 end; 1612 1613 // frame(FOutput.Canvas,x+1,y+1,x+nx*33+33-2,y+ny*16+32-2,$FFFF,$FFFF); 1614 end; { Paint } 1615 1616 procedure TIsoMap.AttackBegin(const ShowMove: TShowMove); 1617 begin 1618 AttLoc := ShowMove.FromLoc; 1619 DefLoc := dLoc(AttLoc, ShowMove.dx, ShowMove.dy); 1620 DefHealth := -1; 1621 end; 1622 1623 procedure TIsoMap.AttackEffect(const ShowMove: TShowMove); 1624 begin 1625 DefHealth := ShowMove.EndHealthDef; 1626 end; 1627 1628 procedure TIsoMap.AttackEnd; 1629 begin 1630 AttLoc := -1; 1631 DefLoc := -1; 1632 end; 1575 end 1576 else 1577 begin 1578 if ShowLoc or (Options and (1 shl moEditMode) <> 0) or 1579 (Options and (1 shl moGrid) <> 0) then 1580 PaintGrid(x, y, nx, ny); 1581 for dy := -2 to ny + 1 do 1582 for dx := -2 to nx + 1 do 1583 if (dx + dy) and 1 = 0 then 1584 PaintTileObjects(x + xxt * dx, y + yyt + yyt * dy, dLoc(Loc, dx, dy), 1585 CityLoc, CityOwner, UseBlink); 1586 end; 1587 1588 // frame(FOutput.Canvas,x+1,y+1,x+nx*33+33-2,y+ny*16+32-2,$FFFF,$FFFF); 1589 end; { Paint } 1590 1591 procedure TIsoMap.AttackBegin(const ShowMove: TShowMove); 1592 begin 1593 AttLoc := ShowMove.FromLoc; 1594 DefLoc := dLoc(AttLoc, ShowMove.dx, ShowMove.dy); 1595 DefHealth := -1; 1596 end; 1597 1598 procedure TIsoMap.AttackEffect(const ShowMove: TShowMove); 1599 begin 1600 DefHealth := ShowMove.EndHealthDef; 1601 end; 1602 1603 procedure TIsoMap.AttackEnd; 1604 begin 1605 AttLoc := -1; 1606 DefLoc := -1; 1607 end; 1633 1608 1634 1609 initialization
Note:
See TracChangeset
for help on using the changeset viewer.
