home *** CD-ROM | disk | FTP | other *** search
/ The Party 1994: Try This At Home / disk_image.bin / source / gallery / subdirs.exe / MAP / TPATH.PAS < prev   
Pascal/Delphi Source File  |  1993-07-19  |  4KB  |  181 lines
  1.  
  2. {$N+}
  3. type real=single;
  4.  
  5. type TPoint = array[0..2] of real;
  6.      TSplineFac = array[0..3] of real;
  7.  
  8. var NumPts, SelPt : integer;
  9.     P : array[1..1000] of TPoint;
  10.     Le: array[1..1000] of real;
  11.  
  12.     PTnum : integer;
  13.     PT: array[1..100] of TPoint;
  14.  
  15. procedure LoadPoints(s:string);
  16. var f : file;
  17.     i : integer;
  18. begin
  19.   assign(f,s); reset(f,1);
  20.   blockread(f,SelPt,2);
  21.   blockread(f,NumPts,2);
  22.   blockread(f,P,NumPts*SizeOf(TPoint));
  23.   close(f);
  24. end;
  25.  
  26.  
  27. procedure SplineFac( var F : TSplineFac; xm1,x0,x1,x2 : real );
  28. begin
  29.   F[0] := (xm1+4*x0+x1)/6;
  30.   F[1] := (-xm1+x1)/2;
  31.   F[2] := (xm1+x1)/2-x0;
  32.   F[3] := (-xm1+3*(x0-x1)+x2)/6;
  33. end;
  34.  
  35. procedure CalculateLengths;
  36. var L : real;
  37.     i,j,k : integer;
  38.     F : array[0..1] of TSplineFac;
  39.     t,dx,dy : real;
  40. begin
  41.   L := 0;
  42.   Le[2] := L;
  43.  
  44.   for i := 2 to NumPts-2 do begin
  45.  
  46.     for j := 0 to 1 do begin
  47.       SplineFac( F[j], P[i-1,j], P[i,j], P[i+1,j], P[i+2,j] );
  48.     end;
  49.  
  50.     for k := 0 to 19 do begin
  51.       t := k/20;
  52.       dx := F[0,1]+t*(2*F[0,2]+t*3*F[0,3]);
  53.       dy := F[1,1]+t*(2*F[1,2]+t*3*F[1,3]);
  54.       L := L + sqrt(sqr(dx)+sqr(dy))/20;
  55.     end;
  56.  
  57.     Le[i+1]:= L;
  58.     writeln('punto ',i:4,'  T = ',P[i,2],' L = ',L);
  59.   end;
  60.  
  61.   Le[NumPts-1] := L;
  62.   Le[NumPts] := L;
  63. end;
  64.  
  65.  
  66. procedure MakeSpeedCurve;
  67. var i : integer;
  68. begin
  69.   PTnum := 0;
  70.   PT[1,0] := 0; PT[1,1] := 0;  { force time := 0; length := 0 }
  71.   PT[2] := PT[1];
  72.   PTnum := 3;
  73.   for i := 2 to NumPts-2 do
  74.     if P[i,2]<>-1 then begin
  75.       PT[PTnum,0] := P[i,2];
  76.       PT[PTnum,1] := Le[i];
  77.       inc(PTnum);
  78.   end;
  79.   PT[PTnum]   := PT[PTnum-1];
  80.   inc(PTnum);
  81.   PT[PTnum] := PT[PTnum-2];
  82. end;
  83.  
  84.  
  85. var Iname, Oname : string;
  86.  
  87. procedure OutputTimed;
  88. var O : Text;
  89.     LT : array[0..1] of TSplineFac;
  90.     Q,dQ : TPoint;
  91.     i,j,k : integer;
  92.     s,tt,ll : real;
  93.     C : longint;
  94.  
  95.   procedure FindPos( l : real; var Q, dQ : Tpoint );
  96.   var i,j,k : integer;
  97.       t,m,xx,yy,dx,dy : real;
  98.       F : array[0..1] of TSplineFac;
  99.   begin
  100.     i := 1;
  101.     while (Le[i+1]<l) and (i<NumPts-2) do inc(i);
  102.  
  103.     for j := 0 to 1 do begin
  104.       SplineFac( F[j], P[i-1,j], P[i,j], P[i+1,j], P[i+2,j] );
  105.     end;
  106.  
  107.     m := Le[i];
  108.     t := 0;
  109.     k := 1;
  110.     while (m<l) do begin
  111.       t := k/200;
  112.       dx := F[0,1]+t*(2*F[0,2]+t*3*F[0,3]);
  113.       dy := F[1,1]+t*(2*F[1,2]+t*3*F[1,3]);
  114.       m := m + sqrt(sqr(dx)+sqr(dy))/200;
  115.       inc(k);
  116.     end;
  117.     xx := F[0,0]+t*(F[0,1]+t*(F[0,2]+t*F[0,3]));
  118.     yy := F[1,0]+t*(F[1,1]+t*(F[1,2]+t*F[1,3]));
  119.  
  120.      Q[0] := xx;   Q[1] := yy;
  121.     dQ[0] := dx;  dQ[1] := dy;
  122.   end;
  123.  
  124.  
  125.   Function Angle(dQ:Tpoint) : real;
  126.   var a : real;
  127.   begin
  128.    if dQ[0]=0 then dQ[0] := dQ[1]/1E6;
  129.    a := ArcTan( -dQ[1]/dQ[0] );
  130.    if dQ[0]>0 then a := a+PI else if dQ[1]<0 then a := a + 2*PI;
  131.    Angle := a*180/PI;
  132.   end;
  133.  
  134. begin
  135.   assign(O, Oname); rewrite(O);
  136.  
  137.   C := 0;
  138.   tt := 0;
  139.   write(O,tt:9:3,' ',(64-P[1,0]):10:6,' ',P[1,1]:10:6,' ');
  140.  
  141.   for i := 2 to PTnum-2 do begin
  142.  
  143.     for j := 0 to 1 do
  144.       SplineFac( LT[j], PT[i-1,j], PT[i,j], PT[i+1,j], PT[i+2,j] );
  145.  
  146.     for k := 0 to 19 do begin
  147.       s := k/20;
  148.       tt := LT[0,0]+s*(LT[0,1]+s*(LT[0,2]+s*LT[0,3]));
  149.       ll := LT[1,0]+s*(LT[1,1]+s*(LT[1,2]+s*LT[1,3]));
  150.       FindPos(ll, Q, dQ);
  151.       if C=0 then writeln(O,Angle(dQ):7:3);
  152.       writeln(O,tt:9:3,' ',(64-Q[0]):10:6,' ',Q[1]:10:6,' ',Angle(dQ):7:3);
  153.       inc(C);
  154.     end;
  155.  
  156.   end;
  157.  
  158.   close(O);
  159. end;
  160.  
  161.  
  162. BEGIN
  163.   writeln('TPATH - synchro fit for PPATH data files // A.R-M. 7/93');
  164.   writeln;
  165.   if paramcount<2 then begin
  166.     writeln('Usage: TPATH InputFile OutputFile');
  167.     Halt(1);
  168.   end;
  169.  
  170.   Iname := ParamStr(1);
  171.   Oname := ParamStr(2);
  172.  
  173.   LoadPoints(Iname);
  174.   CalculateLengths;
  175.  
  176.   MakeSpeedCurve;
  177.  
  178.   OutputTimed;
  179.  
  180. END.
  181.