home *** CD-ROM | disk | FTP | other *** search
/ Virtual Reality Homebrewer's Handbook / vr.iso / vroom / vroom.pas < prev    next >
Pascal/Delphi Source File  |  1996-03-19  |  34KB  |  1,040 lines
  1. unit vroom;
  2.  
  3. interface
  4.  
  5. uses graph, crt, msmouse, dos, fix_math;
  6.  
  7. {$L 3dfill}
  8. {$L trans}
  9.  
  10. const dl=0; dr=319; dt=0; db=239;
  11.       page0=0; page1=19200;
  12.       infinity=1.7e38;
  13.  
  14. {------------------------------------------------}
  15. { Type declarations                              }
  16. {------------------------------------------------}
  17.  
  18. type
  19.      pcx_header = record
  20.           code, version, mode, bits_p_pixel : byte;
  21.           X1, Y1, X2, Y2, Hres, Vres : word;
  22.           palette : array[1..16,1..3] of byte;
  23.           junk, Nplanes : byte;
  24.           bytes_p_line, palette_type : word;
  25.           padding : array[1..58] of byte;
  26.      end;
  27.  
  28.      clock_ptr=^real;
  29.  
  30.      keyproc=function(key : char) : boolean;
  31.  
  32.      textproc=procedure;
  33.  
  34.      vector3d=record
  35.        x, y, z : longint;
  36.      end;
  37.  
  38.      screen3d=record
  39.        x, y, z : integer;
  40.      end;
  41.  
  42.      vertex_ptr=^vertex;
  43.      vertex=object
  44.         screen : screen3d;
  45.         next : vertex_ptr;
  46.         clip : byte;
  47.         world : vector3d;
  48.         screen_depth : longint;
  49.         procedure data(x1, y1, z1 : real);
  50.      end;
  51.  
  52.      vertex_copy_ptr=^vertex_copy;
  53.      vertex_copy=record
  54.         old_vertex, new_vertex : vertex_ptr;
  55.         next : vertex_copy_ptr;
  56.      end;
  57.  
  58.      face_vertex_ptr=^face_vertex;
  59.      face_vertex=record
  60.         this_vertex : vertex_ptr;
  61.         next : face_vertex_ptr;
  62.      end;
  63.  
  64.      face_ptr=^face;
  65.      fillproc=procedure(this_face : face_ptr);
  66.  
  67.      fixed_matrix_4x4=object
  68.         el : array[1..4,1..4] of longint;
  69.         procedure data(x11, x12, x13, x14,
  70.                        x21, x22, x23, x24,
  71.                        x31, x32, x33, x34,
  72.                        x41, x42, x43, x44 : longint);
  73.      end;
  74.  
  75.      titletype=string;
  76.  
  77.      object3d_ptr=^object3d;
  78.      selectproc=procedure(thisobject : object3d_ptr);
  79.  
  80.      child_object3d_ptr=^child_object3d;
  81.      child_object3d=record
  82.         this_child : object3d_ptr;
  83.         next : child_object3d_ptr;
  84.      end;
  85.  
  86.      object3d=object
  87.         first_vertex : vertex_ptr;   {!! Must be first - used for self-reference}
  88.         first_face : face_ptr;
  89.         shown, redraw : boolean;
  90.         reference_point, lo, hi : vector3d;
  91.         child : child_object3d_ptr;
  92.         next : object3d_ptr;
  93.         select_procedure : selectproc;
  94.         constructor Init;
  95.         destructor Done;
  96.         function Add_Vertex(x1, y1, z1 : real) : vertex_ptr; virtual;
  97.         procedure Remove_Vertex(this_vertex : vertex_ptr); virtual;
  98.         procedure Build_Normals; virtual;
  99.         procedure Save_to_Disk(filename : string);
  100.         procedure Unit_Normals; virtual;
  101.         procedure Transform_to_Screen; virtual;
  102.         procedure Screen_Position(var x_pos, y_pos, z_pos); virtual;
  103.         procedure Screen_Limits(var xmin, xmax, ymin, ymax : integer); virtual;
  104.         procedure Apply_Transform(M : fixed_matrix_4x4); virtual;
  105.         procedure Apply_XForm(M : fixed_matrix_4x4); virtual;
  106.         procedure Set_Reference_Point(x, y, z : real); virtual;
  107.  
  108.         procedure Translate(X, Y, Z : real); virtual;
  109.         procedure Scale(Sx, Sy, Sz : real); virtual;
  110.         procedure RotateX(theta : real); virtual;
  111.         procedure RotateY(theta : real); virtual;
  112.         procedure RotateZ(theta : real); virtual;
  113.         procedure Scale_About(Sx, Sy, Sz, X, Y, Z : real); virtual;
  114.         procedure RotateX_About(theta, X, Y, Z : real); virtual;
  115.         procedure RotateY_About(theta, X, Y, Z : real); virtual;
  116.         procedure RotateZ_About(theta, X, Y, Z : real); virtual;
  117.         procedure MoveTo(X, Y, Z : real); virtual;
  118.  
  119.         procedure Timed_Translate(X, Y, Z, TStart, Duration : real); virtual;
  120.         procedure Timed_Scale(Sx, Sy, Sz, TStart, Duration : real); virtual;
  121.         procedure Timed_RotateX(theta, TStart, Duration : real); virtual;
  122.         procedure Timed_RotateY(theta, TStart, Duration : real); virtual;
  123.         procedure Timed_RotateZ(theta, TStart, Duration : real); virtual;
  124.         procedure Timed_Scale_About(Sx, Sy, Sz, X, Y, Z, TStart, Duration : real); virtual;
  125.         procedure Timed_RotateX_About(theta, X, Y, Z, TStart, Duration : real); virtual;
  126.         procedure Timed_RotateY_About(theta, X, Y, Z, TStart, Duration : real); virtual;
  127.         procedure Timed_RotateZ_About(theta, X, Y, Z, TStart, Duration : real); virtual;
  128.         procedure Timed_MoveTo(X, Y, Z, TStart, Duration : real); virtual;
  129.  
  130.         procedure Timed_Translate_At(dX, dY, dZ, TStart, Duration : real); virtual;
  131.         procedure Timed_Scale_At(dSx, dSy, dSz, TStart, Duration : real); virtual;
  132.         procedure Timed_RotateX_At(dtheta, TStart, Duration : real); virtual;
  133.         procedure Timed_RotateY_At(dtheta, TStart, Duration : real); virtual;
  134.         procedure Timed_RotateZ_At(dtheta, TStart, Duration : real); virtual;
  135.         procedure Timed_Scale_About_At(dSx, dSy, dSz, X, Y, Z, TStart, Duration : real); virtual;
  136.         procedure Timed_RotateX_About_At(dtheta, X, Y, Z, TStart, Duration : real); virtual;
  137.         procedure Timed_RotateY_About_At(dtheta, X, Y, Z, TStart, Duration : real); virtual;
  138.         procedure Timed_RotateZ_About_At(dtheta, X, Y, Z, TStart, Duration : real); virtual;
  139.  
  140.         procedure Remove_All_Timed_Transformations;
  141.  
  142.         procedure Change_Colour(color_in : byte; inten : real);
  143.         procedure Show; virtual;
  144.         procedure Hide; virtual;
  145.         procedure AddChild(this_object : object3d_ptr);
  146.         procedure RemoveChild(this_object : object3d_ptr);
  147.      end;
  148.  
  149.      file_object3d_ptr=^file_object3d;
  150.      file_object3d=object(object3d)
  151.         constructor Init(fname : titletype);
  152.      end;
  153.  
  154.      copy_object3d_ptr=^copy_object3d;
  155.      copy_object3d=object(object3d)
  156.         constructor Init(source_object : object3d_ptr);
  157.      end;
  158.  
  159.      face=object
  160.         vertex1 : face_vertex_ptr;  {Leave as first variable - used for self referencing}
  161.         color : byte;
  162.         seen : boolean;
  163.         normal : vector3d;
  164.         D : longint;
  165.         sort_z : integer;
  166.         next_order, next : face_ptr;
  167.         intensity : longint;
  168.         colour : byte;
  169.         long_sort_z : longint;
  170.         two_d : boolean;
  171.         this_fillproc : fillproc;
  172.         constructor Init(var owner : object3d; face_color : byte; inten : real);
  173.         procedure Add_Vertex(this_vertex : vertex_ptr);
  174.         procedure Build_Normal;
  175.         procedure Unit_Normal;
  176.         procedure Shading;
  177.         procedure Fill;
  178.         destructor Done;
  179.      end;
  180.  
  181.      timed_xform_ptr=^timed_xform;
  182.      timed_xform=object
  183.         t_start, t_last, t_end : real;
  184.         this_ob : object3d_ptr;
  185.         next : timed_xform_ptr;
  186.         constructor Init(this_object : object3d_ptr; start, duration : real);
  187.         procedure Update; virtual;
  188.         destructor Done;
  189.      end;
  190.  
  191.      timed_rotX_ptr=^timed_rotX;
  192.      timed_rotX=object(timed_xform)
  193.         dth : real;
  194.         constructor Init(this_object : object3d_ptr; start, duration, dtheta : real);
  195.         procedure Update; virtual;
  196.      end;
  197.  
  198.      timed_rotY_ptr=^timed_rotY;
  199.      timed_rotY=object(timed_rotX)
  200.         procedure Update; virtual;
  201.      end;
  202.  
  203.      timed_rotZ_ptr=^timed_rotZ;
  204.      timed_rotZ=object(timed_rotX)
  205.         procedure Update; virtual;
  206.      end;
  207.  
  208.      timed_rotX_About_ptr=^timed_rotX_About;
  209.      timed_rotX_About=object(timed_xform)
  210.         dth, X, Y, Z : real;
  211.         constructor Init(this_object : object3d_ptr; start, duration, dtheta, x1, y1, z1 : real);
  212.         procedure Update; virtual;
  213.      end;
  214.  
  215.      timed_rotY_About_ptr=^timed_rotY_About;
  216.      timed_rotY_About=object(timed_rotX_About)
  217.         procedure Update; virtual;
  218.      end;
  219.  
  220.      timed_rotZ_About_ptr=^timed_rotZ_About;
  221.      timed_rotZ_About=object(timed_rotX_About)
  222.         procedure Update; virtual;
  223.      end;
  224.  
  225.      timed_scale_ptr=^timed_scale;
  226.      timed_scale=object(timed_xform)
  227.         tsx,tsy,tsz : real;
  228.         constructor Init(this_object : object3d_ptr; start, duration, sx1, sy1, sz1 : real);
  229.         procedure Update; virtual;
  230.      end;
  231.  
  232.      timed_scale_About_ptr=^timed_scale_about;
  233.      timed_scale_About=object(timed_xform)
  234.         tsx,tsy,tsz,X,Y,Z : real;
  235.         constructor Init(this_object : object3d_ptr; start, duration, sx1, sy1, sz1, x1, y1, z1 : real);
  236.         procedure Update; virtual;
  237.      end;
  238.  
  239.      timed_translate_ptr=^timed_translate;
  240.      timed_translate=object(timed_xform)
  241.         X,Y,Z : real;
  242.         constructor Init(this_object : object3d_ptr; start, duration, x1, y1, z1 : real);
  243.         procedure Update; virtual;
  244.      end;
  245.  
  246.  
  247. {--------------------------------------------------------------------------------------------------}
  248.  
  249.      procedure multiply_4x4(first, second : fixed_matrix_4x4; var out : fixed_matrix_4x4);
  250.  
  251.      procedure Store_Settings;
  252.      function Keyboard_Check : boolean;
  253.      function mouse_available : boolean;
  254.      function mouse_check : boolean;
  255.      procedure flip_cursor2D_mode;
  256.      function cursor2D_check : boolean;
  257.      procedure User_KeyCheck_Proc(new_keyproc : keyproc);
  258.  
  259.      procedure Init_System;
  260.      procedure Sort_by_Nearest_Point;
  261.      procedure Sort_by_Furthest_Point;
  262.      procedure Sort_by_Middle_Point;
  263.      procedure Set_Window(wl,wb,wr,wt : real);
  264.      procedure Set_View(x,y,z, azimuth_in, colatitude_in, roll_in : real);
  265.      procedure Set_World_to_View(x,y,z : longint; azimuth_in, colatitude_in, roll_in : real);
  266.      procedure Redraw_Scene;
  267.  
  268.      procedure Set_Ambient_Intensity(inten : real);
  269.      procedure Set_Light(inten, dx, dy, dz : real);
  270.      procedure Set_Background_Colour(color_in : byte; inten : real);
  271.  
  272.      procedure Set_Palette;
  273.      procedure New_Color(col_no : byte; r, g, b : real);
  274.      procedure Save_Colors(fname : titletype);
  275.      procedure Load_Colors(fname : titletype);
  276.  
  277.      procedure ClGSc;
  278.      procedure Fill_Face(this_face : face_ptr);
  279.      procedure Fill_Face_Point(this_face : face_ptr);
  280.      procedure Fill_Face_Line(this_face : face_ptr);
  281.      procedure Show_Page(page_offset : integer);
  282.      procedure Stop_Graphics;
  283.      procedure Start_Graphics;
  284.      procedure Sort_Face_List;
  285.      procedure Clip_Stuff;
  286.      procedure Text_At(x,y : integer; text : string; colour : byte);
  287.      procedure Background_At(x,y : integer; text : string; colour : byte);
  288.      procedure Apply_Timed_Transforms;
  289.      procedure Send_Screen_to_PCX(fname : titletype);
  290.      procedure Write_Text_At(x,y : integer; text : string; tcolour : byte; tintensity : real; bcolour : byte;
  291.                              bintensity : real);
  292.      procedure Set_Text_Proc(temp_textproc : textproc);
  293.      procedure Set_Default_Cursor2D;
  294.      procedure Cursor2D_Colour(number : byte; intens : real);
  295.      procedure Draw_Cursor2D(xpos, ypos : integer);
  296.      function Cursor_Inside_Face(this_face : face_ptr; xpos, ypos : integer) : boolean;
  297.      function Now : real;
  298.      procedure Transform_World_to_Screen;
  299.      function NulKeyProc(key : char) : boolean;
  300.      procedure NulSelectProc(this_object : object3d_ptr);
  301.      function Load_Picture(filename : string) : pointer;
  302.  
  303.      function Number_of_Objects : integer;
  304.      function Number_of_Faces : integer;
  305.      function Number_of_Vertices : integer;
  306.  
  307.  
  308. var  x_pos, y_pos, z_pos : real;
  309.      viewpoint, setviewpoint, light : vector3d;
  310.      azimuth, colatitude, roll, setazimuth, setcolatitude, setroll : real;
  311.      screen_page_offset, font_segment, font_offset : word;
  312.      eye_screen_distance, speed, setspeed : longint;
  313.      light_intensity, ambient_intensity : longint;
  314.      hither, yon, picture_num, cursor_x, cursor_y : integer;
  315.      first_object : object3d_ptr;
  316.      first_list_face : face_ptr;
  317.      Sx,Sy,Rx,Ry : longint;
  318.      main_matrix, w2v : fixed_matrix_4x4;
  319.      redraw_all, timed_Xforms_separately, any_textproc, cursor2D_mode : boolean;
  320.      sort_type : byte;
  321.      first_timed_Xform : timed_Xform_ptr;
  322.      graphics_time : clock_ptr;
  323.      this_keyproc : keyproc;
  324.      this_textproc : textproc;
  325.      cursor_icon : pointer;
  326.      background_colour : longint;
  327.      cursor_colour : byte;
  328.      cursor_y_offset, cursor_x_offset : integer;
  329.      default_cursor_icon : array[1..12] of word;
  330.  
  331.  
  332. implementation
  333.  
  334. {------------------------------------------------}
  335. { Type initialisation method implementations     }
  336. {------------------------------------------------}
  337.  
  338. procedure fixed_matrix_4x4.data(x11, x12, x13, x14,
  339.                                x21, x22, x23, x24,
  340.                                x31, x32, x33, x34,
  341.                                x41, x42, x43, x44 : longint);
  342. begin
  343.      el[1,1]:=x11; el[1,2]:=x12; el[1,3]:=x13; el[1,4]:=x14;
  344.      el[2,1]:=x21; el[2,2]:=x22; el[2,3]:=x23; el[2,4]:=x24;
  345.      el[3,1]:=x31; el[3,2]:=x32; el[3,3]:=x33; el[3,4]:=x34;
  346.      el[4,1]:=x41; el[4,2]:=x42; el[4,3]:=x43; el[4,4]:=x44;
  347. end;
  348.  
  349. procedure vertex.data(x1, y1, z1 : real);
  350. begin
  351.      world.x:=real_to_fixed(x1);
  352.      world.y:=real_to_fixed(y1);
  353.      world.z:=real_to_fixed(z1);
  354. end;
  355.  
  356.  
  357. {------------------------------------------------}
  358. { Vector and matrix manipulation procedures      }
  359. {------------------------------------------------}
  360.  
  361. procedure multiply_4x4(first, second : fixed_matrix_4x4; var out : fixed_matrix_4x4);
  362. var col : integer;
  363. begin
  364.      for col:=1 to 3 do
  365.          begin
  366.               out.el[1,col]:=fixedmul(first.el[1,1],second.el[1,col])+fixedmul(first.el[1,2],second.el[2,col])
  367.               +fixedmul(first.el[1,3],second.el[3,col])+fixedmul(first.el[1,4],second.el[4,col]);
  368.          end;
  369.      for col:=1 to 3 do
  370.          begin
  371.               out.el[2,col]:=fixedmul(first.el[2,1],second.el[1,col])+fixedmul(first.el[2,2],second.el[2,col])
  372.               +fixedmul(first.el[2,3],second.el[3,col])+fixedmul(first.el[2,4],second.el[4,col]);
  373.          end;
  374.      for col:=1 to 3 do
  375.          begin
  376.               out.el[3,col]:=fixedmul(first.el[3,1],second.el[1,col])+fixedmul(first.el[3,2],second.el[2,col])
  377.               +fixedmul(first.el[3,3],second.el[3,col])+fixedmul(first.el[3,4],second.el[4,col]);
  378.          end;
  379.      for col:=1 to 3 do
  380.          begin
  381.               out.el[4,col]:=fixedmul(first.el[4,1],second.el[1,col])+fixedmul(first.el[4,2],second.el[2,col])
  382.               +fixedmul(first.el[4,3],second.el[3,col])+fixedmul(first.el[4,4],second.el[4,col]);
  383.          end;
  384.      out.el[1,4]:=0; out.el[2,4]:=0; out.el[3,4]:=0; out.el[4,4]:=1;
  385. end;
  386.  
  387.  
  388. {------------------------------------------------}
  389. { Object_3d method implementations               }
  390. {------------------------------------------------}
  391.  
  392. constructor object3d.Init;
  393. begin
  394.      first_vertex:=nil;
  395.      first_face:=nil;
  396.      next:=first_object;
  397.      first_object:=@first_vertex;
  398.      shown:=true;
  399.      redraw:=false;
  400.      reference_point.x:=0;
  401.      reference_point.y:=0;
  402.      reference_point.z:=0;
  403.      child:=nil;
  404.      select_procedure:=NulSelectProc;
  405. end;
  406.  
  407. destructor object3d.Done;
  408. var temp : object3d_ptr;
  409.     temp_child : child_object3d_ptr;
  410.     next_vertex : vertex_ptr;
  411.     next_face : face_ptr;
  412. begin
  413.      while first_vertex<>nil do
  414.      begin
  415.            next_vertex:=first_vertex^.next;
  416.            dispose(first_vertex);
  417.            first_vertex:=next_vertex;
  418.      end;
  419.      while first_face<>nil do
  420.      begin
  421.           next_face:=first_face^.next;
  422.           first_face^.Done;
  423.           dispose(first_face);
  424.           first_face:=next_face;
  425.      end;
  426.      {Removes this object from object list}
  427.      if first_object=@first_vertex then first_object:=next
  428.      else
  429.      begin
  430.           temp:=first_object;
  431.           while (temp<>nil) and (temp^.next<>@first_vertex) do temp:=temp^.next;
  432.           if temp<>nil then temp^.next:=next;
  433.      end;
  434.      {Disposes any child object pointers}
  435.      while child<>nil do
  436.      begin
  437.           temp_child:=child^.next;
  438.           dispose(child);
  439.           child:=temp_child;
  440.      end;
  441.      Remove_All_Timed_Transformations;
  442. end;
  443.  
  444. function object3d.Add_Vertex(x1,y1,z1 : real) : vertex_ptr;
  445. var temp_vertex : vertex_ptr;
  446. begin
  447.      new(temp_vertex);
  448.      temp_vertex^.data(x1,y1,z1);
  449.      temp_vertex^.next:=first_vertex;
  450.      first_vertex:=temp_vertex;
  451.      Add_vertex:=temp_vertex;
  452. end;
  453.  
  454. procedure object3d.Remove_Vertex(this_vertex : vertex_ptr);
  455. var temp_vertex, last_vertex : vertex_ptr;
  456.     last_face_vertex, temp_face_vertex : face_vertex_ptr;
  457.     temp_face, old_face : face_ptr;
  458.     count : integer;
  459.     found : boolean;
  460. begin
  461.      {Remove vertex from object's vertex list}
  462.      if first_vertex=temp_vertex then
  463.      begin
  464.           first_vertex:=first_vertex^.next;
  465.      end
  466.      else
  467.      begin
  468.           last_vertex:=first_vertex;
  469.           while (last_vertex^.next<>this_vertex) and (last_vertex^.next<>nil) do last_vertex:=last_vertex^.next;
  470.           if last_vertex^.next=this_vertex then last_vertex^.next:=this_vertex^.next;
  471.      end;
  472.      dispose(this_vertex);
  473.  
  474.      {Find faces referencing vertex and remove vertex from list}
  475.      {Any faces with less than 3 vertices removed}
  476.      temp_face:=first_face;
  477.      while temp_face<>nil do
  478.      begin
  479.           found:=false;
  480.           last_face_vertex:=temp_face^.vertex1;
  481.           if temp_face^.vertex1^.this_vertex=this_vertex
  482.           then
  483.           begin
  484.                found:=true;
  485.                temp_face_vertex:=temp_face^.vertex1;
  486.                temp_face^.vertex1:=temp_face^.vertex1^.next;
  487.                dispose(temp_face_vertex);
  488.           end
  489.           else
  490.           begin
  491.                while (last_face_vertex^.next<>nil) and
  492.                      (last_face_vertex^.next^.this_vertex<>this_vertex) do last_face_vertex:=last_face_vertex^.next;
  493.                if last_face_vertex^.next^.this_vertex=this_vertex then
  494.                begin
  495.                     found:=true;
  496.                     temp_face_vertex:=last_face_vertex^.next;
  497.                     last_face_vertex^.next:=last_face_vertex^.next^.next;
  498.                     dispose(temp_face_vertex);
  499.                end;
  500.           end;
  501.           if found then
  502.           begin
  503.                count:=0;
  504.                temp_face_vertex:=temp_face^.vertex1;
  505.                while temp_face_vertex<>nil do
  506.                begin
  507.                     inc(count);
  508.                     temp_face_vertex:=temp_face_vertex^.next;
  509.                end;
  510.                if count<3 then
  511.                begin
  512.                     old_face:=temp_face;
  513.                     temp_face:=temp_face^.next;
  514.                     dispose(old_face,done);
  515.                end
  516.                else
  517.                    temp_face:=temp_face^.next;
  518.           end
  519.           else
  520.               temp_face:=temp_face^.next;
  521.      end;
  522. end;
  523.  
  524. procedure object3d.Build_Normals;
  525. var temp_face : face_ptr;
  526.     temp_vertex : vertex_ptr;
  527. begin
  528.      temp_face:=first_face;
  529.      while temp_face<>nil do
  530.      begin
  531.           temp_face^.Build_Normal;
  532.           temp_face:=temp_face^.next;
  533.      end;
  534.      lo.x:=$7FFFFFFF; lo.y:=$7FFFFFFF; lo.z:=$7FFFFFFF;
  535.      hi.x:=$80000000; hi.y:=$80000000; hi.z:=$80000000;
  536.      temp_vertex:=first_vertex;
  537.      while temp_vertex<>nil do
  538.      begin
  539.           with temp_vertex^.world do
  540.           begin
  541.                if x>hi.x then hi.x:=x else if x<lo.x then lo.x:=x;
  542.                if y>hi.y then hi.y:=y else if y<lo.y then lo.y:=y;
  543.                if z>hi.z then hi.z:=z else if z<lo.z then lo.z:=z;
  544.           end;
  545.           temp_vertex:=temp_vertex^.next;
  546.      end;
  547. end;
  548.  
  549. procedure object3d.Save_to_Disk(filename : string);
  550. var f : text;
  551.     temp_vertex : vertex_ptr;
  552.     temp_face : face_ptr;
  553.     temp_face_vertex : face_vertex_ptr;
  554.     count : integer;
  555.     temp_string1, temp_string2 : string;
  556. begin
  557.      assign(f,filename);
  558.      rewrite(f);
  559.      count:=0;
  560.      temp_vertex:=first_vertex;
  561.      while temp_vertex<>nil do
  562.      begin
  563.           inc(count);
  564.           temp_vertex:=temp_vertex^.next;
  565.      end;
  566.      writeln(f,count);
  567.  
  568.      temp_vertex:=first_vertex;
  569.      while temp_vertex<>nil do
  570.      begin
  571.           with temp_vertex^.world do
  572.           writeln(f,fixed_to_real(x) : 2 : 5,'   ',fixed_to_real(y) : 2 : 5,'   ',fixed_to_real(z) : 2 : 5);
  573.           temp_vertex:=temp_vertex^.next;
  574.      end;
  575.      writeln(f,0);
  576.  
  577.      count:=0;
  578.      temp_face:=first_face;
  579.      while temp_face<>nil do
  580.      begin
  581.           inc(count);
  582.           temp_face:=temp_face^.next;
  583.      end;
  584.      writeln(f,count);
  585.  
  586.      temp_face:=first_face;
  587.      while temp_face<>nil do
  588.      begin
  589.           writeln(f,temp_face^.colour,'   ', fixed_to_real(temp_face^.intensity) : 3 : 2);
  590.           count:=0;
  591.           temp_face_vertex:=temp_face^.vertex1;
  592.           while temp_face_vertex<>nil do
  593.           begin
  594.                inc(count);
  595.                temp_face_vertex:=temp_face_vertex^.next;
  596.           end;
  597.           writeln(f,count);
  598.           temp_string1:='';
  599.           temp_face_vertex:=temp_face^.vertex1;
  600.           while temp_face_vertex<>nil do
  601.           begin
  602.                count:=1;
  603.                temp_vertex:=first_vertex;
  604.                while (temp_vertex<>nil) and (temp_vertex<>temp_face_vertex^.this_vertex) do
  605.                begin
  606.                     inc(count);
  607.                     temp_vertex:=temp_vertex^.next;
  608.                end;
  609.                if temp_vertex=nil then
  610.                begin
  611.                     writeln('Error - face vertex not in object');
  612.                     halt;
  613.                end
  614.                else
  615.                begin
  616.                     str(count,temp_string2);
  617.                     temp_string1:=temp_string2+'   '+temp_string1;
  618.                end;
  619.                temp_face_vertex:=temp_face_vertex^.next;
  620.           end;
  621.           writeln(f,temp_string1);
  622.           writeln(f,0);
  623.           temp_face:=temp_face^.next;
  624.      end;
  625.      writeln(f,0);
  626.      close(f);
  627. end;
  628.  
  629.  
  630. procedure object3d.Unit_Normals;
  631. var temp_face : face_ptr;
  632. begin
  633.      temp_face:=first_face;
  634.      while temp_face<>nil do
  635.      begin
  636.           temp_face^.Unit_Normal;
  637.           temp_face:=temp_face^.next;
  638.      end;
  639. end;
  640.  
  641. procedure object3d.Transform_to_Screen; external;
  642.  
  643. procedure object3d.Screen_Position(var x_pos, y_pos, z_pos); external;
  644.  
  645. procedure object3d.Screen_Limits(var xmin, xmax, ymin, ymax : integer); external;
  646.  
  647. procedure object3d.Apply_Xform(M : fixed_matrix_4x4); external;
  648.  
  649. procedure object3d.Apply_Transform(M : fixed_matrix_4x4);
  650. var temp_face : face_ptr;
  651.     temp_child : child_object3d_ptr;
  652. begin
  653.      self.Apply_XForm(M);
  654.      temp_face:=first_face;
  655.      while temp_face<>nil do
  656.      begin
  657.           temp_face^.Shading;
  658.           temp_face:=temp_face^.next;
  659.      end;
  660.      redraw:=true;
  661.      if child=nil then exit;
  662.      temp_child:=child;
  663.      while temp_child<>nil do
  664.      begin
  665.           temp_child^.this_child^.Apply_Transform(M);
  666.           temp_child:=temp_child^.next;
  667.      end;
  668. end;
  669.  
  670. procedure object3d.Set_Reference_Point(x, y, z : real);
  671. begin
  672.      reference_point.x:=real_to_fixed(x);
  673.      reference_point.y:=real_to_fixed(y);
  674.      reference_point.z:=real_to_fixed(z)
  675. end;
  676.  
  677. procedure object3d.Translate(X, Y, Z : real);
  678. var temp_vertex : vertex_ptr;
  679.     temp_face : face_ptr;
  680.     temp_child : child_object3d_ptr;
  681.     xf,yf,zf : longint;
  682. begin
  683.      xf:=real_to_fixed(x); yf:=real_to_fixed(y); zf:=real_to_fixed(z);
  684.      temp_vertex:=first_vertex;
  685.      while temp_vertex<>nil do
  686.      begin
  687.           temp_vertex^.world.x:=temp_vertex^.world.x+xf;
  688.           temp_vertex^.world.y:=temp_vertex^.world.y+yf;
  689.           temp_vertex^.world.z:=temp_vertex^.world.z+zf;
  690.           temp_vertex:=temp_vertex^.next;
  691.      end;
  692.  
  693.      reference_point.x:=reference_point.x+xf;
  694.      reference_point.y:=reference_point.y+yf;
  695.      reference_point.z:=reference_point.z+zf;
  696.  
  697.      lo.x:=lo.x+xf;
  698.      lo.y:=lo.y+yf;
  699.      lo.z:=lo.z+zf;
  700.  
  701.      hi.x:=hi.x+xf;
  702.      hi.y:=hi.y+yf;
  703.      hi.z:=hi.z+zf;
  704.  
  705.      redraw:=true;
  706.  
  707.      if child=nil then exit;
  708.      temp_child:=child;
  709.      while temp_child<>nil do
  710.      begin
  711.           temp_child^.this_child^.Translate(x,y,z);
  712.           temp_child:=temp_child^.next;
  713.      end;
  714. end;
  715.  
  716. procedure object3d.Scale(Sx, Sy, Sz : real);
  717. var m : fixed_matrix_4x4;
  718.     sxf, syf, szf : longint;
  719. begin
  720.      sxf:=real_to_fixed(Sx);
  721.      syf:=real_to_fixed(Sy);
  722.      szf:=real_to_fixed(Sz);
  723.      m.data(sxf,0,0,0,
  724.             0,syf,0,0,
  725.             0,0,szf,0,
  726.             fixedmul(reference_point.x,(65536-sxf)),fixedmul(reference_point.Y,(65536-syf)),
  727.             fixedmul(reference_point.Z,(65536-szf)),1);
  728.      Apply_Transform(m);
  729. end;
  730.  
  731. procedure object3d.RotateX(theta : real);
  732. var c, s : longint;
  733.     m : fixed_matrix_4x4;
  734. begin
  735.      CosSin(round(theta*10),c,s);
  736.      m.data(65536,0,0,0,
  737.             0,c,s,0,
  738.             0,-s,c,0,
  739.             0,FixedMul(reference_point.z,s)+FixedMul(reference_point.y,(65536-c)),
  740.             FixedMul(-reference_point.y,s)+FixedMul(reference_point.z,(65536-c)),1);
  741.      Apply_Transform(m);
  742. end;
  743.  
  744. procedure object3d.RotateY(theta : real);
  745. var c, s : longint;
  746.     m : fixed_matrix_4x4;
  747. begin
  748.      CosSin(round(theta*10),c,s);
  749.      m.data(c,0,-s,0,
  750.             0,65536,0,0,
  751.             s,0,c,0,
  752.             FixedMul(-reference_point.z,s)+FixedMul(reference_point.x,(65536-c)),0,
  753.             FixedMul(reference_point.x,s)+FixedMul(reference_point.z,(65536-c)),1);
  754.      Apply_Transform(m);
  755. end;
  756.  
  757. procedure object3d.RotateZ(theta : real);
  758. var c, s : longint;
  759.     m : fixed_matrix_4x4;
  760. begin
  761.      CosSin(round(theta*10),c,s);
  762.      m.data(c,s,0,0,
  763.             -s,c,0,0,
  764.             0,0,65536,0,
  765.             FixedMul(reference_point.y,s)+FixedMul(reference_point.x,(65536-c)),
  766.             FixedMul(-reference_point.x,s)+FixedMul(reference_point.y,(65536-c)),0,1);
  767.      Apply_Transform(m);
  768. end;
  769.  
  770. procedure object3d.Scale_About(Sx, Sy, Sz, X, Y, Z : real);
  771. var m : fixed_matrix_4x4;
  772. begin
  773.      m.data(real_to_fixed(Sx),0,0,0,
  774.             0,real_to_fixed(Sy),0,0,
  775.             0,0,real_to_fixed(Sz),0,
  776.             real_to_fixed(X*(1-Sx)),real_to_fixed(Y*(1-Sy)),real_to_fixed(Z*(1-Sz)),1);
  777.      Apply_Transform(m);
  778. end;
  779.  
  780. procedure object3d.RotateX_About(theta, X, Y, Z : real);
  781. var c, s : longint;
  782.     m : fixed_matrix_4x4;
  783.     yf,zf : longint;
  784. begin
  785.      yf:=real_to_fixed(Y);
  786.      zf:=real_to_fixed(Z);
  787.      CosSin(round(theta*10),c,s);
  788.      m.data(65536,0,0,0,
  789.             0,c,s,0,
  790.             0,-s,c,0,
  791.             0,FixedMul(zf,s)+FixedMul(yf,(65536-c)),FixedMul(-yf,s)+FixedMul(zf,(65536-c)),1);
  792.      Apply_Transform(m);
  793. end;
  794.  
  795. procedure object3d.RotateY_About(theta, X, Y, Z : real);
  796. var c, s : longint;
  797.     m : fixed_matrix_4x4;
  798.     xf,zf : longint;
  799.     row, col : integer;
  800. begin
  801.      xf:=real_to_fixed(X);
  802.      zf:=real_to_fixed(Z);
  803.      CosSin(round(theta*10),c,s);
  804.      m.data(c,0,-s,0,
  805.             0,65536,0,0,
  806.             s,0,c,0,
  807.             FixedMul(-zf,s)+FixedMul(xf,(65536-c)),0,FixedMul(xf,s)+FixedMul(zf,(65536-c)),1);
  808.      Apply_Transform(m);
  809. end;
  810.  
  811. procedure object3d.RotateZ_About(theta, X, Y, Z : real);
  812. var c, s : longint;
  813.     m : fixed_matrix_4x4;
  814.     xf,yf : longint;
  815.     row,col : integer;
  816. begin
  817.      xf:=real_to_fixed(X);
  818.      yf:=real_to_fixed(Y);
  819.      CosSin(round(theta*10),c,s);
  820.      m.data(c,s,0,0,
  821.             -s,c,0,0,
  822.             0,0,65536,0,
  823.             FixedMul(yf,s)+FixedMul(xf,(65536-c)),FixedMul(-xf,s)+FixedMul(yf,(65536-c)),0,1);
  824.      Apply_Transform(m);
  825. end;
  826.  
  827. procedure object3d.MoveTo(X, Y, Z : real);
  828. var dx, dy, dz : real;
  829. begin
  830.      dx:=X-fixed_to_real(reference_point.x);
  831.      dy:=Y-fixed_to_real(reference_point.y);
  832.      dz:=Z-fixed_to_real(reference_point.z);
  833.      Translate(dx,dy,dz);
  834. end;
  835.  
  836. procedure object3d.Timed_Translate(X, Y, Z, TStart, Duration : real);
  837. var junk : pointer;
  838. begin
  839.      junk:=new(timed_translate_ptr,Init(@first_vertex,TStart,Duration,X/Duration,Y/Duration,Z/Duration));
  840. end;
  841.  
  842. procedure object3d.Timed_Scale(Sx, Sy, Sz, TStart, Duration : real);
  843. var junk : pointer;
  844. begin
  845.      junk:=new(timed_scale_ptr,Init(@first_vertex,TStart,Duration,SX/Duration,SY/Duration,SZ/Duration));
  846. end;
  847.  
  848. procedure object3d.Timed_RotateX(theta, TStart, Duration : real);
  849. var junk : pointer;
  850. begin
  851.      junk:=new(timed_rotx_ptr,Init(@first_vertex,TStart,Duration,theta/Duration));
  852. end;
  853.  
  854. procedure object3d.Timed_RotateY(theta, TStart, Duration : real);
  855. var junk : pointer;
  856. begin
  857.      junk:=new(timed_roty_ptr,Init(@first_vertex,TStart,Duration,theta/Duration));
  858. end;
  859.  
  860. procedure object3d.Timed_RotateZ(theta, TStart, Duration : real);
  861. var junk : pointer;
  862. begin
  863.      junk:=new(timed_rotz_ptr,Init(@first_vertex,TStart,Duration,theta/Duration));
  864. end;
  865.  
  866. procedure object3d.Timed_Scale_About(Sx, Sy, Sz, X, Y, Z, TStart, Duration : real);
  867. var junk : pointer;
  868. begin
  869.      junk:=new(timed_scale_about_ptr,Init(@first_vertex,TStart,Duration,SX/Duration,SY/Duration,SZ/Duration,X,Y,Z));
  870. end;
  871.  
  872. procedure object3d.Timed_RotateX_About(theta, X, Y, Z, TStart, Duration : real);
  873. var junk : pointer;
  874. begin
  875.      junk:=new(timed_rotx_about_ptr,Init(@first_vertex,TStart,Duration,theta/Duration,X,Y,Z));
  876. end;
  877.  
  878. procedure object3d.Timed_RotateY_About(theta, X, Y, Z, TStart, Duration : real);
  879. var junk : pointer;
  880. begin
  881.      junk:=new(timed_roty_about_ptr,Init(@first_vertex,TStart,Duration,theta/Duration,X,Y,Z));
  882. end;
  883.  
  884. procedure object3d.Timed_RotateZ_About(theta, X, Y, Z, TStart, Duration : real);
  885. var junk : pointer;
  886. begin
  887.      junk:=new(timed_rotz_about_ptr,Init(@first_vertex,TStart,Duration,theta/Duration,X,Y,Z));
  888. end;
  889.  
  890. procedure object3d.Timed_MoveTo(X, Y, Z, TStart, Duration : real);
  891. var junk : pointer;
  892.     dx, dy, dz : real;
  893. begin
  894.      dx:=X-fixed_to_real(reference_point.x);
  895.      dy:=Y-fixed_to_real(reference_point.y);
  896.      dz:=Z-fixed_to_real(reference_point.z);
  897.      junk:=new(timed_translate_ptr,Init(@first_vertex,TStart,Duration,dx/Duration,dy/Duration,dz/Duration));
  898. end;
  899.  
  900. procedure object3d.Timed_Translate_At(dX, dY, dZ, TStart, Duration : real);
  901. var junk : pointer;
  902. begin
  903.      junk:=new(timed_translate_ptr,Init(@first_vertex,TStart,Duration,dX,dY,dZ));
  904. end;
  905.  
  906. procedure object3d.Timed_Scale_At(dSx, dSy, dSz, TStart, Duration : real);
  907. var junk : pointer;
  908. begin
  909.      junk:=new(timed_scale_ptr,Init(@first_vertex,TStart,Duration,dSX,dSY,dSZ));
  910. end;
  911.  
  912. procedure object3d.Timed_RotateX_At(dtheta, TStart, Duration : real);
  913. var junk : pointer;
  914. begin
  915.      junk:=new(timed_rotx_ptr,Init(@first_vertex,TStart,Duration,dtheta));
  916. end;
  917.  
  918. procedure object3d.Timed_RotateY_At(dtheta, TStart, Duration : real);
  919. var junk : pointer;
  920. begin
  921.      junk:=new(timed_roty_ptr,Init(@first_vertex,TStart,Duration,dtheta));
  922. end;
  923.  
  924. procedure object3d.Timed_RotateZ_At(dtheta, TStart, Duration : real);
  925. var junk : pointer;
  926. begin
  927.      junk:=new(timed_rotz_ptr,Init(@first_vertex,TStart,Duration,dtheta));
  928. end;
  929.  
  930. procedure object3d.Timed_Scale_About_At(dSx, dSy, dSz, X, Y, Z, TStart, Duration : real);
  931. var junk : pointer;
  932. begin
  933.      junk:=new(timed_scale_about_ptr,Init(@first_vertex,TStart,Duration,dSX,dSY,dSZ,X,Y,Z));
  934. end;
  935.  
  936. procedure object3d.Timed_RotateX_About_At(dtheta, X, Y, Z, TStart, Duration : real);
  937. var junk : pointer;
  938. begin
  939.      junk:=new(timed_rotx_about_ptr,Init(@first_vertex,TStart,Duration,dtheta,X,Y,Z));
  940. end;
  941.  
  942. procedure object3d.Timed_RotateY_About_At(dtheta, X, Y, Z, TStart, Duration : real);
  943. var junk : pointer;
  944. begin
  945.      junk:=new(timed_roty_about_ptr,Init(@first_vertex,TStart,Duration,dtheta,X,Y,Z));
  946. end;
  947.  
  948. procedure object3d.Timed_RotateZ_About_At(dtheta, X, Y, Z, TStart, Duration : real);
  949. var junk : pointer;
  950. begin
  951.      junk:=new(timed_rotz_about_ptr,Init(@first_vertex,TStart,Duration,dtheta,X,Y,Z));
  952. end;
  953.  
  954. procedure object3d.Remove_All_Timed_Transformations;
  955. var temp, temp2 : timed_xform_ptr;
  956. begin
  957.      temp:=first_timed_Xform;
  958.      while temp<>nil do
  959.      begin
  960.           if temp^.this_ob=@first_vertex then
  961.           begin
  962.                temp2:=temp;
  963.                temp:=temp^.next;
  964.                dispose(temp2,Done);
  965.           end
  966.           else
  967.           temp:=temp^.next;
  968.      end;
  969. end;
  970.  
  971.  
  972. procedure object3d.Change_Colour(color_in : byte; inten : real);
  973. var temp : face_ptr;
  974.     f_inten : longint;
  975. begin
  976.      if (color_in<0) or (color_in>15) then exit;
  977.      if (inten<0) or (inten>1) then exit;
  978.      f_inten:=real_to_fixed(inten);
  979.      temp:=first_face;
  980.      while temp<>nil do
  981.      begin
  982.           temp^.colour:=color_in;
  983.           temp^.intensity:=f_inten;
  984.           temp^.shading;
  985.           temp:=temp^.next;
  986.      end;
  987.      redraw:=true;
  988. end;
  989.  
  990. procedure object3d.Show;
  991. begin
  992.      shown:=true;
  993.      redraw:=true;
  994. end;
  995.  
  996. procedure object3d.Hide;
  997. begin
  998.      shown:=false;
  999. end;
  1000.  
  1001. procedure object3d.AddChild(this_object : object3d_ptr);
  1002. var temp_child : child_object3d_ptr;
  1003. begin
  1004.      if this_object=nil then exit;
  1005.      temp_child:=child;
  1006.      while temp_child<>nil do
  1007.      begin
  1008.           if temp_child^.this_child=this_object then exit;
  1009.           temp_child:=temp_child^.next;
  1010.      end;
  1011.      new(temp_child);
  1012.      temp_child^.next:=child;
  1013.      child:=temp_child;
  1014.      temp_child^.this_child:=this_object;
  1015. end;
  1016.  
  1017. procedure object3d.RemoveChild(this_object : object3d_ptr);
  1018. var temp_child : child_object3d_ptr;
  1019. begin
  1020.      if child=nil then exit;
  1021.      if child^.this_child=this_object then
  1022.      begin
  1023.           temp_child:=child;
  1024.           child:=child^.next;
  1025.           dispose(temp_child);
  1026.      end
  1027.      else
  1028.      temp_child:=child;
  1029.      while (temp_child^.next<>nil)and(temp_child^.next^.this_child<>this_object) do temp_child:=temp_child^.next;
  1030.      if temp_child^.next=nil then exit;
  1031.      temp_child^.next:=temp_child^.next^.next;
  1032.      dispose(temp_child^.next);
  1033. end;
  1034.  
  1035.  
  1036.  
  1037. {$I vroom1}
  1038.  
  1039. end.
  1040.