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