{ INTRO.PAS   - (c) Ansgar Scherp, Joachim Gelhaus
  All rights reserved / vt'95}

{$M 65000,0,250000}
{$A-,T-,P-,Q-,R-}
uses dos,crt,audiotpu;

const N1 = ' PCS-PINBALL  - Version 1.1 written by A.Scherp and J.Gelhaus ';
      N2 = ' (c)opyrights reserved by PC Spiel and vIRTUAL tECHNOLOGIES GbR';

var
  cd_lw : Char;
  cd_name : string;
  cd_iso : boolean;
  act_lw : Char;
  path : string;
  ch   : char;
  chs  : string[20];
  cd_song:byte;

{$I _FLIC.PAS}
{$I _INTEGRI.PAS} {check for integrity // read volumelabel of cd-rom}
{$I _NORMVGA.PAS}

const
  NofStars = 50;
  ZFactor = 200;
  Xc = 160;
  Yc = 100;
  Palett : array[0..$2ff] of byte = (
0,0,0,2,2,2,4,4,4,6,6,6,8,8,8,
10,10,10,12,12,12,14,14,14,16,16,16,18,18,18,20,
20,20,22,22,22,24,24,24,26,26,26,28,28,28,30,30,
30,33,33,33,35,35,35,37,37,37,39,39,39,41,41,41,
43,43,43,45,45,45,47,47,47,49,49,49,51,51,51,53,
53,53,55,55,55,57,57,57,59,59,59,61,61,61,63,63,
63,63,51,51,63,63,51,51,63,51,51,63,63,51,51,63,
63,51,63,63,39,39,63,51,39,63,63,39,51,63,39,39,
63,39,39,63,51,39,63,63,39,51,63,39,39,63,51,39,
63,63,39,63,63,39,51,63,27,27,63,39,27,63,51,27,
63,63,27,51,63,27,39,63,27,27,63,27,27,63,39,27,
63,51,27,63,63,27,51,63,27,39,63,27,27,63,39,27,
63,51,27,63,63,27,63,63,27,51,63,27,39,63,15,15,
63,27,15,63,39,15,63,51,15,63,63,15,51,63,15,39,
63,15,27,63,15,15,63,15,15,63,27,15,63,39,15,63,
51,15,63,63,15,51,63,15,39,63,15,27,63,15,15,63,
27,15,63,39,15,63,51,15,63,63,15,63,63,15,51,63,
15,39,63,15,27,63,3,15,63,3,3,63,15,3,63,27,
3,63,39,3,63,51,3,63,63,3,51,63,3,39,63,3,
27,63,3,15,63,3,3,63,3,3,63,15,3,63,27,3,
63,39,3,63,51,3,63,63,3,51,63,3,39,63,3,27,
63,3,15,63,3,3,63,15,3,63,27,3,63,39,3,63,
51,3,63,63,3,63,63,3,51,63,3,39,63,3,27,51,
3,15,51,3,3,51,15,3,51,27,3,51,39,3,51,51,
3,39,51,3,27,51,3,15,51,3,3,51,3,3,51,15,
3,51,27,3,51,39,3,51,51,3,39,51,3,27,51,3,
15,51,3,3,51,15,3,51,27,3,51,39,3,51,51,3,
51,51,3,39,51,3,27,39,3,15,39,3,3,39,15,3,
39,27,3,39,39,3,27,39,3,15,39,3,3,39,3,3,
39,15,3,39,27,3,39,39,3,27,39,3,15,39,3,3,
39,15,3,39,27,3,39,39,3,39,39,3,27,27,3,15,
27,3,3,27,15,3,27,27,3,15,27,3,3,27,3,3,
27,15,3,27,27,3,15,27,3,3,27,15,3,27,27,3,
27,15,3,3,15,15,3,3,15,3,3,15,15,3,3,15,
15,3,15,27,15,15,27,27,15,15,27,15,15,27,27,15,
15,27,27,15,27,39,15,15,39,27,15,39,39,15,27,39,
15,15,39,15,15,39,27,15,39,39,15,27,39,15,15,39,
27,15,39,39,15,39,39,15,27,51,15,15,51,27,15,51,
39,15,51,51,15,39,51,15,27,51,15,15,51,15,15,51,
27,15,51,39,15,51,51,15,39,51,15,27,51,15,15,51,
27,15,51,39,15,51,51,15,51,51,15,39,51,15,27,51,
27,27,51,39,27,51,51,27,39,51,27,27,51,27,27,51,
39,27,51,51,27,39,51,27,27,51,39,27,51,51,27,51,
51,27,39,51,39,39,51,51,39,39,51,39,39,51,51,39,
39,51,51,39,51,39,27,27,39,39,27,27,39,27,27,39,
39,27,27,39,39,27,39,3,3,3,15,15,15,27,27,27,
39,39,39,51,51,51,63,63,63,63,22,3,39,7,5,36,
36,63,0,0,0,22,22,22,38,38,38,52,52,52,63,0,0);

type
  StarRec = record
              X,Y,Z : integer;
            end;
  StarPos = array[0..NofStars] of StarRec;
  StarSpd = array[0..NofStars] of word;

var
  Stars : StarPos;
  Speed : StarSpd;
  i,x,mfm : word;
var  OldHeapLimit: pointer;
     OldHeapSize : Longint;

function FileExists(FileName: String): Boolean;
var
  F: file;
begin
  {$I-}
  Assign(F, FileName);
  Reset(F);
  Close(F);
  {$I+}
  FileExists := (IOResult = 0) and (FileName <> '');
end;  { FileExists }


procedure init_all;
Begin
  mfm:=filemode;
  filemode:=0;
  {allocate memory}
  OldHeapSize := memavail;
  mark(OldHeapLimit);
  if MaxAvail<BUFFERSIZE then   { check if there is enough memory to the frame
  buffer }
  begin
    WriteLn('ERROR! Can not allocate enough memory to a frame buffer.');
    Halt(0);
  end;
end;

procedure Close_all;
begin
  {release memory}
  Release(OldHeapLimit);
  if OldHeapSize <> memavail then begin
      writeln('Attention: Heapmanipulations failed!');
      repeat until keypressed;
    end;
  filemode:=mfm;
end;

procedure Init_Star;

var
  Regs : registers;
  C : word;
  I,X,Y : byte;

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

  C := 0;                                                      { Set palette }
  for I := 0 to 50 do begin
    port[$3C8] := I;
    port[$3C9] := Palett[C];
    port[$3C9] := Palett[C+1];
    port[$3C9] := Palett[C+2];
    inc(C,3);
  end;
end;

procedure DoStars;

var
  X,Y : integer;
  I,Color : byte;

procedure NewStar(Num : byte);

var
  X,Y : integer;

begin
  X := Xc+round(Stars[Num].X*Stars[Num].Z/ZFactor);
  Y := Yc+round(Stars[Num].Y*Stars[Num].Z/ZFactor);
  if (X > 0) and (X < 320) and (Y > 0) and (Y < 200) then
    mem[$a000:Y*320+X] := 0;
  Stars[Num].X := random(100)-50;
  Stars[Num].Y := random(100)-50;
  Stars[Num].Z := random(100)+200;
end;

begin
    while (port[$3da] and 8) <> 8 do;
    while (port[$3da] and 8) = 8 do;
    for I := 0 to NofStars do begin                                  { Stars }
      X := Xc+round(Stars[I].X*Stars[I].Z/ZFactor);
      Y := Yc+round(Stars[I].Y*Stars[I].Z/ZFactor);
      if mem[$a000:Y*320+X] <= 31 then mem[$a000:Y*320+X] := 0;
      X := Xc+round(Stars[I].X*(Stars[I].Z+Speed[I])/ZFactor);
      Y := Yc+round(Stars[I].Y*(Stars[I].Z+Speed[I])/ZFactor);
      if (X > 0) and (X < 320) and (Y > 0) and (Y < 200) then begin
        Color := 8+(Stars[I].Z div 150);
        if Color > 31 then Color := 31;
        if mem[$a000:Y*320+X] = 0 then mem[$a000:Y*320+X] := Color;
      end else NewStar(I);
      inc(Stars[I].Z,Speed[I]); if Stars[I].Z > 20000 then NewStar(I);
      Speed[I] := (Stars[I].Z div 150)*(5-(abs(Stars[I].X*Stars[I].Y) div 500));
    end;
end;

procedure play_flic(flic_startpic, flic_endpic:word);
begin
  if act_lw=cd_lw then flicspeed:=0 else flicspeed:=4;
  if flic_startpic=1 then
  begin
    flicspeed:=flicspeed*CLOCK_SCALE; { convert the flicspeed to number of clock}
    GetMem(Buffer,BUFFERSIZE);
    Assign(InputFile,FileName);
    Reset(InputFile,1);
    BlockRead(InputFile,Header,128);  { read the .FLI main header }
    Frames:=Header[6]+Header[7]*256;  { get the number of frames from the.FLI-header }
    if flicspeed=-1 then                  { if flicspeed is not set by a flicspeed overridethen get it from the .FLI-header }
      flicspeed:=(Header[16]+Integer(Header[17])*256)*CLOCK_SCALE;
    InitClock;  { initialize the System Clock }
    GetBlock(Header,16);  { read the first frame-header }
    FrameSize:=Header[0]+256*(LongInt(Header[1])+256*(LongInt(Header[2])+256*LongInt(Header[3])))-16;  { calculate framesize }
    SecondPos:=128+16+FrameSize;  { calculate what position to skip to when the FLI is finished and is going to start again - }
                                  { the position = .FLI-header +  first_frame-header + first_framesize }
    Chunks:=Header[6]+Header[7]*256;  { calculate number of chunks in frame }
    GetBlock(Buffer^,FrameSize);  { read the frame into the framebuffer }
    TreatFrame(Buffer,Chunks);  { treat the first frame }
    TimeCounter:=GetClock;  { get the current time }
    FrameNumber:=1;  { we start at the first frame (after the initial frame) }
  end;
  Repeat
    GetBlock(Header,16);  { read frame-header }
    FrameSize:=Header[0]+256*(LongInt(Header[1])+256*(LongInt(Header[2])+256*LongInt(Header[3])))-16;  { size of frame }
    if (FrameSize<>0) and (flic_startpic<=FrameNumber) then  { sometimes there are no changes from one frame to the}
    begin
      Chunks:=Header[6]+Header[7]*256;  { calculate number of chunks in the frame }

      GetBlock(Buffer^,FrameSize);  { read the frame into the framebuffer }
      TreatFrame(Buffer,Chunks);  { treat the frame }
    end;
    NextTime:=TimeCounter+flicspeed;   { calculate the Delay to the next frame }
    While TimeCounter<NextTime do TimeCounter:=GetClock;
    Inc(FrameNumber);  { one frame finished, over to the next one }
  Until (FrameNumber>Frames) or (flic_endpic<=framenumber);  { Repeated Until we come to the last frame}
  if (FrameNumber>Frames) then
  begin
    Close(InputFile);            { be a kind boy and close the File beFore we end the Program }
    FreeMem(Buffer,BUFFERSIZE);  { and free the framebuffer }
  end;
END;

  const StartSong = 2;

begin
  checkbreak := false;
  asm mov ax,03h; int 10h; end;
  textcolor(white); textbackground(red);
  writeln(' PCS-PINBALL  - Version 2.00a               written by A.Scherp and J.Gelhaus ');
  textcolor(7); textbackground(0);
  init_all;
  if paramcount<>1 then cd_song := StartSong  {play this track}
    else begin chs:=paramstr(1); val(chs,cd_song,i); end;
  CheckCDROM;
  if (cd_song < 1) or (cd_song > MAXtitles) then cd_song := StartSong;
  writeln('CD_SONG: ',cd_song);

  chdir('INTRO');
  if (cd_lw<>act_lw) then begin
    if Init_CDAudio<>0 then
    begin
      stop_Audio_1;
      if not Play_Track(cd_song) then begin
        writeln('Attention: No Audio-CD-ROM inserted or wrong Track-Number.');
        writeln('           You will not hear any music!');
        delay(1500);
      end else repeat until Audio_busy<>0;
    end;
  end else begin
    writeln('No CD-Audio');
    delay(1500);
  end;
  delay(2000);
  video_mode($13);
  palette_black;
  FileName:='INTRO1.FIC';
  play_flic(1,102);
  init_star;
  while keypressed do ch:=readkey;
  repeat
    retrace;
    set_rgb_color(0,00,0,0);
    doStars;
  until keypressed;
  while keypressed do ch:=readkey;
  play_flic(102,160);

  video_mode(3);
  close_all;
  chdir('..');
  halt(100);
end.
