C PROGRAM BDEDIT.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 MARCH 2, 1978 C MARCH 1, 1978 C FEB 28, 1978 C FEB 17, 1978 C FEB 16, 1978 C FEB 14, 1978 C FEB 9, 1978 C FEB 8, 1978 C C C C INTRODUCTION C ------------ C BDEDIT.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 C *_BDEDIT,(If not /G then input BD.DA file), C (output filspec pr ),(If /G Opt. /M for mouse) C (Opt lower output file number n),(Opt. BMi gray scale image) C (Opt. /L if /G to label marked points with mark #) C (Opt. /1 if /G to draw only 1 file and mark 1 pair without C using the keypad) - C Edit boundaries from BD.DA into a set of single boundary files C numbered sequentially from pr&CVS(n)&".DA". If BMi is specified C then the boundary is overlayed on a copy of BMi==>BMj to give the C user a better reference for editing. Otherwise, BMj is C zeroed before editing each boundary. Note: only boundaries C less than 2046 points in length can be edited. C C If /G is specified, then boundary definition class keys 7, 8, C 9, 10 and 11 are activated. On closing the boundary with key 10, C the mark editing class keys 0,1,2,3,4,5,6 and 11 are activated. C If /G is specified, then the graphpen is used to draw the C boundary unless /M is specified for the mouse. C [1] Open the specified BD.DA boundary data input file. C C [2] For each boundary b in BD.DA Do C [2.1] If BMi exists C Then BMj_COPY,BMi C Else BMj_ZERO; C [2.2] Read next boundary header ==> H ==> TTY: ==> LPT:. C [2.3] BMj_field 6_read boundary b labeled w/255 in BMj. C [2.4] Print menu on tty: and listen for class keys. C Class key function C --------- -------- C 0 Reject, Goto [2.6] C 1 Rotate boundary ptr CW C 2 Rotate boundary ptr CCW C 3 mark 1st label (index C or KPD if /G). C 4 mark 2nd label (index C or KPD if /G). C 5 Accept boundary, Do [2.5] C 6 Edit existing boundary at C current cursor point. C 7 Point to last point in DRAW mode C 8 Restart drawn boundary using C graphpen. C 9 Delete drawn boundary backwards. C 10 Close drawn boundary and start C mark edit (keys 0:5). C 11 Return to BMON2. C [2.5] If Accept C Then C [2.5.1] Open Odev:pr&CVS(n)&".DA"; C n_n+1; C [2.5.2] Dump header H; C [2.5.3] Dump boundary b from field 6 C [2.5.4] Dump eof: C -1,0,std index#1,std index#2 C -1,-2,index #, mark label 1, mark label 2. C (where labels are in [1:15] else 0) C . C . C . C -1,-1 C [2.5.5] Close the file; C [2.6] Continue; C OPDEFS C ------ S OPDEF TADI 1400 S OPDEF DCAI 3400 C C 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 S OPDEF LQDT1 6375 S OPDEF POSTA 6520 S OPDEF POSTB 6521 S OPDEF RKYPDL 6353 S OPDEF RKYPDH 6340 S SKPDF SKPKPD 6313 C S OPDEF QPROG2 6371 S OPDEF QPROG7 6433 C [1] INITIALIZATION C SAVE /G ISWG=ISW(7) C C GET THE PREFIX FROM 3RD INPUT FILE SPEC KPREFIX=KINFILE(9) S TAD \KPREFIX S SNA S TAD (0204 /"BD" S DCA \KPREFIX C C C DO 991 IX=1,3,2 WRITE(IX,994) 994 FORMAT('1 BDEDIT 3/2/78 - 12:29PM') S TAD \ISWG /IF /G THEN DO NOT PRINT THIS PART S SZA CLA S JMP \991 /NO WRITE(IX,995)(KINFILE(I),I=5,7) 995 FORMAT(' EDITING BOUNDARY DATA FILE: ' 3A2,'.DA') 991 CONTINUE C CALL DAYTIME(1) CALL DAYTIME(3) FC=TIMER(0) C C C [2] CHECK OUTPUT BMJ S JMS CKOUT C LOOKUP THE BMJ POSITION IXPOSITION=LSAVE(13,JBM+1) IYPOSITION=LSAVE(14,JBM+1) C C IF BMI EXISTS C THEN CKIN; S TAD \SFILE S CIA S TAD BMTEXT S SNA CLA S JMS CKIN C C C [2.1] DEFINE THE BMJ' LINE DRAWING MEMORY. C IF BMi EXISTS C THEN POST BMi; S TAD \SFILE S CIA S TAD BMTEXT S SZA CLA S JMP \201 /NO C YES CALL BMOMNI(IBM1,IHGH1,0,0,0,IBUF1,5) C C POST BMJ IN MASK MODE 201 JHGHP=1-JHGH CALL BMOMNI(JBM,JHGH,0,1,0,IBUF1,5) C ZERO BMJ' CALL BMOMNI(JBM,JHGHP,0,0,0,IBUF1,4) C C SETUP THE QMT DISPLAY PROGRAM FOR THE TRACE IN BMJ' S TAD (0020 S QPROG2 S TAD (6000 S QPROG7 /PUT IN "/B/M" MODE C NOTE: IFILTER IS THE CURRENT VALUE OF QPROG7 C C C SAVE F&S POSITION IN IPSTK[1:4] C DO MRDFS CALL BMOMNI(0,0,0,0,0,IPSTK,20) C POSITION THE F&S AT BMJ KOCT=IXPOSITION S TAD (D256 S DCA \KOCT# KOCT(3)=IYPOSITION KOCT(4)=256 C DO MLDFS (LOAD F&S FROM KOCT[1:4]) CALL BMOMNI(0,0,0,0,0,KOCT,19) C GO DRAW BOUNDARY C C IF /G THEN GOTO [8]; S TAD \ISWG S SZA CLA S JMP \800 C C C [3] IF NOT /G C THEN OPEN THE INPUT FILE S TAD \KDEVIN# S DCA \IZ DEVICE=GETDEV(IZ) IZ=IO(DEVICE,KINFILE(5),'DA',1) S TAD \IZ S SNA CLA S JMP \302 /NO WRITE(1,1301) 1301 FORMAT(' CAN NOT FIND BOUNDARY DATA FILE!') GOTO 998 C C C [3.1] ELSE OPEN INPUT FILE 302 CALL IOPEN(DEVICE,KINFILE(5)) C C [4] READ CC'S UNTIL MATCH OR EOF C ZERO THE BND POINT COUNTER 400 KWC=0 C C [4.1] READ UNTIL MATCH OR EOF 430 READ(4,431)(IBUF4(I),I=1,38) 431 FORMAT(38A2) C C LOOK FOR "-" AFTER " CC#=" STRING. S TAD \IBUF4# S AND (0077 S TAD (200 S TAD (-"- S SNA CLA S JMP \998 /DONE C READ(4,431)(IBUF4(I),I=39,76) READ(4,431)(IBUF4(I),I=77,114) C DO 433 IDEV=1,3,2 433 WRITE(IDEV,432)(IBUF4(I),I=1,114) 432 FORMAT(3(' ',38A2,/)) C C C [4.2] COPY BMI IF IT EXISTS C IF NO BMI THEN USE ZERO==>BMJ DO 435 IZ=1,512 S CLA CMA S TAD PBUF1 S CPAGE 5 S TAD \IZ S DCA 7 S DCAI 7 435 CONTINUE C C C [4.2.1] RESET BMJ EDITING IMAGE DO 436 IY1=1,256,3 IY=IY1-1 S TAD \SFILE S CIA S TAD BMTEXT S SZA CLA S JMP \437 MEM=IBM1 IBYTE=IHGH1 CALL T3BUF(IBUF1,0) 437 MEM=JBM IBYTE=JHGH CALL T3BUF(IBUF1,1) 436 CONTINUE C C [5] LOOP TO READ 2-TUPLES 500 KWC=KWC+1 S TAD \KWC S DISP1 S CLA C C C [5.1] GET NEXT POINT READ(4,510)IX,IY 510 FORMAT(2I5) C C IF -1,0 C THEN DONE S TAD \IX S SPA CLA S JMP \540 /DONE C C C [5.2] PACK INTO FIELD 6 S CLA CMA S TAD \KWC S CLL RAL /*2 S DCA 7 S CPAGE 14 S TAD \IX S 6261 S DCAI 7 S INC 7 S 6211 S TAD \IY S 6261 S DCAI 7 S 6261 C S CPAGE 3 S JMS TTYCTL S JMP \998 /DONE! C C C [5.3] LABEL THE BMJ WITH IZ=255 MEM=JBM IBYTE=JHGH IZ=255 CALL PACK2D GOTO 500 C C C [5.4] DECREMENT KWC BY 1 AND GOTO [6] 540 KWC=KWC-1 C C C [6] EDIT THE BOUNDARY C NOTE: IA[1:2] IS X,Y COORD OF 1ST BACKBONE COORD C IB " OF 2ND C IC[1] IS 1ST BKBN INDEX WHILE IC[2] IS THAT OF THE 2ND. C 600 CONTINUE C C SET THE FIRST CURSOR POINTER LCNT=1 MEM=JBM IBYTE=JHGHP C C SET IA[1:2]<==IB[1:2]<== POSITION OF FIRST POINT S JMS LOKBND C MAKE SURE ONLY [0:255] S TAD \IX S AND (377 S DCA \IX S TAD \IY S AND (377 S DCA \IY C IA=IX IB=IX IC=1 S TAD \IY S DCA \IA# S TAD \IY S DCA \IB# S CLA IAC /+1 S DCA \IC# C C WRITE(1,601) 601 FORMAT(/,' MARK EDIT CLASS KEYS',/,' 0 - REJECT',/ 1,' 1 - ROT CW',/,' 2 - ROT CCW',/,' 3 - MARK 1ST',/, 2' 4 - MARK 2ND',/,' 5 - ACCEPT') WRITE(1,602) 602 FORMAT(' 6 - EDIT EXISTING BDY',/,' 11 - ==>BMON2') C C C [6.1] FBW3 TEST LOOP C WAIT 8X5.0 MSEC = 40 MSEC. 610 DO 611 I=1,8 611 CALL CLOCK C C LOOKUP THE BOUNDARY POINT S JMS LOKBND /IX,IY<==POINT FOR LCNT INDEX C MAKE SURE ONLY [0:255] S TAD \IX S AND (377 S DCA \IX S TAD \IY S AND (377 S DCA \IY C C LOAD THE CURSOR S TAD \IXPOSITION S TAD \IX S LDXP C S TAD \IYPOSITION S TAD \IY S LDYP C C S CPAGE 3 S JMS TTYCTL S JMP \998 /EXIT C C IF FBW3&'7741 NEQ 0 C THEN RING THE BELL AND PROCESS C ELSE GOTO [6.1]; S FBW3 S AND (7741 /KEYS 0:6 AND 11. S SNA CLA S JMP \610 /=0 S FBW3 S AND (4741 S SNA CLA S JMP NOBELL S TAD (207 /BELL! S TLS S CLA C C C IF FBW3='4000 C THEN REJECT S NOBELL, FBW3 S AND (4000 /BIT 0 S SZA CLA S JMP \799 /GOTO [7.6] REJECT C C C IF FBW3='2000 C THEN ROTATE BND PTR CW S FBW3 S AND (2000 /BIT 0 S SNA CLA S JMP \612 /NO LCNT=LCNT+1 C IF LCNT > KWC C THEN LCNT_1; S IAC S TAD \KWC S CIA S TAD \LCNT S RAL S CLA S TAD \LCNT S SNL S CLA IAC S DCA \LCNT C C C IF FBW3='1000 C THEN ROTATE BND PRT CCW S\612, FBW3 S AND (1000 /BIT 0 S SNA CLA S JMP \613 /NO LCNT=LCNT-1 S TAD \LCNT S SNA S TAD \KWC S DCA \LCNT C C C IF FBW3='0400 C THEN MARK 1ST BACKBONE (IA[1:2]) S\613, FBW3 S AND (0400 /BIT 0 S SNA CLA S JMP \614 /NO C WRITE NEW SQUARE C IF NOT /G THEN ERASE OLD SQUATE S TAD \ISWG S SZA CLA S JMP \1613 /DON'T IZ=0 IX=IA S TAD \IA# S DCA \IY S JMS SQUARE C GET NEW COORDS S\1613, JMS LOKBND C MAKE SURE ONLY [0:255] S TAD \IX S AND (377 S DCA \IX S TAD \IY S AND (377 S DCA \IY C IZ=255 S JMS SQUARE C UPDATE THE COORDINATES AND INDEX IA=IX S TAD \IY S DCA \IA# C SAVE THE INDEX IC=LCNT IP=1 S JMS SVID C C C IF FBW3='0200 C THEN MARK 2ND BACKBONE (IB[1:2]) S\614, FBW3 S AND (0200 /BIT 0 S SNA CLA S JMP \615 /NO C WRITE NEW SQUARE C IF NOT /G THEN ERASE OLD SQUARE S TAD \ISWG S SZA CLA S JMP \1614 /DON'T IZ=0 IX=IB S TAD \IB# S DCA \IY S JMS SQUARE C GET NEW COORDS S\1614, JMS LOKBND C MAKE SURE ONLY [0:255] S TAD \IX S AND (377 S DCA \IX S TAD \IY S AND (377 S DCA \IY C IZ=255 S JMS SQUARE C UPDATE THE COORDINATES AND INDEX IB=IX2 S TAD \IY2 S DCA \IB# C SAVE THE INDEX S TAD \LCNT S DCA \IC# IP=2 S JMS SVID C C C IF FBW3='0100 C THEN ACCEPT S \615, FBW3 S AND (0100 S SZA CLA S JMP \700 /ACCEPT! C C C IF FBW3='0040 C THEN EDIT EXISTING BOUNDARY AT CURSOR S FBW3 S AND (0040 S SZA CLA S JMP \888 /GO EDIT EXISTING BOUNDARY C C C IF FBW3='1 C THEN RETURN TO BMON2 S FBW3 S AND (0001 S SNA CLA S JMP \610 /NOT YET GOTO 998 C C C [7] DONE! 700 FILE=GENSYM(KPREFIX,ICNUM) S INC \ICNUM DEVICE=GETDEV(KDEVOUT) C CALL OOPEN(DEVICE,FILE) C C PRINT THE FILE NAME. DO 701 IDEV=1,3,2 S TAD \ISWG S SZA CLA S JMP \701 /NO WRITE(IDEV,702)(KINFI(I),I=5,7),(IBUF4(I),I=1,5),']', 701 WRITE(IDEV,1702)DEVIC,FILE 702 FORMAT(' ',3A2,'[',4A2,2A1) 1702 FORMAT('==> ',A4,':',A6,'.DA',/) C C C [7.1] IF NOT /G C ELSE COMPUTE DUMMY HEADER C THEN OUTPUT THE HEADER FIRST S TAD \ISWG S SNA CLA S JMP \704 C DEFINE THE HEADER FOR /G MODE! S TAD (4040 /" " S DCA \IZ DO 1704 I=1,114 1704 IBUF4(I)=IZ C CURSYM=' CC#= ' S CALL 1,FAD S ARG \CURSYM S CALL 1,STO S ARG \IBUF4 C CURSYM=' 2 ' S TAD PBUF4 S TAD (3 S DCA DAG# S CALL 1,FAD S ARG \CURSYM S CALL 1,STO S DAG, ARG \IBUF4 C C DUMP THE HEADER 704 WRITE(4,703)(IBUF4(I),I=1,114) 703 FORMAT(3(38A2,/)) C C C [7.2] DUMP THE BOUNDARY FROM FIELD 6 DO 710 LCNT=1,KWC S JMS LOKBND /IX,IY<==LCNT POINT OF BOUNDARY S TAD \IX S AND (0377 S DCA \IX C S TAD \IY S AND (0377 S DCA \IY C WRITE(4,714)IX,IY 714 FORMAT(2I5) 710 CONTINUE C C C [7.3] WRITE THE EOF WRITE(4,715)-1,0,IC 715 FORMAT(4I5) C C C [7.4] IF /G C THEN OUTPUT THE INDEX CODE LIST C AS -1,-2, INDEX#, MARK 1 OR 2 (IF ON X OR ON Y) S TAD \ISWG S SNA CLA S JMP \716 /NO C DO 720 LCNT=1,KWC S JMS LOKBND S TAD \IX S BSW; RTR S AND (0017 S DCA \IX C S TAD \IY S BSW; RTR S AND (0017 S DCA \IY C C IF IX OR IY > 0 C THEN DUMP INDEX S TAD \IX S TAD \IY S SNA CLA S JMP \720 /NO WRITE(4,721)-1,-2,LCNT,IX,IY 721 FORMAT(5I5) 720 CONTINUE C C C [7.5] CLOSE THE FILE 716 WRITE(4,714)-1,-1 CALL OCLOSE C C C [7.6] DONE C IF NOT /1 C THEN IF /G THEN GO DRAW NEW BOUNDARY C ELSE RETURN TO BMON2; 799 IF(ISW(28))998,798,998 798 IF(ISWG)800,400,800 C [8] DRAW BOUNDARY FROM GRAPHPEN C C C [8.0.0] IF ENTER AT 888, THEN WE ARE GOING TO C EDIT EXISTING BOUNDARY FROM [6] USING FBW3[7] C IF LCNT=KWC C THEN IGNORE SORTING BECAUSE IT IS ALREADY SORTED. S\888, CLA CMA /-1 S TAD \KWC S SNA CLA S JMP \881 /KWC=1, CONTINUE AT [8.1 S TAD \KWC S CIA S TAD \LCNT S SNA CLA S JMP \881 /YES, CONTINUE AT [8.1 C C C [8.0.0.1] GO SORT THE LIST C [LCNT+1:KWC]&[1:LCNT] <== [1:LCNT]&[LCNT+1:KWC]; IA=LCNT DO 840 IB=1,KWC LCNT=IB+IA C COMPUTE: LCNT MODE KWC S IAC S TAD \KWC S CIA S TAD \LCNT S RAL S CLA S SNL S TAD \KWC /-KWC S CIA S TAD \LCNT S DCA \LCNT C S JMS LOKBND C C WRITE IT OUT IN 2 BYTES IN BMJ, J' IX1=IX IY1=IY MEM=JBM IBYTE=0 S TAD \IB S AND (377 S DCA \IX S TAD \IB S BSW; RTR S AND (7 S DCA \IY IZ=IX1 CALL PACK2D IZ=IY1 IBYTE=1 CALL PACK2D 840 CONTINUE C C NOW REPACK INTO CORE IA=KWC KWC=1 DO 841 LCNT=1,IA C GET IX,IY S TAD \LCNT S AND (377 S DCA \IX S TAD \LCNT S BSW; RTR S AND (7 S DCA \IY MEM=JBM IBYTE=0 CALL FETCH2D IX1=IZ IBYTE=1 CALL FETCH2D IY=IZ IX=IX1 S JMS PUSHXY 841 KWC=KWC+1 C GOTO [8.1.1] GOTO 881 C C C [8.1] INITIALIZED BOUNDARY EDITING 800 KWC=1 C C C [8.1.1] ZERO QMT DISPLAY OF LAST INDEX USED S\881, CLA S LQDT1 /ZERO INDEX # C WRITE(1,866) 866 FORMAT(/,' DRAW CLASS KEYS',/,' 7 - POINT TO LAST BND' 1,/,' 8 - BEGIN BND',/,' 9 - ERASE BND',/,' 10 - END BND' 2,/,' 11 - ==>BMON2') C C COLOR BMJ' ZERO CALL BMOMNI(JBM,JHGHP,0,0,0,IBUF1,4) C C C [8.1.2] COPY BMI IF IT EXISTS C IF NO BMI THEN USE ZERO==>BMJ DO 835 IZ=1,512 S CLA CMA S TAD PBUF1 S CPAGE 5 S TAD \IZ S DCA 7 S DCAI 7 835 CONTINUE C C C [8.1.3] RESET BMJ EDITING IMAGE DO 836 IY1=1,256,3 IY=IY1-1 S TAD \SFILE S CIA S TAD BMTEXT S SZA CLA S JMP \837 MEM=IBM1 IBYTE=IHGH1 CALL T3BUF(IBUF1,0) 837 MEM=JBM IBYTE=JHGH CALL T3BUF(IBUF1,1) 836 CONTINUE C C C [8.1.4] IF KWC > 1 THEN EDITING EXISTING BND. DRAW BND==>BMJ'. S CLA CMA S TAD \KWC S SNA CLA S JMP \801 /NO, GOTO [8.2] C C C [8.1.4.1] DRAW BND INTO BMJ' S\877, CLA CMA S TAD \KWC S SNA CLA S JMP \801 /DON'T DRAW C IA=KWC-1 DO 876 LCNT=1,IA IZ=255 MEM=JBM IBYTE=JHGHP S JMS LOKBND CALL PACK2D 876 CONTINUE C C C [8.2] INTERACTIVE LOOP S\801, CLA S CPAGE 3 S JMS TTYCTL S JMP \998 /EXIT C C IF FBW3[11]=1 THEN EXIT S FBW3 S AND (0001 S SZA CLA S JMP \998 /EXIT C C C [8.2.1] GET GP DATA IZ=1 IF VALID CALL MOUSE(IXPOSITION,IYPOSITION,IX,IY,IZ,ISW(13)) C IF IZ=1 C THEN VALID DATA C ELSE GOTO [8.2.1.2]>; S TAD \IZ S SNA CLA S JMP \802 /NO GOTO [8.2.1.2] C YES, C IF (KWC=1) OR (IX2 NEQ IX) OR (IY2 NEQ IY) C THEN GO INTERPOLATE DATA AND PUSH IT. S CLA CMA S TAD \KWC S SNA CLA S JMP \810 /1, GO PUSH C S TAD \IX S CIA S TAD \IX2 S SZA CLA S JMP \810 /NEQ, GO PUSH C S TAD \IY S CIA S TAD \IY2 S SNA CLA S JMP \802 /NO C C C [8.2.1.1] FIRST POINT. YES, GO PUSH C GO INTERPOLATE DATA C IF KWC=1 C THEN PUSH (IX,IY) AS FIRST POINT C ELSE FOR [IX1:IX2,IY1:IY2] COMPUTE!LINE(PUSH(X,Y)); S\810, CLA CMA S TAD \KWC S SZA CLA S JMP \811 /GO INTERPOLATE LCNT=1 S JMS PUSHXY IX2=IX IY2=IY KWC=KWC+1 GOTO 801 C C C [8.2.1.2] INTERPOLATE: 811 IX1=IX2 IY1=IY2 IX2=IX IY2=IY S JMS DRAW GOTO 801 C C C [8.2.3] TEST FBW3 BITS 7,8,9,10 KEYS C IF FBW3[7] THEN SET CURSOR ON LAST POINT S\802, FBW3 S AND (0020 S SNA CLA S JMP \1802 /NO LCNT=KWC-1 S JMS LOKBND DO 1803 IZ=1,50 S TAD \IXPOSITION S TAD \IX S LDXP S TAD \IYPOSITION S TAD \IY S LDYP CALL CLOCK 1803 CONTINUE C C C IF FBW3[8] THEN RESTART DRAWING S\1802, FBW3 S AND (0010 /KEY 8 S SZA CLA S JMP \800 /RESTART BOUNDARY C C C IF FBW3[9] THEN ERASE BOUNDARY BACKWARDS S FBW3 S AND (0004 S SNA CLA S JMP \803 /NO C C IF KWC LEQ 1 C THEN NOP S CLA CMA /-1 S TAD \KWC S SNA S JMP \801 S SPA CLA S JMP \800 /RESTART ---- C C GET THE X,Y COORDS TO DELETE LCNT=KWC S JMS LOKBND IZ=0 MEM=JBM IBYTE=JHGHP CALL PACK2D KWC=KWC-1 C UPDATE 2ND PTR LCNT=KWC-1 S JMS LOKBND IX2=IX IY2=IY GOTO 801 C C C IF FBW3[10] C THEN CLOSE THE BOUNDARY, COPY BMJ'==>BMJ AND START MARK EDIT. S\803, FBW3 S AND (0002 S SNA CLA S JMP \801 /NO C C C CLOSE THE BOUNDARY BY DRAWING A LINE FROM THE LAST TO FIRST C POINT. C COPY BMJ'<==BMJ C SETUP THE LAST POINT IX1=IX2 IY1=IY2 C GET THE LAST POINT AND MAKE IT THE FIRST POINT. LCNT=1 S JMS LOKBND IX2=IX IY2=IY S JMS DRAW C C BACKUP THE LIST 1 POINT SINCE 1ST=LAST. KWC=KWC-1 C DO 830 LCNT=1,KWC S JMS LOKBND MEM=JBM IBYTE=JHGH IZ=255 CALL PACK2D C ERASE THE BND IN BMJ' IBYTE=JHGHP IZ=0 CALL PACK2D 830 CONTINUE C C GO DO BOUNDARY MARK EDIT AT [6]. GOTO 600 C C [999] RETURN GOTO 998 999 WRITE(1,996) 996 FORMAT('BAD SPEC!') 998 CONTINUE 997 FC=TIMER(2) C C RESTORE F&S POSITIONS C DO MLDFS CALL BMOMNI(0,0,0,0,0,IPSTK,19) C C RESTORE POST STATUS S TAD \IFILTER /OLD VALUE S QPROG7 S TAD \IPSTA S POSTA S TAD \IPSTB S POSTB CALL CHAIN('BMON2') C ********************************************* C *SUBROUTINE R S V I D C ********************************************* C GET THE INDEX # FROM THE KPD AND THEN MARK IT AS A C IP'TH POINT ON THE BOUNDARY. S CPAGE 3 S RSVID, JMP I SVID S SVID, 0 C C C WAIT 1 SECOND DO 1822 INDEX=1,200 CALL CLOCK 1822 IBUF3(INDEX)=0 C C IF /G THEN RETURN S SVCNT, TAD \ISWG S SNA CLA S JMP RSVID /RETURN C C C IF /1 C THEN DEFAULT IT TO 1 LSNEW=1 IF(ISW(28))1831,1832,1831 C GET INDEX # 1832 WRITE(1,1801) 1801 FORMAT(/,' INDEX#=(VIA KPD)') C RING BELL S TAD (207 /BELL S TLS S CLA C S WKP, TSF S JMP WKP S SKPKPD S JMP WKP S RKYPDL /GET LOW BCD DIGITS S DCA \LSNEW C CLEAR KPD S RKYPDH C S CLA S\1831, TAD \LSNEW S LQDT1 /LOAD QMT DISPLAY C C IF /L THEN DRAW THE NUMBER TO THE RIGHT OF THE POINT IBUF3=ISW(12) S TAD \IBUF3 S SNA CLA S JMP \1823 /NO C COMPUTE " XX@" S TAD \LSNEW S RTR;RAR S AND (1 S TAD (4060 /"SPACE&0" S DCA \IBUF3 S TAD \LSNEW S BSW S AND (0700 S TAD (6000 S DCA \IBUF3# C DO MTEXT CALL BMOMNI(JBM,JHGHP,IX,IY,255,IBUF3,1) 1823 INDEX=IBCD(LSNEW,1) C S TAD \INDEX S SNA S JMP SVCNT /NO S AND (7760 S SZA CLA S JMP SVCNT /NO C C OK, NOW UPDATE X IF IP=1, Y IF IP=2 S CLA CMA S TAD \LCNT S CLL RAL S TAD \IP S TAD (-1 /FOR (IP-1) S DCA 7 S CPAGE 17 S TAD \INDEX S BSW; RTL S AND (7400 S MQL S 6261 S TADI 7 S AND (377 S MQA S DCAI 7 S 6211 /RESTORE COMMON C S JMP RSVID C ********************************************* C *SUBROUTINE D R A W C ********************************************* C DRAW [IX1:IX2], [IY1:IY2] AND PUSH THE DATA INTO THE BUFFER. C IF OVF THEN RESTART [8]. S CPAGE 3 S RDRAW, JMP I DRAW S DRAW, 0 C DO MMOVE CALL BMOMNI(0,0, IX1,IY1,0,IBUF1,2) C C DO MDRAW C GENERATE LIST OF POINTS BUT DO NOT DRAW THEM IA=-1 C C DO DDRAW CALL BMOMNI(0,0,IX2,IY2,IA,IBUF1,3) C C IF KWC+IA > 2047 C THEN DISALLOW IT! C PUSH UP TO THE MAXIMUM NUMBER ALLOWED S TAD \KWC S TAD \IA S SPA CLA S JMP \801 /DO NO ALLOW! C DO 1812 INDEX=1,IA C COMPUTE: IX=IBUF1(IP_2*(I-1)) S CLA CMA /-1 S TAD \INDEX S CLL RAL /*2 S TAD (-1 /FOR AUTOINDEX S TAD PBUF1 S DCA 11 S CPAGE 4 S DCA \KX /FORCE COMMON S TADI 11 S CPAGE 4 S DCA \KX C COMPUTE: IY=IBUF1(IP+1) S TADI 11 S DCA \KY C C IF TOPSTK(KWC-1)=(KX,KY) OR BOTSTK(LCNT=1)=(KX,KY) C THEN IGNORE DUPLICATE POINT LCNT=1 S JMS LOKBND S TAD \KX S CIA S TAD \IX S SZA CLA S JMP \1814 /NEQ S TAD \KY S CIA S TAD \IY S SNA CLA S JMP \1812 /=, DO NOT PUSH C 1814 LCNT=KWC-1 S JMS LOKBND S TAD \KX S CIA S TAD \IX S SZA CLA S JMP \1813 /NEQ, GO PUSH S TAD \KY S CIA S TAD \IY S SNA CLA S JMP \1812 /=0, IGNORE C C PUSH IT 1813 IX=KX IY=KY LCNT=KWC S JMS PUSHXY KWC=KWC+1 C DRAW BLACK MEM=JBM IBYTE=JHGHP IZ=255 CALL PACK2D 1812 CONTINUE S JMP RDRAW C ********************************************* C *SUBROUTINE S Q U A R E C ********************************************* C DRAW A SQUARE AT [IX,IY] OF COLOR IZ. S CPAGE 3 S RSQUARE, JMP I SQUARE S SQUARE, 0 C MEM=JBM IBYTE=JHGHP C C C DO FIRST ROW 3 POINTS IY=IY-1 IX=IX-1 CALL PACK2D S INC \IX CALL PACK2D S INC \IX CALL PACK2D C C DO 2ND ROW 2 POINTS IY=IY+1 IX=IX-2 CALL PACK2D IX=IX+2 CALL PACK2D C C DO 3RD ROW 3 POINTS IY=IY+1 IX=IX-2 CALL PACK2D S INC \IX CALL PACK2D S INC \IX CALL PACK2D C C RESTORE IX,IY IY=IY-1 IX=IX-1 S JMP RSQUARE 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 (0215 /"BM" 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 L O K B N D C****************************************************** C C C LOOKUP THE X,Y COORDINATES (IX,IY) FOR THE LCNT'TH POINT C IN THE BOUNDARY STORED IN FIELD 6. S CPAGE 3 SRLOKBND, JMP I LOKBND S LOKBND, 0 /ENTRY C C LOOKUP THE BOUNDARY POINT S CLA CMA S TAD \LCNT S CLL RAL S DCA 7 S CPAGE 14 S 6261 S TADI 7 S INC 7 S 6211 S DCA \IX S 6261 S TADI 7 S 6211 S DCA \IY C S JMP RLOKBND /OK. C*************************************************** C *PROCEDURE P U S H X Y C****************************************************** C C C PUSH (IX,IY)==>FIELD6[LCNT] C IN THE BOUNDARY STORED IN FIELD 6. S CPAGE 3 SRPUSHXY, JMP I PUSHXY S PUSHXY, 0 /ENTRY C C C COMPUTE THE ADDRESS S CLA CMA S TAD \LCNT S CLL RAL S DCA 7 S CPAGE 14 S TAD \IX S 6261 S DCAI 7 S INC 7 S 6211 S TAD \IY S 6261 S DCAI 7 S 6211 C S JMP RPUSHXY /OK. 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 PBUF1, \IBUF1 S PBUF2, \IBUF2 S PBUF4, \IBUF4 END