10 ' TALLY.BA VERS. 5.6 11 ' Tally counter for the Radio Shack Model 100 computer 12 ' Author - William G. Voigt 13 ' Division of Biological Control 14 ' U.C. Berkeley (415) 643-6367 or (415) 232-6962 (h) 15 ' 27 NOVEMBER 1987 16 'CLUB 100 Library - 415/939-1246 BBS, 937-5039 NEWSLETTER, 932-8856 VOICE 17 CLEAR 1000:GOTO 30 20 ' CHANGE TO UPPERCASE 22 A$=INKEY$:IF A$="" THEN 22 25 A$=CHR$(ASC(A$)+(A$CHR$(96))*32):RETURN 30 KEY OFF:CLS: MAXFILES=2 32 FT%=1:TF%=0:TG%=1:TT%=153:BK%=1:MSG%=280:TAB%=1:BF%=1:NF%=1 50 IN=17001:NR=17006:FG%=1:DIM SM%(4,10),NA$(4,10):CLS 65 SM$=" SUM ":MN$="DECREMENT ":PC$=" PERCENT " 70 GOSUB 7500:GOSUB 2100:GOSUB 2200 80 GOTO 10000 200 ' INCREMENT 220 SM%(BK%,V%)=SM%(BK%,V%)+FG% 230 GT%=GT%+FG% 240 GOSUB 2225:' Print Totals 250 FG%=1 260 RETURN 400 ' PRINT MESSAGE 405 PRINT@(MSG%-10),SPACE$(49);:CALL IN:PRINT@MSG%-7,"<"; 410 FOR I=1 TO 4:PRINTCHR$(156-I);:NEXT:PRINT">";:CALL NR:PRINT@MSG%+33,"SELECT";:RETURN 500 ' Display Percentages 510 IF GT%=0 THEN 580 ELSE PRINT@MSG%,PC$; 520 FOR I=0 TO 9 :PCT=SM%(BK%,I)*100/GT% 530 PRINT @81+(IMOD5)*6-(I>4)*160,"";:PRINT USING "##.##";PCT; 540 NEXT 550 GOSUB 20 560 IF A$=CHR$(30) THEN BF%=-1 ELSE IF A$=CHR$(31)THEN BF%=1 ELSE 570 565 PF%=1:GOSUB 800:GOTO 520 570 FOR I = 0 TO 9:PRINT @81+(IMOD5)*6-(I>4)*160,"";:PRINT USING "#####";SM%(BK%,I); 575 NEXT 580 PRINT@MSG%,SM$;:PF%=0:RETURN 600 ' PRINT TOTAL 610 ' Print SM(V%) 620 PRINT @82+((V%)MOD5)*6-((V%)>4)*160,"";:PRINT USING "####";SM%(BK%,V%) 625 PRINT@TT%+80,"";:PRINTUSING"#####";GT%; 650 FG%=1 660 RETURN 700 IF FN$="" THEN FN$=FO$:' ENTER COMMENTS 710 CLS:PRINT"ENTER COMMENTS (255 CHARACTERS MAX)":PRINT"DATE & TIME WILL BE ADDED AUTOMATICALLY":INPUT CM$ 720 OPEN FN$ FOR APPEND AS 1 730 PRINT#1,Q$;DATE$;Q$;" ";Q$;TIME$Q$;" ";Q$;CM$Q$:CLOSE 750 GOSUB 2000:GOSUB 2200 760 RETURN 800 ' Bank Subroutines 810 BK%=BK%+BF%:IF BK%>4 THEN BK%=1 ELSE IF BK%<1 THEN BK%=4 820 GOSUB 2225:GOSUB 2100 830 IF TF%=1 THEN CALL IN:PRINT@BL%,"+";:CALL NR 835 IF FN%=1 THEN PRINT@BL%,"";:PRINTUSING"\ \";NA$(BK%,TB%); 840 BF%=1:RETURN 1000 ' SAVE RESULTS TO A TEXT FILE 1010 PRINT@MSG%,"SAVING TO ";FO$; 1048 OPEN FO$ FOR APPEND AS 1 1050 IF NF%=1 THEN 1055 ELSE 1067:' Save names if they've been changed, else don't. 1055 OPEN"NAMES.DO"FOR OUTPUT AS 2:PRINT#2,FO$;","; 1060 FOR J = 1 TO 4 : FOR I=0 TO 9 1065 PRINT#1,CHR$(34);NA$(J,I);CHR$(34);",";:PRINT#2,NA$(J,I);",";:NEXT:NEXT:PRINT#1,"":PRINT#2,"" 1067 FOR J = 1 TO 4 1070 FOR I=0 TO 9 1075 PRINT #1, SM%(J,I);",";:NEXT:NEXT 1080 PRINT #1,CHR$(34);DATE$;CHR$(34);" ";CHR$(34);TIME$ ;CHR$(34) 1100 CLOSE:X=FRE("") 1220 ':IF EF%=1 THEN 1280 ELSE PRINT@msg,"RESET VALUES? (Y/N)"; 1225 ' GOSUB 20 1230 GOSUB 3500 1260 NF%=0 1270 PRINT@MSG%,SPACE$(29);:PRINT@MSG%,SM$;:PRINT@MSG%+15,"RAM = "+STR$(FRE(0)); 1280 RETURN 2000 'Screen 2005 CLS 2100 CALL NR 2110 FOR I = 0 TO 9 2120 PRINT @1+(IMOD5)*6-(I>4)*160," (";RIGHT$(STR$(I+1),1);")"; 2130 CALL IN:PRINT @41+(IMOD5)*6-(I>4)*160,"";:PRINT USING "\ \";NA$(BK%,I); :CALL NR 2140 IF PF%=1 THEN 2150 ELSE PRINT @81+(IMOD5)*6-(I>4)*160,"";:PRINT USING "#####";SM%(BK%,I); 2150 NEXT 2160 RETURN 2200 CALL IN:PRINT @33,"Bank #";:CALL NR 2205 CALL IN:PRINT@113," File ";:CALL NR 2207 PRINT@153,"";:PRINT USING "\ \";FO$; 2210 CALL IN:PRINT@TT%+39,"";:PRINT"GR.TOTAL";:CALL NR 2225 PRINT @74,"";:PRINT USING " # ";BK%; 2240 PRINT@TT%+80,"";:PRINTUSING"#####";GT%; 2250 IF FN%=0 AND TF%=0 THEN CALL IN:PRINT @TT%+120,"";:CALL NR:PRINT"elp";:CALL IN: PRINT@TT%+160,"<"CHR$(81);">";:CALL NR:PRINT;"uit"; 2260 RETURN 3000 ' Reset numbers to Zero 3005 PRINT@MSG%,"ENTER NUMBER TO BE RESET ";: 3010 GOSUB 20 3015 IF A$=CHR$(13) THEN 3160 3020 IF A$= "A" THEN GOSUB 3500 :GOTO 3160 3030 IF A$=CHR$(30)THEN BF%=-1 ELSE IF A$=CHR$(31) THEN BF%=1 ELSE GOTO 3040 3035 GOSUB 800:GOTO 3155 3040 IF A$<"0" OR A$>"9" THEN BEEP:GOTO 3010 3045 IF A$="0" THEN A$="10" 3050 V%=VAL(A$)-1 3100 GT%=GT%-SM%(BK%,V%):SM%(BK%,V%)=0 3115 GOSUB 600 3155 ' GOTO 3005 3160 PRINT @MSG%,SPACE$(39);: PRINT @MSG%,SM$; 3170 RETURN 3500 GT%=0 3510 FOR J = 1 TO 4 :T%(J)=0 3515 FOR I= 0 TO 9 :SM%(J,I)=0 :NEXT :NEXT 3650 FG%=1:CALL NR:PRINT @ MSG%,SPACE$(29); 3670 GOSUB 2100:GOSUB 2200:RETURN 4000 ' NAME SUBROUTINE 4005 GOSUB 400 4010 TB%=TAB%-1:FN%=1 4015 NM$=NA$(BK%,TB%):GOSUB 4520 4020 BL%=41+(TB%MOD5)*6-(TB%>4)*160: CALL NR:PRINT @BL%,"";:PRINT USING "\ \";NA$(BK%,TB%); 4025 GOSUB 20 4030 IF A$=CHR$(13) THEN FM%=1:GOTO 4170 4060 IF A$=CHR$(31) THEN GOSUB 800:GOTO 4015 4070 IF A$=CHR$(30) THEN BF%=-1:GOSUB 800:GOTO 4015 4080 IF A$=CHR$(8) THEN 4125 4090 IF A$=CHR$(9)OR A$=CHR$(28) THEN PRINT @BL%,"";:CALL IN:PRINT USING"\ \";NA$(BK%,TB%);:NM$="":CALL NR:GOSUB 4300:GOTO 4010 4100 IF A$=CHR$(29) THEN PRINT @BL%,"";:CALL IN:PRINT USING"\ \";NA$(BK%,TB%);:NM$="":CALL NR:NF%=-1:GOSUB 4300:GOTO 4010 4110 NF%=1:NM$="":GOSUB 4500 4120 GOSUB 20 4125 IF A$=CHR$(8)THEN IF LEN(NM$)=0 THEN BEEP ELSE NM$=MID$(NM$,1,LEN(NM$)-1):CALL NR:GOSUB 4500:GOTO 4120 4130 IF A$=CHR$(13)OR A$=CHR$(9)OR A$=CHR$(28) THEN NA$(BK%,TB%)=NM$:IF A$=CHR$(13) THEN FM%=1 ELSE FM%=0:NF%=1:GOSUB 4300:GOTO 4170 4135 IF A$=CHR$(9) OR A$=CHR$(28) OR A$=CHR$(13)THEN NF%=1:GOSUB 4300:FM%=1:GOTO 4170 4140 IF A$=CHR$(27) THEN 4185 4150 IF A$=CHR$(29) THEN GOTO 4170 ELSE IF A$10 THEN TAB%=1 ELSE IF TAB%<1 THEN TAB%=10 4310 NF%=1:RETURN 4500 IF LEN(NM$)>15 THEN BEEP:GOTO 4520 4510 IF A$=CHR$(8) THEN 4520 ELSE NM$=NM$+A$ 4520 PRINT@MSG%,"NAME(";MID$(STR$(TB%+1),2,15);"): ";: PRINTUSING"\ \";NM$;:RETURN 5000 ' HELP SCREEN 5005 PRINT @MSG%," HELP "; 5010 CALL IN:PRINT @30,"<";CHR$(152);" ";CHR$(153);">";:CALL NR :PRINT"Bank";: 5011 CALL IN:PRINT @70,"";:CALL NR:PRINT"Entry"; 5015 CALL IN:PRINT@110,"<-+>"; :CALL NR: PRINT "Reduce "; 5020 CALL IN:PRINT @150,"";:CALL NR: PRINT "ile "; 5030 CALL IN:PRINT @190,"";:CALL NR: PRINT "eset "; 5040 CALL IN:PRINT @230,"

