{$M 8192,0,4096}
uses dos;

{ gestione mem video }(**)
 type
  CrtCell = record Ch,At: byte; end;
  CrtMap  = array [1..50,1..80] of CrtCell;
 var
  CrtMem : CrtMap absolute $B800:$0000;
(**)

{ palette (cambiatela, fa schifo) e procedura di refresh }
 const
  col : array[0..15] of
   byte = ( 9, 1, 8, 7,15,14,12, 4, 5,13, 1, 9, 2,10 ,11, 3);

 var
  g   : integer;
  x,y : longint;
  z,a,b,c,d: real;
  maxrighe : byte;

{ gestione timer... oscena ma funziona }
 const
  OldTimerInt = 103;
 var
  FTmr : record
          Freq,
          Counter : Word;
         end;

 Procedure SetTimer(Rout : Pointer; Freq : Word);
  var
   ICnt: Word;
   OldV: Pointer;
  begin
   Inline($FA);                 { CLI, interrupts off }
   ICnt:=1193180 Div Freq;      { calculate basic counter }
   Port[$43]:=$36;              { set mode }
   Port[$40]:=Lo(ICnt);         { write LSB }
   Port[$40]:=Hi(ICnt);         { write MSB }
   GetIntVec(8,OldV);           { old int vector }
   SetIntVec(OldTimerInt,OldV); { int 8 now Int OldT }
   SetIntVec(8,Rout);           { new int handler }
   Inline($FB);                 { STI, interrupts on }
  end;

 Procedure HandleTimer; far;
  var
   R : Registers;
  begin
   Dec(FTmr.Counter);
   If FTmr.Counter = 0 Then
    Begin
     Intr(OldTimerInt,R);
     FTmr.Counter:= FTmr.Freq div 18;
    End
   Else Port[$20]:=$20;
  end;


 procedure Refresh; interrupt;
  begin
   inc (g);
   for y := 1 to maxrighe do
    for x := 1 to 80 do
     begin
      a := 6 * cos(g/250);
      b := 5 * sin(g/270);
      c := 22 * cos( x/35 + a/3 - 10 * sin(b/10) / cos(b/10) );
      d := 25 * cos( y/45 + b );
      z  := a*(b+c+d) + b*(a+c+d) + c*(a+b+d) + d*(a+b+c);
      z  := z/20 + x + y + g/2;
      z  := z/10;
      CrtMem[y,x].at := (CrtMem[y,x].at and 240) + col[ trunc(z) and 15 ];
     end;
   HandleTimer;
  end;

 begin
  if ParamCount > 0 then Val(ParamStr(1),maxrighe,g);
  if not (maxrighe in [1..50]) then maxrighe := 25;

  FTmr.Counter := 1;
  SetTimer(@Refresh,38);

  (**) Keep(0); (**)
 end.