{$M 22348,0,135360}

program mag98;

uses crush13h,mse_tp,sound,crt;
{crush13h for vga}
{crt for stuff...}
{mse_tp for bwsb}
{sound for setup sound}

const
     nim=0;

Type RgbItem=Record
                   R,G,B:Byte;
             End;

     RgbList=Array[0..255] of RgbItem;

     textrec=record
                   title   : string [32];
                   author  : string [16];
                   source  : string [17];
             end;

Var  color                 : array [1..20] of integer;
     temp                  : rgblist;
     ncolors               : integer;
     muzak                 : integer;
     a,b                   : integer;
     mmarker,smarker       : integer;
     ntexts                : integer;
     textm                 : array [1..20] of textrec;
     line                  : array [1..100] of string[50];
     f                     : text;
     l,l1                  : integer;
     fader                 : boolean;
     c                     : char;

Procedure fadeto (x,y,z:byte;h:integer);
var a:integer;
    r,g,b:byte;
begin
     delay (h);
     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 a:integer;
    r,g,b:byte;
begin
     delay (h);
     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 palrotation;
var a:integer;
    r,g,b,d,e,f:byte;
begin
     getcolor (color[ncolors],d,e,f);
     for a:=(ncolors-1) downto 2 do
         begin
              getcolor (color[a],r,g,b);
              setcolor (color[a+1],r,g,b);
         end;
     setcolor (color[2],d,e,f);
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;

procedure copypage_boom(r,g,b,c:byte);
var a:integer;
begin
     for a:=0 to 63 do fadeto (r,g,b,0);
     restorepal;
     if c=1 then copypage (vp[1],vga,0);
     if c=2 then copypage (vp[2],vga,0);
end;

Procedure ClearKeyBoard;
Begin
 ASM CLI End;
 MemW[$40:$1A] := MemW[$40:$1C];
 ASM STI End;
End;

