{$M 4048,0,150000}

{$A+,B-,E+,F-,G+,N+,Q-,R-,S-}

uses mse_tp,sound;

Const VGA=$A000;
      Npages=2;
      MinX=0;
      MaxX=319;
      MinY=0;
      MaxY=199;

Type RgbItem=Record
                   R,G,B:Byte;
             End;
     RgbList=Array[0..255] of RgbItem;
     Table=Array[0..1799] Of Real;
     PTable=^Table;
     Chars=Array[1..3,' '..'§'] of pointer;

Var Sines:Ptable;
    Cosines:Ptable;
    Virt:Array[1..Npages] Of Pointer;
    VP:Array[1..Npages] Of Word;
    temp:rgblist;

Procedure video_mode (mode : Byte); Assembler;
Asm
  mov  AH,00
  mov  AL,mode
  int  10h
end;

procedure keyboardlock; assembler;
asm
   in  al,21h
   or  al,00000010b
   out 21h,al
end;

procedure keyboardunlock; assembler;
asm
   in  al,21h
   and al,11111101b
   out 21h,al
end;

Procedure PutPixel(X,Y:word;Col:Byte;Where:Word);
Begin
     if x>-1 then if x<320 then if y>-1 then if y<200 then
     Mem[Where:(y*320)+x]:=Col;
End;

Function GetPixel(X,Y:word;Where:Word):Byte;
Begin
     GetPixel:=Mem[Where:(y*320)+x];
End;

Procedure Cls(Col:Byte;Where:Word);
Begin
     Fillchar(Mem[Where:0000],64000,Col);
End;

Procedure WaitVBL; Assembler;
Label A1,A2;
Asm
   Mov DX,3DAh
   A1:
      In AL,DX
      And AL,08h
      Jnz A1
   A2:
      In AL,DX
      And AL,08h
      Jz A2
End;

Procedure GetColor(Col:Byte;Var R,G,B:Byte);
Begin
     Port[$3C7]:=Col;
     R:=Port[$3C9];
     G:=Port[$3C9];
     B:=Port[$3C9];
End;

Procedure SetColor(Col,R,G,B:Byte);
Begin
     Port[$3C8]:=Col;
     Port[$3C9]:=R;
     Port[$3C9]:=G;
     Port[$3C9]:=B;
End;

Procedure SetPalette(Pal:RgbList);
Var A:Byte;
Begin
     WaitVBL;
     For A:=0 To 255 do SetColor(A,Pal[A].R,Pal[A].G,Pal[A].B);
End;

Procedure swapcolors_p (a,d:integer);
var r,g,b,s,h,c:byte;
begin
     Port[$3C7]:=a;
     R:=Port[$3C9];
     G:=Port[$3C9];
     B:=Port[$3C9];

     Port[$3C7]:=d;
     s:=Port[$3C9];
     h:=Port[$3C9];
     c:=Port[$3C9];

     Port[$3C8]:=a;
     Port[$3C9]:=s;
     Port[$3C9]:=h;
     Port[$3C9]:=c;

     Port[$3C8]:=d;
     Port[$3C9]:=R;
     Port[$3C9]:=G;
     Port[$3C9]:=B;
end;

procedure square_fill (x1,y1,x2,y2,c:integer;where:word);
var x,y:integer;
begin
     for x:=x1 to x2 do
         begin
              for y:=y1 to y2 do Mem[Where:(y*320)+x]:=c;
         end;
end;

Function Sgn(A:Real):Integer;
Begin
     If A<0 then Sgn:=-1;
     If A=0 then Sgn:=0;
     If A>0 then Sgn:=+1;
End;

Procedure InitTables;
Var A:Word;
    B:Real;
Begin
     Getmem(Sines,Sizeof(Sines^));
     Getmem(Cosines,Sizeof(Cosines^));
     B:=0;
     For A:=0 To 1799 Do
     Begin
          Sines^[A]:=Sin(B);
          Cosines^[A]:=Cos(B);
          B:=B+0.005;
     End;
End;

Procedure ClearTables;
Begin
     Freemem(Sines,Sizeof(Sines^));
     Freemem(Cosines,Sizeof(Cosines^));
End;

Procedure InitVirt;
Var A:Byte;
Begin
     For A:=1 To Npages Do
     Begin
          GetMem(Virt[A],64000);
          VP[A]:=Seg(Virt[A]^);
     End;
End;

Procedure CloseVirt;
Var A:Byte;
Begin
     For A:=1 To Npages Do
     Begin
          Freemem(Virt[A],64000);
          VP[A]:=$A000;
     End;
