Uses
    Graph, CRT, Objects, texture;
const
    OldAddress : LongInt=0;
    Count      : word=0;

    BGIPath = 'C:\BP\BGI';
    excContinue   = 0;
    excCancel     = 1;
    excRangeError = 2;
    excKilled     = 3;
    excVictory    = 4;
    kbUp       = #072;
    kbDown     = #080;
    kbLeft     = #075;
    kbRight    = #077;
    kbEsc      = #27;
    kbP        = #112;
var
    Gm, Gd      : integer;
    ToDelay     : byte;
Type

    PSoliter = ^TSoliter;
    TSoliter = object (TMainField)
             fStartLen          : byte;
             fCurDot            : byte;
             fExitCode          : byte;
             fVer               : boolean;
             fPrevVer           : boolean;
             fRule              : char;
             fPrev              : char;
             fX, fY             : byte;
             fXZ, fYZ           : byte;
             fLen               : byte;
             fCol               : byte;
             fIsTurn            : boolean;
             fBack              : boolean;
             fCorCol            : TCornerCol;
             fScore             : TScore;
             fDot               : TDot;
             fLife              : TLife;
             fLevel             : TLevel;
             constructor   Init(len: byte);
             procedure   DrawSoliter;
             procedure   kbEvent;
             procedure   Run;
             procedure   SetNewZCoor;
             procedure   SetNewHeadCoor;
             procedure   DrawBar(X, Y:byte);
             procedure   ChangeDirections;
             procedure   Check;
             procedure   SetFields;
             procedure   AddDot;
             procedure   MoveSoliter;
             destructor  Done;virtual;
    end;

 procedure Int8; Interrupt;
    begin
       Asm
         pushf
         call dword ptr OldAddress
       end;
       Inc(Count);
       Port[$20]:=$20;
    end;

procedure SetInt8;
    begin
        asm cli end;
        OldAddress:=MemL[0:8*4];
        MemW[0:8*4]:=Ofs(Int8);
        MemW[0:8*4+2]:=Seg(Int8);
        asm sti end;
    end;

