home *** CD-ROM | disk | FTP | other *** search
/ Virtual Reality Homebrewer's Handbook / vr.iso / 3dgraph / pascal / chap2_12.pas < prev    next >
Pascal/Delphi Source File  |  1996-03-19  |  12KB  |  375 lines
  1. program chap2_12;
  2.  
  3. uses graph, crt;
  4.  
  5. const xoffset=640/2;
  6.       yoffset=480/2;
  7.       xscale=1;
  8.       yscale=-1;
  9.       persp=500;
  10.  
  11. type point=record
  12.        xw, yw, zw : real;
  13.        xs, ys, zs : integer;
  14.      end;
  15.  
  16.      matrix_4x4=array[1..4,1..4] of real;
  17.  
  18. var vertex : array[1..18] of point;
  19.     faces : array[1..13,1..6] of word;  {First entry is face colour}
  20.     face_list : array[1..13,1..2] of integer; {First entry is face, second is depth}
  21.     polygon : array[1..15] of PointType;
  22.     f : text;
  23.     c, c2, hither : integer;
  24.     ch : char;
  25.     w2v, temp, temp2 : matrix_4x4;
  26.  
  27. procedure Initialise_Graphics;
  28. var Graphdriver, Graphmode, Errorcode : integer;
  29. begin
  30.      Graphdriver:=Detect;
  31.      InitGraph(Graphdriver, Graphmode,'');
  32.      Errorcode:=graphresult;
  33.      if Errorcode<>grOk then
  34.      begin
  35.           writeln('Graphics Error: ',GraphErrorMsg(ErrorCode));
  36.           writeln('Program Aborted');
  37.           Halt(1);
  38.      end;
  39.      SetLineStyle(0,0,3);
  40. end;
  41.  
  42. procedure translate(x,y,z : real; var m : matrix_4x4);
  43. begin
  44.      m[1,1]:=1; m[2,1]:=0; m[3,1]:=0; m[4,1]:=0;
  45.      m[1,2]:=0; m[2,2]:=1; m[3,2]:=0; m[4,2]:=0;
  46.      m[1,3]:=0; m[2,3]:=0; m[3,3]:=1; m[4,3]:=0;
  47.      m[1,4]:=x; m[2,4]:=y; m[3,4]:=z; m[4,4]:=1;
  48. end;
  49.  
  50. procedure rotate_x(t : real; var m : matrix_4x4);
  51. begin
  52.      m[1,1]:=1; m[2,1]:=0; m[3,1]:=0; m[4,1]:=0;
  53.      m[1,2]:=0; m[2,2]:=cos(t); m[3,2]:=sin(t); m[4,2]:=0;
  54.      m[1,3]:=0; m[2,3]:=-sin(t); m[3,3]:=cos(t); m[4,3]:=0;
  55.      m[1,4]:=0; m[2,4]:=0; m[3,4]:=0; m[4,4]:=1;
  56. end;
  57.  
  58.  
  59. procedure rotate_y(t : real; var m : matrix_4x4);
  60. begin
  61.      m[1,1]:=cos(t); m[2,1]:=0; m[3,1]:=-sin(t); m[4,1]:=0;
  62.      m[1,2]:=0; m[2,2]:=1; m[3,2]:=0; m[4,2]:=0;
  63.      m[1,3]:=sin(t); m[2,3]:=0; m[3,3]:=cos(t); m[4,3]:=0;
  64.      m[1,4]:=0; m[2,4]:=0; m[3,4]:=0; m[4,4]:=1;
  65. end;
  66.  
  67. procedure rotate_z(t : real; var m : matrix_4x4);
  68. begin
  69.      m[1,1]:=cos(t); m[2,1]:=sin(t); m[3,1]:=0; m[4,1]:=0;
  70.      m[1,2]:=-sin(t); m[2,2]:=cos(t); m[3,2]:=0; m[4,2]:=0;
  71.      m[1,3]:=0; m[2,3]:=0; m[3,3]:=1; m[4,3]:=0;
  72.      m[1,4]:=0; m[2,4]:=0; m[3,4]:=0; m[4,4]:=1;
  73. end;
  74.  
  75. procedure mult_4x4(a,b : matrix_4x4; var m : matrix_4x4);
  76. var c : integer;
  77. begin
  78.       for c:=1 to 4 do
  79.           m[c,1]:=a[1,1]*b[c,1]+a[2,1]*b[c,2]+a[3,1]*b[c,3]+a[4,1]*b[c,4];
  80.       for c:=1 to 4 do
  81.           m[c,2]:=a[1,2]*b[c,1]+a[2,2]*b[c,2]+a[3,2]*b[c,3]+a[4,2]*b[c,4];
  82.       for c:=1 to 4 do
  83.           m[c,3]:=a[1,3]*b[c,1]+a[2,3]*b[c,2]+a[3,3]*b[c,3]+a[4,3]*b[c,4];
  84.       for c:=1 to 4 do
  85.           m[c,4]:=a[1,4]*b[c,1]+a[2,4]*b[c,2]+a[3,4]*b[c,3]+a[4,4]*b[c,4];
  86. end;
  87.  
  88. procedure draw_face(face: integer);
  89. var x1,y1,z1,x2,y2,z2, xlast, ylast, zlast : integer;
  90.     xa,xb,ya,yb : real;
  91.     count, c : integer;
  92.     zn : real;
  93. begin
  94.      count:=0;
  95.      {Check for back face}
  96.      xa:=vertex[faces[face,3]].xs-vertex[faces[face,2]].xs;
  97.      ya:=vertex[faces[face,3]].ys-vertex[faces[face,2]].ys;
  98.      xb:=vertex[faces[face,3]].xs-vertex[faces[face,4]].xs;
  99.      yb:=vertex[faces[face,3]].ys-vertex[faces[face,4]].ys;
  100.      zn:=xa*yb-ya*xb;
  101.      if zn<=0 then exit;
  102.  
  103.      {Copy vertices to polygon and clip}
  104.      for c:=3 to 6 do
  105.      begin
  106.           if faces[face,c]<>0 then
  107.           begin
  108.                x1:=vertex[faces[face,c-1]].xs;
  109.                y1:=vertex[faces[face,c-1]].ys;
  110.                z1:=vertex[faces[face,c-1]].zs;
  111.                x2:=vertex[faces[face,c]].xs;
  112.                y2:=vertex[faces[face,c]].ys;
  113.                z2:=vertex[faces[face,c]].zs;
  114.                xlast:=x2; ylast:=y2; zlast:=z2;
  115.                if ((z2>hither)or(z1>hither)) then
  116.                begin
  117.                     if (z1<hither) then
  118.                     begin
  119.                          x1:=x1+round((x2-x1)*(hither-z1)/(z2-z1));
  120.                          y1:=y1+round((y2-y1)*(hither-z1)/(z2-z1));
  121.                          z1:=hither;
  122.                     end;
  123.                     if (z2<hither) then
  124.                     begin
  125.                          x2:=x2+round((x1-x2)*(hither-z2)/(z1-z2));
  126.                          y2:=y2+round((y1-y2)*(hither-z2)/(z1-z2));
  127.                          z2:=hither;
  128.                     end;
  129.                     if (count=0) then
  130.                     begin
  131.                          polygon[count+1].x:=x1;
  132.                          polygon[count+1].y:=y1;
  133.                          inc(count);
  134.                     end
  135.                     else if ((polygon[count].x<>x1) and (polygon[count].y<>y1)) then
  136.                     begin
  137.                          polygon[count+1].x:=x1;
  138.                          polygon[count+1].y:=y1;
  139.                          inc(count);
  140.                     end;
  141.                     polygon[count+1].x:=x2;
  142.                     polygon[count+1].y:=y2;
  143.                     inc(count);
  144.                end;
  145.           end;
  146.      end;
  147.  
  148.      x1:=xlast;
  149.      y1:=ylast;
  150.      z1:=zlast;
  151.      x2:=vertex[faces[face,2]].xs;
  152.      y2:=vertex[faces[face,2]].ys;
  153.      z2:=vertex[faces[face,2]].zs;
  154.      if ((z2>hither)or(z1>hither)) then
  155.      begin
  156.           if (z1<hither) then
  157.           begin
  158.                x1:=x1+round((x2-x1)*(hither-z1)/(z2-z1));
  159.                y1:=y1+round((y2-y1)*(hither-z1)/(z2-z1));
  160.                z1:=hither;
  161.           end;
  162.           if (z2<hither) then
  163.           begin
  164.                x2:=x2+round((x1-x2)*(hither-z2)/(z1-z2));
  165.                y2:=y2+round((y1-y2)*(hither-z2)/(z1-z2));
  166.                z2:=hither;
  167.           end;
  168.           if (count=0) then
  169.           begin
  170.                polygon[count+1].x:=x1;
  171.                polygon[count+1].y:=y1;
  172.                inc(count);
  173.           end
  174.           else if ((polygon[count].x<>x1) and (polygon[count].y<>y1)) then
  175.           begin
  176.                polygon[count+1].x:=x1;
  177.                polygon[count+1].y:=y1;
  178.                inc(count);
  179.           end;
  180.           polygon[count+1].x:=x2;
  181.           polygon[count+1].y:=y2;
  182.           inc(count);
  183.      end;
  184.  
  185.      {Draw the polygon}
  186.      SetFillStyle(1,(faces[face,1]));
  187.      if count>0 then FillPoly(count,polygon);
  188. end;
  189.  
  190.  
  191. procedure draw_picture;
  192. var c, c2, max_z : integer;
  193.     any_swapped : boolean;
  194. begin
  195.      {Put faces into a list and find each's furthest distance}
  196.      for c:=1 to 13 do
  197.      begin
  198.           face_list[c,1]:=c;
  199.           max_z:=-9999;
  200.           for c2:=2 to 6 do
  201.           begin
  202.                if faces[c,c2]<>0 then
  203.                if vertex[faces[c,c2]].zs>max_z then max_z:=vertex[faces[c,c2]].zs;
  204.           end;
  205.           face_list[c,2]:=max_z;
  206.      end;
  207.  
  208.      {Bubble sort into decreasing depth order}
  209.      repeat
  210.            any_swapped:=false;
  211.            for c:=1 to 12 do
  212.            begin
  213.                 if face_list[c+1,2]>face_list[c,2] then
  214.                 begin
  215.                      c2:=face_list[c+1,2];
  216.                      face_list[c+1,2]:=face_list[c,2];
  217.                      face_list[c,2]:=c2;
  218.                      c2:=face_list[c+1,1];
  219.                      face_list[c+1,1]:=face_list[c,1];
  220.                      face_list[c,1]:=c2;
  221.                      any_swapped:=true;
  222.                 end;
  223.            end;
  224.      until any_swapped=false;
  225.  
  226.      ClearDevice;
  227.      for c:=1 to 13 do
  228.          draw_face(face_list[c,1]);
  229. end;
  230.  
  231. procedure transform(m : matrix_4x4);
  232. var c : integer;
  233. begin
  234.      for c:=1 to 18 do
  235.      begin
  236.          vertex[c].zs:=round(vertex[c].xw*m[3,1]+vertex[c].yw*m[3,2]+vertex[c].zw*m[3,3]+m[3,4]);
  237.          vertex[c].xs:=round(((vertex[c].xw*m[1,1]+vertex[c].yw*m[1,2]+vertex[c].zw*m[1,3]+m[1,4])
  238.                        *(persp/vertex[c].zs)*xscale)+xoffset);
  239.          vertex[c].ys:=round(((vertex[c].xw*m[2,1]+vertex[c].yw*m[2,2]+vertex[c].zw*m[2,3]+m[2,4])
  240.                        *(persp/vertex[c].zs)*yscale)+yoffset);
  241.      end;
  242. end;
  243.  
  244.  
  245. begin
  246.      clrscr;
  247.      writeln; writeln; writeln;
  248.      writeln('This is from Chapter 2 Step 12 of the Virtual Reality Homebrewer''s Handbook');
  249.      writeln('and shows how to move around a virtual shape drawn with depth sorted, ');
  250.      writeln('flat shaded faces, clipped to the hither plane, with back faces removed.');
  251.      writeln;
  252.      writeln('To show the effect of clipping, the hither plane is almost at the object.');
  253.      writeln('Move it back if you just want to move around - or the object will disappear!');
  254.      writeln;
  255.      writeln;
  256.      writeln('Controls:       8/2  - move forwards/back');
  257.      writeln('                4/6  - move left/back');
  258.      writeln('                7/1  - move up/down');
  259.      writeln('                o/l  - pitch up/down');
  260.      writeln('                </>  - yaw left/right');
  261.      writeln('                n/m  - roll left/right');
  262.      writeln('                =/-  - move hither plane forwards/back');
  263.      writeln;
  264.      writeln('                q    - quit');
  265.      writeln;
  266.      writeln('                Press any key to continue');
  267.      ch:=ReadKey;
  268.  
  269.  
  270.      {Read in vertices}
  271.      assign(f,'points.dat');
  272.      reset(f);
  273.      for c:=1 to 18 do
  274.      begin
  275.           readln(f,vertex[c].xw,vertex[c].yw,vertex[c].zw);
  276.      end;
  277.      close(f);
  278.  
  279.      {Read in faces}
  280.      assign(f,'faces.dat');
  281.      reset(f);
  282.      for c:=1 to 13 do
  283.          for c2:=1 to 6 do
  284.              read(f,faces[c,c2]);
  285.      close(f);
  286.  
  287.      {Move to z=500}
  288.      for c:=1 to 18 do
  289.      begin
  290.           vertex[c].zw:=vertex[c].zw+500;
  291.      end;
  292.  
  293.      hither:=600;
  294.      Initialise_Graphics;
  295.  
  296.      translate(-500,-400,0,w2v);
  297.      Rotate_Y(pi/5,temp);
  298.      mult_4x4(w2v,temp,w2v);
  299.      Rotate_X(-pi/6,temp);
  300.      mult_4x4(w2v,temp,w2v);
  301.  
  302.      transform(w2v);
  303.      draw_picture;
  304.  
  305.      repeat
  306.            ch:=Readkey;
  307.            case ch of
  308.                 '8': begin
  309.                        translate(0,0,-10,temp);
  310.                        mult_4x4(w2v,temp,temp2);
  311.                        w2v:=temp2;
  312.                      end;
  313.                 '2': begin
  314.                        translate(0,0,10,temp);
  315.                        mult_4x4(w2v,temp,temp2);
  316.                        w2v:=temp2;
  317.                      end;
  318.                 '4': begin
  319.                        translate(10,0,0,temp);
  320.                        mult_4x4(w2v,temp,temp2);
  321.                        w2v:=temp2;
  322.                      end;
  323.                 '6': begin
  324.                        translate(-10,0,0,temp);
  325.                        mult_4x4(w2v,temp,temp2);
  326.                        w2v:=temp2;
  327.                      end;
  328.                 '1': begin
  329.                        translate(0,10,0,temp);
  330.                        mult_4x4(w2v,temp,temp2);
  331.                        w2v:=temp2;
  332.                      end;
  333.                 '7': begin
  334.                        translate(0,-10,0,temp);
  335.                        mult_4x4(w2v,temp,temp2);
  336.                        w2v:=temp2;
  337.                      end;
  338.                 ',': begin
  339.                        rotate_y(PI/180,temp);
  340.                        mult_4x4(w2v,temp,temp2);
  341.                        w2v:=temp2;
  342.                      end;
  343.                 '.': begin
  344.                        rotate_y(-PI/180,temp);
  345.                        mult_4x4(w2v,temp,temp2);
  346.                        w2v:=temp2;
  347.                      end;
  348.                 'm': begin
  349.                        rotate_z(PI/180,temp);
  350.                        mult_4x4(w2v,temp,temp2);
  351.                        w2v:=temp2;
  352.                      end;
  353.                 'n': begin
  354.                        rotate_z(-PI/180,temp);
  355.                        mult_4x4(w2v,temp,temp2);
  356.                        w2v:=temp2;
  357.                      end;
  358.                 'o': begin
  359.                        rotate_x(PI/180,temp);
  360.                        mult_4x4(w2v,temp,temp2);
  361.                        w2v:=temp2;
  362.                      end;
  363.                 'l': begin
  364.                        rotate_x(-PI/180,temp);
  365.                        mult_4x4(w2v,temp,temp2);
  366.                        w2v:=temp2;
  367.                      end;
  368.                 '=': Hither:=hither+10;
  369.                 '-': Hither:=hither-10;
  370.            end;
  371.            transform(w2v);
  372.            draw_picture;
  373.      until ch='q';
  374.      CloseGraph;
  375. end.