home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / bus / spread.ba < prev    next >
Text File  |  2006-10-19  |  12KB  |  148 lines
  1. 0 'SPREAD.BA 06/19/84 Copyright 1984 by Woods Martin, Houston TX 713/682-3651 Orig by Terry Dettman with ideas from   Don Hergert, Gary Bender, Chris Young & Joel Hassel
  2. 1 ' CLUB 100 LIBRARY - 415/939-1246 BBS,    937-5039 NEWSLETTER, 932-8856 VOICE
  3. 2 MAXFILES=1:CLEAR3037:DEFINTA-Z:DEFSTRS:CM=19:RM=20:SU="S":GOSUB800:GOSUB770:GOSUB90:GOTO70
  4. 4 IFT(I,J)>0THENVI=VAL(S(I,J))ELSEVI=0:IFT(I,J)<0THENST=S(I,J):SC="+":L=1:N=0:GOSUB8
  5. 6 V(I,J)=VI:RETURN
  6. 8 GOSUB44:IFQTHENRETURNELSEIFSL="("THENW=0:GOSUB28ELSEIFINSTR(SN,SL)THENSC=SL:GOTO8ELSEA=ASC(SL):IFA>=65ANDA<=90THENX=VAL(MID$(SL,2)):V=V(X,A-65):T=T(X,A-65)ELSEIFA=64THENGOSUB16ELSEV=VAL(SL)
  7. 10 A=INSTR(SN,SC):IFA<2ORA=6THENVI=VI+VELSEIFA=2THENVI=VI-VELSEIFA=3THENVI=VI*VELSEIFA=4THENVI=VI/VELSEIFA=5THENVI=VI^VELSEIFA=7THENVY=VI:VZ=V
  8. 12 GOTO8
  9. 16 W=INSTR("@ABS   @INT   @SQRT  @ROUND @SUM   @AVG   @COUNT @EXP   @LN    @SIN   @COS   @TAN   @ATAN  @FIX   @MIN   @MAX   @MOD   @<     @<=    @>     @>=    @=     @<>    @PI    @TYP ",SL+" ")
  10. 18 IFW=0THENGOSUB920:RETURNELSEW=W/7+1:GOSUB28:IFW>4ANDW<8THENRETURNELSEIFW=1THENV=ABS(V)ELSEIFW=2THENV=INT(V)ELSEIFW=3THENV=SQR(V)
  11. 20 IFW=4THENVI=SGN(VI)*(INT(ABS(VI)*10^V+.5))/10^V:V=1ELSEIFW=8THENV=EXP(V)ELSEIFW=9THENV=LOG(V)ELSEIFW=10THENV=SIN(V)ELSEIFW=11THENV=COS(V)ELSEIFW=12THENV=TAN(V)
  12. 22 IFW=13THENV=ATN(V)ELSEIFW=14THENV=FIX(V)ELSEIFW=15THENIFVY<VZTHENV=VYELSEV=VZELSEIFW=16THENIFVY>VZTHENV=VYELSEV=VZ
  13. 24 IFW=17THENV=VYMODVZELSEIFW=18THENV=-(VY<VZ)ELSEIFW=19THENV=-(VY<=VZ)ELSEIFW=20THENV=-(VY>VZ)ELSEIFW=21THENV=-(VY>=VZ)ELSEIFW=22THENV=-(VY=VZ)ELSEIFW=23THENV=-(VY<>VZ)ELSEIFW=24THENV=3.1415926536ELSEIFW=25THENV=-(T<>0)
  14. 26 RETURN
  15. 28 SO(N)=SC:SC=SL:VS(N)=VI:W(N)=W:N=N+1:VI=0:IFW>4ANDW<8THENGOSUB32ELSEL=L-(W>0):GOSUB8
  16. 30 N=N-1:V=VI:W=W(N):VI=VS(N):SC=SO(N):RETURN
  17. 32 GOSUB40:CA=CB:RA=RB:GOSUB40:L=L+1:VI=0:X=0:IFCA=CBTHEN34ELSEIFRA=RBTHEN36ELSEGOSUB925:GOTO38
  18. 34 FORRI=RATORB:VI=VI+V(RI,CA):X=X-(T(RI,CA)<>0):NEXT:GOTO38
  19. 36 FORCI=CATOCB:VI=VI+V(RA,CI):X=X-(T(RA,CI)<>0):NEXT
  20. 38 IFX=0ORW=5THENRETURNELSEIFW=6THENVI=VI/X:RETURNELSEVI=X:RETURN
  21. 40 L=L+1:GOSUB44
  22. 42 CB=ASC(SL)-65:RB=VAL(MID$(SL,2)):RETURN
  23. 44 Q=L>LEN(ST):IFQTHENRETURNELSESL=MID$(ST,L,1):L=L+1:Q=(SL=")"):IFQORINSTR(SN,SL)THENRETURN
  24. 46 IFL>LEN(ST)THENRETURNELSES=MID$(ST,L,1):IFINSTR(SN,S)ORS=")"THENRETURNELSEL=L+1:IFS=","THENRETURNELSESL=SL+S:GOTO46
  25. 48 GOSUB76
  26. 50 PRINTSHCHR$(I-R1+34)CHR$(9*(J-C1)+35);:GOSUB52:IFP<0THENPRINTSR(X)USINGSF;S(I,J),SM;:RETURNELSEPRINTSR(X)USINGSE;V(I,J),SM;:RETURN
  27. 52 P=ABS(T(I,J))-1:IFP>=0THENIF(ABS(V(I,J))>99999999/(10^(P+1+(P=0))))OR(P=8)THENMID$(SE,1)="#####^^^^\\"ELSEMID$(SE,1)="#########\\":IFPTHENMID$(SE,9-P,1)="."
  28. 54 RETURN
  29. 58 IFHTHENGOSUB260:RETURNELSEPRINTSI"In>"S;:ST=S:GOTO60
  30. 59 ST=""
  31. 60 GOSUB61:IFKTHENRETURNELSEIFA=27THENST="":RETURNELSEIFA=8THENIFLEN(ST)THENPRINTS" "S;:ST=MID$(ST,1,LEN(ST)-1):GOTO60ELSERETURNELSEIFA=127ORA<32ORA=34THEN60ELSEST=ST+S:PRINTS;:GOTO60
  32. 61 S=INPUT$(1):A=ASC(S):K=INSTR(SA,S):IFKORU=0THENRETURNELSEIFA>=97ANDA<=122THENA=A-32:S=CHR$(A):RETURNELSERETURN
  33. 64 T(R,C)=0:S(R,C)="":V(R,C)=0:RETURN
  34. 66 CL=CL-(J-CL)*(CL<J):RL=RL-(I-RL)*(RL<I):RETURN
  35. 69 GOSUB100
  36. 70 U=0:H=0:Z=0:GOSUB61:IFK=1THENGOSUB76:IFT(I,J)=0THEN70ELSEGOSUB4:GOTO69ELSEIFK=0THENONINSTR("/!>#",S)+1GOSUB110,200,210,230,240:IFK<2THEN69
  37. 72 X=0:GOSUB48:C=C-(K=2)+(K=3)-(K=6)*((C=C1)*(C2+1)+(C<>C1)*(C-C1))+(K=7)*((C=C1+C2)*(C2+1)-(C<>C1+C2)*(C-C1-C2))+(K=10)*C-(K=11)*(CL-C)
  38. 74 R=R+(K=4)-(K=5)-(K=8)*((R=R1)*(R2+1)+(R<>R1)*(R-R1))+(K=9)*((R=R1+R2)*(R2+1)-(R<>R1+R2)*(R-R1-R2))+(K=12)*R-(K=13)*(RL-R):GOSUB90:GOTO70
  39. 76 I=R:J=C:RETURN
  40. 80 PRINTSJ;SO;SH"! wm3";:FORI=C1TOC1+C2:PRINTUSINGSR+".   !   ."+SM;CHR$(65+I);:NEXT:PRINT:X=0:FORI=R1TOR1+R2:PRINTUSINGSR+"###"+SM;I;:FORJ=C1TOC1+C2:IFS(I,J)>""THENGOSUB50
  41. 82 NEXT:IFI<R1+R2THENPRINT
  42. 84 NEXT:RETURN
  43. 88 PRINTSH"! "CHR$(J+65)MID$(STR$(I),1-(I>9)-(I>99)):RETURN
  44. 90 B=0:IFR<0ORR>RMORC<0ORC>CMTHENBEEP:R=-R*(R>=0ANDR<=RM)-RM*(R>RM):C=-C*(C>=0ANDC<=CM)-CM*(C>CM)
  45. 92 GOSUB76:GOSUB66:IFR-R1>R2THENR1=R-R2:B=1ELSEIFR-R1<0THENR1=R:B=1
  46. 94 IFC-C1>C2THENC1=C-C2:B=1ELSEIFC-C1<0THENC1=C:B=1
  47. 96 S="":IFBTHENGOSUB80
  48. 100 X=1:GOSUB48
  49. 102 GOSUB76:GOSUB88:PRINTSI" ";:IFLEN(S(R,C))THENPRINTCHR$(70-6*(T(R,C)=0)-16*(T(R,C)>0))">"S(R,C);
  50. 104 PRINTSH" #";:RETURN
  51. 110 IFINSTR("1234567890.+-(@",S)THEN130ELSEIFA>31ANDA<>127THEN120ELSERETURN
  52. 118 S="":Z=C+1
  53. 120 U=0:IFA=34THENS=""
  54. 122 GOSUB58:IFST=""THENRETURNELSEGOSUB64:IFZ=0THENS(R,C)=ST:RETURNELSEFORX=1TOLEN(ST)STEP9:GOSUB64:S(R,C)=MID$(ST,X,9):C=C+1:IFC>CMTHENX=LEN(ST):BEEP'SPAT03.WM3
  55. 124 NEXT:C=C-1:GOSUB76:GOSUB66:C=Z-1:GOSUB80:RETURN
  56. 130 U=1:GOSUB58:IFST=""THENS=ST:RETURNELSEGOSUB76:S(I,J)=ST:T=ABS(T(I,J)):IFT=0THENT=G
  57. 132 FORX=1TOLEN(ST):A=ASC(MID$(ST,X)):IF(A<48+6*(X=1)ORA>57)ANDA<>46THENT=-T:X=256
  58. 134 NEXT:T(I,J)=T:GOSUB4:RETURN
  59. 200 CLOSE:PRINTSI"Cmd: Hd Ed In De Re Bl Fm Gl Pr St Me ";:U=1:E=0:GOSUB61:ONINSTR("HEIDRBFGPSM",S)+1GOSUB780,118,250,300,310,600,760,500,550,700,400,770:RETURN
  60. 210 PRINTSJ"!"SQ(O)SB;:IFOTHENFORI=0TORL:FORJ=0TOCLELSEFORJ=0TOCL:FORI=0TORL
  61. 215 IFT(I,J)THENGOSUB88:GOSUB4
  62. 220 NEXT:NEXT:GOTO765
  63. 230 PRINTSI"GOTO: ";:U=1:GOSUB59:IFLEN(ST)<2THEN780ELSEX=0:GOSUB48:C=ASC(ST)-65:R=VAL(MID$(ST,2)):GOSUB90:GOTO785
  64. 240 IFT(R,C)=0THEN780ELSES(R,C)=MID$(STR$(V(R,C)),1-(V(R,C)>=0)):T(R,C)=ABS(T(R,C)):GOTO785
  65. 250 H=1:ST=S(R,C):IFT(R,C)THENGOSUB130ELSEGOSUB120
  66. 255 GOTO785
  67. 260 SX=ST:H=LEN(SX)
  68. 265 H=H-(H<0)+(H>LEN(SX)):PRINTSI"Ed>"SX;:PRINTSH" "CHR$(H+35);:GOSUB61:IFK=1THENST=SX:RETURN
  69. 270 IFKTHENH=H+(K=3)-(K=2)+H*(K=10)-(LEN(SX)-H)*(K=11):GOTO265ELSEIFA>31ANDA<>127ANDA<>34THENSX=LEFT$(SX,H)+S+MID$(SX,H+1):H=H+1:GOTO265ELSEIFA=27THENST="":RETURN
  70. 275 IFA=8THENSX=LEFT$(SX,H-1-(H=0))+MID$(SX,H+1):H=H-1ELSEIFA=127THENSX=LEFT$(SX,H)+MID$(SX,H+2)
  71. 280 GOTO265
  72. 300 ST="Insert":GOSUB340:IFA=0THEN780ELSEIFA=67THENIFCL=CMTHEN780ELSEZ=1:FORY=CL+1TOC+1STEP-1:CW=Y-1:GOSUB345:NEXT:Y=R:GOSUB320:R=Y:GOTO355
  73. 305 IFRL=RMTHEN780ELSEZ=2:FORY=RL+1TOR+1STEP-1:RW=Y-1:GOSUB345:NEXT:Y=C:GOSUB335:C=Y:GOTO355
  74. 310 ST="Delete":GOSUB340:IFA=0THEN780ELSEIFA=82THEN325ELSEZ=1:IFC<CLTHENFORY=CTOCL-1:CW=Y+1:GOSUB345:NEXT
  75. 315 CT=C:RT=R:C=CL:GOSUB320:CL=CL-1:C=CT+(CT>0):R=RT:GOTO355
  76. 320 FORR=0TORL:GOSUB64:NEXT:RETURN
  77. 325 Z=2:IFR<RLTHENFORY=RTORL-1:RW=Y+1:GOSUB345:NEXT
  78. 330 CT=C:RT=R:R=RL:GOSUB335:RL=RL-1:C=CT:R=RT+(RT>0):GOTO355
  79. 335 FORC=0TOCL:GOSUB64:NEXT:RETURN
  80. 340 PRINTSI;ST" Col Row ";:GOSUB61:PRINTS;:IFA=67ORA=82THENRETURNELSEA=0:RETURN
  81. 345 IFZ=1THENRW=0:RX=RL:RY=0:CX=CW:CY=YELSECW=0:CX=CL:CY=0:RX=RW:RY=Y
  82. 350 CZ=CY:RZ=RY:GOSUB610:RETURN
  83. 355 Z=0:GOTO210
  84. 400 Z=0:PRINTSI"Store: # L S Q C ";:GOSUB61:ONINSTR("#LSQC",S)+1GOTO780,405,450,410,750,755
  85. 405 Z=1:PRINTSI"Data: L S ";:GOSUB61:IFS="L"THEN450ELSEIFS<>"S"THEN780
  86. 410 CLOSE:PRINTSI"Save File:";:GOSUB59:IFST=""THEN780ELSESV=ST:IFZ=0THENRA=0:RB=RL:CA=0:CB=CL:GOTO415ELSEGOSUB715:IFST=""ORCB<CORRB<RTHEN780ELSECA=C:RA=R
  87. 415 OPENSVFOROUTPUTAS1:IFZTHENPRINT#1,"-1 -1 0 0":RO=R:CO=CELSEPRINT#1,RL;CL;G;O:RO=0:CO=0
  88. 420 FORI=RATORB:FORJ=CATOCB:IFLEN(S(I,J))=0THEN430ELSET=T(I,J):IFZTHENT=ABS(T):V=V(I,J)
  89. 425 PRINT#1,MID$(STR$(I-RO),2);J-CO;MID$(STR$(T),1-(T>=0))" ";:IFZANDT>0THENPRINT#1,MID$(STR$(V),1-(V>=0))ELSEIFT<1THENPRINT#1,CHR$(34)S(I,J)CHR$(34)ELSEPRINT#1,S(I,J)
  90. 430 GOSUB88:NEXT:NEXT:PRINT#1,"-1 -1 0 END"SZ:CLOSE:GOSUB102:GOTO785
  91. 450 CLOSE:PRINTSH"! Ram:"SO:FILES:IFR2>5THENPRINT"Disk:":LFILES
  92. 455 PRINTSI"Load File:";:GOSUB59:IFST=""THEN765ELSEPRINTSH" :"SO;:OPENSTFORINPUTAS1:INPUT#1,I,J,RB,CB:IFZTHENIFI=-1THENRO=R:CO=C:GOTO480ELSE470
  93. 460 IFI<0ORRB<1ORRB>9ORCB<0ORCB>1THEN470ELSEG=RB:O=CB:IFI<=RMANDJ<=CMTHENRL=0:RO=0:CL=0:CO=0:GOTO480
  94. 465 PRINT"="CHR$(J+65)I" too big";:GOSUB955:IFZTHEN495ELSERUN
  95. 470 GOSUB615:GOTO450
  96. 480 IFEOF(1)THEN495ELSEINPUT#1,I,J,T,S:IFI<0THEN495ELSEI=I+RO:J=J+CO:T(I,J)=T:S(I,J)=S:GOSUB66:GOSUB88:GOTO480
  97. 495 CLOSE:IFZ=0THENR=0:C=0:R1=0:C1=0:GOTO210ELSE210
  98. 500 IFT(R,C)THENGOSUB560:T(R,C)=SGN(T(R,C))*A:GOTO785ELSE780
  99. 550 PRINTSI"Global: O F W ";:GOSUB61:IFS="O"THENPRINTSI"Recalc Order: R C ";:GOSUB61:Z=INSTR("CR",S):IFZTHENO=Z-1ELSE780ELSEIFS="F"THENGOSUB560:G=AELSEIFS<>"W"ORR2=5THEN780ELSEC2=3-(C2=3)*(4+(7-CM)*(CM<7)):WIDTH40-40*(C2>3):GOSUB80
  100. 555 GOTO785
  101. 560 PRINTSI"Format: Decimal 0-7 or S ";:GOSUB61:A=A-47+27*(A=83):IFA<1ORA>9THENA=G:GOTO780ELSERETURN
  102. 600 Z=0:SL=CHR$(C+65)+MID$(STR$(R),2):CO=C:RO=R:PRINTSI"Source:";:GOSUB685:IFETHEN615ELSECW=CO:RW=RO:GOSUB680:CX=CO:RX=RO:IFEOR(CW<>CXANDRW<>RX)ORRW>RX ORCW>CXTHEN615
  103. 605 SL="":PRINT" Target:";:GOSUB685:IFST=""ORETHEN615ELSECY=CO:RY=RO:GOSUB680:CZ=CO:RZ=RO
  104. 610 IFEOR(CY<>CZANDRY<>RZ)ORCZ>CMORRZ>RMORCY>CZORRY>RZORCZ>CMORRZ>RMTHEN615ELSERT=RY:CT=CY:GOTO620
  105. 615 IFA=27THEN780ELSEPRINT"<illegal";:GOTO775
  106. 620 IFRW=RXTHENFORCW=CWTOCX:IFCT=CZTHEN625ELSE630ELSEFORRW=RWTORX:IFRT=RZTHEN630
  107. 625 SD="":FORRY=RTTORZ:GOSUB635:IFETHEN695ELSENEXT:CY=CY+1:NEXT:GOTO695
  108. 630 SD="":FORCY=CTTOCZ:GOSUB635:IFETHEN695ELSENEXT:RY=RY+1:NEXT:GOTO695
  109. 635 D=0:E=0:J=CY:I=RY:GOSUB88:IFT(RW,CW)<0THENGOSUB645:S(I,J)=STELSES(I,J)=S(RW,CW)
  110. 640 T(I,J)=T(RW,CW):V(I,J)=0:GOSUB66:IFZORT(I,J)=0THENRETURNELSEGOSUB4:RETURN
  111. 645 ST=S(RW,CW):L=1:SX=""
  112. 650 CO=CY-CW:RO=RY-RW:GOSUB44:CI=ASC(SL):IFCI<65ORCI>90THEN675ELSERI=VAL(MID$(SL,2))
  113. 655 IF(Z=1AND(CI-65)<C)THENCO=0ELSEIF(Z=2ANDRI<R)THENRO=0
  114. 660 IFZTHEN670ELSED=D+1:IFD>LEN(SD)THENPRINTSILEFT$(ST,L-1)"<rep R N";:GOSUB61:SD=SD+SELSES=MID$(SD,D,1)
  115. 665 IFS<>"R"THEN675
  116. 670 CI=CI+CO:RI=RI+RO:IFCI<65ORRI<0THENSL="err"ELSESL=CHR$(CI)+MID$(STR$(RI),2)
  117. 675 SX=SX+SL:IFL<=LEN(ST)THEN650ELSEST=SX:RETURN
  118. 680 PRINT"...";
  119. 685 PRINTSLSTRING$(LEN(SL),8);:GOSUB59:IFST=""THENPRINTSL;ELSECO=ASC(ST)-65:RO=VAL(MID$(ST,2)):SL=ST
  120. 690 E=(LEN(SL)<2)+(CO>CM)+(RO>RM)+(A=27):RETURN
  121. 695 IFZTHENRETURNELSE765
  122. 700 PRINTSI"Print: Printer, Device ";:GOSUB61:IFS="P"THENSV="LPT:":GOTO705ELSEIFS<>"D"THEN780ELSEPRINT"Spec: ";:GOSUB59:IFINSTR(ST,":")=0ORLEFT$(ST,4)="RAM:"THEN780ELSESV=ST
  123. 705 GOSUB715:IFST=""THEN780ELSEOPENSVFOROUTPUTAS1:FORI=RTORB:FORJ=CTOCB:GOSUB52:IFP<0THENPRINT#1,USINGSF;S(I,J);ELSEPRINT#1,USINGSE;V(I,J);
  124. 710 GOSUB88:NEXT:PRINT#1,"":NEXT:PRINT#1,SZ;:CLOSE:GOTO785
  125. 715 PRINTSI"Lower right ";:GOSUB59:IFST=""THENRETURNELSESL=ST:GOSUB42:RETURN
  126. 750 S="Quit: ":GOSUB790:IFS="Y"THENCLS:SCREEN0:MENUELSE780
  127. 755 S="Clear: ":GOSUB790:IFS="Y"THENRUNELSE780
  128. 760 PRINTSI;"Blank ";:GOSUB61:IFKTHENGOSUB64:GOTO785ELSE780
  129. 765 GOSUB80:GOTO780
  130. 770 GOSUB80:GOSUB795:PRINTUSING"f=# o=!#####m ####s";G-1,SQ(O),FRE(0),FRE(S);
  131. 775 BEEP:FORX=1TO4000:NEXT
  132. 780 BEEP
  133. 785 S="":RETURN
  134. 790 PRINTSI;S" Confirm=Y Abort=";:GOSUB955:RETURN
  135. 795 PRINTSIUSING"spr cm=! rm=### p=! ";CHR$(CM+65),RM,SU;:RETURN
  136. 800 C2=3:R2=5:W=(CM+1)*RM:FORU=1TO13:SA=SA+CHR$(ASC(MID$("5DEFG).<*9:?B",U))-40):NEXT
  137. 805 CLS:U=1:RM=W/(CM+1):GOSUB795:PRINT"<ENTER or new cm?";:GOSUB61:IFKTHENIFSU="S"THENDEFSNGVELSEDEFDBLVELSEIFA<68ORA>90THENBEEP:GOTO805ELSECM=A-65:PRINT:PRINT"precision: SorD p=";:GOSUB61:SU=CHR$(83+15*(A=68)):GOTO805
  138. 810 ONERRORGOTO900:SCREEN1:WIDTH40:R2=(-21*(RM>=21))-(RM*(RM<21))
  139. 815 CLS:ONERRORGOTO910:DIMI,J,VI,L,ST,SC,N,Q,SL,T,X,V,VY,VZ,CA,CB,RA,RB,CI,RI,C1,R1,C,R,P,T(RM,CM),S(RM,CM),V(RM,CM),VS(10),SO(10),W(10),SR(1),SQ(1):SN="+-*/^(,":SZ=CHR$(26):SQ(1)="R":SQ(0)="C"
  140. 820 S=CHR$(27):SR=S+"p":SR(1)=SR:SM=S+"q":SB=S+"K":SH=S+"Y":SJ=SH+"  ":SI=SJ+SB:SO=S+"J":G=1:SF="\       \\\":SE=SF:RETURN
  141. 900 RESUME815
  142. 910 E=ERR:IFE=7THENONERRORGOTO0ELSEIFERL=415THENRESUME615ELSEIFERL=455THENRESUME470ELSEIFERL=480ANDERR=9THENRESUME465ELSEIFERL>2ANDERL<48THENGOSUB920ELSEGOSUB950
  143. 915 IFERL>46THENRESUME780ELSEPRINTSI;ST;SJ;:RESUME69
  144. 920 IFL<1THEN950ELSEST=LEFT$(ST,L-1):R=I:C=J:V(I,J)=0:GOSUB90
  145. 925 PRINTSI;ST"<calc error";:GOTO955
  146. 950 PRINTSI"M100 Error"ERR" at line"ERL;
  147. 955 BEEP:PRINT" <ENT>";:GOSUB61:RETURN
  148.