Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/23/calsim.sim
There is 1 other file named calsim.sim in the archive. Click here to see a list.
OPTIONS(/E/C/-Q/-A/-I/-D);
CLASS calsim;
BEGIN INTEGER izet,izorg,izz;
REAL xorg,yorg,xfact,yfact,x0,y0,ln10;
ARRAY save[1:7];
REF (Outfile) pltfile;
PROCEDURE calcmp(x,y,iz,k); NAME x,y,iz; REAL x,y;
INTEGER iz,k;
BEGIN
IF k = 0 THEN
BEGIN pltfile:- NEW Outfile("PLT:");
pltfile.Open(Blanks(32));
GO TO print
END ELSE
IF k > 0 THEN
BEGIN
IF k = 1 THEN BEGIN x0:= x; y0:= y;
izz:= iz END ELSE
IF k = 7 THEN izet:= iz ELSE
IF k = 3 THEN BEGIN xorg:= x; yorg:= y;
izorg:= iz END ELSE
IF k = 4 THEN BEGIN xfact:= x; yfact:= y END;
print:
INSPECT pltfile DO
BEGIN Outchar('1'); Outreal(x,5,11);
Outreal(y,5,11);
Outint(iz,4); Outint(k,2); Outimage;
IF k = 2 AND iz = 9000 THEN Close;
END inspect
END k > 0 ELSE
IF k = -7 THEN iz:= izet ELSE
IF k = -3 THEN BEGIN x:= xorg; y:= yorg;
iz:= izorg END ELSE
IF k = -4 THEN BEGIN x:= xfact; y:= yfact END ELSE
IF k = -1 THEN BEGIN x:= x0; y:= y0;
iz:= izz END ELSE
IF k = -2 OR k = -8 THEN GO TO print;
END of calcmp;
PROCEDURE symbol(x,y,h,itext,theta,n); NAME itext;
REAL x,y,h,theta;
TEXT itext; INTEGER n;
BEGIN TEXT t;
t:- Copy(itext);
INSPECT pltfile DO
BEGIN Outchar('2'); Outreal(x,5,11); Outreal(y,5,11);
IF n > 0 THEN n:= t.Length;
Outint(n,4); Outimage;
IF n < 0 THEN
BEGIN Outfix(h,3,6); Outfix(theta,1,6);
Outint(Mod(t.Getint,128),3); Outimage;
END ELSE
BEGIN
IF n = 0 AND t.Length >= 1 THEN t:- t.Sub(1,1);
Outfix(h,3,6); Outfix(theta,1,6);
IF t.Length > 20 THEN
BEGIN Outtext(t.Sub(1,20));
t:- t.Sub(21,t.Length-20) END;
WHILE t.Length > 30 DO
BEGIN Outtext(t.Sub(1,30));
t:- t.Sub(31,t.Length-30) END;
Outtext(t); Outimage
END n >= 0
END inspect
END of symbol;
PROCEDURE number(x,y,h,f,theta,n);
REAL x,y,h,f,theta; INTEGER n;
INSPECT pltfile DO
BEGIN Outchar('3'); Outreal(x,5,11);
Outreal(y,5,11);
Outint(n,3); Outimage;
Outfix(h,3,6); Outfix(theta,1,6); Outreal(f,10,16);
Outimage
END of number;
PROCEDURE Line(xa,ya,npts,inc,lintyp,inteq);
NAME inteq; TEXT inteq;
ARRAY xa,ya; INTEGER npts,inc,lintyp;
BEGIN
INTEGER
lmin,ldx,nl,ipen,icode,nt,ldy,nf,na,kk,ipena,icodea,lsw,i;
REAL firstx,deltax,firsty,deltay,df,xn,yn,dl;
REAL PROCEDURE amax1(a,b); REAL a,b;
amax1:= IF a > b THEN a ELSE b;
lmin:= npts*inc + 1; ldx:= lmin + inc;
nl:= lmin - inc;
firstx:= xa[lmin]; deltax:= xa[ldx];
firsty:= ya[lmin]; deltay:= ya[ldy];
calcmp(xn,yn,izz,-1);
df:= amax1( Abs((xa[1]-firstx)/deltax-xn),
Abs((ya[1]-firsty)/deltay-yn) );
dl:= amax1( Abs((xa[1]-firstx)/deltax-xn),
Abs((ya[1]-firsty)/deltay-yn) );
ipen:= 0; icode:= -1;
nt:= Abs(lintyp);
IF lintyp NE 0 THEN GO TO label7;
label6: nt:= 1;
label7: IF dl >= df THEN GO TO label9;
label8: nf:= nl; na:= ((npts-1)//nt)*nt + nt - (npts-1);
kk:= -inc;
GO TO label10;
label9: nf:= 1; na:= nt; kk:= inc;
label10:
GO TO IF lintyp < 0 THEN label11 ELSE IF lintyp = 0 THEN
label12 ELSE label13;
label11: ipena:= 0; icodea:= -1; lsw:= 1; GO TO label15;
label12: na:= ldx;
label13: ipena:= 99; icodea:= -2; lsw:= 0;
label15: FOR i:= 1 STEP 1 UNTIL npts DO
BEGIN xn:= (xa[nf]-firstx)/deltax;
yn:= (ya[nf]-firsty)/deltay;
GO TO IF na > nt THEN label22 ELSE IF na = nt THEN
label21 ELSE label20;
label20: GO TO IF lsw = 0 THEN label22 ELSE label23;
label21: symbol(xn,yn,0.2,inteq,0,icode);
na:= 1; GO TO label25;
label22: calcmp(xn,yn,ipen,1);
label23: na:= na + 1;
label25: nf:= nf + kk; icode:= icodea;
label30: ipen:= ipena;
END i-loop;
END of line;
PROCEDURE
axis(xpage,ypage,ibcd,nchar,axlen,angle,firstv,deltav);
NAME ibcd;
TEXT ibcd; REAL xpage,ypage,axlen,angle,firstv,deltav;
INTEGER nchar;
BEGIN
INTEGER i,kn,ntic,nt;
REAL c,a,ex,adx,xval,cth,sth,dxb,dyb,z,xt,yt,xn,yn;
c:= 2.54; kn:= nchar; a:= 1.0;
IF kn >= 0 THEN GO TO label2;
label1: a:= -a; kn:= -kn;
label2: ex:= 0.0; adx:= Abs(deltav);
IF adx = 0 THEN GO TO label7;
label3: IF adx < 99.0 THEN GO TO label6;
label4: adx:= adx/10.0; ex:= ex + 1.0; GO TO label3;
label5: adx:= adx*10.0; ex:= ex - 1.0;
label6: IF adx < 0.01 THEN GO TO label5;
label7: xval:= firstv*10.0**(-ex);
adx:= deltav*10.0**(-ex);
sth:= angle*0.0174533; cth:= Cos(sth); sth:= Sin(sth);
dxb:= -0.1*c; dyb:= 0.15*a - 0.05; dyb:= dyb*c;
xn:= xpage+dxb*cth-dyb*sth; yn:= ypage+dyb*cth+dxb*sth;
ntic:= axlen + 1.0; nt:= ntic//2;
FOR i:= 1 STEP 1 UNTIL ntic DO
BEGIN
IF Mod(i,2) = 0 THEN
number(xn,yn,0.105*c,xval,angle,2);
xval:= xval + adx; xn:= xn + cth; yn:= yn + sth;
IF nt NE 0 THEN GO TO label20;
label11: z:= kn; IF ex = 0 THEN GO TO label13;
label12: z:= z + 7.0; z:= z*c;
label13: dxb:= -0.07*z + axlen/2;
dyb:= 0.325*a-0.075; dyb:= dyb*c;
xt:= xpage+dxb*cth-dyb*sth; yt:= ypage+dyb*cth+dxb*sth;
symbol(xt,yt,0.14*c,ibcd,angle,kn);
IF ex = 0 THEN GO TO label20;
label14: z:= kn + 2; xt:= xt+z*cth*0.14*c;
yt:= yt+z*sth*0.14*c;
symbol(xt,yt,0.14*c,"1550938112",angle,3);
xt:= xt + (3.0*cth-0.8*sth)*0.14*c;
yt:= yt + (3.0*sth+0.8*cth)*0.14*c;
number(xt,yt,0.07*c,ex,angle,-1);
label20:
nt:= nt - 1;
END i-loop;
calcmp(xpage+axlen*cth,ypage+axlen*sth,0,1);
dxb:= -0.07*a*sth*c; dyb:= 0.07*a*cth*c;
a:= ntic - 1; xn:= xpage + a*cth; yn:= ypage + a*sth;
FOR i:= 1 STEP 1 UNTIL ntic DO
BEGIN
calcmp(xn,yn,99,1); calcmp(xn+dxb,yn+dyb,99,1);
calcmp(xn,yn,0,1);
xn:= xn - cth; yn:= yn - sth;
END i-loop;
END of axis;
PROCEDURE scale(arr,axlen,npts,inc); ARRAY arr;
REAL axlen;
INTEGER npts,inc;
BEGIN
INTEGER i,k,n,is_;
REAL fad,ys,firstv,deltav,p,t,yn,y0;
fad:= 0.01; k:= Abs(inc); n:= npts*k;
y0:= arr[1]; yn:= y0;
FOR i:= 1 STEP k UNTIL n DO
BEGIN
ys:= arr[i];
IF y0 <= ys THEN GO TO label22;
label21: y0:= ys; GO TO label25;
label22: IF ys <= yn THEN GO TO label25;
label24: yn:= ys;
label25:
END i-loop;
firstv:= 0;
IF y0 >= 0 THEN GO TO label35;
label34: fad:= fad - 1.0;
label35: deltav:= (yn-firstv)/axlen;
IF deltav <= 0 THEN
BEGIN deltav:= 2.0*firstv;
deltav:= Abs(deltav/axlen) + 1.0 END;
label40: i:= Ln(deltav)/ln10 + 1000.0;
p:= 10.0**(i-1000); deltav:= deltav/p - 0.01;
FOR i:= 1 STEP 1 UNTIL 6 DO
BEGIN
is_:= i;
IF save[i] >= deltav THEN GO TO label50;
label45:
END of i-loop;
label50: deltav:= save[is_]*p;
firstv:= p*Entier(y0/p+fad);
t:= firstv+(axlen+0.01)*deltav;
IF t >= yn THEN GO TO label57;
label56: is_:= is_ + 1; GO TO label50;
label57: firstv:= firstv -
Entier((axlen+(firstv-yn)/deltav)/2.0)*deltav;
IF y0*firstv > 0 THEN GO TO label59;
label58: firstv:= 0;
label59: IF inc > 0 THEN GO TO label65;
label61: firstv:= firstv + Entier(axlen+0.5)*deltav;
deltav:= -deltav;
label65: n:= n + 1; arr[n]:= firstv;
n:= n + k; arr[n]:= deltav;
END of scale;
save[1]:= 1; save[2]:= 2.0; save[3]:= 4.0;
save[4]:= 5.0; save[5]:= 8.0; save[6]:= 10.0;
save[7]:= 20.0;
izet:= 16; xfact:= yfact:= 1.0; ln10:= Ln(10.0&&0);
END of calsim;