C PROGRAM BNRNTST.FT C -------------------- C C C P. LEMKIN C NIH C BETHESDA, MD 20014 C C C MAPRIL 1, 1977 C MARCH 16, 1977 C MARCH 15, 1977 C FEB 8, 1977 C JAN 10, 1977 C JAN 8, 1977 C NOV 12, 1976 C NOV 5, 1976 C C C PURPOSE C ------- C FBW4=0001 TO DUMP EACH PIXEL C FBW4=1000 TO PRINT RLM WHEN DONE C TEST BMOMNI BM/GP INTERFACE C C DIMENSION IFBW(20),JUNK(2047) C IDEBUG=0 WRITE(3,700) WRITE(1,700) 700 FORMAT('1 BNRNTST.SV 4/1/77, DRAW IN BM0, FREEST IN BM3') C C ****PARAMETERS**** KINITAVAIL=4 MEM=0 INCDEGREES=1 R=50 C C BMOMNI DEFS MPACK2D=11 MWT3LINES=33 C POSITION AND TURN ON BM2 MWINDOW=7 MRDFBW=22 MPOST=5 MMOVE=2 S OPDEF DISP2 6436 MDRAW=3 MGRFPEN=17 C INIT THE RUN TABLE CALL BRUN(0,0,IFLAG,1) C C C POST BM2 AT (0,0) C ZERO THE MEMORY 602 DO 601 I=1,2000 601 JUNK(I)=0 C DO 600 IY1=1,256,3 IY=IY1-1 CALL BMOMNI(MEM,0,0,IY,0,JUNK,MWT3LINES) 600 CONTINUE C IX=0 IY=0 CALL BMOMNI(MEM,0,IX,IY,0,JUNK,MWINDOW) CALL BMOMNI(MEM,0, 0,0,0, JUNK,MPOST) CALL BMOMNI(3,0, 256,256,0, JUNK,MWINDOW) CALL BMOMNI(3,0, 0,0,0,JUNK,MPOST) C C INIT THE FREESTORE CALL BNODE(0,0,JUNK,KINITAVAIL) C C IX0=128 IY0=128 IR=R Y0=IY0 X0=IX0 LSTX=128+IR LSTY=128 DO 1000 IANGLE=1,361,INCDEGREES C C GET THE DEBUG SWITCH S 6344 /FBW4 S AND (0001 S DCA \IDEBUG C ANG=IANGLE-1 RAD=ANG*(3.14159/180.0) IY=R*SIN(RAD)+Y0 IX=R*COS(RAD)+X0 CALL BMOMNI(MEM,0,LSTX,LSTY,0, JUNK,MMOVE) IZ=255 CALL BMOMNI(MEM,0,IX,IY,IZ,JUNK,MDRAW) DO 777 IJK=1,3,2 S TAD \IDEBUG S SNA CLA S JMP \777 /NO WRITE(IJK,778)ANG,LSTX,LSTY,IX,IY,IZ 777 CONTINUE 778 FORMAT(' ANG=',F5.1,', L(X,Y)=',2I5,', N(X,Y)=',2I5,',IZ=',I5) LSTX=IX LSTY=IY C PUT INTO RUN TABLE DO 1000 I=1,IZ IX=JUNK(2*(I-1)+1) IY=JUNK(2*I) C C TEST IF DEBUG IF(IDEBUG)991,891,991 991 WRITE(3,886)IX,IY 886 FORMAT(//,' ------------------------------------------------' 1,/,' BRUN[2] PUSH: X,Y=',2I5) C DUMP THIS LINE BEFORE PUSH CALL BRUN(IY,IY,IFLAG,7) C C GO PUSH IT 891 CALL BRUN(IX,IY,IFLAG,2) C C IF(IDEBUG)992,1000,992 992 WRITE(3,482) 482 FORMAT(' AFTER [2]') CALL BRUN(IY,IY,IFLAG,7) 1000 CONTINUE C C C CLOSE OUT TABLE CALL BRUN(0,0,IFLAG,6) C C C GET THE SIZE CALL BRUN(KY1,KY2,IFLAG,3) CALL BRUN(KX1,KX2,IFLAG,4) DO 888 IJK=1,3,2 888 WRITE(IJK,623)KX1,KX2,KY1,KY2 623 FORMAT(' SIZE [',2I5,':',2I5,']') C WRITE(3,555) WRITE(1,555) 555 FORMAT(' DUMPING RLM!') S 6344 /FBW4 S AND (1000 S DCA \IDUMP IF(IDUMP)556,557,556 556 CALL BRUN(0,255,IFLAG,7) 557 CONTINUE WRITE(3,567) WRITE(1,567) 567 FORMAT(' FILL IN CIRCLE USING RLM PREDICATE.') IDUMP=1 568 CONTINUE C DO 300 IY1=1,256 IY=IY1-1 S TAD \IY S DISP2 C TEST IF ANYTHING THERE CALL BRUN(0,IY,NBR,8) S TAD \NBR S SNA CLA S JMP \300 /NO, FORGET THIS LINE. C DO 300 IRUN=1,NBR KX1=IRUN KX2=IY CALL BRUN(KX1,KX2,IFLAG,9) C DO 300 IX1=KX1,KX2 IX=IX1-1 IZ=255 CALL BMOMNI(MEM,0,IX,IY,IZ,JUNK,MPACK2D) 300 CONTINUE C C C TEST PREDICATE 500 CONTINUE READ(1,501)IX,IY 501 FORMAT(' TEST IX=',I5,/,' IY=',I5) CALL BRUN(IX,IY,IFLAG,5) DO 887 IJK=1,3,2 887 WRITE(IJK,502)IX,IY,IFLAG 502 FORMAT(' IX,IY,IFLAG=',3I5) GOTO 500 2047 CONTINUE END