Форум программистов, компьютерный форум, киберфорум
Наши страницы
PascalABC.NET
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.80/5: Рейтинг темы: голосов - 5, средняя оценка - 4.80
kovale
0 / 0 / 0
Регистрация: 01.04.2015
Сообщений: 9
1

Как облагородить игру в слова

10.05.2015, 22:37. Просмотров 831. Ответов 3
Метки нет (Все метки)

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
uses System.IO, GraphABC;
var
  l3:=new List<string>;
  l0:=new List<string>;
  l1:=new List<string>;
  t:string;
  
procedure Rules;  
begin
Window.Title := 'Игра слов';
  writeln('******************************************************');
  writeln('***                  Игра - слова                  ***');
  writeln('***                  Правила игры:                 ***');
  writeln('*     первый игрок называет слово, а второй должен   *');
  writeln('*   предложить другое, начинающееся с той буквы, на  *');
  writeln('*            которую оканчивается названное          *');  
  writeln('*    Тематикой игры могут быть по выбору города,     *');
  writeln('* животные, растения, реки, футбольные клубы.        *');
  writeln('*   Если введенное человеком слово мне не известно   *');
  writeln('*      я предложу его уточнить или добавить.         *');
  writeln('******************************************************');
  writeln('Нажмите "Enter" для продолжения...');
  readln;
end;
 
function AddWord(t,s:string):integer;
var
  i:integer;
begin
  repeat
    writeln(' Я не знаю слова ',s,'! Добавить в словарь (1-да/2-нет):');
    readln(i);
  until i in [1..2];
  if i=1 then begin l3.Add(t+s);&File.WriteAllLines('words'+t+'.dat',l3.ToArray);l1.Add(t+s);end;
  Result:=i-1;
end;  
  
function SelectTheme:char;
begin
  writeln('Выберите тему:');
  writeln('1. Города');
  writeln('2. Животные');
  writeln('3. Растения');
  writeln('4. Реки');
  writeln('5. Футбольные клубы');
  repeat
    write('Ваш выбор(цифра от 1..5):');
    readln(Result);
  until Result in ['1'..'5'];
end;
 
procedure PlayW(i:integer;t:string);
var
  s,b:string;
begin
  repeat
    case i of
      1:begin
         b:='';
         if l0.Count>0 then b:=l0.Item[l0.Count-1];
         repeat
          write('Ваше слово (пусто для выхода):');
          readln(s);s:=trim(s);
          if s='' then exit;          
          s:=Uppercase(s);
          while (length(b)>0) and (b[length(b)] in ['Ь','Ъ','Ы']) do delete(b,length(b),1);
          if (b<>'') and (s[1]<>b[length(b)]) then writeln('Ваше слово должно начинаться с буквы ',b[length(b)]);
         until (b='') or (s[1]=b[length(b)]); 
          if pos(t+s,l1.ToStr(','))<>0 then writeln('Это слово Вы уже называли') else
          if pos(t+s,l0.ToStr(','))<>0 then writeln('Это слово Я уже называл') else
          begin
            i:=0;
            if pos(t+s,l3.ToStr(','))=0 then i:=AddWord(t,s) else l1.Add(t+s);
          end;
        end;
      0:begin
          i:=1;
          if l3.Count>0 then
          if l1.Count=0 then s:=copy(l3[0],2,length(l3[0])) else begin
            while s[length(s)] in ['Ь','Ъ','Ы'] do delete(s,length(s),1);
            foreach s1:string in l3 do begin
                if (s1[2]=s[length(s)]) and (pos(s1,l1.ToStr(','))=0) and (pos(s1,l0.ToStr(','))=0) then begin
                s:=copy(s1,2,length(s1));
                break;
             end;   
           end;  
          end;  
            if (l1.Count>0) and (pos(s,copy(l1.Item[l1.count-1],2,length(l1.Item[l1.count-1])))=1) then 
              begin
                writeln('Больше слов на букву "',s[length(s)],'" я не знаю.'); 
                if s<>'' then l0.Add(t+s);
              end  
              else begin
              writeln('Мое слово ',s);
              if s<>'' then l0.Add(t+s);
            end;  
          end;  
    end;  
    if s='' then writeln('Словарь пуст');
  until false;
end;  
 
begin
  randomize;
  Rules;
  t:=SelectTheme;
  l3.clear;l1.clear;l0.Clear;
  if FileExists('words'+t+'.dat') then 
    l3:=&File.ReadAllLines('words'+t+'.dat').ToList;
  PlayW(ord(random(10)>5),t);
end.
0
Лучшие ответы (1)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
10.05.2015, 22:37
Ответы с готовыми решениями:

Как создать игру на массивах?
Народ, всем привет! Я учусь на первом курсе в техническом ВУЗе. Недавно мы проходили тему...

Восполнить пробелы. Как создать игру?
Здравствуйте! Я узнал, что на Pascal можно создать игру и решил попробовать. В i-net я нашел некие...

