Initial commit

3 files changed, 2218 insertions, 0 deletions

diff --git a/figure.pp b/figure.pp
new file mode 100644
index 0000000..dd88668
--- /dev/null
+++ b/figure.pp
@@ -0,0 +1,1135 @@
+unit figure;
+interface
+
+const
+    CupWidth = 31;
+    CupHeight = 30;
+    BeginCup = 1;
+    WidthSquare = 3;
+    HeightSquare = 2;
+type
+    direction = (left, right, up, down, turning, center);
+    borders = record
+        left, right,
+        up, down: integer
+    end;
+    SquareItemPtr = ^SquareItem;
+    SquareItem = record
+        x: integer;
+        y: integer;
+        next: SquareItemPtr;
+        {for define center of figure}
+        CurDir: direction;
+        color: word;
+    end;
+    ShapeList = record
+        first: SquareItemPtr;
+        last: SquareItemPtr;
+        {for define moving of figure}
+        CurDir: direction;
+        cx, cy: integer;
+        IsSquare: boolean;
+        CanTurn: boolean;
+    end;
+    ExpectedPlace = record
+        FromX: integer;
+        FromY: integer;
+        CurSide: direction;
+    end;
+    TempSquareItemPtr = ^TempSquareItem;
+    TempSquareItem = record
+        OldX: integer;
+        OldY: integer;
+        ActualSquare: SquareItemPtr;
+        next: TempSquareItemPtr;
+    end;
+    ProcValuesType = record
+        first: TempSquareItemPtr;
+        last: TempSquareItemPtr;
+    end;
+    EdgeType = record
+        x, y: integer;
+    end;
+
+function IsHighestFigure(shape: ShapeList): boolean;
+function FigureInVision(shape: ShapeList; CurBorders: borders): boolean;
+function FindSquareShape(shape: ShapeList): boolean;
+function IsAboveTop(square: SquareItemPtr; CurBorders: borders): boolean;
+procedure SetBorders(var CurBorders: borders; left, right, up, down: integer);
+procedure CreateSquare(var shape: ShapeList; color: word);
+procedure PrintAndHideShape(shape: ShapeList; CurBorders: borders; 
+                            HideShape, HideCenter: boolean);
+procedure CheckBorders(var shape, ChangedShape: ShapeList; CurBorders: borders; 
+                       var IsObstacle: boolean);
+procedure FigureInitial(var shape: ShapeList; CurBorders: borders);
+procedure CalculateNewXY(shape: ShapeList; var ChangedShape: ShapeList);
+procedure FindCenterFigure(var shape: ShapeList);
+procedure ComputeTurn(var ChangedShape: ShapeList);
+procedure ClearShape(var square: SquareItemPtr);
+procedure InitEdges(var LeftEdge, RightEdge, UpEdge, DownEdge: EdgeType; 
+                    shape: ShapeList);
+procedure PrintPreviewShape(NextShape: ShapeList);
+
+implementation
+uses crt;
+
+const
+    MaxSquaresFromCenter = 3;
+type
+    MadeTurn = record
+        x: integer;
+        y: integer;
+    end; 
+    ArrTurn = array [1..MaxSquaresFromCenter] of MadeTurn;
+    AllTurnsType = record
+        left, right: ArrTurn;
+        up, down: ArrTurn;
+    end;
+    TypeSort = (increase, decrease);
+
+function FindSquareShape(shape: ShapeList): boolean;
+const
+    SquareSide = 2;
+    UpperBorder = -1;
+type
+    SidesType = record
+        x1, x2: integer;
+        CountX1, CountX2: integer;
+    end;
+var
+    sides: SidesType;
+    square: SquareItemPtr;
+begin
+    square := shape.first;
+    sides.x1 := square^.x;
+    sides.CountX1 := 1;
+    sides.x2 := 0;
+    sides.CountX2 := 0;
+    square := square^.next;
+    while square <> nil do
+    begin
+        if square^.y >= UpperBorder then
+            begin
+            if (square^.x = sides.x1) then
+                sides.CountX1 := sides.CountX1 + 1
+            else if (square^.x = sides.x2) then
+                sides.CountX2 := sides.CountX2 + 1
+            else if sides.x2 = 0 then
+            begin
+                sides.CountX2 := 1;
+                sides.x2 := square^.x
+            end
+        end;
+        square := square^.next
+    end;
+    FindSquareShape := (sides.CountX1 = SquareSide) and 
+                       (sides.CountX2 = SquareSide)
+end;
+
+function IsHighestFigure(shape: ShapeList): boolean;
+var
+    square: SquareItemPtr;
+begin
+    square := shape.first;
+    while square <> nil do
+    begin
+        if square^.y < 1 then
+        begin
+            IsHighestFigure := true;
+            exit
+        end;
+        square := square^.next
+    end;
+    IsHighestFigure := false
+end;
+
+procedure SetBorders(var CurBorders: borders; left, right, up, down: integer);
+begin
+    CurBorders.left := left;
+    CurBorders.right := right;
+    CurBorders.up := up;
+    CurBorders.down := down
+end;
+
+function IsPlaceTaken(x, y: integer; shape: ShapeList): boolean;
+var
+    square: SquareItemPtr;
+begin
+    square := shape.first;
+    while square <> nil do
+    begin
+        if (square^.x = x) and (square^.y = y) then
+        begin
+            IsPlaceTaken := true;
+            exit
+        end
+        else
+            square := square^.next
+    end;
+    IsPlaceTaken := false
+end;
+
+function CorrectPos(place: ExpectedPlace; shape: ShapeList) : boolean;
+var
+    CurX, CurY: integer;
+begin
+    CurX := place.FromX;
+    CurY := place.FromY;
+    case place.CurSide of
+        left: CorrectPos := not IsPlaceTaken(CurX - WidthSquare, CurY, shape);
+        right: CorrectPos := not IsPlaceTaken(CurX + WidthSquare, CurY, shape);
+        up: CorrectPos := not IsPlaceTaken(CurX, CurY - HeightSquare, shape);
+        down: CorrectPos := not IsPlaceTaken(CurX, CurY + HeightSquare, shape)
+    end
+end;
+
+procedure SetLastSquare(var shape: ShapeList; x, y: integer; CurDir: direction);
+begin
+    shape.last^.x := x;
+    shape.last^.y := y;
+    shape.last^.CurDir := CurDir
+end;
+
+procedure SelectPos(var shape: ShapeList; TotalSquares: integer);
+const
+    sides = 4;
+var
+    place: ExpectedPlace;
+    tmp: SquareItemPtr;
+    IdxSquare, i: integer;
+begin
+    tmp := shape.first;
+    IdxSquare := random(TotalSquares);
+    for i:= 1 to IdxSquare do
+        tmp := tmp^.next;
+    place.FromX := tmp^.x;
+    place.FromY := tmp^.y;
+    place.CurSide := direction(random(sides));
+    while not CorrectPos(place, shape) or 
+        ((place.CurSide = down) and ((place.FromY + HeightSquare) > 1)) do
+        place.CurSide := direction(random(sides));
+    case place.CurSide of
+        left: SetLastSquare(shape, place.FromX - WidthSquare, place.FromY, 
+            left);
+        right: SetLastSquare(shape, place.FromX + WidthSquare, place.FromY,
+            right);
+        up: SetLastSquare(shape, place.FromX, place.FromY - HeightSquare, 
+            up);
+        down: SetLastSquare(shape, place.FromX, place.FromY + HeightSquare,
+            down)
+    end;
+end;
+
+procedure ClearShape(var square: SquareItemPtr);
+begin
+    if square = nil then
+        exit;
+    ClearShape(square^.next);
+    dispose(square)
+end;
+
+procedure CreateLineShape(var shape: ShapeList; color: word);
+var
+    x, y: integer;
+begin
+    if shape.first = nil then
+    begin
+        new(shape.first);
+        shape.last := shape.first
+    end
+    else
+    begin
+        x := shape.last^.x;
+        y := shape.last^.y - HeightSquare;
+        new(shape.last^.next);
+        shape.last := shape.last^.next;
+        shape.last^.x := x;
+        shape.last^.y := y;
+        shape.last^.CurDir := up;
+    end;
+    shape.last^.next := nil;
+    shape.last^.color := color
+end;
+
+procedure CreateSquare(var shape: ShapeList; color: word);
+begin
+    if shape.first = nil then
+    begin
+        new(shape.first);
+        shape.last := shape.first
+    end
+    else
+    begin
+        new(shape.last^.next);
+        shape.last := shape.last^.next
+    end;
+    shape.last^.next := nil;
+    shape.last^.color := color
+end;
+
+function IsOnBorders(ChangedShape: ShapeList; CurBorders: borders): boolean;
+var
+    square: SquareItemPtr;
+begin
+    square := ChangedShape.first;
+    while square <> nil do
+    begin
+        if (square^.x < CurBorders.left) or 
+            (square^.x + WidthSquare - 1 > CurBorders.right) or
+            (square^.y + HeightSquare - 1 > CurBorders.down) then
+        begin
+            IsOnBorders := true;
+            exit
+        end;
+        square := square^.next
+    end;
+    IsOnBorders := false
+end;
+
+function IsAboveTop(square: SquareItemPtr; CurBorders: borders): boolean;
+begin
+    IsAboveTop := square^.y < CurBorders.up
+end;
+
+function FigureInVision(shape: ShapeList; CurBorders: borders): boolean;
+var
+    square: SquareItemPtr;
+begin
+    square := shape.first;
+    while square <> nil do
+    begin
+        if IsAboveTop(square, CurBorders) then
+        begin
+            FigureInVision := false;
+            exit
+        end;
+        square := square^.next
+    end;
+    FigureInVision := true
+end;
+
+procedure ClearPreview;
+const
+    PrX = 37;
+    PrY = 7;
+    MaxHeight = 4;
+    MaxWidth = 7;
+var
+    i, j: integer;
+begin
+    for i := 0 to MaxHeight-1 do
+    begin
+        for j := 0 to MaxWidth-1 do
+        begin
+            GotoXY(PrX+j, PrY+i);
+            write(' ')
+        end;
+        writeln
+    end
+end;
+
+procedure PrintPreviewShape(NextShape: ShapeList);
+const
+    PrX = 40;
+    PrY = 10;
+type
+    FindOutPos = record
+        square: SquareItemPtr;
+        px, py: integer;
+    end;
+var
+    PosArr: array [1..4] of FindOutPos;
+    square: SquareItemPtr;
+    i, j: integer;
+    dx, dy: integer;
+begin
+    ClearPreview;
+    i := 1;
+    square := NextShape.first;
+    PosArr[i].square := square;
+    PosArr[i].px := PrX;
+    PosArr[i].py := PrY;
+    GotoXY(PosArr[i].px, PosArr[i].py);
+    TextColor(NextShape.first^.color);
+    write('*');
+    square := square^.next;
+    while square <> nil do
+    begin
+        i := i + 1;
+        PosArr[i].square := square;
+        case square^.CurDir of
+            left: begin
+                dx := WidthSquare;
+                dy := 0
+            end;
+            right: begin
+                dx := -WidthSquare;
+                dy := 0
+            end;
+            up: begin
+                dx := 0;
+                dy := HeightSquare
+            end;
+            down: begin
+                dx := 0;
+                dy := -HeightSquare
+            end
+        end;
+        for j := i-1 downto 1 do
+        begin
+            if (PosArr[j].square^.x = square^.x + dx) and 
+                (PosArr[j].square^.y = square^.y + dy) then
+            begin
+                case square^.CurDir of
+                    left: begin
+                        PosArr[i].px := PosArr[j].px - 1;
+                        PosArr[i].py := PosArr[j].py
+                    end;
+                    right: begin
+                        PosArr[i].px := PosArr[j].px + 1;
+                        PosArr[i].py := PosArr[j].py
+                    end;
+                    up: begin
+                        PosArr[i].px := PosArr[j].px;
+                        PosArr[i].py := PosArr[j].py - 1
+                    end;
+                    down: begin
+                        PosArr[i].px := PosArr[j].px;
+                        PosArr[i].py := PosArr[j].py + 1
+                    end
+                    else
+                        continue
+                end
+            end
+            else
+                continue;
+            GotoXY(PosArr[i].px, PosArr[i].py);
+            write('*')
+        end;
+        square := square^.next
+    end
+end;
+
+procedure PrintAndHideShape(shape: ShapeList; CurBorders: borders; 
+                            HideShape, HideCenter: boolean);
+var
+    square: SquareItemPtr;
+    i, j: integer;
+    IsCenter: boolean = false;
+begin
+    square := shape.first;
+    while square <> nil do
+    begin
+        for i := 0 to HeightSquare-1 do
+        begin
+            for j := 0 to WidthSquare-1 do
+            begin
+                if not IsAboveTop(square, CurBorders) then
+                begin
+                    if not shape.IsSquare and (square^.x+j = shape.cx) 
+                        and (square^.y+i = shape.cy) and not HideShape and
+                        not HideCenter then
+                        IsCenter := true;
+                    if IsCenter then
+                        TextColor(Red)
+                    else if not HideShape then
+                        TextColor(square^.color);
+                    GotoXY(square^.x+j, square^.y+i);
+                    if not HideShape then
+                        write('*')
+                    else
+                        write(' ')
+                end
+            end;
+            writeln
+        end;
+        IsCenter := false;
+        square := square^.next
+    end;
+    GotoXY(1, 1)
+end;
+
+procedure FindCenterFigure(var shape: ShapeList);
+var
+    square: SquareItemPtr;
+    TempSquare: SquareItemPtr;
+begin
+    {square shape don't have any center}
+    if shape.IsSquare then
+        exit;
+    {centers were initialized}
+    if (shape.cx <> - 1) and (shape.cy <> -1) then
+        exit;
+    shape.cx := shape.first^.x;
+    shape.cy := shape.first^.y;
+    square := shape.first;
+    while square <> nil do
+    begin
+        TempSquare := shape.first; 
+        while TempSquare <> nil do
+        begin
+            if (square <> TempSquare) and 
+                (square^.CurDir = TempSquare^.CurDir) then
+            begin
+                shape.cx := square^.x;
+                shape.cy := square^.y;
+                exit
+            end;
+            TempSquare := TempSquare^.next;
+        end;
+        square := square^.next;
+    end
+end;
+
+procedure InitEdges(var LeftEdge, RightEdge, UpEdge, DownEdge: EdgeType; 
+                    shape: ShapeList);
+var
+    square: SquareItemPtr;
+begin
+    LeftEdge.x := 0;
+    LeftEdge.y := 0;
+    RightEdge.x := 0;
+    RightEdge.y := 0;
+    UpEdge.x := 0;
+    UpEdge.y := 0;
+    DownEdge.x := 0;
+    DownEdge.y := 0;
+    square := shape.first;
+    while square <> nil do
+    begin
+        {left}
+        if square^.x < shape.cx then
+        begin
+            if LeftEdge.x = 0 then
+            begin
+                LeftEdge.x := square^.x;
+                LeftEdge.y := square^.y
+            end
+            else if square^.x < LeftEdge.x then
+            begin
+                LeftEdge.x := square^.x;
+                LeftEdge.y := square^.y
+            end
+            else if (square^.x = LeftEdge.x) and (square^.y < LeftEdge.y) then
+            begin
+                LeftEdge.x := square^.x;
+                LeftEdge.y := square^.y
+            end
+        end;
+        {right}
+        if square^.x > shape.cx then
+        begin
+            if RightEdge.x = 0 then
+            begin
+                RightEdge.x := square^.x;
+                RightEdge.y := square^.y
+            end
+            else if square^.x > RightEdge.x then
+            begin
+                RightEdge.x := square^.x;
+                RightEdge.y := square^.y
+            end
+            else if (square^.x = RightEdge.x) and (square^.y > RightEdge.y) then
+            begin
+                RightEdge.x := square^.x;
+                RightEdge.y := square^.y
+            end
+        end;
+        {up}
+        if square^.y < shape.cy then
+        begin
+            if UpEdge.y = 0 then
+            begin
+                UpEdge.x := square^.x;
+                UpEdge.y := square^.y
+            end
+            else if square^.y < UpEdge.y then
+            begin
+                UpEdge.x := square^.x;
+                UpEdge.y := square^.y
+            end
+            else if (square^.y = UpEdge.y) and (square^.x > UpEdge.x) then
+            begin
+                UpEdge.x := square^.x;
+                UpEdge.y := square^.y
+            end
+        end;
+        {down}
+        if square^.y > shape.cy then
+        begin
+            if DownEdge.y = 0 then
+            begin
+                DownEdge.x := square^.x;
+                DownEdge.y := square^.y
+            end
+            else if square^.y > DownEdge.y then
+            begin
+                DownEdge.x := square^.x;
+                DownEdge.y := square^.y
+            end
+            else if (square^.y = DownEdge.y) and (square^.x < DownEdge.x) then
+            begin
+                UpEdge.x := square^.x;
+                UpEdge.y := square^.y
+            end
+        end;
+        square := square^.next
+    end
+end;
+
+procedure CopyShape(shape: ShapeList; var ChangedShape: ShapeList);
+var
+    square: SquareItemPtr;
+begin
+    square := shape.first;
+    while square <> nil do
+    begin
+        CreateSquare(ChangedShape, Black);
+        ChangedShape.last^.x := square^.x;
+        ChangedShape.last^.y := square^.y;
+        ChangedShape.last^.CurDir := square^.CurDir;
+        ChangedShape.last^.color := square^.color;
+        square := square^.next
+    end;
+    ChangedShape.CurDir := shape.CurDir;
+    ChangedShape.IsSquare := shape.IsSquare;
+    ChangedShape.cx := shape.cx;
+    ChangedShape.cy := shape.cy
+end;
+
+procedure CalculateNewXY(shape: ShapeList; var ChangedShape: ShapeList);
+var
+    dx, dy: integer;
+    square: SquareItemPtr;
+begin
+    case shape.CurDir of
+        left: begin
+            dx := -WidthSquare;
+            dy := 0
+        end;
+        right: begin
+            dx := WidthSquare;
+            dy := 0
+        end;
+        down: begin
+            dx := 0;
+            dy := HeightSquare
+        end
+    end;
+    square := ChangedShape.first;
+    while square <> nil do
+    begin
+        square^.x := square^.x + dx;
+        square^.y := square^.y + dy;
+        square := square^.next
+    end;
+    ChangedShape.cx := ChangedShape.cx + dx;
+    ChangedShape.cy := ChangedShape.cy + dy
+end;
+
+procedure swap(var first, second: MadeTurn);
+var
+    temp: MadeTurn;
+begin
+    temp := first;
+    first := second;
+    second := temp
+end;
+
+procedure SortArr(var CurArr: ArrTurn; SortWay: TypeSort; CurDir: direction);
+const
+    n = 2;
+var
+    i, j: integer;
+begin
+    if SortWay = increase then
+    begin
+        for i := 0 to n - 1 do
+            for j := 0 to n - 1 - i do
+            begin
+                if CurDir = right then
+                begin
+                    if CurArr[j+1].x > CurArr[j+2].x then
+                        swap(CurArr[j+1], CurArr[j+2])
+                end
+                else if CurDir = down then
+                    if CurArr[j+1].x > CurArr[j+2].x then
+                        swap(CurArr[j+1], CurArr[j+2])
+            end
+    end
+    else
+        for i := 0 to n - 1 do
+            for j := 0 to n - 1 - i do
+            begin
+                if CurDir = left then
+                begin
+                    if CurArr[j+1].x < CurArr[j+2].x then
+                        swap(CurArr[j+1], CurArr[j+2])
+                end
+                else if CurDir = up then
+                    if CurArr[j+1].y < CurArr[j+2].y then
+                        swap(CurArr[j+1], CurArr[j+2])
+            end
+end;
+
+function FindSquare(ProcValues: ProcValuesType; x, y: integer)
+                                                        : SquareItemPtr;
+var
+    TempSquare: TempSquareItemPtr;
+begin
+    TempSquare := ProcValues.first;
+    while TempSquare <> nil do
+    begin
+        if (TempSquare^.OldX = x) and (TempSquare^.OldY = y) then
+        begin
+            FindSquare := TempSquare^.ActualSquare;
+            exit
+        end;
+        TempSquare := TempSquare^.next
+    end;
+    FindSquare := nil
+end;
+
+{for searching old values which not containing completed offset}
+procedure AddProcValue(var ProcValues: ProcValuesType; OldX, OldY: integer;
+                           square: SquareItemPtr);
+begin
+    if ProcValues.first = nil then
+    begin
+        new(ProcValues.first);
+        ProcValues.last := ProcValues.first
+    end
+    else
+    begin
+        new(ProcValues.last^.next);
+        ProcValues.last := ProcValues.last^.next
+    end;
+    ProcValues.last^.next := nil;
+    ProcValues.last^.OldX := OldX;
+    ProcValues.last^.OldY := OldY;
+    ProcValues.last^.ActualSquare := square
+end;
+
+procedure MakeOffset(CurXY: MadeTurn; var pos: SquareItemPtr; 
+                     CurDir: direction; var TotalOffset: integer; 
+                     var RememberValue: integer; var ProcValues: ProcValuesType);
+var
+    FoundPos: SquareItemPtr;
+    IsSequence: boolean = false;
+    offset: integer;
+begin
+    case CurDir of
+        left: begin
+            if CurXY.y = RememberValue then
+	        begin
+                TotalOffset := TotalOffset + 1;
+                IsSequence := true
+            end;
+            if IsSequence then
+               offset := TotalOffset
+            else
+               offset := 1;
+            FoundPos := FindSquare(ProcValues, CurXY.x, CurXY.y);
+            if FoundPos <> nil then
+            begin
+                FoundPos^.x := FoundPos^.x - offset;
+                {$IFDEF DEBUG}
+                write('left ', FoundPos^.x, ' ', FoundPos^.y, ' ');
+                {$ENDIF}
+            end
+            else
+            begin
+                pos^.x := CurXY.x - offset;
+                pos^.y := CurXY.y;
+                {$IFDEF DEBUG}
+                write('left ', pos^.x, ' ', pos^.y, ' ');
+                {$ENDIF}
+                AddProcValue(ProcValues, CurXY.x, CurXY.y, pos);
+                pos := pos^.next
+            end
+	    end;
+        right: begin
+            if CurXY.y = RememberValue then
+	        begin
+                TotalOffset := TotalOffset + 1;
+                IsSequence := true
+            end;
+            if IsSequence then
+               offset := TotalOffset
+            else
+               offset := 1;
+            FoundPos := FindSquare(ProcValues, CurXY.x, CurXY.y);
+            if FoundPos <> nil then
+            begin
+                FoundPos^.x := FoundPos^.x + offset;
+                {$IFDEF DEBUG}
+                write('right ', FoundPos^.x, ' ', FoundPos^.y, ' ');
+                {$ENDIF}
+            end
+            else
+            begin
+                pos^.x := CurXY.x + offset;
+                pos^.y := CurXY.y;
+                {$IFDEF DEBUG}
+                write('right ', pos^.x, ' ', pos^.y, ' ');
+                {$ENDIF}
+                AddProcValue(ProcValues, CurXY.x, CurXY.y, pos);
+                pos := pos^.next
+            end
+        end;
+        up: begin
+	    if CurXY.x = RememberValue then
+            begin
+                TotalOffset := TotalOffset + 1;
+                IsSequence := true
+            end;
+            if IsSequence then
+               offset := TotalOffset
+            else
+               offset := 1;
+            FoundPos := FindSquare(ProcValues, CurXY.x, CurXY.y);
+            if FoundPos <> nil then
+            begin
+                FoundPos^.y := FoundPos^.y + offset;
+                {$IFDEF DEBUG}
+                write('up ', FoundPos^.x, ' ', FoundPos^.y, ' ');
+                {$ENDIF}
+            end
+            else
+            begin
+                pos^.x := CurXY.x;
+                pos^.y := CurXY.y + offset;
+                AddProcValue(ProcValues, CurXY.x, CurXY.y, pos);
+                pos := pos^.next
+            end
+        end;
+        down: begin
+	    if CurXY.x = RememberValue then
+            begin
+                TotalOffset := TotalOffset + 1;
+                IsSequence := true
+            end;
+            if IsSequence then
+               offset := TotalOffset
+            else
+                offset := 1;
+            FoundPos := FindSquare(ProcValues, CurXY.x, CurXY.y);
+            if FoundPos <> nil then
+            begin
+                FoundPos^.y := FoundPos^.y - offset;
+                {$IFDEF DEBUG}
+                write('down ', FoundPos^.x, ' ', FoundPos^.y, ' ');
+                {$ENDIF}
+            end
+            else
+            begin
+                pos^.x := CurXY.x;
+                pos^.y := CurXY.y - offset;
+                {$IFDEF DEBUG}
+                write('down ', pos^.x, ' ', pos^.y, ' ');
+                {$ENDIF}
+                AddProcValue(ProcValues, CurXY.x, CurXY.y, pos);
+                pos := pos^.next
+            end
+        end
+    end
+end;
+
+procedure ExtractFromArr(CurArr: ArrTurn; var pos: SquareItemPtr; 
+                         CurDir: direction; var ProcValues: ProcValuesType);
+var
+    i: integer = 1;
+    ShiftQuantity: integer = 1;
+    RememberValue: integer;
+    FoundPos: SquareItemPtr;
+begin
+    while (i <= MaxSquaresFromCenter) and 
+        (CurArr[i].x = 0) and (CurArr[i].y = 0) do
+        i := i + 1;
+    if i <= MaxSquaresFromCenter then
+    begin
+        case CurDir of
+            left: begin
+                RememberValue := CurArr[i].y;
+                FoundPos := FindSquare(ProcValues, CurArr[i].x, CurArr[i].y);
+                if FoundPos <> nil then
+                begin
+                    FoundPos^.x := FoundPos^.x - ShiftQuantity;
+                    {$IFDEF DEBUG}
+                    write('left ', FoundPos^.x, ' ', FoundPos^.y, ' ');
+                    {$ENDIF}
+                end
+                else
+                begin
+                    pos^.x := CurArr[i].x - ShiftQuantity;
+                    pos^.y := CurArr[i].y;
+                    AddProcValue(ProcValues, CurArr[i].x, CurArr[i].y, pos);
+                    {$IFDEF DEBUG}
+                    write('left ', pos^.x, ' ', pos^.y, ' ');
+                    {$ENDIF}
+                    pos := pos^.next
+                end;
+            end;
+            right: begin
+                RememberValue := CurArr[i].y;
+                FoundPos := FindSquare(ProcValues, CurArr[i].x, CurArr[i].y);
+                if FoundPos <> nil then
+                begin
+                    FoundPos^.x := FoundPos^.x + ShiftQuantity;
+                    {$IFDEF DEBUG}
+                    write('right ', FoundPos^.x, ' ', FoundPos^.y, ' ');
+                    {$ENDIF}
+                end
+                else
+                begin
+                    pos^.x := CurArr[i].x + ShiftQuantity;
+                    pos^.y := CurArr[i].y;
+                    AddProcValue(ProcValues, CurArr[i].x, CurArr[i].y, pos);
+                    {$IFDEF DEBUG}
+                    write('right ', pos^.x, ' ', pos^.y, ' ');
+                    {$ENDIF}
+                    pos := pos^.next
+                end
+            end;
+            up: begin
+                RememberValue := CurArr[i].x;
+                FoundPos := FindSquare(ProcValues, CurArr[i].x, CurArr[i].y);
+                if FoundPos <> nil then
+                begin
+                    FoundPos^.y := FoundPos^.y + ShiftQuantity;
+                    {$IFDEF DEBUG}
+                    write('up ', FoundPos^.x, ' ', FoundPos^.y, ' ');
+                    {$ENDIF}
+                end
+                else
+                begin
+                    pos^.x := CurArr[i].x;
+                    pos^.y := CurArr[i].y + ShiftQuantity;
+                    AddProcValue(ProcValues, CurArr[i].x, CurArr[i].y, pos);
+                    {$IFDEF DEBUG}
+                    write('up ', pos^.x, ' ', pos^.y, ' ');
+                    {$ENDIF}
+                    pos := pos^.next
+                end
+            end;
+            down: begin
+                RememberValue := CurArr[i].x;
+                FoundPos := FindSquare(ProcValues, CurArr[i].x, CurArr[i].y);
+                if FoundPos <> nil then
+                begin
+                    FoundPos^.y := FoundPos^.y - ShiftQuantity;
+                    {$IFDEF DEBUG}
+                    write('down ', FoundPos^.x, ' ', FoundPos^.y, ' ');
+                    {$ENDIF}
+                end
+                else
+                begin
+                    pos^.x := CurArr[i].x;
+                    pos^.y := CurArr[i].y - ShiftQuantity;
+                    AddProcValue(ProcValues, CurArr[i].x, CurArr[i].y, pos);
+                    {$IFDEF DEBUG}
+                    write('down ', pos^.x, ' ', pos^.y, ' ');
+                    {$ENDIF}
+                    pos := pos^.next
+                end
+            end
+        end
+    end
+    else
+        exit;
+    for i := i + 1 to MaxSquaresFromCenter do
+        if (CurArr[i].x = 0) and (CurArr[i].y = 0) then
+            continue
+        else
+            MakeOffset(CurArr[i], pos, CurDir, ShiftQuantity, RememberValue, 
+                ProcValues)
+end;
+
+procedure AddToArr(var CurArr: ArrTurn; x, y: integer);
+var
+    i: integer;
+begin
+    for i := 1 to MaxSquaresFromCenter do
+        if (CurArr[i].x = 0) and (CurArr[i].y = 0) then
+        begin
+            CurArr[i].x := x;
+            CurArr[i].y := y;
+            break
+        end
+end;
+
+procedure PrintServiceMsg(x, y: integer; msg: string);
+const
+    size = 30;
+var
+    i: integer;
+begin
+    GotoXY(x, y);
+    for i := 1 to size do
+        write(' ');
+    GotoXY(x, y);
+    write(msg)
+end;
+
+procedure UpdateChangedShape(var ChangedShape: ShapeList; 
+                             AllTurns: AllTurnsType);
+var
+    square: SquareItemPtr;
+    ProcValues: ProcValuesType;
+begin
+    ProcValues.first := nil;
+    ProcValues.last := nil;
+    {first square is a center of figure}
+    ChangedShape.first^.x := ChangedShape.cx;
+    ChangedShape.first^.y := ChangedShape.cy;
+    square := ChangedShape.first^.next;
+    {$IFDEF DEBUG}
+    GotoXY(55, 20);
+    write('                     ');
+    GotoXY(55, 20);
+    write('centre: ', ChangedShape.cx, ' ', ChangedShape.cy, ' ');
+    {$ENDIF}
+    ExtractFromArr(AllTurns.left, square, left, ProcValues);
+    ExtractFromArr(AllTurns.right, square, right, ProcValues);
+    ExtractFromArr(AllTurns.up, square, up, ProcValues);
+    ExtractFromArr(AllTurns.down, square, down, ProcValues)
+end;
+
+procedure FixTurnViaArr(square: SquareItemPtr; cx, cy, NewX, NewY: integer; 
+                        var AllTurns: AllTurnsType);
+begin
+    if (square^.x <> cx) or (square^.y <> cy) then
+    begin
+        if square^.x > cx then
+            AddToArr(AllTurns.down, NewX, NewY);
+        if square^.x < cx then
+            AddToArr(AllTurns.up, NewX, NewY);
+        if square^.y > cy then
+            AddToArr(AllTurns.left, NewX, NewY);
+        if square^.y < cy then
+            AddToArr(AllTurns.right, NewX, NewY)
+    end
+end;
+
+procedure InitArr(var AllTurns: AllTurnsType);
+var
+    i: integer;
+begin
+    for i := 1 to MaxSquaresFromCenter do
+    begin
+        AllTurns.left[i].x := 0;
+        AllTurns.left[i].y := 0;
+        AllTurns.right[i].x := 0;
+        AllTurns.right[i].y := 0;
+        AllTurns.up[i].x := 0;
+        AllTurns.up[i].y := 0;
+        AllTurns.down[i].x := 0;
+        AllTurns.down[i].y := 0
+    end
+end;
+
+procedure PrintArr(arr: ArrTurn);
+var
+    i: integer;
+begin
+    for i := 1 to MaxSquaresFromCenter do
+        write(arr[i].x, ' ', arr[i].y, ' ')
+end;
+
+procedure ComputeTurn(var ChangedShape: ShapeList);
+var
+    AllTurns: AllTurnsType;
+    NewX, NewY: integer;
+    square: SquareItemPtr;
+begin
+    InitArr(AllTurns);
+    square := ChangedShape.first;
+    while square <> nil do
+    begin
+        NewX := ChangedShape.cx - (square^.y - ChangedShape.cy);
+        NewY := ChangedShape.cy + (square^.x - ChangedShape.cx);
+        FixTurnViaArr(square, ChangedShape.cx, ChangedShape.cy, NewX, NewY, 
+                      AllTurns);
+        square := square^.next
+    end;
+    SortArr(AllTurns.left, decrease, left);
+    SortArr(AllTurns.right, increase, right);
+    SortArr(AllTurns.up, decrease, up);
+    SortArr(AllTurns.down, increase, down);
+    {$IFDEF DEBUG}
+    PrintServiceMsg(55, 21, 'left arr: ');
+    PrintArr(AllTurns.left);
+    PrintServiceMsg(55, 22, 'right arr: ');
+    PrintArr(AllTurns.right);
+    PrintServiceMsg(55, 23, 'up arr: ');
+    PrintArr(AllTurns.up);
+    PrintServiceMsg(55, 24, 'down arr: ');
+    PrintArr(AllTurns.down);
+    {$ENDIF}
+    UpdateChangedShape(ChangedShape, AllTurns)
+end;
+
+procedure CheckBorders(var shape: ShapeList; var ChangedShape: ShapeList;
+                       CurBorders: borders; var IsObstacle: boolean);
+begin
+    FindCenterFigure(shape);
+    {ChangedShape's center has been got from shape}
+    CopyShape(shape, ChangedShape);
+    if shape.CurDir <> turning then
+        CalculateNewXY(shape, ChangedShape)
+    else
+        ComputeTurn(ChangedShape);
+    IsObstacle := false;
+    if IsOnBorders(ChangedShape, CurBorders) then
+    begin
+        IsObstacle := true;
+        exit
+    end
+end;
+
+procedure FigureInitial(var shape: ShapeList; CurBorders: borders);
+const
+    quantity = 3;
+    ColorCount = 13;
+    probability = 6;
+var
+    TotalSquares: integer = 1;
+    i: integer;
+    AllColors: array [1..ColorCount] of word =
+    (
+        Green, Cyan, Magenta, Brown, 
+        LightGray, DarkGray, LightBlue, LightGreen,
+        LightCyan, LightRed, LightMagenta,
+        Yellow, White
+    );
+    color: word;
+    LineShape: boolean = false;
+begin
+    {creating first square}
+    color := AllColors[random(ColorCount)+1];
+    LineShape := random(probability) = 0;
+    if LineShape then
+        CreateLineShape(shape, color)
+    else
+        CreateSquare(shape, color);
+    shape.CurDir := down;
+    shape.cx := -1;
+    shape.cy := -1;
+    shape.last^.x := CupWidth div 2 - 1;
+    shape.last^.y := 1;
+    shape.last^.CurDir := center;
+    if LineShape then
+        for i := 1 to quantity do
+            CreateLineShape(shape, color)
+    else
+    begin
+        {creating others squares}
+        for i := 1 to quantity do
+        begin
+            CreateSquare(shape, color);
+            SelectPos(shape, TotalSquares);
+            TotalSquares := TotalSquares + 1
+        end
+    end
+end;
+end.
diff --git a/tetree.pp b/tetree.pp
new file mode 100644
index 0000000..2b2a0c7
--- /dev/null
+++ b/tetree.pp
@@ -0,0 +1,358 @@
+unit tetree;
+
+interface
+uses figure;
+
+const
+    MaxLine = CupHeight div 2;
+    MaxSquares = 10;
+type
+    NodePtr = ^Node;
+    Node = record
+        square: SquareItemPtr;
+        left, right: NodePtr;
+    end;
+    LineInfo = record
+        NodeCount: byte;
+        root: NodePtr;
+    end;
+    WayFinding = array [1..MaxLine] of LineInfo;
+
+function SearchFillViaShape(arr: WayFinding; shape: ShapeList): integer;    
+function SearchOtherFill(arr: WayFinding; pos: integer): integer;
+procedure InitMassive(var arr: WayFinding);
+procedure LineInspection(var shape, ChangedShape: ShapeList; 
+                         var arr: WayFinding; var IsObstacle: boolean);
+procedure AddInTree(var shape: ShapeList; var arr: WayFinding);
+procedure DropLine(var arr: WayFinding; pos: integer; CurBorders: borders);
+procedure ClearSquaresAndTree(var root: NodePtr);
+procedure ClearLines(pos: integer);
+
+implementation
+uses crt;
+type
+    TreeNodePos = ^NodePtr;
+    action = (print, ChValue);
+
+function SearchOtherFill(arr: WayFinding; pos: integer): integer;
+var
+    i, LowerLineIdx: integer;
+begin
+    LowerLineIdx := 0;
+    for i := 1 to pos do
+        if (arr[i].NodeCount = MaxSquares) and (i > LowerLineIdx) then
+            LowerLineIdx := i;
+    SearchOtherFill := LowerLineIdx
+end;
+    
+function SearchFillViaShape(arr: WayFinding; shape: ShapeList): integer;    
+type
+    BottomFillLineType = record
+        Idx, value: integer;
+    end;
+var
+    square: SquareItemPtr;
+    BottomFillLine: BottomFillLineType;
+    IdxArr: integer;
+begin
+    BottomFillLine.Idx := 0;
+    BottomFillLine.value := 0;
+    square := shape.first;
+    while square <> nil do
+    begin
+        IdxArr := (square^.y - 1) div 2 + 1;
+        if (IdxArr >= 1) and (IdxArr <= MaxLine) then
+        begin
+            if (arr[IdxArr].NodeCount = MaxSquares) and 
+                (square^.y > BottomFillLine.value) then
+            begin
+                BottomFillLine.Idx := IdxArr;
+                BottomFillLine.value := square^.y
+            end
+        end;
+        square := square^.next
+    end;
+    SearchFillViaShape := BottomFillLine.Idx
+end;
+
+procedure ClearSquaresAndTree(var root: NodePtr);
+begin
+    if root <> nil then
+    begin
+        ClearSquaresAndTree(root^.left);
+        ClearSquaresAndTree(root^.right);
+        {delete squares}
+        if root^.square <> nil then
+        begin
+            dispose(root^.square); 
+            root^.square := nil
+        end;
+        {delete tree}
+        dispose(root);
+        root := nil
+    end
+end;
+
+procedure Traversal(var root: NodePtr; select: action; CurBorders: borders);
+var
+    i, j: integer;
+begin
+    if root = nil then
+        exit;
+    Traversal(root^.left, select, CurBorders);
+    case select of
+        print: begin
+            for i := 0 to HeightSquare-1 do
+            begin
+                for j := 0 to WidthSquare-1 do
+                begin
+                    if not IsAboveTop(root^.square, CurBorders) then
+                    begin
+                        GotoXY(root^.square^.x+j, root^.square^.y+i);
+                        TextColor(root^.square^.color);
+                        write('*')
+                    end
+                end;
+                writeln
+            end
+        end;
+        ChValue: root^.square^.y := root^.square^.y + HeightSquare
+    end;
+    Traversal(root^.right, select, CurBorders)
+end;
+
+procedure ClearLines(pos: integer);
+const
+    LeftBegin = 2;
+var
+    i, j: integer;
+begin
+    for i := 1 to pos * HeightSquare do
+    begin
+        GotoXY(LeftBegin, i);
+        for j := 1 to CupWidth-1 do
+            write(' ')
+    end
+end;
+
+procedure LineShifting(var arr: WayFinding; BeginPos, EndPos: integer; 
+                       CurBorders: borders);
+begin
+    if BeginPos = EndPos then
+    begin
+        ClearSquaresAndTree(arr[EndPos].root);
+        arr[EndPos] := arr[EndPos-1];
+        Traversal(arr[EndPos].root, ChValue, CurBorders);
+        exit
+    end;
+    LineShifting(arr, BeginPos+1, EndPos, CurBorders);
+    if BeginPos-1 < BeginCup then
+        exit;
+    arr[BeginPos] := arr[BeginPos-1];
+    Traversal(arr[BeginPos].root, ChValue, CurBorders)
+end;
+
+procedure DropLine(var arr: WayFinding; pos: integer; CurBorders: borders);
+var
+    i: integer;
+begin
+    ClearLines(pos);
+    i := 1;
+    while arr[i].NodeCount = 0 do
+        i := i + 1;
+    if (i + 1 <> pos) and (i <= MaxLine) then
+        LineShifting(arr, i + 1, pos, CurBorders)
+    else if i + 1 = pos then
+        LineShifting(arr, pos, pos, CurBorders);
+    {if i > pos, clear only last line}
+    if (i >= 1) and (i <= MaxLine) then
+    begin
+        arr[i].root := nil;
+        arr[i].NodeCount := 0
+    end;
+    for i := i + 1 to pos do
+        Traversal(arr[i].root, print, CurBorders)
+end;
+
+procedure InitMassive(var arr: WayFinding);
+var
+    i: integer;
+begin
+    for i := 1 to MaxLine do
+    begin
+        arr[i].NodeCount := 0;
+        arr[i].root := nil
+    end
+end;
+
+function SearchTree(var p: NodePtr; val: integer): TreeNodePos;
+begin
+    if (p = nil) or (p^.square^.x= val) then
+    begin
+        {$IFDEF DEBUG}
+        GotoXY(50, 1);
+        if (p <> nil) and (p^.square^.x = val) then
+            write('DEBUG: value is found');
+        {$ENDIF}
+        SearchTree := @p
+    end
+    else if val < p^.square^.x then
+        SearchTree := SearchTree(p^.left, val)
+    else
+        SearchTree := SearchTree(p^.right, val)
+end;
+
+procedure AddInTree(var shape: ShapeList; var arr: WayFinding);
+var
+    square: SquareItemPtr;
+    PosNode: TreeNodePos;
+    IdxArr: integer;
+begin
+    square := shape.first;
+    while square <> nil do
+    begin
+        IdxArr := (square^.y-1) div 2+1;
+        PosNode := SearchTree(arr[IdxArr].root, square^.x);
+        if PosNode^ = nil then
+        begin
+            new(PosNode^);
+            PosNode^^.square := square;
+            PosNode^^.left := nil;
+            PosNode^^.right := nil;
+            arr[IdxArr].NodeCount := arr[IdxArr].NodeCount + 1
+        end;
+        square := square^.next
+    end
+end;
+
+procedure CheckTurnThroughSquare(var shape: ShapeList; arr: WayFinding);
+const
+    MaxLength = 15;
+var
+    IdxArr, i, j, distance: integer;
+    LeftEdge, RightEdge, UpEdge, DownEdge: EdgeType;
+begin
+    InitEdges(LeftEdge, RightEdge, UpEdge, DownEdge, shape);
+    {left}
+    if (LeftEdge.x <> 0) and (LeftEdge.y <> 0) then
+    begin
+        distance := (shape.cx - LeftEdge.x) div 3;
+        if distance >= 1 then
+        begin
+            for i := 0 to distance-1 do
+            begin
+                for j := 1 to distance do
+                begin
+                    IdxArr := ((LeftEdge.y - j * HeightSquare) - 1) div 2 + 1;
+                    if (IdxArr >= 1) and (IdxArr <= MaxLength) then
+                    begin
+                        if SearchTree(arr[IdxArr].root, 
+                                      LeftEdge.x + i * WidthSquare)^ <> nil then
+                        begin
+                            shape.CanTurn := false;
+                            exit
+                        end
+                    end
+                end
+            end
+        end
+    end;
+    {right}
+    if (RightEdge.x <> 0) and (RightEdge.y <> 0) then
+    begin
+        distance := (RightEdge.x - shape.cx) div 3;
+        if distance >= 1 then
+        begin
+            for i := 0 to distance-1 do
+            begin
+                for j := 1 to distance do
+                begin
+                    IdxArr := ((RightEdge.y + j * HeightSquare) - 1) div 2 + 1;
+                    if (IdxArr >= 1) and (IdxArr <= MaxLength) then
+                    begin
+                        if SearchTree(arr[IdxArr].root, 
+                                      RightEdge.x - i*WidthSquare)^ <> nil then
+                        begin
+                            shape.CanTurn := false;
+                            exit
+                        end
+                    end
+                end
+            end
+        end
+    end;
+    {up}
+    if (UpEdge.x <> 0) and (UpEdge.y <> 0) then
+    begin
+        distance := (shape.cy - UpEdge.y) div 2;
+        if distance >= 1 then
+        begin
+            for i := 0 to distance-1 do
+            begin
+                for j := 1 to distance do
+                begin
+                    IdxArr := ((UpEdge.y + i * HeightSquare) - 1) div 2 + 1;
+                    if (IdxArr >= 1) and (IdxArr <= MaxLength) then
+                    begin
+                        if SearchTree(arr[IdxArr].root, 
+                                      UpEdge.x + j * WidthSquare)^ <> nil then
+                        begin
+                            shape.CanTurn := false;
+                            exit
+                        end
+                    end
+                end
+            end
+        end
+    end;
+    {down}
+    if (DownEdge.x <> 0) and (DownEdge.y <> 0) then
+    begin
+        distance := (DownEdge.y - shape.cy) div 2;
+        if distance >= 1 then
+        begin
+            for i := 0 to distance-1 do
+            begin
+                for j := 1 to distance do
+                begin
+                    IdxArr := ((DownEdge.y - i * HeightSquare) - 1) div 2 + 1;
+                    if (IdxArr >= 1) and (IdxArr <= MaxLength) then
+                    begin
+                        if SearchTree(arr[IdxArr].root, 
+                                      DownEdge.x - j * WidthSquare)^ <> nil then
+                        begin
+                            shape.CanTurn := false;
+                            exit
+                        end
+                    end
+                end
+            end
+        end
+    end;
+end;
+
+procedure LineInspection(var shape, ChangedShape: ShapeList; 
+                         var arr: WayFinding; var IsObstacle: boolean);
+var
+    square: SquareItemPtr;
+    IdxArr: integer;
+begin
+    IsObstacle := false;
+    square := ChangedShape.first;
+    while square <> nil do
+    begin
+        if square^.y > 0 then
+        begin
+            IdxArr := (square^.y-1) div 2+1;
+            if SearchTree(arr[IdxArr].root, square^.x)^ <> nil then
+            begin
+                IsObstacle := true;
+                break
+            end
+        end;
+        square := square^.next
+    end;
+    if not shape.IsSquare then
+        CheckTurnThroughSquare(shape, arr)
+end;
+end.
diff --git a/tetris.pas b/tetris.pas
new file mode 100644
index 0000000..f3ce680
--- /dev/null
+++ b/tetris.pas
@@ -0,0 +1,725 @@
+program TetrisGame;
+uses crt, figure, tetree;
+
+const
+    StartingDuration = 800;
+    FastDuration = 300;
+    LeftArrow = -75;
+    RightArrow = -77;
+    UpArrow = -72;
+    DownArrow = -80;
+    esc = 27;
+    WhiteSpace = 32;
+    LimitTurns = 3;
+    MaxPoints = 100000;
+type
+    GameStatus = record
+        GoOut, pause: boolean;
+        IsUserInput: boolean;
+        TurnsCount: byte;
+        fall: boolean;
+        CurPoints: longword;
+        IsWin: boolean
+    end;
+
+procedure GetKey(var code: integer);
+var
+    ch: char;
+begin
+    ch := ReadKey;
+    if ch = #0 then
+    begin
+        ch := ReadKey;
+        code := -ord(ch);
+        exit
+    end;
+    code := ord(ch)
+end;
+
+procedure ClrBuf();
+var
+    ch: integer;
+begin
+    while KeyPressed do
+        GetKey(ch)
+end;
+
+function CompareArrow(ChCode: integer): direction;
+begin
+    case ChCode of
+        LeftArrow: CompareArrow := left;
+        RightArrow: CompareArrow := right;
+        UpArrow: CompareArrow := turning;
+        DownArrow: CompareArrow := down
+    end
+end;
+
+procedure SetUserDirection(var shape: ShapeList; var status: GameStatus);
+var
+    key: integer;
+begin
+    GetKey(key);
+    case key of
+        LeftArrow: begin
+            if status.TurnsCount < LimitTurns then
+            begin
+                shape.CurDir := CompareArrow(key);
+                status.TurnsCount := status.TurnsCount + 1;
+                status.IsUserInput := true
+            end
+        end;
+        RightArrow: begin
+            if status.TurnsCount < LimitTurns then
+            begin
+                shape.CurDir := CompareArrow(key);
+                status.TurnsCount := status.TurnsCount + 1;
+                status.IsUserInput := true
+            end
+        end;
+        UpArrow: begin
+            if status.TurnsCount < LimitTurns then
+            begin
+                if not shape.IsSquare then
+                begin
+                    shape.CurDir := CompareArrow(key);
+                    status.TurnsCount := status.TurnsCount + 1;
+                    status.IsUserInput := true
+                end
+                else
+                    shape.CurDir := down
+            end
+        end;
+        DownArrow: begin
+            if status.TurnsCount < LimitTurns then
+            begin
+                status.fall := true;
+                shape.CurDir := down
+            end
+        end;
+        esc: status.GoOut := true;
+        WhiteSpace: status.pause := true
+    end;
+    {for press sequence}
+    if KeyPressed then
+    begin
+        GetKey(key);
+        case key of
+            esc: status.GoOut := true;
+            WhiteSpace: status.pause := true
+        end
+    end;    
+    ClrBuf
+end;
+
+procedure PrintTurnsCount(TurnsCount: byte);
+begin
+    GotoXY(36,14);
+    TextColor(White);
+    write('Movement counter: ', TurnsCount);
+    if TurnsCount = LimitTurns then
+    begin
+        GotoXY(36, 15);
+        write('LIMIT');
+        GotoXY(1, 1);
+    end
+    else
+    begin
+        GotoXY(36, 15);
+        write('           ');
+        GotoXY(1, 1)
+    end
+end;
+
+procedure NewTetramino(var shape, NextShape: ShapeList; CurBorders: borders; 
+                       var status: GameStatus);
+begin
+    if NextShape.first = nil then
+    begin
+        shape.first := nil;
+        shape.last := nil;
+        FigureInitial(shape, CurBorders)
+    end
+    else
+        shape := NextShape;
+    status.fall := false;
+    shape.IsSquare := FindSquareShape(shape);
+    shape.CanTurn := true;
+    if FigureInVision(shape, CurBorders) then
+        FindCenterFigure(shape);
+    NextShape.first := nil;
+    NextShape.last := nil;
+    FigureInitial(NextShape, CurBorders);
+    PrintPreviewShape(NextShape);
+    PrintAndHideShape(shape, CurBorders, false, false);
+    status.TurnsCount := 0;
+    PrintTurnsCount(status.TurnsCount);
+    delay(StartingDuration);
+    if FigureInVision(shape, CurBorders) and KeyPressed then
+    begin
+        {PrintTurnsCount(status.TurnsCount);}
+        SetUserDirection(shape, status);
+        PrintTurnsCount(status.TurnsCount)
+    end
+end;
+
+procedure MakePause(var status: GameStatus);
+var
+    key: integer;
+begin
+    GotoXY(36, 3);
+    TextColor(White);
+    write('PAUSE');
+    GetKey(key);
+    while true do
+    begin
+        case key of
+            WhiteSpace: begin
+                status.pause := false;
+                GotoXY(36, 3);
+                write('         ');
+                GotoXY(1, 1);
+                break
+            end
+            else
+                GetKey(key)
+        end
+    end
+end;
+
+procedure GameIsOvers(status: GameStatus);
+const
+    WinMsg = 'YOU WIN';
+    LoseMsg = 'YOU LOSE';
+var
+    MsgX, MsgY: integer;
+begin
+    clrscr;
+    TextColor(White);
+    MsgY := ScreenHeight div 2;
+    if status.IsWin then
+    begin
+        MsgX := (ScreenWidth - Length(WinMsg)) div 2;
+        GotoXY(MsgX, MsgY);
+        write(WinMsg)
+    end
+    else
+    begin
+        MsgX := (ScreenWidth - Length(LoseMsg)) div 2;
+        GotoXY(MsgX, MsgY);
+        write(LoseMsg)
+    end
+end;
+
+procedure PrintRules;
+const
+    RulesTotal = 11;
+    MaxLength = 50;
+    MaxLengthIdx = 10;
+    ControlLines = 7;
+type
+    LinesType = array [1..RulesTotal] of string[MaxLength];
+var
+    lines: LinesType = 
+    (
+        'Control keys:', 'moving left - <-', 'moving right - ->', 
+        'figure turn - ^', 'fall down - (down arrow)', 'pause - whitespace',
+        'exit - esc', 'Scoring system:', '50 points for completing 1 row',
+        'combo X2, X3 and X4 to the current points', 
+        'You need to score 100 000 points'
+    );
+    i, x, y: integer;
+begin
+    TextColor(White);
+    x := ScreenWidth - length(lines[MaxLengthIdx]) + 1;
+    y := 1;
+    GotoXY(x, y);
+    for i := 1 to ControlLines do
+    begin
+        write(lines[i]);
+        y := y + 1;
+        GotoXY(x, y)
+    end;
+    y := y + 1;
+    GotoXY(x, y);
+    for i := ControlLines + 1 to RulesTotal do
+    begin
+        write(lines[i]);
+        y := y + 1;
+        GotoXY(x, y)
+    end
+end;
+
+procedure PrintPoints(DropCount: byte; status: GameStatus);
+begin
+    TextColor(White);
+    GotoXY(36, 13);
+    if DropCount = 1 then
+        write('50 points')
+    else
+        write('COMBO X', DropCount);
+    delay(FastDuration);
+    GotoXY(36, 13);
+    write('             ');
+    GotoXY(36, 12);
+    write('                      ');
+    GotoXY(36, 12);
+    write('Current points: ', status.CurPoints);
+end;
+
+procedure PreviewBorderDrawing;
+const
+    x = 36;
+    y = 6;
+    width = 8;
+    height = 5;
+var
+    i, j: integer;
+begin
+    for i := y to y+height do
+        for j := x to x+width do
+        begin
+            if ((j = x) or (j = x+width)) and (i >=  y + 1) and 
+                (i <= y + height - 1) then
+            begin
+                GotoXY(j, i);
+                write('|')
+            end
+            else if (i = y) or (i = y+height) then
+            begin
+                GotoXY(j, i);
+                write('-')
+            end                
+        end
+end;
+
+procedure FieldDrawing(CurBorders: borders);
+var
+    i, j: integer;
+begin
+    for i := CurBorders.up to CurBorders.down do
+        for j := CurBorders.left to CurBorders.right+1 do
+            if (j = CurBorders.left) or 
+                (j = CurBorders.right+1) then
+            begin
+                GotoXY(j, i);
+                write('|')
+            end;
+    GotoXY(CurBorders.left, CurBorders.down+1);
+    for i := CurBorders.left to CurBorders.right+1 do
+        write('-')
+end;
+
+procedure SetParamsGame(var status: GameStatus; var arr: WayFinding; 
+                        GoOut: boolean; CurBorders: borders);
+begin
+    status.GoOut := GoOut;
+    if not GoOut then
+    begin
+        FieldDrawing(CurBorders);
+        PreviewBorderDrawing;
+        InitMassive(arr);
+        GotoXY(36, 12);
+        write('Current points: ', 0);
+        PrintRules
+    end;
+    status.TurnsCount := 0;
+    status.IsUserInput := false;
+    status.fall := false;
+    status.CurPoints := 0;
+    status.IsWin := false;
+end;
+
+procedure ReloadGame(var arr: WayFinding; var status: GameStatus; 
+                     CurBorders: borders);
+const
+    Msg = 'Reload Game? Y/N';
+var
+    MsgX, MsgY: integer;
+    ch, i: integer;
+begin
+    MsgX := (ScreenWidth - Length(Msg)) div 2;
+    MsgY := (ScreenHeight div 2) + 1;
+    GotoXY(MsgX, MsgY);
+    TextColor(White);
+    write(Msg);
+    GetKey(ch);
+    while true do
+    begin
+        case chr(ch) of
+            'y', 'Y': begin
+                clrscr;
+                for i := 1 to MaxLine do
+                    ClearSquaresAndTree(arr[i].root);
+                SetParamsGame(status, arr, false, CurBorders)
+            end;
+            'n', 'N': begin
+                clrscr;
+                for i := 1 to MaxLine do
+                    ClearSquaresAndTree(arr[i].root);
+                SetParamsGame(status, arr, true, CurBorders)
+            end
+            else
+            begin
+                GetKey(ch);
+                continue
+            end;
+        end;
+        exit
+    end
+end;
+
+procedure CheckFillLine(var arr: WayFinding; var shape: ShapeList; 
+                        CurBorders: borders; var status: GameStatus);
+var
+    PosFillLine: integer;
+    DropCount: byte = 0;
+begin
+    PosFillLine := SearchFillViaShape(arr, shape);
+    while PosFillLine <> 0 do
+    begin
+        DropLine(arr, PosFillLine, CurBorders);
+        DropCount := DropCount + 1;
+        if DropCount = 1 then
+            status.CurPoints := status.CurPoints + 50
+        else
+            status.CurPoints := status.CurPoints * DropCount;
+        PrintPoints(DropCount, status);
+        if status.CurPoints >= MaxPoints then
+        begin
+            status.IsWin := true;
+            GameIsOvers(status);
+            ReloadGame(arr, status, CurBorders);
+            exit
+        end;
+        PosFillLine := SearchOtherFill(arr, PosFillLine)
+    end
+end;
+
+procedure StayAtBottom(var shape, ChangedShape, NextShape: ShapeList; 
+                       var arr: WayFinding; CurBorders: borders; 
+                       var status: GameStatus);
+begin
+    ClearShape(ChangedShape.first);
+    ChangedShape.first := nil;
+    ChangedShape.last := nil;
+    PrintAndHideShape(shape, CurBorders, false, true);
+    shape.cx := -1;
+    shape.cy := -1;
+    AddInTree(shape, arr);
+    CheckFillLine(arr, shape, CurBorders, status);
+    if status.GoOut then
+        exit
+    else
+        NewTetramino(shape, NextShape, CurBorders, status)
+end;
+
+procedure SolveBorderProblem(var shape, ChangedShape: ShapeList; 
+                             CurBorders: borders; var status: GameStatus);
+begin
+    ClearShape(ChangedShape.first);
+    ChangedShape.first := nil;
+    ChangedShape.last := nil;
+    if status.TurnsCount >= LimitTurns then
+    begin
+        {Print previous place}
+        PrintAndHideShape(shape, CurBorders, false, false);
+        delay(FastDuration);
+        shape.CurDir := down;
+        status.IsUserInput := false;
+        status.TurnsCount := 0
+    end
+    else if status.TurnsCount < LimitTurns then
+    begin
+        PrintAndHideShape(shape, CurBorders, false, false);
+        delay(FastDuration);
+        if KeyPressed then
+        begin
+            SetUserDirection(shape, status);
+            if status.pause then
+            begin
+                MakePause(status);
+                delay(FastDuration);
+                if KeyPressed then
+                    SetUserDirection(shape, status)
+                else
+                begin
+                    shape.CurDir := down;
+                    status.IsUserInput := false;
+                    status.TurnsCount := 0
+                end
+            end;
+            PrintTurnsCount(status.TurnsCount)
+        end
+        else 
+        begin
+        {default direction}
+            shape.CurDir := down;
+            status.IsUserInput := false;
+            status.TurnsCount := 0
+        end
+    end
+end;
+
+procedure SolveTetraminoCollision(var shape, ChangedShape, NextShape: ShapeList; 
+                                  var arr: WayFinding; CurBorders: borders; 
+                                  var status: GameStatus);
+begin
+    ClearShape(ChangedShape.first);
+    ChangedShape.first := nil;
+    ChangedShape.last := nil;
+    if IsHighestFigure(shape) then
+    begin
+        PrintAndHideShape(shape, CurBorders, false, true);
+        GameIsOvers(status);
+        ReloadGame(arr, status, CurBorders);
+        if status.GoOut then
+            exit
+        else
+            NewTetramino(shape, NextShape, CurBorders, status);
+        exit        
+    end;
+    if status.TurnsCount >= LimitTurns then
+    begin
+        PrintAndHideShape(shape, CurBorders, false, false);
+        shape.CurDir := down;
+        status.IsUserInput := false;
+        status.TurnsCount := 0;
+        delay(FastDuration)
+    end
+    {stop above some shape}
+    else if shape.CurDir = down then
+    begin
+        PrintAndHideShape(shape, CurBorders, false, true);
+        AddInTree(shape, arr);
+        CheckFillLine(arr, shape, CurBorders, status);
+        if status.GoOut then
+            exit
+        else
+            NewTetramino(shape, NextShape, CurBorders, status)
+    end
+    else if status.TurnsCount < LimitTurns then
+    begin
+        PrintAndHideShape(shape, CurBorders, false, false);
+        delay(FastDuration);
+        if KeyPressed then
+        begin
+            SetUserDirection(shape, status);
+            if status.pause then
+            begin
+                MakePause(status);
+                delay(FastDuration);
+                if KeyPressed then
+                    SetUserDirection(shape, status)
+                else
+                begin
+                    shape.CurDir := down;
+                    status.IsUserInput := false;
+                    status.TurnsCount := 0
+                end
+            end;
+            PrintTurnsCount(status.TurnsCount)
+        end
+        else 
+        begin
+        {default direction}
+            shape.CurDir := down;
+            status.IsUserInput := false;
+            status.TurnsCount := 0
+        end
+    end
+end;
+
+procedure RepositionTetramino(var shape, ChangedShape: ShapeList; 
+                              CurBorders: borders; var status: GameStatus);
+const
+    FallDown = 50;
+begin
+    if not shape.CanTurn and (shape.CurDir = turning) and not status.fall then
+    begin
+        if status.TurnsCount >= LimitTurns then
+            shape.CurDir := down;
+        ClearShape(ChangedShape.first);
+        ChangedShape.first := nil;
+        ChangedShape.last := nil;
+        {Print previous place}
+        PrintAndHideShape(shape, CurBorders, false, false);
+        delay(FastDuration);
+        if KeyPressed and (status.TurnsCount < LimitTurns) then
+        begin
+            SetUserDirection(shape, status);
+            if status.pause then
+            begin
+                MakePause(status);
+                delay(FastDuration);
+                if KeyPressed then
+                    SetUserDirection(shape, status)
+                else
+                    shape.CurDir := down
+            end;
+            PrintTurnsCount(status.TurnsCount)
+        end
+        else if status.TurnsCount < LimitTurns then
+            shape.CurDir := down;
+        shape.CanTurn := true
+    end
+    else
+    begin
+        {Making Move or Turn}
+        ClearShape(shape.first);
+        {shape's center of figure has been got from ChangedShape}
+        shape := ChangedShape;
+        shape.CanTurn := true;
+        ChangedShape.first := nil;
+        ChangedShape.last := nil;
+        if shape.CurDir = down then
+        begin
+            status.TurnsCount := 0;
+            status.IsUserInput := false;
+            PrintTurnsCount(status.TurnsCount)
+        end;
+        {Print previous place}
+        PrintAndHideShape(shape, CurBorders, false, false);
+        if status.fall then
+            delay(FallDown)
+        else if not status.IsUserInput then
+            delay(StartingDuration)
+        else if status.IsUserInput then
+            delay(FastDuration);
+        {select next direction from user}
+        if not status.fall then
+        begin
+            if (status.TurnsCount < LimitTurns) and 
+                FigureInVision(shape, CurBorders) and KeyPressed then
+            begin
+                SetUserDirection(shape, status);
+                if status.pause then
+                begin
+                    MakePause(status);
+                    delay(FastDuration);
+                    if KeyPressed then
+                        SetUserDirection(shape, status)
+                    else
+                    begin
+                        shape.CurDir := down;
+                        status.IsUserInput := false;
+                        status.TurnsCount := 0
+                    end
+                end;
+                PrintTurnsCount(status.TurnsCount)
+            end
+            else if status.TurnsCount = LimitTurns then
+            begin
+                {only for pause or exit}
+                if KeyPressed then
+                    SetUserDirection(shape, status);
+                if status.pause then
+                begin
+                    MakePause(status);
+                    delay(FastDuration)   
+                end;
+                shape.CurDir := down;
+                status.IsUserInput := false;
+                status.TurnsCount := 0;
+                PrintTurnsCount(status.TurnsCount);
+            end
+            {default direction}
+            else
+                shape.CurDir := down
+        end
+    end
+end;
+
+function CheckResolutionDisplay: boolean;
+const
+    width = 101;
+    height = 31;
+    msg1 = 'Your display is smaller than required. Sorry!';
+    msg2 = 'Please press any key...';
+var
+    x, y: integer;
+    key: integer;
+begin
+    if (ScreenWidth < width) or (ScreenHeight < height) then
+    begin
+        x := 1;
+        y := ScreenHeight div 2;
+        GotoXY(x ,y);
+        write(msg1);
+        GotoXY(x, y + 1);
+        write(msg2);
+        while true do
+        begin
+            if KeyPressed then
+            begin
+                ClrBuf;
+                break
+            end
+        end;
+        CheckResolutionDisplay := false;
+        exit
+    end;
+    CheckResolutionDisplay := true
+end;
+
+var
+    SaveTextAttr: integer;
+    shape, ChangedShape, NextShape: ShapeList;
+    CurBorders: borders;
+    arr: WayFinding;
+    IsObstacle: boolean;
+    key: integer;
+    status: GameStatus;
+begin
+    clrscr;
+    if not CheckResolutionDisplay then
+    begin
+        writeln;
+        halt(1)
+    end;
+    randomize;
+    SaveTextAttr := TextAttr;
+    SetBorders(CurBorders, 1, CupWidth, BeginCup, CupHeight);
+    SetParamsGame(status, arr, false, CurBorders);
+    NextShape.first := nil;
+    NewTetramino(shape, NextShape, CurBorders, status);
+    while true do
+    begin
+        PrintAndHideShape(shape, CurBorders, true, true);
+        {expected movement}
+        {IsObstacle's init in CheckBorders each time}
+        CheckBorders(shape, ChangedShape, CurBorders, IsObstacle);
+        if IsObstacle and (shape.CurDir = down) then
+            StayAtBottom(shape, ChangedShape, NextShape, arr, CurBorders, 
+                         status)
+        else if IsObstacle then
+            SolveBorderProblem(shape, ChangedShape, CurBorders, status)
+        else
+        begin
+            LineInspection(shape, ChangedShape, arr, IsObstacle);
+            if IsObstacle then
+                SolveTetraminoCollision(shape, ChangedShape, NextShape, arr, 
+                                        CurBorders, status)
+            else
+                RepositionTetramino(shape, ChangedShape, CurBorders, status)
+        end;
+        if KeyPressed then
+        begin
+            GetKey(key);
+            case key of
+                esc: break;
+                WhiteSpace: continue
+                else
+                    ClrBuf
+            end
+        end
+        else
+        begin
+            if status.GoOut then
+                break;
+            if status.pause then
+                continue
+        end
+    end;
+    TextAttr := SaveTextAttr;
+    clrscr
+end.