Program Demo6;

{ SPX library - 3D demo Copyright 1993 Scott D. Ramsay  }

Uses sb,crt,dos,SPX_VGA,SPX_KEY,SPX_IMG,SPX_VSP,spx_sfn;
var
  Wav: Wave_Record;
  font3 : sfn_type;
  pal:rgblist;
  rab,score1:string;
  man:array [0..12] of pointer;
  other:array [0..10] of pointer;
  ryba,ryba1,exit1, spr_bool3, spr_bool:boolean;
  sunx,suny,baksx,baksy,rakx,raky,xf,yf,xf1,yf1,score,score2,x1,y1,x,y,z: integer;
  fish,fish1,spr_tek:byte;
  Int1CSave : Pointer;
{$F+,S-,W-}
procedure fisher; interrupt;
  begin
       if point(xf+6,yf,1)=166 then ryba:=true;
       if xf=290 then ryba:=true;
       if ryba then
       begin
            xf:=xf-1;
            fish:=random(3);
       end;
       if point(xf-6,yf,1)=166 then ryba:=false;
       if xf=1 then ryba:=false;
       if not ryba then
       begin
            xf:=xf+1;
            fish:=(random(3)+3);
       end;
       if point(xf1+6,yf1,1)=166 then ryba1:=true;
       if xf1=290 then ryba1:=true;
       if ryba1 then
       begin
            fish1:=random(3);
            xf1:=xf1-1;
       end;
       if point(xf1-6,yf1,1)=166 then ryba1:=false;
       if xf1=1 then ryba1:=false;
       if not ryba1 then
       begin
            fish1:=(random(3)+3);
            xf1:=xf1+1;
       end;

  end;
{$F-,S+}


procedure take(x,y,z:integer);
begin
     setpageactive(3);
     ftput_clip(x,y,other[9]^,true);
     score:=score+z;
     setpageactive(2);
end;

function checku:boolean;
begin
     if point(x,y-6,1)=166 then checku:=false
     else checku:=true;
     if (point(x,y-6,1)=254) or (point(x,y-6,1)=174) or (point(x,y-6,1)=206) then take(sunx,suny,10);
     if (point(x,y-6,1)=6) or (point(x,y-6,1)=70) or (point(x,y-6,1)=38) then take(rakx,raky,20);
     if (point(x,y-6,1)=6) or (point(x,y-6,1)=70) or (point(x,y-6,1)=38) then take(baksx,baksy,30);
end;

function checkd:boolean;
begin
     if point(x,y+5,1)=166 then checkd:=false
     else checkd:=true;
     if (point(x,y+5,1)=254) or (point(x,y+5,1)=174) or (point(x,y+5,1)=206) then take(sunx,suny,10);
     if (point(x,y+5,1)=6) or (point(x,y+5,1)=70) or (point(x,y+5,1)=38) then take(rakx,raky,20);
     if (point(x,y+5,1)=1466) or (point(x,y+5,1)=178) then take(baksx,baksy,30);
end;

function checkl:boolean;
begin
     if point(x-6,y,1)=166 then checkl:=false
     else checkl:=true;
     if (point(x-6,y,1)=254) or (point(x-6,y,1)=174) or (point(x-6,y,1)=206) then take(sunx,suny,10);
     if (point(x-6,y,1)=6) or (point(x-6,y,1)=70) or (point(x-6,y,1)=38) then take(rakx,raky,20);
     if (point(x-6,y,1)=146) or (point(x-6,y,178)=178) then take(baksx,baksy,30);
end;


function checkr:boolean;
begin
     if point(x+5,y,1)=166 then checkr:=false
     else  checkr:=true;
     if (point(x+5,y,1)=254) or (point(x+5,y,1)=174) or (point(x+5,y,1)=206) then take(sunx,suny,10);
     if (point(x+5,y,1)=6) or (point(x+5,y,1)=70) or (point(x+5,y,1)=38) then take(rakx,raky,20);
     if (point(x+5,y,1)=146) or (point(x+5,y,1)=178)  then take(baksx,baksy,30);
