{$M 4048,0,370000}

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

program final;

uses mse_tp;

Const VGA=$A000;
      Npages=3;
      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 integer;
     PTable=^Table;
     Chars=Array[' '..'§'] of pointer;

Var Sines:Ptable;
    Cosines:Ptable;
    Virt:Array[1..Npages] Of Pointer;
    VP:Array[1..Npages] Of Word;
    Font:Chars;
    ytable: array [0..320] of integer;
    temp:rgblist;

Procedure video_mode (mode : Byte); Assembler;
Asm
  mov  AH,00
  mov  AL,mode
  int  10h
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;

Function GetKey (Var Key : Word) : Boolean; Assembler;
Asm
  MOV     AH, 1
  INT     16H
  MOV     AL, 0
  JE      @@1
  xor     AH, AH
  INT     16H
  LES     DI, Key
  MOV     Word PTR ES : [DI], AX
  MOV     AL, 1
 @@1 :
end;

Function GetChar (Var Key : Char) : Boolean;
var c : Word;
begin
  Key := #0;
  if GetKey (c) then
  begin
    GetChar := True;
    if (LO (c) = 0) and (HI (c) <> 0) then
      Key := CHR ( HI (c) + 128 )  { add 128 For FN keys }
    else
      Key := CHR (LO (c) );
  end
  else
    GetChar := False;
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 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 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 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 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]:=round(Sin(B)*100);
          Cosines^[A]:=round(Cos(B)*100);
          B:=B+0.005;
     End;
End;

Procedure ClearTables;
Begin
     Freemem(Sines,Sizeof(Sines^));
     Freemem(Cosines,Sizeof(Cosines^));
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:integer;
    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;

     for a:=y to (Y+DY-1) do
     begin
          for b:=x to (X+DX-1) do
          begin
               If (b>=MinX) then if (a>=MinY) Then
               If (b<=MaxX) then if (a<=MaxY) Then
               if Mem[Segm:Offs]<>c then
                 PutPixel(B,A,Mem[Segm:Offs],Where);
               Inc(Offs);
          end;
     End;
End;

Procedure Putchar(X,Y,C:Integer;N:Char;Where:Word);
Var Dx,Dy:Word;
    a,B:Word;
    Segm,Offs:Word;
    Img:Pointer;
Begin
     Img:=Font[N];
     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 (b>=MinX) then if (a>=MinY) Then
               If (b<=MaxX) then if (a<=MaxY) Then
               if Mem[Segm:Offs]<>c then
                 PutPixel(B,A,Mem[Segm:Offs],Where);
               Inc(Offs);
          end;
     End;
End;

Procedure Putstring(x,y,col,lx,s:integer;n:string;Where:word);
var index:byte;
    dx:integer;
begin
     Dx:=x;
     for index:=0 to length(n)-1 do
         begin
              putchar (Dx,y,col,n[index+1],Where);
              dx:=dx+lx+s;
         end;
end;

Procedure Putstring_c(y,col,lx,s:integer;n:string;Where:word);
var index:byte;
    dx:integer;
begin
     Dx:=160-((s+(length(n))*lx) div 2);
     for index:=0 to length(n)-1 do
         begin
              putchar (Dx,y,col,n[index+1],Where);
              dx:=dx+lx+s;
         end;
end;

procedure rcp(x1,y1,r,n,c:integer;where:word);
var aa,value1,value2:integer;
begin
          for aa:=0 to n do
              begin
                   value1:=random(1259);
                   value2:=random(r);
                   mem[where:(((cosines^[value1]*value2) div 100)+x1)+ytable[(((sines^[value1]*value2) div 100)+y1)]]:=c;
              end;
end;

procedure blur_f(from,too:word);
var x,y,aaa,ccc,ccc2,counter:integer;
    cccc: array [1..9] of integer;
