{$M 22048,0,163550}
{Best of 2 worlds:enough memory for music and graphic pages}
{$a+,b-,d+,e+,f-,g+,i+,l+,n-,o-,p-,q-,r-,s+,t-,v+,x+}
{for 286/287 instructions}

program psychic_journey;

{v8.0 by ps}

uses crush13h,mse_tp,sound,crt;
{crush13h for graphics}
{mse_tp for bwsb}
{sound for sound garbage}
{crt for miscellaneous stuff}

{------balls-------}
const acelaration = 0;     { 0 for no xacelaration }
      gravity = -9.8;      { -9.8 for Earth }
      elasticityg = 0;   { + is higher }
      elasticityl = 0;   { + is higher }
      elasticityr = 0;    { - is higher }
      elasticitya = 10;    { - is higher }
      npart = 20;           { do not change, no multiple particles yet :( }
      dt =0.1;             { lower means slower }
      ddt=0.012;
      walla  = 194;        { boundaries }
      wallb  = 6;
      walll  = 6;
      wallr  = 314;

type partrecord= record x0,y0,vx0,vy0,x,y,vx,vy:integer;
                    end;

var part: array [1..npart] of partrecord;
    t: array [1..npart] of real;
    x,y,a:integer;

procedure setballs;
begin
     part[1].x0:= 10;
     part[1].y0:= 150;
     part[1].vx0:= 30;
     part[1].vy0:= 0;

     part[2].x0:= 20;
     part[2].y0:= 150;
     part[2].vx0:= 31;
     part[2].vy0:= 8;

     part[3].x0:= 30;
     part[3].y0:= 150;
     part[3].vx0:= 32;
     part[3].vy0:= 4;

     part[4].x0:= 90;
     part[4].y0:= 150;
     part[4].vx0:= 33;
     part[4].vy0:= 16;

     part[5].x0:= 60;
     part[5].y0:= 200;
     part[5].vx0:= 34;
     part[5].vy0:= -18;

     part[6].x0:= 50;
     part[6].y0:= 150;
     part[6].vx0:= 35;
     part[6].vy0:= 18;

     part[7].x0:= 70;
     part[7].y0:= 150;
     part[7].vx0:= 36;
     part[7].vy0:= 12;

     part[8].x0:= 80;
     part[8].y0:= 150;
     part[8].vx0:= 37;
     part[8].vy0:= 14;

     part[9].x0:= 40;
     part[9].y0:= 150;
     part[9].vx0:= 38;
     part[9].vy0:= 6;

     part[10].x0:= 100;
     part[10].y0:= 150;
     part[10].vx0:= 39;
     part[10].vy0:= 10;

     part[11].x0:= 300;
     part[11].y0:= 150;
     part[11].vx0:= -30;
     part[11].vy0:= 0;

     part[12].x0:= 310;
     part[12].y0:= 150;
     part[12].vx0:= -31;
     part[12].vy0:= -8;

     part[13].x0:= 240;
     part[13].y0:= 150;
     part[13].vx0:= -32;
     part[13].vy0:= -4;

     part[14].x0:= 280;
     part[14].y0:= 150;
     part[14].vx0:= -33;
     part[14].vy0:= -16;

     part[15].x0:= 270;
     part[15].y0:= 180;
     part[15].vx0:= -34;
     part[15].vy0:= -6;

     part[16].x0:= 260;
     part[16].y0:= 150;
     part[16].vx0:= -35;
     part[16].vy0:= -10;

     part[17].x0:= 250;
     part[17].y0:= 170;
     part[17].vx0:= -36;
     part[17].vy0:= -12;

     part[18].x0:= 290;
     part[18].y0:= 150;
     part[18].vx0:= -37;
     part[18].vy0:= -14;

     part[19].x0:= 230;
     part[19].y0:= 150;
     part[19].vx0:= -38;
     part[19].vy0:= -2;

     part[20].x0:= 220;
     part[20].y0:= 140;
     part[20].vx0:= -39;
     part[20].vy0:= -18;

     for a:=1 to npart do
         begin
         part[a].x:=part[a].x0;
         part[a].y:=part[a].y0;
         part[a].vx:=part[a].vx0;
         part[a].vy:=part[a].vy0;
         end;

end;

procedure correctconstants_r(a:integer);
begin
     part[a].vy0:= part[a].vy;
     part[a].y0:= part[a].y;
     part[a].vx0:= ((-1)*(part[a].vx)) + elasticityr;
     part[a].x0:= wallr;
     if part[a].x > wallr then part[a].x:= wallr;
     if part[a].x < walll then part[a].x:= walll;
     if part[a].y < wallb then part[a].y:= wallb;
     if part[a].y > walla then part[a].y:= walla;
     t[a]:= 0;
end;

procedure correctconstants_l(a:integer);
begin
     part[a].vy0:= part[a].vy;
     part[a].y0:= part[a].y;
     part[a].vx0:= ((-1)*(part[a].vx)) + elasticityl;
     part[a].x0:= walll;
     if part[a].x > wallr then part[a].x:= wallr;
     if part[a].x < walll then part[a].x:= walll;
     if part[a].y < wallb then part[a].y:= wallb;
     if part[a].y > walla then part[a].y:= walla;
     t[a]:= 0;
end;

procedure correctconstants_b(a:integer);
begin
     part[a].vy0:= ((-1)*(part[a].vy)) + elasticityg;
     part[a].y0:= wallb;
     part[a].vx0:= part[a].vx;
     part[a].x0:= part[a].x;
     if part[a].x > wallr then part[a].x:= wallr;
     if part[a].x < walll then part[a].x:= walll;
     if part[a].y < wallb then part[a].y:= wallb;
     if part[a].y > walla then part[a].y:= walla;
     t[a]:= 0;
end;

procedure correctconstants_a(a:integer);
begin
     part[a].vy0:= ((-1)*(part[a].vy)) + elasticitya;
     part[a].y0:= walla;
     part[a].vx0:= part[a].vx;
     part[a].x0:= part[a].x;
     if part[a].x > wallr then part[a].x:= wallr;
     if part[a].x < walll then part[a].x:= walll;
     if part[a].y < wallb then part[a].y:= wallb;
     if part[a].y > walla then part[a].y:= walla;
     t[a]:= 0;
end;

procedure checkbounds(a:integer);
begin
     if part[a].x > wallr then correctconstants_r(a);
     if part[a].x < walll then correctconstants_l(a);
     if part[a].y < wallb then correctconstants_b(a);
     if part[a].y > walla then correctconstants_a(a);
end;

procedure actualise(a:integer);
begin
     part[a].vy:= part[a].vy0 + round (gravity*t[a]);
     part[a].vx:= part[a].vx0 + round (acelaration*t[a]);
     part[a].x:= part[a].x0 + round (part[a].vx0*t[a] + (0.5)*acelaration*t[a]*t[a]);
     part[a].y:= part[a].y0 + round (part[a].vy0*t[a] + (0.5)*gravity*t[a]*t[a]);
end;

procedure putball (x,y:integer;where:word);
var b,c:integer;
begin

     for b:=-2 to 2 do
         begin
              c:=getpixel (x+b,y-5,where);
              putpixel (x+b,y-5,c+3,where);
         end;

     for b:=-3 to 3 do
         begin
              c:=getpixel (x+b,y-4,where);
              putpixel (x+b,y-4,c+3,where);
         end;

     for b:=-4 to 4 do
         begin
              c:=getpixel (x+b,y-3,where);
              putpixel (x+b,y-3,c+3,where);
         end;

     for b:=-5 to 5 do
         begin
              c:=getpixel (x+b,y-2,where);
              putpixel (x+b,y-2,c+3,where);
         end;

     for b:=-5 to 5 do
         begin
              c:=getpixel (x+b,y-1,where);
              putpixel (x+b,y-1,c+3,where);
         end;

     for b:=-5 to 5 do
         begin
              c:=getpixel (x+b,y,where);
              putpixel (x+b,y,c+3,where);
         end;

     for b:=-5 to 5 do
         begin
              c:=getpixel (x+b,y+1,where);
              putpixel (x+b,y+1,c+3,where);
         end;

     for b:=-5 to 5 do
         begin
              c:=getpixel (x+b,y+2,where);
              putpixel (x+b,y+2,c+3,where);
         end;

     for b:=-4 to 4 do
         begin
              c:=getpixel (x+b,y+3,where);
              putpixel (x+b,y+3,c+3,where);
         end;

     for b:=-3 to 3 do
         begin
              c:=getpixel (x+b,y+4,where);
              putpixel (x+b,y+4,c+3,where);
         end;

     for b:=-2 to 2 do
         begin
              c:=getpixel (x+b,y+5,where);
              putpixel (x+b,y+5,c+3,where);
         end;
end;

procedure putcross (x,y:integer;where:word);
var b,c,d:integer;
begin
     for b:=0 to 319 do
         begin
              for d:=-5 to 5 do
                  begin
                       c:=getpixel (b,y+d,where);
                       putpixel (b,y+d,c+5,where);
                  end;
         end;

     for b:=0 to 199 do
         begin
              for d:=-5 to 5 do
                  begin
                       c:=getpixel (x+d,b,where);
                       putpixel (x+d,b,c+5,where);
                  end;
         end;
end;

procedure putcross_b (x,y:integer;where:word);
var b,c,d:integer;
begin
     for b:=0 to 319 do
         begin
              putpixel (b,y,0,where);
         end;
end;

{------dots tunnel-------}

const
  divd=128;
  astep=4;
  xst=4;
  yst=5;
var
  sintab:array[0..449] of integer;
  stab,ctab:array[0..255] of integer;
  lstep:byte;
  xxx,yyy,iii,jjj:word;
  ccc:byte;

procedure set_dots (where:word);
begin

  for iii:=0 to 255 do
  begin
    ctab[iii]:=round(cos(pi*iii/128)*60);
    stab[iii]:=round(sin(pi*iii/128)*45);
  end;
  for iii:=0 to 449 do sintab[iii]:=round(sin(2*pi*iii/360)*divd);

  cls(0,where);
  xxx:=30; yyy:=90;
end;

procedure drawpolar(xo,yo,r,a:word; ccc:byte; lvseg:word); assembler;
asm
  mov es,lvseg

  mov bx,a
  add bx,a
  mov cx,word ptr sintab[bx]
  add bx,2*90
  mov ax,word ptr sintab[bx]
  mul r
  mov bx,divd
  xor dx,dx
  cwd
  idiv bx
  add ax,xo
  add ax,160
  cmp ax,320
  ja @out
  mov si,ax

  mov ax,cx
  mul r
  mov bx,divd
  xor dx,dx
  cwd
  idiv bx
  add ax,yo
  add ax,100
  cmp ax,200
  ja @out

  shl ax,6
  mov di,ax
  shl ax,2
  add di,ax
  add di,si
  mov al,ccc
  mov [es:di],al
 @out:
end;

Type RgbItem=Record
                   R,G,B:Byte;
             End;
     RgbList=Array[0..255] of RgbItem;

Var  ncolors:integer;
     color:array [1..20] of integer;
     temp:rgblist;
     blurg:rgblist;
     blarg:rgblist;
     {a,x,y:integer; done already in balls section...}
     c,r,g,b:integer;
     h,i,j:byte;
     F:file;
     remote:pointer; {remote control image}
     dopefish:pointer; {dopefish image}

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 fadefrom2 (blurg: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>blurg[a].r then r:=r-1;
          if r<blurg[a].r then r:=r+1;
          if g>blurg[a].g then g:=g-1;
          if g<blurg[a].g then g:=g+1;
          if b>blurg[a].b then b:=b-1;
          if b<blurg[a].b then b:=b+1;
          setcolor (a,r,g,b);
     end;
end;

procedure fadefrom3 (blarg: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>blarg[a].r then r:=r-1;
          if r<blarg[a].r then r:=r+1;
          if g>blarg[a].g then g:=g-1;
          if g<blarg[a].g then g:=g+1;
          if b>blarg[a].b then b:=b-1;
          if b<blarg[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 1 do
         begin
              getcolor (color[a],r,g,b);
              setcolor (color[a+1],r,g,b);
         end;
     setcolor (color[1],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 savepal2;
var a:integer;
begin
     for a:=0 to 255 do getcolor (a,blurg[a].r,blurg[a].g,blurg[a].b);
end;

procedure savepal3;
var a:integer;
begin
     for a:=0 to 255 do getcolor (a,blarg[a].r,blarg[a].g,blarg[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 restorepal2;
var a:integer;
begin
     for a:=0 to 255 do setcolor (a,blurg[a].r,blurg[a].g,blurg[a].b);
end;

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

procedure putchannel_id (s,r:string;where:word);
begin
     putstring (235,10,255,15,1,s,1,where);
     putstring (247,27,255,28,2,r,2,where);
end;

procedure set_static(where:word);
begin
     ncolors:=15;
     for a:=1 to 15 do
         begin
              color[a]:=199+a;
         end;

     for x:=0 to 319 do
         begin
              for y:=0 to 199 do
                  begin
                       c:=random(15)+200;
                       putpixel (x,y,c,where);
                  end;
         end;
end;

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

procedure set_psychic2 (where:word);
begin
     ncolors:=15;
     loadpcx_nopal ('tunel2.pcx',where);
     for a:=1 to 15 do
         begin
              color[a]:=150+15-a;
         end;
end;

procedure set_freakout;
begin
     ncolors:=6;
     for a:=1 to 6 do
         begin
              color[a]:=164+a;
         end;
     cls (166,vga);
end;

procedure set_freakout_values1;
begin
     setcolor (165,53,0,60);
     setcolor (166,2,23,11);
     setcolor (167,3,34,54);
     setcolor (168,19,5,63);
     setcolor (169,20,0,6);
     setcolor (170,2,63,34);
end;

procedure set_freakout_values2;
begin
     setcolor (165,3,63,6);
     setcolor (166,25,0,18);
     setcolor (167,3,34,4);
     setcolor (168,63,55,3);
     setcolor (169,20,30,6);
     setcolor (170,42,62,31);
end;

procedure set_freakout_values3;
begin
     setcolor (165,23,41,0);
     setcolor (166,0,3,31);
     setcolor (167,53,4,5);
     setcolor (168,63,45,53);
     setcolor (169,20,50,0);
     setcolor (170,1,63,29);
end;

procedure set_freakout_values4;
begin
     setcolor (165,25,3,20);
     setcolor (166,22,3,1);
     setcolor (167,39,42,4);
     setcolor (168,9,63,63);
     setcolor (169,0,13,26);
     setcolor (170,63,4,4);
end;

procedure set_freakout_values5;
begin
     setcolor (165,33,10,6);
     setcolor (166,6,2,41);
     setcolor (167,3,54,5);
     setcolor (168,6,8,33);
     setcolor (169,53,13,0);
     setcolor (170,13,13,4);
end;

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

procedure set_plasma;
begin
     ncolors:=20;
     for a:=1 to 20 do
         begin
              color[a]:=215+a;
         end;
end;

procedure closingcomments;
begin
     a:=random(3)+1;
     if a=1 then
     begin
     clrscr;
     textcolor (white);
     writeln ('Monday, April 9');
     writeln;
     writeln ('The clock keeps going round.');
     writeln ('It won''t tell me the time.');
     writeln ('Santa Claus gave a gun to me.');
     writeln ('Let loose the puppies of war.');
     writeln ('I died last night.');
     textcolor (lightgray);
     writeln;
     writeln ('                 DREAMWEB');
     end;

     if a=2 then
     begin
     clrscr;
     textcolor (white);
     writeln ('');
     writeln ('Ezekiel 25:17. "The path           ');
     writeln ('of the righteous man is beset on   ');
     writeln ('all sides by the inequities of the ');
     writeln ('selfish and the tyranny of evil men.');
     writeln ('Blessed is he who, in the    ');
     writeln ('name of charity and good will,     ');
     writeln ('shepherds the weak through the     ');
     writeln ('valley of darkness, for he is truly');
     writeln ('his brother''s keeper and the finder');
     writeln ('of lost children. And I will      ');
     writeln ('strike down upon thee with great   ');
     writeln ('vengeance and furious anger those  ');
     writeln ('who attempt to poison and destroy  ');
     writeln ('my brothers.  And you will know my ');
     writeln ('name is the Lord, when I lay my     ');
     writeln ('vengeance upon you."               ');
     textcolor (lightgray);
     writeln;
     writeln ('                 PULP FICTION');
     end;

     if a=3 then
     begin
     clrscr;
     textcolor (white);
     writeln ('');
     writeln ('The job, the family, the fucking big television,');
     writeln ('the washing machine, the car, the compact disc');
     writeln ('and electronic can opener.');
     writeln ('Good health, low colesterol, dental ensurance,');
     writeln ('mortgage, stash money and leisure wear,');
     writeln ('luggage, 3 piece suite, DIY, game shows,');
     writeln ('junk food, children, walks in the park, 9 to 5,');
     writeln ('go to golf, washing the car, choice of sweaters,');
     writeln ('family christmas, index pension, tax issenction,');
     writeln ('cleaning gutters,');
     writeln ('getting by,');
     writeln ('looking ahead,');
     writeln ('the day you die.');
     textcolor (lightgray);
     writeln;
     writeln ('                 TRAINSPOTTING');
     end;
end;

procedure haltproc;
begin

     unloadfont (1);                {unload fonts}
     unloadfont (2);
     unloadfont (3);

     closevirt;                     {vga logoff}
     video_mode ( 03);

     stopmusic;                     {music logoff}
     stopoutput;
     unloadmodule;
     freemse;

     closingcomments;

     halt;
end;

procedure checkkb;
begin
     if keypressed=true then if readkey=#27 then haltproc;
     if keypressed=true then clearkeyboard;
end;

procedure setcolors;
begin
     setcolor (175,0,63,0);         {color settings}
     setcolor (16,0,0,0);
     setcolor (17,5,5,5);           {used colors:                }
     setcolor (18,8,8,8);           {0 & 15      -black and white}
     setcolor (19,11,11,11);        {16-31       -3rd font colors}
     setcolor (20,14,14,14);        {32          -journey color  }
     setcolor (21,17,17,17);        {33-65       -dopefish colors}
     setcolor (22,20,20,20);        {82-99       -remote colors  }
     setcolor (23,24,24,24);        {100-124     -balls colors   }
     setcolor (24,28,28,28);        {150-164     -tunel colors   }
     setcolor (25,32,32,32);        {165-170     -freak colors   }
     setcolor (26,36,36,36);        {175         -1&2 font colors}
     setcolor (27,40,40,40);        {200-215     -static colors  }
     setcolor (28,45,45,45);        {216-236     -intermission   }
     setcolor (29,50,50,50);
     setcolor (30,56,56,56);
     setcolor (31,63,63,63);
     setcolor (32,31,31,31);
     setcolor (82,0,53,0);
     setcolor (83,4,4,4);
     setcolor (84,8,8,8);
     setcolor (85,12,12,12);
     setcolor (86,16,35,63);
     setcolor (87,18,18,18);
     setcolor (88,22,22,22);
     setcolor (89,26,26,26);
     setcolor (90,28,28,28);
     setcolor (91,33,33,33);
     setcolor (92,39,0,0);
     setcolor (93,41,41,41);
     setcolor (94,45,45,45);
     setcolor (95,55,0,0);
     setcolor (96,59,0,0);
     setcolor (97,59,59,0);
     setcolor (98,63,24,22);
     setcolor (99,63,47,47);
     setcolor (100,63,62,63);
     setcolor (101,63,55,63);
     setcolor (102,63,47,63);
     setcolor (103,63,39,63);
     setcolor (104,63,62,63);
     setcolor (105,63,55,63);
     setcolor (106,63,15,63);
     setcolor (107,63,7,63);
     setcolor (108,63,0,63);
     setcolor (109,63,0,54);
     setcolor (110,63,0,46);
     setcolor (111,63,0,38);
     setcolor (112,63,0,30);
     setcolor (113,63,0,22);
     setcolor (114,63,0,14);
     setcolor (115,63,0,6);
     setcolor (116,63,0,0);
     setcolor (117,54,0,0);
     setcolor (118,46,0,0);
     setcolor (119,38,0,0);
     setcolor (120,30,0,0);
     setcolor (121,22,0,0);
     setcolor (122,14,0,0);
     setcolor (123,6,0,0);
     setcolor (124,0,0,0);
     setcolor (165,23,11,63);
     setcolor (166,63,23,11);
     setcolor (167,0,34,2);
     setcolor (168,19,55,3);
     setcolor (169,20,0,63);
     setcolor (170,32,63,34);

     setcolor (33,0,0,0);
     setcolor (34,0,2,0);
     setcolor (35,0,6,0);
     setcolor (36,0,12,0);
     setcolor (37,3,3,2);
     setcolor (38,3,13,3);
     setcolor (39,10,13,8);
     setcolor (40,24,8,6);
     setcolor (41,0,26,0);
     setcolor (42,0,33,0);
     setcolor (43,0,37,0);
     setcolor (44,0,41,0);
     setcolor (45,1,34,1);
     setcolor (46,0,49,0);
     setcolor (47,8,30,8);
     setcolor (48,30,33,30);
     setcolor (49,44,9,5);
     setcolor (50,37,45,37);
     setcolor (51,41,41,41);
     setcolor (52,44,44,44);
     setcolor (53,37,53,37);
     setcolor (54,47,47,47);
     setcolor (55,50,50,50);
     setcolor (56,47,57,47);
     setcolor (57,54,54,54);
     setcolor (58,57,57,57);
     setcolor (59,59,59,59);
     setcolor (60,57,63,63);
     setcolor (61,59,63,59);
     setcolor (62,61,61,61);
     setcolor (63,63,63,59);
     setcolor (64,63,63,63);
     setcolor (65,0,63,63);

     setcolor (216,0,0,63);
     setcolor (217,16,0,63);
     setcolor (218,31,0,63);
     setcolor (219,47,0,63);
     setcolor (220,63,0,63);
     setcolor (221,63,0,47);
     setcolor (222,63,0,31);
     setcolor (223,63,0,16);
     setcolor (224,63,0,0);
     setcolor (225,63,16,0);
     setcolor (226,63,31,0);
     setcolor (227,63,47,0);
     setcolor (228,63,63,0);
     setcolor (229,47,63,0);
     setcolor (230,31,63,0);
     setcolor (231,16,63,0);
     setcolor (232,0,63,0);
     setcolor (233,0,47,16);
     setcolor (234,0,31,31);
     setcolor (235,0,16,47);
     setcolor (236,0,16,63);

     for a:=1 to 8 do setcolor (149+a,0,0,4*a);
     for a:=8 to 15 do setcolor (172-a,0,0,4*(a-7));
     for a:=1 to 16 do setcolor (199+a,4*a-1,4*a-1,4*a-1);
end;

procedure bb1;
begin
     checkkb;
     putcross_b (part[5].x , ((-1)*(part[5].y))+200 , vga);
     putchannel_id ('SPACE','01',vga);
     actualise(5);
     checkbounds(5);
     t[5]:= t[5] + ddt;
     waitvbl;
end;

procedure bb2;
begin
      checkkb;
      for a:=1 to npart do
               begin
               putball (part[a].x , ((-1)*(part[a].y))+200 , vp[2]);
               if a=5 then putcross (part[a].x , ((-1)*(part[a].y))+200 , vp[2]);
               if a=10 then putcross (part[a].x , ((-1)*(part[a].y))+200 , vp[2]);
               if a=15 then putcross (part[a].x , ((-1)*(part[a].y))+200 , vp[2]);
               if a=20 then putcross (part[a].x , ((-1)*(part[a].y))+200 , vp[2]);
               actualise(a);
               checkbounds(a);
               t[a]:= t[a] + dt;
               end;

      putchannel_id ('RESPE','04',vp[2]);
      copypage (vp[2],vga);
      copypage (vp[1],vp[2]);
      waitvbl;
end;

procedure bb3;
begin
     waitvbl;
        ccc:=22;
        lstep:=2;
        jjj:=musicrow;

        while jjj<220 do
        begin
              iii:=0;
              while iii<360 do
              begin
                   drawpolar(ctab[(xxx+(200-jjj)) mod 255],stab[(yyy+(200-jjj)) mod 255],jjj,iii,ccc,vp[1]);
                   inc(iii,astep);
              end;
        inc(jjj,lstep);
        if (jjj mod 5)=0 then begin inc(lstep); inc(ccc); if c>31 then c:=22; end;
        end;

        xxx:=xst+xxx mod 255;
        yyy:=yst+yyy mod 255;
        if keypressed=true then if readkey='d' then putimage (120,60,65,dopefish,vp[1]);
        checkkb;
        putchannel_id ('DOTS ','06',vp[1]);
        copypage (vp[1],vga);
        cls(0,vp[1]);
end;

procedure bb4;
begin
     waitvbl;
        ccc:=22;
        lstep:=2;
        jjj:=63;

        while jjj<220 do
        begin
              iii:=0;
              while iii<360 do
              begin
                   drawpolar(ctab[(xxx+(200-jjj)) mod 255],stab[(yyy+(200-jjj)) mod 255],jjj,iii,ccc,vp[1]);
                   inc(iii,astep);
              end;
        inc(jjj,lstep);
        if (jjj mod 5)=0 then begin inc(lstep); inc(ccc); if c>31 then c:=22; end;
        end;

        xxx:=xst+xxx mod 255;
        yyy:=yst+yyy mod 255;
        if keypressed=true then if readkey='d' then putimage (120,60,65,dopefish,vp[1]);
        checkkb;
        putchannel_id ('DOTS ','06',vp[1]);
        copypage (vp[1],vga);
        cls(0,vp[1]);
end;

procedure bb5;
begin
        waitvbl;
        ccc:=22;
        lstep:=2;
        jjj:=63-musicrow;

        while jjj<220 do
        begin
              iii:=0;
              while iii<360 do
              begin
                   drawpolar(ctab[(xxx+(200-jjj)) mod 255],stab[(yyy+(200-jjj)) mod 255],jjj,iii,ccc,vp[1]);
                   inc(iii,astep);
              end;
        inc(jjj,lstep);
        if (jjj mod 5)=0 then begin inc(lstep); inc(ccc); if c>31 then c:=22; end;
        end;

        xxx:=xst+xxx mod 255;
        yyy:=yst+yyy mod 255;
        if keypressed=true then if readkey='d' then putimage (120,60,65,dopefish,vp[1]);
        checkkb;
        putchannel_id ('DOTS ','06',vp[1]);
        copypage (vp[1],vga);
        cls(0,vp[1]);
end;

procedure bb6;
begin
     checkkb;
     palrotation;
     waitvbl;
end;

begin

     textcolor (lightgray);
     getcardinfo;

     loadmodule ('omnibus.gdm');      {music logon}
     for a:=0 to 63 do fadeto (0,0,0,50);

     if keypressed=true then clearkeyboard;

     video_mode ( $13);             {vga logon}
     initvirt;

     setcolor (15,63,63,63);        {general color settings}
     setcolor (0,0,0,0);
     cls (0,vga);                   {black screens for starters}
     cls (0,vp[1]);
     cls (0,vp[2]);

     loadfont ('tv-high.fnt',1);    {load fonts}
     loadfont ('tv-numbe.fnt',2);
     loadfont ('curry13.fnt',3);

     randomize;                     {because...}
     if keypressed=true then clearkeyboard;
     setcolors;                     {set all purpose colors}

     assign (F,'tv-remot.img');     {load remote image}
     reset (F,1);
     loadimage (F,remote);
     close (F);

     savepal;                       {save pallette for faders}

     loadpcx ('logo1.pcx',vp[1]);   {setup first screen}
     savepal3;                      {save 3rd palete}
     if keypressed=true then clearkeyboard;

     loadpcx ('space.pcx',vp[2]);          {setup later gfx}
     for a:=0 to 319 do for b:=189 to 199 do putpixel (a,b,0,vp[2]);
     for a:=0 to 319 do for b:=0 to 10 do putpixel (a,b,0,vp[2]);
     setcolor (175,0,63,0);
     savepal2;                             {save 2nd palete}

     restorepal3;                          {restore 3rd palete}

     for a:=0 to 63 do fadeto (0,0,0,0);
     copypage (vp[1],vga);

     loadpcx_nopal ('dolby.pcx',vp[1]);    {load dolby surrond to vp1}
     if keypressed=true then clearkeyboard;

     startmusic;                    {start the music now}
{}

     repeat
     checkkb;
     fadefrom3 (blarg,100);
     until musicrow=63;

     checkkb;
     waitmusic (63);

     repeat
           checkkb;
     fadeto (0,0,0,100);
     until musicrow=63;

     cls (0,vga);               {change paletes and pages}
     restorepal;
     for a:=0 to 63 do fadeto (0,0,0,0);
     copypage (vp[1],vga);

     checkkb;
     waitmusic (63);

     repeat
           checkkb;
     fadefrom (temp,100);
     until musicrow=63;

     cls (0,vp[1]);                                    {setup next screen}
     putimage (135,25,0,remote,vp[1]);
     putstring (90,65,15,11,10,'Psychic',3,vp[1]);
     putstring (60,95,15,11,10,'Television',3,vp[1]);

     checkkb;
     waitmusic (63);

     repeat
           checkkb;
     fadeto (0,0,0,100);
     until musicrow=63;

     copypage (vp[1],vga);

     checkkb;
     waitmusic (63);

     repeat
           checkkb;
     fadefrom (temp,100);
     until musicrow=63;

     cls (0,vp[1]);
     set_static(vp[1]);

     checkkb;
     waitmusic (63);

     repeat
           checkkb;
     fadeto (0,0,0,100);
     until musicrow=63;

     killimage (remote);
{}
     putchannel_id ('SONY ','00',vp[1]);
     cls (0,vga);
     restorepal;
     copypage_boom(63,63,63,1);

     checkkb;
     waitmusic (63);

     repeat
           checkkb;

           palrotation;
           waitvbl;

     until musicrow=63;
{}

     copypage_boom (63,63,63,2);
     restorepal2;
     putchannel_id ('SPACE','01',vga);
     loadpcx_nopal ('gfx02.pcx',vp[1]);
     set_psychic2 (vp[2]);
     setballs;
     repeat
           checkkb;
     until musicrow=63;

     waitmusic (63);

     repeat
           bb1;
     until musicrow=63;
{}

     copypage_boom (63,63,63,2);
     restorepal;
     putchannel_id ('TUNNE','02',vga);
     checkkb;
     waitmusic (63);

     repeat
     until musicrow>8;

     repeat
           checkkb;
           palrotation;
     until musicrow>24;

     repeat
           checkkb;
           palrotation;
           waitvbl;
     until musicrow>48;

     repeat
     until musicrow=63;
{}

     copypage_boom (63,63,63,2);
     putchannel_id ('LIGHT','03',vga);
     checkkb;
     waitmusic (63);

     repeat
           checkkb;
           palrotation;
     until musicrow>24;

     repeat
           checkkb;
           palrotation;
           waitvbl;
     until musicrow>40;

     repeat
           checkkb;
           palrotation;
     until musicrow=63;

{}
     copypage_boom (63,63,63,1);
     checkkb;
     waitmusic (63);

     repeat
           bb2;
     until musicrow=63;

     copypage_boom (63,63,63,0);      {intermediate boom}
     setcolor (100,62,63,63);      {swap colors}
     setcolor (101,55,63,63);
     setcolor (102,47,63,63);
     setcolor (103,39,63,63);
     setcolor (104,62,63,63);
     setcolor (105,55,63,63);
     setcolor (106,15,63,63);
     setcolor (107,7,63,63);
     setcolor (108,0,63,63);
     setcolor (109,0,54,63);
     setcolor (110,0,46,63);
     setcolor (111,0,38,63);
     setcolor (112,0,30,63);
     setcolor (113,0,22,63);
     setcolor (114,0,14,63);
     setcolor (115,0,6,63);
     setcolor (116,0,0,63);
     setcolor (117,0,0,54);
     setcolor (118,0,0,46);
     setcolor (119,0,0,38);
     setcolor (120,0,0,30);
     setcolor (121,0,0,22);
     setcolor (122,0,0,14);
     setcolor (123,0,0,6);
     setcolor (124,0,0,0);
     savepal;                      {savepal for next boom}

     checkkb;
     waitmusic (63);               {sync}

     repeat
           bb2;
     until musicrow=63;

     copypage_boom (63,63,63,0);      {intermediate boom}
     setcolor (124,63,63,62);      {swap colors}
     setcolor (123,63,63,55);
     setcolor (122,63,63,47);
     setcolor (121,63,63,39);
     setcolor (120,63,63,31);
     setcolor (119,63,63,23);
     setcolor (118,63,63,15);
     setcolor (117,63,63,7);
     setcolor (116,63,63,0);
     setcolor (115,54,63,0);
     setcolor (114,46,63,0);
     setcolor (113,38,63,0);
     setcolor (112,30,63,0);
     setcolor (111,22,63,0);
     setcolor (110,14,63,0);
     setcolor (109,6,63,0);
     setcolor (108,0,63,0);
     setcolor (107,0,54,0);
     setcolor (106,0,46,0);
     setcolor (105,0,6,0);
     setcolor (104,0,0,0);
     setcolor (103,0,22,0);
     setcolor (102,0,14,0);
     setcolor (101,0,6,0);
     setcolor (100,0,0,0);
     savepal;                      {savepal for next boom}

     waitmusic (63);               {sync}

     repeat
           bb2;
     until musicrow=63;
{}

     cls (32,vp[1]);                       { clear screen }
     cls (32,vga);

     putstring (90,64,15,11,3,'Brain Power',3,vp[1]);
     putstring (100,82,15,11,3,'B.Witched',3,vp[1]);
     putstring (100,102,15,11,3,'Passenger',3,vp[1]);
     putstring (115,122,15,11,3,'Trolha',3,vp[1]);

     checkkb;
     waitmusic (63);

     repeat
           checkkb;
                                        { NOTE: random means 0<=x<range }
     r:=random(210)-106;                    { random numbers for r,g,b }
     g:=random(210)-106;                    { between -1 and 1... }
     b:=random(210)-106;                    { random (3) means 0,1 or 2 :) }

     {normal relaxation is random(3)-1}
     {for real psycho journey write random(a)-a/2-1 beeing a>64 and pair}

     getcolor (32,h,i,j);                { get color settings }
                                        { check bounds }
     if h+r > 63 then r:=0;
     if i+g > 63 then g:=0;
     if j+b > 63 then b:=0;

     if h+r < 0 then r:=0;
     if i+g < 0 then g:=0;
     if j+b < 0 then b:=0;

     setcolor (32,h+r,i+g,j+b);          { new color settings }
     setcolor (33,h-r,i-g,j-b);

     square (musicrow,musicrow,319-musicrow,199-musicrow,33,vp[1]);
     putchannel_id ('GREET','05',vp[1]);
     copypage (vp[1],vga);
     waitvbl;

     until musicrow=63;

     waitmusic (63);

     repeat

     checkkb;
                                        { NOTE: random means 0<=x<range }
     r:=random(210)-106;                    { random numbers for r,g,b }
     g:=random(210)-106;                    { between -1 and 1... }
     b:=random(210)-106;                    { random (3) means 0,1 or 2 :) }

     {normal relaxation is random(3)-1}
     {for real psycho journey write random(a)-a/2-1 beeing a>64 and pair}

     getcolor (32,h,i,j);                { get color settings }
                                        { check bounds }
     if h+r > 63 then r:=0;
     if i+g > 63 then g:=0;
     if j+b > 63 then b:=0;

     if h+r < 0 then r:=0;
     if i+g < 0 then g:=0;
     if j+b < 0 then b:=0;

     setcolor (32,h+r,i+g,j+b);          { new color settings }
     setcolor (33,h-r,i-g,j-b);

     square (63-musicrow,63-musicrow,319-63+musicrow,199-63+musicrow,32,vp[1]);
     putchannel_id ('GREET','05',vp[1]);
     copypage (vp[1],vga);
     waitvbl;

     until musicrow=63;
{}
     unloadfont (3);

     assign (F,'tv-df.img');     {load dopefish image}
     reset (F,1);
     loadimage (F,dopefish);
     close (F);

     set_dots (vp[1]);
     copypage_boom (63,63,63,1);

     waitmusic (63);

     repeat
           bb3;
     until musicrow=63;

     waitmusic (63);

     repeat
     repeat
           bb4;
     until musicrow=63;

     waitmusic (63);
     until musicorder($FF)>18;

     waitmusic (63);

     repeat
           bb5;
     until musicrow=63;

     killimage (dopefish);
     loadfont ('curry13.fnt',3);
{}
     set_freakout;
     copypage_boom (63,63,63,0);
     putchannel_id ('FREAK','07',vga);

     waitmusic (63);

     repeat
           bb6;
     until musicrow=63;

     set_freakout_values1;
     savepal;
     copypage_boom (63,63,63,0);

     waitmusic (63);

     repeat
           bb6;
     until musicrow=63;

     set_freakout_values2;
     savepal;
     copypage_boom (63,63,63,0);

     waitmusic (63);

     repeat
           bb6;
     until musicrow=63;

     set_freakout_values3;
     savepal;
     copypage_boom (63,63,63,0);

     waitmusic (63);

     repeat
           bb6;
     until musicrow=63;

     set_freakout_values4;
     savepal;
     copypage_boom (63,63,63,0);

     waitmusic (63);

     repeat
           checkkb;
           palrotation;
     until musicrow=63;

     set_freakout_values5;
     savepal;
     copypage_boom (63,63,63,0);

     waitmusic (63);

     repeat
           bb6;
     until musicrow=63;

     set_freakout_values4;
     savepal;
     copypage_boom (63,63,63,0);

     waitmusic (63);

     repeat
           bb6;
     until musicrow=63;
{}

     for y:=0 to 9 do for c:=0 to 19 do for x:=1 to 319 do putpixel (x,y*20+c,216+c,vp[1]);
     putstring (45,95,15,11,10,'Intermission',3,vp[1]);
     putchannel_id ('INTER','08',vp[1]);
     copypage_boom (63,63,63,1);
     checkkb;
     loadpcx ('eggs320.pcx',vp[2]);
     setcolor (175,0,63,0);
     for a:=1 to 16 do setcolor (199+a,4*a-1,4*a-1,4*a-1);
     savepal2;
     restorepal;
     waitmusic (63);

     repeat
           checkkb;
     until musicrow=63;
{}

     set_plasma;
     for y:=0 to 9 do for c:=0 to 19 do for x:=1 to 319 do putpixel (x,y*20+c,216+c,vp[1]);
     putchannel_id ('MONTY','09',vp[1]);
     checkkb;
     copypage_boom (63,63,63,1);
     putstring (120,95,15,11,2,'and now',3,vga);
     waitmusic (63);

     repeat
           if musicrow=21 then
              begin
                   copypage (vp[1],vga);
                   putstring (65,65,15,11,5,'for something',3,vga);
                   putstring (95,95,15,11,5,'completly',3,vga);
                   putstring (90,125,15,11,5,'different:',3,vga);
              end;
           if musicrow=42 then
              begin
                   copypage (vp[1],vga);
                   putstring (45,95,15,11,2,'Three broken eggs',3,vga);
              end;
              checkkb;
           palrotation;
           waitvbl;
     until musicrow=63;
{}

     copypage_boom (63,63,63,2);
     putchannel_id ('EGGS ','10',vga);
     restorepal2;
     waitmusic (63);

     repeat
           checkkb;
     until musicrow=53;

{}
     for a:=0 to 99 do
         begin
              square (a,a,319-a,199-a,200,vga);
              delay (15);
         end;
     for a:=0 to 120 do putpixel (100+a,100,215,vga);
     for a:=0 to 59 do
         begin
              putpixel (100+a,100,200,vga);
              putpixel (220-a,100,200,vga);
              delay (15);
         end;
     for a:=200 to 215 do
         begin
              putpixel (160,100,a,vga);
              delay (20);
         end;
     delay (5);
     for a:=215 downto 200 do
         begin
              putpixel (160,100,a,vga);
              delay (20);
         end;
{}
     haltproc;  {bye! bye!}
end.