home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol052 / catalist.bas < prev    next >
BASIC Source File  |  1984-04-29  |  8KB  |  201 lines
  1. 1000 '***************************************************************
  2. 1002 '**                                                           **
  3. 1004 '**     Filename is CATALIST.BAS.  Uses Basic-80 ver. 5.xx    **
  4. 1006 '**     Input is modified output of UCAT.COM (MAST.CAT).      **
  5. 1008 '**     MAST.CAT records of 2 fields are made 4 fields per    **
  6. 1010 '**      record by changing all periods to commas.  This      **
  7. 1012 '**      program accepts only CATALOG or SIGMLOG as valid     **
  8. 1014 '**      disk labels.                                         **
  9. 1016 '**     Written Dec. 13, 1981 by Bill Norris, ( b.p.p.l.).    **
  10. 1018 '**     Version 1.01                                          **
  11. 1020 '***************************************************************
  12.  
  13.  
  14.  
  15. 1021 PRINT : PRINT : PRINT : PRINT : PRINT : PRINT
  16. 1022 PRINT "Program compiled from 'CATALIST.BAS', Version 1.01"
  17. 1024 COMPILE.ID$ = "Written Dec. 13, 1981 by Bill Norris, ( b.p.p.l.)."
  18.  
  19. 1030 GOSUB 2400 : ACTION=SETUP.CONSTANTS
  20. 1040 GOSUB 2200 : ACT=SETUP.VARIABLES
  21. 1050 GOSUB 2000 : ACT=SETUP.FILES
  22.  
  23. 1060 GOSUB 3000 : ACT=G.ET.PAGE.OF.DATA
  24. 1070 GOSUB 4000 : ACT=PRINT.PAGE.OF.DATA
  25.  
  26. 1080 IF JOB=DONE THEN GOTO 9000 ELSE GOTO 1060
  27.  
  28.  
  29.  
  30. 2000 '***** Get Disk Filenames & Open for Processing *****
  31. 2010 X1$="INPUT" : X2$="SCAT" : PRINT : GOSUB 2080 : GOSUB 8150 
  32. 2020 IF NOGO=YES THEN PRINT BEL$;"***** ";FIL$;" not found *****":GOTO 2010
  33. 2030 IFIL$=FIL$
  34. 2040 X1$="OUTPUT": X2$="SLIST": GOSUB 2080 : GOSUB 8150
  35. 2050 IF NOGO=OFF THEN PRINT BEL$;"***** ";FIL$;" already exists *****" :
  36.      PRINT "Type 'y' to accept (old ";FIL$;" will be lost) :"; :
  37.      INPUT " ",X$ : GOSUB 8120
  38. 2060 IF XX$="Y" THEN OFIL$=FIL$ : GOTO 2070 ELSE PRINT : GOTO 2040
  39.  
  40. 2070 OPEN "I",#1,IFIL$ : OPEN "O",#2,OFIL$ : INPUT #1,D1$,D2$,D3$,D4$ : RETURN
  41.  
  42. 2080 PRINT "Default ";X1$;" filename is ";X2$;".  Type <cr> to accept :";:
  43.      INPUT " ",X$ : IF X$=""THEN FIL$=X2$ : RETURN ELSE GOSUB 8000 : RETURN
  44.  
  45.  
  46.  
  47. 2200 '***** Parameter definitions & variable initialization *****
  48.  
  49. 2203 FIL$="CAT.DAT" : GOSUB 8150 : IF NOGO=NO THEN GOTO 2233 ELSE PRINT
  50. 2204 INPUT "Does your terminal have a bell? ",X$ : IF X$="" GOTO 2204
  51. 2205 GOSUB 8120 : IF XXX$="Y" THEN BEL$=CHR$(7)
  52. 2206 PRINT : PRINT "Define output page format:" : PRINT
  53. 2209 INPUT "Type TOP MARGIN, BOTTOM MARGIN : ", TOP.MARGIN,BOT.MARGIN
  54. 2212 INPUT "Type PAGE LENGTH : ", PAGE.LENGTH
  55. 2214 INPUT "Type LEFT MARGIN, RIGHT MARGIN : ", LEFT.MARGIN, RIGHT.MARGIN
  56. 2216 INPUT "Type PAGE WIDTH : ", COLUMNS
  57. 2217 PRINT : INPUT "Force new page with new initial filename letter? ",X$ :
  58.      IF X$="" THEN PRINT BEL$ : GOTO 2217
  59. 2218 GOSUB 8120 : IF XXX$="Y" THEN PAGE.CHEK$="Yes" ELSE PAGE.CHEK$="No"
  60. 2219 BAP$=
  61. "123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456":
  62.      PRINT "Type PAGE HEADER :" : PRINT BAP$ : INPUT "", HEAD.LINE$:
  63.      IF HEAD.LINE$="x" THEN HEAD.LINE$=HLIN$
  64.  
  65. 2221 OPEN "O",#1,FIL$
  66. 2223 WRITE #1, TOP.MARGIN, BOT.MARGIN, PAGE.LENGTH
  67. 2225 WRITE #1, LEFT.MARGIN, RIGHT.MARGIN, COLUMNS
  68. 2227 WRITE #1, BEL$, PAGE.CHEK$
  69. 2228 WRITE #1, HEAD.LINE$
  70. 2230 CLOSE : GOTO 2242
  71.  
  72. 2233 OPEN "I",#1,FIL$
  73. 2235 INPUT #1, TOP.MARGIN, BOT.MARGIN, PAGE.LENGTH
  74. 2237 INPUT #1, LEFT.MARGIN, RIGHT.MARGIN, COLUMNS
  75. 2239 INPUT #1, BEL$, PAGE.CHEK$
  76. 2240 INPUT #1, HEAD.LINE$
  77. 2242 CLOSE : Z=16 : PRINT :
  78.      PRINT "Default Parameters are :"
  79. 2244 PRINT: PRINT "Top Margin =";TAB(Z);TOP.MARGIN:
  80.      PRINT "Bottom Margin =";TAB(Z);BOT.MARGIN:
  81.      PRINT "Page Length =";TAB(Z);PAGE.LENGTH
  82. 2245 PRINT "Left Margin =";TAB(Z);LEFT.MARGIN:
  83.      PRINT  "Right Margin =";TAB(Z); RIGHT.MARGIN:
  84.      PRINT "Page Width =";TAB(Z);COLUMNS
  85. 2246 PRINT : PRINT "Page Header is :" : PRINT HEAD.LINE$
  86. 2247 IF PAGE.CHEK$="Yes" THEN PRINT : PRINT
  87.      "Output list skips page before new initial letter."
  88. 2248 PRINT : INPUT "Type 'y' to accept, 'n' to change : ", X$ :
  89.      IF X$="" THEN PRINT BEL$; : GOTO 2248
  90. 2251 GOSUB 8120 : IF XXX$="N" THEN GOTO 2206
  91. 2254 IF XXX$<>"Y" THEN PRINT BEL$; : GOTO 2242
  92.  
  93. 2257 LPP=PAGE.LENGTH-TOP.MARGIN-BOT.MARGIN
  94. 2260 CPL=COLUMNS-LEFT.MARGIN-RIGHT.MARGIN
  95. 2263 CHARS.PER.FIELD=18 : INTER.COL.GAP$="   |   "
  96. 2266 HL=LEN(HEAD.LINE$)
  97. 2280 CPF=CHARS.PER.FIELD : ICG=LEN(INTER.COL.GAP$) :XX=ICG : STICKS=1 : Y=CPF
  98. 2290 Y=Y+CPF+XX : IF Y<CPL THEN STICKS=STICKS+1 : GOTO 2290
  99. 2300 '***** STICKS = the number of data columns per page *****
  100. 2310 IF STICKS>3 THEN HEAD.OFF$=SPACE$((CPF+ICG)*(STICKS-3)/2)
  101. 2320 '*****     Reserve 2 header lines from LinesPerPage.    *****
  102. 2330 ARAY = (LPP-2)*STICKS
  103. 2340 DIM LINDAT$(555)
  104. 2350 RETURN
  105.  
  106. 2400 NO=0 : YES=-1 : EMPTY=NO : FULL=YES : BEL$="***** ding ***** "
  107. 2410 JOB=NO : DONE=YES '***** JOB = done after input file is exhausted *****
  108. 2416 MAX.DR$="D" : HLIN$=
  109. "Format = filename, extension, disk volume, source (c=CPMUG, s=SIG/M)"
  110. 2420 NEX.LETTER=65 '***** Letter "A" = 65, "B" = 66, etc.
  111. 2430 RETURN
  112.  
  113.  
  114.  
  115. 3000 '***** Get one pageful of data *****
  116. 3010 PAGE=EMPTY : CNT=0
  117. 3020 GOSUB 3500 : IF PAGE=FULL THEN GOTO 3040
  118. 3030 LINS=LINS+1: IF CNT < ARAY THEN GOTO 3020
  119. 3040 PAGES=PAGES+1 : IF CNT < ARAY THEN GOSUB 3100 : RETURN
  120.  
  121. 3100 FOR M=CNT+1 TO ARAY : LINDAT$(M)=SPACE$(CPF) : NEXT M : RETURN
  122.  
  123. 3500 '***** Input data through one line buffer *****
  124. 3510 D5$=D1$ : D6$=D2$ : D7$=D3$ : D8$=D4$
  125. 3520 IF EOF(1) THEN PAGE=FULL : JOB=DONE : GOTO 3550
  126. 3525 INPUT #1, D1$, D2$, D3$, D4$
  127. 3530 IF PAGE.CHEK$<>"Yes" THEN GOTO 3550
  128. 3540 IF ASC(D1$)>=NEX.LETTER THEN PAGE=FULL : NEX.LETTER=ASC(D1$)+1
  129. 3550 CNT=CNT+1 : XX$="" '***** right fill strings with spaces *****
  130. 3560 X$=D5$ : X=8 : GOSUB 6000
  131. 3570 X$="."+D6$ : X=5 : GOSUB 6000
  132. 3580 IF D7$="CATALOG" THEN X7$="c" : GOTO 3640
  133. 3590 IF D7$="SIGMLOG" THEN X7$="s" : GOTO 3640
  134.  
  135. 3600 PRINT : PRINT "***** ERROR IN LINE 3600 *****
  136. 3610 PRINT "Source volume should be CATALOG or SIGMLOG."
  137. 3620 PRINT "Value read in is "; : WRITE D7$ : PRINT BEL$
  138. 3630 STOP
  139.  
  140. 3640 X$=D8$ : X=4 : GOSUB 6000
  141. 3650 LINDAT$(CNT)=XX$+X7$
  142. 3660 RETURN
  143.  
  144. 4000 '***** Print the matrix one page at a time *****
  145.  
  146. 4020 FOR I=1 TO TOP.MARGIN : PRINT #2, " " : NEXT I
  147. 4030 PRINT #2,SPACE$(LEFT.MARGIN);HEAD.OFF$;HEAD.LINE$:PRINT #2, " "
  148. 4033 PRINT "***** on page ";PAGES;
  149. 4050 ' cnt / sticks = printable data lines
  150. 4060 LIN.WRITS=INT((CNT-.001)/STICKS)+1
  151. 4070 ICG$=INTER.COL.GAP$
  152.  
  153. 4080 FOR LOOPS=1 TO LIN.WRITS
  154. 4090     PRINT #2, SPACE$(LEFT.MARGIN); LINDAT$(LOOPS);
  155. 4100     FOR LL=1 TO STICKS-1
  156. 4110         IF LINDAT$(LOOPS+LL*LIN.WRITS)="" THEN GOTO 4120
  157.              ELSE PRINT #2, ICG$;LINDAT$(LOOPS+LL*LIN.WRITS);
  158. 4120         NEXT LL
  159. 4130     PRINT #2, " "
  160. 4140     NEXT LOOPS
  161. 4150 FOR I=1 TO BOT.MARGIN+(LPP-2-LIN.WRITS) : PRINT #2, " " : NEXT I
  162. 4160 PAG.NUM=PAG.NUM+1 : PRINT "*****" : RETURN
  163.  
  164.  
  165.  
  166. 6000 '***** Pad right end of string with spaces *****
  167. 6010 XX$=XX$+X$+SPACE$(X-LEN(X$)) : RETURN
  168.  
  169. 8000 '***** Get a valid CP/M filename *****
  170. 8010 FIL$="" : INPUT "Disk drive used - ",X$ : IF LEN(X$)=0 THEN GOTO 8030
  171. 8020 GOSUB 8120 : FIL$=LEFT$(XX$,1)+":" :
  172.      IF ASC(XX$)<65 OR ASC(XX$)>ASC(MAX.DR$) THEN PRINT :
  173.      PRINT "INVALID DISK DRIVE - RETYPE -" : GOTO 8010
  174. 8030 INPUT "Name of file - ",X$ : IF LEN(X$)=0 THEN GOTO 8030
  175. 8040 GOSUB 8120 : FIL$=FIL$+XX$ : F1$=XX$
  176. 8050 INPUT "File extension ? ",X$ : IF LEN(X$)=0 THEN
  177.      F2$="" : GOTO 8070
  178. 8060 XX$=LEFT$(X$,3) : X$=XX$ : GOSUB 8120 :
  179.      F2$=XX$ : FIL$=FIL$+"."+XX$
  180. 8070 PRINT : PRINT "File selected is ";FIL$
  181. 8080 INPUT "O.K.? ",X$ : IF LEN(X$)=0 THEN X$="Y"
  182. 8090 GOSUB 8120 : IF LEFT$(XX$,1)="N" THEN PRINT "ReType..." : GOTO 8010
  183. 8100 PRINT : RETURN
  184.  
  185. 8110 '***** Make UPPERcase XX$ from x$ *****
  186. 8120 XX$="" : FOR I=1 TO LEN(X$) : Y$=MID$(X$,I,1) : YY$=Y$ :
  187.      IF Y$>="a" THEN YY$=CHR$(ASC(Y$)-32)
  188. 8130 XX$=XX$+YY$ : NEXT I
  189. 8140 XXX$=LEFT$(XX$,1) :  RETURN
  190.  
  191. 8150 '***** Code looks for file on disk. *****
  192. 8160 NOGO=YES : ON ERROR GOTO 8190
  193. 8170 OPEN "I",#1,FIL$ : NOGO=OFF
  194. 8180 CLOSE #1 : ON ERROR GOTO 0 : RETURN
  195. 8190 RESUME 8180
  196.  
  197. 9000 '***** It's a closed shop here... *****
  198. 9010 CLOSE : PRINT : PRINT "Fin" : PRINT
  199. 9020 END
  200.  
  201.