C PROGRAM DEFCONTRAST.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 MAY 11, 1977 C C C C INTRODUCTION C ------------ C DEFCONTRAST.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 DEFCONTRAST DRAWS A DIAGONAL IN AFTER ZEROING IT AND C THEN ALLOWS THE USER TO MODIFY THE LINE WITH THE GRAPHPEN. PRESSING C CLASSKEY[11] RETURNS THE USER TO BMON2. IF /L C WAS SPECIFIED, THEN THE CONTRAST FUNCTION IS PRINTED. C C BMJ_DEFCONTRAST,(OPT. BMI)/U C C CLASS KEYS C ---------- C 0 PRINT CF. ON LPT: C 1 _FNCONTRAST,BMI/U C 2 _FNCONTRAST,BMI C 3 _REDISPLAY CONTRAST FUNCTION C 4 RESTART AND PRINT HELP MSG C 11 RETURN TO BMON2 SAVING CONTRAST FN. S OPDEF DISP1 6435 S OPDEF DISP2 6436 S OPDEF TADI 1400 S OPDEF BSW 7002 S OPDEF FBW3 6343 C C C C [1] INITIALIZATION C DEFINE BMOMNI CALLS MCOLOR=4 C C ET=TIMER(0) 992 WRITE(1,995) 995 FORMAT(' DEFCONTRAST 5/11/77 - 10:41AM') C WRITE(1,990) 990 FORMAT(' MENU CLASS KEYS',/,' 0 - PRINT CONTRAST FN.',/, 1' 1 - _FNCONTRAST,/U',/,' 2 - _FNCONTRAST,') C WRITE(1,991) 991 FORMAT(' 3 - _REDISPLAY CONTRAST FN' 1,/,' 4 - RESTART AND PRINT HELP MSG' 2,/,' 11 - RETURN TO BMON2 SAVING C.F.') C C C [2] VERIFY BM SPECS C@S JMS CKIN S JMS CKOUT C@@S JMS CKIN2 C C C [2.1] SAVE POST STATUS IBLACK=200 IWHITE=IWHITE MEM=JBM IBYTE=JHGH C C C [2.2] COLOR BMI 50 IZ=IWHITE CALL BMOMNI(JBM,JHGH,0,0,IZ, IBUF,MCOLOR) C C C [2.3]GET THE OFFSETS JXF=LSAVE(13,JBM+1) JYF=LSAVE(14,JBM+1) C C C [2.5] DRAW DIAGONAL AND FILL IH DO 250 IX1=1,256 IX=IX1-1 IY=255-IX IZ=IBLACK CALL PACK2D 250 IH(IX1)=IX C C C [2.6] DRAW FIDUCIAL MARKS OF DENSITY IPTOP ON THE BOTTOM C OF THE BM SPACED 10 PIXELS APART OF LENGTH 3 AND 50 PIXELS C APART OF LENGTH 6. 269 IZ=IBLACK DO 260 IX1=1,256,10 IX=IX1-1 DO 260 IY=250,252 CALL PACK2D 260 CONTINUE C DO 261 IX1=1,256,50 IX=IX1-1 DO 261 IY=250,255 CALL PACK2D 261 CONTINUE C C C [3] MONITOR LOOP 300 IFBW3=0 S FBW3 S DCA \IFBW3 C C C [3.1] IF FBW4[11] THEN RETURN TO BMON2 S TAD \IFBW3 S AND (0001 S SZA CLA S JMP \998 /RETURN C C C [3.2] IF FBW4[0] THEN PRINT IH[1:256] S TAD \IFBW3 S AND (4000 S SNA CLA S JMP \330 /NO WRITE(3,503) 503 FORMAT('1 CURRENT CONTRAST FUNCTION') DO 501 I=1,256 S FBW3 S SZA CLA S JMP \300 /GET OUT S CPAGE 3 S JMS TTYCTL S JMP \300 /GET OUT WRITE(3,502)I,IH(I) 502 FORMAT(' C(',I3,')=',I5) 501 CONTINUE C C C [3.3] GET THE GRAPHPEN USING THE MOUSE 330 CALL MOUSE(JXF,JYF,IX,IY,IZ,ISW(25)) C C C [3.3.1] IF IZ THEN CHANGE IH(IX+1); IF(IZ)331,340,331 331 IY1=255-IH(IX+1) IY2=IY IH(IX+1)=255-IY C DELETE OLD POINT IY=IY1 IZ=IWHITE CALL PACK2D C ADD NEW POINT IY=IY2 IZ=IBLACK CALL PACK2D GOTO 300 C C C [3.4] IF FBW4[1] THEN _FNCONTRAST,/U S\340, TAD \IFBW3 S AND (2000 S SNA CLA S JMP \350 /NO C S JMS CKIN C JX1=KX1 JX2=KX2 JY1=KY1 JY2=KY2 C C [3.4.1] PERFORM CONTRAST FUNCTION 342 DO 341 IY1=JY1,JY2 IY=IY1-1 S TAD \IY S DISP2 C MEM=JBM IBYTE=JHGH S FBW3 S SZA CLA S JMP \300 /GET OUT S CPAGE 3 S JMS TTYCTL S JMP \300 C DO 341 IX1=JX1,JX2 IX=IX1-1 S TAD \IX S DISP1 C C C LOOKUP BMI MEM=IBM1 IBYTE=IHGH1 CALL FETCH2D C C MAP IT VIA IH(IZ) S TAD PIH S CPAGE 5 S TAD \IZ S DCA 25 S TADI 25 S DCA \IZ C C STORE IT IN BMJ MEM=JBM IBYTE=JHGH CALL PACK2D C 341 CONTINUE GOTO 300 C C C C [3.5] IF FBW4[2] THEN _FNCONTRAST, S \350, TAD \IFBW3 S AND (1000 S SNA CLA S JMP \360 /NO S JMS CKIN JX1=1 JX2=256 JY1=1 JY2=256 GOTO 342 C C C [3.6] IF FBW4[3] THEN REDISPLAY CONTRAST FUNCTION IN BMJ S\360, TAD \IFBW3 S AND (0400 S SNA CLA S JMP \370 /NO C C COLOR BMJ 50 IZ=IWHITE CALL BMOMNI(MEM,IBYTE,0,0,IZ,IBUF1,MCOLOR) C DO 361 IX1=1,256 IY=255-IH(IX1) IX=IX1-1 IZ=IBLACK CALL PACK2D 361 CONTINUE C GOTO [2.6] TO REDRAW FIDUCIAL MARKS GOTO 269 C C C [3.7] IF FBW3[4] THEN RESTART AND PRINT HELP MSG S\370, TAD \IFBW3 S AND (0200 S SNA CLA S JMP \300 /NO S JMP \992 /RESTART C C C [999] RETURN GOTO 998 999 WRITE(1,996) 996 FORMAT('BAD BM SPECIFICATION!') 998 ET=TIMER(1) C C C RESTORE COMMON SINCE MAY HAVE MOVED THE STAGE CALL BSCOMMON(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************** P A R A M E T E R S ************* S BMTEXT, TEXT /BM/ S PIH, \IH /PTR END