home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / GRAPHICS / PLOT / SURFUTI3.ZIP / EXTRUDE.INC < prev    next >
Encoding:
Text File  |  1990-09-03  |  11.2 KB  |  323 lines
  1. procedure EXTRUDE;
  2.  { procedure will make a solid of extrusion }
  3.  
  4. var
  5.    Firstnode, Lastnode:   integer;       { first, last node # in the solid }
  6.    Node:                  integer;       { node # }
  7.    Surf:                  integer;       { surface # }
  8.    X, Y:                  array[1..MAXOUTLN] of real; { coords of surf outln }
  9.    Noutln:                integer;       { number of outline nodes }
  10.    Num:                   integer;       { #inputted vals on line }
  11.    Comment:               text80;        { comment at end of line }
  12.    Realvar:               vartype;       { genl. input array }
  13.    Outln:                 integer;       { outline node number }
  14.    Orient:                integer;       { orientation code (1 = X axis,
  15.                                               2 = Y axis, 3 = Z axis) }
  16.    d1, d2, d3:            integer;       { degree nos. for each axis }
  17.    Nextrude:              integer;       { number of layers to generate }
  18.    Iquad:                 integer;       { flag, (1) use quads only, or }
  19.                                          {       (2) use any order polygons }
  20.    Material:              integer;       { material number of solid }
  21.    Nextnode:              integer;       { 1st node of next quad }
  22.    i:                     integer;       { genl index }
  23.    Zslice:                real;          { length of slice in Z direction }
  24.    Firstnodelastrow:      integer;       { node # }
  25.    Firstnodethisrow:      integer;       { node # }
  26.    Scale:                 vector;        { scale factors }
  27.    Shift:                 vector;        { shift distances }
  28.    Rotate:                vector;        { rotation angles }
  29.    Zbot, Ztop:            real;          { top and bottom specified by input }
  30.    Islice:                integer;       { Z-slice number }
  31.    Quad:                  integer;       { Quad number on top or bottom surf }
  32.    Nquads:                integer;       { #quads on top or bottom surf }
  33.  
  34. begin
  35. {$ifdef BIGMEM}
  36. with ptra^ do with ptrb^ do with ptrc^ do
  37. begin
  38. {$endif}
  39.   Line_num := Line_num + 1;
  40.   Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  41.   if (Num <> 5) or (Realvar[1] < 1) or (Realvar[1] > MAXOUTLN) or
  42.        (Realvar[2] < 1) or (Realvar[3] < 0) or (Realvar[3] > 1) or
  43.        (Realvar[4] < 1) or (Realvar[4] > Nmatl) or (Realvar[5] < 1) or
  44.        (Realvar[5] > 3) then begin
  45.     writeln ('Bad input for solid of extrusion (line ', Line_num, ')');
  46.     if (Num <> 5) then
  47.       writeln ('Expecting 5 numeric entries');
  48.     if (Realvar[1] < 1) or (Realvar[1] > MAXOUTLN) then
  49.       writeln ('Number of outline nodes must be between 1 and ', MAXOUTLN);
  50.     if (Realvar[2] < 1) then
  51.       writeln ('Number of vertical slices must be positive');
  52.     if (Realvar[3] < 0) or (Realvar[3] > 1) then
  53.       writeln ('Subdivision flag must be either 0 or 1');
  54.     if (Realvar[4] < 0) or (Realvar[4] > Nmatl) then
  55.       writeln ('Matl. must be between 1 and ',Nmatl);
  56.     if (Realvar[5] < 0) or (Realvar[5] > Nmatl) then
  57.  
  58.       writeln ('Orientation code must be 1, 2, or 3');
  59.     close (Infile);
  60.     halt;
  61.   end;
  62.   Noutln := round(Realvar[1]);
  63.   Nextrude := round(Realvar[2]);
  64.   Iquad := round(Realvar[3]);
  65.   Material := round(Realvar[4]);
  66.   Orient := round(Realvar[5]);
  67.  
  68.   Line_num := Line_num + 1;
  69.   Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  70.   if (Num <> 6) then begin
  71.     writeln ('Bad input for shifting or scaling (line ', Line_num, ')');
  72.     writeln ('Expecting 6 numeric entries');
  73.     close (Infile);
  74.     halt;
  75.   end;
  76.   Scale[1] := Realvar[1];
  77.   Scale[2] := Realvar[2];
  78.   Scale[3] := Realvar[3];
  79.   Shift[1] := Realvar[4];
  80.   Shift[2] := Realvar[5];
  81.   Shift[3] := Realvar[6];
  82.  
  83.   Line_num := Line_num + 1;
  84.   Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  85.   if (Num <> 3) then begin
  86.     writeln ('Bad input for rotations (line ', Line_num, ')');
  87.     writeln ('Expecting 3 numeric entries');
  88.     close (Infile);
  89.     halt;
  90.   end;
  91.   Rotate[1] := Realvar[1];
  92.   Rotate[2] := Realvar[2];
  93.   Rotate[3] := Realvar[3];
  94.  
  95.   Line_num := Line_num + 1;
  96.   Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  97.   if (Num <> 2) then begin
  98.     writeln ('Bad input: expecting 2 numeric entries for top and bottom ',
  99.         '(line ', Line_num, ')');
  100.     close (Infile);
  101.     halt;
  102.   end; { if Num }
  103.   Ztop := Realvar[1];
  104.   Zbot := Realvar[2];
  105.  
  106.   for Outln := 1 to Noutln do begin
  107.     Line_num := Line_num + 1;
  108.     Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  109.     if (Num <> 2) then begin
  110.       writeln ('Bad input: expecting 2 entries for node (Line ',Line_num, ')');
  111.       close (Infile);
  112.       halt;
  113.     end;
  114.     X[Outln] := Realvar[1];
  115.     Y[Outln] := Realvar[2];
  116.   end; { for Outln }
  117.  
  118.   case Orient of
  119.     1: begin       { X major axis }
  120.          d1 := 2;
  121.          d2 := 3;
  122.          d3 := 1;
  123.        end;
  124.     2: begin       { Y major axis }
  125.          d1 := 3;
  126.          d2 := 1;
  127.          d3 := 2;
  128.        end;
  129.     3: begin       { Z major axis }
  130.          d1 := 1;
  131.          d2 := 2;
  132.          d3 := 3;
  133.        end;
  134.   end;   { case }
  135.  
  136.   Firstnode := Nnodes + 1;
  137.   Node := Nnodes;
  138.   Surf := Nsurf;
  139.  
  140.   Zslice := (Ztop - Zbot) / Nextrude;
  141.  
  142. { Do the top row of nodes first }
  143.   for Outln := 1 to Noutln do begin
  144.     Node := Node + 1;
  145.     if (Node > MAXNODES) then begin
  146.       writeln ('Exceeded MAXNODES=',MAXNODES,' in surface of extrusion ',
  147.         '(line ',Line_num,' of input).');
  148.       close (Infile);
  149.       halt;
  150.     end;
  151.     World[Node][d1] := X[Outln];
  152.     World[Node][d2] := Y[Outln];
  153.     World[Node][d3] := Ztop;
  154.   end;
  155.  
  156. { Connect the top surface(s) }
  157.   Firstnodethisrow := Firstnode;
  158.   if (Iquad = 0) then begin
  159.  
  160.     { Don't break the top surface into quads; leave it as is }
  161.     Surf := Surf + 1;
  162.     if (Surf > Realmaxsurf) then begin
  163.       writeln ('Exceeded MAXSURF=',Realmaxsurf,' in surface of extrusion ',
  164.         '(line ',Line_num,' of input).');
  165.       close (Infile);
  166.       halt;
  167.     end;
  168.     Matl[Surf] := Material;
  169.     if (Noutln > Maxvert) then begin
  170.       writeln ('Bad input: Noutln cannot exceed Maxvert if Iquad=0');
  171.       close (Infile);
  172.       halt;
  173.     end;
  174.     for Outln := 1 to Noutln do
  175.       Connect[(Surf-1)*Maxvert+Outln] := Firstnodethisrow + Outln - 1;
  176.     if (Noutln < Maxvert) then
  177.       Connect[(Surf-1)*Maxvert+Noutln+1] := 0;
  178.  
  179.   end else begin
  180.  
  181.     { Break the surface into quads, plus an extra triangle if req'd }
  182.     Nquads := (Noutln-2) div 2;
  183.     Nextnode := Firstnodethisrow;
  184.     for Quad := 1 to Nquads do begin
  185.       Surf := Surf + 1;
  186.       if (Surf > Realmaxsurf) then begin
  187.         writeln ('Exceeded MAXSURF=',Realmaxsurf,' in surface of extrusion ',
  188.           '(line ',Line_num,' of input).');
  189.         close (Infile);
  190.         halt;
  191.       end;
  192.       Matl[Surf] := Material;
  193.       Connect[(Surf-1)*Maxvert+1] := Firstnodethisrow;
  194.       for i := 2 to 4 do
  195.         Connect[(Surf-1)*Maxvert+i] := Nextnode + i - 1;
  196.       if (Maxvert > 4) then
  197.         Connect[(Surf-1)*Maxvert+5] := 0;
  198.       Nextnode := Nextnode + 2;
  199.     end; { for Quad }
  200.     if ((Noutln div 2) * 2 <> Noutln) then begin
  201.       { Noutln is odd, so need an extra triangle to complete the surface }
  202.       Surf := Surf + 1;
  203.       if (Surf > Realmaxsurf) then begin
  204.         writeln ('Exceeded MAXSURF=',Realmaxsurf,' in surface of extrusion ',
  205.           '(line ',Line_num,' of input).');
  206.         close (Infile);
  207.         halt;
  208.       end;
  209.       Matl[Surf] := Material;
  210.       Connect[(Surf-1)*Maxvert+1] := Firstnodethisrow;
  211.       for i := 2 to 3 do
  212.         Connect[(Surf-1)*Maxvert+i] := Nextnode + i - 1;
  213.       Connect[(Surf-1)*Maxvert+4] := 0;
  214.     end; { if Noutln }
  215.   end; { if Iquad }
  216.  
  217.   Firstnodelastrow := Firstnodethisrow;
  218.   for Islice := 1 to Nextrude do begin
  219.     Firstnodethisrow := Node + 1;
  220.     for Outln := 1 to Noutln do begin
  221.       Node := Node + 1;
  222.       if (Node > MAXNODES) then begin
  223.         writeln ('Exceeded MAXNODES=',MAXNODES,' in surface of extrusion ',
  224.           '(line ',Line_num,' of input).');
  225.         close (Infile);
  226.         halt;
  227.       end;
  228.       World[Node][d1] := X[Outln];
  229.       World[Node][d2] := Y[Outln];
  230.       World[Node][d3] := Ztop - Zslice * Islice;
  231.  
  232.       Surf := Surf + 1;
  233.       if (Surf > Realmaxsurf) then begin
  234.         writeln ('Exceeded MAXSURF=',Realmaxsurf,' in surface of extrusion ',
  235.           '(line ',Line_num,' of input).');
  236.         close (Infile);
  237.         halt;
  238.       end;
  239.       Matl[Surf] := Material;
  240.       Connect[(Surf-1)*Maxvert+1] := Firstnodelastrow + Outln - 1;
  241.       Connect[(Surf-1)*Maxvert+2] := Firstnodethisrow + Outln - 1;
  242.       if (Outln = Noutln) then begin
  243.         Connect[(Surf-1)*Maxvert+3] := Firstnodethisrow;
  244.         Connect[(Surf-1)*Maxvert+4] := Firstnodelastrow;
  245.       end else begin
  246.         Connect[(Surf-1)*Maxvert+3] := Firstnodethisrow + Outln;
  247.         Connect[(Surf-1)*Maxvert+4] := Firstnodelastrow + Outln;
  248.       end;
  249.       if (Maxvert > 4) then
  250.         Connect[(Surf-1)*Maxvert+5] := 0;
  251.     end; { for Outln }
  252.     Firstnodelastrow := Firstnodethisrow;
  253.   end; { for Islice }
  254.  
  255.   Lastnode := Node;
  256.   Nnodes := Node;
  257.  
  258. { Connect the bottom surface(s) in reverse order }
  259.   Firstnodethisrow := Firstnodelastrow;
  260.   if (Iquad = 0) then begin
  261.  
  262.     { Don't break the bottom surface into quads; leave it as is }
  263.     Surf := Surf + 1;
  264.     if (Surf > Realmaxsurf) then begin
  265.       writeln ('Exceeded MAXSURF=',Realmaxsurf,' in surface of extrusion ',
  266.         '(line ',Line_num,' of input).');
  267.       close (Infile);
  268.       halt;
  269.     end;
  270.     Matl[Surf] := Material;
  271.     for Outln := 1 to Noutln do
  272.       Connect[(Surf-1)*Maxvert+Outln] := Firstnodethisrow + Noutln - Outln;
  273.     if (Noutln < Maxvert) then
  274.       Connect[(Surf-1)*Maxvert+Noutln+1] := 0;
  275.  
  276.   end else begin
  277.  
  278.     { Break the surface into quads, plus an extra triangle if req'd }
  279.     Nquads := (Noutln-2) div 2;
  280.     Nextnode := Firstnodethisrow + Noutln;
  281.     for Quad := 1 to Nquads do begin
  282.       Surf := Surf + 1;
  283.       if (Surf > Realmaxsurf) then begin
  284.         writeln ('Exceeded MAXSURF=',Realmaxsurf,' in surface of extrusion ',
  285.           '(line ',Line_num,' of input).');
  286.         close (Infile);
  287.         halt;
  288.       end;
  289.       Matl[Surf] := Material;
  290.       Connect[(Surf-1)*Maxvert+1] := Firstnodethisrow;
  291.       for i := 2 to 4 do
  292.         Connect[(Surf-1)*Maxvert+i] := Nextnode - i + 1;
  293.       if (Maxvert > 4) then
  294.         Connect[(Surf-1)*Maxvert+5] := 0;
  295.       Nextnode := Nextnode + 2;
  296.     end; { for Quad }
  297.     if ((Noutln div 2) * 2 <> Noutln) then begin
  298.       { Noutln is odd, so need an extra triangle to complete the surface }
  299.       Surf := Surf + 1;
  300.       if (Surf > Realmaxsurf) then begin
  301.         writeln ('Exceeded MAXSURF=',Realmaxsurf,' in surface of extrusion ',
  302.           '(line ',Line_num,' of input).');
  303.         close (Infile);
  304.         halt;
  305.       end;
  306.       Matl[Surf] := Material;
  307.       Connect[(Surf-1)*Maxvert+1] := Firstnodethisrow;
  308.       for i := 2 to 3 do
  309.         Connect[(Surf-1)*Maxvert+i] := Nextnode - i + 1;
  310.       Connect[(Surf-1)*Maxvert+4] := 0;
  311.     end; { if Noutln }
  312.   end; { if Iquad }
  313.  
  314.   Nsurf := Surf;
  315.  
  316.   rotatenodes (Firstnode, Lastnode, Rotate);
  317.   shiftnodes (Firstnode, Lastnode, Shift);
  318.   scalenodes (Firstnode, Lastnode, Scale);
  319. {$ifdef BIGMEM}
  320. end; {with}
  321. {$endif}
  322. end; { procedure EXTRUDE }
  323.