begin
     for x:=1 to 318 do for y:=1 to 198 do
         begin
          cccc[1]:=mem[from:(x)+ytable[y+1]];
          cccc[2]:=mem[from:(x+1)+ytable[y]];
          cccc[3]:=mem[from:(x)+ytable[y]];
          cccc[4]:=mem[from:(x-1)+ytable[y]];
          cccc[5]:=mem[from:(x)+ytable[y-1]];

               ccc2:=(((cccc[1]+cccc[2]+cccc[4]+cccc[5]) div 4) + cccc[3]) div 2;
               mem[too:x+ytable[y]]:=ccc2;

         end;
end;

procedure blur_t(from,too:word);
var x2,y2,aaa,ccc:integer;
    cccc: array [1..9] of integer;
begin
     for x2:=1 to 318 do for y2:=1 to 198 do
         begin
          cccc[1]:=mem[from:(x2+1)+ytable[y2+1]];
          cccc[2]:=mem[from:(x2)+ytable[y2+1]];
          cccc[3]:=mem[from:(x2-1)+ytable[y2+1]];
          cccc[4]:=mem[from:(x2+1)+ytable[y2]];
          cccc[5]:=mem[from:(x2)+ytable[y2]];
          cccc[6]:=mem[from:(x2-1)+ytable[y2]];
          cccc[7]:=mem[from:(x2+1)+ytable[y2-1]];
          cccc[8]:=mem[from:(x2)+ytable[y2-1]];
          cccc[9]:=mem[from:(x2-1)+ytable[y2-1]];

          ccc:=cccc[1];
          for aaa:=2 to 9 do if cccc[aaa]>ccc then ccc:=cccc[aaa];

          if ccc<>0 then if ccc>2 then mem[too:x2+ytable[y2]]:=ccc-2;
      end;
end;

procedure shootup(on:word);
begin
     loadpcx ('font.pcx',on);
     getimage (0,0,15,24,font['a'],on);
     getimage (16,0,32,24,font['b'],on);
     getimage (33,0,47,24,font['c'],on);
     getimage (48,0,63,24,font['d'],on);
     getimage (64,0,80,24,font['e'],on);
     getimage (80,0,95,24,font['f'],on);
     getimage (96,0,111,24,font['g'],on);
     getimage (112,0,128,24,font['h'],on);
     getimage (128,0,143,24,font['i'],on);
     getimage (144,0,158,24,font['j'],on);
     getimage (160,0,175,24,font['k'],on);
     getimage (176,0,190,24,font['l'],on);
     getimage (192,0,207,24,font['m'],on);
     getimage (208,0,222,24,font['n'],on);
     getimage (224,0,238,24,font['o'],on);
     getimage (240,0,254,24,font['p'],on);
     getimage (256,0,272,24,font['q'],on);
     getimage (272,0,288,24,font['r'],on);

     getimage (0,24,16,48,font['s'],on);
     getimage (16,24,31,48,font['t'],on);
     getimage (32,24,48,48,font['u'],on);
     getimage (48,24,63,48,font['v'],on);
     getimage (64,24,80,48,font['w'],on);
     getimage (80,24,96,48,font['x'],on);
     getimage (96,24,111,48,font['y'],on);
     getimage (112,24,126,48,font['z'],on);
     getimage (128,24,144,48,font['0'],on);
     getimage (144,24,159,48,font['1'],on);
     getimage (160,24,176,48,font['2'],on);
     getimage (176,24,192,48,font['3'],on);
     getimage (192,24,208,48,font['4'],on);
     getimage (208,24,224,48,font['5'],on);
     getimage (224,24,240,48,font['6'],on);
     getimage (240,24,256,48,font['7'],on);
     getimage (256,24,272,48,font['8'],on);
     getimage (272,24,288,48,font['9'],on);
     getimage (288,24,304,48,font[' '],on);
end;

const greetx=77;

type stars=record
                 x,y:real;
                 c:integer;
           end;
     points=record
            x,y,r:integer;
            end;