End;

Procedure LoadPCX(Filename:String;Where:Word);
Var Fil:File;
    Dx,Dy:Word;
    J,M:Byte;
    Ph:Word;
    Buff:Array[0..127] of byte;
    PCXPal:RgbList;
Begin
     Assign(Fil,Filename);
     Reset(Fil,1);
     Blockread(Fil,Buff,128);
     Dy:=0;
     Repeat
           Dx:=0;
           Repeat
                 BlockRead(Fil,J,1);
                 If J>192 Then
                 Begin
                      BlockRead(Fil,M,1);
                      Dec(J,192);
                      For Ph:=1 To J Do
                      Begin
                           PutPixel(Dx,Dy,M,Where);
                           Inc(Dx);
                      End;
                 End
                 Else
                 Begin
                      PutPixel(Dx,Dy,J,Where);
                      Inc(Dx);
                 End;
           Until Dx>=320;
           Inc(Dy);
     Until Dy=200;
     BlockRead(Fil,M,1);
     If M=12 Then
     Begin
          BlockRead(Fil,PCXPal,768);
          For M:=0 To 255 Do
          Begin
               PCXPal[M].R:=PCXPal[M].R Div 4;
               PCXPal[M].G:=PCXPal[M].G Div 4;
               PCXPal[M].B:=PCXPal[M].B Div 4;
          End;
          SetPalette(PCXPal);
     End;
     Close(Fil);
End;

Procedure LoadPCX_nopal(Filename:String;Where:Word);
Var Fil:File;
    Dx,Dy:Word;
    J,M:Byte;
    Ph:Word;
    Buff:Array[0..127] of byte;
Begin
     Assign(Fil,Filename);
     Reset(Fil,1);
     Blockread(Fil,Buff,128);
     Dy:=0;
     Repeat
           Dx:=0;
           Repeat
                 BlockRead(Fil,J,1);
                 If J>192 Then
                 Begin
                      BlockRead(Fil,M,1);
                      Dec(J,192);
                      For Ph:=1 To J Do
                      Begin
                           PutPixel(Dx,Dy,M,Where);
                           Inc(Dx);
                      End;
                 End
                 Else
                 Begin
                      PutPixel(Dx,Dy,J,Where);
                      Inc(Dx);
                 End;
           Until Dx>=320;
           Inc(Dy);
     Until Dy=200;
     Close(Fil);
end;

Procedure GetImage(x1,y1,x2,y2:Word;Var Img:Pointer;Where:Word);
Var Dx,Dy:Word;
    A,B:Word;
    Segm,Offs:Word;
Begin
     Dx:=Abs(x2-x1)+1;
     Dy:=Abs(y2-y1)+1;
     GetMem(Img,Dx*Dy+4);
     Segm:=Seg(Img^);
     Offs:=Ofs(Img^);
     Move(Dx,Mem[Segm:Offs],2);
     Move(Dy,Mem[Segm:Offs+2],2);
     Offs:=Offs+4;
     For A:=y1 to y2 Do
     For B:=x1 to x2 Do
     Begin
          Mem[Segm:Offs]:=GetPixel(B,A,Where);
          Inc(Offs);
     End;
End;

Procedure KillImage(Var Img:Pointer);
Var Dx,Dy:Word;
    Segm,Offs:Word;
Begin
     Segm:=Seg(Img^);
     Offs:=Ofs(Img^);
     Move(Mem[Segm:Offs],Dx,2);
     Move(Mem[Segm:Offs+2],Dy,2);
     FreeMem(Img,Dx*Dy+4);
End;

Procedure PutImage(X,Y,C:Integer;Var Img:Pointer;Where:Word);
Var Dx,Dy:Word;
    A,B:Word;
    Segm,Offs:Word;
Begin
     Segm:=Seg(Img^);
     Offs:=Ofs(Img^);
     Move(Mem[Segm:Offs],Dx,2);
     Move(Mem[Segm:Offs+2],Dy,2);
     Offs:=Offs+4;
     A:=Y;
     While (A<=Y+DY-1) And (A<MaxY) Do
     Begin
          B:=X;
          While (B<=X+DX-1) And (B<MaxX) Do
          Begin
               If (X>=MinX) And (Y>=MinY) Then
               if Mem[Segm:Offs]<>c then
                 PutPixel(B,A,Mem[Segm:Offs],Where);
               Inc(Offs);
               Inc(B);
          End;
          Inc(A);
     End;
