20 ! +---------------------------------------------+ 30 ! ! PICTRA Ver 1.3 - Bildtransformationer ! 40 ! ! F|r ABC800M, 802 och 806, ej ABC800C ! 50 ! ! Av Kristoffer Eriksson, ABC-klubben <5357> ! 60 ! ! Fri kopiering f|r ickekommersiella syften ! 70 ! +---------------------------------------------+ 80 ! Ver 1.0 85-12-25 <5357> Kristoffer Eriksson. 90 ! Ver 1.3 86-02-03 <5357> YEL som gav bildfel p} 800 & 802 flyttad 100 ! 110 INTEGER : EXTEND 120 DIM Crt$=0,A$=1920 130 POKE VAROOT(Crt$),1920,SWAP%(1920),0,SWAP%(30720),1920,SWAP%(1920) 140 Z=FNMunchinit 150 Abc=800 : IF PEEK(39)=4 THEN Abc=806 ELSE IF PEEK(39)=3 THEN Abc=802 160 Ftkn=127 : IF Abc=806 THEN Ftkn=128+31 ! 806: Fylld graf 170 ! IF Abc=802 THEN Ftkn=128+31 ! Snyggare om man har normalt teckenprom 180 ! 190 ! ____Ram___ 200 ! F|ljande grafiksatser har ingen betydelse f|r programmets funktion: 210 ON ERROR GOTO 300 220 IF Abc=806 THEN 270 230 FGCTL 1 240 FGPOINT 239,239,0 : FGFILL 0,0,0 250 FGPOINT 0,0,1 : FGLINE 239,0 : FGLINE 239,239 : FGLINE 0,239 : FGLINE 0,0 260 GOTO 300 270 FGCTL BLU+GYEL 280 FGPOINT 511,239,0 : FGFILL 0,0,0 290 FGPOINT 15,0,1 : FGLINE 497,0 : FGLINE 497,239 : FGLINE 15,239 : FGLINE 15,0 300 ON ERROR GOTO 310 ! 320 ! ____Anvisningar___ 330 ; CHR$(12); 340 ; "Detta program utf|r transformationer av en startbild som kan ritas upp" 350 ; "p} sk{rmen. N{r man ritar g{ller f|ljande tangenter:" 360 ; 370 ; " (Home) (Upp) (Radstart) RET PF1 (Klart)" 380 ; " Q W (Snabb v{nster) PF3 PF4 (Snabb h|ger)" 390 ; "(V{nster) A S (H|ger) (V{nster) <-- PF5 (Upp)" 400 ; " Z (H|ger) --> PF7 (Ned)" 410 ; " (Ned) CTRL-L (T|m sk{rm) (T|m rad) CE" 420 ; 430 ; "Mellanslag = Blank, \vriga tecken = Fyrkant, SHIFT+PF1 = Avsluta" 440 ; 450 ; 460 ; "N{r man tryckt p} PF1 b|rjar datorn visa bildtransformationer i snabb" 470 ; "f|ljd. I det l{get g{ller f|ljande tangenter:" 480 ; 490 ; " PF1 (]ter till bildritning)" 500 ; "SHIFT+PF1 (Avsluta)" 510 ; " --> (Stega bilderna en och en, n{sta bild)" 520 ; " Blank (Visa i snabb takt / Stega)" 530 ; 540 ; "Transformationerna g|rs s} att f|r varje position i bilden unders|ks "; 550 ; "grannarna." : ; "[r det ett udda antal blir den positionen fylld, "; 560 ; "annars blir den tom. Som" : ; "grannar r{knas endast positionerna "; 570 ; "framf|r, bakom, rakt upp och rakt ned." : ; "Dessutom {r bilden "; 580 ; '"sluten"; efter radens sista position f|ljer radens f|rsta.'; 590 Z=FNLine25("Anvisningar. RETURN=Vidare, SHIFT+PF1=Avsluta.") 600 I$="" : WHILE ASCII(I$)<>13 610 GET I$ 620 IF ASCII(I$)=208 THEN 1210 630 WEND 640 ! 650 ! ____Exempelm|nster___ 660 ; YEL CHR$(12); 670 ; CUR(10,36) ""; 680 ; CUR(11,36) ""; 690 ; CUR(12,36) ""; 700 ; CUR(13,36) ""; 710 ! 720 ! ____Rita m|nster___ 730 R=11 : K=39 740 IF SYS(5) THEN GET I$ : IF ASCII(I$)=192 THEN 1210 750 R$="Rita m|nster. Start=PF1, Avsluta=SHIFT+PF1. " 760 I$="" 770 WHILE ASCII(I$)<>192 780 Z=FNLine25(R$+"("+NUM$(R)+","+NUM$(K)+")") 790 ; CUR(R,K); 800 GET I$ 810 I=INSTR(1," 1ASWZQaswzq",I$)+1 820 ON I GOTO 830,870,860,920,950,930,960,900,920,950,930,960,900 830 I=INSTR(1,CHR$(8,9,12,13,24,192,194,195,196,198,208),I$)+1 840 ON I GOTO 850,920,950,880,970,890,980,910,940,930,960,1210 850 IF I$>" " THEN ; ""; : GOTO 950 ELSE 980 860 ; ""; : GOTO 980 870 ; " "; : GOTO 950 880 ; CHR$(12) YEL; : Z=FNLine25(R$) : GOTO 980 ! CTRL-L 890 ; CHR$(13) SPACE$(80); : GOTO 980 ! CE 900 R=0 : K=0 : GOTO 980 ! Q=HOME 910 K=K-4 : IF K>=0 THEN 980 ELSE K=K+80 : GOTO 930 ! PF3 920 K=K-1 : IF K>=0 THEN 980 ELSE K=79 ! <-- 930 R=MOD(R-1,24) : GOTO 980 ! PF5 940 K=K+4 : IF K<80 THEN 980 ELSE K=K-80 : GOTO 960 ! PF4 950 K=K+1 : IF K<80 THEN 980 ELSE K=0 ! --> 960 R=MOD(R+1,24) : GOTO 980 ! PF7 970 K=0 : GOTO 980 ! CR 980 WEND 990 ! 1000 ! ____Transformationer___ 1010 Dr|j=0 1020 R$="Bildtransformationer" : Z=FNStat 1030 A$=SPACE$(1920) ! Allokera utrymme 1040 ; CUR(0,0); 1050 WHILE -1 1060 Z=FNMunch(30720,VARPTR(A$),Ftkn) 1070 FOR I=1 TO 400 : NEXT I 1080 IF Abc=806 THEN OUT 53,3 ! Gul 1090 WHILE Abc=806 : OUT 35,16 : IF (INP(35) AND 16)=0 WEND ! Undvik flimmer 1100 Crt$=A$ 1110 WHILE SYS(5) OR Dr|j 1120 GET I$ 1130 IF ASCII(I$)=192 THEN 730 1140 IF I$=" " THEN Dr|j=NOT Dr|j : Z=FNStat : GOTO 1170 1150 IF ASCII(I$)=9 THEN Dr|j=-1 : Z=FNStat : GOTO 1180 1160 IF ASCII(I$)=208 THEN 1210 1170 WEND 1180 WEND 1190 ! 1200 ! ____Avsluta___ 1210 Z=FNLine25("") 1220 END 1230 ! 1240 DEF FNStat 1250 IF Dr|j THEN RETURN FNLine25(R$+", N{sta=-->, Snabb=Blank. Avbryt=PF1") 1260 RETURN FNLine25(R$+", Paus=Blanktecken. Avbryt=PF1") 1270 FNEND 1280 ! 1290 DEF FNMunchinit 1300 REM ASSEMBLERING AV MUNCH.ASM. LISTA P] MUNCH.LIS. 1985-12-27 00.54.10 1310 DIM K$=98 1320 K$=K$+CHR$(221,33,0,120,38,127,14,24,6,80,120,61,40,12,254,79,40,16,221,126,255,221,174,1,24,14,221,126,255,221,174,177,24,6,221,126,79,221) 1330 K$=K$+CHR$(174,1,111,121,61,40,12,254,23,40,17,221,126,176,221,174,80,24,23,221,126,176,197,1,208,248,24,7,221,126,80,197,1,48,7,221,229,227) 1340 K$=K$+CHR$(9,174,225,193,173,230,1,62,32,40,1,124,18,19,221,35,16,172,13,32,167,201) 1350 RETURN 0 1360 FNEND 1370 ! 1380 ! A=Bild in, B=Bild ut, T=Fyllt tecken 1390 DEF FNMunch(A,B,T) 1400 MID$(K$,3,2)=CVT%$(A) 1410 MID$(K$,6,1)=CHR$(T) 1420 RETURN CALL(VARPTR(K$),B) 1430 FNEND 1440 ! 1450 DEF FNLine25(S$) LOCAL C$=0 1460 POKE VAROOT(C$),80,0,32640,SWAP%(32640),80,0 1470 OUT 56,6,57,25+(LEN(S$)=0) 1480 C$=S$+SPACE$(80-LEN(S$)) 1490 RETURN 0 1500 FNEND