";:CALL NR: PRINT "ercent "; 5050 CALL IN:PRINT @270,"";:CALL NR: PRINT "ame "; 5060 CALL IN:PRINT @310,"";:CALL NR: PRINT "ave "; 5100 GOSUB 20 5200 FOR I=0 TO 6: PRINT @30+(I*40),SPACE$(10);:NEXT:PRINT@300,SPACE$(18); 5205 PRINT@39," "; 5210 GOSUB 2200 5310 PRINT@MSG%,SM$;:RETURN 7000 ' quit 7010 GOSUB 20:IF A$="Y" THEN EF%=1 ELSE RETURN 7015 PRINT@MSG%,"SAVE DATA? ";:GOSUB20: 7016 IF A$="Y" THEN GOSUB 1000 7017 CALL 16964:CLS:END 7020 PRINT @MSG%,SM$;SPACE$(12);:RETURN 7500 ' READ NAMES FROM FILE 7510 ON ERR GOSUB 7600 7520 OPEN "NAMES.DO" FOR INPUT AS 1: INPUT #1,FO$ 7530 FOR I=1 TO 4:FOR J=0 TO 9:IF EOF(1)THEN I=4 :J=9:GOTO 7540 7535 INPUT #1,NA$(I,J) 7540 NEXT:NEXT:CLOSE 7550 RETURN 7600 PRINT@MSG%,"NAMES file not found, creating now;:BEEP 7610 GOSUB 1000:RETURN 8000 ' Change Data File 8010 CALL 16959:PRINT@MSG%,"New File <";FO$;:INPUT">:";F$ 8020 IF F$="" THEN F$=FO$ 8022 FO$=F$:PRINT@153,"";:PRINTUSING "\ \";FO$; 8025 PRINT@MSG%,SPACE$(30);:RETURN 9000 ' Input Large Numbers 9005 TF%=1:GOSUB 400 9010 NU$="":IF TAB%=6 THEN PRINT@MSG%,SPACE$(10); ELSE PRINT@MSG%," ENTRY "; 9015 TB%=TAB%-1:BL%=121+(TB%MOD5)*6-(TB% >4)*160: CALL IN:PRINT@BL%,"+";:CALL NR 9020 GOSUB 20 9025 IF A$="-" THEN FG%=-1:CALL IN:PRINT @BL%,"-";:CALL NR:GOTO 9055 9030 IF A$=CHR$(31) THEN BF%=1:GOSUB 800:GOTO 9020 9035 IF A$=CHR$(30) THEN BF%=-1:GOSUB 800:GOTO 9020 9040 IF A$=CHR$(28)OR A$=CHR$(9) THEN PRINT@BL%," ";:GOSUB 9400:GOTO 9010 9043 IF A$=CHR$(29) THEN PRINT@BL%," ";:CALL NR:FT%=-1:GOSUB9400:GOTO 9010 9045 IF A$=CHR$(13) THEN 9200 9050 IF A$>"0" AND A$<="9" THEN NU$=NU$+A$:PRINT@BL%+1,NU$;:GOTO 9055 9052 BEEP:GOTO 9020 9055 GOSUB 20 9057 IF A$=CHR$(27) THEN NU$="":GOTO 9200 9060 IF A$=CHR$(13) OR A$=CHR$(9) OR A$=CHR$(28) OR A$=CHR$(29) THEN 9200 9065 IF A$>="0" AND A$<="9" THEN NU$=NU$+A$:PRINT@BL%+1,NU$;:GOTO 9080 9070 IF A$="+" THEN FG%=1:CALL IN:PRINT@BL%, A$;:CALL NR:GOTO 9055 9075 IF A$="-" THEN FG%=-1:CALL IN:PRINT@BL%,A$;:CALL NR:GOTO 9055 9080 GOSUB 20 9084 IF A$=CHR$(27) THEN NU$="":GOTO 9200 9085 IF A$=CHR$(13) OR A$=CHR$(9) OR A$=CHR$(28) OR A$=CHR$(29) THEN 9200 9090 IF A$=CHR$(8) THEN IF NU$="" THEN BEEP ELSE NU$=MID$(NU$,1,LEN(NU$)-1):PRINT@BL%+1,NU$;" ";:GOTO 9100 9093 IF A$<"0" OR A$>"9" THEN BEEP:GOTO 9080 9095 NU$=NU$+A$ 9100 PRINT@BL%+1,NU$;:GOTO 9080 9200 SM%(BK%,TB%)=SM%(BK%,TB%)+VAL(NU$)*FG%:PRINT@BL%,"";:CALL NR:PRINT USING"\ \";"";:T%(BK%)=T%(BK%)+VAL(NU$)*FG%:GT%=GT%+VAL(NU$)*FG% 9205 GOSUB 2225:' UPDATE TOTALS 9210 CALL NR:PRINT@BL%-40,"";:PRINT USING"#####"; SM%(BK%,TB%);:IF A$=CHR$(28)OR A$=CHR$(9) THEN GOSUB 9400:GOTO 9010 9215 IF A$=CHR$(29) THEN FT%=-1:GOSUB 9400:GOTO 9010 9220 PRINT@MSG%-10,SPACE$(49);:PRINT@MSG%,SM$;:TF%=0:GOSUB 2250 9305 TG%=1:FG%=1:RETURN 9400 TAB%=TAB%+FT%:IF TAB%<1 THEN TAB%=10 ELSE IF TAB%>10 THEN TAB%=1 9410 FT%=1:RETURN: 10000 ' Get Keyboard Input & Test for Valid Response 10010 IF FG%=1 THEN CALL NR:PRINT @ MSG%, SM$;:PRINT@MSG%+15,"RAM = "+STR$(FRE(0));:VD$="+-CFRHNSPQ"+CHR$(9)+CHR$(30)+CHR$(31) 10020 GOSUB 20 10025 IF(A$>="0" AND A$<="9") THEN 10100 10030 IF INSTR(VD$,A$)=0 THEN 10020 ELSE ON INSTR(VD$,A$) GOTO 10035,10085,10074,10045,10040,10050,10060,10070,10075,10080,10065,10077,10078 10035 FG%=1:PRINT @ MSG%,SM$;:GOTO 10010 10040 GOSUB 3000 :GOTO 10010 10045 GOSUB 8000:GOTO 10010 10050 PRINT@MSG%," HELP";:GOSUB 5000:GOTO 10010 10060 GOSUB 4000:GOTO 10010 10065 TF%=1:GOSUB 9000:GOTO 10010 10070 GOSUB 1000:GOTO 10010 10074 GOSUB 700:GOTO 10010 10075 GOSUB 500:GOTO 10010 10077 BF%=-1 10078 GOSUB 800:GOTO 10010 10080 PRINT @MSG%, "QUIT (Y/N)?";:GOSUB 7000:GOTO 10010 10085 FG%=-1:PRINT @MSG%,MN$;:GOTO 10010 10090 GOTO 10020 10100 IF A$="0" THEN V%=9 ELSE V%=VAL(A$)-1 10110 GOSUB 220:GOSUB 600:GOTO 10010