C PROGRAM GPEDIT.FT C ------------------- C C C SUBROUTINE GPEDIT(IXF,IYF,JBM,JHGH,IBM1,IHGH1,IQ7,JXF,JYF,M,IS) C C C P LEMKIN C NIH C BETHESDA, MD C C C MAY 9, 1977 C APRIL 14, 1977 C APRIL 12, 1977 C APRIL 1, 1977 C MARCH 31, 1977 C MARCH 22, 1977 C MARCH 15, 1977 C MARCH 13, 1977 C MARCH 12, 1977 C MARCH 4, 1977 C MARCH 3, 1977 C FEB 20, 1977 C FEB 8, 1977 C JAN 28, 1977 C JAN 24, 1977 C JAN 23, 1977 C JAN 19, 1977 C JAN 16, 1977 C JAN 14, 1977 C JAN 13, 1977 C JAN 12, 1977 C JAN 11, 1977 C JAN 10, 1977 C JAN 8, 1977 C NOV 22, 1976 C NOV 18, 1976 C NOV 15, 1976 C NOV 12, 1976 C NOV 11, 1976 C NOV 10, 1976 C NOV 9, 1976 C NOV 8, 1976 C NOV 5, 1976 C NOV 4, 1976 C NOV 3, 1976 C NOV 1, 1976 C OCT 28, 1976 C C PURPOSE C ------- C PERFORM GRAPHPEN EDITING ON THE OF THE POSTED IMAGE . C USE THE MASK () TO EXTRACT DATA FROM ==> AND C USE ' AS A SCRATCH BUFFER. C C C KEY FUNCTION C --- -------- C 0 TOGGLE POST/UNPOST STATUS C 1 GET IMAGE INTO BMI. C 2 ERASE BOUNDARY BACKWARDS. C 3 **FREE** C 4 ZERO , ERASE IT C 5 ZERO (ERASE IT), RESET RLM, RESET VECT. GEN C 6 MOVE CURRENT CURSOR TO LAST XY. C 7 ROTATE CURSOR (TO LAST XY) CLOCKWISE C 8 ROTATE CURSOR (TO LAST XY) COUNTER-CLOCKWISE C 9 COPY 0'S==> BMJ UNDER RLM C 10 _EXTRACT DATA FROM USING RLM. C COMPUTE AND PRINT MIN WINDOW, AREA, PERIM EDGE PTS., C DENSITY/AREA, P**2/A. IF /K THEN REQUEST KEYPAD VALUE. C 11 EXIT C C C ARGUMENTS C ------------ C GPEDIT.FT IS CALLED FROM EXTRACT.FT WHICH GETS ARGUMENTS AND C FROM BMON2 AS: C C _EXTRACT, C C IS SPECIFIED AS: (JBM,JHGH) C IS SPECIFIED AS: (IBM1,IHGH1). C C THE BM WINDOW OFFSET FOR IS SPECIFIED AS: (IXF,IYF). C THE BM WINDOW OFFSET FOR IS SPECIFIED AS: (JXF,JYF). C C IQ7&'7776 IS THE VALUE OF THE QPROG7 (QMT PROGRAM WORD) AND IS C USED TO DETERMINE WHETHER THE RTPP IS IN /B/M MODE OR NOT. C C IQ7&'0001 IS THE /K SWITCH. C C MGP SPECIFIES THE USE OF THE GRAPHPEN IF 0, THE MOUSE IF 1. C EXTRACT SETS MGP TO /Y. C C -------------------------------------------------------- C C NOTE: = (IBM1, (1-IHGH1)). C C THE MASK IS EDITED IN AND IS USED TO EXTRACT C DATA FROM USING EITHER A RASTER FILL OR BY FIRST C CONSTRUCTING A "RUN LENGTH MAP" AND THEN TESTING THE MAP. C OUTPUT DATA FROM IS SAVED IN . IS C USE AS A SCRATCHPAD. C S OPDEF LDXP 6443 S OPDEF LDYP 6444 S OPDEF DISP1 6435 S OPDEF DISP2 6436 C DIMENSION IB(350),IQ(8) DIMENSION IPTR(2),JPTR(2),LIST(2) C C C C [1] DEFINE BMOMNI CALLS S TAD I \IS /SPOOLER IS BIT 0 S AND (0001 S DCA \IOUTSPOOL MGP=M MGET=9 MRUNQMT=26 MPOST=5 MRDFBW=22 MFETCH2D=10 MCOLOR=4 MPACK2D=11 MMOVE=2 MDRAW=3 MLDFS=19 MQPROG=29 MCLOCK=30 MLDCURSOR=18 MRDKPD=21 C C DEFINE BNODE CALLS: KAPPENDXY=1 KDELETEXY=2 KPRINTLIST=3 KINITAVAIL=4 KGETLIST=5 KFREELIST=6 KLASTXY=7 KNEXTXY=8 KCARXY=9 KFINDXY=10 KCOPYLIST=11 KCONSLIST=12 KCDRLIST=13 KSETXY=14 C C C [1.1] DEFINE THE NULL LIST LIST=-1 S CLA CMA S DCA \LIST# C C C [1.2] DEFINE MASK MEMORY IHGHP=1-IHGH1 C C C [1.3] POST BM1 EDIT CALL BMOMNI(IBM1,IHGH1, 0,1,0, IB,MPOST) CALL BMOMNI(JBM,JHGH, 0,0,0, IB,MPOST) C*************DEBUG***** CALL BMOMNI(3,0, 0,0,0,IB,MPOST) C**************************** C C C [1.4] POSITION F&S AT IB=IXF S TAD (D256 S DCA \IB# /IB(2) C IB(3)=IYF IB(4)=256 CALL BMOMNI(0,0 ,0,0,0, IB,MLDFS) C C C [1.5] BACKUP THE BMI' AND BMJ POINTERS IXOFF=IXF IYOFF=IYF C C C C [1.6] TEST IF TURN ON QMT FOR DISPLAYING THE MASK IF IT IS NOT C ALREADY DISPLAYED. C IF (IQ7 LAND '6000)=0 C THEN [QPROG7<==('6000 XOR IQ7); QPROG2<=='0020]; S TAD I \IQ7 S AND (6000 S SZA CLA S JMP \100 /IT IS ALREADY /B/M C C SET UP FOR /B/M S TAD (0020 S DCA \IQ# /IQ(2) C S TAD I \IQ7 S TAD (6000 S DCA \I IQ(7)=I CALL BMOMNI(IBM1,IHGH1,0,0,0,IQ,MQPROG) C C C [1.7] SIMULATE KEY5 AND KEY 4 FOR INIT! S TAD (0300 S DCA \IFBW3 S JMP KEY0 C C C [2] GET CLASS KEYS AND LOOP HERE! 100 CONTINUE C DEFINE THE MASK DENSITY ISHADE=255 C C CHECK THE STAGE CALL MANUAL C C IB[1:10] CONTAINS FBW1:FBW12(OCTAL) SWITCHES CALL BMOMNI(0,0 ,0,0,0, IB,MRDFBW) IFBW3=IB(3) IFBW5=IB(5) C C SPECIFY BRUSH SIZE FROM FBW5 S TAD \IFBW5 S AND (0017 /CLIP TO 15 S DCA \IFBW5 C C C C C C [3] IF FBW3[6]=0 C THEN BRIGHTEN CURRENT CURSOR S KEY6, CLA S TAD \IFBW3 S AND (0040 /BIT 6 S SNA CLA S JMP KEY0 /NO C C C THEN GOTO 700 C [4] IF CLASS KEY 0 C THEN TOGGLE BM0 POST STATUS S KEY0, TAD \IFBW3 S AND (4000 S SNA CLA S JMP KEY1 C C TOGGLE BM0 POST STATUS IPSTSW=1-IPSTSW IDSPMSK=1-IPSTSW CALL BMOMNI(IBM1,IHGH1,0,IDSPMSK,0,IB,MPOST+IPSTSW) C RELOAD THE QPROG REGISTERS CALL BMOMN(0,0, 0,0,0,IQ,MQPROG) C C SYNC WITH THE QMT CALL BMOMNI(0,0, 0,0,IZ,IB,MRUNQMT) GOTO 100 C C C C [5] IF KEY 1 THEN GET BMI S KEY1, TAD \IFBW3 S AND (2000 S SNA CLA S JMP KEY5 /NO C C ASK IF SURE! S TAD (4040 /" " S DCA \IZ WRITE(1,126)IZ, 126 FORMAT(' ARE YOU SURE?(Y/N):',A1) S WINPUT, KSF S JMP WINPUT S KRB S AND (177 S TAD (0200 S TAD (-"Y S SZA CLA S JMP \100 /NO! C C CONTINUE WITH GET S TAD ("Y S TLS /ECHO IT! S CLA C CALL BMOMNI(IBM1,IHGH1,0,0,0,IB,MGET) GOTO 100 C [6] IF KEY 5 ==> ERASE IBM1' AND FREE THE BOUNDARY NODE LIST. S KEY5, TAD \IFBW3 S AND (0100 /BIT 5 S SNA CLA S JMP KEY7 /NO C C C [6.1] ERASE SKETCHPAD MEMORY C YES, C GENERATE ZERO ARRAY 127 CALL BMOMNI(IBM1,IHGHP, 0,0,0, IB,MCOLOR) C C REINIT BOUNDARY VECTOR EDIT IEDIT=-1 C C CLEAR BIT 5 S TAD \IFBW3 S AND (7677 S DCA \IFBW3 C C DEFINE THE SHADE TO WRITE THE BOUNDARY ISHADE=255 C C C FREE THE BOUNDARY LIST IF IT EXISTS C IF LIST(2) NEQ -1 THEN FREE LIST[1:2]. S CLA IAC S TAD \LIST# S SNA CLA S JMP KEY4 /IT IS ALREADY NULL! CONTINUE SCAN FOR KEY 4 C C ELSE FREE THE BOUNDARY CALL BNODE(0,0,LIST,KFREELIST) C C DEFINE THE NULL LIST LIST=-1 S CLA CMA S DCA \LIST# C GOTO 100 C C C [7] IF KEY 7 C THEN ROTATE CURSOR CLOCKWISE S KEY7, TAD \IFBW3 S AND (20 S SNA CLA S JMP KEY8 C C YES, ROTATE CURSOR CLOCKWISE CALL BNODE(LSTX,LSTY,LIST,KNEXTXY) 700 CALL BMOMNI(IBM1,IHGH1,IXOFF+LSTX,IYOFF+LSTY,0,IB,MLDCURSOR) C C WAIT 1/8 SECOND BETWEEN POINTS! CALL BMOMNI(0,0, 0,0,25, JUNK,MCLOCK) GOTO 100 C C [8] IF KEY 8 C THEN ROTATE THE CURSOR COUNTERCLOCKWISE S KEY8, TAD \IFBW3 S AND (10 /BIT 8 S SNA CLA S JMP KEY9 C C YES, ROTATE CURSOR COUNTERCLOCKWISE CALL BNODE(LSTX,LSTY,LIST,KLASTXY) C GO DISPLAY THE CURSOR GOTO 700 C [9] IF KEY 9 C THEN COPY 0'S ==> BMJ UNDER RLM. S KEY9, TAD \IFBW3 S AND (4 S SNA CLA S JMP KEY10 C ISHADE=0 C C CONTINUE AT [10] S TAD (0002 /KEY 10 SIMULATION S DCA \IFBW3 S JMP KEY10 C [10] IF KEY 10 THEN COPY DATA FROM TO UNDER RLM. S KEY10, TAD \IFBW3 S AND (2 S SNA CLA S JMP \150 C C C [10.1] CLOSE THE CURVE, SHUT OFF VECTOR GENERATOR C FIND THE TOP OF THE CURVE AND SET THE LIST TO IT. C IF LIST=NULL THEN DO NOTHING S TAD \LIST# S SPA CLA S JMP \100 /NO LIST, ABORT! C C C [10.1.1] TEST IF LIST WAS SORTED. IF SO GOTO [10.2] S CLA CMA /-1 (IT MUST BE > 0) S TAD \IEDIT S SZA CLA S JMP \136 /DO NOT SORT. C C C [10.1.2] FINISH OFF BOUNDARY IEDIT=0 CALL BMOMNI(0,0 ,LSTX,LSTY,0,IB,MMOVE) IZ=255 CALL BMOMNI(IBM1,IHGHP,IXFIRST,IYFIRST,IZ,IB,MDRAW) C C C [10.1.3] ENTER THE REST OF THE BOUNDARY DO 135 I=1,IZ C COMPUTE: J=(2*I)-1 S TAD \I S CLL RAL /X2 S TAD (-1 S DCA \J C IX=IB(J) IY=IB(J+1) C C APPEND (X,Y) TO LIST CALL BNODE(IX,IY,LIST,KAPPENDXY) 135 CONTINUE C C C [10.1.4] SORT THE BOUNDARY TO THAT LIST POINTS TO THE C FIRST MINIMUM IY. C C COPY CURRENT LIST HEADER PTR IPTR=LIST JPTR=LIST S TAD \LIST# S DCA \IPTR# S TAD \LIST# S DCA \JPTR# C C SET MIN KY1 TO IY[LIST] CALL BNODE(KX1,KY1,LIST,KCARXY) C C LOOP TO FIND MAX(KY1,IY) 132 CALL BNODE(IX,IY,IPTR,KNEXTXY) S TAD \IX S DISP1 S TAD \IY S DISP2 C S TAD \IX S TAD \IXOFF S LDXP S TAD \IY S TAD \IYOFF S LDYP C C TEST IF GET OUT! S CPAGE 3 S JMS TTYCTL S JMP \100 /GET OUT! C C IF (IY < KY1) C THEN [KY1<==IY, JPTR<==IPTR]; IF(IY-IY1)133,134,134 C C THEN 133 KY1=IY KX1=IX JPTR=IPTR S TAD \IPTR# S DCA \JPTR# C C TEST IF DONE. C IF (LIST[1:2]=IPTR[1:2]) C THEN DONE C ELSE GOTO 132; S \134, TAD \LIST S CIA S TAD \IPTR S SZA CLA S JMP \132 /NOT DONE C S TAD \LIST# S CIA S TAD \IPTR# S SZA CLA S JMP \132 /NOT DONE C C C DONE!, NOW SET LIST<==LAST(JPTR) FOR THE MIN Y COORDINATE. LIST=JPTR S TAD \JPTR# S DCA \LIST# CALL BNODE(IX,IY,LIST,KLASTXY) C C SET LST AND FIRST TO SAME POINT LSTX=KX1 LSTY=KY1 IXFIRST=KX1 IYFIRST=KY1 C C C C [10.2] GENERATE THE RLM FROM THE LIST OF BOUNDARY PIXELS. C IF LIST[1:2]=-1 C THEN NOP, GOTO 100 S\136, CLA IAC S TAD \LIST# S SNA CLA S JMP \100 /NOP C C ZERO RLM AND SET UP BRUN POINT LOOKAHEAD. C GET THE XY FROM THE FIRST NODE CALL BNODE(IX1,IY1,LIST,KCARXY) CALL BRUN(IX1,IY1,IFLAG,1) C C C [10.2.1] TRACE BOUNDARY AND ENTER POINTS INTO RLM. C COPY CURRENT LIST HEADER PTR IPTR=LIST S TAD \LIST# S DCA \IPTR# C C GET THE NEXT FROM THE HEADER NODE. CALL BNODE(IX,IY,IPTR,KNEXTXY) C C ENTER IX,IY INTO THE RLM 137 CALL BRUN(IX,IY,DID,2) C S TAD \IX S DISP1 S TAD \IY S DISP2 C S TAD \IX S TAD \IXOFF S LDXP S TAD \IY S TAD \IYOFF S LDYP C C TEST IF GET OUT! S CPAGE 3 S JMS TTYCTL S JMP \100 C C C LOOP TO FIND MAX(KY1,IY) CALL BNODE(IX,IY,IPTR,KNEXTXY) C C TEST IF DONE. C IF (LIST[1:2]=IPTR[1:2]) C THEN DONE C ELSE GOTO 137; S TAD \LIST S CIA S TAD \IPTR S SZA CLA S JMP \137 /NOT DONE C S TAD \LIST# S CIA S TAD \IPTR# S SZA CLA S JMP \136 /NOT DONE C C DONE! C C C C [10.2.2] CLOSE THE RLM CALL BRUN(KY1,KY2,IFLAG,3) CALL BRUN(IX1,IY1,IFLAG,6) C C C *********DEBUG****** C IF FBW4[2] C THEN PRINT RUN INFO S 6344 /FBW4 S AND (2000 /BIT 2 S SNA CLA S JMP NODMP1 IFLAG=3 CALL BRUN(KY1,KY2,IFLAG,7) S NODMP1, CLA C ******************** C C C [10.3] GET WINDOW CALL BRUN(KY1,KY2,IFLAG,3) C C ADD 1 FOR DO LOOPS KY1=KY1+1 KY2=KY2+1 C C C [10.3.1] ZERO COUNTERS C INIT AREA, DENSITY, PERIMETER A=0.0 P=0.0 D=0.0 C C C [10.4] GET RUNS AND COPY PIXELS DO 141 IY1=KY1,KY2 IY=IY1-1 S TAD \IY S DISP2 C S CPAGE 3 S JMS TTYCTL S JMP \100 /GET OUT C C C [10.4.1] TEST IF ANY RUNS CALL BRUN(0,IY,NRUNS,8) S TAD \NRUNS S SNA CLA S JMP \141 /NO RUNS C C COMPUTE: PERIMETER P=P+FLOAT(NRUNS+NRUNS) C C C C [10.4.2] COPY THIS RUN C PASS LINE # IN JY ARG, RUN # IN JX ARG DO 142 IRUN=1,NRUNS KX1=IRUN KX2=IY CALL BRUN(KX1,KX2,IFLAG,9) C DO 143 IX1=KX1,KX2 IX=IX1-1 C S CPAGE 3 S JMS TTYCTL S JMP \100 /FORGET IT C C CALL BMOMNI(IBM1,IHGH1,IX,IY,IZ,IB,MFETCH2D) C C C COMPUTE AREA AND DENSITY A=A+1.0 D=D+FLOAT(IZ) C C TEST IF ISHADE TO ERASE S TAD \ISHADE S SNA CLA S DCA \IZ /ZERO DENSITY C CALL BMOMNI(JBM,JHGH,IX,IY,IZ,IB,MPACK2D) C 143 CONTINUE 142 CONTINUE 141 CONTINUE C C C [10.5] PRINT FEATURES C GET HORIZONTAL RANGE! CALL BRUN(KX1,KX2,IFLAG,4) S JMS PFEATURES C C C [10.6] RELEASE THE RLM LIST STORAGE! CALL BRUN(0,0,IFLAG,12) GOTO 100 C C C [11] IF GRAPHPENSW=TRUE AND C (IX NEQ LSTX) OR (IY NEQ LSTY) C THEN OUTPUT DATA 150 CONTINUE C C [11.1] GET GP XY DATA C NOTE: GRAPHPEN IF MGP=0, MOUSE IF MGP=1. CALL MOUSE(IXOFF,IYOFF,IX,IY,ISW,MGP) C C S CLA CMA S TAD \ISW S SZA CLA S JMP KEY11 /NO C C C [11.2] TEST IF DRAW (IF NOT FIRST X,Y POINT) C ELSE SET IEDIT=1 AND SAVE FIRST X,Y S TAD \IEDIT S SPA CLA S JMP \157 /ENTER FIRST POINT S TAD \LSTX S CIA S TAD \IX S SZA CLA S JMP \159 /NEQ SO SAVE DATA C S TAD \LSTY S CIA S TAD \IY S SNA CLA S JMP \100 /FORGET IT BOTH X,Y = C C C [11.3] WRITE OUT ONTO MASK 159 CALL BMOMNI(0,0 ,LSTX,LSTY,0, IB,MMOVE) IZ=255 CALL BMOMNI(IBM1,IHGHP, IX,IY,IZ,IB,MDRAW) C IF NO INTERPOLATED POINTS, THEN FORGET IT IF(IZ)100,100,158 C C C [11.4] INIT FIRST AND SAVE LAST POINT 157 IEDIT=1 IXFIRST=IX IYFIRST=IY C C UPDATE LAST X,Y 158 LSTX=IX LSTY=IY C C C C [11.5] UPDATE THE BOUNDARY LIST C DO 156 I=1,IZ C C TEST IF GET OUT S CPAGE 3 S JMS TTYCTL S JMP \100 /GET OUT C C COMPUTE: J=(2*I)-1 S TAD \I S CLL RAL /MULT BYT 2 S TAD (-1 S DCA \J C C COMPUTE: IX=IB(J) S TAD (-2 /-1 FOR KX, -1 FOR AUTOINDEX S TAD \J S TAD PIB S DCA 11 S TAD I 11 S DCA \IX C C COMPUTE: IY=IB(J+1) S TAD I 11 S DCA \IY C C C IF LIST[1:]=-1 S CLA IAC S TAD \LIST# S SZA CLA S JMP \155 /LIST NOT NULL C C THEN C GETLIST(IX,IY)==>LIST CALL BNODE(IX,IY,LIST,KGETLIST) GOTO 156 C C ELSE C APPEND IX IY ==>LIST 155 CALL BNODE(IX,IY,LIST,KAPPENDXY) 156 CONTINUE GOTO 100 C C C [12] IF KEY 11 THEN[RESTORE QPROG2,7; EXIT]; S KEY11, TAD \IFBW3 S AND (0001 S SNA CLA S JMP KEY3 /TEST KEY 3 C C YES, IF QPROG7 < '6000 C THEN RESTORE QPROGS S \2047, TAD I \IQ7 S SPA CLA S JMP \162 /NO C S DCA \IQ# /COMPUTE: IQ(2)=0 S TAD I \IQ7 S AND (7776 S DCA \IX IQ(7)=IX CALL BMOMNI(0,0 ,0,0,0, IQ,MQPROG) C C C PASS BACK THE LIST POINTER LIST[1:2]==>IXF:IYF. IXF=LIST IYF=LIST(2) 162 RETURN C C C C [13] IF FBW3[3] NEQ 0 C THEN ***FREE*** S KEY3, TAD \IFBW3 S AND (0400 S SNA CLA S JMP KEY4 /NO C C ***FREE*** GOTO 100 C C [14] IF FBW3[4]=1 THEN ZERO S KEY4, TAD \IFBW3 S AND (0200 S SNA CLA S JMP KEY2 /NO C CALL BMOMNI(JBM,JHGH, 0,0,0, IB,MCOLOR) GOTO 100 C C C C C [15] IF FBW3[2]=1 C THEN ERASE BOUNDARY FROM LIST AND BM MASK BACKWARDS. S KEY2, TAD \IFBW3 S AND (1000 S SNA CLA S JMP \100 /NO C C YES C C IF LIST[1:2]=-1 C THEN "NO LIST", RETURN C ELSE CONTINUE; S CLA IAC S TAD \LIST# S SNA CLA S JMP \100 /NOP C C IF IEDIT=0 C THEN S TAD \IEDIT S SZA CLA S JMP \1500 /NOT ZERO C C THEN IEDIT=1 CALL BNODE(IXFIRST,IYFIRST,LIST,KCARXY) C C C GET CURRENT IX,IY 1500 IPTR=LIST S TAD \LIST# S DCA \IPTR# CALL BNODE(IX,IY,IPTR,KLASTXY) C C IF IPTR=LIST C THEN ERASE USING KEY 5 SIMULATION; S TAD \LIST S CIA S TAD \IPTR S SZA CLA S JMP \1501 /NO C S TAD \LIST# S CIA S TAD \IPTR# S SZA CLA S JMP \1501 /NO C C FINISH ERASE AT [6.1] IFBW3=0 GOTO 127 C C ZERO MASK BM PIXEL 1501 ISHADE=0 CALL BMOMNI(IBM1,IHGHP,IX,IY,ISHADE,IB,MPACK2D) C C UPDATE THE LAST X,Y CALL BNODE(LSTX,LSTY,IPTR,KLASTXY) C C C BACKUP THE LIST BY DELETING THE NODE CALL BNODE(IX,IY,LIST,KDELETEXY) C GOTO 100 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 C C C ******************************************************** C *SUBROUTINE P F E A T U R E C ********************************************************** C PRINT FEATURES DERIVED FROM EXTRACT C S CPAGE 3 S RPFEATURE, JMP I PFEATURE S PFEATURE, 0 /ENTRY C C CVT TO MICRONS CALL BMAP(PUC,PUC,PUC,UNAME) D=D/A A=A*PUC*PUC P=P*PUC PUC=(P*P)/A C C IF (IQ7&'0001)=1 C THEN CLASSKEY<==KEYPAD ELSE CLASSKEY=0; CLASSKEYPAD=0.0 S TAD I \IQ7 S AND (0001 S SNA CLA S JMP \1882 /NO C C GET THE KEYPAD AFTER RING THE BELL S TAD (207 /BELL S TLS S CLA CALL BMOMNI(0,0, 0,0,0, CLASSKEYPAD,MRDKPD) C C C PRINT WINDOW 1882 ISERIAL=ISERIAL+1 IX1=1+IOUTSPOOL IY1=1 DO 1881 IZ=1,IX1 WRITE(IY1,1880)ISERIAL,KX1,KX2,KY1,KY2,A,P,D,PUC,UNAME,CLASSKEYPAD 1880 FORMAT(/,' #',I5,', [',I3,':',I3,', ',I3,':',I3,']',/ 1' A=',F9.2,', P=',F9.2,', D/A=',F10.2,', P*P/A=',F10.4,' ',A6, 2/,' CLASS#=',F7.0) 1881 IY1=4 C C S JMP RPFEATURE C C POINTERS C -------- S PIB, \IB I10=0 I18=0 I14=0 END