diff options
Diffstat (limited to 'tetris.pas')
| -rw-r--r-- | tetris.pas | 725 |
1 files changed, 725 insertions, 0 deletions
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. |