home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er Special 20
/
64er_Magazin_Sonderheft_20_19xx_Markt__Technik_de_Side_A.d64
/
hires4.bas
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-10-26
|
4KB
|
124 lines
10 rem *******************************************************
20 rem * *
30 rem * h i r e s 4 . b a s *
40 rem * *
50 rem * basicversion eines grafikprogrammes fuer den c64 *
60 rem * heimo ponnath hamburg 1987 *
70 rem * *
80 rem *******************************************************
90 rem
100 rem ------- hauptprogramm --------------------------------
110 printchr$(147)
120 print:print:print"dieses programm testet alle module":print"von hires4.bas"
130 zf=5:hf=0:rem zeichen- und hintergrundfarbe
140 gosub 2000:rem grafik einschalten
150 gosub 3000:rem bitmap loeschen
160 gosub 4000:rem farbgebung
170 l=0:rem loeschmarke auf punkt setzen stellen
180 for x=0 to 319
190 :y=50*sin(x/20)+100
200 :gosub 6000:rem punkte setzen
210 next x
220 l=1:rem loeschmarke auf punkt loeschen stellen
230 for x=100 to 200
240 :y=50*sin(x/20)+100
250 :gosub 6000:rem punkte loeschen
260 next x
270 gosub 5000:rem textmodus einschalten
280 print:print"die module 2 bis 6 sind ok"
290 for i=0 to 1000:next i
300 gosub 2000:rem grafik wieder einschalten
310 x1=160:y1=100:r%=90:l=0
320 for a=0 to 6.28 step .05
330 :x2=r%*cos(a)+160
340 :y2=r%*sin(a)+100
350 :gosub 7000:rem linien zeichnen
360 next a
370 gosub 5000:rem textmodus einschalten
380 print:print"auch das modul 7 arbeitet"
390 for i=0 to 1000:next i
400 gosub 2000:rem grafik einschalten
410 xm=160:ym=100:r=95:l=0
420 gosub 8000:rem kreis zeichnen
430 for i=0 to 1000:next i
440 gosub 5000:rem textmodus
450 print:print"auch das modul 8 funktioniert."
460 poke 52,160:poke56,160:rem basiczeiger zurueckstellen
470 clr
480 end
2000 rem ------- modul 2: grafik einschalten -----------------
2010 poke 56576,198 : rem abschnitt 1 einstellen
2020 poke 53272,125 : rem bildschirm und bitmapstart festlegen
2030 poke 648,92 : rem bildschirm an betriebssystem melden
2040 poke 52,92 : rem basicspeicher begrenzen
2050 poke 56,92
2060 poke 53265,peek(53265) or 32:rem bitmapmodus einschalten
2070 return
3000 rem ------- modul 3: bitmap loeschen --------------------
3010 ba=24576 : rem bitmapstartadresse
3020 for i=ba to ba+7999 : rem die loeschschleife
3030 :poke i,0
3040 next i
3050 return
4000 rem ------- modul 4: farbgebung -------------------------
4010 bs=23552 : rem bildschirmstartadresse
4020 f=16*zf+hf:rem berechnung des farbcodes
4030 for i=bs to bs+999 : rem die farbschleife
4040 :poke i,f
4050 next i
4060 return
5000 rem ------- modul 5: textmodus ein ----------------------
5010 poke 53272,21 : rem alten inhalt restaurieren
5020 poke 56576,199: rem vic wieder auf abschnitt 0
5030 poke 648,4 :rem alten bildschirm an betriebssystem melden
5040 poke 53265,peek(53265) and 223:rem textmodus einschalten
5050 return
6000 rem ------- modul 6: punkt setzen/loeschen --------------
6010 if x<0 or x>319 or y<0 or y>199 then 6060
6020 by=(x and 504)+40*(y and 248)+(y and 7)
6030 bi=7 - (x and 7)
6040 if l=1 then poke by+ba,peek(by+ba) and not (2^bi):goto 6060
6050 poke by+ba,peek(by+ba) or (2^bi)
6060 return
7000 rem ------- modul 7: linien zeichnen/loeschen -----------
7010 x%=x1:y%=y1:rem alles in integers
7020 dx%=abs(x2-x1):rem berechnung der differenzen
7030 dy%=abs(y2-y1)
7040 s1%=sgn(x2-x1):rem bestimmung der oktanten
7050 s2%=sgn(y2-y1)
7060 if dx%<dy% then d%=dx%:dx%=dy%:dy%=d%:t%=1:goto 7080
7070 t%=0 : rem umdrehen wenn dx < dy und marke setzen
7080 d%=2*dy% - dx%:rem startwert d(1) ermitteln
7090 i1%=2*dy% : rem inkremente berechnen
7100 i2%=2*dx%
7110 for i=1 to dx% : rem hauptschleife
7120 :x=x%:y=y%:gosub 6000:rem punkt zeichnen
7130 :if d%<0 then goto 7170
7140 :if t%=1 then x%=x%+s1%:goto 7160
7150 :y%=y%+s2%
7160 :d%=d%-i2%
7170 :if t%=1 then y%=y%+s2%:goto 7190
7180 :x%=x%+s1%
7190 :d%=d%+i1%
7200 next i
7210 return
8000 rem ------- modul 8: kreis zeichnen/loeschen ------------
8010 x%=0:y%=r:rem startwerte
8020 d%=r-1:rem entscheidungsgroesse
8030 if d%<0 then y%=y%-1:d%=d%+y%+y%
8040 gosub 8100:rem zeichnen von 8 kreispunkten
8050 d%=d%-x%-x%-1
8060 x%=x%+1
8070 if x%<=y% then 8030
8080 return
8100 rem ------- up 8 kreispunkte zeichnen -----------
8110 x=xm+x%:y=ym+y%:gosub 6000
8120 x=xm-x%:y=ym+y%:gosub 6000
8130 x=xm+x%:y=ym-y%:gosub 6000
8140 x=xm-x%:y=ym-y%:gosub 6000
8150 x=xm+y%:y=ym+x%:gosub 6000
8160 x=xm-y%:y=ym+x%:gosub 6000
8170 x=xm+y%:y=ym-x%:gosub 6000
8180 x=xm-y%:y=ym-x%:gosub 6000
8190 return