-+-+-+-+-+-+-+-+ START OF PART 5 -+-+-+-+-+-+-+-+ X ELSEIF ( CH .EQ. 'D' ) THEN X OUR.DESTROYER = STRENGTH X STREN = DESTROYER(STRENGTH) X PERCENTAGE = STRENGTH*(100/DES_STRENGTH) X IROW = 16 X X ELSEIF ( CH .EQ. 'S' ) THEN X OUR.SUBMARINE = STRENGTH X STREN = SUBMARINE(STRENGTH) X PERCENTAGE = STRENGTH*(100/SUB_STRENGTH) X IROW = 14 X X ELSEIF ( CH .EQ. 'B' ) THEN X OUR.BATTLESHIP = STRENGTH X STREN = BATTLESHIP(STRENGTH) X PERCENTAGE = STRENGTH*(100/BAT_STRENGTH) X IROW = 13 X X ENDIF X X IF ( IMARK .LT. 0 ) THEN X STRENGTH = 0 X STREN = 'Destroyed' X PERCENTAGE= 0 X CALL WRITE( '>', IROW, 3 ) X ELSE X CALL WRITE( ' ', IROW, 3 ) X ENDIF X X WRITE ( TEXT, 1 ) STRENGTH, STREN, PERCENTAGE X CALL WRITE( TEXT, IROW, 15 ) X X RETURN X END X X X X SUBROUTINE THEIR_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 STRENGTH = ISTRENGTH X IMARK = 1 X CALL ESC_7 X X IF ( STRENGTH .EQ. 0 ) THEN X IMARK = - 1 X STRENGTH = 1 X ENDIF X X IF ( CH .EQ. 'C' ) THEN X THEIR.CRUISER = STRENGTH X STREN = CRUISER(STRENGTH) X PERCENTAGE = STRENGTH*(100/CRU_STRENGTH) X IIROW = 17 X X ELSEIF ( CH .EQ. 'A' ) THEN X THEIR.CARRIER = STRENGTH X STREN = CARRIER(STRENGTH) X PERCENTAGE = STRENGTH*(100/CAR_STRENGTH) X IIROW = 18 X X ELSEIF ( CH .EQ. 'P' ) THEN X THEIR.PT_BOAT = STRENGTH `20 X STREN = PT_BOAT(STRENGTH) X PERCENTAGE = STRENGTH*(100/PT_STRENGTH) X IIROW = 15 X X ELSEIF ( CH .EQ. 'D' ) THEN X THEIR.DESTROYER = STRENGTH X STREN = DESTROYER(STRENGTH) X PERCENTAGE = STRENGTH*(100/DES_STRENGTH) X IIROW = 16 X X ELSEIF ( CH .EQ. 'S' ) THEN X THEIR.SUBMARINE = STRENGTH X STREN = SUBMARINE(STRENGTH) X PERCENTAGE = STRENGTH*(100/SUB_STRENGTH) X IIROW = 14 X X ELSEIF ( CH .EQ. 'B' ) THEN X THEIR.BATTLESHIP = STRENGTH X STREN = BATTLESHIP(STRENGTH) X PERCENTAGE = STRENGTH*(100/BAT_STRENGTH) X IIROW = 13 X X ENDIF X X IF ( IMARK .LT. 0 ) THEN X STRENGTH = 0 X STREN = 'Destroyed' X PERCENTAGE= 0 X CALL WRITE( '>', IIROW, 38 ) X THEIR.SHIPS_DESTROYED = THEIR.SHIPS_DESTROYED + 1 X IF((THEIR.SHIPS_DESTROYED.EQ.6) .AND. X _ THEYRE_FINISHED) THEN X CALL WRITE_TO_MAILBOX( '*' ) X CALL THEY_LOST_THE_GAME X ENDIF X ELSE X CALL WRITE( ' ', IIROW, 38 ) X X ENDIF X WRITE ( TEXT, 1 ) STRENGTH, STREN, PERCENTAGE X CALL WRITE( TEXT, IIROW, 50 ) X CALL ESC_8 X X RETURN X END X X X X SUBROUTINE ABORT( CH ) X CHARACTER*1 CH X INCLUDE 'BATTLE.INC' X DO I = 1, 9 X DO J = 1, 15 X IF (M_GRID(I,J) .EQ. CH) THEN X M_GRID(I,J) = '.' X CALL WRITE( '.', I+1, (J*2) + 2 ) X END IF X END DO X END DO X RETURN X END X X INTEGER FUNCTION TOUP( INT ) X TOUP = INT X IF (INT .GE. 97 .AND. INT .LE. 122) TOUP = INT - 32 X RETURN X END X X X SUBROUTINE TRAP_MESSAGES X CHARACTER*200 MSG X INCLUDE 'BATTLE.INC' X CALL SMG$GET_BROADCAST_MESSAGE(PASTEID, MSG, ILN ) X CALL MESSAGE( MSG(1:ILN) ) X CALL SMG$SET_CURSOR_ABS( DISPID ) X RETURN X END X X X SUBROUTINE INIT X INCLUDE '($SMGDEF)' X EXTERNAL TRAP_MESSAGES, REPAINT_SCREEN, SEND_MESSAGE, X _ SPAWN_DCL X INCLUDE 'BATTLE.INC' X CALL SMG$CREATE_VIRTUAL_DISPLAY( 18, 70, DISPID , SMG$M_BORDER ) X CALL SMG$CREATE_VIRTUAL_DISPLAY( 3, 70, DISPID2, SMG$M_BORDER ) X CALL SMG$CREATE_PASTEBOARD( PASTEID ) X CALL SMG$SET_BROADCAST_TRAPPING( PASTEID, TRAP_MESSAGES ) X CALL SMG$CREATE_VIRTUAL_KEYBOARD( KEYBID ) X CALL SMG$PASTE_VIRTUAL_DISPLAY( DISPID, PASTEID, 2, 5, ) X CALL SMG$PASTE_VIRTUAL_DISPLAY( DISPID2, PASTEID, 21, 5, ) X CALL SMG$LABEL_BORDER( DISPID, 'You sank my BATTLESHIP!', X _SMG$K_TOP,,SMG$M_BOLD ) X DO I = 1, 15 X DO J = 1, 9 X M_GRID( J,I ) = '.' X END DO X END DO X CALL DISABLE_CONTROL X CALL CONTROL('W',REPAINT_SCREEN) X RETURN X END X X SUBROUTINE SPAWN_DCL X INCLUDE '($SMGDEF)' X EXTERNAL TRAP_MESSAGES X INCLUDE 'BATTLE.INC' X X CALL WRITE_TO_MAILBOX('=Opponent is going to DCL.') X CALL SMG$DISABLE_BROADCAST_TRAPPING( PASTEID ) X CALL SMG$UNPASTE_VIRTUAL_DISPLAY( DISPID , PASTEID ) X CALL SMG$UNPASTE_VIRTUAL_DISPLAY( DISPID2, PASTEID ) X X CALL LIB$ERASE_PAGE(1,1) X WRITE (*,*) 'Spawning to DCL. . .' X WRITE (*,*) 'Type EOJ to return to game.'`20 X CALL LIB$SPAWN(,,,,,,,,,,'BattleShip> ') X X CALL SMG$PASTE_VIRTUAL_DISPLAY( DISPID, PASTEID, 2, 5, ) X CALL SMG$PASTE_VIRTUAL_DISPLAY( DISPID2, PASTEID, 21, 5, ) X CALL SMG$SET_BROADCAST_TRAPPING( PASTEID, TRAP_MESSAGES ) X CALL REPAINT_SCREEN X CALL WRITE_TO_MAILBOX('=Opponent has returned from DCL.') X CALL MESSAGE( 'Welcome back, sir!' ) X RETURN X END X X SUBROUTINE SEND_MESSAGE X INCLUDE 'BATTLE.INC' X CHARACTER*70 STRING X X I1 = ILN( OUR.UIC ) X IF ( INSERT_CR ) THEN X CALL MESSAGE_NOCR( ' ' ) X INSERT_CR = .FALSE. X ENDIF X X CALL GET_INPUT( 'Msg> ', STRING, II ) X CALL WRITE_TO_MAILBOX( '='//OUR.UIC(1:I1)//'> '//STRING(1:II) ) X CALL REDRAW_BOTTOM_WINDOW X CALL SMG$SET_CURSOR_ABS( DISPID ) X X RETURN X END X X X SUBROUTINE GET_INPUT( PROMPT, STRING, II ) X INCLUDE 'BATTLE.INC' X CHARACTER*(*) PROMPT, STRING X IMAX_LEN = 69 - LEN(PROMPT) X AT_COMMAND_LINE = .TRUE. X CALL SMG$READ_STRING( KEYBID, STRING, PROMPT, IMAX_LEN X _ ,,,,II,,DISPID2) X AT_COMMAND_LINE = .FALSE. X RETURN X END X X X SUBROUTINE REDRAW_BOTTOM_WINDOW X INCLUDE 'BATTLE.INC' X CALL SMG$REPAINT_LINE( PASTEID, 21, 3 ) X RETURN X END X X X X SUBROUTINE DRAW_BOARD X INCLUDE '($SMGDEF)' X INCLUDE 'BATTLE.INC' X X CALL SMG$DRAW_RECTANGLE( DISPID, 1, 2, 11, 34 ) X CALL SMG$DRAW_RECTANGLE( DISPID, 1, 37, 11, 69 ) X X DO I = 1, 9 X CALL WRITE_BOLD( CHAR(I+48), I+1, 2 ) X CALL WRITE( '. . . . . . . . . . . . . . .',I+1,4) X CALL WRITE_REV_BOLD( ' ', I+1, 35 ) X X CALL WRITE_BOLD( CHAR(I+48), I+1, 37 ) X CALL WRITE( '. . . . . . . . . . . . . . .',I+1,39) X CALL WRITE_REV_BOLD( ' ', I+1, 70 ) X END DO X X CALL WRITE_BOLD( 'A B C D E F G H I J K L M N O', 11, 39 ) X CALL WRITE_BOLD( 'A B C D E F G H I J K L M N O', 11, 4 ) X X CALL WRITE_REV_BOLD(' ', 12, 3 ) X CALL WRITE_REV_BOLD( ' ', I+1, 35 ) X CALL WRITE_REV_BOLD('Our NAVY is ',12,3) X X CALL WRITE_REV_BOLD( ' ', I+1, 70 ) X CALL WRITE_REV_BOLD(' ', 12, 38) X CALL WRITE_REV_BOLD('Their NAVY is ',12,38) X X CALL WRITE( 'Battleship: ', 13, 4 ) X CALL WRITE( 'Battleship: ', 13, 39 ) X CALL WRITE_BOLD( 'B', 13,4) X CALL WRITE_BOLD( 'B', 13,39) X X CALL WRITE( 'Submarine : ', 14, 4 ) X CALL WRITE( 'Submarine : ', 14, 39 ) X CALL WRITE_BOLD( 'S', 14,4) X CALL WRITE_BOLD( 'S', 14,39) X X CALL WRITE( 'Pt Boat : ', 15, 4 ) X CALL WRITE( 'Pt Boat : ', 15, 39 ) X CALL WRITE_BOLD( 'P', 15, 4) X CALL WRITE_BOLD( 'P', 15, 39) X X CALL WRITE( 'Destroyer : ', 16, 4 ) X CALL WRITE( 'Destroyer : ', 16, 39 ) X CALL WRITE_BOLD( 'D', 16,4) X CALL WRITE_BOLD( 'D', 16, 39) X X CALL WRITE( 'Cruiser : ', 17, 4 ) X CALL WRITE( 'Cruiser : ', 17, 39 ) X CALL WRITE_BOLD( 'C', 17,4) X CALL WRITE_BOLD( 'C', 17,39) X X CALL WRITE( 'cArrier : ', 18, 4 ) X CALL WRITE( 'cArrier : ', 18, 39 ) X CALL WRITE_BOLD( 'A', 18,5) X CALL WRITE_BOLD( 'A', 18,40) X RETURN X END X X $ CALL UNPACK SCREEN1.FOR;1 290175073 $ create 'f' XC XC SCREEN2.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 AIM_AND_FIRE Position cursor on prospective target and fi Vre XC HELP_ROUTINE Displays a brief help window XC HELP_WRITE Routine to display text onto the help window XC WAIT Wait while your opponent aims and fires XC DISPLAY_WHAT_WERE_DOING Display what we're doing XC DISPLAY_WHAT_THEYRE_DOING Display what they're doing XC SEND_CURSOR Send your opponent's process your cursor pos V. XC FIRE Fire a shot against your opponent XC MESSAGE Displays text at the bottom portion of the s Vcrn. XC MESSAGE_NOCR Same as MESSAGE, only with no XC ILN Returns the length of a string XC WRITE Routine to display text on the general scree Vn. XC WRITE_REV_BOLD Same as WRITE with REVERSE and BOLD attribut Ves. XC WRITE_REV Same as WRITE with REVERSE attribute. XC WRITE_BOLD Same as WRITE with BOLD attribute. XC INKEY Inkey function, returns integer code of kyst Vrk. XC SET_CURSOR Sets the cursor on your screen XC ABORT_GAME Clears your screen, shuts down both processe Vs XC CANCELLED_THE_GAME Displays exit message (credits) XC THEY_WON_THE_GAME Displays a defeat screen XC THEY_LOST_THE_GAME Displays a victorious screen XC NOT_ALLOWED_TO_PLAY Displays a not-allowed-to-play screen XC NOT_A_SCHEDULED_TIME When not scheduled to play XC CENTER_DISP_REV_BOLD WRITE function for exit screens. REV,BOLD XC CENTER_DISP_BOLD WRITE function for exit screens. BOLD XC CENTER_DISP WRITE function for exit screens.`20 XC X X SUBROUTINE AIM_AND_FIRE( II ) X INCLUDE 'BATTLE.INC' X INTEGER INKEY, TOUP X LOGICAL FIRED X SAVE X X FIRED = .FALSE. X X DO WHILE( .NOT. FIRED ) X X CALL SET_CURSOR ( IOUR_ROW, IOUR_COL ) X CALL SEND_CURSOR( IOUR_ROW, IOUR_COL-35 ) X X IF ( II .EQ. 0 ) II = INKEY() X II = TOUP( II ) X X IF ( II .EQ. 277 ) THEN ! RIGHT ARROW X IF ( IOUR_COL .LT. 66 ) THEN X IOUR_COL = IOUR_COL + 2 X ELSE X IOUR_COL = 39 X ENDIF X X ELSEIF ( II .EQ. 276 ) THEN ! LEFT ARROW X IF ( IOUR_COL .GT. 39 ) THEN X IOUR_COL = IOUR_COL - 2 X ELSE X IOUR_COL = 67 X ENDIF X X ELSEIF( II .EQ. 274 ) THEN ! UP ARROW X IF ( IOUR_ROW .GT. 2 ) THEN X IOUR_ROW = IOUR_ROW - 1 X ELSE X IOUR_ROW = 10 X ENDIF X X ELSEIF( II .EQ. 275 ) THEN ! DOWN ARROW X IF ( IOUR_ROW .LT. 10 ) THEN X IOUR_ROW = IOUR_ROW + 1 X ELSE X IOUR_ROW = 2 X ENDIF X X ELSEIF(( II .EQ. 32 ) .OR. (II .EQ. 13)) THEN X X FIRED = .TRUE. X CALL MESSAGE( '*kerbloop* .. whhoooOFFFFSSssss....' ) X CALL FIRE( IOUR_ROW, IOUR_COL ) X CALL SYS$WAITFR( 1 ) 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 END IF X X II = 0 X X END DO X X RETURN X END X X X SUBROUTINE HELP_ROUTINE X INCLUDE 'BATTLE.INC' X INTEGER INKEY X COMMON /HELP/ HELPID X INCLUDE '($SMGDEF)' X IN_HELP = .TRUE. X CALL SMG$CREATE_VIRTUAL_DISPLAY( 15, 50, HELPID, SMG$M_BORDER ) X CALL SMG$PASTE_VIRTUAL_DISPLAY( HELPID, PASTEID, 4, 15, ) X CALL SMG$LABEL_BORDER( HELPID, 'HELP' ) X CALL HELP_WRITE( '`5EW Refresh screen' ,1,4 ) X CALL HELP_WRITE( '`5EA, `5EC Abort, Cancel game' ,2,4 ) X CALL HELP_WRITE( '`5EE Send Message to opponent' ,3,4 ) X CALL HELP_WRITE( '`5EH This Screen' ,4,4 ) X CALL HELP_WRITE( '`5EP Spawn to DCL' ,5,4 ) X CALL HELP_WRITE( '`5Bspace`5D Fires a torpedo', 6,4 ) X CALL HELP_WRITE( 'Setup procedure: Press B,C,A,D,S, or P',7,4) X CALL HELP_WRITE( 'to begin placing your ship, then use',8,10) X CALL HELP_WRITE( 'arrows to place it. `5EZ aborts placing of',9,10) X CALL HELP_WRITE( 'the current ship.',10,10 ) X CALL HELP_WRITE( '...press any key to exit help...',14,9 ) X CALL PURGE_TYPE_AHEAD X IF ( .NOT. GETTING_INKEY ) II = INKEY() X CALL SMG$DELETE_VIRTUAL_DISPLAY( HELPID ) X CALL SMG$SET_CURSOR_ABS( DISPID ) X IN_HELP = .FALSE. X RETURN X END X `20 X SUBROUTINE HELP_WRITE( TEXT, I1, I2 ) X CHARACTER *(*) TEXT X INCLUDE 'BATTLE.INC' X INCLUDE '($SMGDEF)' X COMMON /HELP/ HELPID X CALL SMG$PUT_CHARS( HELPID, TEXT, I1, I2 ) X RETURN X END X X SUBROUTINE WAIT( II ) X INCLUDE 'BATTLE.INC' X CHARACTER*1 ESC/27/ X INTEGER INKEY X X DO WHILE ( THEIR_TURN ) +-+-+-+-+-+-+-+- END OF PART 5 +-+-+-+-+-+-+-+-