home *** CD-ROM | disk | FTP | other *** search
/ Virtual Reality Homebrewer's Handbook / vr.iso / 3dgraph / pascal / chap2_11.pas < prev    next >
Pascal/Delphi Source File  |  1996-03-19  |  9KB  |  285 lines
  1. program chap2_11;
  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 : 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 : integer;
  90.     count, c : integer;
  91. begin
  92.      count:=0;
  93.      {Copy vertices to polygon}
  94.      for c:=2 to 6 do
  95.      begin
  96.           if faces[face,c]<>0 then
  97.           begin
  98.                polygon[c-1].x:=vertex[faces[face,c]].xs;
  99.                polygon[c-1].y:=vertex[faces[face,c]].ys;
  100.                inc(count);
  101.           end;
  102.      end;
  103.  
  104.      {Draw polygon}
  105.      SetFillStyle(1,(faces[face,1]));
  106.      FillPoly(count,polygon);
  107. end;
  108.  
  109. procedure draw_picture;
  110. var c, c2, max_z : integer;
  111.     any_swapped : boolean;
  112. begin
  113.      {Put faces into a list and find each's furthest distance}
  114.      for c:=1 to 13 do
  115.      begin
  116.           face_list[c,1]:=c;
  117.           max_z:=-9999;
  118.           for c2:=2 to 6 do
  119.           begin
  120.                if faces[c,c2]<>0 then
  121.                if vertex[faces[c,c2]].zs>max_z then max_z:=vertex[faces[c,c2]].zs;
  122.           end;
  123.           face_list[c,2]:=max_z;
  124.      end;
  125.  
  126.      {Bubble sort into decreasing depth order}
  127.      repeat
  128.            any_swapped:=false;
  129.            for c:=1 to 12 do
  130.            begin
  131.                 if face_list[c+1,2]>face_list[c,2] then
  132.                 begin
  133.                      c2:=face_list[c+1,2];
  134.                      face_list[c+1,2]:=face_list[c,2];
  135.                      face_list[c,2]:=c2;
  136.                      c2:=face_list[c+1,1];
  137.                      face_list[c+1,1]:=face_list[c,1];
  138.                      face_list[c,1]:=c2;
  139.                      any_swapped:=true;
  140.                 end;
  141.            end;
  142.      until any_swapped=false;
  143.  
  144.      ClearDevice;
  145.      for c:=1 to 13 do
  146.          draw_face(face_list[c,1]);
  147. end;
  148.  
  149. procedure transform(m : matrix_4x4);
  150. var c : integer;
  151. begin
  152.      for c:=1 to 18 do
  153.      begin
  154.          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]);
  155.          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])
  156.                        *(persp/vertex[c].zs)*xscale)+xoffset);
  157.          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])
  158.                        *(persp/vertex[c].zs)*yscale)+yoffset);
  159.      end;
  160. end;
  161.  
  162.  
  163. begin
  164.      clrscr;
  165.      writeln; writeln; writeln; writeln;
  166.      writeln('This is from Chapter 2 Step 11 of the Virtual Reality Homebrewer''s Handbook');
  167.      writeln('and shows how to move around a virtual shape drawn with depth sorted, ');
  168.      writeln('flat shaded faces.');
  169.      writeln;
  170.      writeln;
  171.      writeln('Controls:       8/2  - move forwards/back');
  172.      writeln('                4/6  - move left/back');
  173.      writeln('                7/1  - move up/down');
  174.      writeln('                o/l  - pitch up/down');
  175.      writeln('                </>  - yaw left/right');
  176.      writeln('                n/m  - roll left/right');
  177.      writeln;
  178.      writeln('                q    - quit');
  179.      writeln;
  180.      writeln('                Press any key to continue');
  181.      ch:=ReadKey;
  182.  
  183.      {Read in vertices}
  184.      assign(f,'points.dat');
  185.      reset(f);
  186.      for c:=1 to 18 do
  187.      begin
  188.           readln(f,vertex[c].xw,vertex[c].yw,vertex[c].zw);
  189.      end;
  190.      close(f);
  191.  
  192.      {Read in faces}
  193.      assign(f,'faces.dat');
  194.      reset(f);
  195.      for c:=1 to 13 do
  196.          for c2:=1 to 6 do
  197.              read(f,faces[c,c2]);
  198.      close(f);
  199.  
  200.      {Move to z=500}
  201.      for c:=1 to 18 do
  202.      begin
  203.           vertex[c].zw:=vertex[c].zw+500;
  204.      end;
  205.  
  206.      Initialise_Graphics;
  207.  
  208.      translate(-500,-400,0,w2v);
  209.      Rotate_Y(pi/5,temp);
  210.      mult_4x4(w2v,temp,w2v);
  211.      Rotate_X(-pi/6,temp);
  212.      mult_4x4(w2v,temp,w2v);
  213.  
  214.      transform(w2v);
  215.      draw_picture;
  216.  
  217.      repeat
  218.            ch:=Readkey;
  219.            case ch of
  220.                 '8': begin
  221.                        translate(0,0,-10,temp);
  222.                        mult_4x4(w2v,temp,temp2);
  223.                        w2v:=temp2;
  224.                      end;
  225.                 '2': begin
  226.                        translate(0,0,10,temp);
  227.                        mult_4x4(w2v,temp,temp2);
  228.                        w2v:=temp2;
  229.                      end;
  230.                 '4': begin
  231.                        translate(10,0,0,temp);
  232.                        mult_4x4(w2v,temp,temp2);
  233.                        w2v:=temp2;
  234.                      end;
  235.                 '6': begin
  236.                        translate(-10,0,0,temp);
  237.                        mult_4x4(w2v,temp,temp2);
  238.                        w2v:=temp2;
  239.                      end;
  240.                 '1': begin
  241.                        translate(0,10,0,temp);
  242.                        mult_4x4(w2v,temp,temp2);
  243.                        w2v:=temp2;
  244.                      end;
  245.                 '7': begin
  246.                        translate(0,-10,0,temp);
  247.                        mult_4x4(w2v,temp,temp2);
  248.                        w2v:=temp2;
  249.                      end;
  250.                 ',': begin
  251.                        rotate_y(PI/180,temp);
  252.                        mult_4x4(w2v,temp,temp2);
  253.                        w2v:=temp2;
  254.                      end;
  255.                 '.': begin
  256.                        rotate_y(-PI/180,temp);
  257.                        mult_4x4(w2v,temp,temp2);
  258.                        w2v:=temp2;
  259.                      end;
  260.                 'm': begin
  261.                        rotate_z(PI/180,temp);
  262.                        mult_4x4(w2v,temp,temp2);
  263.                        w2v:=temp2;
  264.                      end;
  265.                 'n': begin
  266.                        rotate_z(-PI/180,temp);
  267.                        mult_4x4(w2v,temp,temp2);
  268.                        w2v:=temp2;
  269.                      end;
  270.                 'o': begin
  271.                        rotate_x(PI/180,temp);
  272.                        mult_4x4(w2v,temp,temp2);
  273.                        w2v:=temp2;
  274.                      end;
  275.                 'l': begin
  276.                        rotate_x(-PI/180,temp);
  277.                        mult_4x4(w2v,temp,temp2);
  278.                        w2v:=temp2;
  279.                      end;
  280.            end;
  281.            transform(w2v);
  282.            draw_picture;
  283.      until ch='q';
  284.      CloseGraph;
  285. end.