fork download
copy 
  1. \ Diet system
  2.  
  3. variable fruits0
  4. variable vegs0
  5. variable shakes0
  6. variable entrees0
  7. variable pa0
  8. variable cals0
  9. variable fruits
  10. variable vegs
  11. variable shakes
  12. variable entrees
  13. variable pa
  14. variable cals
  15. variable wt
  16. variable day
  17.  
  18. : 0! 0 swap ! ;
  19. : 1+! 1 swap +! ;
  20. : f+ fruits0 1+! ;
  21. : v+ vegs0 1+! ;
  22. : fruit ( cals -- ) create , does> @ * cals0 +! f+ ;
  23. : veg ( cals -- ) create , does> @ * cals0 +! v+ ;
  24. : food ( cals -- ) create , does> @ * cals0 +! ;
  25. : pa+! ( cals -- ) wt @ 150 */ pa0 +! ;
  26. : ex ( cals -- ) create , does> @ * pa+! ;
  27. : pex ( mins*pulse/min -- ) 85 / 300 * 60 / pa+! ;
  28. : eat ( cals -- ) cals0 +! ;
  29. : d. ( -- )
  30.   1 day +!
  31.   cr ." Day:" day ?
  32.   ." S:" shakes0 ? ." E:" entrees0 ?
  33.   ." F:" fruits0 ? ." V:" vegs0 ?
  34.   ." kC:" cals0 @ dup . ." PA:" pa0 @ dup . ." Net:" - .
  35.   shakes0 @ shakes +! shakes0 0!
  36.   entrees0 @ entrees +! entrees0 0!
  37.   fruits0 @ fruits +! fruits0 0!
  38.   vegs0 @ vegs +! vegs0 0!
  39.   cals0 @ cals +! cals0 0!
  40.   pa0 @ pa +! pa0 0!
  41. ;
  42. : wk. ( -- )
  43.   cr ." Week: S:" shakes ? ." E:" entrees ?
  44.   ." F:" fruits ? ." V:" vegs ? ."
  45.   ." kC:" cals @ dup . ." PA:" pa @ dup . ." Net:" - dup .
  46.   ." Wt:"
  47.   wt @ 11 * day @ * swap -  ( -- net cals under  maintenance )
  48.   dup 0> if ." -" else ." +" then  ( for under or over )
  49.   abs 35 / 5 + 10 /  ( lbs change x 10 )
  50.   0 <# # 46 hold #s #> type cr
  51. ;
  52.  
  53. 8 ex el  ( minutes on eliptical )
  54. 100 ex w  ( miles walking )
  55. 6 ex sh  ( minutes shoveling snow )
  56. 7 ex xc ( minutes cross-country skiing )
  57. 5 ex eb ( minutes on ex bike -- )
  58. 3 ex exlow ( minutes low intensity exercise )
  59. 28 ex b ( mi biking -- )
  60. : s ( -- ) 120 eat shakes0 1+! ;
  61. : ce ( -- ) 210 eat shakes0 1+! ;
  62. : en ( cals -- ) eat entrees0 1+! ;
  63. : veat ( #vegs cals -- ) eat vegs0 +! ;
  64.  
  65. 15 fruit oz.apple
  66. 25 fruit oz.banana
  67. 90 fruit c.blueberries
  68. 15 fruit oz.cherries
  69. 15 fruit oz.grapefruit
  70. 100 fruit c.grapes
  71. 14 fruit oz.mango
  72. 10 fruit oz.melon
  73. 17 fruit oz.nectarine
  74. 15 fruit oz.orange
  75. 11 fruit oz.peach
  76. 17 fruit oz.pear
  77. 13 fruit oz.plum
  78. 55 fruit c.strawberries
  79. 7 fruit oz.watermelon
  80.  
  81. 8 veg oz.broccoli
  82. 10 veg oz.brusselssprouts
  83. 5 veg oz.cabbage
  84. 10 veg oz.carrots
  85. 8 veg oz.cauliflower
  86. 25 veg oz.corn
  87. 5 veg oz.cucumber
  88. 7 veg oz.greenbeans
  89. 10 veg c.lettuce
  90. 8 veg oz.mushrooms
  91. 20 veg oz.potato
  92. 40 veg c.squash
  93. 5 veg oz.tomato
  94. 5 veg oz.zucchini
  95.  
  96. 50 food oz.chicken
  97. 25 food oz.fish
  98. 50 food oz.salmon
  99. 75 food oz.bread
  100.  
  101. : ba 4 oz.banana ;
  102. : ap 6 oz.apple ;
  103. : or 6 oz.orange ;
  104. : st 1 c.strawberries ;
  105. : bb 1 c.blueberries ;
  106. : ma 12 oz.mango f+ ;
  107. : ne 6 oz.nectarine ;
  108. : me 16 oz.melon ;
  109. : pl 4 oz.plum ;
  110. : gr 1 c.grapes ;
  111. : ch 8 oz.cherries ;
  112. : 2cb ba ce ce ;
  113. : 2sb ba s s ;
  114. : sa 200 eat 4 vegs0 +! ;
  115. : ps 250 eat 3 vegs0 +! ;
  116. : yo 90 eat ;
  117. : cc 90 eat ; ( 1/2 cup cottage cheese )
  118. : sq 3 c.squash v+ v+ ;
  119. : gf 10 oz.grapefruit f+ ;
  120. : pr 8 oz.pear ;
  121. : pe 8 oz.peach ;
  122. : br 90 eat ;
  123. : fi 8 oz.fish ;
  124. : vs 50 eat v+ ; ( 1 cup vegetable soup )
  125. : gb 10 oz.greenbeans v+ ;
  126. : zu 16 oz.zucchini v+ v+ ;
  127. : cu 12 oz.cucumber v+ ;
  128. : to 6 oz.tomato ;
  129. : co 3 oz.corn ;
  130. : ca 6 oz.carrots ;
  131. : bs 10 oz.brusselssprouts v+ ;
  132. : vm 5 150 veat ;
  133. : mp 2cb ap ba yo 210 en 210 en sa cc fi vm ap ;
  134.  
  135. \ Goal wt. 165 BMI 24 1815 calsb/d
  136. \ B:2cb | L:en 2f yo | D:en sa cc fi 2f
  137.  
  138. 200.8 ( <-- Current weight ) drop 5 + 10 / wt !
  139. \ Assign: W&M, write 1st, no 7-10s!
  140.  
  141. 2cb 60 el ma ne ba 420 en ch ch gr gr 230 en sa cc d.
  142. 2cb gr ba yo 240 en 60 el 220 en sa cc yo ap ne d.
  143. 2cb ba ch ch yo 230 en 12 w 640 en sa cc zu ch ch ne 8 oz.broccoli d.
  144.  
  145. wk.
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
Success #stdin #stdout #stderr 0.01s 5284KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Day:1 S:2 E:2 F:9 V:4 kC:2270 PA:643 Net:1627 
Day:2 S:2 E:2 F:5 V:4 kC:1842 PA:643 Net:1199 
Day:3 S:2 E:2 F:7 V:8 kC:2596 PA:1608 Net:988 
Week: S:6 E:6 F:21 V:16 kC:6708 PA:2894 Net:3814 Wt:-0.8
stderr
copy 
redefined f+  redefined d.  redefined sh  redefined Eb with eb  redefined or  redefined Gb with gb  redefined TO with to
https://ideone.com/2LRm8z
language:
Forth (gforth 0.7.3)
created:
3 days ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!