home *** CD-ROM | disk | FTP | other *** search
/ Virtual Reality Homebrewer's Handbook / vr.iso / 3dgraph / pascal / chap2_9.bak < prev    next >
Text File  |  1996-03-19  |  8KB  |  246 lines
  1. program chap2_8;
  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 : integer;
  22.     ch : char;
  23.     w2v, temp, temp2, temp3 : 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 c : integer;
  88. begin
  89.      ClearDevice;
  90.      for c:=1 to 27 do
  91.           line(vertex[edges[c,1]].xs,vertex[edges[c,1]].ys,vertex[edges[c,2]].xs,vertex[edges[c,2]].ys);
  92. end;
  93.  
  94. procedure transform(m : matrix_4x4);
  95. var c : integer;
  96. begin
  97.      for c:=1 to 18 do
  98.      begin
  99.          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]);
  100.          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])
  101.                        *(persp/vertex[c].zs)*xscale)+xoffset);
  102.          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])
  103.                        *(persp/vertex[c].zs)*yscale)+yoffset);
  104.      end;
  105. end;
  106.  
  107. procedure transform_object(m : matrix_4x4);
  108. var c : integer;
  109.     xt, yt, zt : real;
  110. begin
  111.      for c:=1 to 18 do
  112.      begin
  113.          zt:=(vertex[c].xw*m[3,1]+vertex[c].yw*m[3,2]+vertex[c].zw*m[3,3]+m[3,4]);
  114.          xt:=(vertex[c].xw*m[1,1]+vertex[c].yw*m[1,2]+vertex[c].zw*m[1,3]+m[1,4]);
  115.          yt:=(vertex[c].xw*m[2,1]+vertex[c].yw*m[2,2]+vertex[c].zw*m[2,3]+m[2,4]);
  116.          vertex[c].zw:=zt;
  117.          vertex[c].xw:=xt;
  118.          vertex[c].yw:=yt;
  119.      end;
  120. end;
  121.  
  122. begin
  123.      clrscr;
  124.      writeln; writeln; writeln; writeln; writeln;
  125.      writeln('This is from Chapter 2 Step 9 of the Virtual Reality Homebrewer''s Handbook');
  126.      writeln('and shows how to move around a rotating virtual shape drawn in wireframe.');
  127.      writeln;
  128.      writeln;
  129.      writeln('Controls:       8/2  - move forwards/back');
  130.      writeln('                4/6  - move left/back');
  131.      writeln('                7/1  - move up/down');
  132.      writeln('                o/l  - pitch up/down');
  133.      writeln('                </>  - yaw left/right');
  134.      writeln('                n/m  - roll left/right');
  135.      writeln;
  136.      writeln('                q    - quit');
  137.      writeln;
  138.      writeln('                Press any key to continue');
  139.      ch:=ReadKey;
  140.  
  141.      {Read in vertices}
  142.      assign(f,'points.dat');
  143.      reset(f);
  144.      for c:=1 to 18 do
  145.      begin
  146.           readln(f,vertex[c].xw,vertex[c].yw,vertex[c].zw);
  147.      end;
  148.      close(f);
  149.  
  150.      {Move to z=500}
  151.      for c:=1 to 18 do
  152.      begin
  153.           vertex[c].zw:=vertex[c].zw+500;
  154.      end;
  155.  
  156.      {Read in edges}
  157.      assign(f,'edges.dat');
  158.      reset(f);
  159.      for c:=1 to 27 do
  160.          readln(f,edges[c,1], edges[c,2]);
  161.      close(f);
  162.  
  163.      Initialise_Graphics;
  164.  
  165.      translate(0,0,0,w2v);
  166.      transform(w2v);
  167.      draw_picture;
  168.  
  169.      translate(-100,-100,-650,temp);
  170.      rotate_y(0.087266,temp3);
  171.      mult_4x4(temp,temp3,temp2);
  172.      translate(100,100,650,temp);
  173.      mult_4x4(temp2,temp,temp3);
  174.  
  175.      repeat
  176.            if KeyPressed then ch:=Readkey;
  177.            case ch of
  178.                 '8': begin
  179.                        translate(0,0,-10,temp);
  180.                        mult_4x4(w2v,temp,temp2);
  181.                        w2v:=temp2;
  182.                      end;
  183.                 '2': begin
  184.                        translate(0,0,10,temp);
  185.                        mult_4x4(w2v,temp,temp2);
  186.                        w2v:=temp2;
  187.                      end;
  188.                 '4': begin
  189.                        translate(10,0,0,temp);
  190.                        mult_4x4(w2v,temp,temp2);
  191.                        w2v:=temp2;
  192.                      end;
  193.                 '6': begin
  194.                        translate(-10,0,0,temp);
  195.                        mult_4x4(w2v,temp,temp2);
  196.                        w2v:=temp2;
  197.                      end;
  198.                 '1': begin
  199.                        translate(0,10,0,temp);
  200.                        mult_4x4(w2v,temp,temp2);
  201.                        w2v:=temp2;
  202.                      end;
  203.                 '7': begin
  204.                        translate(0,-10,0,temp);
  205.                        mult_4x4(w2v,temp,temp2);
  206.                        w2v:=temp2;
  207.                      end;
  208.                 ',': begin
  209.                        rotate_y(PI/180,temp);
  210.                        mult_4x4(w2v,temp,temp2);
  211.                        w2v:=temp2;
  212.                      end;
  213.                 '.': begin
  214.                        rotate_y(-PI/180,temp);
  215.                        mult_4x4(w2v,temp,temp2);
  216.                        w2v:=temp2;
  217.                      end;
  218.                 'm': begin
  219.                        rotate_z(PI/180,temp);
  220.                        mult_4x4(w2v,temp,temp2);
  221.                        w2v:=temp2;
  222.                      end;
  223.                 'n': begin
  224.                        rotate_z(-PI/180,temp);
  225.                        mult_4x4(w2v,temp,temp2);
  226.                        w2v:=temp2;
  227.                      end;
  228.                 'o': begin
  229.                        rotate_x(PI/180,temp);
  230.                        mult_4x4(w2v,temp,temp2);
  231.                        w2v:=temp2;
  232.                      end;
  233.                 'l': begin
  234.                        rotate_x(-PI/180,temp);
  235.                        mult_4x4(w2v,temp,temp2);
  236.                        w2v:=temp2;
  237.                      end;
  238.            end;
  239.            if ch<>'q' then ch:=' ';
  240.            transform_object(temp3);
  241.            transform(w2v);
  242.            draw_picture;
  243.            delay(100);
  244.      until ch='q';
  245.      CloseGraph;
  246. end.