-+-+-+-+-+-+-+-+ START OF PART 6 -+-+-+-+-+-+-+-+ X CALL SET_CURSOR( ITHEIR_ROW, ITHEIR_COL ) X II = INKEY() X X IF ( II .EQ. 5 ) THEN X CALL SEND_MESSAGE X II = 0 X X ENDIF X END DO X X RETURN X END X X X SUBROUTINE DISPLAY_WHAT_WERE_DOING( TEXT , I1, I2 ) X CHARACTER*(*) TEXT X CALL WRITE_REV_BOLD( TEXT, 12, 15) X CALL SET_CURSOR( I1, I2 ) X RETURN X END X X SUBROUTINE DISPLAY_WHAT_THEYRE_DOING( TEXT, I1, I2 ) X CHARACTER*(*) TEXT X CALL WRITE_REV_BOLD( TEXT, 12, 52) X CALL SET_CURSOR( I1, I2 ) X RETURN X END X X SUBROUTINE SEND_CURSOR( ROW, COL ) X INTEGER ROW, COL X CHARACTER*5 LINE X 1 FORMAT( 'C', I2, I2 ) X WRITE( LINE, 1 ) ROW, COL X CALL WRITE_TO_MAILBOX( LINE ) X RETURN X END X X SUBROUTINE FIRE( ROW, COL ) X INTEGER ROW, COL X CHARACTER*5 LINE X 1 FORMAT( 'F', I2, I2 ) X WRITE( LINE, 1 ) ROW, COL X CALL WRITE_TO_MAILBOX( LINE ) X RETURN X END X X SUBROUTINE MESSAGE( TEXT ) X CHARACTER*(*) TEXT X INCLUDE '($SMGDEF)' X INCLUDE 'BATTLE.INC' X II = ILN( TEXT ) X CALL SMG$SCROLL_DISPLAY_AREA( DISPID2 ) X CALL SMG$PUT_CHARS( DISPID2, TEXT(1:II), 3 ) X RETURN X END X X SUBROUTINE MESSAGE_NOCR( TEXT ) X CHARACTER*(*) TEXT X INCLUDE '($SMGDEF)' X INCLUDE 'BATTLE.INC' X II = ILN( TEXT ) X CALL SET_CURSOR( 3, 1 ) X CALL SMG$PUT_LINE( DISPID2, TEXT(1:II),,,, ) X RETURN X END X X X INTEGER FUNCTION ILN( TEXT ) X CHARACTER*(*) TEXT X ILN = LEN(TEXT) X DO WHILE(( TEXT(ILN:ILN) .EQ. ' ' ) .AND. (ILN .GT. 1)) X ILN = ILN - 1 X END DO X RETURN X END X X X SUBROUTINE WRITE( TEXT, ROW, COL ) X CHARACTER*(*) TEXT X INTEGER STATUS, SMG$PUT_CHARS, ROW, COL X INCLUDE 'BATTLE.INC' X STATUS = SMG$PUT_CHARS( DISPID, TEXT, ROW, COL ) X IF ( .NOT. STATUS) CALL LIB$SIGNAL( %VAL( STATUS )) X RETURN X END X X X X SUBROUTINE WRITE_REV_BOLD( TEXT, ROW, COL ) X INCLUDE '($SMGDEF)' X CHARACTER*(*) TEXT X INTEGER STATUS, SMG$PUT_CHARS, ROW, COL X INCLUDE 'BATTLE.INC' X STATUS = SMG$PUT_CHARS( DISPID, TEXT, ROW, COL, , X _SMG$M_BOLD+SMG$M_REVERSE ) X IF ( .NOT. STATUS) CALL LIB$SIGNAL( %VAL( STATUS )) X RETURN X END X X SUBROUTINE WRITE_REV( TEXT, ROW, COL ) X INCLUDE '($SMGDEF)' X CHARACTER*(*) TEXT X INTEGER STATUS, SMG$PUT_CHARS, ROW, COL X INCLUDE 'BATTLE.INC' X STATUS = SMG$PUT_CHARS( DISPID, TEXT, ROW, COL, , X _SMG$M_REVERSE ) X IF ( .NOT. STATUS) CALL LIB$SIGNAL( %VAL( STATUS )) X RETURN X END X X X X SUBROUTINE WRITE_BOLD( TEXT, ROW, COL ) X INCLUDE '($SMGDEF)' X CHARACTER*(*) TEXT X INTEGER STATUS, SMG$PUT_CHARS, ROW, COL X INCLUDE 'BATTLE.INC' X STATUS = SMG$PUT_CHARS( DISPID, TEXT, ROW, COL, , X _SMG$M_BOLD ) X IF ( .NOT. STATUS) CALL LIB$SIGNAL( %VAL( STATUS )) X RETURN X END X X X INTEGER FUNCTION INKEY() X INCLUDE 'BATTLE.INC' X GETTING_INKEY = .TRUE. X CALL SMG$READ_KEYSTROKE(KEYBID, INKEY) X GETTING_INKEY = .FALSE. X RETURN X END X X X SUBROUTINE SET_CURSOR( ROW, COL ) X INTEGER ROW, COL X INCLUDE 'BATTLE.INC' X CALL SMG$SET_CURSOR_ABS( DISPID, ROW, COL ) X RETURN X END X X X SUBROUTINE ABORT_GAME X CHARACTER*132 MASTER_FILE X INCLUDE 'BATTLE.INC' X IF ( WAITING_FOR_COMLINK ) THEN X II = ILN( IMAGE_DEFAULT_DIR ) X IJ = ILN( CURR_NODE ) X X MASTER_FILE = IMAGE_DEFAULT_DIR(1:II)// X _ 'BATTLESHIP_' // X _ CURR_NODE(1:IJ) // X _ '.DAT' X X X THEIR.MBX_NAME = ' ' X 19 OPEN( FILE=MASTER_FILE, STATUS='OLD', UNIT=20, ERR=21 ) X WRITE( 20, * ) ' ' X CALL CANCELLED_THE_GAME X X ENDIF X X CALL WRITE_TO_MAILBOX( 'A' ) X 21 CALL CANCELLED_THE_GAME X X RETURN X END X X X SUBROUTINE CANCELLED_THE_GAME X INCLUDE 'BATTLE.INC' X X CALL SMG$DELETE_VIRTUAL_DISPLAY( DISPID2 ) X CALL SMG$ERASE_DISPLAY( DISPID ) X CALL CENTER_DISP_REV_BOLD( 'VMS BattleShip V1.0' , 1 )`20 X CALL CENTER_DISP_BOLD( 'was written by' , 3 ) X CALL CENTER_DISP_BOLD( 'Ray Renteria' , 5 ) X CALL CENTER_DISP_BOLD( 'Copyright(C) 1989 IRONLOGIC(tm)', 7 ) X CALL CENTER_DISP_BOLD( 'Send suggestions or comments to',10) X CALL CENTER_DISP_BOLD( 'RR02026@SWTEXAS' , 11 ) X CALL CENTER_DISP_BOLD( 'or', 12 ) X CALL CENTER_DISP_BOLD( 'ACM_CSA@SWTEXAS',13 ) X CALL CENTER_DISP_BOLD( '. . .press any key to continue. . .',17) X CALL PURGE_TYPE_AHEAD X IF ( .NOT. GETTING_INKEY ) II = INKEY() X CALL SMG$DISABLE_BROADCAST_TRAPPING( PASTEID ) X CALL SYS$DELMBX( OUR.MBX_CHAN ) X CALL SYS$DASSGN( THEIR.MBX_CHAN ) X CALL SMG$DELETE_VIRTUAL_DISPLAY( DISPID ) X CALL EXIT X RETURN X END X X SUBROUTINE THEY_WON_THE_GAME X INCLUDE 'BATTLE.INC' X CALL SMG$DELETE_VIRTUAL_DISPLAY( DISPID2 ) X CALL SMG$ERASE_DISPLAY( DISPID ) X CALL CENTER_DISP( 'I''m sorry to inform you '// X _ 'that our NAVY was' ,5) X CALL CENTER_DISP( 'unsuccessful in destroying the',6 ) X CALL CENTER_DISP( 'enemy.' ,7) X CALL CENTER_DISP( 'We have walked away wiser. . .', 9 ) X CALL CENTER_DISP( 'and',10) X CALL CENTER_DISP_BOLD( 'We shall return!', 11 ) X CALL CENTER_DISP( '. . .press any key to continue. . .', 17 ) X CALL PURGE_TYPE_AHEAD X IF ( .NOT. GETTING_INKEY ) II = INKEY() X GETTING_INKEY = .FALSE. X CALL CANCELLED_THE_GAME X RETURN X END X X X SUBROUTINE THEY_LOST_THE_GAME X INCLUDE 'BATTLE.INC' X CALL SMG$DELETE_VIRTUAL_DISPLAY( DISPID2 ) X CALL SMG$ERASE_DISPLAY( DISPID ) X CALL CENTER_DISP( 'Your keen senses has led this' ,5) X CALL CENTER_DISP( 'NAVY to victory!',6 ) X CALL CENTER_DISP_BOLD( 'Congratulations, sir!', 8 ) X CALL CENTER_DISP( '. . .press any key to continue. . .', 17 ) X CALL PURGE_TYPE_AHEAD X IF ( .NOT. GETTING_INKEY ) II = INKEY() X GETTING_INKEY = .FALSE. X CALL CANCELLED_THE_GAME X RETURN X END X X X X SUBROUTINE NOT_ALLOWED_TO_PLAY X INCLUDE 'BATTLE.INC' X CALL SMG$DELETE_VIRTUAL_DISPLAY( DISPID2 ) X CALL SMG$ERASE_DISPLAY( DISPID ) X CALL CENTER_DISP( 'Your username has been' ,5) X CALL CENTER_DISP_BOLD( 'restricted',6 ) X CALL CENTER_DISP( 'from this game.', 8 ) X CALL CENTER_DISP( 'contact the operator of this game', 10 ) X CALL CENTER_DISP( 'if you have any questions.',12 ) X CALL CENTER_DISP( '. . .press any key to continue. . .', 17 ) X CALL PURGE_TYPE_AHEAD X IF ( .NOT. GETTING_INKEY ) II = INKEY() X GETTING_INKEY = .FALSE. X CALL CANCELLED_THE_GAME X RETURN X END X X X X SUBROUTINE NOT_A_SCHEDULED_TIME X INCLUDE 'BATTLE.INC' X CALL SMG$DELETE_VIRTUAL_DISPLAY( DISPID2 ) X CALL SMG$ERASE_DISPLAY( DISPID ) X CALL CENTER_DISP( 'You cannot play at this time' ,5) X CALL CENTER_DISP( 'Contact the operator of this game', 10 ) X CALL CENTER_DISP( 'if you have any questions.',12 ) X CALL CENTER_DISP( '. . .press any key to continue. . .', 17 ) X CALL PURGE_TYPE_AHEAD X IF ( .NOT. GETTING_INKEY ) II = INKEY() X GETTING_INKEY = .FALSE. X CALL CANCELLED_THE_GAME X RETURN X END X X X SUBROUTINE CENTER_DISP_REV_BOLD( TEXT, ROW ) X CHARACTER*(*) TEXT X INTEGER ROW X ILN = LEN(TEXT) X II = 35 - (ILN/2) X CALL WRITE_REV_BOLD( TEXT, ROW, II ) X RETURN X END X X X SUBROUTINE CENTER_DISP_BOLD( TEXT, ROW ) X CHARACTER*(*) TEXT X INTEGER ROW X ILN = LEN(TEXT) X II = 35 - (ILN/2) X CALL WRITE_BOLD( TEXT, ROW, II ) X RETURN X END X X X SUBROUTINE CENTER_DISP( TEXT, ROW ) X CHARACTER*(*) TEXT X INTEGER ROW X ILN = LEN(TEXT) X II = 35 - (ILN/2) X CALL WRITE( TEXT, ROW, II ) X RETURN X END X $ CALL UNPACK SCREEN2.FOR;1 1210826125 $ create 'f' XC XC SYSTEM.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 ASSIGN_CHANNEL Assigns a channel to a specified device XC CONTROL Set's an AST for specified control code XC CREATE_MAILBOX Create a temporary mailbox XC DISABLE_CONTROL Traps `5EC and `5EY (has problems with F6) XC ESC_7 Set cursor with no XC ESC_8 Reset cursor with no XC FILL_VARIABLE Reads the contents of a string received via V mbx XC GET_JOB_PROCESS_INFORMATION Gets job process information of current pro Vcess XC GET_JPI Clean call to LIB$GET_JPI XC GET_JPIL Same, except returns a longword. XC GET_THEIR_INFO Reads their information through mailbox cha Vnnel XC HIT Updates when a hit has been made XC LOWER Converts a single character to lower case XC PURGE_TYPE_AHEAD Empties out the current type-ahead buffer XC READ_MAILBOX AST procedure to read and respond to mbx da Vta. XC SET_WRITE_ATTENTION Sets a write attention on the tmpmbx XC STATUS_CHECK Performs a 'IF(.NOT.STATUS)CALL LIB$SIGNAL. V.. XC TRNLNM Returns the translation of a logical name. XC UPPER Converts a single character to upper case. XC WRITE_SYSOUTPUT_RAW Writes text to your screen. No ($qio) XC WRITE_TO_MAILBOX Writes to your opponent's mailbox with a co Vde. XC WRITE_TO_MAILBOX_RAW Writes to your opponent's mailbox w/out a c Vode. XC X SUBROUTINE GET_JOB_PROCESS_INFORMATION X INTEGER INKEY X CHARACTER*39 TRNLNM X INCLUDE '($JPIDEF)' X INCLUDE 'BATTLE.INC' X X CALL GET_JPI( JPI$_USERNAME, OUR.UIC , OUR.UIC_LEN ) X X CALL GET_JPI( JPI$_PRCNAM, OUR.NICKNAME , OUR.NICKNAME_LEN ) X X CALL GET_JPI( JPI$_IMAGNAME, CURRENT_IMAGE_NAME , IDUMMY ) X II = INDEX( CURRENT_IMAGE_NAME, '`5D' ) X IMAGE_DEFAULT_DIR = CURRENT_IMAGE_NAME(1:II) X X CURR_NODE = TRNLNM( 'SYS$NODE', 'LNM$SYSTEM_TABLE' ) X II = INDEX( CURR_NODE, ':' ) - 1 X CURR_NODE(1:) = CURR_NODE(1:II) X X CALL CREATE_MAILBOX X OUR.MBX_NAME = TRNLNM( 'BATTLE$MBX', 'LNM$TEMPORARY_MAILBOX') X X RETURN X END X X X SUBROUTINE DISABLE_CONTROL X INTEGER CTRL_MASK(2) X EXTERNAL ABORT_GAME X COMMON /SYSTEM_SERVICES/ MULTI_EXEC, INPUT_CHANNEL,`20 X _ OUTPUT_CHANNEL X LOGICAL MULTI_EXEC/.FALSE./ X INCLUDE '($IODEF)' X X IF (.NOT.MULTI_EXEC) THEN X STATUS = SYS$ASSIGN('SYS$INPUT',INPUT_CHANNEL,,,,) X CALL STATUS_CHECK( STATUS ) X X STATUS = SYS$ASSIGN('SYS$OUTPUT',OUTPUT_CHANNEL,,,,) X CALL STATUS_CHECK( STATUS ) X X MULTI_EXEC = .TRUE. X ENDIF X X CTRL_MASK(1) = 0 X CTRL_MASK(2) = 33554440 X X STATUS = SYS$QIOW(,%VAL(INPUT_CHANNEL), X _ %VAL(IO$_SETMODE+IO$M_OUTBAND),,,, X _ ABORT_GAME,CTRL_MASK,,,,) X CALL STATUS_CHECK( STATUS ) X X RETURN X END X X X X CHARACTER*(*) FUNCTION TRNLNM( LOGNAME, TABNAME ) X CHARACTER*(*) LOGNAME, TABNAME X INTEGER STATUS, SYS$TRNLNM X CHARACTER*40 TEMPLOGNAME X INCLUDE '($LNMDEF)' X STRUCTURE /ITMLST/ X UNION X MAP X INTEGER*2 BUFLEN X INTEGER*2 CODE X INTEGER*4 BUFADR X INTEGER*4 RETLENADR X END MAP X MAP X INTEGER*4 END_LIST X END MAP X END UNION X END STRUCTURE X X RECORD /ITMLST/ LOGICAL_ITMLST(2) X IIBUFLEN = LEN(TRNLNM) X LOGICAL_ITMLST(1).BUFLEN = IIBUFLEN X LOGICAL_ITMLST(1).CODE = LNM$_STRING X LOGICAL_ITMLST(1).BUFADR = %LOC(TEMPLOGNAME) X LOGICAL_ITMLST(1).RETLENADR = %LOC(II) X LOGICAL_ITMLST(2).END_LIST = 0 X X STATUS = SYS$TRNLNM(,%DESCR(TABNAME),%DESCR(LOGNAME) X _ ,,LOGICAL_ITMLST) X TRNLNM = TEMPLOGNAME X CALL STATUS_CHECK( STATUS ) X RETURN X END X X X SUBROUTINE GET_JPI( CODE, RETVAL , II) X INTEGER STATUS, LIB$GETJPI, CODE X CHARACTER*(*) RETVAL X X STATUS = LIB$GETJPI( CODE,,,,RETVAL, II ) X CALL STATUS_CHECK( STATUS ) X X RETURN X END X X X SUBROUTINE GET_JPIL( CODE, RETVAL ) X INTEGER STATUS, LIB$GETJPI, CODE X REAL RETVAL X X STATUS = LIB$GETJPI( CODE,,,RETVAL, ) X CALL STATUS_CHECK( STATUS ) X X RETURN X END X X X SUBROUTINE CREATE_MAILBOX X INTEGER STATUS X INTEGER SYS$CREMBX X INCLUDE 'BATTLE.INC' X X STATUS = SYS$CREMBX(,%REF(OUR.MBX_CHAN),,,,, X _ %DESCR('BATTLE$MBX')) X CALL STATUS_CHECK(STATUS) X X RETURN X END X X X SUBROUTINE ASSIGN_CHANNEL( MAILBOX ) X INTEGER STATUS X INTEGER SYS$ASSIGN X CHARACTER*(*) MAILBOX X INCLUDE 'BATTLE.INC' X STATUS=SYS$ASSIGN(MAILBOX,THEIR.MBX_CHAN,,) X CALL STATUS_CHECK( STATUS ) X RETURN X END X X X SUBROUTINE SET_WRITE_ATTENTION X INTEGER STATUS,SYS$QIOW X EXTERNAL READ_MAILBOX X INCLUDE 'BATTLE.INC' X INCLUDE '($IODEF)' X X STATUS=SYS$QIOW(,%VAL(OUR.MBX_CHAN) , X _ %VAL(IO$_SETMODE+IO$M_WRTATTN) ,,,, +-+-+-+-+-+-+-+- END OF PART 6 +-+-+-+-+-+-+-+-