Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!
!COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION


%ACTUAL TOP LEVEL FUNCTION...THE MODULE CODE WHICH CALLS IT IS AT 
 THE END OF THE FILE%

FUNCTION OVLPLT=
BEGIN
	TMP1_GETSON(ROOT<ZZ>,0,0);
	IF .TMP1 EQL 0 THEN (DOABORT);
	SELFDATA(ROOT)
	SUBTREE(ROOT<ZZ>);
	BRKAPART(ROOT<ZZ>);
	SELTREE2P(ROOT<ZZ>);
	RETURN;
END;

FUNCTION SUBTREE(SELF)=
BEGIN
    MACRO NEWSON=TMP2$;
    REGISTER SON;
    MAP BASE SELF:SON:NEWSON;
    LOCAL IDX;

	IDX_0;
	WHILE 1 DO
	BEGIN
	    ALLOC(TMP1,AMTNODE)
	    NEWSON_GETSON(.TMP1,.SELF[LNKNODE],.IDX);
	    IF .NEWSON NEQ 0
	    THEN BEGIN
		IF .IDX EQL 0
		THEN SELF[ASON]_.TMP1
		ELSE SON[BROTHER]_.TMP1;
		SON_.TMP1;
		SELFDATA(SON)
		SUBTREE(.SON);
	    END
	    ELSE BEGIN
		IF .IDX EQL 0
		THEN SELF[MYWT]_1.0;
		RETURN;
	    END;

	    SELF[MYWT]_.SON[MYWT] PLUS .SELF[MYWT];
	    IDX_.IDX+1;
	END;
    RETURN;	%CANNOT BE REACHED%
END;

FUNCTION BRKAPART(MEMSELF)=
BEGIN

% FUNCTION CONSISTS OF 3 PHASES:
1) RECURSIVELY BRKAPART ANY SON WHOSE WEIGHT IS GTR THAN MAX
2) CREATE SUB-TREES FOR ALL SONS SUCH THAT BRKQAD>SONWT>MAXWT
3) IF PREV. 2 STEPS NOT SUFFICIENT, TAKE LARGEST & SUCCESSIVELY SMALLER
   SONS LEFT AND MAKE SUB-TREES OUT OF THEM.
   IF SELF WEIGHT STILL TOO LARGE, BREAK UP TRAPEZOIDALLY
%

	REGISTER SON,SELF,SELFWT,NXOFPRV;
	MAP 	BASE SELF:SON;
	MACRO RESTRETWT=(SELF[MYWT]_.SELFWT; RETURN(.SELFWT))$;

	SELF_.MEMSELF;
	SELFWT_.SELF[MYWT];

%PHASE 1%
	SON_.SELF[ASON];
	WHILE .SON NEQ 0 DO
	BEGIN
	    IF .SON[MYWT] GTR .MAXWT
	    THEN BEGIN
		SELFWT_.SELFWT SUB .SON[MYWT];
		SELFWT_.SELFWT PLUS BRKAPART(.SON);
	    END;
	    SON_.SON[BROTHER];
	END;

	IF .SELFWT LEQ .MAXWT
	THEN RESTRETWT;

%PHASE 2%
	NXOFPRV_SELF[ASON]<ZZ>;
	SON_.SELF[ASON];

	WHILE .SON NEQ 0 DO
	BEGIN
		IF .SON[MYWT] GTR .BRKQAD
		THEN BEGIN
		    SELFWT_.SELFWT SUB .SON[MYWT] PLUS 1.0;
		    SON_MAKTREE(DIAMOND,.SON,.NXOFPRV,.SON[MYWT]);
		    IF .SELFWT LEQ .MAXWT
		    THEN RESTRETWT;
		END;
		NXOFPRV_SON[BROTHER]<ZZ>;
		SON_.SON[BROTHER];	%NOTE THAT THIS WORKS WHEN IF SATISFIED BECAUSE MAKTREE
					RESETS ALL POINTERS%
	END;

