[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
{another plasma. Uses John Bridges' 360x480x256 non standard vga mode,
somebody elses plasma routine, yet another person's palette cycle
routine, and my color mutator. }
uses crt,printer;
Const
granularity=0.5;
EndProgram:Boolean=False;
DelayFactor:Byte=20;
skyr=0;
skyg=0;
skyb=55;
var
pal:array[0..773] of byte;
r,g,b,dir,which:byte;
i,j,counter:integer;
ch:char;
{$F+}
procedure set360x480;
{courtesy of John Bridges}
begin
asm
push si
push di
mov ax,12h {clear video memory with bios}
int 10h {and set 640x480x16 mode}
mov ax,13h {set 320x200x256 mode with bios}
int 10h
mov dx,3c4h {alter sequencer registers}
mov ax,0604h {disable chain 4}
out dx,ax
mov ax,0100h {syncronus reset}
out dx,ax
mov dx,3c2h
mov al,0e7h
out dx,al
mov dx,3c4h
mov ax,0300h
out dx,ax
mov dx,3d4h
mov al,11h
out dx,al
inc dx
in al,dx
and al,7fh
out dx,al
dec dx
mov ax,06b00h {horiz total}
out dx,ax
mov ax,05901h {horiz displayed}
out dx,ax
mov ax,05a02h {start horiz blanking}
out dx,ax
mov ax,08e03h {end horiz blanking}
out dx,ax
mov ax, 05e04h {start h sync}
out dx,ax
mov ax, 08a05h {end h sync}
out dx,ax
mov ax, 00d06h {vertical total}
out dx,ax
mov ax, 03e07h {overflow}
out dx,ax
mov ax, 04009h {cell height}
out dx,ax
mov ax, 0ea10h {v sync start}
out dx,ax
mov ax, 0ac11h {v sync end and protect cr0-cr7}
out dx,ax
mov ax, 0df12h {vertical displayed}
out dx,ax
mov ax, 02d13h {offset}
out dx,ax
mov ax, 00014h {turn off dword mode}
out dx,ax
mov ax, 0e715h {v blank start}
out dx,ax
mov ax, 00616h {v blank end}
out dx,ax
mov ax, 0e317h {turn on byte mode}
out dx,ax
pop di
pop si
end;
end;
procedure dot360x480(drawx,drawy,color:word);
begin
asm
mov ax,0a000h {VGA_SEGMENT}
mov es,ax
mov ax,90 {SCREEN_WIDTH/4}
mul DrawY
mov di,DrawX
shr di,1
shr di,1
add di,ax
mov cl,byte ptr DrawX
and cl,3
mov ah,1
shl ah,cl
mov al,2 {MAP_MASK}
mov dx,03c4h {SC_INDEX}
out dx,ax
mov al,byte ptr Color
stosb {draw pixel}
end;
end;
Function Read360x480(Readx,Ready:word):word;
{Read360x480 PROC FAR ReadX:WORD, ReadY:WORD RETURNS result:WORD}
begin
asm
mov ax,0a000h {VGA_SEGMENT}
mov es,ax
mov ax,90 {SCREEN_WIDTH/4}
mul ReadY
mov si,ReadX
shr si,1
shr si,1
add si,ax
mov ah,byte ptr ReadX
and ah,3
mov al,4 {READ_MAP}
mov dx,3ceh {GC_INDEX}
out dx,ax
SEGES mov al,[si]
sub ah,ah
mov @result,ax
end;
end;
{$F-}
procedure bump(var r:byte; var g:byte; var b:byte);
{this one's mine. Inc/dec one r, g, or b value to make returned
color one bit off from delivered one.
Ron Nossaman nossaman@southwind.net }
begin
dec(counter);
if counter<=0 then
begin
counter:=random(10)+1;
dir:=random(2);
which:=random(3);
end;
dec(counter);
case dir of
0: case which of
0:if r>0 then dec(r) else counter:=0;
1:if g>0 then dec(g) else counter:=0;
2:if b>0 then dec(b) else counter:=0;
end;
1: case which of
0:if r<63 then inc(r) else counter:=0;
1:if g<63 then inc(g) else counter:=0;
2:if b<63 then inc(b) else counter:=0;
end;
end;
end;
Procedure CyclePalette(s,e:Byte);
var r,g,b:byte;
p,j:word;
Begin
r:=pal[s*3];
g:=pal[s*3+1];
b:=pal[s*3+2];
bump(r,g,b);
move(pal[s*3],pal[s*3+3],(e-(s))*3);
pal[s*3]:=r;
pal[s*3+1]:=g;
pal[s*3+2]:=b;
{install palette}
for p:=0 to 255 do
begin
j:=p*3;
ASM
CLI
END;
Port[$3C8]:=p;
Port[$3C9]:=pal[j];
Port[$3C9]:=pal[j+1];
Port[$3C9]:=pal[j+2];
ASM
STI
END;
end;
End;
procedure setpixel(x,y,hue:integer);
{with brute force (dip stick) clipping}
begin
if x<0 then exit;
if y<0 then exit;
if x>359 then exit;
if y>479 then exit;
dot360x480(x,y,hue);
end;
Procedure dopal; {define palette}
var iback,i3,i,j:integer;
dir,which:byte;
begin
pal[0]:=0;
pal[1]:=0;
pal[2]:=0;
pal[3]:=random(10)+26;
pal[4]:=random(10)+26;
pal[5]:=random(10)+26;
counter:=0;
r:=pal[3];
g:=pal[4];
b:=pal[5];
for i:=1 to 255 do
begin
bump(r,g,b);
pal[i*3]:=r;
pal[i*3+1]:=g;
pal[i*3+2]:=b;
end;
end;
procedure installpal;
var pseg,pofs:word;
begin
pseg:=seg(pal);
pofs:=ofs(pal);
set360x480;
asm
mov ah,$10;
mov al,$12;
mov bx,0;
mov cx,256;
mov dx,pofs;
mov es,pseg;
int $10;
end;
end;
Procedure adjust(xa,ya,x,y,xb,yb:Integer);
Var
d,v:Integer;
begin
if read360x480(x,y)<>0 then
Exit;
d:=abs(xa-xb)+abs(ya-yb);
v:=trunc((read360x480(xa,ya)+read360x480(xb,yb))/2+
(random-0.5)*d*granularity);
if v<1 then
v:=1;
if v>=255 then
v:=255;
setpixel(x,y,v);
end;
Procedure subDivide(x1, y1, x2, y2:Integer);
Var
x, y:Integer;
v:Real;
begin
if KeyPressed then
Exit;
if (x2-x1 <2)and(y2-y1 <2) then
Exit;
x:=(x1+x2) div 2;
y:=(y1+y2) div 2;
adjust(x1,y1,x,y1,x2,y1);
adjust(x2,y1,x2,y,x2,y2);
adjust(x1,y2,x,y2,x2,y2);
adjust(x1,y1,x1,y,x1,y2);
if read360x480(x,y)=0 then
begin
v:=(read360x480(x1,y1)+read360x480(x2,y1)+read360x480(x2,y2)+
read360x480(x1,y2))/4;
setpixel(x,y,Trunc(v));
end;
SubDivide(x1,y1,x,y);
subDivide(x,y1,x2,y);
subDivide(x,y,x2,y2);
subDivide(x1,y,x,y2);
end;
begin
randomize;
dopal;
installpal;
Randomize;
setpixel(0,0,1+random(255));
setpixel(359,0,1+random(255));
setpixel(359,479,1+random(255));
setpixel(0,479,1+random(255));
SubDivide(0,0,359,479);
Repeat
cyclepalette(1,255);
Delay(DelayFactor);
If KeyPressed then
Case ReadKey of
#0:Case ReadKey of
#80,#75:If DelayFactor<255 then Inc(DelayFactor);{down,left}
#72,#77:If DelayFactor>0 then Dec(DelayFactor);{up,right}
end;
#113,#81,#27 {Q,q}:EndProgram:=True;
'p':for i:=0 to 86 do
begin
write(lst,i*3,': ',pal[i*9],',',pal[i*9+1],',',pal[i*9+2],' ');
write(lst,pal[i*9+3],',',pal[i*9+4],',',pal[i*9+5],' ');
writeln(lst,pal[i*9+6],',',pal[i*9+7],',',pal[i*9+8]);
end;
end;
Until EndProgram;
TextMode(lastmode);
end.
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]