home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / bus / tally.ba < prev    next >
Text File  |  2006-10-19  |  10KB  |  231 lines
  1. 10 '  TALLY.BA VERS. 5.6
  2. 11 '  Tally counter for the Radio Shack Model 100 computer  
  3. 12 '  Author - William G. Voigt  
  4. 13 '  Division of Biological Control  
  5. 14 '  U.C. Berkeley  (415) 643-6367 or (415) 232-6962 (h)
  6. 15 '  27 NOVEMBER 1987
  7. 16 'CLUB 100 Library - 415/939-1246 BBS,    937-5039 NEWSLETTER, 932-8856 VOICE
  8. 17 CLEAR 1000:GOTO 30
  9. 20 '   CHANGE TO UPPERCASE
  10. 22 A$=INKEY$:IF A$="" THEN 22
  11. 25 A$=CHR$(ASC(A$)+(A$<CHR$(123) AND A$>CHR$(96))*32):RETURN
  12. 30 KEY OFF:CLS: MAXFILES=2
  13. 32 FT%=1:TF%=0:TG%=1:TT%=153:BK%=1:MSG%=280:TAB%=1:BF%=1:NF%=1
  14. 50 IN=17001:NR=17006:FG%=1:DIM SM%(4,10),NA$(4,10):CLS 
  15. 65 SM$="  SUM     ":MN$="DECREMENT ":PC$=" PERCENT "
  16. 70 GOSUB 7500:GOSUB 2100:GOSUB 2200
  17. 80 GOTO 10000
  18. 200 ' INCREMENT
  19. 220 SM%(BK%,V%)=SM%(BK%,V%)+FG%  
  20. 230 GT%=GT%+FG%  
  21. 240 GOSUB 2225:'        Print Totals
  22. 250 FG%=1  
  23. 260 RETURN  
  24. 400 ' PRINT MESSAGE
  25. 405 PRINT@(MSG%-10),SPACE$(49);:CALL IN:PRINT@MSG%-7,"<";
  26. 410 FOR I=1 TO 4:PRINTCHR$(156-I);:NEXT:PRINT">";:CALL NR:PRINT@MSG%+33,"SELECT";:RETURN
  27. 500 '        Display Percentages 
  28. 510 IF GT%=0 THEN 580 ELSE PRINT@MSG%,PC$; 
  29. 520 FOR I=0 TO 9 :PCT=SM%(BK%,I)*100/GT% 
  30. 530 PRINT @81+(IMOD5)*6-(I>4)*160,"";:PRINT USING "##.##";PCT;  
  31. 540 NEXT 
  32. 550 GOSUB 20
  33. 560 IF A$=CHR$(30) THEN BF%=-1 ELSE IF A$=CHR$(31)THEN BF%=1 ELSE 570
  34. 565 PF%=1:GOSUB 800:GOTO 520
  35. 570 FOR I = 0 TO 9:PRINT @81+(IMOD5)*6-(I>4)*160,"";:PRINT USING "#####";SM%(BK%,I);  
  36. 575 NEXT 
  37. 580 PRINT@MSG%,SM$;:PF%=0:RETURN 
  38. 600 '            PRINT TOTAL  
  39. 610 '        Print SM(V%)  
  40. 620 PRINT @82+((V%)MOD5)*6-((V%)>4)*160,"";:PRINT USING "####";SM%(BK%,V%)  
  41. 625 PRINT@TT%+80,"";:PRINTUSING"#####";GT%; 
  42. 650 FG%=1  
  43. 660 RETURN  
  44. 700 IF FN$="" THEN FN$=FO$:' ENTER COMMENTS
  45. 710 CLS:PRINT"ENTER COMMENTS (255 CHARACTERS MAX)":PRINT"DATE & TIME WILL BE ADDED AUTOMATICALLY":INPUT CM$
  46. 720 OPEN FN$ FOR APPEND AS 1
  47. 730 PRINT#1,Q$;DATE$;Q$;" ";Q$;TIME$Q$;" ";Q$;CM$Q$:CLOSE
  48. 750 GOSUB 2000:GOSUB 2200
  49. 760 RETURN
  50. 800 '         Bank Subroutines  
  51. 810 BK%=BK%+BF%:IF BK%>4 THEN BK%=1 ELSE IF BK%<1 THEN BK%=4 
  52. 820 GOSUB 2225:GOSUB 2100
  53. 830 IF TF%=1 THEN CALL IN:PRINT@BL%,"+";:CALL NR
  54. 835 IF FN%=1 THEN PRINT@BL%,"";:PRINTUSING"\   \";NA$(BK%,TB%);
  55. 840 BF%=1:RETURN
  56. 1000 ' SAVE RESULTS TO A TEXT FILE  
  57. 1010 PRINT@MSG%,"SAVING TO ";FO$;
  58. 1048 OPEN FO$ FOR APPEND AS 1  
  59. 1050 IF NF%=1 THEN 1055 ELSE 1067:' Save names if they've been changed, else don't.  
  60. 1055 OPEN"NAMES.DO"FOR OUTPUT AS 2:PRINT#2,FO$;",";
  61. 1060  FOR J = 1 TO 4 : FOR I=0 TO 9 
  62. 1065 PRINT#1,CHR$(34);NA$(J,I);CHR$(34);",";:PRINT#2,NA$(J,I);",";:NEXT:NEXT:PRINT#1,"":PRINT#2,""
  63. 1067 FOR J = 1 TO 4 
  64. 1070 FOR I=0 TO 9 
  65. 1075  PRINT #1, SM%(J,I);",";:NEXT:NEXT
  66. 1080  PRINT #1,CHR$(34);DATE$;CHR$(34);"   ";CHR$(34);TIME$ ;CHR$(34)
  67. 1100 CLOSE:X=FRE("")
  68. 1220 ':IF EF%=1 THEN 1280 ELSE PRINT@msg,"RESET VALUES? (Y/N)";
  69. 1225 ' GOSUB 20
  70. 1230  GOSUB 3500
  71. 1260 NF%=0
  72. 1270 PRINT@MSG%,SPACE$(29);:PRINT@MSG%,SM$;:PRINT@MSG%+15,"RAM = "+STR$(FRE(0));
  73. 1280 RETURN  
  74. 2000 'Screen  
  75. 2005 CLS
  76. 2100 CALL NR
  77. 2110 FOR I = 0 TO 9  
  78. 2120 PRINT @1+(IMOD5)*6-(I>4)*160," (";RIGHT$(STR$(I+1),1);")";  
  79. 2130 CALL IN:PRINT @41+(IMOD5)*6-(I>4)*160,"";:PRINT USING "\   \";NA$(BK%,I); :CALL NR 
  80. 2140 IF PF%=1 THEN 2150 ELSE PRINT @81+(IMOD5)*6-(I>4)*160,"";:PRINT USING "#####";SM%(BK%,I);  
  81. 2150 NEXT  
  82. 2160 RETURN
  83. 2200 CALL IN:PRINT @33,"Bank #";:CALL NR
  84. 2205 CALL IN:PRINT@113," File ";:CALL NR
  85. 2207 PRINT@153,"";:PRINT USING "\    \";FO$;
  86. 2210 CALL IN:PRINT@TT%+39,"";:PRINT"GR.TOTAL";:CALL NR
  87. 2225 PRINT @74,"";:PRINT USING " # ";BK%;  
  88. 2240 PRINT@TT%+80,"";:PRINTUSING"#####";GT%;
  89. 2250 IF FN%=0 AND TF%=0 THEN CALL IN:PRINT @TT%+120,"<H>";:CALL NR:PRINT"elp";:CALL IN: PRINT@TT%+160,"<"CHR$(81);">";:CALL NR:PRINT;"uit";  
  90. 2260 RETURN  
  91. 3000 '      Reset numbers to Zero  
  92. 3005 PRINT@MSG%,"ENTER NUMBER TO BE RESET  ";:
  93. 3010 GOSUB 20 
  94. 3015 IF A$=CHR$(13) THEN 3160  
  95. 3020 IF A$= "A" THEN GOSUB 3500 :GOTO 3160
  96. 3030 IF A$=CHR$(30)THEN BF%=-1 ELSE IF A$=CHR$(31) THEN BF%=1 ELSE GOTO 3040
  97. 3035 GOSUB 800:GOTO 3155
  98. 3040 IF A$<"0" OR  A$>"9" THEN BEEP:GOTO 3010  
  99. 3045 IF A$="0" THEN A$="10"
  100. 3050 V%=VAL(A$)-1  
  101. 3100 GT%=GT%-SM%(BK%,V%):SM%(BK%,V%)=0
  102. 3115 GOSUB 600  
  103. 3155 ' GOTO 3005
  104. 3160 PRINT @MSG%,SPACE$(39);: PRINT @MSG%,SM$;
  105. 3170 RETURN 
  106. 3500 GT%=0  
  107. 3510 FOR J = 1 TO 4 :T%(J)=0
  108. 3515 FOR I= 0 TO 9 :SM%(J,I)=0 :NEXT :NEXT 
  109. 3650 FG%=1:CALL NR:PRINT @ MSG%,SPACE$(29);  
  110. 3670 GOSUB 2100:GOSUB 2200:RETURN  
  111. 4000 '            NAME SUBROUTINE  
  112. 4005 GOSUB 400
  113. 4010 TB%=TAB%-1:FN%=1
  114. 4015 NM$=NA$(BK%,TB%):GOSUB 4520
  115. 4020 BL%=41+(TB%MOD5)*6-(TB%>4)*160: CALL NR:PRINT @BL%,"";:PRINT USING "\   \";NA$(BK%,TB%);
  116. 4025 GOSUB 20
  117. 4030 IF A$=CHR$(13) THEN FM%=1:GOTO 4170
  118. 4060 IF A$=CHR$(31) THEN GOSUB 800:GOTO 4015
  119. 4070 IF A$=CHR$(30) THEN BF%=-1:GOSUB 800:GOTO 4015         
  120. 4080 IF A$=CHR$(8) THEN 4125
  121. 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
  122. 4100 IF A$=CHR$(29) THEN PRINT @BL%,"";:CALL IN:PRINT USING"\   \";NA$(BK%,TB%);:NM$="":CALL NR:NF%=-1:GOSUB 4300:GOTO 4010
  123. 4110 NF%=1:NM$="":GOSUB 4500
  124. 4120 GOSUB 20
  125. 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
  126. 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
  127. 4135 IF A$=CHR$(9) OR A$=CHR$(28) OR A$=CHR$(13)THEN NF%=1:GOSUB 4300:FM%=1:GOTO 4170
  128. 4140 IF A$=CHR$(27) THEN 4185
  129. 4150 IF A$=CHR$(29) THEN GOTO 4170 ELSE IF A$<CHR$(32) THEN BEEP:GOTO 4120
  130. 4160 GOSUB 4500;:GOTO 4120
  131. 4170 CALL IN:PRINT @BL%,"";:PRINT USING "\   \";NA$(BK%,TB%);:CALL NR
  132. 4180 IF FM%=0 THEN GOTO 4010
  133. 4185 FM%=0
  134. 4190 PRINT @MSG%,SPACE$(30);:PRINT@ MSG%, SM$;
  135. 4200 FN%=0:GOSUB 2250:RETURN
  136. 4300 TAB%=TAB%+NF%:IF TAB%>10 THEN TAB%=1 ELSE IF TAB%<1 THEN TAB%=10
  137. 4310 NF%=1:RETURN
  138. 4500 IF LEN(NM$)>15 THEN BEEP:GOTO 4520
  139. 4510 IF A$=CHR$(8) THEN 4520  ELSE NM$=NM$+A$
  140. 4520 PRINT@MSG%,"NAME(";MID$(STR$(TB%+1),2,15);"): ";: PRINTUSING"\             \";NM$;:RETURN
  141. 5000 '         HELP SCREEN  
  142. 5005 PRINT @MSG%,"  HELP  ";  
  143. 5010 CALL IN:PRINT @30,"<";CHR$(152);" ";CHR$(153);">";:CALL NR :PRINT"Bank";:
  144. 5011 CALL IN:PRINT @70,"<TAB>";:CALL NR:PRINT"Entry";
  145. 5015 CALL IN:PRINT@110,"<-+>"; :CALL NR: PRINT "Reduce ";  
  146. 5020 CALL IN:PRINT @150,"<F>";:CALL NR: PRINT "ile  ";  
  147. 5030 CALL IN:PRINT @190,"<R>";:CALL NR: PRINT "eset   ";  
  148. 5040 CALL IN:PRINT @230,"<P>";:CALL NR: PRINT "ercent ";   
  149. 5050 CALL IN:PRINT @270,"<N>";:CALL NR: PRINT "ame    ";  
  150. 5060 CALL IN:PRINT @310,"<S>";:CALL NR: PRINT "ave   ";  
  151. 5100 GOSUB 20
  152. 5200 FOR I=0 TO 6: PRINT @30+(I*40),SPACE$(10);:NEXT:PRINT@300,SPACE$(18); 
  153. 5205 PRINT@39," ";
  154. 5210 GOSUB 2200
  155. 5310 PRINT@MSG%,SM$;:RETURN 
  156. 7000 '    quit 
  157. 7010 GOSUB 20:IF A$="Y" THEN EF%=1 ELSE RETURN
  158. 7015 PRINT@MSG%,"SAVE DATA?  ";:GOSUB20:
  159. 7016 IF A$="Y" THEN GOSUB 1000 
  160. 7017 CALL 16964:CLS:END
  161. 7020 PRINT @MSG%,SM$;SPACE$(12);:RETURN
  162. 7500 ' READ NAMES FROM FILE
  163. 7510 ON ERR GOSUB 7600
  164. 7520 OPEN "NAMES.DO" FOR INPUT AS 1: INPUT #1,FO$
  165. 7530 FOR I=1 TO 4:FOR J=0 TO 9:IF EOF(1)THEN I=4 :J=9:GOTO 7540
  166. 7535 INPUT #1,NA$(I,J)
  167. 7540 NEXT:NEXT:CLOSE
  168. 7550 RETURN
  169. 7600 PRINT@MSG%,"NAMES file not found, creating now;:BEEP
  170. 7610 GOSUB 1000:RETURN
  171. 8000 '    Change Data File
  172. 8010 CALL 16959:PRINT@MSG%,"New File <";FO$;:INPUT">:";F$
  173. 8020 IF F$="" THEN F$=FO$
  174. 8022 FO$=F$:PRINT@153,"";:PRINTUSING "\    \";FO$;
  175. 8025 PRINT@MSG%,SPACE$(30);:RETURN
  176. 9000 '  Input Large Numbers
  177. 9005 TF%=1:GOSUB 400
  178. 9010 NU$="":IF TAB%=6 THEN PRINT@MSG%,SPACE$(10); ELSE PRINT@MSG%," ENTRY ";
  179. 9015 TB%=TAB%-1:BL%=121+(TB%MOD5)*6-(TB% >4)*160: CALL IN:PRINT@BL%,"+";:CALL NR
  180. 9020 GOSUB 20
  181. 9025 IF A$="-" THEN FG%=-1:CALL IN:PRINT @BL%,"-";:CALL NR:GOTO 9055
  182. 9030 IF A$=CHR$(31) THEN BF%=1:GOSUB 800:GOTO 9020
  183. 9035 IF A$=CHR$(30) THEN BF%=-1:GOSUB 800:GOTO 9020
  184. 9040 IF A$=CHR$(28)OR A$=CHR$(9) THEN PRINT@BL%,"     ";:GOSUB 9400:GOTO 9010
  185. 9043 IF A$=CHR$(29) THEN PRINT@BL%,"     ";:CALL NR:FT%=-1:GOSUB9400:GOTO 9010
  186. 9045 IF A$=CHR$(13)  THEN 9200 
  187. 9050 IF A$>"0" AND A$<="9" THEN NU$=NU$+A$:PRINT@BL%+1,NU$;:GOTO 9055
  188. 9052 BEEP:GOTO 9020
  189. 9055 GOSUB 20
  190. 9057 IF A$=CHR$(27) THEN NU$="":GOTO 9200
  191. 9060 IF A$=CHR$(13) OR A$=CHR$(9) OR A$=CHR$(28) OR A$=CHR$(29) THEN 9200 
  192. 9065 IF A$>="0" AND A$<="9" THEN NU$=NU$+A$:PRINT@BL%+1,NU$;:GOTO 9080
  193. 9070 IF A$="+" THEN FG%=1:CALL IN:PRINT@BL%, A$;:CALL NR:GOTO 9055
  194. 9075 IF A$="-" THEN FG%=-1:CALL IN:PRINT@BL%,A$;:CALL NR:GOTO 9055
  195. 9080 GOSUB 20
  196. 9084 IF A$=CHR$(27) THEN NU$="":GOTO 9200
  197. 9085 IF A$=CHR$(13) OR A$=CHR$(9) OR A$=CHR$(28) OR A$=CHR$(29) THEN 9200 
  198. 9090 IF A$=CHR$(8) THEN IF NU$="" THEN BEEP ELSE NU$=MID$(NU$,1,LEN(NU$)-1):PRINT@BL%+1,NU$;" ";:GOTO 9100
  199. 9093 IF A$<"0" OR A$>"9" THEN BEEP:GOTO 9080
  200. 9095 NU$=NU$+A$
  201. 9100 PRINT@BL%+1,NU$;:GOTO 9080
  202. 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%
  203. 9205 GOSUB 2225:' UPDATE TOTALS
  204. 9210 CALL NR:PRINT@BL%-40,"";:PRINT USING"#####"; SM%(BK%,TB%);:IF A$=CHR$(28)OR A$=CHR$(9) THEN GOSUB 9400:GOTO 9010
  205. 9215 IF A$=CHR$(29) THEN FT%=-1:GOSUB 9400:GOTO 9010        
  206. 9220 PRINT@MSG%-10,SPACE$(49);:PRINT@MSG%,SM$;:TF%=0:GOSUB 2250
  207. 9305 TG%=1:FG%=1:RETURN
  208. 9400 TAB%=TAB%+FT%:IF TAB%<1 THEN TAB%=10 ELSE IF TAB%>10 THEN TAB%=1
  209. 9410 FT%=1:RETURN:
  210. 10000 ' Get Keyboard Input & Test for Valid Response
  211. 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)  
  212. 10020 GOSUB 20
  213. 10025 IF(A$>="0" AND A$<="9") THEN 10100
  214. 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
  215. 10035 FG%=1:PRINT @ MSG%,SM$;:GOTO 10010  
  216. 10040 GOSUB 3000 :GOTO 10010
  217. 10045 GOSUB 8000:GOTO 10010
  218. 10050 PRINT@MSG%," HELP";:GOSUB 5000:GOTO 10010
  219. 10060 GOSUB 4000:GOTO 10010
  220. 10065 TF%=1:GOSUB 9000:GOTO 10010
  221. 10070 GOSUB 1000:GOTO 10010
  222. 10074 GOSUB 700:GOTO 10010
  223. 10075 GOSUB 500:GOTO 10010
  224. 10077 BF%=-1
  225. 10078 GOSUB 800:GOTO 10010
  226. 10080 PRINT @MSG%, "QUIT (Y/N)?";:GOSUB 7000:GOTO 10010
  227. 10085 FG%=-1:PRINT @MSG%,MN$;:GOTO 10010
  228. 10090 GOTO 10020  
  229. 10100 IF A$="0" THEN V%=9 ELSE V%=VAL(A$)-1  
  230. 10110 GOSUB 220:GOSUB 600:GOTO 10010
  231.