end;
procedure setup;
begin
     If not ResetDSP( bp220h ) then
     begin
          writeln('Sound твоя не поддерживается');
          Halt;
     end;
     loadvsp('man.vsp',man);
     loadvsp('other.vsp',other);
     LoadSfn('mono8.sfn',font3);
     loadcolors('man.col',pal);
     openmode(3);
     SetSfn(font3);
     putletter(245,1,5,'JXRJD');
     GetIntVec($1C,Int1CSave);
     SetIntVec($1C,Addr(fisher));
     exit1:=false;
     x:=50;
     y:=50;
end;

procedure level1;
begin
     setpageactive(3);
     loadpcx('more.pcx');
     fsetcolors(rgb256);
     fadein(40,pal);
     baksx:=240;
     baksy:=170;
     sunx:=140;
     suny:=176;
     rakx:=40;
     raky:=138;
     ftput_clip(sunx,suny,other[6]^,true);
     ftput_clip(rakx,raky,other[7]^,true);
     ftput_clip(baksx,baksy,other[8]^,true);
     x:=318;
     xf:=3;
     yf1:=170;
     xf1:=230;
     yf:=100;
     setPAGEactive(2);
     repeat

{Вправо}   if key[77] then if checkr then begin x:=x+1; spr_tek:=random(2)+3; end;
{Влево}    if key[75] then if checkl then begin x:=x-1; spr_tek:=random(2); end;
{Вниз}     if key[80] then if checkd then begin y:=y+1; spr_tek:=random(2)+6; end;
{Вверх}    if key[72] then if checku then begin y:=y-1; spr_tek:=random(2)+9; end;
           if x=320 then exit;
           if key[key_f11] then exit1:=true;
           pcopy(3,2);
           if (point(x+5,y,1)=36) or (point(x,y+5,1)=36) or (point(x,y-6,1)=36) or (point(x-6,y,1)=36) then
           begin
                putletter(10,0,100,'NB NHEG');
                LoadWave( '1.WAV', WAV );
                PlayWave( Wav );
           end;
           str(score,score1);
           putletter(290,1,43,score1);
           ftput_clip(x,y,man[spr_tek]^,true);
           ftput_clip(xf,yf,other[fish]^,true);
           ftput_clip(xf1,yf1,other[fish1]^,true);
           pcopy(2,1);
     until key[key_f10];
end;

procedure level2;
begin
     setpageactive(3);
     loadpcx('more2.pcx');
     fsetcolors(rgb256);
     fadein(40,pal);
     baksx:=270;
     baksy:=186;
     sunx:=140;
     suny:=173;
     rakx:=76;
     raky:=176;
     ftput_clip(sunx,suny,other[6]^,true);
     ftput_clip(rakx,raky,other[7]^,true);
     ftput_clip(baksx,baksy,other[8]^,true);
     x:=3;
     yf1:=160;
     xf1:=260;
     yf:=100;
     setPAGEactive(2);
     repeat

{Вправо}   if key[77] then if checkr then begin x:=x+1; spr_tek:=random(2)+3; end;
{Влево}    if key[75] then if checkl then begin x:=x-1; spr_tek:=random(2); end;
{Вниз}     if key[80] then if checkd then begin y:=y+1; spr_tek:=random(2)+6; end;
{Вверх}    if key[72] then if checku then begin y:=y-1; spr_tek:=random(2)+9; end;
           if x=0 then exit;
           if key[key_f11] then exit1:=true;
           pcopy(3,2);
           if (point(x+5,y,1)=36) or (point(x,y+5,1)=36) or (point(x,y-6,1)=36) or (point(x-6,y,1)=36) then
           begin
                putletter(10,0,100,'NB NHEG');
                LoadWave( '1.WAV', WAV );
                PlayWave( Wav );
           end;
           str(score,score1);
           putletter(290,1,43,score1);
           ftput_clip(x,y,man[spr_tek]^,true);
           ftput_clip(xf,yf,other[fish]^,true);
           ftput_clip(xf1,yf1,other[fish1]^,true);
           pcopy(2,1);
     until key[key_f10];
end;

begin

     setup;
     repeat
           level1;
           level2;
     until exit1;
     SetIntVec($01C,Int1CSave);
     closemode;
end.


