All pastes #958702 Raw Edit

plasma

public text v1 · immutable
#958702 ·published 2008-03-26 21:42 UTC
rendered paste body
Program Plazma;

(* Copyright (c) 9.V.1999 by Omega Red - freeware *)

uses vesa, bitmaps;

const
	maxcol		=	255;
	n				=	9;
	ms				=	2*n;
	hurst			=	0.7; { 0 - 1 ! }
var
	p2						:	array [0..15] of word;
	i, st, c, p			:	byte;
	max, step, init,
	x, y, dist, pix	:	word;
	scale : real;

Function rnd : real; {prawie rozklad Gaussa (normalny)}
Begin
	rnd:=random + random + random + random + random + random - 3;
End;

Function RndPix : byte;
Begin
	RndPix:=round(maxcol*random);
{	rndpix:=0;}
End;

Function FixPix : word;
Begin
	FixPix:=round(maxcol*rnd*scale);
{	fixpix:=0;}
End;

Procedure InitPalette;
var  	col, r, g, b	:	byte;
		f		:	text;
Begin
	assign(f, 'rainbow.pal');
	reset(f);
	for col:=0 to maxcol do begin
		read(f, r, g, b);
		setrgb(col, r, g, b);
	end;
	close(f);
End;

Procedure ClearScreen;
var x, y : word;
Begin
	for x:=0 to xmax do
	for y:=0 to ymax do
	setpix(x, y, 0);
End;


BEGIN
	randomize;
	p2[0]:=1;
	for i:=1 to 15 do p2[i]:=2*p2[i-1];
	max:=p2[n];
	setmode($103);
	initpalette;

{	repeat}
{	scale:=random;
	hurst:=random;}
	scale:=sqrt(1-exp((2*hurst-2)*ln(2)));
	setpix(0, 0, rndpix);
	setpix(0, max, rndpix);
	setpix(max, 0, rndpix);
	setpix(max, max, rndpix);

	p:=round((getpix(0,0)+getpix(0,max)+
				 getpix(max,0)+getpix(max,max))/4+fixpix);
	setpix(max div 2,max div 2, p);

	for st:=2 to ms do begin
		step:=max div p2[(st-1) div 2];
		init:=max div p2[(st+1) div 2];
		if odd(st) then begin
			x:=init;
			while x < ymax do begin
				y:=init;
				while y < ymax do begin
					dist:=init;
					pix:=0;
					c:=0;
					p:=getpix(x-dist, y-dist);
					if p <> 0 then begin
						inc(pix, p);
						inc(c);
					end;
					p:=getpix(x-dist, y+dist);
					if p <> 0 then begin
						inc(pix, p);
						inc(c);
					end;
					p:=getpix(x+dist, y-dist);
					if p <> 0 then begin
						inc(pix, p);
						inc(c);
					end;
					p:=getpix(x+dist, y+dist);
					if p <> 0 then begin
						inc(pix, p);
						inc(c);
					end;
					if c <> 0 then pix:=round(pix/c + fixpix);
					setpix(x, y, pix);
					inc(y, step div 2);
				end;
				inc(x, step div 2);
			end;
		end
		else begin
			x:=0;
			while x <= ymax do begin
				y:=0;
				while y <= ymax do begin
					if (abs(x-y) mod step > 0) then begin
						dist:=max div p2[st div 2];
						pix:=0;
						c:=0;
						p:=getpix(x, y-dist);
						if p <> 0 then begin
							inc(pix, p);
							inc(c);
						end;
						p:=getpix(x, y+dist);
						if p <> 0 then begin
							inc(pix, p);
							inc(c);
						end;
						p:=getpix(x+dist, y);
						if p <> 0 then begin
							inc(pix, p);
							inc(c);
						end;
						p:=getpix(x-dist, y);
						if p <> 0 then begin
							inc(pix, p);
							inc(c);
						end;
						if c <> 0 then pix:=round(pix/c + fixpix);
						setpix(x, y, pix);
					end;
					inc(y, step div 2);
				end;
				inc(x, step div 2);
			end;
		end;
		scale:=scale/sqrt(exp(hurst*ln(2)));
{		readln;}
	end;
	readln;
	screenshot(max, max, 8, 'plazma.bmp');
	clearscreen;
{	until false;}
END.