{$A+,B-,E+,F-,G+,N+,Q-,R-,S-}

program snoww;

Const VGA=$A000;
      Npages=2;
      MinX=0;
      MaxX=319;
      MinY=0;
      MaxY=199;

Type RgbItem=Record
                   R,G,B:Byte;
             End;
     RgbList=Array[0..255] of RgbItem;
     Table=Array[0..1799] Of integer;
     PTable=^Table;

Var Sines:Ptable;
    Cosines:Ptable;
    Virt:Array[1..Npages] Of Pointer;
    VP:Array[1..Npages] Of Word;

Procedure video_mode (mode : Byte); Assembler;
Asm
  mov  AH,00
  mov  AL,mode
  int  10h
end;

Procedure Cls(Col:Byte;Where:Word);
Begin
     Fillchar(Mem[Where:0000],64000,Col);
End;

Procedure WaitVBL; Assembler;
Label A1,A2;
Asm
   Mov DX,3DAh
   A1:
      In AL,DX
      And AL,08h
      Jnz A1
   A2:
      In AL,DX
      And AL,08h
      Jz A2
End;

Procedure GetColor(Col:Byte;Var R,G,B:Byte);
Begin
     Port[$3C7]:=Col;
     R:=Port[$3C9];
     G:=Port[$3C9];
     B:=Port[$3C9];
End;

Procedure SetColor(Col,R,G,B:Byte);
Begin
     Port[$3C8]:=Col;
     Port[$3C9]:=R;
     Port[$3C9]:=G;
     Port[$3C9]:=B;
End;

Procedure InitTables;
Var A:Word;
    B:Real;
Begin
     Getmem(Sines,Sizeof(Sines^));
     Getmem(Cosines,Sizeof(Cosines^));
     B:=0;
     For A:=0 To 1799 Do
     Begin
          Sines^[A]:=round(Sin(B)*100);
          Cosines^[A]:=round(Cos(B)*100);
          B:=B+0.005;
     End;
End;

Procedure ClearTables;
Begin
     Freemem(Sines,Sizeof(Sines^));
     Freemem(Cosines,Sizeof(Cosines^));
End;

Procedure InitVirt;
Var A:Byte;
Begin
     For A:=1 To Npages Do
     Begin
          GetMem(Virt[A],64000);
          VP[A]:=Seg(Virt[A]^);
     End;
End;

Procedure CloseVirt;
Var A:Byte;
Begin
     For A:=1 To Npages Do
     Begin
          Freemem(Virt[A],64000);
          VP[A]:=$A000;
     End;
End;

Function GetKey (Var Key : Word) : Boolean; Assembler;
{ determine if key pressed and return it as a Word }
{ if Lo(key) = 0 and Hi(key) <> 0 then we have a FN key ! }
Asm
  MOV     AH, 1
  INT     16H
  MOV     AL, 0
  JE      @@1
  xor     AH, AH
  INT     16H
  LES     DI, Key
  MOV     Word PTR ES : [DI], AX
  MOV     AL, 1
 @@1 :
end;

Function GetChar (Var Key : Char) : Boolean;
var c : Word;
begin
  Key := #0;
  if GetKey (c) then
  begin
    GetChar := True;
    if (LO (c) = 0) and (HI (c) <> 0) then
      Key := CHR ( HI (c) + 128 )  { add 128 For FN keys }
    else
      Key := CHR (LO (c) );
  end
  else
    GetChar := False;
end;

type flake=record
                 x,y:real;
                 c:integer;
           end;

const nflakes=4500;

var c:char;
    snow:array[0..nflakes] of flake;
    a:integer;

begin
     video_mode ( $13);
     initvirt;
     inittables;

     for a:=0 to 255 do setcolor (a,a div 4,a div 4, a div 4);

     for a:=0 to nflakes do snow[a].x:=random(320);
     for a:=0 to nflakes do snow[a].y:=random(200);
     for a:=0 to nflakes do snow[a].c:=random(255)+1;
     randomize;

     repeat

     cls (0,vp[1]);
     for a:=0 to nflakes do
         begin
              snow[a].x:=snow[a].x+(random(snow[a].c) / snow[a].c)-0.5;
              snow[a].y:=snow[a].y+(random(snow[a].c) / 256);
              if snow[a].x>320 then snow[a].x:=0;
              if snow[a].y>200 then snow[a].y:=0;
              mem[vp[1]:round(snow[a].x)+round(snow[a].y)*320]:=snow[a].c;
         end;

     waitvbl;
     move (mem[vp[1]:0],mem[vga:0],64000);


      if getchar(c)=true then c:=#27;
     until c=#27;


     cleartables;
     closevirt;
     video_mode ( 03);
end.