DEFINE(DIG0,48) # ASCII "0" PROGRAM PLAYER # # MAY 1980 BILL CAEL AND BILL WOOD RECODED IN RATFOR # MAY 1980 BILL CAEL AND BILL WOOD ADDED DEFAULT SHIP AND DIRECTION # MAY 1980 BILL WOOD ADDED ENERGY NETS # MAY 1980 BILL CAEL AND BILL WOOD RECODED OUTPUT # MAY 1980 BILL CAEL, BILL WOOD, AND BOB STODOLA # RECODED COMMAND ARG PROMPTING # NOV 1980 BILL WOOD CONVERTED TO RUN ON VAX # INCLUDE COMMON.RAT LOGICAL*1 OK,DONE,YES,WARN,REFTOG LOGICAL QUIKUP INTEGER DEFSHP REAL DEFDIR COMMON /DEFLTS/ DEFSHP,DEFDIR,DEFSHD LOGICAL CLEARF, VERBOS COMMON /MESS/ CLEARF,VERBOS BYTE BLANK(80),ALPHA,MESBUF(60) BYTE BLUNK(2) BYTE BLUNK2(2) BYTE OBUFF(-9:+9,-9:+9), NBUFF(-9:+9,-9:+9) BYTE JUNK LOGICAL*1 REFRES COMMON /BNDRY/ IXX, IYY, ID, MINID8, JUNK, OBUFF, NBUFF, REFRES BYTE COMMND INTEGER ME #MY SHIP NUMBER BYTE NAME(10) LOGICAL*1 LSTOUT EQUIVALENCE (BLUNK(2), NBUFF(-9, -9)) EQUIVALENCE (BLUNK2(2), OBUFF(-9, -9)) DATA BLANK/80*' '/ DATA BLUNK,BLUNK2/4*' '/ DATA DONE/.FALSE./ DATA OK/.FALSE./ DATA DEFDIR/0.0/,DEFSHD/0.0/ #---------------------------------------------------------------------- # DON'T EXIT ON I/O CONVERSION ERRORS CALL ERRSET( 63, .TRUE., .FALSE.,, .FALSE.) CALL ERRSET( 64, .TRUE., .FALSE.,, .FALSE.) # # QUIKUP IS SET TRUE IF TERMINAL SPEED EXCEEDS A THRESHOLD # DETERMINED IN GTCHAR. # IF QUIKUP IS TRUE, A FULL SCREEN UPDATE OCCURS EVERY 1/2 SECOND; # AT SLOWER SPEEDS, 1/2 THE SCREEN IS UPDATED EVERY SECOND ON THE # HALF SECOND, THE OTHER 1/2 IS UPDATED EVERY SECOND ON THE SECOND. # THIS ALLOWS ENJOYABLE GAMES ON TERMINALS AS SLOW AS 1200 BAUD. # CALL GTCHAR(QUIKUP) # GET QUIKUP, INITIALIZE TERMINAL IO WRITE(5,1001) 1001 FORMAT('0WELCOME TO MULTI-TREK.') REPEAT [ WRITE(5,1011) 1011 FORMAT('0 CURRENT VESSEL STATUS IS:', //T11,'Name',T24,'Score'/) DO I=1,8 [ IF ( !SHPACT(I) & (CREW(I)<=400) ) [ WRITE(5,1021) I, (SHPNAM(J,I),J=1,10), SCORE(I), ' EMPTY' 1021 FORMAT(' Ship ',I1,2X,10A1,2X,F8.0,A) ] ELSE [ WRITE(5,1021) I, (SHPNAM(J,I),J=1,10), SCORE(I), '*IN USE' ] ] WRITE(5,1031) 1031 FORMAT(//'$ENTER THE NUMBER OF THE VESSEL YOU WISH TO COMMAND: ') CALL GETINT(0,IW,OK,1,8,0) IF (OK) [ IF (IW == 0) [ OK = .FALSE. NEXT ] ME=IW #OUR SHIP NUMBER IF ( SHPACT(ME) | (CREW(ME)>400) ) [ WRITE(5,1041) 1041 FORMAT('0THIS SHIP ALREADY HAS A COMMANDER.') WRITE(5,1051) 1051 FORMAT('$DO YOU WISH TO SHARE THIS COMMAND? ') CALL YESNO(0,OK) ] ELSE [ WRITE(5,1055) 1055 FORMAT(/'$WHAT DO YOU CHRISTEN YOUR SHIP? (10 CHARS MAX) > ') READ(5,1056) NCH, NAME 1056 FORMAT(Q,10A1) IF ( NCH > 0 ) [ # RENAME SHIP & CLEAR SCORE DO I = 1, 10 SHPNAM(I,ME) = NAME(I) SCORE(ME) = 0.0 ] ] ] ELSE CALL EXIT ] UNTIL (OK) REFRES = .TRUE. REFTOG = .FALSE. CREW(ME)=CREW(ME)+1 DEFSHP = ME CALL STRMOV(BLUNK2,1,361,OBUFF,1) CALL RBUFF IF (!QUIKUP) CALL MARK(3,60,1,IDS) # START 1 SECOND TIMER IF SLOW UPDATE CALL MARK(2,30,1,IDS) # START 1/2 SECOND TIMER REPEAT [ # # THE FOLLOWING CALL SPAWNS THE MTREKD UNIVERSE MANAGER TASK ON TT0:. # IF YOU CANNOT DO SOMETHING SIMILAR, YOU MUST START MTREKD YOURSELF # BEFORE PLAYING EACH GAME. # IF (THRU) [ # THEN MTREKD ISN'T RUNNING CALL RUNMTR ] # # PLACE LOCAL SCAN ON TERMINAL # REFTOG = (!REFTOG) | QUIKUP IF ((SHPACT(ME) & REFTOG) | REFRES) [ # DON'T REFRESH IF BLOWN UP! CALL SRSCAN( ME ) ] # # THE FOLLOWING WAIT CONTROLS THE UPDATE RATE, WHICH IS NORMALLY # SET TO A HALF SECOND (30 CLOCK TICKS). # IF (COMMND != ' ' & SHPACT(ME)) [ IF (REFTOG) [ CALL WAITFR(2,IDS) IF (QUIKUP) CALL MARK(2,30,1,IDS) # RESTART 1/2 SECOND TIMER ] ELSE [ CALL WAITFR(3,IDS) CALL MARK(3,60,1,IDS) # RESTART 1 SECOND TIMER CALL MARK(2,30,1,IDS) # RESTART 1/2 SECOND TIMER ] ] REPEAT [ IF (!SHPACT(ME)) BREAK NC=1 CALL TREAD(COMMND,NC) #SEE IF ANY COMMANDS TYPED IF (NC > 0) CALL XQTCMD( COMMND, ME, DONE ) ] UNTIL (NC==0) IF ((SHPACT(ME) & REFTOG) | REFRES) [ CALL REFRSH(ME) ] IF (REFRES) [ SHPACT(ME) = .TRUE. REFRES = .FALSE. REFTOG = .FALSE. ] # WRITE OUT MESSAGES FROM DRIVER CALL DRVMSG( ME, DONE ) # WRITE OUT MESSAGES FROM OTHER PLAYERS IF (MESSAG(ME*60-59) != ' ') [ CALL TPOS(24,1) DEFINE(BELL,7) #ASCII BELL CHARACTER CALL OUTCH( BELL, 1 ) CALL OUTCH('MESSAGE FROM ', 13) MIND = ME*60-59 CALL OUTCH(MESSAG(MIND), 1) CALL OUTCH(': ', 2) CALL OUTCH(MESSAG(MIND+1), 59) CALL FLUSH( 0 ) CALL STRMOV(BLANK,1,60,MESSAG,MIND) ] # DISPLAY LOW ENERGY WARNING IF ((ENERGY(ME) < 900.) & WARN) [ CALL MESSGE('ENERGY LOW!') WARN=.FALSE. ] ELSE [ WARN=.TRUE. ] CALL MESSGE(0) #FLUSH OUT MESSAGES ] UNTIL (DONE) # PILOT ABANDONED SHIP CREW(ME)=CREW(ME)-1 IF (CREW(ME) <= 400) [ SHPACT(ME) = .FALSE. ] ELSE [ SHPACT(ME) = .TRUE. ] CALL CLEAR CALL FLUSH( 0 ) CALL EXIT END SUBROUTINE GETREL(PROMPT,V,EXIST,LOW,HIGH,DEFVAL) LOGICAL*1 EXIST,OK REAL V,LOW,HIGH,DEFVAL BYTE INPUT(15) INTEGER NCHRS EXIST=.FALSE. CALL REDPMT(PROMPT,INPUT,15,NCHRS) IF (NCHRS == 0) [ V = DEFVAL EXIST=.TRUE. ] ELSE IF (NCHRS < 0) [ EXIST = .FALSE. ] ELSE IF (NCHRS <= 15) [ DECODE(NCHRS,1001,INPUT,ERR=201) V 1001 FORMAT(G15.0) IF (V >= LOW & V <= HIGH) [ EXIST=.TRUE. ] ELSE [ 201 CONTINUE CALL MESSGE('?! RANGE ERROR !?') ] ] RETURN END SUBROUTINE BUFFIL(IY,IX,ST,L) BYTE ST(1) CALL TPOS(IY, IX) CALL OUTCH(ST,L) RETURN END SUBROUTINE GETINT(PROMPT,N,FLAG,LOW,HIGH,DEFVAL) INTEGER N,LOW,HIGH,DEFVAL LOGICAL*1 OK,FLAG BYTE INPUT(15) FLAG=.FALSE. CALL REDPMT(PROMPT,INPUT,15,NCHRS) IF (NCHRS < 0) [ FLAG=.FALSE. ] ELSE IF (NCHRS == 0) [ FLAG = .TRUE. N = DEFVAL ] ELSE [ DECODE(NCHRS,1011,INPUT,ERR=201) N 1011 FORMAT(I5) IF ((N >= LOW) & (N <= HIGH)) [ FLAG=.TRUE. ] ELSE [ 201 CONTINUE CALL MESSGE('?! RANGE ERROR !?') ] ] RETURN END SUBROUTINE REDPMT(PROMPT,INPUT,NINPUT,NCHRS) # # DO A READ WITHOUT PROMPT AND WITHOUT ECHO; IF NO INPUT IS RECEIVED AFTER 1/2 # SECOND, ISSUE THE PROMPT, THEN READ WITH NO TIMEOUT AND WITH ECHO. # IF A PROMPT IS ISSUED, IT AND THE INPUT IS ERASED TO BLANKS AFTER # THE READ. # # THIS ROUTINE COULD DO A SIMPLE PROMPT AND READ AFTER POSITIONING # TO (PRMPTY, PRMPTX), FOLLOWED BY ERASING THE PROMPT AND INPUT # TO BLANKS, IF NECCESSARY ON YOUR SYSTEM. # IMPLICIT INTEGER (A - Z) PARAMETER MAXPRM = 20 PARAMETER PRMPTY = 18, PRMPTX = 1, PRMPTL = 24, CR = 13 BYTE PROMPT(1), INPUT(NINPUT), BLANKS(PRMPTL) LOGICAL ECHO DATA BLANKS/PRMPTL*' '/ NCHRS = 0 ECHO = .TRUE. IF (PROMPT(1) != 0) [ # IF PROMPT IS NOT NULL... CALL INCHAR(INPUT,NINPUT,.FALSE.,0,NC,IERR) # GET TYPE AHEAD IF (IERR == -1) # EOF? GO TO 999 NCHRS = NCHRS+NC IF (IERR == CR) RETURN # DONE? CALL WAIT(30,0,DSW) # WAIT 1/2 SEC, THEN READ AGAIN CALL INCHAR(INPUT(NCHRS+1),NINPUT-NCHRS,.FALSE.,0,NC,IERR) IF (IERR == -1) # EOF? GO TO 999 NCHRS = NCHRS+NC IF (IERR == CR) RETURN # DONE? IF (NCHRS == 0) [ # THEN ISSUE PROMPT FOR (LEN = 1; LEN <= MAXPRM & PROMPT(LEN) != 0; LEN = LEN+1) ; CALL TPOS(PRMPTY, PRMPTX) CALL OUTCH(PROMPT,LEN-1) ] ELSE ECHO = .FALSE. ] CALL INCHAR(INPUT(NCHRS+1),NINPUT-NCHRS,ECHO,-1,NC,IERR) # FINAL READ IF (PROMPT(1) != 0 & NCHRS == 0) [ # THEN ERASE PROMPT STRNG CALL TPOS(PRMPTY, PRMPTX) CALL OUTCH(BLANKS,PRMPTL) ] IF (IERR == -1) # EOF? GO TO 999 NCHRS = NCHRS+NC RETURN 999 CONTINUE NCHRS = -1 RETURN END DEFINE(CR,13) SUBROUTINE YESNO(PROMPT,FLAG) LOGICAL*1 FLAG,OK BYTE PROMPT(1) BYTE ANSWER(4) # OK=.FALSE. ANSWER(1) = 0 CALL REDPMT(PROMPT,ANSWER,4,NCHRS) REPEAT [ IF (NCHRS <= 0) [ NCHRS = 1 ANSWER(1) = 0 ] IF (ANSWER(1) >= 'a' & ANSWER(1) <= 'z') ANSWER(1) = (ANSWER(1) - 'a') + 'A' # * CHECK FOR YES IF (ANSWER(1) == 'Y') [ FLAG=.TRUE. OK=.TRUE. ] # * CHECK FOR A NO ELSE IF (ANSWER(1) == 'N') [ FLAG=.FALSE. OK=.TRUE. ] # * INCORRECT RESPONSE ELSE [ IF (PROMPT(1) == 0) [ CALL OUTCH(CR, 1) CALL OUTSTR(.TRUE., 'ANSWER YES OR NO? ', .FALSE.) CALL INCHAR(ANSWER, 4, .TRUE., -1, NCHRS, IER) ] ELSE [ CALL REDPMT('ANSWER YES OR NO? ',ANSWER,4,NCHRS) ] ] ] UNTIL (OK) RETURN END DEFINE(LF,10) SUBROUTINE OUTSTR(LFFLAG, STRNG, CRFLAG) LOGICAL LFFLAG, CRFLAG BYTE STRNG(1) FOR (LEN = 0; STRNG(LEN+1) != 0; LEN = LEN+1) ; IF (LFFLAG) CALL OUTCH(LF, 1) CALL OUTCH(STRNG, LEN) IF (CRFLAG) CALL OUTCH(0, -1) ELSE CALL OUTCH(0, 0) RETURN END # CLKDIR - CONVERT DIRECTION IN DEGREES (0-360) TO CLOCK FACE (0-12) REAL FUNCTION CLKDIR( DEGR ) CLOCK = (90.0-DEGR)*(1/30.0) IF ( CLOCK < 0.0 ) CLOCK = CLOCK + 12.0 CLKDIR = CLOCK RETURN END # DEGDIR - CONVERT CLOCK FACE DIRECTION (0-12) TO DEGREES (0-360) REAL FUNCTION DEGDIR( CLOCK ) DEGR = (3.0-CLOCK)*30.0 IF ( DEGR < 0.0 ) DEGR = DEGR + 360.0 DEGDIR = DEGR RETURN END