home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1991 February / 64er_Magazin_91-02_1991_Markt__Technik_de_Side_A.d64 / paraplot (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1991-01-01  |  6.1 KB  |  295 lines
  1. 1000 rem ******************************
  2. 1010 rem *    programm para-plot      *
  3. 1020 rem *         v 1.1              *
  4. 1030 rem *    u. schwebinghaus        *
  5. 1040 rem *    erbschloer str. 115     *
  6. 1050 rem *    5600 wuppertal 21       *
  7. 1060 rem *                            *
  8. 1070 rem ******************************
  9. 1072 :
  10. 1073 rem ****** erststart ******
  11. 1074 :
  12. 1075 if lf=1 then 1082
  13. 1080 lf=1:load"fractal.obj",8,1
  14. 1082 fx$="sin(t*t+t-3)"
  15. 1083 fy$="cos(t)":vb=1
  16. 1085 sys 50176,1,2:goto 4000
  17. 1087 :
  18. 1100 rem ******* definition *********
  19. 1105 :
  20. 1110 gosub 2000
  21. 1120 if a$="m" then 4000
  22. 1130 print""
  23. 1140 print"x(t) =   "fx$
  24. 1142 print"[145]"tab(7);:input fx$
  25. 1143 print
  26. 1145 print"y(t) =   "fy$
  27. 1150 print"[145]"tab(7);:input fy$
  28. 1160 gosub 2100
  29. 1170 if a$="k" then 1130
  30. 1200 :
  31. 1210 print"[147][149]";
  32. 1220 print 4590"xw="fx$
  33. 1230 print 5050"xw="fx$
  34. 1240 print 4610"yw="fy$
  35. 1242 print 5080"yw="fy$
  36. 1246 print "fx$="chr$(34)fx$ chr$(34)
  37. 1247 print "fy$="chr$(34)fy$ chr$(34)
  38. 1248 print "vb="vb":goto 4000"
  39. 1250 poke 198,7
  40. 1260 for i=1 to 7
  41. 1270 :   poke 630+i,13
  42. 1280 next i
  43. 1290 print"":end
  44. 1300 :
  45. 1310 :
  46. 2000 rem ****** upgm-einstieg ******
  47. 2010 :
  48. 2020 print"[147]"tab(8)"" mp$(r)
  49. 2030 print:print
  50. 2040 print tab(8)"w[146]eiter oder m[146]enue?"
  51. 2050 get a$:if a$="" then 2050
  52. 2060 if a$<>"w" and a$<>"m" then 2050
  53. 2070 :
  54. 2080 :         return
  55. 2090 :
  56. 2100 rem ****** korrektur ******
  57. 2110 :
  58. 2120 print tab(6) "k[146]orrektur oder w[146]eiter?"
  59. 2130 get a$:if a$="" then 2130
  60. 2140 if a$<>"w" and a$<>"k" then 2130
  61. 2160 :
  62. 2170 :         return
  63. 2180 :
  64. 2200 rem ****** einstieg/hinweis ******
  65. 2210 :
  66. 2220 print"[147]"tab(8)"" mp$(r)
  67. 2230 print
  68. 2240 print"[153]    vom bild fuehrt die taste <m>  "
  69. 2250 print"        ins menue zurueck!"
  70. 2255 print tab(8)"w[146]eiter oder m[146]enue?"
  71. 2260 get a$:if a$="" then 2260
  72. 2270 if a$<>"w" and a$<>"m" then 2260
  73. 2280 :
  74. 2290 :         return
  75. 2300 :
  76. 2500 rem ****** informationen ******
  77. 2510 :
  78. 2520 gosub 2000
  79. 2530 if a$="m" then return
  80. 2540 print"[153]diskette mit infobild muss einliegen!"
  81. 2550 gosub 2100
  82. 2560 if a$="k" then return
  83. 2570 n$="infobild":sys 50176,1,2
  84. 2580 open 2,8,2,n$+",p,r":sys 50188:close 2
  85. 2590 gosub 3580:gosub 3740:return
  86. 2600 :
  87. 3000 rem ****** parameter ******
  88. 3010 :
  89. 3020 gosub 2000
  90. 3030 if a$="m" then return
  91. 3040 print""
  92. 3045 if pz=0 then pz=100
  93. 3050 print"x min =   "xu
  94. 3060 print"[145]"tab(8);:input xu
  95. 3070 print"x max =   "xo
  96. 3080 print"[145]"tab(8);:input xo
  97. 3090 print"y min =   "yu
  98. 3100 print"[145]"tab(8);:input yu
  99. 3110 print"y max =   "yo
  100. 3120 print"[145]"tab(8);:input yo
  101. 3130 print"t min =   "t1
  102. 3140 print"[145]"tab(8);:input t1
  103. 3150 print"t max =   "t2
  104. 3160 print"[145]"tab(8);:input t2
  105. 3170 print"punktezahl =   "pz
  106. 3180 print"[145]"tab(14);:input pz
  107. 3185 print"[153]eingabe von 0 in x min, x max, y min und"
  108. 3186 print"y max erzielt anpassung an parameter t."
  109. 3190 gosub 2100
  110. 3200 if a$="k" or pz<=0 or t2-t1<=0 then 3040
  111. 3210 tx=(t2-t1)/pz
  112. 3220 :
  113. 3230 :       return
  114. 3240 :
  115. 3300 rem ****** modus ******
  116. 3310 :
  117. 3320 gosub 2000
  118. 3330 if a$="m" then return
  119. 3340 vb$(0)="nein":vb$(1)=" ja "
  120. 3350 print""
  121. 3355 print"punkte des graphen verbinden: "vb$(vb)
  122. 3360 gosub 2100
  123. 3370 if a$="k" then vb=abs(vb-1):goto 3350
  124. 3380 :
  125. 3390 :      return
  126. 3400 :
  127. 3500 rem ****** bild zeigen ******
  128. 3510 :
  129. 3520 gosub 2200
  130. 3570 if a$="m" then return
  131. 3580 sys 50179,1
  132. 3590 gosub 2000
  133. 3600 sys 50179,0
  134. 3610 :
  135. 3620 :     return
  136. 3630 :
  137. 3700 rem ****** bild loeschen ******
  138. 3710 :
  139. 3715 gosub 2000:if a$="m" then return
  140. 3740 sys 50176,1,2
  141. 3750 :
  142. 3760 :        return
  143. 3780 :
  144. 3800 rem ****** bild speichern ******
  145. 3810 :
  146. 3820 gosub 2000
  147. 3830 if a$="m" then return
  148. 3832 n$=""
  149. 3835 print""
  150. 3840 print"     bildname:    "n$
  151. 3850 print"[145]"tab(16);:input n$
  152. 3860 gosub 2100
  153. 3870 if a$="k" or len(n$)=0 or len(n$)>16 then 3835
  154. 3880 open2,8,2,n$+",p,w":sys 50191:close 2
  155. 3885 :
  156. 3890 :        return
  157. 3895 :
  158. 3900 rem ****** bild laden ******
  159. 3910 :
  160. 3920 gosub 2000
  161. 3930 if a$="m" then return
  162. 3932 n$=""
  163. 3935 print""
  164. 3940 print"     bildname:    "n$
  165. 3950 print"[145]"tab(16);:input n$
  166. 3960 gosub 2100
  167. 3970 if a$="k" or len(n$)=0 or len(n$)>16 then 3835
  168. 3980 open2,8,2,n$+",p,r":sys 50188:close 2
  169. 3985 :
  170. 3990 :        return
  171. 3995 :
  172. 4000 rem ******* menue *******
  173. 4010 :
  174. 4020 cd$=""
  175. 4030 tt$="p a r a m e t e r - p l o t"
  176. 4040 tu$="[184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184]"
  177. 4050 mp$(1)="*  informationen   *"
  178. 4060 mp$(2)="* neue vorschrift  *"
  179. 4070 mp$(3)="* parameterbereich *"
  180. 4080 mp$(4)="*   zeichenmodus   *"
  181. 4090 mp$(5)="*  graph zeichnen  *"
  182. 4100 mp$(6)="*   bild zeigen    *"
  183. 4110 mp$(7)="*  bild loeschen   *"
  184. 4120 mp$(8)="*  bild speichern  *"
  185. 4130 mp$(9)="*   bild laden     *"
  186. 4140 mp$(10)="*  programm-ende   *"
  187. 4145 :
  188. 4150 poke 53280,9 :poke 53281,9:rem farben
  189. 4160 print"[147]"tab(7)tt$:print tab(7)tu$
  190. 4170 print
  191. 4180 for i=1 to 10:print"[158]"tab(10) mp$(i):print:next i
  192. 4190 print"wahl mit cursor up und down und return";
  193. 4200 if r=0 then r=1
  194. 4210 gosub 4290
  195. 4220 get a$:if a$="" then 4220
  196. 4230 if a$="" then gosub 4320
  197. 4240 if a$="[145]" then gosub 4350
  198. 4250 if a$<>chr$(13) then 4220
  199. 4260 if r=10 then print"[147]":end
  200. 4265 if r=2 then 1110
  201. 4270 on r gosub 2500,1110,3000,3300,4500,3500,3700,3800,3900:goto 4160
  202. 4280 :
  203. 4290 print""left$(cd$,(r-1)*2)tab(10)""mp$(r):return
  204. 4300 print""left$(cd$,(r-1)*2)tab(10)"[158]"mp$(r):return
  205. 4310 :
  206. 4320 gosub 4300:r=r+1:if r>10 then r=1
  207. 4330 gosub 4290:return
  208. 4340 :
  209. 4350 gosub 4300:r=r-1:if r<1 then r=10
  210. 4360 gosub 4290:return
  211. 4370 :
  212. 4380 :
  213. 4500 rem ****** graph zeichnen ******
  214. 4510 :
  215. 4520 gosub 2200
  216. 4530 if a$="m" then return
  217. 4539 if tx=0 then t1=-3.3:t2=3.3:tx=6.6/100
  218. 4540 if xo-xu<=0 or yo-yu<=0 then gosub 5000
  219. 4550 sys 50179,1:sys 50194
  220. 4560 xv=320/(xo-xu):yv=200/(yo-yu)
  221. 4570 gosub 6000
  222. 4580 poke 768,61:for t=t1 to t2 step tx
  223. 4590 xw=sin(t)*exp(0.1*t)
  224. 4600 xb=int((xw-xu)*xv)
  225. 4610 yw=sin(t)*cos(t)
  226. 4620 yb=199-int((yw-yu)*yv)
  227. 4630 if xb<0 or xb>319 or yb<0 or yb>199 then 4700
  228. 4640 sys 50182,xb,yb,1
  229. 4650 if t>t1+0.5*tx and vb=1 then sys50185,xa,ya,xb,yb,1
  230. 4660 xa=xb:ya=yb
  231. 4700 next t:poke 768,139
  232. 4710 :
  233. 4720 gosub 2000:if a$<>"m"then 4720
  234. 4730 sys 50179,0
  235. 4800 :            return
  236. 4810 :
  237. 5000 rem ****** automatische grenzen ******
  238. 5010 :
  239. 5020 print"     [153]bitte warten, x und y werden"
  240. 5030 print"     an den parameter t angepasst!"
  241. 5040 poke 768,61:for t=t1 to t2 step tx
  242. 5050 xw=sin(t)*exp(0.1*t)
  243. 5060 if xw<xu then xu=xw
  244. 5070 if xw>xo then xo=xw
  245. 5080 yw=sin(t)*cos(t)
  246. 5090 if yw<yu then yu=yw
  247. 5100 if yw>yo then yo=yw
  248. 5110 next t:poke 768,139
  249. 5115 if xu<0 and xo>100*(-xu) then xo=abs(xu)
  250. 5116 if xo>0 and xu<100*(-xo) then xu=-xo
  251. 5117 if yu<0 and yo>100*(-yu) then yo=abs(yu)
  252. 5118 if yo>0 and yu<100*(-yo) then yu=-yo
  253. 5120 :
  254. 5130 :        return
  255. 5140 :
  256. 6000 rem ****** achsen zeichnen ******
  257. 6010 :
  258. 6020 xc=int(-xu*xv)
  259. 6030 yc=199-int(-yu*yv)
  260. 6040 if xc>=0 then sys 50185,xc,0,xc,199,1
  261. 6050 if yc>=0 then sys 50185,0,yc,319,yc,1
  262. 6055 gosub 6400
  263. 6060 ex=1
  264. 6070 xb=int(ex*xv)
  265. 6080 if xb<10 then ex=ex*10:goto 6070
  266. 6085 if xb>100 then ex=ex/10:goto 6070
  267. 6090 x=xc
  268. 6110 if x>=0 and x<320 and yc>2 then sys 50185,x,yc,x,yc-3,1:x=x+xb:goto 6110
  269. 6115 x=xc-xb
  270. 6120 if x>=0 and yc>2 then sys 50185,x,yc,x,yc-3,1:x=x-xb:goto 6120
  271. 6130 :
  272. 6160 ey=1
  273. 6170 yb=int(ey*yv)
  274. 6180 if yb<8 then ey=ey*10:goto 6170
  275. 6185 if yb>80  then ey=ey/10:goto 6170
  276. 6190 y=yc
  277. 6210 if y>=0 and xc<317 then sys 50185,xc,y,xc+3,y,1:y=y-yb:goto 6210
  278. 6215 y=yc+yb
  279. 6220 if y<200 and xc<317 then sys 50185,xc,y,xc+3,y,1:y=y+yb:goto 6220
  280. 6230 :
  281. 6240 :
  282. 6250 :       return
  283. 6260 :
  284. 6400 rem ****** pfeilspitzen ******
  285. 6410 :
  286. 6420 if xc<2 or xc>317 then 6450
  287. 6430 sys 50182,xc-2,2,1:sys 50182,xc-1,1,1
  288. 6440 sys 50182,xc+1,1,1:sys 50182,xc+2,2,1
  289. 6450 if yc<2 or yc>197 then return
  290. 6460 sys 50182,317,yc-2,1:sys 50182,318,yc-1,1
  291. 6470 sys 50182,318,yc+1,1:sys 50182,317,yc+2,1
  292. 6500 :
  293. 6510 :       return
  294. 6520 :
  295.