End;

Procedure fadeto (x,y,z:byte;h:integer);
var r,g,b:byte;
    a:integer;
begin
     for a:=0 to h do waitvbl;
     for a:=0 to 255 do
     begin
          getcolor (a,r,g,b);
          if r>x then r:=r-1;
          if r<x then r:=r+1;
          if g>y then g:=g-1;
          if g<y then g:=g+1;
          if b>z then b:=b-1;
          if b<z then b:=b+1;
          setcolor (a,r,g,b);
          end;
end;

procedure fadefrom (temp:rgblist;h:integer);
var r,g,b:byte;
    a:integer;
begin
     for a:=0 to h do waitvbl;
     for a:=0 to 255 do
     begin
          getcolor (a,r,g,b);
          if r>temp[a].r then r:=r-1;
          if r<temp[a].r then r:=r+1;
          if g>temp[a].g then g:=g-1;
          if g<temp[a].g then g:=g+1;
          if b>temp[a].b then b:=b-1;
          if b<temp[a].b then b:=b+1;
          setcolor (a,r,g,b);
     end;
end;

procedure savepal;
var a :integer;
begin
     for a:=0 to 255 do getcolor (a,temp[a].r,temp[a].g,temp[a].b);
end;

procedure restorepal;
var a :integer;
begin
     for a:=0 to 255 do setcolor (a,temp[a].r,temp[a].g,temp[a].b);
end;

var xx,yy,x,y:integer;
    count1,add1,count2,add2,c1:integer;
    a:integer;
    c:char;
    muzak,tables,flares:integer;
    filename:string[12];
    f:text;
    mrow,morder:integer;

procedure bitk0dingeffect;
var yyyy:integer;
begin
         for y:=-100 to 100 do
             begin
                  yyyy:=320*(100-y);
              for x:=-160 to 160 do
                       if mem[vp[1]:yyyy+160+x]<>0
                          then
                           mem[vga:yyyy+160+x]:=mem[vp[1]:yyyy+160+x]+
                           mem[vp[2]:round(320*round(100-(Y*Cosines^[count1]-X*Sines^[count1])*0.4))+
                           round(160+(X*Cosines^[count1]+Y*Sines^[count1])*0.4)]
                          else
                           mem[vga:yyyy+160+x]:=
                           mem[vp[2]:round(320*round(100-(Y*Cosines^[count1]-X*Sines^[count1])*0.4))+
                           round(160+(X*Cosines^[count1]+Y*Sines^[count1])*0.4)];

             end;
end;

procedure circleseffect;
begin
        for y:=-100 to 100 do
             for x:=-160 to 160 do
                 begin
                       if mem[vp[2]:320*(100-y)+(160+x)]=255
                          then
                           mem[vga:320*(100-y)+(160+x)]:=
                           mem[vp[1]:320*round((100-(Y*Cosines^[count1]-X*Sines^[count1])*Cosines^[count2]))+
                            round(160+(X*Cosines^[count1]+Y*Sines^[count1])*sines^[count2])]+
                           mem[vp[1]:320*round(100-(y*cosines^[count2]))+round(160+x*cosines^[count2]*sines^[count2])]
                          else
                           mem[vga:320*(100-y)+(160+x)]:=mem[vp[2]:320*(100-y)+(160+x)];
                 end;
end;

Const
        ZInc = 25;
        ZOfs = 256;
        ZScale = 256;
        Sc=0.7;

type verts= record
                   x,y,z:real;
                   color:integer;
            end;
     lines= record
                   v1,v2:word;
                   color:integer;
            end;

Var     Vert : Array[0..100] Of verts;
        VLine : Array[0..100] Of lines;
        Vertn,linen,n:word;
        ang: real;
        count:integer;

var     k:word;
        Q:Array[0..255]Of Integer;
        line1,line2:string;

Procedure Line(X1,Y1,X2,Y2,Col:Integer;Where:Word);
Var Deltax,S,Deltay,Dx1,Dy1,Dx2,Dy2,S1,S2:Real;
    I:Integer;
