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