var c:char;
    x,y,xx,muzak,mrow,morder: integer;
    line: array [0..greetx] of string;
    l,px,py,deg,dista,a,p1,p2,perc,refer:integer;
    x1,y1,value1,value2,func1,func2:integer;
    f:text;
    circlie: array [0..2] of pointer;
    counter1,color : integer;
    star:array[1..2000] of stars;
    point:array [0..5] of points;

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;

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;

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 dLine(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(where:word);
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));

           dline (160+SX1, 100-SY1, 160+SX2, 100-SY2,100,where);
           dline (160+SX1+1, 100-SY1, 160+SX2+1, 100-SY2,100,where);
           dline (160+SX1-1, 100-SY1, 160+SX2-1, 100-SY2,100,where);
           dline (160+SX1, 100-SY1+1, 160+SX2, 100-SY2+1,100,where);
           dline (160+SX1, 100-SY1-1, 160+SX2, 100-SY2-1,100,where);
           n := n + 1;
     Until n = linen;
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;

Var
  SoundCardName : String;
  DMA, IRQ : Byte;
  BaseIO : Word;
  SampleRate : Word;
  DMABuffer : Word;
  Handle : File;
  Header : GDMHeader;
  EMSFlag : Word;
  MusicChannels : Word;
  ChannelCount : Word;
  ExitProgram : Boolean;
  n1:char;

Procedure EndProg(ErrorString : String);
{ Prints the error string and Halts the program }
Begin
  Writeln;
  Writeln(ErrorString);
  If IOResult <> 0 then Close(Handle);
  Halt(0);
End;

Function GetSoundCardName : String;
Begin
  Writeln;
  Writeln(' Select Sound Card: ');
  Writeln('   0. No Sound');
  Writeln('   1. Gravis Ultrasound');
  Writeln('   2. Sound Blaster 1.0');
  Writeln('   3. Sound Blaster 2.0');
  Writeln('   4. Sound Blaster Pro');
  Writeln('   5. Sound Blaster 16');
  Writeln('   6. Pro Audio Spectrum');
  repeat until getchar(n1)=true;
    if n1='0' then GetSoundCardName := 'none';
    if n1='1' then GetSoundCardName := 'GUS.MSE';
    if n1='2' then GetSoundCardName := 'SB1X.MSE';
    if n1='3' then GetSoundCardName := 'SB2X.MSE';
    if n1='4' then GetSoundCardName := 'SBPRO.MSE';
    if n1='5' then GetSoundCardName := 'SB16.MSE';
    if n1='6' then GetSoundCardName := 'PAS.MSE';
End;

Function GetIRQNumber : Byte;
Begin
  Writeln;
  Writeln(' Select IRQ: ');
  Writeln('   1. IRQ 2');
  Writeln('   2. IRQ 3');
  Writeln('   3. IRQ 5');
  Writeln('   4. IRQ 7');
  Writeln('   5. IRQ 11');
  Writeln('   6. IRQ 12');
  Writeln('   7. auto-detect');
  repeat until getchar(n1)=true;
  if n1='1' then GetIRQNumber := 2;
  if n1='2' then GetIRQNumber := 3;
  if n1='3' then GetIRQNumber := 5;
  if n1='4' then GetIRQNumber := 7;
  if n1='5' then GetIRQNumber := 11;
  if n1='6' then GetIRQNumber := 12;
  if n1='7' then GetIRQNumber := $FF;
End;

Function GetDMAChannel : Byte;
Begin
  Writeln;
  Writeln(' Select DMA Channel: ');
  Writeln('   1. DMA Channel 1');
  Writeln('   2. DMA Channel 2');
  Writeln('   3. DMA Channel 3');
  Writeln('   4. DMA Channel 5');
  Writeln('   5. auto-detect');
  repeat until getchar(n1)=true;
  if n1='1' then GetDMAChannel := 1;
  if n1='2' then GetDMAChannel := 2;
  if n1='3' then GetDMAChannel := 3;
  if n1='4' then GetDMAChannel := 5;
  if n1='5' then GetDMAChannel := $FF;
End;