Begin
     Deltax:=X2-X1;
     Deltay:=Y2-Y1;
     Dx1:=Sgn(Deltax);
     Dy1:=Sgn(Deltay);
     Dx2:=Sgn(Deltax);
     Dy2:= 0;
     S1:=Abs(Deltax);
     S2:=Abs(Deltay);
     If Not (S1>S2) Then
     Begin
          Dx2:=0;
          Dy2:=Sgn(Deltay);
          S1:=Abs(Deltay);
          S2:=Abs(Deltax);
     End;
     S:=Int(S1/2);
     For I:=0 To Round(S1) Do
     Begin
          if x1<320 then if x1>-1 then if y1<200 then if y1>-1 then PutPixel(X1,Y1,Col,Where);
          S:=S+S2;
          If Not (S<S1) Then
          Begin
               S:=S-S1;
               X1:=X1+Round(Dx1);
               Y1:=Y1+Round(Dy1);
          End
          Else
          Begin
               X1:=X1+Round(dx2);
               Y1:=Y1+Round(Dy2);
          End;
     End;
End;

Procedure Drawlines;
Var SX1, SY1, SX2, SY2, n : Word;
Begin
     n := 0;
     Repeat
           SX1 := Round((ZScale*vert[vline[n].v1].x)/(vert[vline[n].v1].Z-ZOfs));
           SY1 := Round((ZScale*vert[vline[n].v1].Y)/(vert[vline[n].v1].Z-ZOfs));
           SX2 := Round((ZScale*vert[vline[n].v2].X)/(vert[vline[n].v2].Z-ZOfs));
           SY2 := Round((ZScale*vert[vline[n].v2].Y)/(vert[vline[n].v2].Z-ZOfs));

           line (160+SX1, 100-SY1, 160+SX2, 100-SY2,100,vp[1]);
           line (160+SX1+1, 100-SY1, 160+SX2+1, 100-SY2,100,vp[1]);
           line (160+SX1-1, 100-SY1, 160+SX2-1, 100-SY2,100,vp[1]);
           line (160+SX1, 100-SY1+1, 160+SX2, 100-SY2+1,100,vp[1]);
           line (160+SX1, 100-SY1-1, 160+SX2, 100-SY2-1,100,vp[1]);
           n := n + 1;
     Until n = linen;
End;

type
     iverts= record
                   x,y,z:real;
                   image:pointer;
            end;

Var     iVert : Array[0..100] Of iverts;
        iVertn:word;
        b:integer;
        rflare,bflare,sflare,lsflare:pointer;

Procedure PutImage_bob(X,Y,C:Integer;Var Img:Pointer;Where:Word);
const minx=0;
      maxx=319;
      miny=0;
      maxy=199;
Var Dx,Dy:Word;
    A,B:integer;
    Segm,Offs:Word;
    c1,c2,c3:integer;
Begin
     Segm:=Seg(Img^);
     Offs:=Ofs(Img^);
     Move(Mem[Segm:Offs],Dx,2);
     Move(Mem[Segm:Offs+2],Dy,2);
     Offs:=Offs+4;
     for a:=y to y+dy-1 do
     Begin
          for b:=x to x+dx-1 do
          Begin

               if Mem[Segm:Offs]<>c then
               if b>minx then if b<maxx then if a>miny then if a<maxy then
                  begin
                       c1:=getpixel(B,A,where);
                       c2:=mem[segm:offs];
                       c3:=c2+c1;

                       if c3>255 then c3:=255;
                       if c3<0 then c3:=0;
                       PutPixel(B,A,c3,Where);
                  end;
               Inc(Offs);
          End;
     End;
End;

Procedure Drawimages (where:word);
Var SX, SY, n : Word;
Begin
     n := 0;
     Repeat
           With iVert[n] Do
                 Begin
                         SX := Round((ZScale*X)/(Z-ZOfs));
                         SY := Round((ZScale*Y)/(Z-ZOfs));
                           putimage_bob (160+SX-37, 100+SY-32, 1,image, where);

                 End;
           n := n + 1;
     Until n = iVertn;
End;

Procedure Rotate(Var X, Y, ang : Real);
Var XX, YY : Real;
Begin
           XX := X*Cos(ang)+Y*Sin(ang);
      YY := Y*Cos(ang)-X*Sin(ang);
      X := XX;
      Y := YY;
End;

procedure flare;
begin
      move (mem[vp[2]:0],mem[vp[1]:0],64000);
      drawimages(vp[1]);
      waitvbl;
      move (mem[vp[1]:0],mem[vga:0],64000);

      for a:=0 to ivertn do
              begin
                   With iVert[a] Do Rotate(Y, X, ang);
                   With iVert[a] Do Rotate(Z, X, ang);
              end;
end;

