Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/calsim.sim
There is 1 other file named calsim.sim in the archive. Click here to see a list.
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;
	IF k = 0 THEN
	BEGIN   pltfile:- NEW Outfile("PLT:");
	    GO TO print
	IF k > 0 THEN
	    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;
	    INSPECT pltfile DO
	    BEGIN   Outchar('1');    Outreal(x,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;
		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);
	Outint(n,3);   Outimage;
	Outfix(h,3,6);   Outfix(theta,1,6);   Outreal(f,10,16);
    END of number;

    PROCEDURE Line(xa,ya,npts,inc,lintyp,inteq);
    NAME inteq;   TEXT inteq;
    ARRAY xa,ya;   INTEGER npts,inc,lintyp;
	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];
	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;
	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;

    NAME ibcd;
    TEXT ibcd;   REAL xpage,ypage,axlen,angle,firstv,deltav;
    INTEGER nchar;
	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
	    IF Mod(i,2) = 0 THEN
	    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;
	    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;
	    xt:= xt + (3.0*cth-0.8*sth)*0.14*c;
	    yt:= yt + (3.0*sth+0.8*cth)*0.14*c;
	    nt:= nt - 1;
	END i-loop;
	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
	    calcmp(xn,yn,99,1);	calcmp(xn+dxb,yn+dyb,99,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;
	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
	    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;
	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
	    is_:= i;
	    IF save[i] >= deltav THEN GO TO label50;
	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 -
	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;