home *** CD-ROM | disk | FTP | other *** search
/ The Glitch Apple Disk Collection / 2014.glitch.apple.collection.zip / indexed / DF2.DSK / CA.bas next >
BASIC Source File  |  2014-09-09  |  12KB  |  118 lines
  1. 10 TE$ = "": POKE 216,0: TEXT :D$ =  CHR$(4): PRINT D$"NOMON I,O,C": GOSUB 798: POKE 37902,255: GOTO 110
  2. 50  PRINT D$"OPEN"N$".P": PRINT D$"READ"N$".P": INPUT CO,F1,LI,F2,F1$,F3,F3$,F6$,F8$,F8,MO,CT$,N,TF$,LF$: PRINT CL$: RETURN 
  3. 90  PRINT  TAB( 3)"* UNIV. DATA MANAGEMENT SYSTEM 4.0 *": PRINT  TAB( 6)"COPYRIGHT 1980 BY W.L.PASSAUER": RETURN 
  4. 110 D1 =  PEEK(864):P$ =  CHR$( PEEK(865)):P1$ =  CHR$( PEEK(866)):S$ =  STR$( PEEK(867)):I =  PEEK(868): FOR X = 869 TO I +868:N$ = N$ + CHR$( PEEK(X)): NEXT :RF$ = D$ +"READ" +N$ +",R":OF$ = D$ +"OPEN" +N$ +",L":CL$ = D$ +"CLOSE"
  5. 150  IF D1 = 1  THEN  HOME : PRINT  CHR$(7): VTAB 12: HTAB 4: PRINT "LOAD ";: INVERSE : PRINT "DATA DISK";: NORMAL : PRINT " THEN PRESS 'RTN'";: GET Z$
  6. 160  PRINT : PRINT D$"OPEN"N$".V,D"D1: PRINT D$"READ"N$".V": INPUT NC,RC,RR: DIM CL(NC +10): FOR X = 1 TO NC: INPUT CL(X): NEXT 
  7. 200 LL = (CL(NC) +NC): PRINT D$"OPEN"N$",L"LL: DIM B$(40,NC +10),S$(RR),H$(NC +10),CL%(NC +10),A$(RR),S1(NC +10),S2(NC +10),SL(NC +10),CM(NC +10)
  8. 220  FOR X = 1 TO NC:B1 = CL(X -1): PRINT D$"READ"N$",R"0",B"B1: CALL 783:H$(X) =  MID$ (TE$,1): NEXT : PRINT D$"CLOSE": FOR X = 1 TO NC:CL%(X) = CL(X) -CL(X -1) -1: NEXT : GOSUB 50
  9. 240  PRINT  CHR$(7);: GOTO 8000
  10. 340  PRINT : PRINT OF$LL",D"D1: FOR I = 1 TO RC:B1 = CL(C -1): PRINT RF$I",B"B1: CALL 783:S$(I) =  MID$ (TE$,1): NEXT : PRINT CL$: RETURN 
  11. 380 CV =  PEEK(37): POKE 37,(CV -1): CALL  -958: RETURN 
  12. 390 CV =  PEEK(37): POKE 37,(CV -2): CALL  -958: RETURN 
  13. 400  FOR X = 1 TO NC: PRINT  TAB( 4)X;"- ("CL%(X)") ";: HTAB 14: PRINT H$(X): NEXT : RETURN 
  14. 410  FOR X = 1 TO 40: PRINT "-";: NEXT : RETURN 
  15. 420  HOME : VTAB 12: PRINT  TAB( 11)"> RECALLING DATA <": RETURN 
  16. 780  ONERR  GOTO 795
  17. 790  PRINT D$"OPEN DATA FILES,D1": PRINT D$"READ DATA FILES": INPUT NR: FOR J = 1 TO NR: INPUT R$(J): NEXT : PRINT CL$: IF   NOT NR  THEN 797
  18. 792  FOR J = 1 TO NR: IF R$(J) = R$  THEN 797
  19. 793  NEXT 
  20. 794 R$(NR +1) = R$: PRINT D$"OPEN DATA FILES": PRINT D$"WRITE DATA FILES": PRINT NR +1: FOR J = 1 TO NR +1: PRINT R$(J): NEXT : PRINT CL$: GOTO 797
  21. 795  CALL 1013: PRINT D$"OPEN DATA FILES": PRINT D$"WRITE DATA FILES": PRINT 1: PRINT R$: PRINT CL$
  22. 797  POKE 216,0: RETURN 
  23. 798  FOR I = 1013 TO 1022: READ PP: POKE I,PP: NEXT : RETURN : DATA 104,168,104,166,223,154,72,152,72,96
  24. 800 B$ = "": PRINT : FOR I = 1 TO L: PRINT "_";: NEXT : VTAB ( PEEK(37) +2 -(L/39.9)): HTAB 1
  25. 810  FOR I = 1 TO L +1
  26. 820  GET E$
  27. 823  IF E$ =  CHR$(10)  THEN E$ =  CHR$(92)
  28. 824  IF E$ =  CHR$(11)  THEN E$ =  CHR$(91)
  29. 825  IF E$ =  CHR$(12)  THEN E$ =  CHR$(95)
  30. 830  IF E$ =  CHR$(21)  THEN 820
  31. 840  IF E$ =  CHR$(8)  THEN  GOSUB 890: GOTO 820
  32. 850  IF E$ =  CHR$(13)  THEN  PRINT E$;: RETURN 
  33. 860  PRINT E$;:B$ = B$ +E$: NEXT 
  34. 870  IF  RIGHT$(B$,1) < > CHR$(13)  THEN  GOSUB 940: GOTO 800
  35. 880  RETURN 
  36. 890  IF I < = 1  THEN  RETURN 
  37. 900  PRINT  CHR$(8);"_"; CHR$(8);
  38. 910 I = I -1
  39. 920  IF I =  <1  THEN I = 1:B$ = "": RETURN 
  40. 930 B$ =  LEFT$(B$, LEN(B$) -1): RETURN 
  41. 940  PRINT  CHR$(7): INVERSE : HTAB 10: PRINT "ENTRY IS TOO LONG": NORMAL : RETURN 
  42. 950 SK =  INT(CL/40): FOR X3 = 1 TO SK: PRINT : NEXT : RETURN 
  43. 960  CALL 37896: RETURN 
  44. 8000 E = 0:C = 0:D =  -1:Z = 0: HOME : PRINT  TAB( 7)"* CONSTRUCT/APPEND ROUTINE *": GOSUB 410
  45. 8005  PRINT  TAB( 1)"YOUR EXISTING FILE HAS >"RC"< RECORDS": PRINT  TAB( 1)"YOU MAY APPEND UP TO >"RR -RC"< MORE RECORDS": GOSUB 410
  46. 8010  PRINT : PRINT "PLEASE LABEL YOUR DISKETTES AS NEEDED:": PRINT : HTAB 7: PRINT "A- EXISTING FILE IN MEMORY": PRINT : HTAB 7: PRINT "B- NEW FILE": PRINT : HTAB 7: PRINT "C- APPEND FROM FILE": PRINT : HTAB 11: PRINT "THEN PRESS 'RTN' ";: GET Z$: HOME 
  47. 8015  IF Z$ < >""  THEN  IF  ASC(Z$) = 17  THEN  TEXT : GOTO 8820
  48. 8020  GOSUB 400: GOSUB 410: HTAB 9: PRINT "ENTER <0> WHEN FINISHED": GOSUB 410: PRINT : FOR Y = 1 TO NC
  49. 8040  PRINT "SELECT FIELD # ('RTN'=ALL/1-"NC") ";: INPUT S1$
  50. 8045  IF S1$ = ""  THEN  FOR Y = 1 TO NC:S1$ =  STR$(Y): GOTO 8070
  51. 8050  IF S1$ = "0"  THEN  PRINT : GOTO 8080
  52. 8060  IF  VAL(S1$) <0  OR  VAL(S1$) >NC  THEN  PRINT  CHR$(7);: GOSUB 380: GOTO 8040
  53. 8070 S1(Y) =  VAL(S1$):SL(Y) = SL(Y -1) +(CL(S1(Y)) -CL(S1(Y) -1)):A$(Y) = H$(S1(Y)): NEXT : PRINT 
  54. 8080 EN = Y -1: PRINT "FOR EXISTING FILE-CONSTRUCT FROM": PRINT "RECORD # (1-"RC") ";: INPUT A: IF A <1  OR A >RC  THEN  PRINT  CHR$(7);: GOSUB 390: GOTO 8080
  55. 8090  PRINT : PRINT "TO RECORD # ("A"-"RC") ";: INPUT B: IF B <A  OR B >RC  THEN  PRINT  CHR$(7);: GOSUB 390: GOTO 8090
  56. 8095  PRINT : PRINT :EM = EN
  57. 8102  PRINT : INPUT "ADD HOW MANY FIELDS (0-10): ";N3: IF N3 <0  OR N3 >10  THEN  PRINT  CHR$(7);: GOSUB 380: GOTO 8102
  58. 8103  IF N3 = 0  THEN 8108
  59. 8104  FOR X = 1 TO N3: PRINT : PRINT "ENTER LENGTH FOR FIELD # "X" (1-239) ";: INPUT L: IF L <1  OR L >239  THEN  PRINT  CHR$(7);: GOSUB 380: GOTO 8104
  60. 8105 S2(X +EN) = X +EN:SL(X +EN) = SL(X +EN -1) +L +1:EM = EM +1
  61. 8106  PRINT : PRINT "NAME FIELD ("L") ": GOSUB 800:A$(X +EN) = B$: GOSUB 950
  62. 8107  NEXT X: PRINT : HTAB 14: PRINT "< WORKING >": FOR X2 = 1 TO 40: FOR Y2 = (1 +EN) TO (EN +N3):B$(X2,Y2) = "": NEXT Y2: NEXT X2
  63. 8108  HOME : FOR X = 1 TO EN: PRINT  TAB( 4)X;"- ("CL%(S1(X))") ";: HTAB 14: PRINT H$(S1(X)): NEXT 
  64. 8110  IF N3 >0  THEN  FOR X = 1 TO N3: PRINT  TAB( 4)X +EN"- ("(SL(X +EN) -SL(X -1 +EN) -1)") ";: HTAB 14: PRINT A$(X +EN): NEXT 
  65. 8113  PRINT : INPUT "ENTER THE LENGTH OF THE LONGEST FIELD   YOU WILL SORT OR SEARCH (>9) ? ";N2: IF N2 <10  THEN  PRINT  CHR$(7): GOTO 8108
  66. 8115 N2 = N2 +12:RR =  INT(28700/N2):L1% =  INT(252960/(N2 -12)): IF L1% <RR  THEN RR = L1%
  67. 8117 LB = (SL(EM) +EM): PRINT : PRINT "APPEND FROM FILE NAME (END/FILE NAME) ?":L = 28: GOSUB 800:N1$ = B$: IF N1$ = ""  THEN  GOSUB 380: PRINT  CHR$(7);: GOTO 8117
  68. 8120  IF N1$ = "END"  THEN  PRINT :N2$ = N$: GOTO 8250
  69. 8125  ONERR  GOTO 8850
  70. 8130  PRINT : HOME : PRINT  CHR$(7): VTAB 11: PRINT "PLACE <DISKETTE C> 'APPEND FROM'": PRINT "INTO DRIVE #1 AND PRESS 'RTN' ";: GET Z$: PRINT : PRINT D$"OPEN"N1$".V,D1": PRINT D$"READ"N1$".V": INPUT A1,A2,A3: FOR X = 1 TO A1: INPUT CM(X): NEXT : PRINT CL$:LA = (CM(A1) +A1): PRINT : POKE 216,0
  71. 8140  PRINT D$"OPEN"N1$",L"LA: FOR X3 = 1 TO A1:B1 = CM(X3 -1): PRINT D$"READ"N1$",R"0",B"B1: CALL 783:S$(X3) =  MID$ (TE$,1): NEXT : PRINT D$"CLOSE": DIM CM%(A1): FOR X3 = 1 TO A1:CM%(X3) = CM(X3) -CM(X3 -1) -1: NEXT 
  72. 8150  HOME : PRINT "FLD#";: HTAB 6: PRINT "LENGTH";: HTAB 13: PRINT "NAME": GOSUB 410: FOR X3 = 1 TO A1: PRINT  TAB( 2)X3;: HTAB 7: PRINT "("CM%(X3)")";: HTAB 13: PRINT S$(X3): NEXT : PRINT 
  73. 8190 Z = Z +1
  74. 8200  PRINT "SELECT FIELD # ('RTN'=SAME/1-"A1") ";: INPUT S1$:S2(Z) =  VAL(S1$): IF S2(Z) >A1  THEN  PRINT  CHR$(7);: GOSUB 380: GOTO 8200
  75. 8205  IF S1$ = ""  THEN  FOR Z = 1 TO EN:S2(Z) = S1(Z): NEXT : GOTO 8230
  76. 8210  IF Z = EN  THEN  PRINT : GOTO 8230
  77. 8220  GOTO 8190
  78. 8230  PRINT : PRINT "CONSTRUCT FROM RECORD # (1-"A2") ";: INPUT C: IF C <1  OR C >A2  THEN  PRINT  CHR$(7);: GOSUB 390: GOTO 8230
  79. 8240  PRINT : PRINT "TO RECORD # (1-"A2") ";: INPUT D: IF D <1  OR D >A2  THEN  PRINT  CHR$(7);: GOSUB 390: GOTO 8240
  80. 8245  PRINT 
  81. 8250  PRINT "CALL NEW FILE WHAT NAME (28) ? ":L = 28: GOSUB 800:N2$ = B$: IF N2$ = ""  OR (N2$ = N$  AND D1 = 1)  THEN  GOSUB 390: PRINT  CHR$(7);: GOTO 8250
  82. 8260  PRINT : IF (B -A) +(D -C) +2 >RR  THEN  PRINT  CHR$(7): HOME : VTAB 12: PRINT  TAB( 7)"=APPENDING TO MANY RECORDS=": FOR TI = 1 TO 3000: NEXT : GOTO 8000
  83. 8265 R8 =  INT(15000/LL): IF R8 >40  THEN R8 = 40
  84. 8270  HOME : VTAB 12: PRINT  CHR$(7);: PRINT "LOAD <DISKETTE B> AN INITIALIZED 'NEW   FILE' DISKETTE INTO DRIVE #1 AND": PRINT "PRESS'RTN' ";: GET Z$: HOME : VTAB 10: PRINT  TAB( 11)"< WRITING PART 1 >"
  85. 8300  VTAB 12: HTAB 5: PRINT "WRITING PRINTER VARIABLE FILE": PRINT : PRINT D$"OPEN"N2$".P,D1": PRINT D$"WRITE"N2$".P": PRINT CO: PRINT F1: PRINT LI: PRINT F2: PRINT F1$: PRINT F3: PRINT F3$: PRINT F6$: PRINT F8$: PRINT F8: PRINT MO: PRINT CT$: PRINT N: PRINT TF$: PRINT LF$: PRINT CL$
  86. 8340 RB = (B -A +1) +(D -C +1): VTAB 12: CALL  -868: HTAB 10: PRINT "WRITING VARIABLE FILE": PRINT : PRINT D$"OPEN"N2$".V,D1": PRINT D$"WRITE"N2$".V": PRINT EM: PRINT RB: PRINT RR: FOR N1 = 1 TO EM: PRINT SL(N1): NEXT : PRINT : PRINT CL$: HOME : HTAB 7: PRINT "WRITING DATA FILE PART -1-": GOSUB 410: PRINT : PRINT D$"OPEN"N2$",L"LB",D1"
  87. 8420  FOR X1 = 1 TO EM:B1 = SL(X1 -1): PRINT D$"WRITE"N2$",R0,B"B1: PRINT A$(X1): NEXT : PRINT CL$:R2 = 0:R4 = A:R5 = 0:R7 = (B -A) +1:R3 = R7: VTAB 5: HTAB 5: PRINT "WE WILL BE MOVING";: HTAB 23: PRINT R7;: HTAB 28: PRINT "RECORDS"
  88. 8450  IF D1 = 1  THEN  PRINT  CHR$(7);: VTAB 20: PRINT "LOAD <DISKETTE A> 'EXISTING FILE'": INPUT "AND PRESS 'RTN'";Z$: GOSUB 390
  89. 8460 R6 = 0: IF R3 >R8  THEN R1 = R8: GOTO 8475
  90. 8470 R1 = R3
  91. 8475  ONERR  GOTO 9000
  92. 8480  VTAB 9: HTAB 11: PRINT "MOVING";: HTAB 18: PRINT R1" ";: HTAB 21: PRINT "RECORDS": PRINT : PRINT OF$LL",D"D1:R5 = R5 +(R1 +(A -1)):A = 1: FOR X2 = R4 TO R5:R6 = R6 +1: FOR X = 1 TO EN:B1 = CL(S1(X) -1)
  93. 8490  PRINT RF$X2",B"B1: CALL 783:B$(R6,X) =  MID$ (TE$,1): NEXT : NEXT : PRINT CL$: POKE 216,0: IF D1 = 1  THEN  PRINT  CHR$(7);: VTAB 20: PRINT "LOAD <DISKETTE B> 'NEW FILE' AND": INPUT "PRESS 'RTN'";Z$: GOSUB 390
  94. 8530  PRINT : PRINT D$"OPEN"N2$",L"LB",D1":R6 = 0: FOR X2 = R4 TO R5:R6 = R6 +1:E = E +1: FOR X1 = 1 TO EM:B1 = SL(X1 -1): PRINT D$"WRITE"N2$",R"E",B"B1: PRINT B$(R6,X1): NEXT : NEXT : PRINT CL$
  95. 8540 R2 = R2 +R1: VTAB 12: HTAB 11: PRINT R2" ";: HTAB 16: PRINT "RECORDS MOVED":R4 = R4 +R1:R3 = R7 -R2: VTAB 14: HTAB 10: PRINT R3" ";: HTAB 15: PRINT "RECORDS TO GO": IF R3 = 0  THEN 8590
  96. 8580  GOSUB 960: GOTO 8450
  97. 8590  IF N1$ = "END"  THEN 8780
  98. 8600  IF D1 = 2  THEN  HOME : VTAB 12: PRINT "LOAD <DISKETTE C> 'APPEND FROM FILE'": PRINT "INTO DRIVE #2 AND PRESS 'RTN' ";: FOR TI = 1 TO 15: PRINT  CHR$(7);: NEXT : GET Z$
  99. 8610  HOME : HTAB 8: PRINT "< APPENDING DATA PART 2 >": GOSUB 410:R2 = 0:R7 = (D -C) +1:R4 = C:R5 = 0:R3 = R7: VTAB 5: HTAB 5: PRINT "WE WILL BE MOVING";: HTAB 23: PRINT R7;: HTAB 28: PRINT "RECORDS"
  100. 8640  IF D1 = 1  THEN  PRINT  CHR$(7);: VTAB 20: INPUT "LOAD <DISKETTE C> 'APPEND FROM FILE' ANDPRESS 'RTN'";Z$: GOSUB 390
  101. 8650 R6 = 0: IF R3 >R8  THEN R1 = R8: GOTO 8665
  102. 8660 R1 = R3
  103. 8665  ONERR  GOTO 9000
  104. 8670  VTAB 9: HTAB 11: PRINT "MOVING";: HTAB 18: PRINT R1" ";: HTAB 21: PRINT "RECORDS": PRINT D$"OPEN"N1$",L"LA",D"D1:R5 = R5 +(R1 +(C -1)):C = 1: FOR X2 = R4 TO R5:R6 = R6 +1: FOR X = 1 TO EN:B1 = CM(S2(X) -1)
  105. 8680  PRINT D$"READ"N1$",R"X2",B"B1: CALL 783:B$(R6,X) =  MID$ (TE$,1,CL%(S1(X))): NEXT : NEXT : PRINT CL$: POKE 216,0
  106. 8710  IF D1 = 1  THEN  PRINT  CHR$(7);: VTAB 20: PRINT "LOAD <DISKETTE B> 'NEW FILE' AND": INPUT "PRESS 'RTN'";Z$: GOSUB 390
  107. 8720  PRINT : PRINT D$"OPEN"N2$",L"LB",D1":R6 = 0: FOR X2 = R4 TO R5:R6 = R6 +1:E = E +1: FOR X1 = 1 TO EM:B1 = SL(X1 -1): PRINT D$"WRITE"N2$",R"E",B"B1: PRINT B$(R6,X1): NEXT : NEXT : PRINT CL$
  108. 8730 R2 = R2 +R1: VTAB 12: HTAB 11: PRINT R2" ";: HTAB 16: PRINT "RECORDS MOVED":R4 = R4 +R1:R3 = R7 -R2: VTAB 14: HTAB 10: PRINT R3" ";: HTAB 15: PRINT "RECORDS TO GO": IF R3 = 0  THEN 8780
  109. 8770  GOSUB 960: GOTO 8640
  110. 8780 R$ = N2$: GOSUB 780: HOME : VTAB 12: HTAB 11: PRINT "> APPENDING DONE <": FOR TI = 1 TO 15: PRINT  CHR$(7);: NEXT 
  111. 8790  IF D1 = 1  THEN  HOME : VTAB 12: PRINT  CHR$(7);: PRINT "LOAD <DISKETTE A> 'EXISTING FILE'": PRINT "AND PRESS 'RTN' ";: GET Z$
  112. 8800  IF D1 = 2  THEN  HOME : VTAB 12: PRINT  CHR$(7);: PRINT "LOAD <UTILITY DISK> INTO DRIVE# 1": PRINT "AND PRESS 'RTN' ";: GET Z$
  113. 8820  IF D1 = 1  THEN  HOME : PRINT  CHR$(7): VTAB 12: HTAB 3: PRINT "LOAD ";: INVERSE : PRINT "UTILITY DISK";: NORMAL : PRINT " THEN PRESS 'RTN'";: GET Z$
  114. 8830  HOME : VTAB 12: HTAB 11: PRINT ">> LOADING MENU <<"
  115. 8840  PRINT D$"RUN MENU,D1"
  116. 8850  PRINT  CHR$(7): INVERSE : PRINT "FILE NOT FOUND": NORMAL : GOTO 8110
  117. 9000  POKE 216,0: PRINT  CHR$(7): HOME : VTAB 12: PRINT "DISK ERROR-RECORD ";: INVERSE : PRINT X2;: NORMAL : PRINT " MAY BE BAD": PRINT "PRESS 'RTN'";: GET Z$: GOTO 8790
  118. 63000  GOTO 8000