procedure interlacescreens;
var y2:integer;
begin

     y2:=count;
     for a:=y2 to y2+200 do
         begin
              if a>-1 then if a<200 then
               if a mod 2 <> 0 then move(mem[vp[2]:320*(a-y2)],mem[vga:320*a],320);
         end;
     y2:=count*(-1);
     for a:=y2 to y2+200 do
         begin
              if a>-1 then if a<200 then
               if a mod 2 = 0 then move(mem[vp[2]:320*(a-y2)],mem[vga:320*a],320);
         end;
     if count>-1 then if count<200 then for x:=0 to 319 do putpixel (x,count,0,vga);
     if count>-200 then if count<0 then for x:=0 to 319 do putpixel (x,count+200,0,vga);

     if y2>-1 then if y2<200 then for x:=0 to 319 do putpixel (x,y2,0,vga);
     if y2>-200 then if y2<0 then for x:=0 to 319 do putpixel (x,y2+200,0,vga);

end;

procedure countersup;
begin
     count1:=count1+add1;
     if count1>1799 then count1:=count1-1259;

     count2:=count2+add2;
     if count2>1799 then count2:=count2-1259;
end;

procedure wavemix;
var cnt,b:integer;
begin
     for cnt:=0 to 20 do
     begin
     x:=random (320);
     y:=random (200);

     c1:=mem[vp[2]:x+320*y];

     for b:=-1 to 1 do if mem[vp[1]:(x+b)+320*(y-2)]=0 then
     mem[vga:(x+b)+320*(y-2)]:=c1 else mem[vga:(x+b)+320*(y-2)]:=mem[vp[1]:(x+b)+320*(y-2)];
     for b:=-2 to 2 do if mem[vp[1]:(x+b)+320*(y-1)]=0 then
     mem[vga:(x+b)+320*(y-1)]:=c1 else mem[vga:(x+b)+320*(y-1)]:=mem[vp[1]:(x+b)+320*(y-1)];
     for b:=-2 to 2 do if mem[vp[1]:(x+b)+320*(y)]=0 then
     mem[vga:(x+b)+320*(y)]:=c1 else mem[vga:(x+b)+320*(y)]:=mem[vp[1]:(x+b)+320*(y)];
     for b:=-2 to 2 do if mem[vp[1]:(x+b)+320*(y+1)]=0 then
     mem[vga:(x+b)+320*(y+1)]:=c1 else mem[vga:(x+b)+320*(y+1)]:=mem[vp[1]:(x+b)+320*(y+1)];
     for b:=-1 to 1 do if mem[vp[1]:(x+b)+320*(y+2)]=0 then
     mem[vga:(x+b)+320*(y+2)]:=c1 else mem[vga:(x+b)+320*(y+2)]:=mem[vp[1]:(x+b)+320*(y+2)];

     end;
     waitvbl;
     swapcolors_p(1,0);
end;

procedure distortioneffect;
var yyyy:integer;
begin
     for y:=-100 to 100 do
         begin
              yyyy:=320*(100-y);
              for x:=-160 to 160 do
                  if mem[vp[1]:yyyy+160+x]=0 then
                  mem[vga:yyyy+160+x]:=
                  mem[vp[2]:320*round(100-y*sines^[count1])+round(160+x*cosines^[count1])]
                  else mem[vga:yyyy+160+x]:=mem[vp[1]:yyyy+160+x];
         end;
end;

procedure crossfade;
var yyyy:integer;
begin
for y:=0 to 199 do
         begin
              for x:=0 to 319 do
              begin
                   yyyy:=x+y*320;
                   if mem[vp[1]:yyyy]>mem[vp[2]:yyyy] then mem[vp[1]:yyyy]:=mem[vp[1]:yyyy]-1;
                   if mem[vp[1]:yyyy]>mem[vp[2]:yyyy] then mem[vp[1]:yyyy]:=mem[vp[1]:yyyy]-1;
                   if mem[vp[1]:yyyy]<mem[vp[2]:yyyy] then mem[vp[1]:yyyy]:=mem[vp[1]:yyyy]+1;
                   if mem[vp[1]:yyyy]<mem[vp[2]:yyyy] then mem[vp[1]:yyyy]:=mem[vp[1]:yyyy]+1;
              end;
         end;

     move (mem[vp[1]:0],mem[vga:0],64000);
end;

