home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 34 / 64er_Magazin_Sonderheft_34_19xx_Markt__Technik_de_Disk_2_of_2_Side_A.d64 / musterbrueter (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  11KB  |  499 lines
  1. 100 rem ************************
  2. 110 rem *  musterbrueter v2.8  *
  3. 120 rem *     vom 25.12.87     *
  4. 130 rem *        autor:        *
  5. 140 rem *    i. camphausen     *
  6. 150 rem *    aspenweg 29       *
  7. 160 rem *    1000 berlin 20    *
  8. 170 rem * hardware: c64 + 1541 *
  9. 180 rem ************************
  10. 190 :
  11. 200 if zx=0 then zx=1:load"mb.mc",8,1
  12. 210 :
  13. 1000 poke 56,20000/256:poke 55,20000 and 255:clr
  14. 1010 dim hm$(9),mz$(9)
  15. 1020 zf=0:hf=15:rf=11:f1=0:f0=12
  16. 1030 :
  17. 1040 s1=49152+11*256:rem adressen fuer speicherbereiche
  18. 1050 s2=s1+64
  19. 1060 sd=21519
  20. 1070 na=s2+64
  21. 1080 an=49152+10*256
  22. 1090 vic=53248
  23. 1100 vram=49152+12*256
  24. 1105 :
  25. 1110 calc=20000:rem startadressen maschinenpgm's
  26. 1120 copy=20003
  27. 1130 gcl=20006
  28. 1140 farbset=20009
  29. 1150 ein=20012
  30. 1160 aus=20015
  31. 1170 dir=20018
  32. 1180 devpres=20021
  33. 1190 sa=20024
  34. 1200 speicherman=20027
  35. 1210 ss=20030
  36. 1220 as=20033
  37. 1230 zeichenneu=20036
  38. 1240 is=20039
  39. 1250 :
  40. 1260 :
  41. 1280 sys 58784:rem vic initialisieren
  42. 1290 poke 53281,hf:poke 53280,rf:poke 646,zf
  43. 1300 sys zeichenneu:print chr$(8):rem <c=> <shift> verriegeln
  44. 1310 print "[147]"
  45. 1320 print tab(13)"[205]ustermaker 64"
  46. 1330 print:print tab(9)"von [201]ngmar [195]amphausen"
  47. 1340 for i=1 to 9:read hm$(i):next i
  48. 1350 data"[193]usgangsstellung editieren","aktive [206]achbarschaft editieren"
  49. 1360 data"n;chstes [194]ild berechnen","[194]ilderserie berechnen","[199]rafik laden"
  50. 1370 data"[199]rafik saven","[218]wischenspeicher benutzen"
  51. 1380 data"[199]rafik zeigen","[198]arben ;ndern"
  52. 1390 for i=1 to 9:read mz$(i):next i
  53. 1400 data"[211]peicher l:schen"
  54. 1410 data"[199]rafik > [211]peicher"
  55. 1420 data"[211]peicher > [199]rafik"
  56. 1430 data"[199]rafik [207][210] [211]peicher"
  57. 1440 data"[199]rafik [193][206][196] [211]peicher"
  58. 1450 data"[199]rafik [216][207][210] [211]peicher"
  59. 1460 data"[199]rafik invertieren"
  60. 1470 data"[211]peicher invertieren"
  61. 1480 data"[199]rafik zeigen"
  62. 1490 :
  63. 1500 for i=an to an+64:poke i,0:next i
  64. 1510 for i=0 to 63:poke s1+i,0:poke s2+i,peek(sd+i):next i
  65. 1520 :
  66. 1530 us$=chr$(183):for i=1 to 5:us$=us$+us$:next i
  67. 1540 :
  68. 1550 :
  69. 1560 rem **********
  70. 1570 rem hauptmenue
  71. 1580 rem **********
  72. 1590 :
  73. 1600 t$="[200]auptmenue":print"[147]":gosub 5300:print
  74. 1610 for i=1 to 9
  75. 1620 print tab(2)i"[157])";spc(2);hm$(i):print
  76. 1630 next i
  77. 1635 poke 198,0
  78. 1640 get a$:if a$="" then goto 1640
  79. 1650 if (a$<"1") or (a$>"9") then goto 1640
  80. 1660 a=val(a$):t$=hm$(a)
  81. 1670 on a gosub 1700,3300,4100,4190,4420,4560,4700,4900,5000
  82. 1680 goto 1600
  83. 1700 :
  84. 1710 rem **************************
  85. 1720 rem ausgangsstellung editieren
  86. 1730 rem **************************
  87. 1740 :
  88. 1750 print"[147]":gosub 5300
  89. 1760 sys ss:print"";:rem stellung anzeigen
  90. 1770 print:print:print:print
  91. 1780 print tab(25)"  _ - zur@ck":print:print
  92. 1790 print tab(25)"  [204] - laden"
  93. 1800 print tab(25)"  [211] - saven":print
  94. 1810 print tab(25)"[211][208][195] - toggle"
  95. 1820 print tab(25)"[195][204][210] - l:schen"
  96. 1830 print tab(25)"[201]   - invert.":print
  97. 1840 print tab(25)"   [195][210][211][210] [213][208]"
  98. 1850 print tab(25)"      ^"
  99. 1860 print tab(25)"[204][197][198][212] _ > [210][201][199][200][212]"
  100. 1870 print tab(25)"      <"
  101. 1880 print tab(25)"  [195][210][211][210] [196][207][215][206]":print:print
  102. 1890 print tab(25)"[210][197][212][213][210][206] - [197]nde"
  103. 1900 :
  104. 1910 poke vic,112:poke vic+1,140:rem x/y-startpostion des fadenkreuz-cursors
  105. 1920 poke vic+39,1:rem spritefarbe
  106. 1930 poke vram+1016,45:rem blockpointer
  107. 1940 poke vic+21,1:rem sprite an
  108. 1950 :
  109. 1960 get a$:if a$="" then goto 1960
  110. 1970 if a$="_"then poke vic+21,0:goto 3240
  111. 1980 if a$="[157]" then goto 2100
  112. 1990 if a$="" then goto 2180
  113. 2000 if a$="[145]" then goto 2240
  114. 2010 if a$="" then goto 2300
  115. 2020 if a$="[147]" then goto 2360
  116. 2030 if a$=" " then goto 2400
  117. 2040 if a$="i" then goto 2500
  118. 2050 if a$="l" then goto 2670
  119. 2060 if a$="s" then goto 2540
  120. 2070 if a$=chr$(13) then goto 2800
  121. 2080 goto 1960
  122. 2090 :
  123. 2100 rem left
  124. 2110 :
  125. 2120 x=peek(vic):if x=16 then 2140
  126. 2130 x=x-8:poke vic,x
  127. 2140 goto 1960
  128. 2150 :
  129. 2160 rem right
  130. 2170 :
  131. 2180 x=peek(vic):if x=200 then goto 2200
  132. 2190 x=x+8:poke vic,x
  133. 2200 goto 1960
  134. 2210 :
  135. 2220 rem up
  136. 2230 :
  137. 2240 y=peek(vic+1):if y=68 then goto 2260
  138. 2250 y=y-8:poke vic+1,y
  139. 2260 goto 1960
  140. 2270 :
  141. 2280 rem down
  142. 2290 :
  143. 2300 y=peek(vic+1):if y=228 then goto 2320
  144. 2310 y=y+8:poke vic+1,y
  145. 2320 goto 1960
  146. 2330 :
  147. 2340 rem clear
  148. 2350 :
  149. 2360 for i=s1 to s1+63:poke i,0:next i:print"":print:print:sys ss
  150. 2370 goto 1960
  151. 2380 :
  152. 2390 rem toggle
  153. 2400 :
  154. 2410 x=peek(vic):y=peek(vic+1)
  155. 2420 x%=(x-16)/8:y%=(y-68)/8
  156. 2430 a%=3*y%+x%/8:b=2^(7-x%and7)
  157. 2440 p=peek(s1+a%):if (pandb)=0 then poke s1+a%,p or b:goto 2460
  158. 2450 poke s1+a%,p and (255-b)
  159. 2460 print"":print:print:sys ss:goto 1960
  160. 2470 :
  161. 2480 rem invert
  162. 2490 :
  163. 2500 sys is:print"":print:print:sys ss:goto 1960
  164. 2510 :
  165. 2520 rem saven
  166. 2530 :
  167. 2540 poke vic+21,0:n$=""
  168. 2550 print"[147]         [193]usgangsstellung saven"
  169. 2560 print:input"[198]ilename ";n$:if n$="_" then goto 2630
  170. 2570 if n$="$" then gosub 5700:goto 2540
  171. 2580 if n$="" then goto 2630
  172. 2590 sys devpres:if st<>0 then goto 2540
  173. 2600 s=s1:e=s1+64:rem start- und endadresse
  174. 2610 gosub 5390:rem bereich speichern
  175. 2620 gosub 5490:if fe<>0 then goto 2540:rem fehlerkanal
  176. 2630 goto 1700
  177. 2640 :
  178. 2650 rem laden
  179. 2660 :
  180. 2670 poke vic+21,0:n$=""
  181. 2680 print"[147]         [193]usgangsstellung laden"
  182. 2690 print:input"[198]ilename ";n$:if n$="_"then goto 2760
  183. 2700 if n$="$" then gosub 5700:goto 2670
  184. 2710 if n$=""then goto 2760
  185. 2720 sys devpres:if st<>0 then goto 2670
  186. 2730 s=s1
  187. 2740 gosub 5600:rem laden
  188. 2750 gosub 5490:if fe<>0 then goto 2670:rem fehlerk.
  189. 2760 goto 1700
  190. 2770 :
  191. 2780 rem ausgangsstellung fertig, positionieren in der hiresgrafik
  192. 2790 :
  193. 2800 poke vic+21,0:print"[147]"
  194. 2810 poke vic,168:poke vic+1,138:poke vic+16,0
  195. 2820 poke vic+39,0:poke vram+1016,44
  196. 2830 poke vic+21,1
  197. 2840 get a$:if a$="" then goto 2840
  198. 2850 if a$="[157]" then goto 2910
  199. 2860 if a$="" then goto 2950
  200. 2870 if a$="[145]" then goto 2990
  201. 2880 if a$="" then goto 3020
  202. 2890 if a$=chr$(13) then goto 3080
  203. 2900 goto 2840
  204. 2905 :
  205. 2910 x=peek(vic)+256*(peek(vic+16) and 1):if x=24 then goto 2930
  206. 2920 x=x-8:poke vic,x and 255:poke vic+16,x/256
  207. 2930 goto 2840
  208. 2940 :
  209. 2950 x=peek(vic)+256*(peek(vic+16) and 1):if x=320 then goto 2970
  210. 2960 x=x+8:poke vic,x and 255:poke vic+16,x/256
  211. 2970 goto 2840
  212. 2980 :
  213. 2990 y=peek(vic+1):if y=50 then goto 3010
  214. 3000 y=y-8:poke vic+1,y
  215. 3010 goto 2840
  216. 3015 :
  217. 3020 y=peek(vic+1):if y=226 then goto 3040
  218. 3030 y=y+8:poke vic+1,y
  219. 3040 goto 2840
  220. 3050 :
  221. 3060 rem sprite in bitmap kopieren
  222. 3070 :
  223. 3080 x=peek(vic)+256*(peek(vic+16) and 1):y=peek(vic+1)
  224. 3090 x%=(x-24)/8:y%=(y-50)/8
  225. 3100 ad=57344+8*x%+320*y%:sys gcl
  226. 3110 for i=0 to 7
  227. 3120 poke ad+i,peek(s1+3*i)
  228. 3130 poke ad+8+i,peek(s1+1+3*i)
  229. 3140 poke ad+16+i,peek(s1+2+3*i)
  230. 3150 poke ad+320+i,peek(s1+24+3*i)
  231. 3160 poke ad+328+i,peek(s1+25+3*i)
  232. 3170 poke ad+336+i,peek(s1+26+3*i)
  233. 3180 next i
  234. 3185 for i=0 to 4
  235. 3190 poke ad+640+i,peek(s1+48+3*i)
  236. 3200 poke ad+648+i,peek(s1+49+3*i)
  237. 3210 poke ad+656+i,peek(s1+50+3*i)
  238. 3220 next i
  239. 3230 poke vic+21,0:sys copy
  240. 3240 return
  241. 3250 :
  242. 3260 rem ******************************
  243. 3270 rem aktive nachbarschaft editieren
  244. 3280 rem ******************************
  245. 3290 :
  246. 3300 print"[147]":gosub 5300
  247. 3310 print:print:print:print:sys as
  248. 3320 print"":print:print:print:print
  249. 3330 print tab(21)"  _ - [200]auptmen@":print:print
  250. 3340 print tab(21)"[211][208][195] - toggle"
  251. 3350 print tab(21)"[195][204][210] - l:schen"
  252. 3360 print tab(21)" [201]  - invertieren":print
  253. 3370 print tab(21)"     [213][208]"
  254. 3380 print tab(21)"      ^"
  255. 3390 print tab(21)"[204][197][198][212] _ > [210][201][199][200][212]"
  256. 3400 print tab(21)"      <"
  257. 3410 print tab(21)"    [196][207][215][206]":print:print
  258. 3420 print tab(21)"[210][197][212][213][210][206] - [197]nde"
  259. 3430 :
  260. 3440 poke vic,96:poke vic+1,123:poke vic+16,0
  261. 3450 poke vic+39,1:poke vram+1016,45
  262. 3460 poke vic+21,1
  263. 3470 :
  264. 3480 get a$:if a$="" then goto 3480
  265. 3490 if a$="[157]" then goto 3600
  266. 3500 if a$="" then goto 3670
  267. 3510 if a$="[145]" then goto 3730
  268. 3520 if a$="" then goto 3790
  269. 3530 if a$="[147]" then goto 3850
  270. 3540 if a$=" " then goto 3900
  271. 3550 if a$="i" then goto 3980
  272. 3560 if a$="_" then goto 4030
  273. 3570 if a$=chr$(13) then goto 4030
  274. 3580 :
  275. 3590 rem left
  276. 3600 :
  277. 3610 x=peek(vic):if x=72 then goto 3630
  278. 3620 x=x-8:poke vic,x
  279. 3630 goto 3480
  280. 3640 :
  281. 3650 rem right
  282. 3660 :
  283. 3670 x=peek(vic):if x=120 then 3690
  284. 3680 x=x+8:poke vic,x
  285. 3690 goto 3480
  286. 3700 :
  287. 3710 rem up
  288. 3720 :
  289. 3730 y=peek(vic+1):if y=99 then 3750
  290. 3740 y=y-8:poke vic+1,y
  291. 3750 goto 3480
  292. 3760 :
  293. 3770 rem down
  294. 3780 :
  295. 3790 y=peek(vic+1):if y=147 then 3810
  296. 3800 y=y+8:poke vic+1,y
  297. 3810 goto 3480
  298. 3820 :
  299. 3830 rem clear
  300. 3840 :
  301. 3850 for i=0 to 64:poke an+i,0:next i
  302. 3860 print"":print:print:print:print:print:print:sys as
  303. 3865 goto 3480
  304. 3870 :
  305. 3880 rem toggle
  306. 3890 :
  307. 3900 x=peek(vic):y=peek(vic+1)
  308. 3910 x%=(x-72)/8:y%=(y-99)/8
  309. 3920 ad=an+8*y%+x%:p=peek(ad)
  310. 3925 if p<>0 then poke ad,0:goto 3940
  311. 3930 poke ad,1
  312. 3940 print"":print:print:print:print:print:print:sys as
  313. 3945 goto 3480
  314. 3950 :
  315. 3960 rem invert
  316. 3970 :
  317. 3980 for i=0 to 63:poke an+i,-(peek(an+i)=0):next i
  318. 3990 print"":print:print:print:print:print:print:sys as
  319. 3995 goto 3480
  320. 4000 :
  321. 4010 rem fertig
  322. 4020 :
  323. 4030 poke vic+21,0
  324. 4040 return
  325. 4050 :
  326. 4060 rem ************************
  327. 4070 rem naechstes bild berechnen
  328. 4080 rem ************************
  329. 4090 :
  330. 4100 sys gcl:poke 780,f1*16+f0:sys farbset:sys ein
  331. 4105 sys calc
  332. 4110 poke 198,0:wait 198,1
  333. 4120 sys aus
  334. 4130 return
  335. 4140 :
  336. 4150 rem *********************
  337. 4160 rem bilderserie berechnen
  338. 4170 rem *********************
  339. 4180 :
  340. 4190 print"[147]":gosub 5300:print:na$="":mb$="":s$=""
  341. 4200 input"maximale [194]ilderzahl ";mb$:if mb$="_" then goto 4360
  342. 4210 mb=val(mb$):if (int(mb)<>mb) or (mb<1) then goto 4200
  343. 4220 print:print:print"[213]nter welchem [206]amen soll die [194]ilderserie";
  344. 4230 input"abgespeichert werden ";na$:if na$="_" then goto 4360
  345. 4240 if na$="" then goto 4220
  346. 4250 :
  347. 4260 z=1:nr=1
  348. 4270 sys gcl:poke 780,f1*16+f0:sys farbset:sys ein:sys calc
  349. 4280 n$=na$+"."+str$(nr)
  350. 4290 sys aus:print"[147]":gosub 5300:print
  351. 4300 sys devpres:if st<>0 then goto 4290
  352. 4310 s=40960:e=s+8192:sf=1
  353. 4320 gosub 5390:sys sa:rem bereich speichern
  354. 4330 gosub 5490:if fe<>0 then goto 4190:rem fehlerkanal
  355. 4340 nr=nr+1:z=z+1
  356. 4350 if z<=mb then goto 4270
  357. 4360 return
  358. 4370 :
  359. 4380 rem ************
  360. 4390 rem grafik laden
  361. 4400 rem ************
  362. 4410 :
  363. 4420 print"[147]":gosub 5300:n$=""
  364. 4430 input"[198]ilename ";n$:if n$="_" then goto 4505
  365. 4440 if n$="" then goto 4505
  366. 4450 if n$="$" then gosub 5720:goto 4420
  367. 4460 sys devpres:if st<>0 then goto 4420
  368. 4470 s=57344
  369. 4480 gosub 5600:rem laden
  370. 4490 gosub 5490:if fe<>0 then goto 4420:rem fehlerk.
  371. 4500 sys copy
  372. 4505 return
  373. 4510 :
  374. 4520 rem ************
  375. 4530 rem grafik saven
  376. 4540 rem ************
  377. 4550 :
  378. 4560 print"[147]":gosub 5300:n$=""
  379. 4570 input"[198]ilename ";n$:if n$="_" then goto 4650
  380. 4580 if n$="" then goto 4650
  381. 4590 if n$="$" then gosub 5720:goto 4560
  382. 4610 sys devpres:if st<>0 then goto 4560
  383. 4620 s=40960:e=s+8192:sf=1
  384. 4630 gosub 5390:sys sa:rem bereich speichern
  385. 4640 gosub 5490:if fe<>0 then goto 4560:rem fehlerkanal
  386. 4650 return
  387. 4660 :
  388. 4670 rem ***************************
  389. 4680 rem arbeit mit zwischenspeicher
  390. 4690 rem ***************************
  391. 4700 :
  392. 4710 print"[147]":gosub 5300:print
  393. 4720 for i=1 to 9
  394. 4730 print tab(6)i"[157])";spc(2);mz$(i):print
  395. 4740 next i
  396. 4750 print:print tab(7)"_ - zur@ck zum [200]auptmen@"
  397. 4760 :
  398. 4770 poke 198,0
  399. 4775 get a$:if a$="" then goto 4775
  400. 4780 if a$="_" then 4850
  401. 4790 a=val(a$):if a<1 or a>9 then goto 4775
  402. 4800 if a=9 then gosub 4920:goto 4710
  403. 4810 poke 53280,255-peek(53280)
  404. 4820 poke 781,a:sys speicherman:sys copy
  405. 4830 poke 53280,255-peek(53280)
  406. 4840 goto 4770
  407. 4850 return
  408. 4860 :
  409. 4870 rem *************
  410. 4880 rem grafik zeigen
  411. 4890 rem *************
  412. 4900 :
  413. 4920 poke 780,16*f1+f0:sys farbset:sys ein
  414. 4940 poke 198,0:wait 198,1
  415. 4950 sys aus:print"[147]"
  416. 4955 return
  417. 4960 :
  418. 4970 rem **************
  419. 4980 rem farben aendern
  420. 4990 rem **************
  421. 5000 :
  422. 5010 z2=zf:h2=hf:r2=rf:p2=f1:b2=f0
  423. 5020 print"[147]":gosub 5300:print
  424. 5030 print tab(7)"_ - zur@ck zum [200]auptmen@":print:print
  425. 5040 poke 646,z2:print tab(7)"1)  [218]eichenfarbe":print
  426. 5050 poke 646,zf:poke 53281,h2:print tab(7)"2)  [200]intergrundfarbe":print
  427. 5060 poke 646,p2:print tab(7)"3)  [214]ordergrund [200]ires":print
  428. 5070 poke 646,b2:print tab(7)"4)  [200]intergrund [200]ires":print
  429. 5080 poke 646,zf:poke 53280,r2:print tab(7)"5)  [210]ahmenfarbe":print:print
  430. 5090 poke 646,zf:print tab(4)"[210][197][212][213][210][206]  neue [198]arben @bernehmen"
  431. 5100 get a$:if a$="" then goto 5100
  432. 5110 if a$="_" then goto 5230
  433. 5120 if a$=chr$(13) then goto 5220
  434. 5130 a=val(a$):if a<1 or a>5 then goto 5100
  435. 5140 on a goto 5160,5170,5180,5190,5200
  436. 5150 :
  437. 5160 z2=(z2+1) and 15:goto 5020
  438. 5170 h2=(h2+1) and 15:poke 53281,h2:goto 5020
  439. 5180 p2=(p2+1) and 15:goto 5020
  440. 5190 b2=(b2+1) and 15:goto 5020
  441. 5200 r2=(r2+1) and 15:poke 53280,r2:goto 5020
  442. 5210 :
  443. 5220 zf=z2:rf=r2:hf=h2:f1=p2:f0=b2
  444. 5230 poke 646,zf:poke 53280,rf:poke 53281,hf
  445. 5240 return
  446. 5250 :
  447. 5260 :
  448. 5270 rem ************************
  449. 5280 rem up ueberschrift ausgeben
  450. 5290 rem ************************
  451. 5300 :
  452. 5310 print"":ta=(40-len(t$))/2
  453. 5320 print tab(ta) t$:print tab(ta) left$(us$,len(t$))
  454. 5330 return
  455. 5340 :
  456. 5350 rem ***************
  457. 5360 rem bereich absaven
  458. 5370 rem ***************
  459. 5380 :
  460. 5390 sys (57812)n$,8
  461. 5400 poke 194,int(s/256):poke 193,s-256*peek(194)
  462. 5410 poke 175,int(e/256):poke 174,e-256*peek(175)
  463. 5420 if sf=0 then sys 62957
  464. 5430 sf=0
  465. 5435 return
  466. 5440 :
  467. 5450 rem ********************
  468. 5460 rem fehlerkanal abfragen
  469. 5470 rem ********************
  470. 5480 :
  471. 5490 fe=0:open 1,8,15
  472. 5500 input#1,fe,fe$,f$,f$
  473. 5510 close 1
  474. 5520 print:print fe,fe$
  475. 5530 if fe<>0 then poke 198,0:wait 198,1
  476. 5540 return
  477. 5550 :
  478. 5560 rem *****
  479. 5570 rem laden
  480. 5580 rem *****
  481. 5590 :
  482. 5600 poke 781,8:poke 782,0:sys 65466
  483. 5610 for i=1 to len(n$):poke na-1+i,asc(mid$(n$,i,1)):next i
  484. 5620 poke 782,na/256:poke 781,na-256*peek(782)
  485. 5630 poke 780,len(n$):sys 65469
  486. 5640 poke 780,0:poke 782,s/256:poke 781,s-256*peek(782)
  487. 5650 sys 65493
  488. 5660 return
  489. 5670 :
  490. 5680 rem *********
  491. 5690 rem directory
  492. 5700 rem *********
  493. 5710 :
  494. 5720 print"":print:print:print:print
  495. 5730 sys devpres:if st<>0 then goto 5760
  496. 5740 sys dir:gosub5490:if fe<>0 then goto 5760
  497. 5750 poke 198,0:wait 198,1
  498. 5760 return
  499.