-+-+-+-+-+-+-+-+ START OF PART 4 -+-+-+-+-+-+-+-+ XC Southwest Texas State University XC (512) 396 - 7216 XC XC Contains: XC XC LOGUSER Logs the user's attempt to play the game. XC FILL_STRUCTURE Fills the /USR/ structure with miscellaneous informati Von. XC X SUBROUTINE LOGUSER X CHARACTER*120 DATAFILE X CHARACTER*15 KEY_FIELD X LOGICAL TIME_OKAY X X INCLUDE 'BATTLE.INC' X 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 `20 X CALL FILL_STRUCTURE( USER_STRUCTURE ) X X II = ILN( IMAGE_DEFAULT_DIR ) X DATAFILE = IMAGE_DEFAULT_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 _ SHARED , X _ IOSTAT = IOS) X X IOS=0 X KEY_FIELD = USER_STRUCTURE.USERNAME 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 USER_STRUCTURE.TIMES = USER_STRUCTURE.TIMES + 1 X CALL LIB$DATE_TIME( USER_STRUCTURE.DATE_TIME ) X REWRITE(UNIT=20,ERR=21) USER_STRUCTURE X X ELSEIF(IOS.EQ.36) THEN X USER_STRUCTURE.TIMES = 1 X WRITE(UNIT=20, ERR=21) USER_STRUCTURE X X ENDIF X 21 CLOSE(21) X IF(USER_STRUCTURE.FLAGS(2:2) .NE. '1' ) THEN X CALL NOT_ALLOWED_TO_PLAY X ENDIF X `20 X IF (.NOT. TIME_OKAY(IDUMMY)) THEN X IF (USER_STRUCTURE.FLAGS(1:1) .NE. '1') THEN X CALL NOT_A_SCHEDULED_TIME X ENDIF X ENDIF X X 22 RETURN X END X X X SUBROUTINE FILL_STRUCTURE( USER_STRUCTURE ) X INCLUDE 'BATTLE.INC' X 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 USER_STRUCTURE.USERNAME = OUR.UIC X USER_STRUCTURE.PNAME = OUR.NICKNAME X USER_STRUCTURE.FLAGS = '0100' X USER_STRUCTURE.TIMES = 0 X X CALL LIB$DATE_TIME( USER_STRUCTURE.DATE_TIME ) X X RETURN X END $ CALL UNPACK LOGGER.FOR;1 992002287 $ create 'f' XC XC SCREEN1.FOR XC XC Ray Renteria XC RR02026@SWTEXAS ACM_CSA@SWTEXAS XC Southwest Texas State University XC (512) 396 - 7216 XC XC Contains: XC XC SETUP_SHIPS User procedure for placement of ships on screen XC SEND_UPDATE System procedure for sending ship strength to oppone Vnt XC REPAINT_SCREEN AST procedure for refreshing the screen XC ANNOUNCE Displays message on current ship's status while plac Ving XC ENTER Interface for placing a ship. XC OUR_UPDATE Display to our screen our ship's status' XC THEIR_UPDATE Display to their screen our ship's status' XC ABORT Removes the current ship from the screen while placi Vng XC TOUP Converts a single character to upper case XC TRAP_MESSAGES AST procedure for trapping a broadcast message XC INIT Initializes smg display id's, keyboard etc. XC SPAWN_DCL Envokes a spawn and notifies opponent. XC SEND_MESSAGE Accepts input for message to be sent to opponent XC GET_INPUT Interface for SEND_MESSAGE XC DRAW_BOARD Draws the screen XC X SUBROUTINE SETUP_SHIPS X INTEGER TOUP X LOGICAL FINISHED X COMMON /SETUP/ ICOMMON_SETUP_ROW, ICOMMON_SETUP_COL X STRUCTURE /ALLOW/ X LOGICAL BATTLESHIP/.TRUE./,`20 X _ SUBMARINE /.TRUE./,`20 X _ PT_BOAT /.TRUE./,`20 X _ CARRIER /.TRUE./, X _ CRUISER /.TRUE./,`20 X _ DESTROYER /.TRUE./ X END STRUCTURE X RECORD /ALLOW/ ALLOWING X INCLUDE 'BATTLE.INC' X INUMPLACED = 0 X FINISHED = .FALSE. X CALL MESSAGE( 'Place your ships, sir. '// X _ 'Type B, C, D, S, P, or A to place.' ) X X CALL OUR_UPDATE ('B', 0 ) X CALL THEIR_UPDATE('B', 0 ) X CALL OUR_UPDATE ('C', 0 ) X CALL THEIR_UPDATE('C', 0 ) X CALL OUR_UPDATE('D', 0 ) X CALL THEIR_UPDATE('D', 0 ) X CALL OUR_UPDATE('S', 0 ) X CALL THEIR_UPDATE('S', 0 ) X CALL OUR_UPDATE('P', 0 ) X CALL THEIR_UPDATE('P', 0 ) X CALL OUR_UPDATE('A', 0 ) X CALL THEIR_UPDATE('A', 0 ) X X IROW = 2 X ICOL = 4 X X DO WHILE ( INUMPLACED .LT. 6 ) X CALL SET_CURSOR( IROW, ICOL ) X ICOMMON_SETUP_ROW = IROW X ICOMMON_SETUP_COL = ICOL X II = INKEY() X II = TOUP( II ) X IF ( II .EQ. 277 ) THEN ! RIGHT ARROW X IF ( ICOL .LT. 32 ) THEN X ICOL = ICOL + 2 X ELSE X ICOL = 4 X ENDIF X X ELSEIF ( II .EQ. 276 ) THEN ! LEFT ARROW X IF ( ICOL .GT. 4 ) THEN X ICOL = ICOL - 2 X ELSE X ICOL = 32 X ENDIF X X ELSEIF( II .EQ. 274 ) THEN ! UP ARROW X IF ( IROW .GT. 2 ) THEN X IROW = IROW - 1 X ELSE X IROW = 10 X ENDIF X X ELSEIF( II .EQ. 275 ) THEN ! DOWN ARROW X IF ( IROW .LT. 10 ) THEN X IROW = IROW + 1 X ELSE X IROW = 2 X ENDIF X X ELSEIF( II .EQ. 65 ) THEN X IF ( ALLOWING.CARRIER ) THEN X CALL MESSAGE( 'Place your carrier, sir!' ) X CALL ENTER( ALLOWING.CARRIER, CAR_STRENGTH,`20 X _ CHAR(II), IROW, ICOL ) X X CALL ANNOUNCE( ALLOWING.CARRIER, 'Carrier', X - INUMPLACED) X ELSE X CALL MESSAGE( 'You have already placed your carrier,' X _ //' sir.' ) X END IF X X ELSEIF( II .EQ. 66 ) THEN X IF ( ALLOWING.BATTLESHIP ) THEN X CALL MESSAGE( 'Place your battleship, sir!' ) X CALL ENTER( ALLOWING.BATTLESHIP, BAT_STRENGTH,`20 X _ CHAR(II), IROW, ICOL ) X CALL ANNOUNCE( ALLOWING.BATTLESHIP, 'Battleship', X _ INUMPLACED) X X ELSE X CALL MESSAGE( 'You have already placed your '// X _ 'battleship, sir.' ) X ENDIF X X ELSEIF( II .EQ. 67 ) THEN X IF ( ALLOWING.CRUISER ) THEN X CALL MESSAGE( 'Place your cruiser, sir!' ) X CALL ENTER( ALLOWING.CRUISER, CRU_STRENGTH,`20 X _ CHAR(II), IROW, ICOL ) X CALL ANNOUNCE( ALLOWING.CRUISER, 'Cruiser', X _ INUMPLACED) X X ELSE X CALL MESSAGE( 'You have already placed your cruiser,' X _ //' sir.' ) X ENDIF X`20 X ELSEIF( II .EQ. 68 ) THEN X IF ( ALLOWING.DESTROYER ) THEN X CALL MESSAGE( 'Place your destroyer, sir!' ) X CALL ENTER( ALLOWING.DESTROYER, DES_STRENGTH,`20 X _ CHAR(II), IROW, ICOL ) X CALL ANNOUNCE( ALLOWING.DESTROYER, 'Destroyer', X _ INUMPLACED) X X ELSE X CALL MESSAGE( 'You have already placed your destroyer,' X _ //' sir.' ) X ENDIF X X ELSEIF( II .EQ. 83 ) THEN X IF ( ALLOWING.SUBMARINE ) THEN X CALL MESSAGE( 'Place your submarine, sir!' ) X CALL ENTER( ALLOWING.SUBMARINE, SUB_STRENGTH,`20 X + CHAR(II), IROW, ICOL ) X CALL ANNOUNCE( ALLOWING.SUBMARINE, 'Submarine', X _ INUMPLACED) X `20 X ELSE X CALL MESSAGE( 'You have already placed your submarine,' X _ //' sir.' ) X ENDIF X X ELSEIF( II .EQ. 80 ) THEN X IF ( ALLOWING.PT_BOAT ) THEN X CALL MESSAGE( 'Place your PT boat, sir!' ) X CALL ENTER( ALLOWING.PT_BOAT, PT_STRENGTH,`20 X _ CHAR(II), IROW, ICOL ) X CALL ANNOUNCE( ALLOWING.PT_BOAT, 'PT Boat', X _ INUMPLACED) X X ELSE X CALL MESSAGE( 'You have already placed your pt boat,' X _ //' sir.' ) X ENDIF X X ELSEIF ( II .EQ. 16 ) THEN`20 X CALL SPAWN_DCL X X ELSEIF ( II .EQ. 5 ) THEN X CALL SEND_MESSAGE X X ENDIF X END DO X X RETURN X END X X X SUBROUTINE SEND_UPDATE( CH, STRENGTH ) X CHARACTER*1 CH X CHARACTER*3 LINE X INTEGER STRENGTH X 1 FORMAT( '+',A1,I1 ) X WRITE( LINE, 1 ) CH, STRENGTH X CALL WRITE_TO_MAILBOX( LINE ) X RETURN X END X X X SUBROUTINE REPAINT_SCREEN X INCLUDE 'BATTLE.INC' X CALL SMG$REPAINT_SCREEN(PASTEID) X RETURN X END X X SUBROUTINE ANNOUNCE( LOG, BOAT,II ) X LOGICAL LOG X CHARACTER*(*) BOAT X X IF ( LOG ) THEN X CALL MESSAGE( 'Your '//BOAT//' still needs'// X + ' to be placed, sir!') X X ELSE X CALL MESSAGE( 'Your '//BOAT//' has been placed,'// X _ ' sir!' ) X II = II + 1 X ENDIF X RETURN X END X X SUBROUTINE ENTER( LOG, NUM_HITS, CH, IROW, ICOL ) X INTEGER NUM_HITS, IROW, ICOL X LOGICAL FINISHED, ALLOWING_VERT, ALLOWING_HOR, LOG X CHARACTER*1 CH X INCLUDE 'BATTLE.INC' X X FINISHED = .FALSE. X ALLOWING_VERT = .TRUE. X ALLOWING_HOR = .TRUE. X ICOUNT = 0 X LOG = .FALSE. X X IF (M_GRID(IROW-1,(ICOL/2)-1).EQ.'.') THEN X X CALL WRITE( CH, IROW, ICOL ) `20 X M_GRID( IROW - 1,(ICOL/2) - 1 ) = CH X ICOUNT = ICOUNT + 1 X IF (ICOUNT .EQ. NUM_HITS ) FINISHED = .TRUE. X CALL OUR_UPDATE( CH, ICOUNT ) X X ELSEIF(M_GRID(IROW-1,(ICOL/2)-1) .NE. CH ) THEN X CALL MESSAGE('This position is already occupied, sir.') X LOG = .TRUE. X RETURN X X ENDIF X X X DO WHILE ( .NOT. FINISHED ) X `20 X CALL SET_CURSOR( IROW, ICOL ) X IOLDROW = IROW X IOLDCOL = ICOL X II = INKEY() X X IF (( II .EQ. 277 ) .AND. (ALLOWING_HOR)) THEN ! RIGHT ARRO VW X ALLOWING_VERT = .FALSE. X IF ( ICOL .LT. 32 ) THEN X ICOL = ICOL + 2 X ELSE X ICOL = 4 X ENDIF X X ELSEIF (( II .EQ. 276 ) .AND. (ALLOWING_HOR)) THEN ! LEFT ARROW X ALLOWING_VERT = .FALSE. X IF ( ICOL .GT. 4 ) THEN X ICOL = ICOL - 2 X ELSE X ICOL = 32 X ENDIF X X ELSEIF(( II .EQ. 274 ) .AND. (ALLOWING_VERT)) THEN ! UP ARROW X ALLOWING_HOR = .FALSE. X IF ( IROW .GT. 2 ) THEN X IROW = IROW - 1 X ELSE X IROW = 10 X ENDIF X X ELSEIF(( II .EQ. 275 ) .AND. (ALLOWING_VERT)) THEN ! DOWN ARRO VW X ALLOWING_HOR = .FALSE. X IF ( IROW .LT. 10 ) THEN X IROW = IROW + 1 X ELSE X IROW = 2 X ENDIF X `20 X ELSEIF ( II .EQ. 26 ) THEN X CALL MESSAGE( 'Aborting placement of this ship, sir!' ) X CALL ABORT( CH ) X LOG = .TRUE. X CALL OUR_UPDATE( CH, 0) X RETURN X `20 X ENDIF X X IF(ICOUNT .LE. NUM_HITS) THEN X X IF (M_GRID(IROW-1,(ICOL/2)-1).EQ.'.') THEN X X CALL WRITE( CH, IROW, ICOL ) `20 X M_GRID( IROW - 1,(ICOL/2) - 1 ) = CH X ICOUNT = ICOUNT + 1 X IF (ICOUNT .EQ. NUM_HITS ) FINISHED = .TRUE. X CALL OUR_UPDATE( CH, ICOUNT ) X X ELSEIF(M_GRID(IROW-1,(ICOL/2)-1) .NE. CH ) THEN X CALL MESSAGE('This position is already occupied, sir.') X IROW = IOLDROW X ICOL = IOLDCOL X X ENDIF X ENDIF X X END DO X LOG = .FALSE. X RETURN X END X X X SUBROUTINE OUR_UPDATE( CH, ISTRENGTH ) X INTEGER STRENGTH, PERCENTAGE X CHARACTER*20 TEXT X CHARACTER*9 STREN X CHARACTER*1 CH X INCLUDE 'BATTLE.INC' X 1 FORMAT( 1X,I1, 2X, '(',A9,')',1X,I3,'%' ) X INCLUDE 'BATTLE_ARRAY.INC' X X CALL SEND_UPDATE( CH, ISTRENGTH ) X X STRENGTH = ISTRENGTH X IMARK = 1 X X IF ( STRENGTH .EQ. 0 ) THEN X IMARK = - 1 X STRENGTH = 1 X ENDIF X `20 X IF ( CH .EQ. 'C' ) THEN X OUR.CRUISER = STRENGTH X STREN = CRUISER(STRENGTH) X PERCENTAGE = STRENGTH*(100/CRU_STRENGTH) X IROW = 17 X X ELSEIF ( CH .EQ. 'A' ) THEN X OUR.CARRIER = STRENGTH X STREN = CARRIER(STRENGTH) X PERCENTAGE = STRENGTH*(100/CAR_STRENGTH) X IROW = 18 X X ELSEIF ( CH .EQ. 'P' ) THEN X OUR.PT_BOAT = STRENGTH `20 X STREN = PT_BOAT(STRENGTH) X PERCENTAGE = STRENGTH*(100/PT_STRENGTH) X IROW = 15 X +-+-+-+-+-+-+-+- END OF PART 4 +-+-+-+-+-+-+-+-