procedure cubegoround;
begin
      cls (0,vp[1]);

      Drawlines;
      for x:=0 to 319 do
       for y:=0 to 199 do
                  if mem[vp[2]:320*y+x]=0
                   then
                   if (y mod 2)=0
                    then mem[vga:320*y+x]:=mem[vp[1]:320*y+x]
                    else mem[vga:320*y+x]:=random(256);

      for x:=0 to 319 do
       for y:=0 to 199 do
                  if mem[vp[2]:320*y+x]<>0
                    then mem[vga:320*y+x]:=mem[vp[2]:320*y+x];

      for a:=0 to vertn do
              begin
                   With Vert[a] Do Rotate(X, Z, ang);
                   With Vert[a] Do Rotate(Y, X, ang);
                   With Vert[a] Do Rotate(X, Z, ang);
                   With Vert[a] Do Rotate(Y, X, ang);
              end;

end;

procedure check12;
begin
     if count1=1 then loadpcx_nopal('respect.pcx',vp[2]);
     if count1=1 then move(mem[vga:0],mem[vp[1]:0],64000);
     if count1=3 then loadpcx_nopal('image45_.pcx',vp[2]);
     if count1=3 then move(mem[vga:0],mem[vp[1]:0],64000);
     if count1=5 then loadpcx_nopal('image46_.pcx',vp[2]);
     if count1=5 then move(mem[vga:0],mem[vp[1]:0],64000);
     if count1=7 then loadpcx_nopal('image47_.pcx',vp[2]);
     if count1=7 then move(mem[vga:0],mem[vp[1]:0],64000);
     if count1=9 then loadpcx_nopal('image48_.pcx',vp[2]);
     if count1=9 then move(mem[vga:0],mem[vp[1]:0],64000);
     if count1=11 then loadpcx_nopal('image49_.pcx',vp[2]);
     if count1=11 then move(mem[vga:0],mem[vp[1]:0],64000);
     if count1=13 then loadpcx_nopal('image50_.pcx',vp[2]);
     if count1=13 then move(mem[vga:0],mem[vp[1]:0],64000);
     if count1=15 then loadpcx_nopal('final.pcx',vp[2]);
     if count1=15 then move(mem[vga:0],mem[vp[1]:0],64000);
end;

procedure plasma;
var ccc2: integer;
begin
      for y:=0 to 199 do for x:=0 to 319 do
      begin
      ccc2:=lo(y+x+2*q[lo(x-2*k+q[lo(y-k)])]+q[lo(2*y+k+20)]);
      if ccc2>127 then ccc2:=255-ccc2;
      if mem[vp[2]:y*320+x]=0 then mem[vga:y*320+x]:=ccc2
                              else mem[vga:y*320+x]:=mem[vp[2]:y*320+x];
      end;
      inc(k);
end;

procedure mupdate(check:integer); {1 means fast, 2 means normal}
begin
     if muzak=1 then mrow:=musicrow;
     if muzak=1 then morder:=musicorder($FF);
     if muzak=0 then if random(check)=0 then mrow:=mrow+1;
     if muzak=0 then if mrow>63 then
        begin
             mrow:=mrow-63;
             morder:=morder+1;
        end;
end;

{-------------begins here------------}

begin

     cls(0,vga);
     writeln('Psychic Symphony knows Pi till the 11th decimal case... by heart! :)');;
     writeln('3.14159236535');
     writeln;
     writeln('Reading sound.dat...');
     writeln('You DID run setup first didn''t you?');
     writeln;
     filename:='sound.dat';
     assign (f,filename);
     reset (f);
     readln(f,line1);
     readln(f,line2);
     readln(f,line2);
     readln(f,line2);
     readln(f,line2);
     close (f);
     writeln('Done!');
     muzak:=1;
     if line1='0' then muzak:=0;
     if line1='0' then writeln('music OFF! Better Ctrl^C while you can...');
     if line1='1' then writeln('Ah! A GUS... i wish i owned one...');
     if line1='2' then writeln('Ah! First soundblaster ever made!');
     if line1='3' then writeln('Soundblaster 2.0');
     if line1='4' then writeln('Soundblaster Pro');
     if line1='5' then writeln('Soundblaster 16');
     if line1='6' then writeln('Hum... A Pro Audio Spectrum!');
     if muzak=1 then readconfig ('sound.dat');
     writeln;
     for a:=0 to 10 do waitvbl;
     writeln ('module loaded!');
     if muzak=1 then loadmodule ('label-sk.gdm');
     keyboardlock;
     writeln ('keyboard locked!');
     writeln;
     writeln ('Sleepy eyes');
     writeln ('Blue sky');
     writeln ('White clouds');
     writeln ('Aching mind');
     writeln ('Grieving soul');
     writeln ('Beautifull sight');
     writeln ('Shapes of freedom');
     writeln ('i wish i was a bird...');
     for a:=0 to 53 do fadeto (0,0,0,8);
     line1:=' ';
     c:=' ';

     video_mode ( $13);
     initvirt;

     flares:=2;
     tables:=2;