procedure terminate;
begin

     closevirt;                 {close vp's}
     video_mode ( 03);          {back to normal mode}
     unloadfont (1);

     if muzak=1 then
     begin
          stopmusic;                 {no more music}
          stopoutput;                {no more sound output}
          unloadmodule;              {unloadmodule}
          freemse;                   {free memory for sound}
     end;

     writeln;
     clrscr;
     writeln ('This is it...blabladontforgetaboutblablablabla');
     writeln ('blablablastuffnoonereadsblablablaimsogoodblabla');
     writeln ('blablablanowweregetingthereblablablanotblabla');
     writeln ('blablablamoreofthesameblablablaanywayblabla');
     writeln ('blablablasendstuffblablablafinnalyblabla');
     writeln ('blablablaendingsoonblablabla email me to...');
     writeln;
     writeln ('                        ec97104@crazy.fe.up.pt');
     writeln;
     halt;
end;

procedure updatesecond;
begin
     move(mem[vp[2]:0],mem[vp[1]:0],64000);
     for a:=1 to ntexts do
         begin
              putstring (17,a*10,0,5,1,textm[a].title,1,vp[1]);
              putstring (217,a*10,0,5,1,textm[a].author,1,vp[1]);
              if smarker=a then putstring (0,a*10,0,5,1,':)',1,vp[1]);
         end;
     move(mem[vp[1]:0],mem[vga:0],64000);
     if fader=true then
        begin
             for a:=0 to 63 do fadefrom (temp,20);
             fader:=false;
        end;
end;

procedure updatetext;
begin
     move(mem[vp[2]:0],mem[vp[1]:0],64000);
     for a:=1 to 19 do
               begin
                    if l1-1+a<l then putstring (15,a*10,0,5,1,line[l1-1+a],1,vp[1]);
               end;
     move(mem[vp[1]:0],mem[vga:0],64000);
end;

procedure scrooluptext;
begin
     for b:=10 downto 0 do
         begin
     move(mem[vp[2]:0],mem[vp[1]:0],64000);
     for a:=1 to 19 do
               begin
                    if l1-1+a<l then putstring (15,a*10+b,0,5,1,line[l1-1+a],1,vp[1]);
               end;
     move(mem[vp[1]:0],mem[vga:0],64000);
         end;
end;

procedure scrooldowntext;
begin
     for b:=10 downto 0 do
         begin
     move(mem[vp[2]:0],mem[vp[1]:0],64000);
     for a:=1 to 19 do
               begin
                    if l1-1+a<l then putstring (15,a*10-b,0,5,1,line[l1-1+a],1,vp[1]);
               end;
     move(mem[vp[1]:0],mem[vga:0],64000);
         end;
end;

procedure entertext;
begin
     for a:=1 to 63 do fadeto (0,0,0,20);
     fader:=true;

     l:=1;
     assign (f,textm[smarker].source);
     reset (f);
     readln (f,l);
     for a:=1 to l do
         begin
           readln (f,line[a]);
         end;
     for a:=l to 100 do line[a]:=' ';
     close (f);

     l1:=1;
     updatetext;

     if fader=true then
        begin
             for a:=0 to 63 do fadefrom (temp,20);
             fader:=false;
        end;

     repeat
           clearkeyboard;
           c:=readkey;
           if c=#80 then if l1<l then if l>19 then
              begin
                   l1:=l1+1;
                   scrooluptext;
              end;
           if c=#81 then if l1<l then if l>19 then
              begin
                   if l1+19>l then l1:=l else l1:=l1+19;
                   updatetext;
              end;
           if c=#72 then if l1>1 then
              begin
                   l1:=l1-1;
                   scrooldowntext;
              end;
           if c=#73 then if l1>1 then
              begin
                   if l1-19<1 then l1:=1 else l1:=l1-19;
                   updatetext;
              end;
     until c=#27;
     c:=' ';

     for a:=1 to 63 do fadeto (0,0,0,20);
     fader:=true;
end;

procedure readbook;
begin
     reset (f);
     readln (f,ntexts);
     for a:=1 to ntexts do
            begin
                 readln (f,textm[a].title);
                 readln (f,textm[a].author);
                 readln (f,textm[a].source);
            end;
     close (f);
     for a:=1 to ntexts do textm[a].source:='data\'+textm[a].source;
end;

procedure enterbook;
begin
     for a:=1 to 63 do fadeto (0,0,0,20);
     fader:=true;

     if mmarker=7 then terminate ;

     if mmarker=1 then assign (f,'data\data1.dat');
     if mmarker=2 then assign (f,'data\data3.dat');
     if mmarker=3 then assign (f,'data\data2.dat');
     if mmarker=4 then assign (f,'data\data5.dat');
     if mmarker=5 then assign (f,'data\data6.dat');
     if mmarker=6 then assign (f,'data\data4.dat');

     readbook;

     smarker:=1;
     updatesecond;
     repeat
           ClearKeyBoard;
           c:=readkey;
           if c=#80 then if smarker<ntexts then smarker:=smarker+1 else smarker:=1;
           if c=#72 then if smarker>1 then smarker:=smarker-1 else smarker:=ntexts;
           if c=#13 then entertext;
           updatesecond;
     until c=#27;
     c:=' ';
     for a:=1 to 63 do fadeto (0,0,0,20);
     fader:=true;
end;

procedure updatemain;
begin
     move(mem[vp[2]:0],mem[vp[1]:0],64000);
     putstring (160-35,55,0,5,1,'introduction',1,vp[1]);
     putstring (160-30,70,0,5,1,'literature',1,vp[1]);
     putstring (160-25,85,0,5,1,'demoscene',1,vp[1]);
     putstring (160-14,100,0,5,1,'games',1,vp[1]);
     putstring (160-17,115,0,5,1,'social',1,vp[1]);
     putstring (160-20,130,0,5,1,'hitlist',1,vp[1]);
     putstring (160-11,145,0,5,1,'exit',1,vp[1]);
     if mmarker=1 then putstring (160-35-17,55,0,5,1,':)',1,vp[1]);
     if mmarker=2 then putstring (160-30-17,70,0,5,1,':)',1,vp[1]);
     if mmarker=3 then putstring (160-25-17,85,0,5,1,':)',1,vp[1]);
     if mmarker=4 then putstring (160-14-17,100,0,5,1,':)',1,vp[1]);
     if mmarker=5 then putstring (160-17-17,115,0,5,1,':)',1,vp[1]);
     if mmarker=6 then putstring (160-20-17,130,0,5,1,':)',1,vp[1]);
     if mmarker=7 then putstring (160-11-17,145,0,5,1,':)',1,vp[1]);
     move(mem[vp[1]:0],mem[vga:0],64000);
     if fader=true then
        begin
             for a:=0 to 63 do fadefrom (temp,20);
             fader:=false;
        end;
end;

begin

     muzak:=2;
     writeln ('Press Esc for no muzak...');
     writeln ('Press Enter for rock''n''roll...');
     repeat
     c:=readkey;
     if c=#27 then muzak:=0;
     if c=#13 then muzak:=1;
     until muzak<>2;
     if muzak=1 then readconfig ('sound.dat');
     if muzak=1 then
        begin
             writeln;
             writeln ('Now press one of the following...');
             writeln ('''1'' for Warez Jazz  by Noise Bleeder /Dawn 3');
             writeln ('''2'' for Moonwinds   by Garfield      /RD');
             writeln ('''3'' for Intro song! by DJ mind');
             c:=readkey;
             if c='1' then loadmodule ('data\datamod1.dat');
             if c='2' then loadmodule ('data\datamod2.dat');
             if c='3' then loadmodule ('data\datamod3.dat');
             if c<>'1' then if c<>'2' then if c<>'3' then loadmodule ('data\datamod1.dat');
        end;
     video_mode ( $13);         {change to 13h}
     initvirt;                  {vp[1] and vp[2]}
     ncolors:=10;

     cls (0,vga);
     loadpcx ('data\datat1.dat',vp[2]);
     loadfont ('data\datafnt.dat',1);

     mmarker:=1;
     setcolor (144,0,45,45);
     savepal;
     for a:=1 to 63 do fadeto (0,0,0,0);

     move(mem[vp[2]:0],mem[vp[1]:0],64000);
     putstring (160-35,55,0,5,1,'introduction',1,vp[1]);
     putstring (160-30,70,0,5,1,'literature',1,vp[1]);
     putstring (160-25,85,0,5,1,'demoscene',1,vp[1]);
     putstring (160-14,100,0,5,1,'games',1,vp[1]);
     putstring (160-17,115,0,5,1,'social',1,vp[1]);
     putstring (160-20,130,0,5,1,'hitlist',1,vp[1]);
     putstring (160-11,145,0,5,1,'exit',1,vp[1]);
     if mmarker=1 then putstring (160-35-17,55,0,5,1,':)',1,vp[1]);
     if mmarker=2 then putstring (160-30-17,70,0,5,1,':)',1,vp[1]);
     if mmarker=3 then putstring (160-25-17,85,0,5,1,':)',1,vp[1]);
     if mmarker=4 then putstring (160-14-17,100,0,5,1,':)',1,vp[1]);
     if mmarker=5 then putstring (160-17-17,115,0,5,1,':)',1,vp[1]);
     if mmarker=6 then putstring (160-20-17,130,0,5,1,':)',1,vp[1]);
     if mmarker=7 then putstring (160-11-17,145,0,5,1,':)',1,vp[1]);
     move(mem[vp[1]:0],mem[vga:0],64000);

     if muzak=1 then startmusic;
     for a:=1 to 63 do fadefrom (temp,20);

     repeat
     ClearKeyBoard;
     c:=readkey;
     if c=#80 then if mmarker<7 then mmarker:=mmarker+1 else mmarker:=1;
     if c=#72 then if mmarker>1 then mmarker:=mmarker-1 else mmarker:=7;
     if c=#13 then enterbook;
     if c='1' then
              begin
                   for a:=0 to 63 do fadeto (0,0,0,20);
                   cls (0,vga);
                   loadpcx ('data\datat1.dat',vp[2]);
                   setcolor (144,0,45,55);
                   savepal;
                   updatemain;
                   for a:=0 to 63 do fadefrom (temp,20);
              end;
     if c='2' then
              begin
                   for a:=0 to 63 do fadeto (0,0,0,20);
                   cls (0,vga);
                   loadpcx ('data\datat2.dat',vp[2]);
                   setcolor (144,20,63,20);
                   savepal;
                   updatemain;
                   for a:=0 to 63 do fadefrom (temp,20);
              end;
     if c='3' then
              begin
                   for a:=0 to 63 do fadeto (0,0,0,20);
                   cls (0,vga);
                   loadpcx ('data\datat3.dat',vp[2]);
                   setcolor (144,0,45,45);
                   savepal;
                   updatemain;
                   for a:=0 to 63 do fadefrom (temp,20);
              end;
     if c='4' then
              begin
                   for a:=0 to 63 do fadeto (0,0,0,20);
                   cls (0,vga);
                   loadpcx ('data\datat4.dat',vp[2]);
                   setcolor (144,0,32,0);
                   savepal;
                   updatemain;
                   for a:=0 to 63 do fadefrom (temp,20);
              end;
     if c='5' then
              begin
                   for a:=0 to 63 do fadeto (0,0,0,20);
                   cls (0,vga);
                   loadpcx ('data\datat5.dat',vp[2]);
                   setcolor (144,63,63,5);
                   savepal;
                   updatemain;
                   for a:=0 to 63 do fadefrom (temp,20);
              end;
     updatemain;
     until c=#27;

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

     terminate;
end.
