home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / GRAPHICS / PLOT / SURFUTI3.ZIP / FUNC2SUR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-01-23  |  3.4 KB  |  130 lines
  1. program Func2Surf (input,output);
  2. uses crt;
  3. { Program ported from Basic to TurboPascal by Stefan Kaufmann
  4.   Adress: S. Kaufmann, UNM407 at DBNUAMA1.BITNET
  5.           University of Bonn, West Germany
  6.  
  7.   The program does only the basic conversions like in the BASIC-Version.
  8.   The first line of the raw 3D-DATA file must contain the GridSize,
  9.   all other lines consist of x,y,z coordinates.
  10.  
  11.   Bonn, Nov. 1987, Stefan Kaufmann                                            }
  12.  
  13.  
  14. VAR INFIL,OUTFIL       : TEXT {[7000]}; { SPEED IT UP!! }
  15.     FNCF,FNIF          : STRING [64]; { PATH MAY BE GIVEN ... }
  16.     xtics,ytics        : integer;
  17.     GridNodes,Surfaces : integer;
  18.     R1,R2              : real;
  19.     Color              : integer;
  20.     Script,Materials   : integer;
  21.     Sides,Vertices     : integer;
  22.     DataVersion        : integer;
  23.     xc,yc,i,j          : integer;
  24.     x,y,z              : real;
  25.     C1,C2,N1,N2,N3,N4  : integer;
  26.     LINE               : STRING [255];
  27.  
  28.  
  29. begin
  30. clrscr;
  31. writeln ('Converting Raw 3D - DATA to SurfModl-Format');
  32. writeln;
  33. writeln ('ported from the Basic-version to TurboPascal by Stefan Kaufmann');
  34. writeln;
  35. writeln ('send any kind of note to:  S. Kaufmann, UNM407 at DBNUAMA1.BITNET');
  36. writeln;
  37. writeln;
  38. if (paramcount <> 2) then
  39.   begin
  40.   write ('FileName InputFile : ');
  41.   readln ( FNIF );
  42.   write ('FileName Converted Data : ');
  43.   readln (FNCF);
  44.   end
  45. else
  46.   begin
  47.   FNIF := paramstr(1);
  48.   FNCF := paramstr(2);
  49.   end;
  50.  
  51. writeln;
  52. writeln ('Attaching Files ...');
  53. assign (InFil,FNIF);
  54. reset (InFil);
  55. assign (OutFil,FNCF);
  56. rewrite (OutFil);
  57.  
  58. writeln ('Setting default parameters ...');
  59. DataVersion := 2;
  60. Materials   := 1;
  61. Script      := 0;
  62. Vertices    := 4;
  63. Sides       := 2;
  64. R1          := 1.0;
  65. R2          := 1.0;
  66. Color       := 3;
  67. C1          := 4;
  68. C2          := 1;
  69.  
  70. write ('Reading GridSize ...');
  71. readln  (InFil,xtics,ytics);
  72. writeln (xtics:4,ytics:4);
  73.  
  74. writeln ('Calculating GridNodes and Surfaces ... ');
  75. GridNodes   := (xtics * ytics);
  76. Surfaces    := ((xtics - 1) * (ytics - 1));
  77.  
  78. writeln ('Writing Parameters ...');
  79. writeln (OutFil,'SurfModl - Data - File  [',FNCF,']');
  80. writeln (OutFil,DataVersion:6);
  81. writeln (OutFil,Materials:6,GridNodes:6,Surfaces:6,Script:6,Vertices:6,Sides:6);
  82. writeln (OutFil,R1:10:6,R2:10:6,Color:6);
  83.  
  84. writeln;
  85. write ('Moving Data between ',FNIF,' and ',FNCF,' ... ');
  86. xc := WhereX;
  87. yc := WhereY;
  88.  
  89. for i:=1 to xtics do
  90.   begin
  91.   gotoxy(xc,yc);
  92.   clreol;
  93.   write(i);
  94.   for j:=1 to ytics do
  95.     begin
  96.     readln (InFil,line);            { Moving Data line by line is quicker   }
  97.     writeln (OutFil,line);          { than readln(x,y,z) and writeln(x,y,z) }
  98.     end;
  99.   end;
  100.  
  101. writeln;
  102. writeln;
  103. writeln ('Closing ',FNIF,' ...');
  104. close (InFil);
  105.  
  106. write ('Calculating Surface connectivity ... ');
  107. xc := WhereX;
  108. yc := WhereY;
  109. for i:=1 to (xtics-1) do
  110.   begin
  111.   gotoxy(xc,yc);
  112.   clreol;
  113.   write(i);
  114.   for j:=1 to (ytics-1) do
  115.     begin
  116.     N1 := (I-1)*ytics + j;            { N1 .. N4 = NodeNo. for Vertices }
  117.     N2 := (I-1)*ytics + j + 1;
  118.     N3 := (I)  *ytics + j + 1;
  119.     N4 := (I)  *ytics + j;
  120.     writeln (OutFil,C1:6,C2:6,N1:6,N2:6,N3:6,N4:6);  { C1 = Number of Vertices}
  121.     end;                                             { C2 = Materialconst. }
  122.   end;
  123.  
  124. writeln;
  125. writeln;
  126. writeln ('Closing ',FNCF,' ...');
  127. close (OutFil);
  128. writeln ('done');
  129. end.
  130.