home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / GRAPHICS / PLOT / SURFUTI3.ZIP / SURFEDIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-02-10  |  37.2 KB  |  1,135 lines
  1. program Surfmodl_datafile_editor;
  2.  
  3. { Names of all the systems currently supported by SURFMODL: }
  4. const MAXSYS = 8;           { maximum # of systems currently supported }
  5.       Sys_name: Array[1..MAXSYS] of string[30] = (
  6.         'IBM Color Graphics Adapter',
  7.         'IBM Enhanced Graphics Adapter',
  8.         'Hercules Graphics Adapter',
  9.         'Sanyo MBC-555',
  10.         'Heath/Zenith Z-100',
  11.         'CGA Compatible',
  12.         'AT&T 6300',
  13.         'IBM 3270');
  14.  
  15.       Up    = 242; Down = 250;  Left = 245;
  16.       Right = 247; Esc  = 27;   Space= 32;
  17.       Ret   = 13;
  18.       Red   = 4;   Blue = 3;    Black = 0;
  19.  
  20.       STDCGA   = 1;      EGA      = 2;      HERCULES = 3;
  21.       SANYO    = 4;      Z100     = 5;      TBCGA    = 6;
  22.       ATT      = 7;      IBM3270  = 8;      QUAD480  = 9;
  23.       QUAD752  = 10;
  24.  
  25.       NUMLGLSYS = 1;
  26.       LGLSYS: Array[1..NUMLGLSYS] of integer = (EGA);
  27.       { Global variables and constants for SURFMODL }
  28.       MSDOS: boolean = TRUE;
  29.       TOOLBOX: boolean = FALSE;
  30.       MAXNODES = 4096;      { maximum # of nodes in the entire solid }
  31.       MAXCONNECT = 16384;   { maximum # of connections in entire solid }
  32.       MAXSURF = 5461;       { maximum # of surfaces in entire solid }
  33.                             { (MAXSURF = MAXCONNECT / 3) }
  34.       MAXMATL = 30;         { maximum # of materials in entire solid }
  35.       MAXPTS = 600;         { maximum # of line points (in fillsurf) }
  36.       MAXVAR = 20;          { maximum # of numeric inputs on a line }
  37.       MAXLITE = 20;         { maximum # of light sources }
  38.       maxobj = 10;            { maximum # of objects to include }
  39.  
  40.  
  41. type  WindowType = ( elevation,plan,endview);
  42.       Points = Array[1..MAXPTS] of integer;
  43.       Realpts = Array[1..MAXPTS] of real;
  44.       Text80 = string[80];
  45.       VarType = Array[1..MAXVAR] of real;
  46.       Surfaces = Array[1..MAXSURF] of real;
  47.       Vector = Array[1..3] of real;
  48.       NodeArray= Array[1..MAXNODES] of real;
  49.  
  50.       HeapArray1 = record Xworld:nodeArray; end;
  51.       Hptr1 = ^heapArray1;
  52.       HeapArray2 = record Yworld:nodeArray; end;
  53.       HPtr2 = ^heapArray2;
  54.       HeapArray3 = record Zworld:nodeArray; end;
  55.       HPtr3 = ^heapArray3;
  56.       HeapArray7 = record Connect :Array[1..MAXCONNECT] of integer; end;
  57.       HPtr7 = ^heapArray7;
  58.       HeapArray8 = record Nvert : Array[1..MAXSURF] of integer; end;
  59.       HPtr8 = ^heapArray8;
  60.       HeapArray9 = record Matl : Array[1..MAXSURF] of integer; end;
  61.       hPtr9 = ^heapArray9;
  62.       heapArray11 = record  Surfmin, Surfmax : surfaces; end;
  63.       hPtr11 = ^heapArray11;
  64.  
  65. var   Ptra : hPtr1;   { Xworld }
  66.       Ptrb : hPtr2;   { Yworld }
  67.       Ptrc : hPtr3;   { Zworld }
  68.       Ptrg : hPtr7;   { Connect }
  69.       Ptrh : hPtr8;   { Nvert }
  70.       Ptri : hPtr9;   { Matl }
  71.       Ptrk : hPtr11;  { Surfmin, Surfmax }
  72.       R1, R2, R3:   Array[1..MAXMATL] of real;
  73.       Color:        Array[1..MAXMATL] of integer;
  74.       Ambient:      Array[1..MAXMATL] of real;
  75.       Xlite, Ylite,
  76.       Zlite:        Array[1..MAXLITE] of real;
  77.       Intensity:    Array[1..MAXLITE] of real;
  78.  
  79.       Flpurpose: string[127];              { title for plot }
  80.       Xeye, Yeye, Zeye: real;              { coords of eye }
  81.       Xfocal, Yfocal, Zfocal: real;        { coords of focal point }
  82.       Maxvert: integer;                    { max # vertices per surface }
  83.       Nsurf: integer;                      { # surfaces }
  84.       Nnodes: integer;                     { # nodes }
  85.       Nlite: integer;                      { # light sources }
  86.       Magnify: real;                       { magnification factor }
  87.       Viewtype: integer;                   { code for viewing type: }
  88.                                            { 0=perspective, 1=XY, 2=XZ, 3=YZ }
  89.       Fileread: boolean;                   { flag first file read }
  90.       Nmatl: integer;                      { number of materials }
  91.       GxMin, GxMax, GyMin, GyMax: integer; { graphics screen limits }
  92.       System: integer;                     { computer being used (1..MAXSYS) }
  93.       Nsides: integer;                     { #sides of surface used (1 or 2)}
  94.       Interpolate: boolean;                { flag for Gouraud interpolation }
  95.       Epsilon: real;                       { Gouraud interpolation range }
  96.       Dorandom: boolean;                   { flag for randomness in Gouraud }
  97.       Randshade: real;                     { random shade added to each pixel }
  98.       Shadowing: boolean;                  { flag shadowing option }
  99.       Inifile: text80;                     { name of INI file }
  100.       XYadjust: real;                      { factor for screen width }
  101.       Ngraphchar: integer;                 { #chars across graphics screen}
  102.                                            { If 0 then no text will be
  103.                                              displayed on the graphics screen }
  104.       Showaxes: integer;                   { code to show (0) no axes; (1) }
  105.                                            { axis directions; (2) full axes }
  106.       Xaxislen,Yaxislen,Zaxislen: real;    { lengths of axes }
  107.       Axiscolor: integer;                  { color to draw axes }
  108.       Nwindow: integer;                    { # graphics windows on screen }
  109.       Ncolors: integer;                    { #colors supported on computer }
  110.       Mono: boolean;                       { Is picture to be displayed on }
  111.                                            { monochrome monitor? }
  112.       TBinit: boolean;                     { Has Toolbox been initialized? }
  113.       Viewchanged: boolean;                { Has the viewing angle changed? }
  114.       Xfotran, Yfotran, Zfotran: real;     { transformed focal point }
  115.       XYmax: real;                         { limits of transformed coords }
  116.       Memavail: real;                      { # bytes of available memory }
  117.       Mxc: integer;                        { suggested value of MAXCONNECT }
  118.       Realmaxsurf:      integer;           { max #surfaces, based on }
  119.                                            { Maxvert and MAXCONNECT }
  120.       line_num : integer;
  121.       nobj:       integer;
  122.       infile: text;
  123.       comment,filename : text80;
  124.       realvar:             vartype;
  125.       i,Ch:                                integer;
  126.       Curwindow,win:                       windowtype;
  127.       Rotate:           vector;        { rotation angles }
  128.       trans:        vector;        { transformation dist }
  129.       Scale:            vector;        { scaling magnitude }
  130.       firstnode,lastnode,
  131.       firstsurf,lastsurf:                  array [1..maxobj] of integer;
  132.       curobj:                              integer;
  133.       Max,MIn:                             real;
  134.       ElevTopX,elevTopY,elevBotX,elevBotY: real;
  135.       EndTopX,endTopY,endBotX,endBotY:     real;
  136.       PlanTopX,planTopY,planBotX,planBotY: real;
  137.       TmpTopX,tmpTopY,tmpBotX,tmpBotY:     real;
  138.  
  139. {$i tbemega.pas}
  140. {$i exgrega.pas}
  141. {$i setsys.pas}
  142. {$i inreal.pas}
  143. {$i readini.pas}
  144. {$i gx2de.pas}
  145. {$i gxzoom.pas}
  146. {$i gxgin.pas}
  147.  
  148. { An important function for decoding the Connect Array: }
  149.  
  150. function KONNEC (Surf, Vert: integer): integer;
  151. { Decode the Connect Array to yield the connection data: Vertex Vert of
  152. surface Surf. This function returns an index to the global Xtran, Ytran,
  153. and Ztran Arrays (i.e., a node number) }
  154. begin
  155. with ptrg^ do
  156. begin
  157.   Konnec := Connect[(Surf-1) * Maxvert + Vert];
  158. end; {with}
  159. end; { function KONNEC }
  160. procedure msg (p: integer;line : text80);
  161. begin
  162.      gotoxy (42,15+p);
  163.      write (line,copy ('                                        ',
  164.                         1,38-length(line)));
  165. end; { msg }
  166.  
  167. procedure OPENFILE (var Filename: text80; var Infile: text);
  168. { Open a file with error checking. Prompt for new one if file not found }
  169.  
  170. begin   Fileread := FALSE;
  171.   while (NOT Fileread) do begin
  172.     assign (Infile, Filename);
  173.     {$I-}
  174.     reset (Infile);
  175.     {$I+}
  176.     if (ioresult <> 0) then begin
  177.       writeln ('Error: file ',Filename,' does not exist.');
  178.       write ('Enter new file name (or <enter> to exit): ');
  179.       readln (Filename);
  180.       if (Filename = '') then
  181.         halt;
  182.     end else
  183.       Fileread := TRUE;
  184.   end;
  185. end;   { procedure OPENFILE }
  186.  
  187. procedure READFILE (Filename: text80);
  188. { read the input data from the file }
  189.  
  190. var
  191.   Version: integer;       { used for multiple version input flag (only 4 now) }
  192.   j: integer;             { counter for looping and reading into arrays}
  193.   Infile: text;           { file to read}
  194.   Realvar: vartype;       { temporary array for storage of line input }
  195.   Num: integer;           { number of inputted values on the line }
  196.   Comment: text80;        { comment at end of line }
  197.   Line_num: integer;      { line number in input file }
  198.   Nvread: integer;        { #vertices read so far in this surface }
  199.   Vert: integer;          { vertex # }
  200.   Nscript: integer;       { #script inputs }
  201.   Cmmd: integer;          { script command number }
  202.   Mat: integer;           { material # }
  203.   Node: integer;          { node # }
  204.   Surf: integer;          { surface # }
  205.   Connection: integer;    { next connection number on surface }
  206.   oldnmatl,oldnnodes,oldnsurf:   integer;
  207.  
  208. begin
  209. with ptra^ do with ptrb^ do
  210. with ptrc^ do with ptrg^ do
  211. with ptrh^ do with ptri^ do
  212. begin {with}
  213.   oldnmatl  := nmatl;
  214.   oldnnodes := nnodes;
  215.   oldnsurf  := nsurf;
  216.  
  217.   openfile (Filename, Infile);
  218.   readln (Infile, Flpurpose);
  219.   Line_num := 2;
  220.   Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  221.   if (Num <> 1) then begin
  222.     writeln ('Bad input: Reading version number.');
  223.     close (Infile);
  224.     halt;
  225.   end;
  226.   Version := round(Realvar[1]);
  227.   if (Version = 1) then begin
  228.     Line_num := Line_num + 1;
  229.     Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  230.     if (Num <> 4) then begin
  231.       writeln ('Bad input: Reading #nodes, #surfaces, Maxvert and #materials',
  232.           ' (line ',Line_num,')');
  233.       close (Infile);
  234.       halt;
  235.     end;
  236.     Nnodes  := round(Realvar[1]);
  237.     Nsurf   := round(Realvar[2]);
  238.     Maxvert := round(Realvar[3]);
  239.     Nmatl   := nmatl + round(Realvar[4]);
  240.     Nscript := 0;
  241.     Nsides  := 1;
  242.   end else if (Version = 2) then begin
  243.     Line_num := Line_num + 1;
  244.     Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  245.     if (Num <> 6) then begin
  246.       writeln ('Bad input: Reading #matl, #nodes, #surf, #script, Maxvert,',
  247.           ' #sides (line ',Line_num,')');
  248.       close (Infile);
  249.       halt;
  250.     end;
  251.     Nmatl := round(Realvar[1]);
  252.     Nnodes := round(Realvar[2]);
  253.     Nsurf := round(Realvar[3]);
  254.     Nscript := round(Realvar[4]);
  255.     Maxvert := round(Realvar[5]);
  256.     Nsides := round(Realvar[6]);
  257.   end else if (Version = 3) or (Version = 4) then begin
  258.     Line_num := Line_num + 1;
  259.     Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  260.     if (Num <> 5) then begin
  261.       writeln ('Bad input: Reading #matl, #nodes, #surf, Maxvert,',
  262.           ' #sides (line ',Line_num,')');
  263.       close (Infile);
  264.       halt;
  265.     end;
  266.     Nmatl := round(Realvar[1]);
  267.     Nnodes := round(Realvar[2]);
  268.     Nsurf := round(Realvar[3]);
  269.     Maxvert := round(Realvar[4]);
  270.     Nsides := round(Realvar[5]);
  271.   end else begin
  272.     writeln('Wrong data input version number specified');
  273.     close (Infile);
  274.     halt;
  275.   end;
  276.  
  277.   if (Nnodes<=MAXNODES) and (Nsurf<=MAXSURF) and
  278.      (Nmatl<=MAXMATL)   and (Maxvert*Nsurf<=MAXCONNECT) and
  279.      (Nsides<=2)        and (Nnodes>0) and (Nsurf>0) and (Nmatl>0) then
  280.   begin
  281.     for mat := oldnmatl+1 to (oldnmatl+Nmatl) do
  282.     begin
  283.       Line_num := Line_num + 1;
  284.       Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  285.       if (Version <= 2) then
  286.       begin
  287.         if (Num <> 3) then
  288.         begin
  289.           writeln ('Bad input: Reading data for material #',mat,' (line ',
  290.               Line_num,')');
  291.           close (Infile);
  292.           halt;
  293.         end;
  294.         R1[mat] := Realvar[1];
  295.         R2[mat] := Realvar[2];
  296.         R3[mat] := 0.0;
  297.         Color[mat] := round(Realvar[3]);
  298.         Ambient[mat] := 0.1;
  299.       end
  300.       else
  301.       if (Version = 3) then
  302.       begin
  303.         if (Num <> 4) then
  304.         begin
  305.            writeln ('Bad input: Reading data for material #',mat,' (line ',
  306.               Line_num,')');
  307.           close (Infile);
  308.           halt;
  309.         end;
  310.         R1[mat] := Realvar[1];
  311.         R2[mat] := Realvar[2];
  312.         R3[mat] := Realvar[3];
  313.         Color[mat] := round(Realvar[4]);
  314.         Ambient[mat] := 0.1;
  315.       end
  316.       else
  317.       begin
  318.         if (Num <> 5) then
  319.         begin
  320.           writeln ('Bad input: Reading data for material #',mat,' (line ',
  321.               Line_num,')');
  322.           close (Infile);
  323.           halt;
  324.         end;
  325.         R1[mat] := Realvar[1];
  326.         R2[mat] := Realvar[2];
  327.         R3[mat] := Realvar[3];
  328.         Color[mat] := round(Realvar[4]);
  329.         Ambient[mat] := Realvar[5];
  330.       end; { if Version }
  331.     end;  {for Mat}
  332.  
  333.  
  334.  
  335.     firstnode[curobj] := oldnnodes + 1;
  336.     lastnode [curobj] := oldnnodes + nnodes+1;
  337.     for Node := firstnode[curobj] to lastnode[curobj]-1 do
  338.     begin
  339.       Line_num := Line_num + 1;
  340.       Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  341.       if (Num <> 3) then
  342.       begin
  343.         writeln ('Bad input: Reading data for node #',Node,' (line ',
  344.              Line_num,')');
  345.         close (Infile);
  346.         halt;
  347.       end;
  348.       Xworld[Node] := Realvar[1];
  349.       Yworld[Node] := Realvar[2];
  350.       Zworld[Node] := Realvar[3];
  351.     end; {for Node}
  352.  
  353.  
  354.  
  355.     firstsurf[curobj] := oldnsurf + 1;
  356.     lastsurf [curobj] := oldnsurf + nsurf+1;
  357.     for Surf := firstsurf[curobj] to lastsurf[curobj]-1 do
  358.     begin
  359.        Line_num := Line_num + 1;
  360.        Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  361.        if (Num < 5) then
  362.        begin
  363.          writeln ('Bad input: Reading data for surface #',Surf,
  364.                   ' (line ',Line_num,')');
  365.          if (Num > 2) then
  366.             writeln ('Must have at least 3 nodes on a surface!');
  367.          close (Infile);
  368.          halt;
  369.        end;
  370.        Nvert[Surf] := round(Realvar[1]);
  371.        Matl[Surf]  := round(Realvar[2]);
  372.        if (Nvert[Surf]<3) or (Nvert[Surf]>Maxvert)
  373.           or (Nvert[Surf]<Num-2) or (Matl[Surf]<1)
  374.           or (Matl[Surf]>Nmatl) then
  375.        begin
  376.          writeln ('Error in surface ',Surf,'(line ',Line_num,'): ');
  377.          if (Nvert[Surf] < 3) then
  378.             writeln ('Must have at least 3 nodes per surface')
  379.          else
  380.          if (Nvert[Surf] > Maxvert) then
  381.             writeln ('#vertices exceeds Maxvert')
  382.          else
  383.          if (Matl[Surf]<1) or (Matl[Surf]>Nmatl) then
  384.             writeln ('Matl no. not in range 0..Nmatl (',Nmatl,')')
  385.          else
  386.             writeln ('#vertices specified does not match #arguments');
  387.          close (Infile);
  388.          halt;
  389.        end; { if Nvert... }
  390.  
  391.        Nvread := Num - 2;
  392.        for Vert := 1 to Nvread do
  393.        begin
  394.          Connection := round(Realvar[Vert+2])+ oldnnodes;
  395.          if (Connection<1) or (Connection>Nnodes+oldnnodes) then
  396.          begin
  397.            writeln ('Error in surface ',Surf,'(line ',Line_num,'): ');
  398.            writeln ('Connection #,',Vert,' not in range 0..Nnodes (',
  399.                      Nnodes,')');
  400.            close (Infile);
  401.            halt;
  402.          end;
  403.          Connect[(Surf-1)*Maxvert+Vert] := Connection;
  404.        end; { for Vert }
  405.  
  406.        while (Nvread < Nvert[Surf]) do
  407.        begin
  408.          Line_num := Line_num + 1;
  409.          Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  410.          if (Num < 1) or (Nvread + Num > Nvert[Surf]) then
  411.          begin
  412.            writeln ('Error in surface ',Surf,'(line ',Line_num,'): ');
  413.            if (Num = 0) then writeln ('No data read.')
  414.            else if (Nvread + Num > Nvert[Surf]) then
  415.               writeln ('Too many vertices read.');
  416.            close (Infile);
  417.            halt;
  418.          end; { if Num... }
  419.          Vert := Nvread + 1;
  420.          for j := 1 to Num do
  421.          begin
  422.            Connection := round(Realvar[j]) + oldnnodes;
  423.            if (Connection<1) or (Connection>Nnodes+oldnnodes) then
  424.            begin
  425.              writeln ('Error in surface ',Surf,'(line ',Line_num,'): ');
  426.              writeln ('Connection #,',Vert,
  427.                       ' not in range 0..Nnodes (',Nnodes,')');
  428.              close (Infile);
  429.              halt;
  430.           end;
  431.           Connect[(Surf-1)*Maxvert+Vert] := Connection;
  432.           Vert := Vert + 1;
  433.         end;
  434.         Nvread := Nvread + Num;
  435.       end; { while }
  436.     end; { for Surf }
  437.   end
  438.   else
  439.   begin
  440.     if (Nnodes>MAXNODES) or (Nnodes<1) then
  441.        writeln('Nnodes (',Nnodes,') must be between 1 and ',MAXNODES);
  442.     if (Nsurf>MAXSURF) or (Nsurf<1) then
  443.        writeln('Nsurf (',Nsurf,') must be between 1 and ',MAXSURF);
  444.     if (Nmatl>MAXMATL) or (Nmatl<1) then
  445.        writeln('Nmatl (',Nmatl,') must be between 1 and ',MAXMATL);
  446.     if Maxvert*Nsurf>MAXCONNECT then
  447.     begin
  448.        writeln('Number of surfaces or max number of vertices too large!');
  449.        writeln('Maxvert (',Maxvert,') * Nsurf (',Nsurf,
  450.                ') must be smaller than ',MAXCONNECT);
  451.     end;
  452.     if (Nsides<1) or (Nsides>2) then
  453.         writeln('Nsides (',Nsides,') must be either 1 or 2');
  454.     close (Infile);
  455.     halt;
  456.   end; { if Nnodes... }
  457.   nmatl := nmatl + oldnmatl;
  458.   nnodes := nnodes + oldnnodes;
  459.   nsurf := nsurf + oldnsurf;
  460.   close (Infile);
  461.   readini (Filename);
  462. end; {with}
  463. end; { procedure READFILE }
  464.  
  465. procedure WRITEFILE (Filename: text80);
  466. { Write the new SURFMODL-format file }
  467.  
  468. var Outfile: text;              { file to write to }
  469.     Vert: integer;              { vertex # }
  470.     Node: integer;              { node # }
  471.     Mat: integer;               { material # }
  472.     Surf: integer;              { surface # }
  473.     Nvertex: integer;           { # vertices in surface }
  474.     Fileopen: boolean;          { flag opened file }
  475.     Yorn: char;                 { user response }
  476.  
  477. begin
  478. with ptra^ do with ptrb^ do
  479. with ptrc^ do with ptrg^ do
  480. with ptrh^ do with ptri^ do
  481. begin {with}
  482.   Fileopen := FALSE;
  483.   while (NOT Fileopen) do begin
  484.     assign (Outfile, Filename);
  485.     {$I-}
  486.     rewrite (Outfile);
  487.     {$I+}
  488.     if (ioresult <> 0) then begin
  489.       writeln ('Error opening output file ',Filename);
  490.       write ('Try again (Y or N)?');
  491.       readln (Yorn);
  492.       if (Yorn <> 'Y') and (Yorn <> 'y') then
  493.         halt;
  494.     end else
  495.       Fileopen := TRUE;
  496.   end; { while }
  497.  
  498.   writeln (Outfile, Flpurpose);
  499.   writeln (Outfile, 4);
  500.   writeln (Outfile, Nmatl,' ',Nnodes,' ',Nsurf,' ',Maxvert,' ',Nsides);
  501.  
  502.   for Mat := 1 to Nmatl do
  503.     writeln (Outfile, R1[Mat],' ',R2[Mat],' ',R3[Mat],' ',Color[Mat],' ',
  504.              Ambient[Mat]);
  505.  
  506.   for Node := 1 to Nnodes do
  507.     writeln (Outfile, xworld[Node]:9:4,' ',yWorld[Node]:9:4,' ',
  508.              zWorld[Node]:9:4);
  509.  
  510.   for Surf := 1 to Nsurf do begin
  511.     Nvertex := nvert[Surf];
  512.     write (Outfile, Nvertex,' ',Matl[Surf],' ');
  513.     for Vert := 1 to Nvertex do
  514.       write (Outfile, konnec (Surf, Vert),' ');
  515.     writeln (Outfile);
  516.   end; { for Surf }
  517.  
  518.   close (Outfile);
  519. end; {with ptr do}
  520. end; { procedure WRITEFILE }
  521.  
  522. { procedures SCALENODES, SHIFTNODES, and ROTATENODES }
  523. procedure SCALENODES (Firstnode, Lastnode: integer; Scale: vector);
  524. { Scale all nodes in this solid by the factors specified }
  525.  
  526. var Axis:       integer;  { axis to scale on }
  527.     Node:       integer;  { node # }
  528.  
  529. begin
  530. with ptra^ do with ptrb^ do with ptrc^ do
  531.   for Axis := 1 to 3 do
  532.     if (Scale[Axis] <> 0.0) and (Scale[Axis] <> 1.0) then
  533.       for Node := Firstnode to Lastnode do
  534.       case axis of
  535.       1 : xWorld[node] := xworld[node] * Scale[Axis];
  536.       2 : yWorld[node] := yworld[node] * Scale[Axis];
  537.       3 : zWorld[node] := zworld[node] * Scale[Axis];
  538.       end;
  539.       { for Node }
  540.     { if Scale... }
  541.   { for Axis }
  542. end; { procedure SCALENODES }
  543.  
  544. procedure Translate (Firstnode, Lastnode: integer; Shift: vector);
  545. { Shift all nodes in this solid by the vector specified }
  546.  
  547. var Axis:       integer;  { axis to scale on }
  548.     Node:       integer;  { node # }
  549.  
  550. begin
  551. with ptra^ do with ptrb^ do with ptrc^ do
  552.   for Axis := 1 to 3 do
  553.     if (Shift[Axis] <> 0.0) then
  554.       for Node := Firstnode to Lastnode do
  555.       case axis of
  556.         1 : xWorld[node] := xworld[node] + Shift[axis];
  557.         2 : yWorld[node] := yworld[node] + Shift[axis];
  558.         3 : zWorld[node] := zworld[node] + Shift[axis];
  559.       end;
  560.       { for Node }
  561.     { if Scale... }
  562.   { for Axis }
  563. end; { procedure translate }
  564.  
  565. function ATAN2 (Y, X: real): real;
  566. { returns the arc-tangent, in radians, of Y/X, in the range of -PI to PI. }
  567.  
  568. const PI = 3.141592654;
  569. begin
  570.   if (Y = 0.0) then begin
  571.     if (X >= 0.0) then
  572.       ATAN2 := 0.0
  573.     else
  574.       ATAN2 := PI;
  575.   end else if (Y > 0) then begin
  576.     if (X = 0.0) then
  577.       ATAN2 := PI / 2.0
  578.     else if (X > 0.0) then
  579.       ATAN2 := arctan (Y / X)
  580.     else
  581.       ATAN2 := PI - arctan (Y / -X);
  582.   end else begin
  583.     if (X = 0.0) then
  584.       ATAN2 := -PI / 2.0
  585.     else if (X > 0.0) then
  586.       ATAN2 := arctan (Y / X)
  587.     else
  588.       ATAN2 := -PI + arctan (Y/ X);
  589.   end; { if Y }
  590. end; { procedure ATAN2 }
  591.  
  592. procedure ROTATENODES (Firstnode, Lastnode: integer; Rotate: vector);
  593. { Rotate all nodes in this solid by the rotation vector specified }
  594.  
  595. var Anglerad:   real;     { angle in radians }
  596.     Node:       integer;  { node # }
  597.     Axis:       integer;  { axis to rotate about }
  598.     A1, A2:     integer;  { other two axes }
  599.     Dist:       real;     { distance to X,Y coord }
  600.     Theta2:     real;     { new angle, after rotating }
  601.  
  602. begin
  603.   with ptra^ do with ptrb^ do with ptrc^ do
  604.   for Axis := 1 to 3 do begin
  605.     if (Rotate[Axis] <> 0.0) then begin
  606.       { Convert degrees to radians }
  607.       Anglerad := 3.141592654 * Rotate[Axis] / 180.0;
  608.       for Node := Firstnode to Lastnode do begin
  609.         case Axis of
  610.         1: begin
  611.              Dist := sqrt (sqr(YWorld[node]) + sqr(ZWorld[Node]));
  612.              Theta2 := atan2 (ZWorld[Node], YWorld[Node]) + Anglerad;
  613.              YWorld[Node] := Dist * cos(Theta2);
  614.              ZWorld[Node] := Dist * sin(Theta2);
  615.            end;
  616.         2: begin
  617.              Dist := sqrt (sqr(ZWorld[node]) + sqr(xworld[Node]));
  618.              Theta2 := atan2 (xWorld[Node], zworld[Node]) + Anglerad;
  619.              ZWorld[Node] := Dist * cos(Theta2);
  620.              xWorld[Node] := Dist * sin(Theta2);
  621.            end;
  622.         3: begin
  623.              Dist := sqrt (sqr(xWorld[node]) + sqr(yworld[Node]));
  624.              Theta2 := atan2 (yWorld[Node], xworld[Node]) + Anglerad;
  625.              xWorld[Node] := Dist * cos(Theta2);
  626.              yWorld[Node] := Dist * sin(Theta2);
  627.            end;
  628.         end; { case Axis of }
  629.       end; { for Node }
  630.     end; { if Rotate[Axis] }
  631.   end; { for Axis }
  632. end; { procedure ROTATENODES }
  633.  
  634. procedure INITIAL;
  635. begin
  636.   new (ptra);     new (ptrb);     new (ptrc);     new (ptrg);
  637.   new (ptrh);     new (ptri);     new (ptrk);
  638.  
  639.   Line_num := 0;
  640.   curobj := 1;
  641.   maxvert := 10000;
  642.   Nnodes := 0;
  643.   Nsurf := 0;
  644.   NMATL := 0;
  645.   NNODES :=0;
  646.   nsurf :=0;
  647.   nsides := 2;
  648.   realmaxsurf := Maxsurf;
  649.   Inifile := ' ';
  650.   Fileread := FALSE;
  651.  
  652.   write (' Data file name ');
  653.   readln (filename);
  654.   readfile (filename);
  655.   nobj :=1;
  656.  
  657.   clipOn2d;
  658.   graphicsopen;
  659.   zoomcolour (12);
  660. end;  { procedure INITIAL }
  661.  
  662.  
  663. procedure BADSURF;
  664. { A bad surface was attempted to be plotted. Explain why and halt. }
  665. begin
  666.   graphicsclose;
  667.   msg (1,'Error: You have attempted to plot a concave surface.');
  668.   msg (2,'  This surface should be broken into at least two smaller');
  669.   msg (3,'  surfaces. Alternatively, you may possibly be able to');
  670.   msg (4,'  plot this surface anyway from a different angle or');
  671.   msg (5,'  with a lower magnification factor.');
  672.   halt;
  673. end;  { procedure BADSURF }
  674.  
  675. procedure drawimage(state:boolean);
  676. var
  677.    vert,surf,node1,node2 : integer;
  678.  
  679. begin
  680.   lineindex (black);
  681.   with ptra^ do with ptrb^ do with ptrc^ do with ptri^ do with ptrh^ do
  682.   begin
  683.     for surf := 1 to nsurf do
  684.     begin
  685.       if state = true then lineindex(color[ matl[surf] ]);
  686.       for vert := 1 to nvert[surf]-1 do
  687.       begin
  688.         node1 := konnec(surf,vert);
  689.         node2 := konnec(surf,vert+1);
  690.         case curwindow of
  691.           elevation:clip2d ( xworld[node1], yworld[node1],
  692.                              xworld[node2], yworld[node2]);
  693.           endview:  clip2d ( zworld[node1], yworld[node1],
  694.                              zworld[node2], yworld[node2]);
  695.           plan:     clip2d ( xworld[node1], zworld[node1],
  696.                              xworld[node2], zworld[node2]);
  697.         end; { case }
  698.       end; { for vert..}
  699.     end; { for surf...}
  700.  
  701.     node1 := konnec(surf,nvert[surf]);
  702.     node2 := konnec(surf,1);
  703.     case curwindow of
  704.       elevation:clip2d ( xworld[node1], yworld[node1],
  705.                          xworld[node2], yworld[node2]);
  706.       endview:  clip2d ( zworld[node1], yworld[node1],
  707.                          zworld[node2], yworld[node2]);
  708.       plan:     clip2d ( xworld[node1], zworld[node1],
  709.                          xworld[node2], zworld[node2]);
  710.    end; { case }
  711.   end;{ with ptr..}
  712. end; { Drawimage }
  713.  
  714. procedure selwindow (windo:windowtype);
  715. begin
  716.    case windo of
  717.    elevation :
  718.      begin
  719.        window (elevbotx,elevboty,elevtopx,elevtopy);
  720.        viewport (0,150,300,349);
  721.        curwindow := elevation;
  722.      end;
  723.    endview:
  724.      begin
  725.        window (endbotx,endboty,endtopx,endtopy);
  726.        viewport (310,150,600,349);
  727.        curwindow := endview;
  728.      end;
  729.    plan:
  730.      begin
  731.        window (planbotx,planboty,plantopx,plantopy);
  732.        viewport (0,0,300,145);
  733.        curwindow := plan;
  734.      end;
  735.   end; {case windo of..}
  736. end; { Selwindow }
  737.  
  738. procedure savewincoords;
  739. begin
  740.      case curwindow of
  741.      elevation:begin
  742.                  elevtopx := gxwxt;    elevbotx := gxwxb;
  743.                  elevtopy := gxwyt;    elevboty := gxwyb;
  744.                end;
  745.      endview:  begin
  746.                  endtopx := gxwxt;     endbotx := gxwxb;
  747.                  endtopy := gxwyt;     endboty := gxwyb;
  748.                end;
  749.     plan:      begin
  750.                  plantopx := gxwxt;    planbotx := gxwxb;
  751.                  plantopy := gxwyt;    planboty := gxwyb;
  752.                end;
  753.     end; {case}
  754.  
  755. end; { Savewincoords }
  756.  
  757. procedure resetwindow;
  758. var
  759.    i : integer;
  760. begin
  761.      max := 0; min := 0;
  762.      with ptra^ do with ptrb^ do with ptrc^ do
  763.      for i := 1 to nnodes do
  764.      begin
  765.           if xworld[i] > max then max := xworld[i];
  766.           if xworld[i] < min then min := xworld[i];
  767.  
  768.           if yworld[i] > max then max := yworld[i];
  769.           if yworld[i] < min then min := yworld[i];
  770.  
  771.           if zworld[i] > max then max := zworld[i];
  772.           if zworld[i] < min then min := zworld[i];
  773.      end;
  774.      elevtopx := max;    elevbotx := min;
  775.      elevtopy := max;    elevboty := min;
  776.      endtopx := max;     endbotx := min;
  777.      endtopy := max;     endboty := min;
  778.      plantopx := max;    planbotx := min;
  779.      plantopy := max;    planboty := min;
  780.  
  781. end; { Resetwindow }
  782.  
  783.  
  784.  
  785.  
  786.  
  787.  
  788.  
  789. {------------------------------------------------------------------------}
  790. {                     Editing section                                    }
  791. {------------------------------------------------------------------------}
  792.  
  793. procedure edit;
  794. var
  795.    ch:             char;
  796.    x, y,
  797.    xvdiff, yvdiff,
  798.    dxstep,dystep, xwdiff,
  799.    ywdiff, xlen, ylen,
  800.    Chx1,Chx2,Chy1,Chy2:      real;
  801.    i:                        integer;
  802.  
  803.   function worldpointnum (x,y:real): integer;
  804.   var
  805.      mindx, mindy,
  806.      dx,dy,x1,y1,x2,y2 : real;
  807.      i,minnumpts,numpts:       integer;
  808.  
  809.   begin
  810.      dx := xwdiff/2; minnumpts := nnodes;
  811.      dy := ywdiff/2; numpts    := nnodes;
  812.  
  813.      repeat
  814.        if minnumpts > numpts then
  815.        begin
  816.             minnumpts := numpts;
  817.             mindx     := dx;   mindy := dy;
  818.        end;
  819.  
  820.        dx := dx/2;         dy := dy/2;
  821.        x1 := x - dx;       x2 := x + dx;
  822.        y1 := y - dy;       y2 := y + dy;
  823.  
  824.        { draws concentric squares showing search area (interesting :-))
  825.        clip2d (x1,y1,x1,y2);
  826.        clip2d (x1,y2,x2,y2);
  827.        clip2d (x2,y2,x2,y1);
  828.        clip2d (x2,y1,x1,y1); }
  829.  
  830.        numpts := 0;
  831.        with ptra^ do with ptrb^ do with ptrc^ do
  832.        case curwindow of
  833.          elevation: for i := 1 to nnodes do
  834.                       if (xworld[i]>x1) and (xworld[i]<x2) and
  835.                          (yworld[i]>y1) and (yworld[i]<y2) then
  836.                          numpts := numpts +1;
  837.          endview:   for i := 1 to nnodes do
  838.                       if (zworld[i]>x1) and (zworld[i]<x2) and
  839.                          (yworld[i]>y1) and (yworld[i]<y2) then
  840.                          numpts := numpts +1;
  841.          plan:      for i := 1 to nnodes do
  842.                       if (xworld[i]>x1) and (xworld[i]<x2) and
  843.                          (zworld[i]>y1) and (zworld[i]<y2) then
  844.                          numpts := numpts +1;
  845.       end; { case }
  846.  
  847.       if numpts = 0 then
  848.       begin
  849.            dx := dx * 3;
  850.            dy := dy * 3;
  851.       end;
  852.  
  853.     until numpts > minnumpts;
  854.  
  855.     dy := mindy;
  856.     dx := mindx;
  857.     i := 1;
  858.  
  859.     with ptra^ do with ptrb^ do with ptrc^ do
  860.     case curwindow of
  861.       elevation: while not((xworld[i]>x1) and (xworld[i]<x2) and
  862.                            (yworld[i]>y1) and (yworld[i]<y2)) do
  863.                             i := i +1;
  864.       endview:   while not((zworld[i]>x1) and (zworld[i]<x2) and
  865.                            (yworld[i]>y1) and (yworld[i]<y2)) do
  866.                             i := i +1;
  867.       plan:      while not((xworld[i]>x1) and (xworld[i]<x2) and
  868.                            (zworld[i]>y1) and (zworld[i]<y2)) do
  869.                             i := i +1;
  870.    end; { case }
  871.  
  872.    gotoxy (45,19);
  873.    with ptra^ do with ptrb^ do with ptrc^ do
  874.    worldpointnum := i;
  875.  
  876.   end; { worldpointnum }
  877.  
  878.  
  879.   procedure crosshairs (x,y : real;colour: integer);
  880.   var c : integer;
  881.   begin
  882.      c := gxindex;
  883.      lineindex (colour);
  884.      clip2d (x-xlen, y, x+xlen, y);
  885.      clip2d (x, y-ylen, x, y+ylen);
  886.      lineindex (c);
  887.   end; { crosshairs }
  888.  
  889. begin { edit }
  890.      writemodexor;
  891.  
  892.      xwdiff := gxwxt - gxwxb;     ywdiff := gxwyt - gxwyb;
  893.      xvdiff := gxvxt - gxvxb;     yvdiff := gxvyt - gxvyb;
  894.      dxstep := xwdiff/xvdiff;     dystep := ywdiff/yvdiff;
  895.      xlen := dxstep*5;            ylen := dystep*5;
  896.  
  897.      ginenable;
  898.      gin (ch,chx1,chy1);
  899.      gindisable;
  900.  
  901.      i := worldpointnum(chx1,chy1);
  902.  
  903.      with ptra^ do with ptrb^ do with ptrc^ do
  904.      case curwindow of
  905.        elevation: crosshairs (xworld[i],yworld[i],red);
  906.        endview  : crosshairs (zworld[i],yworld[i],red);
  907.        plan     : crosshairs (xworld[i],zworld[i],red);
  908.      end; { case }
  909.  
  910.      msg (1,'Select new point'); msg (2,' ');
  911.      ginenable;
  912.      gin (Ch,Chx2,Chy2);
  913.      gindisable;
  914.  
  915.      with ptra^ do with ptrb^ do with ptrc^ do { erase cross hairs }
  916.      case curwindow of
  917.        elevation: crosshairs (xworld[i],yworld[i],red);
  918.        endview  : crosshairs (zworld[i],yworld[i],red);
  919.        plan     : crosshairs (xworld[i],zworld[i],red);
  920.      end; { case }
  921.  
  922.      writemodeset;
  923.  
  924.      drawimage(false);
  925.      with ptra^ do with ptrb^ do with ptrc^ do
  926.      case curwindow of
  927.        elevation: begin
  928.                     xworld[i] := chx2; yworld[i] := chy2;
  929.                   end;
  930.        endview  : begin
  931.                     zworld[i] := chx2; yworld[i] := chy2;
  932.                   end;
  933.        plan     : begin
  934.                     xworld[i] := chx2; zworld[i] := chy2;
  935.                   end;
  936.      end; { case }
  937.      drawimage(true);
  938.  
  939. end; { Edit }
  940.  
  941.  
  942.  
  943. begin { main }
  944.   initial;
  945.   resetwindow;
  946.   gxborderindex := blue;
  947.   for win := elevation to endview do
  948.   begin
  949.     selwindow (win);
  950.     drawimage(true);
  951.   end;
  952.   border(red);
  953.   repeat
  954.      msg (1,' select frame with arrow keys');
  955.      msg (2,' Zoom Edit Options Rotate');
  956.      msg (3,' Import Transform Magnify ');
  957.      msg (4,' Write');
  958.      repeat
  959.            ch := getch
  960.      until (ch in [up,down,left,right,esc]) or
  961.            (upcase(chr(ch)) in ['Z','E','O','R','M','I','T','W']);
  962.  
  963.      case ch of
  964.      up,left:begin
  965.                 border(blue);
  966.                 selwindow (elevation);
  967.                 border (red);
  968.            end;
  969.      right:  begin
  970.                 border(blue);
  971.                 selwindow (endview);
  972.                 border(red);
  973.            end;
  974.      down:   begin
  975.                 border(blue);
  976.                 selwindow (plan);
  977.                 border(red);
  978.            end;
  979.      end; { Case }
  980.      case upcase(ch) of
  981.      'Z': begin { z.... Zoom}
  982.             msg (1,'Zoom: Use arrow keys to move frame');
  983.             msg (2,'      +/- increase/decrease frame size');
  984.             msg (3,'      5 to accept chosen frame');
  985.             msg (4,'      7 to cancel');
  986.             zoompan;
  987.  
  988.             for i := 1 to 4 do msg (i,'');
  989.             tmptopx := gxwxt;    tmpbotx := gxwxb;
  990.             tmptopy := gxwyt;    tmpboty := gxwyb;
  991.  
  992.             case curwindow of
  993.                  elevation: selwindow(elevation);
  994.                  endview:   selwindow(endview);
  995.                  plan:      selwindow(plan);
  996.             end; { case }
  997.  
  998.             msg(1,'erasing');
  999.             drawimage(false);
  1000.             window(tmpbotx,tmpboty,tmptopx,tmptopy);
  1001.             savewincoords;
  1002.  
  1003.             border (red);
  1004.             msg (1,'drawing');
  1005.             drawimage(true);
  1006.         end; {Zoom}
  1007.     'E' : edit;
  1008.     'O' : begin { Options }
  1009.             msg (2,'');
  1010.             msg (1,'Options: Reset');
  1011.             repeat
  1012.               ch := getch;
  1013.             until ( ch in [esc]) or
  1014.                   ( upcase(chr(ch)) in ['R'] );
  1015.             case upcase(chr(ch)) of
  1016.             'R': begin { resetwindows}
  1017.                    graphics(0,-1);
  1018.                    resetwindow;
  1019.                    for win := elevation to endview do
  1020.                    begin
  1021.                      selwindow (win);
  1022.                      border(blue);
  1023.                      drawimage(true);
  1024.                    end;
  1025.                    border (red);
  1026.                  end;{ resetwindows }
  1027.            end; { case }
  1028.         end; { options }
  1029.     'R' : begin
  1030.             msg(2,''); msg(3,'');
  1031.             msg(1,'Rotate which object? ');
  1032.             gotoxy (67,16);
  1033.             write('(1..', nobj, ')');
  1034.             readln (curobj);
  1035.             if (curobj <> 0) then
  1036.             begin
  1037.               msg (1,'x,y,z angles ');
  1038.               gotoxy (56,16);
  1039.               i := inreal (infile,realvar,comment,0,true);
  1040.               if (i=3) and
  1041.               ((realvar[1]<>0) or (realvar[2]<>0) or (realvar[3]<>0)) then
  1042.               begin
  1043.                 rotate[1] := realvar[1];
  1044.                 rotate[2] := realvar[2];
  1045.                 rotate[3] := realvar[3];
  1046.  
  1047.                 msg (1,'Working....');
  1048.                 gxborderindex := blue;
  1049.                 for win := elevation to endview do
  1050.                 begin
  1051.                   selwindow (win);
  1052.                   drawimage(false);
  1053.                 end;
  1054.                 msg (2,'rotating....');
  1055.                 rotatenodes (firstnode[curobj],lastnode[curobj],rotate);
  1056.                 for win := elevation to endview do
  1057.                 begin
  1058.                   selwindow (win);
  1059.                   drawimage(true);
  1060.                 end;
  1061.                 border(red);
  1062.                 msg (1,' ');
  1063.               end;
  1064.             end;
  1065.           end;
  1066.     'I':begin
  1067.           msg(1,'Enter filename');
  1068.           msg(2,'');
  1069.           gotoxy (57,16);
  1070.           readln (filename);
  1071.  
  1072.           If not ( filename='') then
  1073.           begin
  1074.             if curobj <> maxobj then
  1075.             begin
  1076.               curobj:= curobj +1;
  1077.               nobj  := nobj + 1;
  1078.               readfile (filename);
  1079.             end
  1080.             else msg(5,'Too many objects');
  1081.  
  1082.          end;
  1083.        end;
  1084.     'T':begin
  1085.           msg(2,''); msg(3,'');
  1086.           msg(1,'Transform which object? ');
  1087.           gotoxy (67,16);
  1088.           write('(1..', nobj, ')');
  1089.           readln (curobj);
  1090.           if (curobj <> 0) then
  1091.           begin
  1092.             msg(1,'X,Y,Z transformation ?');
  1093.             gotoxy(65,16);
  1094.             i := inreal (infile,realvar,comment,0,true);
  1095.             if i>0 then
  1096.             begin
  1097.               trans[1] := realvar[1];
  1098.               trans[2] := realvar[2];
  1099.               trans[3] := realvar[3];
  1100.               translate ( firstnode[curobj],lastnode[curobj],trans)
  1101.             end;
  1102.           end;
  1103.         end;
  1104.     'M':begin
  1105.           msg(2,''); msg(3,'');
  1106.           msg(1,'Magnify which object? ');
  1107.           gotoxy (67,16);
  1108.           write('(1..', nobj, ')');
  1109.           readln (curobj);
  1110.           if (curobj <> 0) then
  1111.           begin
  1112.             msg(1,'X,Y,Z magnification ?');
  1113.             gotoxy(65,16);
  1114.             i := inreal (infile,realvar,comment,0,true);
  1115.             if i>0 then
  1116.             begin
  1117.               scale[1] := realvar[1];
  1118.               scale[2] := realvar[2];
  1119.               scale[3] := realvar[3];
  1120.               scalenodes ( firstnode[curobj],lastnode[curobj],scale)
  1121.             end;
  1122.           end;
  1123.         end;
  1124.     'W': begin
  1125.               msg(3,''); msg(2,''); msg(1,'Write : Filename?');
  1126.               gotoxy (41,17);
  1127.               readln (filename);
  1128.               if not (filename ='') then
  1129.                  writefile (filename);
  1130.          end;
  1131.     end; {case}
  1132.   until ch = esc;
  1133. graphicsclose;
  1134. end.{main}
  1135.