home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1986 October / 64er_Magazin_86-10_1986_Markt__Technik_de_Side_B.d64 / vg-converter (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  5KB  |  194 lines
  1. 10 ifpeek(49152)=32 and peek(49153)=84then210
  2. 20 load"grconv.code.obj",8,1
  3. 30 rem ********************************
  4. 40 rem *                              *
  5. 50 rem * vizawrite-grafik-converter   *
  6. 60 rem *                              *
  7. 70 rem * (c) 1986 markt&technik verlag*
  8. 80 rem *                              *
  9. 90 rem *       written by             *
  10. 100 rem*                              *
  11. 110 rem*        ralf lenz             *
  12. 120 rem*                              *
  13. 130 rem*     am landgraben 12         *
  14. 140 rem*                              *
  15. 150 rem*    4290 bocholt-barlo        *
  16. 160 rem*                              *
  17. 170 rem*                              *
  18. 180 rem*                              *
  19. 190 rem********************************
  20. 200 :
  21. 210 vic=53248:rem startadresse vic-chip
  22. 220 laden = 12*4096:rem bild laden
  23. 230 hires= laden+20:rem umschalten auf hires
  24. 240 lres= laden+53:rem umschalten auf lores
  25. 250 lcol= laden+65:rem farbe textbildschirm
  26. 260 colr= laden+76 :rem farbe hires
  27. 270 invert= laden+103:rem bild invertieren
  28. 280 speichern= laden+127:rem bild speichern
  29. 290 cnvert= laden+276:rem bild convertieren
  30. 300 setsprite= laden+349:rem sprites initialisieren
  31. 310 down= laden+436:rem sprites nach untenbewegen
  32. 320 up=laden+453:rem sprites nach oben bewegen
  33. 330 :
  34. 340 sys lcol:printchr$(14):rem farbe setzen und umschalten auf kleinschrift
  35. 350 printchr$(30):rem schriftfarbe blau
  36. 360 print"[147]****************************************"
  37. 370 print" [160][160]     [214]izawrite-[199]rafik-[195]onverter"
  38. 380 print"      (c) 1986 [205]arkt&[212]echnik [214]erlag"
  39. 390 print"                  by
  40. 400 [153]"               (NULL)alf (NULL)enz
  41. 410 print"            [193]m [204]andgraben 12
  42. 420 [153]"           4290 peekocholt-peekarlo
  43. 430 print
  44. 440 print"****************************************"
  45. 450 name$=""
  46. 460 print"[206]ame des [194]ildes ('$' fuer [196]irectory): ";
  47. 470 inputname$:ifname$=""then340
  48. 480 ifname$="$"thengosub1650:goto340
  49. 490 print"[204]egen [211]ie die [196]iskette mit dem [194]ild ins [204]aufwerk und druecken [211]ie ";
  50. 500 print"[210][197][212][213][210][206][146]"
  51. 510 gosub980
  52. 520 sys laden,name$:rem bild nach $2000 laden
  53. 530 gosub1080
  54. 540 ifa=0then590
  55. 550 print"[196]isk [198]ehler![146] ";
  56. 560 print"[196]ruecken [211]ie [210][197][212][213][210][206][146]";
  57. 570 gosub 980
  58. 580 goto340
  59. 590 gosub1010
  60. 600 print"1[146] [194]ild ansehen"
  61. 610 print"2[146] [199]anzes [194]ild convertieren"
  62. 620 print"3[146] [193]usschnitt convertieren"
  63. 630 print"4[146] [206]eues [194]ild laden"
  64. 640 print"5[146] [196]isc-[194]efehl senden"
  65. 650 print"6[146] [196]irectory"
  66. 660 print"7[146] [208]rogrammende"
  67. 670 print"[201]hre [215]ahl (1-7) ? ";
  68. 680 geta$:ifa$<"1" or a$>"7"then 680
  69. 690 printa$:on val(a$) gosub 1160,1230,1290
  70. 700 if a$="4"then340
  71. 710 if a$="5"thengosub1910:goto590
  72. 720 if a$="6"thengosub1680:goto590
  73. 730 if a$="7"thenprint"[147]";:end
  74. 740 iff3then 760:rem flag fuer ende des convertierens
  75. 750 goto590
  76. 760 syslres:pokevic+21,0:rem sprites aus
  77. 770 gosub1010
  78. 780 name$=""
  79. 790 print"[213]nter welchem [206]amen soll das [194]ild"
  80. 800 print"gespeichert werden?"
  81. 810 input"";name$:ifname$=""then900
  82. 820 name$="vg."+na$+",s,w"
  83. 830 print"[204]egen [211]ie die [196]iskette, auf die das [194]ildgespeichert werden soll ";
  84. 840 print"ins [204]aufwerk und";
  85. 850 print"druecken [211]ie [210][197][212][213][210][206][146]"
  86. 860 gosub980
  87. 870 sys speichern,name$,oben,unten
  88. 880 gosub1080:ifa<>0then770
  89. 890 gosub1010
  90. 900 print"[215]ollen [211]ie noch ein [194]ild convertieren?"
  91. 910 print"[198]alls ja, druecken [211]ie [210][197][212][213][210][206][146]"
  92. 920 geta$:ifa$=""then920
  93. 930 ifa$=chr$(13)thenrun210
  94. 940 print"[147]":end
  95. 950 :
  96. 960 rem wartet auf returntaste
  97. 970 :
  98. 980 geta$:ifa$<>chr$(13)then 980
  99. 990 return
  100. 1000 :
  101. 1010 print"[147]****************************************"
  102. 1020 print" [160][160]     [214]izawrite-[199]rafik-[195]onverter      "
  103. 1030 print"****************************************"
  104. 1040 return
  105. 1050 :
  106. 1060 rem fehlerkanal abfragen
  107. 1070 :
  108. 1080 open15,8,15:input#15,a,b$,c,d:print:printb$:close15:return
  109. 1090 :
  110. 1100 print"[218]um [193]usfuehren druecken [211]ie [210][197][212][213][210][206][146]"
  111. 1110 print"[210]ueckkehr zum [205]enue mit [210][197][212][213][210][206][146]"
  112. 1120 gosub 980:return
  113. 1130 :
  114. 1140 rem bild ansehen
  115. 1150 :
  116. 1160 gosub1100:syscolr,1:syshires
  117. 1170 geta$:ifa$="i"then sys invert
  118. 1180 ifa$=chr$(13)then syslres :return
  119. 1190 goto1170
  120. 1200 :
  121. 1210 rem ganzes bild convertieren
  122. 1220 :
  123. 1230 f3=-1:syscolr,1:sys hires:sys cnvert:sys lres
  124. 1240 oben=8192:unten=8192+8000
  125. 1250 return
  126. 1260 :
  127. 1270 rem ausschnitt convertieren
  128. 1280 :
  129. 1290 print"[147][194]ewegen [211]ie den [218]eiger mit den [195]ursor-  [212]asten auf und ab"
  130. 1300 print"[218]uerst legen [211]ie die obere [199]renze fest. [215]enn [211]ie die gewuenschte [218]eile"
  131. 1310 print"erreicht haben, druecken [211]ie die [210]eturn-[212]aste. [193]nalog verfahren [211]ie mit"
  132. 1320 print"der unteren [199]renze."
  133. 1330 print"[200][207][205][197][146] bringt den [218]eiger nach oben und"
  134. 1340 print"[201][146] invertiert die [199]rafik"
  135. 1350 print"[218]um [211]tart druecken [211]ie [210][197][212][213][210][206][146]":gosub 980
  136. 1360 syshires:syscolr,1:sys setsprite
  137. 1370 geta$:ifa$=""then 1370
  138. 1380 ifa$=chr$(13)thengosub1470 :iff3thenreturn
  139. 1390 ifa$=""then sys down
  140. 1400 ifa$="[145]"then sys up
  141. 1410 ifa$="i"then sys invert:fori=1to200:next
  142. 1420 ifa$=""thenfori=vic+1 to vic+14step2:pokei,50:next
  143. 1430 goto 1370
  144. 1440 :
  145. 1450 rem obere grenze berechnen
  146. 1460 :
  147. 1470 iff2then1580 :rem untere grenze
  148. 1480 f2=-1
  149. 1490 oz=int((peek(vic+1)-50)/8):rem bildschirmzeilennummer des sprites
  150. 1500 ifoz=0then1520 :rem sprite ist ganz oben
  151. 1510 fori=1024to1023+oz*40:pokei,0:next:rem im farbram loeschen
  152. 1520 oben=8192+oz*320
  153. 1530 fori=vic+1 to vic+14step2:pokei,242:next:rem alle sprites nach unten
  154. 1540 return
  155. 1550 :
  156. 1560 rem untere grenze berechnen
  157. 1570 :
  158. 1580 uz=int((peek(vic+1)-50)/8):rem bildschrimzeilennummer des sprites
  159. 1590 ifuz=250then 1610 :rem sprite ist ganz unten
  160. 1600 fori=1024+uz*40to 2023:pokei,0:next:rem im farbram loeschen
  161. 1610 unten=8192+uz*320
  162. 1620 f3=-1:fori=1to800:next
  163. 1630 syscnvert
  164. 1640 return
  165. 1650 :
  166. 1660 rem inhaltsverzeichnis anzeigen
  167. 1670 :
  168. 1680 print"[147]";
  169. 1690 open1,8,0,"$0"
  170. 1700 get#1,u$,v$
  171. 1710 get#1,u$,v$
  172. 1720 get#1,u$,v$
  173. 1730 bl=0
  174. 1740 ifu$<>""thenbl=asc(u$)
  175. 1750 ifv$<>""thenbl=bl+asc(v$)*256
  176. 1760 printmid$(str$(bl),2);tab(4);
  177. 1770 get#1,v$:ifst<>0then1890
  178. 1780 ifv$<>chr$(34)then1770
  179. 1790 get#1,v$:ifv$<>chr$(34)thenprintv$;:goto1790
  180. 1800 get#1,v$:ifv$=chr$(32)then1800
  181. 1810 ifv$=chr$(42)thenv$="[157]*"
  182. 1820 printtab(22);:w$=""
  183. 1830 w$=w$+v$:get#1,v$:ifv$<>""then1830
  184. 1840 printleft$(w$,5)
  185. 1850 getx$
  186. 1860 ifx$="_"thenclose1:return
  187. 1870 ifx$=" "thenpoke198,0:wait198,1:poke198,0
  188. 1880 ifst=0then1710
  189. 1890 print"blocks free"
  190. 1900 close1:poke198,0:wait198,1:poke198,0:return
  191. 1910 open15,8,15:print"[194]efehl: ";:poke631,34:poke198,1:inputdb$
  192. 1920 print#15,db$:close15:gosub1080
  193. 1930 poke198,0:wait198,1:poke198,0:return
  194.