i21прим/Mod/Тетрис.odc

(* кликнуть по круглому коммандеру, чтобы начать: 
	i21примТетрис.НоваяИгра
	Esc -- начать/пауза/продолжить.
	Стрелочки -- вертеть, двигать падающую фигуру.
	Пробел -- сбросить падающую фигуру.
*)

(* From ketmar@ua.fm Sat Aug  9 08:29:34 2003 
Date: Sat, 9 Aug 2003 07:29:29 +0300
From: Ketmar <ketmar@ua.fm>
To: info21 <info21@ms2.inr.ac.ru>
Subject: tetris

Hello, info21.

Here's the promised tetris. it seems to be ok. excuse me my ugly code %-)

*)
(**
National russian game "Tetris"
Original idea by Alexey Pajitnov
Programmed in JOB by S.Sverdlov, 8.03.98/23.04.98
Ported to BlackBox by Ketmar // Piranha, 22-Aug-XXXVIII A.S.

	game can be saved & loaded later
	todo:
		[?] revrite using models? (а зачем? это делают, чтобы по-разному изображать одни и те же данные. --info21)
*)
(* Модификации info21 2008-06-03: переименования, форматирование. *)

(* Модификации info21 2003-09-22:
Изменено имя модуля.
В процедуре HandleCtrlMsg поставлен CASE вместо IF в обработке клавиш и добавлены другие варианты клавиш.
*)

