perm filename STADPY[GEM,BGB] blob sn#030940 filedate 1973-03-25 generic text, type T, neo UTF8
00100	SUBR(STADPY)------------------------------------------------------
00200	BEGIN STADPY;STATUS DISPLAY - BGB - 1/12/73
00300		CALL(DPYSET,BUFDPY)
00400	
00500	;STATUS OF FRAME SELECT.
00600		CALL(AIVECT,[=180],[=500])
00700		LAC 1,FRAME
00800		PUSH P,[
00900			[ASCIZ/WORLD/]
01000			[ASCIZ/BODY/]
01100			[ASCIZ/RELATIVE/]
01200			[ASCIZ/CAMERA/]](1)
01300		CALL(DPYSTR)
01400	
01500	;STATUS OF FRAME ORIGIN SWITCH.
01600		LACI[ASCIZ/ FRAME/]
01700		SKIPE FRMORG
01800		LACI[ASCIZ/ FRAME */]
01900		CALL(DPYSTR,0)
02000	
02100	;STATUS OF OPERAT SELECT SWITCH.
02200		CALL(AIVECT,[=390],[=500])
02300		LAC 1,OPERAT
02400		PUSH P,[
02500			[ASCIZ/TRANSLATION/]
02600			[ASCIZ/ROTATION/]
02700			[ASCIZ/DILATION/]
02800			[ASCIZ/REFLECTION/]](1)
02900		CALL(DPYSTR)
03000	
     

00100	;TRANSLATION STRENGTH.
00200		CALL(AIVECT,[=185],[=480])
00300		CALL(FLODPY,TDEL,[4])
00400		CALL(DPYSTR,{[[ASCIZ/ FEET/]]})
00500	
00600	;ROTATION STRENGTH IN PI FRACTION.
00700		CALL(AIVECT,[=185],[=460])
00800	L1:	LAC RDEL↔LAC 1,[3.15]
00900		CAMLE[6.28]↔GO L2
01000		CAML[2.0]↔GO[FSC 1,1↔PUSH P,1
01100			CALL(DTYO,["2"])↔POP P,1
01200			GO .+1]
01300		FDVR 1,RDEL↔FIX 1,233000↔PUSH P,1
01400		CALL(DPYSTR,{[[ASCIZ"π/"]]})
01500		CALL(DECDPY)
01600	L2:
01700	
01800	;ROTATION STRENGTH IN RADIANS.
01900		CALL(AIVECT,[=400],[=460])
02000		CALL(FLODPY,RDEL,[3])
02100	
02200	;RDEL IN DEGREES, MINUTES AND SECONDS.
02300		CALL(AIVECT,[=270],[=460])
02400		LAC 1,RDEL
02500		FMPR 1,[206264.806]
02600		FIX 1,233000
02700		AOS 1
02800		IDIVI 1,=3600
02900		IDIVI 2,=60
03000		PUSH P,3
03100		PUSH P,2
03200		PUSH P,1
03300		CALL(DECDPY)↔CALL(DTYO,[" "])
03400		CALL(DECDPY)↔CALL(DTYO,[" "])
03500		CALL(DECDPY)
03600	
03700	;DILATION STRENGTH.
03800		CALL(AIVECT,[=390],[=480])
03900		LAC DDEL↔FMP[100.0]↔FADR[0.001]
04000		CALL(FLODPY,0,[2])
04100		CALL(DTYO,["%"])
04200		CALL(DTYO,[" "])
04300		LAC AXECNT↔ADDI 60↔CALL(DTYO,0)
     

00100	;DISPLAY THE SCRATCH PAD PDL.
00200		CALL(AIVECT,[-=511],[=430])
00300		CDR 16,PDLPTR
00400		CAILE 16,PADPDL↔GO[
00500			CALL(IDPY,{(16)})
00600			CALL(DTYO,[15])↔CALL(DTYO,[12])
00700			SOJA 16,.-1]
00750		SKIPN FLAGL↔GO L3
00800	
00900	;DISPLAY TOP OBJECT OF PADPDL.
01000		CDR 16,PDLPTR
01100		CAILE 16,PADPDL↔GO[
01200			LAC 1,(16)
01300			TESTZ 1,VBIT↔GO[CALL(VDPY,1)↔GO .+1]
01400			TESTZ 1,EBIT↔GO[CALL(EDPY,1)↔GO .+1]
01500			TESTZ 1,FBIT↔GO[CALL(FDPY,1)↔GO .+1]
01600			GO .+1]
01700	;DISPLAY THE SECOND OBJECT WHEN APPROPRIATE.
01800		CDR 16,PDLPTR
01900		CAILE 16,PADPDL+1↔GO[
02000			LAC 1,-1(16)↔LAC 2,(16)
02100			LAC 0,(1)↔IOR 0,(2)↔LDB[POINT 3,0,16]
02200			CAIE 6↔CAIN 3↔SKIPA↔GO .+1
02300			CALL(LINKED,1,2)↔JUMPE 1,.+1
02400			LAC 1,-1(16)
02500			TESTZ 1,VBIT↔GO[CALL(VDPY,1)↔GO .+1]
02600			TESTZ 1,EBIT↔GO[CALL(EDPY,1)↔GO .+1]
02700			TESTZ 1,FBIT↔GO[CALL(FDPY,1)↔GO .+1]
02800			GO .+1]
02900	
03000	;III CLIPPER WINDOW FRAME.
03100	L3:	CALL(AIVECT,[-=511],[-=384])
03200	;	CALL(AVECT,[ =511],[-=384])
03300	;	CALL(AVECT,[ =511],[ =384])
03400	;	CALL(AVECT,[-=511],[ =384])
03500	;	CALL(AVECT,[-=511],[-=384])
03600		CALL(DPYOUT,[0])
03700		POP0J
03800	BEND;2/4/73-------------------------------------------------------