home *** CD-ROM | disk | FTP | other *** search
/ Virtual Reality Homebrewer's Handbook / vr.iso / 3dgraph / pascal / chap2_10.pas < prev    next >
Pascal/Delphi Source File  |  1996-03-19  |  8KB  |  260 lines
  1. program chap2_10;
  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.     edges : array[1..27,1..27] of integer;
  20.     f : text;
  21.     c, hither : integer;
  22.     ch : char;
  23.     w2v, temp, temp2 : matrix_4x4;
  24.  
  25. procedure Initialise_Graphics;
  26. var Graphdriver, Graphmode, Errorcode : integer;
  27. begin
  28.      Graphdriver:=Detect;
  29.      InitGraph(Graphdriver, Graphmode,'');
  30.      Errorcode:=graphresult;
  31.      if Errorcode<>grOk then
  32.      begin
  33.           writeln('Graphics Error: ',GraphErrorMsg(ErrorCode));
  34.           writeln('Program Aborted');
  35.           Halt(1);
  36.      end;
  37.      SetLineStyle(0,0,3);
  38. end;
  39.  
  40. procedure translate(x,y,z : real; var m : matrix_4x4);
  41. begin
  42.      m[1,1]:=1; m[2,1]:=0; m[3,1]:=0; m[4,1]:=0;
  43.      m[1,2]:=0; m[2,2]:=1; m[3,2]:=0; m[4,2]:=0;
  44.      m[1,3]:=0; m[2,3]:=0; m[3,3]:=1; m[4,3]:=0;
  45.      m[1,4]:=x; m[2,4]:=y; m[3,4]:=z; m[4,4]:=1;
  46. end;
  47.  
  48. procedure rotate_x(t : real; var m : matrix_4x4);
  49. begin
  50.      m[1,1]:=1; m[2,1]:=0; m[3,1]:=0; m[4,1]:=0;
  51.      m[1,2]:=0; m[2,2]:=cos(t); m[3,2]:=sin(t); m[4,2]:=0;
  52.      m[1,3]:=0; m[2,3]:=-sin(t); m[3,3]:=cos(t); m[4,3]:=0;
  53.      m[1,4]:=0; m[2,4]:=0; m[3,4]:=0; m[4,4]:=1;
  54. end;
  55.  
  56.  
  57. procedure rotate_y(t : real; var m : matrix_4x4);
  58. begin
  59.      m[1,1]:=cos(t); m[2,1]:=0; m[3,1]:=-sin(t); m[4,1]:=0;
  60.      m[1,2]:=0; m[2,2]:=1; m[3,2]:=0; m[4,2]:=0;
  61.      m[1,3]:=sin(t); m[2,3]:=0; m[3,3]:=cos(t); m[4,3]:=0;
  62.      m[1,4]:=0; m[2,4]:=0; m[3,4]:=0; m[4,4]:=1;
  63. end;
  64.  
  65. procedure rotate_z(t : real; var m : matrix_4x4);
  66. begin
  67.      m[1,1]:=cos(t); m[2,1]:=sin(t); m[3,1]:=0; m[4,1]:=0;
  68.      m[1,2]:=-sin(t); m[2,2]:=cos(t); m[3,2]:=0; m[4,2]:=0;
  69.      m[1,3]:=0; m[2,3]:=0; m[3,3]:=1; m[4,3]:=0;
  70.      m[1,4]:=0; m[2,4]:=0; m[3,4]:=0; m[4,4]:=1;
  71. end;
  72.  
  73. procedure mult_4x4(a,b : matrix_4x4; var m : matrix_4x4);
  74. var c : integer;
  75. begin
  76.       for c:=1 to 4 do
  77.           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];
  78.       for c:=1 to 4 do
  79.           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];
  80.       for c:=1 to 4 do
  81.           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];
  82.       for c:=1 to 4 do
  83.           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];
  84. end;
  85.  
  86. procedure draw_picture;
  87. var x1,y1,z1,x2,y2,z2,c : integer;
  88. begin
  89.      ClearDevice;
  90.      for c:=1 to 27 do
  91.      begin
  92.           x1:=vertex[edges[c,1]].xs;
  93.           y1:=vertex[edges[c,1]].ys;
  94.           z1:=vertex[edges[c,1]].zs;
  95.           x2:=vertex[edges[c,2]].xs;
  96.           y2:=vertex[edges[c,2]].ys;
  97.           z2:=vertex[edges[c,2]].zs;
  98.           if ((z2>hither)or(z1>hither)) then
  99.           begin
  100.                if (z1<hither) then
  101.                begin
  102.                     x1:=x1+round((x2-x1)*(hither-z1)/(z2-z1));
  103.                     y1:=y1+round((y2-y1)*(hither-z1)/(z2-z1));
  104.                     z1:=hither;
  105.                end;
  106.                if (z2<hither) then
  107.                begin
  108.                     x2:=x2+round((x1-x2)*(hither-z2)/(z1-z2));
  109.                     y2:=y2+round((y1-y2)*(hither-z2)/(z1-z2));
  110.                     z2:=hither;
  111.                end;
  112.                line(x1,y1,x2,y2);
  113.                setcolor(white);
  114.           end;
  115.      end;
  116. end;
  117.  
  118. procedure transform(m : matrix_4x4);
  119. var c : integer;
  120. begin
  121.      for c:=1 to 18 do
  122.      begin
  123.          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]);
  124.          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])
  125.                        *(persp/vertex[c].zs)*xscale)+xoffset);
  126.          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])
  127.                        *(persp/vertex[c].zs)*yscale)+yoffset);
  128.      end;
  129. end;
  130.  
  131.  
  132. begin
  133.      clrscr;
  134.      writeln; writeln; writeln;
  135.      writeln('This is from Chapter 2 Step 10 of the Virtual Reality Homebrewer''s Handbook');
  136.      writeln('and shows how to move around a virtual shape drawn in wireframe, clipped to');
  137.      writeln('the hither plane.');
  138.      writeln;
  139.      writeln('To show the effect of clipping, the hither plane is almost at the object.');
  140.      writeln('Move it back if you just want to move around - or the object will disappear!');
  141.      writeln;
  142.      writeln;
  143.      writeln('Controls:       8/2  - move forwards/back');
  144.      writeln('                4/6  - move left/back');
  145.      writeln('                7/1  - move up/down');
  146.      writeln('                o/l  - pitch up/down');
  147.      writeln('                </>  - yaw left/right');
  148.      writeln('                n/m  - roll left/right');
  149.      writeln('                =/-  - move hither plane forwards/back');
  150.      writeln;
  151.      writeln('                q    - quit');
  152.      writeln;
  153.      writeln('                Press any key to continue');
  154.      ch:=ReadKey;
  155.  
  156.      {Read in vertices}
  157.      assign(f,'points.dat');
  158.      reset(f);
  159.      for c:=1 to 18 do
  160.      begin
  161.           readln(f,vertex[c].xw,vertex[c].yw,vertex[c].zw);
  162.      end;
  163.      close(f);
  164.  
  165.      {Move to z=500}
  166.      for c:=1 to 18 do
  167.      begin
  168.           vertex[c].zw:=vertex[c].zw+500;
  169.      end;
  170.  
  171.      {Read in edges}
  172.      assign(f,'edges.dat');
  173.      reset(f);
  174.      for c:=1 to 27 do
  175.          readln(f,edges[c,1], edges[c,2]);
  176.      close(f);
  177.  
  178.      hither:=600;
  179.      Initialise_Graphics;
  180.  
  181.      translate(-500,-400,0,w2v);
  182.      Rotate_Y(pi/5,temp);
  183.      mult_4x4(w2v,temp,w2v);
  184.      Rotate_X(-pi/6,temp);
  185.      mult_4x4(w2v,temp,w2v);
  186.  
  187.      transform(w2v);
  188.      draw_picture;
  189.  
  190.      repeat
  191.            ch:=Readkey;
  192.            case ch of
  193.                 '8': begin
  194.                        translate(0,0,-10,temp);
  195.                        mult_4x4(w2v,temp,temp2);
  196.                        w2v:=temp2;
  197.                      end;
  198.                 '2': begin
  199.                        translate(0,0,10,temp);
  200.                        mult_4x4(w2v,temp,temp2);
  201.                        w2v:=temp2;
  202.                      end;
  203.                 '4': begin
  204.                        translate(10,0,0,temp);
  205.                        mult_4x4(w2v,temp,temp2);
  206.                        w2v:=temp2;
  207.                      end;
  208.                 '6': begin
  209.                        translate(-10,0,0,temp);
  210.                        mult_4x4(w2v,temp,temp2);
  211.                        w2v:=temp2;
  212.                      end;
  213.                 '1': begin
  214.                        translate(0,10,0,temp);
  215.                        mult_4x4(w2v,temp,temp2);
  216.                        w2v:=temp2;
  217.                      end;
  218.                 '7': begin
  219.                        translate(0,-10,0,temp);
  220.                        mult_4x4(w2v,temp,temp2);
  221.                        w2v:=temp2;
  222.                      end;
  223.                 ',': begin
  224.                        rotate_y(PI/180,temp);
  225.                        mult_4x4(w2v,temp,temp2);
  226.                        w2v:=temp2;
  227.                      end;
  228.                 '.': begin
  229.                        rotate_y(-PI/180,temp);
  230.                        mult_4x4(w2v,temp,temp2);
  231.                        w2v:=temp2;
  232.                      end;
  233.                 'm': begin
  234.                        rotate_z(PI/180,temp);
  235.                        mult_4x4(w2v,temp,temp2);
  236.                        w2v:=temp2;
  237.                      end;
  238.                 'n': begin
  239.                        rotate_z(-PI/180,temp);
  240.                        mult_4x4(w2v,temp,temp2);
  241.                        w2v:=temp2;
  242.                      end;
  243.                 'o': begin
  244.                        rotate_x(PI/180,temp);
  245.                        mult_4x4(w2v,temp,temp2);
  246.                        w2v:=temp2;
  247.                      end;
  248.                 'l': begin
  249.                        rotate_x(-PI/180,temp);
  250.                        mult_4x4(w2v,temp,temp2);
  251.                        w2v:=temp2;
  252.                      end;
  253.                 '=': Hither:=hither+10;
  254.                 '-': Hither:=hither-10;
  255.            end;
  256.            transform(w2v);
  257.            draw_picture;
  258.      until ch='q';
  259.      CloseGraph;
  260. end.