C C SIGN GENERATOR PROGRAM C C MARK C. WESTON C CITY OF GAINESVILLE, FLORIDA C JULY 10, 1980 C C ANY UNAUTHORIZED USE OF THIS PROGRAM FOR PROFIT C SHALL RESULT IN NASTY EVENTS. C C C THIS PROGRAM READS KEYBOARD INPUT AND PRINTS OUT THE INPUT C IN LETTERS NORMAL HEIGHT OR IN 5 X 5 CHARACTERS. C C TYPE OF LETTERS IS CONTROLLED BY '$L' OR '$S' IN COLS 1 & 2 C FOR LARGE (5 X 5) OR SMALL (1 LINE) LETTERS, RESPECTIVELY. C PLACE '$L' OR '$S' ON A SEPERATE LINE OF INPUT. END OF FILE C IS '(CTRL)Z' OR '$E'. C C OUTPUT IS SAVED IN SY:SIGN.SGN FOR PRINTING BY THE USER. C C C C NOTE: THIS PROGRAM WAS WRITTEN SO THAT USER DEFINED CHARACTER SETS C CAN BE ADDED BY MODIFYING THE PROGRAM. ALLOWING THE PROGRAM TO READ THE C CHARACTER SIZE FROM THE CHARACTER SET FILE AND FORMAT THE OUTPUT FOR C PRINTING IS A FUTURE ENHANCEMENT. THIS PROGRAM WAS ORIGINALLY WRITTEN C TO CLEANUP MESSAGE BOARDS AND PROVIDE FOR EASILY PRODUCED SIGNS. THIS C PROGRAM IS EXCELLENT FOR A UNIVERSITY ENVIRONMENT. C C C C C C C C BYTE INBUF(132),ALPHA(5,400),LCHARS(80),OUTBUF(132),BELL LOGICAL TYPE,SMALL,LARGE INTEGER I,J,K,L,NCHARS,CNTR,START,WIDTH,LIMIT DATA LARGE,SMALL/.TRUE.,.FALSE./ DATA OUTBUF/132*' '/ C C C OPEN LUNS C C UNIT 1 IS THE CHARACTER SET C C UNIT 2 IS THE OUTPUT FILE C C UNIT 5 IS THE KEYBOARD INPUT C C OPEN (UNIT=1,NAME='DB:[211,2]CHARSET.DAT',TYPE='OLD', 1DISPOSE='KEEP',READONLY) OPEN (UNIT=2,NAME='DB:SIGN.SGN',TYPE='NEW',DISPOSE='KEEP', 1RECORDSIZE=133) C C C INITIALIZE A FEW VARIABLES C C TYPE = LARGE WIDTH = 132 CNTR = WIDTH/2 LIMIT = WIDTH/6 BELL = "007 C C C READ IN CHARACTER SET C C THE FILE CHARSET.DAT CONTAINS THE LARGE LETTER SET C C THE FIRST RECORD IS COMPOSED OF ALL THE CHARACTERS IN THE SET, AND C SERVES AS AN INDEX INTO THE REST OF THE FILE. C C THE REST OF THE FILE CONSISTS OF FIVE CHARACTER RECORDS THAT MAKE UP C THE LARGE LETTER SET, AN EXAMPLE OF CHARSET.DAT FOLLOWS: C C COL. C 123456790 C AB---(ETC.) ;THE FIRST RECORD C AAA C A A C AAAAA C A A C A A C BBBB C B B C BBBB C B B C BBBB C . C . C . C (ETC.) C C C READ (1,10)NCHARS,(LCHARS(I),I=1,NCHARS) 10 FORMAT(Q,80A1) NALPHA=NCHARS WRITE (5,11)NALPHA,LCHARS 11 FORMAT('0',I5,1X,'CHARACTERS IN LARGE LETTER SET',1X, 1//,' ***LARGE LETTER SET***',/,' ',80A1) DO 50 I=1,NALPHA DO 60 J=1,5 READ(1,12,END=99)(ALPHA(J,K),K=(I*5)-4,I*5) 12 FORMAT(5A1) 60 CONTINUE 50 CONTINUE C C C WRITE START MESSAGE C C 99 WRITE (5,13) 13 FORMAT('0','*ENTER SIGN TEXT*') C C C READ A LINE FROM THE KEYBOARD C C 100 WRITE (5,14) 14 FORMAT('$','SGN>') READ (5,15,END=999)NCHARS,INBUF 15 FORMAT(Q,132A1) C C C CHECK TO SEE IF A CHANGE OF CHARACTER TYPE (LARGE OR SMALL) C C '$L' IN COLS 1 & 2 CHANGES TYPE TO LARGE LETTERS C '$S' IN COLS 1 & 2 CHANGES TYPE TO SMALL LETTERS C '$E' IN COLS 1 & 2 FOR EXIT C C IF(INBUF(1).EQ.'$'.AND.INBUF(2).EQ.'L')TYPE=LARGE IF(INBUF(1).EQ.'$'.AND.INBUF(2).EQ.'S')TYPE=SMALL IF(INBUF(1).EQ.'$'.AND.INBUF(2).EQ.'S')WRITE(2,16) IF(INBUF(1).EQ.'$'.AND.INBUF(2).EQ.'E')GO TO 999 16 FORMAT(' ') IF(INBUF(1).EQ.'$')GO TO 100 IF(TYPE.EQ.SMALL)GO TO 200 C IF(TYPE.EQ.LARGE)CONTINUE IF(NCHARS.LE.LIMIT)GO TO 101 WRITE(5,17)BELL 17 FORMAT(' ',A1,'*ERROR* INPUT LINE TOO LONG, RE-ENTER') GO TO 100 101 WRITE(2,18) 18 FORMAT('0',/) C C C PROCESS EACH CHARACTER OF INPUT AND CREATE LARGE LETTERS C C DO 300 I=1,5 CALL BLANK(OUTBUF) START=CNTR-(6*NCHARS/2)+1 DO 400 J=1,NCHARS DO 500 K=1,NALPHA IF (INBUF(J).EQ.' ')GO TO 601 IF(K.EQ.NALPHA)GO TO 602 IF(INBUF(J).NE.LCHARS(K))GO TO 500 DO 600 L=0,4 OUTBUF(START+L)=ALPHA(I,(5*K)+L-4) 600 CONTINUE 601 START=START+4 602 START=START+2 GO TO 400 500 CONTINUE 400 CONTINUE WRITE(2,19)OUTBUF 19 FORMAT(' ',132A1) 300 CONTINUE C C C NOW THAT WE HAVE FINISHED THIS INPUT LINE C GO BACK FOR ANOTHER C C GO TO 100 C C C SINCE 'TYPE=SMALL' CENTER INPUT LINE AND PRINT IT OUT C C 200 START=CNTR-(NCHARS/2) CALL BLANK(OUTBUF) DO 700 I=1,NCHARS OUTBUF(START+I)=INBUF(I) 700 CONTINUE WRITE(2,20)OUTBUF 20 FORMAT('0',132A1,/) CALL BLANK(OUTBUF) C C NOW THAT THE INPUT LINE IS PROCESSED GO GET ANOTHER C C GO TO 100 C C C ON END-OF-FILE COME HERE C C 999 WRITE(2,21) 21 FORMAT('+') C C C CLOSE ALL FILES C C CLOSE(UNIT=1) CLOSE(UNIT=2) C C C CALL THE MONITOR CONSOLE ROUTINE (MCR) C C CALL REQUES(RAD50('...MCR'),,) C C C CALL EXIT AND QUIT C C CALL EXIT END C C C USE THIS SUBROUTINE TO CLEAR OUTPUT BUFFER C C SUBROUTINE BLANK(ARRAY) BYTE ARRAY(132) DO 100 I=1,132 ARRAY(I)= ' ' 100 CONTINUE RETURN END