perm filename CREDPY[GEM,BGB] blob
sn#050725 filedate 1973-08-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00018 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE CREDPY - CRE DISPLAY ROUTINES - BGB - 16 APRIL 1973.
C00004 00003 III DPY CONTINUED.
C00006 00004 III DPY CONTINUED.
C00008 00005 EXTERN BLKCNT,VCUT,HISTO,FILM,HISTOG
C00009 00006 AI(X,Y). AV(X,Y).
C00011 00007 CLIP(X1,Y1,X2,Y2). 2D CLIPPER.
C00014 00008 2D CLIPPER continued.
C00016 00009 SUBR(CREDPY). STATUS DISPLAY.
C00018 00010 SUBR(DPYIMG). DISPLAY QIMAGE.
C00020 00011 SUBR(ID)----------------------------------------------------------
C00022 00012 DECDPY:NUM DECIMAL DISPLAY NUMBER.
C00023 00013 SUBR(DPYBLK)NODE. DISPLAY CONTENTS OF A NODE.
C00024 00014 DPYBLK CONTINUED.
C00026 00015 DPYBLK CONTINUED.
C00027 00016 SUBR(TIMDPY)PGON DISPLAY A POLYGON'S TIME SUCCESSOR.
C00029 00017 SUBR(DPYHIS) DISPLAY HISTOGRAM.
C00032 00018 SUBR(DPYGON)PGON DISPLAY POLYGON.
C00033 ENDMK
C⊗;
TITLE CREDPY - CRE DISPLAY ROUTINES - BGB - 16 APRIL 1973.
EXTERN FLGIII,FLGDD,PLOTO
;III DISPLAY SUBROUTINES.
;DISPLAY UUO CODES.
OPDEF GETLIN [TTYUUO 6,]
A←1↔B←2↔C←3
DPYBUF: DPYBU.
=2048↔1↔XWD 1,=2048
DPYBU.: BLOCK 4000
;SOURCE WINDOW.
SX: 0
SY: 0
SOX: 0
SOY: 0
;OBJECT WINDOW.
OX: 0
OY: 0
INTERN SX,SY,MAG,DEL
MAG: 3.4
DEL: 32.0
;PSEUDO BEAM POSITION.
XXX: 0
YYY: 0
DECLARE{XL,XH,YL,YH}
IGNORE: 0
DPYPTR: 0
BUFEND: 0
BUFHD: 0
0
;III DPY CONTINUED.
DPYBIG: LAC 1,ARG1
LACI 3,46 ;ZERO LENGTH RELATIVE-INVISIBLE VECTOR
DPB 1,[POINT 3,3,27]
PUSH P,(P) ;COPY PC.
GO LV2
DPYBRT: LAC 1,ARG1
LACI 3,46
DPB 1,[POINT 3,3,24]
PUSH P,(P) ;COPY PC.
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
;--------------------------------------------------------------
;III DPY CONTINUED.
DPYSTR: LAC 3,ARG1
LIPI 3,440700
ILDB 3↔JUMPE POP1J.
CALL(DTYO,0)↔GO DPYSTR+2
DTYO: LAC 1,ARG1
IDPB A,DPYPTR
CDR A,DPYPTR
CAML A,BUFEND
SETOM IGNORE
POP1J
DPYCLR: SKIPL DPYFLG#
DPYCLR
DZM BUFHD
POPJ P,
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
ADDI B,1
DAC B,BUFHD+1
LAC 1,ARG1
DPB A,[POINT 4,.+3,12]↔IOR A,DPYFLG↔SKIPL A↔UPGIOT BUFHD
POP1J
DPYSET: DZM DPYFLG
LAC 1,ARG1
ADDI 1,2
DAC 1,BUFHD
CDR 2,-3(1) ;SIZE
ADDI 2,-3(1)
SUBI 2,1
DZM IGNORE
DAC 2,BUFEND
CLR2: LAC A,BUFHD
LACI B,1
DAC B,1(A)
LACI B,2(A)
LIPI B,1(A)
BLT B,@BUFEND ;SET DPY BUFFER TO NULL CHARACTER WORDS
PUSH P,(P) ;COPY PC.
GO LV3
EXTERN BLKCNT,VCUT,HISTO,FILM,HISTOG
;CROP.
CROP:;------------------------------------------------------------
BEGIN CLIPIN
LAC 1,OX↔LAC MAG↔FMP SX↔FSB 1,0↔DAC 1,SOX
LAC 1,OY↔LAC MAG↔FMP SY↔FSB 1,0↔DAC 1,SOY
LAC 1,OX↔LAC MAG↔FMP[155.0]↔FSB 1,0
CAMG 1,[-510.0]↔LAC 1,[-510.0]↔DAC 1,XL
LAC 1,OX↔LAC MAG↔FMP[155.0]↔FAD 1,0
CAML 1,[ 510.0]↔LAC 1,[510.0]↔DAC 1,XH
LAC 1,OY↔LAC MAG↔FMP[115.0]↔FSB 1,0
CAMG 1,[-470.0]↔LAC 1,[-470.0]↔DAC 1,YL
LAC 1,OY↔LAC MAG↔FMP[115.0]↔FAD 1,0
CAML 1,[ 470.0]↔LAC 1,[470.0]↔DAC 1,YH
POP0J
BEND;12/20/72-----------------------------------------------------
;AI(X,Y). AV(X,Y).
SUBR(AI)----------------------------------------------------------
BEGIN AI
LAC ARG2↔FMP MAG↔FAD SOX↔DAC XXX
LAC ARG1↔FMP MAG↔FAD SOY↔DAC YYY
DZM AIVFLG
POP2J
BEND;12/20/72-----------------------------------------------------
AIVFLG:0
SUBR(AV)----------------------------------------------------------
BEGIN AV
LAC XXX↔DAC X1
LAC YYY↔DAC Y1
LAC ARG2↔FMP MAG↔FAD SOX↔DAC XXX↔DAC X2
LAC ARG1↔FMP MAG↔FAD SOY↔DAC YYY↔DAC Y2
CALL(CLIP,X1,Y1,X2,Y2)
JUMPE 1,[DZM AIVFLG↔POP2J]
CAIN 1,1↔GO[
SKIPN AIVFLG↔GO[
SETOM AIVFLG↔GO L1+1]↔GO L2]
L1: DZM AIVFLG
FIXX 6,↔FIXX 7,↔CALL(AIVECT,6,7)
L2: FIXX 8,↔FIXX 9,↔CALL(AVECT,8,9)
POP2J
DECLARE{X1,Y1,X2,Y2}
BEND;12/20/72-----------------------------------------------------
;COLUMN INTO X-COORDINATE.
SUBR(GETXY)VERTEX-------------------------------------------------
BEGIN GETXY; GET DISPLAY COORDINATES FROM ROW-COL COORDINATES.
;RETURN VALUES IN STACK.
;COLUMN INTO X-COORDINATE.
LAC 1,ARG1↔PUSH P,(P) ;COPY PC.
COL 0,1
SUBI =144*=64↔FSC 225↔DAC 0,ARG2 ;DPY X.
;ROW INTO Y-COORDINATE.
ROW 2,1
LACI =108*=64↔SUB 0,2↔FSC 225↔DAC 0,ARG1 ;DPY Y.
POP0J
BEND;1/4/73-------------------------------------------------------
;CLIP(X1,Y1,X2,Y2). 2D CLIPPER.
DECLARE{AAA,BBB,CCC,FLGO,FLGZ,AXH,AXL,BYH,BYL,QNE,QNW,QSW,QSE}
CLIP:;------------------------------------------------------------
; FLG ← CLIP(X1,Y1,X2,Y2) RETURN TRUE WHEN PORTION IS VISIBLE.
BEGIN CLIP
ACCUMULATORS{X1,Y1,X2,Y2,PDL}
PTR←13
;PICK 'EM UP;
LAC X1,ARG4↔LAC Y1,ARG3
LAC X2,ARG2↔LAC Y2,ARG1
LACI PTR,PDL-1
;SET NSEW BITS.
SETZB 1
CAMLE Y1,YH↔TRO 8↔CAMLE Y2,YH↔TRO 1,8; NORTH.
CAMGE Y1,YL↔TRO 4↔CAMGE Y2,YL↔TRO 1,4; SOUTH.
CAMLE X1,XH↔TRO 2↔CAMLE X2,XH↔TRO 1,2; EAST.
CAMGE X1,XL↔TRO 1↔CAMGE X2,XL↔TRO 1,1; WEST.
;EASY OUTSIDER EDGE.
TRNE 0,(1)↔GO [OUTSIDE: SETZ 1,↔POP4J]
;EASY INSIDER VERTICES.
JUMPE 0,[PUSH PTR,X1↔PUSH PTR,Y1↔GO .+1]
JUMPE 1,[PUSH PTR,X2↔PUSH PTR,Y2↔GO .+1]
DEFINE DONE{CAMN PTR,[XWD 4,PDL+3]↔GO L}
CAMN PTR,[XWD 4,PDL+3]↔GO[LACI 1,1↔GO L+1]
;COMPUTE EDGE COEFFICIENTS.
LAC Y1↔FSBR Y2↔DAC AAA
LAC X2↔FSBR X1↔DAC BBB
LAC X2↔FMPR Y1↔MOVNM CCC
LAC X1↔FMPR Y2↔FADRM CCC
;PARTIAL PRODUCTS.
LAC AAA↔FMPR XH↔DAC AXH
LAC AAA↔FMPR XL↔DAC AXL
LAC BBB↔FMPR YH↔DAC BYH
LAC BBB↔FMPR YL↔DAC BYL
;CORNER Q'S.
SETOM FLGO↔DZM FLGZ
LAC AXH↔FADR BYH↔FADR CCC↔DAC QNE↔ANDM FLGO↔IORM FLGZ
LAC AXL↔FADR BYH↔FADR CCC↔DAC QNW↔ANDM FLGO↔IORM FLGZ
LAC AXL↔FADR BYL↔FADR CCC↔DAC QSW↔ANDM FLGO↔IORM FLGZ
LAC AXH↔FADR BYL↔FADR CCC↔DAC QSE↔ANDM FLGO↔IORM FLGZ
;HARD OUTSIDER CASES.
SKIPGE FLGO↔GO OUTSIDE
SKIPL FLGZ↔GO OUTSIDE
;2D CLIPPER continued.
;NORTH BORDER CROSSING.
LAC QNE↔XOR QNW↔SKIPL↔GO L2
LAC Y1↔CAMGE Y2↔LAC Y2↔CAMG YH↔GO L2
LAC BYH↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
LAC YH↔PUSH PTR,
DONE
;SOUTH BORDER CROSSING.
L2: LAC QSE↔XOR QSW↔SKIPL↔GO L3
LAC Y1↔CAMLE Y2↔LAC Y2↔CAML YL↔GO L3
LAC BYL↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
LAC YL↔PUSH PTR,
DONE
;EAST BORDER CROSSING.
L3: LAC QSE↔XOR QNE↔SKIPL↔GO L4
LAC X1↔CAMGE X2↔LAC X2↔CAMG XH↔GO L4
LAC XH↔PUSH PTR,
LAC AXH↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
DONE
;WEST BORDER CROSSING.
L4: LAC QSW↔XOR QNW↔SKIPL↔GO L5
LAC X1↔CAMLE X2↔LAC X2↔CAML XL↔GO L5
LAC XL↔PUSH PTR,
LAC AXL↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
DONE
;STRANGE EXIT - NSEW BIT MARKING & EDGE COEF ARE INCONSISTENT.
L5: OUTSTR[ASCIZ/2D CLIPPER FALL THRU !
/]↔ GO OUTSIDER
;VISIBLE PORTION EXIT.
L: SETO 1,
POP4J
LIT
BEND;12/20/72-----------------------------------------------------
SUBR(CREDPY). STATUS DISPLAY.
BEGIN CREDPY;-----------------------------------------------------
EXTERN QIMAGE
SKIPN FLGIII↔POP0J
CALL(DPYSET,DPYBUF)
CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
;FILM NAME AND IMAGE SEQUENCE NUMBER.
CALL(AIVECT,[=320],[=502])
CALL(DPYSTR,[[ASCIZ/IMAGE/]])
CALL(AIVECT,[=320],[=477])
CALL(DPYSTR,[FNAME])↔EXTERN FNAME
SETZ↔SKIPE 1,QIMAGE↔NCNT 0,1
LAC 1,0↔CALL(DECDPY)
;NUMBER OF NODES IN USE.
CALL(AIVECT,[=160],[=502])
CALL(DPYSTR,[[ASCIZ/NODES/]])
CALL(AIVECT,[=170],[=477])
LAC 1,@BLKCNT↔CALL(DECDPY)
;CUT THRESHOLD OF MOST RECENT LEVEL.
CALL(AIVECT,[=240],[=502])
CALL(DPYSTR,[[ASCIZ/LEVEL/]])
CALL(AIVECT,[=250],[=477])
SETZ 10,↔LAC 1,FILM
SON 1,1↔JUMPE 1,.+5
SON 1,1↔JUMPE 1,.+3
CW 1,1↔NCNT 10,1↔CALL(OD)
CALL(DPYOUT,[10])
POP0J
BEND CREDPY; BGB 21 JANUARY 1973 ---------------------------------
SUBR(DPYIMG). DISPLAY QIMAGE.
BEGIN DPYIMG;-----------------------------------------------------
EXTERN QIMAGE
SKIPN FLGIII↔POP0J
CALL(CREDPY)
CALL(DPYBLK)
;SQUARE FRAME.
CALL(DPYSET,DPYBUF)
SKIPE WNDFLG↔GO L0A
CALL(AIVECT,[-=510],[-=470])
CALL(AVECT,[ =510],[-=470])
CALL(AVECT,[ =510],[ =470])
CALL(AVECT,[-=510],[ =470])
CALL(AVECT,[-=510],[-=470])
L0A:
;LOOP THE LEVELS, LOOP THE POLYGONS.
LAC 1,FILM↔MARK 1,FBIT
SKIPN 1,QIMAGE↔GO L2 ;FIRST IMAGE.
;CONTOUR DISPLAYS.
SON 1,1↔DAC 1,LEV0#↔DAC 1,LEV1# ;FIRST LEVEL.
L0: LAC 1,LEV1↔CDR 1,(1)↔DAC 1,LEV1 ;CDR-LEVEL-RING.
SON 1,1↔JUMPE 1,L1A
DAC 1,PGN0#↔DAC 1,PGN1# ;FIRST POLYGON.
L1: LAC 1,PGN1↔CDR 1,(1)↔DAC 1,PGN1 ;CDR-POLY-RING.
CALL(DPYGON,1)
LAC 1,PGN1↔CAME 1,PGN0↔GO L1 ;POLY-RING-END.
L1A: LAC 1,LEV1↔CAME 1,LEV0↔GO L0 ;LEVEL-RING-END.
L2: CALL(DPYOUT,[0])
POP0J ;EXIT.
BEND DPYIMG; BGB 4 DECEMBER 1972 ---------------------------------
WNDFLG: 0
SUBR(ID)----------------------------------------------------------
BEGIN ID;IDENT DISPLAY - BGB - 13 DEC 1972.
JUMPE 10,[
CALL(DPYSTR,[[ASCIZ/NIL /]])↔AOS(P)↔POP0J]
LACI 2,"U"
TESTZ 10,VBIT↔LACI 2,"V"
TESTZ 10,VBIT↔LACI 2,"A"
TESTZ 10,PBIT↔LACI 2,"P"
TESTZ 10,LBIT↔LACI 2,"L"
TESTZ 10,IBIT↔LACI 2,"I"
TESTZ 10,FBIT↔LACI 2,"F"
TESTZ 10,SBIT↔LACI 2,"S"
CALL(DTYO,2)
LACI 7,6↔DIPZ 10,10
JFFO 10,.+1↔CAIL 11,3↔GO[
ROT 10,3↔SUBI 11,3↔SOJA 7,.-1]↔ZAP 10
L: ROT 10,3↔ADDI 10,60
CALL(DTYO,10)↔ZAP 10↔SOJG 7,L
CALL(DTYO,[" "])
AOS(P)↔POP0J
BEND;12/13/72-----------------------------------------------------
SUBR(OD)----------------------------------------------------------
BEGIN OD;OCTAL HALF WORD DISPLAY - BGB - 13 DEC 1972.
JUMPE 10,[CALL(DPYSTR,[[ASCIZ/--- /]])↔POP0J]
LACI 7,6↔DIPZ 10,10↔SETO
L: ROT 10,3↔ADDI 10,60↔TRNE 10,17↔SETZ
JUMPN 0,.+3↔CALL(DTYO,10)↔ZAP 10↔SOJG 7,L
CALL(DTYO,[" "])↔POP0J
BEND;12/13/72-----------------------------------------------------
DECDPY:;NUM ;DECIMAL DISPLAY NUMBER.
BEGIN DECDPY;-----------------------------------------------------
L: JUMPGE 1,.+5
MOVM 2,1
CALL(DTYO,["-"])
LAC 1,2
IDIVI 1,12
PUSH P,2
SKIPE 1
PUSHJ P,L
POP P,1↔ADDI 1,60
CALL(DTYO,1)
POP0J
BEND;12/17/72-----------------------------------------------------
SUBR(DPYBLK)NODE. DISPLAY CONTENTS OF A NODE.
BEGIN DPYBLK;-----------------------------------------------------
YORG ←← -=280
CALL(DPYSET,DPYBUF)
SKIPN 15,QBLK↔GO L2
;DISPLAY BLOCK TYPE LABEL.
CALL(AIVECT,[=320],[YORG-0])
LAC 1,15↔ LACI 2,[ASCIZ/EMPTY/]
TESTZ 1,FBIT↔LACI 2,[ASCIZ/FILM/]
TESTZ 1,IBIT↔LACI 2,[ASCIZ/IMAGE/]
TESTZ 1,LBIT↔LACI 2,[ASCIZ/LEVEL/]
TESTZ 1,PBIT↔LACI 2,[ASCIZ/POLYGON/]
TESTZ 1,SBIT↔LACI 2,[ASCIZ/SHAPE/]
TESTZ 1,VBIT↔LACI 2,[ASCIZ/VECTOR/]
L0: CALL(DPYSTR,2)
L1: CALL(DTYO,["-"])↔LAC 10,15↔CALL(ID)↔JFCL
;DPYBLK CONTINUED.
;DISPLAY CONTENTS OF THE FIRST THREE WORDS OF THE NODE.
RELOC 14,15 ;GET RELLOCATION BITS.
CALL(AIVECT,[=280],[YORG-=40])
CALL(DPYSTR,{[[ASCIZ/,. 0 /]]})
CAR 10,0(15)↔TRNE 14,200000↔CALL(ID)↔CALL(OD)
CDR 10,0(15)↔TRNE 14,100000↔CALL(ID)↔CALL(OD)
CALL(AIVECT,[=280],[YORG-=60])
CALL(DPYSTR,{[[ASCIZ/<> 1 /]]})
CAR 10,1(15)↔TRNE 14,20000↔CALL(ID)↔CALL(OD)
CDR 10,1(15)↔TRNE 14,10000↔CALL(ID)↔CALL(OD)
CALL(AIVECT,[=280],[YORG -=80])
CALL(DPYSTR,{[[ASCIZ/ 2 /]]})
CAR 10,2(15)↔CALL(OD)
CDR 10,2(15)↔CALL(OD)
;DISPLAY CONTENTS OF THE LAST THREE WORDS OF THE NODE.
CALL(AIVECT,[=280],[YORG -=120])
CALL(DPYSTR,{[[ASCIZ/∪∩ 3 /]]})
CAR 10,3(15)↔TRNE 14,2000↔CALL(ID)↔CALL(OD)
CDR 10,3(15)↔TRNE 14,1000↔CALL(ID)↔CALL(OD)
CALL(AIVECT,[=280],[YORG -=140])
CALL(DPYSTR,{[[ASCIZ/≤≥ 4 /]]})
CAR 10,4(15)↔TRNE 14,200↔CALL(ID)↔CALL(OD)
CDR 10,4(15)↔TRNE 14,100↔CALL(ID)↔CALL(OD)
CALL(AIVECT,[=280],[YORG -=160])
CALL(DPYSTR,{[[ASCIZ/⊂⊃ 5 /]]})
CAR 10,5(15)↔TRNE 14,20↔CALL(ID)↔CALL(OD)
CDR 10,5(15)↔TRNE 14,10↔CALL(ID)↔CALL(OD)
CALL(AIVECT,[=280],[YORG -=180])
CALL(DPYSTR,{[[ASCIZ/∨∧ 6 /]]})
CAR 10,6(15)↔TRNE 14,2↔CALL(ID)↔CALL(OD)
CDR 10,6(15)↔TRNE 14,1↔CALL(ID)↔CALL(OD)
;DPYBLK CONTINUED.
;LIGHT UP THE QBLK WHEN IT IS A VECTOR OR A POLYGON.
TESTZ 15,PBIT↔GO[CALL(DPYBRT,[6])↔CALL(DPYGON,15)↔GO L2]
TESTZ 15,SBIT↔GO[
CALL(DPYBRT,[6])
CALL(GETXY,15)↔CALL(AI)
CALL(GETXY,15)↔CALL(AV)
GO L2]
TESTZ 15,VBIT↔GO[
CALL(DPYBRT,[6])
CALL(GETXY,15)↔CALL(AI)
CCW 1,15
CALL(GETXY,1)↔CALL(AV)
GO L2]
L2: CALL(DPYBRT,[2])
CALL(DPYOUT,[1])↔POP0J
BEND;1/25/73------------------------------------------------------
QBLK: 0 ↔ INTERN QBLK
SUBR(TIMDPY)PGON ;DISPLAY A POLYGON'S TIME SUCCESSOR.
BEGIN TIMDPY;-----------------------------------------------------
TDCA↔SETO↔DAC FLG# ;PAST OR FUTURE.
LAC 1,ARG1↔DAC 1,POLY1#
TEST 1,PBIT↔POP1J
PTIME 1,1↔SKIPE FLG↔NTIME 1,1
SKIPN 1↔POP1J↔DAC 1,POLY2#↔DZM POLY3#
;DISPLAY POLYGONS LINKED IN TIME.
DZM 1↔LACI 1↔UPGIOT ;CLEAR DPYBLK.
CALL(DPYSET,DPYBUF)
CALL(DPYBRT,[3])
CALL(DPYBIG,[1])
CALL(DPYGON,POLY1)
CALL(DPYGON,POLY2)
LAC 1,ARG1
SON 1,1↔DAC 1,V0#
DZM CNT#
L1: DAC 1,V1#
PTIME 2,1↔SKIPE FLG↔NTIME 2,1
JUMPE 2,L2↔DAC 2,U1#↔DAD 0,2↔CAME 0,POLY2↔DAC 0,POLY3
;DISPLAY LINE SEGMENT BETWEEN TIME LINKED VERTICES.
CALL(GETXY,V1)↔CALL(AI)
CALL(GETXY,U1)↔CALL(AV)
AOS 1,CNT↔CALL(DECDPY)
L2: LAC 1,V1↔CCW 1,1
CAME 1,V0↔GO L1
SKIPE POLY3↔GO[CALL(DPYGON,POLY3)↔GO .+1]
CALL(DPYBRT,[2])
CALL(DPYBIG,[2])
CALL(DPYOUT,[0])
INCHRW↔CAIN"P"↔GO[CALL(PLOTO)↔GO .+1]
CALL(DPYIMG)
POP1J
BEND TIMDPY;BGB 25 APRIL 1973 ------------------------------------
SUBR(DPYHIS) DISPLAY HISTOGRAM.
BEGIN DPYHIS;-----------------------------------------------------
X←←10 ↔ Y←←11 ↔ CNT←←14
SKIPN FLGIII↔POP0J
;COMPUTE THE HISTOGRAM AND DETERMINE WHETHER 4 OR 6 BIT.
CALL(HISTOG)
CALL(DPYSET,DPYBUF)
CALL(DPYBIG,[1])
SETZ↔LACI 1,74↔ADD HISTO(1)↔SUBI 1,4↔SKIPL 1↔GO .-3
DZM FLGSIX#↔CAIE =62208↔SETOM FLGSIX
;SCALE THE IMAGE TO ITS LARGEST COLUMN.
SETZ↔HRLZI 1,-77
CAMGE 0,HISTO(1)↔LAC HISTO(1)↔AOBJN 1,.-2
MOVE 1,[800.0]↔FSC 233↔FDV 1,0↔DAC 1,SY#
;INITIALIZE HISTO LOOP.
SETZ CNT,
NIM X,=511↔NIM Y,-=404
CALL(AIVECT,X,Y)↔MOVNS X
CALL(AVECT,X,Y)
L1: SKIPN FLGSIX↔GO[TRNE CNT,3↔GO L2↔GO .+1]
LAC Y,HISTO(CNT)↔FSC Y,233↔FMP Y,SY↔FIXX Y,
SUBI Y,=400
L2: CALL(AVECT,X,Y)
TRNE CNT,3↔GO L3
;INTENSITY LEVEL NUMERAL.
NIM 0,-=440↔SUBI X,10↔CALL(AIVECT,X,0)
LAC CNT↔LSHC -3↔SKIPE↔IORI "0"↔IORI " "
LSH 4↔LSHC 3
IORI "0"↔ROT 0,-16↔IORI 1
AOS 1,DPYPTR↔DAC(1)
;PEC CENT AT THIS LEVEL NUMERAL.
NIM 0,-=465↔CALL(AIVECT,X,0)↔ADDI X,10
LAC HISTO+0(CNT)↔ADD HISTO+1(CNT)
ADD HISTO+2(CNT)↔ADD HISTO+3(CNT)
IMULI =1000↔IDIVI =62208↔ADDI 5↔IDIVI =10
JUMPE L4↔IDIVI =10
ROT 1,-4
SKIPE↔IORI "0"↔IORI " "
LSH 3↔LSHC 4↔IORI "0"↔LSH 16↔IORI " %"
LSH 8↔IORI 1↔AOS 1,DPYPTR↔DAC(1)
L4: CALL(AIVECT,X,Y)
;ADVANCE.
L3: ADDI X,20
CALL(AVECT,X,Y)
AOS CNT↔CAIE CNT,100↔GO L1
NIM -=400↔CALL(AVECT,X,0)
CALL(DPYBIG,[2])↔CALL(DPYOUT,[0])↔POP0J
BEND DPYHIS; BGB 8 DECEMBER 1972 ---------------------------------
SUBR(DPYGON)PGON DISPLAY POLYGON.
BEGIN DPYGON;-----------------------------------------------------
;FIRST EDGE/VERTEX ABSOLUTE INVISIBLE VECTOR.
LAC 1,ARG1
SON 2,1
LAC 1,2
JUMPE 1,POP1J.
LAC 2(1)↔JUMPE POP1J.
L0: DAC 1,E0#↔DAC 1,V#
CALL(GETXY,1)↔PUSHJ P,AI
;FOLLOW AROUND THE POLYGON WITH ABS VISIBLE VECTORS.
L1: LAC 1,V↔CDR 1,0(1)↔DAC 1,V
CALL(GETXY,1)↔LAC 1,V↔CNTRST 0,1↔MOVMS
CAMG 0,VCUT↔GO[PUSHJ P,AI↔GO .+2]↔PUSHJ P,AV
LAC 1,V↔CAME 1,E0↔GO L1
POP1J
BEND DPYGON; BGB 4 DECEMBER 1972 ---------------------------------
END