[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
{
This is my plasma code. Written here for windows 24bit mode. There's
some comments in it. It had a problem. I tried to fix it. Couldn't.
Deleted some POSITIVELY ABSOLUTELY ESSENTIAL bits of code, and the
problem went away. Don't ask me, I just wrote it.
You should be able to put it to palette based code pretty easy. It
started out that way and then got converted to RGB. Probably all you'd
need to do, is kill red and green, and just use blue as the palette
entry. Your problem to make sure your palette has nice colours.
It still tends to be a little ridgy on the primary axes. If anybody can
get rid of that, that would be cool. Let me know.
It's also a fractal terrain generator. Same alg. This is just 3 fractal
terrain altitude maps overlaid in rgb.
(Oh, yeah, it's not really windows code. All the real windows code
should be separate from the useful code, just in case you don't do
windows, don't be scared.)
--8<--------------------------------------------------------
}
program plasma;
{integer version of cloud.
Only works 24bit. Change resolution
constants width, height if you need.}
{Left button starts drawing.
CTRL-ALT-DEL to stop. Or wait for it to finish, and
right button}
uses OWindows, ODialogs, WinTypes, WinProcs;
const
{integer version of old real constant.
For calm versions, try FUZZ1/FUZZ2=0.3
For wild versions, try FUZZ1/FUZZ2=10}
FUZZ1=1;
FUZZ2=6;
width= 800;
height= 600;
type
TMyApp=object (TApplication)
procedure InitMainWindow; virtual;
end;
PMyWindow=^TPlasmaWindow;
TPlasmaWindow=object (TWindow)
r,g,b:byte;
w,h:integer;
constructor init(AParent:PWindowsObject; ATitle:PChar);
procedure SetUpWindow; virtual;
procedure WMLButtonDown(var Msg:TMessage); virtual wm_First+wm_LButtonDown;
procedure WMRButtonDown(var Msg:TMessage); virtual wm_First+wm_RButtonDown;
function getclassname:pchar; virtual;
procedure getwindowclass(var awndclass:twndclass); virtual;
end;
var maxx,maxy:integer;
backg:TColorRef;
i:integer;
function clamp(x:integer):byte;
begin
{ if x<0 then x:=0
else if x>255 then x:=255;
clamp:=x;}
case x of
-32767..0 : clamp:=0;
0..255 : clamp:=x;
256..32767: clamp:=255;
else {oops};
end; {case}
end;
function randomcolour:TColorRef;
var r,g,b:byte;
begin
randomcolour:=rgb(random(256),random(256),random(256));
end;
procedure TMyApp.InitMainWindow;
begin
MainWindow := New(PMyWindow, Init(NIL,'Plasma'));
end;
constructor TPlasmaWindow.init(AParent:PWindowsObject; ATitle:PChar);
begin
inherited init(AParent,ATitle);
r:=0; g:=0; b:=0;
w:=2;h:=2;
attr.x:=0; attr.y:=0;
attr.w:=width; attr.h:=height;
attr.style:=ws_popup + ws_visible;
end;
procedure TPlasmaWindow.SetUpWindow;
begin
inherited setupwindow;
end;
procedure TPlasmaWindow.WMLButtonDown(var Msg:TMessage);
var ADC:HDC;
AP,TempP:HPen;
AB,TempB:HBrush;
function max(a,b:integer):integer;
begin
if a<b then max:=b else max:=a;
end;
function mid(a,b:integer):integer;
begin
mid:=(a + b) div 2;
end;
function ridge(a,b,c,d:integer):TColorref;
{Take two endpoints, shift the mid point, based on how far apart they are.}
var variance:integer;
r,g,l:byte;
m,n:TColorref;
vd2:integer;
begin
variance:=max(c-a,d-b) * FUZZ1 div FUZZ2;
vd2:=variance div 2;
m:=getpixel(adc,(a),(b));
n:=getpixel(adc,(c),(d));
r:=clamp(((getrvalue(m) + getrvalue(n)) div 2{ + (random(variance))-vd2}));
g:=clamp(((getgvalue(m) + getgvalue(n)) div 2{ + (random(variance))-vd2}));
l:=clamp(((getbvalue(m) + getbvalue(n)) div 2{ + (random(variance))-vd2}));
ridge:=rgb(r,g,l);
end;
function shift(a,b,c,d:integer; col:tcolorref):tcolorref;
var variance:integer;
r,g,l:byte;
vd2:integer;
begin
{ variance:=max(d-b,c-a) * FUZZ1 div FUZZ2;}
variance:=(c-a) * FUZZ1 div FUZZ2;
vd2:=variance div 2;
r:=clamp(getrvalue(col) + (random(variance))-vd2);
g:=clamp(getgvalue(col) + (random(variance))-vd2);
l:=clamp(getbvalue(col) + (random(variance))-vd2);
shift:=rgb(r,g,l);
end;
procedure quarter(l,t,r,b:integer);
var mx,my,width,colour,variance:integer;
mzr,mzg,mzb:byte;
c:char;
m,n,o,p,tc:TColorRef;
vd2:integer;
abrush:hbrush;
begin
width:=r-l;
if (width>1) or (b-t>1) then
begin
variance:=width * FUZZ1 div fuzz2 ;
vd2:=variance div 2;
mx:=mid(l,r);
my:=mid(t,b);
m:=getpixel(adc,l,t);
n:=getpixel(adc,l,b);
o:=getpixel(adc,r,t);
p:=getpixel(adc,r,b);
mzr:=clamp((getrvalue(m) + getrvalue(n) + getrvalue(o) + getrvalue(p)) div 4 + random(variance)-vd2);
mzg:=clamp((getgvalue(m) + getgvalue(n) + getgvalue(o) + getgvalue(p)) div 4 + random(variance)-vd2);
mzb:=clamp((getbvalue(m) + getbvalue(n) + getbvalue(o) + getbvalue(p)) div 4 + random(variance)-vd2);
setpixel(adc,mx,my,rgb(mzr,mzg,mzb));
setpixel(adc,(l),(my),ridge(l,t,l,b));
setpixel(adc,(r),(my),ridge(r,t,r,b));
setpixel(adc,(mx),(t),ridge(l,t,r,t));
setpixel(adc,(mx),(b),ridge(l,b,r,b));
quarter(l,t,mx,my);
quarter(l,my,mx,b);
quarter(mx,t,r,my);
quarter(mx,my,r,b);
end;
end;
begin
ADC:=getdc(HWindow);
randomize;
maxx:=width-1; maxy:=height-1;
backg:=getpixel(ADC,10,10);
setpixel(adc,0,0,randomcolour);
setpixel(adc,0,maxy,randomcolour);
setpixel(adc,maxx,0,randomcolour);
setpixel(adc,maxx,maxy,randomcolour);
setpixel(adc,mid(0,maxx),0,randomcolour);
setpixel(adc,mid(0,maxx),maxy,randomcolour);
setpixel(adc,0,mid(0,maxy),randomcolour);
setpixel(adc,maxx,mid(0,maxy),randomcolour);
quarter(0,0,maxx,maxy);
end;
procedure TPlasmaWindow.WMRButtonDown(var Msg:TMessage);
begin
destroy;
end;
function TPlasmaWindow.getclassname:pchar;
begin
getclassname:='Cloud Window';
end;
procedure TPlasmaWindow.getwindowclass(var awndclass:twndclass);
begin
inherited getwindowclass(awndclass);
awndclass.hbrbackground:=getstockobject(white_brush);
end;
var DitherApp:TMyApp;
begin
DitherApp.init('Cloud');
DitherApp.run;
DitherApp.done;
end.
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]