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 >
Wrap
Commodore BASIC
|
2022-10-26
|
5KB
|
194 lines
10 ifpeek(49152)=32 and peek(49153)=84then210
20 load"grconv.code.obj",8,1
30 rem ********************************
40 rem * *
50 rem * vizawrite-grafik-converter *
60 rem * *
70 rem * (c) 1986 markt&technik verlag*
80 rem * *
90 rem * written by *
100 rem* *
110 rem* ralf lenz *
120 rem* *
130 rem* am landgraben 12 *
140 rem* *
150 rem* 4290 bocholt-barlo *
160 rem* *
170 rem* *
180 rem* *
190 rem********************************
200 :
210 vic=53248:rem startadresse vic-chip
220 laden = 12*4096:rem bild laden
230 hires= laden+20:rem umschalten auf hires
240 lres= laden+53:rem umschalten auf lores
250 lcol= laden+65:rem farbe textbildschirm
260 colr= laden+76 :rem farbe hires
270 invert= laden+103:rem bild invertieren
280 speichern= laden+127:rem bild speichern
290 cnvert= laden+276:rem bild convertieren
300 setsprite= laden+349:rem sprites initialisieren
310 down= laden+436:rem sprites nach untenbewegen
320 up=laden+453:rem sprites nach oben bewegen
330 :
340 sys lcol:printchr$(14):rem farbe setzen und umschalten auf kleinschrift
350 printchr$(30):rem schriftfarbe blau
360 print"[147]****************************************"
370 print" [160][160] [214]izawrite-[199]rafik-[195]onverter"
380 print" (c) 1986 [205]arkt&[212]echnik [214]erlag"
390 print" by
400 [153]" (NULL)alf (NULL)enz
410 print" [193]m [204]andgraben 12
420 [153]" 4290 peekocholt-peekarlo
430 print
440 print"****************************************"
450 name$=""
460 print"[206]ame des [194]ildes ('$' fuer [196]irectory): ";
470 inputname$:ifname$=""then340
480 ifname$="$"thengosub1650:goto340
490 print"[204]egen [211]ie die [196]iskette mit dem [194]ild ins [204]aufwerk und druecken [211]ie ";
500 print"[210][197][212][213][210][206][146]"
510 gosub980
520 sys laden,name$:rem bild nach $2000 laden
530 gosub1080
540 ifa=0then590
550 print"[196]isk [198]ehler![146] ";
560 print"[196]ruecken [211]ie [210][197][212][213][210][206][146]";
570 gosub 980
580 goto340
590 gosub1010
600 print"1[146] [194]ild ansehen"
610 print"2[146] [199]anzes [194]ild convertieren"
620 print"3[146] [193]usschnitt convertieren"
630 print"4[146] [206]eues [194]ild laden"
640 print"5[146] [196]isc-[194]efehl senden"
650 print"6[146] [196]irectory"
660 print"7[146] [208]rogrammende"
670 print"[201]hre [215]ahl (1-7) ? ";
680 geta$:ifa$<"1" or a$>"7"then 680
690 printa$:on val(a$) gosub 1160,1230,1290
700 if a$="4"then340
710 if a$="5"thengosub1910:goto590
720 if a$="6"thengosub1680:goto590
730 if a$="7"thenprint"[147]";:end
740 iff3then 760:rem flag fuer ende des convertierens
750 goto590
760 syslres:pokevic+21,0:rem sprites aus
770 gosub1010
780 name$=""
790 print"[213]nter welchem [206]amen soll das [194]ild"
800 print"gespeichert werden?"
810 input"";name$:ifname$=""then900
820 name$="vg."+na$+",s,w"
830 print"[204]egen [211]ie die [196]iskette, auf die das [194]ildgespeichert werden soll ";
840 print"ins [204]aufwerk und";
850 print"druecken [211]ie [210][197][212][213][210][206][146]"
860 gosub980
870 sys speichern,name$,oben,unten
880 gosub1080:ifa<>0then770
890 gosub1010
900 print"[215]ollen [211]ie noch ein [194]ild convertieren?"
910 print"[198]alls ja, druecken [211]ie [210][197][212][213][210][206][146]"
920 geta$:ifa$=""then920
930 ifa$=chr$(13)thenrun210
940 print"[147]":end
950 :
960 rem wartet auf returntaste
970 :
980 geta$:ifa$<>chr$(13)then 980
990 return
1000 :
1010 print"[147]****************************************"
1020 print" [160][160] [214]izawrite-[199]rafik-[195]onverter "
1030 print"****************************************"
1040 return
1050 :
1060 rem fehlerkanal abfragen
1070 :
1080 open15,8,15:input#15,a,b$,c,d:print:printb$:close15:return
1090 :
1100 print"[218]um [193]usfuehren druecken [211]ie [210][197][212][213][210][206][146]"
1110 print"[210]ueckkehr zum [205]enue mit [210][197][212][213][210][206][146]"
1120 gosub 980:return
1130 :
1140 rem bild ansehen
1150 :
1160 gosub1100:syscolr,1:syshires
1170 geta$:ifa$="i"then sys invert
1180 ifa$=chr$(13)then syslres :return
1190 goto1170
1200 :
1210 rem ganzes bild convertieren
1220 :
1230 f3=-1:syscolr,1:sys hires:sys cnvert:sys lres
1240 oben=8192:unten=8192+8000
1250 return
1260 :
1270 rem ausschnitt convertieren
1280 :
1290 print"[147][194]ewegen [211]ie den [218]eiger mit den [195]ursor- [212]asten auf und ab"
1300 print"[218]uerst legen [211]ie die obere [199]renze fest. [215]enn [211]ie die gewuenschte [218]eile"
1310 print"erreicht haben, druecken [211]ie die [210]eturn-[212]aste. [193]nalog verfahren [211]ie mit"
1320 print"der unteren [199]renze."
1330 print"[200][207][205][197][146] bringt den [218]eiger nach oben und"
1340 print"[201][146] invertiert die [199]rafik"
1350 print"[218]um [211]tart druecken [211]ie [210][197][212][213][210][206][146]":gosub 980
1360 syshires:syscolr,1:sys setsprite
1370 geta$:ifa$=""then 1370
1380 ifa$=chr$(13)thengosub1470 :iff3thenreturn
1390 ifa$=""then sys down
1400 ifa$="[145]"then sys up
1410 ifa$="i"then sys invert:fori=1to200:next
1420 ifa$=""thenfori=vic+1 to vic+14step2:pokei,50:next
1430 goto 1370
1440 :
1450 rem obere grenze berechnen
1460 :
1470 iff2then1580 :rem untere grenze
1480 f2=-1
1490 oz=int((peek(vic+1)-50)/8):rem bildschirmzeilennummer des sprites
1500 ifoz=0then1520 :rem sprite ist ganz oben
1510 fori=1024to1023+oz*40:pokei,0:next:rem im farbram loeschen
1520 oben=8192+oz*320
1530 fori=vic+1 to vic+14step2:pokei,242:next:rem alle sprites nach unten
1540 return
1550 :
1560 rem untere grenze berechnen
1570 :
1580 uz=int((peek(vic+1)-50)/8):rem bildschrimzeilennummer des sprites
1590 ifuz=250then 1610 :rem sprite ist ganz unten
1600 fori=1024+uz*40to 2023:pokei,0:next:rem im farbram loeschen
1610 unten=8192+uz*320
1620 f3=-1:fori=1to800:next
1630 syscnvert
1640 return
1650 :
1660 rem inhaltsverzeichnis anzeigen
1670 :
1680 print"[147]";
1690 open1,8,0,"$0"
1700 get#1,u$,v$
1710 get#1,u$,v$
1720 get#1,u$,v$
1730 bl=0
1740 ifu$<>""thenbl=asc(u$)
1750 ifv$<>""thenbl=bl+asc(v$)*256
1760 printmid$(str$(bl),2);tab(4);
1770 get#1,v$:ifst<>0then1890
1780 ifv$<>chr$(34)then1770
1790 get#1,v$:ifv$<>chr$(34)thenprintv$;:goto1790
1800 get#1,v$:ifv$=chr$(32)then1800
1810 ifv$=chr$(42)thenv$="[157]*"
1820 printtab(22);:w$=""
1830 w$=w$+v$:get#1,v$:ifv$<>""then1830
1840 printleft$(w$,5)
1850 getx$
1860 ifx$="_"thenclose1:return
1870 ifx$=" "thenpoke198,0:wait198,1:poke198,0
1880 ifst=0then1710
1890 print"blocks free"
1900 close1:poke198,0:wait198,1:poke198,0:return
1910 open15,8,15:print"[194]efehl: ";:poke631,34:poke198,1:inputdb$
1920 print#15,db$:close15:gosub1080
1930 poke198,0:wait198,1:poke198,0:return