home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Profi Club
/
Profi_Club_2_1992_-_de.d64
/
grafik-demo
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2023-02-26
|
7KB
|
219 lines
10 rem grafik-demo =================c64
20 rem written by a. mittelmeyer
30 rem ================================
130 vb=3
140 gb=8
150 vr=7
151 rem -------------------------------
155 vf=1
160 gosub180:gosub200:goto1150
180 vh=64*vb+4*vr:gh=64*vb+4*gb
190 va=256*vh:ga=256*gh:return
200 fori=828to1004
201 reada:pokei,a:next:return
202 data120,072,165,001,041,252,133,001
203 data104,096,072,165,001,009,003,133
204 data001,088,104,096,032,060,003,160
205 data000,145,251,200,208,251,230,252
206 data202,208,246,240,229,160,000,032
207 data207,255,176,222,032,060,003,145
208 data251,032,070,003,200,208,240,230
209 data252,202,208,235,240,204,160,000
210 data032,060,003,177,251,032,070,003
211 data032,210,255,200,208,242,230,252
212 data202,208,237,096,032,253,174,032
213 data235,183,138,032,060,003,160,000
214 data145,020,076,070,003,032,253,174
215 data032,138,173,032,247,183,032,060
216 data003,160,000,177,020,032,070,003
217 data168,032,162,179,032,253,174,032
218 data139,176,133,073,132,074,165,014
219 data076,194,169,032,253,174,032,235
220 data183,169,000,056,106,202,016,252
221 data160,000,076,060,003,032,199,003
222 data017,020,145,020,076,070,003,032
223 data199,003,073,255,049,020,076,222
224 data003
420 rem ---- grafik an ----
430 poke56576,peek(56576)and252or(3-vb)
440 poke53272,16*vr+gb
450 poke53265,peek(53265)or32:return
470 rem ---- grafik aus ----
480 poke56576,peek(56576)and252or3
490 poke53272,21
500 poke53265,peek(53265)and223:return
520 rem ---- farbe klaeren ----
530 poke780,16*vf+hf:poke781,4
540 poke251,0:poke252,vh:sys848:return
550 rem ---- bild loeschen ----
560 poke780,0:poke781,32
570 poke251,0:poke252,gh:sys848:return
580 rem ---- grafik laden ----
590 open8,8,8,fi$+",p,r":poke781,8
600 sys65478:geta$:geta$:poke251,0
610 iffg=0then630
620 poke252,vh:poke781,4:sys865
630 poke252,gh:poke781,32:sys865
640 sys65484:close8:return
645 rem ---- grafik saven ----
650 open8,8,8,fi$+",p,w":poke781,8
660 sys65481:printchr$(0);:poke251,0
670 iffg=0thenprint" ";:goto700
680 printchr$(28);:poke252,vh:poke781,4
690 sys890
700 poke252,gh:poke781,32:sys890:goto640
710 rem ---- speicherzugriff ----
720 rem i=sys912,a,i:rem pokea,i
730 rem sys929,a,i:rem i=peek(a)
750 rem ---- pixel setzen ----
760 sn=int(x/8):zn=int(y/8)
770 iffa=1thensys912,40*zn+sn+va,16*vf+hf
780 ad=312*zn+y+8*sn+ga
790 iflo=0thensys985,ad,xand7:return
800 sys995,ad,xand7:return
810 rem ---- linie ----
820 ifabs(y2-y1)>abs(x2-x1)then860
830 m=(y2-y1)/(x2-x1)
840 forx=x1tox2stepsgn(x2-x1)
850 y=int(y1+(x-x1)*m+.5):gosub760:next:return
860 m=(x2-x1)/(y2-y1)
870 fory=y1toy2stepsgn(y2-y1)
871 x=int(x1+(y-y1)*m+.5):gosub760:next:return
875 rem ---- rechteck ----
880 a=y2:y2=y1:gosub820:y2=a
890 a=x2:x2=x1:gosub820:x2=a
900 a=y1:y1=y2:gosub820:y1=a
910 a=x1:x1=x2:gosub820:x1=a:return
920 rem ---- kreis ----
930 xe=int(r/sqr(2)+.5)
940 forkx=0toxe:ky=int(sqr(r*r-kx*kx)+.5)
950 gosub970:kx=-kx:gosub970:ky=-ky
960 gosub970:kx=-kx:gosub970:next:return
970 x=xm+kx:y=ym+ky:gosub760
980 x=xm+ky:y=ym+kx:goto760
990 rem ---- cursor setzen ----
1000 zz=40*(yand248)+(xand504)+ga:return
1010 xm=160:ym=100:r=50:gosub930
1020 gosub1000
1030 poke56334,peek(56334)and254
1040 poke1,peek(1)and251
1050 forj=1tolen(tx$)
1060 iffa=1thensys912,(zz-ga)/8+va,16*vf+hf
1070 printchr$(19)mid$(tx$,j,1);
1080 ad=peek(1024)*8+1024*gz+53248
1090 fori=0to7:sys912,zz+i,peek(ad+i)
1100 next:zz=zz+8:next
1110 poke1,peek(1)or4
1115 poke56334,peek(56334)or1:return
1120 rem ====================
1130 rem hauptprogramm
1140 rem ====================
1150 gosub530:gosub560:gosub430
1160 x=80:y=8
1170 tx$="g r a f i k d e m o":gosub1020
1180 x=40:y=32:tx$="die farbe kann global fuer den":gosub1020
1190 y=40:tx$="gesamten bildschirm festgelegt":gosub1020
1200 y=48:tx$="werden":gosub1020
1210 y=64:x=40:tx$="hintergrundfarbe hf":gosub1020
1220 forhf=15to0step-1:gosub530:foraa=0to500:next:next:hf=0
1230 y=72:tx$="vordergrundfarbe vf":gosub1020
1240 forvf=0to15:gosub530:foraa=0to500:next:next:vf=1:gosub530
1250 y=88:tx$="aber auch fuer einzelne zeichen":gosub1020
1260 y=96:tx$="gibt es eigene farben, im":gosub1020
1270 y=104:tx$="grafikmodus gar eine eigene":gosub1020
1280 y=112:tx$="hintergrundfarbe":gosub1020
1290 tx$="[209]":fa=1:x=32:y=128:gosub1000
1300 forhf=0to15:vf=15-hf:gosub1030:zz=zz+8:next
1310 y=144:tx$="weiter mit taste":hf=0:vf=7:gosub1020:gosub9000
1320 vf=1:fa=0:gosub530:gosub560
1330 x=0:y=8:tx$="soeben sahen sie schnelles":gosub1020
1340 y=16:tx$="bildschirmloeschen":gosub1020
1350 y=32:x=0:tx$="waehrend im textmodus nur jeweils ein ":gosub1020
1360 tx$="einziger zeichensatz auf dem bildschirm ":gosub1030
1370 tx$="verwendung finden kann, gibt es im ":gosub1030
1380 tx$="grafik-modus keinerlei einschraenkungen.":gosub1030
1390 y=80:tx$="gross/grafik: zxasqw/[218][216][193][211][209][215]":gosub1020
1400 y=88:tx$="invers : ":gosub1020:tx$="zxasqw/[218][216][193][211][209][215]":gz=1:gosub1030
1410 gz=0:y=96:tx$="klein/gross : ":gosub1020:tx$="zxasqw/[218][216][193][211][209][215]":gz=2:gosub1030
1420 gz=0:y=104:tx$="invers : ":gosub1020:tx$="zxasqw/[218][216][193][211][209][215]":gz=3:gosub1030
1430 gz=2:vf=7:fa=1:y=120:tx$="[215]eiter mit [212]aste":gosub1020:gosub9000
1440 fa=0:vf=1:gosub530:gosub560
1450 y=8:tx$="[197]ine [199]rafik besteht natuerlich nicht nur":gosub1020
1460 tx$="aus [194]uchstaben. [197]s gibt:":gosub1030
1470 x=16:y=40:tx$="[208]unkte":gosub1020
1480 foraa=0to40
1490 x=int(rnd(1)*40):y=int(rnd(2)*40)
1500 x=20+x:y=68+y:gosub760:next
1510 x=96:y=40:tx$="[204]inien":gosub1020
1520 x1=120:y1=68:x2=x1:y2=108:gosub820
1530 x1=100:x2=140:y1=88:y2=y1:gosub820
1540 y1=108:y2=68:gosub820
1550 y1=68:y2=108:gosub820
1560 x=160:y=40:tx$="[210]echtecke":gosub1020
1570 x1=180:y1=68:x2=220:y2=108
1580 forj=1to4:gosub880:x1=x1+5:y1=y1+5:x2=x2-5:y2=y2-5:next
1590 x=260:y=40:tx$="[203]reise":gosub1020
1600 xm=280:ym=88:forr=5to20step5
1610 gosub930:next
1620 fa=1:vf=7:x=20:y=150:tx$="[215]eiter mit [212]aste":gosub1020
1630 gosub9000:vf=1:fa=0:gosub530:gosub560
1640 x=0:y=8:tx$="[205]it der [208]unkt-[198]unktion lassen sich auch ":gosub1020
1650 tx$="beliebige [198]iguren erzeugen.":gosub1030
1660 x=100:y=32:tx$="[211]inusfunktion":gosub1020
1670 x1=2:y1=60:x2=2:y2=160:gosub820
1680 y=110:ad=39*(yand248)+y+ga
1690 fori=adtoad+312step8
1700 sys912,i,255:next
1710 forkx=0to315:ky=sin(kx/50)
1720 x=2+kx:y=110-int(50*ky+.5):gosub760:next
1730 x=0:y=180:tx$="[215]eiter mit [212]aste":gosub1020:gosub9000:vf=0
1731 gosub1740:goto1830
1735 rem ---- abblendung ----
1740 a=16*vf+hf:lo=va:lu=va+24*40
1750 ro=va+39:ru=lu+39
1760 forj=1to12:fori=lotoro:sys912,i,a
1770 next:fori=ro+40torustep40:sys912,i,a
1780 next:fori=ru-1tolustep-1:sys912,i,a
1790 next:fori=lu-40tolo+40step-40:sys912,i,a
1800 next:lo=lo+41:ro=ro+39:lu=lu-39
1810 ru=ru-41:next
1820 fori=lotoro:sys912,i,a:next:return
1821 rem --------------------
1830 tx$=" ":gosub1020
1831 printchr$(147)"":gosub480:printchr$(14);
1835 printchr$(147)"":gosub480:printchr$(14);
1840 print"[193]uf- und [193]bblendungen sind moeglich":print:print"[215]eiter mit [212]aste"
1850 gosub9000:gosub430:vf=1
1851 gosub1860:goto1950
1855 rem ---- aufblendung ----
1860 a=16*vf+hf:lo=va+12*41:lu=lo
1870 ro=va+13*39:ru=ro
1880 fori=rotolostep-1:sys912,i,a:next
1890 forj=1to12:lo=lo-41:ro=ro-39
1900 lu=lu+39:ru=ru+41
1910 fori=lo+1toro:sys912,i,a:next
1920 fori=ro+40torustep40:sys912,i,a:next
1930 fori=ru-1tolustep-1:sys912,i,a:next
1940 fori=lu-40tolostep-40:sys912,i,a:next:next:return
1945 rem ---------------------
1950 vb=1:gosub180:poke56,vh:clr
1960 vb=1:gb=8:vr=7:gosub180
1970 vf=0:gosub530
1980 fi$="hires-bild 1":gosub590
1990 vb=3:gosub180:gosub1740
2000 vb=1:gosub180:vf=1
2010 gosub430:gosub1860
2020 vb=3:gosub180:vf=0:gosub530
2030 fi$="hires-bild 2":gosub590
2031 vb=1:gosub180:gosub1740
2040 vb=3:gosub180:gosub430
2050 vf=1:hf=0:gosub1860
2060 x=0:y=199:tx$="[215]eiter mit [212]aste":gz=2:gosub1020:gosub9000
2070 printchr$(147)"";:gosub480
2080 printchr$(14)"[196]urch [215]echseln der [199]rafikbereiche"
2090 print"kann eine richtige [194]ildershow"
2100 print"aufgebaut werden."
2110 end
9000 geta$:ifa$=""then9000
9001 return