%PHASE 3%
	WHILE 1 DO
	BEGIN
	    MACRO MAXNOP=TMP1$,MAXSON=TMP2$;	%NOTE THAT THESE TWO ARE
						GARBAGE AFTER THE 2 FUNCTION REFS%
	    MAP BASE MAXSON;
	    MAXSON_TRAPSON<ZZ>;
	    NXOFPRV_SELF[ASON]<ZZ>;
	    SON_.SELF[ASON];
	    WHILE .SON NEQ 0 DO
	    BEGIN
		IF .SON[MYWT] GTR .MAXSON[MYWT]
		THEN (MAXSON_.SON; MAXNOP_.NXOFPRV);
		NXOFPRV_SON[BROTHER]<ZZ>;
		SON_.SON[BROTHER];
	    END;

	    IF .MAXSON EQL TRAPSON<ZZ>
	    THEN BEGIN
		SELF[MYWT]_.SELFWT;	%TRAPBRK WILL ADJUST SELF[MYWT]--GET IT UP TO DATE%
		DO TRAPBRK(.SELF)  UNTIL .SELF[MYWT] LEQ .MAXWT;
		RETURN(.SELF[MYWT]);
	    END;

	    SELFWT_.SELFWT SUB .MAXSON[MYWT] PLUS 1.0;
%TAKES ADVAN OF VAL PASSING--MAXSON AND MAXNOP%
	    SON_MAKTREE(DIAMOND,.MAXSON,.MAXNOP,.MAXSON[MYWT]);
	    IF .SELFWT LEQ .MAXWT 
	    THEN RESTRETWT;
	END;
    RETURN;
END;

FUNCTION PLTTREE(SELF,WIDTH,OFFST,XSON,YSELF)=
BEGIN
	REGISTER SON;
	LOCAL SONWIDTH,XCOM,YSON;
	MAP 	BASE SELF:SON;

	IF .XSON GTR .XMAX THEN XMAX_.XSON;
	SON_.SELF[ASON];
	XCOM_.XSON SUB ((.XINCR SUB .SIDE) MUL 0.667);
	SONWIDTH_(.SON[MYWT] DVIDE .SELF[MYWT]) MUL .WIDTH;
	YSON_.OFFST PLUS .SONWIDTH DVIDE 2.0;
	IF .LPBUF NEQ PLTDIAG
	THEN PLTLINE(.XSON SUB .XINCR PLUS .SIDE, .YSELF, .XCOM, .YSELF);

	WHILE .SON NEQ 0 DO
	BEGIN
	    SONWIDTH_(.SON[MYWT] DVIDE .SELF[MYWT]) MUL .WIDTH;
	    TMP2_.OFFST PLUS .SONWIDTH DVIDE 2.0;
	    IF .LPBUF EQL PLTDIAG
	    THEN PLTLINE(.XSON SUB .XINCR PLUS .SIDE, .YSELF, .XSON, .TMP2)
	    ELSE BEGIN
		PLTLINE(.XCOM, .YSON, .XCOM, .TMP2);
		PLTLINE(.XCOM, .TMP2, .XSON, .TMP2);
	    END;
	    YSON_.TMP2;
	    PLTPOLY(.XSON, .YSON, .SON[NAMLEN], .SON[LNUM], .SON[LNAME], .SON[1+LNAME]);

	    IF .SON[ASON] NEQ 0
	    THEN PLTTREE(.SON,.SONWIDTH,.OFFST,.XSON PLUS .XINCR,.YSON);
	    OFFST_.OFFST PLUS .SONWIDTH;
	    SON_.SON[BROTHER];
	END;
	RETURN; %THE FORM OF THE WHILE AND THIS, ENDS THE RECURSION%
END;

FUNCTION TRAPBRK(SELF)=
BEGIN
	MACRO TRAPWT=TMP2$;
	REGISTER SON,NXOFPRV;
	LOCAL MAXTRP,RMSON;
	MAP BASE SELF:SON:NXOFPRV;

	TMP1_2.0;
	DO BEGIN
	    MAXTRP_.SELF[MYWT] DVIDE .TMP1;
	    TMP1_.TMP1 PLUS 1.0;
	END WHILE .MAXTRP GTR .MAXWT;

