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 >
Wrap
Commodore BASIC
|
2022-10-26
|
11KB
|
499 lines
100 rem ************************
110 rem * musterbrueter v2.8 *
120 rem * vom 25.12.87 *
130 rem * autor: *
140 rem * i. camphausen *
150 rem * aspenweg 29 *
160 rem * 1000 berlin 20 *
170 rem * hardware: c64 + 1541 *
180 rem ************************
190 :
200 if zx=0 then zx=1:load"mb.mc",8,1
210 :
1000 poke 56,20000/256:poke 55,20000 and 255:clr
1010 dim hm$(9),mz$(9)
1020 zf=0:hf=15:rf=11:f1=0:f0=12
1030 :
1040 s1=49152+11*256:rem adressen fuer speicherbereiche
1050 s2=s1+64
1060 sd=21519
1070 na=s2+64
1080 an=49152+10*256
1090 vic=53248
1100 vram=49152+12*256
1105 :
1110 calc=20000:rem startadressen maschinenpgm's
1120 copy=20003
1130 gcl=20006
1140 farbset=20009
1150 ein=20012
1160 aus=20015
1170 dir=20018
1180 devpres=20021
1190 sa=20024
1200 speicherman=20027
1210 ss=20030
1220 as=20033
1230 zeichenneu=20036
1240 is=20039
1250 :
1260 :
1280 sys 58784:rem vic initialisieren
1290 poke 53281,hf:poke 53280,rf:poke 646,zf
1300 sys zeichenneu:print chr$(8):rem <c=> <shift> verriegeln
1310 print "[147]"
1320 print tab(13)"[205]ustermaker 64"
1330 print:print tab(9)"von [201]ngmar [195]amphausen"
1340 for i=1 to 9:read hm$(i):next i
1350 data"[193]usgangsstellung editieren","aktive [206]achbarschaft editieren"
1360 data"n;chstes [194]ild berechnen","[194]ilderserie berechnen","[199]rafik laden"
1370 data"[199]rafik saven","[218]wischenspeicher benutzen"
1380 data"[199]rafik zeigen","[198]arben ;ndern"
1390 for i=1 to 9:read mz$(i):next i
1400 data"[211]peicher l:schen"
1410 data"[199]rafik > [211]peicher"
1420 data"[211]peicher > [199]rafik"
1430 data"[199]rafik [207][210] [211]peicher"
1440 data"[199]rafik [193][206][196] [211]peicher"
1450 data"[199]rafik [216][207][210] [211]peicher"
1460 data"[199]rafik invertieren"
1470 data"[211]peicher invertieren"
1480 data"[199]rafik zeigen"
1490 :
1500 for i=an to an+64:poke i,0:next i
1510 for i=0 to 63:poke s1+i,0:poke s2+i,peek(sd+i):next i
1520 :
1530 us$=chr$(183):for i=1 to 5:us$=us$+us$:next i
1540 :
1550 :
1560 rem **********
1570 rem hauptmenue
1580 rem **********
1590 :
1600 t$="[200]auptmenue":print"[147]":gosub 5300:print
1610 for i=1 to 9
1620 print tab(2)i"[157])";spc(2);hm$(i):print
1630 next i
1635 poke 198,0
1640 get a$:if a$="" then goto 1640
1650 if (a$<"1") or (a$>"9") then goto 1640
1660 a=val(a$):t$=hm$(a)
1670 on a gosub 1700,3300,4100,4190,4420,4560,4700,4900,5000
1680 goto 1600
1700 :
1710 rem **************************
1720 rem ausgangsstellung editieren
1730 rem **************************
1740 :
1750 print"[147]":gosub 5300
1760 sys ss:print"";:rem stellung anzeigen
1770 print:print:print:print
1780 print tab(25)" _ - zur@ck":print:print
1790 print tab(25)" [204] - laden"
1800 print tab(25)" [211] - saven":print
1810 print tab(25)"[211][208][195] - toggle"
1820 print tab(25)"[195][204][210] - l:schen"
1830 print tab(25)"[201] - invert.":print
1840 print tab(25)" [195][210][211][210] [213][208]"
1850 print tab(25)" ^"
1860 print tab(25)"[204][197][198][212] _ > [210][201][199][200][212]"
1870 print tab(25)" <"
1880 print tab(25)" [195][210][211][210] [196][207][215][206]":print:print
1890 print tab(25)"[210][197][212][213][210][206] - [197]nde"
1900 :
1910 poke vic,112:poke vic+1,140:rem x/y-startpostion des fadenkreuz-cursors
1920 poke vic+39,1:rem spritefarbe
1930 poke vram+1016,45:rem blockpointer
1940 poke vic+21,1:rem sprite an
1950 :
1960 get a$:if a$="" then goto 1960
1970 if a$="_"then poke vic+21,0:goto 3240
1980 if a$="[157]" then goto 2100
1990 if a$="" then goto 2180
2000 if a$="[145]" then goto 2240
2010 if a$="" then goto 2300
2020 if a$="[147]" then goto 2360
2030 if a$=" " then goto 2400
2040 if a$="i" then goto 2500
2050 if a$="l" then goto 2670
2060 if a$="s" then goto 2540
2070 if a$=chr$(13) then goto 2800
2080 goto 1960
2090 :
2100 rem left
2110 :
2120 x=peek(vic):if x=16 then 2140
2130 x=x-8:poke vic,x
2140 goto 1960
2150 :
2160 rem right
2170 :
2180 x=peek(vic):if x=200 then goto 2200
2190 x=x+8:poke vic,x
2200 goto 1960
2210 :
2220 rem up
2230 :
2240 y=peek(vic+1):if y=68 then goto 2260
2250 y=y-8:poke vic+1,y
2260 goto 1960
2270 :
2280 rem down
2290 :
2300 y=peek(vic+1):if y=228 then goto 2320
2310 y=y+8:poke vic+1,y
2320 goto 1960
2330 :
2340 rem clear
2350 :
2360 for i=s1 to s1+63:poke i,0:next i:print"":print:print:sys ss
2370 goto 1960
2380 :
2390 rem toggle
2400 :
2410 x=peek(vic):y=peek(vic+1)
2420 x%=(x-16)/8:y%=(y-68)/8
2430 a%=3*y%+x%/8:b=2^(7-x%and7)
2440 p=peek(s1+a%):if (pandb)=0 then poke s1+a%,p or b:goto 2460
2450 poke s1+a%,p and (255-b)
2460 print"":print:print:sys ss:goto 1960
2470 :
2480 rem invert
2490 :
2500 sys is:print"":print:print:sys ss:goto 1960
2510 :
2520 rem saven
2530 :
2540 poke vic+21,0:n$=""
2550 print"[147] [193]usgangsstellung saven"
2560 print:input"[198]ilename ";n$:if n$="_" then goto 2630
2570 if n$="$" then gosub 5700:goto 2540
2580 if n$="" then goto 2630
2590 sys devpres:if st<>0 then goto 2540
2600 s=s1:e=s1+64:rem start- und endadresse
2610 gosub 5390:rem bereich speichern
2620 gosub 5490:if fe<>0 then goto 2540:rem fehlerkanal
2630 goto 1700
2640 :
2650 rem laden
2660 :
2670 poke vic+21,0:n$=""
2680 print"[147] [193]usgangsstellung laden"
2690 print:input"[198]ilename ";n$:if n$="_"then goto 2760
2700 if n$="$" then gosub 5700:goto 2670
2710 if n$=""then goto 2760
2720 sys devpres:if st<>0 then goto 2670
2730 s=s1
2740 gosub 5600:rem laden
2750 gosub 5490:if fe<>0 then goto 2670:rem fehlerk.
2760 goto 1700
2770 :
2780 rem ausgangsstellung fertig, positionieren in der hiresgrafik
2790 :
2800 poke vic+21,0:print"[147]"
2810 poke vic,168:poke vic+1,138:poke vic+16,0
2820 poke vic+39,0:poke vram+1016,44
2830 poke vic+21,1
2840 get a$:if a$="" then goto 2840
2850 if a$="[157]" then goto 2910
2860 if a$="" then goto 2950
2870 if a$="[145]" then goto 2990
2880 if a$="" then goto 3020
2890 if a$=chr$(13) then goto 3080
2900 goto 2840
2905 :
2910 x=peek(vic)+256*(peek(vic+16) and 1):if x=24 then goto 2930
2920 x=x-8:poke vic,x and 255:poke vic+16,x/256
2930 goto 2840
2940 :
2950 x=peek(vic)+256*(peek(vic+16) and 1):if x=320 then goto 2970
2960 x=x+8:poke vic,x and 255:poke vic+16,x/256
2970 goto 2840
2980 :
2990 y=peek(vic+1):if y=50 then goto 3010
3000 y=y-8:poke vic+1,y
3010 goto 2840
3015 :
3020 y=peek(vic+1):if y=226 then goto 3040
3030 y=y+8:poke vic+1,y
3040 goto 2840
3050 :
3060 rem sprite in bitmap kopieren
3070 :
3080 x=peek(vic)+256*(peek(vic+16) and 1):y=peek(vic+1)
3090 x%=(x-24)/8:y%=(y-50)/8
3100 ad=57344+8*x%+320*y%:sys gcl
3110 for i=0 to 7
3120 poke ad+i,peek(s1+3*i)
3130 poke ad+8+i,peek(s1+1+3*i)
3140 poke ad+16+i,peek(s1+2+3*i)
3150 poke ad+320+i,peek(s1+24+3*i)
3160 poke ad+328+i,peek(s1+25+3*i)
3170 poke ad+336+i,peek(s1+26+3*i)
3180 next i
3185 for i=0 to 4
3190 poke ad+640+i,peek(s1+48+3*i)
3200 poke ad+648+i,peek(s1+49+3*i)
3210 poke ad+656+i,peek(s1+50+3*i)
3220 next i
3230 poke vic+21,0:sys copy
3240 return
3250 :
3260 rem ******************************
3270 rem aktive nachbarschaft editieren
3280 rem ******************************
3290 :
3300 print"[147]":gosub 5300
3310 print:print:print:print:sys as
3320 print"":print:print:print:print
3330 print tab(21)" _ - [200]auptmen@":print:print
3340 print tab(21)"[211][208][195] - toggle"
3350 print tab(21)"[195][204][210] - l:schen"
3360 print tab(21)" [201] - invertieren":print
3370 print tab(21)" [213][208]"
3380 print tab(21)" ^"
3390 print tab(21)"[204][197][198][212] _ > [210][201][199][200][212]"
3400 print tab(21)" <"
3410 print tab(21)" [196][207][215][206]":print:print
3420 print tab(21)"[210][197][212][213][210][206] - [197]nde"
3430 :
3440 poke vic,96:poke vic+1,123:poke vic+16,0
3450 poke vic+39,1:poke vram+1016,45
3460 poke vic+21,1
3470 :
3480 get a$:if a$="" then goto 3480
3490 if a$="[157]" then goto 3600
3500 if a$="" then goto 3670
3510 if a$="[145]" then goto 3730
3520 if a$="" then goto 3790
3530 if a$="[147]" then goto 3850
3540 if a$=" " then goto 3900
3550 if a$="i" then goto 3980
3560 if a$="_" then goto 4030
3570 if a$=chr$(13) then goto 4030
3580 :
3590 rem left
3600 :
3610 x=peek(vic):if x=72 then goto 3630
3620 x=x-8:poke vic,x
3630 goto 3480
3640 :
3650 rem right
3660 :
3670 x=peek(vic):if x=120 then 3690
3680 x=x+8:poke vic,x
3690 goto 3480
3700 :
3710 rem up
3720 :
3730 y=peek(vic+1):if y=99 then 3750
3740 y=y-8:poke vic+1,y
3750 goto 3480
3760 :
3770 rem down
3780 :
3790 y=peek(vic+1):if y=147 then 3810
3800 y=y+8:poke vic+1,y
3810 goto 3480
3820 :
3830 rem clear
3840 :
3850 for i=0 to 64:poke an+i,0:next i
3860 print"":print:print:print:print:print:print:sys as
3865 goto 3480
3870 :
3880 rem toggle
3890 :
3900 x=peek(vic):y=peek(vic+1)
3910 x%=(x-72)/8:y%=(y-99)/8
3920 ad=an+8*y%+x%:p=peek(ad)
3925 if p<>0 then poke ad,0:goto 3940
3930 poke ad,1
3940 print"":print:print:print:print:print:print:sys as
3945 goto 3480
3950 :
3960 rem invert
3970 :
3980 for i=0 to 63:poke an+i,-(peek(an+i)=0):next i
3990 print"":print:print:print:print:print:print:sys as
3995 goto 3480
4000 :
4010 rem fertig
4020 :
4030 poke vic+21,0
4040 return
4050 :
4060 rem ************************
4070 rem naechstes bild berechnen
4080 rem ************************
4090 :
4100 sys gcl:poke 780,f1*16+f0:sys farbset:sys ein
4105 sys calc
4110 poke 198,0:wait 198,1
4120 sys aus
4130 return
4140 :
4150 rem *********************
4160 rem bilderserie berechnen
4170 rem *********************
4180 :
4190 print"[147]":gosub 5300:print:na$="":mb$="":s$=""
4200 input"maximale [194]ilderzahl ";mb$:if mb$="_" then goto 4360
4210 mb=val(mb$):if (int(mb)<>mb) or (mb<1) then goto 4200
4220 print:print:print"[213]nter welchem [206]amen soll die [194]ilderserie";
4230 input"abgespeichert werden ";na$:if na$="_" then goto 4360
4240 if na$="" then goto 4220
4250 :
4260 z=1:nr=1
4270 sys gcl:poke 780,f1*16+f0:sys farbset:sys ein:sys calc
4280 n$=na$+"."+str$(nr)
4290 sys aus:print"[147]":gosub 5300:print
4300 sys devpres:if st<>0 then goto 4290
4310 s=40960:e=s+8192:sf=1
4320 gosub 5390:sys sa:rem bereich speichern
4330 gosub 5490:if fe<>0 then goto 4190:rem fehlerkanal
4340 nr=nr+1:z=z+1
4350 if z<=mb then goto 4270
4360 return
4370 :
4380 rem ************
4390 rem grafik laden
4400 rem ************
4410 :
4420 print"[147]":gosub 5300:n$=""
4430 input"[198]ilename ";n$:if n$="_" then goto 4505
4440 if n$="" then goto 4505
4450 if n$="$" then gosub 5720:goto 4420
4460 sys devpres:if st<>0 then goto 4420
4470 s=57344
4480 gosub 5600:rem laden
4490 gosub 5490:if fe<>0 then goto 4420:rem fehlerk.
4500 sys copy
4505 return
4510 :
4520 rem ************
4530 rem grafik saven
4540 rem ************
4550 :
4560 print"[147]":gosub 5300:n$=""
4570 input"[198]ilename ";n$:if n$="_" then goto 4650
4580 if n$="" then goto 4650
4590 if n$="$" then gosub 5720:goto 4560
4610 sys devpres:if st<>0 then goto 4560
4620 s=40960:e=s+8192:sf=1
4630 gosub 5390:sys sa:rem bereich speichern
4640 gosub 5490:if fe<>0 then goto 4560:rem fehlerkanal
4650 return
4660 :
4670 rem ***************************
4680 rem arbeit mit zwischenspeicher
4690 rem ***************************
4700 :
4710 print"[147]":gosub 5300:print
4720 for i=1 to 9
4730 print tab(6)i"[157])";spc(2);mz$(i):print
4740 next i
4750 print:print tab(7)"_ - zur@ck zum [200]auptmen@"
4760 :
4770 poke 198,0
4775 get a$:if a$="" then goto 4775
4780 if a$="_" then 4850
4790 a=val(a$):if a<1 or a>9 then goto 4775
4800 if a=9 then gosub 4920:goto 4710
4810 poke 53280,255-peek(53280)
4820 poke 781,a:sys speicherman:sys copy
4830 poke 53280,255-peek(53280)
4840 goto 4770
4850 return
4860 :
4870 rem *************
4880 rem grafik zeigen
4890 rem *************
4900 :
4920 poke 780,16*f1+f0:sys farbset:sys ein
4940 poke 198,0:wait 198,1
4950 sys aus:print"[147]"
4955 return
4960 :
4970 rem **************
4980 rem farben aendern
4990 rem **************
5000 :
5010 z2=zf:h2=hf:r2=rf:p2=f1:b2=f0
5020 print"[147]":gosub 5300:print
5030 print tab(7)"_ - zur@ck zum [200]auptmen@":print:print
5040 poke 646,z2:print tab(7)"1) [218]eichenfarbe":print
5050 poke 646,zf:poke 53281,h2:print tab(7)"2) [200]intergrundfarbe":print
5060 poke 646,p2:print tab(7)"3) [214]ordergrund [200]ires":print
5070 poke 646,b2:print tab(7)"4) [200]intergrund [200]ires":print
5080 poke 646,zf:poke 53280,r2:print tab(7)"5) [210]ahmenfarbe":print:print
5090 poke 646,zf:print tab(4)"[210][197][212][213][210][206] neue [198]arben @bernehmen"
5100 get a$:if a$="" then goto 5100
5110 if a$="_" then goto 5230
5120 if a$=chr$(13) then goto 5220
5130 a=val(a$):if a<1 or a>5 then goto 5100
5140 on a goto 5160,5170,5180,5190,5200
5150 :
5160 z2=(z2+1) and 15:goto 5020
5170 h2=(h2+1) and 15:poke 53281,h2:goto 5020
5180 p2=(p2+1) and 15:goto 5020
5190 b2=(b2+1) and 15:goto 5020
5200 r2=(r2+1) and 15:poke 53280,r2:goto 5020
5210 :
5220 zf=z2:rf=r2:hf=h2:f1=p2:f0=b2
5230 poke 646,zf:poke 53280,rf:poke 53281,hf
5240 return
5250 :
5260 :
5270 rem ************************
5280 rem up ueberschrift ausgeben
5290 rem ************************
5300 :
5310 print"":ta=(40-len(t$))/2
5320 print tab(ta) t$:print tab(ta) left$(us$,len(t$))
5330 return
5340 :
5350 rem ***************
5360 rem bereich absaven
5370 rem ***************
5380 :
5390 sys (57812)n$,8
5400 poke 194,int(s/256):poke 193,s-256*peek(194)
5410 poke 175,int(e/256):poke 174,e-256*peek(175)
5420 if sf=0 then sys 62957
5430 sf=0
5435 return
5440 :
5450 rem ********************
5460 rem fehlerkanal abfragen
5470 rem ********************
5480 :
5490 fe=0:open 1,8,15
5500 input#1,fe,fe$,f$,f$
5510 close 1
5520 print:print fe,fe$
5530 if fe<>0 then poke 198,0:wait 198,1
5540 return
5550 :
5560 rem *****
5570 rem laden
5580 rem *****
5590 :
5600 poke 781,8:poke 782,0:sys 65466
5610 for i=1 to len(n$):poke na-1+i,asc(mid$(n$,i,1)):next i
5620 poke 782,na/256:poke 781,na-256*peek(782)
5630 poke 780,len(n$):sys 65469
5640 poke 780,0:poke 782,s/256:poke 781,s-256*peek(782)
5650 sys 65493
5660 return
5670 :
5680 rem *********
5690 rem directory
5700 rem *********
5710 :
5720 print"":print:print:print:print
5730 sys devpres:if st<>0 then goto 5760
5740 sys dir:gosub5490:if fe<>0 then goto 5760
5750 poke 198,0:wait 198,1
5760 return