Function GetBaseIO : Word;
Begin
  Writeln;
  Writeln(' Select Base I/O Address: ');
  Writeln('   1. 210h');
  Writeln('   2. 220h');
  Writeln('   3. 230h');
  Writeln('   4. 240h');
  Writeln('   5. 250h');
  Writeln('   6. 260h');
  Writeln('   7. auto-detect');
  repeat until getchar(n1)=true;
  if n1='1' then GetBaseIO := $210;
  if n1='2' then GetBaseIO := $220;
  if n1='3' then GetBaseIO := $230;
  if n1='4' then GetBaseIO := $240;
  if n1='5' then GetBaseIO := $250;
  if n1='6' then GetBaseIO := $260;
  if n1='7' then GetBaseIO := $FFFF;
End;

Function ToHex(Num : Word) : String;
{ Converts a decimal number to Hexidecimal }
Const HexChars : String = '0123456789ABCDEF';
Var   Temp : String;
Begin
  Temp := '';
  Temp := Temp + HexChars[((Num Shr 8) And 15) + 1];
  Temp := Temp + HexChars[((Num Shr 4) And 15) + 1];
  Temp := Temp + HexChars[((Num Shr 0) And 15) + 1];
  ToHex := Temp + 'h';
End;

{start}

Begin
  SoundCardName := GetSoundCardName; { Get the Sound card to be used      }

if soundcardname<>'none' then
 begin

  BaseIO := GetBaseIO;               { Get the Base port address          }
  IRQ := GetIRQNumber;               { Get IRQ number                     }
  DMA := GetDMAChannel;              { Get DMA Channel                    }
  SampleRate := 45;                  { Initially set at 45Khz             }
  DMABuffer := 4096;                 { DMA Buffer of 4096 bytes           }
  Case LoadMSE(SoundCardName, 0, SampleRate, DMABuffer, BaseIO, IRQ, DMA) of
    1 : EndProg('Base I/O address autodetection failure');
    2 : EndProg('IRQ level autodetection failure');
    3 : EndProg('DMA channel autodetection failure');
    4 : EndProg('DMA channel not supported');
    6 : EndProg('Sound device does not respond');
    7 : EndProg('Memory control blocks destroyed');
    8 : EndProg('Insufficient memory for mixing buffers');
    9 : EndProg('Insufficient memory for MSE file');
    10: EndProg('MSE has invalid identification string');
    11: EndProg('MSE disk read failure');
    12: EndProg('MVSOUND.SYS not loaded');
  End;
  ExitProc := @FreeMSE;              { Call FreeMSE on abnormal program end }
  If EMSExist                      { Check for EMS }
    Then EMSFlag := 1              { Yes, EMS exists, so use it }
    Else EMSFlag := 0;             { EMS does not exist }

{$I-}                              { Turn off I/O checking }
  Assign(Handle, 'painting.gdm');   { Open the file for loading }
  Reset(Handle);
{$I+}                              { Turn I/O checking back on }
  If IOResult <> 0 Then
     EndProg('Module does not exist');    { File not found, exit program }

  Case LoadGDM(Handle, 0, EMSFlag, Header) of
    1 : EndProg('Module is corrupt');
    2 : EndProg('Could not autodetect module type (N/A)');
    3 : EndProg('Bad file format ID string');
    4 : EndProg('Insufficient memory to load module');
    5 : EndProg('Can not unpack samples');
    6 : EndProg('AdLib instruments not supported');
  End;
  Close(Handle);

    MusicChannels := 0;            { Calculate the number of channels in song }
  For ChannelCount := 1 to 32 do
    Begin
      If Header.PanMap[ChannelCount] <> $FF
        Then MusicChannels := MusicChannels + 1;
    End;
  SampleRate := StartOutput(MusicChannels, 0);

  muzak:=1;

 end

