File: RSTRGM.LS of Disk: V50/Source/Source-Listing-FORTRAN-2
(Source file text)
FORTRAN IV V50-A (A6) 24-JUL-20
C SAVE/RESTORE PROCESSOR
C
C WRITTEN BY BOB SUPNIK
C DISK ENGINEERING
C 25-AUG-78
C
C CURRENT LIMITS:
C 750 TRAVEL OPTIONS (TRAVEL, TRVSIZ).
C 300 VOCABULARY WORDS (KTAB, ATAB, TABSIZ).
C 150 LOCATIONS (LTEXT, STEXT, KEY, COND, ABB, ATLOC, LOCSIZ).
C 100 OBJECTS (PLAC, PLACE, FIXD, FIXED, LINK (TWICE), PTEXT, PROP).
C 35 "ACTION" VERBS (ACTSPK, VRBSIZ).
C 205 RANDOM MESSAGES (RTEXT, RTXSIZ).
C 12 DIFFERENT PLAYER CLASSIFICATIONS (CTEXT, CVAL, CLSMAX).
C 20 HINTS, LESS 3 (HINTLC, HINTED, HINTS, HNTSIZ).
C THERE ARE ALSO LIMITS WHICH CANNOT BE EXCEEDED DUE TO THE STRUCTURE OF
C THE DATABASE. (E.G., THE VOCABULARY USES N/1000 TO DETERMINE WORD TYPE,
C SO THERE CAN'T BE MORE THAN 1000 WORDS.) THESE UPPER LIMITS ARE:
C 1000 NON-SYNONYMOUS VOCABULARY WORDS
C 300 LOCATIONS
C 100 OBJECTS
C
0002 SUBROUTINE RSTRGM(F1,F2)
0003 LOGICAL F1
0004 INTEGER F2
C IMPLICIT INTEGER (A-Z)
0005 LOGICAL LMWARN,CLOSNG,PANIC,HINTED,
1 CLOSED,GAVEUP,SCORNG,DSEEN
C
0006 COMMON /VERSN/ VMAJ, VMIN, VEDIT
0007 INTEGER VMAJ, VMIN, VEDIT
0010 COMMON /FILES/ INDXNM, TEXTNM, SAVENM
0011 INTEGER INDXNM(3), TEXTNM(3), SAVENM(3)
0012 COMMON /TXTCOM/ RTEXT,LINES,ASCVAR,TXTLOC,DATA
0013 COMMON /VOCCOM/ KTAB,ATAB,TABSIZ
0014 COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
0015 COMMON /PTXCOM/ PTEXT
0016 COMMON /ABBCOM/ ABB
0017 COMMON /MISCOM/ LINUSE,TRVS,CLSSES,OLDLOC,LOC,CVAL,TK,NEWLOC,
1 KEY,PLAC,FIXD,ACTSPK,COND,HINTS,HNTMAX,PROP,TALLY,TALLY2,
2 HINTLC,CHLOC,CHLOC2,DSEEN,DFLAG,DLOC,DALTLC,KEYS,LAMP,GRATE
0020 COMMON /MISCOM/
3 CAGE,ROD,ROD2,STEPS,BIRD,DOOR,PILLOW,SNAKE,FISSUR,TABLET,
4 CLAM,OYSTER,MAGZIN,DWARF,KNIFE,FOOD,BOTTLE,WATER,OIL,PLANT,
5 PLANT2,AXE,MIRROR,DRAGON,CHASM,TROLL,TROLL2,BEAR,MESSAG,VEND,
6 BATTER,NUGGET,COINS,CHEST,EGGS,TRIDNT,VASE,EMRALD,PYRAM
0021 COMMON /MISCOM/
7 PEARL,RUG,CHAIN,BACK,LOOK,CAVE,NULL,ENTRNC,DPRSSN,SAY,LOCK,
8 THROW,FIND,INVENT,TURNS,LMWARN,KNFLOC,DETAIL,ABBNUM,
9 NUMDIE,MAXDIE,DKILL,FOOBAR,BONUS,CLOCK1,CLOCK2,
1 CLOSNG,PANIC,CLOSED,GAVEUP,SCORNG,ODLOC,STREAM,SPICES
0022 COMMON /MISC2/ I,RTXSIZ,CLSMAX,LOCSIZ,CTEXT,STEXT,LTEXT,
1 SECT,TRAVEL,TRVCON,TRVLOC,TRVSIZ,TABNDX,OBJ,J,K,VERB,HNTSIZ,
2 MAXTRS,HINTED,HNTLOC,KK
0023 COMMON /MISC3/ATTACK,DTOTAL,OLDLC2,LIMIT,MXSCOR,SCORE,
FORTRAN IV V50-A (A6) 24-JUL-20
1 STICK,WZDARK
C
0024 INTEGER LINES(12),DATA(78)
C The TRAVEL, TRVCON, and TRVLOC arrays are
C Packed with words 0,1,2 holding the data. Saves lots
C of wasted space at the expense of some complexity.
0025 INTEGER TRAVEL(250), TRVCON(250), TRVLOC(250), TRVSIZ
0026 INTEGER KTAB(300),ATAB(300),TABSIZ
0027 INTEGER LTEXT(150),STEXT(150),KEY(150),COND(150),ABB(150),
1 ATLOC(150)
0030 INTEGER PLAC(100),PLACE(100),FIXD(100),FIXED(100),LINK(200),
1 PTEXT(100),PROP(100),HOLDNG
0031 INTEGER ACTSPK(35)
0032 INTEGER RTEXT(205)
0033 INTEGER CTEXT(12),CVAL(12)
0034 INTEGER HINTLC(20),HINTS(20,4)
0035 DIMENSION HINTED(20)
0036 INTEGER TK(20),DLOC(6),ODLOC(6)
0037 DIMENSION DSEEN(6)
0040 INTEGER ASCVAR, TXTLOC, TRVS, CLSSES, OLDLOC
0041 INTEGER HNTSIZ, HNTMAX, TALLY, TALLY2, CHLOC, CHLOC2, DFLAG
0042 INTEGER DALTLC,GRATE,CAGE,ROD,ROD2,STEPS,BIRD,DOOR,PILLOW,SNAKE
0043 INTEGER FISSUR,TABLET,CLAM,OYSTER,MAGZIN,DWARF,KNIFE,FOOD,BOTTLE
0044 INTEGER WATER,OIL,PLANT,PLANT2,AXE,MIRROR,DRAGON,CHASM,EMRALD
0045 INTEGER BEAR,MESSAG,VEND,BATTER,COINS,CHEST,EGGS,TRIDNT,VASE
0046 INTEGER PYRAM,PEARL,RUG,CHAIN,BACK,LOOK,CAVE,NULL,ENTRNC,DPRSSN
0047 INTEGER LOCK,THROW,FIND,INVENT,TURNS,KNFLOC,DETAIL,ABBNUM,SAY
0050 INTEGER NUMDIE,MAXDIE,DKILL,FOOBAR,BONUS,CLOCK1,CLOCK2
0051 INTEGER TROLL,TROLL2,STREAM,SPICES
0052 INTEGER RTXSIZ,CLSMAX,LOCSIZ,SECT,TABNDX,OBJ
0053 INTEGER VERB,HNTLOC,KK
0054 INTEGER ATTACK,DTOTAL,OLDLC2,LIMIT,MXSCOR,SCORE,STICK,WZDARK
C
C USR call - FORTRAN unit, filename, operation, error flag
C Operation is 2, open input; 3 open output; 4 close output.
C Calling "CLOSE" on an input file causes it to be deleted!
C
0055 IF (.NOT. F1) GOTO 10
C
C Attempt to restore saved database
C
0056 CALL USR(7, SAVENM, 2, IERR)
0057 IF (IERR.NE.0) GOTO 60
0060 GOTO 20
C
C Attempt to restore initial database
C
0061 10 CALL USR(7, INDXNM, 2, IERR)
0062 IF (IERR.EQ.0) GOTO 20
0063 F2=-1
0064 RETURN
C
0065 20 READ(7) I1,I2,I3
0066 IF((I1.NE.VMAJ).OR.(I2.NE.VMIN)) GO TO 50
0067 READ(7) RTEXT,KTAB,ATAB
FORTRAN IV V50-A (A6) 24-JUL-20
0070 READ(7) ATLOC,LINK,PLACE,FIXED,HOLDNG
0071 READ(7) PTEXT,ABB,LINUSE,TRVS,CLSSES
0072 READ(7) OLDLOC,LOC,CVAL,NEWLOC,KEY
0073 READ(7) PLAC,FIXD,ACTSPK,COND,HINTS
0074 READ(7) HNTMAX,PROP,TALLY,TALLY2,HINTLC
0075 READ(7) CHLOC,CHLOC2,DSEEN,DFLAG,DLOC,DALTLC
0076 READ(7) TURNS,LMWARN,KNFLOC,DETAIL,ABBNUM
0077 READ(7) NUMDIE,MAXDIE,DKILL,FOOBAR,BONUS
0100 READ(7) CLOCK1,CLOCK2,CLOSNG,PANIC,CLOSED
0101 READ(7) GAVEUP,SCORNG,ODLOC,CTEXT,STEXT,LTEXT
0102 READ(7) TRAVEL,TRVCON,TRVLOC,MAXTRS,HINTED,HNTLOC
0103 READ(7) ATTACK,DTOTAL,OLDLC2,LIMIT,MXSCOR,SCORE,STICK,WZDARK
C
C CLOSNG = 0
0104 IF(F1) CALL SIXOUT('R]ESTORED.@',5,0)
0105 F2=0
0106 RETURN
0107 50 IF(F1) CALL SIXOUT('F]ILE IS OBSOLETE, [RESTORE] FAILS.',18,0)
0110 F2=-1
0111 RETURN
0112 60 CALL SIXOUT('C]AN''T OPEN SAVE FILE, [RESTORE] FAILS.', 22, 0)
0113 F2=-1
0114 RETURN
0115 END