unit TexturePoly;

interface

Uses
  Windows, SysUtils, Graphics;

Type
  TPoly4 = Record
    case Integer of
      0 : (x1,y1,x2,y2,x3,y3,x4,y4: Integer);
      1 : (TopLeft, TopRight, BottomRight, BottomLeft: TPoint);
      2 : (Points : Array[0..3] of TPoint);
    end;

Procedure SwapIntegers(var A,B : Integer);
Procedure TexturePoly4(Poly4 : TPoly4; Source, Dest : TBitmap);

implementation

Function GetMaxInteger4(var A,B,C,D : Integer) : Integer;
var
  T : Integer;
Begin
  T := A;
  If B > T then T := B;  If C > T then T := C;  If D > T then T := D;
  Result := T;
End;

Function GetMinInteger4(var A,B,C,D : Integer) : Integer;
var
  T : Integer;
Begin
  T := A;
  If B < T then T := B;  If C < T then T := C;  If D < T then T := D;
  Result := T;
End;

Procedure SwapIntegers(var A,B : Integer);
var
  T : Integer;
Begin
  T := A;  A := B;  B := T;
End;

Type
  TE = Record X : Integer; px, py : Byte; End;
  Table = Array[0..512] of TE;
  PTable = ^Table;

Var
  Left, Right : Table;

Procedure TexturePoly4(Poly4 : TPoly4; Source, Dest : TBitmap);
//Procedure Texture4Poly(X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer; Dim :
Byte);

Var
  yMin, yMax, xStart, xEnd, yStart, yEnd, pxStart, pxEnd : Integer;
  pyStart,pyEnd, pxVal, pxStep, pyVal, pyStep, Count : Integer;
  XVal, XStep : Longint;
  Side : PTable;

  Procedure DoSide(X1,Y1,X2,Y2, PX1,PY1,PX2,PY2 : Integer);
  var
    Count : Integer;
  Begin
    If Y1 = Y2 then Exit;    // --> Nothing worth drawing.
    If Y2 < Y1 then          // --> It is upside down.
      Begin
        SwapIntegers(Y1,Y2);
        SwapIntegers(X1,X2);
        SwapIntegers(PX1,PX2);
        SwapIntegers(PY1,PY2);
        Side := @Left
      End else Side := @Right;

    xStart := X1;  xEnd := X2;
    yStart := Y1;  yEnd := Y2;

    xStep  := (( X2- X1) shl 7) div (Y2-Y1);
    pxStep := ((PX2-PX1) shl 7) div (Y2-Y1);

    xVal   := X1 shl 7;      // all shl 7 is used to avoid using...
    pxVal  := PX1;           // real number division for speed.

    For Count := Y1 to Y2 do
      Begin
        Side^[Count].x  := xVal  shr 7;
        Side^[Count].px := pxVal shr 7;
        Side^[Count].py := pyVal shr 7;
        pxVal := pxVal + pxStep;
      End;
  End; { DoSide }

  Procedure HLine(X1,X2,PX1,PY1,PX2,PY2,Y : Integer);
  var
    Count : Word;
    P     : PByteArray;
  Begin
    pxStep := ((px2-px1) Shl 8) Div (x2-x1+1);
    // (px2-px1) is Source.bmWidth
    pyStep := ((py2-py1) Shl 8) Div (x2-x1+1);
    // (py2-py1) is Source.bmHeight
    pxVal := px1 Shl 8;
    pyVal := py1 Shl 8;
    // reason for all shl 8 is for rounding purposes using hi()
    P := Dest.Scanline[Y];
    // scanline[] is quicker then pixels[]
    for Count := X1 to X2 do
      Begin
        P[Count] := Source.Canvas.Pixels[hi(pxVal),hi(pyVal)];
        // using hi() instead of round(real) for speed
        pxVal := pxVal + pxStep;
        pyVal := pyVal + pyStep;
      End;
  End; { HLine }

Begin

  with Poly4 do yMin := GetMinInteger4(Y1,Y2,Y3,Y4);
  with Poly4 do yMax := GetMaxInteger4(Y1,Y2,Y3,Y4);

  If (yMin > Dest.Width) or (yMax < 0) then Exit;

  With poly4 do DoSide(X1,Y1,X2,Y2, 0,0,Source.Width,0);
  With poly4 do DoSide(X2,Y2,X3,Y3, Source.Width,0,
Source.Width,Source.Height);
  With poly4 do DoSide(X3,Y3,X4,Y4,
Source.Width,Source.Height,0,Source.Height);
  With poly4 do DoSide(X4,Y4,X1,Y1, 0,Source.Height,0,0);

  For Count := yMin to yMax do If Left[Count].x < Right[Count].x Then
    HLine(Left[Count].x, Right[Count].x, Left[Count].px, Left[Count].py,
      Right[Count].px, Right[Count].py, Count) Else
    HLine(Right[Count].x, Left[Count].x, Right[Count].px, Right[Count].py,
      Left[Count].px, Left[Count].py, Count);

End;