дневник Яос

[БудДен]

За сегодня сделал примерно следующее:
* поправил навигацию по Alt-F7 к сущностям, заканчивающимся на цифру
* решил проблему с попыткой повторной блокировки при взаимодействии трассировки и вывода в ЛогЯдра под Win32 (теперь падает с кодом ошибки)
* печать локальной переменной по имени в кадре стека (не совсем то, что нужно, но как костыль может пригодиться ввиду того, что пПиши не умеет печатать всё, что надо. Хотя для проекта pw надо просто сделать отдельные пр-ры печати)
* починил интерпретатор после этих изменений
* поправил чтение опций команд, содержащее допустимые в идентификаторах знаки препинания
* для проекта pw написал порядка 10-15 строк инфраструктурного кода, который не считается, к сожалению

Вроде много пунктов, но в целом продолжается какое-то беспомощное барахтание в болоте технического долго. Я много делал демо-проектов, когда какой-то полезный (необходимый) функционал работал только в 1-2 частных случаях, чтобы показать путь, куда надо идти. Но потом оказалось, что идти тоже нужно мне самому, и теперь всё это приходится постепенно допиливать, поскольку постоянно возникает ситуация, что не работает вообще ничего, за что ни возьмёшься. Надо, чтобы работало хоть что-нибудь :)

[БудДен]

Пришлось расширить реализацию типов-объединений, чтобы можно было нормально наследовать методы. Теперь добавлен явный метакласс для каждого члена типа-объединения, укль на который записывается в каждый экземпляр. В нём заводятся тела методов, а сама "родовая функция" заводится в базовом типе. Как-то так:

Код: Выделить всё

модуль ДляRepr;  

(* ДляRepr.Дей ~ *)

тип База = запись
	м*: метаБаза;
	полеБазы* : массив 50 из симв8 

	проц Метод*(); нач м.ТелоМетода(сам) кон Метод;
кон;

перем МетаБаза : метаБаза; 
		
тип	метаБаза* = окласс
	проц ТелоМетода*(конст Б {можноБазу}: База);
	нач	трассируй("метод базы") кон ТелоМетода  кон метаБаза;

тип Член = запись { членТипаˉобъединения } (База)
	м*: метаБаза;
	й* : массив 50 из симв8 кон;

проц ЯвиЧлен():Член;
	нач
	результат.м := МетаЧлен;
	результат.й := "это член";
	возврат результат кон ЯвиЧлен;
	
тип	метаЧлен* = окласс (метаБаза)
	проц {перекрыта} ТелоМетода*(конст Б {можноБазу}: Член); 
	нач	утв(Б.м суть метаЧлен);
			трассируй(Б.й, "метод члена") кон ТелоМетода кон метаЧлен;
			
перем МетаЧлен : метаЧлен; 
			

тип Член2 = запись { членТипаˉобъединения } (База)
	м*: метаБаза;
	щ* : массив 50 из симв8 кон;

проц ЯвиЧлен2():Член2;
	нач
	результат.м := МетаЧлен2;  (* укль на метакласс надо занести в экземпляр *)
	результат.щ := "это член 2";
	возврат результат кон ЯвиЧлен2;
	
тип	метаЧлен2* = окласс (метаБаза)
	проц {перекрыта} ТелоМетода*(конст Б {можноБазу}: Член2); (* должно компилироваться *)
	нач	утв(Б.м суть метаЧлен2);
			трассируй("метод члена 2") кон ТелоМетода кон метаЧлен2;
			
перем МетаЧлен2 : метаЧлен2; 



проц Дей*();
перем б : База; ч : Член; ч2 : Член2;
нач
	ч := ЯвиЧлен(); 	ч2 := ЯвиЧлен2();
	б := ч;
	ч.Метод();   (* печатает "метод члена" *)
	б.Метод();   (* печатает "метод члена" *)
	б := ч2;
	б.Метод();   (* печатает "метод члена 2" *)
	(* трассируй(ч.полеБазы); *)
кон Дей;

нач
	нов(МетаБаза);   (* инициализация метаклассов *)
	нов(МетаЧлен);
	нов(МетаЧлен2);
кон ДляRepr.

[БудДен]

Точнее сказать, компилятор ничего не знает про метакласс. Добавлено наследование методов
от базового типа к членам типа-объединения, а также атрибут "можноБазу" для параметров, который позволяет принимать параметр базового типа и неявно преобразовывать его к типу члена. Это позволяет не делать каждый раз явное преобразование при реализации тел методов для членов типа.

