Uses Crt;

CONST VGA=$a000;

Var Pall,Pall2 : Array[0..255,1..3] of Byte;

{--------------------------------------------------------------------------}
Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
BEGIN
  asm
     mov        ax,0013h
     int        10h
  end;
END;


{--------------------------------------------------------------------------}
Procedure SetText;  { This procedure returns you to text mode.  }
BEGIN
  asm
     mov        ax,0003h
     int        10h
  end;
END;


{--------------------------------------------------------------------------}
procedure WaitRetrace; assembler;

label
  l1, l2;
asm
    mov dx,3DAh
l1:
    in al,dx
    and al,08h
    jnz l1
l2:
    in al,dx
    and al,08h
    jz  l2
end;


{--------------------------------------------------------------------------}
Procedure GetPal(ColorNo : Byte; Var R,G,B : Byte);
Begin
   Port[$3c7] := ColorNo;
   R := Port[$3c9];
   G := Port[$3c9];
   B := Port[$3c9];
End;


{--------------------------------------------------------------------------}
Procedure Pal(ColorNo : Byte; R,G,B : Byte);
Begin
   Port[$3c8] := ColorNo;
   Port[$3c9] := R;
   Port[$3c9] := G;
   Port[$3c9] := B;
End;


{--------------------------------------------------------------------------}
Procedure Putpixel (X,Y : Integer; Col : Byte);
BEGIN
  Mem [VGA:X+(Y*320)]:=Col;
END;


{--------------------------------------------------------------------------}
Procedure line(a,b,c,d,col:integer);
   Function sgn(a:real):integer;
   BEGIN
        if a>0 then sgn:=+1;
        if a<0 then sgn:=-1;
        if a=0 then sgn:=0;
   END;
var u,s,v,d1x,d1y,d2x,d2y,m,n:real;
    i:integer;
BEGIN
     u:= c - a;
     v:= d - b;
     d1x:= SGN(u);
     d1y:= SGN(v);
     d2x:= SGN(u);
     d2y:= 0;
     m:= ABS(u);
     n := ABS(v);
     IF NOT (M>N) then
     BEGIN
          d2x := 0;
          d2y := SGN(v);
          m := ABS(v);
          n := ABS(u);
     END;
     s := INT(m / 2);
     FOR i := 0 TO round(m) DO
     BEGIN
          putpixel(a,b,col);
          s := s + n;
          IF not (s<m) THEN
          BEGIN
               s := s - m;
               a:= a +round(d1x);
               b := b + round(d1y);
          END
          ELSE
          BEGIN
               a := a + round(d2x);
               b := b + round(d2y);
          END;
     END;
END;


{--------------------------------------------------------------------------}
Procedure PalPlay;
Var Tmp : Array[1..3] of Byte;
  { This is used as a "temporary color" in our pallette }
    loop1 : Integer;
BEGIN
   Move(Pall[200],Tmp,3);
     { This copies color 200 from our virtual pallette to the Tmp variable }
   Move(Pall[0],Pall[1],200*3);
     { This moves the entire virtual pallette up one color }
   Move(Tmp,Pall[0],3);
     { This copies the Tmp variable to the bottom of the virtual pallette }
   WaitRetrace;
   For loop1:=1 to 255 do
     pal (loop1,pall[loop1,1],pall[loop1,2],pall[loop1,3]);
END;


{--------------------------------------------------------------------------}
Procedure SetUpScreen;
Var Loop : Integer;
BEGIN
   FillChar(Pall,SizeOf(Pall),0);
       { Clear the entire PALL variable to zero. }
   For Loop := 0 to 200 do BEGIN
      Pall[Loop,1] := Loop mod 64;
   END;
       { This sets colors 0 to 200 in the PALL variable to values between
         0 to 63. the MOD function gives you the remainder of a division,
         ie. 105 mod 10 = 5 }

   For Loop := 1 to 320 do BEGIN
      Line(319,199,320-Loop,0,(Loop Mod 199)+1);
      Line(0,0,Loop,199,(Loop Mod 199)+1);
       { These two lines start drawing lines from the left and the right
         hand sides of the screen, using colors 1 to 199. Look at these
         two lines and understand them. }
      PalPlay;
        { This calls the PalPlay procedure }
   END;
END;


{--------------------------------------------------------------------------}
Procedure GrabPallette;
VAR loop1:integer;
BEGIN
  For loop1:=0 to 255 do
    Getpal (loop1,pall2[loop1,1],pall2[loop1,2],pall2[loop1,3]);
END;



{--------------------------------------------------------------------------}
Procedure Blackout;
  { This procedure blackens the screen by setting the pallette values of
    all the colors to zero. }
VAR loop1:integer;
BEGIN
  WaitRetrace;
  For loop1:=0 to 255 do
    Pal (loop1,0,0,0);
END;


{--------------------------------------------------------------------------}
Procedure HiddenScreenSetup;
VAR loop1,loop2:integer;
BEGIN
  For loop1:=0 to 319 do
    For loop2:=0 to 199 do
      PutPixel (loop1,loop2,Random (256));
END;


{--------------------------------------------------------------------------}
Procedure Fadeup;
VAR loop1,loop2:integer;
    Tmp : Array [1..3] of byte;
      { This is temporary storage for the values of a color }
BEGIN
  For loop1:=1 to 64 do BEGIN
      { A color value for Red, green or blue is 0 to 63, so this loop only
        need be executed a maximum of 64 times }
    WaitRetrace;
    For loop2:=0 to 255 do BEGIN
      Getpal (loop2,Tmp[1],Tmp[2],Tmp[3]);
      If Tmp[1]<Pall2[loop2,1] then inc (Tmp[1]);
      If Tmp[2]<Pall2[loop2,2] then inc (Tmp[2]);
      If Tmp[3]<Pall2[loop2,3] then inc (Tmp[3]);
        { If the Red, Green or Blue values of color loop2 are less then they
          should be, increase them by one. }
      Pal (loop2,Tmp[1],Tmp[2],Tmp[3]);
        { Set the new, altered pallette color. }
    END;
  END;
END;


{--------------------------------------------------------------------------}
Procedure FadeDown;
VAR loop1,loop2:integer;
    Tmp : Array [1..3] of byte;
      { This is temporary storage for the values of a color }
BEGIN
  For loop1:=1 to 64 do BEGIN
    WaitRetrace;
    For loop2:=0 to 255 do BEGIN
      Getpal (loop2,Tmp[1],Tmp[2],Tmp[3]);
      If Tmp[1]>0 then dec (Tmp[1]);
      If Tmp[2]>0 then dec (Tmp[2]);
      If Tmp[3]>0 then dec (Tmp[3]);
        { If the Red, Green or Blue values of color loop2 are not yet zero,
          then, decrease them by one. }
      Pal (loop2,Tmp[1],Tmp[2],Tmp[3]);
        { Set the new, altered pallette color. }
    END;
  END;
END;


{--------------------------------------------------------------------------}
Procedure RestorePallette;
VAR loop1:integer;
BEGIN
  WaitRetrace;
  For loop1:=0 to 255 do
    pal (loop1,Pall2[loop1,1],Pall2[loop1,2],Pall2[loop1,3]);
END;


BEGIN
  SetMCGA;
  GrabPallette;
  SetUpScreen;
  repeat
     PalPlay;
       { Call the PalPlay procedure repeatedly until a key is pressed. }
  Until Keypressed;
  RestorePallette;
  SetText;
END.