perm filename GEOMES[GEM,BGB] blob sn#032395 filedate 1973-03-30 generic text, type T, neo UTF8
00100	TITLE GEOMES  -  GEOMETRIC MODELING EMBEDDED IN SAIL - BGB 1973.
00200	;-----------------------------------------------------------------
00300	;AD HOC TOP LEVEL OF GEOMES - TEMPORARY VERSION FOR RUSS TAYLOR.
00400		INTERN UNIVER,BLKCNT,AVAIL,CAMERA
00500		UNIVER:	0	;POINTER TO THE UNIVERSE NODE.
00600		BLKCNT: 0	;NUMBER OF NODES IN USE.
00700		AVAIL:	0	;POINTER TO EMPTY NODE LIST.
00800		NODSIZ←←=12	;NUMBER OF WORDS PER NODE.
00900		CAMERA:0↔WINDOW:0	;WHICH ARE HERE AND SHOULDN'T BE.
01000	
01100	SUBR(MKNODE)TYPE--------------------------------------------------
01200	BEGIN MAKE; ALLOCATE A BLOCK OF NODSIZ WORDS - BGB - 4 DEC 1972.
01300		SKIPE AVAIL
01400		SKIPN 1,@AVAIL↔CALL(MORCOR)
01500		CDR -3(1)↔DAP @AVAIL
01600		DZM -3(1)↔AOS @BLKCNT
01700		POP P,.+3↔POP P,(1)↔GO @.+1↔0
01800	BEND;1/12/73------------------------------------------------------
01900	
02000	SUBR(KLNODE)NODE--------------------------------------------------
02100	BEGIN KILL; - RELEASE  BLOCK OF NODSIZ WORDS - BGB - 4 DEC 1972.
02200		LAC 1,ARG1
02300		SOS @BLKCNT
02400		LIPI -3(1)↔LAPI -2(1)
02500		SETZM -3(1)↔BLT 8(1)    	;CLEAR NODE.
02600		LAC@AVAIL↔DAPZ -3(1)
02700		DAPZ 1,@AVAIL
02800		POP1J
02900	BEND;1/12/73------------------------------------------------------
     

00100	SUBR(MORCOR)------------------------------------------------------
00200	BEGIN MORCOR; - GET MORE CORE FROM SAIL - BGB - 8 MARCH 1972.
00300		EXTERN CORGET
00400	
00500		PUSH P,2↔PUSH P,3
00600		SETZ 2,
00700	L1:	LACI 3,NODSIZ*=400		;AC3 SIZE OF SPACE.
00800		CALL(CORGET)			;AC2 ADDRESS OF SPACE.
00900		GO[FATAL(NO MORE CORE.)]
01000		SLACI(2)↔LAPI 1(2)↔DZM(2)
01100		BLT NODSIZ*=400-1(2)		;CLEAR BLOCK OF MEMORY.
01200		LACI 1,3(2)			;ORIGIN OF FIRST NODE.
01300	
01400	;INITIALIZE THE UNIVERSE WHEN NECESSARY.
01500		SKIPE UNIVER↔GO L3
01600		LACI -2(1)↔DAC AVAIL		;POINTER TO AVAIL LIST.
01700		LACI -1(1)↔DAC BLKCNT		;POINTER TO NODE COUNT.
01800		DAC 1,UNIVERSE			;POINTER TO UNIVERSE NODE.
01900	
02000	;MAKE AVAIL LIST.
02100	L3:	DIP 1,1
02200		ADD 1,[XWD NODSIZ,0]
02300		SKIPN@BLKCNT↔GO[
02400			ADD 1,[XWD NODSIZ,NODSIZ]     ;STEP OVER UNIVERSE.
02500			AOS@BLKCNT↔SUBI 3,NODSIZ↔GO .+1]
02600		SUBI 3,NODSIZ
02700		DAPZ 1,@AVAIL
02800	
02900	;PLACE EACH NEW EMPTY BLOCK ON THE AVAIL LIST.
03000	L2:	HLRZM 1,-3(1)			;EMPTY LIST POINTER.
03100		ADD 1,[XWD NODSIZ,NODSIZ]
03200		SUBI 3,NODSIZ
03300		JUMPN 3,L2
03400	
03500		LAC 1,@AVAIL
03600		POP P,3↔POP P,2
03700		POP0J
03800	
03900	BEND;1/12/73------------------------------------------------------
     

