C PROGRAM SEG22.FT C ---------------- C C SUBROUTINE SEG22(JM,JB,JX1,JX2,JY1,JY2,PUC,JL,JU,JOS) C 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 OCT 22, 1976 C OCT 20, 1976 C OCT 18, 1976 C OCT 14, 1976 C OCT 13, 1976 C OCT 1, 1976 C C C C INTRODUCTION C ------------ C SEG22.FT IS A SUBROUTINE USED WITH SEG2PS.FT C C SEG22 PERFORMS A 2 PASS RASTER SEGMENTATION (C.F. C ROSENFELD CHAP 8, 1969). C THE ALGORITHM LOOKS FOR PIXEL AREAS IN AN INITIALLY BINARY C IMAGE AND LABELS THEM WITH POSITIVE COMPONENT NUMBERS C > 1. IT THEN KEEPS TRACK OF COMPONENTS TO BE MERGED AND C MERGES THEM ON THE 2ND PASS. C C THREE CASES CAUSE A MERGE TO BE PERFORMED. IF B AND A C ARE DIFFERENT COMPONENT NUMBERS, THEN, C C (1) -B- C -A- C C (2) --B C -A- C C (3) --- C A1- =>AA- C C CASES (1) AND (2) ==> MERGE COMPONENT B INTO COMPONENT A. C C OPDEFS C ------ S OPDEF TADI 1400 S OPDEF DCAI 3400 C S OPDEF DISP1 6435 S OPDEF DISP2 6436 C C S OPDEF SWAB 7431 S OPDEF SWBA 7447 C S OPDEF MQA 7501 S OPDEF MQL 7421 S OPDEF KRS 6034 S OPDEF BSW 7002 C C C C DIMENSION JUNK1(2),MAP(258) DIMENSION MTO(256) DIMENSION MFROM(256) DIMENSION JUNK2(2),LINE(258),LSTLINE(258) DIMENSION AREA(256) C [1] INIT C C [1.1] COPY PARAMS BY VALUE MEM=JM IBYTE=JB KX1=JX1 KX2=JX2 KY1=JY1 KY2=JY2 ILSIZE=JL IUSIZE=JU C FORCE IT TO BE 2047 IF 0 S TAD \IUSIZE S AND (3777 S SNA S TAD (D2047 S DCA \IUSIZE IOUTSPOOL=JOS C C C [1.2] ZERO ARRAYS DO 100 I=1,256 MAP(I)=I-1 MTO(I)=0 MFROM(I)=0 LSTLINE(I)=0 100 AREA(I)=0 M=0 NC=1 C C C [1.3] DEFINE BMOMNI CALLS MRDLINE=12 MWTLINE=13 MFETCH2D=10 MPACK2D=11 C C C [1.4] READ IN LINE KY1==>LINE CALL BMOMNI(IMEM,IBYTE,0,(KY1-1),0,LINE,MRDLINE) C [1.5] LOOK FOR 1'S AND MAKE NEW SEGMENT ON LINE 0 C CHECK LEFT ENDPOINT IF(LINE(KX1)-1)101,102,101 C YES, MAKE NEW SEGMENT 102 NC=NC+1 LINE(1)=NC AREA(NC)=1.0 C C [1.5.1] LOOK AT REST OF LINE 0 101 JX1=KX1+1 DO 103 IX1=JX1,KX2 IF(LINE(IX1)-1)103,104,103 C THEN C ****BEGIN ALPHA***** C YES, MAKE NEW SEGMENT IF NOT ADJ TO LAST NC 104 JC=LINE(IX1-1) IF(JC)106,105,106 105 NC=NC+1 JC=NC 106 LINE(IX1)=JC AREA(JC)=AREA(JC)+1.0 C ****END ALPHA*** 103 CONTINUE C C C [2] LOOK FOR 1'S ON LINES KY1+1:KY2 AND GENERATE COMPONENTS JY1=KY1+1 DO 200 IY1=JY1,KY2 IY=IY1-1 S TAD \IY S DISP2 C S CPAGE 3 S JMS TTYCTL S JMP \2047 /END C C C [2.1] MOVE LINE==>LSTLINE, C THEN READ IN LINE IY DO 218 IX1=KX1,KX2 218 LSTLINE(IX1)=LINE(IX1) CALL BMOMNI(MEM,IBYTE,0,IY,0,LINE,MRDLINE) C C C [2.2] ANALYZE LINE IY DO 201 IX1=KX1,KX2 IX=IX1-1 S TAD \IX1 S DISP1 C C [2.2.1] TEST IF LEFT ACTIVE PIXEL IF(IX1-KX1)220,220,211 C THEN 211 IF(LINE(KX1)-1)220,212,220 C THEN C ****BEGIN BETA**** C TEST IF CASE OF: C (Y-1) - NC - C (Y ) 1 - - 212 IF(LSTLINE(IX1)-1)213,213,214 C C THEN C ****BEGIN ZETA*** 214 JT=LSTLINE(IX1) LINE(KX1)=JT AREA(JT)=AREA(JT)+1.0 C TEST IF CASE OF: C (Y-1) - B - C (Y ) A B - C THEN MERGE B==>A JF=LINE(IX1-1) IF(JF)219,201,219 219 IF(JT-JF)228,201,228 C THEN DO MERGE C ELSE CONTINUE [2.2] C ***** END ZETA***** C C C C TEST IF CASE OF: C (Y-1) - 0 NC C (Y ) - 1 - 213 JC=LSTLINE(KX1+1) IF(JC-1)217,217,216 C THEN C *****BEGIN OMEGA**** 216 NC=NC+1 JC=NC 217 LINE(KX1)=JC AREA(JC)=AREA(JC)+1.0 GOTO 201 C ****END OMEGA*** C ****END BETA*** C C C [2.2.2] TEST IF ACTIVE PIXEL IN REST OF LINE 220 IF (LINE(IX1)-1) 201,221,201 C THEN C ****BEGIN DELTA**** C TEST IF CASE OF: C (Y) NC 1 - 221 JT=LINE(IX1-1) IF(JT-1)222,222,223 C THEN 223 LINE(IX1)=JT AREA(JT)=AREA(JT)+1.0 C C [2.2.3] CHECK BEFORE MERGE" C TEST IF CASE OF: C (Y-1) - B C (Y ) A - C THEN MERGE 222 JF=LSTLINE(IX1) IF(JF)224,225,224 225 IF(IX1-KX2)226,224,224 C THEN 226 JF=LSTLINE(IX1+1) C 224 IF(JF)227,227,231 C IF(JF-JT)228,201,228 C ****BEGIN GAMMA**** 228 M=M+1 IF(M-256)229,229,2046 C THEN "MERGE" JF TO JT 229 MTO(M)=JT MFROM(M)=JF C ***END GAMMA*** 227 CONTINUE C ****END DELTA**** C 201 CONTINUE C COPY LSTLINE<==LINE DO 230 IX1=KX1,KX2 230 LSTLINE(IX1)=LINE(IX1) C C WRITE OUT THE LINE. CALL BMOMNI(MEM,IBYTE,0,IY,0,LINE,MWTLINE) 200 CONTINUE C C C [3] DO MERGE BY COMPUTING ALL TRANSITIVE RELATIONS C AND GENERATING A 2ND PASS MAPPING FUNCTION C C SCAN TO/FROM TABLES AND GENERATE MAP FUNCTION C C DO 300 J=1,M JT=MTO(J) JF=MFROM(J) MAP(JF)=MAP(JT) 300 AREA(JT)=AREA(JT)+AREA(JF) C [4] REMAP IMAGE TO ORDERED COMPONENTS WITH SIZING DO 400 IY1=KY1,KY2 IY=IY1-1 S TAD \IY S DISP2 S CPAGE 3 S JMS TTYCTL S JMP \2047 /EXIT C C GET LINE CALL BMOMNI(MEM,IBYTE,0,IY,0,LINE,MRDLINE) C C DO REMAP DO 401 IX1=KX1,KX2 IX=IX1-1 S TAD \IX S DISP1 IP=LINE(IX1) IQ=MAP(IP) IA=AREA(IQ)*PUC*PUC C C DO SIZING IF(IA-ILSIZE)402,403,403 403 IF(IA-IUSIZE)402,404,404 402 IP=0 404 LINE(IX1)=IP 401 CONTINUE C C WRITE OUT THE LINE CALL BMOMNI(MEM,IBYTE,0,IY,0,LINE,MWTLINE) 400 CONTINUE C [5] RETURN 2047 RETURN 2046 WRITE(1,2045) 2045 FORMAT('TOO MANY COMPONENTS') GOTO 2047 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 C *********PARAMETERS****** C C************** P A R A M E T E R S ************* C S PMTO, \MTO S PMFROM, \MFROM S PAREA, \AREA S PLINE, \LINE S PLSTLINE, \LSTLINE END