{very lamie!!! I used anivga unit, because there was a famous simple
 method of scroll with nice fonts, but it have some trouble with faster
 computers (P200)   ;-(((} 
program scrolly;
uses anivga,crt;
const
      FirstSpriteNumber=100;
      FireFontData='fire.fnt';      {path & name of the font to load}
      FireFontPal ='FIRE.PAL';      {corresponding palette}
      ch:CHAR=#0;                   {sets ch to that value everytime the program starts}

      NofStars = 50;
      ZFactor = 150;
      Xc = 160;
      Yc = 100;

type StarRec = record
           X,Y,Z : integer;
           end;
 StarPos = array[0..NofStars] of StarRec;
 StarSpd = array[0..NofStars] of word;
 PaletteType = Array[0..255,1..3] of Byte;

var
 tempPal:Palette;
 nr,x,y,i,j:INTEGER;
  Stars : StarPos;
  Speed : StarSpd;
  ActivePal : Palette;
  stop:boolean;


{==========================================================}
procedure waitretrace;
begin
    while (port[$3da] and 8) <> 8 do;
    while (port[$3da] and 8) = 8 do;
end;

procedure fade1;
var a,b:integer;
begin
  for a:= 0 to 255 do
   begin
    If activepal[a].red > temppal[a].red then
     temppal[a].red:=(temppal[a].red)+1;
    If activepal[a].green > temppal[a].green then
     temppal[a].green:=(temppal[a].green)+1;
    If activepal[a].blue > temppal[a].blue then
     temppal[a].blue:=(temppal[a].blue)+1;
   end;
   SetPalette(temppal,true);
end;


procedure fade2;
var a,b:integer;
begin
  for a:= 0 to 255 do
   begin
    If activepal[a].red > temppal[a].red then
     dec(activepal[a].red);
    If activepal[a].green > temppal[a].green then
     dec(activepal[a].green);
    If activepal[a].blue > temppal[a].blue then
     dec(activepal[a].blue);
   end;
   SetPalette(activepal,true);
end;




procedure initstars;
var   I : byte;
      pom:integer;
begin
  randomize;                                              { Initialize stars }
  for I := 0 to NofStars do begin
    pom:=random(100);
    Stars[I].X :=pom-50;
    pom:=random(100);
    Stars[I].Y := pom-50;
    pom:=random(200);
    Stars[I].Z := pom+200;
    Speed[I] := 0;
  end;
end;

{===============================}
procedure DoStars;

var
  Xs,Ys : word;
  Is,Color : byte;

procedure NewStar(Num : byte);
var pom:integer;
begin
  pom:=random(100);
  Stars[Num].X := pom-50;
  pom:=random(100);
  Stars[Num].Y := pom-50;
  pom:=random(100);
  Stars[Num].Z := pom+200;
end;

begin
   for Is := 0 to NofStars do begin                                  { Stars }
      Xs := Xc+round(Stars[Is].X*Stars[Is].Z/ZFactor);          {pevod 3d na xy}
      Ys := Yc+round(Stars[Is].Y*Stars[Is].Z/ZFactor);
      {if mem[$a000:Y*320+X] = 31 then mem[$a000:Y*320+X] := 0;}
      if BackgroundGetPixel(xs,ys)=31 then BackgroundPutPixel(xs,ys,0);
      Xs := Xc+round(Stars[Is].X*(Stars[Is].Z+Speed[Is])/ZFactor);
      Ys := Yc+round(Stars[Is].Y*(Stars[Is].Z+Speed[Is])/ZFactor);
      if (Xs > 0) and (Xs < 320) and (Ys > 0) and (Ys < 200) then
      begin
        Color := 31;
        {if mem[$a000:Y*320+X] = 0 then mem[$a000:Y*320+X] := Color;}
        if BackgroundGetPixel(xs,ys)=0 then BackgroundPutPixel(xs,ys,color);
      end                     {uz to vylezlo, generuj novou}
       else NewStar(Is);
      inc(Stars[Is].Z,Speed[Is]); if Stars[Is].Z > 20000 then NewStar(Is);
      Speed[Is] := (Stars[Is].Z div 150)*(5-(abs(Stars[Is].X*Stars[Is].Y) div 500));
    end;
end;

{=======================================}

procedure sprite_definicion(numb:integer);
begin
 SpriteN[nr]:=numb; SpriteX[nr]:=x-28; SpriteY[nr]:=y;
 INC(y,MaxFontHeight+8); INC(nr);
end;


PROCEDURE CheckFileErr(name:STRING);
{ in: Error = error value}
{     name  = file to deal with}
{out: If there was an error with the file, the program stops in a clean way}
BEGIN
 IF Error<>Err_None
  THEN BEGIN
        CloseRoutines;
        WRITELN('Couldn''t access file '+name+' : '+GetErrorMessage);
        halt(1)
       END;
END;

procedure skonci;
begin
 Closeroutines;
 halt(1);
end;

begin
 stop:=false;
 initstars;
 SetBackgroundMode(static);
 setcycletime(24);

 LoadFont(FireFontData); CheckFileErr(FireFontData);
 LoadPalette(FireFontPal,0,tempPal); CheckFileErr(FireFontPal);

 MakeTextSprite('GREETZ GO TO:',1);
 MakeTextSprite('----------------------',2);

 MakeTextSprite('PERSONS:',3);
 MakeTextSprite('El          (Pascal rulezz!)',4);
 MakeTextSprite('Axe',5);
 MakeTextSprite('Caveman     (graph unit)',5);
 MakeTextSprite('Fido',6);
 MakeTextSprite('Lzap',7);
 MakeTextSprite('Pizi',8);
 MakeTextSprite('Kai Rohbacher (ANI-VGA)',9);
 MakeTextSprite('Fuzzy',10);
 MakeTextSprite('Helix',11);
 MakeTextSprite('Denthor',12);
 MakeTextSprite('K!O',14);
 MakeTextSprite('ill',14);
 MakeTextSprite('coders of many sources,',13);
 MakeTextSprite('which I rip  :-)',14);

 MakeTextSprite('GROUPS:',15);
 MakeTextSprite('Iguana',16);
 MakeTextSprite('Incognita',17);
 MakeTextSprite('MOVSD',18);
 MakeTextSprite('Anaconda',19);
 MakeTextSprite('PipkaSoft',20);
 MakeTextSprite('Broncs',21);
 MakeTextSprite('Sector 31',22);
 MakeTextSprite('Spanish Lords',23);
 MakeTextSprite('Eclipse',24);


 MakeTextSprite('ANOTHER:',25);
 MakeTextSprite('INERTIA   (3D engine)',26);
 MakeTextSprite('Bzuk',27);
 MakeTextSprite('Fidel',28);
 MakeTextSprite('Michal T.',29);
 MakeTextSprite('Bohnice homiez',30);
 MakeTextSprite('my family',31);
 MakeTextSprite('and all jungle',32);
 MakeTextSprite('and Drum and Bass',33);
 MakeTextSprite('trackers from whole world,',34);
 MakeTextSprite('because jungle is not',35);
 MakeTextSprite('death style',36);
 MakeTextSprite('Sources come about month!!',37);
 MakeTextSprite('I guess, this lamer thing',38);
 MakeTextSprite('need to be totaly free :-)',39);
 MakeTextSprite('OPTIK 1998',40);


 MakeTextSprite('First DEMO attempt',41);
 MakeTextSprite('code  : Optik',42);
 MakeTextSprite('music : Optik',43);



 InitGraph;

 SetPalette(tempPal,TRUE);
 Color:=0;
 FillBackground(Color);
 GraphTextOrientation:=horizontal;

 {Place text sprites:}
 nr:=FirstSpriteNumber; x:=80; y:=200;

 SpriteN[nr]:=41; SpriteX[nr]:=x-3; SpriteY[nr]:=y;
 INC(y,MaxFontHeight+1); INC(nr);
 SpriteN[nr]:=2; SpriteX[nr]:=x; SpriteY[nr]:=y;
 INC(y,FontHeight+2); INC(nr);
 SpriteN[nr]:=42; SpriteX[nr]:=x; SpriteY[nr]:=y;
 INC(y,FontHeight+2); INC(nr);
 SpriteN[nr]:=43; SpriteX[nr]:=x; SpriteY[nr]:=y;
 INC(y,FontHeight+80); INC(nr);



 SpriteN[nr]:=1; SpriteX[nr]:=x; SpriteY[nr]:=y;
 INC(y,MaxFontHeight-3); INC(nr);
 SpriteN[nr]:=2; SpriteX[nr]:=x; SpriteY[nr]:=y;
 INC(y,FontHeight+2); INC(nr);
 SpriteN[nr]:=3; SpriteX[nr]:=x+10; SpriteY[nr]:=y;
 INC(y,FontHeight+7); INC(nr);
 for i:=4 to 14 do
  sprite_definicion(i);
 INC(y,FontHeight+80); INC(nr);

 SpriteN[nr]:=15; SpriteX[nr]:=x+20; SpriteY[nr]:=y;
 INC(y,FontHeight+10); INC(nr);
 for i:=16 to 24 do
  sprite_definicion(i);
 INC(y,FontHeight+80); INC(nr);

 SpriteN[nr]:=25; SpriteX[nr]:=x+20; SpriteY[nr]:=y;
 INC(y,FontHeight+10); INC(nr);
 for i:=26 to 36 do
  sprite_definicion(i);
 INC(y,FontHeight+20);
 for i:=37 to 39 do
  sprite_definicion(i);
 INC(y,FontHeight+100);

 SpriteN[nr]:=40; SpriteX[nr]:=x+20; SpriteY[nr]:=y;


 Animate;

 FillChar(tempPal,SizeOf(tempPal),0);
 getpalette(activepal);
 for i:= 1 to 128 do
  begin
   fade1;
   dostars;
   animate;
   if port[$60]=$01 then stop:=true;
   if stop then skonci;
  end;

 {scroll in text block:}
 FOR i:=1 TO 1520 DO
  BEGIN
   FOR j:=FirstSpriteNumber TO nr DO
   begin
    DEC(SpriteY[j]);
   end;
    dostars;
    delay(10);
    waitretrace;
    Animate;
    if port[$60]=$01 then stop:=true;
    if stop then skonci;
  END;

 for i:=1 to 200 do
  begin
   dostars;
   delay(10);
   waitretrace;
   Animate;
   if port[$60]=$01 then stop:=true;
   if stop then skonci;
  end;

 FillChar(tempPal,SizeOf(tempPal),0);
 getpalette(activepal);
 for i:= 1 to 80 do
  begin
   fade2;
   dostars;
   animate;
   if stop then skonci;
   if port[$60]=$01 then stop:=true;
  end;
 CloseRoutines;
 asm
  mov ax,3h
  int 10h
 end;
END.