%	THIS IF-STAT CONSTITUTES A SIMPLE HEURISTIC FOR HELPING TREES LOOK PRETTY%

	IF .MAXTRP PLUS 2.0 GTR .MAXWT 
	THEN MAXTRP_.MAXWT
	ELSE MAXTRP_.MAXTRP PLUS 1.0;

	SON_.SELF[ASON];
	NXOFPRV_SELF[ASON]<ZZ>;
	TRAPWT_0;
	% RMSON NO INIT SINCE AT LEAST 1 SON%

	LETR_'A';	%TRAP NODES ARE PUT OUT AS 1A,1B,1C,...%
	WHILE .SON NEQ 0 DO
	BEGIN
	    IF .TRAPWT PLUS .SON[MYWT] GTR .MAXTRP
	    THEN BEGIN
		SELF[MYWT]_.SELF[MYWT] SUB .TRAPWT PLUS 1.0;
		NXOFPRV_MAKTREE(TRAPZOID,.RMSON,.NXOFPRV,.TRAPWT);	%MAKTR RETURNS THE NEW LEAF%

		NXOFPRV_NXOFPRV[BROTHER]<ZZ>;
		TRAPWT_.SON[MYWT];
	    END
	    ELSE TRAPWT_.TRAPWT PLUS .SON[MYWT];
	    RMSON_.SON;
	    SON_.SON[BROTHER];
	END;
	IF .TRAPWT GTR .TRAPSON[MYWT]
	THEN BEGIN
		SELF[MYWT]_.SELF[MYWT] SUB .TRAPWT PLUS 1.0;
		NXOFPRV_MAKTREE(TRAPZOID,.RMSON,.NXOFPRV,.TRAPWT);
	END;
	NAME[TRAPZOID]_.NAME[TRAPZOID] PLUS 1.0;

	RETURN;
END;

FUNCTION MAKTREE(TYPE,FWDSELF,PREV,WEIT)=
BEGIN
    MAP BASE FWDSELF:PREV:TMP1:TMP2;

%NEW "ROOT"%
	ALLOC(TMP1,AMTNODE)
	TMP1[MYWT]_.WEIT;
	TMP1[LNUM]_.TYPE;
	TMP1[ASON][email protected];
	TMP2_.TMP1;	%WILL BE NEEDED FOR LNKNODE%

%NEW LEAF%
	ALLOC(TMP1,AMTNODE)
	TMP1[LNUM]_.TYPE;
	TMP1[MYWT]_1.0;
	TMP1[BROTHER]_.FWDSELF[BROTHER];
	TMP1[LNKNODE]_.TMP2;	%THE TREE SPAWNED BY PSEUDO LEAF IS
				CHAINED THRU THIS MECH RATHER THAN SON MECH%
	PREV[NEXT]_.TMP1;

%SUPPLANTED SON%
	FWDSELF[BROTHER]_0;

%NAME PROCESSING--COMMON TO BOTH%

	TMP2[LNAME]_TMP1[LNAME]_.NAME[.TYPE];
	IF .TYPE EQL DIAMOND
	THEN BEGIN
	    NAME[DIAMOND]_.NAME[DIAMOND] PLUS 1.0;
	END
	ELSE BEGIN
		TMP2[1+LNAME]_TMP1[1+LNAME]_.LETR;
		LETR_.LETR + 1^29;
	END;

	RETURN(.TMP1);
END;

FUNCTION SELTREE2P(CUROOT)=
BEGIN