{-cloud stuff begins-}

     loadpcx ('cloud2.pcx',vp[1]);

     savepal;
     loadpcx_nopal('label.pcx',vp[2]);

     for a:=0 to 63 do fadeto (0,0,0,0);

     cls (40,vga);

     count:=200;

     randomize;

     if muzak=1 then startmusic;
     if muzak=0 then
        begin
             mrow:=0;
             morder:=0;
        end;

     {letsgo!}

     repeat
           if count>1 then count:=count-1;
           if count>1 then for a:=count to count+200 do
              if a>-1 then if a<200 then move(mem[vp[1]:320*(a-count)],mem[vga:320*a],320);
           fadefrom (temp,1);
           waitvbl;
           mupdate(2);
           if morder>1 then c:=#27;
     until c=#27;
     c:=' ';

     count:=-200;
     repeat
      if count <1 then count:=count+1;
      if count <1 then waitvbl;
      if count <1 then interlacescreens;
      mupdate(2);
      if morder>3 then c:=#27;
     until c=#27;
     c:=' ';

     loadpcx_nopal ('finalogo.pcx',vp[2]);

     repeat
           fadeto (63,63,63,2);
           mupdate(2);
           if morder>4 then c:=#27;
     until c=#27;
     c:=' ';

     cls(255,vga);
     for a:=0 to 63 do fadefrom (temp,0);

     count:=-200;
     repeat
      if count <1 then count:=count+1;
      if count <1 then waitvbl;
      if count <1 then interlacescreens;
      mupdate(2);
      if morder>6 then c:=#27;
     until c=#27;
     c:=' ';

     repeat
           fadeto (63,63,63,2);
           mupdate(2);
           if morder=7 then if mrow>32 then c:=#27;
     until c=#27;
     c:=' ';

     repeat
           fadeto (7,7,63,2);
           mupdate(2);
           if morder>7 then c:=#27;
     until c=#27;
     c:=' ';

     cls (20,vga);

{-sunflare begins-}

     loadpcx_nopal ('sflare2.pcx',vp[2]);
     getimage (14,111,92,174,rflare,vp[2]);
     getimage (130,17,208,80,bflare,vp[2]);
     getimage (222,16,300,79,sflare,vp[2]);
     getimage (112,113,190,176,lsflare,vp[2]);
     flares:=1;
     loadpcx_nopal ('poem1.pcx',vp[2]);


      With iVert[0] Do
           Begin
              X := 0* Sc;
              Y := 30* Sc;
              Z := 30* Sc;

                   image:=sflare;
           end;
      With iVert[1] Do
           begin
              X := 0* Sc;
              Y := 70* Sc;
              Z := 70* Sc;

                   image:=rflare;
           end;
      With iVert[2] Do
           begin
              X := 0* Sc;
              Y := 120* Sc;
              Z := 120* Sc;

                   image:=bflare;
           end;
      With iVert[3] Do
           begin
              X := 0* Sc;
              Y := 160* Sc;
              Z := 160* Sc;

                   image:=sflare;
           End;
      With iVert[4] Do
           begin
              X := 0* Sc;
              Y := -40* Sc;
              Z := -40* Sc;

                   image:=lsflare;
           End;
   ivertn:=5;
   ang:= Pi/72;

   c:=' ';

   restorepal;

   Repeat
      flare;
      mupdate(2);
      if morder>9 then c:=#27;
   Until c=#27;

   c:=' ';

     killimage (sflare);
     killimage (rflare);
     killimage (bflare);
     killimage (lsflare);
     flares:=2;

{---- bitk0ding starts ----}

     inittables;
     tables:=1;
     loadpcx_nopal ('poem2.pcx',vp[1]);
     loadpcx_nopal ('image6_3.pcx',vp[2]);

     count1:=0;
     add1:=3;

     count2:=0;
     add2:=3;

     repeat
      countersup;
      bitk0dingeffect;
      waitvbl;
      mupdate(1);
      if morder>11 then c:=#27;
     until c=#27;
     c:=' ';

{--------------distortion starts--------------}

     loadpcx_nopal ('image6_2.pcx',vp[2]);
     loadpcx_nopal ('poem3.pcx',vp[1]);
     add2:=3;

     repeat
      countersup;
      distortioneffect;
      waitvbl;
      mupdate(1);
      if muzak=0 then if morder=10 then if mrow>32 then c:=#27;
      if morder>13 then c:=#27;
     until c=#27;
     c:=' ';