procedure RestoreInt8;
    begin
        asm cli end;
        MemL[0:8*4]:=OldAddress;
        asm sti end;
    end;


    procedure    ClearBuffer;
          begin
              MemW[0:$41a]:=MemW[0:$41c];
          end;

    procedure    Pause;
          begin
              Repeat until keypressed;
              ClearBuffer;
          end;

    procedure    Wait;
          begin
              Repeat
              until count >= ToDelay;
              Count:=0;
          end;

    constructor    TSoliter.Init;
                  var
                     buf : PCorner;
                  begin
                       Randomize;
                       fStartLen:=len;
                       fLife.Init(TextX, TextY+8, 'Life:');
                       fLife.fCount:=5;
                       fDot.Init(7);
                       fCurDot:=0;
                       fCol:=white;
                       SetColor(fCol);
                       SetFillPattern(FP, fCol);
                       fCorCol.Init(1,1);
                       fCorCol.Insert(New(PCorner, Init(0, 0, kbUp, kbUp)));
                       fScore.Init(TextX,TextY , 'Score:');
                       fLevel.Init(TextX, TextY+4, 'Level:');
                       fLevel.fCount:=1;
                  end;

    procedure   TSoliter.DrawSoliter;
                var
                   i    :byte;
                begin
                   SetFillPattern(FP, fCol);
                   For  i:=0 to fLen-1 do
                       begin
                           DrawBar(fX, fY+i);
                       end;
                end;

    procedure   TSoliter.Run;
                var
                   IsExt : boolean;
                begin
                   fLife.Show;
                   Repeat
                        DrawAll;
                        SetFields;
                        fRule:=kbUp;
                        DrawSoliter;
                        fLevel.Show;
                        Pause;
                        Repeat
                            If fDot.fNotDot then  AddDot;
                            fPrev:=fRule;
                            fPrevVer:=(fRule=kbUp) or (fRule=kbDown);
                            Wait;
                            If KeyPressed then kbEvent;
                            MoveSoliter;
                        until fExitCode <> excContinue;
                        If fExitCode = excVictory then
                          begin
                             inc(fLevel.fCount);
                             inc(fScore.fCount);
                             If ToDelay >= 2 then Dec(ToDelay);
                          end;
                   until (fLife.fCount =0) or (fExitCode = excCancel);

                end;

    procedure    TSoliter.Check;
         function  Beetween(z, a, b:byte):boolean;
              begin
                  Beetween:=((z>=a) and (z<=b)) or ((z>=b)and(z<=a));
              end;

                var
                   i: byte;
                   Min, Max : byte;
                begin
                    If (fX < fMinX) or (fX > fMaxX) or (fY<fMinY) or (fY>fMaxY) then
                       begin
                          fExitCode:=excKilled;
                          Dec(fLife.fCount);
                          fLife.EraseOne;
                          Exit;
                       end;
                    If fCorCol.Count <= 3 then
                       begin
                          Exit;
                       end;
                    i:=4;
                    If fVer then
                        begin
                            While (i+1 < fCorCol.Count) and (fExitCode <> excKilled) do
                              begin
                                  If beetween(fX, PCorner(fCorCol.At(i-1))^.fX, PCorner(fCorCol.At(i))^.fX) then
                                     begin
                                        If fY = PCorner(fCorCol.At(i-1))^.fY then fExitCode:=excKilled;
                                     end;
                                  Inc(i, 2);
                              end;
                             If fExitCode <> excKilled then
                                If beetween(fX, PCorner(fCorCol.At(fCorCol.Count-1))^.fX, fXZ) then
                                     begin
                                        If fY = fYZ then fExitCode:=excKilled;
                                     end;
                        end
                    else
                        begin
                            While (i+1 < fCorCol.Count) and (fExitCode <> excKilled) do
                              begin
                                  If beetween(fY, PCorner(fCorCol.At(i-1))^.fY, PCorner(fCorCol.At(i))^.fY) then
                                     begin
                                        If fX = PCorner(fCorCol.At(i-1))^.fX then fExitCode:=excKilled;
                                     end;
                                  Inc(i, 2);
                              end;
                            If fExitCode <> excKilled then
                                If beetween(fY, PCorner(fCorCol.At(fCorCol.Count-1))^.fY, fYZ) then
                                     begin
                                        If fX = fXZ then fExitCode:=excKilled;
                                     end;
                        end;
                            If fExitCode = excKilled then
                              begin
                                Dec(fLife.fCount);
                                fLife.EraseOne;
                              end;

                end;

    procedure   TSoliter.MoveSoliter;
        begin
              SetNewHeadCoor;
              fDot.fNotDot:=(fX=fDot.fDotX)and(fY=fDot.fDotY);
              If fDot.fNotDot then
                  begin
                      inc(fLen);
                      DrawBar(fX, fY);
                      If fCurDot = fDot.fMaxDot then
                         fExitCode:=excVictory;
                      Exit;
                  end;
              Check;
              SetNewZCoor;
              If fExitCode = excContinue then
                 begin
                     DrawBar(fX, fY);
                     DrawBar(fXZ, fYZ);
                 end;
        end;

    procedure    TSoliter.AddDot;
            function    Ok:boolean;
               var
                  bufOk        : boolean;
                  i, x, y, cor : byte;
               begin
                  fScore.Show;
                  Inc(fCurDot);
                  Inc(fScore.fCount);
                  fDot.fNotDot:=false;
                  x:=fXZ; y:=fYZ;
                  bufOk:=(X<>fDot.fDotX) or (Y<>fDot.fDotY);
                  i:=1;
                  cor:=0;
                  While (i < fLen) and (bufOk) do
                        begin
                        with fCorCol do
                        If (Count-1<>cor)and(PCorner(At(Count-cor-1))^.fX=x)and(PCorner(At(Count-cor-1))^.fY=y)then
                               begin
                                    Inc(cor);
                               end;

                           Case PCorner(fCorCol.At(fCorCol.Count-cor-1))^.fInDir of
                                kbUp   : Dec(Y);
                                kbDown : Inc(Y);
                                kbLeft : Dec(X);
                                kbRight: Inc(X);
                           end;
                           inc(i);
                           bufOk:=(Y<>fDot.fDotY) or (X<>fDot.fDotX);
                        end;
                  Ok:=bufOk;
               end;

                 begin
                     Repeat
                         fDot.fDotX:=fMinX+random(fMaxX-fMinX+1);
                         fDot.fDotY:=fMinY+random(fMaxY-fMinY+1);
                     until Ok;
                     fDot.DrawDot;
                 end;

    procedure    TSoliter.ChangeDirections;
         procedure  CD1(Item:pointer);Far;
               var
                  bufD:char;
               begin
                  If Item = fCorCol.At(0) then Exit;
                  bufD:=PCorner(Item)^.fInDir;
                           Case PCorner(Item)^.fOutDir of
                               kbLeft  : PCorner(Item)^.fInDir:=kbRight;
                               kbRight : PCorner(Item)^.fInDir:=kbLeft;
                               kbUp    : PCorner(Item)^.fInDir:=kbDown;
                               kbDown  : PCorner(Item)^.fInDir:=kbUp;
                           end;
                           Case bufD of
                               kbLeft  : PCorner(Item)^.fOutDir:=kbRight;
                               kbRight : PCorner(Item)^.fOutDir:=kbLeft;
                               kbUp    : PCorner(Item)^.fOutDir:=kbDown;
                               kbDown  : PCorner(Item)^.fOutDir:=kbUp;
                           end;

               end;

                 var
                    buf : byte;
                    bufD: char;
                    bufC: Pointer;
                 begin
                    buf:=fX; fX:=fXZ; fXZ:=buf;
                    buf:=fY; fY:=fYZ; fYZ:=buf;
                    Case PCorner(fCorCol.At(fCorCol.Count-1))^.fInDir of
                       kbLeft  : PCorner(fCorCol.At(0))^.fInDir:=kbRight;
                       kbRight : PCorner(fCorCol.At(0))^.fInDir:=kbLeft;
                       kbUp    : PCorner(fCorCol.At(0))^.fInDir:=kbDown;
                       kbDown  : PCorner(fCorCol.At(0))^.fInDir:=kbUp;
                    end;

                    fRule:=PCorner(fCorCol.At(0))^.fInDir;
                    PCorner(fCorCol.At(0))^.fOutDir:=PCorner(fCorCol.At(0))^.fInDir;
                    fPrev:=fRule;
                    fVer :=(fRule=kbUp)  or (fRule=kbDown);
                    fPrevVer:=fVer;
                    fIsTurn:=false;
                    ;;;;;;;;;;;;;;;;;;;;;;;;
                    fCorCol.ForEach(@CD1);
                    ;;;;;;;;;;;;;;;;;;;;;;;;
                    GetMem(bufC, sizeOf(TCorner));
                    With fCorCol do
                      begin
                         For buf :=1 to (count shr 1) do
                             begin
                                 Move(At(buf)^,bufC^, sizeOf(TCorner));
                                 Move(At(count-buf)^,At(buf)^, sizeOf(TCorner));
                                 Move(bufC^,At(count-buf)^, sizeOf(TCorner));
                             end;
                       end;
                    FreeMem(bufC, sizeOf(TCorner));

                 end;

    procedure    TSoliter.kbEvent;
         var
            IsExt : boolean;
         begin
                fRule:=ReadKey;
                IsExt:= (fRule=#0);
                If IsExt then
                      begin
                         fRule:=ReadKey;
                         fVer:=(fRule=kbUp) or (fRule=kbDown);
                         fIsTurn:=fPrevVer xor fVer;
                      end
                else
                      begin
                         case       fRule of
                            kbEsc : fExitCode:=excCancel;
                            kbP   : Pause;
                         end;
                       end;
                ClearBuffer;
         end;

    procedure    TSoliter.SetNewZCoor;
         begin
             SetFillPattern(FP, fBkCol);
             DrawOne(fXZ, fYZ);
             SetFillPattern(FP, fCol);
             Case PCorner(fCorCol.At(fCorCol.Count-1))^.fInDir of
                kbUp   : Dec(fYZ);
                kbDown : Inc(fYZ);
                kbLeft : Dec(fXZ);
                kbRight: Inc(fXZ);
             end;
             If  (PCorner(fCorCol.At(fCorCol.Count-1))^.fX=fXZ) then
               If (PCorner(fCorCol.At(fCorCol.Count-1))^.fY=fYZ) then
                  If fCorCol.Count <> 1 then
                     fCorCol.AtDelete(fCorCol.Count-1);
         end;

    procedure    TSoliter.SetNewHeadCoor;
                 begin
                    If ((fVer and fPrevVer) and (fRule <> fPrev))or (not(fVer or fPrevVer) and (fRule <> fPrev)) then
                       ChangeDirections;
                    If fIsTurn then
                      begin
                          fCorCol.AtInsert(1, New(PCorner, Init(fX, fY, fPrev, fRule)));
                          PCorner(fCorCol.At(0))^.fInDir:=fRule;
                          PCorner(fCorCol.At(0))^.fOutDir:=fRule;
                      end;

                    Case fRule of
                        kbLeft   : Dec(fX);
                        kbRight  : Inc(fX);
                        kbUp     : Dec(fY);
                        kbDown   : Inc(fY);
                    end;

                 end;


    procedure   TSoliter.SetFields;
         begin
                       fRule:=kbUp;
                       fDot.fNotDot:=true;
                       fLen:=fStartLen;
                       fX:=fMinX+((fMaxX-fMinX) shr 1);
                       fY:=fMinY+((fMaxY-fMinY) shr 1)-(fLen shr 1);
                       fXZ:=fX;
                       fYZ:=fY+fLen-1;
                       fExitCode:=excContinue;
                       fVer:=true;
                       fCorCol.Init(1,1);
                       fCorCol.Insert(New(PCorner, Init(0, 0, kbUp, kbUp)));
                       fCurDot:=0;
                       Dec(fScore.fCount);
         end;

    procedure   TSoliter.DrawBar;
                begin
                     Bar(X*fmasshX+dx, Y*fmasshY+dy, (X+1)*fmasshX-dx, (Y+1)*fmasshY-dy);
                end;


         destructor     TSoliter.Done;
              begin
                  fDot.Done;
                  fScore.Done;
                  fCorCol.Done;
                  Inherited Done;
              end;



var
   Sol: TSoliter;
   MF : TMainField;
begin
     Gd:=detect;
     InitGraph(Gd, Gm, BGIPath);
     Gm:=GraphResult;
     ClearBuffer;
     If Gm <> 0 then
        begin
            WriteLn(GraphErrorMsg(Gm));
            WriteLn('Press any key...');
            ReadKey;
            Halt(1);
        end;
     ToDelay:=10;
     SetInt8;
     MF.Init(1, 1, 20, 20);
     MF.Zastavka;
     Sol.Init(3);
     Sol.Run;
     Sol.Done;
     MF.Done;
     RestoreInt8;
     CloseGraph;
end.