home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1989 April / 64er_Magazin_89-04_1989_Markt__Technik_de.d64 / biorhythmus (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  6KB  |  207 lines
  1. 100 rem *******************************
  2. 110 rem *                             *
  3. 120 rem * b. jakubaschk martin ruof   *
  4. 130 rem * neue str.14/1 brunnenstr.17 *
  5. 140 rem * 7000 stgt. 10 7238 oberndf. *
  6. 150 rem *                             *
  7. 160 rem * 0711/462989   07423/4525    *
  8. 170 rem *                             *
  9. 180 rem *******************************
  10. 190 :
  11. 1000 rem biorhythmische studien
  12. 1010 :
  13. 1020 if peek(49153)<>169 then load"bio.mc",8,1
  14. 1030 sys 49152
  15. 1040 poke648,196:poke56576,148:poke53272,19
  16. 1050 :
  17. 1060 dim ml(12),wt$(6):gosub10510
  18. 1070 poke53280,11:poke53281,11
  19. 1080 :
  20. 1500 print"[147][150] abcdefghijklmno[146][194].[202]akubaschk & [205].[210]uof"
  21. 1510 print"[163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
  22. 1520 print" [199]eben [211]ie bitte [201]hr [199]eburtsdatum an."
  23. 1530 print" [199]eburtsdatum  :";:gosub11000
  24. 1540 gj=j:gosub 10000
  25. 1550 print" [211]ie sind an einem ";wt$;" geboren."
  26. 1560 print" [196]as julianische [196]atum [201]hres [199]eburts-    tages lautet:"jd
  27. 1570 jg=jd:gt=t:gm=m
  28. 1580 print" [199]eben [211]ie nun das heutige [196]atum an."
  29. 1590 print" heutiges [196]atum:";:gosub12000
  30. 1600 cf=1
  31. 1610 gosub11030
  32. 1620 gosub12500 : gosub 10000
  33. 1630 print" [200]eute ist ";wt$;"."
  34. 1640 print" [202]ulianisches [196]atum:";jd
  35. 1650 dd=jd-jg+1
  36. 1660 print" [211]ie sind also genau"dd"[212]age alt!"
  37. 1670 if(gm=m)and(gt<=t)and(gt>t-3)then1690
  38. 1680 goto1700
  39. 1690 print" [200]erzlichen [199]l[168]ckwunsch zum [199]eburtstag!"
  40. 1700 print" [196]as julianische [196]atum ist eine fort-"
  41. 1710 print" laufende [212]agesz[166]hlung, die am ersten"
  42. 1720 print" [202]anuar 4713 v.[195]hr. beginnt. [214]erwendet"
  43. 1730 print" wird es haupts[166]chlich in der [193]strono-"
  44. 1740 print" mie, um [218]eitdifferenzen zu bestimmen."
  45. 1750 printtab(30)">>[212][193][211][212][197]<<"
  46. 1760 poke198,0:wait198,1
  47. 1770 :
  48. 2000 print"[147][150]      abcdefghijklm[146] - [193][213][211][215][197][210][212][213][206][199]"
  49. 2010 print"[163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
  50. 2020 print" [201]hre [218]yklen stehen bei:"
  51. 2030 z1=int((dd/23-int(dd/23))*23+.5)
  52. 2040 print"[150]  [203] (23-[212]age-[210]hythmus) ="z1
  53. 2050 z2=int((dd/28-int(dd/28))*28+.5)
  54. 2060 print"[154]  [211] (28-[212]age-[210]hythmus) ="z2
  55. 2070 z3=int((dd/33-int(dd/33))*33+.5)
  56. 2080 print"[153]  [199] (33-[212]age-[210]hythmus) ="z3
  57. 2090 p1=sin(z1/23*2*(NULL))
  58. 2100 if p1>.3 then print"[150]  [223] [203] ist in [200]ochlage.";:goto2130
  59. 2110 if p1<-.3 then print"[150]  [223] [203] ist in [212]ieflage.";:goto2130
  60. 2120 print"[150]  [223] [203] befindet sich im @bergang.";
  61. 2130 print"(";mid$("[=^",sgn(cos(z1/23*2*(NULL)))+2,1)")"
  62. 2140 p2=sin(z2/28*2*(NULL))
  63. 2150 if p2>.3 then print"[154]  [255] [211] ist in [200]ochlage.";:goto2180
  64. 2160 if p2<-.3 then print"[154]  [255] [211] ist in [212]ieflage.";:goto2180
  65. 2170 print"[154]  [255] [211] befindet sich im @bergang.";
  66. 2180 print"(";mid$("[=^",sgn(cos(z2/28*2*(NULL)))+2,1)")"
  67. 2190 p3=sin(z3/33*2*(NULL))
  68. 2200 if p3>.3 then print"[153]  * [199] ist in [200]ochlage.";:goto2230
  69. 2210 if p3<-.3 then print"[153]  * [199] ist in [212]ieflage.";:goto2230
  70. 2220 print"[153]  * [199] befindet sich im @bergang.";
  71. 2230 print"(";mid$("[=^",sgn(cos(z3/33*2*(NULL)))+2,1)")"
  72. 2240 print" [203] bestimmt den [203][220]rperrhythmus, [211] den"
  73. 2250 print" [211]eelen- und [199] den [199]eistesrhythmus."
  74. 2260 print" [ und ^ zeigen die [212]endenzen an."
  75. 2270 printtab(30)">>[212][193][211][212][197]<<"
  76. 2280 poke198,0:wait198,1
  77. 2290 :
  78. 2500 rem zeichnerische darstellung
  79. 2510 :
  80. 2520 jm=jd-t
  81. 2530 :
  82. 2540 print"[147][150]      abcdefghijklm[146]  -  [199][210][193][208][200][201][203]"
  83. 2550 print"[163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
  84. 2560 print"[199]eburtsdatum:";gt"[157]."gm"[157]."gj"("jg")"
  85. 2570 print"[193]uswertung f[168]r: "m"[157]/"j+1890"("jm")"
  86. 2580 dd=jm-jg
  87. 2590 print"   [176][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][174]"
  88. 2600 fori=1to8:print"   [221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221]":nexti
  89. 2610 print"   [171][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][179]"
  90. 2620 fori=1to8:print"   [221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221]":nexti
  91. 2630 print"    0[221][221][221]0[221][221][221][221]1[221][221][221][221]1[221][221][221][221]2[221][221][221][221]2[221][221][221][221]3[221] "
  92. 2640 print"    1[221][221][221]5[221][221][221][221]0[221][221][221][221]5[221][221][221][221]0[221][221][221][221]5[221][221][221][221]0[221] "
  93. 2650 print"     [150][223]=[203][220]rper    [154][255]=[211]eele   [153]*=[199]eist  ";
  94. 2660 for i=1 to 31
  95. 2670 v(1)=sin((dd+i)/23*2*(NULL))*8
  96. 2680 v(2)=sin((dd+i)/28*2*(NULL))*8
  97. 2690 v(3)=sin((dd+i)/33*2*(NULL))*8
  98. 2700 for k=1 to 3
  99. 2710 poke211,i+3:poke214,13.5-v(k)
  100. 2720 sys58640
  101. 2730 printmid$("[150][223][154][255][153]*",k*2-1,2)
  102. 2740 next k,i : print"";
  103. 2750 poke198,0:wait198,1
  104. 2760 :
  105. 3000 print"[147][150]      abcdefghijklm[146] - [200][193][210][205][207][206][201][197][206]"
  106. 3010 print"[163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
  107. 3020 print" [194]ei der [208]artnerberechnung kann auch"
  108. 3030 print" das [214]erh[166]ltnis zu [193]rbeitskollegen,"
  109. 3040 print" [211]chulkameraden und anderen, eventuell"
  110. 3050 print" gleichgeschlechtlichen [205]enschen ausge-"
  111. 3060 print" wertet werden."
  112. 3070 print" [215]ollen [211]ie eine [208]artnerberechnung?"
  113. 3080 geta$:ifa$="n"thenrun
  114. 3090 if a$<>"j" then 3080
  115. 3100 print" [199]eben [211]ie das [199]eburtsdatum des '[208]art-   ners' an."
  116. 3110 print" [199]eburtsdatum:";:gosub11000
  117. 3120 gosub10000
  118. 3130 print" [202]ulianisches [199]eburtsdatum:"jd
  119. 3140 dd=abs(jd-jg)
  120. 3150 print" [196]ie [193]ltersdifferenz bel[166]uft sich auf":printdd"[212]age."
  121. 3160 printtab(30)">>[212][193][211][212][197]<<"
  122. 3170 poke198,0:wait198,1
  123. 3180 :
  124. 3500 print"[147][150]      abcdefghijklm[146] - [193][213][211][215][197][210][212][213][206][199]"
  125. 3510 print"[163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
  126. 3520 z1=int((dd/23-int(dd/23))*23+.5)
  127. 3530 z2=int((dd/28-int(dd/28))*28+.5)
  128. 3540 z3=int((dd/33-int(dd/33))*33+.5)
  129. 3550 ifz1>11thenz1=23-z1
  130. 3560 ifz2>14thenz2=28-z2
  131. 3570 ifz3>16thenz3=33-z3
  132. 3580 print" [210]hythmusdifferenzen (in [212]agen):"
  133. 3590 print"[150]  [223] [203]-[210]hythmus:"z1
  134. 3600 print"[154]  [255] [211]-[210]hythmus:"z2
  135. 3610 print"[153]  * [199]-[210]hythmus:"z3
  136. 3620 print" [208]rozentuale @bereinstimmung:"
  137. 3630 p1=int(1000-z1*87+.5)/10+.01
  138. 3640 p2=int(1000-z2*71+.5)/10+.01
  139. 3650 p3=int(1000-z3*60+.5)/10+.01
  140. 3660 print"[150]  [223] [203][220]rperlich:"p1"[157][157] % ("mid$("[186][170][169]",p1/34+1,1)")"
  141. 3670 print"[154]  [255] [211]eelisch  :"p2"[157][157] % ("mid$("[186][170][169]",p2/34+1,1)")"
  142. 3680 print"[153]  * [199]eistig   :"p3"[157][157] % ("mid$("[186][170][169]",p3/34+1,1)")"
  143. 3690 printtab(30)">>[212][193][211][212][197]<<"
  144. 3700 poke198,0:wait198,1
  145. 3710 goto3000
  146. 3720 :
  147. 10000 rem routine zur berechnung des
  148. 10010 rem    julianischen datums
  149. 10020 j=j-1890
  150. 10030 jd=2411367+365*j+int((j+1)/4)
  151. 10040 jd=jd+ml(m)+t-1
  152. 10050 jd=jd+(((j+2)/4=int((j+2)/4))*(m>2))
  153. 10060 i=(jd+1)/7 : wt$=wt$((i-int(i))*7+.5)
  154. 10070 return
  155. 10080 :
  156. 10500 rem daten einlesen
  157. 10510 for i=1 to 12 : read ml(i) : next
  158. 10520 for i=0 to 6 : read wt$(i) : next
  159. 10530 return
  160. 10540 :
  161. 11000 rem datum eingeben
  162. 11010 :
  163. 11020 cf=1:t=15:m=6:j=1970
  164. 11030 gosub11500
  165. 11040 geta$
  166. 11050 ifcf>1then11090
  167. 11060 ifa$="[145]"ora$="+"thent=t+1:ift>31thent=1
  168. 11070 ifa$=""ora$="-"thent=t-1:ift<1thent=31
  169. 11080 goto11150
  170. 11090 ifcf>2then11130
  171. 11100 ifa$="[145]"ora$="+"thenm=m+1:ifm>12thenm=1
  172. 11110 ifa$=""ora$="-"thenm=m-1:ifm<1thenm=12
  173. 11120 goto11150
  174. 11130 ifa$="[145]"ora$="+"thenj=j+1:ifj>1999thenj=1890
  175. 11140 ifa$=""ora$="-"thenj=j-1:ifj<1890thenj=1999
  176. 11150 ifa$=""thencf=cf+1:ifcf>3thencf=1
  177. 11160 ifa$="[157]"thencf=cf-1:ifcf<1thencf=3
  178. 11170 ifa$=chr$(13)thencf=4:gosub11500:print:return
  179. 11180 ifa$=""then11040
  180. 11190 goto11030
  181. 11200 :
  182. 11500 rem datum drucken
  183. 11510 print"[154]";:ifcf=1thenprint"";
  184. 11520 printspc(2+(t>9));t;
  185. 11530 print"[154]";:ifcf=2thenprint"";
  186. 11540 printspc(2+(m>9));"[157][157]";m;
  187. 11550 print"[154]";:ifcf=3thenprint"";
  188. 11560 printspc(5-len(str$(j)));"[157]";j;
  189. 11570 print"[157][157][157][157][157][157][157][157][157]..[157][157][157][157][157][157][157][157]";
  190. 11580 return
  191. 11590 :
  192. 12000 rem datum holen
  193. 12010 t=peek(828):m=peek(829):j=peek(830)+peek(831)*256
  194. 12020 if j>1890 and j<2099 then return
  195. 12030 t=1 : m=1 : j=1989
  196. 12040 return
  197. 12050 :
  198. 12500 rem datum speichern
  199. 12510 poke828,t:poke829,m
  200. 12520 hj=int(j/256):lj=j-hj*256
  201. 12530 poke830,lj:poke831,hj
  202. 12540 return
  203. 12550 :
  204. 50000 data 0,31,59,90,120,151,181,212,243,273,304,334
  205. 50010 data "[205]ontag","[196]ienstag","[205]ittwoch","[196]onnerstag"
  206. 50020 data "[198]reitag","[211]amstag","[211]onntag"
  207.