C PROGRAM BP2.FT 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 JUNE 21, 1977 C C C C INTRODUCTION C ------------ C BP2.FT IS A CHAINED PROGRAM USED WITH BMON2 C IT RECEIVES ITS ARGUMENTS FROM THE CD AREA AND THE IBM1,IHGH1 C IBM2,IHGH2, JBM, JHGH VARIABLES IN COMMON. COMMON IS RESTORED C FIRST BEFORE THE FUNCTION (TO BE INSERTED INTO THE BODY) IS C EVALUATED. AFTER THE FUNCTION IS PERFORMED, COMMON C IS SAVED AND BMON2 IS CHAINED BACK TO. C ANY COMPUTATIONS ARE DONE, THE ARGUMENTS ARE THEN CHECKED C C *(Opt )_BP2, (Opt. /Q /T /L), C (Opt lower CC,upper CC#), (Opt. semantic labeling s) - C BP2 PRINTS THE REMAPED RLM B.P. SEMANTIC LABELING C NAMES FOR THE XY VALUES IN THE SPECIFIED INPUT FILE ON THE LPT:. C C IF /Q IS SPECIFIED THEN DO NOT PRINT THE SPECIFIC XY POINT DATA C BUT ONLY THE SUMMARIES. C C IF /L IS SPECIFIED THEN LABEL POINTS WITH THE CORRESPONDING C SEMANTIC LABEL IN ( TRANSFORM X AND Y AS FOLLOWS IF /T C IS SPECIFIED: C Y' = 255-X, C X' = Y. C C USES BENDING ENERGY COMPUTED USING CHAIN CODE DIFFERENCES C FROM PAPER BY TED YOUNG, INF. CONTROL, 25, 357:370, 1974. C OPDEFS C ------ S OPDEF TADI 1400 S OPDEF ISZI 2400 S OPDEF DCAI 3400 C C S OPDEF MQA 7501 S OPDEF MQL 7421 S OPDEF KRS 6034 S OPDEF BSW 7002 C C S OPDEF LDXP 6443 S OPDEF LDYP 6444 DIMENSION KNAME(3) EQUIVALENCE(KNAME,PNAME) C DIMENSION HDR(14) C C [1] INITIALIZATION WRITE(1,995) WRITE(3,995) 995 FORMAT('1 BP2 6/16/77 - 4:01PM') FA=TIMER(0) C C C GET SEMANTIC LABELING NAME DO 123 I=1,3 123 KNAME(I)=KINFILE(I+16) C C SAVE THE BMJ OFFSETS IXOFFSET=LSAVE(13,JBM+1) IYOFFSET=LSAVE(14,JBM+1) C C GET /Q SWITCH IQSW=ISW(17) C C SAVE THE /T SWITCH ITSW=ISW(20) C C C [2] VERIFY BM SPECS C IF /L THEN CHKOUT ILSW=ISW(12) S TAD \ILSW S SZA CLA S JMS CKOUT C C C C [3] OPEN THE INPUT FILE DEV=GETDEVICE(KDEVIN(2)) IZ=IBNDREAD(DEV,KINFILE(5),IBUF1,IX,IY,ICHAIN,SEM,ISEM,1) C IF(IZ)999,330,999 C C C [4] READ UNTIL MATCH OR EOF 330 CONTINUE IY=ICNUM S TAD \ICNUM# S DCA \ICHAIN C C SETUP SIZING DEFAULTS IVAL=2 C IF ICNUM NEQ 0 C THEN IVAL_IVAL+1 S TAD \ICNUM S SZA CLA S INC \IVAL C C IF ICNUM(2) NEQ 0 C THEN IVAL_IVAL+1 S TAD \ICNUM# S SZA CLA S INC \IVAL# C C SET TO PRINT HEADER IF NOT /L IX=1-ILSW C IZ=IBNDREAD(0,0,HDR,IX,IY,ICHAIN,SEM,ISEM,IVAL) C GET THE NUMBER OF BOUNDARY POINTS BP=HDR(11) C C IF (ICNUM LEQ NC LEQ ICNUM(2)) C THEN IOUTSPOOL_1 "PRINT HEADER" ELSE IOUTSPOOL_0; IOUTSPOOL=1+IZ C C ZERO FREQ DISTR. ARRAYS DO 500 IX=1,512 S CLA CMA S TAD PIBUF1 S CPAGE 5 S TAD \IX S DCA 7 S DCAI 7 500 CONTINUE C C ZERO BENDING ENERGY CURSYM=0.0 C C SET FIRST SWITCH IX2=-1 C C C [5] READ AND PRINT (X,Y,CHCODE,LOOKUP(BMSEMANTIC) 324 IZ=IBNDREAD(0,0, HDR,IX,IY,ICHAIN,SEMBP,ISEM,6) C S CPAGE 3 S JMS TTYCTL S JMP \998 /DONE! C C C [5.1] IF IZ GEQ 0 C THEN PRINT IT C ELSE DONE S TAD \IZ S SPA CLA S JMP \380 C C C [5.2] INCREMENT CHAIN CODE FREQ HIST AND IZ=ICHAIN C COMPUTE: IBUF2(IZ+1)=IBUF2(IZ+1)+1 S TAD PIBUF2 S CPAGE 6 S TAD \IZ S DCA 7 S ISZI 7 S CLA C C C [5.3] INCREMENT SEMBP HIST C COMPUTE: IBUF1(ISEM)=IBUF1(ISEM)+1 S CLA CMA S TAD \ISEM S TAD PIBUF1 S DCA \IZ S CPAGE 6 S TAD \IZ S DCA 7 S ISZI 7 S CLA C C C [5.4] COMPUTE CURVATURE FROM CHAIN CODE C HANDLE FIRST POINT C IF IX2=-1 C THEN IX2<==ICHAIN S TAD \IX2 S SMA CLA S JMP \600 /NOT FIRST POINT IX2=ICHAIN C C DEFINE CHAIN DIFFERENCE: IY2 600 IY2=ICHAIN-IX2 C DEFINE PATH LENGTH: FA C FC <== (I11_IX2 LAND '1)*0.207+ C (I12_ICHAIN LAND '1)*0.207+1.0; S TAD \IX2 S AND (0001 S DCA \I11 S TAD \ICHAIN S AND (0001 S DCA \I12 FC=1.0+0.207*FLOAT(I11+I12) C C DEFINE CURVATURE FA: FA=FLOAT(IY2)/FC C C COMPUTE BENDING ENERGY CURSYM=CURSYM+(FA*FA)/BP C C RENAME LAST CHAIN CODE IX2=ICHAIN C C C IF NOT (/Q OR /L) C THEN PRINT S TAD \ILSW S TAD \IQSW S SZA CLA S JMP \710 /DO NOT PRINT WRITE(3,1336)IX,IY,ICHAN,SEMBP,FA,CURSYM 1336 FORMAT(' [',I3,',',I3,'], CHAINCD.=',I2,', RLM SEM.=',A6 1,', CURV.=',F7.3,', B-ENGY=',F8.3) GOTO 324 C C C [5.5] IF /L THEN C IF SEMBP=PNAME C THEN WRITE 255 INTO (IBM,JHGH,IX,IY) S\710, TAD \ILSW S SNA CLA S JMP \324 /NO IF(SEMBP-PNAME)324,711,324 711 MEM=JBM IBYTE=JHGH C C IF /T C THEN Y_255-X, X_Y; S TAD \ITSW S SNA CLA S JMP \712 /NO TRANSFORMATION IZ=IY IY=255-IX IY=IZ C 712 IZ=255 CALL PACK2D C C LOAD IT INTO CURSOR S TAD \IXOFFSET S TAD \IX S LDXP S CLA S TAD \IYOFFSET S TAD \IY S LDYP S CLA GOTO 324 C C C [6] IF IOUTSPOOL AND NOT /L C THEN PRINT DISTRIBUTIONS S \380, TAD \IOUTSPOOL S SNA CLA S JMP \330 /NO C S TAD \ILSW S SZA CLA S JMP \330 /NO C C PRINT BENDING ENERGY WRITE(3,387)CURSYM 387 FORMAT(' BENDING ENERGY=',F9.3) DO 384 I=1,8 IX=I-1 384 WRITE(3,381)IX,IBUF2(I) 381 FORMAT(' CHAIN CODE[',I1,']=',I5) C DO 382 I=1,26 C GET SYMBOL S CLA CMA S TAD \I S DCA \IZ S TAD \IZ S CLL RAL S TAD \IZ /MULT BY 3 S TAD PTABLE S TAD (-1 S DCA 11 S TAD I 11 S DCA \KNAME S TAD I 11 S DCA \KNAME# S TAD I 11 S DCA \IZ KNAME(3)=IZ 382 WRITE(3,383)I,PNAME,IBUF1(I) 383 FORMAT(' #',I3,'[',A6,']=',I5) C GOTO 330 C C C [999] RETURN GOTO 998 999 WRITE(1,996) 996 FORMAT('BAD BM SPECIFICATION!') 998 FA=TIMER(1) CALL CHAIN('BMON2') C*************************************************** C *PROCEDURE C K O U T C****************************************************** C C C CHECK WHETHER THE OUTPUT BM SPEC IS LEGAL ELSE GOTO 999. S CPAGE 3 SRCKOUT, JMP I CKOUT S CKOUT, 0 /ENTRY C C [1] TEST IF KOUTFILE="BM" S TAD \KOUTFILE S CIA S TAD (0215 /"BM" S SZA CLA S JMP \999 /FAILED C C [2] TEST IF (KOUTFILE(2) LAND '7700)=DIGIT S TAD \KOUTFILE# S BSW S AND (0077 S TAD (-60 /"0" S SPA S JMP \999 /NO, FAILED S TAD (-D8 /"7" TEST S SMA CLA S JMP \999 /FAILED S JMP RCKOUT /OK. C 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************** P A R A M E T E R S ************* S PIBUF1, \IBUF1 S PIBUF2, \IBUF2 S PTABLE, TABLE C S PAGE S LAP S TABLE, BLOCK 0 S TEXT /CGLHSP/ S TEXT /CGRHSP/ S TEXT /CPALFT/ S TEXT /CPARHT/ S TEXT /CPNLFT/ S TEXT /CPNRHT/ S TEXT /CMPUNY/ S TEXT /DUP-PT/ S TEXT /EXALFT/ S TEXT /EXARHT/ S TEXT /EXNLFT/ S TEXT /EXNRHT/ S TEXT /HAIREP/ S TEXT /IMPLFT/ S TEXT /IMPRHT/ S TEXT /IMPLFH/ S TEXT /IMPRHH/ S TEXT /INCDPT/ S TEXT /MRGLFT/ S TEXT /MRGRHT/ S TEXT /NEWRUN/ S TEXT /NULPNT/ S TEXT /SPCW-L/ S TEXT /SPCW-R/ S TEXT /SPCCWL/ S TEXT /SPCCWR/ S EAP END