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 >
Commodore BASIC  |  2022-10-26  |  4KB  |  124 lines
  1. 10 rem *******************************************************
  2. 20 rem *                                                     *
  3. 30 rem *             h i r e s 4 . b a s                     *
  4. 40 rem *                                                     *
  5. 50 rem *  basicversion eines grafikprogrammes fuer den c64   *
  6. 60 rem *         heimo ponnath  hamburg  1987                *
  7. 70 rem *                                                     *
  8. 80 rem *******************************************************
  9. 90 rem
  10. 100 rem ------- hauptprogramm --------------------------------
  11. 110 printchr$(147)
  12. 120 print:print:print"dieses programm testet alle module":print"von hires4.bas"
  13. 130 zf=5:hf=0:rem zeichen- und hintergrundfarbe
  14. 140 gosub 2000:rem grafik einschalten
  15. 150 gosub 3000:rem bitmap loeschen
  16. 160 gosub 4000:rem farbgebung
  17. 170 l=0:rem loeschmarke auf punkt setzen stellen
  18. 180 for x=0 to 319
  19. 190 :y=50*sin(x/20)+100
  20. 200 :gosub 6000:rem punkte setzen
  21. 210 next x
  22. 220 l=1:rem loeschmarke auf punkt loeschen stellen
  23. 230 for x=100 to 200
  24. 240 :y=50*sin(x/20)+100
  25. 250 :gosub 6000:rem punkte loeschen
  26. 260 next x
  27. 270 gosub 5000:rem textmodus einschalten
  28. 280 print:print"die module 2 bis 6 sind ok"
  29. 290 for i=0 to 1000:next i
  30. 300 gosub 2000:rem grafik wieder einschalten
  31. 310 x1=160:y1=100:r%=90:l=0
  32. 320 for a=0 to 6.28 step .05
  33. 330 :x2=r%*cos(a)+160
  34. 340 :y2=r%*sin(a)+100
  35. 350 :gosub 7000:rem linien zeichnen
  36. 360 next a
  37. 370 gosub 5000:rem textmodus einschalten
  38. 380 print:print"auch das modul 7 arbeitet"
  39. 390 for i=0 to 1000:next i
  40. 400 gosub 2000:rem grafik einschalten
  41. 410 xm=160:ym=100:r=95:l=0
  42. 420 gosub 8000:rem kreis zeichnen
  43. 430 for i=0 to 1000:next i
  44. 440 gosub 5000:rem textmodus
  45. 450 print:print"auch das modul 8 funktioniert."
  46. 460 poke 52,160:poke56,160:rem basiczeiger zurueckstellen
  47. 470 clr
  48. 480 end
  49. 2000 rem ------- modul 2: grafik einschalten -----------------
  50. 2010 poke 56576,198 : rem abschnitt 1 einstellen
  51. 2020 poke 53272,125 : rem bildschirm und bitmapstart festlegen
  52. 2030 poke 648,92    : rem bildschirm an betriebssystem melden
  53. 2040 poke 52,92     : rem basicspeicher begrenzen
  54. 2050 poke 56,92
  55. 2060 poke 53265,peek(53265) or 32:rem bitmapmodus einschalten
  56. 2070 return
  57. 3000 rem ------- modul 3: bitmap loeschen --------------------
  58. 3010 ba=24576 : rem bitmapstartadresse
  59. 3020 for i=ba to ba+7999 : rem die loeschschleife
  60. 3030 :poke i,0
  61. 3040 next i
  62. 3050 return
  63. 4000 rem ------- modul 4: farbgebung -------------------------
  64. 4010 bs=23552 : rem bildschirmstartadresse
  65. 4020 f=16*zf+hf:rem berechnung des farbcodes
  66. 4030 for i=bs to bs+999 : rem die farbschleife
  67. 4040 :poke i,f
  68. 4050 next i
  69. 4060 return
  70. 5000 rem ------- modul 5: textmodus ein ----------------------
  71. 5010 poke 53272,21 : rem alten inhalt restaurieren
  72. 5020 poke 56576,199: rem vic wieder auf abschnitt 0
  73. 5030 poke 648,4 :rem alten bildschirm an betriebssystem melden
  74. 5040 poke 53265,peek(53265) and 223:rem textmodus einschalten
  75. 5050 return
  76. 6000 rem ------- modul 6: punkt setzen/loeschen --------------
  77. 6010 if x<0 or x>319 or y<0 or y>199 then 6060
  78. 6020 by=(x and 504)+40*(y and 248)+(y and 7)
  79. 6030 bi=7 - (x and 7)
  80. 6040 if l=1 then poke by+ba,peek(by+ba) and not (2^bi):goto 6060
  81. 6050 poke by+ba,peek(by+ba) or (2^bi)
  82. 6060 return
  83. 7000 rem ------- modul 7: linien zeichnen/loeschen -----------
  84. 7010 x%=x1:y%=y1:rem alles in integers
  85. 7020 dx%=abs(x2-x1):rem berechnung der differenzen
  86. 7030 dy%=abs(y2-y1)
  87. 7040 s1%=sgn(x2-x1):rem bestimmung der oktanten
  88. 7050 s2%=sgn(y2-y1)
  89. 7060 if dx%<dy% then d%=dx%:dx%=dy%:dy%=d%:t%=1:goto 7080
  90. 7070 t%=0 : rem umdrehen wenn dx < dy und marke setzen
  91. 7080 d%=2*dy% - dx%:rem startwert d(1) ermitteln
  92. 7090 i1%=2*dy% : rem inkremente berechnen
  93. 7100 i2%=2*dx%
  94. 7110 for i=1 to dx% : rem hauptschleife
  95. 7120 :x=x%:y=y%:gosub 6000:rem punkt zeichnen
  96. 7130 :if d%<0 then goto 7170
  97. 7140 :if t%=1 then x%=x%+s1%:goto 7160
  98. 7150 :y%=y%+s2%
  99. 7160 :d%=d%-i2%
  100. 7170 :if t%=1 then y%=y%+s2%:goto 7190
  101. 7180 :x%=x%+s1%
  102. 7190 :d%=d%+i1%
  103. 7200 next i
  104. 7210 return
  105. 8000 rem ------- modul 8: kreis zeichnen/loeschen ------------
  106. 8010 x%=0:y%=r:rem startwerte
  107. 8020 d%=r-1:rem entscheidungsgroesse
  108. 8030 if d%<0 then y%=y%-1:d%=d%+y%+y%
  109. 8040 gosub 8100:rem zeichnen von 8 kreispunkten
  110. 8050 d%=d%-x%-x%-1
  111. 8060 x%=x%+1
  112. 8070 if x%<=y% then 8030
  113. 8080 return
  114. 8100 rem ------- up 8 kreispunkte zeichnen -----------
  115. 8110 x=xm+x%:y=ym+y%:gosub 6000
  116. 8120 x=xm-x%:y=ym+y%:gosub 6000
  117. 8130 x=xm+x%:y=ym-y%:gosub 6000
  118. 8140 x=xm-x%:y=ym-y%:gosub 6000
  119. 8150 x=xm+y%:y=ym+x%:gosub 6000
  120. 8160 x=xm-y%:y=ym+x%:gosub 6000
  121. 8170 x=xm+y%:y=ym-x%:gosub 6000
  122. 8180 x=xm-y%:y=ym-x%:gosub 6000
  123. 8190 return
  124.