home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / WIN95 / Programa / PERSPTEX.ZIP / TEXTURE.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1996-08-11  |  9.8 KB  |  371 lines
  1.  
  2. {
  3.   Perspective Texture Mapping Demo. 11 Aug 96.
  4.   Copyright (c) 1996 Keith Harrison.
  5.   Delphi 2.0 32 bit version for Windows 95.
  6.   For private use only.
  7. }
  8.  
  9. unit Texture;
  10.  
  11. interface
  12.  
  13. uses
  14.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  15.   ExtCtrls, ComCtrls, StdCtrls, Buttons;
  16.  
  17. type
  18.   ScanPoints = (NoPoints, OnePoint, TwoPoints); //Note: Convex polygons only!
  19.  
  20.   ScanType = record //One of these for each Y coord on screen
  21.     points: ScanPoints; //Either none, one, or two points
  22.     x1, x2: Integer; //X coord of two points max (Y coord is from position in array)
  23.     u1, v1, z1: Single; //Texture coordinates
  24.     u2, v2, z2: Single; //Texture coordinates
  25.   end;
  26.  
  27.   VertType = record
  28.     x, y, z: Integer; //Coordinates of vertex in worldspace
  29.     sx, sy: Integer;  //Screen coordinate after projection
  30.     u, v: Single; //Coordinate of texture at this vertex
  31.   end;
  32.  
  33.   TForm1 = class(TForm)
  34.     GroupBox1: TGroupBox;
  35.     RadioButton1: TRadioButton;
  36.     RadioButton2: TRadioButton;
  37.     GroupBox2: TGroupBox;
  38.     Image1: TImage;
  39.     Label1: TLabel;
  40.     TrackBar1: TTrackBar;
  41.     lblRepeat: TLabel;
  42.     GroupBox3: TGroupBox;
  43.     Label2: TLabel;
  44.     Label3: TLabel;
  45.     Label4: TLabel;
  46.     Edit1: TEdit;
  47.     Edit2: TEdit;
  48.     Edit3: TEdit;
  49.     Edit4: TEdit;
  50.     Edit5: TEdit;
  51.     Edit6: TEdit;
  52.     Edit7: TEdit;
  53.     Edit8: TEdit;
  54.     Label5: TLabel;
  55.     Image2: TImage;
  56.     Edit9: TEdit;
  57.     Edit10: TEdit;
  58.     Edit11: TEdit;
  59.     Edit12: TEdit;
  60.     Label6: TLabel;
  61.     Label7: TLabel;
  62.     Label8: TLabel;
  63.     SpeedButton1: TSpeedButton;
  64.     procedure TrackBar1Change(Sender: TObject);
  65.     procedure FormCreate(Sender: TObject);
  66.     procedure FormPaint(Sender: TObject);
  67.     procedure SpeedButton1Click(Sender: TObject);
  68.     procedure FormDestroy(Sender: TObject);
  69.   private
  70.     { Private declarations }
  71.   public
  72.     { Public declarations }
  73.   end;
  74.  
  75. Const
  76.   TEX_X = 127; //Texture mask (width of texture bitmap - 1)
  77.   TEX_Y = 127; //Texture mask (height of texture bitmap - 1)
  78.   HSCALE = 10; //Scale used in perspective projection.
  79.   VSCALE = 10; //(as above)
  80.   FormCaption = 'Perspective Texture Mapping Test: ';
  81.  
  82. var
  83.   Form1: TForm1;
  84.   Bitmap: TBitmap; //We will draw onto this then blit to the screen.
  85.  
  86.   SCREEN_X, SCREEN_Y, MID_X, MID_Y: Integer; //Screen info
  87.   tex: array[0..TEX_X, 0..TEX_Y] of TColor; //Holds the texture pixels
  88.   scan: array[0..1023] of ScanType; //One for each potential screen Y coord
  89.   v: array[0..3] of VertType; //Hold the vertices
  90.  
  91. implementation
  92.  
  93. {$R *.DFM}
  94.  
  95. procedure TForm1.TrackBar1Change(Sender: TObject);
  96. begin
  97.   lblRepeat.Caption := IntToStr(TrackBar1.Position);
  98. end;
  99.  
  100. procedure TForm1.FormCreate(Sender: TObject);
  101. var
  102.   i, j: Integer;
  103. begin
  104.   SCREEN_X := Image2.Width; //The bitmap is made to fit its container
  105.   SCREEN_Y := Image2.Height;
  106.   MID_X := SCREEN_X div 2;
  107.   MID_Y := SCREEN_Y div 2;
  108.  
  109.   //Make our drawing surface - CreateDIBSection would be preferable... 8)
  110.   Bitmap := TBitmap.Create;
  111.   Bitmap.Width := SCREEN_X;
  112.   Bitmap.Height := SCREEN_Y;
  113.  
  114.   for i:=0 to TEX_X do
  115.     for j:= 0 to TEX_Y do
  116.       tex[i,j] := Image1.Canvas.Pixels[i,j]; //This could be done much faster.
  117.  
  118.   //This program does not bother with palettes, hence this warning
  119.   if ((1 shl GetDeviceCaps(Canvas.Handle, BITSPIXEL)) < 65536) then
  120.     MessageDlg('This program runs best in 16bit colour or higher',
  121.       mtInformation, [mbOk], 0);
  122. end;
  123.  
  124. procedure InitScans;
  125. var
  126.   i: Integer;
  127. begin
  128.   for i:=0 To SCREEN_Y do
  129.     scan[i].points := NoPoints; //Empty all scanlines in the edge list
  130. end;
  131.  
  132. procedure AddEdge(p1, p2: Integer);
  133. var
  134.   temp, i, v1, v2: Integer;
  135.   dy: Single;
  136.   xp, zp, up, vp: Single; //Prime vars
  137.   dxp, dzp, dup, dvp: Single; // Delta-Prime vars
  138.   zp1, up1, vp1: Single; //Primes of 1st point
  139.   zp2, up2, vp2: Single; //Primes of 2nd point
  140. begin
  141.   v1 := p1; //These are pointers - could be altered to Vertex pointers
  142.   v2 := p2; //""
  143.  
  144.   //Horizontal lines are ignored
  145.   if v[v1].sy = v[v2].sy then exit;
  146.  
  147.   if v[v2].sy < v[v1].sy then begin
  148.     //Swap pointers
  149.     temp := v1;
  150.     v1 := v2;
  151.     v2 := temp;
  152.   end;
  153.  
  154.   zp1 := 1.0 / v[v1].z;
  155.   up1 := v[v1].u * zp1;
  156.   vp1 := v[v1].v * zp1;
  157.  
  158.   zp2 := 1.0 / v[v2].z;
  159.   up2 := v[v2].u * zp2;
  160.   vp2 := v[v2].v * zp2;
  161.  
  162.   xp := v[v1].sx;
  163.   up := up1;
  164.   vp := vp1;
  165.   zp := zp1;
  166.  
  167.   dy := 1.0 / (v[v2].sy - v[v1].sy);
  168.   dxp := (v[v2].sx - v[v1].sx) * dy;
  169.   dup := (up2 - up1) * dy;
  170.   dvp := (vp2 - vp1) * dy;
  171.   dzp := (zp2 - zp1) * dy;
  172.  
  173.   for i:= v[v1].sy to v[v2].sy - 1 do begin
  174.     if (i >= 0) and (i < SCREEN_Y) then
  175.       case scan[i].points of
  176.       NoPoints: begin
  177.         scan[i].points := OnePoint;
  178.         scan[i].x1 := Trunc(xp);
  179.         scan[i].u1 := up;
  180.         scan[i].v1 := vp;
  181.         scan[i].z1 := zp;
  182.         scan[i].x2 := Trunc(xp); //Copying to both points eliminates the
  183.         scan[i].u2 := up;        //need to swap at case:OnePoints
  184.         scan[i].v2 := vp;
  185.         scan[i].z2 := zp;
  186.       end;
  187.       OnePoint: begin
  188.         scan[i].points := TwoPoints;
  189.         if scan[i].x1 > xp then begin
  190.           scan[i].x1 := Trunc(xp);
  191.           scan[i].u1 := up;
  192.           scan[i].v1 := vp;
  193.           scan[i].z1 := zp;
  194.         end
  195.         Else begin
  196.           scan[i].x2 := Trunc(xp);
  197.           scan[i].u2 := up;
  198.           scan[i].v2 := vp;
  199.           scan[i].z2 := zp;
  200.         end;
  201.       end;
  202.     end;
  203.     xp := xp + dxp;
  204.     up := up + dup;
  205.     vp := vp + dvp;
  206.     zp := zp + dzp;
  207.   end;
  208. end;
  209.  
  210. procedure RenderScansAffine;
  211. var
  212.   i, j, length, tx, ty: Integer;
  213.   dx, up, vp, up0, vp0, up1, vp1, dup, dvp: Single;
  214.   {dzp: Single; Not used in this proc.}
  215. begin
  216.   for i:= 0 To Bitmap.Height - 1 do
  217.     if ((scan[i].points = TwoPoints) and (scan[i].x1 <> scan[i].x2)) then begin
  218.         up0 := scan[i].u1 / scan[i].z1;
  219.         vp0 := scan[i].v1 / scan[i].z1;
  220.         up1 := scan[i].u2 / scan[i].z2;
  221.         vp1 := scan[i].v2 / scan[i].z2;
  222.         up := up0;
  223.         vp := vp0;
  224.         length := scan[i].x2 - scan[i].x1;
  225.         dx := 1.0 / length;
  226.         dup := (up1 - up0) * dx;
  227.         dvp := (vp1 - vp0) * dx;
  228.         {dzp := (scan[i].z2 - scan[i].z1) * dx; Not used in this proc.}
  229.         for j := scan[i].x1 to scan[i].x2 do begin
  230.           tx := Trunc(up * TEX_X) and TEX_X; //Convert U-prime to texture coord
  231.           ty := Trunc(vp * TEX_Y) and TEX_Y; //Convert V-prime to texture coord
  232.           Bitmap.Canvas.Pixels[j,i] := tex[tx, ty]; //THIS IS SLOW!!!
  233.           up := up + dup;
  234.           vp := vp + dvp;
  235.         end;
  236.     end;
  237. end;
  238.  
  239. procedure RenderScansPerspective;
  240. var
  241.   i, j: Integer;
  242.   x1, x2, tx, ty: Integer;
  243.   tu, tv, tz: Single;
  244.   dtu, dtv, dtz: Single;
  245. begin
  246.   {
  247.    Note that this procedure gives perfect results with no distortion.
  248.    'Quake' uses sub-division for extra speed (sampling U and V at
  249.    intervals of 16 bits and linearly interpolating). The distortion is
  250.    hardly noticable.
  251.   }
  252.   for i:= 0 To Bitmap.Height - 1 do
  253.     if ((scan[i].points = TwoPoints) and (scan[i].x1 <> scan[i].x2)) then begin
  254.       x1 := scan[i].x1;
  255.       x2 := scan[i].x2;
  256.       tu := scan[i].u1;
  257.       tv := scan[i].v1;
  258.       tz := scan[i].z1;
  259.       dtu := (scan[i].u2 - tu) / (x2 - x1);
  260.       dtv := (scan[i].v2 - tv) / (x2 - x1);
  261.       dtz := (scan[i].z2 - tz) / (x2 - x1);
  262.       for j:= x1 To x2 do begin
  263.         tx := Trunc(tu / tz * TEX_X) and TEX_X;
  264.         ty := Trunc(tv / tz * TEX_Y) and TEX_Y;
  265.         Bitmap.Canvas.Pixels[j,i] := tex[tx, ty]; //THIS IS SLOW!!!
  266.         tu := tu + dtu;
  267.         tv := tv + dtv;
  268.         tz := tz + dtz;
  269.       end;
  270.     end;
  271. end;
  272.  
  273. procedure RenderScans;
  274. begin
  275.   if Form1.RadioButton1.Checked = True then begin
  276.     Form1.Caption := FormCaption + 'AFFINE (LINEAR)';
  277.     RenderScansAffine;
  278.   end
  279.   else begin
  280.     Form1.Caption := FormCaption + 'PERSPECTIVE (PERFECT)';
  281.     RenderScansPerspective;
  282.   end;
  283. end;
  284.  
  285. procedure DrawTexturedPolygon;
  286. var
  287.   i, z: Integer;
  288.   uv: Single;
  289. begin
  290.   Screen.Cursor := crHourglass;
  291.  
  292.   try
  293.   begin
  294.     //Clear bitmap
  295.     with Bitmap.Canvas do begin
  296.       Brush.Color := clBlack;
  297.       Brush.Style := bsSolid;
  298.       Fillrect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
  299.     end;
  300.  
  301.     //Read vertex coords
  302.     with Form1 do begin
  303.       v[0].x := StrToInt(Edit1.Text);
  304.       v[0].y := StrToInt(Edit2.Text);
  305.       v[0].z := StrToInt(Edit3.Text);
  306.       v[1].x := StrToInt(Edit4.Text);
  307.       v[1].y := StrToInt(Edit5.Text);
  308.       v[1].z := StrToInt(Edit6.Text);
  309.       v[2].x := StrToInt(Edit7.Text);
  310.       v[2].y := StrToInt(Edit8.Text);
  311.       v[2].z := StrToInt(Edit9.Text);
  312.       v[3].x := StrToInt(Edit10.Text);
  313.       v[3].y := StrToInt(Edit11.Text);
  314.       v[3].z := StrToInt(Edit12.Text);
  315.     end;
  316.  
  317.     //Texture coord's (floats)
  318.     uv := Form1.TrackBar1.Position;
  319.     v[0].u := 0.0;
  320.     v[0].v := 0.0;
  321.     v[1].u := uv;
  322.     v[1].v := 0.0;
  323.     v[2].u := uv;
  324.     v[2].v := uv;
  325.     v[3].u := 0.0;
  326.     v[3].v := uv;
  327.  
  328.     //Perspective projection
  329.     for i := 0 To 3 do begin
  330.       z := v[i].z;
  331.       if z = 0 Then z := 1; // Catch divide by zero.
  332.       v[i].sx := (v[i].x * HSCALE div z) + MID_X;
  333.       v[i].sy := (-v[i].y * VSCALE div z) + MID_Y;
  334.     end;
  335.  
  336.     InitScans; //Set up the scanline edge list
  337.  
  338.     AddEdge(0,1); //Add an edge to the edge list
  339.     AddEdge(1,2);
  340.     AddEdge(2,3);
  341.     AddEdge(3,0);
  342.  
  343.     RenderScans; //Draw any spans in the edge list
  344.  
  345.     Form1.Image2.Canvas.Draw(0, 0, Bitmap); //Blit to screen
  346.   end;
  347.   finally
  348.     Screen.Cursor := crDefault;
  349.   end;
  350. end;
  351.  
  352.  
  353. procedure TForm1.FormPaint(Sender: TObject);
  354. begin
  355.   DrawTexturedPolygon;
  356. end;
  357.  
  358. procedure TForm1.SpeedButton1Click(Sender: TObject);
  359. begin
  360.   DrawTexturedPolygon;
  361. end;
  362.  
  363. procedure TForm1.FormDestroy(Sender: TObject);
  364. begin
  365.   Bitmap.Free;
  366. end;
  367.  
  368. end.
  369.  
  370.  
  371.