home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Intermedia 1998 January
/
inter1_98.iso
/
www
/
rozi
/
PIASEK.ZIP
/
PIASEK.PAS
next >
Wrap
Pascal/Delphi Source File
|
1997-01-21
|
3KB
|
122 lines
const
maxgrains = 199;
type
data = (x,y,c);
var
sand : array[0..maxgrains,x..c]of integer;
bottom : array[0..639,0..1]of integer;
grains,source : integer;
procedure movedown(i : integer);
var
moved : boolean;
j : integer;
procedure totheleft;
var
j : integer;
begin
for j:=1 to sand[i,c] do
if (sand[i,y]>bottom[sand[i,x]-j,0]+1) and (sand[i,x]>8) then
begin
dec(sand[i,x],j);
sand[i,y]:=bottom[sand[i,x],0]+1;
moved:=true;
EXIT
end;
end;
procedure totheright;
var
j : integer;
begin
for j:=1 to sand[i,c] do
if (sand[i,y]>bottom[sand[i,x]+j,0]+1) and (sand[i,x]<632) then
begin
inc(sand[i,x],j);
sand[i,y]:=bottom[sand[i,x],0]+1; {}
moved:=true;
EXIT
end;
end;
begin
moved:=false;
if random(2)<>0 then
begin
totheleft;
if not moved then totheright;
end
else
begin
totheright;
if not moved then totheleft;
end;
if moved then movedown(i)
end;
procedure pour;
var
i : integer;
addr : word;
dummy : byte;
px,py,pc : integer;
begin
for i:=0 to grains do
begin
dec(sand[i,y],sand[i,c]);
if sand[i,y] shr 4<=bottom[sand[i,x],0] then
begin
sand[i,y]:=bottom[sand[i,x],0]+1;
movedown(i);
px:=sand[i,x];
py:=sand[i,y];
pc:=sand[i,c];
bottom[px,0]:=py;
bottom[px,1]:=pc;
Port[$3CE]:=08;
Port[$3CF]:=$80 shr (px and 7); { Bit Mask }
addr:=80*(480-py)+px shr 3;
dummy:=mem[$A000:addr]; { load latches }
mem[$A000:addr]:=Lo(17-pc shl 1); { PutPixel - write mode #2 }
move(sand[grains],sand[i],6);
dec(grains);
end;
end;
while grains<maxgrains do
begin
inc(grains);
sand[grains,x]:=source;
sand[grains,y]:=16*400;
sand[grains,c]:=1+random(8);
end;
end;
procedure colors16;
var
i : integer;
begin
Port[$3C8]:=0;
for i:=0 to 15 do
begin
Port[$3C9]:=3+4*i;
Port[$3C9]:=3+4*i;
Port[$3C9]:=3+4*i;
port[$3C0]:=i;
port[$3C0]:=i;
end;
port[$3C0]:=$30;
end;
begin
asm mov ax,12h; int 10h end;
randomize;
colors16;
Port[$3C4]:=02; Port[$3C5]:=$0F;
Port[$3CE]:=05; Port[$3CF]:=(Port[$3CF] and $FD) or 2;
fillchar(sand,sizeof(sand),#0);
fillchar(bottom,sizeof(bottom),#0);
grains:=0;
source:=30+random(600);
sand[grains,x]:=source;
sand[grains,y]:=16*400;
sand[grains,c]:=1;
repeat
pour;
if random(10000)>9997 then source:=30+random(600)
until port[$60]=1;
asm mov ax,03h; int 10h end;
end.