{> Cut here. FileName= WATER.PAS }
Program Water;
{Ничего не USES}

type Tscr=array[0..199,0..319] of byte;
     SegmentT = Array[0..65534] of byte;
     Tsegment = ^SegmentT;
var
  ilx,ily:integer;
  key,amp,mul,i,j,k,nx,ny,nz,rx,ry,x,y,lx,ly,x1,y1:integer;
  MANUAL:BOOLEAN;
  tx,ty,tz:real;
  time:integer;

var segm,offs:integer;
 Segment : Tsegment;
 frame:integer;
 screen,buffer,wave:word;
 buf,scr:pointer;
 sintab:array[0..255] of integer;
 multab:array[0..319] of integer;

Procedure GetSegment(VAR segname:Tsegment;VAR add : word);
begin
 GetMem (Segname,65535);
 add := seg (Segname^);
end;

Procedure wait; assembler;
asm mov dx,3DAh;
@l1:in al,dx
    and al,08h
    jnz @l1
@l2:in al,dx
    and al,08h
    jz @l2
end;

Procedure SetMode (Mode : word);assembler;
asm
 mov ax,Mode
 int 10h
end;

Procedure FillBox(x,y,w,h:integer; color:byte);
var i,j,k:integer;
begin
 for j:=y to y+h-1 do
  for i:=x to x+w-1 do
   mem[buffer:i+j*320]:=color;
end;

Procedure Print(x,y:integer; s:string; xs,ys:integer; color:byte);
var i,j,k,c,px,py:integer; b:byte;
begin
 px:=x;
 py:=y;
 for k:=1 to length(s) do begin
  c:=ord(s[k]);
  for i:=0 to 7 do begin
   b:=mem[segm:offs+c*8+i];
   for j:=0 to 7 do begin
    if b shl j and 128<>0 then FillBox(x,y,xs,ys,color);
    x:=x+xs;
   end;
   x:=px;
   y:=y+ys;
  end;
  y:=py;
  px:=px+xs*8;
  x:=px;
 end;
end;

Procedure SetGradientPalette;
var k,r,g,b:byte;
begin
 asm
  mov  dx,03c8h
  xor  al,al
  out  dx,al
 end;
 r:=0;
 g:=0;
 for k:=0 to 255 do begin
  b:=(k*63 div 255);
  r:=b;
  g:=b;{}{ if k>200 then begin r:=r+1;g:=g+1;end;{}
  asm
   mov dx,03c9h
   mov al,r
   out dx,al
   mov al,g
   out dx,al
   mov al,b
   out dx,al
  end;
 end;
end;

Procedure Blur;
var i,j,k,jt:integer;
begin
 jt:=0;
 for j:=0 to 199 do begin
  for i:=0 to 319 do
   mem[buffer:i+jt]:=( mem[buffer:(i+1)+jt]+
                       mem[buffer:(i-1)+jt]+
                       mem[buffer:i+(jt+320)]+ 
                       mem[buffer:i+(jt-320)]) shr 2;
  jt:=jt+320;
 end;
end;

Procedure Clearbuffer(buffer:word);
var i:word;
begin
 for i:=0 to 63999 do mem[buffer:i]:=0;
end;

Procedure CopyBuffer(Buffer:word);assembler;
asm
 push ds
 mov ax,buffer
 mov ds,ax
 mov ax,$0a000
 mov es,ax
 xor di,di
 xor si,si
 mov cx,32000
 cld
 db $66
 rep movsw
 pop ds
end;

Procedure DrawWave(mx,my,amp:integer);
var x,y,yt,px,py:integer;
begin
 yt:=0;
 for y:=0 to 199 do begin
  px:=-mx;
  py:=(y-my)*(y-my);
  for x:=0 to 319 do begin
   inc(px);
   py:=py+px;
   mem[wave:x+yt]:=sintab[(frame+(py div mul)) and 255] div amp;
  end;
  yt:=yt+320;
 end;
end;

Procedure DrawPic;
var x,y,yt,px,py,mx,my:integer;
begin
 yt:=320*20;
 for y:=20 to 199-20 do begin
  for x:=0 to 319 do begin
   px:=x+(mem[wave:(x-1)+yt]-mem[wave:(x+1)+yt]);
   py:=y+(mem[wave:x+(yt-320)]-mem[wave:x+(yt+320)]);
   mem[screen:x+yt]:=mem[buffer:multab[py]+px];{}
  end;
  yt:=yt+320;
 end;
end;

BEGIN
 {Достанем адрес знакогенератора}
 asm
  mov ax,$1130
  mov bh,03h
  int 10h
  mov segm,es
  mov offs,bp
 end;
 {установим режим и палитру}
 setmode($13);
 setgradientpalette;

 screen:=$0a000;
 GetSegment(Segment,buffer);
 GetSegment(Segment,wave);

 frame:=1;
 clearbuffer(buffer);

 for i:=0 to 30000 do fillbox(random(320),random(200),1,1,255);{}
 blur;blur;blur;blur;blur;blur;blur;blur;
 print(56,50,'WAVE',7,7,255);
 print(60,115,'TRANSFORM',3,4,255);
 blur;
 for i:=0 to 255 do sintab[i] := round(cos(2 * PI * i / 256) * 127 +128);
 for i:=0 to 320 do multab[i] :=i * 320;

 ilx:=5;
 ily:=5;
 lx:=160;
 ly:=100;

 frame:=1;
 amp:=4;
 mul:=64;
 time:=0;

 REPEAT
  {clearbuffer(wave);}

  memw[$000:$041a]:=memw[$000:$041c];
  key:=port[$60];
  case key of
  82: inc(mul);
  83: if mul<>1 then dec(mul);
  71: begin  if (amp<>1) then dec(amp); end;
  79: begin  inc(amp); end;
  {73: iz :=  1;   81: iz := -1;}
  56: if not manual then begin  manual:=true;end;
  57: if manual then begin clearbuffer(screen);manual:=false;end;
  end;

  DrawWave(lx,ly,amp);{}
  if not manual then DrawPic;{}

  if manual then copybuffer(wave);{}
  frame:=frame-25;
  {
  lx:=lx+ilx;if (lx>270) or (lx<50) then ilx:=-ilx;
  ly:=ly+ily;if (ly>150) or (ly<50) then ily:=-ily;
  }
  wait;
  inc(time);
 UNTIL port[$60]=1;{ESC}
 {сбросим буфер клавиатуры}
 memw[$000:$041a]:=memw[$000:$041c];
 setmode($3);
END.