C PROGRAM SEGB2.FT C ---------------- C S ENTRY SEGB2 S CPAGE 2 S SEGB2,BLOCK 2 C C PETER LEMKIN C IMAGE PROCESSING UNIT, DCBD C NATIONAL CANCER INSTITUTE C NATIONAL INSTITUTES OF HEALTH C 9000 ROCKVILLE PIKE C BETHESDA, MD. 20014 C C FEB 9, 1978 C FEB 8, 1978 C NOV 15, 1977 C NOV 11, 1977 C OCT 26, 1977 C OCT 25, 1977 C OCT 13, 1977 C SEPT 2, 1977 C JUNE 26, 1977 C JUNE 24, 1977 C JUNE 16, 1977 C JUNE 11, 1977 C JUNE 10, 1977 C JUNE 8, 1977 C JUNE 7, 1977 C JUNE 4, 1977 C JUNE 3, 1977 C JUNE 2, 1977 C MAY 27, 1977 C MAY 24, 1977 C MAY 19, 1977 C MAY 17, 1977 C MAY 16, 1977 C MAY 13, 1977 C MAY 11, 1977 C MAY 10, 1977 C APRIL 14, 1977 C APRIL 12, 1977 C APRIL 11, 1977 C APRIL 4, 1977 C MARCH 30, 1977 C MARCH 29, 1977 C MARCH 28, 1977 C MARCH 26, 1977 C MARCH 25, 1977 C MARCH 24, 1977 C MARCH 18, 1977 C MARCH 17, 1977 /RENAMED FROM BMAX8, PUT FOLL==>BFOLLOW.FT C C PURPOSE C ------- C SEGB2 COMPUTES THE BOUNDARY FOLLOWED SEGMENTATION. C C IVAL FUNCTION C ---- -------- C 1 INIT THE FOLLOW SEGMENT COUNTER NC<==1; C QRC<==0; C C 2 FOLLOW THE CURVE AT (IX,IY). PUT BOUNDARY DESCRIPTORS C INTO THE LIST POINTED TO BY QR[Z]. C IT RETURNS WITH A TERMINATION CONDITION IN "LSNUM" C C LSNUM CONDITION C ---- --------- C 1 NORMAL RETURN C 2 ISOLATED PIXEL C 3 COMPONENT GOT LOST C 4 > 253 COMPONENTS C C BOUNDARY DESCRIPTOR LIST FORMAT C ------------------------------- C C C Q-registers Y:Z C | C | C \|/ C [BACK PTR]<---NEXT DESCR.<---NEXT DESCR.<--- C [FWD PTR]--->NEXT DESCR.--->NEXT DESCR.---> C --------[PTR TO PROP LIST] C | [CONECT. CMP#] C | [PTR TO BOUNDARY LIST]. C | | C | \|/ C | [XY1]<==>...[XYn]; C | C \|/ C PROP LIST: C NODE 1<==>NODE 2<==>NODE 3 C C C NODE 1 C ------ C right ptr: #B.P. C datum 1: true perimeter C datum 2: area under RLM C C NODE 2 C ------ C right ptr: area FILLED under RLM C datum 1: horizontal position C datum 2: vertical position C C NODE 3 C ------ C right ptr: DENSITY C datum 1: horizontal size C datum 2: vertical size C C DEBUG SWITCHES C --------------- C FBW4 FUNCTION C ---- -------- C@ 0010 BRUN DID SEMANTICS IX,IY,DID. C@C 0400 SEGB2[7] LIST, BKPTR, IX,IY C 0400 [ROTATE90, BPSEMANTICS] C 2000 SEGB2 PRINT RLM AFTER IT IS COMPUTED IN FILL C@C 4000 SEGB2[2] TRUE NON-ISOLATED POINT CC COUNTER C C C COMMON VARIABLES USED C ---------------------- C FILE - AREA C EXT - DENSITY C CURSYM - TRUE PERIMETER C FC - # FILLED AREA C FA - HOR SIZE OF ENCLOSING RECTANGLE C FB - VERT SIZE ENCL RECT C FC - FILLED AREA COMPUTED IN SEGB2 C MODEE - # BOUNDARY POINTS C IERRNUM - TRUE CC # C MACTIVE - NC (ACTIVE CC#) C MTROP - # TOUCHING EDGES C LSNUM - ERROR CONDITION RETURNED TO SEGB1. C LSSAVE - SIZING CRITERIA MET SWITCH C LSDUMP - DUMP SWITCH C LSUMSK - /T SWITCH COMPUTED IN SEGB1 C LSFILL - /H SWITCH COMPUTED IN SEGB1 C KX - LAST X SEEN C KY - LAST Y SEEN C DMIN (DMAX) - SIZE LIMITS USED AS TEMP VARS IN SEGB3 C C TEMP VARIABLES C --------------- C KWC C INDEX C LSNEW C LSPAL C C OPDEFS C ------ S OPDEF TADI 1400 S OPDEF DCAI 3400 C C S OPDEF LDXP 6443 S OPDEF LDYP 6444 S OPDEF DISP1 6435 S OPDEF DISP2 6436 C S OPDEF MQA 7501 S OPDEF MQL 7421 S OPDEF BSW 7002 C S OPDEF CLAMQ 7621 /CLA MQL S OPDEF SWAB 7431 S OPDEF SWBA 7447 S OPDEF DAD 7443 S OPDEF DST 7445 C S OPDEF RKYPDL 6353 S SKPDF SKPKPD 6313 C DIMENSION LFTLIST(2),L0LIST(4) EQUIVALENCE(L0LIST(3),L90LIST) DIMENSION IPTR(2),LIST(2),NODE(2,3) C [0] DISPATCH C DEFINE BNODE CALLS: C@ KAPPENDXY=1 C@ KINITAVAIL=4 C@ KGETLIST=5 C@ KFREELIST=6 C@ KLASTXY=7 C@ KNEXTXY=8 C@ KCARXY=9 C@ KFINDXY=10 C@ KCVXYTOI=15 C@ KCVITOXY=16 C@ LPUTDATA=5 C C C DISPATCH GOTO (1,2), IVAL C C [SEGB2-1] INIT THE FOLLOW SEGMENT COUNTER 1 NC=1 C C SET ISWX=/X S TAD PISW S TAD (D23 /"/X" S DCA 7 S CPAGE 4 S DCA \IERRNUM /FORCE COMMONE S TADI 7 S DCA \ISWX C ZERO THE TRUE CC COUNTER IERRNUM=0 C C C GET THE CONVERSION FACTORS TO BE USED FOR COMPUTING THE C WINDOW SIZE AND PERIMTER IN MICRONS. C COPY BMAP PARAMETERS PUT IN COMMON BY BMON2 BEFORE CHAIN C IN BMAX2[16]. C@ LENS=IA C@ ZOOM=FA PUC=FB C@ UNAME=FC C C C INIT THE LFTLIST TO NIL. LFTLIST=-1 S CLA CMA S DCA \LFTLIST# C C RETURN LFTLIST[1:2]==>IVAL[1:2]. 2047 IVAL=LFTLIST S TAD \LFTLIST# S DCA \IVAL# S RETRN SEGB2 C C [SEGB2-2] FOLLOW CURVE STARTING AT (IX,IY) C FOLLOW THE OUTSIDE BORDER AND SEGMENT IT C [1] INIT THE TERMINATION SWITCH TO NORMAL EXIT 2 LSNUM=1 C C [1.1] INIT THE BOUNDARY LENGTH COUNTER MODEEBNDCNT=1 C C C C [2] TEST IF ISOLATED PIXEL C C GET FRESH NEIGHBORHOOD CALL GETI1 C IZ=I10+I11+I12+I13+I14+I15+I16+I17 S TAD \IZ S SNA CLA S JMP \902 /ISO. ERROR C GOTO 900 C C C [2.1] ISOLATED POINT ERROR HANDLER! 902 CONTINUE C C@ WRITE(1,901)IX,IY C@901 FORMAT(' ISOL.PEL AT',2I5) C C ZERO THE PIXEL IZ=0 CALL PACK2D C SET TERMINATION SWITCH LSNUM=2 GOTO 2047 C C C [3] NOT ISOLATED PIXEL, SO IS COMPONENT 900 NC=1+NC C INCREMENT THE TRUE CC NUMBER IERRNUM=1+IERRNUM C S TAD \NC S CIA S TAD (D255 S SMA CLA S JMP \903 C C SET TERMINATION SWITCH LSNUM=4 GOTO 2047 C C C OK, SAVE THE POSITION AND CREATE A BOUNDARY LIST C ** KGETLIST=5 903 CALL BNODE(IX,IY,LIST,5) C C SETUP THE BFOLLOW ROUTINE C DEFINE THE MEM,IBYTE CALL BFOLLOW(MEM,IBYTE,1) C C INIT THE SEGMENT COUNTER CALL BFOLLOW(0,NC,2) C C INIT THE FIRST POINTS OF THE BOUNDARY CALL BFOLLOW(IX,IY,3) C C SETUP THE KY1 VARIABLE FOR USE IN COMPUTING 0 DEGREE RLM. KY1=257 C SETUP THE KX2 VARIABLE FOR USE IN COMPUTING 90 DEGREE RLM C FOR ORTHOGONAL TRANSFORMATION B.P. LABELING KX2=-1 C C C [4] TRACE THE BOUNDARY 906 CONTINUE C C TEST IF EXIT S CPAGE 3 S JMS TTYCTL S JMP \2046 /RETURN TO SEGBND.FT C C LOAD DISPLAYS S TAD \IX S DISP1 S TAD \IY S DISP2 C C LOAD CURSOR OVER BMJ S TAD \KODTN S TAD \IX S LDXP C S TAD \KODTM S TAD \IY S LDYP C C C [4.1] IF /T SWITCH THEN WRITE OUT BLACK INTO C (MEM,IBYTE',IX,IY) S TAD \LSUMSK S SNA CLA S JMP \907 /NO SWITCH C WRITE IT OUT IBYTE=1-IBYTE IZ=255 CALL PACK2D IBYTE=1-IBYTE C C C [4.2] SET THE PIXEL TO THE NEW COMPONENT NUMBER 907 IZ=NC CALL PACK2D C C C [4.3] GET NEXT POINT C SAVE OLD X,Y INCASE OF LOSING CC. KX=IX KY=IY CALL BFOLLOW(IX,IY,4) C [5] DISPATCH IF IX < 0 S TAD \IX S SMA CLA S JMP \496 /IX GEQ 0, CONTINUE AT [7] C IX=-IX C CASE: C [-1]==>GOTO [8] "DONE!, NOTE: PERIMETER RETURNED IN IY"; C [-2]==>GOTO [2] "ISOLATED PIXEL"; C [-3]==>GOTO [6] "COMPONENT GOT LOST"; GOTO(491,902,483),IX C C C C [6] GOT LOST CONTINUE ANYWAYS 483 LSNEW=1 LSPAL=1+IOUTSPOOL DO 484 INDEX=1,LSPAL C NOTE: ISOLATED POINTS ARE NOT TRUE CC'S WRITE(LSNEW,482)NC,IERRNUM,KX,KY 482 FORMAT(' LOST CC#',I4,' TCC#',I4,', AT ',2I4) 484 LSNEW=3 C C SET TERMINATION CONDITION LSNUM=3 C C GO ERASE POINTS IN AND , RETURN AT [14.1] LSSAVE=0 LSDUMP=0 S JMS FILL GOTO 485 C C C [7] NOT DONE, ADD POINT TO BOUNDARY LIST C SAVE THE CHAIN CODE OF PREVIOUS POINT S \496, JMS CHAINCODE C C ** KAPPENDIX=1 CALL BNODE(IX,IY,LIST,1) C C INCREMENT THE BOUNDARY LENGTH CTR S ISZ \MODEEBNDCNT S SKP S JMP \483 /IF =4096, THEN WRAP AROUND FAIL AT [14.1] C C C@C*****DEBUG**** C@S 6344 /FBW4 C@S AND (0400 /BIT 3 C@S SNA CLA C@S JMP \1906 C@ CALL DPCVRT(LIST,FA,-1) C@ IP=LIST C@S TAD \LIST# C@S DCA \IP# C@ CALL BNODE(KX,KY,IP,7) C@ CALL DPCVRT(IP,FB,-1) C@ WRITE(3,1990)FA,FB,KX,KY C@1990 FORMAT(' SB2[7] LST=',F7.0,', BK=',F7.0,' IX,IY=',2I5) C@1906 CONTINUE C@C********************* C C C [7.1] FIND THE TOP (X,Y) OF THE BND AT 0 AND 90 DEGREES. C THE 1ST OCCURANCE OF MIN(KY1,IY) AND SAVE THE PTR TO BND C NODE L0LIST<==BACK(LIST). C THE 1ST OCCURANCE OF THE MAX(KX2,IX) C AND SAVE THE POINTER TO THE BOUNDARY NODE L90LIST<==BACK(LIST[1:2]) C FOR USE LATER IN COMPUTING 90 DEGREE ROTATION OF RLM BPSEMANTICS. C C TEST 0 DEGREES S TAD \KY1 S CIA S TAD \IY S SMA CLA /SKIP IF KY1 > IY S JMP T90 /NO KY1=IY C C L0LIST[1:2]<==BACK(LIST[1:2]) L0LIST=LIST S TAD \LIST# S DCA \L0LIST# C NOTE: KLASTXY=7 CALL BNODE(FA,FA,L0LIST,7) C C TEST 90 DEGREES S T90, TAD \IX S CIA S TAD \KX2 S SMA CLA /SKIP IF KX2SET; C CREATE THE DESCRIPTOR! GET A NODE C IF LFTLIST[1:2]=PHI THEN LFTLIST[1:2]_GETNODE; C C IF LFTLIST=NIL C THEN LFTLIST_IB_NEW(LIST) C ELSE IB_APPENDXY TO LFTLIST; C S TAD \LFTLIST# S SMA CLA S JMP \499 /LIST, EXISTS, APPEND IT; C ** KGETLIST=5 CALL BNODE(0,0,LFTLIST,5) C COPY POINTER BACK IB=LFTLIST S TAD \LFTLIST# S DCA \IB# C GOTO 497 C C C [13.1] APPEND NODE TO LFTLIST LIST AND GET ITS PTR INTO IB. C ** KAPPENDXY=1 499 CALL BNODE(0,0,LFTLIST,1) C GET THE POINTER TO THE NEW NODE (BK PTR) DO C ** KLASTXY=7 C NOTE: NODE IS TRASH VARIABLE! IB=LFTLIST S TAD \LFTLIST# S DCA \IB# CALL BNODE(NODE,NODE,IB,7) C C C [13.2] UPDATE Q-REGISTER CC# COUNTER C QRC<==NC 497 ITMPSTK(3)=NC C C C [13.3] INSTANTIATE THE PROP LIST C@ CALL STPROP(IB,IMONR,MODEEBNDCNT,FILE,CURSYM,EXT,KX1 C@ 1,KX2,KY1,KY2,NC,LIST) C RETURN CC# IZ=NC C C C [13.4] FREE THE RLM C***==>BUG<==**** CALL BRUN(0,0,KBRK,12) C C C [13.5] RESET THE 0 DEGREE LIST PTR AND TEST I90DEGREE=0 LIST=L0LIST S TAD \L0LIST# S DCA \LIST# C C IF /B THEN DUMP THE BOUNDARY C NOTE: BACKUP THE POINTER ONLY ONCE! LSDUMP=1 S TAD \ISW# S SZA CLA S JMS FILL GOTO 2047 C C C [14] ELSE FREE THE LIST AND TRASH CC# C ERASE TRACE AND CC 486 LSSAVE=0 LSDUMP=0 S JMS PROP /ERASE S JMS FILL /ERASE C C C [14.1] LOST CC, EXIT 485 CONTINUE C***==>BUG<==**** CALL BNODE(0,0,LIST,6) C BACKUP THE CC COUNTER NC=-1+NC C RETURN NC IN IZ IZ=NC C C C [14.2] FREE THE RLM C***==>BUG<==**** CALL BRUN(0,0,KBRK,12) C GOTO 2047 C ******************************************************* C *SUBROUTINE F I L L C ******************************************************* C C C COMPUTE RLM FROM BOUNDARY IN LIST. THEN IF /H (LSFILL=1) THEN C FILL IN JBM HOLES WITH NC GRAY VALUE SUCH THAT A HOLE C IS DEFINED TO BE A 0 PIXEL INSIDE OF A BOUNDARY DEFINED C BY A NC GRAY VALUE BOUNDARY PIXEL. C LSUMSK=1 FOR DRAWING MASK (/T) IN (MEM,1-IBYTE) C C THE SEMANTIC LABEL INDEX IS STORED IN THE RIGHT PTR C BITS [4:9] FOR 90 DEGREES AND BITS [10:15] FOR 0 DEGREES. C C IF I90DEGREE=1 C THEN ROTATE (X,Y) 90 DEGREES BY: C Y'<==255-X' C X'<==Y; C S CPAGE 3 S RFILL, JMP I FILL S FILL, 0 /ENTRY C [FILL.1] ZERO THE RLM AND ENTER LOOKBACK(X,Y) FOR 1ST POINT MEM=JBM IBYTE=JHGH C C@C****DEBUG**** C@S 6344 /FBW4 C@S AND (0400 C@S SNA CLA C@S JMP NONDPRINT C@ CALL BNODE(3,0,LIST,3) C@S NONDPRINT, CLA C@C******************* IA=LIST S TAD \LIST# S DCA \IA# C C ZERO THE POINT COUNTER IBPCNT=0 C C BACKUP FIRST AND GET DATA C COMPUTE: KLASTXY=7 CALL BNODE(IX,IY,IA,7) C C SAVE IB=BACK(IA_LIST); IB=IA S TAD \IA# S DCA \IB# C C C IF I90DEGREE=1 C THEN ROTATE90(X,Y); S JMS ROTATE90 C C IF I90DEGREE=1 C THEN DON'T WRITE PIXELS S TAD \I90DEGREE S SZA CLA S JMP \139 C C C [FILL.1.0.1] ZERO FIRST PIXEL IN AND C IF /T AND (LSDUMP=0) C THEN WRITE OUT ZERO ==> . S TAD \LSDUMP S SZA CLA S JMP \140 /GOTO [FILL.1.1] C IZ=0 CALL PACK2D C S TAD \LSUMSK S SNA CLA S JMP \139 /NO SWITCH C WRITE IT OUT IBYTE=1-IBYTE IZ=0 CALL PACK2D IBYTE=1-IBYTE C C C ZERO THE RLM AND ENTER LA. 139 CALL BRUN(IX,IY,KBRK,1) GOTO 142 C C C C [FILL.1.1] IFDUMP=1 C THEN DUMP FIRST (IX,IY) C WRITE OUT (IX,IY,CHAIN CODE, BPSEMANTICS) OF LIST[1:2] NODE S\140, JMS DMP5TUPLE C C C [FILL.2] TRACE BOUNDARY AND ENTER POINTS INTO RLM. C GET THE XY FROM THE HEADER NODE. C FIRST SAVE CURRENT POINTER 142 IC=IA S TAD \IA# S DCA \IC# C C COMPUTE: KNEXTXY=8 CALL BNODE(IX,IY,IB,8) C IF I90DEGREE=1 C THEN ROTATE90(X,Y); S JMS ROTATE90 C C C [FILL.2.1] BOUNDARY TRACING LOOP: ENTER (IX,IY)==>RLM C IF LSDUMP=0 C IF LSSAVE=0 C THEN GOTO [FILL.2.3]; C NOTE: NODE[1:3] A6 CONTAINS "DID" VARIABLE AND THE IDID INDEX C VARIABLE IS RETURNED IN THE MQ. S\137, TAD \LSDUMP S SZA CLA S JMP \143 /ELSE DUMP C S TAD \LSSAVE S SNA CLA S JMP \144 /GOTO [FILL.2.3] C CALL BRUN(IX,IY,NODE,2) C C SAVE THE SEMANTICS ON THE "IDID" VARIABLE (RETURNED IN MQ) C BY STORING IT C IN THE NODE'S RIGHT 12 BITS (EITHER LEFT 6-BITS FOR 90 DEGREES C OR RIGHT 6-BITS FOR 0 DEGREES). S JMS BPSEMANTICS GOTO 144 C C C [FILL.2.2] ELSE DUMP (IX,IY,CHAIN CODE, BPSEMANTICS) C GET CHAIN CODE AND BPSEMANTICS FROM THE RIGHT PTR FIELD S\143, JMS DMP5TUPLE C C C [FILL.2.3] LOAD DISPLAYS S \144, TAD \IX S DISP1 S TAD \IY S DISP2 C C LOAD CURSOR OVER BMJ S TAD \KODTN S TAD \IX S LDXP C S TAD \KODTM S TAD \IY S LDYP C C C [FILL.2.4] IF LSSAVE=0 AND (I90DEGREE=0) C THEN WRITE 0==> BOUNDARY TRACE S TAD \LSSAVE S SZA CLA S JMP \138 /NOT TRASHING C S TAD \I90DEGREE S SZA CLA S JMP \138 /NOT TRASHING C C C [FILL.2.4.1] ZERO PIXEL IN AND C IF /T SWITCH THEN WRITE OUT ZERO ==> . IZ=0 CALL PACK2D C S TAD \LSUMSK S SNA CLA S JMP \138 /NO SWITCH C WRITE IT OUT IBYTE=1-IBYTE IZ=0 CALL PACK2D IBYTE=1-IBYTE C C C [FILL.2.5] TEST IF GET OUT! S CPAGE 3 S\138, JMS TTYCTL S JMP \2046 /RETURN TO SEGBND.FT C C C [FILL.2.6] LOOP TO FIND STARTING POINT C FIRST BACKUP THE LIST PTR FOR BPSEMANTICS IN [FILL.2.1] C FIRST SAVE CURRENT POINTER IC=IB S TAD \IB# S DCA \IC# C C COMPUTE: KNEXTXY=8 CALL BNODE(IX,IY,IB,8) C C IF I90DEGREE=1 C THEN ROTATE90(X,Y); S JMS ROTATE90 C C C [FILL.2.7] TEST IF DONE. C IF (IA[1:2]=IB[1:2]) C THEN "DONE" GOTO [FILL.2.8] C ELSE GOTO [FILL.2.1]; S TAD \IA S CIA S TAD \IB S SZA CLA S JMP \137 /NOT DONE, GOTO [FILL.2.1] C S TAD \IA# S CIA S TAD \IB# S SZA CLA S JMP \137 /NOT DONE, GOTO [FILL.2.1] C C C C [FILL.2.8] DONE! C IF LSDUMP=1 C THEN OUTPUT (-1,0) S TAD \LSDUMP S SNA CLA S JMP \170 /GOTO [FILL.2.9] C S CLA CMA S DCA \IVAL S DCA \IVAL# WRITE(4,1401)IVAL S JMP RFILL /RETURN C C C C [FILL.2.9] CLOSE THE RLM AND TEST IF FILL. C CLOSE THE RLM WITH LAST POINT=FIRST POINT. 170 CALL BRUN(IX,IY,NODE,6) C NOTE: "IDID" INDEX RETURNED IN THE MQ; S JMS BPSEMANTICS C C TEST IF DO FILL! C IF LSSAVE=1 AND I90DEGREE=0 C THEN FILL C ELSE RETURN; S TAD \I90DEGREE S SZA CLA S JMP RFILL/ RETURN C S TAD \LSSAVE S SNA CLA S JMP RFILL /ELSE RETURN C C C*************DEBUG****** S 6344 S AND (2000 /BIT 1 S SNA CLA S JMP \1977 /NO KBRK=3 CALL BRUN(KY1,KY2,KBRK,3) CALL BRUN(KY1,KY2,KBRK,7) 1977 CONTINUE C************************** C C [FILL.3] GET WINDOW CALL BRUN(KY1,KY2,KBRK,3) CALL BRUN(KX1,KX2,KBRK,4) C C LOAD (X,Y) OFFSETS OF MEM. CALL BWINDOW(KODTN,0,KODTM,0,8) C LOAD WINDOW INTO F&S CALL BWINDOW(KX1,KX2,KY1,KY2, 2) C C ADD 1 FOR DO LOOPS S INC \KY1 S INC \KY2 C C ZERO AREA COUNTER FOR FILLED HOLES IMONR=0 S DCA \IMONR# C C C [FILL.4] IF LSFILL=0 OR LSSAVE=0 C THEN "DON'T FILL", RETURN C ELSE GET RUNS AND COPY PIXELS S TAD \LSFILL S SNA CLA S JMP \145 /DON'T FILL C S TAD \LSSAVE S SNA CLA S JMP \145 /DON'T FILL C DO 141 IY1=KY1,KY2 IY=-1+IY1 C S CPAGE 3 S JMS TTYCTL S JMP \2046 /RETURN TO SEGBND.FT /GET OUT C C C [FILL.4.1] TEST IF ANY RUNS CALL BRUN(0,IY,LCNT,8) S TAD \LCNT S SNA CLA S JMP \141 /NO RUNS C C C [FILL.4.2] COPY THIS RUN C PASS LINE # IN KY ARG, RUN # IN KX ARG DO 141 KWC=1,LCNT KX1=KWC KX2=IY CALL BRUN(KX1,KX2,KBRK,9) C NOTE: THE RUNS ARE IN [0:255] AND NEED TO BE MAPPED TO [1:256]. S INC \KX1 S INC \KX2 C DO 141 IX1=KX1,KX2 IY=-1+IY1 IX=-1+IX1 C C LOAD DISPLAYS S TAD \IX S DISP1 S TAD \IY S DISP2 C C LOAD CURSOR OVER BMJ S TAD \KODTN S TAD \IX S LDXP C S TAD \KODTM S TAD \IY S LDYP C C IF IZ(IX,IY)=0 C THEN IZ=NC CALL FETCH2D S TAD \IZ S SZA CLA S JMP \141 /OK IZ=NC CALL PACK2D C C COLOR IN IZ=70 IZ=70 IBYTE=1-IBYTE CALL PACK2D IBYTE=1-IBYTE C INCREMENT THE FILLED AREA FOR HOLES S ISZ \IMONR S SKP S ISZ \IMONR# S CLA C 141 CONTINUE C C C [FILL.5] UPDATE THE WINDOW FOR USE IN PRINTING THE HEADER 145 CALL BRUN(KX1,KX2,KBRK,4) C INCREMENT FOR DO LOOPS S ISZ \KX1 S CLA S ISZ \KX2 S CLA S JMP RFILL /RETURN C C C ******************************************************* C *SUBROUTINE P R O P C ******************************************************* C PROPAGATE 1'S INSIDE THE RLM TI NC'S. C C FOR (ALL X,Y) IN RLM DO C IF LSSAVE=1 C THEN IF IZ(IX,IY)=1 C THEN IZ(IX,IY)<==NC C ELSE IZ(IX,IY)<==0; C S CPAGE 3 SRPROP, JMP I PROP S PROP, 0 /ENTRY C C C [1] INIT C ZERO DENSITY EXT=0.0 C ZERO AREA FILE=0.0 C C C [2] SCAN THROUGH THE IMAGE DO 1600 IY1=KY1,KY2 IY=-1+IY1 C S CPAGE 3 S JMS TTYCTL S JMP \2046 /RETURN TO SEGBND.FT C C GET THE MAX # OF RUNS FOR LINE IY CALL BRUN(0,IY,LCNT,8) C C C GET THE RANGE OF BOUNDARY DO 1600 KWC=1,LCNT KX1=KWC KX2=IY CALL BRUN(KX1,KX2,KBRK,9) C C COMPUTE AREA AS THE SUM OF CHORDS (RUNS) IZ=1+KX2-KX1 FILE=FILE+FLOAT(IZ) C C DO NOT DO EDGE OF BOUNDARY KX1=2+KX1 KX2=KX2 C DO 1600 IX1=KX1,KX2 IY=-1+IY1 IX=-1+IX1 C C LOAD DISPLAYS S TAD \IX S DISP1 S TAD \IY S DISP2 C C LOAD CURSOR OVER BMJ S TAD \KODTN S TAD \IX S LDXP C S TAD \KODTM S TAD \IY S LDYP C C C GET THE PIXEL IF BMI2 EXISTS C ELSE GET IT FROM IBM1 MEM=IBM1 IBYTE=IHGH1 C S TAD \SEXT /BMI2 COPY S TAD (-0215 /"BM" S SZA CLA S JMP \1601 C C COMPUTE DENSITY MEM=IBM2 IBYTE=IHGH2 C 1601 CALL FETCH2D C D.P. ADD S CPAGE 10 S TAD \IZ S SWAB C S DAD S \EXT C S DST S \EXT S SWBA S CLAMQ C C RESET MEM MEM=JBM C C C IF LSSAVE=0 C THEN IZ(IX,IY)<==0, IZ'(IX,IY)<==0; S TAD \LSSAVE S SZA CLA S JMP \1603 IZ=0 IBYTE=1-JHGH CALL PACK2D GOTO 1602 C C C GET BMJ PIXEL DENSITY 1603 IBYTE=JHGH CALL FETCH2D C ELSE PROP; C IF IZ=1 C THEN IZ_NC; S CLA CMA S TAD \IZ S SZA CLA S JMP \1600 /DO NOT TEST IF PROP C C YES,PROPAGATE IZ=NC C C WRITE OUT IZ(IX,IY) INTO . 1602 IBYTE=JHGH CALL PACK2D C 1600 CONTINUE C S JMP RPROP C C ************************************************************ C SUBROUTINE: T T Y C T L (INTERNAL) C ************************************************************ C S CPAGE 3 S RTTYC, JMP I TTYCTL S TTYCTL, 0000 /ENTRY C S KSF /ANYTHING TYPED S JMP NORMAL /NO, RETURN NORMALLY S KRB /GET TYPED CHARACTER S AND (0177 /TAKE CARE OF PARITY PROBLEMS S TAD (-17 /TEST FOR CTRL/O S SNA /SKIP IF NOT CTRL/O S JMP RTTYC /ABORT CALLING ROUTINE (ERROR RETURN) S TAD (-4 /TEST FOR CTRL/S [-17-4=-23(OCTAL)] S SZA CLA /SKIP IF CTRL/S S JMP NORMAL /NOT CTRL/O OR CTRL/S SO RETURN NORMALLY C S SLEEP,KSF /WAIT FOR CTRL/Q S JMP SLEEP /KEEP WAITING S KRB /READ CHARACTER S AND (0177 S TAD (-17 /IS IT A CTRL/O? S SNA /SKIP IF NOT S JMP RTTYC /YES, ABORT S TAD (-2 /TEST FOR CTRL/Q (-17-2=-21(OCTAL)) S SZA CLA /SKIP IF SO S JMP SLEEP /NOPE, KEEP SLEEPING C S NORMAL,INC TTYCTL /INCREMENT RETURN ADDRESS FOR NORMAL RETURN S CLA /SAFETY VALVE S JMP RTTYC /RETURN C ***************************************************** C *SUBROUTINE C H A I N C O D E C ***************************************************** C IF /X C THEN ADD THE DIRECTION CHAIN CODE CONTAINED IN THE MQ[9:11] C TO THE HIGH 4 BITS OF 16-BIT RIGHT PTR C OF LAST POINT POINTED TO BY "LIST[1:2]". S CPAGE 3 S RCHAINCODE, JMP I CHAINCODE S CHAINCODE, 0 S MQA S DCA \IZ /SAVE CHAIN CODE C C IF /X C THEN CONTINUE ELSE RETURN S TAD \ISWX S SNA CLA S JMP RCHAINCODE C GET THE REAR OF THE LIST IPTR=LIST S TAD \LIST# S DCA \IPTR# C ** KLASTXY=7 CALL BNODE(NODE,NODE,IPTR,7) C C ** KREADINFO=18 CALL BNODE(NODE,0,IPTR,18) C C SET HIGH RIGHT PTR<==C(MQ) S TAD \IZ S DCA \NODE# /NODE(2,1) C C ** KWRITEINFO=17 CALL BNODE(NODE,0,IPTR,17) S JMP RCHAINCODE C ***************************************************** C *SUBROUTINE B P S E M A N T I C S C ***************************************************** C ADD THE INDEX OF THE BOUNDARY POINT SEMANTIC "IDID" C VARIABLE OBTAINED FROM THE BRUN PROCEDURE RETURNED IN THE MQ C TO THE LOW 12 BITS OF 16-BIT RIGHT PTR C OF THE LIST POINTED TO BY IC[1:2]. C IF I90DEGREE=1 C THEN XOR IT INTO BITS 4:9 ELSE BITS 10:15. S CPAGE 3 S RBPSEMANTICS, JMP I BPSEMANTICS S BPSEMANTICS, 0 C IF NOT /X C THEN RETURN S TAD \ISWX S SNA CLA S JMP RBPSEMANTICS C C SAVE INDEX S CLA S MQA /GET "IDID" S DCA \IZ C C ** KREADINFO=18 C READ 3 WORDS INFO FROM FIELD OF NODE 1414 CALL BNODE(NODE,0,IC,18) C C XOR LEFT OR RIGHT 6-BITS OF LOW 12-BITS S TAD \I90DEGREE S CLL RAR /MOVE BIT 11 TO LINK FOR LATER TESTING S CLA S TAD \IZ S AND (0077 /MAKE SURE NO OVERLAP BETWEEN S1&S2 FIELDS S SZL S BSW /90 DEG S MQL /SAVE INDEX S TAD (0077 /BIT PATTERN S SNL S BSW /(7700 MASK FOR 0 DEG) (0077 MASK FOR 90 DEG) S DCA 7 S TAD \NODE S AND 7 S MQA /OR BACK IN DATA S DCA \NODE C C ** KWRITEINFO=17 C WRITE 3 WORDS INTO INFO FIELD OF NODE CALL BNODE(NODE,0,IC,17) C****DEBUG**** S 6344 /FBW4 S AND (0400 S SNA CLA S JMP RBPSEMANTICS WRITE(3,1955)IX,IY,IZ 1955 FORMAT(' [BPSEM] [',I3,',',I3,'] SEM=',I5,/) C************************** S JMP RBPSEMANTICS C ***************************************************** C *SUBROUTINE D M P 5 T U P L E C ***************************************************** C DUMP (IX,IY,CHAIN CODE, BPSEMANTICS) NODE POINTED TO BY IB[1:2] C IN 5I5 FORMAT ON C THE FORTRAN II GENERAL I/O CHANNEL IN ASCII. C S CPAGE 3 S RDMP5TUPLE, JMP I DMP5TUPLE S DMP5TUPLE, 0 C DUMP (IX,IY,CHAIN CODE, BPSEMANTICS) C GET CHAIN CODE AND BPSEMANTICS FROM THE RIGHT PTR FIELD C ** KREADINFO=18 CALL BNODE(IBUF1,0,IB,18) C GET CHAIN CODE S TAD \IBUF1# S DCA \KX C GET THE BPSEMANTICS HASH CODE S TAD \IBUF1 S AND (77 /0 DEGREES S DCA \KY S TAD \IBUF1 /GET 90 DEGREE LABEL INDEX S BSW S AND (77 S DCA \IZ C C IF /X S TAD \ISWX S SNA CLA S JMP \1403 C C THEN DUMP 4-TUPLE WRITE(4,1401)IX,IY,KX,KY,IZ 1401 FORMAT(5I5) S JMP RDMP5TUPLE C C ELSE WRITE JUST ,Y 1403 WRITE(4,1401)IX,IY S JMP RDMP5TUPLE C ***************************************************** C *SUBROUTINE R O T A T E 9 0 C ***************************************************** C IF I90DEGREE=1 C THEN ROTATE (X,Y) 90 DEGREES C S CPAGE 3 S RROTATE90, JMP I ROTATE90 S ROTATE90, 0 C C COUNT IBPCNT S ISZ \IBPCNT S CLA C C*****DEBUG**** S 6344 /FBW4 S AND (0400 S SNA CLA S JMP DOR90 WRITE(3,1942)IBPCNT,IX,IY 1942 FORMAT(' [R90] #',I5,'[',I3,',',I3,']') S DOR90, CLA C**************** C S TAD \I90DEGREE S SNA CLA S JMP RROTATE90 C C DO ROTATION S TAD \IY S MQL IY=255-IX C S MQA S DCA \IX S JMP RROTATE90 C POINTERS C -------- C RETURN TO SEGBND.FT VIA RETURN STATEMENT S \2046, RETRN SEGB1 C C C S PNODE, \NODE /PTR C S PISW, \ISW ISWX=0 END