1 REM Ins{nd av Kristoffer Eriksson <5357> 1988-10-19 23.05.46 (KERMIT) 20 ! +---------------------------------------------+ 30 ! ! LIFE Ver 1.1 - Klassisk bildtransformation ! 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 86-??-?? <5357> Kristoffer Eriksson, fr}n PICTRA 1.3 90 ! Ver 1.1 88-10-18 <5357> Slutf|rt 100 ! 110 ! Life {r ett klassiskt tidsf|rdriv p} dator, d{r man har "celler" som 120 ! f|ds och d|r enligt enkla regler, och d{r olika utg}ngsm|nster f}r 130 ! mycket olika slutresultat. Se reglerna. 140 ! Det enda tr}kiga med den h{r implementationen, {r att man bara har 24 150 ! rader p} sk{rmen... Men snabbt g}r det i alla fall. 160 ! 170 INTEGER : EXTEND 180 DIM Crt$=0,M|nster$=1920 190 POKE VAROOT(Crt$),1920,SWAP%(1920),0,SWAP%(30720),1920,SWAP%(1920) 200 Abc=800 : IF PEEK(39)=4 THEN Abc=806 ELSE IF PEEK(39)=3 THEN Abc=802 210 Ftkn=127 : IF Abc=806 THEN Ftkn=128+31 ! 806: Fylld graf 220 ! IF Abc=802 THEN Ftkn=128+31 ! Snyggare om man har normalt teckenprom 230 Knext=214 : Kprev=212 : Kexit=208 240 Knext$="SHIFT+PF7" : Kprev$="SHIFT+PF5" : Kexit$="SHIFT+PF1" 250 ! 260 \vers$=" +++ +" ! Standard Life-regler 270 Z=FNLifeinit(30720,Ftkn,VARPTR(\vers$)) 280 ! 290 ! ____Ram___ 300 ! F|ljande grafiksatser har ingen betydelse f|r programmets funktion: 310 ON ERROR GOTO 400 320 IF Abc=806 THEN 370 330 FGCTL 1 340 FGPOINT 239,239,0 : FGFILL 0,0,0 350 FGPOINT 0,0,1 : FGLINE 239,0 : FGLINE 239,239 : FGLINE 0,239 : FGLINE 0,0 360 GOTO 400 370 FGCTL BLU+GYEL 380 FGPOINT 511,239,0 : FGFILL 0,0,0 390 FGPOINT 15,0,1 : FGLINE 497,0 : FGLINE 497,239 : FGLINE 15,239 : FGLINE 15,0 400 ON ERROR GOTO 410 ! 420 ! ____Huvudsnurra___ 430 State$="B" 440 WHILE 1 450 State$=FNF|rdela$ 460 WEND 470 ! 480 DEF FNF|rdela$ 490 ON INSTR(1,"BARMTSE",State$) GOTO 500,510,520,530,540,550,560 500 RETURN FNBeskrivning$ ! (B)eskrivning 510 RETURN FNAnvisningar$ ! (A)nvisningar 520 RETURN FNRegler$ ! (R)egler 530 RETURN FNM|nster$ ! (M)|nster 540 RETURN FNTransformering$ ! (T)ransformera 550 RETURN FNSluta$ ! (S)luta 560 Z=FNLine25("") ! (E)nd 570 END 580 FNEND 590 ! 600 ! ____Anvisningar___ 610 DEF FNBeskrivning$ 620 ; CHR$(12); 630 ; "Detta {r Life." 640 ; 650 ; "Sk{rmen {r uppdelad i rutor. Varje ruta kan antingen vara tom, eller "; 660 ; 'hysa en' : ; '"levande" cell. Generationerna v{xlar snabbt, och '; 670 ; 'cellernas liv styrs av n}gra' : ; 'enkla regler som utg}r fr}n '; 680 ; 'antalet levande celler i de 8 intilliggande' : ; 'grannrutorna.' 690 ; 700 ; 'Standardreglerna i Life {r: En levande cell med 2 eller 3 grannar '; 710 ; '|verlever.' : ; 'I en tom ruta med 3 grannar f|ds en ny cell. '; 720 ; '|vriga d|r eller f|rblir tomma.' : ; 'Som grannar till rutor vid '; 730 ; 'bildens kanter kan r{knas rutorna p} bildens' : ; 'motsatta kant, om '; 740 ; 'man s} vill.' 750 ; 760 ; 'Reglerna kan modifieras i en tabell p} en senare sida, d{r man '; 770 ; 'anger vad som' : ; 'ska h{nda i en tom respektive full ruta beroende '; 780 ; 'p} antal levande grannar.' 790 ; 800 ; 'Beroende p} vilka regler som anv{nds, och utg}ngsm|nstret av tomma '; 810 ; 'och fyllda' : ; 'rutor, kan man f} tre olika slutresultat: Allting '; 820 ; 'd|r ut, M|nstret v{xlar' : ; 'cykliskt mellan n}gra f} tillst}nd, '; 830 ; 'Evigt varierande m|nster. Det sistn{mnda {r' : ; 'klart ovanligast. '; 840 ; 'Trots de enkla reglerna, {r det inte l{tt att f|rutse hur ett' 850 ; 'visst m|nster kommer att utveckla sig i Life.' 860 ; 870 ; '[ndrade regler kan ge systemet helt andra egenskaper {n normala '; 880 ; 'Life. Vissa ' : ; 'regler kan antagligen ge ett slags primitiv '; 890 ; 'data-behandling av den inmatade' : ; 'bilden. Man beh|ver inte l}sa '; 900 ; 'sig vid tolkningen av bilden som celler. '; 910 Z=FNLine25("Beskrivning. RETURN=Vidare, "+Kexit$+"=Avsluta.") 920 WHILE 1 930 GET I$ 940 IF ASCII(I$)=Kexit THEN RETURN "E" 950 IF ASCII(I$)=Knext OR ASCII(I$)=13 THEN RETURN "A" 960 IF I$=" " THEN RETURN "R" 970 WEND 980 FNEND 990 ! 1000 DEF FNAnvisningar$ 1010 ; CHR$(12); 1020 ; "Anvisningar." 1030 ; 1040 ; "N{r du l{st det h{r och tryckt p} RETURN kommer du till regelsidan "; 1050 ; "d{r spelets" : ; "regler kan modifieras. N{r du tryckt p} PF1 p} "; 1060 ; "den sidan, kommer du till" : ; "m|nstersidan d{r du kan rita upp "; 1070 ; "utg}ngs-bilden. N{r du tryckt p} PF1 igen," : ; "b|rjar bilden "; 1080 ; "leva, och generationerna avl|ser varandra i snabb takt. Det g}r" 1090 ; "att stoppa och g|ra om m|nstret n{r som helst." 1100 ; 1110 ; "P} m|nstersidan g{ller f|ljande tangenter:" 1120 ; 1130 ; " (Home) (Upp) (Radstart) RET PF1 (Klart)" 1140 ; " Q W (Snabb v{nster) PF3 PF4 (Snabb h|ger)" 1150 ; "(V{nster) A S (H|ger) (V{nster) <-- PF5 (Upp)" 1160 ; " Z (H|ger) --> PF7 (Ned)" 1170 ; " (Ned) CTRL-L (T|m sk{rm) (T|m rad) CE" 1180 ; 1190 ; "Mellanslag = Blank, \vriga tecken = Cell, SHIFT+PF1 = Avsluta" 1200 ; 1210 ; "Vilka tangenter som g{ller p} |vriga sidor kommer att framg}." 1220 ; "SHIFT+PF5 och SHIFT+PF7 g}r alltid till f|reg}ende resp n{sta sida. "; 1230 Z=FNLine25("Anvisningar. RETURN=Vidare, "+Kprev$+"=Beskrivning.") 1240 WHILE 1 1250 GET I$ 1260 IF ASCII(I$)=Kprev THEN RETURN "B" 1270 IF ASCII(I$)=Knext OR ASCII(I$)=13 OR I$=" " THEN RETURN "R" 1280 WEND 1290 FNEND 1300 ! 1310 ! ____Livsregler___ 1320 DEF FNRegler$ LOCAL G$=1 1330 ; CHR$(12); 1340 ; "Regler f|r vilka celler som ska |verleva, f|das eller d|." 1350 ; 1360 ; "Antal levande grannar Nuvarande tillst}nd" 1370 ; " D|d Levande" 1380 FOR A=0 TO 8 1390 ; TAB(20) A TAB(35) FNLev$(A,0) TAB(46) FNLev$(A,1) 1400 NEXT A 1410 ; CUR(14,20) "Hopkopplade sk{rmkanter: " FNLev$(9,0) 1420 ; CUR(15,20) "Spara bild+regler p} fil: "; 1430 ; CUR(16,20) "H{mta bild+regler fr}n fil: "; 1440 ; CUR(19,13) "PF5 = Upp, PF7 = Ned, <-- V{nster, --> H|ger." 1450 ; CUR(20,13) '"=" = Standard-reglerna. L = Lev, - = D|.' 1460 Z=FNLine25("Life-regler. RETURN=Vidare, "+Kprev$+"=Anvisningar, "+Kexit$+"=Avsluta.") 1470 WHILE 1 1480 IF Ra=10 G$=FNFiler$ : IF G$="" THEN Ra=0 : Rl=0 : GOTO 1330 ELSE 1510 1490 IF Ra=9 THEN Rl=0 : ; CUR(5+Ra,45); ELSE ; CUR(4+Ra,34+Rl*11); 1500 GET G$ 1510 I=INSTR(1,CHR$(8,9,12,196,198,Kexit,Kprev,Knext,13),G$)+1 1520 ON I GOTO 1530,1600,1630,1580,1620,1650,1670,1680,1690,1690 1530 I=(INSTR(1,"Ll- JjNnWwXxAaDd= ",G$)+3)/2 1540 ON I GOTO 1660,1560,1570,1560,1570,1620,1650,1600,1630,1590 1550 ! 1560 MID$(\vers$,Ra+Ra+1+Rl,1)="+" : ; FNLev$(Ra,Rl); : GOTO 1630 1570 MID$(\vers$,Ra+Ra+1+Rl,1)=" " : ; FNLev$(Ra,Rl); : GOTO 1630 1580 \vers$=SPACE$(19) : GOTO 1330 1590 \vers$=" +++ +" : GOTO 1330 1600 Rl=Rl-1 : IF Rl>=0 THEN 1660 ELSE Rl=1 1610 Ra=MOD(Ra-1,9) : GOTO 1660 1620 Ra=(Ra-1 AND Ra>0)+(9 AND Ra<=0) : GOTO 1660 1630 IF Ra<9 THEN Rl=Rl+1 : IF Rl<2 THEN 1660 ELSE Rl=0 1640 Ra=(Ra+1 AND Ra<8) : GOTO 1660 1650 Ra=MOD(Ra+1,11) : GOTO 1660 1660 WEND 1670 RETURN "S" ! Sluta 1680 RETURN "A" ! Tillbaka Anvisning 1690 RETURN "M" ! Vidare M|nster 1700 FNEND 1710 ! 1720 DEF FNFiler$ LOCAL R,Fil$=30,G$=1 1730 WHILE R>=0 AND R<=1 1740 ; CUR(15+R,48); 1750 ON ERROR GOTO 1840 : INPUT ""Fil$ 1760 ; CUR(17,0) SPACE$(80) CUR(15+R,48) SPACE$(52); 1770 WHILE LEN(Fil$) 1780 IF INSTR(1,Fil$,".")=0 THEN Fil$=Fil$+".LIF" 1790 IF R=0 THEN Z=FNSkrivfil(Fil$) ELSE Z=FNL{sfil(Fil$) 1800 IF Z=0 THEN RETURN "" 1810 IF 0 WEND 1820 IF Fil$="" THEN R=R+1 1830 WHILE 0 1840 ; CUR(15+R,48) SPACE$(52); 1850 WHILE ERRCODE=53 1860 Z=SYS(6) : GET G$ 1870 IF ASCII(G$)=198 THEN R=R+1 ELSE IF ASCII(G$)=196 THEN R=R-1 ELSE R=-1 1880 IF R<0 OR R>1 THEN ; CUR(23,0); : RETURN G$ 1890 IF 0 WEND 1900 WEND 1910 WEND 1920 RETURN CHR$(198) 1930 FNEND 1940 ! 1950 DEF FNLev$(Ant,L)=MID$("-LNJ",1+(1 AND MID$(\vers$,Ant+Ant+L+1,1)<>" ")+(2 AND Ant>8),1) 1960 ! 1970 ! ____Filer___ 1980 DEF FNSkrivfil(Fil$) LOCAL G$=1,P,K 1990 ON ERROR GOTO 2070 : OPEN Fil$ AS FILE 1 : CLOSE 1 2000 WHILE 1 2010 ; CUR(17,20) "Filen finns redan. Skriva |ver J/N ? "; 2020 GET G$ 2030 ; CUR(17,0) SPACE$(80); 2040 IF G$="N" OR G$="n" THEN RETURN -1 2050 IF G$<>"J" AND G$<>"j" WEND 2060 ! 2070 ON ERROR GOTO 2180 : PREPARE Fil$ AS FILE 1 2080 ; CUR(17,20) "Sparar..." 2090 ; #1 \vers$ 2100 P=1 : WHILE P+79<=LEN(M|nster$) AND M|nster 2110 K=0 : WHILE K<80 2120 IF ASCII(RIGHT$(M|nster$,P+K))>32 THEN ; #1 "*"; ELSE ; #1 " "; 2130 K=K+1 : WEND 2140 ; #1 2150 P=P+80 : WEND 2160 CLOSE 1 : RETURN 0 2170 ! 2180 ; CUR(17,20) "Felkod" ERRCODE "p} " Fil$ CHR$(7); : CLOSE 1 : RETURN -1 2190 FNEND 2200 ! 2210 DEF FNL{sfil(Fil$) LOCAL I$=160,E,K,L 2220 ON ERROR GOTO 2400 : E=-1 : OPEN Fil$ AS FILE 1 2230 ; CUR(17,20) "L{ser in..." 2240 INPUT LINE #1 I$ : \vers$=LEFT$(I$,LEN(I$)-2) 2250 IF LEN(\vers$)<19 THEN \vers$=\vers$+SPACE$(19-LEN(\vers$)) 2260 M|nster$="" : M|nster=-1 2270 WHILE LEN(M|nster$)<1920 2280 ON ERROR GOTO 2350 : INPUT LINE #1 I$ 2290 L=LEN(I$)-2 : IF L>80 THEN L=80 2300 K=1 : WHILE K<=L : IF ASCII(RIGHT$(I$,K))>32 THEN MID$(I$,K,1)="" 2310 K=K+1 : WEND 2320 M|nster$=M|nster$+LEFT$(I$,L)+SPACE$(80-L) 2330 WEND 2340 WHILE 0 2350 IF ERRCODE<>34 THEN E=0 : GOTO 2400 2360 M|nster$=M|nster$+SPACE$(1920-LEN(M|nster$)) 2370 IF 0 WEND 2380 CLOSE 1 : RETURN 0 2390 ! 2400 IF ERRCODE=21 THEN ; CUR(17,20) "Hittar inte " Fil$ CHR$(7); : RETURN -1 2410 ; CUR(17,20) "Felkod" ERRCODE "p} " Fil$ CHR$(7); : CLOSE 1 : RETURN E 2420 FNEND 2430 ! 2440 ! ____Rita m|nster___ 2450 DEF FNM|nster$ 2460 ! Standardm|nster___ 2470 ; YEL CHR$(12) " "; 2480 IF Abc=806 THEN OUT 53,3 ! Gul 2490 IF M|nster THEN Crt$=M|nster$ : WHILE 0 2500 M|nster=-1 2510 ; CUR(10,39) ""; 2520 ; CUR(11,39) ""; 2530 ; CUR(12,39) ""; 2540 WEND 2550 ! 2560 ! Rita m|nster___ 2570 R=11 : K=39 2580 IF SYS(5) THEN GET I$ : IF ASCII(I$)=Kprev THEN RETURN "R" 2590 R$="Rita m|nster. "+Knext$+"/PF1=Start, "+Kprev$+"=Regler. " 2600 I$="" 2610 WHILE 1 2620 Z=FNLine25(R$+"("+NUM$(R)+","+NUM$(K)+")") 2630 ; CUR(R,K); 2640 GET I$ 2650 I=INSTR(1," 1ASWZQaswzq=",I$)+1 2660 ON I GOTO 2670,2710,2700,2760,2790,2770,2800,2740,2760,2790,2770,2800,2740,2820 2670 I=INSTR(1,CHR$(8,9,12,13,24,194,195,196,198,192,Knext,Kprev,Kexit),I$)+1 2680 ON I GOTO 2690,2760,2790,2720,2810,2730,2750,2780,2770,2800,2840,2840,2850,2850 2690 IF I$>" " AND ASCII(I$)<128 THEN ; ""; : GOTO 2790 ELSE 2830 2700 ; ""; : GOTO 2830 2710 ; " "; : GOTO 2790 2720 ; CHR$(12) YEL; : Z=FNLine25(R$) : GOTO 2830 ! CTRL-L 2730 ; CHR$(13) SPACE$(80); : GOTO 2830 ! CE 2740 R=0 : K=0 : GOTO 2830 ! Q=HOME 2750 K=K-4 : IF K>=0 THEN 2830 ELSE K=K+80 : GOTO 2770 ! PF3 2760 K=K-1 : IF K>=0 THEN 2830 ELSE K=79 ! <-- 2770 R=MOD(R-1,24) : GOTO 2830 ! PF5 2780 K=K+4 : IF K<80 THEN 2830 ELSE K=K-80 : GOTO 2800 ! PF4 2790 K=K+1 : IF K<80 THEN 2830 ELSE K=0 ! --> 2800 R=MOD(R+1,24) : GOTO 2830 ! PF7 2810 K=0 : GOTO 2830 ! CR 2820 M|nster=0 : GOTO 2460 2830 WEND 2840 RETURN "T" 2850 M|nster$=Crt$ : RETURN "R" 2860 FNEND 2870 ! 2880 ! ____Transformationer___ 2890 DEF FNTransformering$ 2900 Dr|j=0 2910 R$="Bildtransformationer" : Z=FNStat 2920 M|nster$=SPACE$(1920) ! Allokera utrymme 2930 ; CUR(0,0); 2940 WHILE 1 2950 Z=FNLife(VARPTR(M|nster$)) 2960 IF Abc=806 THEN OUT 53,3 ! Gul 2970 WHILE Abc=806 : OUT 35,16 : IF (INP(35) AND 16)=0 WEND ! Undvik flimmer 2980 Crt$=M|nster$ 2990 WHILE SYS(5) OR Dr|j 3000 GET I$ 3010 ON INSTR(1,CHR$(32,9,192,13,Kprev,Kexit),I$)+1 GOTO 3060,3020,3030,3040,3040,3040,3050 3020 Dr|j=NOT Dr|j : Z=FNStat : GOTO 3060 3030 Dr|j=-1 : Z=FNStat : GOTO 3070 3040 RETURN "M" 3050 RETURN "R" 3060 WEND 3070 WEND 3080 FNEND 3090 ! 3100 DEF FNSluta$ 3110 Z=FNLine25("Sluta? J/N ") 3120 WHILE 1 3130 GET G$ 3140 IF INSTR(1,"Jj",G$) THEN RETURN "E" 3150 IF INSTR(1,"Nn",G$) THEN RETURN "R" 3160 WEND 3170 FNEND 3180 ! 3190 DEF FNStat 3200 IF Dr|j THEN RETURN FNLine25(R$+", N{sta=-->, Snabb=Blank, Avbryt=PF1.") 3210 RETURN FNLine25(R$+", Paus=Blanktecken, Avbryt=PF1.") 3220 FNEND 3230 ! 3240 ! Tecken=Teckenkod f|r levande cell, \vers$=Regeltabell 3250 DEF FNLifeinit(Bildin,Tecken,\vers) 3260 REM ASSEMBLERING AV MF1:LIFE.ASM. 1988-10-19 00.53 3270 DIM K$=348 3280 K$=K$+CHR$(253,229,253,33,0,0,221,33,0,120,38,127,14,24,253,126,18,230,1,32,66,6,80,229,213,197,253,229,221,229,209,121,61,40,14,254,23,40,20) 3290 K$=K$+CHR$(33,176,255,253,33,80,0,25,24,17,33,176,255,25,253,33,0,0,24,9,253,33,80,0,33,0,0,253,25,126,253,134,0,79,120,61,40,31,254,79,40,37) 3300 K$=K$+CHR$(24,6,24,192,24,192,24,86,221,126,255,221,134,1,253,134,255,253,134,1,43,134,35,35,134,24,18,221,126,255,253,134,255,43,134,24,8,221) 3310 K$=K$+CHR$(126,1,253,134,1,35,134,129,230,15,40,4,246,240,237,68,135,95,22,0,221,126,0,230,15,40,1,19,225,229,25,126,253,225,193,209,225,230) 3320 K$=K$+CHR$(1,62,32,40,1,124,18,19,221,35,16,172,13,32,167,253,225,201,6,80,229,213,197,253,229,121,61,40,13,254,23,40,18,33,176,255,253,33,80) 3330 K$=K$+CHR$(0,24,16,33,176,255,253,33,208,248,24,7,33,48,7,253,33,80,0,221,229,209,25,253,25,126,253,134,0,79,120,61,40,29,254,79,40,46,24,4) 3340 K$=K$+CHR$(24,193,24,193,221,126,255,221,134,1,253,134,255,253,134,1,43,134,35,35,134,24,40,221,126,255,221,134,177,253,134,255,253,134,177) 3350 K$=K$+CHR$(43,134,17,178,255,25,134,24,19,221,126,79,221,134,1,253,134,79,253,134,1,35,134,17,78,0,25,134,129,230,15,40,4,246,240,237,68,135) 3360 K$=K$+CHR$(95,22,0,221,126,0,230,15,40,1,19,225,229,25,126,253,225,193,209,225,230,1,62,32,40,1,124,18,19,221,35,16,152,13,32,147,253,225,201) 3370 ! 3380 MID$(K$,9,2)=CVT%$(Bildin) 3390 MID$(K$,12,1)=CHR$(Tecken) 3400 MID$(K$,5,2)=CVT%$(\vers) 3410 DIM Blanka$=3 : Blanka$=" " 3420 MID$(K$,56,2)=CVT%$(VARPTR(Blanka$)+1) 3430 MID$(K$,65,2)=CVT%$(VARPTR(Blanka$)+1) 3440 RETURN 0 3450 FNEND 3460 ! 3470 DEF FNLife(Bildut)=CALL(VARPTR(K$),Bildut) 3480 ! 3490 DEF FNLine25(S$) LOCAL C$=0 3500 POKE VAROOT(C$),80,0,32640,SWAP%(32640),80,0 3510 OUT 56,6,57,25+(LEN(S$)=0) 3520 C$=S$+SPACE$(80-LEN(S$)) 3530 RETURN 0 3540 FNEND