Короче, вы всё поняли, а если нет, то и я с трудом сам понимаю. Во всяком случае, теперь я могу нормально написать 70 реализаций метода __repr__ для моих типов данных и они будут вызываться без if-а на 70 веток и без 70 бессмысленных копирований данных из пустого в порожнее.

[смотритель]

Реализовал проект pw (код портирован с Python), но дальше деталей не раскрываю. Проверил собираемость и запускаемость Win32, Win64, Linux64, BIOS32 и Zybo в эмуляторе. Перевод делал недавно (см. журнал). На этом проект ЯОС замораживается.

Остаётся проект по обучению нейросетей про Оберон, но это не мой проект, я только помогаю.

Недоделано, но надо доделать:
* список ядерных модулей, чтобы не пытаться их выгрузить
* автодополнение имени файла и имени символа в любом месте (ну или хотя бы в ИСР другой кнопкой)
* перевести тесты компилятора на русский и написать под WSL2 скрипт, чтобы запускать тесты под разными платформами
* выкинуть мат. массивы, но литералы массивов нужны
* выкинуть активные ячейки
* далее проект улучшения ЯП, но это уже большой проект
* в отладчике сделать кнопку "скопировать ссылку на место, где стоит курсор", чтобы можно было от отладчика перейти на то же место в ИСР

[БудДен]

Заменил мат массивы на обычные, вроде функционал не потерян, но чтобы это знать точно, перевожу на русский тестовую сюиту. Она большая. Осталось разобрать 3000 строк, 400 строк содержат падающие тесты, и 4800 строк содержат тесты, которые в переведённом состоянии успешно прошли. Также продолжается деятельность по частному проекту в закрытом режиме, хотя мне за это не платят.

[смотритель]

Реализовал такое:

Код: Выделить всё

З(мнвоНаБитахМЗ,1,2..4)

- это как бы конструктор с указанием типа. До этого в АО можно было только создать множество с типом, выведенным компилятором, а потом присвоить. Литералы или конструкторы, когда сначала объявляется тип, а потом даются инициализаторы, есть как минимум в golang и modula2. Объективно вывод типов литералов ведёт к проблемам, потому что не всегда можно однозначно вывести этот тип из синтаксиса инициализаторов. Например, если бы мы ввели другое представление множеств, отличающееся от вектора бит, то было бы удобно делать для двух видов множеств инициализатор вида

Код: Выделить всё

{1,2..3}

, однако увидеть, какое представление множества мы хотим, из этого синтаксиса нельзя. Также, для конструктора массивов, если написано

Код: Выделить всё

[a,b,c]

, то неочевидно, каков тип элемента массива - чтобы его понять, нужно провести в уме немало вычислений. Если же написано

Код: Выделить всё

З(массив 3 из цел32,1,2,матМаксимум(бцел32))

, компилятор может смело выдать ошибку (в реальности пока нельзя таким образом создавать массивы, но синтаксис под это уже выработан, осталось его наполнить семантикой, когда он реально будет нужен для чего-то).

[БудДен]

Вроде бы успешно слил компилятор в единый, почти работающий код. И тут возникла идея, не сделать ли системные сущности на китайском? В своё время я выпиливал пиньин из ЯОС, но поддержка иероглифов осталась. Китаизировал КРТ (генератор псевдо-кортежа), вот как это выглядит:

Код: Выделить всё

проц Дей*;
перем ю: pyV.ЗКортеж;
нач
	ю := 元组(1,"1",元组("а"));
	пПиши(py0.repr(ю));
кон Дей;

[БудДен]

Идея с китайским отвергнута, т.к. для этого пришлось бы увеличить размер шрифта. А смесь букв и иероглифов неэффективно расходует место на экране. Починил тестовую сюиту (все тесты проходят на Win32 и Win64, все конфигурации собираются, хотя не проверял Linux64).

Приступил к удалению из языка и компилятора активных ячеек и мат.массивов - основная часть работы уже проделана, система собирает себя, хотя тесты не запускал.

[БудДен]

Частично перевели тетрис, теперь он выглядит так:

Код: Выделить всё

модуль грТетрис;	(** AUTHOR "TF"; PURPOSE "Tetris with semitransparent blocks"; *)

использует
	Modules, Kernel, Random, Строки8,
	Raster, WMRasterScale, WMRectangles, WMGraphics, WMGraphicUtilities,
	WMMessages, WM := WMWindowManager, WMDialogs, Inputs;

