File: SAVEGM.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 SAVEGM(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 SAY,LOCK,THROW,FIND,INVENT,TURNS,KNFLOC,DETAIL,ABBNUM
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
0055 IF (F1) GOTO 10
C
C Normal setup, open AINDX.DA for output
C
0056 CALL USR(7,INDXNM,3,IERR)
0057 IF (IERR .EQ. 0) GO TO 20
0060 CALL SIXOUT('C]AN''T OPEN ',6,2)
0061 CALL SIXOUT(INDXNM, 9, 3)
0062 CALL SIXOUT(' ]FOR OUTPUT',6,1)
0063 F2 = -1
0064 RETURN
C
C Saving game
C
0065 10 CALL USR(7,SAVENM,3,IERR)
0066 IF (IERR.EQ.0) GOTO 20
0067 CALL SIXOUT('C]AN''T OPEN ',6,2)
0070 CALL SIXOUT(SAVENM,9,3)
0071 CALL SIXOUT(' ]FOR OUTPUT',6,1)
0072 F2 = -1
0073 RETURN
C
FORTRAN IV V50-A (A6) 24-JUL-20
0074 20 WRITE(7) VMAJ,VMIN,VEDIT
0075 WRITE(7) RTEXT,KTAB,ATAB
0076 WRITE(7) ATLOC,LINK,PLACE,FIXED,HOLDNG
0077 WRITE(7) PTEXT,ABB,LINUSE,TRVS,CLSSES
0100 WRITE(7) OLDLOC,LOC,CVAL,NEWLOC,KEY
0101 WRITE(7) PLAC,FIXD,ACTSPK,COND,HINTS
0102 WRITE(7) HNTMAX,PROP,TALLY,TALLY2,HINTLC
0103 WRITE(7) CHLOC,CHLOC2,DSEEN,DFLAG,DLOC,DALTLC
0104 WRITE(7) TURNS,LMWARN,KNFLOC,DETAIL,ABBNUM
0105 WRITE(7) NUMDIE,MAXDIE,DKILL,FOOBAR,BONUS
0106 WRITE(7) CLOCK1,CLOCK2,CLOSNG,PANIC,CLOSED
0107 WRITE(7) GAVEUP,SCORNG,ODLOC,CTEXT,STEXT,LTEXT
0110 WRITE(7) TRAVEL,TRVCON,TRVLOC,MAXTRS,HINTED,HNTLOC
0111 WRITE(7) ATTACK,DTOTAL,OLDLC2,LIMIT,MXSCOR,SCORE,STICK,WZDARK
C
0112 IF(F1) CALL SIXOUT('S]AVED.',3, 0)
C
C Close the output file
C
0113 IF(F1) CALL USR(7,SAVENM, 4, IERR)
0114 IF(.NOT.F1) CALL USR(7, INDXNM, 4, IERR)
0115 F2=0
0116 RETURN
0117 END