PROGRAM FRAKTAL_2; { programmed by Kristian Peters (c) Copyright 1995-2004 Korseby released under the terms of GPL contact: kristian.peters@korseby.net web: http://www.korseby.net } USES CRT,DOS,GRAPH,MAIN; VAR j: byte; rauheit:real; incdec:boolean; ch:char; RATE:INTEGER; {²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²} PROCEDURE FRAKTAL1; {-------------------------------------} procedure NewCol(xa, ya, x, y, xb, yb:Integer); var col: integer; begin col:= Abs(xa - xb) + Abs(ya - yb); col:= Round(Random(col)*Rauheit)-col; col:= (col+GetPixel(xa,ya)+GetPixel(xb,yb)) div 2; if col < 1 then col:=1; if col >180 then col:=180; if Getpixel(x,y) = 0 then PutPixel(x,y,col); end; {-------------------------------------} procedure SetPalette(j: byte); var i: byte; begin for i:= 1 to 63 do begin Setpal(i + j, 0, 63 -i, i); Setpal(i + 63 + j, i, 0, 63 - i); Setpal(i + 126 + j, 63 - i, i, 0); end; end; {-------------------------------------} procedure SubDivide(x1,y1,x2,y2:word); var col:integer; x,y:word; begin if (not((x2-x1<2)and(y2-y1<2)))and(not keypressed)then begin x:= (x1 + x2) div 2; y:= (y1 + y2) div 2; NewCol(x1, y1, x, y1, x2, y1); NewCol(x2, y1, x2, y, x2, y2); NewCol(x1, y2, x, y2, x2, y2); NewCol(x1, y1, x1, y, x1, y2); col:=(GetPixel(x1,y1)+GetPixel(x2,y2)+GetPixel(x2,y1)+GetPixel(x1,y2))div 4; PutPixel(x,y,col); SubDivide(x1, y1, x, y); SubDivide(x, y1, x2, y); SubDivide(x, y, x2, y2); SubDivide(x1, y, x, y2); end; end; {-------------------------------------} VAR x,y:integer; BEGIN randomize; Rauheit:=(random({99}9)+21)/10; j:=random(2); if j=0 then incdec:=true else incdec:=false; SetPalette(0); j:=4*(random(64)+1); for x:=0 to 639 do for y:=0 to 479 do putpixel(x,y,x*y div j); ch:=#0; repeat SetPalette(j); if incdec then inc(j) else dec(j); delay(rate); if keypressed then begin ch:=readkey; case ch of '+': if rate>0 then dec(rate); '-': inc(rate); #27:; end; end; until ch=#27; END; {²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²} BEGIN rate:=30; initgr; fraktal1; closegraph; END.