
{ The SVGA driver "Svga256.bgi" is on my Pascal Page }
{ http://www.universal.nl/users/dickmann/pascal.htm }

program board;

uses crt,graph;

var
  x,y,xx,yy,p,pp,q :integer;
  ch               :char;


Procedure RGB(Color,wr,wg,wb : Byte);

begin
  Port[$3C8]:=Color;
  Port[$3C9]:=wr;
  Port[$3C9]:=wg;
  Port[$3C9]:=wb;
end;

procedure stars(x,y,xx,yy,aantal :integer);

begin
  randomize;
  for p :=1 to aantal do
    putpixel(random(xx-(x-1))+x,random(yy-(y-1))+y,random(12)+20);
end;

procedure draw_board;

begin
  clearviewport;
  setrgbpalette(8,7,7,7);
  setrgbpalette(1,0,0,60);
  setfillstyle(1,192);
  bar(0,240,639,479);
  stars(0,0,639,239,500);

  settextstyle(0,0,2);
  setcolor(10);outtextxy(170,100,'ESCAPE IS STOP DEMO');
  setcolor(2);outtextxy(171,101,'ESCAPE IS STOP DEMO');
  settextstyle(0,0,3);
  setcolor(7);outtextxy(180,150,'PALETTE DEMO');
  setcolor(192);outtextxy(181,151,'PALETTE DEMO');

  setcolor(7);
  y :=0;
  for p :=1 to 7 do begin
    line(0,240+y,639,240+y);
    inc(y,(p*10));
  end;
  x :=320;xx :=320;y :=320;yy :=320;
  for p :=1 to 32 do begin
    line(x,240,xx,479);line(y,240,yy,479);
    inc(x,20);inc(xx,80);
    dec(y,20);dec(yy,80);
  end;

  { BLUE COLORS }
  setfillstyle(1,128);
  x :=5;y :=241;for p :=1 to 16 do begin floodfill(x,y,7);inc(x,40);end;
  x :=15;y :=255;for p :=1 to 15 do begin floodfill(x,y,7);inc(x,48);end;
  x :=0;y :=275;for p :=1 to 12 do begin floodfill(x,y,7);inc(x,56);end;
  x :=10;y :=303;for p :=1 to 9 do begin floodfill(x,y,7);inc(x,71);end;
  x :=60;y :=353;for p :=1 to 7 do begin floodfill(x,y,7);inc(x,92);end;
  x :=60;y :=395;for p :=1 to 6 do begin floodfill(x,y,7);inc(x,115);end;
  x :=20;y :=460;for p :=1 to 5 do begin floodfill(x,y,7);inc(x,151);end;
end;

Procedure wait(ms : Word); Assembler;
Asm
  mov ax, 1000;
  mul ms;
  mov cx, dx;
  mov dx, ax;
  mov ah, $86;
  int $15;
end;

procedure run;

begin
  repeat
    for p :=63 downto 0 do begin
      rgb(128,0,0,p);
      rgb(192,63-p,0,0);
      if keypressed then exit;
      wait(50);
    end;

    for p :=0 to 63 do begin
      rgb(128,0,0,p);
      rgb(192,63-p,0,0);
      if keypressed then exit;
      wait(50);
    end;
  until keypressed;
end;

procedure screen;

var
  AutoDetect : pointer;
  GrMd,GrDr  : integer;

{$F+}
function DetectVGA2 : Integer;
begin
  detectvga2 :=2;
end;
{$F-}

begin
  AutoDetect := @DetectVGA2;
  GrDr := InstallUserDriver('SVGA256',AutoDetect);
  GrDr := Detect;
  InitGraph(GrDr,GrMd,'');
end;

begin
  screen;                       { screen 640x480x256 }
  rgb(128,0,0,63);
  rgb(192,0,0,0);
  draw_board;
  run;
  closegraph;
  halt;
end.