home *** CD-ROM | disk | FTP | other *** search
/ Intermedia 1998 January / inter1_98.iso / www / rozi / PIASEK.ZIP / PIASEK.PAS next >
Pascal/Delphi Source File  |  1997-01-21  |  3KB  |  122 lines
  1. const
  2.   maxgrains = 199;
  3. type
  4.   data   = (x,y,c);
  5. var
  6.   sand   : array[0..maxgrains,x..c]of integer;
  7.   bottom : array[0..639,0..1]of integer;
  8.   grains,source : integer;
  9. procedure movedown(i : integer);
  10. var
  11.   moved : boolean;
  12.   j : integer;
  13.   procedure totheleft;
  14.   var
  15.     j : integer;
  16.   begin
  17.     for j:=1 to sand[i,c] do
  18.       if (sand[i,y]>bottom[sand[i,x]-j,0]+1) and (sand[i,x]>8) then
  19.       begin
  20.         dec(sand[i,x],j);
  21.         sand[i,y]:=bottom[sand[i,x],0]+1;
  22.         moved:=true;
  23.         EXIT
  24.       end;
  25.   end;
  26.   procedure totheright;
  27.   var
  28.     j : integer;
  29.   begin
  30.     for j:=1 to sand[i,c] do
  31.       if (sand[i,y]>bottom[sand[i,x]+j,0]+1) and (sand[i,x]<632)  then
  32.       begin
  33.         inc(sand[i,x],j);
  34.         sand[i,y]:=bottom[sand[i,x],0]+1;  {}
  35.         moved:=true;
  36.         EXIT
  37.       end;
  38.   end;
  39. begin
  40.   moved:=false;
  41.   if random(2)<>0 then
  42.   begin
  43.     totheleft;
  44.     if not moved then totheright;
  45.   end
  46.   else
  47.   begin
  48.     totheright;
  49.     if not moved then totheleft;
  50.   end;
  51.   if moved then movedown(i)
  52. end;
  53. procedure pour;
  54. var
  55.   i : integer;
  56.   addr : word;
  57.   dummy : byte;
  58.   px,py,pc : integer;
  59. begin
  60.   for i:=0 to grains do
  61.   begin
  62.     dec(sand[i,y],sand[i,c]);
  63.     if sand[i,y] shr 4<=bottom[sand[i,x],0] then
  64.     begin
  65.       sand[i,y]:=bottom[sand[i,x],0]+1;
  66.       movedown(i);
  67.       px:=sand[i,x];
  68.       py:=sand[i,y];
  69.       pc:=sand[i,c];
  70.       bottom[px,0]:=py;
  71.       bottom[px,1]:=pc;
  72.       Port[$3CE]:=08;
  73.       Port[$3CF]:=$80 shr (px and 7);   { Bit Mask }
  74.       addr:=80*(480-py)+px shr 3;
  75.       dummy:=mem[$A000:addr];           { load latches }
  76.       mem[$A000:addr]:=Lo(17-pc shl 1); { PutPixel - write mode #2 }
  77.       move(sand[grains],sand[i],6);
  78.       dec(grains);
  79.     end;
  80.   end;
  81.   while grains<maxgrains do
  82.   begin
  83.     inc(grains);
  84.     sand[grains,x]:=source;
  85.     sand[grains,y]:=16*400;
  86.     sand[grains,c]:=1+random(8);
  87.   end;
  88. end;
  89. procedure colors16;
  90. var
  91.   i : integer;
  92. begin
  93.   Port[$3C8]:=0;
  94.   for i:=0 to 15 do
  95.   begin
  96.     Port[$3C9]:=3+4*i;
  97.     Port[$3C9]:=3+4*i;
  98.     Port[$3C9]:=3+4*i;
  99.     port[$3C0]:=i;
  100.     port[$3C0]:=i;
  101.   end;
  102.   port[$3C0]:=$30;
  103. end;
  104. begin
  105.   asm mov ax,12h; int 10h end;
  106.   randomize;
  107.   colors16;
  108.   Port[$3C4]:=02;  Port[$3C5]:=$0F;
  109.   Port[$3CE]:=05;  Port[$3CF]:=(Port[$3CF] and $FD) or 2;
  110.   fillchar(sand,sizeof(sand),#0);
  111.   fillchar(bottom,sizeof(bottom),#0);
  112.   grains:=0;
  113.   source:=30+random(600);
  114.   sand[grains,x]:=source;
  115.   sand[grains,y]:=16*400;
  116.   sand[grains,c]:=1;
  117.   repeat
  118.     pour;
  119.     if random(10000)>9997 then source:=30+random(600)
  120.   until port[$60]=1;
  121.   asm mov ax,03h; int 10h end;
  122. end.