C PROGRAM ROTATE.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 20, 1977 C JUNE 17, 1977C JUNE 16, 1977 C C C C INTRODUCTION C ------------ C ROTATE.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 _ROTATE,,(ROTATION IN DEGREES),(OPT. X,Y SHIFTS) C (OPT /X /Y TO NEGATE THE X,Y SHIFTS). C OPDEFS C ------ C S OPDEF MQL 7421 S OPDEF MQA 7501 C C S OPDEF DISP2 6436 S OPDEF DISP1 6435 C S OPDEF KRS 6034 S OPDEF BSW 7002 C C C S OPDEF SWAB 7431 S OPDEF SWBA 7447 S OPDEF DAD 7443 S OPDEF DST 7445 S OPDEF DCM 7575 S OPDEF MUY 7405 C S OPDEF LSR 7417 C DIMENSION IDATA(2) C C [1] INITIALIZATION WRITE(1,995)KX1,KX2,KY1,KY2 995 FORMAT('ROTATE 6/20/77 - 4:01PM' 1,' WINDOW [',I3,':',I3,',',I4,':',I3,']') CURSYM=TIMER(0) C C C C [2] VERIFY BM SPECS S JMS CKIN S JMS CKOUT C@@S JMS CKIN2 C C C C [3] SET UP PARAMETERS AND SIN TABLE. C DEFINE VARIABLES C CURSYM=-FLOAT(ICNUM)*(3.14159/180.0) C ISIN1K=1024.0*SIN(CURSYM) ICOS1K=1024.0*COS(CURSYM) C C SAVE THE SIGNS OF SIN AND COS AS D.P. INSTRUCTIONS C TO EITHER TO A DCM OR NOP. S TAD \ISIN1K S SPA CLA S TAD (575 /DCM-NOP S TAD (7000 /NOP S DCA S1 S TAD S1 S DCA S2 C S TAD \ICOS1K S SPA CLA S TAD (575 /DCM-NOP S TAD (7000 //NOP S DCA C1 S TAD C1 S DCA C2 C S TAD \ISIN1K S SPA S CIA S DCA \ISIN1K C S TAD \ICOS1K S SPA S CIA S DCA \ICOS1K C S TAD \ICNUM# S DCA \IXPOSITION IYPOSITION=ICNUM(3) C IF /X THEN IXPOSITION_-IXPOSITION IZ=ISW(24) S TAD \IZ S SNA CLA S JMP \302 IXPOSITION=-IXPOSITION C C IF /Y THEN IYPOSITION_-IYPOSITION 302 IZ=ISW(25) S TAD \IZ S SNA CLA S JMP \304 IYPOSITION=-IYPOSITION C C COMPUTE THE CENTER OF THE WINDOW 304 IXCENTER=((KX2+KX1)/2)-1 IYCENTER=((KY2+KY1)/2)-1 C C C [4] PROCESS IMAGE DO 400 IY1=1,256 C S CPAGE 3 S JMS TTYCTL S JMP \998 /DONE C IY=IY1-1 S TAD \IY S DISP2 C C C [4.1] PROCESS A LINE DO 400 IX1=1,256 IY=IY1-1 IX=IX1-1 S TAD \IX S DISP1 C MX=IX-IXCENTER MY=IYCENTER-IY C C C SAVE THE SIGNS OF MX,MY AS D.P. INSTRUCTIONS C TO EITHER TO A DCM OR NOP. S TAD \MX S SPA CLA S TAD (575 /DCM-NOP S TAD (7000 /NOP S DCA KC1 S TAD KC1 S DCA KS2 C S TAD \MY S SPA CLA S TAD (575 /DCM-NOP S TAD (7000 //NOP S DCA KS1 S TAD KS1 S DCA KC2 C S TAD \MX S SPA S CIA S DCA \MX C S TAD \MY S SPA S CIA S DCA \MY C C C C [4.1.1] COMPUTE NEW IXP,IYP C COMPUTE: IX2=IXCENTER+(MX*COS)+(MY*SIN)+IXPOSITION C NOTE: COS AND SIN ARE STORED AS INTEGERS X 1024!. C C COMPUTE: MXCOS=MX*COS S TAD \MX S SWAB S CPAGE 2 S MUY S \ICOS1K C S C1, 0 /DCM OR NOP S KC1, 0 /DCM OR NOP C S CPAGE 2 S DST S \IDATA S CLA C C C COMPUTE: MYSIN=MY*SIN S TAD \MY S SWAB S CPAGE 2 S MUY S \ISIN1K C S S1, 0 /DCM OR NOP S KS1, 0 /DCM OR NOP C S CPAGE 2 S DAD S \IDATA C S CPAGE 2 S LSR S 12 /1024 SHIFT C S CLA S MQA S DCA \IEX IX2=(IXCENTER-IEX)+IXPOSITION C C C COMPUTE: IY2=IYCENTER-(-(MX*SIN)+(MY*COS))+IYPOSITION S TAD \MX S SWAB S CPAGE 2 S MUY S \ISIN1K C S S2, 0 /DCM OR NOP S KS2, 0 /DCM OR NOP C S DCM C S CPAGE 2 S DST S \IDATA S CLA C C COMPUTE: MYCOS=MY*COS S TAD \MY S SWAB S CPAGE 2 S MUY S \ICOS1K C S C2, 0 /DCM OR NOP S KC2, 0 /DCM OR NOP C C S CPAGE 2 S DAD S \IDATA C S CPAGE 2 S LSR S 12 /1024 S CLA S MQA S DCA \IEY IY2=(IYCENTER+IEY)+IYPOSITION S SWBA C C C C [4.1.2] IF (IX2+1 IN [KX1,KX2] AND IY2+1 IN [KY1:KY2]) C THEN ROTATE; S CLA CMA /-1 S TAD \KX1 S CIA S TAD \IX2 S SPA CLA S JMP \413 / XKX2 C S CLA CMA /-1 S TAD \KY1 S CIA S TAD \IY2 S SPA CLA S JMP \413 / YKY2 C C C C [4.1.3] BMJ(IX,IY) <== BMI(IX2,IY2) IX=IX2 IY=IY2 MEM=IBM1 IBYTE=IHGH1 CALL FETCH2D C IX=IX1-1 IY=IY1-1 MEM=JBM IBYTE=JHGH CALL PACK2D C 413 CONTINUE C 400 CONTINUE C C C C C [999] RETURN GOTO 998 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************** P A R A M E T E R S ************* S BMTEXT, TEXT /BM/ END