Newsgroups: vmsnet.sources.games Path: uunet!zaphod.mps.ohio-state.edu!hobbes.physics.uiowa.edu!iowa.physics.uiowa.edu!dyson From: dyson@iowa.physics.uiowa.edu (Rick Dyson) Subject: BATTLESHIP (7/8) Message-ID: <1991Dec20.012504.1@iowa.physics.uiowa.edu> Lines: 452 Sender: news@space.physics.uiowa.edu Nntp-Posting-Host: iaiowa.physics.uiowa.edu Organization: Department of Physics and Astronomy, University of Iowa Date: Fri, 20 Dec 1991 06:25:04 GMT -+-+-+-+-+-+-+-+ START OF PART 7 -+-+-+-+-+-+-+-+ X INCLUDE 'BATTLESHIP.INC' X GETTING_INKEY = .TRUE. X CALL SMG$READ_KEYSTROKE(KEYBID, INKEY) X GETTING_INKEY = .FALSE. X RETURN X END X`0C X SUBROUTINE SET_CURSOR( ROW, COL ) X INTEGER ROW, COL X INCLUDE 'BATTLESHIP.INC' X CALL SMG$SET_CURSOR_ABS( DISPID, ROW, COL ) X RETURN X END X`0C X SUBROUTINE ABORT_GAME X CHARACTER*132 MASTER_FILE X INCLUDE 'BATTLESHIP.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`0C X SUBROUTINE CANCELLED_THE_GAME X INCLUDE 'BATTLESHIP.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`0C X SUBROUTINE THEY_WON_THE_GAME X INCLUDE 'BATTLESHIP.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`0C X SUBROUTINE THEY_LOST_THE_GAME X INCLUDE 'BATTLESHIP.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`0C X SUBROUTINE NOT_ALLOWED_TO_PLAY X INCLUDE 'BATTLESHIP.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`0C X SUBROUTINE NOT_A_SCHEDULED_TIME X INCLUDE 'BATTLESHIP.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`0C 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`0C 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`0C 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 $ CALL UNPACK [.SOURCE]SCREEN2.FOR;1 1059668065 $ create 'f' X$ VERIFY = F$Verify (0) X$! X$! BattleShip X$! Written by Ray Renteria X$! Southwest Texas State University X$! X$! Distributed by (read "BLAME") Rick Dyson X$! (dyson@iowasp.physics.uiowa.edu) X$! 18-DEC-1991 X$! X$ Write Sys$Output "SETting UP Battleship Maintanence program..." X$ THIS_PATH = F$Element (0, "`5D", F$Environment ("PROCEDURE")) + "`5D" X$ Write Sys$Output "Use BS_MAINT to execute the program" X$ BS_MAINT :== $ 'THIS_PATH'BATTLESHIP_MAINT.EXE X$ VERIFY :== F$Verify (VERIFY) X$ Exit $ CALL UNPACK [.SOURCE]SETUP.COM;1 1046626010 $ 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`0C X SUBROUTINE GET_JOB_PROCESS_INFORMATION X INTEGER INKEY X CHARACTER*39 TRNLNM X INCLUDE '($JPIDEF)' X INCLUDE 'BATTLESHIP.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`0C 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`0C 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`0C 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`0C 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`0C X SUBROUTINE CREATE_MAILBOX X INTEGER STATUS X INTEGER SYS$CREMBX X INCLUDE 'BATTLESHIP.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`0C X SUBROUTINE ASSIGN_CHANNEL( MAILBOX ) X INTEGER STATUS X INTEGER SYS$ASSIGN X CHARACTER*(*) MAILBOX X INCLUDE 'BATTLESHIP.INC' X STATUS=SYS$ASSIGN(MAILBOX,THEIR.MBX_CHAN,,) X CALL STATUS_CHECK( STATUS ) X RETURN X END X`0C X SUBROUTINE SET_WRITE_ATTENTION X INTEGER STATUS,SYS$QIOW X EXTERNAL READ_MAILBOX X INCLUDE 'BATTLESHIP.INC' X INCLUDE '($IODEF)' X X STATUS=SYS$QIOW(,%VAL(OUR.MBX_CHAN) , X _ %VAL(IO$_SETMODE+IO$M_WRTATTN) ,,,, X _ %REF(READ_MAILBOX),OUR.MBX_CHAN,,,,) X CALL STATUS_CHECK(STATUS) X X RETURN X END X`0C X SUBROUTINE WRITE_TO_MAILBOX( TEXT ) X INTEGER STATUS X INTEGER SYS$QIOW X INTEGER BUFLEN X CHARACTER*(*) TEXT, LINE*99 X INCLUDE 'BATTLESHIP.INC' X INCLUDE '($IODEF)' X 1 FORMAT( I2,A97 ) X BUFLEN = 99 X WRITE( LINE, 1 ) ILN( TEXT ), TEXT X STATUS=SYS$QIOW(,%VAL(THEIR.MBX_CHAN),`20 X _ %VAL(IO$_WRITEVBLK+IO$M_NOW) X _ ,,,,%REF(LINE),%VAL(BUFLEN),,,,) X CALL STATUS_CHECK(STATUS) X X RETURN X END X`0C X SUBROUTINE WRITE_TO_MAILBOX_RAW( TEXT ) X INTEGER STATUS X INTEGER SYS$QIOW X INTEGER BUFLEN X CHARACTER*(*) TEXT, LINE*99 X INCLUDE 'BATTLESHIP.INC' X INCLUDE '($IODEF)' X BUFLEN = LEN(TEXT) X`20 X STATUS=SYS$QIOW(,%VAL(THEIR.MBX_CHAN),`20 X _ %VAL(IO$_WRITEVBLK+IO$M_NOW) X _ ,,,,%REF(TEXT),%VAL(BUFLEN),,,,) X CALL STATUS_CHECK(STATUS) X X RETURN X END X`0C X SUBROUTINE GET_THEIR_INFO X INTEGER STATUS,SYS$QIOW,BUFLEN X CHARACTER*99 TEXT`20 X 1 FORMAT( 1X, A12, 1X, A12, 1X, A15 ) X INCLUDE 'BATTLESHIP.INC' X INCLUDE '($IODEF)' X X BUFLEN = 99 X TEXT = ' ' X STATUS=SYS$QIOW(,%VAL(OUR.MBX_CHAN),%VAL(IO$_READVBLK),,,, X _ %REF(TEXT),%VAL(BUFLEN),,,,) X CALL STATUS_CHECK(STATUS) X X READ( TEXT, 1 ) THEIR.MBX_NAME, THEIR.UIC, THEIR.NICKNAME X X RETURN X END X`0C X SUBROUTINE READ_MAILBOX X INTEGER STATUS,SYS$QIOW,BUFLEN X COMMON /SETUP/ ICOMMON_SETUP_ROW, ICOMMON_SETUP_COL X LOGICAL HIT X CHARACTER*1 CH, TCH, LOWER, CCH, UPPER X CHARACTER*99 TEXT`20 X CHARACTER*97 STRING X INCLUDE 'BATTLESHIP.INC' X INCLUDE '($IODEF)' X X 1 FORMAT( 1X, A1, I1 ) X 2 FORMAT( 1X, I2, I2 ) X 3 FORMAT( A1, A1, I1 , I2, I2 ) X 4 FORMAT( 1X, A1, I1 , I2, I2 ) X X BUFLEN = 99 X STATUS = SYS$QIOW(,%VAL(OUR.MBX_CHAN), X _ %VAL(IO$_READVBLK+IO$M_NOW),,,, X _ %REF(TEXT),%VAL(BUFLEN),,,,) X CALL STATUS_CHECK(STATUS) X CALL FILL_VARIABLE( STRING, TEXT, II ) X XC------------------------------------------------------------------ X IF ( STRING(1:1) .EQ. '=' ) THEN ! A SENT MESSAGE X CALL ESC_7 X CALL MESSAGE( STRING(2:II) ) X INSERT_CR = .TRUE. X CALL ESC_8 X XC------------------------------------------------------------------ +-+-+-+-+-+-+-+- END OF PART 7 +-+-+-+-+-+-+-+- -- Richard L. Dyson INTERNET: Dyson@IowaSP.Physics.UIowa.EDU Keep your eyes wide open before marriage, half shut afterwards. -- Poor Richard.