C PROGRAM STRIP.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 17, 1978 C C C C INTRODUCTION C ------------ C STRIP.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 C *STRIP - ACQUIRE A 4X880 PIXEL STRIP FROM THE QMT LOCATED C ON THE FRAME AND SCALE LINE. DUMP THE DATA INTO THE OPENED DATA FILE C WHICH USES THE GENSYM ".DA" FILE ON DEVICE "DSK". C MENU FBW3 FUNCTION C ---------- -------- C 0 OPEN OUTPUT DATA FILE C C 1 CLOSE OUTPUT DATA FILE.C C C 2 **NOP** C C 3 GET STRIP AND DUMP IT INTO THE OUTPUT FILE. C C C C 11 EXIT to BMON2. C OPDEFS C ------ S OPDEF POSTA 6520 S OPDEF POSTB 6521 C S OPDEF HPR 6320 S OPDEF HSR 6321 S OPDEF VPR 6322 S OPDEF VSR 6323 C S OPDEF HPL 6360 S OPDEF VPL 6362 S OPDEF HSL 6361 S OPDEF VSL 6363 C S OPDEF TADI 1400 S OPDEF DCAI 3400 C C S OPDEF SWAB 7431 S OPDEF SWBA 7447 S OPDEF DAD 7443 S OPDEF DCM 7575 S OPDEF DST 7445 S OPDEF CLAMQ 7621 S OPDEF MUY 7405 S OPDEF SHL 7413 S OPDEF DVI 7407 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 C S OPDEF DISP1 6435 S OPDEF DISP2 6436 C C S OPDEF FBW3 6343 S OPDEF FBW4 6344 C C S OPDEF BMX0 6500 S OPDEF BMY0 6504 C S OPDEF GETA 6522 C@S OPDEF GETB 6523 S OPDEF LQDT1 6375 S OPDEF LQDT2 6376 S OPDEF LQDT3 6377 S OPDEF STQMT 6300 S SKPDF QMSKP 6301 C C S OPDEF READGP 6146 S SKPDF GPSKP 6141 S OPDEF FBW12 6352 C [1] GLOBAL INITIALIZATION C SAVE F&S IN IPSTK,IOPSTK S HPR S DCA \IPSTK S VPR S DCA \IPSTK# S HSR S DCA \IOPSTK S VSR S DCA \IOPSTK# C C C [1.1] LOCAL INITIALIZATION WRITE(1,995) WRITE(3,995) 995 FORMAT('1 STRIP 5/10/78 - 1:06PM') CALL DAYTIME(3) C WRITE(1,123) 123 FORMAT(' 0 - OPEN DATA FILE',/,' 1 - CLOSE DATA FILE' 1,/,' 3 - DUMP DATA', 2/,' 11 - EXIT BMON2') C C C [1.1.1] SET UP STD POSITIONS KX=0 KY=131 IXPOSITION=KX IYPOSITION=KY S JMS SETBMS C C C [1.1.2] POSITION F&S AT IXPOSITION, IYPOSITION S TAD (00 /0 BCD S HPL S TAD (0461 /131 BCD S VPL C C C [1.1.3] UNPOST BMS S POSTA S POSTB C C C [1.1.4] TURN OFF GRAPHPEN C ZERO QMT RIGHT DISP REGISTER S LQDT1 S LQDT2 S LQDT3 C C C [1.1.5] CLEAR FILE OPEN SWITCH KOUTFILE=0 C C C [1.1.6] CLEAR THE COUNT OF DATA. ICOUNT=0 C [2] MONITOR LOOP 200 CONTINUE C LOAD F&S WITH 4X880 S TAD (4200 S HSL S TAD (4 S VSL C S CPAGE 3 S JMS TTYCTL S JMP \998 /EXIT C C C [2.1] MOVE THE HIGH BMS ACCORING TO THE F&S S VPR S JMS BCDDEC S DCA \IYPOSITION S JMS SETBMS C C C C [2.2] IF FBW3[0] AND KOUTFILE=0 C THEN KOUTFILE_1, OPEN DATA FILE. S FBW3 S AND (4000 /BIT 1 TO STRIP S SNA CLA S JMP \223 /NO S TAD \KOUTFILE S SZA CLA S JMP \223 /NO, ALREADY OPENED C C OK KOUTFILE=1 C C GENERATE FILENAME AND OPEN FILE S ISZ \IGENSYM# /COUNT S NOP S TAD \IGENSYM# S DCA \IA FILE=GENSYM(IGENSYM,IA) CALL OOPEN('DSK',FILE) DO 544 INDEX=1,3,2 544 WRITE(INDEX,1544)FILE 1544 FORMAT(' NEW DATA FILE DSK:',A6,',DA') S JMS WAITWHILE C C C [2.3] IF FBW3[1] AND KOUTFILE=1 C THEN CLOSE DATA FILE. S\223, FBW3 S AND (2000 S SNA CLA S JMP \224 /NO S TAD \KOUTFILE S SNA CLA S JMP \224 /NO, NOT OPENED KOUTFILE=0 CALL OCLOSE DO 545 INDEX=1,3,2 545 WRITE(INDEX,1545)FILE 1545 FORMAT(' CLOSED FILE DSK:',A6,'.DA') S JMS WAITWHILE C C C C [2.4] IF FBW3[2] THEN **NOP** S\224, FBW3 S AND (1000 S SNA CLA S JMP \225 /NO C ***NOP*** C C C [2.5] IF FBW3[3] THEN GET DATA AND DUP IT S\225, FBW3 S AND (0400 S SNA CLA S JMP \226 C C YES, ICOUNT=ICOUNT+1 S TAD (0017 /BM0:3 S GETA /LOAD GET STATUS REGISTER IN BM INTERFACE S STQMT /START A BM MEMORY/ACQUISITION CYCLE ON THE QMT S WAIT, QMSKP /SKIP WHEN DONE S JMP WAIT C C C [2.5.1] READ THE DATA OUT INTO THE FILE DO 250 IY1=1,4 DO 251 IX1=1,881 IY=IY1-1 IX=IX1-1 S TAD \IX S RTR /"/4" S AND (0007 S DCA \MEM S TAD \IX S AND (377 S DCA \IX CALL FETCH2D 251 IBUF1(IX1)=IZ C C DUMP THE DATA 250 WRITE(4,1250)ICOUNT,IY,(IBUF1(IZ),IZ=1,881) 1250 FORMAT(' ',2I5,44(/,20I4)) C IP=IBCD(ICOUNT,-1) S TAD \IP S LQDT1 /LOAD QMT DISPLAY REG WRITE(1,559)ICOUNT 559 FORMAT(/,' ACQUIRED ',I4,',TH DATUM.') C S JMS WAITWHILE /WAIT ABOUT A SECOND C C C [2.6] TEST IF RETURN FBW3[11] S\226, FBW3 S AND (0001 S SZA CLA S JMP \998 /YES C C C [2.15] CONTINUE *** 1215 CONTINUE C GOTO 200 C C C [999] RETURN GOTO 998 999 WRITE(1,996) 996 FORMAT('BAD BM SPECIFICATION!') C RESTORE POST AND F&S POSITIONS S\998, TAD \IPSTA S POSTA S TAD \IPSTB S POSTB C C RESTORE F&S S TAD \IPSTK S HPL S TAD \IPSTK# S VPL S TAD \IOPSTK S HSL S TAD \IOPSTK# S VSL C C IF KOUTFILE=1 C THEN CLOSE THE FILE! S TAD \KOUTFILE S SNA CLA S JMP \990 /NO! CALL OCLOSE C RESTORE COMMON SINCE CHANGED GENSYM VARIABLE IN COMMON 990 CALL BSCOMMON(1) C C RETURN CALL CHAIN('BMON2') C ******************************************* C *SUBROUTINE W A I T W H I L E C ***************************************************** C RING THE TTY: BELL AND WAIT ABOUT 1 SECOND. S CPAGE 3 S RWAITWHILE, JMP I WAITWHILE S WAITWHILE, 0 C WAIT A WHILE S TAD (207 /BELL S TLS S CLA C DO 1111 IZ=1,500 1111 CURSYM=CURSYM S JMP RWAITWHILE C C ********************************************** C *SUBROUTINE S Q U A R E C ************************************************** C DRAW LETTER(INDEX) AND SQUARE OF SIZE 14X14 AT (IX,IY) S CPAGE 3 S RSQUARE, JMP I SQUARE S SQUARE, 0 C C SAVE IX,IY IX2=IX IY2=IY C C YES, DRAW SQUARE IN KBYTE BMS IBYTE=KBYTE IZ=255 C C SET UP THE RANGE LSPALSIZE2=7 C COMPUTE: I11=MAX(1,IX-LSPALSIZE2) I11=IX-LSPALSIZE2 S CLA CMA S TAD \I11 S SPA S CLA S IAC S DCA \I11 C C COMPUTE: I12=MIN(511,IX+LSPALSIZE2) I12=IX+LSPALSIZE2 S TAD \I12 S TAD (-D512 S SMA S CLA CMA /-1 S TAD (D512 S DCA \I12 C C COMPUTE: I13=MAX(1,IY-LSPALSIZE2) I13=IY-LSPALSIZE2 S CLA CMA S TAD \I13 S SPA S CLA S IAC S DCA \I13 C C COMPUTE: I14=MIN(511,IY+LSPALSIZE2) I14=IY+LSPALSIZE2 S TAD \I14 S TAD (-D512 S SMA S CLA CMA /-1 S TAD (D512 S DCA \I14 C C C C [SQ.1] DISPLAY CHARACTER IN INDEX[6:8] C AT (IX,IY) AT CURRENT IZ DENSITY AT THE CURRENT IBYTE. C C DEFINE WINDOW C DEFINE TOP I15=IY-2 C C DEFINE BOT I16=I15+5 C C DEFINE LEFT I17=IX-2 C C DEFINE RIGHT I18=I17+3 C C C [SQ.2] MAP CHARACTER IN INDEX AND POST S TAD \INDEX S AND (0077 S CLL RAL /MULTIPLY BY 2 C C GO LOOKUP THE CHARACTER S TAD (-1 /FOR AUTOINDEX REG S TAD PTAB /GET TABLE POINTER S DCA 11 /STUFF INTO AUTO-INDEX REGISTER C S TAD I 11 /GET FIRST HALF OF BIT PATTERN S DCA BUFF# /PUT IT IN HI-ORDER HALF OF WORD S TAD I 11 /GET SECOND HALF OF BIT PATTERN S DCA BUFF /PUT IN IN LOW-ORDER HALF C C WRITE A CHARACTER DO 424 IX1=I17,I18 DO 424 IY1=I15,I16 C S SWAB /CHANGE TO MODE B S CPAGE 16 S JMS 45 S NOP S DAD /GET... S BUFF /DOUBLE PRECISION BIT PATTERN INTO AC-MQ S SHL /SHIFT LEFT.. S 0001 /...ONE PLACE (INTO LINK) S DST /RESTORE... S BUFF /...REMAINDER OF BIT PATTERN S CLAMQ /CLEAN IT OUT S SWBA /RESTORE MODE A S SNL /SKIP ON ZERO LINK S JMP \424 /DO NOT WRITE IT OUT C C DISPLAY THE LOC S JMS CVT512 CALL PACK2D 424 CONTINUE C C C [SQ.3] DRAW THE ENCLOSING SQUARE DO 1800 IY1=I13,I14 IX1=I11 S JMS CVT512 CALL PACK2D IX1=I12 S JMS CVT512 CALL PACK2D 1800 CONTINUE C DO 1801 IX1=I11,I12 IY1=I13 S JMS CVT512 CALL PACK2D IY1=I14 S JMS CVT512 CALL PACK2D 1801 CONTINUE S JMP RSQUARE C C C ****************************************** C *SUBROUTINE C V T 5 1 2 C *********************************************** C MAP (IX1,IY1) IN [0:511] ==> (MBM,IX,IY)[0:255]. S RCVT512, JMP I CVT512 S CVT512, 0 C C COMPUTE BMi S CLA CMA S TAD \IX1 S AND (400 S SZA CLA S IAC /EITHER 0 OR 2 S DCA \MEM S CLA CMA S TAD \IY1 S AND (400 S SZA CLA S TAD (2 /EITHER 2 OR 3 S TAD \MEM S DCA \MEM C C GET LOW ORDER 8-BITS S TAD \IX1 S AND (377 S DCA \IX S TAD \IY1 S AND (377 S DCA \IY C S JMP RCVT512 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 B C D D E C C ************************************************ C CVT AC (DECIMAL) FROM AC (BCD) S CPAGE 3 S RBCDDEC, JMP I BCDDEC S BCDDEC, 0 S MQL S MQA S BSW; RTR S AND (0017 S DCA \I11 S MQA S RTR;RTR S AND (0017 S DCA \I12 S MQA S AND (0017 S DCA \I13 C COMPUTE: I11*100 + I12*10 + I13 S TAD \I11 S MQL S CPAGE 2 S MUY S 144 /D100 S CLA S MQA S DCA 7 /(I11*100) C S TAD \I12 S MQL S CPAGE 2 S MUY S 12 /D10 S CLA S MQA /(I12*10) C S TAD 7 S TAD \I13 C S JMP RBCDDEC C ***************************************** C *SUBROUTINE D E C B C D C ************************************************ C CVT AC (BCD) FROM AC ( DECIMAL) S CPAGE 3 S RDECBCD, JMP I DECBCD S DECBCD, 0 S DCA \I10 C COMPUTE: I11=I10/100 S TAD \I10 S MQL S CPAGE 2 S DVI S 144 /D100 S CLA S MQA S DCA \I11 C C COMPUTE: I10=I10-(I11*100) S CPAGE 2 S MUY /NOTE: C(MQ)= I11 S 144 /D100 S CLA S MQA /I11*100 S CIA S TAD \I10 S DCA \I10 C C COMPUTE: I12=I10/10 S TAD \I10 S MQL S CPAGE 2 S DVI S 12 /D10 S CLA S MQA S DCA \I12 /(I10/10) C C COMPUTE: I13=I10-(I12*10) S CPAGE 2 S MUY S 12 /D10 S CLA S MQA /I12*10 S CIA S TAD \I10 S DCA \I13 C S TAD \I11 S BSW; RTL S AND (7400 S MQL S TAD \I12 S RTL; RTL S AND (0360 S MQA S TAD \I13 C S JMP RDECBCD C ************************************************** C *SUBROUTINE S E T F S C ************************************************** C LOAD THE BMX(IBM1), BMY(IBM1) WITH (IX,IY) S CPAGE 3 S RSETFS, JMP I SETFS S SETFS, 0 C S TAD \IBM1 /COMPUTE OFFSET S TAD (-4 S SMA CLA S TAD (10 /OFFSET FOR GROUP B S MQL S TAD \IBM1 S AND (0003 S MQA /OR IN POSSIBLE GROUP B S MQL / OFFSET OF EITHER 0:3 OR 10:13. C S MQA S TAD PBMX0 S DCA SETX S TAD \IX S SETX, BMX0 C S MQA S TAD PBMY0 S DCA SETY S TAD \IY S SETY, BMY0 S JMP RSETFS C C ************************************************** C *SUBROUTINE S E T B M S C ************************************************** C LOAD THE BMX(IBM1), BMY(IBM1) WITH (IX,IY) S CPAGE 3 S RSETBMS, JMP I SETBMS S SETBMS, 0 C IBM1=0 IX=IXPOSITION IY=IYPOSITION S JMS SETFS C IBM1=1 IX=IXPOSITION+256 S JMS SETFS C IBM1=2 IX=IXPOSITION+512 S JMS SETFS C IBM1=3 IX=IXPOSITION+768 S JMS SETFS S JMP RSETBMS C *********************************************** C *SUBROUTINE G R F P E N C ******************************************************* C GET THE IX,IY REL COORDINATES 0:511 AND DISPLAY CURSOR S CPAGE 3 S RGRFPEN, JMP I GRFPEN S GRFPEN, 0 /ENTRY C C S GPSKP /GRAPH PEN DATA READY? S JMP GRFPEN# /NO C C YES, GET PEN DATA S READGP /GET X S CLL RAR; RTR /DIVIDE BY 8 SO COVER [0:511] S AND (777 S DCA \IX C S READGP /GET Y S CIA S CLL RAR; RTR /DIVIDE BY 8 SO COVER [0:511] S AND (777 S DCA \IY S TAD \IX C C C LOAD DISP1/2 S TAD \IX S DISP1 S TAD \IY S DISP2 C C READ THE DENSITY FROM PROPER BM AND ==>BCD(LQDT1) IX1=IX IY1=IY S JMS CVT512 CALL FETCH2D S TAD \IZ S JMS DECBCD S LQDT1 C RESTORE IX,IY IX=IX1 IY=IY1 C C DISPLAY CURSOR IN CORRECT BMS S TAD \KBYTE S SZA CLA S JMP HGHCURSOR C C LOW CURSOR S TAD \IX S TAD \KX S LDXP S TAD \KY S TAD \IY S LDYP S JMP RGRFPEN C C HIGH CURSOR S HGHCURSOR, TAD \KX1 S TAD \IX S LDXP S TAD \KY1 S TAD \IY S LDYP S JMP RGRFPEN C C************** P A R A M E T E R S ************* S PTAB, TABLE /POINTER S CPAGE 2 S BUFF, BLOCK 2 S BMTEXT, TEXT /BM/ S PBMX0, BMX0 S PBMY0, BMY0 C C S LAP S PAGE S TABLE, S 0000 /@ S 0000 S 7744 /A S 4477 S 7751 /B S 5126 S 3641 /C S 4122 S 7741 /D S 4136 S 7745 /E S 4541 S 7744 /F S 4440 S 3641 /G S 4526 S 7710 /H S 1077 S 4177 /I S 4100 S 4241 /J S 7640 S 7710 /K S 2443 S 7701 /L S 0103 S 7730 /M S 3077 S 7730 /N S 0677 S 3641 /O S 4136 S 7744 /P S 4430 S 7642 /Q S 7603 S 7744 /R S 4631 S 2151 /S S 5146 S 4040 /T S 7740 S 7701 /U S 0177 S 7601 /V S 0274 S 7706 /W S 0177 S 6314 /X S 1463 S 7007 /Y S 0770 S 4345 /Z S 5161 S 7741 /[ S 0000 S 6010 /\ S 0403 S 0000 /] S 4177 S 0010 /^ S 2010 S 0101 /_ S 0101 S 0000 /SPACE S 0000 S 0075 /! S 0000 S 6000 /" S 0060 S 7227 /# S 7227 S 0677 /$ S 7730 S 6374 /% S 2543 S 6625 /& S 1067 S 0000 /' S 6000 S 3641 /( S 0000 S 0000 /) S 4136 S 2214 /* S 1422 S 1034 /+ S 1000 S 0102 /, S 0000 S 1010 /- S 1000 S 0303 /. S 0000 S 0304 // S 1060 S 7745 /0 S 5177 S 0121 /1 S 7701 S 2345 /2 S 5121 S 2241 /3 S 5126 S 1424 /4 S 7704 S 7251 /5 S 5106 S 0615 /6 S 2542 S 4344 /7 S 5060 S 2651 /8 S 5126 S 2051 /9 S 5136 S 0063 /: S 6300 S 6162 /; S 0000 S 1024 /< S 4200 S 2222 /= S 2222 S 0042 /> S 2410 S 5550 /? S 2000 C C C END