C PROGRAM GRADN.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 FEB 17, 1977 C FEB 16, 1977 C JAN 7, 1977 C DEC 14, 1976 C C C C INTRODUCTION C ------------ C GRADN.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 GRADN COMPUTES THE GRADIENT OF EACH NXN NEIGHBORHOOD of AND C STORES THAT VALUE IN . C OPDEFS C ------ C S ABSYM TOP 130 S ABSYM BOT 131 S ABSYM LEFT 132 S ABSYM RIGHT 133 C C C S OPDEF SWAB 7431 S OPDEF SWBA 7447 C S OPDEF DAD 7443 S OPDEF DST 7445 S OPDEF DCM 7575 S OPDEF MUY 7405 S OPDEF DVI 7407 C S OPDEF DISP2 6436 S OPDEF DISP1 6435 C S OPDEF CLAMQ 7621 S OPDEF MQA 7501 S OPDEF MQL 7421 S OPDEF KRS 6034 S OPDEF BSW 7002 C C DIMENSION KP(225),ITOP(2),IBOT(2),ILEFT(2),IRIGHT(2) DIMENSION IVERT(2),IHOR(2) C C C [1] INITIALIZATION WRITE(1,900) 900 FORMAT('GRADN 2/17/77 - 4:01PM') CURSYM=TIMER(0) C C VERIFY THAT ICNUM=0 OR ICNUM IS ODD C S TAD \ICNUM S SPA CLA S JMP \995 / < 0 C S TAD \ICNUM S SNA S TAD (3 /FORCE IT TO 3 S DCA \ICNUM C C IF ICNUM > 15 THEN ERROR S TAD (-D16 S TAD \ICNUM S SMA CLA S JMP \995 /ERROR C C TEST IF ICNUM IS ODD S TAD \ICNUM S AND (1 S SNA CLA S JMP \995 /ICNUM IS NOT ODD ERROR C C C COMPUTE SOME USEFUL TERMS S TAD \ICNUM S CLL RAR /DIVIDE BY 2 S DCA \LSNUM C E.G. FOR ICNUM=5, LSNUM=2. C C DEFINE THE ROW OFFSET JOFFSET=(LSNUM+1)*ICNUM C E.G. FOR ICNUM=5, JOFFSET=15 C C C [2] VERIFY BM SPECS S JMS CKIN S JMS CKOUT C@@S JMS CKIN2 C C C C [3] PROCESS IMAGE DO 200 IY1=KY1,KY2 C S CPAGE 3 S JMS TTYCTL S JMP \998 /DONE C IY=IY1-1 S TAD \IY S DISP2 C C C [3.1] PROCESS A LINE DO 200 IX1=KX1,KX2 IX=IX1-1 S TAD \IX S DISP1 C C C C [3.1.1] GET BMI NEIGHBORHOOD MEM=IBM1 IBYTE=IHGH1 IZ=ICNUM C ITOP=0 IBOT=0 ILEFT=0 IRIGHT=0 S DCA \ITOP# S DCA \IBOT# S DCA \ILEFT# S DCA \IRIGHT# CALL GETNXN(KP) C C C [3.1.2] COMPUTE: GRADN S JMS KERNAL C C C C [3.1.3] IZ==>BMJ MEM=JBM IBYTE=JHGH CALL PACK2D 200 CONTINUE C C C C C [999] RETURN GOTO 998 C C ICNUM SIZE ERROR S\995, CLA WRITE(1,994)ICNUM(1) 994 FORMAT(' ',I5,' IS EITHER NOT ODD OR IS > 15') C 999 WRITE(1,996) 996 FORMAT('BAD BM SPECIFICATION!') 998 CURSYM=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 BMTEXT 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 *PROCEDURE C K I N C****************************************************** C C C CHECK WHETHER THE INPUT BM SPEC IS LEGAL ELSE GOTO 999. S CPAGE 3 SRCKIN, JMP I CKIN S CKIN, 0 /ENTRY C C [1] TEST IF BMI1="BM" S TAD \SFILE S CIA S TAD BMTEXT S SZA CLA S JMP \999 /FAILED C C [2] TEST IF (BMI1(2) LAND '7700)=DIGIT S TAD \SFILE# 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 RCKIN /OK. C C C*************************************************** C *PROCEDURE C K I N 2 C****************************************************** C C C CHECK WHETHER THE INPUT BM SPEC IS LEGAL ELSE GOTO 999. S CPAGE 3 SRCKIN2, JMP I CKIN2 S CKIN2, 0 /ENTRY C C [1] CHECK FIRST IBM1 SPEC S JMS CKIN C C C [2] TEST IF BMI2="BM" S TAD \SEXT S CIA S TAD BMTEXT S SZA CLA S JMP \999 /FAILED C C [3] TEST IF (BMI2((6) LAND '7700)=DIGIT S TAD \SEXT# 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 RCKIN2 /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 **************************************************** C *SUBROUTINE K E R N A L C ***************************************************** C C COMPUTE IZ AS A FUNTION OF KP NEIGHBORHOOD. C C S CPAGE 3 S RKERNAL, JMP I KERNAL S KERNAL, 0/ENTRY C C C COMPUTE THE 4 DP SUMS C C DO ICNUM/2 ROWS OR COLS. DO 320 IP=1,LSNUM C C C DO ICNUM ROWS OR COLUMNS S SWAB DO 320 LSNEW=1,ICNUM C TOP ROW JT=(LSNEW+IP)-2 C C BOTTOM ROW JB=(LSNEW+IP+JOFFSET)-2 C C COMPUTE LEFT COLUMN ADDRESS (LSNEW,IP) C =(LSNEW-1)+ICNUM*(IP-1) S CLA CMA S CPAGE 6 S TAD \IP S SWAB S MUY S \ICNUM S CLA S MQA S TAD \LSNEW S TAD (-1 S DCA \JL C C C COMPUTE RIGHT COLUMN ADDRESS (LSNEW+(LSNUM+1),IP) S MQA S TAD \LSNUM S TAD \LSNEW S DCA \JR C C SET UP THE POINTERS S TAD \JT S TAD PKP /KP(1) S DCA TOP C S TAD \JB S TAD PKP S DCA BOT C S TAD \JL S TAD PKP S DCA LEFT C S TAD \JR S TAD PKP S DCA RIGHT C C C C GET THE DATA AND ADD TO THE SUMS S TAD I TOP S MQL S CPAGE 4 S DAD S \ITOP S DST S \ITOP S CLAMQ C S TAD I BOT S MQL S CPAGE 4 S DAD S \IBOT S DST S \IBOT S CLAMQ C S TAD I LEFT S MQL S CPAGE 4 S DAD S \ILEFT S DST S \ILEFT S CLAMQ C S TAD I RIGHT S MQL S CPAGE 4 S DAD S \IRIGHT S DST S \IRIGHT S CLAMQ C 320 CONTINUE C C COMPUTE IVERT=ABS(ITOP-IBOT) S CPAGE 5 S DAD S \IBOT S DCM S DAD S \ITOP S SPA S DCM /MAKE IT > 0 S CPAGE 2 S DST S \IVERT S CLAMQ C C COMPUTE: IHOR=ABS(IRIGHT-ILEFT) S CPAGE 5 S DAD S \ILEFT S DCM S DAD S \IRIGHT S SPA S DCM S CPAGE 2 S DST S \IHOR S CLAMQ C C C SET \IZ TO MIN(255,MAX(IVERT,IHOR)) S CPAGE 5 S DAD S \IVERT S DCM S DAD S \IHOR S SPA CLA S JMP \325 /VERTICAL C C IT IS HORIZONTAL IZ=IHOR S TAD \IHOR# S MQL S TAD \IHOR S AND (7400 S MQA S SNA CLA S JMP \330 /DONE C CLKP IT TO 255 IZ=255 GOTO 330 C C VERTICAL 325 IZ=IVERT S TAD \IVERT# S MQL S TAD \IVERT S AND (7400 S MQA S SNA CLA S JMP \330 /OK C CLKP IT IZ=255 330 CONTINUE C C RETURN S JMP RKERNAL C************** P A R A M E T E R S ************* S BMTEXT, TEXT /BM/ S PKP, \KP /POINTER C JT=0 JB=0 JL=0 JR=0 END