home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib23a.dsk / JANUARY.1985 / CALORIE.COUNTER.bas < prev    next >
BASIC Source File  |  2023-02-26  |  11KB  |  258 lines
  1. 10  REM  ************************
  2. 20  REM  *    CALORIE.COUNTER   *
  3. 30  REM  *     BY  GARY KNOX    *
  4. 40  REM  *  COPYRIGHT (C) 1985  *
  5. 50  REM  *  BY MICROSPARC, INC  *
  6. 60  REM  *  CONCORD, MA. 01742  *
  7. 70  REM  ************************
  8. 80  TEXT : HOME 
  9. 90  VTAB 5: HTAB 13: PRINT "CALORIE COUNTER": PRINT : HTAB 15: PRINT "BY GARY KNOX": VTAB 20: HTAB 10: PRINT "PRESS ANY KEY TO BEGIN": VTAB 23: PRINT "** COPYRIGHT 1985 BY MICROSPARC, INC. **"
  10. 100  WAIT  -16384,128: POKE  -16368,0
  11. 110  DIM F$(200),C(200),T$(200),N$(20),L(20),A(20)
  12. 120  HOME : VTAB 10: PRINT "PAPER PRINTOUT? Y/N?";: GET PP$
  13. 130  PRINT 
  14. 140 D$ =  CHR$(4):R$ =  CHR$(13):NP = 0:NU = 0: FOR K = 1 TO 50:BL$ = BL$ +" ": NEXT K: GOTO 1080
  15. 150  HOME : IF PP$ < >"Y"  THEN 200
  16. 160  VTAB 10: PRINT "TURN ON PRINTER,": VTAB 14: PRINT "THEN PRESS SPACE BAR": IF  PEEK( -16384) <127  THEN 160
  17. 170  GET A$: PRINT : HOME : PRINT D$"PR#1": PRINT : PRINT "CALORIE LIST FOR "E$: FOR K = 1 TO 80: PRINT "-";: NEXT K: PRINT 
  18. 180  PRINT  TAB( 35)"SERVINGS   CALORIES/SERVING   TOTAL CALORIES": PRINT  TAB( 35);"--------   ----------------   --------------": PRINT D$"PR#0": REM  8 DASHES, 3 SPACES, 16 DASHES, 7 SPACES, 14 DASHES
  19. 190  REM 
  20. 200  REM  ** CHOOSE THE MEAL  **
  21. 210  HOME : PRINT "ENTER CHOICE..."
  22. 220  VTAB 5: HTAB 5: PRINT "(1) BREAKFAST": VTAB 7: HTAB 5: PRINT "(2) LUNCH": VTAB 9: HTAB 5: PRINT "(3) DINNER": VTAB 11: HTAB 5: PRINT "(4) SNACKS": VTAB 13: HTAB 5: PRINT "(5) END PROGRAM"
  23. 230  VTAB 1: HTAB 16: GET A$:A =  VAL(A$): IF A >5  OR A <1  THEN  CALL  -868: GOTO 230
  24. 240  PRINT 
  25. 250  ON A GOTO 260,270,280,290,300
  26. 260 M$ = "BREAKFAST":FF = 0:TC = 0: GOTO 340
  27. 270 M$ = "LUNCH":FF = 0:TC = 0: GOTO 340
  28. 280 M$ = "DINNER":FF = 0:TC = 0: GOTO 340
  29. 290 M$ = "SNACKS":FF = 0:TC = 0: GOTO 340
  30. 300  GOTO 1050
  31. 310  HTAB 7: VTAB 14: PRINT "PRESS   <";: INVERSE : PRINT "RETURN";: NORMAL : PRINT ">  TO GO ON";
  32. 320  POKE 34,4: POKE 35,11: VTAB 5: HOME 
  33. 330  FOR K = B +1 TO R +B
  34. 340  ONERR  GOTO 1700
  35. 350 B = 0:BB = 8
  36. 360  REM  ** GET DATA FOR MEAL
  37. 370  PRINT D$;"OPEN"M$"LIST,L40"
  38. 380  PRINT D$;"READ"M$"LIST,R0"
  39. 390  INPUT NU
  40. 400  FOR K = 1 TO NU
  41. 410  PRINT D$;"READ"M$"LIST,R"K
  42. 420  INPUT F$(K),C(K)
  43. 430 T$(K) = F$(K)
  44. 440  NEXT K
  45. 450  PRINT D$;"CLOSE"M$"LIST"
  46. 460 N = NU: HOME 
  47. 470  REM 
  48. 480  REM  ** MAKE FOOD SELECTION
  49. 490  HTAB (20 - LEN(M$))/2: INVERSE : PRINT "FOOD SELECTIONS FOR "M$: NORMAL 
  50. 500  VTAB 17: PRINT "PRESS  <";: INVERSE : PRINT "Y";: NORMAL : PRINT ">   IF ITEM WAS CONSUMED"
  51. 510  VTAB 19: PRINT "PRESS <";: INVERSE : PRINT "RETURN";: NORMAL : PRINT ">  TO GO TO NEXT SELECTION"
  52. 520  VTAB 21: PRINT "PRESS  <";: INVERSE : PRINT "B";: NORMAL : PRINT ">  TO GO BACK, ONE SELECTION"
  53. 530  VTAB 23: PRINT "PRESS  <";: INVERSE : PRINT "E";: NORMAL : PRINT ">  TO ERASE FOOD FROM DISK FILE";
  54. 540  POKE 34,3: POKE 35,16: VTAB 4: HOME 
  55. 550  GOSUB 1950
  56. 560  IF Q$ < >"NONE"  THEN 740
  57. 570  REM 
  58. 580  REM  ** ADD FOOD TO LIST
  59. 590  HOME : VTAB 10: PRINT "ENTER NAME OF "M$" ITEM": VTAB 12: HTAB 4: INVERSE : PRINT "<";: HTAB 34: PRINT ">";: NORMAL : HTAB 5:LE = 29:LB = 4: VTAB 12: GOSUB 1430
  60. 600 NU = NU +1:B = B +1:F$(NU) = EE$: HOME :K$ = EE$
  61. 610  VTAB 10: HTAB 11: PRINT "ENTER CALORIES IN": VTAB 12: HTAB ((40 - LEN(K$))/2): PRINT K$;: INPUT CA:C(NU) = CA
  62. 620  GOSUB 1600
  63. 630  PRINT D$;"OPEN"M$"LIST,L40"
  64. 640  PRINT D$;"WRITE"M$"LIST,R0"
  65. 650  PRINT NU
  66. 660  FOR DD = 1 TO NU
  67. 670  PRINT D$;"WRITE"M$"LIST,R"DD
  68. 680  PRINT F$(DD);R$;C(DD)
  69. 690  NEXT DD
  70. 700  PRINT D$;"CLOSE"M$"LIST"
  71. 710  GOSUB 1560
  72. 720 C = C +QQ *CA
  73. 730  GOTO 760
  74. 740 K$ = T$(B):CA = C(B): GOSUB 1560
  75. 750 C = C +QQ *C(B)
  76. 760  IF PP$ = "N"  THEN 820
  77. 770  REM 
  78. 780  REM  ** PRINT ROUTINES **
  79. 790 SC = QQ *CA:L1 =  LEN( STR$(QQ)):L2 =  LEN( STR$(CA)):L3 =  LEN( STR$(SC)):B$ = "": FOR K = 1 TO 50:B$ = B$ +"-": NEXT K
  80. 800  PRINT D$"PR#1": PRINT K$;: PRINT  LEFT$(B$,33 - LEN(K$));
  81. 810 S$ =  LEFT$(BL$,6 -L1) + STR$(QQ) + LEFT$(BL$,17 -L2) + STR$(CA) + LEFT$(BL$,19 -L3) + STR$(SC): PRINT S$: PRINT D$"PR#0":TC = TC +SC
  82. 820  HOME : IF C >LI  THEN 1340
  83. 830  HOME : INVERSE : VTAB 3: HTAB ((40 - LEN(M$))/2): PRINT M$: NORMAL 
  84. 840  VTAB 7: PRINT "SERVINGS";: FOR K = 1 TO 22: PRINT "-";: NEXT K: PRINT QQ
  85. 850  VTAB 9: PRINT "CALORIES/SERVING";: FOR K = 1 TO 14: PRINT "-";: NEXT K: PRINT CA
  86. 860  VTAB 11: PRINT "TOTAL CALORIES";: FOR K = 1 TO 16: PRINT "-";: NEXT K: PRINT QQ *CA
  87. 870  VTAB 13: PRINT "TOTAL CALORIES FOR THE DAY----"C
  88. 880  VTAB 21: PRINT "<";: INVERSE : PRINT "Q";: NORMAL : PRINT "> TO QUIT      <";: INVERSE : PRINT "RETURN";: NORMAL : PRINT "> TO GO ON";
  89. 890  GET A$: IF A$ = "Q"  THEN  PRINT : GOTO 920
  90. 900  IF FF = 1  THEN 590
  91. 910  HOME : GOTO 470
  92. 920  HOME : VTAB 10: PRINT "FIGURE CALORIES FOR ANOTHER MEAL? Y/N?";: GET A$: PRINT 
  93. 930  IF PP$ = "N"  THEN 990
  94. 940  PRINT D$"PR#1": FOR K = 1 TO 80: PRINT "-";: NEXT K: PRINT :S$ = "  TOTAL CALORIES FOR " +M$:L1 = 75 - LEN(S$) - LEN( STR$(TC))
  95. 950 S$ = S$ + LEFT$(BL$,L1) + STR$(TC): PRINT S$
  96. 960 S$ = "  TOTAL CALORIES FOR THE DAY":L1 = 47 - LEN( STR$(C))
  97. 970 S$ = S$ + LEFT$(BL$,L1) + STR$(C): PRINT S$: PRINT : PRINT : PRINT : PRINT : PRINT : PRINT D$"PR#0"
  98. 980  IF A$ = "Y"  THEN  HOME : VTAB 10: PRINT "PRESS THE <RETURN> KEY TO GO ON...";: GOTO 170
  99. 990  IF A$ = "Y"  THEN 200
  100. 1000  HOME : VTAB 10: INPUT "PRESS THE <RETURN> KEY TO QUIT...";A$
  101. 1010  PRINT D$;"OPEN PEOPLE,L35"
  102. 1020  PRINT D$;"WRITE PEOPLE,R"P
  103. 1030  PRINT E$;R$;LI;R$;C
  104. 1040  PRINT D$"CLOSE PEOPLE"
  105. 1050  HOME : END 
  106. 1060  REM 
  107. 1070  REM  ** GET NAMES AND CALORIE LIMITS
  108. 1080  ONERR  GOTO 1800
  109. 1090 B = 0:BB = 5
  110. 1100  PRINT D$;"OPEN PEOPLE,L35"
  111. 1110  PRINT D$;"READ PEOPLE,R0"
  112. 1120  INPUT NP
  113. 1130  FOR K = 1 TO NP
  114. 1140  PRINT D$;"READ PEOPLE,R"K
  115. 1150  INPUT N$(K),L(K),A(K)
  116. 1160 T$(K) = N$(K)
  117. 1170  NEXT K
  118. 1180  PRINT D$;"CLOSE PEOPLE"
  119. 1190  REM  ** DISPLAY NAMES
  120. 1200 N = NP
  121. 1210  HOME : INVERSE : HTAB 11: PRINT "PEOPLE ON FILE": NORMAL 
  122. 1220  VTAB 16: PRINT "PRESS  <";: INVERSE : PRINT "Y";: NORMAL : PRINT ">  IF SELECTION IS YOUR NAME"
  123. 1230  VTAB 18: PRINT "PRESS  <";: INVERSE : PRINT "RETURN";: NORMAL : PRINT ">  TO GO ON";: POKE 34,3: POKE 35,11: VTAB 4: HOME 
  124. 1240  VTAB 20: PRINT "PRESS  <";: INVERSE : PRINT "B";: NORMAL : PRINT ">  TO GO BACK, ONE SELECTION"
  125. 1250  GOSUB 1950
  126. 1260  IF Q$ = "NONE"  THEN 1800
  127. 1270  HOME : VTAB 10: PRINT "CHANGE YOUR  CALORIE LIMIT?": HTAB 14: VTAB 12: PRINT "Y/N? ";: GET A$: IF A$ = "N"  THEN 1300
  128. 1280  IF A$ < >"Y"  THEN 1270
  129. 1290  PRINT : VTAB 16: INPUT "ENTER YOUR NEW CALORIE LIMIT ";A$:L(B) =  VAL(A$): IF L(B) < = 0  THEN  VTAB 14: CALL  -868: GOTO 1290
  130. 1300 E$ = T$(B):LI = L(B):C = A(B):P = B: HOME : VTAB 10: PRINT "FIRST MEAL FOR THE DAY? Y/N? ";: GET A$: IF A$ = "Y"  THEN C = 0:A(B) = 0
  131. 1310  GOTO 150
  132. 1320  REM 
  133. 1330  REM  ** EXCEEDED CALORIE LIMIT WARNING
  134. 1340  HOME : VTAB 6: HTAB 15: FLASH : PRINT "WARNING": NORMAL : VTAB 8: PRINT "YOU ARE OVER YOUR "LI" CALORIE LIMIT!"
  135. 1350  VTAB 12: HTAB (27 - LEN(E$))/2: INVERSE : PRINT " STOP EATING ";: NORMAL : PRINT ", "E$
  136. 1360  HTAB 6: VTAB 14: PRINT "YOU HAVE EATEN "C" CALORIES!"
  137. 1370  FOR K = 1 TO 2000: NEXT K
  138. 1380  VTAB 17: PRINT "PRESS Q TO QUIT OR RETURN TO GO ON ";: GET A$: IF A$ < >"Q"  AND FF = 0  THEN  HOME : PRINT : GOTO 490
  139. 1390  PRINT : IF A$ < >"Q"  AND FF = 1  THEN 590
  140. 1400  GOTO 920
  141. 1410  REM 
  142. 1420  REM  ** ENTER A WORD ROUTINE
  143. 1430 EE$ = "":CC = 0
  144. 1440  GET V$
  145. 1450  IF  ASC(V$) = 21  THEN V$ = " ": GOTO 1510
  146. 1460  IF  ASC(V$) = 13  THEN 1530
  147. 1470  IF  ASC(V$) < >8  THEN 1510
  148. 1480  IF  POS(0) = LB  THEN 1440
  149. 1490  IF CC = 1  THEN EE$ = "": CALL  -1008: PRINT " ";:CC = CC -1: CALL  -1008: GOTO 1440
  150. 1500 EE$ =  LEFT$(EE$,CC -1): CALL  -1008: PRINT " ";:CC = CC -1: CALL  -1008: GOTO 1440
  151. 1510  IF CC <(LE)  THEN CC = CC +1:EE$ = EE$ +V$: PRINT V$;: GOTO 1440
  152. 1520  GOTO 1440
  153. 1530  RETURN 
  154. 1540  REM 
  155. 1550  REM  ** HELPINGS ROUTINE
  156. 1560  HOME : VTAB 8: HTAB 8: PRINT "ENTER # OF HELPINGS FOR"
  157. 1570  VTAB 10: HTAB ((40 - LEN(K$))/2): PRINT K$;: INPUT QQ: RETURN 
  158. 1580  REM 
  159. 1590  REM  ** ALPHABETIZE NAMES ROUTINE
  160. 1600  FOR DD = NU -1 TO 1  STEP  -1
  161. 1610  IF F$(DD) <K$  THEN 1650
  162. 1620 F$(DD +1) = F$(DD)
  163. 1630 C(DD +1) = C(DD)
  164. 1640  NEXT DD
  165. 1650 F$(DD +1) = K$
  166. 1660 C(DD +1) = CA
  167. 1670  RETURN 
  168. 1680  REM 
  169. 1690  REM  ** OPEN A NEW FILE ROUTINE
  170. 1700  PRINT D$;"CLOSE"
  171. 1710 NU = 0: POKE 216,0: IF  PEEK(222) < >5  THEN 2490
  172. 1720  PRINT D$;"OPEN"M$"LIST,L40"
  173. 1730  PRINT D$;"WRITE"M$"LIST,R0"
  174. 1740  PRINT NU
  175. 1750  PRINT D$;"CLOSE"M$"LIST"
  176. 1760 FF = 1
  177. 1770  GOTO 590
  178. 1780  REM 
  179. 1790  REM  ** ADD A PERSON TO DISK FILE
  180. 1800  PRINT D$;"CLOSE": POKE 34,0: POKE 35,24: POKE 216,0: IF  PEEK(222) < >5  AND Q$ < >"NONE"  THEN 2490
  181. 1810  HOME : VTAB 8: PRINT "ENTER YOUR NAME": VTAB 12: HTAB 5: INVERSE : PRINT "<";: HTAB 25: PRINT ">": NORMAL : HTAB 6:LE = 19:LB = 5: VTAB 12: GOSUB 1430:E$ = EE$: IF E$ = ""  THEN  PRINT  CHR$(7): GOTO 1810
  182. 1820  HOME : VTAB 10: PRINT "ENTER YOUR CALORIE LIMIT FOR ONE DAY.": VTAB 12: HTAB 18: INPUT Q$:LI =  VAL(Q$): IF LI <0  THEN 1820
  183. 1830 NP = NP +1
  184. 1840 P = NP:AA = 0
  185. 1850  PRINT : HOME 
  186. 1860  PRINT D$;"OPEN PEOPLE,L35"
  187. 1870  PRINT D$;"WRITE PEOPLE,R0"
  188. 1880  PRINT NP
  189. 1890  PRINT D$;"WRITE PEOPLE,R"NP
  190. 1900  PRINT E$;R$;LI;R$;AA
  191. 1910  PRINT D$;"CLOSE PEOPLE"
  192. 1920  GOTO 150
  193. 1930  REM 
  194. 1940  REM  ** DISPLAY CHOICES ROUTINE
  195. 1950 A =  INT((N -B)/BB):R = N -B -A *BB
  196. 1960 UU = 0:U = 0
  197. 1970  IF R >0  THEN UU = 1
  198. 1980  IF A = 0  THEN 2160
  199. 1990  FOR U = 1 TO A
  200. 2000  HTAB 15: VTAB 3: INVERSE : PRINT "PAGE": HTAB 13: NORMAL : PRINT "("U" OF "A +UU")"
  201. 2010  VTAB 6
  202. 2020  FOR K = B +1 TO B +BB
  203. 2030  PRINT " .."T$(K)
  204. 2040  NEXT K
  205. 2050  FOR K = 1 TO BB
  206. 2060 B = B +1
  207. 2070  VTAB K +5: GET Q$
  208. 2080  IF Q$ = "E"  AND BB = 8  THEN  GOSUB 2370:B = B -1: HOME : GOTO 1950
  209. 2090  IF Q$ = "B"  AND K = 1  THEN 2070
  210. 2100  IF Q$ = "B"  THEN K = K -1:B = B -1: GOTO 2070
  211. 2110  IF Q$ = "Y"  THEN Q$ = T$(B): GOTO 2320
  212. 2120  IF  ASC(Q$) < >13  THEN 2070
  213. 2130  NEXT K
  214. 2140  HOME 
  215. 2150  NEXT U:U = U -1
  216. 2160  IF R = 0  THEN 2310
  217. 2170  HTAB 15: VTAB 3: INVERSE : PRINT "PAGE": HTAB 13: NORMAL : PRINT "("U +1" OF "A +UU")"
  218. 2180  VTAB 6
  219. 2190  FOR K = B +1 TO R +B
  220. 2200  PRINT " .."T$(K)
  221. 2210  NEXT K
  222. 2220  FOR K = 1 TO R
  223. 2230 B = B +1
  224. 2240  VTAB K +5: GET Q$
  225. 2250  IF Q$ = "E"  AND BB = 8  THEN  GOSUB 2370:B = B -1: HOME : GOTO 1950
  226. 2260  IF Q$ = "B"  AND K = 1  THEN 2240
  227. 2270  IF Q$ = "B"  THEN K = K -1:B = B -1: GOTO 2240
  228. 2280  IF Q$ = "Y"  THEN Q$ = T$(B): GOTO 2320
  229. 2290  IF  ASC(Q$) < >13  THEN 2240
  230. 2300  NEXT K
  231. 2310 Q$ = "NONE"
  232. 2320  POKE 34,0: POKE 35,24: PRINT : HOME 
  233. 2330  IF B = N  THEN FF = 1
  234. 2340  RETURN 
  235. 2350  REM 
  236. 2360  REM  ** DELETE FOOD FROM FILE **
  237. 2370  IF B = NU  THEN 2390
  238. 2380  FOR DD = B TO NU -1:F$(DD) = F$(DD +1):C(DD) = C(DD +1):T$(DD) = T$(DD +1): NEXT DD
  239. 2390 NU = NU -1:N = N -1: PRINT 
  240. 2400  PRINT D$;"OPEN"M$"LIST,L40"
  241. 2410  PRINT D$;"WRITE"M$"LIST,R0"
  242. 2420  PRINT NU
  243. 2430  FOR DD = 1 TO NU
  244. 2440  PRINT D$;"WRITE"M$"LIST,R"DD
  245. 2450  PRINT F$(DD);R$;C(DD)
  246. 2460  NEXT DD
  247. 2470  PRINT D$;"CLOSE"
  248. 2480  RETURN 
  249. 2490  REM  ERROR TRAP
  250. 2500 ER =  PEEK(222)
  251. 2510  IF ER = 4  THEN  PRINT "DISK WRITE PROTECTED": GOTO 2570
  252. 2520  IF ER = 8  THEN  PRINT "DISK I/O ERROR": GOTO 2570
  253. 2530  IF ER = 9  THEN  PRINT "DISK FULL": GOTO 2570
  254. 2540  IF ER = 10  THEN  PRINT "FILE LOCKED": GOTO 2570
  255. 2550  IF ER = 13  THEN  PRINT "FILE TYPE MISMATCH": GOTO 2570
  256. 2560  PRINT "ERROR #";ER"IN LINE "; PEEK(218) + PEEK(219) *256
  257. 2570  PRINT "DO YOU WISH TO RESTART?(Y/N)";: GET K$: IF K$ = "Y"  THEN  PRINT : GOTO 140
  258. 2580  END