hab ich seinerzeit mal schnell in Pascal gemacht... wirklich Quick&dirty - fragt nicht was da im QT sonst noch passiert... ich hatte etliche male dran rumgebastelt... so dass halt noch ungenutzte fragmente drin sind.
Code: Alles auswählen
uses crt;
const max_x=320;
const max_y=200;
const maxcount=((max_x)*(max_y))-1;
var x:PChar;
var x2:PChar;
var Bedingung:array[0..8]of byte;
var cx,cy,cxl,cxh,cyl,cyh:word;
var Nachbarn,d:word;
var w:char;
begin
randomize;
d:=200;
getmem(x,maxcount);
getmem(x2,maxcount);
for cx:=0 to maxcount-1 do x2[cx]:=char(0);
for cx:=0 to 8 do Bedingung[cx]:=0;
writeln('(j)a, (n)ein, (w)iederbeleben) (w)ieberbeleben bei:');
writeln('0 Nachbarn');
w:=readkey; if w='j' then Bedingung[0]:=1 else if w='w' then Bedingung[0]:=2;
writeln('1 Nachbar');
w:=readkey; if w='j' then Bedingung[1]:=1 else if w='w' then Bedingung[1]:=2;
writeln('2 Nachbarn');
w:=readkey; if w='j' then Bedingung[2]:=1 else if w='w' then Bedingung[2]:=2;
writeln('3 Nachbarn');
w:=readkey; if w='j' then Bedingung[3]:=1 else if w='w' then Bedingung[3]:=2;
writeln('4 Nachbarn');
w:=readkey; if w='j' then Bedingung[4]:=1 else if w='w' then Bedingung[4]:=2;
writeln('5 Nachbarn');
w:=readkey; if w='j' then Bedingung[5]:=1 else if w='w' then Bedingung[5]:=2;
writeln('6 Nachbarn');
w:=readkey; if w='j' then Bedingung[6]:=1 else if w='w' then Bedingung[6]:=2;
writeln('7 Nachbarn');
w:=readkey; if w='j' then Bedingung[7]:=1 else if w='w' then Bedingung[7]:=2;
writeln('8 Nachbarn');
w:=readkey; if w='j' then Bedingung[8]:=1 else if w='w' then Bedingung[8]:=2;
clrscr;
Writeln('Startpattern X=Zelle; 3x3, r=random');
w:=readkey;
if (w<>'r') then
begin
write (w);if w='x' then x2[ 99*max_x+159]:=char($01);
w:=readkey;write (w);if w='x' then x2[ 99*max_x+160]:=char($01);
w:=readkey;writeln(w);if w='x' then x2[ 99*max_x+161]:=char($01);
w:=readkey;write (w);if w='x' then x2[100*max_x+159]:=char($01);
w:=readkey;write (w);if w='x' then x2[100*max_x+160]:=char($01);
w:=readkey;writeln(w);if w='x' then x2[100*max_x+161]:=char($01);
w:=readkey;write (w);if w='x' then x2[101*max_x+159]:=char($01);
w:=readkey;write (w);if w='x' then x2[101*max_x+160]:=char($01);
w:=readkey;writeln(w);if w='x' then x2[101*max_x+161]:=char($01);
end
else
begin
cy:=random(maxcount);
for cx:=0 to cy do x2[random(maxcount)]:=char(1);
end;
{
1234/34
234/34
2345/4 erzeugt sehr starke muster
234/4 verarmt
345/4 verarmt
34/34
234/34 wächst keine stabilen muster
1357/35 langsames wachsen
135/35 langsames aussterben
}
asm
mov ah,$00
mov al,$13
int $10
end; {}
move(x2^,x^,maxcount);
for cx:=0 to maxcount do Mem[SEGA000:cx]:=byte(x2[cx])*$f;
readkey;
repeat
for cx:=0 to max_x-1 do
begin
if cx=0 then cxl:=max_x-1 else cxl:=cx-1;
if cx=max_x-1 then cxh:=0 else cxh:=cx+1;
for cy:=0 to max_y-1 do
begin
if cy=0 then cyl:=max_y-1 else cyl:=cy-1;
if cy=max_y-1 then cyh:=0 else cyh:=cy+1;
Nachbarn:=(byte(x[(cyl*max_x)+cxl]))+(byte(x[(cyl*max_x)+cx]))+(byte(x[(cyl*max_x)+cxh]))+
(byte(x[(cy *max_x)+cxl]))+ (byte(x[(cy *max_x)+cxh]))+
(byte(x[(cyh*max_x)+cxl]))+(byte(x[(cyh*max_x)+cx]))+(byte(x[(cyh*max_x)+cxh]));
{ writeln('posxy:',cxl,' ',cx,' ',cxh,'y',cyl,' ',cy,' ',cyh,' inhalt:',byte(x[cy*max_x+cx]),' Nachbarn: ',Nachbarn,
'Bed l w:',Bedingung[Nachbarn]);
readkey;{}
if Bedingung[Nachbarn]=1 then
else
begin
if Bedingung[Nachbarn]=2 then
begin
x2[cx+(cy*max_x)]:=char($01);
Mem[SEGA000:cx+(cy*max_x)]:=$0F;
end
else
begin
x2[cx+(cy*max_x)]:=char($00);
Mem[SEGA000:cx+(cy*max_x)]:=$00;
end
end;
end;
end;
asm
cld
mov dx,ds
les di,x
lds si,x2
mov cx,$8000
db $F3 {rep}
db $A5 {movsw}
mov ds,dx
end;
delay(d);
if keypressed then
begin;
w:=readkey;
if w='+' then d:=d+1;
if (w='-') and (d>0)then d:=d-1;
end;
until w='q';
asm
mov ax,$0000
int $10
end;
end.