kris

{
Программа для игры "Поле Чудес".
Машина задумывает слово; Человек называет буквы;
если введенная буква есть в задуманном слове, то она "открывается".
При этом идет подсчет очков. По ходу игры машина выводит подсказки, 
касающиеся значения заданного слова.
Работа идет в интерактивном режиме, 
по желанию пользователя протокол работы может записываться на диск.
 
а) задумываются слова из словаря, хранящегося в текстовом файле;
формат следующий: 
слово на отдельной строке начинается с 1й позиции; 	
затем, начиная со следующей строки со 2й позиции 
обьяснение значения этого слова, 
которое выводится на экран перед началом игры;
перед каждым ходом человека, задается случайное число от 1 до 5; 
если буква угадывается правильно, то это число очков добавляется, 
иначе - отнимается.
}
 
program guess_word; {Название программы}
 
uses crt; {подключение модуля псевдографики}
 
var {секция обьявления переменных}
	answer 		: string;	{загаданное слово}
	description 	: string;	{описание слова}
	display		: string;	{отображаемая пользователю информация}
	input_file 	: text; 	{указатель на входной файл}
	ii 		: integer;	{счетчик}
	protocol	: text; 	{файл для хранений лога}
	is_protocol	: boolean;	{ведется протокол?}
	buffer		: char; 	{буффер ввода}
	score 		: integer;	{счет игры}
	had_guessed 	: boolean;	{угадал что либо за ход?}
 
 
 
{процедура проверяет включена ли запись в протокол и, если включена, 
записывает передаваемую строку "s" в файл "protocol"}
procedure proto (s :string);
begin
	if is_protocol = true then
		writeln(protocol, s);
end;
 
 
 
begin {тело программы}
	randomize; {инициализация рандома}
 
	{вести или нет протокол?}
	is_protocol := false;  {инициализация перменной}
	write('enable protocol? [y/n] : ');
	if readKey = 'y' then  {если пользователь сказал 'y'}
	begin
		is_protocol := true;  {переключить флаг}
		assign(protocol, 'protocol.txt');  {прикрепить файл}
		rewrite(protocol );  {"перемотать" файл на начало}
		proto('game started');  {занести 1ую запись в лог}
	end;
 
	writeln;  {перевести строку}
 
	ii := 0; {начальное значение}
	assign(input_file, 'dict.txt'); {прикрепить файл}
	reset(input_file);  {перемотать файл на начало}
	while not EOF(input_file) do  {до конца файла}
	begin
		readln(input_file); {считывать из него по одной строке}
		ii := ii + 1; {запоминая их количество}
	end; 
 
	{прочитать вопрос и ответ наугад из файла}
	reset(input_file);
	for ii := 0 to random(Round(ii/2)) do
	begin
		readln(input_file, answer);
		readln(input_file, description);
	end;
 
	delete(answer, 1, 1); {удаление 1ого пробела}
	delete(description, 1, 2); {удаление 2х пробелов}
	proto('answer is: ' + answer); {запись в протокол}
	proto('descr: ' + description); {запись в протокол}
 
	writeln(description); {вывод подсказки}
	{заполнение звездочками отображаемой пользователю инфы}
	display := ''; 
	for ii := 1 to length(answer) do
		display := display + '*';
 
	score := 0; {обнуление счета}
	writeln('Enter [Spacebar][Enter] to quit'); {подсказка}
	while true do {бесконечный цикл}
	begin
		write('>'); {вывод "приглашения"}
		readln(buffer); {прочитать символ}
		proto('user entered ' + buffer); {запись в протокол}
 
		{если пользователь ввел пробел - выйти}
		if buffer = ' ' then 
		begin
			proto('QUIT');
			break; {обрыв главного цикла}
		end;
 
		had_guessed := false; {сброс флага}
		for ii := 1 to length(answer) do {для каждого символа в answer}
			if (answer[ii] = buffer) and {если символ совпадает с вводом пользователя}
					(answer[ii] <> display[ii]) then {и еще не открыт}
			begin
				score := score + random(4)+1; {увеличить счет на число от 1 до 5ти}
				display[ii] := answer[ii]; {открыть букву}
				had_guessed := true; {установка флага}
				proto('right!'); {запись в протокол}
			end;
 
		if had_guessed = false then {если не угадано ни одной буквы}
		begin
			score := score - (random(4)+1); {уменьшить счет на число от 1 до 5ти}
			proto('wrong!'); {запись в протокол}
		end;
 
		writeln(display, ' [', score, ']'); {вывод на экран инфы}
 
		if display = answer then {если слово польностью угадано то}
		begin
			writeln('COOL! U DONE IT'); {вывод инцы пользователю}
			proto('User guessed word!'); {запись в протокол}
			break; {выход из главного цикла}
		end;
	end;
 
	if is_protocol = true then {если велся протокол}
		close(protocol); {закрыть файл протокола}
end. {конец}
 
 
 
 
{
пример работы:
 
C:\downloads\CURSE\a\KRIS>more dict.txt
 fuck
  "fuck"
 shit
  "shit"
 tits
  "tits"
 linux
  'linux'
 
C:\downloads\CURSE\a\KRIS>c
 
C:\downloads\CURSE\a\KRIS>..\..\b\fpc\bin\i386-win32\fpc.exe MAIN.PAS
Free Pascal Compiler version 2.2.4 [2009/04/10] for i386
Copyright (c) 1993-2008 by Florian Klaempfl
Target OS: Win32 for i386
Compiling MAIN.PAS
Linking MAIN.exe
138 lines compiled, 0.3 sec , 32720 bytes code, 1704 bytes data
 
C:\downloads\CURSE\a\KRIS>del main.o
 
C:\downloads\CURSE\a\KRIS>pause
Для продолжения нажмите любую клавишу . . .
 
 
C:\downloads\CURSE\a\KRIS>MAIN.exe
enable protocol? [y/n] :
"shit"
Enter [Spacebar][Enter] to quit
>g
**** [-4]
>s
s*** [-2]
>h
sh** [1]
>h
sh** [0]
>i
shi* [1]
>t
shit [5]
COOL! U DONE IT
 
C:\downloads\CURSE\a\KRIS>more protocol.txt
game started
answer is: shit
descr: "shit"
user entered g
wrong!
user entered s
right!
user entered h
right!
user entered h
wrong!
user entered i
right!
user entered t
right!
User guessed word!
}