perm filename III.OLD[GEM,BGB] blob sn#036851 filedate 1973-04-25 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	III DISPLAY SUBROUTINES-BGB-JANUARY 1973----------------------
C00005 00003	SUBR(OCTDPY)INTEGER ----------------------------------------------
C00006 00004	SUBR(DECDPY)INTEGER ----------------------------------------------
C00008 00005	SUBR(IIIDPY)WINDOW,GLASS -----------------------------------------
C00011 00006	VERNIER III TEXT POSITIONING.
C00013 00007	SUBR(FDPY)F-------------------------------------------------------
C00015 00008	SUBR(IDPY)NODE----------------------------------------------------
C00017 ENDMK
C⊗;
;III DISPLAY SUBROUTINES-BGB-JANUARY 1973----------------------
	A←1↔B←2↔C←3
INTERN BUFDPY↔BUFDPY:.+2↔=100↔BLOCK =100
INTERN DPYBUF↔DPYBUF:DPYBU.↔=2048 ↔ DPYBU.: BLOCK =2048
	IGNORE:0↔DPYPTR:0↔BUFEND:0
	BUFHD:0↔0;UPG ARGUMENT. ;ADDRESS ↔ LENGTH.
;--------------------------------------------------------------
INTERN DPYSET,DPYOUT,DPYBRT,AIVECT,AVECT,RIVECT,RVECT,DPYSTR,DTYO,DPYBIG
DPYSET:	LAC 1,ARG1↔CDR 2,-1(1)	;BUFFER SIZE.
	ADDI 2,-1(1)↔DAC 2,BUFEND
	ADDI 1,2↔DAC 1,BUFHD	;POINT TO THIRD WORD.
	SETZM IGNORE
CLR2:	LAC A,BUFHD↔LACI B,1↔DAC B,1(A)
	LACI B,2(A)↔LIPI B,1(A)↔BLT B,@BUFEND
	PUSH P,(P)↔GO LV3
;--------------------------------------------------------------
DPYBIG:	SKIPE IGNORE↔POP1J
	LAC A,ARG1↔LACI C,46↔DPB A,[POINT 3,3,27]
	PUSH P,(P)↔GO LV2

DPYBRT:	SKIPE IGNORE↔POP1J
	LAC 1,ARG1↔LACI C,46↔DPB A,[POINT 3,3,24]
	PUSH P,(P)↔GO LV2
;--------------------------------------------------------------
RIVECT: SKIPA C,[46]
RVECT:	LACI C,6
	GO LV0
AIVECT:	SKIPA C,[146]	;INVISIBLE ABSOLUTE.
AVECT:	LACI C,106
LV0:	SKIPGE IGNORE↔POP2J
LV:	LAC A,ARG2↔LAC B,ARG1
LVC:	DPB A,[POINT 11,C,10]
	DPB B,[POINT 11,C,21]
LV2:	AOS A,DPYPTR↔DAC C,(A)
LV3:	LIPI A,<(<POINT 7,0,35>)>
	DAC A,DPYPTR↔LACI A,(A)
	CAML A,BUFEND↔SETOM IGNORE
	POP2J
;--------------------------------------------------------------
DPYSTR:	LAC 3,ARG1↔LIPI 3,440700
	ILDB 3↔JUMPE POP1J.
	CALL(DTYO,0)↔GO DPYSTR+2

DTYO:	LAC 1,ARG1↔IDPB 1,DPYPTR
	CDR 1,DPYPTR↔CAML 1,BUFEND
	SETOM IGNORE↔POP1J
;--------------------------------------------------------------
DPYOUT:	SKIPN 1,BUFHD↔GO .+6
	LAC 2,DPYPTR↔DAC 2,-2(1)
	LACI 2,2(2)↔SUB 2,1↔DAC 2,-1(1)
	CDR B,DPYPTR↔SUB B,BUFHD
	AOS B↔DAC B,BUFHD+1
	LAC 1,ARG1↔DPB A,[POINT 4,.+1,12]↔703B8+BUFHD
	POP1J
;--------------------------------------------------------------
SUBR(OCTDPY)INTEGER ----------------------------------------------
BEGIN OCTDPY; OCTAL NUMBER DISPLAY.
	Q←←15 ↔ N←←13
	SKIPA↔GO L2
	LAC 14,ARG1↔LAC Q,[POINT 3,14,-1]↔LACI N,6
L1:	ILDB Q↔IORI 60↔CALL(DTYO,0)↔SOJG N,L1
	CALL(DTYO,[" "])
L2:	LAC 14,ARG1↔LAC Q,[POINT 3,14,17]↔LACI N,6
L3:	ILDB Q↔IORI 60↔CALL(DTYO,0)↔SOJG N,L3
	POP1J
BEND OCTDPY; BGB 25 MARCH 1973 -----------------------------------
SUBR(DECDPY)INTEGER ----------------------------------------------
BEGIN DECDPY; DECIMAL NUMBER DISPLAY.
	LAC 1,ARG1↔POP P,ARG1	        ;GET ARG AND ADJUST STACK.