Как написать игру Магический квадрат на Паскаль
Как написать игру Магический квадрат на Паскаль (В виде игры именно так,что бы пользователь вводил...

Как задать в этой программе условие "Напечатать все слова, отличные от последнего слова"?
Дана последовательность, содержащая от 2 до 30 слов, в каждом из которых от 2 до 10 латинских...

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

3
Joy
Эксперт Pascal/Delphi
2169 / 1197 / 1437
Регистрация: 29.08.2014
Сообщений: 4,387
11.05.2015, 06:22 2
что в вашем понимании «красиво»? Просто добавление модуля graphabc красоты не добавит.
изначально просили просто игру Составить программу, позволяющую компьютеру и человеку играть в слова

Добавлено через 1 час 12 минут
Если просто текст раскрасить-используйте модуль Crt
0
kovale
0 / 0 / 0
Регистрация: 01.04.2015
Сообщений: 9
11.05.2015, 21:55  [ТС] 3
Мне надо сделать её как можно лучше ( что касается программы) просто надо сдать её, это курсовая
0
JuriiMW
1992 / 1077 / 1573
Регистрация: 10.12.2014
Сообщений: 4,040
12.05.2015, 06:15 4
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

Ну, вот пример расцветки данной программы:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
uses System.IO, CRT;
var
  l3:=new List<string>;
  l0:=new List<string>;
  l1:=new List<string>;
  t:string;
  
procedure Rules;  
begin
  TextColor(10);
  writeln('******************************************************');
  writeln('***                  Игра - слова                  ***');
  writeln('***                  Правила игры:                 ***');
  writeln('*     первый игрок называет слово, а второй должен   *');
  writeln('*   предложить другое, начинающееся с той буквы, на  *');
  writeln('*            которую оканчивается названное          *');  
  writeln('*    Тематикой игры могут быть по выбору города,     *');
  writeln('* животные, растения, реки, футбольные клубы.        *');
  writeln('*   Если введенное человеком слово мне не известно   *');
  writeln('*      я предложу его уточнить или добавить.         *');
  writeln('******************************************************');
  TextColor(9); writeln('Нажмите "Enter" для продолжения...');
  readln;
end;
 
function AddWord(t,s:string):integer;
var
  i:integer;
begin
  repeat
    TextColor(9); write(' Я не знаю слова ');
    TextColor(12); Write(s);
    TextColor(9); WriteLn('! Добавить в словарь (1-да/2-нет):');
    TextColor(12); readln(i);
  until i in [1..2];
  if i=1 then begin l3.Add(t+s);&File.WriteAllLines('words'+t+'.dat',l3.ToArray);l1.Add(t+s);end;
  Result:=i-1;
end;  
  
function SelectTheme:char;
begin
  TextColor(10);
  writeln('Выберите тему:');
  writeln('1. Города');
  writeln('2. Животные');
  writeln('3. Растения');
  writeln('4. Реки');
  writeln('5. Футбольные клубы');
  repeat
    TextColor(9); write('Ваш выбор(цифра от 1..5):');
    TextColor(12); readln(Result);
  until Result in ['1'..'5'];
end;
 
procedure PlayW(i:integer;t:string);
var
  s,b:string;
begin
  repeat
    case i of
      1:begin
         b:='';
         if l0.Count>0 then b:=l0.Item[l0.Count-1];
         repeat
          TextColor(9); write('Ваше слово (пусто для выхода):');
          TextColor(12); readln(s);
          s:=trim(s);
          if s='' then exit;          
          s:=Uppercase(s);
          while (length(b)>0) and (b[length(b)] in ['Ь','Ъ','Ы']) do
            delete(b,length(b),1);
          if (b<>'') and (s[1]<>b[length(b)]) then
            begin
              TextColor(9); write('Ваше слово должно начинаться с буквы ');
              TextColor(12); WriteLn(b[length(b)]);
            end;
         until (b='') or (s[1]=b[length(b)]); 
          if pos(t+s,l1.ToStr(','))<>0 then writeln('Это слово Вы уже называли') else
          if pos(t+s,l0.ToStr(','))<>0 then writeln('Это слово Я уже называл') else
          begin
            i:=0;
            if pos(t+s,l3.ToStr(','))=0 then i:=AddWord(t,s) else l1.Add(t+s);
          end;
        end;
      0:begin
          i:=1;
          if l3.Count>0 then
          if l1.Count=0 then s:=copy(l3[0],2,length(l3[0])) else begin
            while s[length(s)] in ['Ь','Ъ','Ы'] do delete(s,length(s),1);
            foreach s1:string in l3 do begin
                if (s1[2]=s[length(s)]) and (pos(s1,l1.ToStr(','))=0) and (pos(s1,l0.ToStr(','))=0) then begin
                s:=copy(s1,2,length(s1));
                break;
             end;   
           end;  
          end;  
            if (l1.Count>0) and (pos(s,copy(l1.Item[l1.count-1],2,length(l1.Item[l1.count-1])))=1) then 
              begin
                TextColor(9); write('Больше слов на букву "');
                TextColor(12); Write(s[length(s)]);
                TextColor(9); WriteLn('" я не знаю.');
                if s<>'' then l0.Add(t+s);
              end  
              else begin
              writeln('Мое слово ',s);
              if s<>'' then l0.Add(t+s);
            end;  
          end;  
    end;  
    if s='' then writeln('Словарь пуст');
  until false;
end;  
 
begin
  randomize;
  Rules;
  t:=SelectTheme;
  l3.clear;l1.clear;l0.Clear;
  if FileExists('words'+t+'.dat') then 
    l3:=&File.ReadAllLines('words'+t+'.dat').ToList;
  PlayW(ord(random(10)>5),t);
end.
Если что не нравиться, поменяйте сами ;–)
0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
12.05.2015, 06:15

Напечатать все слова, отличные от последнего слова, предварительно удалив из каждого слова последнюю букву
1) Программа. Дан текстиз строчных русских букв, закоторым следует точка. Напечатать этот текст...

Удалить слова, которые содержат все буквы заданного слова, и продублировать остальные слова
Разделитель — один из символов « ,.;:!?&quot;'» (начиная с пробела и заканчивая апострофом). Буква —...

Напечатать все слова, перенеся первую букву каждого слова в конец слова
приветствую вас))) помогите пожалуйста даме... Текст задан строкой var St: string; Напечатать...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
4
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru