{$G+}
unit plasma;

interface

Uses Crt, MemGrfx;

var
  stab:array[0..255] of byte;
  address,x,y:word;
  i1,i2,j1,j2,c:byte;

procedure doplasma;
procedure initplasma;

implementation

procedure doplasma; assembler;
const vseg:word=$a000;
asm
  mov es,vseg
 @run:
  call waitretrace
  add i1,1
  add j1,1
  mov si,5
  mov ax,si
  shl ax,6
  mov di,ax
  shl ax,4
  add di,ax
  add di,20
 @l0:
  xor bh,bh
  mov bl,i1
  add bx,si
  and bx,$ff
  mov dl,byte ptr stab[bx]
  xor bh,bh
  mov bl,j1
  mov dh,byte ptr stab[bx]
  mov cx,10
 @l1:
  mov bx,dx
  add bx,cx
  xor bh,bh
  mov al,byte ptr stab[bx]
  mov bx,dx
  shr bx,8
  add bx,si
  xor bh,bh
  add al,byte ptr stab[bx]
  mov ah,al
  mov [es:di],ax
  add di,2
  add ax,$1010
  mov [es:di],ax
  add di,318
  mov [es:di],ax
  sub ax,$1010
  add di,2
  mov [es:di],ax
  sub di,318
  inc cx
  cmp cx,80
  jne @l1
  add di,360
  inc si
  cmp si,85
  jne @l0
  in al,$60
  cmp al,$80
  ja @run
end;

procedure initplasma;
Var Count: Integer;
Begin
  Count:=0;
  SetMcga;
  for x:=0 to 255 do
	stab[x]:=round(sin(2*pi*x/255)*128)+128;
  i1:=random(100); j1:=random(100); address:=0;
  for x:=0 to 255 do begin
	 setpalt(x,x div 2,x div 2,x div 2);
	 setpalt(x,x div 2,x div 2,x div 2);
	 setpalt(x,x div 2,x div 2,x div 2);
	 setpalt(x,x div 2,x div 2,x div 2);
  end;
  repeat
	doplasma;
	Inc(Count);
  until (EscPressed=True) Or (Count = 5);
  FadeOut;
end;

End.