L1:	JUMPGE 1,L2			;TEST FOR NEGATIVE NUMBER.
	MOVM 2,1↔CALL(DTYO,["-"])	;PRINT MINUS SIGN.
	LAC 1,2
L2:	IDIVI 1,12↔PUSH P,2		;MODULO TEN AND SAVE.
	SKIPE 1↔PUSHJ P,L2		;TEST FOR DONE.
	POP P,1↔ADDI 1,60↔CALL(DTYO,1)	;RESTORE & PRINT.
	POP0J
BEND DECDPY; BGB 17 DECEMBER 1973 --------------------------------

SUBR(FLODPY)FLONUM,PLACES ----------------------------------------
BEGIN FLODPY; FLOATING NUMBER DISPLAY.
	LAC ARG2↔JUMPL[CALL(DTYO,["-"])↔LACM ARG2↔GO .+1]
	LACM 2,ARG1↔CAILE 2,6↔LACI 2,6↔DAC 2,ARG1
	FMPR[1.↔10.↔100.↔1000.↔10000.↔100000.↔1000000.](2)↔FIXX
	IDIV[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
	PUSH P,1↔CALL(DECDPY,0)↔POP P,0↔LAC 2,ARG1
	ADD[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
	PUSH P,DPYPTR↔CALL(DECDPY,0)↔POP P,1
	LACI "."↔IDPB 0,1↔POP2J↔LIT
BEND FLODPY; BGB 17 DECEMBER 1973 --------------------------------
SUBR(IIIDPY)WINDOW,GLASS -----------------------------------------
BEGIN IIIDPY; DISPLAY DEVICE ROUTINE.
	E←←16
	T←←15
	TBIT1←←1B18	;UNTIL IT'S DEFINED IN 'N.FAI'

;DISPLAY WINDOW FRAME.
	LAC 1,ARG2
	NIP 1(1)↔DAC XL			;PICK UP 2D CLIPPER WINDOW
	NAP 1(1)↔DAC XH
	NIP 2(1)↔DAC YL
	NAP 2(1)↔DAC YH
	CALL(DPYSET,DPYBUF)		;NEW POG
	CALL(AIVECT,XL,YL)		;MAKE A BOARDER
	CALL(AVECT,XH,YL)
	CALL(AVECT,XH,YH)
	CALL(AVECT,XL,YH)
	CALL(AVECT,XL,YL)

;DISPLAY THE VISIBLE EDGE LIST.
	LAC E,ARG2
	ALT2 E,E			;GET THE WORLD.
	JUMPE E,L3			;NOTHING THERE, RETURN
	PED E,E↔SKIPA			;FIRST EDGE OF WORLD.
L1:	ALT2 E,E↔JUMPE E,L3		;GET AN EDGE.
	X1DC 1,E↔Y1DC 2,E
	CALL(AIVECT,1,2)
	X2DC 1,E↔Y2DC 2,E
	CALL(AVECT,1,2)
	PVT 1,E
	CALL DPYTXT
L2:	NVT 1,E
	CALL DPYTXT
	GO L1

L3:	CALL(DPYOUT,ARG1)
	POP2J

DPYTXT:	TEST 1,NSEW+TBIT1	;IF INVISIBLE, THEN SKIP THIS ONE
	POP0J
	PTEXT T,1		;GET TJOINT OR TEXT OF VERTEX
	JUMPE T,[POP0J]		;NOTHING THERE
	TESTZ T,VBIT↔POP0J	;IF IT'S A TJOINT
	MARK 1,TBIT1
	XDC 0,1↔FIXX 0,		;GET READY FOR AIVECT
	YDC 1,1↔FIXX 1,		;GET READY FOR AIVECT
	CALL AIVECT,0,1
	MOVEI 0,1(T)
	CALL DPYSTR,0
	POP0J

	DECLARE{XL,XH,YL,YH}
BEND IIIDPY; BGB 5 FEB 1973 --------------------------------------
;VERNIER III TEXT POSITIONING.
	VERNX ←← 14
	VERNY ←← 11
SUBR(VDPY)V-------------------------------------------------------
BEGIN VDPY;SPECIAL VERTEX DISPLAY - BGB - 9 JANUARY 1973.
	LAC 1,ARG1↔CAR 0,(1)↔ANDI 0,017400	;NSEW & PZZ.
	SKIPE↔POP1J
	XDC 0,1↔FIXX↔SUBI VERNX↔PUSH P,0
	YDC 0,1↔FIXX↔SUBI VERNY↔PUSH P,0↔PUSHJ P,AIVECT
	CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
	CALL(IDPY,ARG1)
	CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
	POP1J
BEND;2/9/73-------------------------------------------------------

SUBR(EDPY)E-------------------------------------------------------
BEGIN EDPY;SPECIAL EDGE DISPLAY - BGB - 9 FEBRUARY 1973.
	CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
	LAC 2,ARG1
	PVT 1,2↔CAR 0,(1)↔ANDI 0,017400↔JUMPN L1
	XDC 0,1↔FIXX↔DAC X↔PUSH P,0
	YDC 0,1↔FIXX↔DAC Y↔PUSH P,0
	PUSH P,ARG1↔PUSH P,ARG1
	PUSHJ P,AIVECT
	CALL(DTYO,["+"])↔CALL(AIVECT)
L1:	LAC 2,ARG1
	NVT 1,2↔CAR 0,(1)↔ANDI 0,017400↔JUMPN L2
	XDC 0,1↔FIXX↔ADDM X↔PUSH P,0
	YDC 0,1↔FIXX↔ADDM Y↔PUSH P,0↔PUSHJ P,AVECT
	CALL(DTYO,["-"])
L2:	LAC 2,ARG1
	LAC X↔ASH -1↔PUSH P,0
	LAC Y↔ASH -1↔PUSH P,0
	CALL(AIVECT)↔CALL(IDPY,ARG1)
	CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
	POP1J
DECLARE{X,Y}
BEND;2/9/73-------------------------------------------------------

SUBR(FDPY)F-------------------------------------------------------
BEGIN FDPY;SPECIAL FACE DISPLAY - BGB - 9 FEBRUARY 1973.
	EXTERN ECCW
	LAC 1,ARG1↔DAC 1,F
	TEST 1,FBIT↔POP1J
	PED 2,1↔DAC 2,E↔DAC 2,E0
	SETZM I
	CALL(DPYBIG,[1])
	CALL(DPYBRT,[3])
	SKIPN E↔GO[LAC 1,F↔PFACE 1,1↔PVT 1,1↔GO VDPY+1]
L1:	AOS I↔LAC 2,E↔TEST 2,VISIBLE↔GO L2
	X1DC 0,2↔DAC 0,X
	Y1DC 1,2↔DAC 1,Y
	CALL(AIVECT,0,1)↔LAC 2,E
	X2DC 0,2↔ADDM 0,X
	Y2DC 1,2↔ADDM 1,Y
	CALL(AVECT,0,1)
	LAC 0,X↔ASH 0,-1↔SUBI 0,VERNX
	LAC 1,Y↔ASH 1,-1↔SUBI 1,VERNY
	CALL(AIVECT,0,1)
	CALL(DECDPY,I)
L2:	CALL(ECCW,E,F)
	CAMN 1,E↔GO L3↔DAC 1,E
	CAME 1,E0↔GO L1
L3:	CALL(DPYBRT,[2])
	CALL(DPYBIG,[2])
	POP1J
	DECLARE{F,E,E0,X,Y,I}
BEND;2/9/73-------------------------------------------------------
SUBR(IDPY)NODE----------------------------------------------------
BEGIN IDPY; IDENTIFIER DISPLAY.
	EXTERN CAMERA
	EXTERN NTYPE
	CALL(NTYPE,ARG1)↔CAIGE 1,$BODY↔GO L5
	LAC 1,ARG1↔SETZ 2,
	TESTZ 1,BBIT↔GO[
		SKIPE 13,-2(1)↔GO[
		LAC 14,-1(1)↔DZM 15
		CALL(DPYSTR,[13])↔POP1J]
	L1:	CW 1,1↔TESTZ 1,BBIT↔AOJA 2,L1
		AOS 2↔PUSH P,2↔CALL(DTYO,["B"])
		CALL(DECDPY)↔POP1J]
	TESTZ 1,FBIT↔GO[
	L2:	NFACE 1,1↔TESTZ 1,FBIT↔AOJA 2,L2
		AOS 2↔PUSH P,2↔CALL(DTYO,["F"])
		CALL(DECDPY)↔POP1J]
	TESTZ 1,EBIT↔GO[
	L3:	NED 1,1↔TESTZ 1,EBIT↔AOJA 2,L3
		AOS 2↔PUSH P,2↔CALL(DTYO,["E"])
		CALL(DECDPY)↔POP1J]
	TESTZ 1,VBIT↔GO[
	L4:	NVT 1,1↔TESTZ 1,VBIT↔AOJA 2,L4
		AOS 2↔PUSH P,2↔CALL(DTYO,["V"])
		CALL(DECDPY)↔POP1J]

L5:	PUSH P,NNAMES(1)↔EXTERN NNAMES
	CALL(DPYSTR)

	LAC 1,ARG1↔CAMN 1,UNIVERSE↔POP1J
	$TYPE 2,1↔DZM 5			    ;NODE - TYPE - COUNT.
	LAC 3,UNIVERSE↔SON 3,3↔DAC 3,4		;SON0 - SON.
	CAME 1,4↔GO[$TYPE 0,4↔CAMN 0,2↔AOS 5↔SIS 4,4
		CAME 3,4↔GO .-1↔GO .+1]↔AOS 5
	CALL(DECDPY,5)
	POP1J
BEND IDPY; BGB 4 FEBRUARY 1973 -----------------------------------
END