00100	;III DISPLAY SUBROUTINES-BGB-JANUARY 1973----------------------
00200		A←1↔B←2↔C←3
00300	INTERN BUFDPY↔BUFDPY:.+2↔=100↔BLOCK =100
00400	INTERN DPYBUF↔DPYBUF:DPYBU.↔=2048 ↔ DPYBU.: BLOCK =2048
00500		IGNORE:0↔DPYPTR:0↔BUFEND:0
00600		BUFHD:0↔0;UPG ARGUMENT. ;ADDRESS ↔ LENGTH.
00700	;--------------------------------------------------------------
00800	INTERN DPYSET,DPYOUT,DPYBRT,AIVECT,AVECT,DPYSTR,DTYO,DPYBIG
00900	DPYSET:	LAC 1,ARG1↔CDR 2,-1(1)	;BUFFER SIZE.
01000		ADDI 2,-1(1)↔DAC 2,BUFEND
01100		ADDI 1,2↔DAC 1,BUFHD	;POINT TO THIRD WORD.
01200		SETZM IGNORE
01300	CLR2:	LAC A,BUFHD↔LACI B,1↔DAC B,1(A)
01400		LACI B,2(A)↔LIPI B,1(A)↔BLT B,@BUFEND
01500		PUSH P,(P)↔GO LV3
01600	;--------------------------------------------------------------
01700	DPYBIG:	SKIPE IGNORE↔POP1J
01800		LAC A,ARG1↔LACI C,46↔DPB A,[POINT 3,3,27]
01900		PUSH P,(P)↔GO LV2
02000	
02100	DPYBRT:	SKIPE IGNORE↔POP1J
02200		LAC 1,ARG1↔LACI C,46↔DPB A,[POINT 3,3,24]
02300		PUSH P,(P)↔GO LV2
02400	;--------------------------------------------------------------
02500	AIVECT:	SKIPA C,[146]	;INVISIBLE ABSOLUTE.
02600	AVECT:	LACI C,106
02700		SKIPGE IGNORE↔POP2J
02800	LV:	LAC A,ARG2↔LAC B,ARG1
02900	LVC:	DPB A,[POINT 11,C,10]
03000		DPB B,[POINT 11,C,21]
03100	LV2:	AOS A,DPYPTR↔DAC C,(A)
03200	LV3:	LIPI A,<(<POINT 7,0,35>)>
03300		DAC A,DPYPTR↔LACI A,(A)
03400		CAML A,BUFEND↔SETOM IGNORE
03500		POP2J
03600	;--------------------------------------------------------------
03700	DPYSTR:	LAC 3,ARG1↔LIPI 3,440700
03800		ILDB 3↔JUMPE POP1J.
03900		CALL(DTYO,0)↔GO DPYSTR+2
04000	
04100	DTYO:	LAC 1,ARG1↔IDPB 1,DPYPTR
04200		CDR 1,DPYPTR↔CAML 1,BUFEND
04300		SETOM IGNORE↔POP1J
04400	;--------------------------------------------------------------
04500	DPYOUT:	SKIPN 1,BUFHD↔GO .+6
04600		LAC 2,DPYPTR↔DAC 2,-2(1)
04700		LACI 2,2(2)↔SUB 2,1↔DAC 2,-1(1)
04800		CDR B,DPYPTR↔SUB B,BUFHD
04900		AOS B↔DAC B,BUFHD+1
05000		LAC 1,ARG1↔DPB A,[POINT 4,.+1,12]↔703B8+BUFHD
05100		POP1J
05200	;--------------------------------------------------------------
     