{-------break-------}

      randomize;
      loadpcx_nopal('wave_1.pcx',vp[2]);
      loadpcx_nopal ('poem4.pcx',vp[1]);
      cls  (0,vga);

      repeat
       if mrow<10 then if mrow>6 then setcolor (0,63,63,63);
       if mrow<18 then if mrow>14 then setcolor (0,0,0,63);
       if mrow<26 then if mrow>22 then setcolor (0,63,63,63);
       if mrow<34 then if mrow>30 then setcolor (0,0,0,63);
       if mrow<42 then if mrow>38 then setcolor (0,63,63,63);
       if mrow<50 then if mrow>46 then setcolor (0,0,0,63);
       if mrow<58 then if mrow>54 then setcolor (0,63,63,63);
       if mrow<64 then if mrow>60 then setcolor (0,0,0,63);
       waitvbl;
       wavemix;
       mupdate(2);
       if morder>15 then c:=#27;
      until c=#27;

      c:=' ';
      restorepal;

{----- cube 3d starts ---------}

      filename:='3dcube.ps';

      assign (f,filename);
      reset (f);
      read (f,vertn);
      read (f,linen);
      for a:=0 to vertn-1 do
         begin
              With Vert[a] Do
                begin
                     read(f,x);
                     read(f,y);
                     read(f,z);
                end;
         end;
      for a:=0 to linen-1 do
         begin
              With vline[a] Do
                begin
                     read(f,v1);
                     read(f,v2);
                end;
         end;
      close (f);

     loadpcx_nopal ('poem5.pcx',vp[2]);

     repeat
           cubegoround;
       if mrow<10 then if mrow>6 then setcolor (0,63,63,63);
       if mrow<18 then if mrow>14 then setcolor (0,0,0,63);
       if mrow<26 then if mrow>22 then setcolor (0,63,63,63);
       if mrow<34 then if mrow>30 then setcolor (0,0,0,63);
       if mrow<42 then if mrow>38 then setcolor (0,63,63,63);
       if mrow<50 then if mrow>46 then setcolor (0,0,0,63);
       if mrow<58 then if mrow>54 then setcolor (0,63,63,63);
       if mrow<64 then if mrow>60 then setcolor (0,0,0,63);
           waitvbl;
           mupdate(2);
           if morder>17 then c:=#27;
     until c=#27;
     c:=' ';

     cls (0,vp[2]);

{------------circles begin-------}

     loadpcx_nopal ('poem6.pcx',vp[2]);
     loadpcx_nopal ('bluecirc.pcx',vp[1]);
     move(mem[vp[2]:0],mem[vga:0],64000);
     restorepal;

     add1:=10;
     add2:=4;

     repeat
           countersup;
           circleseffect;
           mupdate(3);
           if morder>19 then c:=#27;
     until c=#27;
     c:=' ';

     cleartables;
     tables:=2;

{------------ plasma ------------}

     loadpcx_nopal ('poem7.pcx',vp[2]);
     move(mem[vp[2]:0],mem[vga:0],64000);

     for x:=0 to 255 do q[x]:=round(31*sin(x*pi/128)+32);
     k:=0;

     repeat
      plasma;
      mupdate(3);
      if morder>21 then c:=#27;
     until c=#27;
     c:=' ';

     count1:=0;

  repeat

     count1:=count1+1;

     check12;

     repeat
      crossfade;
      mupdate(1);
      if morder>count1+21 then c:=#27;
     until c=#27;
     c:=' ';

  until count1=17;

  for a:=0 to 63 do fadeto (0,0,0,8);

     closevirt;
     video_mode ( 03);

     writeln('mode 13h disengaged!');

     if muzak=1 then
     begin
     stopmusic;
     stopoutput;
     unloadmodule;
     freemse;
     end;

     if muzak=1 then writeln('music player turned off');

     filename:='hidden.txt';
     assign (f,filename);
     reset (f);

     for a:=0 to 14 do
         begin
              readln(f,line1);
              writeln (line1);
         end;

     if line2<>'insert hidden part parameter here :P' then
        begin
             repeat
              readln(f,line1);
              if line1=line2 then
                for a:=0 to 8 do
                begin
                     readln(f,line1);
                     writeln (line1);
                end;
             until line1=' -';
         end;

      close (f);

      keyboardunlock;
end.
