[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]

    {
    SEAN PALMER

    > I've been trying For some time to get a Pascal Procedure that can
    > SCALE and/or ROTATE Graphic images. if anyone has any idea how to do this,
    > or has a source code, PLEEEAASSEE drop me a line.. THANK YOU!

    This is an out-and-out blatant hack of the routines from Abrash's
    XSHARP21. They are too slow to be usable as implemented here.
    }

    {$A-,B-,D+,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X+}
    {$M $2000,0,0}
    Program VectTest;
    Uses
      Crt, b320x200; {<-this Unit just implements Plot(x, y) and Color : Byte; }

    Const
      ClipMinY = 0;
      ClipMaxY = 199;
      ClipMinX = 0;
      ClipMaxX = 319;
      VertMax  = 3;

    Type
      fixed = Record
        Case Byte of
          0 : (f : Byte; si : shortint);
          1 : (f2, b : Byte);
          2 : (w : Word);
          3 : (i : Integer);
        end;

      ByteArray = Array [0..63999] of Byte;

      VertRec   = Record
        X, Y : Byte;
      end;

      VertArr   = Array [0..VertMax] Of VertRec;
      EdgeScan  = Record
        scansLeft   : Integer;
        Currentend  : Integer;
        srcX, srcY  : fixed;
        srcStepX,
        srcStepY    : fixed;
        dstX        : Integer;
        dstXIntStep : Integer;
        dstXdir     : Integer;
        dstXErrTerm : Integer;
        dstXAdjUp   : Integer;
        dstXAdjDown : Integer;
        dir         : shortInt;
      end;

    Const
      numVerts = 4;
      mapX     = 7;
      mapY     = 7;

      Vertex : Array [0..vertMax] of vertRec =
        ((x : 040; y : 020),
         (x : 160; y : 050),
         (x : 160; y : 149),
         (x : 040; y : 179));

      Points : Array [0..vertMax] of vertRec =
        ((x : 0; y : 0),
         (x : mapX; y : 0),
         (x : mapX; y : mapY),
         (x : 0; y : mapY));

      texMap : Array [0..mapY, 0..mapX] of Byte =
        (($F, $F, $F, $F, $F, $F, $F, $0),
         ($F, $7, $7, $7, $7, $7, $F, $0),
         ($F, $7, $2, $2, $2, $7, $F, $0),
         ($F, $7, $2, $2, $2, $7, $F, $0),
         ($F, $7, $2, $2, $9, $7, $F, $0),
         ($F, $7, $2, $2, $2, $7, $F, $0),
         ($F, $7, $2, $2, $2, $7, $F, $0),
         ($0, $0, $0, $0, $0, $0, $0, $0));

    Var
      lfEdge,
      rtEdge : EdgeScan;
      z, z2  : Integer;

    Function fixedDiv(d1, d2 : LongInt) : LongInt; Assembler;
    Asm
      db  $66; xor dx, dx
      mov cx, Word ptr D1+2
      or  cx, cx
      jns @S
      db  $66; dec dx
     @S:
      mov dx, cx
      mov ax, Word ptr D1
      db  $66; shl ax, 16
      db  $66; idiv Word ptr d2
      db  $66; mov dx, ax
      db  $66; shr dx, 16
    end;

    Function div2Fixed(d1, d2 : LongInt) : LongInt; Assembler;
    Asm
      db $66; xor dx, dx
      db $66; mov ax, Word ptr d1
      db $66; shl ax, 16
      jns @S
      db $66; dec dx
     @S:
      db $66; idiv Word ptr d2
      db $66; mov dx, ax
      db $66; shr dx, 16
    end;

    Function divfix(d1, d2 : Integer) : Integer; Assembler;
    Asm
      mov  al, Byte ptr d1+1
      cbw
      mov  dx, ax
      xor  al, al
      mov  ah, Byte ptr d1
      idiv d2
    end;

    Procedure Draw;
    Var
      MinY,
      MaxY,
      MinVert,
      MaxVert,
      I, dstY  : Integer;

      Function SetUpEdge(Var Edge : EdgeScan; StartVert : Integer) : Boolean;
      Var
        NextVert   : shortint;
        dstXWidth  : Integer;
        T,
        dstYHeight : fixed;
      begin
        SetUpEdge := True;
        While (StartVert <> MaxVert) Do
        begin
          NextVert := StartVert + Edge.dir;
          if (NextVert >= NumVerts) Then
            NextVert := 0
          else
          if (NextVert < 0) Then
            NextVert := pred(NumVerts);

          With Edge Do
          begin
           scansLeft := vertex[NextVert].Y - vertex[StartVert].Y;
           if (scansLeft <> 0) Then
           begin
             dstYHeight.f  := 0;
             dstYHeight.si := scansLeft;
             Currentend    := NextVert;
             srcX.f  := 0;
             srcX.si := Points[StartVert].X;
             srcY.f  := 0;
             srcY.si := Points[StartVert].Y;
             srcStepX.i := divFix(points[nextVert].x - srcX.si, scansLeft);
             srcStepY.i := divFix(points[nextVert].y - srcY.si, scansLeft);
             dstX       := vertex[StartVert].X;
             dstXWidth  := vertex[NextVert].X-vertex[StartVert].X;

             if (dstXWidth < 0) Then
             begin
               dstXdir     := -1;
               dstXWidth   := -dstXWidth;
               dstXErrTerm := 1 - scansLeft;
               dstXIntStep := -(dstXWidth Div scansLeft);
             end
             else
             begin
               dstXdir     := 1;
               dstXErrTerm := 0;
               dstXIntStep := dstXWidth Div scansLeft;
             end;
             dstXAdjUp   := dstXWidth Mod scansLeft;
             dstXAdjDown := scansLeft;
             Exit;
           end;
           StartVert := NextVert;
          end;
        end;
        SetUpEdge := False;
      end;

      Function StepEdge(Var Edge : EdgeScan) : Boolean;
      begin
        Dec(Edge.scansLeft);
        if (Edge.scansLeft = 0) Then
        begin
          StepEdge := SetUpEdge(Edge, Edge.Currentend);
          Exit;
        end;
        With Edge Do
        begin
          Inc(srcX.i, srcStepX.i);
          Inc(srcY.i, srcStepY.i);
          Inc(dstX, dstXIntStep);
          Inc(dstXErrTerm, dstXAdjUp);
          if (dstXErrTerm > 0) Then
          begin
            Inc(dstX, dstXdir);
            Dec(dstXErrTerm, dstXAdjDown);
          end;
        end;
        StepEdge := True;
      end;

      Procedure ScanOutLine;
      Var
        srcX,
        srcY     : fixed;
        dstX,
        dstXMax  : Integer;
        dstWidth,
        srcXStep,
        srcYStep : fixed;
      begin
        srcX.w  := lfEdge.srcX.w;
        srcY.w  := lfEdge.srcY.w;
        dstX    := lfEdge.dstX;
        dstXMax := rtEdge.dstX;

        if (dstXMax <= ClipMinX) Or (dstX >= ClipMaxX) Then
          Exit;
        dstWidth.f  := 0;
        dstWidth.si := dstXMax - dstX;
        if (dstWidth.i <= 0) Then
          Exit;
        srcXStep.i := divFix(rtEdge.srcX.i - srcX.i, dstWidth.i);
        srcYStep.i := divFix(rtEdge.srcY.i - srcY.i, dstWidth.i);
        if (dstXMax > ClipMaxX) Then
          dstXMax := ClipMaxX;
        if (dstX < ClipMinX) Then
        begin
          Inc(srcX.i, srcXStep.i * (ClipMinX - dstX));
          Inc(srcY.i, srcYStep.i * (ClipMinX - dstX));
          dstX := ClipMinX;
        end;

        Asm
         mov  ax, $A000
         mov  es, ax
         mov  ax, xRes
         mul  dstY
         add  ax, dstX
         mov  di, ax
         mov  cx, dstXMax
         sub  cx, dstX
         mov  bx, srcXStep.i
         mov  dx, srcYStep.i
        @L:
         mov  al, srcY.&si
         xor  ah, ah
         shl  ax, 3
         add  al, srcX.&si
         add  ax, offset texmap
         mov  si, ax
         movsb
         add  srcX.i,bx
         add  srcY.i,dx
         loop @L
         end;
       end;

    begin
      if (NumVerts < 3) Then
        Exit;
      MinY := vertex[numVerts - 1].y;
      maxY := vertex[numVerts - 1].y;
      maxVert := numVerts - 1;
      minVert := numVerts - 1;
      For I := numVerts - 2 downto 0 Do
      begin
        if (vertex[I].Y < MinY) Then
        begin
          MinY    := vertex[I].Y;
          MinVert := I;
        end;
        if (vertex[I].Y > MaxY) Then
        begin
          MaxY    := vertex[I].Y;
          MaxVert := I;
        end;
      end;
      if (MinY >= MaxY) Then
        Exit;
      dstY := MinY;
      lfEdge.dir := -1;
      SetUpEdge(lfEdge, MinVert);
      rtEdge.dir := 1;
      SetUpEdge(rtEdge, MinVert);
      While (dstY < ClipMaxY) Do
      begin
        if (dstY >= ClipMinY) Then
          ScanOutLine;
        if Not StepEdge(lfEdge) Then
          Exit;
        if Not StepEdge(rtEdge) Then
          Exit;
        Inc(dstY);
      end;
    end;

    begin
      directVideo := False;
      TextAttr    := 63;
      { For z:=0 to mapY do For z2:=0 to mapx do texMap[z,z2]:=random(6+53);}
      For z := 4 to 38 do
      begin
        clearGraph;
        vertex[0].x := z * 4;
        vertex[3].x := z * 4;
        draw;
        if KeyPressed then
        begin
          ReadKey;
          ReadKey;
        end;
      end;
      readln;
    end.

[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]