else muzak:=0;

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

     writeln ('module loaded!');

     c:=' ';

     video_mode ( $13);
     initvirt;
     inittables;

     for x:=0 to 320 do ytable[x]:=x*320;

     cls (0,vp[1]);

     shootup(vp[2]);

     getimage (50,60,100,110,circlie[0],vp[2]);
     getimage (100,60,150,110,circlie[1],vp[2]);
     getimage (150,60,200,110,circlie[2],vp[2]);

     assign (f,'greets');
     reset (f);
     for a:=0 to greetx do
         begin
           readln (f,line[a]);
         end;
     close (f);

     randomize;

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

     c:=' ';

     cls (0,vp[2]);
     putstring_c (90,0,16,0,'painting plastics',vp[2]);

     repeat
      mupdate(1);

      if morder=0 then
      begin
       perc:=(mrow*100) div 63;
       for x:=0 to 319 do for y:=0 to 199 do mem[vp[3]:x+ytable[y]]:=
       ((random(256)*perc) div 100) + ((mem[vp[2]:x+ytable[y]]*(100-perc)) div 100);
      end;

      if morder=1 then
      begin
       counter1:=counter1+20;
       if counter1>1259 then counter1:=counter1-1259;
       rcp(150+cosines^[counter1],95+sines^[counter1] div 2,20,1500,200,vp[1]);
       blur_t (vp[1],vp[2]);
       blur_f (vp[2],vp[1]);
       perc:=(mrow*100) div 63;
       for x:=0 to 319 do for y:=0 to 199 do mem[vp[3]:x+ytable[y]]:=
       ((random(256)*(100-perc) div 100) + ((mem[vp[2]:x+ytable[y]]*perc) div 100));
      end;

      if morder=2 then
      begin
       counter1:=counter1+20;
       if counter1>1259 then counter1:=counter1-1259;
       rcp(150+cosines^[counter1],95+sines^[counter1] div 2,20,1500,200,vp[1]);
       blur_t (vp[1],vp[2]);
       blur_f (vp[2],vp[1]);
       move(mem[vp[2]:0],mem[vp[3]:0],64000);
      end;

      if morder>2 then if morder<7 then
      begin
       counter1:=counter1+20;
       if counter1>1259 then counter1:=counter1-1259;
       rcp(150+cosines^[counter1],95+sines^[counter1] div 2,20,1500,200,vp[1]);
       if mrow<30 then if ((mrow mod 3) = 0) then putimage (random(270),random(150),0,circlie[random(3)],vp[1]);
       if mrow=34 then putimage (random(170),random(150),0,circlie[random(3)],vp[1]);
       if mrow>34 then if (((mrow-2) mod 3) = 0) then putimage (random(270),random(150),0,circlie[random(3)],vp[1]);
       blur_t (vp[1],vp[2]);
       blur_f (vp[2],vp[1]);
       move(mem[vp[2]:0],mem[vp[3]:0],64000);
      end;

      move (mem[vp[3]:0],mem[vga:0],64000);
      if getchar(c)=true then c:=#27;
      if morder>6 then c:=#27;
     until c=#27;

{intermission start (morder6)}
     c:=' ';
     for x:=0 to 2000 do
         begin
              star[x].x:=random(320);
              star[x].y:=random(200);
              star[x].c:=random(255)+1;
         end;

     loadpcx_nopal ('side.pcx',vp[2]);
{intermission end (morder7)}

     repeat
      mupdate(1);
      cls (0,vp[1]);

       for x:=0 to 2000 do
         begin
          if morder=7 then
           begin
            star[x].x:=star[x].x+0.125*(star[x].c div 64);
            if star[x].x<0 then star[x].x:=320;
            if star[x].x>320 then star[x].x:=0;
            color:=mem[vp[1]:round(star[x].x)+ytable[round(star[x].y)]]+star[x].c;
            if color>255 then color:=255;
            mem[vp[1]:round(star[x].x)+ytable[round(star[x].y)]]:=color;
           end;

          if morder>7 then
           begin
            star[x].x:=star[x].x+(random(star[x].c) / star[x].c)-0.5;
            star[x].y:=star[x].y+(random(star[x].c) / 256);
            if star[x].x>320 then star[x].x:=0;
            if star[x].x<0 then star[x].x:=320;
            if star[x].y>200 then star[x].y:=0;
            mem[vp[1]:round(star[x].x)+ytable[round(star[x].y)]]:=star[x].c;
           end;
         end;

          if morder=9 then
          begin
           for x:=0 to 319 do mem[vp[1]:x+ytable[0]]:=0;
           for x:=0 to 319 do for y:=1 to 199 do if mem[vp[2]:x+ytable[y]]<>0 then
            mem[vp[1]:x+ytable[y]]:=mem[vp[2]:x+ytable[y]];
          end;

      move(mem[vp[1]:0],mem[vga:0],64000);
      if getchar(c)=true then c:=#27;
      if morder>10 then c:=#27;
     until c=#27;

