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.