конст

	Граница = 10; (* window border in number of pixels *)

	РазмерЯчейки = 16;

	(* Width and height of game field in number of BoxSize's *)
	Ширина = 10;	Высота = 30;

	(* Position of game field *)
	СмещениеПоляX = 120;
	СмещениеПоляY = Граница;

	СмещениеИнфоX = Граница;
	СмещениеИнфоY = 100;
	ШиринаИнфо = СмещениеПоляX - 2*Граница;
	ВысотаИнфо = 110 + 2 * Граница;
	ВысотаСтрокиИнфо  = 20;

	ШиринаОкна = 1*Граница + СмещениеПоляX + Ширина*РазмерЯчейки;
	ВысотаОкна = 2*Граница + Высота*РазмерЯчейки;

	СкошеннаяГраница = 3;
	РазмерБлока = 5;

	КолвоБлоков = 7;
	СлучайноеПадение = ложь;

	СоотношениеЛинийУровень = 10; (* level = lines DIV LinesToLevelRatio *)

	(* Additions bonus points when removing more than one line at once (1 line = 1 point) *)
	Бонус2Линии = 6; (* 2 lines -> 8 points *)
	Бонус3Линии = 13; (* 3 lines -> 16 points *)
	Бонус4Линии = 46; (* 4 lines -> 50 points *)

	БонусОдинЦвет = 50; (* Bonus when removing a line where all boxes have the same color *)
	БонусУровень = 20;

	Инициализировано = 0;
	Работает = 5;
	Пауза = 6;
	Перезапуск = 7;
	ИграЗавершена = 8;
	ЗавершениеПриложения = 9;
	ЗавершеноПриложение = 10;

перем
	цвета : массив КолвоБлоков + 1 из Raster.Pixel;

тип
	СмертельноеСообщение = окласс
	кон СмертельноеСообщение;

	Блок = массив РазмерБлока, РазмерБлока из симв8;

	Окно = окласс (WM.BufferWindow)
	перем
		сброшен : булево;
		поле : массив Ширина из массив Высота из симв8;
		повернутыйБлок, блок, следующийБлок : Блок;
		позX, позY : цел32;
		режим : Raster.Mode;
		случайный : Random.Generator;
		линии, блоки, задержка, уменьшЗадержки, уровень, очки : цел32;

		генерНовыйБлок : булево;

		таймер : Kernel.Timer;
		состояние : цел32;

		фоновоеИзображение : WMGraphics.Image;

		проц &Нов*(альфа : булево);
		перем пиксель : Raster.Pixel;
		нач
			УвелСчет;
			Init(ШиринаОкна, ВысотаОкна, альфа);
			Raster.InitMode(режим, Raster.srcCopy); нов(таймер); нов(случайный); случайный.InitSeed(Kernel.GetTicks());
			Raster.SetRGBA(пиксель, 0C0H, 0C0H, 0CCH, 0CCH);
			Raster.Fill(img, 0, 0, ШиринаОкна, ВысотаОкна, пиксель, режим);
			фоновоеИзображение := WMGraphics.LoadImage("SaasFee.jpg", истина);
			если (фоновоеИзображение # НУЛЬ) то
				WMRasterScale.Scale(
					фоновоеИзображение, WMRectangles.MakeRect(0, 0, фоновоеИзображение.width, фоновоеИзображение.height),
					img, WMRectangles.MakeRect(0, 0, img.width, img.height),
					WMRectangles.MakeRect(0, 0, img.width, img.height),
					WMRasterScale.ModeCopy, WMRasterScale.ScaleBilinear);
			всё;
			(* Game field *)
			Raster.Fill(img, СмещениеПоляX, СмещениеПоляY, СмещениеПоляX + Ширина*РазмерЯчейки, СмещениеПоляY + Высота*РазмерЯчейки, цвета[0], режим);
			WMGraphicUtilities.DrawBevel(canvas, WMRectangles.MakeRect(
				СмещениеПоляX - СкошеннаяГраница, СмещениеПоляY - СкошеннаяГраница, СмещениеПоляX + Ширина*РазмерЯчейки + СкошеннаяГраница, СмещениеПоляY + Высота*РазмерЯчейки + СкошеннаяГраница),
				2, истина, цел32(0FFFFFFFFH), WMGraphics.ModeCopy);

			(* Preview panel *)
			Raster.Fill(img, Граница, Граница, СмещениеПоляX - Граница, Граница + РазмерБлока*РазмерЯчейки, цвета[0], режим);
			WMGraphicUtilities.DrawBevel(canvas, WMRectangles.MakeRect(
				Граница - СкошеннаяГраница, Граница - СкошеннаяГраница, СмещениеПоляX - Граница + СкошеннаяГраница, Граница + РазмерБлока*РазмерЯчейки + СкошеннаяГраница),
				2, истина, цел32(0FFFFFFFFH), WMGraphics.ModeCopy);
			Сброс;
			pointerThreshold := 10;
			WM.DefaultAddWindow(сам);
			SetTitle(Строки8.ЯвиУСтроку("WM Transparent Tetris"));
			SetIcon(WMGraphics.LoadImage("WMIcons.tar://WMTetris.png", истина));
			состояние := Инициализировано;
		кон Нов;

		проц УстСостояние(л0сост : цел32);
		нач {единолично}
			если (сам.состояние < ЗавершениеПриложения) или (л0сост = ЗавершеноПриложение) то
				сам.состояние := л0сост;
			всё;
		кон УстСостояние;

		проц ОжидСостояние(л1сост : цел32);
		нач {единолично}
			дождись(сам.состояние = л1сост);
		кон ОжидСостояние;

		проц НарисИнфо;
		перем строка : массив 128 из симв8; число : массив 16 из симв8;

			проц НарисЛинию(линия : цел32; конст л2стр : массив из симв8);
			нач
				утв(линия >= 1);
				WMGraphics.DrawStringInRect(canvas,
					WMRectangles.MakeRect(
						СмещениеИнфоX + Граница, СмещениеИнфоY + Граница + (линия-1) * ВысотаСтрокиИнфо,
						СмещениеИнфоX + ШиринаИнфо - Граница, СмещениеИнфоY + Граница + линия * ВысотаСтрокиИнфо),
					ложь, WMGraphics.AlignCenter, WMGraphics.AlignTop, л2стр);
			кон НарисЛинию;

		нач
			canvas.Fill(WMRectangles.MakeRect(СмещениеИнфоX, СмещениеИнфоY, СмещениеПоляX - Граница, СмещениеИнфоY + ВысотаИнфо), цел32(0FFFFFFA0H), WMGraphics.ModeCopy);
			WMGraphicUtilities.DrawBevel(canvas, WMRectangles.MakeRect(
				СмещениеИнфоX - СкошеннаяГраница, СмещениеИнфоY - СкошеннаяГраница, СмещениеПоляX - Граница + СкошеннаяГраница, СмещениеИнфоY + ВысотаИнфо + СкошеннаяГраница),
				2, истина, цел32(0FFFFFFFFH), WMGraphics.ModeCopy);
			canvas.SetColor(WMGraphics.Black);
			если (состояние = Работает) или (состояние = ИграЗавершена) то
				если (состояние = ИграЗавершена) то
					НарисЛинию(1, "Press 'Space'");
					НарисЛинию(2, "to restart!");
				всё;
				(* Number of lines completed *)
				строка := "Lines: "; Строки8.ПишиЦел64_вСтроку(линии, число); Строки8.ПодклейВСтрокуХвост(строка, число);
				НарисЛинию(3, строка);
				(* Number of blocks *)
				строка := "Blocks: "; Строки8.ПишиЦел64_вСтроку(блоки-1, число); Строки8.ПодклейВСтрокуХвост(строка, число);
				НарисЛинию(4, строка);
				(* Level *)
	 			строка := "Level: "; Строки8.ПишиЦел64_вСтроку(уровень, число); Строки8.ПодклейВСтрокуХвост(строка, число);
				НарисЛинию(5, строка);
				(* Points *)
				строка := "Points: "; Строки8.ПишиЦел64_вСтроку(очки, число); Строки8.ПодклейВСтрокуХвост(строка, число);
				НарисЛинию(6, строка);
			аесли (состояние = Инициализировано) то
				НарисЛинию(1, "Press 'Space'");
				НарисЛинию(2, "to start!");
			аесли (состояние = Пауза) то
				НарисЛинию(1, "Press 'Space'");
				НарисЛинию(2, "to continue!");
			всё;
			Invalidate(WMRectangles.MakeRect(
				СмещениеИнфоX - СкошеннаяГраница, СмещениеИнфоY - СкошеннаяГраница, СмещениеПоляX - Граница + СкошеннаяГраница, СмещениеИнфоY + ВысотаИнфо + СкошеннаяГраница));
		кон НарисИнфо;

		проц {перекрыта}StyleChanged*;
		нач
			НарисИнфо
		кон StyleChanged;

		проц ПовернутьБлок(конст л3блок : Блок) : Блок;
		перем И, й : цел16; врем : Блок;
		нач
			нцДля И := 0 до РазмерБлока - 1 делай нцДля й := 0 до РазмерБлока - 1 делай врем[й, И] := л3блок[(РазмерБлока - 1) - И, й] кц кц;
			возврат врем
		кон ПовернутьБлок;

		проц НарисКвадрат(х, у : цел32; цвет : симв8);
		перем пикс : Raster.Pixel;
		нач
			пикс := цвета [кодСимв8(цвет)];
			если (х >= 0) и (х < Ширина) и (у >= 0) и (у < Высота) то
				Raster.Fill(img, СмещениеПоляX + х * РазмерЯчейки, СмещениеПоляY + у * РазмерЯчейки,
					СмещениеПоляX + х * РазмерЯчейки+ РазмерЯчейки, СмещениеПоляY + у * РазмерЯчейки + РазмерЯчейки, пикс, режим);
				если (цвет # 0X) то
					WMGraphicUtilities.RectGlassShade(canvas, WMRectangles.MakeRect(
						СмещениеПоляX + х * РазмерЯчейки, СмещениеПоляY + у * РазмерЯчейки,
						СмещениеПоляX + х * РазмерЯчейки+ РазмерЯчейки, СмещениеПоляY + у * РазмерЯчейки + РазмерЯчейки), 2, истина);
				всё;
			всё;
		кон НарисКвадрат;

		проц НарисПредпросмотр(конст л4блок : Блок);
		перем
			И, й : цел32;

			проц л5НарисКвадрат(х, у : цел32; цвет : симв8);
			перем пикс : Raster.Pixel;
			нач
				пикс := цвета [кодСимв8(цвет)];
				Raster.Fill(img, Граница + х * РазмерЯчейки, Граница + у * РазмерЯчейки,
					Граница + х * РазмерЯчейки+ РазмерЯчейки, Граница + у * РазмерЯчейки + РазмерЯчейки, пикс, режим);
				если (цвет # 0X) то
					WMGraphicUtilities.RectGlassShade(canvas, WMRectangles.MakeRect(
						Граница + х * РазмерЯчейки, Граница + у * РазмерЯчейки,
						Граница + х * РазмерЯчейки+ РазмерЯчейки, Граница + у * РазмерЯчейки + РазмерЯчейки), 2, истина);
				всё;
			кон л5НарисКвадрат;

		нач
			нцДля И := 0 до РазмерБлока - 1 делай
				нцДля й := 0 до РазмерБлока - 1 делай
					л5НарисКвадрат(И, й, л4блок[И, й]);
				кц;
			кц;
			Invalidate(WMRectangles.MakeRect(Граница, Граница, Граница + РазмерБлока*РазмерЯчейки, Граница + РазмерБлока*РазмерЯчейки));
		кон НарисПредпросмотр;

		проц УстБлок(х, у : цел32; очистить : булево);
		перем И, й : цел32;
		нач
			нцДля И := 0 до РазмерБлока - 1 делай нцДля й := 0 до РазмерБлока - 1 делай
				если блок[И, й] # 0X то
					если (И + х < Ширина) и (й + у >= 0) и (й + у < Высота) то
						если очистить то
							поле[И + х, й + у] := 0X;
							НарисКвадрат(И + х, й + у, 0X)
						иначе поле[И + х, й + у] := блок[И, й];
							НарисКвадрат(И + х, й + у, блок[И, й])
						всё
					всё
				всё
			кц кц
		кон УстБлок;

		проц ЕстьСтолкСнизу(х, у : цел32) : булево;
		перем И, й : цел32;
		нач
			нцДля И := 0 до РазмерБлока - 1 делай нцДля й := 0 до РазмерБлока - 1 делай
				если блок[И, й] # 0X то
					если (И + х < Ширина) и (й + у >= 0) то
						если (й + у < Высота) то
							если (блок[И, й] # 0X) и (поле[И + х, й + у] # 0X) то возврат истина всё
						аесли блок[И, й] # 0X то возврат истина
						всё
					иначе возврат истина
					всё
				всё
			кц кц;
			возврат ложь
		кон ЕстьСтолкСнизу;

		проц ЕстьСтолк(конст бл : Блок; х, у : цел32) : булево;
		перем И, й : цел32;
		нач
			нцДля И := 0 до РазмерБлока - 1 делай нцДля й := 0 до РазмерБлока - 1 делай
				если бл[И, й] # 0X то
					если (И + х >= Ширина) или (И + х < 0) или (й + у >= Высота) или (поле[И + х, й + у] # 0X) то возврат истина всё
				всё
			кц кц;
			возврат ложь
		кон ЕстьСтолк;

		проц Двинуть(напр : цел32) : булево;
		перем новХ, новУ : цел32; рез : булево;
		нач
			новХ := позX; новУ := позY;
			если напр = 0 то увел(новХ)
			аесли напр = 1 то умень(новХ)
			аесли напр = 2 то увел(новУ)
			всё;

			УстБлок(позX, позY, истина);
			если ~ЕстьСтолк(блок, новХ, новУ) то позX := новХ; позY := новУ; рез := истина
			иначе рез := ложь
			всё;
			УстБлок(позX, позY, ложь);
			Invalidate(WMRectangles.MakeRect(СмещениеПоляX + позX * РазмерЯчейки - РазмерЯчейки, СмещениеПоляY + позY * РазмерЯчейки - РазмерЯчейки,
				СмещениеПоляX + позX * РазмерЯчейки + РазмерБлока * РазмерЯчейки + РазмерЯчейки,  СмещениеПоляY + позY * РазмерЯчейки + РазмерБлока*РазмерЯчейки +РазмерЯчейки));
			возврат рез
		кон Двинуть;

		проц {перекрыта}KeyEvent*(ucs : размерМЗ; l6flags: мнвоНаБитахМЗ; keysym : размерМЗ);
		перем ignore : булево;
			l7rotBlock : Блок;
		нач {единолично}
			если Inputs.Release в l6flags то
				возврат;
			аесли (состояние >= ЗавершениеПриложения) то
				возврат;
			аесли (состояние = Инициализировано) то
				если (keysym = 020H) то состояние := Работает; всё;
			аесли (состояние = Работает) то
				если (keysym = 0FF50H) или (keysym = 0FF51H) то (* Move left *)
					ignore := Двинуть(1);
				аесли (keysym = 0FF55H)или (keysym = 0FF53H) то (* Move right *)
					ignore := Двинуть(0)
				аесли (keysym = 0FF52H) то (* Rotate block *)
					УстБлок(позX, позY, истина);
					l7rotBlock := ПовернутьБлок(блок);
					если ~ЕстьСтолк(l7rotBlock, позX, позY) то блок := l7rotBlock всё;
					УстБлок(позX, позY, ложь);
					Invalidate(WMRectangles.MakeRect(
						СмещениеПоляX + позX * РазмерЯчейки - РазмерЯчейки, СмещениеПоляY + позY * РазмерЯчейки - РазмерЯчейки,
						СмещениеПоляX + позX * РазмерЯчейки + РазмерБлока * РазмерЯчейки, СмещениеПоляY + позY * РазмерЯчейки + РазмерБлока * РазмерЯчейки));
				аесли (keysym = 0FF54H) или (keysym = 0FF0DH) или (keysym = 20H) то (* Drop block *)
					сброшен := истина;
				аесли (keysym = 070H) то (* p key *)
					состояние := Пауза;
				всё;
			аесли (состояние = ИграЗавершена) то
				если (keysym = 020H) то состояние := Перезапуск; всё;
			аесли (состояние = Пауза) то
				если (keysym = 020H) или (keysym = 070H)  то состояние := Работает; всё;
			всё;
		кон KeyEvent;

		проц НовБлок() : Блок;
		перем
			новБлок : Блок;
			И, й : цел32; вид : цел32;
			цвет : симв8;

			проц Уст(х, у : цел32);
			нач
				новБлок[х, у] := цвет
			кон Уст;

		нач
			сброшен := ложь;
			позX := Ширина DIV 2 - 1; позY := 0;

			нцДля И := 0 до РазмерБлока - 1 делай нцДля й := 0 до РазмерБлока - 1 делай новБлок [И, й] := 0X кц кц;
			вид := случайный.Integer() остОтДеленияНа КолвоБлоков;

			цвет := симв8ИзКода(1 + вид);

			просей вид из
				| 0 : Уст(0, 2); Уст(1, 2); Уст(2, 2); Уст(3, 2)
				| 1 : Уст(1, 3); Уст(2, 3); Уст(3, 3); Уст(2, 2)
				| 2 : Уст(1, 1); Уст(1, 2); Уст(2, 2); Уст(2, 3)
				| 3 : Уст(2, 1); Уст(1, 2); Уст(2, 2); Уст(1, 3)
				| 4 : Уст(2, 1); Уст(2, 2); Уст(2, 3); Уст(3, 3)
				| 5 : Уст(2, 1); Уст(2, 2); Уст(2, 3); Уст(1, 3)
				| 6 : Уст(1, 1); Уст(1, 2); Уст(2, 1); Уст(2, 2)
			всё;
			увел(блоки);
			НарисПредпросмотр(новБлок);
			возврат новБлок;
		кон НовБлок;

		проц УдалЛинию(у : цел32);
		перем И, й : цел32; старУров : цел32;
		нач
			нцДля И := 0 до Ширина - 1 делай
				нцДля й := у до 1 шаг - 1 делай
					поле[И, й] := поле[И, й - 1];
					НарисКвадрат(И, й, поле[И, й])
				кц;
				поле[И, 0] := 0X;
				НарисКвадрат(И, 0, 0X)
			кц;
			Invalidate(WMRectangles.MakeRect(СмещениеПоляX, СмещениеПоляY, СмещениеПоляX + Ширина * РазмерЯчейки, СмещениеПоляY + у * РазмерЯчейки + РазмерЯчейки));
			увел(линии);
			таймер.Sleep(200);
			старУров := уровень;
			уровень := линии DIV СоотношениеЛинийУровень;
			если (старУров < уровень) и (задержка > 10) то
				очки := очки + БонусУровень;
				умень(задержка, уменьшЗадержки);
				если уменьшЗадержки >= 10 то уменьшЗадержки := уменьшЗадержки DIV 2 всё
			всё;
		кон УдалЛинию;

		проц ОчЛинии;
		перем у, х, ц : цел32; линииУдал : цел32; цвет : симв8; одинЦвет : булево;
		нач
			линииУдал := 0;
			у := Высота - 1;
			нцПока у > 0 делай
				одинЦвет := истина; цвет := поле[0, у];
				ц := 0;
				нцДля х := 0 до Ширина - 1 делай
					если поле[х, у] # 0X то
						если (поле[х, у] # цвет) то
							одинЦвет := ложь;
						всё;
						увел(ц);
					всё;
				кц;
				если ц = Ширина то
					УдалЛинию(у);
					увел(линииУдал);
					если одинЦвет то очки := очки + БонусОдинЦвет; всё;
				иначе
					умень(у);
				всё;
			кц;
			если (линииУдал > 0) то
				очки := очки + линииУдал;
				если (линииУдал = 2) то
					очки := очки + Бонус2Линии;
				аесли (линииУдал = 3) то
					очки := очки + Бонус3Линии;
				аесли (линииУдал = 4) то
					очки := очки + Бонус4Линии;
				всё;
			всё;
		кон ОчЛинии;

		проц ШагПадения;
		перем нужнНов : булево;
		нач {единолично}
			УстБлок(позX, позY, истина);
			если ~ЕстьСтолкСнизу(позX, позY +1) то увел(позY); нужнНов := ложь иначе нужнНов := истина всё;
			УстБлок(позX, позY, ложь);
			Invalidate(WMRectangles.MakeRect(
				СмещениеПоляX + позX * РазмерЯчейки - РазмерЯчейки, СмещениеПоляY + позY * РазмерЯчейки - РазмерЯчейки,
				СмещениеПоляX + позX * РазмерЯчейки + РазмерБлока * РазмерЯчейки, СмещениеПоляY + позY * РазмерЯчейки + РазмерБлока*РазмерЯчейки));
			если нужнНов то
				ОчЛинии;
				блок := следующийБлок;
				следующийБлок := НовБлок();
				если ЕстьСтолк(блок, позX, позY) то
					состояние := ИграЗавершена;
					WMDialogs.Information("Game Over", "You have lost the game");
				всё;
			всё;
		кон ШагПадения;

		проц Сброс;
		перем х,у : цел32;
		нач
			нцДля х := 0 до Ширина-1 делай
				нцДля у := 0 до Высота-1 делай
					поле[х,у] := 0X
				кц
			кц;
			блоки := 0; линии := 0; очки := 0; уровень := 0;
			задержка :=150; уменьшЗадержки := 30;
			Raster.Fill(img, СмещениеПоляX, СмещениеПоляY, СмещениеПоляX + Ширина*РазмерЯчейки, СмещениеПоляY + Высота*РазмерЯчейки, цвета[0], режим);
			Invalidate(WMRectangles.MakeRect(СмещениеПоляX, СмещениеПоляY, СмещениеПоляX + Ширина*РазмерЯчейки, СмещениеПоляY + Высота*РазмерЯчейки));
		кон Сброс;

		проц {перекрыта}Close*;
		нач
			УстСостояние(ЗавершениеПриложения);
			таймер.Wakeup;
			ОжидСостояние(ЗавершеноПриложение);
			Close^;
			УменьшСчет;
		кон Close;

		проц {перекрыта}Handle*(перем x : WMMessages.Message);
		нач
			если (x.msgType = WMMessages.MsgExt) и (x.ext # НУЛЬ) и (x.ext суть СмертельноеСообщение) то
				Close;
			иначе Handle^(x)
			всё
		кон Handle;

	нач {активное}
		генерНовыйБлок := истина;
		блок := НовБлок();
		следующийБлок := НовБлок();
		нц
			НарисИнфо;
			нач {единолично} дождись((состояние = Работает) или (состояние = Перезапуск) или (состояние = ЗавершениеПриложения)); кон;
			если (состояние = ЗавершениеПриложения) то
				прервиЦикл;
			аесли (состояние = Перезапуск) то
				УстСостояние(Работает);
				Сброс;
				блок := НовБлок();
				следующийБлок := НовБлок();
			иначе
				если ~сброшен то таймер.Sleep(задержка) всё;
				если СлучайноеПадение то
					просей случайный.Dice(3) из
						| 0 : если Двинуть(0) то всё;
						| 1 : если Двинуть(1) то всё;
						| 2 : УстБлок(позX, позY, истина);
							 повернутыйБлок := ПовернутьБлок(блок);
							 если ~ЕстьСтолк(повернутыйБлок, позX, позY) то блок := повернутыйБлок всё;
							 УстБлок(позX, позY, ложь);
							 Invalidate(WMRectangles.MakeRect(
							 	СмещениеПоляX + позX * РазмерЯчейки - РазмерЯчейки, СмещениеПоляY + позY * РазмерЯчейки - РазмерЯчейки,
							 	СмещениеПоляX + позX * РазмерЯчейки + РазмерБлока * РазмерЯчейки, СмещениеПоляY + позY * РазмерЯчейки + РазмерБлока * РазмерЯчейки));
					всё;
				всё;
				ШагПадения;
			всё;
		кц;
		УстСостояние(ЗавершеноПриложение);
	кон Окно;

перем
	колОкон : цел32;

проц Открыть*;
перем экзОкна : Окно;
нач
	нов(экзОкна, истина);
кон Открыть;

проц УвелСчет;
нач {единолично}
	увел(колОкон)
кон УвелСчет;

проц УменьшСчет;
нач {единолично}
	умень(колОкон)
кон УменьшСчет;

проц Очистка;
перем заверш : СмертельноеСообщение;
	 сообщ : WMMessages.Message;
	 м : WM.WindowManager;
нач {единолично}
	нов(заверш);
	сообщ.ext := заверш;
	сообщ.msgType := WMMessages.MsgExt;
	м := WM.GetDefaultManager();
	м.Broadcast(сообщ);
	дождись(колОкон = 0);
кон Очистка;

нач
	Raster.SetRGBA(цвета[0], 0, 0, 0, 0);
	Raster.SetRGBA(цвета[1], 255, 0, 0, 128);
	Raster.SetRGBA(цвета[2], 0, 255, 0, 128);
	Raster.SetRGBA(цвета[3], 0, 0, 255, 128);
	Raster.SetRGBA(цвета[4], 200, 200, 0, 200);
	Raster.SetRGBA(цвета[5], 255, 0, 255, 128);
	Raster.SetRGBA(цвета[6], 0, 255, 255, 200);
	Raster.SetRGBA(цвета[7], 256, 128, 100, 200);
	Modules.InstallTermHandler(Очистка)
кон грТетрис.

System.Free WMTetris ~
WMTetris.Open ~

В работе переводы примеров из пакета Education. Однако публикация исходных текстов затруднена тем, что часть кода я не хочу открывать. Надо будет думать, как с этим обойтись. Вероятно, надо будет сделать несколько файлов проекта, а закрытые исходные коды вынести в:

* отдельную директорию, добавленную в поиск
* отдельный подмодуль гит
* отдельный файл описания конфигурации

И для открытой версии всё это будет на заглушках. Но более вероятно, что пока что я не буду морочиться, а буду просто публиковать переводы некоторых модулей здесь.

[БудДен]

Поднял словарь, бывший semantic-dict.ru. Теперь он работает на новом адресе https://словарь.программирование-по-русски.рф