{intermission start (morder10)}
     c:=' ';
     loadpcx_nopal ('gray0.pcx',vp[2]);
     for x:=0 to 5 do point[x].x:=random (320)-159;
     for x:=0 to 5 do point[x].y:=random (200)-99;
     for x:=0 to 5 do point[x].r:=random (100);
     for x:=0 to 5 do point[x].x:=point[x].x div 2;
     for x:=0 to 5 do point[x].y:=point[x].y div 2;
     savepal;
     for x:=0 to 128 do setcolor (x,x div 2,x div 2,x div 2);
     for x:=128 to 255 do setcolor (x,63-(x div 2),63-(x div 2),63-(x div 2));
{intermission end (morder11)}

     repeat
      mupdate(1);
      cls (0,vp[1]);

      deg:=deg+5;
      if deg>1269 then repeat deg:=deg-1269 until deg<1269;
      for x:=0 to 1 do
       begin
            point[x].x:=point[x].x*coSines^[Deg] div 100;
            point[x].y:=point[x].y*sines^[Deg] div 100;
       end;
      for x:=2 to 3 do
       begin
            point[x].x:=point[x].x+64*Sines^[Deg] div 100;
            point[x].y:=point[x].y+2*Cosines^[Deg] div 100;
       end;
      for x:=4 to 5 do
       begin
            point[x].x:=point[x].r+2*Sines^[Deg] div 100;
            point[x].y:=point[x].r+16*Cosines^[Deg] div 100;
       end;
      for x:=-159 to 159 do for y:=-99 to 99 do
      begin
           dista:=0;
           for xx:=0 to 5 do dista:=dista+(sqr(point[xx].x-x)+sqr(point[xx].y-y));
           dista:=dista div 256;
           mem[vp[1]:(x+159)+ytable[y+99]]:=dista;
      end;
      waitvbl;
      move(mem[vp[1]:0],mem[vga:0],64000);
      if getchar(c)=true then c:=#27;
      if morder>14 then c:=#27;
     until c=#27;

{intermission start (morder14)}
     c:=' ';
     shootup(vp[1]);
     loadpcx_nopal ('gray1.pcx',vp[1]);
     {second pic was loaded b4 last intermission ;)}
{intermission end (morder15)}

     repeat
      mupdate(1);

      if morder<19 then
      begin
       cls (0,vp[3]);
       if ((morder mod 2) = 0) then perc:=(mrow*100) div 63
                               else perc:=((63-mrow)*100) div 63;

       for x:=0 to 319 do for y:=0 to 199 do mem[vp[3]:x+ytable[y]]:=
        ((mem[vp[1]:x+ytable[y]]*perc) div 100) + ((mem[vp[2]:x+ytable[y]]*(100-perc)) div 100);

       refer:=200-mrow*7-(morder-15)*441;
       for x:=0 to greetx-1 do putstring (20,refer+x*19,0,16,0,line[x],vp[3]);
      end;

      if morder>18 then
      begin
       if morder=19 then
        begin
         cls (0,vp[2]);
         putstring_c (20,0,16,0,'music',vp[2]);
         putstring_c (120,0,16,0,'vim',vp[2]);
        end;

       if morder=20 then
        begin
         move (mem[vp[3]:0],mem[vp[1]:0],64000);
         cls (0,vp[2]);
         putstring_c (20,0,16,0,'code',vp[2]);
         putstring_c (120,0,16,0,'psychic symphony',vp[2]);
        end;

       if morder=21 then
        begin
         move (mem[vp[3]:0],mem[vp[1]:0],64000);
         cls (0,vp[2]);
         putstring_c (20,0,16,0,'graphics',vp[2]);
         putstring_c (120,0,16,0,'hellfire',vp[2]);
        end;

       if morder=22 then
        begin
         move (mem[vp[3]:0],mem[vp[1]:0],64000);
         cls (0,vp[2]);
         putstring_c (20,0,16,0,'dedicated to',vp[2]);
         putstring_c (120,0,16,0,'distance',vp[2]);
        end;

       perc:=(mrow*100) div 63;
       for x:=0 to 319 do for y:=0 to 199 do mem[vp[3]:x+ytable[y]]:=
        ((mem[vp[2]:x+ytable[y]]*perc) div 100) + ((mem[vp[1]:x+ytable[y]]*(100-perc)) div 100);
       putstring (20,200+a*20-mrow*5,0,16,0,line[a],vp[2]);
      end;

      move(mem[vp[3]:0],mem[vga:0],64000);
      if getchar(c)=true then c:=#27;
      if morder>22 then c:=#27;
     until c=#27;

