// EXEC FWCG,PARM='NOSOURCE,NOEXT' 00000010 //SYSIN DD * 00000020 COMMON /SGGN/ ISIGN(133,66) LOGICAL*1 ISIGN,IOUT(7,7) INTEGER*2 MESSAG(80) C C DATA STRUCTURE: C 1) THE SNOOPY DECK.......147 PAIRS OF CARDS C 2) THE DEFINITIONS OF THE CHARACTERS C A. THE PICTURES STORED ROW-WISE IN COLS 1-49 C B. THE CHARACTER WITH WHICH THEY ARE ASSOCIATED IN COL 80 C C. THE CURRENT VERSION WILL HANDLE 100 CHARACTERS C D. THE LAST CHARACTER DEFINITION CARD IS COMPLETELY BLANK AND C DEFINES THE BLANK CHARACTER AS WELL AS THE END OF CHARACTERS C 3) MESSAGE DEFINITION C A. THE MESSAGES ARE PUNCHED IN COLS 1-78, THEY WILL BE PRINTED C IN SIX ROWS OF THIRTEEN CHARACTERS ECAH C B. ANY IMBEDDED BLANKS MUST BE INCLUDED BY THE USER... C THE PROGRAM DOES NOT ADJUST THE LINES C C. AN ASTERISK '*' IN THE LAST COLUMN OF A MESSAGE CARD C (COL 80) WILL SUPPRESS THE PRINTING OF THE C PICTURE OF SNOOPY, GIVING ONLY THE SIGN. C D. THE END-OF-FILE ('//' OR '/*') SHOULD FOLLOW IMMEDIATELY C THE LAST MESSAGE C 1000 FORMAT (80A1) 1002 FORMAT (1X,80A1) CALL INIT CALL INPUT 10 READ (5,1000,END=999) (MESSAG(I),I=1,80) WRITE(6,1002) (MESSAG(I),I=1,80) DO 15 I=1,6 DO 15 J=1,13 CALL NLARGE (MESSAG(J+13*(I-1)),IOUT) DO 25 K=1,7 DO 25 L=1,7 25 ISIGN (9*J+K,10*I-5+L) = IOUT(L,K) 15 CONTINUE CALL OUTPUT (MESSAG(80)) GO TO 10 999 STOP END SUBROUTINE INIT COMMON /SGGN/ ISIGN(133,66) LOGICAL*1 ISIGN,NSTAR,NBLANK LOGICAL*1 LINES(8778) EQUIVALENCE (LINES(1),ISIGN(1,1)) LOGICAL*1 ESS/'S'/ DATA NBLANK,NSTAR /' ','*'/ C C THIS SUBPROGRAM BLANKS OUT THE INTERIOR OF THE SIGN AND CREATES THE BORDERS C DO 15 I=266,8512 15 LINES(I) = NBLANK DO 25 I=2,133 ISIGN(I,1) = NSTAR ISIGN(I,2) = NSTAR ISIGN(I,65) = NSTAR 25 ISIGN(I,66) = NSTAR DO 35 I=3,64 ISIGN (2,I) = NSTAR ISIGN (3,I) = NSTAR ISIGN (133,I) = NSTAR 35 ISIGN (132,I) = NSTAR DO 777 I=1,66 777 ISIGN(1,I) = ESS RETURN END SUBROUTINE INPUT COMMON /SNOOP/ ISNOOP(130,147) COMMON /PICTUR/ IPIC(100,7,7),ICHAR(100),NUM LOGICAL*1 ISNOOP,IPIC INTEGER*2 NSTAR,NBLANK,ICHAR DATA NBLANK,NSTAR /' ','*'/ C C THIS SUBROUTINE INPUTS THE PICTURES OF THE LETTERS AND THE PICTURE OF SNOOPY C 1000 FORMAT (49A1,30X,A1) 1001 FORMAT (67A1,/,63A1) 1002 FORMAT (1X,49A1,30X,A1) READ (5,1001)((ISNOOP(J,K),J=1,130),K=1,147) I=1 10 READ (5,1000) ((IPIC(I,J,K),J=1,7),K=1,7),ICHAR(I) WRITE(6,1002) ((IPIC(I,J,K),J=1,7),K=1,7),ICHAR(I) I=I+1 IF (ICHAR(I-1) .NE. NBLANK) GO TO 10 NUM=I-1 RETURN END SUBROUTINE NLARGE (NCHAR,IOUT) COMMON /PICTUR/ IPIC(100,7,7),ICHAR(100),NUM LOGICAL*1 IPIC,IOUT(7,7) INTEGER*2 NCHAR,ICHAR C C THIS SUBPROGRAM PUTS INTO IOUT THE PICTURE ASSOCIATED WITH NCHAR C DO 15 I=1,NUM IF (ICHAR(I) .EQ. NCHAR) GO TO 10 15 CONTINUE I=NUM 10 DO 25 J=1,7 DO 25 K=1,7 25 IOUT (J,K) = IPIC (I,J,K) RETURN END SUBROUTINE OUTPUT(ICHAR) COMMON /SGGN/ ISIGN(133,66) COMMON /SNOOP/ ISNOOP(130,147) LOGICAL*1 ISIGN,ISNOOP LOGICAL*1 LINES(8778) EQUIVALENCE (LINES(1),ISIGN(1,1)) INTEGER*2 NSTAR,NBLANK,ICHAR DATA NBLANK,NSTAR /' ','*'/ C C THIS SUBROUTINE PRINTS THE SIGNS C 1000 FORMAT ('1') 1001 FORMAT (133A1) 1002 FORMAT('S',130A1) 1003 FORMAT (5(/)) 1005 FORMAT (59(/)) WRITE (6,1000) WRITE (6,1005) WRITE(6,1001) LINES WRITE (6,1003) IF(ICHAR .EQ. NBLANK) WRITE(6,1002)((ISNOOP(I,J),I=1,130),J=1,147) WRITE (6,1000) RETURN END //DATA.INPUT DD * 00006400 ********** S000 A S000 B ** *** *** ** S000 C S000 D ** ******* ** * S000 E S000 F **** ********* ** * S001 1 S001 2 ***** *********** * ** S002 1 ********* S002 2 ** ** ************ * ** S003 1 *** *** S003 2 ** ** ************* *** S004 1 ** ** S004 2 ** ** ************** *** S005 1 ** * S005 2 ** ** *************** *** S006 1 ** * S006 2 ** * ************** ***** S007 1 ** * S007 2 ** * ************** ** *** ** S008 1 * * S008 2 ** * ************* * ********* S009 1 * S009 2 * * ************ * S010 1 * S010 2 * * ********** * S011 1 * ***** S011 2 * * ******** * ** S012 1 ** ** S012 2 ** * ****** * *** S013 1 * * S013 2 * * *** ***** S014 1 * *** * S014 2 ** * ** * ***** S015 1 ****** * S015 2 ** ** ** * **** S016 1 ***** * S016 2 * ******** * **** S017 1 ******* S017 2 ** *** * ** S018 1 ******* S018 2 ** *** * S019 1 ******* S019 2 ** *** * S020 1 * **** S020 2 ** *** * S021 1 * S021 2 ** *** * S022 1 *********** * S022 2 ** ***** * ** S023 1 ** ***** ** S023 2 ** ****** * ** S024 1 ************** S024 2 ** * * * * S025 1 S025 2 ** * * ** * S026 1 S026 2 ** * * * * S027 1 S027 2 ** * * * * S028 1 S028 2 * * * * * S029 1 S029 2 * * * * * S030 1 S030 2 * * * * * S031 1 S031 2 ** * * * * S032 1 ****** S032 2 ** * * * * S033 1 ** S033 2 ** ** * ** * S034 1 ** S034 2 ** * * ** * S035 1 S035 2 ** * * * * S036 1 S036 2 * ** * * S037 1 S037 2 ** * * S038 1 S038 2 ** * * S039 1 **** S039 2 * * * S040 1 ****** *** S040 2 ** * * S041 1 * * ** ** S041 2 * * * S042 1 * * * *** S042 2 ** * * S043 1 **** * ** * * * S043 2 * * *** S044 1 ****** * * * * S044 2 ** * S045 1 * * **** * S045 2 * * S046 1 * ** ** * * S046 2 ** * S047 1 * ** ** S047 2 ** ** S048 1 ** ** ** * S048 2 * * S049 1 ** ** * * S049 2 * * S050 1 ** ** * * S050 2 * * S051 1 **** ** ****** * S051 2 * * ******* S052 1 ** ** ** S052 2 ** * * S053 1 ** ** ** S053 2 *** *** ** S054 1 ** ** * S054 2 **** *********** S055 1 ** ** S055 2 ******************** **** S056 1 ** ** S056 2 * *** * S057 1 ** ** S057 2 * ** * S058 1 ** ** S058 2 *** ** S059 1 ** ** S059 2 ** * S060 1 ** ** S060 2 *** ***** S061 1 ** ** S061 2 *** *** * S062 1 ** ** S062 2 * * *** * S063 1 ** ** S063 2 * ****** * S064 1 *** * S064 2 * * ** * S065 1 ** * S065 2 * * * S066 1 *** ** S066 2 * * ** S067 1 * ** S067 2 * * ** S068 1 ** ** S068 2 * * *** S069 1 * * S069 2 * * * * S070 1 * * S070 2 * * * ** S071 1 ** * S071 2 * * * * S072 1 * * S072 2 * ** * * S073 1 *** S073 2 * * ** * S074 1 *** S074 2 * ** * * S075 1 *** S075 2 * * ** S076 1 * S076 2 * * * * S077 1 * S077 2 * ** * * S078 1 * S078 2 * * *** S079 1 * S079 2 * ** * * S080 1 * S080 2 * * * * * S081 1 * S081 2 * * * * * S082 1 * S082 2 * * ** * * ** S083 1 ** S083 2 * * ** * * * S084 1 * S084 2 * * ** * * ** S085 1 * S085 2 * * **** * ** S086 1 ** S086 2 * * ** * * * S087 1 * S087 2 * ** ** * * * S088 1 * S088 2 * * *** * * * S089 1 * S089 2 * * *** * * ** S090 1 * S090 2 * * * * * ** * S091 1 ** S091 2 * * * ** * * S092 1 * S092 2 * * * * * * * S093 1 *** * S093 2 * * * * ** ** * S094 1 * ** S094 2 ** * * * * * S095 1 * * S095 2 * ** * * * ** S096 1 * * S096 2 * ** * * * * S097 1 * ** S097 2 * * * * * * S098 1 * ** S098 2 * * * * * ** S099 1 * * S099 2 * * * * * ** S100 1 * * S100 2 * * * * * * S101 1 * * S101 2 * * * * * * S102 1 ** * S102 2 * * * * ** * S103 1 * * S103 2 * * * * * * S104 1 * ** S104 2 * * * * * * S105 1 * ** S105 2 * * * * ** ** S106 1 *** ** S106 2 * * * * * S107 1 * ** S107 2 * * * * ** ** S108 1 * S108 2 * * * * **** S109 1 * S109 2 * * * * S110 1 ** S110 2 * * * S111 1 * S111 2 * * ** S112 1 * S112 2 * * * S113 1 * S113 2 * * * S114 1 ** S114 2 * * * S115 1 ** S115 2 ** * ** S116 1 ** S116 2 * * ** S117 1 ** S117 2 * * * S118 1 ** S118 2 * * ** S119 1 ** S119 2 * * *** S120 1 * S120 2 ** * **** S121 1 * S121 2 * * * S122 1 * * S122 2 * * * S123 1 * * S123 2 * * * S124 1 * * S124 2 * * * S125 1 * * S125 2 * * * * S126 1 ** * S126 2 ********* * * S127 1 * *********** S127 2 ** * ** S128 1 * ******* S128 2 ** ***** * * S129 1 ************ *** S129 2 ****** * * * S130 1 ** ****** ** S130 2 * * * * S131 1 *** ** S131 2 ***** * * S132 1 ** ** S132 2 ***** *** * * *** S133 1 ** * * S133 2 * * * *** S134 1 * * * S134 2 * * *** S135 1 * * * S135 2 **** * * *** S136 1 * * * S136 2 ******** ** * ** S137 1 * * * * S137 2 * * * ** S138 1 * * * ** S138 2 *** * * * S139 1 * * * ******** S139 2 ***** *** ** * S140 1 ** * *** S140 2 ** * ********** ** S141 1 ** * ** S141 2 ********** ***** *** S142 1 ** *** **** S142 2 **** **************** S143 1 *************************** ***** S143 2 * S144 1 *** S144 2 AAAAAAAAAAAAAA A A A A A AAAAAAA AAAAAA A BBBBBBBBBBBBBBB B BB B BB B BBBBBBBB BB BB B CCCCC CCCCCCCC CC CC CCC CC C C C DDDDDDDDDDDDDDD DD DD DDDDDDDD DDDDD D EEEEEEEEEEEEEEE E EE E EE E EE EE E E FFFFFFFFFFFFFFF F F F F F F F F GGGGG GGGGGGGG GG GG G GGG GGGG G GGG G HHHHHHHHHHHHHH H H H HHHHHHHHHHHHHH H I II IIIIIIIIIIIIIIII II I I J JJ J JJ JJ JJJJJJJJJJJJJJ J J J KKKKKKKKKKKKKK K KKK KK KK KK KKK K K LLLLLLLLLLLLLL L L L L L MMMMMMMMMMMMMM M M M MMMMMMMMMMMMMM M NNNNNNNNNNNNNN NNN NNN NNN NNNNNNNNNNNNNN N OOOOO OOOOOOOO OO OO OOOOOOOO OOOOO O PPPPPPPPPPPPPPP P P P P P PPPP PP P QQQQ QQQQQQ Q Q Q Q Q QQ QQQQQQ QQQQ Q Q RRRRRRRRRRRRRRR R R RR R RRR RRRR RR RR R R SS SSSSS SS S SS S SS S SS SSSSS SS S T T TTTTTTTTTTTTTTT T T T UUUUUU UUUUUUU U U UUUUUUUUUUUUUU U VVV VVV VV VV VV VVV VVV V WWWWWW WWWWWWW W WWW WWWWWWWWWWWWWW W X X X X X X X X X X X X X X YY YY YYYY YYYY YY YY Y Z ZZ ZZZ Z ZZ Z ZZ Z ZZZ ZZ Z Z 00000 00000000 00 00 00000000 00000 0 1 1 1 111111111111111 1 1 1 22 2222 2222 2222 22 22222 2 22 2 2 3 3 33 333 3 33 3 33 3 33333333 33 33 3 4444 4444 4 4 44444444444444 4 4 5555 55555 55 5 55 5 55 5 55 55555 55 5 66666 66666666 6 66 6 66 6 6 6666 66 6 7 77 7 7 7 7 7 7 7 77 7 7 88 88 88888888 8 88 8 88 8 88888888 88 88 8 99 99 9 9 9 9 9 9 999999 999999 9 + + + +++++ + + + + ((( ((((( (( ((( ( ( ) ))) )) ))))) ))) ) * * * * *** ******* *** * * * * * / // // // // // // / $ $ $ $ $$$$$$$ $ $ $ $$$$$$$ $ $ $ $ $ = = = = = = = = = = = = = = = ,, ,,, , -- -- -- -- -- - .. .. . % %% % % % % % % % % % %% % % |||||||||||||| | """" """" """" """" " '''' '''' ' ;; ;; ;; ;;; ; |||| |||||| || ! :: :: :: :: : ? ? ? ?? ?? ? ?? ? CURSE YOU REDBARON! .. .