start tok64 d64-OU5QRa 1000 REM dscalc - a spreadsheet program for the commodore 64 1010 : 1020 REM original program ver 851207 by 1030 REM 1040 REM: dick sowa 1050 REM: renton, wa 1060 : 1070 REM dynamic expression evaluation routine by chris tamara 1080 REM transactor vol 5, issue 04 1090 : 1100 REM ---------------------------- 1110 REM title screen 1120 REM ---------------------------- 1130 POKE53281,1:POKE53280,1:PRINTCHR$(14)"{clear}{down*3}{red}" 1140 pa$="{right}{red}{=*38}" 1150 vm=1024:vx=vm+999:cm=55296:cx=cm+999:POKEvm,240:POKEcm,2:POKEvx,253:POKEcx,2 1160 FORx=1TO23:POKEvm+40*x,221:POKEcm+40*x,2:POKEvx-40*x,221:POKEcx-40*x,2 1170 NEXT:POKEvm+39,238:POKEcm+39,2:POKEvx-39,237:POKEcx-39,2:FORx=1TO38 1180 POKEvm+39-x,192:POKEcm+39-x,2:POKEvx-39+x,192:POKEcx-39+x,2:NEXT 1190 PRINT"{down*2}"pa$"{home}{down*3}" 1200 PRINT"{green}{down*3}{right}{space*4}DSCALC - A BASIC Spreadsheet":PRINTpa$:FORi=1TO500:NEXT 1210 PRINT"{down*2}{right}{light blue}{space*8}(c) 1985 by Dick Sowa 1220 PRINT"{right}{space*20}Renton, WA 1230 PRINT"{down*2}{right}{red}{space*8}Free to copy/use/modify" 1240 PRINT"{right}{space*13}Not for sale. 1250 PRINT:PRINT:PRINT:PRINT:PRINT"{black}{right}{space*13}Standby{.*3}" 1260 GOSUB4860:REM dynamic expression evaluator 1270 GOSUB5270:REM seq file reader 1280 REM ty(r,c)=0 blank cell 1290 REM =1 numeric value 1300 REM =2 formulas 1310 REM =3 text 1320 REM =4 sum command 1330 CLR:sp$="{space*20}" 1340 nr=30:REM number of possible rows 1350 nc=20:REM number of possible cols 1360 sr=18:REM max num of display rows 1370 sc=4 :REM max num of display cols 1380 wc=8 :REM column width 1390 bk$="{space*8}":REM blank cell 1400 DIMrn(nr),cn(nc),fx$(nr,nc),dx$(nr,nc),ty(nr,nc),fm$(nr,nc),fx(nr,nc) 1410 DIMn(21):REM nested formula levels 1420 DIM fl(nr,nc),r(100),c(100),ra(100),rb(100),ca(100),cb(100) 1430 FORr=1TOnr:FORc=1TOnc:ty(r,c)=0:NEXT:NEXT:REM blank cells 1440 : 1450 REM display columns/rows 1460 c1=1:c2=sc:r1=1:r2=sr:REM default display size 1470 ro=2:co=4:r0=1:c0=1:REM cursor at r01c01 1480 GOSUB1940:x=FRE(0):REM display a screen 1490 GOSUB4440:REM clear menu area 1500 cr=20:cc=0:GOSUB2090:REM crsr to menu area 1510 GOSUB4690:REM print function key menu 1520 FORx=22TO24:POKE781,x:SYS59903:NEXT:REM clear text area 1530 cr=22:cc=0:GOSUB2090:PRINT"{green}"fx$(r0,c0)"{black}"; 1540 cr=r0-r1+2:cc=wc*(c0-c1)+c0-c1+4 1550 GOSUB2090:PRINTdx$(r0,c0);:GOSUB2090:REM print data in cell 1560 GOSUB2120:REM get a character 1570 : 1580 REM check for cursor keys 1590 ON-(a$="{right}")*1-(a$="{left}")*2-(a$="{down}")*3-(a$="{up}")*4GOTO1730,1780,1830,1880 1600 : 1610 REM check for function keys 1620 IFa$=CHR$(133)THENt=1:GOTO2230:REM numbers 1630 IFa$=CHR$(134)THENt=2:GOTO2230:REM formulas 1640 IFa$=CHR$(135)THENt=3:GOTO2230:REM alphanumeric text 1650 IFa$=CHR$(136)THEN2610:REM help 1660 IFa$=CHR$(137)THEN2720:REM load 1670 IFa$=CHR$(138)THEN2920:REM save 1680 IFa$=CHR$(139)THEN3080:REM print 1690 IFa$=CHR$(140)THEN3140:REM recalc 1700 GOTO1560:REM not valid char-start over 1710 : 1720 REM cursor right 1730 IFc0=c2THENIFc2<>ncTHENc1=c1+1:c2=c2+1:c0=c0+1:GOTO1480:REM shift screen 1740 IFc0=c2THEN1560:REM can't shift 1750 c0=c0+1:GOTO1520 1760 : 1770 REM cursor left 1780 IFc0=c1THENIFc1<>1THENc1=c1-1:c2=c2-1:c0=c0-1:GOTO1480:REM shift screen 1790 IFc0=c1THEN1560:REM can't shift 1800 c0=c0-1:GOTO1520 1810 : 1820 REM cursor down 1830 IFr0=r2THENIFr2<>nrTHENr1=r1+1:r2=r2+1:r0=r0+1:GOTO1480:REM shift screen 1840 IFr0=r2THEN1560:REM can't shift 1850 r0=r0+1:GOTO1520 1860 : 1870 REM cursor up 1880 IFr0=r1THENIFr1<>1THENr1=r1-1:r2=r2-1:r0=r0-1:GOTO1480:REM shift screen 1890 IFr0=1THEN1560 1900 r0=r0-1:GOTO1520 1910 : 1920 : 1930 REM display spreadsheet screen 1940 PRINT"{black}{clear}"CHR$(142); 1950 FORc=0TO3:c$="0"+MID$(STR$(c+c1),2,3) 1960 PRINTTAB((wc+1)*c+4);"c"RIGHT$(c$,2);:NEXT 1970 PRINT:PRINT 1980 FORr=r1TOr2:r$="0"+MID$(STR$(r),2,3) 1990 PRINT"r"RIGHT$(r$,2); 2000 FORc=0TO3 2010 PRINTTAB((wc+1)*c+4);:REM row nums 2020 IFty(r,c+c1)=0THENdx$(r,c+c1)=bk$ 2030 PRINTdx$(r,c+c1); 2040 NEXT:PRINT 2050 NEXT 2060 RETURN 2070 : 2080 REM posn crsr at current cell (cr,cc) 2090 POKE781,cr:POKE782,cc:POKE783,0:SYS65520:RETURN 2100 : 2110 REM turn on crsr & get keypress 2120 POKE204,0:GETa$:IFa$=""THEN2120 2130 POKE205,2 2140 IF PEEK(207)<>0THEN2140 2150 POKE204,1:RETURN 2160 STOP :REM error??? 2170 : 2180 REM print cell contents on line 22 2190 FORx=22TO24:POKE781,x:SYS59903:NEXT 2200 PRINT"{green}"fx$(r0,c0)"{black}";:RETURN 2210 : 2220 REM f1,f3,f5 accept cell input 2230 ro=cr:co=cc:REM save crsr posn 2240 GOSUB4440:REM clear menu area 2250 cr=20:cc=0:GOSUB4480:REM crsr to menu area 2260 ONtGOSUB4710,4720,4730:REM menu text 2270 l=0:PRINTfx$(r0,c0);:cr=21:cc=0:GOSUB2090:REM print current contents 2280 GOSUB2120:REM get a char 2290 : 2300 REM filter entered data 2310 IFa$=CHR$(20)THENGOSUB4510:GOTO2280 2320 IFa$=CHR$(13)ANDl=0THEN2440 2330 IFa$=CHR$(13)THEN2410:REM cleanup 2340 ONtGOTO2350,2370,2370 2350 IFa$<"0"ORa$>"9"THENIFa$<>"."THEN2280 2360 GOSUB4560:GOTO2280:REM good char & get another 2370 IFa$<"!"ORa$>"{arrow left}"THEN2280 2380 GOSUB4560:GOTO2280:REM good char & get another 2390 : 2400 REM cleanup after 2410 GOSUB4600:REM get in$ from screen 2420 ONt+1GOTO2440,2460,2500,2570 2430 REM blank type=0 2440 fx$(r0,c0)=bk$:dx$(r0,c0)=bk$:ty(r0,c0)=0:GOTO1490 2450 REM values type = 1 2460 fx$(r0,c0)=in$:ty(r0,c0)=1:fx(r0,c0)=VAL(in$) 2470 dx$(r0,c0)=LEFT$(in$+bk$,8) 2480 GOTO1490 2490 REM formulas type=2 and type=4 2500 IFLEFT$(in$,3)<>"sum"THEN2520 2510 fx$(r0,c0)=in$:dx$(r0,c0)="0{space*7}":ty(r0,c0)=4:GOTO1490 2520 fx$(r0,c0)=in$:dx$(r0,c0)="0{space*7}":ty(r0,c0)=2 2530 GOSUB4380:REM convert to usable formula 2540 fm$(r0,c0)=in$ 2550 GOTO1490 2560 REM text type = 3 2570 fx$(r0,c0)=in$:dx$(r0,c0)=in$:ty(r0,c0)=3 2580 GOTO1490 2590 : 2600 REM display help screens 2610 OPEN15,8,15:OPEN2,8,2,"0:dscalc.hlp" 2620 INPUT#15,e:IFe<>0THENCLOSE2:CLOSE15:PRINT"{red}{reverse on}"e,e$"{black}{reverse off}";:GOSUB4810:GOTO1480 2630 PRINT"{clear}{black}"; 2640 SYS49152:IFst AND 64 THEN2670 2650 PRINT:PRINT"{blue}=next screen =abort{black}"; 2660 GETa$:ON-(a$="")GOTO2660:IFa$=CHR$(32)THEN2630 2670 CLOSE2:CLOSE15 2680 PRINT:PRINT"{red}end of help file ":GOSUB4810 2690 GETa$:ON-(a$="")GOTO2690:PRINTCHR$(142):GOTO1480 2700 : 2710 REM load a spreadsheet from disk 2720 PRINT"{clear}{reverse on}{red}load a spreadsheet{reverse off}{blue}":PRINT 2730 PRINT"{red}caution! you will lose current sheet." 2740 PRINT"continue? (y/n){black}" 2750 GETa$:IFa$=""THEN2750 2760 IFa$="y"THENPRINT:GOTO2780 2770 GOTO1480 2780 PRINT:PRINT"clearing current sheet. please wait{.*3}" 2790 FORr=1TOnr:FORc=1TOnc 2800 ty(r,c)=0:NEXT:NEXT:x=FRE(0) 2810 PRINT:PRINT"{blue}enter filename{black}"; 2820 INPUTfi$:IFLEN(fi$)>16THEN2820 2830 OPEN15,8,15:OPEN2,8,2,"0:"+fi$ 2840 INPUT#15,e,e$:IFe<>0THENCLOSE2:CLOSE15:PRINT"{red}{reverse on}"e,e$"{reverse off}{black}";:END 2850 INPUT#2,r,c,ty(r,c),fx$(r,c) 2860 IF st AND 64 THEN2880 2870 GOTO2850 2880 CLOSE2:CLOSE15 2890 GOTO3330 2900 : 2910 REM save a spreadsheet to disk 2920 PRINT"{clear}{reverse on}{red}save a spreadsheet{reverse off}{blue}":PRINT 2930 PRINT"enter filename"; 2940 INPUTfi$:IFLEN(fi$)>16THEN2930 2950 IFfi$=""THEN3050 2960 OPEN15,8,15:OPEN2,8,2,"0:"+fi$+",s,w":z$="," 2970 INPUT#15,e,e$:IFe<>0THENCLOSE2:CLOSE15:PRINT"{red}{reverse on}e,e${reverse off}{black}";:END 2980 FORr=1TOnr:FORc=1TOnc 2990 IFty(r,c)=0THEN3030:REM skip blank cells 3000 in$=STR$(r)+z$+STR$(c)+z$+STR$(ty(r,c))+z$+fx$(r,c):x=FRE(0) 3010 PRINT#2,in$ 3020 INPUT#15,e,e$:IFe<>0THENCLOSE2:CLOSE15:PRINT"{red}{reverse on}e,e${reverse off}{black}";:STOP 3030 NEXT:NEXT 3040 CLOSE2:CLOSE15 3050 GOTO1480 3060 : 3070 REM print spreadsheet 3080 OPEN4,4 3090 FORr=r1TOr2:PRINT#4,r;:FORc=c1TOc2 3100 PRINT#4,dx$(r,c);:NEXT:PRINT#4:NEXT 3110 PRINT#4:CLOSE4:GOTO1490 3120 : 3130 REM f8 - calculate spreadsheet 3140 GOSUB4440 3150 GOSUB3560:REM analyze formula nesting 3160 IFer<>0THENer=0:GOTO1490 3170 GOSUB4440 3180 cr=21:cc=0:GOSUB2090:REM posn crsr 3190 PRINT"formulas to calculate:";tf 3200 FORi=2TOfl:REM formula levels to calc 3210 FORj=1TOnf:REM # of formulas 3220 IFfl(r(j),c(j))<>iTHEN3290:REM next formula-wrong level 3230 IFty(r(j),c(j))=4THENGOSUB3490:GOTO3260 3240 in$=fm$(r(j),c(j)) 3250 fx=USR(0),in$ 3260 dx$(r(j),c(j))=STR$(fx):fx(r(j),c(j))=fx 3270 IFLEN(STR$(fx))>8THENdx$(r(j),c(j))="{!*8}" 3280 tf=tf-1:cr=21:cc=23:GOSUB2090:PRINT"{space*3}{left*3}"tf; 3290 NEXTj:NEXTi 3300 GOTO1480 3310 : 3320 REM re-generate spreadsheet 3330 PRINT: PRINT"{blue}loading complete." 3340 PRINT"re-generating sheet, please wait{.*3}" 3350 FORr=1TOnr:FORc=1TOnc 3360 ONty(r,c)+1GOTO3370,3380,3410,3430,3450 3370 GOTO3460:REM skip blank cells 3380 dx$(r,c)=fx$(r,c):fx(r,c)=VAL(fx$(r,c)) 3390 IFLEN(fx$(r,c))>wcTHENdx$(r,c)="{!*8}" 3400 GOTO3460 3410 dx$(r,c)="0":in$=fx$(r,c):GOSUB4380:fm$(r,c)=in$ 3420 GOTO3460 3430 dx$(r,c)=LEFT$(fx$(r,c),8) 3440 GOTO3460 3450 dx$(r,c)="0" 3460 NEXT:NEXT:x=FRE(0):GOTO1470 3470 : 3480 REM calculate col/row sums 3490 fx=0:FORm=ra(j)TOrb(j):FORn=ca(j)TOcb(j) 3500 fx=fx+fx(m,n) 3510 NEXT:NEXT:RETURN 3520 : 3530 REM analyze formula nesting and 3540 REM determine calc sequence 3550 REM isolate formula cells from value and blank cells 3560 er=0:REM error flag 3570 nf=0:REM # of formulas 3580 fl=0:REM current formula nesting level 3590 cr=21:cc=0:GOSUB2090:GOSUB4830 3600 FORr=1TOnr:FORc=1TOnc 3610 IFty(r,c)=1THENfl(r,c)=1:GOTO3630:REM value cells 3620 IFty(r,c)=2ORty(r,c)=4THENnf=nf+1:r(nf)=r:c(nf)=c:fl(r,c)=2 3630 NEXT:NEXT:tf=nf 3640 IFnf=0THENRETURN:REM no formulas found 3650 GOSUB4440:GOSUB2090:GOSUB4820 3660 : 3670 REM flag and drop formulas that only ref value cells 3680 REM entry:nf = total # of formulas 3690 REM ty(r,c)=0 for all text & blank cells 3700 REM fl(r,c)=1 for all value cells 3710 REM fl(r,c)=2 for all formula cells 3720 REM exit: fl(r,c)>=3 for all cells calling formula cells 3730 fl=2:n(fl)=nf:REM n(fl)=# of formulas at each level 3740 n(fl+1)=0:FORi=1TOn(fl):a$=fx$(r(i),c(i)):l=LEN(a$) 3750 IFty(r(i),c(i))=4THENGOTO4040 3760 FORj=1TOl 3770 IFMID$(a$,j,1)<>"["THEN3840:REM try next character 3780 GOSUB4270:REM parse cell reference 3790 IFer<>0THENr=r(i):c=c(i):j=l:i=n(fl):GOTO3840 3800 IFty(r,c)<>0ANDty(r,c)<>3THEN3820:REM blank/text cell ref test 3810 er=1:r=r(i):c=c(i):j=LEN(a$):i=n(fl):GOTO3840 3820 IFfl(r,c)=fl-1THENfl(r(i),c(i))=fl:GOTO3840:REM current cell level is ok 3830 IFfl(r,c)>=flTHENfl(r(i),c(i))=fl+1:j=l:n(fl+1)=n(fl+1)+1:REM next formula 3840 NEXT 3850 NEXT 3860 IFfl=2THENn(fl)=n(fl)-n(fl+1) 3870 IFfl>2THENn(fl)=n(fl-1)-n(fl+1) 3880 IFer<>0THEN3960 3890 IFn(fl+1)=0THEN:RETURN:REM current level is last level 3900 IFfl=2ANDn(fl)=0THENer=2:GOTO3960:REM no ref to value cells error 3910 IFn(fl)=n(fl-1)THENer=3:GOTO3960:REM infinite loop error 3920 fl=fl+1:IFfl=21THENer=4:GOTO3960:REM excessive loops error 3930 GOTO3740 3940 : 3950 REM handle cell reference errors 3960 GOSUB4440:REM clear menu 3970 ro=cr:co=cc:GOSUB4480:REM move cursor 3980 ONerGOSUB4740,4760,4780,4800,4840 3990 GETa$:IFa$=""THEN3990 4000 RETURN 4010 : 4020 : 4030 REM parse sum statement/extract cell range 4040 IFl<>15THEN4120 4050 b$=LEFT$(a$,5)+MID$(a$,8,1)+MID$(a$,11,1)+MID$(a$,14,1) 4060 x1=VAL(MID$(a$,6,2)):x2=VAL(MID$(a$,9,2)):x3=VAL(MID$(a$,12,2)) 4070 IFx1=0ORx2=0ORx3=0THEN4120 4080 IFb$="sum[cr-]"THEN4130 4090 IFb$="sum[c-r]"THEN4140 4100 IFb$="sum[rc-]"THEN4150 4110 IFb$="sum[r-c]"THEN4160 4120 er=5:r=r(i):c=c(i):i=n(fl):GOTO3850:REM syntax error 4130 ra(i)=x2:rb(i)=x3:ca(i)=x1:cb(i)=x1:GOTO4170 4140 ra(i)=x3:rb(i)=x3:ca(i)=x1:cb(i)=x2:GOTO4170 4150 ra(i)=x1:rb(i)=x1:ca(i)=x2:cb(i)=x3:GOTO4170 4160 ra(i)=x1:rb(i)=x2:ca(i)=x3:cb(i)=x3:GOTO4170 4170 FORm=ra(i)TOrb(i):FORn=ca(i)TOcb(i) 4180 IFty(m,n)<>0THENIFty(m,n)<>3THEN4200 4190 er=5:m=rb(i):n=cb(i):r=r(i):c=c(i):i=n(fl):GOTO4230 4200 IFfl(m,n)=fl-1THENfl(r(i),c(i))=fl:GOTO4230 4210 IFfl(m,n)"["THENNEXT:RETURN 4400 in$=LEFT$(in$,i-1)+"fx("+MID$(in$,i+2,2)+","+MID$(in$,i+5,2)+")"+MID$(in$,i+8) 4410 NEXT:RETURN 4420 : 4430 REM clr menu area 4440 FORx=20TO24:POKE781,x:SYS59903:NEXT 4450 RETURN 4460 : 4470 REM posn crsr at cr,cc (row,col) 4480 POKE781,cr:POKE782,cc:POKE783,0:SYS65520:RETURN 4490 : 4500 REM handle delete 4510 IFl=1THENPRINT"{left} {left}";:l=l-1:RETURN 4520 IFl0THENPOKEos,b:os=os+1:cs=cs+b 4990 rd=-(b<0):REM until b<0 5000 NEXTrd 5010 : 5020 IFcs<>10928 THEN PRINT"***checksum error***":END 5030 : 5040 POKE 785,43:POKE786,192 5050 REM **call expeval with: 5060 REM 'usr(0),string variable' 5070 : 5080 RETURN 5090 DATA32,253,174,32,158,173 5100 DATA32,143,173,160,0,177 5110 DATA100,170,200,177,100,133 5120 DATA251,200,177,100,133,252 5130 DATA 160,0,185,0,2,153 5140 DATA 60,3,177,251,153,0 5150 DATA2,200,192,80,208,240 5160 DATA169,0,157,0,2,165 5170 DATA122,72,165,123,72,169 5180 DATA0,133,122,169,2,133 5190 DATA123,32,121,165,169,0 5200 DATA133,122,169,2,133,123 5210 DATA32,158,173,104,133,123 5220 DATA104,133,122,162,79,189 5230 DATA60,3,157,0,2,202 5240 DATA16,247,96,-1 5250 : 5260 REM seq file reader 5270 FORad=49152TO49194:READda:POKEad,da:NEXTad:RETURN 5280 DATA169,14,32,210,255,160 5290 DATA0,162,2,32,198,255 5300 DATA32,207,255,141,42,192 5310 DATA32,183,255,208,15,173 5320 DATA42,192,32,210,255,201 5330 DATA13,208,235,200,192,21 5340 DATA208,230,32,204,255,96 5350 DATA13,32,253,174,32,158 stop tok64 (bastext 1.0)