MODULE i21примТетрис;
	IMPORT  Dates, Services, Ports, Models, Views, Properties, Controllers, Stores;

	CONST
		(** random number generator *)
		(** taken from Project Pbox by J. Stanley Warford *)
		multiplier = 48271;
		modulus = 2147483647;
		quotient = modulus DIV multiplier;
		remainder = modulus MOD multiplier;
		seedLimit = modulus;
		(** конец взятия *)

		speed = Services.resolution DIV 2; (* 1 second *)

		n = 24; (* высота стакана *)
		m = 12; (* ширина стакана *)
		s = 6 * Ports.mm; (*размер одного кубика фигуры *)

	TYPE
		Field = ARRAY n, m OF Ports.Color;
		Figure = ARRAY 4, 4 OF BOOLEAN;
		Figures = ARRAY 7 OF Figure;
		Colors = ARRAY 7 OF Ports.Color;

		GameView = POINTER TO RECORD (Views.View)
			field: Field;	(* стакан *)
			figs: Figures;	(* всевозможные фигуры *)
			bc: Ports.Color;	(* цвет фона *)
			cols: Colors;	(* цвета фигур? *)
			ncurr: INTEGER;	(* текущая фигура? *)
			curr: Figure;	(* текущая фигура? *)
			x, y: INTEGER;	(* координаты текущей фигуры в стакане *)
			(*rand : ut.PRandom;*)
			seed: INTEGER;	(* "зерно" для бре... для генератора случайных чисел *)
			fly: BOOLEAN;	(* фигура в полёте? *)
			paused: BOOLEAN;	(* ждём-с? *)
			prevTick: LONGINT;	(* время прошлого tick-сообщения *)
		END;


	(** taken from Project Pbox by J. Stanley Warford *)
	PROCEDURE ComputeNextSeed (VAR seed: INTEGER);
		VAR  low, high: INTEGER;
	BEGIN
		low := seed MOD quotient;
		high := seed DIV quotient;
		seed := multiplier * low - remainder * high;
		IF seed <= 0 THEN seed := seed + modulus; END;
	END ComputeNextSeed;

	PROCEDURE RndInt (VAR seed: INTEGER; n: INTEGER): INTEGER;
	BEGIN
		ASSERT(0 < n, 20);
		ASSERT(n < seedLimit, 21);
		ComputeNextSeed (seed);
		RETURN SHORT(ENTIER(seed / modulus * n));
	END RndInt;

	PROCEDURE Randomize (VAR seed: INTEGER);
		VAR  date: Dates.Date;  time: Dates.Time;  i: INTEGER;
	BEGIN
		Dates.GetDate(date); Dates.GetTime(time);
		seed := 86400 * Dates.Day(date) + 3600 * time.hour + 60 * time.minute + time.second; (* Elapsed time this year in seconds *)
		FOR i := 0 TO 7 DO ComputeNextSeed(seed); END;
	END Randomize;
	(** конец взятия *)


	PROCEDURE WriteFigure (VAR wr: Stores.Writer; IN fig: Figure);
		VAR  f, c: INTEGER;
	BEGIN
		FOR f := 0 TO 3 DO
			FOR c := 0 TO 3 DO
				wr.WriteBool(fig[f, c]);
			END;
		END;
	END WriteFigure;

	PROCEDURE ReadFigure (VAR rd: Stores.Reader; OUT fig: Figure);
		VAR  f, c: INTEGER;
	BEGIN
		FOR f := 0 TO 3 DO
			FOR c := 0 TO 3 DO
				rd.ReadBool(fig[f, c]);
			END;
		END;
	END ReadFigure;

	PROCEDURE (v: GameView) Internalize- (VAR rd: Stores.Reader);
		VAR  f, c, ver: INTEGER;
	BEGIN
		IF ~rd.cancelled THEN
			rd.ReadVersion(0, 0, ver);
			IF ~rd.cancelled THEN
				rd.ReadInt(v.bc);
				rd.ReadInt(v.ncurr);
				rd.ReadInt(v.x);
				rd.ReadInt(v.y);
				rd.ReadInt(v.seed);
				rd.ReadBool(v.fly);
				FOR f := 0 TO 6 DO rd.ReadInt(v.cols[f]); END;
				FOR f := 0 TO 6 DO ReadFigure(rd, v.figs[f]); END;
				ReadFigure(rd, v.curr);
				FOR f := 0 TO n-1 DO
					FOR c := 0 TO m-1 DO
						rd.ReadInt(v.field[f, c]);
					END;
				END;
				v.paused := TRUE;
			END;
		END;
	END Internalize;

	PROCEDURE (v: GameView) Externalize- (VAR wr: Stores.Writer);
		VAR  f, c: INTEGER;
	BEGIN
		wr.WriteVersion(0);
		wr.WriteInt(v.bc);
		wr.WriteInt(v.ncurr);
		wr.WriteInt(v.x);
		wr.WriteInt(v.y);
		wr.WriteInt(v.seed);
		wr.WriteBool(v.fly);
		FOR f := 0 TO 6 DO wr.WriteInt(v.cols[f]); END;
		FOR f := 0 TO 6 DO WriteFigure(wr, v.figs[f]); END;
		WriteFigure(wr, v.curr);
		FOR f := 0 TO n-1 DO
			FOR c := 0 TO m-1 DO
				wr.WriteInt(v.field[f, c]);
			END;
		END;
	END Externalize;

	PROCEDURE (v: GameView) CopyFromSimpleView- (source: Views.View);
	BEGIN
		WITH source: GameView DO
			v.field := source.field;
			v.figs := source.figs;
			v.bc := source.bc;
			v.cols := source.cols;
			v.ncurr := source.ncurr;
			v.curr := source.curr;
			v.x := source.x;
			v.y := source.y;
			v.seed := source.seed;
			v.fly := source.fly;
			v.paused := TRUE;
		END;
	END CopyFromSimpleView;


	(*********************************************)
	PROCEDURE DrawFigure (f: Views.Frame; x0, y: INTEGER; IN fig: Figure; col: Ports.Color);
		VAR  i, j: INTEGER;  x: INTEGER;
	BEGIN
		FOR i := 0 TO 3 DO
			x := x0;
			FOR j := 0 TO 3 DO
				IF fig[i, j] & (0 <= x) & (x < m) & (0 <= y) & (y < n) THEN
					f.DrawRect(x*(s+1), y*(s+1), x*(s+1)+s, y*(s+1)+s, Ports.fill, col);
				END;
				INC(x);
			END;
			INC(y);
		END;
	END DrawFigure;

	PROCEDURE (v: GameView) Restore* (f: Views.Frame; l, t, r, b: INTEGER);
	(*: намалевать стакан *)
		VAR  i, j: INTEGER;  x, y: INTEGER;
	BEGIN
		y := 0;
		FOR i := 0 TO n - 1 DO
			x := 0;
			FOR j := 0 TO m - 1 DO
				f.DrawRect(x, y, x+s, y+s, Ports.fill, v.field[i, j]);
				IF ~v.paused THEN f.DrawRect(x+s DIV 2-Ports.mm, y+s DIV 2-Ports.mm, x+s DIV 2, y+s DIV 2, Ports.fill, Ports.red); END;
				INC(x, s+1);
			END;
			INC(y, s+1);
		END;
		IF v.fly THEN DrawFigure(f, v.x, v.y, v.curr, v.cols[v.ncurr]); END;
	END Restore;

	PROCEDURE (v: GameView) InitField (), NEW;
	(*: очистить стакан *)
		VAR  i, j: INTEGER;
	BEGIN
		FOR i := 0 TO n - 1 DO
			FOR j := 0 TO m - 1 DO
				v.field[i, j] := v.bc;
			END;
		END;
	END InitField;

	PROCEDURE (v: GameView) Free (IN f: Figure; x0, y0: INTEGER): BOOLEAN, NEW;
	(*: проверить, свободно ли место для фигуры *)
		VAR  i, j: INTEGER;  x, y: INTEGER;  F: BOOLEAN;
	BEGIN
		F := TRUE;
		i := 0;
		y := y0;
		REPEAT
			j := 0;
			x := x0;
			REPEAT
				IF f[i, j] & ((x < 0) OR (x >= m) OR (y >= n) OR (y >= 0) & (v.field[y, x] # v.bc)) THEN F := FALSE; END;
				INC(j);
				INC(x);
			UNTIL ~F OR (j = 4);
			INC(i);
			INC(y);
		UNTIL ~F OR (i = 4);
		RETURN F;
	END Free;

	PROCEDURE (v: GameView) Move (dx, dy: INTEGER), NEW;
	(*: стереть фигуру на старом месте, сдвинуть на dx и dy, нарисовать на новом *)
	BEGIN
		INC(v.x, dx);
		INC(v.y, dy);
	END Move;

	PROCEDURE (v: GameView) Fix (), NEW;
	(*: "прописать" фигуру в стакане *)
		VAR  i, j: INTEGER;  x, y: INTEGER;
	BEGIN
		y := v.y;
		FOR i := 0 TO 3 DO
			x := v.x;
			FOR j := 0 TO 3 DO
				IF v.curr[i, j] & (0 <= x) & (x < m) & (0 <= y) & (y < n) THEN
					v.field[y, x] := v.cols[v.ncurr];
				END;
				INC(x);
			END;
			INC(y);
		END;
	END Fix;

	PROCEDURE (v: GameView) RowEmpty (r: INTEGER): BOOLEAN, NEW;
	(*: пуста ли строка? *)
		VAR  e: BOOLEAN;  j: INTEGER;
	BEGIN
		j := m;
		REPEAT
			DEC(j);
			e := (v.field[r, j] = v.bc);
		UNTIL (j = 0) OR ~e;
		RETURN e;
	END RowEmpty;

	PROCEDURE (v: GameView) ClearRow (r: INTEGER), NEW;
	(*: убрать все пустые строки, перерисовать стакан *)
	BEGIN
		WHILE (r > 0) & ~v.RowEmpty(r) DO
			v.field[r] := v.field[r - 1];
			DEC(r);
		END;
	END ClearRow;

	PROCEDURE (v: GameView) RowFull (r: INTEGER): BOOLEAN, NEW;
	(*: полна ли строка? *)
		VAR  j: INTEGER;  full: BOOLEAN;
	BEGIN
		j := m;
		REPEAT
			DEC(j);
			full := (v.field[r, j] # v.bc);
		UNTIL (j = 0) OR ~full;
		RETURN full;
	END RowFull;

	PROCEDURE (v: GameView) TestRows (), NEW;
	(*: убрать все заполненые строки *)
		VAR  i, j, r: INTEGER;
	BEGIN
		i := 3;
		r := v.y + i;
		REPEAT
			IF (r < n) & (r >= 0) & v.RowFull(r) THEN
				v.ClearRow(r);
			ELSE
				DEC(r);
			END;
			DEC(i);
		UNTIL i < 0;
	END TestRows;

	PROCEDURE Rotate (f: Figure; OUT fr: Figure);
	(*: создать "повернутую" фигуру *)
		VAR  i, j: INTEGER;
	BEGIN
		i := 0;
		j := 3;
		REPEAT
			fr[i, 0] := f[0, j];
			fr[3, i] := f[i, 0];
			fr[j, 3] := f[3, i];
			fr[0, i] := f[i, 3];
			INC(i);
			DEC(j);
		UNTIL j < 0;
		fr[1, 1] := f[1, 2];
		fr[2, 1] := f[1, 1];
		fr[2, 2] := f[2, 1];
		fr[1, 2] := f[2, 2];
	END Rotate;

	PROCEDURE (v: GameView) FigRotate (), NEW;
	(*: повернуть фигуру *)
		VAR  temp: Figure;
	BEGIN
		Rotate(v.curr, temp);
		IF v.Free(temp, v.x, v.y) THEN
			v.curr := temp;
			Views.Update(v, Views.keepFrames);
		END;
	END FigRotate;

	PROCEDURE (v: GameView) FigDown (), NEW;
	(*: опустить фигуру вниз на строку *)
	BEGIN
		IF v.Free(v.curr, v.x, v.y+1) THEN v.Move(0, 1);
		ELSE
			v.fly := FALSE;
			v.Fix();
			v.TestRows();
		END;
		Views.Update(v, Views.keepFrames);
	END FigDown;

	PROCEDURE (v: GameView) FigRelease (), NEW;
	(*: уронить фигуру *)
	BEGIN
		WHILE v.Free(v.curr, v.x, v.y+1) DO v.Move(0, 1); END;
(*		v.fly := FALSE;
		v.Fix();
		v.TestRows();*)
		Views.Update(v, Views.keepFrames);
	END FigRelease;

	PROCEDURE (v: GameView) FigRight (), NEW;
	(*: фигуру вправо *)
	BEGIN
		IF v.Free(v.curr, v.x+1, v.y) THEN v.Move(1, 0); END;
		Views.Update(v, Views.keepFrames);
	END FigRight;

	PROCEDURE (v: GameView) FigLeft (), NEW;
	(*: фигуру влево *)
	BEGIN
		IF v.Free(v.curr, v.x-1, v.y) THEN v.Move(-1, 0); END;
		Views.Update(v, Views.keepFrames);
	END FigLeft;

	PROCEDURE NewColor (r, g, b: INTEGER): Ports.Color;
	(*: новый цвет из ргб *)
	BEGIN
		RETURN Ports.RGBColor(r, g, b);
	END NewColor;

	PROCEDURE (v: GameView) InitColors (), NEW;
	(*: установить цвета для фигур по умолчанию *)
	BEGIN
		v.bc := NewColor(220, 220, 220);

		v.cols[0] := NewColor(255, 0, 0);
		v.cols[1] := NewColor(255, 128, 0);
		v.cols[2] := NewColor(255, 255, 0);
		v.cols[3] := NewColor(0, 255, 0);
		v.cols[4] := NewColor(0, 255, 255);
		v.cols[5] := NewColor(0, 0, 255);
		v.cols[6] := NewColor(255, 0, 255);
	END InitColors;

	PROCEDURE (v: GameView) InitFigures (), NEW;
	(*: проинициализировать массив фигур *)
		VAR  i, j, k: INTEGER;
	BEGIN
		FOR i := 0 TO 6 DO
			FOR j := 0 TO 3 DO
				FOR k := 0 TO 3 DO
					v.figs[i, j, k] := FALSE;
				END;
			END;
		END;

		v.figs[0, 1, 0] := TRUE;
		v.figs[0, 1, 1] := TRUE;
		v.figs[0, 1, 2] := TRUE;
		v.figs[0, 1, 3] := TRUE;

		v.figs[1, 1, 2] := TRUE;
		v.figs[1, 2, 0] := TRUE;
		v.figs[1, 2, 1] := TRUE;
		v.figs[1, 2, 2] := TRUE;

		v.figs[2, 1, 0] := TRUE;
		v.figs[2, 1, 1] := TRUE;
		v.figs[2, 1, 2] := TRUE;
		v.figs[2, 2, 2] := TRUE;

		v.figs[3, 1, 1] := TRUE;
		v.figs[3, 1, 2] := TRUE;
		v.figs[3, 2, 1] := TRUE;
		v.figs[3, 2, 2] := TRUE;

		v.figs[4, 1, 0] := TRUE;
		v.figs[4, 1, 1] := TRUE;
		v.figs[4, 2, 1] := TRUE;
		v.figs[4, 2, 2] := TRUE;

		v.figs[5, 0, 1] := TRUE;
		v.figs[5, 1, 1] := TRUE;
		v.figs[5, 1, 2] := TRUE;
		v.figs[5, 2, 2] := TRUE;

		v.figs[6, 1, 0] := TRUE;
		v.figs[6, 1, 1] := TRUE;
		v.figs[6, 1, 2] := TRUE;
		v.figs[6, 2, 1] := TRUE;
	END InitFigures;

	PROCEDURE (v: GameView) NewFigure (), NEW;
	(*: новая фигурка *)
		VAR  rot: INTEGER;
	BEGIN
		v.x := m DIV 2 - 2;
		v.y := - 2;
		v.ncurr := RndInt(v.seed, 7);
		v.curr := v.figs[v.ncurr];
		rot := RndInt(v.seed, 4);
		WHILE rot > 0 DO
			Rotate(v.curr, v.curr);
			DEC(rot);
		END;
	END NewFigure;

	PROCEDURE (v: GameView) TimerStep (), NEW;
	(*: тикалка *)
	BEGIN
		IF v.fly THEN v.FigDown();
		ELSE
			v.NewFigure();
			IF v.Free(v.curr, v.x, v.y) THEN v.fly := TRUE;
			ELSE v.paused := TRUE; v.InitField();
			END;
			Views.Update(v, Views.keepFrames);
		END;
	END TimerStep;

	PROCEDURE (v: GameView) HandlePropMsg- (VAR msg: Properties.Message);
	(*: установка начальных размеров окна *)
	BEGIN
		WITH msg: Properties.SizePref DO
			IF (msg.w = Views.undefined) OR (msg.h = Views.undefined) THEN
				 msg.w := m*(s+1);
				msg.h := n*(s+1);
			END;
		ELSE
		END;
	END HandlePropMsg;

(*	PROCEDURE (v: GameView) HandleCtrlMsg- (f: Views.Frame; VAR msg: Views.CtrlMessage; VAR focus: Views.View);*)
	PROCEDURE (v: GameView) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
	(*: обработка клавиш и таймера *)
		CONST
			стрелкаВлево = 1CX;
			стрелкаВправо = 1DX;
			стрелкаВверх = 1EX;
			стрелкаВниз = 1FX;
			цифра4 = 34X;
			цифра5 = 35X;
			цифра6 = 36X;
			пробел = 20X;
	BEGIN
		WITH 
		| msg: Controllers.EditMsg DO
			IF ~v.paused THEN

				IF msg.char = 1CX THEN v.FigLeft();
				ELSIF msg.char = 1DX THEN v.FigRight();
				ELSIF msg.char = 1EX THEN v.FigRotate();
				ELSIF msg.char = 1FX THEN v.FigRelease();
				END;
(* ketmar's code inside the fold *)
				CASE  msg.char  OF
				| стрелкаВлево, цифра4:
					v.FigLeft()
				| стрелкаВправо, цифра6:
					v.FigRight()
				| стрелкаВверх, цифра5:
					v.FigRotate()
				| стрелкаВниз, пробел:
					v.FigRelease()
				ELSE
				END;

			END;
			IF msg.char = 1BX THEN
				v.paused := ~v.paused;
				Views.Update(v, Views.keepFrames);
				v.prevTick := Services.Ticks();
			END;
		| msg: Controllers.TickMsg DO
			IF ~v.paused & (msg.tick - v.prevTick >= speed) THEN
				v.TimerStep();
				v.prevTick := msg.tick;
			END;
		ELSE
		END;
	END HandleCtrlMsg;

	PROCEDURE (v: GameView) Init (), NEW;
	BEGIN
		v.InitColors();
		v.InitFigures();
		v.InitField();
		Randomize(v.seed);
		v.NewFigure();
		v.fly := TRUE;
		v.paused := TRUE;
	END Init;

	PROCEDURE НоваяИгра*;
		VAR  t: GameView;
	BEGIN
		NEW(t);
		t.Init();
		t.NewFigure();
		Views.OpenView(t);
	END НоваяИгра;

END i21примТетрис.