home *** CD-ROM | disk | FTP | other *** search
/ PCDisk Magazine Disks / PCDisk Magazine - Disk 3.img / SPREAD.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-08-01  |  7.5 KB  |  135 lines
  1. 10  '"SPREADSHEET CONSOLIDATOR." COPYRIGHT 1984 BY ROBERT E. JOSEPHSON
  2. 22  KEYOFF:CLS:T$="Consolidate Data from "+CHR$(34)+".DIF"+CHR$(34)+" files":LOCATE1,1:PRINTT$:LOCATE25,1:PRINT"Copyright 1984 by Robert E. Josephson";:DEFSEG=&H40:DIMW$(1,1),W#(1,1):W=40:DEFFNT=(W-LEN(T$))\2
  3. 45  MASTX=-2:NULL$=CHR$(34)+CHR$(34):ROWSW=0:HEXZERO$=STRING$(255,0):DEFSEG:SUBRTN$=STRING$(159,32):SUBLOC%=VARPTR(SUBRTN$):DIRECT=PEEK(SUBLOC%+1)+PEEK(SUBLOC%+2)*256:BLOAD"DIR",DIRECT:DIMDIRECTORY$(111),DIFFILES$(111)
  4. 90  FCB$=STRING$(33,32):DTA$=STRING$(33,32):COUNT%=0:FORN=0TO111:DIRECTORY$(N)=SPACE$(12):DIFFILES$(N)=SPACE$(12):NEXT:FILSW=0
  5. 160  FIL$="MASTER":GOSUB7150:GOSUB7290:IFCOUNT%=0THENGOSUB8090:GOTO160
  6. 180  GOSUB1000:GOSUB7330:MASTFIL$=FIL$:IFDRIVE$<>""THENMDR$=DRIVE$+":
  7. 498  ONERRORGOTO8590
  8. 500  OPEN MDR$+MASTFIL$ FOR INPUT AS 1:ONERRORGOTO0
  9. 510  T$="Processing "+CHR$(34)+MDR$+MASTFIL$+CHR$(34)+SPACE$(39-LEN(T$)):GOSUB8070:LOCATE4,1:PRINTT$;:GOSUB1095:MASTX=X:GOSUB1300:DIMM$(ROWMAX,COLMAX),M#(ROWMAX,COLMAX):MASTROW=ROWMAX:MASTCOL=COLMAX:IFROWSW=1THENGOSUB1500 ELSEGOSUB1450
  10. 560  GOSUB1600:CLOSE:GOSUB8090
  11. 610  FILSW=1:FIL$="SUBSIDIARY":GOSUB7150:IFDRIVE$<>MDR$THENGOSUB7290:MASTX=-1:IFCOUNT%=0THENGOSUB8090:GOTO610
  12. 630  GOSUB1000
  13. 640  GOSUB7330:IFCOUNT%=0THEN610 ELSEGOSUB1090
  14. 645  IFEOJ=1THEN710
  15. 646  ONERRORGOTO8600
  16. 650  OPEN DRIVE$+":"+FIL$ FOR INPUT AS 1:GOSUB1300:ONERRORGOTO0
  17. 655  T$="Processing "+CHR$(34)+FIL$+CHR$(34):T$=T$+SPACE$(39-LEN(T$)):GOSUB8070:LOCATE4,1:PRINTT$;:IFROWSW=1THENGOSUB1500 ELSEGOSUB1450
  18. 670  GOSUB1700
  19. 700  CLOSE:FIL$="SUBSIDIARY":GOTO640
  20. 710  REM
  21. 715  GOSUB8090:GOSUB6000:GOSUB8070:LOCATE4,1:PRINT"Creating "+FIL$:ONERRORGOTO8700
  22. 730  OPEN FIL$ FOR OUTPUT AS 1:ONERRORGOTO0
  23. 740  GOSUB 6100:LOCATE 3,1:PRINT"Consolidation of .DIF Files into":PRINT FIL$+SPACE$(39-LEN(FIL$)):PRINT"successfully completed":LOCATE 6,1:PRINT"File has been saved by ROW":LOCATE CSRLIN+2:GOTO 10000
  24. 1000  LOCATE7,1:PRINTSTRING$(39,196):T$=CHR$(34)+".DIF"+CHR$(34)+" Files on Drive "+DRIVE$:LOCATE8,1:COLOR7,0:PRINTT$:X=0:IFX<0THENX=0
  25. 1035  IFCOUNT%>27THENCOUNT%=28
  26. 1040  IFX>COUNT%-1THENX=COUNT%-1
  27. 1050  FORN=0TOCOUNT%-1:COLOR(X<>N)*(-7),(X=N)*(-7):LOCATENMOD14+9,(N\14)*22+4:PRINT" "+DIFFILES$(N)+" ":NEXTN:COLOR7,0:IFDRIVE$+":"=MDR$THENIFFILSW=1THENLOCATEMASTERMOD14+9,(MASTER\14)*22+1:PRINT"*M* "+DIFFILES$(MASTER)
  28. 1059  FILSW=0:RETURN
  29. 1070  IFX<0THENX=0
  30. 1072  IFX>COUNT%-1THENX=COUNT%-1
  31. 1075  COLOR(HIGHLIGHT<>1)*(-7),(HIGHLIGHT=1)*(-7):LOCATEXMOD14+9,(X\14)*22+4:PRINT" "+DIFFILES$(X)+" ":COLOR7,0:RETURN
  32. 1090  LOCATEXMOD14+9,(X\14)*22+1:PRINT"***":RETURN
  33. 1095  LOCATEXMOD14+9,(X\14)*22+1:PRINT"*M*":RETURN
  34. 1100  X=0:FORN=0TOCOUNT%-1:IFMID$(DIRECTORY$(N),10,3)="DIF"THENDIFFILES$(X)=DIRECTORY$(N):X=X+1
  35. 1130  NEXTN:COUNT%=X:RETURN
  36. 1200  N=1
  37. 1220  IFMID$(FIL$,N,1)=" "THENFIL$=LEFT$(FIL$,N-1)+RIGHT$(FIL$,LEN(FIL$)-N) ELSEN=N+1
  38. 1230  IFN<=LEN(FIL$)THEN1220 ELSERETURN
  39. 1300  LINE INPUT#1,A$:IF A$<>"TABLE"THEN CLS:LOCATE 10,1:PRINT "File read is not a legal .DIF file.": LOCATE 11,1:PRINT "Choose a new file": CLS : GOTO 90
  40. 1320  FORN=1TO3:LINEINPUT#1,A$:NEXTN:IFA$="VECTORS"THENVECT=1 ELSEVECT=0
  41. 1340  LINEINPUT#1,A$:Z=INSTR(A$,","):IFZ=0THENSTOP
  42. 1360  ROWMAX=VAL(MID$(A$,Z+1,3)):FORN=1TO2:LINEINPUT#1,A$:NEXT:IFA$<>"TUPLES"THENSTOP
  43. 1390  LINEINPUT#1,A$:Z=INSTR(A$,","):IFZ=0THENSTOP ELSECOLMAX=VAL(MID$(A$,Z+1,3))
  44. 1400  FORN=1TO6:LINEINPUT#1,A$:NEXT:IFA$<>"BOT"THENSTOP
  45. 1410  ERASEW$,W#:IFROWSW=1THENDIMW$(ROWMAX,COLMAX),W#(ROWMAX,COLMAX) ELSEDIMW$(COLMAX,ROWMAX),W#(COLMAX,ROWMAX)
  46. 1415  IFROWSW=0THENSWAPROWMAX,COLMAX
  47. 1420  RETURN
  48. 1450  ONERRORGOTO8500
  49. 1455  FORROW=1TOROWMAX:FORCOL=1TOCOLMAX:LINEINPUT#1,A$:IFLEFT$(A$,1)="1"THENSTRNG=1 ELSESTRNG=0:Z=INSTR(A$,","):W#(ROW,COL)=VAL(RIGHT$(A$,LEN(A$)-Z)):W$(ROW,COL)=CHR$(255)
  50. 1470  IFLEFT$(A$,2)<>"1,"ANDLEFT$(A$,2)<>"0,"THENPRINT"bad record":STOP
  51. 1475  LINEINPUT#1,A$:IFSTRNG=1THENW$(ROW,COL)=MID$(A$,2,LEN(A$)-2)
  52. 1485  NEXTCOL:LINEINPUT#1,A$:IFA$<>"-1,0"THENPRINT"bad row end":STOP
  53. 1492  LINEINPUT#1,A$:IFA$<>"BOT"ANDA$<>"EOD"THENPRINT"bad row end":STOP
  54. 1494  NEXTROW:ONERRORGOTO0
  55. 1498  RETURN
  56. 1500  ONERRORGOTO8500
  57. 1510  FORCOL=1TOCOLMAX:FORROW=1TOROWMAX:LINEINPUT#1,A$:IFLEFT$(A$,1)="1"THENSTRNG=1 ELSESTRNG=0:Z=INSTR(A$,","):W#(ROW,COL)=VAL(RIGHT$(A$,LEN(A$)-Z)):W$(ROW,COL)=CHR$(255)
  58. 1540  IFLEFT$(A$,2)<>"1,"ANDLEFT$(A$,2)<>"0,"THENPRINT"bad record":STOP
  59. 1550  LINEINPUT#1,A$:IFSTRNG=1THENW$(ROW,COL)=MID$(A$,2,LEN(A$)-2)
  60. 1570  NEXTROW:LINEINPUT#1,A$:IFA$<>"-1,0"THENPRINT"bad row end":STOP
  61. 1590  LINEINPUT#1,A$:IFA$<>"BOT"ANDA$<>"EOD"THENPRINT"bad row end":STOP
  62. 1595  NEXTCOL:ONERRORGOTO0
  63. 1598  RETURN
  64. 1600  FORCOL=1TOCOLMAX:FORROW=1TOROWMAX:M$(ROW,COL)=W$(ROW,COL):NEXTROW:NEXTCOL:FORROW=1TOROWMAX:B$=M$(ROW,1):GOSUB8010:M$(ROW,0)=B$:NEXTROW:RETURN
  65. 1700  FORROW=1TOROWMAX:IFW$(ROW,1)=SPACE$(LEN(W$(ROW,1)))THEN1780
  66. 1730  B$=W$(ROW,1):GOSUB8010:RM=1
  67. 1740  IFB$=M$(RM,0)THEN1750 ELSERM=RM+1:IFRM<=MASTROWTHEN1740 ELSEGOSUB8070:LOCATE3,1:PRINT"**WARNING** NO MATCH FOUND FOR:":PRINTB$:LOCATE5,1:PRINT"Press Any Key to Continue":GOSUB8100:GOSUB8120
  68. 1750  FORCOL=2TOCOLMAX:IFW$(ROW,COL)=CHR$(255)THENM#(RM,COL)=M#(RM,COL)+W#(ROW,COL):M$(RM,COL)=CHR$(255):NEXTCOL
  69. 1780  NEXTROW:RETURN
  70. 6000  GOSUB8070:LOCATE3,1:PRINT"Enter the name of the CONSOLIDATED":PRINT"file you are creating":LINEINPUTB$:GOSUB8010:FIL$=B$:Z=INSTR(FIL$,"."):IFZ=0THENFIL$=FIL$+".DIF
  71. 6030  RETURN
  72. 6100  DIF$="TABLE":GOSUB6900:DIF$="0,1":GOSUB6900:DIF$=NULL$:GOSUB6900:DIF$="VECTORS":GOSUB6900:DIF$="0,"+STR$(MASTROW):GOSUB6920:GOSUB6900
  73. 6130  DIF$=NULL$:GOSUB6900:DIF$="TUPLES":GOSUB6900:DIF$="0,"+STR$(MASTCOL):GOSUB6920:GOSUB6900:DIF$=NULL$:GOSUB6900:DIF$="DATA":GOSUB6900:DIF$="0,0":GOSUB6900:DIF$=NULL$:GOSUB6900:DIF$="-1,0":GOSUB6900:DIF$="BOT":GOSUB6900
  74. 6160  FORCOL=1TOMASTCOL:FORROW=1TOMASTROW:IFM$(ROW,COL)=CHR$(255)THENGOSUB6300:GOTO6200
  75. 6180  IFLEN(M$(ROW,COL))=0THENGOSUB6350:GOTO6200
  76. 6190  GOSUB6350
  77. 6200  NEXTROW:DIF$="-1,0":GOSUB6900:IFCOL<MASTCOLTHENDIF$="BOT" ELSEDIF$="EOD
  78. 6220  GOSUB6900:NEXTCOL:DIF$=HEXZERO$:GOSUB6900:CLOSE:RETURN
  79. 6300  DIF$="0,"+STR$(M#(ROW,COL)):GOSUB6920:GOSUB6900:DIF$="V":GOSUB6900:RETURN
  80. 6350  DIF$="1,0":GOSUB6900:DIF$=CHR$(34)+M$(ROW,COL)+CHR$(34):GOSUB6900:RETURN
  81. 6900  PRINT#1,DIF$:RETURN
  82. 6920  IFLEFT$(DIF$,1)=CHR$(34)THEN6960 ELSEN=1
  83. 6940  IFMID$(DIF$,N,1)=" "THENDIF$=LEFT$(DIF$,N-1)+RIGHT$(DIF$,LEN(DIF$)-N) ELSEN=N+1
  84. 6950  IFN<=LEN(DIF$)THEN6940
  85. 6960  RETURN
  86. 7150  GOSUB 8070:IF LEFT$(FIL$,3)="MAS"THEN LOCATE 3,1:PRINT"Select Disk Drive Where";:LOCATE 5,1:PRINT "(Use <- or ->)":LOCATE 4,1:PRINT FIL$+" File Located
  87. 7185  IF LEFT$(FIL$,3)="SUB"THEN LOCATE 3,1:PRINT"Select Disk Drive Where":LOCATE 4,1:PRINT FIL$+" Files Located :LOCATE 5,1:PRINT "(USE <- OR ->)
  88. 7190  X=0
  89. 7200  LOCATE4,29:COLOR(X<>0)*(-7),(X=0)*(-7):PRINT" A ":LOCATE4,32:COLOR(X<>1)*(-7),(X=1)*(-7):PRINT" B ":LOCATE4,35:COLOR(X<>2)*(-7),(X=2)*(-7):PRINT" C ":LOCATE4,38:COLOR(X<>3)*(-7),(X=3)*(-7):PRINT" D ":COLOR7,0
  90. 7240  A$=INKEY$:IFA$=""THEN7240
  91. 7250  IFA$=CHR$(0)+"K"THENX=X-1:X=(X+4)MOD4:GOTO7200
  92. 7260  IFA$=CHR$(0)+"M"THENX=X+1:X=(X+4)MOD4:GOTO7200
  93. 7270  IFA$=CHR$(13)THENDRIVE$=CHR$(65+X) ELSESOUND120,3:GOTO7200
  94. 7280  RETURN
  95. 7290  CALLDIRECT(DRIVE$,FCB$,DTA$,DIRECTORY$(0),COUNT%):GOSUB1100:X=0
  96. 7315  IFCOUNT%=0THENLOCATE6,1:PRINT"Unable to find "+CHR$(34)+".DIF"+CHR$(34)+" files":PRINT"on Disk Drive "+DRIVE$:LOCATECSRLIN+2:PRINT"Press any key to continue - ":PRINT"-Then reselect Disk Drive" ELSE7318
  97. 7316  IFINKEY$=""THEN7316
  98. 7318  RETURN
  99. 7330  GOSUB8070:LOCATE3,1:PRINT"Select "+FIL$+" File":PRINT"Using Cursor Controls":IFMASTX>-2THENLOCATE6:PRINT"Press "+CHR$(34)+"Esc"+CHR$(34)+" to END Processing";
  100. 7370  A$=INKEY$:IFA$=""THEN7370
  101. 7380  IFA$=CHR$(0)+"P"THENHIGHLIGHT=0:GOSUB1070:X=X+1:HIGHLIGHT=1:GOSUB1070:GOTO7370
  102. 7390  IFA$=CHR$(0)+"H"THENHIGHLIGHT=0:GOSUB1070:X=X-1:HIGHLIGHT=1:GOSUB1070:GOTO7370
  103. 7400  IFA$=CHR$(0)+"M"THENHIGHLIGHT=0:GOSUB1070:X=X+14:HIGHLIGHT=1:GOSUB1070:GOTO7370
  104. 7410  IFA$=CHR$(0)+"K"THENHIGHLIGHT=0:GOSUB1070:X=X-14:HIGHLIGHT=1:GOSUB1070:GOTO7370
  105. 7420  IFA$=CHR$(27)THENEOJ=1:GOTO7490
  106. 7430  IFA$=CHR$(13)THENFIL$=DIFFILES$(X):GOSUB1200 ELSESOUND120,3:GOTO7370
  107. 7440  LOCATE 5,1:PRINT SPC(20):GOSUB 8070:LOCATE 3,1:PRINT"Was "+FIL$+" Saved by":PRINT"Row or Column?":PRINT"(Enter "+CHR$(34)+"R"+CHR$(34)+" OR "+CHR$(34)+"C"+CHR$(34)+")":LOCATE 6,9,1
  108. 7450  B$=INKEY$:IFB$=""THEN7450 ELSEGOSUB8010:PRINTB$;
  109. 7460  IFB$="R"THENROWSW=1 ELSEIFB$="C"THENROWSW=0 ELSESOUND120,3:LOCATE,POS(0)-1:PRINT" ";:LOCATE,POS(0)-1:GOTO7450
  110. 7470  LOCATE,,0
  111. 7490  IFFILSW=0THENMASTER=X
  112. 7492  RETURN
  113. 8010  REM
  114. 8020  IFLEFT$(B$,1)=" "THENB$=RIGHT$(B$,LEN(B$)-1):GOTO8020
  115. 8030  FORN=1TOLEN(B$):IFMID$(B$,N,1)>="a"ANDMID$(B$,N,1)<="z"THENMID$(B$,N,1)=CHR$(ASC(MID$(B$,N,1))-32)
  116. 8040  NEXTN:RETURN
  117. 8070  FORVERT=2TO6:LOCATEVERT,1:PRINTSPACE$(40);:NEXTVERT:RETURN
  118. 8090  FORVERT=7TO24:LOCATEVERT,1:PRINTSPACE$(39);:NEXTVERT:RETURN
  119. 8100  REM
  120. 8110  IFINKEY$=""THEN8110 ELSERETURN
  121. 8120  T$="Processing "+CHR$(34)+MDR$+MASTFIL$+CHR$(34)+SPACE$(39-LEN(T$)):GOSUB8070:LOCATE4,1:PRINTT$;:RETURN
  122. 8500  STOP:IFERR<>9THENPRINT"Have encountered error number ";ERR;" in line ";ERL:STOP
  123. 8520  CLS:PRINT"There is a problem in processing ";FIL$:LOCATE3,1:PRINT"You indicated that ";FIL$;:PRINT"was saved by";:IFROWSW=1THENPRINT"ROW" ELSEPRINT"COLUMN
  124. 8550  LOCATECSRLIN+1,1:PRINT"It is possible that it was actually":PRINT"saved by";:IFROWSW=0THENPRINT"ROW" ELSEPRINT"COLUMN
  125. 8570  LOCATECSRLIN+1,1:PRINT"Press any key to process another file ":PRINT"or to reprocess ";FIL$:RESUME700
  126. 8590  GOSUB8070:SOUND120,3:LOCATE3,1:PRINT"***WARNING*** UNABLE TO OPEN":PRINTMDR$+MASTFIL$:LOCATE5,1:PRINT"Press any key to reselect file
  127. 8594  IFINKEY$=""THEN8594 ELSERESUME160
  128. 8600  GOSUB8070:SOUND120,3:LOCATE3,1:PRINT"***WARNING*** UNABLE TO OPEN":PRINTDRIVE$+":"+FIL$:LOCATE5,1:PRINT"Press any key to reselect file
  129. 8620  IFINKEY$=""THEN8620 ELSEFIL$="SUBSIDIARY":RESUME640
  130. 8700  GOSUB8070:SOUND120,3:LOCATE3,1:PRINT"***WARNING*** UNABLE TO OPEN":PRINTDRIVE$+":"+FIL$:LOCATE5,1:PRINT"Press any key to reselect file
  131. 8720  IFINKEY$=""THEN8720 ELSEFIL$="SUBSIDIARY":RESUME715
  132. 9010  FORR=1TO10:FORC=1TO6:PRINTW#(R,C),:NEXTC:PRINT:NEXTR:STOP:FORR=1TO10:FORC=1TO6:PRINTW$(R,C),:NEXTC:PRINT:NEXTR:STOP:FORR=1TO15:PRINTM$(R,0),M$(R,1):NEXT:CLOSE:OPEN "junk.dif" FOR INPUT AS 1
  133. 9120  LINEINPUT#1,A$:PRINTA$:GOTO9120
  134. 10000  CLS:KEY ON:KEY 1,"LIST":KEY 2,"RUN"+CHR$(13):KEY 3,"LOAD"+CHR$(34):KEY 4,"SAVE"+CHR$(34):KEY 5,"CONT"+CHR$(13):KEY 6,",LPT1:"+CHR$(13):KEY 7,"TRON"+CHR$(13):KEY 8,"TROFF"+CHR$(13):KEY 9"KEY":KEY 10,"SCREEN 0,0,0"+CHR$(13):END
  135.