%THIS FUNCTION AND FNDLEAVES HAVE A FUNNY RECURSIVE INTERACTION--
THE RECURSION IS CAUSED BY THE LOWER LEVEL FUNCTION FNDLEAVES.
THIS 2-LEVEL APPROACH IS NECESSARY BECAUSE (SUBTREE) ROOTS MUST BE
DISTINGUISHED FROM ALL OTHER NODES SO THAT THE SUBTREES CAN BE
PLOTTED IN THE MOST INTUITIVE ORDER%
%AFTER PLOTTING A TREE-- THIS PROG CALLS FNDLEAVES TO SEE IF THE CURRENT
TREE IS CHAINED TO ANY OTHER TREES%

	REGISTER BASE TRI;

	MACRO INCHO2=TMP2$;

	INCHO2_.INCHES DVIDE 2.0;
	XMAX_.XMAX PLUS 3.0;
	IF .LPBUF NEQ 0 THEN PLTINIT(.XMAX, 0);
	TRI_.CUROOT;
	PLTPOLY(.XMAX, .INCHO2, .TRI[NAMLEN], .TRI[LNUM], .TRI[LNAME], .TRI[1+LNAME]);
	PLTTREE(.TRI,.INCHES,0,.XMAX PLUS .XINCR, .INCHO2);
	CLEANUP(.TRI);
	IF .LPBUF NEQ 0 THEN LPTOUT();	%WITHIN PLOTTER PACK%

	FNDLEAVES(.CUROOT);
	RETURN;
END;

FUNCTION FNDLEAVES(SELF)=
BEGIN
	REGISTER SON;
	MAP BASE SELF:SON;

	SON_.SELF[ASON];
	WHILE .SON NEQ 0 DO
	BEGIN
	    IF .SON[ASON] EQL 0
	    THEN IF .SON[LNUM] GEQ DIAMOND
		 THEN SELTREE2P(.SON[LNKNODE])
		 ELSE
	    ELSE FNDLEAVES(.SON);
	    SON_.SON[BROTHER];
	END;
	RETURN;
END;


FUNCTION CLEANUP(SELF)=
BEGIN
	REGISTER SON;
	MAP BASE SELF:SON;

	SON_.SELF[ASON];
	WHILE .SON NEQ 0 DO 
	BEGIN
	CLEANUP(.SON);
	SON_.SON[BROTHER];
	END;

	DEALLOC(SELF,AMTNODE)
	RETURN;
END;

FUNCTION TASCII(WHERE,BYTES)=
BEGIN
	REGISTER C,WORDS[2];
	LOCAL INBYTES,OUTBYTES;
	MAP BASE WHERE;

	INBYTES_WORDS<36,6>;
	WORDS[0]_.WHERE[0,WHOLE];
	WORDS[1]_.WHERE[1,WHOLE];
	OUTBYTES_(.WHERE)<36,7>;
	DECR LEN FROM .BYTES-1 TO 0 DO
	BEGIN
		ILDB(C,INBYTES);
		C_.C+#40;
		IDPB(C,OUTBYTES);
	END;
	RETURN;
END;

!***********************************************************

%	THE TOP-LEVEL CODE	%

	MACRO RATIO=TMP2$;

	INCHES_FLOAT(.INCHES);
	MAXWT_FLOAT(.LEAVES);
	BRKQAD_.MAXWT MUL NOCHECK;
	TRAPSON[MYWT]_.MAXWT MUL TRPCHECK;
	IF .TRAPSON[MYWT] LSS 2.0 THEN TRAPSON[MYWT]_2.0;
	RATIO _ .INCHES DVIDE .MAXWT;
	TOP_ITOP MUL .RATIO;
	SIDE_ISIDE MUL .RATIO;
	XINCR_IXINCR MUL .RATIO;
	STEPS _ FLOAT(.STEPS);
	PLTORIG(.TOP, .SIDE, .INCHES);
	IF .ERRFND EQL -1 THEN (DOABORT);

	NAME[DIAMOND]_NAME[TRAPZOID]_1.0;
	XMAX_0;
	OVLPLT();
	SREG<RIGHT>_.FREG<RIGHT>;	%A KLUDGE TO GET STACK RIGHT%
	POPJ(#17,0)	!RETURN TO LINK
END ELUDOM;