home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er 1985 June
/
64er_Magazin_85-06_1985_Markt__Technik_de.d64
/
scroll-editor
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-10-26
|
11KB
|
592 lines
0 rem************ editor **************
1 rem*--------------------------------*
2 rem* *
3 rem* (c) 1985 by thilo herrmann *
4 rem* poststr. 6 *
5 rem* 7321 b\rtlingen *
6 rem* *
7 rem* tel. 07161/52592 *
8 rem*--------------------------------*
9 rem**********************************
10 :
100 ifpeek(50000)=56andpeek(50001)=253then160
110 print"scroll-machine laden !"
120 end
130 :
140 :
150 rem erweiterung ein
160 sys49152
170 rem basic-speicher ueber 20000
180 rem freihalten
190 poke56,78:poke55,32:clr
200 ze=160:v=53248:as=1024:sp=53240:m=1
210 sx=40:sy=180:tt=197:nt=64
220 xk=64:yk=8
230 h1=8:h2=16:h3=255:h4=256
240 uf=55296: rem zwischenspeicher
250 a(0)=1:a(1)=0:a(2)=128
260 pokev+21,0
270 a=3:gosub2240
280 gosub2280
290 :
300 rem *** eingabe ***
310 gosub2500:_us0
320 print"[147]"
330 sa=40960:xd=128:yd=64
340 gosub4860
350 :
360 :
370 rem zeichensatz kopieren
380 print"[147]":gosub5010
390 :
400 rem *** parameter setzen ***
410 _rs:_zf14
420 s2=sa-19-7*xd:gosub2130
430 _mts2,xd,yd
440 _js1,64,64
450 _gm1:_grxd*8,xd*16-8,0,yd*8-8
460 df=3*xd
470 :
480 rem textfenster verlegen
490 _rz40,50,164
500 _su0:_1r31,23,16
510 _rf6,6,6:_vi52224,15
520 :
530 ifwhthen760
540 _fu52224,53223,32
550 _us1:gosub2500:gosub3080
560 f(1)=14:f(4)=6
570 ifc=1thenf(1)=0:f(2)=7:f(3)=8:f(4)=10
580 gosub2500:gosub2930
590 :
600 rem palette erstellen
610 a=52867:b=40:c=32
620 fori=0to7
630 fort=0to31
640 pokea+i*b+t,i*c+t
650 nextt,i
660 :
670 rem *** loeschen ***
680 gosub2500:print"loeschen (j/n)?"
690 gosub2060:onagoto700,760
700 print"[145]wirklich (j/n)?"
710 gosub2060:onagoto720,760
720 _fusa,ea,32
730 :
740 :
750 rem *** sprites ***
760 _fuas,as+62,.
770 fort=as+6tot+21step3:poket,3:next
780 fort=as+8tot+21step3:poket,192:next
790 pokeas+31,255:pokeas+4,255
800 _ut as,as+64,55296,48,48
810 pokesp,96:pokesp+1,96
820 pokev,175:pokev+1,100
830 pokev+2,0:pokev+3,180
840 pokev+40,7
850 pokev+21,3
860 :
870 _fu960,1023,0
880 _fu1024,2023,32
890 _fu2040,2047,15
900 gosub2570
910 :
920 ifwhthen970
930 wh=1:rem flag setzen
940 :
950 rem auf 0,0 -position setzen
960 _poxd*8,0
970 _tm1:_us1:print
980 e$="[255]":gosub4760:goto1070
990 :
1000 :
1010 rem ***** hauptroutine *****
1020 :
1030 rem *** tastaturabfrage ***
1040 rem cursortasten abfragen
1050 gete$:ife$=""then1490
1060 ife$="[145]"ore$=""ore$="[157]"ore$=""thengosub2730:goto1410
1070 e=val(e$)
1080 rem zeichen unter cursor loeschen
1090 ifpeek(tt)=.ore$=chr$(20)thenpokepo,32:goto1490
1100 ife$=" "thengosub4300
1105 ife$="@"then5430
1110 ife$="r"thengosub4370
1120 ife>0then:_ase-1
1130 ife$=""thenze=32
1140 gosub2500
1150 _fu1024,2023,32
1160 ife$="l"then680
1170 :
1180 :
1190 gosub2690
1200 ife$="[136]"thengosub2250
1210 ife$="k"thengosub2200
1220 ife$="m"thengosub4820
1230 ife$="[205]"thengosub5230
1240 ife$="[133]"then1790
1250 ife$="[134]"then1890
1260 ife$=""thenpoke648,4:_us0:print"[147]";:end
1270 ife$="f"thengosub2910
1280 ife$="z"then3140
1290 ife$="[215]"thengosub3420
1300 ife$="s"thengosub3230
1310 ife$="c"thengosub5010
1320 ife$="w"thengosub4700
1330 ife$="a"then5080
1340 ife$="u"thengosub3570
1350 ife$="t"then5540
1360 ife$="[203]"thengosub3700
1370 ife$="^"thengosub5360
1390 ife$="_"thengosub4760
1400 rem bildschirm zuruecksetzen
1410 gosub2570:print
1420 _fu55896,56295,fs
1430 _fu55296,55855,f(4)
1440 pokev+39,1:poke198,0
1450 xc=zeand31:yc=int(ze/32)
1460 ut=1:gosub2780:ut=0
1470 printtab(26)"[145]nr. :"ze"[157] "
1480 :
1490 gosub1580
1500 ifm2thengosub1630
1510 ifusr(4)then:gosub1540:pokepo,ze
1520 _sy1
1530 gosub1690:goto1050
1540 ifm1thenze=k(paand7,km):pa=usr(kd)
1550 ifwethenze=ze+1:ifze>w2thenze=w1
1560 return
1565 :
1570 rem adresse berechnen
1580 po=usr(3)-df
1590 ifpo<.thenpo=65536+po
1600 return
1610 :
1620 rem micro-punkt berechnen
1630 pu=p2((p1and1)+(p2and1)*2)
1640 ze=s(r(usr(po))orpu)
1650 p1=usr(1)/4:p2=usr(2)/4
1660 return
1670 :
1680 rem x- und y-koordinaten printen
1690 gosub1750
1700 print"[145]x:"xp;
1710 print"[157] y:"yp;
1720 print"[157] addr:"po"[157] "
1730 return
1740 :
1750 xp=int(usr(1)/8-xd)
1760 yp=int(usr(2)/8):return
1770 :
1780 rem *** abspeichern ***
1790 print"abspeichern (j/n)?"
1800 gosub2060:onagoto1810,1410
1810 gosub5780:ifa$="k"then3960
1820 _mtsa,xd,yd
1830 _us0
1840 open1,8,15,"s:"+n$:gosub1990
1850 _sv n$,ea
1860 gosub1980:goto420
1870 :
1880 rem *** laden ***
1890 print"laden (j/n)?"
1900 gosub2060:onagoto1910,1410
1910 gosub5780:ifa$="k"then4190
1920 _ld n$
1930 gosub1980:ifenthen1950
1940 sa=usr(10):xd=usr(11):yd=usr(12)
1950 goto420
1960 :
1970 rem floppymeldung
1980 _us0:open1,8,15
1990 input#1,en,er$,et,es
2000 close1:_us1
2010 if er$="ok"then return
2020 print""en;er$;et;es
2030 wait197,63:poke198,0:return
2040 :
2050 rem j/n eingabe
2060 poke198,0
2070 geta$
2080 ifa$="j"thena=1:return
2090 ifa$<>"n"then2070
2100 a=2:return
2110 :
2120 rem endadresse berechnen
2130 ea=sa+xd*yd-1:return
2140 :
2150 :
2160 rem hi/lo-byte umrechnung
2170 h=int(a/256):l=a-h*256:return
2180 :
2190 rem kontur einstellen
2200 gosub3880
2210 input"geschwindigkeit:8[157][157][157]";ge
2220 ifa<3then:xk=ge:yk=64:goto2240
2230 yk=ge:xk=64
2240 km=a:kd=(a-1)/2+1
2250 we=0:m1=1:m2=0:_js1,xk,yk:return
2260 :
2270 rem micro-datas
2280 data 32,108,123,98,124,225,255,254,126,127,97,252,226,251,236,160
2290 dimr(255),s(15)
2300 restore
2310 fori=0to15
2320 reada:s(i)=a:r(a)=i:next
2330 :
2340 fori=0to3:p2(i)=2^(3-i):next
2350 :
2360 rem y - datas
2370 data100,111,121,98,248,247,227,160
2380 fori=7to0step-1:reada:k(i,3)=a
2390 k(i,4)=a+128and255:next
2400 :
2410 rem x - datas
2420 data101,116,117,97,246,234,231,160
2430 fori=0to7:reada:k(i,1)=a
2440 k(i,2)=a+128and255:next
2450 :
2460 return
2470 :
2480 :
2490 rem normal schalten
2500 poke648,4
2510 _mc21,52,52
2520 _ci151,148,148
2530 gosub2650
2540 return
2550 :
2560 rem palette einschalten
2570 _mc52,52,52
2580 _ci148,148,148
2590 poke648,204
2600 poke214,14:print
2610 _fu55856,55895,6:rem hin.far.
2620 return
2630 :
2640 rem cursor setzen + zeile loeschen
2650 poke214,14:print:print" [145]"
2660 return
2670 :
2680 rem auf vielfaches von 8 setzen
2690 gosub1750:_poxd*8+xp*8,yp*8:return
2700 :
2710 :
2720 rem wahl des characters
2730 ife$="[145]"thenyc=yc-1:ifyc<0thenyc=7
2740 ife$=""thenyc=yc+1:ifyc>7thenyc=0
2750 ife$="[157]"thenxc=xc-1:ifxc<0thenxc=31
2760 ife$=""thenxc=xc+1:ifxc>31thenxc=0
2770 rem spritesteuerung
2780 cx=xc*h1+sx
2790 pokev+2,cxandh3
2800 pokev+h2,sgn(cxandh4)*2
2810 pokev+3,sy+yc*h1
2820 :
2830 ifutthen2860
2840 ifpeek(tt)<>ntthengete$:goto2730
2850 gosub2570:print
2860 ze=yc*32+xc:rem zeichen berechnen
2870 return
2880 :
2890 :
2900 rem farbeneingabe
2910 gosub3080
2920 :
2930 print
2940 a=1:gosub3050:
2950 oncgoto2960,2980
2960 a=2:gosub3050:pokev+34,f(2)
2970 a=3:gosub3050:pokev+35,f(3)
2980 _2r200+b,200,192+b
2990 a=4:gosub3050:_hf6,6,f(1)
3000 :
3010 fs=f(4)
3020 ifb=0thenfs=f(1)
3030 gosub2570:return
3040 :
3050 print"[145]farbe"a": "f(a)"[157] "
3060 print"[145]"tab(10);:inputf(a):return
3070 :
3080 print"multicolor (j/n)?"
3090 gosub2060:gosub2500:b=(1-(a-1))*16:c=a
3100 return
3110 :
3120 :
3130 rem zeichensatz laden
3140 print"zeichensatz laden (j/n)?"
3150 gosub2060:onagoto3160,3190
3160 input"name: ";n$
3170 rem laden an 53248 - 2
3180 _ld n$,53246:gosub1980
3190 goto420
3200 :
3210 :
3220 rem schreiben
3230 _sy0:_tm0:_js0:rt=usr(1)
3240 x=usr(1):y=usr(2)
3250 geta$:ifa$="[136]"then:_tm1:_js1:return
3260 ifa$=""then3250
3270 a=asc(a$)
3280 rem cursorsteuercodes beachten
3290 ifa=32then3360
3300 ifa=20ora=157thenx=x-8:goto3380
3310 ifa=29thenx=x+8:goto3380
3320 ifa=17theny=y+8:goto3380
3330 ifa=145theny=y-8:goto3380
3340 ifa=13theny=y+8:x=rt:goto3380
3350 ifa=18ora=146thenprinta$;:goto3250
3360 print""a$;:a=peek(1024)
3370 pokeusr(3)-df,a:x=x+8
3380 _pox,y:goto3240
3390 :
3400 :
3410 rem wechsel
3420 gosub2570:gosub2650
3430 print"wechsel von":gosub3500
3440 w1=ze
3450 print"[145]wechsel bis":gosub3500
3460 w2=ze:ifw2<w1then3450
3470 we=1:return
3480 :
3490 rem waehlen des zeichens
3500 gosub2730
3510 gete$:ife$=chr$(13)thenreturn
3520 ife$=""then3510
3530 goto3500
3540 :
3550 :
3560 rem uebertragen
3570 gosub2570:gosub2650
3580 y2=yc:x2=xc:ut=1
3590 print"uebertragen !"
3600 gete$:ife$=chr$(13)thenut=.:return
3610 ife$=""then3600
3620 gosub2730
3630 a=usr(3)-df+xc-x2+yc*xd-y2*xd
3640 ifa>=saanda<=eathenpokea,ze
3650 _sy1
3660 goto3600
3670 :
3680 :
3690 rem konturen definieren
3700 gosub3880:a2=a
3710 gosub2570:gosub2650
3720 print"erstes element ?"
3730 gosub3500
3740 gosub2650
3750 :
3760 rem austeigend oder fallend
3770 print"1...[-1] / 2...[+1]"
3780 geta$:a=val(a$)*2-3
3790 ifa<-1ora>1then3780
3800 a3=0
3810 rem in variablen schreiben
3820 fori=-3.5*ato3.5*astepa
3830 k(i+4,a2)=ze+a3:a3=a3+1:next
3840 a=a2:gosub2650:goto2210
3850 :
3860 :
3870 rem wahl des konturmodes
3880 print"1...x+ [194] 2...x- [194] 3...y+ [194] 4...y-
3890 [161]a$:a[178][197](a$)
3900 [139]a[179]1[176]a[177]4[167]3890
3910 [142]
3920 :
3930 :
3940 [143] abspeichern auf kassette
3950 [143] schreiben von sa,xd,yd
3960 _of:[159]1,1,1,n$:[152]1,sa","xd","yd:[160]1
3970 [143] schreiben des schirms
3980 [141]4050:a[178]sa:[141]2170
3990 [151]251,l:[151]252,h
4000 a[178]ea[170]1:[141]2170
4010 [151]780,251:[151]781,l:[151]782,h
4020 [158]65496:[160]1:[158]49152:[137]410
4030 :
4040 [143] oeffnen des kassettenkanals
4050 l[178][195](n$):[151]183,l
4060 s[178]256[172]204
4070 [139]l[178]0[167]4100
4080 [129]x[178]1[164]l
4090 [151]s[170]x[171]1,[198]([202](n$,x,1)):[130]
4100 [151]780,1:[151]781,1:[151]782,0
4110 [158]65466
4120 [151]780,l:[151]781,0
4130 [151]782,204:[158]65469
4140 [142]
4150 :
4160 :
4170 [143] laden von kassette
4180 [143] lesen von sa,xd,yd
4190 _of:[159]1,1,0,n$:[132]1,s2,x2,y2:[160]1
4200 [143] lesen des schirms
4210 [141]4050:a[178]s2:[141]2170
4220 [151]780,0:[151]781,l:[151]782,h
4230 [158]65493
4240 [139](st [175] 48)[167][153]"band fehler !":[160]1:[146]197,63:[137]410
4250 sa[178]s2:xd[178]x2:yd[178]y2:[158]49152:[137]410
4260 :
4270 :
4280 [143] schnellgang
4290 [143] syncronisation aus + hf=gruen
4300 _sy0:_rf6,6,5:[151]v[170]39,1
4310 [141]1580:[141]1690
4320 [161]e$:[139]e$[178]""[167]4310
4330 e$[178]"":_rf6,6,6:[142]
4340 :
4350 :
4360 [143] rechteck ausfuellen
4370 [141]4480:[143] bereich waehlen
4380 [139]e$[178]"_"[167][142]
4390 :
4400 [143] rechteck fuellen
4410 [129]i[178]ys[164]yp
4420 br[178]ps[170](yp[171]i)[172]xd
4430 _fu br,br[170](xp[171]xs),ze
4440 [130]
4450 e$[178]"":[142]
4460 :
4470 [143] bereich waehlen
4480 xs[178]xp:ys[178]yp:ps[178]po:g[178][183](ps)
4490 [151]ps,([183](ps)[170]128)[175]h3
4500 [151]v[170]39,[194](v[170]39)[170]1[175]h3
4510 _sy1
4520 [141]1580:[141]1690
4530 [139][183](4)[167]4590
4540 [161]e$
4550 [139]e$[178]""[167]4490
4560 [139]e$[178]" "[167][141]4300
4570 [139]e$[178]"_"[167][151]ps,g:[137]4760
4580 [137]4490
4590 [151]ps,g
4600 :
4610 [143] normalisieren
4620 [139]xp[171]xs[179]0[167]a[178]xp:xp[178]xs:xs[178]a
4630 [139]yp[171]ys[179]0[167]a[178]yp:yp[178]ys:ys[178]a
4640 ps[178]sa[170]ys[172]xd[170]xs
4650 [142]
4660 :
4670 :
4680 :
4690 [143] umschalten auf wechselmodus
4700 we[178]we[170]1[175]1
4710 [139]we[167]ze[178]w1:[142]
4720 [137]2860
4730 :
4740 :
4750 [143] reset
4760 m1[178]0:m2[178]0:[141]2690:_js1,64,64
4770 we[178]0:ze[178]160
4780 [142]
4790 :
4800 :
4810 [143] micro - mode setzen
4820 m2[178]1:m1[178]0:we[178]0:_js1,32,32:[142]
4830 :
4840 :
4850 [143] eingabe von aa,xd,yd
4860 [141]2650
4870 [153]"x- und y-ausdehnung "xd","yd
4880 [153]"on"[166]23);:[133]xd,yd
4890 [153]"startadresse "sa
4900 [153]"on"[166]16);:[133]sa
4910 [139]xd[179]1[176]yd[179]1[167]4860
4920 [141]2130
4930 [153]"start:"sa" ende:"ea
4940 [139]sa[179]20000[176](sa[177]49152[175]sa[179]57344)[176]sa[177]65530[167]4860
4950 [139](ea[177]49152[175]ea[179]57344)[176]ea[177]65535[167]4860
4960 [153]"richtig (j/n)?"
4970 [141]2060:[145]a[137]4980,4860
4980 [142]
4990 :
5000 [143] zeichensatz vom rom ins ram
5010 [141]2500:[153]"zeichensatz kopieren (j/n)?"
5020 [141]2060:[145]a[137]5030,5040
5030 _cp
5040 [142]
5050 :
5060 :
5070 [143] umformatieren eines schirms
5080 sf[178]sa:ef[178]ea:xf[178]xd:yf[178]yd
5090 [141]4860:_us0:l[178]48
5100 l1[178]0:l2[178]yf[171]1:l3[178]1
5110 [139]xd[177]xf[167]l1[178]yf[171]1:l2[178]0:l3[178][171]1
5120 :
5122 [153]"load schirm an neue adresse kopieren (j/n)?"
5123 [141] 2060:[145] a [137] 5140,5190
5130 :
5140 [129]i[178] l1 [164] l2 [169] l3
5150 a[178]sf[170]xf[172]i:b[178]sf[170]xf[172](i[170]1)[171]1:c[178]b[171]a
5160 _ut a,b,uf,l,l
5170 _ut uf,uf[170]c,sa[170]xd[172]i,l,l
5180 [130]
5190 [137]420
5200 :
5210 :
5220 [143] micro-zeichen definieren
5230 [141]2570:[141]2650
5240 [153]"erstes element ?"
5250 [141]3500:[143] zeichen waehlen
5260 [139]ze[177]240[167]5250
5270 [141]5320
5280 [129]i[178]0[164]15:s(i)[178]i[170]ze:r(i[170]ze)[178]i
5290 [130]
5300 [137]4820
5310 :
5320 [129]i[178]0[164]255:r(i)[178].:[130]:[142]
5330 :
5340 :
5350 [143] kontur und micro reset
5360 [153]"kontur und micro zuruecksetzen (j/n)?"
5370 [141]2060:[145]a[137]5380,5390
5380 [141]5320:[141]2300
5390 [142]
5400 :
5410 :
5420 [143] micro-mode umschalten
5430 r(32)[178]15[171]r(32)
5440 [129]i[178]0[164]15
5450 r(s(i))[178]15[171]i
5460 [130]
5470 [129]i[178]0[164]7
5480 a[178]s(i):s(i)[178]s(15[171]i):s(15[171]i)[178]a
5490 [130]
5500 [137]1490
5510 :
5520 :
5530 [143] transfer eines bereiches
5540 [141]4480:[143] bereich waehlen
5550 [139]e$[178]"_"[167]420
5560 [141]2650:[153]"wohin (linker oberer punkt) ?on"
5570 [139][183](4)[167]5570
5580 pt[178]ps:xt[178]xs:yt[178]ys
5590 xr[178]xp:yr[178]yp:[141]4480
5600 [139]e$[178]"_"[167]420
5610 :
5620 [143] rechteck uebertragen
5630 _us0
5640 [139]po[177]pt[167]l1[178]yt:l2[178]yr:l3[178]1:[137]5660
5650 l1[178]yr:l2[178]yt:l3[178][171]1
5660 l[178]48
5670 [129]i[178]l1[164]l2[169]l3
5680 br[178](yr[171]i)[172]xd
5690 a[178](xr[171]xt)
5700 _ut pt[170]br,pt[170]br[170]a,uf,l,l
5710 [139]po[170]br[170]a[177]ea[167]5730
5720 _ut uf,uf[170]a,po[170]br,l,l
5730 [130]
5740 [137]420
5750 :
5760 :
5770 [143] eingabe fuer disk & kassette
5780 n$[178]"":[133]"name: ";n$
5790 [153]"dwaitisk oder kwaitassette ?
5800 geta$:ifa$<>"k"anda$<>"d"then5800
5810 return
5820 gosub2280:restore
5830 fori=0to15
5840 r(s(i))=15-i:reada:s(15-i)=a+128and255
5850 next
5860 fori=0to15:prints(i);:next