{intermission start (morder22)}
     c:=' ';

      assign (f,'3dcube.ps');
      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);

      ang:= Pi/72;
{intermission end (morder23)}

     repeat
      mupdate(1);
      cls (0,vp[1]);

      Drawlines(vp[1]);

      if mrow<30 then if ((mrow mod 3) = 0) then perc:=random(21)*3;
      if mrow=34 then perc:=random(21)*3;
      if mrow>34 then if (((mrow+2) mod 3) = 0) then perc:=random(21)*3;

      for x:=0 to 319 do for y:=0 to 199 do mem[vp[3]:x+ytable[y]]:=
       ((random(256)*perc) div 100) + ((mem[vp[1]:x+ytable[y]]*(100-perc)) div 100);

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

      move(mem[vp[3]:0],mem[vga:0],64000);
      if getchar(c)=true then c:=#27;
      if morder>26 then c:=#27;
     until c=#27;

{intermission start (morder26)}
     c:=' ';

     for x:=0 to 319 do for y:=0 to 199 do mem[vp[1]:x+ytable[y]]:=random(256);

     blur_f(vp[1],vp[2]);
     blur_f(vp[2],vp[1]);

{intermission end (morder27)}

     repeat
      mupdate(1);
      cls (0,vp[2]);

      deg:=deg+9;
      if deg>1279 then deg:=deg-1279;

      for x:=-160 to 160 do
       for y:=-100 to 100 do
           begin
                value1:=(deg);

                if value1>1279 then repeat value1:=value1-1279 until value1<1279;
                if value1<0 then repeat value1:=value1+1279 until value1>0;

                func1:=round(x*cosines^[value1]-y*sines^[value1]);
                func2:=round(y*cosines^[value1]+x*sines^[value1]);

                x1:=x+func1 div 100;
                y1:=y+func2 div 100;
                if x1<-159 then repeat x1:=x1+319 until x1>-159;;
                if x1>159 then repeat x1:=x1-319 until x1<159;
                if y1<-99 then repeat y1:=y1+199 until y1>-99;
                if y1>99 then repeat y1:=y1-199 until y1<99;

                mem[vp[2]:(160-x)+ytable[100+y]]:=mem[vp[1]:(160-x1)+ytable[100+y1]];
           end;

      if mrow<30 then if ((mrow mod 3) = 0) then perc:=random(21)*3;
      if mrow=34 then perc:=random(12)*3;
      if mrow>34 then if (((mrow+2) mod 3) = 0) then perc:=random(21)*3;

      for x:=0 to 319 do for y:=0 to 199 do mem[vp[3]:x+ytable[y]]:=
       ((random(256)*perc) div 100) + ((mem[vp[2]:x+ytable[y]]*(100-perc)) div 100);

      move(mem[vp[3]:0],mem[vga:0],64000);
      if getchar(c)=true then c:=#27;
      if morder>31 then if mrow>50 then c:=#27;
     until c=#27;

     c:=' ';

     for c:='a'  to 'z' do killimage (font[c]);
     for c:='0'  to '9' do killimage (font[c]);
     killimage(font[' ']);

     cleartables;
     closevirt;
     video_mode ( 03);

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

     writeln;
     writeln ('another wannabe demo hacked, sorry bout not doing justice to yar song vimster');
end.