home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 47 / 64er_Magazin_Sonderheft_47_19xx_Markt__Technik_de_Side_A.d64 / parapol (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  15KB  |  605 lines
  1. 5 rem ********parapol******************
  2. 10 rem funktionen in parameter-bzw.-  *
  3. 12 rem polarkoordinatendarstellung    *
  4. 14 rem zeichnen und ausdrucken        *
  5. 16 rem grafik mit gr2001              *
  6. 18 rem                                *
  7. 20 rem      diether gnilka            *
  8. 22 rem      nelkenstr.7               *
  9. 24 rem      8120 weilheim             *
  10. 26 rem        28.7.1989               *
  11. 28 rem                                *
  12. 30 rem ********************************
  13. 32 poke 53280,13:poke 53281,0
  14. 36 :
  15. 38 print"[147]     [158]gr2001 geladen ? <j/n> ?"
  16. 40 get l$:if l$="n" then 46
  17. 42 if l$<>"j" then 40
  18. 44 goto 70
  19. 46 print"     mit <run/stop>[158] prg. beenden !"
  20. 48 print"     gr2001,8 laden ![158]"
  21. 50 print"    poke 12481,133:poke12482,48[158]
  22. 52 [153]"     eingeben, dann 'runsys'"
  23. 54 [153]"   und 'parapol,8' laden u.starten !sys"
  24. 56 [153]"           <taste>close!sys"
  25. 58 [146] 198,1: [161]a$
  26. 60 :
  27. 65 [143] eingangsgrafik
  28. 70 [151] 53280,8
  29. 75 [153]"load"
  30. 80 a[178]1024:b[178]55296:c[178]1984:d[178]56256
  31. 82 [129] i[178]0 [164] 39:[151]a[170]i,42:[151]b[170]i,4:[130]
  32. 84 [129] i[178]0 [164] 39:[151]c[170]i,42:[151]d[170]i,4:[130]
  33. 86 [129] i[178]1 [164] 23:[151]a[170]40[172]i,42:[151]b[170]40[172]i,4:[130]
  34. 88 [129] i[178]1 [164] 22:[151]a[170]39[170]40[172]i,42:[151]b[170]39[170]40[172]i,4:[130]
  35. 90 [153]"zeichnen und drucken von funktionen"
  36. 92 [153]"in parameterdarstellung"
  37. 94 [153]"oder"
  38. 96 [153]"polarkoordinatenform"
  39. 98 [129] w[178]1 [164] 1000:[130]
  40. 100 [151]781,18:[151]782,11:[158]65520
  41. 102 [153]"d.gnilka weilheim"
  42. 104 [151]781,20:[151]782,18:[158]65520
  43. 106 [153]"deftaste !sys"
  44. 108 [151] 1983,42:[151] 56255,4
  45. 112 [209] 0
  46. 115 [146] 198,1: [161] a$
  47. 116 :
  48. 118 [151] 53280,3
  49. 120 [153]"loades werden funktionen, die in parameter-sys"
  50. 125 [153]"    oder polarkoordinatendarstellung sys"
  51. 130 [153]"        gegeben sind, gezeichnet."
  52. 135 [153]"typ 1: parameterdarstellung  x(t), y(t)sys"
  53. 140 [153]"       mit argument t,wobei t1..t..t2"
  54. 145 [153]"       im bogenmass einzusetzen ist."
  55. 150 [153]"typ 2: polarkoordinatendarstellung r(w)sys"
  56. 155 [153]"       mit argument w,wobei w1..w..w2"
  57. 160 [153]"       im bogenmass einzusetzen ist."
  58. 165 [153]"  es kann auch ein zweiter parameter k"
  59. 170 [153]"   als formvariablesys genommen werden."
  60. 175 [153]"   nach zeichnen ausgabe auf druckersys"
  61. 177 [153]"                moeglich."
  62. 180 [153]"          defauswahl:  <taste> !sys"
  63. 185 [209] 0
  64. 190 [146] 198,1: [161] a$
  65. 192 :
  66. 195 [141] 4000: [143] fehlerroutine einlesen
  67. 200 [143]************menue**************
  68. 205 [206] 0
  69. 207 [151] 53280,5: [143] rahmen gruen
  70. 208 [151] 53281,0: [143] hintergrd.schwarz
  71. 210 [153]"loadsys  ************ defmenuesys *****************"
  72. 220 [153]"  <1sys>  funktionen in parameterform"
  73. 225 [153]"        definieren und zeichnen"
  74. 230 [153]"  <2sys>  funktion in polarkoordinaten"
  75. 235 [153]"        definieren und zeichnen"
  76. 245 [153]"  <3sys>  grafik ansehen"
  77. 248 [153]"  <4sys>  grafik loeschensys
  78. 250 print"  <5[158]>  param.(x0;y0,t,w,k) aendern"
  79. 255 print"  <6[158]>  drucker-hardcopy"
  80. 257 print"  <7[158]>  grafik save/load"
  81. 258 print"  <8[158]>  directory lesen"
  82. 260 print"  <9[158]>  ende ?"
  83. 265 print"  funktionen aendern mit <1[158]> oder <2[158]> !"
  84. 268 print"         [150]bitte waehlen ![158]"
  85. 269 (NULL) 0
  86. 270 poke 198,0:wait 198,1:get a$
  87. 280 ifa$<"1"or a$>"9" then 270
  88. 285 a=val(a$)
  89. 290 on a goto 400,800,4500,5000,1200,3200,5700,6100,3500
  90. 295 goto 270
  91. 300 print"[147]mit parameter k[158] ? <j/n[158]>"
  92. 310 get p$: if p$="n" then 340
  93. 320 if p$<>"j" then 310
  94. 330 q=1:poke856,1:goto 350 :rem mit parameter
  95. 340 q=0:poke 856,0:rem ohne parameter
  96. 350 return
  97. 380 :
  98. 390 rem funktionen x(t),y(t) definieren
  99. 400 rem *******************************
  100. 401 poke 53280,4
  101. 402 m%=0:poke 854,0:rem neue funkt.eingegeben
  102. 403 p=1: rem typ 1 parameterform
  103. 404 poke 852,1:rem retten in zp
  104. 405 gosub 300: rem mit parameter k
  105. 410 print"[147]bitte funktionsterm x(t)[158] eingeben:"
  106. 420 print"in ueblicher basic-syntax[158]!"
  107. 425 gosub 3900
  108. 430 print:print
  109. 440 input"x(t)=";xt$
  110. 450 print"[147]"
  111. 460 print"490xt$="chr$(34)xt$chr$(34)"
  112. 462 [153]"740xt$="[199](34)xt$[199](34)"
  113. 465 print"2490xt$="chr$(34)xt$chr$(34)"
  114. 470 [153]"2340x="xt$:[153]"goto490"
  115. 480 [151] 631,19:[129] i[178]632 [164] 637:[151] i,13:[130]:[151] 198,6:[128]
  116. 490 xt$[178]"150*sin(k)*cos(t)"
  117. 500 [153]"loadx(t)=sys"xt$
  118. 510 [153]"richtig eingegeben ? <j/nsys>"
  119. 520 [161] e$:[139] e$[178]"n" [167] 430
  120. 530 [139] e$[179][177]"j" [167] 520
  121. 540 [153]
  122. 550 :
  123. 590 [143] y(t) eingeben
  124. 600 [143] *************
  125. 605 [209] 0
  126. 610 [153]"loadbitte funktionsterm y(t)sys eingeben:"
  127. 620 [153]"in ueblicher basic-syntaxsys!"
  128. 625 [141] 3900
  129. 630 [153]:[153]
  130. 640 [133]"y(t)=";yt$
  131. 650 [153]"load"
  132. 660 [153]"690yt$="[199](34)yt$[199](34)"
  133. 665 print"2495yt$="chr$(34)yt$chr$(34)"
  134. 670 [153]"2350y="yt$:[153]"goto690"
  135. 680 [151] 631,19:[129] i[178]632 [164] 636:[151] i,13:[130]:[151] 198,5:[128]
  136. 690 yt$[178]"88*cos(k)*sin(2*t)"
  137. 700 [153]"loady(t)=sys"yt$
  138. 710 [153]"richtig eingegeben ? <j/nsys>"
  139. 720 [161] e$:[139] e$[178]"n" [167] 630
  140. 730 [139] e$[179][177]"j" [167] 720
  141. 740 xt$[178]"150*sin(k)*cos(t)"
  142. 750 [153]"loadx(t)="xt$
  143. 760 [153]"y(t)="yt$
  144. 770 [153]"weiter:<tastesys>, menue:<_sys>"
  145. 775 [141] 3700
  146. 780 [137] 1202: [143] achsen,parameter
  147. 790 :
  148. 795 [143] funktion r(w) definieren
  149. 800 [143] ************************
  150. 801 [151] 53280,4
  151. 802 m%[178]0:[151] 854,0:[143] neue funkt.eingegeben
  152. 803 p[178]2 : [143] typ 2 polark.
  153. 804 [151] 852,2
  154. 805 [141] 300: [143] mit parameter k
  155. 807 [209] 0
  156. 810 [153]"loadbitte funktionsterm r(w)sys eingeben:"
  157. 820 [153]"in ueblicher basic-syntaxsys!"
  158. 825 [141] 3900
  159. 830 [153]:[153]
  160. 840 [133]"r(w)=";rw$
  161. 850 [153]"load"
  162. 860 [153]"890rw$="[199](34)rw$[199](34)"
  163. 865 print"2840rw$="chr$(34)rw$chr$(34)"
  164. 870 [153]"2670r="rw$:[153]"goto890"
  165. 880 [151] 631,19:[129] i[178]632 [164] 636:[151] i,13:[130]:[151] 198,5:[128]
  166. 890 rw$[178]"k*w"
  167. 900 [153]"loadr(w)=sys"rw$
  168. 910 [153]"richtig eingegeben ? <j/nsys>"
  169. 920 [161] e$:[139] e$[178]"n" [167] 830
  170. 930 [139] e$[179][177]"j" [167] 920
  171. 940 [153]"loadr(w)="rw$
  172. 950 [153]"weiter:<tastesys>, menue:<_sys>"
  173. 960 [141] 3700
  174. 970 [137] 1202
  175. 1180 :
  176. 1190 [143] festlegen der achsen
  177. 1200 [143] ********************
  178. 1201 [137] 5500
  179. 1202 [151] 53280,8
  180. 1205 [209] 0
  181. 1210 [153]"loadposition der koordinatenachsensys"
  182. 1220 [153]"durch druecken von <f1sys> koennen nach"
  183. 1230 [153]"zeichnung der funktion die achsen ge-"
  184. 1240 [153]"loeschtsys od. durch <f3sys> erneuertsys werden !"
  185. 1250 [153]"achsen beim 1.lauf unbedingt festlegen sys!"
  186. 1260 x0[178][194](832):y0[178][194](836):n%[178][194](834)
  187. 1262 [139] n%[178]1 [167] x0[178]x0[172]8
  188. 1265 [153]"soll die achsenlage neu festgelegt"
  189. 1270 [153]"werden ?"
  190. 1275 [153]"alte werte:  x0="x0,"y0="y0
  191. 1277 [153]" syseingabe  <j/nsys> !"
  192. 1280 [161]b$:[139]b$[178]"n" [167] 1400
  193. 1290 [139] b$[179][177]"j" [167] 1280
  194. 1295 [153]"nullpunkt o(x0;y0)sys
  195. 1297 print" o in der mitte: o(150;90)[158]"
  196. 1300 print"x-wert d. nullpunkts[158]: 0<x0<=300"
  197. 1305 n%=0:rem marke,wenn x0<256
  198. 1307 poke 834,0
  199. 1310 input"x0=";x0
  200. 1312 if x0<=0 or x0>300 then (NULL) 0:goto 1300
  201. 1315 if x0>255 then x0=int(x0/8):n%=1:poke 834,1
  202. 1320 poke 832,x0
  203. 1330 print"y-wert d. nullpunkts[158]: 0<y0<=180"
  204. 1340 input"y0=";y0
  205. 1345 if y0<=0 or y0>180 then (NULL) 0:goto 1330
  206. 1350 poke 836,y0
  207. 1355 if n%=1 then print"x0="x0*8,"y0="y0 :goto 1365
  208. 1360 print"x0="x0,"y0="y0
  209. 1365 gosub 3800
  210. 1370 gosub 3700
  211. 1375 if m$="^" then print"[147]": goto 1260
  212. 1380 goto 1400
  213. 1385 :
  214. 1390 rem eingabe t1,t2 (parameter k)
  215. 1395 rem ***************************
  216. 1400 p=peek(852):poke 53280,9
  217. 1408 if p=2 then 1600
  218. 1409 (NULL) 0
  219. 1410 m%=peek(854):rem nach neueingabe d.funkt. m%=0,sonst 1
  220. 1412 if m%=0 then print"[147]":goto 1425
  221. 1415 print "[147]alte werte:"
  222. 1420 print"t1="t1;"  t2="t2
  223. 1425 print"anfangs-und endwert fuer t[158]:"
  224. 1430 print"t im bogenmass [158]!"
  225. 1435 input "t1=[158]";t1
  226. 1440 input "t2=[158]";t2
  227. 1442 if t1>t2 then print"t1>t2 !!"
  228. 1444 print"recht so ?      <j/n>"
  229. 1445 get a$:if a$="j" then 1460
  230. 1446 if a$<>"n" then 1445
  231. 1450 goto 1430
  232. 1455 :
  233. 1460 q=peek(856):rem mit parameter k
  234. 1465 if q=0 then 2000
  235. 1468 m%=peek(854)
  236. 1470 if m%=0 then 1480
  237. 1474 print"alte werte:"
  238. 1476 print"ka="ka;"ke="ke;"s="s
  239. 1480 input"anfangswert ka=[158]";ka
  240. 1490 input"endwert      ke=[158]";ke
  241. 1492 if ka>ke then print"ka>ke !!"
  242. 1494 print"recht so ?      <j/n>"
  243. 1495 get a$:if a$="j" then 1500
  244. 1496 if a$<>"n" then 1495
  245. 1498 goto 1480
  246. 1500 input"schrittweite s =[158]";s
  247. 1501 if s=0 then print"s darf nicht null sein ![158]":goto 1500
  248. 1502 print"recht so ?      <j/n>"
  249. 1503 get a$:if a$="j" then 1506
  250. 1504 if a$<>"n" then 1503
  251. 1505 goto 1500
  252. 1506 ifka<ke and s<0 then s=-s:goto1510
  253. 1508 ifka>ke and s>0 then s=-s
  254. 1510 goto 2000
  255. 1570 :
  256. 1580 rem eingabe w1,w2 (parameter k)
  257. 1590 rem ***************************
  258. 1600 poke 53280,9
  259. 1601 (NULL) 0
  260. 1602 m%=peek(854)
  261. 1603 if m%=0 then print"[147]":goto 1610
  262. 1604 print"[147]alte werte :"
  263. 1606 print"w1="w1;"w2="w2
  264. 1610 print"anfangs-und endwert fuer w[158]:"
  265. 1615 print"w im bogenmass[158]"
  266. 1620 input "w1=[158]";w1
  267. 1630 input "w2=[158]";w2
  268. 1632 if w1>w2 then print"w1>w2 !!"
  269. 1634 print"recht so ?      <j/n>"
  270. 1635 get a$:if a$="j" then 1790
  271. 1636 if a$<>"n" then 1635
  272. 1638 goto 1620
  273. 1640 :
  274. 1790 rem eingabe ka,ke,s
  275. 1800 (NULL) 0
  276. 1805 q=peek(856):rem mit parameter k
  277. 1810 if q=1 then 1460: rem mit k
  278. 1970 :
  279. 1980 rem graphik
  280. 1990 rem *******
  281. 2000 print"bildschirm loeschen[158] !"
  282. 2010 print"beim 1.lauf unbedingt erforderlich [158]!"
  283. 2020 print"soll der bildschirm geloescht"
  284. 2030 print"werden ? <j/n[158]>"
  285. 2040 get c$: if c$="n" then 2050
  286. 2045 if c$<>"j" then 2040
  287. 2050 print"sollen die achsen gezeichnet[158]"
  288. 2055 print"werden ?   <j/n[158]>"
  289. 2060 get k$:if k$="n" then 2070
  290. 2065 if k$<>"j" then 2060
  291. 2070 (NULL) 1:    rem grafik-ein
  292. 2080 (NULL) 1,0: rem zeichenfarbe weiss
  293. 2090 rem hintergrund schwarz
  294. 2095 poke 53280,2: rem rahmen rot
  295. 2100 if c$="n" then 2120
  296. 2110 (NULL) : rem loeschen graf.schirm
  297. 2115 :
  298. 2120 p=peek(852)
  299. 2130 (NULL) 1,0,0,319,199
  300. 2140 if k$="n" and p=1 then 2300
  301. 2150 if k$="n" and p=2 then 2600
  302. 2160 gosub 2200: rem achsen zeichnen
  303. 2170 if p=1 then 2300
  304. 2180 goto 2600
  305. 2190 :
  306. 2194 rem achsen zeichnen
  307. 2196 rem ***************
  308. 2200 x0=peek(832):y0=peek(836):n%=peek(834)
  309. 2205 if n%=1 then x0=x0*8
  310. 2210 xa$="x": rem x-achse
  311. 2220 (NULL) 0,1,y0,300,y0
  312. 2230 (NULL) 0,1,1,1,0,8,290,y0+2,xa$
  313. 2240 ya$="y": rem y-achse
  314. 2250 (NULL) 0,x0,1,x0,180
  315. 2260 (NULL) 0,1,1,1,0,8,x0+1,1,ya$
  316. 2270 return
  317. 2280 :
  318. 2290 rem plotten x(t), y(t)
  319. 2295 rem ******************
  320. 2300 gosub 4110: rem fehlerr. ein
  321. 2302 x0=peek(832):y0=peek(836):n%=peek(834)
  322. 2303 if n%=1 then x0=x0*8
  323. 2304 m%=peek(854)
  324. 2305 if k$="n" and m%=1 then gosub 3100
  325. 2306 gosub 2460: rem grafik beschriften
  326. 2308 if q=0 then 2320
  327. 2310 for k=ka to ke step s
  328. 2320 pl%=1: rem plotflag f.ausserhalb
  329. 2325 dt=6.2832/360
  330. 2327 if t1>t2 then dt=-dt
  331. 2330 for t=t1-dt to t2 step dt
  332. 2335 get h$:if h$=chr$(95) then 2900
  333. 2340 x=150*sin(k)*cos(t)
  334. 2350 y=88*cos(k)*sin(2*t)
  335. 2360 x2=int(x+x0)
  336. 2370 if x2<0 or x2>300 then pl%=1:next t:goto 2440
  337. 2380 y2=y0-y
  338. 2390 if t=t1 then 2430
  339. 2400 if y2<0 or y2>180 then pl%=1:next t:goto 2440
  340. 2410 if pl%=0 then (NULL) 0,x1,y1,x2,y2
  341. 2420 pl%=0
  342. 2430 x1=x2: y1=y2: next t
  343. 2440 if q=0 then 2900
  344. 2450 next k
  345. 2452 goto 2900
  346. 2455 :
  347. 2456 rem grafik beschriften (par.darst)
  348. 2457 rem ******************
  349. 2458 rem zuerst alte daten loeschen
  350. 2460 tl$="                        [146]"
  351. 2462 kl$="                        [146]"
  352. 2466 xl$="                                    [146]"
  353. 2468 yl$="                                    [146]"
  354. 2470 (NULL) 1,4,1,1,0,8,318,1,tl$
  355. 2472 (NULL) 1,4,1,1,0,8,310,1,kl$
  356. 2474 (NULL) 1,1,1,1,0,8,1,182,xl$
  357. 2476 (NULL) 1,1,1,1,0,8,1,191,yl$
  358. 2478 if l$=chr$(135) then return
  359. 2480 t1$=str$(t1):t2$=str$(t2)
  360. 2482 t$="t1="+t1$+";"+"t2="+t2$
  361. 2490 xt$="150*sin(k)*cos(t)"
  362. 2495 yt$="88*cos(k)*sin(2*t)"
  363. 2500 (NULL) 0,4,1,1,0,8,318,1,t$
  364. 2510 (NULL) 0,1,1,1,0,8,1,182,"x(t)="+xt$
  365. 2520 (NULL) 0,1,1,1,0,8,1,191,"y(t)="+yt$
  366. 2522 if q=0 then 2540
  367. 2525 ka$=str$(ka):ke$=str$(ke):s$=str$(s)
  368. 2527 k$="ka="+ka$+";"+"ke="+ke$+";"+"s="+s$
  369. 2530 (NULL) 0,4,1,1,0,8,310,1,k$
  370. 2540 return
  371. 2560 goto 2900: rem zum text
  372. 2590 :
  373. 2600 rem plotten r(w)
  374. 2610 rem ************
  375. 2614 gosub 4110: rem fehlerr. ein
  376. 2615 x0=peek(832):y0=peek(836):n%=peek(834)
  377. 2616 if n%=1 then x0=x0*8
  378. 2617 m%=peek(854)
  379. 2620 if k$="n" and m%=1 then gosub 3100
  380. 2625 gosub 2800: rem grafik beschriften
  381. 2627 q=peek(856)
  382. 2630 if q=0 then 2650
  383. 2640 for k=ka to ke step s
  384. 2650 pl%=1: rem plotflag f.ausserhalb
  385. 2655 dw=6.2832/360
  386. 2656 if w1>w2 then dw=-dw
  387. 2660 for w=w1-dw to w2 step dw
  388. 2665 geth$:ifh$=chr$(95)then2900
  389. 2670 r=k*w
  390. 2680 xr=r*cos(w)
  391. 2690 yr=r*sin(w)
  392. 2700 x=int(xr+x0)
  393. 2710 if x<0 or x>300 then pl%=1:next w:goto 2780
  394. 2720 y=y0-yr
  395. 2730 if w=w1 then 2770
  396. 2740 if y<0 or y>190 then pl%=1:next w:goto 2780
  397. 2750 if pl%=0 then (NULL) 0,x1,y1,x,y
  398. 2760 pl%=0
  399. 2770 x1=x:y1=y:next w
  400. 2780 if q=0 then 2900
  401. 2790 next k
  402. 2792 goto 2900
  403. 2795 :
  404. 2800 rem grafik beschriften (polark.d)
  405. 2801 rem ******************
  406. 2802 rem zuerst alte daten loeschen
  407. 2804 wl$="                      [146]"
  408. 2806 kl$="                      [146]"
  409. 2808 xl$="                                    [146]"
  410. 2810 rl$="                                    [146]"
  411. 2812 (NULL) 1,4,1,1,0,8,318,1,wl$
  412. 2814 (NULL) 1,4,1,1,0,8,310,1,kl$
  413. 2816 (NULL) 1,1,1,1,0,8,1,182,xl$
  414. 2818 (NULL) 1,1,1,1,0,8,1,191,rl$
  415. 2819 if l$=chr$(135) then return
  416. 2820 w1$=str$(w1):w2$=str$(w2)
  417. 2825 w$="w1="+w1$+";"+"w2="+w2$
  418. 2835 (NULL) 0,4,1,1,0,8,318,1,w$
  419. 2840 rw$="k*w"
  420. 2845 (NULL) 0,1,1,1,0,8,1,191,"r(w)="+rw$
  421. 2850 if q=0 then 2870
  422. 2855 ka$=str$(ka):ke$=str$(ke):s$=str$(s)
  423. 2860 k$="ka="+ka$+";"+"ke="+ke$+";"+"s="+s$
  424. 2865 (NULL) 0,4,1,1,0,8,310,1,k$
  425. 2870 return
  426. 2878 :
  427. 2880 rem grafik fertig -> menue
  428. 2890 rem **********************
  429. 2900 gosub 4120: rem fehlerr. aus
  430. 2905 (NULL) 0,0,0,301,181
  431. 2910 m%=1: rem funktion gezeichnet
  432. 2912 poke 854,1
  433. 2915 (NULL) 0
  434. 2920 wait 198,1: get a$
  435. 2930 goto 200: rem menue
  436. 3080 :
  437. 3090 rem achsen loeschen
  438. 3095 rem ***************
  439. 3100 x0=peek(832):y0=peek(836):n%=peek(834)
  440. 3105 if n%=1 then x0=x0*8
  441. 3110 xa$="x"
  442. 3120 (NULL) 1,1,y0,300,y0
  443. 3130 (NULL) 1,1,1,1,0,8,290,y0+2,xa$
  444. 3140 ya$="y"
  445. 3150 (NULL) 1,x0,1,x0,180
  446. 3160 (NULL) 1,1,1,1,0,8,x0+1,1,ya$
  447. 3170 return
  448. 3180 :
  449. 3190 rem drucken
  450. 3195 rem *******
  451. 3200 poke 53280,2
  452. 3210 goto 5600
  453. 3220 print"[147]drucken mit doppelter vergroesserung in"
  454. 3230 print"x-richtung          vg=1"
  455. 3235 print"y-richtung          vg=2"
  456. 3240 print"x- und y-richtung   vg=3"
  457. 3245 print"ohne vergroesserung vg=0"
  458. 3250 print"nach dem drucken ist vg=0"
  459. 3255 print
  460. 3260 input" vg=";vg
  461. 3270 open 4,4
  462. 3280 (NULL) 1
  463. 3290 (NULL) vg
  464. 3300 close4
  465. 3310 vg=0
  466. 3320 goto 200 : rem menue
  467. 3470 :
  468. 3480 rem beenden
  469. 3490 rem *******
  470. 3500 poke 53280,11:poke 53281,6
  471. 3505 print"[147]aufhoeren mit parapol ? <j/n[158]>"
  472. 3510 geta$:ifa$="n" then 200:rem menue
  473. 3520 if a$<>"j" then 3510
  474. 3530 goto 3600:rem gra1 aufrufen/ende
  475. 3540 print"[147]danke u. auf wiedersehen !"
  476. 3550 end
  477. 3600 print"gra1 aufrufen[158] und mit anderem gr2001-[158]"
  478. 3610 print"programm[158] weiterarbeiten ? <j/n[158]>"
  479. 3620 get gr$:if gr$="n"then 3540
  480. 3630 if gr$<>"j" then 3620
  481. 3640 print"[147][158][147]:l[207]";chr$(34);"gra1";chr$(34);",8":print"r[213]"
  482. 3650 poke 631,19:fori=0to2:poke632+i,13:next:poke198,4:end
  483. 3670 :
  484. 3680 rem ruecksprung zum menue
  485. 3690 rem *********************
  486. 3700 getm$:if m$="" then 3700
  487. 3710 if m$="_" then 200
  488. 3720 return
  489. 3790 :
  490. 3800 print"[158]weiter: <taste[158]>, neueingabe: <^[158]>,             menue: <_[158]>"
  491. 3810 return
  492. 3880 :
  493. 3890 rem hinweis auf parameter k
  494. 3895 rem ***********************
  495. 3900 q=peek(856)
  496. 3910 if q=1 then print"mit[158] parameter k !": goto 3930
  497. 3920 print"ohne[158] parameter k !"
  498. 3930 return
  499. 3990 :
  500. 4000 rem fehlerroutine herstellen
  501. 4005 rem ************************
  502. 4010 fori=860 to 868:readx:pokei,x:next
  503. 4020 data 138,48,3,76,59,169,76,116,164
  504. 4030 return
  505. 4100 rem fehlerroutine ein/aus
  506. 4110 poke 768,92:poke 769,03 :return
  507. 4120 poke 768,139:poke 769,227:return
  508. 4140 :
  509. 4480 rem hinweise zu <f1>,<f3>,<f5> und <f7>
  510. 4490 rem *************************
  511. 4500 (NULL) 1:va=(NULL)(0,0)
  512. 4504 if va=1 then 4508
  513. 4506 goto 5520
  514. 4508 (NULL) 0
  515. 4510 print"[147]mit <f1[158]> werden die achsen geloescht[158],"
  516. 4515 print"mit <f3[158]> wieder gezeichnet[158]!"
  517. 4520 print"mit <f5[158]> wird d. beschriftung geloescht[158],"
  518. 4525 print"mit <f7[158]> wieder geschrieben!"
  519. 4530 print"<taste[158]> !"
  520. 4540 print"dann zum menue[158] mit <taste[158]>[160]!"
  521. 4545 p=peek(852)
  522. 4550 wait 198,1: get a$
  523. 4560 (NULL) 1: (NULL) 1,0
  524. 4570 get l$: if l$="" then 4570
  525. 4580 if l$=chr$(133) then gosub 3100:goto 4570: rem <f1>
  526. 4590 if l$=chr$(134) then gosub 2200:goto 4570: rem <f3>
  527. 4600 if l$=chr$(135) and p=1 then gosub 2460:goto 4570: rem <f5>
  528. 4610 if l$=chr$(135) and p=2 then gosub 2800:goto 4570: rem <f5>
  529. 4620 if l$=chr$(136) and p=1 then gosub 2460:goto 4570: rem <f7>
  530. 4630 if l$=chr$(136) and p=2 then gosub 2800:goto 4570: rem <f7>
  531. 4640 goto 200 : rem menue
  532. 4990 :
  533. 5000 rem grafik loeschen
  534. 5010 rem ***************
  535. 5014 (NULL) 1:va=(NULL)(0,0)
  536. 5015 if va=1 then 5020
  537. 5016 goto 5520
  538. 5020 (NULL) 0:(NULL) 0,1
  539. 5030 print"[147]wirklich loeschen ?  <j/n>"
  540. 5040 for i=0 to 20 :poke53280,1:next
  541. 5050 for i=0 to 20 :poke53280,2:next
  542. 5060 for i=0 to 20 :poke53280,5:next
  543. 5070 for i=0 to 20 :poke53280,8:next
  544. 5080 get a$:if a$="j" then 5110
  545. 5090 if a$<>"n" then 5040
  546. 5100 goto 200
  547. 5110 (NULL) 1:(NULL)
  548. 5120 m%=0:poke 854,0
  549. 5130 goto 200 : rem menue
  550. 5140 :
  551. 5480 rem test auf grafik-param.aendern
  552. 5490 rem *****************************
  553. 5500 (NULL) 1:(NULL) 1,0:va=(NULL)(0,0)
  554. 5510 if va=1 then (NULL) 0:goto 1202
  555. 5520 (NULL) 0
  556. 5530 print"[147]noch keine grafik da !"
  557. 5540 for i=0 to 500:next
  558. 5550 goto 200: rem menue
  559. 5590 :
  560. 5600 rem test auf grafik-drucken
  561. 5610 rem ***********************
  562. 5620 (NULL) 1:va=(NULL)(0,0)
  563. 5630 if va=1 then (NULL) 0:goto 3220:rem drucken
  564. 5640 goto 5520:rem keine grafik-menue
  565. 5690 :
  566. 5700 rem grafik save/load
  567. 5710 rem ****************
  568. 5720 (NULL) 0
  569. 5730 print"[147]grafik save oder load ? <s/l> od.<taste>"
  570. 5740 getl$:if l$=""then 5740
  571. 5750 if l$="s" then 5800
  572. 5760 if l$="l" then 5900
  573. 5770 goto 200
  574. 5790 :
  575. 5800 rem grafik speichern
  576. 5810 rem ****************
  577. 5815 goto 6000
  578. 5820 (NULL) 0
  579. 5830 input"bildname ?";g$
  580. 5840 print"[147][158][147]:mode1:change:gsave";chr$(34);g$;chr$(34);",8:change"
  581. 5845 print"r[213]200"
  582. 5850 poke 631,19:fori=0to3:poke632+i,13:next:poke198,5:end
  583. 5890 :
  584. 5900 rem grafik laden
  585. 5910 rem ************
  586. 5920 input"bildname ?";g$
  587. 5930 print"[147][158][147]:mode1:gload";chr$(34);g$;chr$(34);",8":print"r[213]200"
  588. 5940 poke 631,19:fori=0to3:poke632+i,13:next:poke198,5:end
  589. 5990 :
  590. 6000 rem test auf grafik-save
  591. 6010 rem ********************
  592. 6020 (NULL) 1:(NULL) 1,0:va=(NULL)(0,0)
  593. 6030 if va=1 then 5820:rem save
  594. 6040 goto 5520:rem keine grafik da
  595. 6090 :
  596. 6100 rem directory lesen
  597. 6110 rem ***************
  598. 6120 print"[147]"
  599. 6130 (NULL)
  600. 6140 print:print
  601. 6150 print"      taste !"
  602. 6160 (NULL) 0
  603. 6170 wait 198,1: poke 198,0
  604. 6180 goto 200
  605.