00100	SUBR(DECDPY)NUMBER------------------------------------------------
00200	BEGIN DECDPY;DECIMAL NUMBER DISPLAY - BGB - 17 DEC 1972.
00300		LAC 1,ARG1↔POP P,ARG1	        ;GET ARG AND ADJUST STACK.
00400	L1:	JUMPGE 1,L2			;TEST FOR NEGATIVE NUMBER.
00500		MOVM 2,1↔CALL(DTYO,["-"])	;PRINT MINUS SIGN.
00600		LAC 1,2
00700	L2:	IDIVI 1,12↔PUSH P,2		;MODULO TEN AND SAVE.
00800		SKIPE 1↔PUSHJ P,L2		;TEST FOR DONE.
00900		POP P,1↔ADDI 1,60↔CALL(DTYO,1)	;RESTORE & PRINT.
01000		POP0J
01100	BEND;12/17/72-----------------------------------------------------
01200	
01300	SUBR(FLODPY)FLONUM,PLACES-----------------------------------------
01400	BEGIN FLODPY;FLOATING NUMBER DISPLAY - BGB - 4 FEB 1973.
01500		LAC ARG2↔JUMPL[CALL(DTYO,["-"])↔LACM ARG2↔GO .+1]
01600		LACM 2,ARG1↔CAILE 2,6↔LACI 2,6↔DAC 2,ARG1
01700		FMPR[1.↔10.↔100.↔1000.↔10000.↔100000.↔1000000.](2)↔FIXX
01800		IDIV[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
01900		PUSH P,1↔CALL(DECDPY,0)↔POP P,0↔LAC 2,ARG1
02000		ADD[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
02100		PUSH P,DPYPTR↔CALL(DECDPY,0)↔POP P,1
02200		LACI "."↔IDPB 0,1↔POP2J↔LIT
02300	BEND;2/4/73-------------------------------------------------------
     

00100	SUBR(IIIDPY)WINDOW,GLASS -----------------------------------------
00200	BEGIN IIIDPY; DISPLAY DEVICE ROUTINE.
00300		E←←16
00400	
00500	;DISPLAY WINDOW FRAME.
00600		LAC 1,ARG2
00700		NIP 1(1)↔DAC XL
00800		NAP 1(1)↔DAC XH
00900		NIP 2(1)↔DAC YL
01000		NAP 2(1)↔DAC YH
01100		CALL(DPYSET,DPYBUF)
01200		CALL(AIVECT,XL,YL)
01300		CALL(AVECT,XH,YL)
01400		CALL(AVECT,XH,YH)
01500		CALL(AVECT,XL,YH)
01600		CALL(AVECT,XL,YL)
01700	
01800	;DISPLAY THE VISIBLE EDGE LIST.
01900		LAC E,ARG2
02000		ALT2 E,E↔JUMPE E,L2		;GET THE WORLD.
02100		PED E,E↔SKIPA		;FIRST EDGE OF WORLD.
02200	L1:	ALT2 E,E↔JUMPE E,L2		;GET AN EDGE.
02300		X1DC 1,E↔Y1DC 2,E↔CALL(AIVECT,1,2)
02400		X2DC 1,E↔Y2DC 2,E↔CALL(AVECT,1,2)
02500		GO L1
02600	
02700	L2:	CALL(DPYOUT,ARG1)
02800		POP2J
02900	
03000		DECLARE{XL,XH,YL,YH}
03100	BEND IIIDPY; BGB 5 FEB 1973 --------------------------------------
     

00100	;VERNIER III TEXT POSITIONING.
00200		VERNX ←← 14
00300		VERNY ←← 11
00400	SUBR(VDPY)V-------------------------------------------------------
00500	BEGIN VDPY;SPECIAL VERTEX DISPLAY - BGB - 9 JANUARY 1973.
00600		LAC 1,ARG1↔CAR 0,(1)↔ANDI 0,017400	;NSEW & PZZ.
00700		SKIPE↔POP1J
00800		XDC 0,1↔FIXX↔SUBI VERNX↔PUSH P,0
00900		YDC 0,1↔FIXX↔SUBI VERNY↔PUSH P,0↔PUSHJ P,AIVECT
01000		CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
01100		CALL(IDPY,ARG1)
01200		CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
01300		POP1J
01400	BEND;2/9/73-------------------------------------------------------
01500	
01600	SUBR(EDPY)E-------------------------------------------------------
01700	BEGIN EDPY;SPECIAL EDGE DISPLAY - BGB - 9 FEBRUARY 1973.
01800		CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
01900		LAC 2,ARG1
02000		PVT 1,2↔CAR 0,(1)↔ANDI 0,017400↔JUMPN L1
02100		XDC 0,1↔FIXX↔DAC X↔PUSH P,0
02200		YDC 0,1↔FIXX↔DAC Y↔PUSH P,0
02300		PUSH P,ARG1↔PUSH P,ARG1
02400		PUSHJ P,AIVECT
02500		CALL(DTYO,["+"])↔CALL(AIVECT)
02600	L1:	LAC 2,ARG1
02700		NVT 1,2↔CAR 0,(1)↔ANDI 0,017400↔JUMPN L2
02800		XDC 0,1↔FIXX↔ADDM X↔PUSH P,0
02900		YDC 0,1↔FIXX↔ADDM Y↔PUSH P,0↔PUSHJ P,AVECT
03000		CALL(DTYO,["-"])
03100	L2:	LAC 2,ARG1
03200		LAC X↔ASH -1↔PUSH P,0
03300		LAC Y↔ASH -1↔PUSH P,0
03400		CALL(AIVECT)↔CALL(IDPY,ARG1)
03500		CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
03600		POP1J
03700	DECLARE{X,Y}
03800	BEND;2/9/73-------------------------------------------------------
03900	
     

00100	SUBR(FDPY)F-------------------------------------------------------
00200	BEGIN FDPY;SPECIAL FACE DISPLAY - BGB - 9 FEBRUARY 1973.
00300		EXTERN ECCW
00400		LAC 1,ARG1↔DAC 1,F
00500		TEST 1,FBIT↔POP1J
00600		PED 2,1↔DAC 2,E↔DAC 2,E0
00700		SETZM I
00800		CALL(DPYBIG,[1])
00900		CALL(DPYBRT,[3])
01000		SKIPN E↔GO[LAC 1,F↔PFACE 1,1↔PVT 1,1↔GO VDPY+1]
01100	L1:	AOS I↔LAC 2,E↔TEST 2,VISIBLE↔GO L2
01200		X1DC 0,2↔DAC 0,X
01300		Y1DC 1,2↔DAC 1,Y
01400		CALL(AIVECT,0,1)↔LAC 2,E
01500		X2DC 0,2↔ADDM 0,X
01600		Y2DC 1,2↔ADDM 1,Y
01700		CALL(AVECT,0,1)
01800		LAC 0,X↔ASH 0,-1↔SUBI 0,VERNX
01900		LAC 1,Y↔ASH 1,-1↔SUBI 1,VERNY
02000		CALL(AIVECT,0,1)
02100		CALL(DECDPY,I)
02200	L2:	CALL(ECCW,E,F)
02300		CAMN 1,E↔GO L3↔DAC 1,E
02400		CAME 1,E0↔GO L1
02500	L3:	CALL(DPYBRT,[2])
02600		CALL(DPYBIG,[2])
02700		POP1J
02800		DECLARE{F,E,E0,X,Y,I}
02900	BEND;2/9/73-------------------------------------------------------
     

00100	SUBR(IDPY)NODE----------------------------------------------------
00200	BEGIN IDPY; IDENTIFIER DISPLAY.
00300		EXTERN CAMERA
00400		LAC 1,ARG1↔SETZ 2,
00500		TESTZ 1,BBIT↔GO[
00600			SKIPE 4(1)↔GO[SETZ↔ALT. 0,1↔LACI 4(1)
00700				CALL(DPYSTR,0)↔GO L1A]
00800		L1:	CW 1,1↔TESTZ 1,BBIT↔AOJA 2,L1
00900			AOS 2↔PUSH P,2↔CALL(DTYO,["B"])
01000			CALL(DECDPY)
01100		L1A:	SETZB 14,15↔LAC 1,ARG1
01200			TESTZ 1,BDLBIT↔IORI 14,4
01300			TESTZ 1,BDVBIT↔IORI 14,2
01400			TESTZ 1,BDPBIT↔IORI 14,1
01500			JUMPE 14,POP1J.
01600			LAC 14,[
01700			0↔ASCII/.P./↔ASCII/.V./↔ASCII/.VP./
01800			ASCII/.L./↔ASCII/.LP./
01900			ASCII/.LV./↔ASCII/.LVP./](14)
02000			CALL(DPYSTR,[14])↔POP1J]
02100		TESTZ 1,FBIT↔GO[
02200		L2:	NFACE 1,1↔TESTZ 1,FBIT↔AOJA 2,L2
02300			AOS 2↔PUSH P,2↔CALL(DTYO,["F"])
02400			CALL(DECDPY)↔POP1J]
02500		TESTZ 1,EBIT↔GO[
02600		L3:	NED 1,1↔TESTZ 1,EBIT↔AOJA 2,L3
02700			AOS 2↔PUSH P,2↔CALL(DTYO,["E"])
02800			CALL(DECDPY)↔POP1J]
02900		TESTZ 1,VBIT↔GO[
03000		L4:	NVT 1,1↔TESTZ 1,VBIT↔AOJA 2,L4
03100			AOS 2↔PUSH P,2↔CALL(DTYO,["V"])
03200			CALL(DECDPY)↔POP1J]
03300		CAMN 1,CAMERA↔GO[CALL(DPYSTR,{[[ASCIZ"CAMERA"]]})↔POP1J]
03400		CALL(DPYSTR,{[[ASCIZ"UNDEF"]]})
03500		POP1J
03600		LIT
03700	BEND;2/4/73-------------------------------------------------------
03800	END