Source:Special Log

From Eamon Wiki
Jump to navigation Jump to search
This page is a verbatim reproduction of original source material and should not be edited except for maintenance.
Description

The Applesoft BASIC source code of the Eamon utility program Special Log.

Source

Eamon Utilities I

Date

c. 1984

Author

John Nelson

License

The use of this item is permitted on the grounds that it's free or in the public domain.

1  REM      EAMON ADVENTURE LOG
2  REM           MAINTENANCE
3  REM 
4  REM       BY JOHN NELSON
5  REM 
6  REM 
7  REM 
10 D$ =  CHR$ (4): TEXT : GOSUB 10000
20  HOME : PRINT  SPC( 10);"EAMON ADVENTURE LOG": PRINT  SPC( 11);"BY JOHN C. NELSON": VTAB 8: PRINT "SELECT ACTION:"
30  PRINT "  1. PRINT LIST": PRINT "  2. DISPLAY LIST": PRINT "  3. CHANGE RECORD"
70  PRINT "  4. ADD RECORD": PRINT "  5. DELETE ADVENTURE": PRINT "  6. PRINT LABELS": PRINT "  7. QUIT": PRINT "INPUT YOUR CHOICE (1-7):";
80  GET A$: IF A$ < "1" OR A$ > "7" THEN 80
90  PRINT : ON  VAL (A$) GOTO 1000,2000,3000,4000,6000,7000,5000
700  REM  >>>> WRITE RECORD
710  PRINT D$"WRITE ";FI$;",R";A: PRINT AN$(A)
720  IF RS$ = "S" THEN  PRINT DS$(A)
780  PRINT DN$(A): PRINT ST$(A): PRINT D$
790  RETURN 
800  REM  >>>> WRITE RECORD 0
810  PRINT D$"WRITE ";FI$;",R0": PRINT NA
820  RETURN 
999  PRINT : PRINT "PRESS ANY KEY TO CONTINUE";: GET A$: PRINT : RETURN 
1000  REM  >>>> PRINT LIST
1010  INPUT "ALL OR PRODUCTION ONLY (A OR P):";A$: IF A$ <  > "A" AND A$ <  > "P" THEN 1010
1020  PRINT D$"PR#1": FOR A = 1 TO NA: IF A$ = "A" OR ST$(A) = "PROD" THEN  GOSUB 1100
1080  NEXT 
1090  PRINT D$"PR#0": GOSUB 999: GOTO 20
1100  REM  >>> PRINT LINE
1110  PRINT A". "AN$(A); SPC( 57 -  LEN (AN$(A)) -  LEN (DN$(A)) -  LEN ( STR$ (A)));DN$(A); SPC( 10 -  LEN (ST$(A)));ST$(A)
1190  RETURN 
2000  REM  /// DISPLAY LIST
2010 PC = 0: HOME : FOR A = 1 TO NA: PRINT A;". ";AN$(A); SPC( 29 -  LEN (AN$(A)));ST$(A): GOSUB 2500: NEXT 
2020  GOSUB 999:PC = 0: GOTO 20
2500 PC = PC + 1: IF PC > 20 THEN  GOSUB 999:PC = 0: HOME : RETURN 
2510  RETURN 
3000  REM  >>>> CHANGE ROUTINE
3010  INPUT "ADVENTURE #:";A
3020  IF A <  >  INT (A) OR A > NA OR A < 1 THEN 3010
3030  PRINT AN$(A);" ": PRINT "BY ";DN$(A): PRINT "STATUS:";ST$(A): PRINT 
3040  PRINT "INPUT FIELD TO CHANGE:": PRINT "  1. ADVENTURE NAME": PRINT "  2. AUTHOR NAME": PRINT "  3. STATUS": PRINT "INPUT YOUR CHOICE (1-3):";
3050  GET A$: IF A$ < "1" OR A$ > "3" THEN 3050
3060  PRINT : ON  VAL (A$) GOTO 3070,3080,3090
3070  INPUT "NEW ADVENTURE NAME:";AN$(A): GOTO 3100
3080  INPUT "NEW AUTHOR NAME:";DN$(A): GOTO 3100
3090  INPUT "NEW STATUS:";ST$(A): GOTO 3100
3100  REM  >>>> CHECK FOR DONE
3110  PRINT "MORE CHANGES FOR THIS RECORD? (Y/N)";
3120  GET A$: IF A$ <  > "Y" AND A$ <  > "N" THEN 3120
3130  PRINT : IF A$ = "Y" THEN 3030
3140  GOSUB 700: GOTO 20
4000  REM  >>>> ADD RECORD
4005 ADD = 1
4010  INPUT "ADVENTURE NAME:";AN$(NA + 1)
4020  INPUT "AUTHOR'S NAME:";DN$(NA + 1)
4030  INPUT "STATUS : ";ST$(NA + 1)
4040 A = NA + 1:NA = NA + 1: GOSUB 700: GOTO 20
5000  REM  >>>> QUIT ROUTINE
5010  IF ADD THEN  PRINT D$"WRITE ";FI$;",R0": PRINT NA: PRINT D$"CLOSE": END 
5020  PRINT D$"CLOSE": END 
6000  REM  /// DELETE ADVENTURE
6010  INPUT "ADVENTURE # TO DELETE:";A$:A =  VAL (A$): IF A < 1 OR A > NADV THEN 6010
6020  IF ST$(A) = "PROD" THEN  PRINT "CANNOT DELETE A PRODUCTION ADVENTURE.": GOSUB 999: GOTO 20
6030  IF ST$(A) = "TEST" THEN  PRINT "ARE YOU SURE YOU WANT TO DELETE ": PRINT AN$(A);"?": INPUT "INPUT (Y OR N):";A$: IF A$ = "N" THEN 20
6040 AN$(A) = "(OPEN)":ST$(A) = "NONE":DN$(A) = "(NOBODY)": GOSUB 700: GOTO 20
7000  REM  /// PRINT LABELS
7010  PRINT : PRINT "SELECT LABELS FOR:": PRINT "  1. ALL ADVENTURES PRINTED": PRINT "  2. RANGE OF ADVENTURES": PRINT "  3. SINGLE ADVENTURE"
7020  GET A$: IF A$ < "1" OR A$ > "3" THEN 7020
7025  INPUT "HOW MANY LABELS (DEFAULT = 1):";N$:N =  VAL (N$): IF N = 0 THEN N = 1
7030  PRINT : IF  VAL (A$) = 1 THEN B = 1:E = NA: GOTO 7500
7040  ON  VAL (A$) - 1 GOTO 7100,7200
7100  REM   /// RANGE LABELS
7110  INPUT "INPUT RANGE AS BB-EE:";A$:B =  VAL (A$):E =  VAL ( MID$ (A$, LEN ( STR$ (B)) + 2)): IF B < 1 OR B > NA OR B > E THEN 7110
7120  IF E > NA OR E < 2 OR B = E THEN 7110
7130  GOTO 7500
7200  REM  /// SINGLE LABELS
7210  INPUT "ADVENTURE #:";A$:A =  VAL (A$): PRINT D$"PR#1": GOSUB 7800: PRINT D$"PR#0": GOTO 20
7500  PRINT D$"PR#1": FOR A = B TO E: GOSUB 7800: NEXT : PRINT D$"PR#0": GOTO 20
7800  REM  /// PRINT LABEL
7805  FOR X = 1 TO N
7808  IF RS$ = "S" THEN  PRINT  CHR$ (15); SPC( 18);"SPECIAL EAMON DISKETTE": PRINT 
7810  IF RS$ = "R" THEN  PRINT  CHR$ (15); SPC( 22);"ADVENTURE #";A: PRINT 
7820  PRINT  CHR$ (14); CHR$ (27); CHR$ (71); SPC( (29 -  LEN (AN$(A))) / 2);AN$(A)
7830  PRINT  CHR$ (27); CHR$ (72); CHR$ (20);" "
7840  PRINT "COPYRIGHT (C) 1981 BY ";DN$(A);" * DOS 3.3": PRINT  CHR$ (18);""
7850  NEXT X: RETURN 
10000  REM  >>>> PUT FILE INTO TABLE
10010  HOME : PRINT : PRINT : PRINT "SPECIAL DISKETTES OR REGULAR ADVENTURES?": INPUT "(R OR S) - DEFAULT = R:";RS$
10020  IF  LEFT$ (RS$,1) <  > "R" AND  LEFT$ (RS$,1) <  > "S" THEN RS$ = "R"
10030 L = 0:FI$ = "EAMON.ADVLOG": IF  LEFT$ (RS$,1) = "S" THEN L = 64:FI$ = "EAMON.SPECLOG"
10410  PRINT D$"OPEN ";FI$;",L";L + 64: PRINT D$" READ ";FI$;",R0": INPUT NA
10460  IF RS$ = "S" THEN  DIM DS$(50)
10470  DIM AN$(50),DN$(50),ST$(50)
10480  FOR A = 1 TO NA: PRINT D$"READ ";FIL$;",R";A: INPUT AN$(A): IF RS$ = "S" THEN  INPUT DS$(A)
10490  INPUT DN$(A): INPUT ST$(A): NEXT : PRINT D$
10500  RETURN 
20000 D$ =  CHR$ (4): TEXT 
20010  PRINT D$"OPEN ";FI$;",L64": PRINT D$"WRITE ";FI$;",R0": PRINT 1
20020  PRINT D$"WRITE ";FI$;",R1": PRINT "MAIN HALL AND BEGINNER'S CAVE": PRINT "DONALD BROWN": PRINT "PROD": PRINT D$"CLOSE"
30000 D$ =  CHR$ (4): PRINT D$"OPEN EAMON.SPECLOG,L64": PRINT D$"WRITE EAMON.SPECLOG,R1": PRINT "MASTER DISKETTE": PRINT "MAIN HALL & BEGINNER'S CAVE": PRINT "DONALD BROWN": PRINT "PROD": PRINT D$"WRITE EAMON.SPECLOG,R0": PRINT 1: PRINT D$"CLOSE