home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1990 April / 64er_Magazin_90-04_1990_Markt__Technik_de_Side_A.d64 / business-grafics (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  19KB  |  670 lines
  1. 10 rem -- business-grafik --
  2. 20 rem - 09.11.89 -
  3. 30 poke53280,0:poke53281,0
  4. 50 printchr$(142)"[147]"tab(9)"                       "
  5. 60 printtab(9)"   business-graphics   "
  6. 70 u$="                       ":printtab(9)u$
  7. 80 printtab(9)"         v 5.0         "
  8. 90 printtab(9)u$
  9. 100 print""tab(15)"(c) 1987-89"
  10. 110 printtab(9)"autor:  wolfgang dehmer"
  11. 120 print""tab(9)u$
  12. 140 dimzz$(9,60),jz$(9,60),zz(9,60),jz(9,60),tt(40),vv(40),mn$(12)
  13. 150 gosub5980
  14. 160 dd$="":da$="1":c=1:s=1:j=5:ds$=""
  15. 162 ti$="000000":u$="      ":print"[147]"chr$(14);
  16. 170 print""u$" <<      [205] [197] [206] [213]   [201]    [146] >>"
  17. 190 printu$"[196][193][212][197][206] [204][193][196][197][206] ...........  [198]1 [146]"
  18. 200 printu$"[196][193][212][197][206][160][197][201][206][199][197][194][197][206] ........  [198]2 [146]"
  19. 210 printu$"[199][210][193][198][201][203] [218][197][201][199][197][206] .........  [198]3 [146]"
  20. 220 printu$"[196][201][210][197][195][212][207][210][217] .............  [198]4 [146]"
  21. 230 printu$"[198][201][204][197] [204][207][197][211][195][200][197][206] .........  [198]5 [146]"
  22. 235 printu$"[198][201][204][197] [213][205][194][197][206][197][206][206][197][206] .......  [198]6 [146]"
  23. 240 printu$"[205][197][206][213] [201][201] ...............  [198]7 [146]"
  24. 260 gete$:gosub25000:ife$=""then260
  25. 266 ife$="^"thenti$="000000":poke53265,27
  26. 270 ife$="[135]"thenprint"[147]"chr$(142):input"scratch: filename ";fi$
  27. 280 ife$="[135]"andfi$="m"then160
  28. 290 ife$="[135]"thenopen1,8,15,"s:"+fi$:close1:goto160
  29. 300 ife$="[137]"thenprint"[147]":goto370
  30. 310 ife$="[133]"thenprint"[147]":goto3840
  31. 320 ife$="[134]"then(NULL):goto2340
  32. 330 ife$="[138]"then5450
  33. 340 ife$="[136]"thenprint"[147]":goto3320
  34. 354 ife$="[139]"thenprint"[147]"chr$(142):input"rename: file-neu ";f1$
  35. 355 ife$="[139]"andf1$="m"then160
  36. 356 ife$="[139]"theninput"        file-alt ";f2$
  37. 357 ife$="[139]"thenopen1,8,15,"r:"+f1$+"="+f2$:close1:goto160
  38. 365 goto260
  39. 370 rem - eingabe -
  40. 380 print"   [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  41. 390 printtab(11)"[164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  42. 400 printtab(11)"[212][201][212][197][204] [196][197][211] [196][201][193][199][210][193][205][205][211]":print
  43. 410 print"   (2 [218]eilen zu je max. 34 [218]eichen !)"
  44. 420 print"  ([215]enn 2.[218]eile leer -> '-' eingeben!)"
  45. 440 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]"
  46. 450 print"                 ";:print"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";
  47. 460 open1,0
  48. 470 input#1,tt$:print
  49. 480 iftt$="m"thenclose1:goto160
  50. 490 l1=len(tt$)
  51. 500 close1
  52. 510 ifl1>34thenprint"[147]":goto370
  53. 520 print"                 ";"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";
  54. 530 open1,0
  55. 540 input#1,vv$:print
  56. 550 ifvv$="m"thenclose1:goto160
  57. 560 close1
  58. 570 l2=len(vv$)
  59. 580 ifl2>34thenprint"[147]":goto370
  60. 590 print"[147]"tab(9)"[196]iagrammtyp ? ([206]/-/[203])"
  61. 600 getkd$:ifkd$=""then600
  62. 610 wt$="[203]urven"
  63. 613 ifkd$="k"thenwt$="[203]reise"
  64. 625 ifkd$="-"thends$="*.-"
  65. 630 print"[147]         ** [215]ieviele "wt$" ? ** "
  66. 640 w=9:ifkd$="k"thenkd$="j":w=6
  67. 650 print""tab(16)"(max."w"[157])"
  68. 660 gets$:ifs$=""then660
  69. 670 ifval(s$)<1then660
  70. 680 s=val(s$):ss=s
  71. 690 poke19,1:input"[147]    [215]ieviel [215]erte je [196]atenblock: ";z:poke19,0
  72. 700 ifkd$="j"thena$="-":br$="5":goto780
  73. 710 print"[147]      [194]ezeichnung der [215]erte-[211]kala"
  74. 720 print"       ([203]eine [194]ezeichnung = '-')"
  75. 750 open1,0
  76. 760 print"                 ";:input#1,a$:print:close1
  77. 780 fork=1tos:rem kurven
  78. 790 b=1:print"[147]"
  79. 800 bz$="[202]ahreszahl: ":ifkd$="j"thenbz$="[197]lement:    "
  80. 810 forw=btoz:rem werte
  81. 820 print""tab(12)k"[157].[196][193][212][197][206][194][204][207][195][203]: [146]"
  82. 830 print""""w"[157].";
  83. 840 printbz$"[146] ";:open1,0:input#1,jz$(k,w):print:close1:jz(k,w)=val(jz$(k,w))
  84. 860 print""w"[157].";
  85. 870 print"[215]ert: [146]       ";:open1,0:input#1,zz$(k,w):print:close1
  86. 875 zz(k,w)=val(zz$(k,w))
  87. 880 print"";:printtab(11)"[203][207][210][210][197][203][212][213][210] ? ([202]/[206])"
  88. 900 getky$:ifky$<>"j"andky$<>"n"then900
  89. 910 ifky$="j"thenprint"[147]":goto820
  90. 920 print"                [145][145][145][145][145][145][145][145][145][145]     "
  91. 930 print""spc(16)"          "
  92. 935 printtab(11)"                 "
  93. 950 next
  94. 960 next
  95. 970 dz=jz(1,z)-jz(1,1)
  96. 980 ifjz(1,z)<jz(1,1)thendz=100-jz(1,1)+jz(1,z)
  97. 990 ifkd$="j"then1070
  98. 1000 rem - bereichsskala -
  99. 1010 ifdz<=6thenbr$="5"
  100. 1020 ifdz>6thenbr$="4"
  101. 1030 ifdz>11thenbr$="3"
  102. 1040 ifdz>23thenbr$="2"
  103. 1050 ifdz>29thenbr$="1"
  104. 1060 ifdz>47thenbr$="0"
  105. 1070 gosub4180:rem maximum
  106. 1080 art$="k":print"[147]"
  107. 1090 s=ss:rem orig.kurvenzaehler
  108. 1100 ifbd$="a"orbd$="[133]"orbd$="[137]"orbd$="[134]"orbd$="[138]"orbd$="[135]"orbd$="[139]"then1270
  109. 1110 ifbd$="[136]"orbd$="[140]"orbd$=chr$(32)orbd$="s"orbd$="9"orbd$="-"then1270
  110. 1120 ifbd$="*"orbd$="_"orbd$="o"orbd$="@"then1270
  111. 1130 ifbd$="b"then1230
  112. 1140 rem -- graphik --
  113. 1150 br=val(br$)
  114. 1160 l1=len(tt$):forq=1tol1
  115. 1170 tt(q)=asc(mid$(tt$,q,1))
  116. 1180 nextq
  117. 1190 l2=len(vv$):forq=1tol2
  118. 1200 vv(q)=asc(mid$(vv$,q,1))
  119. 1210 nextq
  120. 1220 ifbd$="u"then1270
  121. 1230 t3=len(a$):forq=1tot3
  122. 1240 a(q)=asc(mid$(a$,q,1))
  123. 1250 nextq
  124. 1260 rem --
  125. 1270 ifbd$=chr$(32)or(bd$="@"andart$<>"k"andart$<>"s")thengosub5810
  126. 1280 ifkd$="j"orright$(ds$,2)=".k"thenda$="2":bd$="o"
  127. 1290 ifez$<>"j"andez$<>"@"andbd$<>"k"then(NULL)
  128. 1300 ifm2=1thenm2=0:gosub6080
  129. 1310 (NULL)1,0:(NULL)
  130. 1320 ifda$="2"thengosub5220
  131. 1330 ti$="000000"
  132. 1350 ifda$="2"then1580
  133. 1360 (NULL)1
  134. 1370 (NULL)70,30,70,180
  135. 1380 ifright$(ds$,1)="-"then(NULL)70,105,310,105
  136. 1385 ifd3$<>"j"or(d3$="j"andbr$<>"4")then(NULL)70,180,310,180
  137. 1390 ifar$="s"then1470
  138. 1400 ifbr$="2"thensp=20:goto1440
  139. 1410 ifbr$<>"5"thensp=20
  140. 1420 ifbr$="5"thensp=40
  141. 1430 foraa=70to310stepsp
  142. 1440 foraa=70to310step40
  143. 1450 (NULL)aa,180,aa,183
  144. 1460 next
  145. 1470 forbb=180to30step-15
  146. 1480 (NULL)70,bb,66,bb
  147. 1490 next
  148. 1500 rem
  149. 1505 ifright$(ds$,1)="-"then20000
  150. 1510 mf=10:te=b/10
  151. 1520 forx=27to162step15
  152. 1530 za=te*mf
  153. 1540 (NULL)1,1,7,0
  154. 1550 (NULL)56-(6*len(str$(za))),x,str$(za)
  155. 1560 mf=mf-1
  156. 1570 next
  157. 1580 a$="":forq=1tot3
  158. 1590 a$=a$+chr$(a(q))
  159. 1600 next
  160. 1605 ifa$="-"thena$=" "
  161. 1610 ifbd$<>"o"then(NULL)58-(6*(len(a$))),15,chr$(14)+a$
  162. 1620 tt$=""
  163. 1630 forq=1tol1
  164. 1640 tt$=tt$+chr$(tt(q))
  165. 1650 next
  166. 1660 vv$="":forq=1tol2
  167. 1670 vv$=vv$+chr$(vv(q))
  168. 1680 next
  169. 1690 br$=right$(str$(br),1)
  170. 1710 ifvv$="-"thenvv$=" "
  171. 1720 (NULL)72,5,chr$(14)+tt$:(NULL)72,15,chr$(14)+vv$
  172. 1730 ifda$="2"then2340
  173. 1740 ifbd$="@"orbd$="f"thenu=0:goto1760
  174. 1750 aj=jz(1,1):u=0
  175. 1760 rem
  176. 1770 ifbr$="3"thendf=4:ifart$="s"thenu=3
  177. 1780 ifbr$="1"thendf=8:ifart$="s"thenu=2
  178. 1790 ifbr$="0"thendf=10:ifart$="s"thenu=1
  179. 1800 ifbr$="2"thendf=5:ifart$="s"thenu=2
  180. 1810 ifbr$="4"thendf=2:ifart$="s"thenu=8
  181. 1820 ifbr$="5"thendf=1:ifart$="s"thenu=17
  182. 1830 (NULL)56+u,187,str$(aj)
  183. 1840 if(aj+df)>=100then(NULL)96+u,187,str$(aj+df-100):goto1860
  184. 1850 (NULL)96+u,187,str$(aj+df)
  185. 1860 if(aj+df*2)>=100then(NULL)136+u,187,str$(aj+df*2-100):goto1880
  186. 1870 (NULL)136+u,187,str$(aj+df*2)
  187. 1880 if(aj+df*3)>=100then(NULL)176+u,187,str$(aj+df*3-100):goto1900
  188. 1890 (NULL)176+u,187,str$(aj+df*3)
  189. 1900 if(aj+df*4)>=100then(NULL)216+u,187,str$(aj+df*4-100):goto1920
  190. 1910 (NULL)216+u,187,str$(aj+df*4)
  191. 1920 if(aj+df*5)>=100then(NULL)256+u,187,str$(aj+df*5-100):goto1940
  192. 1930 (NULL)256+u,187,str$(aj+df*5)
  193. 1940 rem
  194. 1950 v=180:u=150
  195. 1960 if(bd$<>"@"andbd$<>"f")thenjk=1
  196. 1970 ifart$="k"thenfork=ctos
  197. 1980 ifart$="s"thenfork=bltobl
  198. 1990 ifart$="k"thenforw=jktoz-1
  199. 2000 ifart$="s"thenforw=jktoz
  200. 2010 ifbr$="4"thenja=12:re=16:rem ja=jahre im intervall-re=str$breite
  201. 2020 ifbr$="2"thenja=30:re=4
  202. 2030 ifbr$="1"thenja=48:re=3
  203. 2040 ifbr$="0"thenja=60:re=1
  204. 2050 ifbr$="5"thenja=6:re=35
  205. 2060 ifbr$="3"thenja=24:re=6
  206. 2070 ifjz(k,1)=0then2340:rem overflow-control
  207. 2080 f=240/ja:rem raster/jahre
  208. 2090 ff=u/b
  209. 2100 ifart$="s"andra$<>"r"then2190
  210. 2110 ifart$="s"andra$="r"thenaj=jz(1,jk):goto2210
  211. 2120 if70+(jz(k,w+1)-aj)*f>318then2180:rem overflow
  212. 2130 ifbd$="@"orbd$="f"thenaj=jz(1,jk)
  213. 2140 :ifjz(k,w+1)<jz(k,w)thenjz(k,w+1)=jz(k,w+1)+100:rem >jahr 2000
  214. 2142 ifright$(ds$,1)="-"thenoe=(v-ff*zz(k,w))/2:ge=(v-ff*zz(k,w+1))/2:goto2150
  215. 2145 (NULL)70+(jz(k,w)-aj)*f,v-ff*zz(k,w),70+(jz(k,w+1)-aj)*f,v-ff*zz(k,w+1)
  216. 2146 goto2160
  217. 2150 (NULL)70+(jz(k,w)-aj)*f,oe+15,70+(jz(k,w+1)-aj)*f,ge+15
  218. 2160 fg$="14545222237473638444527"
  219. 2164 ifright$(ds$,1)="-"thenoe=(v-ff*zz(k,w))/2+15
  220. 2165 ifbd$="k"andright$(ds$,1)="-"then(NULL)70+(jz(k,w)-aj)*f,oe,fg$
  221. 2166 ifbd$="k"andright$(ds$,1)="-"then2180
  222. 2170 ifbd$="k"then(NULL)70+(jz(k,w)-aj)*f,v-ff*zz(k,w),fg$
  223. 2180 goto2300
  224. 2190 if(70+(jz(k,w)-aj)*f)+re>318then2300
  225. 2191 :ifjz(k,w+1)<jz(k,w)thenjz(k,w+1)=jz(k,w+1)+100:rem >jahr 2000
  226. 2195 ifright$(ds$,1)="-"thenoe=(v-ff*zz(k,w))/2+15:goto2200
  227. 2197 goto2205
  228. 2200 (NULL)(70+(jz(k,w)-aj)*f),oe,(70+(jz(k,w)-aj)*f)+re,105:goto2300
  229. 2205 (NULL)(70+(jz(k,w)-aj)*f),v-ff*zz(k,w),(70+(jz(k,w)-aj)*f)+re,180:goto2300
  230. 2210 if70+(jz(k,w)-aj)*f+re>318then2300
  231. 2212 ifright$(ds$,1)="-"thenoe=(v-ff*zz(k,w))/2+15:goto2215
  232. 2213 goto2220
  233. 2215 (NULL)(70+(jz(k,w)-aj)*f),oe,(70+(jz(k,w)-aj)*f)+re,105:goto2224
  234. 2220 (NULL)(70+(jz(k,w)-aj)*f),v-ff*zz(k,w),(70+(jz(k,w)-aj)*f)+re,180
  235. 2224 ws$=""
  236. 2225 od=103:ifzz(k,w)<0thenod=107
  237. 2226 ifbd$="f"thengosub10000:bd$="f"
  238. 2227 ifbd$="f"andright$(ds$,1)="-"then(NULL)0,mu$:goto2229
  239. 2228 ifbd$="f"then(NULL)0,mu$:(NULL)(70+(jz(k,w)-aj)*f)+2,179:goto2230
  240. 2229 ifbd$="f"then(NULL)(70+(jz(k,w)-aj)*f)+2,od:ds$="*.-"
  241. 2230 s1=70+(jz(k,w)-aj)*f:z1=ff*zz(k,w)
  242. 2240 ifd3$<>"j"orbr$<>"4"then2300
  243. 2250 (NULL)s1,v-z1,s1+4,v-z1-4
  244. 2260 (NULL)s1+16,v-z1,s1+20,v-z1-4
  245. 2270 (NULL)s1+4,v-z1-4,s1+20,v-z1-4
  246. 2280 (NULL)s1+16,180,s1+20,176
  247. 2290 (NULL)s1+20,176,s1+20,v-z1-4
  248. 2300 nextw:if70+(jz(k,w)-aj)*f>319then2320
  249. 2303 oe=(v-ff*zz(k,w))/2+15
  250. 2305 ifbd$="k"andright$(ds$,1)="-"then(NULL)70+(jz(k,w)-aj)*f,oe,fg$:goto2320
  251. 2310 ifbd$="k"then(NULL)70+(jz(k,w)-aj)*f,v-ff*zz(k,w),fg$
  252. 2320 nextk
  253. 2330 d3$="":ez$="n"
  254. 2335 rem - grafik-menu -
  255. 2340 getbd$:gosub25015:ifbd$=""then2340
  256. 2410 (NULL)1
  257. 2415 ifbd$=""then(NULL)
  258. 2420 ifbd$="j"thenprint"[147]"
  259. 2428 br$=right$(str$(br),1)
  260. 2430 ifbd$="j"then(NULL):printchr$(14):print"       [206]euer [218]eitraum (0-5) ? ("br$")"
  261. 2440 ifbd$="j"thengetbr$:ifbr$=""then2440
  262. 2445 br=val(br$)
  263. 2450 ifbd$="j"andval(br$)>5thenbr$="":goto2440
  264. 2460 ifbd$="j"thenprint"[147]":goto1260:rem grafik
  265. 2470 ifbd$="c"orbd$="[195]"thenopen1,4,1:close1:ifst=-128then2340
  266. 2480 ifbd$="c"orbd$="[195]"thenopen1,4,1:print#1,chr$(27);chr$(108);chr$(0);:close1
  267. 2490 ifbd$="c"then(NULL)0
  268. 2500 ifbd$="[195]"then(NULL)0,1
  269. 2510 ifbd$=chr$(32)thenra$="r":art$="s":(NULL):print"[147]":printchr$(147):goto2545
  270. 2520 ifbd$="r"then(NULL)2:(NULL) 0,0,319,199
  271. 2530 ifbd$="k"andart$="k"then1290
  272. 2540 ifbd$="s"thenart$="s":ra$="b":(NULL):print"[147]";chr$(142);
  273. 2545 if(bd$="s"orbd$=chr$(32))ands=1thenbl$="1":goto2590
  274. 2550 ifbd$="s"orbd$=chr$(32)thenbl$="0":kd$="n":da$="1":print"";
  275. 2560 ifbd$="s"orbd$=chr$(32)thenprint"         * saeulendarstellung *"
  276. 2570 ifbd$="s"orbd$=chr$(32)thenprintchr$(142);"        nummer des datenblocks ?"
  277. 2580 ifbd$="s"orbd$=chr$(32)thengetbl$:ifbl$=""then2580
  278. 2590 bl=val(bl$)
  279. 2600 if(bd$="s"orbd$=chr$(32))andbl<=s then6010
  280. 2610 ifbd$=chr$(32)and(bl<1orbl>s)then2580
  281. 2620 ifbd$="s"and(bl<1orbl>s)then2570
  282. 2630 ifbd$="g"thenformn=60to150step30:fornm=70to310stepj:(NULL)nm,mn:next:next
  283. 2640 ifbd$="g"thenfornm=70+sp*2to280stepsp*2:formn=30to180stepj:(NULL)nm,mn:next:next
  284. 2650 ifbd$=chr$(13)then3050
  285. 2660 ifbd$="[199]"then(NULL):printchr$(14):input"[147][208]unktweite (1,2,5,10) ";j:print"[147]":(NULL)
  286. 2670 ifbd$="*"then(NULL)70+(jz(s,z)-aj)*f,v-ff*zz(s,z),70+(jz(s,z)-aj)*f,180
  287. 2680 ifbd$="*"then(NULL)0,oa$:(NULL) 67+(jz(s,z)-aj)*f,178
  288. 2690 ifbd$="1"thengosub10000:oa$=o1$
  289. 2700 ifbd$="2"thengosub10000:oa$=o2$
  290. 2710 ifbd$="3"thengosub10000:oa$=o3$
  291. 2720 ifbd$="4"thengosub10000:oa$=o4$
  292. 2730 ifbd$="5"thengosub10000:oa$=o5$
  293. 2740 ifbd$="6"thengosub10000:oa$=o6$
  294. 2760 ifbd$="h"thenprint"[147]":(NULL):me$="2":printchr$(14):goto4240
  295. 2770 ifbd$="t"thenprint"[147]":(NULL):printchr$(14):input"[218]eile-1 ";tt$
  296. 2780 ifbd$="t"thenprint"";:input"[218]eile-2 ";vv$:print"[147]":goto1110
  297. 2790 ifbd$="b"thenprint"[147]":(NULL):printchr$(14): input"[206]eue [211]kalenbezeichnung ";a$
  298. 2800 ifbd$="b"thenprint"[147]":gosub4180:goto1090
  299. 2810 ifbd$="[205]"thenprint"[147]":(NULL):goto3320
  300. 2820 ifbd$="[133]"thenc=1:s=1:art$="k":goto6010
  301. 2830 ifbd$="[137]"thenc=2:s=2:art$="k":goto6010
  302. 2840 ifbd$="[134]"thenc=3:s=3:art$="k":goto6010
  303. 2850 ifbd$="[138]"thenc=4:s=4:art$="k":goto6010
  304. 2860 ifbd$="[135]"thenc=5:s=5:art$="k":goto6010
  305. 2870 ifbd$="[139]"thenc=6:s=6:art$="k":goto6010
  306. 2880 ifbd$="[136]"thenc=7:s=7:art$="k":goto6010
  307. 2890 ifbd$="[140]"thenc=8:s=8:art$="k":goto6010
  308. 2920 ifbd$="9"thenc=9:s=9:art$="k":goto6010
  309. 2930 ifbd$="z"then4810
  310. 2940 ifbd$="a"thenc=1:da$="1":art$="k":kd$="n":ds$=" ":goto1090
  311. 2945 ifbd$="-"thenc=1:da$="1":art$="k":kd$="n":ds$="x.-":goto1090
  312. 2950 ifbd$="o"thenda$="2":goto1100
  313. 2960 ifbd$=""then(NULL):printchr$(142);:input"[147]laden:grafik-name ";na$
  314. 2965 ifbd$="[145]"then(NULL):printchr$(142);:input"[147]speichern:grafik-name ";na$
  315. 2970 if(bd$=""orbd$="[145]")andna$="g"then(NULL):goto2340
  316. 2975 if(bd$=""orbd$="[145]")andna$="g"then(NULL):goto2340
  317. 2980 ifbd$="[145]"then(NULL):(NULL)0,na$,8
  318. 2990 ifbd$=""then(NULL):(NULL)0,na$,8
  319. 3000 ifbd$="@"then(NULL):printchr$(14):input"[147][211]tartjahr ";aj
  320. 3010 ifbd$="@"andjz(1,z)-jz(1,1)+1=zthenjk=aj-jz(1,1)+1:print"[147]":goto1110
  321. 3020 ifbd$="@"thengosub5550:goto1110
  322. 3030 ifbd$="m"thenprint"[147]":(NULL):goto160
  323. 3034 ifbd$="f"thenart$="s":br$=right$(br$,1):ra$="r":goto1750
  324. 3035 ifbd$="\"then(NULL)0:(NULL)60,187,"                                    "
  325. 3037 fr=0:ifart$="s"thenfr=7
  326. 3038 ifbd$="\"then(NULL)1:forx=0to11:readmn$(x):(NULL)fr+67+x*20,187,mn$(x):next
  327. 3039 restore
  328. 3040 ifbd$="/"thenforw=jktoz:du=du+zz(c,w):next
  329. 3041 ifbd$="/"andright$(ds$,1)<>"-"then3043
  330. 3042 ifbd$="/"then(NULL)2:(NULL)71,(v-ff*du/z)/2+15,310,(v-ff*du/z)/2+15:du=0:goto3044
  331. 3043 ifbd$="/"then(NULL)2:(NULL)71,v-ff*du/z,310,v-ff*du/z:du=0
  332. 3044 goto2340
  333. 3045 rem --
  334. 3050 (NULL):print"[147]"
  335. 3060 printchr$(142);"";:print"             * datenliste * "
  336. 3070 print"         (b[146]ildschirm / d[146]rucker)"
  337. 3080 getab$:ifab$=""then3080
  338. 3082 ifab$="d"theninput"[147] tabellentitel ";tl$
  339. 3090 ifab$="b"then3150
  340. 3100 ifab$="d"thenopen1,4,1:close1:ifst=-128then3080
  341. 3110 ifab$="d"thenopen1,4,1:print#1,chr$(27);chr$(108);chr$(7);:close1
  342. 3120 ifab$="d"thenopen1,4:cmd1:goto3150
  343. 3130 ifab$=chr$(13)then3320
  344. 3140 goto3080
  345. 3150 printchr$(147);
  346. 3155 ifab$="d"thenprinttl$:print
  347. 3160 j$="jahr"
  348. 3170 fork=1toss
  349. 3180 print"datenblock"k"[157]:[146]":print
  350. 3190 forw=1toz
  351. 3200 ifab$="b"thengetws$:ifws$=chr$(32)thengosub5980
  352. 3210 ifjz(k,w)>=100thenjz(k,w)=jz(k,w)-100
  353. 3220 su=su+zz(k,w)
  354. 3230 print""w"[146]"tab(5)j$":";jz(k,w),"    wert:"zz(k,w)
  355. 3240 nextw
  356. 3250 forx=1to40:print"-";:next
  357. 3260 ifab$="d"thenprint"---"
  358. 3270 print
  359. 3280 ifab$<>"d"thengosub5980
  360. 3285 ifws$="/"thenprint"mittelwert:"su/z:su=0:gosub5980
  361. 3290 printchr$(147);
  362. 3300 nextk
  363. 3310 ifab$="d"then print#1:close1
  364. 3315 rem - menu ii -
  365. 3320 printchr$(142)"[147]       <<      m e n u  ii    [146] >>"
  366. 3330 ti$="000000":u$="      ":su=0
  367. 3340 printu$"daten speichern .......  f1 [146]"
  368. 3345 printu$"daten auflisten .......  f2 [146]"
  369. 3350 printu$"grafik zeigen .........  f3 [146]"
  370. 3360 printu$"datei erweitern .......  f4 [146]"
  371. 3370 printu$"daten aendern .........  f5 [146]"
  372. 3380 printu$"daten einfuegen .......  f6 [146]"
  373. 3390 printu$"menu i ................  f7 [146]"
  374. 3400 printu$"programmende ..........  f8 [146]"
  375. 3420 getsp$:gosub25000:ifsp$=""then3420
  376. 3425 ifsp$="^"thenti$="000000":poke53265,27
  377. 3430 ifsp$="[133]"then3510
  378. 3435 ifsp$="[137]"thenprint"[147]":goto3060
  379. 3440 ifsp$="[136]"thenprint"[147]":goto160
  380. 3450 ifsp$="[140]"thenprinttab(7)" sind sie sicher ? (j/n) [146]";
  381. 3451 ifsp$="[140]"thengetws$:ifws$=""then3451
  382. 3452 ifsp$="[140]"andws$<>"j"then3320
  383. 3455 ifsp$="[140]"thensys64738
  384. 3460 ifsp$="[134]"then(NULL):print"[147]":ti$="000000":goto2340:rem grafik
  385. 3470 ifsp$="[138]"thenprint"[147]":sp$="":goto4470
  386. 3480 ifsp$="[135]"then4650
  387. 3490 ifsp$="[139]"then5600
  388. 3500 goto3420
  389. 3510 rem - speichern -
  390. 3550 input"[147]    save: datei-name ";dd$
  391. 3560 ifdd$="m"thenprint"[147]":goto3320
  392. 3580 open1,8,15,"s:"+dd$:close1
  393. 3590 open2,8,2,dd$+",s,w"
  394. 3600 print"[147]"
  395. 3610 open1,8,15:input#1,po:close1:close2
  396. 3620 dd$=dd$+",s,a"
  397. 3630 open 2,8,2,dd$
  398. 3650 print#2,s
  399. 3660 print#2,ss
  400. 3670 print#2,z
  401. 3675 ifa$=" "thena$="-"
  402. 3680 print#2,a$
  403. 3690 print#2,t
  404. 3700 print#2,br$
  405. 3710 print#2,aj
  406. 3720 print#2,tt$
  407. 3725 ifvv$=" "thenvv$="-"
  408. 3730 print#2,vv$
  409. 3750 fork=1tos:rem kurven
  410. 3760 forw=1toz:rem werte
  411. 3770 ifjz(k,w)>100thenjz(k,w)=jz(k,w)-100
  412. 3780 print#2,jz(k,w)
  413. 3790 print#2,zz(k,w)
  414. 3800 nextw
  415. 3810 nextk
  416. 3820 close2
  417. 3830 goto3320
  418. 3840 rem - lesen -
  419. 3850 printchr$(142):m2=1
  420. 3860 input"[147]    load: datei-name ";dd$
  421. 3865 ds$=dd$
  422. 3870 ifdd$="m"then160
  423. 3890 dd$=dd$+",s,r":print"[147]"
  424. 3900 open2,8,2,dd$
  425. 3910 open1,8,15:input#1,po,po$:close2:close1
  426. 3920 ifpo=62thenprintpo$:close2:forx=1to2000:next:goto3860
  427. 3925 ifpo=74thenprintpo$:close2:forx=1to2000:next:goto3860
  428. 3930 open2,8,2,dd$
  429. 3940 input#2,s:input#2,ss:input#2,z:input#2,a$:input#2,t
  430. 3950 t3=len(a$):forq=1tot3
  431. 3960 a(q)=asc(mid$(a$,q,1))
  432. 3970 nextq
  433. 3980 input#2,br$:input#2,aj:input#2,tt$:input#2,vv$
  434. 3990 l1=len(tt$):forq=1tol1
  435. 4000 tt(q)=asc(mid$(tt$,q,1))
  436. 4010 nextq
  437. 4020 l2=len(vv$):forq=1tol2
  438. 4030 vv(q)=asc(mid$(vv$,q,1))
  439. 4040 nextq
  440. 4050 fork=1tos:rem kurven
  441. 4060 forw=1toz:rem werte
  442. 4070 input#2,jz(k,w)
  443. 4080 input#2,zz(k,w)
  444. 4090 nextw
  445. 4100 nextk
  446. 4140 close2
  447. 4150 ifsp$="4"then sp$="":goto4470
  448. 4160 art$="k":gosub4180
  449. 4170 goto1100
  450. 4180 rem - maximum -
  451. 4200 t=0
  452. 4210 printchr$(14)
  453. 4220 me$="1"
  454. 4230 print"[147]":goto4260
  455. 4240 ifme$="2"theninput"[147]    [206]euer [200]oechstwert ";t1:print"[147]"
  456. 4250 goto4410
  457. 4260 forx=1tos
  458. 4270 fory=1toz
  459. 4280 ifx=1andy=2andabs(zz(1,1))>abs(zz(1,2))thent=abs(zz(1,1)):goto4300
  460. 4290 ifabs(zz(x,y))>tthent=abs(zz(x,y))
  461. 4300 nexty
  462. 4310 nextx
  463. 4320 t$=str$(t):hz=t
  464. 4330 ifval(t$)<1thent=1:goto4410
  465. 4340 ifval(t$)<=10thent=10:goto4410
  466. 4350 t=val(t$):t=int(t):t$=str$(t):rem ganzzahlig
  467. 4360 ifval(t$)<=100thent=(t+10)-val(right$(t$,1)):goto4410
  468. 4370 ifval(t$)<=1000thent=(t+100)-val(right$(t$,2)):goto4410
  469. 4380 ifval(t$)<=10000thent=(t+1000)-val(right$(t$,3)):goto4410
  470. 4390 ifval(t$)<=100000thent=(t+10000)-val(right$(t$,4)):goto4410
  471. 4400 ifval(t$)<=1000000thent=(t+100000)-val(right$(t$,5)):goto4410
  472. 4405 ifval(t$)<=10000000thent=(t+1000000)-val(right$(t$,6))
  473. 4410 ifbd$="h"andt1<t andt1>hzthenb=t1:goto4440
  474. 4420 ifbd$="h"andt1>tthenb=t1:goto4440
  475. 4430 b=t
  476. 4440 ifbd$=""thenc=1
  477. 4450 ifbd$="h"thenprint"[147]":goto1140:rem grafik
  478. 4460 return
  479. 4470 rem - erweiterung -
  480. 4480 fork=1tos
  481. 4490 print"letzte jahreszahl:"jz(c,z)
  482. 4500 print"";
  483. 4510 printk"[157].datenblock:[146]"
  484. 4520 print"neue jahreszahl "jz(c,z)+1"[157][157][157][157][157]";:inputjz(k,z+1)
  485. 4530 ifjz(k,z+1)=-1then3320
  486. 4550 input"neuer wert ";zz(k,z+1)
  487. 4560 print"[147]"
  488. 4570 nextk
  489. 4580 z=z+1
  490. 4585 gosub4180:rem max
  491. 4590 print"[147]         grafik/erweitern/daten"
  492. 4600 printtab(16)"(g/e/d) ?"
  493. 4610 getgs$:ifgs$<>"g"andgs$<>"e"andgs$<>"d"then4610
  494. 4620 ifgs$="g"then1140
  495. 4630 ifgs$="d"thenab$="b":goto3150
  496. 4640 ifgs$="e"thenprint"[147]":goto4480
  497. 4650 rem -- korrektur --
  498. 4655 ifs=1thendb=1:print"[147]":goto4700
  499. 4660 print"[147]       welcher datenblock ? (1-9)"
  500. 4670 getdb$:ifdb$=""then4670
  501. 4680 db=val(db$)
  502. 4690 ifdb=0then3320
  503. 4700 input"       welches element (1-60) ";el
  504. 4705 ifel=0then3320
  505. 4710 input"neue jahreszahl ";jz(db,el)
  506. 4720 input"neuer wert ";zz(db,el)
  507. 4730 gosub4180:rem max
  508. 4735 printchr$(142)
  509. 4740 print"[147]           grafik/aendern/daten"
  510. 4750 printtab(17)"(g/a/d) ?"
  511. 4760 getws$:ifws$=""then4760
  512. 4770 ifws$="g"then1140
  513. 4780 ifws$="a"thenprint"[147]":goto4655
  514. 4790 ifws$="d"thenab$="b":goto3150
  515. 4800 goto4760
  516. 4810 rem - malen -
  517. 4820 zk=0:fa=2:q=2:x=160:y=100
  518. 4830 (NULL)1:ifx>318thenx=318:goto4880
  519. 4840 ifx<2thenx=2:goto4880
  520. 4850 ify<2theny=2:goto4880
  521. 4860 ify>198theny=198:goto4880
  522. 4870 (NULL)1:(NULL)x,y
  523. 4880 getpa$:ifpa$=""then4880
  524. 4885 ti$="000000"
  525. 4890 ifpa$=chr$(141)then(NULL)x,y:goto4880
  526. 4900 ifpa$="_"then(NULL)0:(NULL)x,y:(NULL)1:goto2340
  527. 4910 ifpa$=chr$(20)thenx=x-7:(NULL)0:(NULL)x,y," [146]":zk=zk-7:goto4880
  528. 4920 ifpa$=chr$(13)thenx=x-zk:y=y+8:zk=0:goto4880
  529. 4930 ifpa$="[133]"thenfa=1:q=1:goto4880
  530. 4940 ifpa$="[134]"thenfa=0:q=1:goto4880
  531. 4950 ifpa$="[135]"thenfa=0:q=2:goto4880
  532. 4970 ifpa$="[140]"thenfk=0:fa=0:goto4880
  533. 4980 ifpa$="[136]"thenfk=10:fa=0:goto4880
  534. 4990 ifpa$="[145]"and(NULL)(x,y-1)=1then(NULL)fa:(NULL)x,y:y=y-q-fk:goto4830
  535. 5000 ifpa$="[145]"then(NULL)fa:(NULL)x,y:y=y-1-fk:goto4830
  536. 5010 ifpa$=""and(NULL)(x+1,y)=1then(NULL)fa:(NULL)x,y:x=x+q+fk:goto4830
  537. 5020 ifpa$=""then(NULL)fa:(NULL)x,y:x=x+1+fk:zk=0:goto4830
  538. 5030 ifpa$=""and(NULL)(x,y+1)=1then(NULL)fa:(NULL)x,y:y=y+q+fk:goto4830
  539. 5040 ifpa$=""then(NULL)fa:(NULL)x,y:y=y+1+fk:goto4830
  540. 5050 ifpa$="[157]"and(NULL)(x-1,y)=1then(NULL)fa:(NULL)x,y:x=x-q-fk:goto4830
  541. 5060 ifpa$="[157]"then(NULL)fa:(NULL)x,y:x=x-1-fk:goto4830
  542. 5070 ifpa$="*"then(NULL)0:(NULL)x,y:(NULL)1:(NULL)0,oa$:(NULL) x+1,y:goto2340
  543. 5080 ifpa$="[176]"then(NULL)0:(NULL)x,y:x=10:y=10:goto4830
  544. 5090 ifpa$="[191]"then(NULL)0:(NULL)x,y:x=10:y=90:goto4830
  545. 5100 ifpa$="[188]"then(NULL)0:(NULL)x,y:x=10:y=190:goto4830
  546. 5110 ifpa$="[172]"then(NULL)0:(NULL)x,y:x=160:y=10:goto4830
  547. 5120 ifpa$="[177]"then(NULL)0:(NULL)x,y:x=160:y=90:goto4830
  548. 5130 ifpa$="[187]"then(NULL)0:(NULL)x,y:x=160:y=190:goto4830
  549. 5140 ifpa$="[165]"then(NULL)0:(NULL)x,y:x=310:y=10:goto4830
  550. 5150 ifpa$="[180]"then(NULL)0:(NULL)x,y:x=310:y=90:goto4830
  551. 5160 ifpa$="[162]"then(NULL)0:(NULL)x,y:x=310:y=187:goto4830
  552. 5170 ifpa$<>""andpa$<>"[145]"andpa$<>""andpa$<>"[157]"andpa$<>"*"then5190
  553. 5180 goto4880
  554. 5190 ifpa$="[215]"then(NULL)0:(NULL)x,y:(NULL)1:(NULL)x,y,chr$(14)+pa$:x=x+8:zk=zk+8:goto4880
  555. 5200 ifpa$="[205]"then(NULL)0:(NULL)x,y:(NULL)1:(NULL)x,y,chr$(14)+pa$:x=x+8:zk=zk+8:goto4880
  556. 5210 (NULL)0:(NULL)x,y:(NULL)1:(NULL)x,y,chr$(14)+pa$:x=x+7:zk=zk+7:goto4880
  557. 5220 rem - kreis -
  558. 5230 s1=0:s2=0:fl=0
  559. 5240 (NULL):printchr$(14)
  560. 5250 ifs=1ors=2thennn=1:mm=2:goto5270
  561. 5260 input"[147] [215]elche beiden [196]atenbloecke (a,b) ";nn,mm
  562. 5270 (NULL)
  563. 5280 forqw=1toz:s2=s2+zz(mm,qw)
  564. 5290 s1=s1+zz(nn,qw):next
  565. 5300 (NULL)80,100,45,.9*56
  566. 5310 (NULL)80,51,80,100
  567. 5320 forwe=1toz-1
  568. 5330 (NULL)80,100,44,.9*55,zz(nn,we)*100/s1*3.6+fl
  569. 5340 fl=fl+zz(nn,we)*100/s1*3.6
  570. 5350 next
  571. 5360 ifs=1thenreturn
  572. 5370 fl=0:rem 2.kreis
  573. 5380 (NULL)240,100,45,.9*56
  574. 5390 (NULL)240,51,240,100
  575. 5400 forwe=1toz-1
  576. 5410 (NULL)240,100,44,.9*55,zz(mm,we)*100/s2*3.6+fl
  577. 5420 fl=fl+zz(mm,we)*100/s2*3.6
  578. 5430 next
  579. 5440 return
  580. 5450 rem - dir -
  581. 5460 print"[147] 0 ";:open1,8,0,"$":poke781,1:sys65478:geta$,a$,a$,a$:x$=chr$(0)
  582. 5470 fori=1to7:geta$,b$,c$,d$:printa$b$c$d$;:next:print:geta$,a$,a$,b$
  583. 5480 ifstthensys65484:close1:gosub5990:print"[147]":goto160
  584. 5490 printasc(a$+x$)+256*asc(b$+x$);
  585. 5500 goto5470
  586. 5510 rem - @-korrektur -
  587. 5520 ifjk>w-1thenjk=w-1
  588. 5530 ifjk<1thenjk=1
  589. 5540 return
  590. 5550 rem - bereichsdarstellung -
  591. 5560 forx=1toz
  592. 5570 ifaj=jz(1,x)thenjk=x
  593. 5580 nextx
  594. 5590 return
  595. 5600 rem - einfuegen -
  596. 5610 input"[147]an welcher stelle einfuegen ";sl
  597. 5620 ifsl=0then3320
  598. 5625 ifsl>zthen5610
  599. 5630 z=z+1
  600. 5640 forx=1tos
  601. 5650 fory=ztoslstep-1
  602. 5660 jz(x,y)=jz(x,y-1):zz(x,y)=zz(x,y-1)
  603. 5670 next:next
  604. 5680 forx=1tos
  605. 5690 input"neue jahreszahl ";jz(x,sl)
  606. 5700 input"neuer wert ";zz(x,sl)
  607. 5710 next
  608. 5720 ab$="b":goto3150
  609. 5810 rem - 3d -
  610. 5815 ifright$(ds$,2)=".-"thenreturn
  611. 5820 ifbr$<>"4"thenreturn
  612. 5830 print"[147]"chr$(142)
  613. 5840 print"3-d-darstellung ? (j/n)"
  614. 5850 getd3$:ifd3$=""then5850
  615. 5860 print"[147]":return
  616. 5980 rem - warteschleife -
  617. 5990 getws$:ifws$=""then5990
  618. 6000 return
  619. 6010 rem - ueberzeichnen -
  620. 6020 (NULL):print"[147]"chr$(14)"        [213]eberzeichnen ? ([202]/[206]/@)"
  621. 6030 getez$:ifez$=""then6030
  622. 6040 ifez$="@"thenbd$="@"
  623. 6050 print"[147]":goto1100
  624. 6070 rem - liste -
  625. 6080 printchr$(142)"[147]"tab(10)"graphik/daten ? (g/d)"
  626. 6090 getws$:ifws$=""then6090
  627. 6100 ifws$="g"thenprint"[147]":return
  628. 6110 ab$="b":goto3150
  629. 10000 rem - musterwahl -
  630. 10001 o1$="ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff"
  631. 10002 o2$="4444111144441111444411114444111144441111444411114444111144441111"
  632. 10003 o3$="ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000"
  633. 10004 o4$="5555555555555555555555555555555555555555555555555555555555555555"
  634. 10005 o5$="8888444422221111888844442222111188884444222211118888444422221111"
  635. 10006 o6$="1111222244448888111122224444888811112222444488881111222244448888"
  636. 10007 o7$="0000000000000000000000000000000000000000000000000000000000000000"
  637. 10008 ifbd$<>"f"thenreturn
  638. 10009 getws$:ifws$=""then10009
  639. 10010 ifws$="1"thenmu$=o1$
  640. 10020 ifws$="2"thenmu$=o2$
  641. 10030 ifws$="3"thenmu$=o3$
  642. 10040 ifws$="4"thenmu$=o4$
  643. 10050 ifws$="5"thenmu$=o5$
  644. 10060 ifws$="6"thenmu$=o6$
  645. 10065 ifws$="0"thenmu$=o7$
  646. 10070 bd$="f":return
  647. 20000 rem - min-skala -
  648. 21510 mf=10:te=b/10
  649. 21520 forx=27to91step15
  650. 21530 za=te*mf
  651. 21540 (NULL)1,1,7,0
  652. 21550 (NULL)56-(6*len(str$(za))),x,str$(za)
  653. 21560 mf=mf-2
  654. 21570 next
  655. 22510 mf=2:te=b/10:rem minusbereich
  656. 22520 forx=117to177step15
  657. 22530 za=-te*mf
  658. 22540 (NULL)1,1,7,0
  659. 22550 (NULL)56-(6*len(str$(za))),x,str$(za)
  660. 22560 mf=mf+2
  661. 22570 next
  662. 23000 goto1580
  663. 25000 rem - time -
  664. 25010 ifval(ti$)>120thenpoke53265,11:ti$="000000":return
  665. 25012 goto25020
  666. 25015 ifval(ti$)>120thenprint"[147]":(NULL):goto3320
  667. 25020 return
  668. 30000 rem - datas -
  669. 30010 dataj,f,m,a,m,j,j,a,s,o,n,d
  670.