home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib41b.dsk / DIR.SAVER.bas < prev    next >
BASIC Source File  |  2023-02-26  |  20KB  |  441 lines

  1. 10  REM ************************
  2. 20  REM * DIRECTORY SAVER      *
  3. 30  REM * by Charles T. Hill   *
  4. 40  REM * Copyright (c) 1991   *
  5. 50  REM * Mindcraft Publ. Corp *
  6. 60  REM * Lincoln, MA 01773    *
  7. 70  REM ************************
  8. 80 :
  9. 90  REM   INITIALIZE VARIABLES
  10. 100  ONERR  GOTO 4180
  11. 110 PD = 0: IF  PEEK(48640) = 76  THEN PD = 1: REM   PRODOS 
  12. 120 D$ =  CHR$(4): PRINT D$;"PR#3":HT = 1403:W = 79:WB = 79:TC = 9:DL = 20
  13. 130  DIM FI$(100),W$(20),DI$(105): IF PD = 0  THEN TC = 3:WB = 29:DL = 18
  14. 140 LB$ = " NAME           TYPE  BLOCKS  MODIFIED": REM   SPACES 1,11,2,2
  15. 150 LB$ = LB$ +"   TIME  CREATED    TIME  ENDFILE SUBTYPE": REM   SPACES 3,2,4,2,1   
  16. 160 LD$ = " NAME                           T BLK": REM   SPACES 1,27,1   
  17. 170 AD$(1) = "AW20-DB":AD$(2) = "AWGS-DB":AD$(3) = "TEXT"
  18. 180 WP(1) = 16:WP(2) = 20:WP(3) = 28:WP(4) = 39:WP(5) = 45
  19. 190 WP(6) = 56:WP(7) = 62:WP(8) = 71:WP(9) = 79
  20. 200 WD(1) = 31:WD(2) = 33:WD(3) = 37
  21. 210 :
  22. 220  REM   GREETING
  23. 230  HOME : PRINT : VTAB 3
  24. 240  PRINT  SPC( 32);"DIRECTORY SAVER"
  25. 250  PRINT  SPC( 31);"by Charles T. Hill": PRINT 
  26. 260  PRINT  SPC( 31);"Copyright (C) 1991"
  27. 270  PRINT  SPC( 27);"Mindcraft Publishing Corp."
  28. 280  PRINT  SPC( 31);"Lincoln, MA  01773"
  29. 290  PRINT : PRINT 
  30. 300  PRINT  SPC( 15);"Directory Saver saves directories as ASCII files,"
  31. 310  PRINT  SPC( 15);"optionally formatted to load into a database"
  32. 320  PRINT  SPC( 15);"in Appleworks 2.0 or 3.0 or in Appleworks GS."
  33. 330  PRINT 
  34. 340  PRINT  SPC( 15);"Use letters or up-down arrows to change lines,"
  35. 350  PRINT  SPC( 15);"right-left arrows for next or previous page."
  36. 360  PRINT  SPC( 15);"RETURN selects subdirectory, ESC backs up or exits."
  37. 370  PRINT  SPC( 15);"TAB changes width, CTRL-S saves directory."
  38. 380  PRINT : PRINT 
  39. 390 :
  40. 400  REM   INPUT PREFIX
  41. 410 LA$ = "": REM   RESET LABELS TO INDICATE DIR NOT READ FOR RESTART
  42. 420  IF PD = 0  THEN 1940: REM   DOS 3.3 disk
  43. 430 SV = 0: REM   RESET FLAG FOR WRITING PRODOS DIRECTORY
  44. 440  PRINT : PRINT  SPC( 8);"PREFIX OR SLOT NUMBER: ";
  45. 450 IS = 1: GOSUB 1310: REM   GET LINE
  46. 460  IF GL$ = ""  OR GL$ =  CHR$(27)  THEN 1880: REM   CHECK FOR END
  47. 470 PS$ = GL$:SN =  VAL(PS$)
  48. 480  IF (SN <1  OR SN >7)  THEN P$ = PS$: GOTO 540: REM   not a slot 
  49. 490  PRINT : PRINT  SPC( 17);"DRIVE NUMBER: ";
  50. 500 IS = 0: GOSUB 1310: REM   GET LINE
  51. 510  IF GL$ =  CHR$(27)  THEN 1880: REM   CHECK FOR END
  52. 520 PD$ = GL$
  53. 530 P$ = ",S" +PS$ +",D" +PD$: REM   CONSTRUCT PATH USING SLOT,DRIVE 
  54. 540  PRINT D$;"PREFIX";P$: REM   ENTER PATH
  55. 550  PRINT D$;"PREFIX": INPUT P$: REM   RETRIEVE FULL PREFIX   
  56. 560 P$ =  LEFT$(P$, LEN(P$) -1): REM   strip trailing slash    
  57. 570 :
  58. 580  REM   OPEN DIRECTORY
  59. 590  IF PD = 0  THEN TF = 0: GOTO 2540: REM      DOS3.3 DISK
  60. 600  VTAB 23: POKE HT,79: PRINT : REM     AVOID BLANK LINE ABOVE   
  61. 610 EOD = 0:FS = 0:PG = 0
  62. 620 X =  FRE(0): REM   CLEAR MEMORY OF OLD VALUES OF CHANGED STRINGS   
  63. 630  PRINT D$;"CLOSE";P$
  64. 640  PRINT D$;"OPEN ";P$;",TDIR"
  65. 650  PRINT D$;"READ";P$: IF FS = 1  THEN 730
  66. 660  INPUT A$: INPUT LA$: INPUT A$: REM   READ HEADER  
  67. 670  IF FS >0  THEN  FOR I = 1 TO FS: INPUT A$: NEXT : GOTO 730
  68. 680 :
  69. 690  REM   READ DIRECTORY FILES
  70. 700  IF PD = 0  THEN 2540: REM   DOS3.3 DISK
  71. 710  IF EOD = 1  THEN  GOTO 850: REM   NO MORE FILES TO DISPLAY 
  72. 720 PG = PG +1: VTAB 23: POKE HT,79: PRINT : REM   AVOID BLANK LINE ABOVE
  73. 730  FOR J = 1 TO DL: REM   NUMBER OF DISPLAY LINES
  74. 740  INPUT FI$(J): REM   READ FILEINFO
  75. 750  IF SV >0  THEN  VTAB 23: POKE HT,75: INVERSE : PRINT FS +J;: NORMAL 
  76. 760  GOSUB 1660: REM   CHECK FOR ESCAPE
  77. 770  IF FI$(J) = ""  THEN  INPUT "";ST$:EOD = 1: GOTO 790: REM   END OF DIR
  78. 780  NEXT 
  79. 790 NL = J -1: REM   NUMBER OF LINES READ
  80. 800  IF SV >0  THEN  VTAB 23: POKE HT,75: INVERSE : PRINT FS +NL;" ";: NORMAL 
  81. 810 OI = 1: REM   RESET DISPLAY LINE
  82. 820  IF SV >0  THEN 3570: REM   WRITE DIRECTORY  
  83. 830 :
  84. 840  REM   SELECT DIRECTORY ENTRY
  85. 850  HOME : PRINT P$: INVERSE : VTAB 2: PRINT  SPC( 1);LB$: NORMAL 
  86. 860 LW$ =  LEFT$(LB$,WB): VTAB 2: POKE HT,0: PRINT  SPC( 1);LW$: REM   PRODOS 
  87. 870 LS$ =  LEFT$(LD$,W): IF PD = 0  THEN  VTAB 4: PRINT  SPC( 1);LS$: REM   DOS3.3
  88. 880  FOR I = 1 TO NL: GOSUB 1110: NEXT : GOSUB 1190:I = OI: GOSUB 1100
  89. 890  IF PD = 1  AND EOD = 1  THEN  VTAB NL +3: IF NL <20  THEN  PRINT 
  90. 900  IF PD = 1  AND EOD = 1  THEN  PRINT ST$
  91. 910  VTAB 1: POKE HT,68: PRINT "PAGE ";PG;: POKE HT,77: PRINT "-->";
  92. 920  IF EOD = 1  THEN  VTAB 1: POKE HT,77: PRINT "<--";
  93. 930  GOSUB 1240: IF K = 13  THEN K = I: GOTO 1540: REM   RETURN
  94. 940  IF K = 9  THEN 2630: REM   AT     TAB
  95. 950  IF K = 19  THEN SV = 1: GOTO 2690: REM   CTRL-S
  96. 960  IF K = 1  THEN SV = 2: GOTO 2690: REM   CTRL-A
  97. 970  IF K = 8  THEN  GOSUB 1110: GOTO 590: REM   LEFT   
  98. 980  IF K = 11  THEN  GOSUB 1110:I = I -1: REM   UP
  99. 990  IF K = 21  THEN  GOSUB 1110: GOTO 700: REM   RIGHT  
  100. 1000  IF K = 10  THEN  GOSUB 1110:I = I +1: REM   DOWN  
  101. 1010  IF K = 27  THEN 1710: REM   ESC -- RESTART
  102. 1020  IF K >96  AND K <123  THEN K = K -32: REM   SMALL LETTERS
  103. 1030  IF K >64  AND K <85  THEN  GOSUB 1110:I = K -64: REM   LETTERS A-T  
  104. 1040  IF I >NL  THEN I = NL
  105. 1050  IF I <1  THEN I = 1
  106. 1060 OI = I
  107. 1070  GOSUB 1100: GOTO 930
  108. 1080 :
  109. 1090  REM   DISPLAY DIRECTORY FILES
  110. 1100  INVERSE 
  111. 1110 V = I +2: IF PD = 0  THEN V = I +4: REM   MAKE ROOM FOR DOS3.3 LABELS
  112. 1120 WI$ =  LEFT$(FI$(I),W)
  113. 1130  VTAB V: POKE HT,1: PRINT WI$;: NORMAL 
  114. 1140  INVERSE :VA = I +64
  115. 1150  VTAB V: POKE HT,0: PRINT  CHR$(VA);
  116. 1160  NORMAL : RETURN 
  117. 1170 :
  118. 1180  REM   DISPLAY INSTRUCTIONS
  119. 1190  VTAB 23: POKE HT,0: INVERSE : PRINT  SPC( 2);"DIRECTORY SAVER:";
  120. 1200  PRINT  SPC( 2);"TAB"; SPC( 2);"CTRL-S"; SPC( 2);"CTRL-A ";
  121. 1210  RETURN 
  122. 1220 :
  123. 1230  REM   GET KEY FROM KEYBOARD
  124. 1240 K =  PEEK(49152): IF K <128  THEN 1240
  125. 1250 K = K -128: POKE 49168,0: RETURN 
  126. 1260 :
  127. 1270  REM   CLEAR LINE
  128. 1280  VTAB 24: POKE HT,0: PRINT  SPC( 79);: RETURN 
  129. 1290 :
  130. 1300  REM   GET LINE FROM KEYBOARD
  131. 1310 V =  PEEK(37) +1:H = 30
  132. 1320 GL$ = ""
  133. 1330  GOSUB 1240: REM   GET KEY
  134. 1340  IF K = 13  THEN  RETURN : REM   RETURN
  135. 1350 LL =  LEN(GL$)
  136. 1360  IF K = 27  THEN 1490: REM   ESC -- BACKUP
  137. 1370  IF K < >8  AND K < >127  THEN 1430: REM   NOT LEFT
  138. 1380 LL = LL -1: REM   LEFT
  139. 1390  IF LL >0  THEN GL$ =  LEFT$(GL$,LL)
  140. 1400  IF LL = 0  THEN GL$ = ""
  141. 1410  VTAB V: POKE HT,H +LL +1: PRINT " ";
  142. 1420  GOTO 1330: REM   GET ANOTHER CHARACTER    
  143. 1430  IF LL = 40  THEN 1330: REM   LIMIT 40 CHARACTERS   
  144. 1440  IF IS = 0  AND K >47  AND K <58  THEN GL$ = GL$ + CHR$(K): REM   #
  145. 1450  IF IS = 1  AND K >31  THEN GL$ = GL$ + CHR$(K): REM   STRING
  146. 1460  VTAB V: POKE HT,H +LL +1
  147. 1470  IF  LEN(GL$) >LL  THEN  PRINT  CHR$(K);
  148. 1480  GOTO 1330: REM   GET NEXT CHARACTER 
  149. 1490  IF LL >0  THEN  VTAB V: POKE HT,H: PRINT  SPC( LL +1): GOTO 1320
  150. 1500 GL$ =  CHR$(27)
  151. 1510  RETURN : REM   escape when blank
  152. 1520 :
  153. 1530  REM   CHECK FILETYPE   
  154. 1540 NM$ =  MID$ (FI$(I),2,16): REM   GET FILENAME 
  155. 1550  FOR J = 1 TO 15: REM   TO STRIP TRAILING BLANKS
  156. 1560  IF  RIGHT$(NM$,1) = " "  THEN NM$ =  LEFT$(NM$, LEN(NM$) -1)
  157. 1570  NEXT J
  158. 1580 FT$ =  MID$ (FI$(I),18,3): REM   get file type   
  159. 1590  IF FT$ = "DIR"  THEN P$ = P$ +"/" +NM$: GOTO 1850: REM   READ NEW DIR
  160. 1600  VTAB 24: POKE HT,0: INVERSE 
  161. 1610  PRINT "Not a subdirectory. Press any key";
  162. 1620  NORMAL : GOSUB 1240
  163. 1630  GOSUB 1280: GOTO 930
  164. 1640 :
  165. 1650  REM   CHECK FOR ESCAPE
  166. 1660 E =  PEEK(49152):E = E -128: POKE 49168,0
  167. 1670  IF E = 27  THEN  POP : GOTO 1710: REM   ESCAPE
  168. 1680  RETURN 
  169. 1690 :
  170. 1700  REM   RESTART
  171. 1710  VTAB 23: POKE HT,78: PRINT D$: REM   FOR DOS3.3
  172. 1720  PRINT D$;"CLOSE": GOSUB 1280
  173. 1730  IF LA$ = ""  THEN 1880: REM   DIRECTORY NOT READ   
  174. 1740 SV = 0: IF PD = 1  THEN DL = 20: REM   RESET FOR READING PRODOS DIR
  175. 1750  VTAB 24: POKE HT,0
  176. 1760  INVERSE : PRINT "DISPLAY PREVIOUS DIRECTORY? <Y>";: NORMAL 
  177. 1770  GOSUB 1240: IF K = 78  OR K = 110  OR K = 27  THEN  GOSUB 1280: GOTO 1880
  178. 1780  IF K < >89  AND K < >121  AND K < >13  THEN 1750
  179. 1790  GOSUB 1280: IF PD = 0  THEN TF = 0: GOTO 2540: REM  CLEAR; DOS 3.3   
  180. 1800 NP$ = P$
  181. 1810 NP$ =  LEFT$(NP$, LEN(NP$) -1): REM   STRIP SUBDIRECTORY NAME
  182. 1820  IF  RIGHT$(NP$,1) < >"/"  THEN 1810
  183. 1830  IF  LEN(NP$) = 1  THEN 1850: REM   WAS ROOT DIRECTORY
  184. 1840 P$ =  LEFT$(NP$, LEN(NP$) -1): REM   STRIP TRAILING SLASH
  185. 1850  VTAB 23: POKE HT,0: PRINT  SPC( 80);
  186. 1860  VTAB 23: POKE HT,0: INVERSE : PRINT "READING DIRECTORY ";P$;
  187. 1870  NORMAL : GOTO 540: REM   RESET PREFIX   
  188. 1880  POKE HT,0: VTAB 24: INVERSE : PRINT "RESTART? <Y> ";: NORMAL 
  189. 1890  NORMAL : GOSUB 1240: IF K = 78  OR K = 110  OR K = 27  THEN  END 
  190. 1900  IF K < >89  AND K < >121  AND K < >13  THEN 1880
  191. 1910  GOTO 230: REM   GREETING     
  192. 1920 :
  193. 1930  REM   INPUT DOS3.3 DISK NAME
  194. 1940  PRINT : PRINT  SPC( 8);
  195. 1950  PRINT "NAME FOR DOS3.3 DISK: ";
  196. 1960 IS = 1: GOSUB 1310:P$ = GL$: REM   GET LINE
  197. 1970  IF P$ = ""  OR P$ =  CHR$(27)  THEN 1880: REM   CHECK FOR END
  198. 1980 :
  199. 1990  REM   CHECK DOS3.3 DRIVE
  200. 2000 DR =  PEEK(43624)
  201. 2010  PRINT 
  202. 2020  POKE HT,8: PRINT "INSERT DISK IN DRIVE 1";
  203. 2030  PRINT " AND PRESS ANY KEY ";
  204. 2040  GOSUB 1240: REM   GET KEY
  205. 2050  PRINT : PRINT 
  206. 2060  IF K = 27  THEN 1880: REM   CHECK FOR END
  207. 2070  IF DR < >1  THEN  PRINT D$: PRINT D$;"VERIFY HELLO,D1": REM   CHANGE DRIVE
  208. 2080  POKE HT,8: PRINT "READING DOS3.3 DIRECTORY": NORMAL 
  209. 2090 :
  210. 2100  REM   LOAD DOSCAT MACHINE LANGUAGE ROUTINES
  211. 2110  RESTORE 
  212. 2120  READ A$,B$: FOR I = 1 TO 49
  213. 2130 A = 16 * ASC( MID$ (A$,I)) + ASC( MID$ (B$,I)) -816
  214. 2140  POKE 767 +I,A: NEXT :P = 47080
  215. 2150  FOR I = 1 TO 5: READ A,B: POKE P +A,B: NEXT 
  216. 2160  DATA   "2>02=062>=8888:::1831;0>:=0<:??<2790=>:0:02>>29=6"
  217. 2170  DATA   "033093003?5546210=8011001059003:9?100<50410930::0"
  218. 2180  DATA   3,0,4,17,8,187,9,180,12,1
  219. 2190 :
  220. 2200  REM   READ DOS3.3 DIRECTORY INFORMATION
  221. 2210 A =  FRE(0):K = 1:P = 47080:NL = 0
  222. 2220  FOR S = 1 TO 15: POKE P +5,16 -S: CALL 768
  223. 2230  FOR J = 0 TO 6:I = 46281 +J *35:T =  PEEK(I -3)
  224. 2240  IF T = 0  THEN K = K -1: GOTO 2480: REM   END OF DIRECTORY     
  225. 2250  IF T = 255  THEN 2470: REM   DELETED FILE
  226. 2260  POKE 1,I/256: POKE 0,I -256 * PEEK(1)
  227. 2270  CALL 775C$: REM   GET FILENAME
  228. 2280 TL =  PEEK(I -1): REM   GET FILETYPE AND LOCK BIT  
  229. 2290 LK$ = " ": IF TL >127  THEN LK$ = "*": REM   LOCK BIT
  230. 2300  IF TL >127  THEN TL = TL -128: REM   STRIP LOCK BIT
  231. 2310 FT$ = " ": IF TL = 0  THEN FT$ = "T": REM   TEXT
  232. 2320  IF TL = 1  THEN FT$ = "I": REM   INTEGER
  233. 2330  IF TL = 2  THEN FT$ = "A": REM   APPLESOFT
  234. 2340  IF TL = 4  THEN FT$ = "B": REM   BINARY
  235. 2350  IF TL = 8  THEN FT$ = "S": REM   TYPE S FILE
  236. 2360  IF TL = 16  THEN FT$ = "R": REM   RELOCATABLE FILE
  237. 2370  IF TL = 32  THEN FT$ = "A": REM   TYPE A FILE
  238. 2380  IF TL = 64  THEN FT$ = "B": REM   TYPE B FILE
  239. 2390 FL =  PEEK(I +30): REM   GET FILE LENGTH
  240. 2400 L$ =  STR$(FL): IF  LEN(L$) = 1  THEN L$ = "00" +L$
  241. 2410  IF  LEN(L$) = 2  THEN L$ = "0" +L$: REM   RIGHT JUSTIFY
  242. 2420 SP = 30 - LEN(C$): REM   FILL-IN SPACES FOR FILENAME
  243. 2430 DI$(K) = LK$ +C$: FOR M = 1 TO SP +1:DI$(K) = DI$(K) +" ": NEXT M
  244. 2440 DI$(K) = DI$(K) +FT$ +" " +L$: REM   PRODOS ORDER
  245. 2450  REM   LK$ + FT$ + " " + L$ + " " + C$ IS STANDARD DOS3.3 FORMAT
  246. 2460 K = K +1
  247. 2470  NEXT : NEXT 
  248. 2480 ND = K: REM   NUMBER OF FILES IN DIRECTORY
  249. 2490 X =  FRE(0): REM   CLEAR OLD STRINGS FROM MEMORY
  250. 2500 TF = 0: REM   RESET TRANSFER COUNTER
  251. 2510 LA$ = "Y": REM   RESET FLAG FOR RESTART
  252. 2520 :
  253. 2530  REM   TRANSFER DOS3.3 DIRECTORY INFORMATION
  254. 2540  IF TF = ND  THEN 850: REM    NO MORE FILES   
  255. 2550  IF TF = 0  THEN EOD = 0:PG = 0
  256. 2560 PG = PG +1:NL = DL: IF (ND -TF) <DL  THEN NL = ND -TF
  257. 2570  FOR J = 1 TO NL
  258. 2580 TF = TF +1:FI$(J) = DI$(TF)
  259. 2590  NEXT J: IF TF = ND  THEN EOD = 1
  260. 2600 OI = 1: GOTO 850: REM   SELECT DIRECTORY FILE
  261. 2610 :
  262. 2620  REM   ROUTINE TO CHANGE WIDTH OF DISPLAY
  263. 2630 TC = TC +1: IF TC = 10  THEN TC = 1
  264. 2640 WB = WP(TC):W = WP(TC): REM   PRODOS LABELS
  265. 2650  IF PD = 0  THEN W = WD(TC): IF TC >3  THEN W = 37: REM   DOS3.3
  266. 2660  GOTO 850: REM   SELECT DIRECTORY ENTRY
  267. 2670 :
  268. 2680  REM   OPEN OUTPUT FILE
  269. 2690  VTAB 23: POKE HT,79: PRINT D$: REM   FOR DOS3.3   
  270. 2700  PRINT D$;"CLOSE"
  271. 2710  VTAB 24: POKE HT,0
  272. 2720  IF SV = 1  THEN  PRINT "SAVE FILE ";
  273. 2730  IF SV = 2  THEN  PRINT "APPEND FILE ";
  274. 2740  IF PD = 1  THEN  PRINT "PATHNAME: ";
  275. 2750  IF PD = 0  THEN  PRINT "NAME [,D2]: ";
  276. 2760 IS = 1: GOSUB 1310:PW$ = GL$: REM   GET LINE
  277. 2770  IF GL$ = ""  OR GL$ =  CHR$(27)  THEN  GOSUB 1280: GOTO 930
  278. 2780  VTAB 23: POKE HT,40: PRINT "OPENING FILE"
  279. 2790 VF = 1: PRINT D$;"VERIFY";PW$:VF = 0: REM   IF ERROR=6 THEN DOESN'T EXIST
  280. 2800  IF SV = 2  THEN 2910: REM   OK IF EXISTS FOR APPEND    
  281. 2810  GOSUB 1280: VTAB 24: POKE HT,0
  282. 2820  PRINT "FILE ";PW$;" ALREADY EXISTS.  DELETE IT? <N> ";
  283. 2830  GOSUB 1240: VTAB 23: POKE HT,78: PRINT D$: REM   PRINT FOR DOS3.3
  284. 2840  IF K = 121  OR K = 89  THEN  PRINT D$;"DELETE";PW$: GOTO 2910
  285. 2850  IF K < >78  AND K < >110  AND K < >27  AND K < >13  THEN 2830
  286. 2860  GOSUB 1280: GOTO 2710: REM   GET NEW PATHNAME 
  287. 2870  IF SV = 1  THEN 2910: REM   OK IF DOESN'T EXIST FOR SAVE
  288. 2880  GOSUB 1280: VTAB 24: POKE HT,0
  289. 2890  PRINT "FILE ";PW$;" DOES NOT EXIST -- PRESS ANY KEY";
  290. 2900  GOSUB 1240: GOSUB 1280: GOTO 2710: REM   GET NEW PATHNAME
  291. 2910  VTAB 23: POKE HT,78: PRINT D$: REM   FOR DOS3.3
  292. 2920  PRINT D$;"OPEN";PW$
  293. 2930 CM$ = "": REM   FOR STRIPPING [,D2]
  294. 2940  IF  LEN(PW$) >3  THEN CM$ =  MID$ (PW$, LEN(PW$) -2,1)
  295. 2950  IF CM$ =  CHR$(44)  THEN PW$ =  LEFT$(PW$, LEN(PW$) -3)
  296. 2960  IF SV = 2  THEN 3080: REM   READ FORMAT FOR APPEND
  297. 2970 :
  298. 2980  REM   GET FORMAT FOR SAVE
  299. 2990  GOSUB 1280: VTAB 24: POKE HT,0
  300. 3000  PRINT "FORMAT:  [1] AW20-DB  [2] AWGS-DB  [3] TEXT  <1>? ";
  301. 3010  GOSUB 1240: IF K = 49  OR K = 13  THEN DB = 1: GOTO 3510
  302. 3020  IF K = 50  THEN DB = 2: GOTO 3510: REM   WRITE OUTPUT
  303. 3030  IF K = 51  THEN DB = 3: GOTO 3510: REM   WRITE OUTPUT
  304. 3040  IF K = 27  THEN  GOSUB 1280: GOTO 930
  305. 3050  GOTO 2990: REM  INCORRECT CHOICE
  306. 3060 :
  307. 3070  REM   READ FORMAT FOR APPEND
  308. 3080  PRINT D$;"READ";PW$
  309. 3090 NI = 0:NR = 0:NN$ = ""
  310. 3100 RA = 1: REM   IF ERROR 5 THEN CHECK IF NR>0
  311. 3110  GET C$: IF C$ =  CHR$(47)  OR C$ =  CHR$(44)  THEN 3160
  312. 3120  GOSUB 1280: VTAB 24: POKE HT,0
  313. 3130  PRINT PW$;" HAS INCORRECT FORMAT -- PRESS ANY KEY";
  314. 3140  VTAB 23: POKE HT,78: PRINT D$: REM   FOR DOS3.3
  315. 3150  PRINT D$;"CLOSE": GOSUB 1240: GOSUB 1280: GOTO 2710
  316. 3160  GET C$: REM   SKIP DIR NAME
  317. 3170  IF C$ < > CHR$(9)  AND C$ < > CHR$(13)  THEN 3160
  318. 3180  GET C$: REM   FOR FIELDS
  319. 3190  IF C$ =  CHR$(47)  OR C$ =  CHR$(44)  THEN 3280
  320. 3200  IF NR >11  THEN 3120: REM   TOO MANY FIELDS  
  321. 3210  IF C$ =  CHR$(9)  THEN NI = NI +1: GOTO 3180: REM   COUNT TABS
  322. 3220  IF C$ =  CHR$(13)  THEN 3260: REM   CARRIAGE RETURN
  323. 3230 NN$ = NN$ +C$: REM   STORE FILENAME  
  324. 3240  IF NN$ = " NAME"  THEN 3300: REM   TEXT LABEL
  325. 3250  GOTO 3180: REM   READ MORE OF FIELDS
  326. 3260  IF NI >0  THEN AF = NI +2:AD = 2: GOTO 3390: REM   AWGS FORMAT    
  327. 3270 NR = NR +1: GOTO 3180: REM   COUNT RETURNS
  328. 3280  IF NR >0  THEN AF = NR +1:AD = 1: GOTO 3390: REM   AW20 FORMAT   
  329. 3290  GOTO 3120: REM   NO FIELDS  
  330. 3300  GET C$: REM   FOR LABELS
  331. 3310  IF C$ =  CHR$(13)  THEN 3330
  332. 3320 NN$ = NN$ +C$: GOTO 3300: REM   STORE LABELS
  333. 3330  IF PD = 0  THEN 3360
  334. 3340  FOR I = 1 TO 9: IF  LEN(NN$) = WP(I)  THEN AF = I +1: GOTO 3380
  335. 3350  NEXT : GOTO 3120: REM   WRONG LENGTH IN PRODOS  
  336. 3360  FOR I = 1 TO 3: IF  LEN(NN$) = WD(I)  THEN AF = I +1: GOTO 3380
  337. 3370  NEXT : GOTO 3120: REM   WRONG LENGTH IN DOS3.3   
  338. 3380 AD = 3: REM   TEXT FORMAT
  339. 3390  VTAB 23: POKE HT,0: PRINT D$: REM   FOR DOS3.3
  340. 3400 RA = 0: PRINT D$"CLOSE";PW$
  341. 3410  GOSUB 1280: VTAB 24: POKE HT,0
  342. 3420  PRINT "USE ";AF;" FIELDS IN ";AD$(AD);" FORMAT <Y>? ";
  343. 3430  GOSUB 1240: VTAB 23: POKE HT,78: PRINT D$: REM  PRINT FOR DOS3.3
  344. 3440  IF K = 78  OR K = 110  OR K = 27  THEN  GOSUB 1280: GOTO 850
  345. 3450  IF K < >89  AND K < >121  AND K < >13  THEN 3430
  346. 3460 DB = AD:TC = AF -1: IF DB <3  THEN TC = AF -2: REM   SET FORMAT
  347. 3470 WB = WP(TC):W = WP(TC): IF PD = 0  THEN W = WD(TC): IF TC >3  THEN W = 37
  348. 3480  PRINT D$;"APPEND";PW$: PRINT D$: REM   DON'T WRITE YET
  349. 3490 :
  350. 3500  REM   WRITE OUTPUT FILE
  351. 3510  VTAB 23: POKE HT,0:: PRINT  SPC( 80)
  352. 3520 NF = TC +1: IF DB <3  THEN NF = TC +2
  353. 3530  GOSUB 1280
  354. 3540  VTAB 23: POKE HT,0: INVERSE 
  355. 3550  PRINT "WRITING FILE ";PW$;" IN FORMAT ";DB;: NORMAL 
  356. 3560  IF PD = 1  THEN DL = 100: GOTO 610: REM    OPEN DIRECTORY    
  357. 3570  GOSUB 1660: REM   CHECK FOR ESCAPE
  358. 3580  PRINT D$: PRINT D$;"WRITE";PW$
  359. 3590  IF PD = 0  THEN NL = ND: REM   DOS3.3 HAS ALL IN MEMORY   
  360. 3600  IF DB <3  THEN 3720: REM   DATABASE FORMAT
  361. 3610  IF FS = 0  AND SV = 2  THEN  PRINT : PRINT : REM   BLANKS BETWEEN DIR
  362. 3620  IF FS = 0  AND PD = 0  THEN  PRINT  CHR$(44);: REM   COMMA FOR DOS3.3
  363. 3630  IF FS = 0  THEN  PRINT P$: PRINT 
  364. 3640  IF FS = 0  AND PD = 1  THEN  PRINT  LEFT$(LB$,W): PRINT 
  365. 3650  IF FS = 0  AND PD = 0  THEN  PRINT  LEFT$(LD$,W): PRINT : REM   DOS3.3   
  366. 3660  FOR I = 1 TO NL: GOSUB 1660
  367. 3670  IF PD = 1  THEN WI$ = FI$(I): REM   PRODOS  
  368. 3680  IF PD = 0  THEN WI$ = DI$(I): REM   DOS3.3
  369. 3690  IF  LEN(WI$) >W  THEN WI$ =  LEFT$(WI$,W)
  370. 3700  PRINT WI$: NEXT 
  371. 3710  GOTO 4090
  372. 3720 SC$ =  CHR$(13): IF DB = 2  THEN SC$ =  CHR$(9): REM   AW20 VS.AWGS
  373. 3730  FOR I = 1 TO NL: GOSUB 1660
  374. 3740  IF PD = 0  THEN 3880
  375. 3750 WI$ = FI$(I): REM   PRODOS
  376. 3760  IF  LEN(WI$) >W  THEN WI$ =  LEFT$(WI$,W)
  377. 3770 WK$ =  MID$ (WI$,1,1)
  378. 3780 WN$ =  MID$ (WI$,2,15)
  379. 3790 WT$ =  MID$ (WI$,18,3)
  380. 3800 WB$ =  MID$ (WI$,22,7)
  381. 3810 WM$ =  MID$ (WI$,31,9)
  382. 3820 WH$ =  MID$ (WI$,41,5)
  383. 3830 WC$ =  MID$ (WI$,48,9)
  384. 3840 WR$ =  MID$ (WI$,58,5)
  385. 3850 WE$ =  MID$ (WI$,64,8)
  386. 3860 WS$ =  MID$ (WI$,73,7)
  387. 3870  GOTO 3960
  388. 3880 WI$ = DI$(I): REM   DOS3.3
  389. 3890  IF  LEN(WI$) >W  THEN WI$ =  LEFT$(WI$,W)
  390. 3900 WK$ =  MID$ (WI$,1,1)
  391. 3910 WN$ =  MID$ (WI$,2,30)
  392. 3920 WT$ =  MID$ (WI$,33,1)
  393. 3930 WB$ = "    " + MID$ (WI$,35,3): REM   4 SPACES
  394. 3940 WM$ = "":WH$ = "":WC$ = "":WR$ = "":WE$ = "":WS$ = ""
  395. 3950  IF PD = 0  THEN  PRINT  CHR$(44);: REM   COMMA FOR DOS3.3
  396. 3960  PRINT P$;
  397. 3970  PRINT SC$;WK$;
  398. 3980  PRINT SC$;WN$;
  399. 3990  IF TC >1  THEN  PRINT SC$;WT$;
  400. 4000  IF TC >2  THEN  PRINT SC$;WB$;
  401. 4010  IF TC >3  THEN  PRINT SC$;WM$;
  402. 4020  IF TC >4  THEN  PRINT SC$;WH$;
  403. 4030  IF TC >5  THEN  PRINT SC$;WC$;
  404. 4040  IF TC >6  THEN  PRINT SC$;WR$;
  405. 4050  IF TC >7  THEN  PRINT SC$;WE$;
  406. 4060  IF TC >8  THEN  PRINT SC$;WS$;
  407. 4070  PRINT 
  408. 4080  NEXT 
  409. 4090  IF PD = 1  AND EOD = 0  THEN FS = FS +NL: GOTO 620: REM   READ MORE 
  410. 4100  IF PD = 1  AND DB = 3  THEN  PRINT : PRINT ST$: REM   DIR STATISTICS
  411. 4110  PRINT D$: REM   EXTRA FOR DOS3.3
  412. 4120  PRINT D$;"CLOSE";PW$
  413. 4130 I = OI: VTAB 23: POKE HT,0: INVERSE 
  414. 4140  PRINT NF;" FIELDS WRITTEN IN FORMAT ";DB;" ON ";PW$;: NORMAL 
  415. 4150  GOSUB 1280: GOTO 1710: REM   RESTART
  416. 4160 :
  417. 4170  REM   ERROR ROUTINE
  418. 4180 EN =  PEEK(222): REM   GET ERROR NUMBER  
  419. 4190 EL =  PEEK(219) *256 + PEEK(218): REM   GET LINE 
  420. 4200  POKE 216,0: REM   RESET ERROR TRAPPING    
  421. 4210  ONERR  GOTO 4180
  422. 4220  IF EN = 6  AND PD = 0  AND LA$ = ""  THEN 2080: REM   CHANGE DOS3.3. DRIVE
  423. 4230  IF EN = 6  AND VF = 1  THEN VF = 0: GOTO 2870: REM   OUTPUT FILE NOT FOUND
  424. 4240  IF EN = 5  AND RA = 1  THEN RA = 0: GOTO 3280: REM   CHECK NR>0
  425. 4250  IF EN = 255  THEN  END : REM   TRAPPED CTRL-C
  426. 4260  PRINT D$: PRINT D$;"CLOSE": REM   CLOSE ALL FILES
  427. 4270  VTAB 23: POKE HT,0
  428. 4280  INVERSE : PRINT "ERROR ";EN;" ON LINE ";EL;
  429. 4290  IF EN = 254  THEN 1710: REM   TRAPPED ESC
  430. 4300  IF EN = 2  THEN  PRINT " -- RANGE ERROR";
  431. 4310  IF EN = 4  THEN  PRINT " -- WRITE PROTECTED";
  432. 4320  IF EN = 6  THEN  PRINT " -- PATH NOT FOUND";
  433. 4330  IF EN = 8  THEN  PRINT " -- I/O ERROR";
  434. 4340  IF EN = 9  THEN  PRINT " -- DISK FULL";
  435. 4350  IF EN = 10  THEN  PRINT " -- FILE LOCKED";
  436. 4360  IF EN = 11  OR EN = 16  THEN  PRINT " -- SYNTAX ERROR";
  437. 4370  PRINT " -- ";: NORMAL 
  438. 4380  INVERSE 
  439. 4390  PRINT "PRESS ANY KEY ";: NORMAL : PRINT " ";
  440. 4400  GOSUB 1240: REM   GET KEY
  441. 4410  GOTO 1710: REM   RESTART