Logic Chaos

{TURBO PASCAL SOURCE}
{JOAO PAULO SCHWARZ SCHULER}
uses dum,crt;
type TVIDEO = array[0..199,0..319] of byte;


procedure INVERTEL(L:word;var RVIDEO:TVIDEO);
var I:integer;
    VVIDEO:TVIDEO;
begin
VVIDEO[L]:=RVIDEO[L];
for I:=1 to 319 do
    VVIDEO[L,I]:=not((RVIDEO[L,I] xor RVIDEO[L,pred(I)]));
RVIDEO[L]:=VVIDEO[L];

for I:=318 downto 0 do
    VVIDEO[L,I]:=not(RVIDEO[L,I] xor RVIDEO[L,succ(I)]);
RVIDEO[L]:=VVIDEO[L];
end;

procedure CRIA(var RVIDEO:TVIDEO);
var I,I2:integer;
    W:word;
begin
Randomize;
for I:=0 to 319 do
    for I2:=0 to 199 do
    begin
    W:=Round(Random(1000));
    if Random(1000)>990
       then RVIDEO[I2,I]:= W mod 255
       else RVIDEO[I2,I]:=0;
    end;
end;

procedure SCROLL(var RVIDEO:TVIDEO);
type VID = array [0..6399] of extended;
     VIDPtr = ^VID;

var L:word;
    P:pointer;
    VVID:VIDPtr;
begin
VVID:=addr(RVIDEO);
for L:=0 to 6367 do
    VVID^[L]:=VVID^[L+32];
end;

procedure STEP3(var RVIDEO:TVIDEO);
var L,C:word;
begin
INVERTEL(199,RVIDEO);
SCROLL(RVIDEO);
RVIDEO[199]:=RVIDEO[198];
end;

var L:byte;
    var RVIDEO:  TVIDEO absolute $a000:0000;
begin { of program }
L:=0;
DMG($13);
CRIA(RVIDEO);
repeat
    begin
    Step3(RVIDEO);
    end;
until keypressed;
DMG(2);
writeln('Joao Paulo Schwarz Schuler');
writeln('http://www.schulers.com/jpss');
writeln('mailto://jpss@schulers.com');
end.

See Also

• LSM: Fractal em Pascal; Fractal in Pascal Source.
• TCAOS: Classe que gera caos; Chaos class.
• MEUCAOS: Eu inventei esse caos; I did this chaos.

Return to the Home Page

Return to the Fontes em Pascal Page

I want to read your E-Mail