-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+ X _ NICKNAME_LEN ,`20 X _ SHIPS_DESTROYED , X _ UIC_LEN X CHARACTER*12 MBX_NAME ,`20 X _ UIC X CHARACTER*15 NICKNAME X END STRUCTURE X X RECORD /INFO/ OUR, THEIR X X REAL DISPID ,`20 X _ PASTEID , `20 X _ KEYBID ,`20 X _ DISPID2 X LOGICAL WERE_FIRST ,`20 X _ INSERT_CR ,`20 X _ THEIR_TURN , X _ PLAYING ,`20 X _ THEYRE_FINISHED ,`20 X _ IM_FINISHED , X _ AT_COMMAND_LINE , X _ WE_CANCELLED_THE_GAME/.FALSE./, X _ THEY_CANCELLED_THE_GAME/.FALSE./, X _ GETTING_INKEY/.FALSE./, X _ WAITING_FOR_COMLINK, X _ IN_HELP X CHARACTER*1 M_GRID( 9, 15 ) X INTEGER ITHEIR_ROW/2/ , X _ ITHEIR_COL/4/ ,`20 X _ IOUR_ROW /2/ ,`20 X _ IOUR_COL /39/ X CHARACTER*39 CURRENT_IMAGE_NAME,`20 X _ IMAGE_DEFAULT_DIR , X + CURR_NODE $ CALL UNPACK BATTLE.INC;1 1782339850 $ create 'f' X XC XC This routine was just a last minute kick in (so was LOGGER.FOR) so that XC I could keep track and control those who played this game.`20 XC XC It is not complete - currently, the most it can do is restrict certain XC users from playing the game. You can also view all thos who have played XC it and how many times. XC X PROGRAM BATTLE_MAINT X CHARACTER*15 USER X CHARACTER*80 COMMAND, DEF_DIR X COMMAND(1:2) = ' ' X DO WHILE( COMMAND(1:2) .NE. '.E' ) X CALL LIB$GET_INPUT( COMMAND, 'BATTLE-MAINT> ', II ) X CALL STR$UPCASE ( COMMAND, COMMAND ) X X IF ( COMMAND(1:4) .EQ. 'INIT' ) THEN X CALL INITIALIZE_DATAFILE X X ELSEIF ((COMMAND(1:2) .EQ. 'ME' ) .OR. X _ ( COMMAND(1:2) .EQ. 'HE' ) .OR. X _ ( COMMAND(1:1) .EQ. '?' )) THEN X CALL DRAW_MENU X X ELSEIF ( COMMAND(1:2) .EQ. 'VA' ) THEN X CALL VIEW_ALL_USERS X X ELSEIF ( COMMAND(1:2) .EQ. 'LA' ) THEN X CALL LIST_ALL_USERS X X ELSEIF ( COMMAND(1:2) .EQ. 'LT' ) THEN X CALL LIST_TODAYS_USERS X X ELSEIF ( COMMAND(1:2) .EQ. 'CA' ) THEN X CALL CHANGE_ALL_USERS X X ELSEIF ( COMMAND(1:2) .EQ. 'VS' ) THEN X CALL LIB$GET_INPUT( USER, '_User: ', I1 ) X CALL STR$UPCASE( USER, USER ) X CALL VIEW_USER( USER ) X X ELSEIF ( COMMAND(1:2) .EQ. 'CS' ) THEN X CALL LIB$GET_INPUT( USER, '_User: ', I1 ) X CALL STR$UPCASE( USER, USER ) X CALL CHANGE_USER( USER ) X X ENDIF X END DO `20 X X END X X SUBROUTINE VIEW_USER( USER ) X CHARACTER*14 SP/' '/ X CHARACTER*80 DATA_DIR X CHARACTER*132 DATAFILE X CHARACTER*15 USER, KEY_FIELD X INCLUDE '($JPIDEF)' X STRUCTURE /USR/ X CHARACTER*15 USERNAME X CHARACTER*15 PNAME X CHARACTER*23 DATE_TIME X CHARACTER*4 FLAGS X INTEGER *4 TIMES X END STRUCTURE X RECORD /USR/ USER_STRUCTURE X X 11 FORMAT( 1X, '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' ) X 12 FORMAT( 1X, 'User : ',A15,20X,'(',A15,')') X 13 FORMAT( 1X, 'Times played: ',I4 ) X 14 FORMAT( 1X, 'Last played : ',A23 ) X 15 FORMAT( 1X, 'Priv. Flags : ',A4 ) X 16 FORMAT( 1X, 'Flag translation follows:' ) X 18 FORMAT( 1X, 'User ',A15,' is not listed in the BATTLESHIP UAF.') X X CALL GET_JPI( JPI$_IMAGNAME, DATA_DIR , IDUMMY ) X DATAFILE = DATA_DIR(1:II)//'BATTLESHIP_UAF.DAT' X X OPEN(FILE = DATAFILE , X _ STATUS = 'OLD' , X _ ORGANIZATION= 'INDEXED' , X _ ACCESS = 'KEYED' , X _ RECORDTYPE = 'VARIABLE' , X _ FORM = 'UNFORMATTED' , X _ CARRIAGECONTROL = 'NONE' , X _ RECL = 61 , X _ KEY = (1:15:CHARACTER), X _ ERR = 22 , X _ UNIT = 20 , X _ IOSTAT = IOS) X X KEY_FIELD = USER X X READ(UNIT = 20 , X _ IOSTAT = IOS , X _ KEY = KEY_FIELD , X _ ERR = 2 ) X _USER_STRUCTURE X X 2 IF (IOS.EQ.0) THEN X WRITE(*,11) X WRITE(*,12) USER_STRUCTURE.USERNAME, USER_STRUCTURE.PNAME X WRITE(*,13) USER_STRUCTURE.TIMES X WRITE(*,14) USER_STRUCTURE.DATE_TIME X WRITE(*,15) USER_STRUCTURE.FLAGS X WRITE(*,16) X IF (USER_STRUCTURE.FLAGS(1:1) .EQ. '1' ) THEN X WRITE (*,*) SP//'User may override scheduled times.' X ELSE X WRITE (*,*) SP//'User may not override scheduled times.' X ENDIF X X IF (USER_STRUCTURE.FLAGS(2:2) .EQ. '1' ) THEN X WRITE (*,*) SP//'User is allowed to play.' X ELSE X WRITE (*,*) SP//'User is not allowed to play.' X ENDIF X X WRITE (*,*) SP//'(3rd flag reserved for future use)' X WRITE (*,*) SP//'(4th flag reserved for future use)' X WRITE(*,11) X X ELSEIF(IOS.EQ.36) THEN X WRITE (*,18) USER X X ENDIF X 21 CLOSE(20) X 22 RETURN X END X X X X X SUBROUTINE CHANGE_USER( USER ) X CHARACTER*14 SP/' '/ X CHARACTER*4 FLAGS X CHARACTER*80 DATA_DIR X CHARACTER*132 DATAFILE X CHARACTER*15 USER, KEY_FIELD X INCLUDE '($JPIDEF)' X STRUCTURE /USR/ X CHARACTER*15 USERNAME X CHARACTER*15 PNAME X CHARACTER*23 DATE_TIME X CHARACTER*4 FLAGS X INTEGER *4 TIMES X END STRUCTURE X RECORD /USR/ USER_STRUCTURE X X 11 FORMAT( 1X, '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' ) X 12 FORMAT( 1X, 'User : ',A15,20X,'(',A15,')') X 13 FORMAT( 1X, 'Times played: ',I4 ) X 14 FORMAT( 1X, 'Last played : ',A23 ) X 15 FORMAT( 1X, 'Priv. Flags : ',A4 ) X 16 FORMAT( 1X, 'Flag translation follows:' ) X 17 FORMAT( 1X, 'Press `5BRETURN`5D to cancel operation.' ) X 18 FORMAT( 1X, 'User ',A15,' is not listed in the BATTLESHIP UAF.') X X CALL GET_JPI( JPI$_IMAGNAME, DATA_DIR , IDUMMY ) X DATAFILE = DATA_DIR(1:II)//'BATTLESHIP_UAF.DAT' X X OPEN(FILE = DATAFILE , X _ STATUS = 'OLD' , X _ ORGANIZATION= 'INDEXED' , X _ ACCESS = 'KEYED' , X _ RECORDTYPE = 'VARIABLE' , X _ FORM = 'UNFORMATTED' , X _ CARRIAGECONTROL = 'NONE' , X _ RECL = 61 , X _ KEY = (1:15:CHARACTER), X _ ERR = 22 , X _ UNIT = 20 , X _ IOSTAT = IOS) X X KEY_FIELD = USER X X READ(UNIT = 20 , X _ IOSTAT = IOS , X _ KEY = KEY_FIELD , X _ ERR = 2 ) X _USER_STRUCTURE X FLAGS = ' ' X 2 IF (IOS.EQ.0) THEN X WRITE (*,17) X CALL LIB$GET_INPUT( FLAGS, 'New flag setting: ',IID ) X IF ( IID .NE. 0 ) THEN X DO I = 1, 4, 1 X IF((FLAGS(I:I).NE.'0').AND.(FLAGS(I:I).NE.'1')) X _ FLAGS(I:I)='0' X END DO X X USER_STRUCTURE.FLAGS = FLAGS X REWRITE(UNIT=20,ERR=21) USER_STRUCTURE X ENDIF X X ELSEIF(IOS.EQ.36) THEN X WRITE (*,18) USER X X ENDIF X 21 CLOSE(20) X 22 RETURN X END X X X X SUBROUTINE VIEW_ALL_USERS X CHARACTER DUMMY X CHARACTER*80 DATA_DIR X CHARACTER*132 DATAFILE X INCLUDE '($JPIDEF)' X STRUCTURE /USR/ X CHARACTER*15 USERNAME X CHARACTER*15 PNAME X CHARACTER*23 DATE_TIME X CHARACTER*4 FLAGS X INTEGER *4 TIMES X END STRUCTURE X RECORD /USR/ USER_STRUCTURE X X 11 FORMAT( 1X, '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' ) X 12 FORMAT( 1X, 'User : ',A15,20X,'(',A15,')') X 13 FORMAT( 1X, 'Times played: ',I4 ) X 14 FORMAT( 1X, 'Last played : ',A23 ) X 15 FORMAT( 1X, 'Priv. Flags : ',A4 ) X 16 FORMAT( 1X, 'BATTLESHIP has been played ',I4,' times.' ) X 18 FORMAT( 1X, 'There are ',I3,' users listed in the database.' ) X CALL GET_JPI( JPI$_IMAGNAME, DATA_DIR , IDUMMY ) X DATAFILE = DATA_DIR(1:II)//'BATTLESHIP_UAF.DAT' X INUM_USERS = 0 X INUM_TIMES = 0 X OPEN(FILE = DATAFILE , X _ STATUS = 'OLD' , X _ ORGANIZATION= 'INDEXED' , X _ ACCESS = 'KEYED' , X _ RECORDTYPE = 'VARIABLE' , X _ FORM = 'UNFORMATTED' , X _ CARRIAGECONTROL = 'NONE' , X _ RECL = 61 , X _ KEY = (1:15:CHARACTER), X _ ERR = 22 , X _ UNIT = 20 , X _ IOSTAT = IOS) X KEY_FIELD = USER X IOS = 0 X DO WHILE( IOS .EQ. 0 ) X READ(UNIT = 20 , X _ IOSTAT = IOS , X _ ERR = 2 ) X _ USER_STRUCTURE X X WRITE(*,11) X WRITE(*,12) USER_STRUCTURE.USERNAME, USER_STRUCTURE.PNAME X WRITE(*,13) USER_STRUCTURE.TIMES X WRITE(*,14) USER_STRUCTURE.DATE_TIME X WRITE(*,15) USER_STRUCTURE.FLAGS X WRITE(*,* ) ' ' X INUM_USERS = INUM_USERS + 1 X INUM_TIMES = INUM_TIMES + USER_STRUCTURE.TIMES X IICNT = IICNT + 1 X IF ( IICNT .EQ. 3 ) THEN X CALL LIB$GET_INPUT( DUMMY, '`5Bpress RETURN to continue`5D',I) X IICNT = 0 X ENDIF X X END DO X 2 CONTINUE X 21 CLOSE(20) X WRITE (*,16) INUM_TIMES X WRITE (*,18) INUM_USERS X 22 RETURN X END X X X SUBROUTINE LIST_ALL_USERS X CHARACTER DUMMY X CHARACTER*80 DATA_DIR X CHARACTER*132 DATAFILE X INCLUDE '($JPIDEF)' X STRUCTURE /USR/ X CHARACTER*15 USERNAME X CHARACTER*15 PNAME X CHARACTER*23 DATE_TIME X CHARACTER*4 FLAGS X INTEGER *4 TIMES X END STRUCTURE X RECORD /USR/ USER_STRUCTURE X X 13 FORMAT( 1X, 'Username P.Name Last Played ', X _ ' #XPld Flags') X 14 FORMAT( 1X, A15,1X,A15,1X,A23,1X,I4,1X,A4) X 16 FORMAT( 1X, 'BATTLESHIP has been played ',I4,' times.' ) X 17 FORMAT( 1X, '----------------------------------------', X _ '----------------------------------------') X 18 FORMAT( 1X, 'There are ',I3,' users listed in the database.' ) X CALL GET_JPI( JPI$_IMAGNAME, DATA_DIR , IDUMMY ) X DATAFILE = DATA_DIR(1:II)//'BATTLESHIP_UAF.DAT' X INUM_USERS = 0 X INUM_TIMES = 0 X OPEN(FILE = DATAFILE , X _ STATUS = 'OLD' , X _ ORGANIZATION= 'INDEXED' , X _ ACCESS = 'KEYED' , X _ RECORDTYPE = 'VARIABLE' , X _ FORM = 'UNFORMATTED' , X _ CARRIAGECONTROL = 'NONE' , X _ RECL = 61 , X _ KEY = (1:15:CHARACTER), X _ ERR = 22 , X _ UNIT = 20 , X _ IOSTAT = IOS) X KEY_FIELD = USER X IOS = 0 X WRITE (*,13) X WRITE (*,17) X DO WHILE( IOS .EQ. 0 ) X READ(UNIT = 20 , X _ IOSTAT = IOS , X _ ERR = 2 ) X _ USER_STRUCTURE X X WRITE(*,14) USER_STRUCTURE.USERNAME, USER_STRUCTURE.PNAME, X _ USER_STRUCTURE.DATE_TIME,USER_STRUCTURE.TIMES, X _ USER_STRUCTURE.FLAGS X X INUM_USERS = INUM_USERS + 1 X INUM_TIMES = INUM_TIMES + USER_STRUCTURE.TIMES X IICNT = IICNT + 1 X IF ( IICNT .EQ. 20 ) THEN X CALL LIB$GET_INPUT( DUMMY, '`5Bpress RETURN to continue`5D',I) X IICNT = 0 X ENDIF X X END DO X 2 CONTINUE X 21 CLOSE(20) X WRITE (*,17) X WRITE (*,16) INUM_TIMES X WRITE (*,18) INUM_USERS X 22 RETURN X END X X X X OPTIONS /EXTEND_SOURCE X SUBROUTINE LIST_TODAYS_USERS X CHARACTER DUMMY X CHARACTER*80 DATA_DIR X CHARACTER*132 DATAFILE X CHARACTER*23 TODAYS_DATE X INCLUDE '($JPIDEF)' X STRUCTURE /USR/ X CHARACTER*15 USERNAME X CHARACTER*15 PNAME X CHARACTER*23 DATE_TIME X CHARACTER*4 FLAGS X INTEGER *4 TIMES X END STRUCTURE X RECORD /USR/ USER_STRUCTURE X 11 FORMAT( 1X, 'Todays date is ',A12) X 13 FORMAT( 1X, 'Username P.Name Last Played ', X _ ' #XPld Flags') X 14 FORMAT( 1X, A15,1X,A15,1X,A23,1X,I4,1X,A4) X 17 FORMAT( 1X, '----------------------------------------', X _ '----------------------------------------') X 18 FORMAT( 1X, 'There are ',I3,' users who played today.' ) X CALL GET_JPI( JPI$_IMAGNAME, DATA_DIR , IDUMMY ) X DATAFILE = DATA_DIR(1:II)//'BATTLESHIP_UAF.DAT' X INUM_USERS = 0 X INUM_TIMES = 0 X OPEN(FILE = DATAFILE , X _ STATUS = 'OLD' , X _ ORGANIZATION= 'INDEXED' , X _ ACCESS = 'KEYED' , X _ RECORDTYPE = 'VARIABLE' , X _ FORM = 'UNFORMATTED' , X _ CARRIAGECONTROL = 'NONE' , X _ RECL = 61 , +-+-+-+-+-+-+-+- END OF PART 2 +-+-+-+-+-+-+-+-