"DataCalc"
/Basic tool/
Contributor : Antipontifex.
Code: Select all
1 REM DATACALC
3 REM *********
5 SLOW
6 LET CC=0
8 LET P=3
20 PRINT AT 5,9;"˜ EXISTING DATA";AT 7,9;"™ SET UP"
30 IF INKEY$="" THEN GOTO 30
40 IF INKEY$<>"2" THEN GOSUB 1000
50 IF INKEY$<>"2" THEN GOTO 2000
55 CLS
60 PRINT AT 5,3;"« NUMBER OF ROWS ?";AT 7,3;" NUMBER OF COLUMNS ?"
70 INPUT N1
80 LET N=N1+1
85 LET L=N1+(N1<=19)+19*(N1>19)
87 LET J=L
90 PRINT AT 5,3;" ";AT 7,3;"«"
100 INPUT C1
105 FAST
110 DIM F$(N,10*C1+3)
120 DIM K$(1,10*C1+3)
125 DIM A$(C1,100)
127 LET C=1
130 LET K=1
132 LET HL=1
134 LET HC=1
140 LET M=1
150 REM LOAD COLUMN NUMBERS
151 REM ***********************
155 LET K$(1,1 TO 3)="®®®"
160 FOR X=4 TO (C1-1)*10+4 STEP 10
170 LET K$(1,X TO X+9)="®®K"+STR$ VAL "((X+6)/10)"+"®®®®®®"
180 NEXT X
189 REM LOAD MAIN STRINGS
190 REM ***********************
200 FOR R=1 TO N1
205 LET F$(R,1 TO 3)=STR$ VAL "R"+" "
210 FOR F=4 TO (C1-1)*10+4 STEP 10
220 LET F$(R,F TO F+9)="0 À"
230 NEXT F
240 NEXT R
330 CLS
340 GOSUB 1000
350 GOTO 2000
400 REM CURSOR LOCATION
401 REM ***********************
410 LET R=INT((PC-PS-3)/33)+M-1
420 LET P=INT(((PC-PS-3)/33-INT((PC-PS-3)/33)+.01)*33)+3
430 LET C=(P-7)/10+(K-1)
440 LET F=(K*10-6)+(P-3)
450 RETURN
1000 REM PRINT MAIN SHEET
1001 REM **********************
1002 FAST
1045 PRINT AT 0,0;K$(1,K*10-9 TO K*10+22)
1060 FOR R=M TO J
1070 PRINT F$(R,1 TO 3);F$(R,K*10-6 TO K*10+22)
1080 NEXT R
1085 PRINT AT J-M+2,0;"--------------------------------"
1090 PRINT AT J-M+3,3;F$(N,K*10-6 TO K*10+22)
1092 LET CC=0
1100 RETURN
2000 REM CURSOR
2001 REM ***********************
2002 SLOW
2010 LET PS=PEEK(16396)+PEEK(16397)*256+1
2020 LET PC=PS+(HL*33)+P
2030 GOTO 2070
2040 LET PP=PC
2050 LET PC=PC+(CODE INKEY$=36)*\
10*(INT ((PC-PS+10)/33)<>(PC-PS+\
10)/33)+(CODE INKEY$=34)*33*(PC-\
PS<(L*33))-(CODE INKEY$=33)*10*(\
INT ((PC-PS-3)/33)<>(PC-PS-3)/33\
)-(CODE INKEY$=35)*33*(PC-PS>66)
2060 POKE PP,PEEK(PP)-128
2062 IF PP=PC AND INKEY$="8" OR PP=PC AND INKEY$="5" THEN LET CC=CC+1
2065 GOSUB 3000
2067 SLOW
2070 POKE PC,PEEK(PC)+128
2080 GOTO 2040
3000 REM COMMANDS
3001 REM **********************
3005 IF CC=2 THEN GOTO 3550
3007 IF PC<>PP THEN LET CC=0
3010 IF INKEY$="M" THEN GOTO 3100
3012 IF INKEY$="L" THEN GOTO 3200
3015 IF INKEY$="F" THEN GOTO 4000
3016 IF INKEY$="H" THEN GOTO 3475
3017 IF INKEY$="T" THEN LET HC=2
3020 IF INKEY$="K" THEN GOTO 3300
3025 IF INKEY$="P" THEN COPY
3030 IF INKEY$="J" THEN GOTO 3500
3035 IF INKEY$="S" THEN GOTO 3800
3040 IF INKEY$="C" THEN GOTO 3700
3045 IF INKEY$="D" THEN GOTO 3600
3050 IF INKEY$="A" THEN GOTO 3900
3055 IF INKEY$="O" THEN GOTO 4800
3057 IF INKEY$="X" THEN GOTO 4785
3060 IF INKEY$="V" THEN GOTO 5001
3070 RETURN
3100 REM FORMAT
3101 REM ***********************
3102 FAST
3105 FOR C=HC TO C1
3106 LET F=C*10-6
3115 FOR R=HL TO N
3117 IF F$(R,F TO F+8)=" " THEN GOTO 3150
3120 LET XS=VAL F$(R,F TO F+8)
3125 LET XL=INT(ABS XS+.005)+SGN XS
3130 LET XP=INT((ABS(XS-XL)*100)+.5)
3135 LET Z$=STR$ XP
3140 LET Z$=STR$ XL+"."+("0"+Z$)(LEN Z$ TO)
3142 LET F$(R,F TO F+8)=" "
3145 LET F$(R,F+6-(LEN STR$ XL) TO F+8)=Z$
3150 NEXT R
3155 NEXT C
3160 GOSUB 1045
3165 RETURN
3200 REM OVERPRINT LABELS
3201 REM ***********************
3215 PRINT AT 0,0;K$(1,1 TO 9)
3225 FOR R=M TO J
3230 PRINT F$(R,1 TO 12)
3235 NEXT R
3240 RETURN
3300 REM ENTER A COLUMN
3301 REM ***********************
3305 FAST
3310 GOSUB 400
3312 LET PC=PS+(HL*33)+P
3315 LET M=1
3320 GOSUB 3630
3330 SLOW
3340 FOR Q=HL TO N1
3342 IF Q=20 OR Q=39 OR Q=58 OR Q=77 THEN GOSUB 3650
3345 LET PK=PS+((Q-M+1)*33)+P
3350 POKE PK,PEEK(PK)+128
3360 INPUT X$
3370 IF X$="" OR X$="R" THEN GOTO 3390
3372 IF X$(1)="=" THEN GOSUB 3475
3373 IF X$(1)="?" THEN GOSUB 3490
3375 IF X$(LEN X$)=":" THEN GOSUB 3420
3380 LET F$(Q,F TO F+8)=X$
3390 PRINT AT Q-M+1,P;F$(Q,F TO F-P+29)
3392 IF X$="R" THEN RETURN
3410 NEXT Q
3415 RETURN
3420 REM REPEAT ROUTINE
3421 REM ***********************
3430 LET X$=X$(1 TO LEN X$-1)
3440 FOR Y=F TO (C1*10) STEP 10
3450 LET F$(Q,Y TO Y+8)=X$
3455 NEXT Y
3470 RETURN
3475 REM COLUMN HEADING ROUTINE
3476 REM ***********************
3480 GOSUB 400
3485 LET HL=R+1
3487 RETURN
3500 REM JUMP
3501 REM ***********************
3510 INPUT J$
3515 IF J$="R" THEN RETURN
3520 LET K=VAL J$
3525 IF K>C1-2 THEN LET K=C1-2
3530 LET CC=0
3535 GOSUB 1045
3540 RETURN
3550 REM CURSOR JUMP
3551 REM ***********************
3555 LET KK=K+((INKEY$="8")*(K<(C1-2)))-((INKEY$="5")*(K>1))
3560 IF K=1 AND K=KK OR K=C1-2 AND K=KK THEN RETURN
3565 LET K=KK
3570 GOSUB 1045
3575 RETURN
3600 REM DROP OF RISE
3601 REM ***********************
3610 GOSUB 400
3615 INPUT X$
3625 LET M=VAL X$
3630 IF M>N1-L+1 THEN LET M=N1-L+1
3635 LET J=(M+18)*(N+18)<=N1)+N1*((M+18)>N1)
3640 GOSUB 1045
3645 RETURN
3650 REM DROP ONE PAGE
3651 REM ***********************
3652 FAST
3653 CLS
3655 LET M=M+19
3660 LET J=(M+18)*((M+18)<=N1)+N1*((M+18)>N1)
3670 GOSUB 1045
3675 SLOW
3680 RETURN
3700 REM CALCULATE
3701 REM ***********************
3705 FAST
3710 FOR C=HC TO C1
3720 LET F=C*10-6
3730 IF A$(C,1)=" " THEN GOTO 3790
3740 FOR R=HL TO N1
3760 LET F$(R,F TO F+8)=STR$ VAL A$(C)
3770 NEXT R
3780 IF F$(N,F)<>" " THEN GOSUB 3810
3790 NEXT C
3792 GOSUB 1045
3795 RETURN
3800 REM SUM OF A COLUMN
3801 REM ***********************
3805 GOSUB 400
3808 FAST
3810 LET S=0
3820 FOR R=HL TO N1
3830 LET S=S+VAL F$(R,F TO F+8)
3840 NEXT R
3850 LET F$(N,F TO F+8)=STR$ VAL "S"
3870 GOSUB 1090
3880 RETURN
3900 REM ADD OR AMEND
3901 REM ***********************
3910 POKE PC,PEEK(PC)+128
3920 GOSUB 400
3930 LET Q=R
3950 INPUT X$
3960 IF X$="R" OR X$="" THEN GOTO 3990
3965 IF X$(1)="=" THEN GOSUB 3475
3967 IF X$(1)="?" THEN GOSUB 3490
3970 IF X$(LEN X$)=":" THEN GOSUB 3420
3980 LET F$(R,F TO F+8)=X$
3990 PRINT AT R-M+1,P;F$(R,F TO F-P+31)
3992 IF F$(N,F)<>" " THEN GOSUB 3808
3995 RETURN
4000 REM FORMULA ENTRY
4001 REM ***********************
4005 FAST
4010 GOSUB 400
4020 INPUT A$(C)
4030 GOSUB 4500
4031 GOSUB 400
4040 FOR R=HL TO N1
4060 LET F$(R,F TO F+8)=STR$ VAL A$(C)
4070 NEXT R
4075 IF A$(C,1 TO 3)="R " THEN LET A$(C)=""
4080 IF F$(N,F)<>" " THEN GOSUB 3810
4090 GOSUB 1045
4095 RETURN
4500 REM FORMULA ENCODE
4501 REM ***********************
4505 IF A$(C,1)="P" THEN GOTO 4730
4510 IF A$(C,1)="I" THEN GOTO 4755
4515 LET X=1
4520 LET A=1
4522 IF A$(C,A+1 TO A+3)=" " THEN GOTO 4530
4524 LET A=A+1
4526 GOTO 4522
4530 LET B$=A$(C)
4540 LET C$=""
4550 IF X>A+1 THEN GOTO 4710
4560 REM
4570 IF B$(X)<>"K" AND B$(X)<>"S" THEN GOTO 4640
4580 LET X$="R"
4590 IF B$(X)<>"K" THEN LET X$="N"
4600 IF B$(X+2)=")" OR B$(X+2)="*" OR B$(X+2)="/" OR B$(X+2)="**" OR B$(X+2)="+" OR B$(X+2)="-" THEN GOTO 4670
4605 LET F=VAL(B$(X+1 TO X+2))*10-6
4610 LET C$=C$+"VAL F$("+X$+","+STR$ VAL "F"+" TO "+STR$ VAL "F+8"+")"
4620 LET X=X+3
4630 GOTO 4550
4640 LET C$=C$+B$(X)
4650 LET X=X+1
4660 GOTO 4550
4670 LET F=VAL B$(X+1)*10-6
4680 LET C$=C$+"VAL F$("+X$+","+STR$ VAL "F"+" TO "+STR$ VAL "F-8"+")"
4690 LET X=X+2
4700 GOTO 4550
4710 LET A$(C)=C$
4720 RETURN
4730 REM PROGRESSIVE SUM
4731 REM ***********************
4745 LET A$(C)="VAL F$(R,F-10 TO F-2)+(R<>HL)*VAL F$(R-1*(R<>HL),F TO F+8)"
4750 RETURN
4755 REM INVERT COLUMN
4756 REM ***********************
4770 LET A$(C)="VAL F$(N-(R-HL+1),F-10 TO F-2)"
4780 RETURN
4785 REM CANCEL SUM
4786 REM ***********************
4790 GOSUB 400
4792 LET F$(N,F TO F+8)=" "
4794 GOTO 1090
4800 REM SORT
4801 REM ***********************
4805 FAST
4810 GOSUB 400
4820 LET R=1
4830 IF 2**R>N1 THEN GOTO 4860
4840 LET R=R+1
4850 GOTO 4830
4860 LET F1=2**R-1
4870 LET F1=INT(F1/2)
4880 IF F1=0 THEN GOTO 1045
4890 LET D=N1-F1
4900 LET B=1
4910 LET R=B
4920 LET E=R+F1
4925 IF R<HL OR E<HL THEN GOTO 4940
4930 IF VAL F$(R,F TO F+8)>VAL F$(E,F TO F+8) THEN GOTO 4955
4940 LET B=B+1
4945 IF B>D THEN GOTO 4870
4950 GOTO 4910
4955 LET X$=F$(R,3 TO)
4960 LET F$(R,3 TO)=F$(E,3 TO)
4965 LET F$(E,3 TO)=X$
4970 LET R=R-F1
4975 IF R<1 THEN GOTO 4940
4980 GOTO 4920
5000 REM SAVE
5001 REM ***********************
5002 SAVE "DATACALC"
5003 CLS
5004 GOTO 1