C PROGRAM EXTRACT.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 2, 1977 C MARCH 31, 1977 C MARCH 29, 1977 C MARCH 22, 1977 C MARCH 17, 1977 C MARCH 16, 1977 C MARCH 15, 1977 C MARCH 13, 1977 C MARCH 10, 1977 C MARCH 8, 1977 C MARCH 4, 1977 C MARCH 2, 1977 C FEB 8, 1977 C JAN 28, 1977 C JAN 24, 1977 C JAN 16, 1977 C JAN 14, 1977 C JAN 13, 1977 C JAN 10, 1977 C JAN 8, 1977 C JAN 7, 1977 C JAN 4, 1977 C NOV 22, 1976 C NOV 18, 1976 C NOV 12, 1976 C NOV 10, 1976 C NOV 8, 1976 C NOV 5, 1976 C NOV 4, 1976 C NOV 3, 1976 C NOV 1, 1976 C OCT 27, 1976 C OCT 26, 1976 C OCT 21, 1976 C OCT 15, 1976 C OCT 13, 1976 C OCT 1, 1976 C C C C INTRODUCTION C ------------ C EXTRACT.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 EXTRACT.FT PUTS THE OPERATOR IN GRAPHPEN MODE C WITH AS THE SKETCHPAD. THEN ON LEAVING C THE GRAPHPEN MODE, IT FILLS WITH DATA INSIDE OF THE C BOUNDARY DEFINED IN FROM GRAYSCALE DATA INSIDE C OF . C C NOTE IS USED AS A SCRATCHPAD. S OPDEF BSW 7002 S OPDEF POSTA 6520 S OPDEF POSTB 6521 C C DIMENSION IFRAME(4) C C [1] INITIALIZATION ET=TIMER(0) WRITE(1,995) 995 FORMAT('EXTRACT 6/2/77 - 10:41AM') C WRITE(1,888) 888 FORMAT(' MENU CLASS KEY',/,' 0-TOGGLE POST/UNPOST STATUS' 1,/,' 1-GET FROM TV CAMERA' 2,/,' 2-ERASE BOUNDARY BACKWARDS') C WRITE(1,884) 884 FORMAT(' 3-',/ 1,' 4-ZERO ',/ 2,' 5-ZERO , RESET BOUNDARY') C WRITE(1,886) 886 FORMAT(' 6-MOVE CURSOR TO LAST XY', 1/,' 7-MOVE LAST XY CURSOR CLOCKWISE',/ 2,' 8-MOVE LAST XY CURSOR COUNTERCLOCKWISE') C WRITE(1,887) 887 FORMAT(' 9-_EXTRACT,0 USING RLM',/ 1,' 10-_EXTRACT, USING RLM', 2/,' 11-EXIT') C C C C [2] VERIFY BM SPECS S JMS CKIN S JMS CKOUT C@@S JMS CKIN2 C C C [2.1] OPEN OUTPUT FILE CONDITIONALLY IF(IOUTSPOOL)100,100,101 101 CALL OOPEN('LPT','EXTRACT') 100 CONTINUE C C C [2.2] SAVE POST STATUS IASAVE=IPSTA IBSAVE=IPSTB C C SAVE F&S MRDFS=20 MLDFS=19 CALL BMOMNI(0,0, 0,0,0, IFRAME,MRDFS) C C C [2.3] SET THE AVAIL LIST IN THE BM C IF /I OR (LSFREESTORE[1:2]=-1) C THEN REINIT AVAIL LIST C ELSE SET AVAIL PTR<==LSFREESTORE IF(ISW(9))231,232,231 232 IF(LSFREESTORE(2)+1)230,231,230 C C THEN REINIT AVAIL 231 KINITFREESTORE=4 CALL BNODE(0,0,0,KINITFREESTORE) C UPDATE COMMON PTR LSFREESTORE=1 S DCA \LSFREESTORE# GOTO 239 C C ELSE COPY PTR 230 KSETFREESTORE=19 CALL BNODE(0,0,LSFREESTORE,KSETFREESTORE) 239 CONTINUE C C C [3] FAKE OUT THE GRAPHPEN AND GO WRITE IT INTO IXF=LSAVE(13,IBM1+1) IYF=LSAVE(14,IBM1+1) C JXF=LSAVE(13,JBM+1) JYF=LSAVE(14,JBM+1) C C NOTE PASS THE /K SWITCH HERE AS WELL IQ7=ISW(11) S TAD \IFILTOP S AND (7776 S TAD \IQ7 S DCA \IQ7 C C MGP = /Y SWITCH MGP=ISW(25) C C PASS SPOOLING AND /D SWITCH TOGETHER ISPL=IOUTSPOOL+(2*ISW(4)) CALL GPEDIT(IXF,IYF,JBM,JHGH,IBM1,IHGH1,IQ7,JXF,JYF,MGP,ISPL) C C C [4] CONDITIONALLY CLOSE OUTPUT FILE IF (IOUTSPOOL)400,400,401 401 CALL OCLOSE 400 CONTINUE C C C [5] SAVE THE LIST POINTER IN QRY:QRZ. ITMPSTK(26)=IXF IQREG(26)=IYF C C C [999] RETURN GOTO 998 999 WRITE(1,996) 996 FORMAT('BAD BM SPECIFICATION!') 998 ET=TIMER(1) C C RESTORE POST STATUS S TAD \IASAVE S POSTA S TAD \IBSAVE S POSTB C C RESTORE F&S CALL BMOMNI(0,0, 0,0,0, IFRAME,MLDFS) 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************** P A R A M E T E R S ************* S BMTEXT, TEXT /BM/ END