home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Pack
/
Power_Pack_3_1992_Alfons_Mittelmeyer_de.d64
/
hires-druck
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2023-02-26
|
7KB
|
241 lines
10 rem hires-druck =================c64
20 rem written by a. mittelmeyer
30 rem ================================
100 poke56,153:clr
130 vb=3
140 gb=8
150 vr=7
151 rem -------------------------------
155 vf=1
160 gosub180:gosub200:gosub230: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
230 fori=49244to49293
231 reada:pokei,a:next:return
232 data 120,072,165,001,041,252,133
233 data 001,104,096,072,165,001,009
234 data 007,133,001,104,088,096,169
235 data 224,133,252,160,000,132,251
236 data 162,032,032,092,192,177,251
237 data 073,255,145,251,200,208,247
238 data 230,252,202,208,242,076,102
239 data 192
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 gosub565:sys848:return
565 poke780,0:poke781,32
570 poke251,0:poke252,gh:return
571 rem ---- grafik invertieren ----
572 gosub565:sysxxx:return
580 rem ---- grafik laden ----
590 open8,8,8,fi$: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 poke53281,0:printchr$(147)chr$(14)chr$(5)
1151 printspc(11)"[195][207][205][205][207][196][207][210][197] [196][201][211][195]"
1155 printspc(12)"[200]i[210]es-[196]ruck"
1160 printspc(12)"-----------"
1165 printspc(5)"[176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
1170 printspc(5)"[221] [199]rafik laden [221]"
1171 printspc(5)"[221] [199]rafik laden ([198]arbe) [221]"
1172 printspc(5)"[221] [199]rafik sehen [221]"
1173 printspc(5)"[221] [199]rafik invertieren [221]"
1174 printspc(5)"[221] [212]reiber laden [221]"
1175 printspc(5)"[221] [196]rucken ("left$(tr$+") ",7)" [221]"
1176 printspc(5)"[221] [196]irectory [221]"
1177 printspc(5)"[221] [196]irectory [215]ildcard [221]"
1178 printspc(5)"[221] [212]reiber aendern [221]"
1179 printspc(5)"[221] [212]reiber speichern [221]"
1180 printspc(5)"[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
1200 poke1391+mp*40,62
1201 geta$:ifa$=""then1200
1202 poke1391+mp*40,32
1203 ifa$=""andmp<9thenmp=mp+1:goto1200
1204 ifa$="[145]"andmp>0thenmp=mp-1:goto1200
1205 ifa$<>chr$(13)then1200
1210 onmp+1goto1300,1350,1900,1890,1410,1950,1600,1800,2000,2010
1220 end
1300 fg=0
1305 vf=0:hf=1
1306 print:print"? "chr$(34)gr$chr$(34);
1307 wait198,1:ifpeek(631)=13then1310
1308 poke211,2:print" ";
1310 poke211,0:inputgr$:fi$=gr$
1312 gosub530:gosub560:gosub430
1315 gosub590:gosub530
1320 geta$:ifa$=""then1320
1330 gosub480:goto1150
1350 fg=1:goto1305
1400 gosub430:gosub571:goto1320
1410 printchr$(147)spc(13)"[212]reiber laden"
1419 print" [176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
1420 print" [221] c1.1","[221] ie0.1 [221]"
1421 print" [221] c1.2","[221] ie0.1r [221]"
1422 print" [221] c1.3","[221] ie0.2 [221]"
1423 print" [221] c2.2","[221] ie0.2r [221]"
1424 print" [221] c2.3","[221] ie2.1 [221]"
1425 print" [221] c3.1","[221] ie2.1r [221]"
1426 print" [221] c3.2","[221] ie2.2 [221]"
1427 print" [221] c3.2r","[221] ie2.2r [221]"
1428 print" [221] e1.1r","[221] ie2.3 [221]"
1429 print" [221] e2.1","[221] ie2.3r [221]"
1430 print" [221] e2.1r","[221] ie2.4 [221]"
1431 print" [221] e2.2","[221] ie2.4r [221]"
1432 print" [221] e2.2r","[221] ie3.1 [221]"
1433 print" [221] e3.1r","[221] ie3.2 [221]"
1434 print" [221] ie1.1","[221] ie3.2r [221]"
1435 print" [221] ie1.2","[221] ie3.3r [221]"
1436 print" [221] ie1.3","[221] ie3.4r [221]"
1437 print" [173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
1440 x=0:y=0
1441 poke1191+40*y+17*x,62
1450 geta$:ifa$=""then1450
1451 poke1191+40*y+17*x,32
1460 ifa$=""andy<16theny=y+1:goto1441
1461 ifa$="[145]"andy>0theny=y-1:goto1441
1462 ifa$=""ora$="[157]"thenx=(x+1)and1:goto1441
1463 ifa$=" "then1150
1470 ifa$<>chr$(13)then1441
1480 a=1193+40*y+17*x:fori=0to5:poke1913+i,peek(a+i):next
1490 poke198,1:poke631,13:inputtr$
1491 open8,8,8,tr$:poke781,8
1492 sys65478:geta$:geta$:poke251,0
1493 poke252,153:poke781,1:sys865
1494 sys65484:close8:goto1150
1600 printchr$(147);
1601 open8,8,0,"$":gosub1610
1605 ifnotffthengosub1820
1606 goto1150
1610 ff=0:i=0:get#8,a$:get#8,a$:goto1650
1620 get#8,a$
1630 ifa$=""thena$=chr$(0)
1640 return
1650 get#8,a$
1660 ifa$=""then1730
1670 get#8,a$
1680 gosub1620:al=asc(a$):gosub1620
1690 print256*asc(a$)+al;
1700 get#8,a$
1710 ifa$<>""thenprinta$;:goto1700
1720 print:i=i+1:ifi<>25then1650
1721 gosub1820:ifffthen1730
1722 i=1:goto1650
1730 close8:return
1800 print:input"[211]uchbegriff";fi$:printchr$(147);
1810 open8,8,0,"$"+fi$:gosub1610:goto1605
1820 x=0
1822 a=peek(1028+40*x):poke1028+40*x,62
1825 geta$:ifa$=""then1825
1826 poke1028+40*x,a
1830 ifa$=""andx<>23thenx=x+1:goto1822
1840 ifa$="[145]"andx<>0thenx=x-1:goto1822
1850 ifa$=" "thenreturn
1860 ifa$<>chr$(13)then1822
1861 ad=1029+40*x
1870 fori=1to18:poke1989+i,peek(ad+i):next
1871 poke211,0:poke214,24:sys58732
1880 poke198,1:poke631,13:inputgr$:ff=-1:return
1890 sys49264
1900 gosub430
1910 geta$:ifa$=""then1910
1920 gosub480:printchr$(14);:goto1200
1950 gosub430:sys39168:goto1920
2000 o=0:a=0:print:input"[207]ffset,[194]yte";o,a
2001 ifo or athenpoke39168+(oand255),a
2002 goto1150
2010 print:input"[212]reibername";fi$
2011 open8,8,8,fi$+",p,w":poke781,8:sys65481:printchr$(0);:poke251,0
2012 printchr$(153);:poke252,153:poke781,1:sys890:gosub640:goto1150
2020 rem =ende==hires-druck========