home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 63 / 64er_Magazin_Sonderheft_63_19xx_Markt__Technik_de_Side_A.d64 / hprogramm (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  20KB  |  988 lines
  1. 10 rem ********************************
  2. 20 rem * funktionenhilfe fuer den c64 *
  3. 30 rem * michael suhr                 *
  4. 40 rem * 5160 dueren wernerstr. 10    *
  5. 50 rem * tel: 02421/14666             *
  6. 60 rem * zeilen-70 bitte loeschen!!   *
  7. 70 rem ********************************
  8. 100 run900
  9. 110 :
  10. 120 rem ** zeitkritische u-programme ***
  11. 130 :
  12. 140 rem ** steigung ***
  13. 150 :
  14. 160 y=(fnx(x+h)-fnx(x-h))/h
  15. 170 return
  16. 180 :
  17. 190 rem ** nullstellen ***
  18. 200 :
  19. 210 gosub8140
  20. 220 pokeh4,h8:if fnx(rnd(ti)*5)=fnx(rnd(h8)*5)andst=h8then330
  21. 230 hh=1e-31:h=h2:z=-en:sw=.2+h
  22. 240 z=z+sw:x=z:ze=h8:printint(x)"[157]  [145]":geta$:ifa$="_"thenreturn
  23. 250 pokeh4,h8
  24. 260 y1=fnx(x):ifabs(y1)>enandz<en then240
  25. 270 x=x-y1/((fnx(x+h)-y1)/h+hh):ze=ze+h9
  26. 280 ifabs(z-x)>sw/2 or ze>24 or (st<>h8 and de<>2) then320
  27. 290 if abs(y1)>=h3 orze<20 then 250
  28. 300 ifst=h8 orde=2thenx=int(x*1e5+.5)/1e5:lz=lz+1:de(lz)=x:iffuthende$(lz)="f"
  29. 310 ifabs(de(lz))<5e-2thende(lz)=h8
  30. 320 if z<enthen240
  31. 330 gosub8190
  32. 340 return
  33. 350 :
  34. 360 rem ** extremasuche ***
  35. 370 :
  36. 380 printf$(59)
  37. 390 ex=h9:lz=h8:gosub9680
  38. 400 gosub8140
  39. 410 hh=1e-31:h=h2:z=-en:sw=.1+h
  40. 420 z=z+sw:x=z:ze=h8:printint(x)"[157]  [145]":geta$:ifa$="_"thenreturn
  41. 430 pokeh4,h8
  42. 440 gosub140:y1=y
  43. 450 if(abs(fnx(x))>en or abs(y)>2 or st<>h8 or(y=h8 andze=h8)) and z<enthen420
  44. 460 x=x+h:gosub140:y3=y:x=x-h
  45. 470 x=x-y1/((y3-y1)/h+hh):ze=ze+h9
  46. 480 ifabs(z-x)>sw/2 orze>24then550
  47. 490 ifst<>h8then550
  48. 500 ifabs(y1)>=h2orze<22then430
  49. 510 x=int(x*h5+.5)/h5
  50. 520 ifabs(x)<5e-2thenx=h8
  51. 530 gosub4340
  52. 540 ifabs(de(lz))<hthende(lz)=h8
  53. 550 ifz<enthen420
  54. 560 gosub8190
  55. 570 iflu>0thengosub8660
  56. 580 iflz=h8orde$(1)=""thende$(1)="[203]eine"+chr$(160)+"[197]xtremwerte":de(1)=-50:lz=1
  57. 590 return
  58. 600 :
  59. 610 rem ** zur stringverarbeitung ***
  60. 620 :
  61. 630 q$=mid$(e$,f,h9):return
  62. 640 :
  63. 650 q$=mid$(e$,f,2):return
  64. 660 :
  65. 670 q$=mid$(e$,f,3):return
  66. 680 :
  67. 690 rem ** linien ziehen ***
  68. 700 :
  69. 710 y1=int(y1+.5):y2=int(y2+.5)
  70. 720 ify1<h8  theny1=h8
  71. 730 ify1>160theny1=160
  72. 740 ify2<h8  theny2=h8
  73. 750 ify2>160theny2=160
  74. 760 :
  75. 770 forza=y1 to y2 step sgn(y2-y1)
  76. 780 syss1,x1,za
  77. 790 next
  78. 800 return
  79. 810 :
  80. 820 rem ** def'luecke zeichnen ***
  81. 830 :
  82. 840 if lz<>h8then for za=h8to159:syss1,x1+sw,za:next:return
  83. 850 forza=h9+ge to 160+ge step 2
  84. 860 syss1,x1,za
  85. 870 next
  86. 880 return
  87. 890 :
  88. 900 rem ** start ***
  89. 910 :
  90. 920 gosub7400:rem startwerte
  91. 930 gosub4430:rem eingabe
  92. 940 gosub9220:rem berechnen
  93. 950 gosub7790:rem entscheidung
  94. 960 goto 930
  95. 970 :
  96. 980 rem ** def'luecken ***
  97. 990 :
  98. 1000 gosub8240:rem init
  99. 1010 gosub1140:rem suche
  100. 1020 gosub8490:rem sortieren
  101. 1030 gosub9330:rem gleiche stellen
  102. 1040 le=7:gosub1970:rem vereinfachen
  103. 1050 gosub2570:rem verkuerzen
  104. 1060 gosub9150:rem funkt.init
  105. 1070 ifpl=h8thengosub 9440:goto1120:rem normalausgabe
  106. 1080 gosub8870:rem graphik ein
  107. 1090 gosub2710:rem def'zeichnen
  108. 1100 gosub2790:rem def'in graphik
  109. 1110 gosub8930:rem graphik aus
  110. 1120 de=h9:return
  111. 1130 :
  112. 1140 rem ** funktionen **
  113. 1150 gosub9680
  114. 1160 printf$(16)
  115. 1170 de$(1)="[196](x)=[167][210]":de(1)=-50:lz=h9:de=2:fe=h8
  116. 1180 forf=h9tolen(e$)
  117. 1190 ifmid$(e$,f,1)=chr$(188)ormid$(e$,f,1)=chr$(186)thengosub1430:rem (log+sqr)
  118. 1200 ifmid$(e$,f,h9)=chr$(174)thengosub1520:rem (^)
  119. 1210 next
  120. 1220 :
  121. 1230 rem ** brueche ***
  122. 1240 :
  123. 1250 forf=h9tolen(e$)
  124. 1260 ifmid$(e$,f,h9)=chr$(173)thengosub1350:rem (/)
  125. 1270 next
  126. 1280 gosub 9150:iflz<>h9then1310
  127. 1290 iflz=h9thengosub8140:pokeh4,h8:y=fnx(rnd(ti)*en):gosub8190:ifst<>h8then1320
  128. 1300 return
  129. 1310 de$(h9)=de$(h9)+chr$(160)+"ohne":gosub9330:gosub1730
  130. 1320 iflz=h9thende$(h9)="[206]icht definiert!"
  131. 1330 return
  132. 1340 :
  133. 1350 rem ** bruch gefunden ***
  134. 1360 :
  135. 1370 printf$(17)
  136. 1380 gosub8990
  137. 1390 gosub9080
  138. 1400 fu=h9:gosub190:fu=h8
  139. 1410 return
  140. 1420 :
  141. 1430 rem ** log+sqr finden ***
  142. 1440 :
  143. 1450 ll=lz:printf$(18)
  144. 1460 gosub8990
  145. 1470 gosub9080
  146. 1480 if mid$(e$,f,h9)<>chr$(186)thenfu=h9:rem sqr
  147. 1490 gosub190:fu=h8:rem nullstellen
  148. 1500 return
  149. 1510 :
  150. 1520 rem ** ^ finden ***
  151. 1530 :
  152. 1540 printf$(19)
  153. 1550 gosub8990
  154. 1560 gosub9080
  155. 1570 ll=lz
  156. 1580 gosub 8140
  157. 1590 if int(fnx(.345))<>fnx(.543) or fnx(.345234)<=h8then1610
  158. 1600 return:rem keine luecke
  159. 1610 a=h8:fs=f:za=f-h9
  160. 1620 f=f-h9
  161. 1630 ifmid$(e$,f,h9)="("thena=a+1
  162. 1640 ifmid$(e$,f,h9)=")"thena=a-1
  163. 1650 ifa<>h8then1620
  164. 1660 f=f-h9
  165. 1670 gosub9080
  166. 1680 gosub190
  167. 1690 gosub9150
  168. 1700 f=fs
  169. 1710 return
  170. 1720 :
  171. 1730 rem ** bereiche ***
  172. 1740 :
  173. 1750 printf$(20)
  174. 1760 gosub8140
  175. 1770 ze=h9
  176. 1780 ze=ze+h9:a$=""
  177. 1790 x=de(ze):if de$(ze)="f"then a$="=":lu=lu+h9:lu(lu)=de(ze)
  178. 1800 pokeh4,h8
  179. 1810 y=fnx(x+.101)
  180. 1820 ifst<>h8then1870
  181. 1830 y=fnx(x-.101)
  182. 1840 if ze=2andst<>h8thende$(ze)="[ x<"+a$+str$(de(ze))+"]":goto1930
  183. 1850 if st=h8thende$(ze)="["+str$(de(ze))+"]":lu=lu+1:lu(lu)=de(ze)
  184. 1860 goto1930
  185. 1870 pokeh4,h8:y=fnx(x-.101)
  186. 1880 ifst<>h8thenforf=zetolz:de(f)=de(f+1):next:lz=lz-1:iflz>h9then1770
  187. 1890 de$(ze)="["+str$(de(ze))+"<"+a$+"x"
  188. 1900 ifze>=lzthen1920
  189. 1910 de$(ze)=de$(ze)+"<"+a$+str$(de(ze+1))+"]":ze=ze+1:de$(ze)="def":goto1930
  190. 1920 if ze=lzthende$(ze)=de$(ze)+"]"
  191. 1930 ifze<lzthen1780
  192. 1940 gosub8190
  193. 1950 return
  194. 1960 :
  195. 1970 rem ** vereinfachen ***
  196. 1980 :
  197. 1990 printf$(21)
  198. 2000 forf=h9tolz:printlz-f+h9"[157] [145]"
  199. 2010 ifde$(f)=""then2140
  200. 2020 za=h8:a$=de$(f)
  201. 2030 za=za+h9
  202. 2040 if mid$(a$,za,h9)<"-"or mid$(a$,za,1)>"9"then2120
  203. 2050 h=val(mid$(a$,za)):b$=str$(h):ze=len(b$)
  204. 2060 ifmid$(b$,h9,h9)=" "thenb$=mid$(b$,2):ze=len(b$)
  205. 2070 h=int(h*h6+.5)/h6:ifint(h)=hthenb$=str$(h)
  206. 2080 if int(h)<>h then gosub2170
  207. 2090 iflen(b$)>le thenb$=left$(b$,le)
  208. 2100 ifb$=""orh=0thenb$="":goto2120
  209. 2110 h$=mid$(a$,(za+ze)):a$=left$(a$,za-h9)+b$:za=len(a$):a$=a$+h$
  210. 2120 ifza<len(a$)then2030
  211. 2130 de$(f)=a$
  212. 2140 next
  213. 2150 return
  214. 2160 :
  215. 2170 rem ** zuordnen ***
  216. 2180 :
  217. 2190 hh=h1:a=h6
  218. 2200 for d=h9 to 6
  219. 2210 fors=-10to10:ifs=h8thennext
  220. 2220 x=s*(NULL)/d:x=int(x*a+.5)/a
  221. 2230 ifabs(h-x)>hhthen2320
  222. 2240 ifs=h9or s=-h9then2280
  223. 2250 b$=str$(s)+"pi"
  224. 2260 ifd<>1thenb$=b$+"/"+mid$(str$(d),2)
  225. 2270 return
  226. 2280 ifs=h9andd=h9thenb$="pi":return
  227. 2290 ifs=-h9andd=h9thenb$="-pi":return
  228. 2300 ifs=h9thenb$="pi/"+str$(d):return
  229. 2310 ifs=-h9thenb$="-pi/"+str$(d):return
  230. 2320 next:next
  231. 2330 :
  232. 2340 s=h9
  233. 2350 s=s+h9
  234. 2360 x=h*s:x=int(x*h7+.5)/h7
  235. 2370 ifx=int(x)thenb$=str$(x)+"/"+mid$(str$(s),2):return
  236. 2380 ifs<20then2350
  237. 2390 :
  238. 2400 ford=h9to4
  239. 2410 fors=2to12
  240. 2420 x=(1/d)*sqr(s):x=int(x*a+.5)/a
  241. 2430 ifd=h9andabs(h-x)<hhthenb$=" [186]"+mid$(str$(s),2):return
  242. 2440 ifabs(h-x)<hhthenb$=" [186]"+mid$(str$(s),2)+"/"+mid$(str$(d),2):return
  243. 2450 next:next
  244. 2460 :
  245. 2470 ford=h9to4
  246. 2480 fors=2to12
  247. 2490 x=(1/d)*-sqr(s):x=int(x*a+.5)/a
  248. 2500 ifd=h9andabs(h-x)<hhthenb$="-[186]"+mid$(str$(s),2):return
  249. 2510 ifabs(h-x)<hhthenb$="-[186]"+mid$(str$(s),2)+"/"+mid$(str$(d),2):return
  250. 2520 next:next
  251. 2530 :
  252. 2540 :
  253. 2550 return
  254. 2560 :
  255. 2570 rem ** kuerzen  ***
  256. 2580 :
  257. 2590 a$=""
  258. 2600 forza=h9tolz
  259. 2610 ifde$(za)=""then2680
  260. 2620 a$=de$(za)
  261. 2630 forze=h9tolen(a$)
  262. 2640 ifmid$(a$,ze,h9)<>" "then2660
  263. 2650 ifze>2andze<>9andze<>6thena$=mid$(a$,h9,ze-h9)+mid$(a$,ze+h9):ze=ze-h9
  264. 2660 next
  265. 2670 de$(za)=a$
  266. 2680 next
  267. 2690 return
  268. 2700 :
  269. 2710 rem ** def'zeichnen ***
  270. 2720 :
  271. 2730 forf=h9tolz
  272. 2740 x=de(f):x1=fa*(en+x):ifx1<h8thenx1=h8
  273. 2750 gosub820
  274. 2760 next
  275. 2770 return
  276. 2780 :
  277. 2790 rem ** de$ in graphik ***
  278. 2800 :
  279. 2810 x=20:x1=gp:fl=h8
  280. 2820 forgp=x1+h9tox1+lz
  281. 2830 a$=de$(gp-x1+fl):ifa$="def"thenfl=fl+h9:goto2830
  282. 2840 ifgp<20thengosub3700
  283. 2850 next:gp=gp-fl
  284. 2860 return
  285. 2870 :
  286. 2880 rem ** plotten ***
  287. 2890 :
  288. 2900 sw=h9/fa:ge=1
  289. 2910 syss2:rem graphik loeschen
  290. 2920 gosub8240: rem init
  291. 2930 pl=h8:gosub8870:pl=h9
  292. 2940 gosub3630:rem achsen
  293. 2950 gosub8740:rem gitter
  294. 2960 gosub3050:ifa$="_"then3000:rem zeichnen;abruchmerkmal
  295. 2970 gosub3400:rem funktion schreiben
  296. 2980 gosub3540:rem intervall schreiben
  297. 2990 gosub8810:rem rahmen
  298. 3000 gosub8930:rem graphik aus
  299. 3010 b$=f$(60):gosub8050:rem entscheidung
  300. 3020 ifa$="[133]"thengosub8310:goto2900
  301. 3030 gp=h8:pl=h9:return
  302. 3040 :
  303. 3050 rem ** zeichnen ***
  304. 3060 :
  305. 3070 gosub8140
  306. 3080 x=-en:gosub8870
  307. 3090 pokeh4,h8
  308. 3100 y=fa*(en-fnx(x))
  309. 3110 geta$:ifa$="_"ora$=chr$(13)then3250
  310. 3120 ifst=h8then3170
  311. 3130 x1=fa*(en+x):gosub 820:ge=(ge=h8)
  312. 3140 ifx>enthen3250
  313. 3150 x=x+sw
  314. 3160 goto3090
  315. 3170 x=x+sw:x1=fa*(en+x):ge=(ge=h8)
  316. 3180 geta$:ifa$="_"ora$=chr$(13)then3250
  317. 3190 y1=y:ifst<>h8theny1=fa*(en-fnx(x))
  318. 3200 pokeh4,h8
  319. 3210 y=fa*(en-fnx(x)):y2=y
  320. 3220 ifst=h8thengosub690
  321. 3230 ifst<>h8thengosub820
  322. 3240 ifx<enthen3170
  323. 3250 gosub8190
  324. 3260 return
  325. 3270 :
  326. 3280 rem ** schrift in graphik ***
  327. 3290 :
  328. 3300 poke56334,peek(56334)and254
  329. 3310 poke1,peek(1)and251
  330. 3320 fors=h9tolen(b$)
  331. 3330 if (mid$(b$,s,h9))=" "then3360
  332. 3340 hh=asc(mid$(b$,s,h9))*8:h=x*8+24576+320*gp+s*8
  333. 3350 ford=h8to7:pokeh+d,peek(hh+55296+d):next
  334. 3360 next
  335. 3370 poke1,55:poke56334,h9
  336. 3380 return
  337. 3390 :
  338. 3400 rem ** funktion in graphik ***
  339. 3410 :
  340. 3420 print"[147][198](x)="es$:x=h8:gp=20:b$=""
  341. 3430 forza=1024to1024+len(es$)+4
  342. 3440 b$=b$+chr$(peek(za))
  343. 3450 next
  344. 3460 gosub3280
  345. 3470 x=h8:gp=21:b$=""
  346. 3480 forza=1064to1064+len(es$)+4
  347. 3490 b$=b$+chr$(peek(za))
  348. 3500 next
  349. 3510 gosub3280
  350. 3520 return
  351. 3530 :
  352. 3540 rem ** intervall schreiben ***
  353. 3550 :
  354. 3560 a$=str$(en):a$=mid$(a$,2,3):print"[147][201]ntervall [-"a$";"a$"]":x=h8:gp=23:b$=""
  355. 3570 forza=1024to1060
  356. 3580 b$=b$+chr$(peek(za))
  357. 3590 next
  358. 3600 gosub3280
  359. 3610 return
  360. 3620 :
  361. 3630 rem ** achsen bezeichnen ***
  362. 3640 :
  363. 3650 x=9:gp=h8:b$=chr$(25)
  364. 3660 gosub3280
  365. 3670 x=18:gp=10:b$=chr$(24)
  366. 3680 gosub3280:return
  367. 3690 :
  368. 3700 rem ** erste zeile schreiben ***
  369. 3710 :
  370. 3720 print"[147]"a$:b$=""
  371. 3730 forza=1024to1060
  372. 3740 b$=b$+chr$(peek(za))
  373. 3750 next
  374. 3760 gosub3280
  375. 3770 return
  376. 3780 :
  377. 3790 rem ** nullstellen ***
  378. 3800 :
  379. 3810 printf$(22)
  380. 3820 gosub3950:rem suche
  381. 3830 gosub9150:rem re-init
  382. 3840 ifa$="_"thenreturn
  383. 3850 gosub9540:rem gueltigkeit
  384. 3860 gosub4110:rem de in de$
  385. 3870 le=7:gosub1970:rem vereinf.+zuordnen
  386. 3880 gosub2570:rem kuerzen
  387. 3890 ifpl=h8thengosub 9440:goto3930:rem normalausgabe
  388. 3900 gosub8870:rem graphik ein
  389. 3910 gosub2790:rem schreiben
  390. 3920 gosub8930:rem graphik aus
  391. 3930 return
  392. 3940 :
  393. 3950 rem ** suche n. nullstellen ***
  394. 3960 :
  395. 3970 lz=h8:nu=h9:gosub9680
  396. 3980 gosub190:rem ganze fkt.
  397. 3990 for f=1tolen(e$):rem fkt. teilen
  398. 4000 ifa$="_"thenreturn
  399. 4010 f=f+h9:gosub630:ifq$<>chr$(182)andq$<>chr$(186)thenf=f-h9
  400. 4020 gosub630
  401. 4030 if q$=chr$(173)thengosub8990:f=za+h9:rem (/)
  402. 4040 ifq$=chr$(188)orq$=chr$(189)orq$=chr$(180)then 4090:rem ln,exp,sgn
  403. 4050 ifq$=chr$(186)orq$=chr$(182)thengosub8990:gosub9080:gosub190:rem abs;sqr
  404. 4060 iff=h9then 4080
  405. 4070 ifq$<>chr$(172)then4090:rem (*)
  406. 4080 gosub8990:gosub9080:gosub190
  407. 4090 next:return
  408. 4100 :
  409. 4110 rem ** de in de$ ***
  410. 4120 :
  411. 4130 iflz=h8then4170
  412. 4140 forza=h9tolz:de$(za)="[206]ullst.:"+str$(de(za)):next:gosub8490
  413. 4150 gosub9330
  414. 4160 iflu>0thengosub8660
  415. 4170 iflz=h8then de$(1)="[203]eine"+chr$(160)+"[206]ullstellen":de(1)=-50:lz=h9
  416. 4180 return
  417. 4190 :
  418. 4200 rem ** extremas ***
  419. 4210 :
  420. 4220 gosub8240:rem init
  421. 4230 gosub360:rem suche
  422. 4240 ifa$="_"thenreturn
  423. 4250 le=6:gosub1970:rem vereinfachen
  424. 4260 gosub2570:rem verkuerzen
  425. 4270 ifpl=h8thengosub9440:goto4320:rem normalausgabe
  426. 4280 gosub8870:rem graphik ein
  427. 4290 gosub 8490:rem sortieren
  428. 4300 gosub2790:rem extrema in graphik
  429. 4310 gosub8930:rem graphik aus
  430. 4320 return
  431. 4330 :
  432. 4340 rem ** minima oder maxima ***
  433. 4350 :
  434. 4360 y=fnx(x):y=int(y*h5+.5)/h5
  435. 4370 ifabs(y)<h1theny=h8
  436. 4380 r=fnx(x+.1):l=fnx(x-.1):m=fnx(x)
  437. 4390 ifr<m and l<m thenlz=lz+h9:de$(lz)="[205]ax.:"+str$(x)+";"+str$(y):de(lz)=x
  438. 4400 ifr>m and l>m thenlz=lz+h9:de$(lz)="[205]in.:"+str$(x)+";"+str$(y):de(lz)=x
  439. 4410 return
  440. 4420 :
  441. 4430 rem ** eingaberoutine ***
  442. 4440 :
  443. 4450 gosub4650:rem eingabe
  444. 4460 gosub4950:rem syntaxkontrolle
  445. 4470 gosub7010:rem betraege
  446. 4480 gosub6890:rem pi suche
  447. 4490 gosub5760:rem malzeichen
  448. 4500 gosub5670:rem potenzen
  449. 4510 gosub5890:rem klammern1
  450. 4520 gosub7220:rem tan
  451. 4530 gosub6010:rem klammern2
  452. 4540 gosub6110:rem klammern3
  453. 4550 gosub6300:rem klammern4
  454. 4560 gosub6210:rem log+ln
  455. 4570 gosub6460:rem eulerische zahl
  456. 4580 gosub6550:rem tokens
  457. 4590 gosub5290:rem letzte syntaxkontrolle
  458. 4600 gosub5590:rem fehlermeldungen
  459. 4610 if fe then4450
  460. 4620 gosub6800:rem speichern
  461. 4630 return
  462. 4640 :
  463. 4650 rem ** eingabeteil ***
  464. 4660 :
  465. 4670 printf$(23):sys46374
  466. 4680 fe=h8:fl=h8:ll=h8:hi=h8
  467. 4690 print""es$"_[145]":e$=es$
  468. 4700 geta$:ifa$=""then4700
  469. 4710 a=asc(a$):ifa=20andlen(e$)=h8then4700
  470. 4720 if(a$="[200]"ora$="h")andfl=h8thenes$=e$:gosub9790:goto4650
  471. 4730 if peek(211)>34andpeek(211)<40orpeek(211)>74anda<>20thena=20
  472. 4740 ifa$="[194]"thena$="[221]":a=221:be=be+h9
  473. 4750 print
  474. 4760 ifa<>13ore$=""then 4820
  475. 4770 if fl<>h8then4810
  476. 4780 es$=e$:e$=e$+":"
  477. 4790 b$=""+es$+chr$(13)+f$(24):gosub8050:ifa$="[136]"thenreturn
  478. 4800 goto4650:rem neue eingabe
  479. 4810 if right$(e$,3)<>" [157][145]"thene$=e$+"":fl=h8
  480. 4820 if e$=""then4890
  481. 4830 ifa$="^"andfl=0andright$(e$,1)<>""thene$=e$+" [157][145]":fl=h9:goto4910
  482. 4840 ifa<>20then4900
  483. 4850 ifright$(e$,h9)=""thene$=left$(e$,len(e$)-1):fl=h9
  484. 4860 ifright$(e$,3)=" [157][145]"thene$=left$(e$,len(e$)-3):fl=h8
  485. 4870 ifright$(e$,h9)="[221]"thenbe=be-1
  486. 4880 e$=left$(e$,len(e$)-h9)
  487. 4890 ifa$="^"ande$=""then4910
  488. 4900 if(a>32anda<96)ora=186ora=222ora=221thene$=e$+a$
  489. 4910 e$=e$+"[145]  [157][157]_   [157][157][157][157]  [145]":print"[145]"e$;:e$=left$(e$,len(e$)-18)
  490. 4920 iffl=h9thenprint"";
  491. 4930 goto4700
  492. 4940 :
  493. 4950 rem ** syntax 1 ***
  494. 4960 :
  495. 4970 printf$(25)
  496. 4980 a=h8:forf=h9tolen(e$)
  497. 4990 gosub630
  498. 5000 ifq$="("thena=a+1
  499. 5010 ifq$=")"thena=a-1
  500. 5020 ifq$="x"thenll=ll+1
  501. 5030 next
  502. 5040 ifa<>h8thenfe=1:gosub9740:return
  503. 5050 ifll=h8thenfe=8192:gosub9740:return
  504. 5060 a=h8:forf=h9tolen(e$)
  505. 5070 gosub630
  506. 5080 ifq$="["thena=a+1
  507. 5090 ifq$="]"thena=a-1
  508. 5100 next
  509. 5110 ifa<>h8thenfe=2:gosub9740
  510. 5120 forf=h9tolen(e$)
  511. 5130 gosub630
  512. 5140 ifq$<>"/"then 5180
  513. 5150 f=f+h9:gosub630
  514. 5160 if (q$<"0" or q$>"9") and (q$<>"("and q$<>"["and q$ <>"x") thenfe=2048
  515. 5170 iffethengosub9740:return
  516. 5180 next
  517. 5190 forf=h9tolen(e$)
  518. 5200 gosub630:ifq$="("orq$=")"orq$="]"orq$="["then5230
  519. 5210 ifq$>="0"andq$<="9"then5230
  520. 5220 a$=q$:f=f+h9:gosub630:f=f-h9:ifa$=q$thenfe=4096:gosub9740:return
  521. 5230 gosub630:ifq$<>"*"andq$<>"("then 5260
  522. 5240 f=f+h9:gosub630:f=f-h9
  523. 5250 ifq$="*"orq$="/"orq$="+"orq$=")"thenfe=4096:gosub9740:return
  524. 5260 next
  525. 5270 return
  526. 5280 :
  527. 5290 rem ** letzte syntaxkontrolle ***
  528. 5300 :
  529. 5310 iffethen return
  530. 5320 printf$(26)
  531. 5330 forf=2tolen(e$)-h9
  532. 5340 gosub630
  533. 5350 a=asc(q$):ifa<45and(a<40ora=44)or(a=>58anda<170anda<>88)thenfe=8
  534. 5360 iffethenprint"'"q$"[146]'":return
  535. 5370 next
  536. 5380 forf=2tolen(e$)-h9
  537. 5390 gosub630
  538. 5400 ifq$<>"("then5440
  539. 5410 f=f+1:gosub630
  540. 5420 a=asc(q$):ifa=172or a=173 ora=174 thenfe=4096:return
  541. 5430 f=f-1:gosub630
  542. 5440 gosub650:ifq$=")("thenfe=32:return
  543. 5450 ifq$="x)"thenf=f+2:gosub630:f=f-2:if(q$<"[167]"orq$>"[174]")andq$>":"thenfe=64
  544. 5460 iffethenreturn
  545. 5470 gosub630:ifq$<="x"orq$=chr$(255)then5520
  546. 5480 f=f+h9:gosub630:ifq$<>"("andq$<>":"andasc(q$)<170thenfe=4096:return
  547. 5490 ifq$="[174]"thenf=f-1:gosub630:f=f+1:ifq$>"9"andasc(q$)<>255thenfe=4:return
  548. 5500 f=f-h9:gosub630
  549. 5510 ifq$>"[180]"andq$<"[192]"thenf=f+1:gosub630:f=f-1:ifq$<>"("thenfe=128:return
  550. 5520 ifq$<>")"then5550
  551. 5530 f=f+h9:gosub630:f=f-h9
  552. 5540 a=asc(q$):if(a<170ora>174)and(a<>58)and(a<>41)thenfe=512:return
  553. 5550 next
  554. 5560 iflen(e$)>79thenfe=256
  555. 5570 return
  556. 5580 :
  557. 5590 rem ** fehlermeldungen ***
  558. 5600 :
  559. 5610 iffe=h8thenreturn
  560. 5620 hi=log(fe)/log(2)+1
  561. 5630 printf$(hi):gosub7970
  562. 5640 ifa$="[200]"ora$="h"thengosub9790:hi=0
  563. 5650 return
  564. 5660 :
  565. 5670 rem ** potenzen in klammern ***
  566. 5680 :
  567. 5690 iffethenreturn
  568. 5700 printf$(27)
  569. 5710 forf=h9tolen(e$)
  570. 5720 if mid$(e$,f,3)=" [157][145]"thene$=left$(e$,f-1)+"^("+right$(e$,len(e$)-f-2)
  571. 5730 if mid$(e$,f,h9)=""thene$=left$(e$,f-1)+")"+right$(e$,len(e$)-f)
  572. 5740 next:return
  573. 5750 :
  574. 5760 rem ** mal zeichen setzen ***
  575. 5770 :
  576. 5780 iffethenreturn
  577. 5790 printf$(28):f=h8
  578. 5800 f=f+h9
  579. 5810 gosub630
  580. 5820 a=asc(q$):if(a<64ora>90)and(a<>255anda<>40anda<>186)then5860
  581. 5830 iff<>1thenf=f-h9:gosub630
  582. 5840 a=asc(q$):ifa<48ora>57thenf=f+h9:goto5860
  583. 5850 ifa>47anda<58thene$=left$(e$,f)+"*"+right$(e$,len(e$)-f):f=f+2
  584. 5860 iff<len(e$)then5800
  585. 5870 return
  586. 5880 :
  587. 5890 rem ** klammern setzen (1) ***
  588. 5900 :
  589. 5910 iffethenreturn
  590. 5920 printf$(29)
  591. 5930 f=h8:e$=" "+e$
  592. 5940 f=f+h9:gosub630:a=asc(q$)
  593. 5950 gosub630:ifq$="x"thene$=left$(e$,f-1)+"(x)"+right$(e$,len(e$)-f):f=f+2
  594. 5960 ifq$="e"thene$=left$(e$,f-1)+"(e)"+right$(e$,len(e$)-f):f=f+2
  595. 5970 ifq$=chr$(255)thene$=left$(e$,f-1)+"("+chr$(255)+")"+right$(e$,len(e$)-f):f=f+2
  596. 5980 iff<len(e$)then5940
  597. 5990 return
  598. 6000 :
  599. 6010 rem **  klammern setzen (2) ***
  600. 6020 :
  601. 6030 iffe thenreturn
  602. 6040 printf$(30)
  603. 6050 f=h8
  604. 6060 f=f+h9
  605. 6070 ifmid$(e$,f,2)=")("thene$=left$(e$,f-1)+")*"+right$(e$,len(e$)-f):f=f+2
  606. 6080 iff<len(e$)then6060
  607. 6090 return
  608. 6100 :
  609. 6110 rem ** klammern setzen (3) ***
  610. 6120 :
  611. 6130 iffethenreturn
  612. 6140 printf$(31)
  613. 6150 forf=h9tolen(e$)
  614. 6160 gosub630
  615. 6170 ifq$="["thene$=left$(e$,f-1)+"("+right$(e$,len(e$)-f)
  616. 6180 ifq$="]"thene$=left$(e$,f-1)+")"+right$(e$,len(e$)-f)
  617. 6190 next:return
  618. 6200 :
  619. 6210 rem ** log+ln umwandlung ***
  620. 6220 :
  621. 6230 iffe thenreturn
  622. 6240 printf$(32)
  623. 6250 forf=h9tolen(e$)
  624. 6260 ifmid$(e$,f,2)="ln"thene$=left$(e$,f-1)+"log"+right$(e$,len(e$)-f-1):f=f+1
  625. 6270 ifmid$(e$,f,3)="log"thenfe=feor16
  626. 6280 next:return
  627. 6290 :
  628. 6300 rem ** klammern setzen (4) ***
  629. 6310 :
  630. 6320 iffethenreturn
  631. 6330 printf$(33)
  632. 6340 f=h8
  633. 6350 f=f+h9
  634. 6360 gosub630:a=asc(q$)
  635. 6370 if(a>47anda<58)ora=46thengosub6400
  636. 6380 iff<len(e$)then6350
  637. 6390 return
  638. 6400 e$=left$(e$,f-h9)+"("+right$(e$,len(e$)-f+1)
  639. 6410 f=f+h9
  640. 6420 gosub630:a=asc(q$)
  641. 6430 if(a>47anda<58)ora=46then6410
  642. 6440 e$=left$(e$,f-h9)+")"+right$(e$,len(e$)-f+1):return
  643. 6450 :
  644. 6460 rem ** e wandeln ***
  645. 6470 :
  646. 6480 iffethenreturn
  647. 6490 f=h8
  648. 6500 f=f+h9
  649. 6510 gosub630:ifq$="e"thene$=left$(e$,f-1)+"exp(1)"+right$(e$,len(e$)-f):f=f+3
  650. 6520 iff<len(e$)then6500
  651. 6530 return
  652. 6540 :
  653. 6550 rem ** string in tokens wandeln ***
  654. 6560 :
  655. 6570 iffethenreturn
  656. 6580 printf$(34)
  657. 6590 me$=e$
  658. 6600 forf=h9tolen(e$):gosub630
  659. 6610 ifq$="+"thena=170:gosub6770
  660. 6620 ifq$="-"thena=171:gosub6770
  661. 6630 ifq$="*"thena=172:gosub6770
  662. 6640 ifq$="/"thena=173:gosub6770
  663. 6650 ifq$="^"thena=174:gosub6770
  664. 6660 next
  665. 6670 forf=h9tolen(e$):gosub670
  666. 6680 ifq$="cos"thena=190:gosub6780
  667. 6690 ifq$="sin"thena=191:gosub6780
  668. 6700 ifq$="tan"thena=192:gosub6780
  669. 6710 ifq$="log"thena=188:gosub6780
  670. 6720 ifq$="exp"thena=189:gosub6780
  671. 6730 ifq$="abs"thena=182:gosub6780
  672. 6740 ifq$="sgn"thena=180:gosub6780
  673. 6750 ifq$="sqr"thena=186:gosub6780
  674. 6760 next:return
  675. 6770 e$=left$(e$,f-h9)+chr$(a)+right$(e$,len(e$)-f):return
  676. 6780 e$=left$(e$,f-h9)+chr$(a)+right$(e$,len(e$)-f-2):return
  677. 6790 :
  678. 6800 rem ** funktion speichern ***
  679. 6810 :
  680. 6820 printf$(47)
  681. 6830 ad=49152+999
  682. 6840 forf=h9tolen(e$)
  683. 6850 pokead+f,asc(mid$(e$,f,h9))
  684. 6860 next
  685. 6870 pokead+f,h8
  686. 6880 return
  687. 6890 :
  688. 6900 rem ** pi wandeln ***
  689. 6910 :
  690. 6920 iffethenreturn
  691. 6930 printf$(35)
  692. 6940 f=h8
  693. 6950 f=f+h9:gosub650
  694. 6960 ifq$="pi"thene$=left$(e$,f-1)+chr$(255)+right$(e$,len(e$)-f-1):f=f+1
  695. 6970 ifq$=chr$(222)thene$=left$(e$,f-1)+chr$(255)+right$(e$,len(e$)-f)
  696. 6980 iff<len(e$)then6950
  697. 6990 return
  698. 7000 :
  699. 7010 rem *** betraege ***
  700. 7020 :
  701. 7030 iffe<>0orbe=0thenreturn
  702. 7040 printf$(36)
  703. 7050 fl=h8:a=h8:s=h8:f=h8
  704. 7060 f=f+h9:gosub630:ifq$="[221]"thena=a+h9
  705. 7070 if(q$="/"orq$="*"orq$="+"orq$="-")anda=2thenza=f:gosub7120:a=h8:s=za:f=za
  706. 7080 iff<len(e$)then7060
  707. 7090 gosub7120
  708. 7100 return
  709. 7110 :
  710. 7120 ifa=h9ora>2thenfe=1024:return
  711. 7130 f=s:fl=h8
  712. 7140 f=f+h9
  713. 7150 gosub630
  714. 7160 ifq$="[221]"thenfl=fl+h9:iffl=3thenfl=1
  715. 7170 ifq$="[221]"andfl=h9thene$=left$(e$,f-1)+"abs("+right$(e$,len(e$)-f)
  716. 7180 iffl=2andq$="[221]"thene$=left$(e$,f-1)+")"+right$(e$,len(e$)-f)
  717. 7190 iff<len(e$)then7140
  718. 7200 return
  719. 7210 :
  720. 7220 rem ** tangens  ***
  721. 7230 :
  722. 7240 iffethenreturn
  723. 7250 printf$(37):f=h8
  724. 7260 f=f+h9
  725. 7270 gosub670
  726. 7280 ifq$<>"tan"then7370
  727. 7290 a=h8:s=f-h9:f=f+2:q$=""
  728. 7300 f=f+h9
  729. 7310 gosub 630
  730. 7320 ifq$="("thena=a+h9
  731. 7330 ifq$=")"thena=a-h9
  732. 7340 ifa<>h8then7300
  733. 7350 q$=mid$(e$,s+4,f-s-3)
  734. 7360 e$=left$(e$,s)+"(sin"+q$+")/(cos"+q$+")"+right$(e$,len(e$)-f)
  735. 7370 if f<len(e$)then7260
  736. 7380 return
  737. 7390 :
  738. 7400 rem ** startwerte ***
  739. 7410 :
  740. 7420 x=1:ze=1:za=1:y1=1:sw=1:z=1:en=1:h=1:h9=1:h4=144:h8=0:f=1:h5=1e8:y3=1:y2=1
  741. 7430 a=1:h1=1e-3:h2=1e-4:h3=1e-5:h6=1e4:h7=1e3:fl=1:x1=1
  742. 7440 s1=49152:s2=49380:dimde$(50):dimde(50):dimlu(50):dimf$(62)
  743. 7450 open1,8,8,"strings":forf=1to62:input#1,f$(f):next:close1
  744. 7460 return
  745. 7470 :
  746. 7480 rem ** drucken ***
  747. 7490 :
  748. 7500 b$=f$(38):gosub 8050
  749. 7510 ifa$="[133]"thenreturn
  750. 7520 printf$(39)
  751. 7530 ze=h8:ifdr=h8thendimdr%(320):dr=h9
  752. 7540 forf=h8to7:d%(f)=2^(7-f):next
  753. 7550 forza=24576 to 32576 step 8
  754. 7560 print"[206]och"32576-za"[157] [218]eichen  "
  755. 7570 for d=h8 to 7:h=peek(za+d)
  756. 7580 ifh=h8then 7620
  757. 7590 for f=h8 to 7
  758. 7600 if (handd%(f))thendr%(ze+f)=dr%(ze+f)ord%(d)
  759. 7610 next
  760. 7620 next
  761. 7630 ze=ze+8
  762. 7640 if ze= 320 then gosub 7680
  763. 7650 next
  764. 7660 return
  765. 7670 :
  766. 7680 rem *druckeranpassung und ausdruck*
  767. 7690 :
  768. 7700 open1,4,4:a$=chr$(27):rem escape
  769. 7710 print#1,a$;chr$(51);chr$(24);:rem 8 nadeln vorschub
  770. 7720 print#1,a$;chr$(108);chr$(16);:rem 16 zeichen vom rand
  771. 7730 print#1,a$;"*";chr$(5);:rem zeichendichte,fuer epson 5= 1:1
  772. 7740 print#1,chr$(64);chr$(1);:rem anzahl der daten im low/highbyte format
  773. 7750 forf=h8to320:print#1,chr$(dr%(f));:dr%(f)=h8:next:rem zeichen drucken
  774. 7760 print#1,chr$(10):rem zeilenvorschub
  775. 7770 close1:ze=h8:return
  776. 7780 :
  777. 7790 rem ** entscheidung ***
  778. 7800 :
  779. 7810 printf$(40)
  780. 7820 printf$(41)
  781. 7830 ifpl<>h8thenprintf$(42)
  782. 7840 ifpl<>h8thenprintf$(43)
  783. 7850 printf$(44)
  784. 7860 printf$(45)
  785. 7870 printf$(46)
  786. 7880 gosub7970
  787. 7890 ifa$="[133]"thenpl=0:de=0:nu=0:ex=0:lz=0:lu=0:ge=0:return
  788. 7900 ifpl<>h8anda$="[134]"then gosub8870:gosub7970:gosub8930:goto7790
  789. 7910 ifpl<>h8anda$="[135]"thengosub 7480:goto7790
  790. 7920 ifa$="[136]"thenlz=h8:gosub9220:goto7790
  791. 7930 ifa$="[137]"thenpl=0:de=0:nu=0:ex=0:lz=0:lu=0:gosub 9220:goto7790
  792. 7940 ifa$="[140]"thenprint"[147][193]uf [215]iedersehen!":sys64738
  793. 7950 goto7880
  794. 7960 :
  795. 7970 rem ** auf tastendruck warten ***
  796. 7980 :
  797. 7990 printf$(15)
  798. 8000 geta$:ifa$<>""then8000
  799. 8010 geta$:ifa$=""then8010
  800. 8020 printf$(62)
  801. 8030 return
  802. 8040 :
  803. 8050 rem ** entscheidung ***
  804. 8060 :
  805. 8070 print"[147]"b$""
  806. 8080 printf$(48)
  807. 8090 printf$(49)
  808. 8100 gosub7970:rem warten
  809. 8110 ifa$<>"[133]"anda$<>"[136]"then8100
  810. 8120 return
  811. 8130 :
  812. 8140 rem ** fehlermeldung abschalten ***
  813. 8150 :
  814. 8160 poke768,188:poke769,2
  815. 8170 return
  816. 8180 :
  817. 8190 rem ** fehlermeldung einschalten ***
  818. 8200 :
  819. 8210 poke768,139:poke769,227
  820. 8220 return
  821. 8230 :
  822. 8240 rem ** initialisierung der fkt. ***
  823. 8250 :
  824. 8260 def fnx(x)=x:
  825. 8270 a=256*peek(79)+peek(78)
  826. 8280 poke a,232:poke a+h9,195
  827. 8290 return
  828. 8300 :
  829. 8310 rem ** intervall ***
  830. 8320 :
  831. 8330 print"[147] [198](x)="es$
  832. 8340 printf$(50)
  833. 8350 printf$(51)
  834. 8360 printf$(52)
  835. 8370 printf$(53)
  836. 8380 printf$(54)
  837. 8390 gosub7970:rem warten
  838. 8400 ifa$="[133]"then x=-4
  839. 8410 ifa$="[134]"then x=-8
  840. 8420 ifa$="[135]"then x=-16
  841. 8430 ifa$="[136]"then x=-32
  842. 8440 ifa$<"[133]"ora$>"[136]"then8390
  843. 8450 en=-x
  844. 8460 fa=-80/x
  845. 8470 return
  846. 8480 :
  847. 8490 rem ** sortieren ***
  848. 8500 :
  849. 8510 forza=h9tolz
  850. 8520 forze=h9tolz
  851. 8530 ifde(za)=>de(ze)then8550
  852. 8540 a=de(za):a$=de$(za):de(za)=de(ze):de$(za)=de$(ze):de(ze)=a:de$(ze)=a$:ze=1
  853. 8550 next
  854. 8560 next:za=h8
  855. 8570 za=za+h9
  856. 8580 if de$(za)<>""then8630
  857. 8590 forze=za tolz
  858. 8600 de(ze)=de(ze+h9):de$(ze)=de$(ze+h9)
  859. 8610 next
  860. 8620 lz=lz-h9:za=h9
  861. 8630 ifza<lzthen8570
  862. 8640 return
  863. 8650 :
  864. 8660 rem ** auf def'l. pruefen ***
  865. 8670 :
  866. 8680 forza=h9tolu
  867. 8690 forze=h9tolz
  868. 8700 if abs(lu(za)-de(ze))>h1 or lz=h8 then8720
  869. 8710 forf=zetolz:de(f)=de(f+h9):de$(f)=de$(f+1):next:lz=lz-h9:ze=h9:goto8680
  870. 8720 next:next:return
  871. 8730 :
  872. 8740 rem ** gitter ***
  873. 8750 :
  874. 8760 for ze=h8 to 160 step 20
  875. 8770 forza=h8to160step4:syss1,za,ze:syss1,ze,za:next
  876. 8780 next
  877. 8790 forza=160to0step-2:syss1,za,80:syss1,80,za:next:return
  878. 8800 :
  879. 8810 rem ** rahmen ***
  880. 8820 :
  881. 8830 forza=h8to319:syss1,za,h8:syss1,za,199:next
  882. 8840 forza=h8to199:syss1,h8,za:syss1,319,za:next
  883. 8850 return
  884. 8860 :
  885. 8870 rem ** graphik ein ***
  886. 8880 :
  887. 8890 poke53265,59:poke53272,104:poke56576,2:rem graphik ein
  888. 8900 ifpl<>h8thenv=53248:pokev+21,1:pokev+39,11:poke23544,116:rem sprite ein
  889. 8910 return
  890. 8920 :
  891. 8930 rem ** graphik aus ***
  892. 8940 :
  893. 8950 poke53265,155:poke53272,21:pokev+21,h8:poke56576,3
  894. 8960 printchr$(14)
  895. 8970 return
  896. 8980 :
  897. 8990 rem ** argument finden (def'l) ***
  898. 9000 :
  899. 9010 a=h8:za=f:fl=h8
  900. 9020 za=za+h9
  901. 9030 ifmid$(e$,za,h9)="("thena=a+1:fl=h9
  902. 9040 ifmid$(e$,za,h9)=")"thena=a-1
  903. 9050 ifa<>h8 or fl=h8then9020
  904. 9060 return
  905. 9070 :
  906. 9080 rem ** argument initialisieren  ***
  907. 9090 :
  908. 9100 forze=h9toza-f
  909. 9110 poke49152+999+ze,asc(mid$(e$,ze+f,h9))
  910. 9120 next:pokeze+49152+999,asc(":")
  911. 9130 return
  912. 9140 :
  913. 9150 rem ** funktion reinitialisieren ***
  914. 9160 :
  915. 9170 forze=h9tolen(e$)
  916. 9180 poke49152+999+ze,asc(mid$(e$,ze,h9))
  917. 9190 next:pokeze+49152+999,asc(":")
  918. 9200 return
  919. 9210 :
  920. 9220 rem ** hauptprogramm berechnen ***
  921. 9230 :
  922. 9240 ifpl=h8andde=h8andnu=h8andex=h8thengosub8310:rem startwerte
  923. 9250 ifpl=h8thenb$=f$(55):gosub8050:ifa$="[136]"thende=0:nu=0:ex=0:lu=0:gosub2880
  924. 9260 if be then return:rem betraege
  925. 9270 ifde=h8thenb$=f$(56):gosub8050:ifa$="[136]"thengosub980
  926. 9280 ifde=h8thenreturn
  927. 9290 ifnu=h8thenb$=f$(57):gosub8050:ifa$="[136]"thengosub3790
  928. 9300 ifex=h8thenb$=f$(58):gosub8050:ifa$="[136]"thengosub4200
  929. 9310 return
  930. 9320 :
  931. 9330 rem ** gleiche stellen pruefen ***
  932. 9340 :
  933. 9350 iflz=h9thenreturn
  934. 9360 gosub8140:forza=h9-(de=2)tolz-h9
  935. 9370 if abs(de(za)-de(za+1))>.2orlz<=h9-(de=2)then9410
  936. 9380 ifnu=1and(abs(fnx(de(za)))<abs(fnx(de(za+1))))then 9400
  937. 9390 forf=zatolz:de$(f)=de$(f+1):de(f)=de(f+1):next:lz=lz-h9:goto9360
  938. 9400 forf=zatolz:de$(f+1)=de$(f+2):de(f+1)=de(f+2):next:lz=lz-h9:goto9360
  939. 9410 next
  940. 9420 gosub8190:return
  941. 9430 :
  942. 9440 rem ** normalausgabe ***
  943. 9450 :
  944. 9460 x=20:x1=gp:print"[147]"
  945. 9470 forgp=x1+h9tox1+lz
  946. 9480 a$=de$(gp-x1)
  947. 9490 ifa$<>"def"thenprinta$
  948. 9500 next
  949. 9510 gosub 7970
  950. 9520 return
  951. 9530 :
  952. 9540 rem ** gueltigkeit ***
  953. 9550 :
  954. 9560 printf$(61)
  955. 9570 gosub8140
  956. 9580 for za= h9 to lz:pokeh4,h8:y=fnx(de(za))
  957. 9590 if st=h8then9630
  958. 9600 pokeh4,h8:y=fnx(de(za)+h1):ifst=h8then9630
  959. 9610 pokeh4,h8:y=fnx(de(za)-h1):ifst=h8then9630
  960. 9620 iflz>h8thengoto9640
  961. 9630 if abs(y)<.5orlz=h8then9650
  962. 9640 forf=zatolz:de$(f)=de$(f+h9):de(f)=de(f+h9):next:lz=lz-h9:goto9580
  963. 9650 next
  964. 9660 gosub8190:return
  965. 9670 :
  966. 9680 rem ** loeschen ***
  967. 9690 :
  968. 9700 forf=h9to50
  969. 9710 de(f)=h8:de$(f)=""
  970. 9720 next :return
  971. 9730 :
  972. 9740 rem ** syntaxfehler markieren ***
  973. 9750 :
  974. 9760 es$=left$(es$,f-1)+"_"+mid$(es$,f)
  975. 9770 return
  976. 9780 :
  977. 9790 rem ** hilfsmeldungen ***
  978. 9800 :
  979. 9810 a$=mid$(str$(hi),2)+"hilfe"
  980. 9820 open8,8,8,a$
  981. 9830 input#8,a$
  982. 9840 ifa$<>"warte"thenprinta$
  983. 9850 ifa$="warte"thengosub7970
  984. 9860 ifst<>64anda$<>"_"then9830
  985. 9870 close8:hi=0
  986. 9880 return
  987. 10000 open15,8,15,"s:hpro*":close15:save"hprogramm",8:verify"hprogramm",8
  988.