LOGICAL REDRAW,VCEN BYTE ITIT,LPLT,CEN,OPT,null REAL*8 FONTNM INTEGER*2 PARM COMMON /DAT/ ITIT(20,80),LPLT(80),LEN(20),SIZE(20),SLANT(20) & ,IFONT(20),FONTNM(5),PARM(6),IOWLB,NULL DATA FONTNM/'DEFAULT ','STICK ','SCRIPT ','BOLDFACE','GOTHIC '/ DATA NULL/0/ DATA IOWLB/"400/ CALL WTQIO("1400,5,1) CALL GETADR(PARM,NULL) PARM(2)=1 PARM(3)="100401 CALL WTQIO(IOWLB,5,1,,,PARM,) TYPE *,'You may enter up to 20 lines of text.' TYPE *,'Terminate text entry by typing a "]"' TYPE *,'in response to the prompt for more text.' NUMLIN=0 DO 20 LINE=1,20 CALL TEXTIN(LINE,.TRUE.) IF (ITIT(LINE,1).EQ.']') GOTO 100 NUMLIN=NUMLIN+1 IF (NUMLIN.EQ.1) GOTO 15 TYPE *,' ' TYPE *,'Do you want the same text characteristics' TYPE *,'as the previous line? [Y/N]' READ (5,444) OPT IF (OPT.EQ.'N' .OR. OPT.EQ.'n') GOTO 15 SIZE(LINE)=SIZE(LINE-1) SLANT(LINE)=SLANT(LINE-1) IFONT(LINE)=IFONT(LINE-1) GOTO 20 15 CALL PARAM(LINE,.TRUE.) 20 CONTINUE WRITE (5,*) 'MAXIMUM NUMBER OF LINES HAVE BEEN INPUT' 100 CONTINUE CALL WTQIO(IOWLB,5,1,,ISB,PARM,IDS) WRITE(5,*)'Characters 76-80 will not be shown' WRITE(5,*)' ' WRITE(5,*)'Line' DO 110 LINE=1,NUMLIN WRITE(5,111)LINE,(ITIT(LINE,J),J=1,75) 111 FORMAT(1H ,I4,1X,75A1) 110 CONTINUE WRITE(5,*)'Enter one of the following options:' WRITE(5,*)'(C) Change line (I) Insert line' WRITE(5,*)'(D) Delete line (T) Text is correct' READ(5,444)OPT IF (OPT.EQ.'T' .OR. OPT.EQ.'t') GOTO 200 IF (OPT.EQ.'D' .OR. OPT.EQ.'d') CALL DELETE(NUMLIN) IF (OPT.EQ.'I' .OR. OPT.EQ.'i') CALL INSERT(NUMLIN) IF(OPT.NE.'C' .AND. OPT.NE.'c') GOTO 100 WRITE(5,*) ' ' WRITE(5,*)'Enter number of line to be changed.' READ(5,*)LINE CALL TEXTIN(LINE,.FALSE.) WRITE(5,144)SIZE(LINE),SLANT(LINE),FONTNM(IFONT(LINE)-49) 144 FORMAT(1H1,'HEIGHT = ',F5.2,' SLANT =',F5.1,' FONT =',A8) WRITE(5,*)' ' WRITE(5,*)'Do you want to change the text characteristics? [Y/N]' READ (5,444) OPT IF (OPT.EQ.'Y' .OR. OPT.EQ.'y') CALL PARAM(LINE,.FALSE.) GOTO 100 200 CONTINUE WRITE(5,*)'Enter pen number' READ(5,*)IPEN WRITE(5,*)'Enter pen speed (1-36)' READ(5,*)ISPD WRITE(5,*)'Enter paper size in inches ("X,Y" ex. 11,8.5 )' READ(5,*)XX,YY WRITE(5,*)'Enter C for centered labels or J for left justified' WRITE(5,*)'Justification will be 1 inch from the left edge' READ(5,444)CEN WRITE(5,*)'To have your block of text centered' WRITE(5,*)' vertically enter T otherwise F' READ(5,*)VCEN CALL PLOTS(3,1,1) IF(XX.GT.15.75)XX=15.75 CALL LIMIT(0.,XX,.59055,11.22) CALL SETIN CALL LORG(4) IF(VCEN .AND. CEN .EQ.'C')CALL LORG(4) IF(VCEN .AND. CEN .EQ.'J')CALL LORG(1) IF(CEN.EQ.'J' .AND. .NOT. VCEN )CALL LORG(1) CALL PENSPD(ISPD) CALL NEWPEN(IPEN) X=XX/2. IF(CEN.EQ.'J')X=1. IF(.NOT.VCEN)GO TO 40 SUM=SIZE(1) DO 70 LINE=2,NUMLIN SUM=SUM+(SIZE(LINE)*1.7)-SIZE(LINE-1)*.2 70 CONTINUE Y=(YY/2.+SUM/2.)-SIZE(1)-SIZE(NUMLIN)*.5 GO TO 80 40 CONTINUE Y=YY-(1.+SIZE(1)*.5) 80 CONTINUE DO 50 LINE=1,NUMLIN CALL CFONT(0,IFONT(LINE)) CALL CSIZEA(SIZE(LINE),.7,SLANT(LINE)) DO 60 M=1,80 LPLT(M)=ITIT(LINE,M) 60 CONTINUE CALL SYMBOL(X,Y,SIZE(LINE),LPLT,0.,LEN(LINE)) IF(LINE.EQ.20)GO TO 50 DDELTA=SIZE(LINE+1)*1.7-SIZE(LINE)*.2 Y=Y-DDELTA 50 CONTINUE CALL NEWPEN(0) CALL PLOTOF WRITE(5,*)'DO YOU WISH TO REDRAW THIS LABEL? [Y/N]' READ(5,444)ANS IF(ANS.EQ.'Y' .OR. ANS.EQ.'y') GOTO 100 444 FORMAT(A1) call exit END SUBROUTINE INSERT(NUMLIN) LOGICAL REPEAT LOGICAL*1 ITIT,LPLT,CEN,OPT COMMON /DAT/ ITIT(20,80),LPLT(80),LEN(20),SIZE(20),SLANT(20) & ,IFONT(20) 5 CONTINUE WRITE(5,*)'In front of which line is new text to be inserted?' READ(5,*)LINE NUMLIN=NUMLIN+1 IF(NUMLIN .GT. 20)NUMLIN=20 DO 15 II=NUMLIN,LINE,-1 LEN(II)=LEN(II-1) SIZE(II)=SIZE(II-1) SLANT(II)=SLANT(II-1) IFONT(II)=IFONT(II-1) DO 10 J=1,80 ITIT(II,J)=ITIT(II-1,J) 10 CONTINUE 15 CONTINUE DO 50 JJ=1,80 ITIT(LINE,JJ)=' ' 50 CONTINUE WRITE(5,*)'ENTER TEXT LINE' READ(5,20)LEN(LINE),(ITIT(LINE,J),J=1,LEN(LINE)) if (len(line).gt.79) goto 70 do 60 i=len(line)+1,80 60 itit(line,i)=0 70 continue 20 FORMAT(Q,80A1) CALL PARAM(LINE,.TRUE.) RETURN END SUBROUTINE DELETE(NUMLIN) LOGICAL*1 ITIT,LPLT,CEN,OPT COMMON /DAT/ ITIT(20,80),LPLT(80),LEN(20),SIZE(20),SLANT(20) & ,IFONT(20) WRITE(5,*)'Enter line number of text to be deleted.' READ(5,*)LINE DO 10 II=LINE,NUMLIN LEN(LINE)=LEN(LINE+1) SIZE(LINE)=SIZE(LINE+1) SLANT(LINE)=SLANT(LINE+1) IFONT(LINE)=IFONT(LINE+1) DO 10 J=1,80 ITIT(LINE,J)=ITIT(LINE+1,J) 10 CONTINUE NUMLIN=NUMLIN-1 RETURN END SUBROUTINE PARAM(LINE,NEWLIN) LOGICAL NEWLIN REAL*8 FONTNM INTEGER OPT,PARM BYTE ITIT,LPLT,NULL COMMON /DAT/ ITIT(20,80),LPLT(80),LEN(20),SIZE(20),SLANT(20) & ,IFONT(20),FONTNM(5),PARM(6),IOWLB,NULL IF (NEWLIN) GOTO 10 5 CALL WTQIO(IOWLB,5,1,,,PARM,) TYPE *,' ' TYPE *,'TEXT CHARACTERISTICS FOR CURRENT LINE' WRITE (5,7) SIZE(LINE),SLANT(LINE),FONTNM(IFONT(LINE)-49) 7 FORMAT (1H1,'HEIGHT = ',F5.2,' SLANT =',F5.1,' FONT = ',A8) TYPE *,' ' TYPE *,'CHOOSE DESIRED OPTION' TYPE *,' 1) CHANGE ALL TEXT PARAMETERS' TYPE *,' 2) CHANGE TEXT SIZE' TYPE *,' 3) CHANGE TEXT SLANT' TYPE *,' 4) CHANGE TEXT FONT' TYPE *,' 5) ALL TEXT PARAMETERS CORRECT' TYPE *,' ' ACCEPT *,OPT TYPE *,' ' GOTO (10,20,30,40,50) OPT 10 TYPE *,'Enter character height in inches' ACCEPT *,REPLY SIZE(LINE)=REPLY TYPE *,' ' TYPE *,'Enter text slant (in degrees from vertical)' ACCEPT *,REPLY SLANT(LINE)=REPLY TYPE *,' ' GOTO 40 20 TYPE *,'Enter character height (in inches)' ACCEPT *,REPLY SIZE(LINE)=REPLY GOTO 5 30 TYPE *,'Enter text slant (in degrees from vertical)' ACCEPT *,REPLY SLANT(LINE)=REPLY GOTO 5 40 TYPE *,'Choose a text font' TYPE *,' ' TYPE *,'1) default STICK' TYPE *,'2) enhanced STICK' TYPE *,'3) SCRIPT' TYPE *,'4) BOLDFACE' TYPE *,'5) GOTHIC' TYPE *,' ' ACCEPT *,OPT IFONT(LINE)=49+OPT GOTO 5 50 CONTINUE RETURN END SUBROUTINE TEXTIN(LINE,NEWLIN) LOGICAL NEWLIN INTEGER PARM BYTE ITIT,LPLT,NULL,ANS COMMON /DAT/ITIT(20,80),LPLT(80),LEN(20),SIZE(20),SLANT(20) & ,IFONT(20),FONTNM(5),PARM(6),IOWLB,NULL IF (.NOT. NEWLIN .OR. LINE.NE.1) CALL WTQIO(IOWLB,5,1,,,PARM,) IF (NEWLIN) GOTO 20 WRITE (5,11) (ITIT(LINE,J),J=1,80) 11 FORMAT (1H ,80A1) WRITE (5,*) ' ' WRITE (5,*) 'Do you want to retype this text line? [Y/N]' READ (5,44) ANS IF (ANS.EQ.'N' .OR. ANS.EQ.'n') RETURN 20 WRITE (5,*) ' ' WRITE (5,*) 'Enter text line' READ (5,33) LEN(LINE),(ITIT(LINE,J),J=1,LEN(LINE)) if (len(line).gt.79) goto 40 do 30 i=len(line)+1,80 30 itit(line,i)=0 40 continue 33 FORMAT (Q,80A1) 44 FORMAT (A1) RETURN END