perm filename PATHS.SAI[S,AIL] blob sn#056472 filedate 1973-08-03 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00002 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	BEGIN "PATHS"
 00006 ENDMK
⊗;
BEGIN "PATHS"
 STRING A; INTEGER B; REAL X,Y,TH,IR,T1,T2,V;
 REAL FORTRAN PROCEDURE SIN(REAL X);
 REAL FORTRAN PROCEDURE COS(REAL X);
 REAL FORTRAN PROCEDURE ATAN2(REAL X,Y);
 REAL FORTRAN PROCEDURE ATAN(REAL X);
 REAL FORTRAN PROCEDURE SQRT(REAL X);

PROCEDURE CASE(STRING I); OUTSTR("CASE "&I&'12&'15);

REAL PROCEDURE TRIANG(REAL Y,X);
 BEGIN REAL Z;
  Z←ATAN2(Y,X);
  RETURN(IF Z<0.0 THEN Z+6.2831852 ELSE Z);
 END;

 PROCEDURE PATH(REAL X,Y,TH; REFERENCE REAL IR,T1,T2);
 IF X=0. AND TH=0. THEN
  BEGIN
    CASE("0-0");
   IR←0.;
   T1←T2←Y/(2.*V);
   RETURN;
  END
 ELSE
  BEGIN
   REAL CT,ST,CTP1,IRV;
   CT←COS(TH);
   ST←SIN(TH);
   CTP1←CT+1.0;
   IF ABS(TH)<0.1 THEN
    IF ABS(X)<2.*ABS(TH*Y) THEN
     BEGIN REAL YTH;
    CASE("SMALL X, SMALL TH");
      YTH←Y*TH;
      IR←2.0*YTH*YTH-4.0*X*YTH+4.0*X*X;
      IR←TH*TH/(-2.0*X+YTH+SQRT(IR));
     END
    ELSE
     BEGIN REAL Q,Q2;
    CASE("BIG X,SMALL TH");
       Q←Y/X; Q2←Q*Q;
       IR←4.-TH*(2.*Q-TH*(Q2/4.-3./4.));
       IR←X*IR/(X*X+Y*Y);
     END
   ELSE
    BEGIN REAL OMCT,STSQ;
   CASE("BIG X,BIG TH");
    OMCT←1.0-CT;
    STSQ←ST*ST;
    IR←(STSQ+2.0*OMCT)*Y*Y-2.0*CTP1*ST*X*Y+(4.0-STSQ)*X*X;
    IR←2.0*OMCT/(Y*ST-X*CTP1+SQRT(IR));
    END;
   IRV←IR*V;
   T1←TRIANG(IR*Y+ST,CTP1-IR*X)/IRV;
   T2←T1-TH/IRV;
   RETURN;
  END;

 PROCEDURE SCOUT(REAL X,Y,TH; REFERENCE REAL IR,T1,T2);
  BEGIN
   PATH(X,Y,TH,IR,T1,T2);
   IF T1<0. ∨ T2<0. THEN
    BEGIN
    PATH(-X,Y,-TH,IR,T1,T2);
    IR←-IR;
    END;
   RETURN;
  END;

RECURSIVE  PROCEDURE BACK(REAL IR,T1,T2; REFERENCE REAL X,Y,TH);
  BEGIN
   TH←IR*V*(T1-T2);
   X←(1.0+COS(TH)-2.0*COS(V*T1*IR))/IR;
   Y←(2.0*SIN(V*T1*IR)-SIN(TH))/IR;
   RETURN;
  END;

 V←2.0;
 SETFORMAT(8,2);
 WHILE TRUE DO
  BEGIN
  OUTSTR("X Y TH: ");
  A←INCHWL;
  X←REALSCAN(A,B);
  Y←REALSCAN(A,B);
  TH←REALSCAN(A,B)*3.141593/180.;
  SCOUT(X,Y,TH,IR,T1,T2);
  BACK(IR,T1,T2,X,Y,TH);
  TH←TH*180./3.141593;
  OUTSTR("       X       Y      TH       R      T1      T2"&'12&'15
	&CVF(X)&CVF(Y)&CVF(TH)&CVF(1.0/IR)&CVF(T1)&CVF(T2)&'12&'15&'12&'15);
  END;
END;