home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
SIMTEL
/
CPMUG
/
CPMUG006.ARK
/
REPORT.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-04-29
|
8KB
|
344 lines
REM CACHE MAILING LIST REPORT PROGRAM
PRINT "REPORT VERSION 0.8"
SPACES$=" "
UP = 3
WIDTH = 38
LENGTH = 6
FILE.NAME$="CACHE.FIL"
FILE.SIZE = 512
INDEX.SIZE = 400
REC.LENG = 128
INDEX.READ = 0 :REM SHOW NO INDEX READ
KB = 1 :REM KEYBOARD INPUT
ABORT = 255 :REM KB VALUE TO ABORT
LF = 138:REM LINEFEED FROM KB
FIELD.COUNT = 10 :REM # FIELDS IN RECORD
FILE FILE.NAME$(REC.LENG),\
FILE.NAME$(REC.LENG),\
FILE.NAME$(REC.LENG),\
FILE.NAME$(REC.LENG)
DIM FIELD.NAME$(FIELD.COUNT)
DIM RECORD$(FIELD.COUNT)
DIM INDEX(INDEX.SIZE)
DIM LINE$(4,4)
TITLE$=CHR$(14)+"CACHE MAILING LIST"
REM READ FIELD NAMES
DATA SORT,NAME,ORGANIZATION,STREET,CITY,ZIP,\
PHONE,COMPUTER,PAID,TYPE
FOR I = 1 TO FIELD.COUNT
READ FIELD.NAME$(I)
NEXT I
REM MAIN PROCESSING LOOP
100 INPUT "COMMAND--->";C$
IF C$="HELP" THEN 200
IF LEFT$(C$,6)="INDEX " THEN 1000
IF LEFT$(C$,9)="POSITION " THEN 1100
IF LEFT$(C$,6)="TITLE " THEN 1300
IF C$="PRINT" THEN 1400
IF LEFT$(C$,6)="WIDTH " THEN 1500
IF LEFT$(C$,7)="LENGTH "THEN 1550
IF C$="TAGS" THEN 1600
IF C$="LABELS" THEN 1600
IF C$="CHECK" THEN 1700
IF LEFT$(C$,3)="UP " THEN 1800
IF C$="END" THEN 9999
199 PRINT "INVALID COMMAND"
GOTO 100
REM HELP
200 PRINT "END TO END EXECUTION"
PRINT "INDEX FN.FT READ INDEX FILE"
PRINT "POSITION FIELD VALUE POSITION VIA FILE SCAN"
PRINT
GOTO 100
REM READ INDEX FILE
1000 INDEX.NAME$=MID$(C$,7,99)
PRINT "READING FILE ";INDEX.NAME$
FILE INDEX.NAME$
IF END #5 THEN 1050
REM CAN'T FOR-NEXT: EOF WOULD EXIT LOOP EARLY
I=1
1010 READ #5;INDEX(I)
IF INP(KB)=ABORT THEN \
PRINT I
I=I+1
GOTO 1010
1050 CLOSE 5
INDEX.COUNT = I-1
PRINT INDEX.COUNT;" INDEX ENTRIES LOADED."
INDEX.READ = 1 :REM SHOW READ
1080 PRINT "POSITIONED TO RECORD 1"
POSITION = 1
GOTO 100
REM POSITION TO PARTICULAR RECORD
1100 X=ASC(MID$(C$,10,1))
IF X > 47 AND X < 58 THEN 1200
GOSUB 8910 :REM EXTRACT FIELD NAME, VALUE
IF INDEX.READ = 0 THEN 8700
X=LEN(FIELD.VALUE$)
1110 IF POSITION > INDEX.COUNT THEN \
PRINT "NOT FOUND":\
GOTO 1080
IF INP(KB)=ABORT THEN 100
KEY = INDEX(POSITION)
GOSUB 8800 :REM READ RECORD
PRINT KEY,RECORD$(FIELD.NO)
IF LEFT$(RECORD$(FIELD.NO),X)=FIELD.VALUE$ THEN \
GOSUB 9000:\
GOTO 100
POSITION = POSITION + 1
GOTO 1110
REM POSITION TO RECORD NUMBER
1200 POSITION = VAL(MID$(C$,10,99))
IF INDEX.READ = 0 THEN 8700
PRINT "POSITIONED TO ";POSITION
IF POSITION < 1 OR POSITION > INDEX.COUNT THEN \
PRINT "INVALID POSITION":\
GOTO 1080
KEY = INDEX(POSITION)
GOSUB 8800
GOSUB 9000
GOTO 100
REM ENTER TITLE
1300 TITLE$=CHR$(14)+MID$(C$,7,99)
GOTO 100
REM PRINT REPORT USING INDEX
1400 PRINT "PRESS LINE FEED TO START"
IF INDEX.READ = 0 THEN 8700
1405 IF INP(KB)<>LF THEN 1405
REM SET UP FIELD TABS
T1=6
T2=T1+25
T3=T2+21
T4=T3+25
IF WIDTH < 80 THEN T4 = 6
T5=T4+21
T6=T5+6
T7=T6+15
T8=T7+6
T9=T8+5
REM PRINT A PAGE
1410 PRINT TITLE$
PRINT
LINE.COUNT = 7
PRINT "SORT";\
TAB(T1);"---------NAME-----------";\
TAB(T2);"----ORGANIZATION----";\
TAB(T3);"---------STREET---------";
IF WIDTH < 80 THEN PRINT:\
LINE.COUNT = LINE.COUNT + 1
PRINT TAB(T4);"---------CITY-------";\
TAB(T5);"-ZIP-";\
TAB(T6);"----PHONE----";\
TAB(T7);"MICRO";\
TAB(T8);"PAID";\
TAB(T9);"T"
PRINT
1420 IF POSITION > INDEX.COUNT THEN 1490
KEY = INDEX(POSITION)
POSITION = POSITION + 1
GOSUB 8800
PRINT SORT$;\
TAB(T1);NAME$;\
TAB(T2);ORGANIZATION$;\
TAB(T3);STREET$;
IF WIDTH < 80 THEN \
PRINT :\
LINE.COUNT = LINE.COUNT + 1
PRINT TAB(T4);CITY$;\
TAB(T5);ZIP$;\
TAB(T6);PHONE$;\
TAB(T7);COM$;\
TAB(T8);PAID$;\
TAB(T9);TYPE$
LINE.COUNT = LINE.COUNT + 1
IF INP(KB)=ABORT THEN 1490
IF LINE.COUNT < 60 THEN 1420
PRINT CHR$(12) :REM EJECT
GOTO 1410
REM WAIT FOR KEY PRESSED OTHER THAN LINEFEED
1490 PRINT
1495 IF INP(KB)=LF THEN 1495
GOTO 100
REM SET REPORT OR LABEL WIDTH
1500 WIDTH = VAL(MID$(C$,7,99))
IF WIDTH > 24 THEN 100
PRINT "WIDTH TOO NARROW - SET TO 25"
WIDTH = 25
GOTO 100
REM SET LABEL LENGTH
1550 LENGTH = VAL (MID$(C$,8,99))
IF LENGTH > 3 THEN 100
PRINT "LENGTH INVALID, SET TO 6"
LENGTH = 6
GOTO 100
REM PRINT LABELS
1600 PRINT "PRESS LINEFEED"
IF INDEX.READ = 0 THEN 8700
1610 IF INP(KB)<>LF THEN 1610
REM READ 'UP' LABELS OR TAGS
1620 IF POSITION > INDEX.COUNT THEN 1690
IF INP(KB)<>LF THEN 1690
FOR I=1 TO UP
1621 IF POSITION > INDEX.COUNT THEN 1650
KEY = INDEX(POSITION)
POSITION = POSITION + 1
GOSUB 8800
IF C$="LABELS" THEN 1630
REM FORMAT NAME TAGS
REM DON'T PRINT FOR GROUPS OR MAGAZINES
IF TYPE$="G" THEN 1621
IF TYPE$="M" THEN 1621
FOR BLANK.POS = LEN(NAME$) TO 1 STEP -1
IF MID$(NAME$,BLANK.POS,1)=" " THEN 1624
1622 NEXT BLANK.POS
GOTO 1628
1624 IF MID$(NAME$+" ",BLANK.POS+1,2)="JR" THEN 1622
IF BLANK.POS<4 THEN 1628
IF MID$(NAME$,BLANK.POS-2,2)="MC" THEN 1622
IF MID$(NAME$,BLANK.POS-3,3)="VAN" THEN 1622
IF MID$(NAME$,BLANK.POS-3,3)=" DE" THEN 1622
IF MID$(NAME$,BLANK.POS-3,3)=" LA" THEN 1622
IF MID$(NAME$,BLANK.POS-3,3)=" DI" THEN 1622
1628 LINE$(I,1)=""
IF BLANK.POS>1 THEN \
LINE$(I,1)=LEFT$(NAME$,BLANK.POS-1)
LINE$(I,2)=MID$(NAME$,BLANK.POS+1,99)
LINE$(I,3)=COM$
IF I=1 AND 0=LEN(COM$) THEN \
LINE$(1,3)="."
LINE$(I,4)=CITY$
GOTO 1640
1630 LINE$(I,1)=LEFT$(NAME$+SPACES$,25)+PAID$
LINE$(I,2)=ORGANIZATION$
LINE$(I,3)=STREET$
LINE$(I,4)=LEFT$(CITY$+SPACES$,24)+ZIP$
1640 NEXT I
REM PRINT THE LABELS
FOR LINE = 1 TO 4
WD=WIDTH
IF LINE < 4 AND C$="TAGS" THEN \
PRINT CHR$(14);:\
WD=.5+WIDTH/2
PRINT LINE$(1,LINE);TAB(WD);
PRINT LINE$(2,LINE);TAB(2*WD);
PRINT LINE$(3,LINE);
IF UP = 4 THEN \
PRINT TAB(3*WD);LINE$(4,LINE);
PRINT
NEXT LINE
IF LENGTH > 4 THEN \
FOR I=4 TO LENGTH-1 :\
PRINT :\
NEXT I
GOTO 1620
REM END OF FILE - PAD W/BLANK FIELDS
1650 NAME$=" "
PAID$=" "
ORGANIZATION$=" "
STREET$=" "
CITY$=" "
ZIP$=" "
GOTO 1630
REM END OF LABELS
1690 PRINT
1695 IF INP(KB)=LF THEN 1695
GOTO 100
REM PRINT CONTENTS OF VARIABLES
1700 PRINT "WIDTH=";WIDTH
PRINT "LENGTH=";LENGTH
PRINT "POSITION=";POSITION
PRINT "INDEX HAS ";
IF INDEX.READ = 0 THEN \
PRINT "NOT ";
PRINT "BEEN READ."
PRINT "INDEX ENTRIES=";INDEX.COUNT
GOTO 100
REM SET 'N' UP LABELS
1800 UP = VAL(MID$(C$,4,99))
GOTO 100
REM ERROR - NO INDEX READ
8700 PRINT "NO INDEX READ"
GOTO 100
REM PHYSICAL READ RECORD # IN KEY
8800 FILE.NO = 1+INT((KEY-1)/128)
READ #FILE.NO,KEY;FLAG
IF FLAG=0 THEN RETURN
READ #FILE.NO,KEY;\
FLAG,\
RECORD$(1),\
RECORD$(2),\
RECORD$(3),\
RECORD$(4),\
RECORD$(5),\
RECORD$(6),\
RECORD$(7),\
RECORD$(8),\
RECORD$(9),\
RECORD$(10)
REM SET VARIABLE NAMES FROM RECORD$(N)
8850 SORT$=RECORD$(1)
NAME$=RECORD$(2)
ORGANIZATION$=RECORD$(3)
STREET$=RECORD$(4)
CITY$=RECORD$(5)
ZIP$=RECORD$(6)
PHONE$=RECORD$(7)
COM$=RECORD$(8)
PAID$=RECORD$(9)
TYPE$=RECORD$(10)
RETURN
REM EXTRACT FIELD NAME, VALUE FROM C$
REM FIND BLANK AFTER COMMAND
8910 FOR I=LEN(C$) TO 1 STEP -1
IF MID$(C$,I,1)=" " THEN \
BLANK.POS = I+1
NEXT I
C$=MID$(C$,BLANK.POS,99)
BLANK.POS = 0
REM FIND BLANK AFTER FIELD NAME
FOR I=LEN(C$) TO 1 STEP -1
IF MID$(C$,I,1)=" " THEN \
BLANK.POS=I-1
NEXT I
IF BLANK.POS=0 THEN 199
FIELD$=LEFT$(C$,BLANK.POS)
FIELD.NO = 0
FOR I=1 TO FIELD.COUNT
IF LEFT$(FIELD.NAME$(I),BLANK.POS)=FIELD$ THEN\
FIELD.NO = I
NEXT I
IF FIELD.NO=0 THEN\
PRINT "NO SUCH FIELD ";FIELD$:\
GOTO 100
FIELD.VALUE$=MID$(C$,BLANK.POS+2,99)
FIELD$=FIELD.NAME$(FIELD.NO)
RETURN
REM RECORD PRINT ROUTINE
9000 PRINT
PRINT "RECORD #";KEY;" ";RECORD$(1) :REM SORT
PRINT RECORD$(2) :REM NAME
PRINT RECORD$(3) :REM ORGANIZATION
PRINT RECORD$(4) :REM STREET
PRINT RECORD$(5);" ";RECORD$(6)
PRINT RECORD$(7);"/";\
RECORD$(8);";";\
RECORD$(9);";";\
RECORD$(10)
PRINT
RETURN
9999 END