home *** CD-ROM | disk | FTP | other *** search
/ Virtual Reality Homebrewer's Handbook / vr.iso / 3dgraph / pascal / chap2_8.pas < prev    next >
Pascal/Delphi Source File  |  1996-03-19  |  7KB  |  222 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 : 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. begin
  108.      clrscr;
  109.      writeln; writeln; writeln; writeln; writeln;
  110.      writeln('This is from Chapter 2 Step 8 of the Virtual Reality Homebrewer''s Handbook');
  111.      writeln('and shows how to move around a virtual shape drawn in wireframe.');
  112.      writeln;
  113.      writeln;
  114.      writeln('Controls:       8/2  - move forwards/back');
  115.      writeln('                4/6  - move left/back');
  116.      writeln('                7/1  - move up/down');
  117.      writeln('                o/l  - pitch up/down');
  118.      writeln('                </>  - yaw left/right');
  119.      writeln('                n/m  - roll left/right');
  120.      writeln;
  121.      writeln('                q    - quit');
  122.      writeln;
  123.      writeln('                Press any key to continue');
  124.      ch:=ReadKey;
  125.  
  126.      {Read in vertices}
  127.      assign(f,'points.dat');
  128.      reset(f);
  129.      for c:=1 to 18 do
  130.      begin
  131.           readln(f,vertex[c].xw,vertex[c].yw,vertex[c].zw);
  132.      end;
  133.      close(f);
  134.  
  135.      {Move to z=500}
  136.      for c:=1 to 18 do
  137.      begin
  138.           vertex[c].zw:=vertex[c].zw+500;
  139.      end;
  140.  
  141.      {Read in edges}
  142.      assign(f,'edges.dat');
  143.      reset(f);
  144.      for c:=1 to 27 do
  145.          readln(f,edges[c,1], edges[c,2]);
  146.      close(f);
  147.  
  148.      Initialise_Graphics;
  149.  
  150.      translate(0,0,0,w2v);
  151.      transform(w2v);
  152.      draw_picture;
  153.  
  154.      repeat
  155.            ch:=Readkey;
  156.            case ch of
  157.                 '8': begin
  158.                        translate(0,0,-10,temp);
  159.                        mult_4x4(w2v,temp,temp2);
  160.                        w2v:=temp2;
  161.                      end;
  162.                 '2': begin
  163.                        translate(0,0,10,temp);
  164.                        mult_4x4(w2v,temp,temp2);
  165.                        w2v:=temp2;
  166.                      end;
  167.                 '4': begin
  168.                        translate(10,0,0,temp);
  169.                        mult_4x4(w2v,temp,temp2);
  170.                        w2v:=temp2;
  171.                      end;
  172.                 '6': begin
  173.                        translate(-10,0,0,temp);
  174.                        mult_4x4(w2v,temp,temp2);
  175.                        w2v:=temp2;
  176.                      end;
  177.                 '1': begin
  178.                        translate(0,10,0,temp);
  179.                        mult_4x4(w2v,temp,temp2);
  180.                        w2v:=temp2;
  181.                      end;
  182.                 '7': begin
  183.                        translate(0,-10,0,temp);
  184.                        mult_4x4(w2v,temp,temp2);
  185.                        w2v:=temp2;
  186.                      end;
  187.                 ',': begin
  188.                        rotate_y(PI/180,temp);
  189.                        mult_4x4(w2v,temp,temp2);
  190.                        w2v:=temp2;
  191.                      end;
  192.                 '.': begin
  193.                        rotate_y(-PI/180,temp);
  194.                        mult_4x4(w2v,temp,temp2);
  195.                        w2v:=temp2;
  196.                      end;
  197.                 'm': begin
  198.                        rotate_z(PI/180,temp);
  199.                        mult_4x4(w2v,temp,temp2);
  200.                        w2v:=temp2;
  201.                      end;
  202.                 'n': begin
  203.                        rotate_z(-PI/180,temp);
  204.                        mult_4x4(w2v,temp,temp2);
  205.                        w2v:=temp2;
  206.                      end;
  207.                 'o': begin
  208.                        rotate_x(PI/180,temp);
  209.                        mult_4x4(w2v,temp,temp2);
  210.                        w2v:=temp2;
  211.                      end;
  212.                 'l': begin
  213.                        rotate_x(-PI/180,temp);
  214.                        mult_4x4(w2v,temp,temp2);
  215.                        w2v:=temp2;
  216.                      end;
  217.            end;
  218.            transform(w2v);
  219.            draw_picture;
  220.      until ch='q';
  221.      CloseGraph;
  222. end.