home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / news / sorcpak / pas_0493 / vecttest.pas < prev    next >
Pascal/Delphi Source File  |  1993-04-29  |  9KB  |  318 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 533 of 658
  3. From : Trevor Robinson                     1:3808/10.0          25 Apr 93  19:41
  4. To   : Sean Palmer
  5. Subj : DownScaling Bitmaps 1/2
  6. ────────────────────────────────────────────────────────────────────────────────
  7.  -=> Quoting Sean Palmer to Trevor Robinson <=-
  8.  
  9.  TR> It is called DDA texture mapping, and is used to add texture to 3D
  10.  TR> vector objects.  It is basically polygon drawing code that keeps track
  11.  TR> of transformed coordinates in a source bitmap.  There is C source for
  12.  TR> it in the Sep. '92 issue of DDJ.  I have rewritten it for Turbo Pascal,
  13.  TR> but need to rewrite it again in ASM to make it fast enough to use.
  14.  
  15.  SP> Post! Post!! If not here then in the PASCAL echo, I can translate to
  16.  SP> asm... I NEED those algorithms! I may have to just subscribe to DDJ...
  17.  
  18. Okay, here it is, hope you can figure them out...  When you finish your
  19. assembly translation, please post it in the 80XXX echo.  I'd like to see it,
  20. because it is quite complicated.  It uses 386 fixed-point arithmetic, which
  21. is in assembly, but I'll post that in the Pascal echo anyway.  (I think you'll
  22. be able to figure out the routines in XGraph.)
  23.  
  24. *** DDA texture mapping routines for Turbo Pascal }
  25.  
  26. {$R-,X+}
  27. Program VectTest;
  28. Uses
  29.   Dos, Crt, XGraph;
  30. Const
  31.   ClipMinY = 0;
  32.   ClipMaxY = 199;
  33.   ClipMinX = 0;
  34.   ClipMaxX = 319;
  35.   VertMax = 4;
  36. Type
  37.   TextureMap = Record
  38.     TexMapWidth : Word;
  39.     TexMapBits : Pointer;
  40.   End;
  41.   VertRec = Record
  42.     X, Y : Integer;
  43.   End;
  44.   VertArr = Array [0..VertMax] Of VertRec;
  45.   Face = Record
  46.     VertNums : ^VertArr;
  47.     NumVerts : Word;
  48.     ColorIdx : Byte;
  49.     ShadeTyp : Byte;
  50.     TexMap : TextureMap;
  51.     Point : ^VertArr;
  52.   End;
  53.   EdgeScan = Record
  54.     Direction : Integer;
  55.     RemainingScans : Integer;
  56.     CurrentEnd : Integer;
  57.     SourceX : Longint;
  58.     SourceY : Longint;
  59.     SourceStepX : Longint;
  60.     SourceStepY : Longint;
  61.     DestX : Integer;
  62.     DestXIntStep : Integer;
  63.     DestXDirection : Integer;
  64.     DestXErrTerm : Integer;
  65.     DestXAdjUp : Integer;
  66.     DestXAdjDown : Integer;
  67.   End;
  68. Var
  69.   GD, GM, MapX, MapY : Integer;
  70.   Poly : Face;
  71.  
  72. PROCEDURE LoadPal (N : STRING);
  73. VAR
  74.   F : FILE;
  75.   Pal : PalType;
  76. BEGIN
  77.   ASSIGN (F, N);
  78.   {$I-} RESET (F, 1); {$I+}
  79.   IF IORESULT <> 0 THEN BEGIN
  80.     SetTextMode;
  81.     HALT;
  82.   END;
  83.   BLOCKREAD (F, Pal, SIZEOF (Pal) );
  84.   SetAllPal (Pal);
  85.   CLOSE (F);
  86. END;
  87.  
  88. {$F+}
  89. {$L FIXEDM}
  90. Function FixedDiv(L1, L2 : Longint) : Longint; External;
  91. {$F-}
  92.  
  93. Procedure DrawTexPoly(Var Polygon : Face);
  94. Var
  95.   MinY, MaxY, MinVert, MaxVert, I, DestY : Integer;
  96.   LeftEdge, RightEdge : EdgeScan;
  97.  
  98.   Function SetUpEdge(Var Edge : EdgeScan; StartVert : Integer) : Boolean;
  99.   Var
  100.     NextVert, DestXWidth : Integer;
  101.     DestYHeight, T : Longint;
  102.   Begin
  103.     SetUpEdge := True;
  104.     While (StartVert <> MaxVert) Do Begin
  105.       NextVert := StartVert + Edge.Direction;
  106.       If (NextVert >= Polygon.NumVerts) Then
  107.         NextVert := 0
  108.       Else If (NextVert < 0) Then
  109.         NextVert := Polygon.NumVerts - 1;
  110.       With Edge Do Begin
  111.         RemainingScans := Polygon.VertNums^[NextVert].Y -
  112.           Polygon.VertNums^[StartVert].Y;
  113.         If (RemainingScans <> 0) Then Begin
  114.           T := RemainingScans;        DestYHeight := T Shl 16;
  115.           CurrentEnd := NextVert;
  116.           T := Polygon.Point^[StartVert].X;   SourceX := T Shl 16;
  117.           T := Polygon.Point^[StartVert].Y;   SourceY := T Shl 16;
  118.           T := Polygon.Point^[NextVert].X;    T := T Shl 16;
  119. { Pascal equivalent of assembler fixed division:
  120.           SourceStepX := Trunc((T - SourceX) / DestYHeight * $10000);
  121. }
  122.           SourceStepX := FixedDiv(T - SourceX, DestYHeight);
  123.           T := Polygon.Point^[NextVert].Y;    T := T Shl 16;
  124. { Pascal equivalent of assembler fixed division:
  125.           SourceStepY := Trunc((T - SourceY) / DestYHeight * $10000);
  126. }
  127.           SourceStepY := FixedDiv(T - SourceY, DestYHeight);
  128.           DestX := Polygon.VertNums^[StartVert].X;
  129.           DestXWidth := Polygon.VertNums^[NextVert].X -
  130.             Polygon.VertNums^[StartVert].X;
  131.           If (DestXWidth < 0) Then Begin
  132.             DestXDirection := -1;
  133.             DestXWidth := -DestXWidth;
  134.             DestXErrTerm := 1 - RemainingScans;
  135.             DestXIntStep := -(DestXWidth Div RemainingScans);
  136.           End Else Begin
  137.             DestXDirection := 1;
  138.             DestXErrTerm := 0;
  139.             DestXIntStep := DestXWidth Div RemainingScans;
  140.           End;
  141.           DestXAdjUp := DestXWidth Mod RemainingScans;
  142.           DestXAdjDown := RemainingScans;
  143.           Exit;
  144.         End;
  145.         StartVert := NextVert;
  146.       End;
  147.     End;
  148.     SetUpEdge := False;
  149.   End;
  150.  
  151.   Function StepEdge(Var Edge : EdgeScan) : Boolean;
  152.   Begin
  153.     Dec(Edge.RemainingScans);
  154.     If (Edge.RemainingScans = 0) Then Begin
  155.       StepEdge := SetUpEdge(Edge, Edge.CurrentEnd);
  156.       Exit;
  157.     End;
  158.     With Edge Do Begin
  159.       Inc(SourceX,SourceStepX);
  160.       Inc(SourceY,SourceStepY);
  161.       Inc(DestX,DestXIntStep);
  162.       Inc(DestXErrTerm,DestXAdjUp);
  163.       If (DestXErrTerm > 0) Then Begin
  164.         Inc(DestX,DestXDirection);
  165.         Dec(DestXErrTerm,DestXAdjDown);
  166.       End;
  167.     End;
  168.     StepEdge := True;
  169.   End;
  170.  
  171.   Procedure ScanOutLine;
  172.   Var
  173.     T, SourceX, SourceY : Longint;
  174.     DestX, DestXMax : Integer;
  175.     DestWidth, SourceXStep, SourceYStep : Longint;
  176.     C : Byte;
  177.     A : Word;
  178.   Begin
  179.     SourceX := LeftEdge.SourceX;
  180.     SourceY := LeftEdge.SourceY;
  181.     DestX := LeftEdge.DestX;
  182.     DestXMax := RightEdge.DestX;
  183.     If (DestXMax <= ClipMinX) Or (DestX >= ClipMaxX) Then Exit;
  184.     T := DestXMax - DestX;
  185.     If (T <= 0) Then Exit;
  186.     DestWidth := T Shl 16;
  187. { Pascal equivalent of assembler fixed division:
  188.     SourceXStep := Trunc((RightEdge.SourceX - SourceX) / DestWidth * $10000);
  189.     SourceYStep := Trunc((RightEdge.SourceY - SourceY) / DestWidth * $10000);
  190. }
  191.     SourceXStep := FixedDiv(RightEdge.SourceX - SourceX, DestWidth);
  192.     SourceYStep := FixedDiv(RightEdge.SourceY - SourceY, DestWidth);
  193.     If (DestXMax > ClipMaxX) Then
  194.       DestXMax := ClipMaxX;
  195.     If (DestX < ClipMinX) Then Begin
  196.       Inc(SourceX, SourceXStep * (ClipMinX - DestX));
  197.       Inc(SourceY, SourceYStep * (ClipMinX - DestX));
  198.       DestX := ClipMinX;
  199.     End;
  200.     A := DestY * BytesPerLine + DestX;
  201.     While (DestX <= DestXMax) Do Begin
  202.       With Polygon.TexMap Do
  203.         C := Mem[Seg(TexMapBits^):Ofs(TexMapBits^) +
  204.           (SourceY Shr 16) * TexMapWidth + (SourceX Shr 16)];
  205.       If C = 0 Then Inc(C);
  206.       Mem[VideoSeg:A] := C;
  207.       Inc(SourceX, SourceXStep);
  208.       Inc(SourceY, SourceYStep);
  209.       Inc(DestX);
  210.       Inc(A);
  211.     End;
  212.   End;
  213.  
  214. Begin
  215.   If (Polygon.NumVerts < 3) Then Exit;
  216.   MinY := 32767;
  217.   MaxY := -32768;
  218.   For I := 0 To Polygon.NumVerts-1 Do
  219.     With Polygon Do Begin
  220.       If (VertNums^[I].Y < MinY) Then Begin
  221.         MinY := VertNums^[I].Y;
  222.         MinVert := I;
  223.       End;
  224.       If (VertNums^[I].Y > MaxY) Then Begin
  225.         MaxY := VertNums^[I].Y;
  226.         MaxVert := I;
  227.       End;
  228.     End;
  229.   If (MinY >= MaxY) Then Exit;
  230.   DestY := MinY;
  231.   LeftEdge.Direction := -1;
  232.   SetUpEdge(LeftEdge, MinVert);
  233.   RightEdge.Direction := 1;
  234.   SetUpEdge(RightEdge, MinVert);
  235.   While (DestY < ClipMaxY) Do Begin
  236.     If (DestY >= ClipMinY) Then
  237.       ScanOutLine;
  238.     If Not StepEdge(LeftEdge) Then Exit;
  239.     If Not StepEdge(RightEdge) Then Exit;
  240.     Inc(DestY);
  241.   End;
  242. End;
  243.  
  244. Function LoadBitMap(Fname : String; Var Polygon : Face) : Boolean;
  245. Var
  246.   F : File;
  247.   W : Word;
  248. Begin
  249.   LoadBitMap := False;
  250.   Assign(F, Fname);
  251.   {$I-} Reset(F, 1); {$I+}
  252.   If IOResult <> 0 Then Exit;
  253.   BlockRead(F, W, 2);
  254.   Dec(W, 6);
  255.   If MaxAvail < W Then Begin
  256.     Close(F);
  257.     Exit;
  258.   End;
  259.   With Polygon.TexMap Do Begin
  260.     BlockRead(F, TexMapWidth, 2);
  261.     MapX := TexMapWidth;
  262.     BlockRead(F, MapY, 2);
  263.     GetMem(TexMapBits, W);
  264.     BlockRead(F, TexMapBits^, W);
  265.   End;
  266.   Close(F);
  267.   LoadBitMap := True;
  268. End;
  269.  
  270. Begin
  271.   SetGraphMode;
  272.   DirectVideo := False;
  273.   LoadPal('C:\XGRAPH\PICT.PAL');
  274.   { PAL format: raw 768-byte palette information file }
  275.   If Not LoadBitMap('C:\XGRAPH\PICT.CUT', Poly) Then Begin
  276.     SetTextMode;
  277.     WriteLn('Error loading bitmap');
  278.     Halt;
  279.   End;
  280.   { CUT format: image size + 6 (word), width (word), height (word), image }
  281.   With Poly Do Begin
  282.     NumVerts := 4;
  283.     ColorIdx := 16;
  284.     ShadeTyp := 4;
  285.     GetMem(VertNums,(NumVerts + 1) * SizeOf(VertRec));
  286.     With VertNums^[0] Do Begin
  287.       X := 50;  Y := 40;
  288.     End;
  289.     With VertNums^[1] Do Begin
  290.       X := 240;  Y := 20;
  291.     End;
  292.     With VertNums^[2] Do Begin
  293.       X := 270;  Y := 160;
  294.     End;
  295.     With VertNums^[3] Do Begin
  296.       X := 70;  Y := 180;
  297.     End;
  298.     With VertNums^[3] Do Begin
  299.       X := 100;  Y := 140;
  300.     End;
  301.     GetMem(Point,NumVerts * SizeOf(VertRec));
  302.     With Point^[0] Do Begin
  303.       X := 0;  Y := 0;
  304.     End;
  305.     With Point^[1] Do Begin
  306.       X := MapX-1;  Y := 0;
  307.     End;
  308.     With Point^[2] Do Begin
  309.       X := MapX-1;  Y := MapY-1;
  310.     End;
  311.     With Point^[3] Do Begin
  312.       X := 0;  Y := MapY-1;
  313.     End;
  314.   End;
  315.   DrawTexPoly(Poly);
  316.   ReadKey;
  317.   SetTextMode;
  318. End.