diff options
Diffstat (limited to 'figure.pp')
| -rw-r--r-- | figure.pp | 1135 |
1 files changed, 1135 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. |