Форум программистов, компьютерный форум, киберфорум
Free Pascal
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/7: Рейтинг темы: голосов - 7, средняя оценка - 5.00
0 / 0 / 0
Регистрация: 23.03.2017
Сообщений: 4
1

Написать программу игры в кости

23.03.2017, 23:34. Просмотров 1392. Ответов 4


Написать программу игры в кости по следующим правилам: играющий (их число не больше 4) называет (вводит в ЭВМ) целое число А от 1 до 6. Затем генерируются 3 случайных числа от 1 до 6 (т.е. бросаются кости) если среди 3х сгенерированных чисел число А встретилось 1 раз - игрок получает 5 очков, если 2 раза - 10 очков, 3 раза - 15 очков, не встретилось ни разу - 0 очков. Кости кидаются по очереди каждым из участников. Победитель тот, кто набрал больше всех очков.
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
23.03.2017, 23:34
Ответы с готовыми решениями:

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

Написать программу, реализующую игру в кости
Ребята, всем доброго времени суток... Посмотрите, пожалуйста, может кто то подскажет что...

Надо написать программу (игру) "Кости". Где ошибка?
Доброго времени. суток. Прошу помочь с решение "проблемы" по написанию программы (игры) в "Кости"...

Создать аналог игры кости с выбором режима на два игрока
Help

4
1742 / 1335 / 1407
Регистрация: 28.10.2016
Сообщений: 4,267
24.03.2017, 00:36 2
Лучший ответ Сообщение было отмечено DmitryStrs как решение

Решение

Вроде этого?
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
var
a,i,k,j,r,win:integer;
t:array [1..4] of integer;
begin
  randomize;
  repeat
    write('Количество участников (1-4): '); readln(k);
  until k<=4;
  for i:=1 to k do begin
    repeat
      writeln(i,' игрок введите число (1-6): '); readln(a);
    until a<=6;
    t[i]:=0;
    for j:=1 to 3 do begin
      r:=random(6)+1;
      if r=a then t[i]:=t[i]+5;
      write(r,' ');
    end;
    writeln;
  end;
  win:=t[1];
  for i:=2 to k do
    if t[i]>win then win:=t[i];
  if win>0 then
    for i:=1 to k do //на случай, если несколько победивших
      if t[i]=win then writeln(i,' игрок победил')
    else writeln('Победителя нет');
end.
1
0 / 0 / 0
Регистрация: 23.03.2017
Сообщений: 4
24.03.2017, 01:03  [ТС] 3
Спасибо!
0
Эксперт Pascal/Delphi
2359 / 1278 / 1484
Регистрация: 29.08.2014
Сообщений: 4,602
24.03.2017, 11:07 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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
{$mode Delphi} 
uses Graph,wincrt, SysUtils;
procedure Kub(i,x0,y0,xs,ys,r:integer;redraw:boolean;l:integer=0;m:integer=0;rec:integer=0);
procedure point(x,y,r:integer;k:integer=0);
var
  color:word;
begin
  if k=1 then  color:=Black else color:=darkGray;
  SetColor(color);
  setfillstyle(SolidFill,color);
  circle(x,y,r);
  floodfill(x,y,color);
  SetColor(White);
  Circle(x-r div 2,y-r div 2,r div 5);
  setfillstyle(SolidFill,white);
  if r div 5>1 then floodfill(x-r div 2,y-r div 2,white);
end;
begin
  if redraw then begin
    MoveTo(xs+x0,ys+y0 div 2);
    LineTo(xs+x0 div 2,ys+y0);
    LineTo(xs+x0,ys+y0+y0 div 2);
    LineTo(xs+x0+x0 div 2,ys+y0);
    LineTo(xs+x0,ys+y0 div 2);
    MoveTo(xs+x0 div 2,ys+y0);
    LineTo(xs+x0 div 2,ys+2*y0);
    LineTo(xs+x0,ys+2*y0+y0 div 2);
    LineTo(xs+x0+x0 div 2,ys+2*y0);
    LineTo(xs+x0+x0 div 2,ys+y0);
    Line(xs+x0, ys+y0+y0 div 2,xs+x0,ys+2*y0+y0 div 2);
    setfillstyle(SolidFill,White);
    FloodFill(xs+x0,ys+y0,getcolor);
    setfillstyle(SolidFill,LightGray);
    FloodFill(xs+x0+x0 div 2-r,ys+y0+r,getcolor);
    FloodFill(xs+x0-x0 div 2+r,ys+y0+r,getcolor)
  end;
   case i of
    1:begin point(xs+x0,ys+y0,r,1);
        case random(4)+rec of
          0:kub(0,x0,y0,xs,ys,r,false,5,4);
          1:kub(0,x0,y0,xs,ys,r,false,4,3);
          2:kub(0,x0,y0,xs,ys,r,false,3,2);
          3:kub(0,x0,y0,xs,ys,r,false,2,5);
        end;
      end;
    2:begin point(xs+x0 div 2+6*r,ys+y0,r,1); point(xs+x0+x0 div 2-6*r,ys+y0,r,1);
        case random(4)+rec of
          0:kub(0,x0,y0,xs,ys,r,false,5,1);
          1:kub(0,x0,y0,xs,ys,r,false,1,3);
          2:kub(0,x0,y0,xs,ys,r,false,3,6);
          3:kub(0,x0,y0,xs,ys,r,false,6,5);
        end;
      end;
    3:begin kub(2,x0,y0,xs,ys,r,false,0,0,10);kub(1,x0,y0,xs,ys,r,false,0,0,10);
        case random(4)+rec of
          0:kub(0,x0,y0,xs,ys,r,false,4,6);
          1:kub(0,x0,y0,xs,ys,r,false,6,2);
          2:kub(0,x0,y0,xs,ys,r,false,2,1);
          3:kub(0,x0,y0,xs,ys,r,false,1,4);
        end;  
      end;
    4:begin kub(2,x0,y0,xs,ys,r,false,0,0,10);point(xs+x0,ys+y0+y0 div 2-r*3,r,1);point(xs+x0,ys+y0-y0 div 2+r*3,r,1);
        case random(4)+rec of
          0:kub(0,x0,y0,xs,ys,r,false,5,6);
          1:kub(0,x0,y0,xs,ys,r,false,6,3);
          2:kub(0,x0,y0,xs,ys,r,false,3,1);
          3:kub(0,x0,y0,xs,ys,r,false,1,5);
        end;  
      end;
    5:begin kub(1,x0,y0,xs,ys,r,false,0,0,10);kub(4,x0,y0,xs,ys,r,false,0,0,10);
        case random(4)+rec of
          0:kub(0,x0,y0,xs,ys,r,false,2,6);
          1:kub(0,x0,y0,xs,ys,r,false,6,4);
          2:kub(0,x0,y0,xs,ys,r,false,4,1);
          3:kub(0,x0,y0,xs,ys,r,false,1,2);
        end;
      end;
    6:begin
       kub(4,x0,y0,xs,ys,r,false,0,0,10);
       point(xs+(x0 div 2+6*r+x0) div 2, ys+(2*y0+y0 div 2-r*3) div 2,r,1);
       point(xs+(x0 div 2-6*r+2*x0) div 2, ys+(2*y0-y0 div 2+r*3) div 2,r,1);
        case random(4)+rec of
          0:kub(0,x0,y0,xs,ys,r,false,2,3);
          1:kub(0,x0,y0,xs,ys,r,false,3,4);
          2:kub(0,x0,y0,xs,ys,r,false,4,5);
          3:kub(0,x0,y0,xs,ys,r,false,5,2);
        end;  
    end;
  end;
  case l of
    1:point(xs+(2*x0-x0 div 2) div 2,ys+(3*y0+y0 div 2) div 2,r);
    2:begin point(xs+x0-x0 div 2+2*r,ys+y0+3*r,r);point(xs+x0-2*r,ys+2*y0+y0 div 2-3*r,r);end;
    3:begin kub(0,x0,y0,xs,ys,r,false,1);kub(0,x0,y0,xs,ys,r,false,2);end;
    4:begin kub(0,x0,y0,xs,ys,r,false,2);point(xs+x0-2*r,ys+y0+y0 div 2+2*r,r);point(xs+x0-x0 div 2+2*r,ys+2*y0-2*r,r);end;
    5:begin kub(0,x0,y0,xs,ys,r,false,1);kub(0,x0,y0,xs,ys,r,false,4);end;
    6:begin kub(0,x0,y0,xs,ys,r,false,4);point(xs+(2*x0-x0 div 2) div 2,ys+(2*y0+y0 div 2+5*r) div 2,r);point(xs+(2*x0-x0 div 2) div 2,ys+(4*y0+y0 div 2-5*r) div 2,r);end;
  end;
  case m of 
    1:point(xs+(2*x0+x0 div 2) div 2,ys+(3*y0+y0 div 2) div 2,r);
    2:begin point(xs+x0+x0 div 2-2*r,ys+y0+3*r,r);point(xs+x0+2*r,ys+2*y0+y0 div 2-3*r,r);end;
    3:begin kub(0,x0,y0,xs,ys,r,false,0,1);kub(0,x0,y0,xs,ys,r,false,0,2);end;
    4:begin kub(0,x0,y0,xs,ys,r,false,0,2);point(xs+x0+2*r,ys+y0+y0 div 2+2*r,r);point(xs+x0+x0 div 2-2*r,ys+2*y0-2*r,r);end;
    5:begin kub(0,x0,y0,xs,ys,r,false,0,1);kub(0,x0,y0,xs,ys,r,false,0,4);end;
    6:begin kub(0,x0,y0,xs,ys,r,false,0,4);point(xs+(2*x0+x0 div 2) div 2,ys+(2*y0+y0 div 2+5*r) div 2,r);point(xs+(2*x0+x0 div 2) div 2,ys+(4*y0+y0 div 2-5*r) div 2,r);end;
  end;
end;
 
procedure TextXY(s:string;color,x,y:word);
begin
  setcolor(color);
  moveto(x,y*textheight('W'));
  outtext(s);
end;
 
var
  x0,y0,xs,ys,r,i,j,k,l:integer;
  gd,gm:smallint;
  t:array[1..4] of integer;
  begin
    gd:=detect;
    gm:=0;
    initgraph(gd,gm,'');
    randomize;
    x0:=300;y0:=150;r:=15;xs:=getmaxx div 2;ys:=getmaxy div 2;
    setfillstyle(1,green);
    FloodFill(150,150, 2);
    setcolor(darkgray);
    kub(Random(6)+1,x0,y0,xs,ys,r,true);
    SettextStyle(SansSerifFont, HorizDir,3);
    TextXY('Enter number of players[1..4]:',Yellow,1,1);
    repeat i:=ord(readkey)-48; until (i>0) and (i<5);
    setcolor(LightRed);
    outtext(chr(i+48));
    x0:=100;y0:=50;r:=5;
    for i:=1 to i do begin
      TextXY('Player:'+chr(i+48)+' you bet(1..6):',Yellow,1,i*6);
    repeat k:=ord(readkey)-48;  until (k>0) and (k<7);
      outtext(chr(k+48));
      ys:=getY;xs:=1;
    for j:=1 to 3 do begin
      l:=random(6)+1;
      if l=k then setcolor(LightBlue) else setcolor(LightRed);
      inc(t[i],5*ord(l=k));
      kub(l,x0,y0,xs+x0*j+10*j,ys,r,true);
    end;
      textxy('Score:'+inttostr(t[i]),Magenta,getx+x0,i*6);
    end;
    repeat until readkey=#27;
end.
1
Модератор
Эксперт Pascal/DelphiЭксперт NIX
5693 / 3408 / 2429
Регистрация: 22.11.2013
Сообщений: 9,560
Записей в блоге: 1
24.03.2017, 17:49 5
Joy,
а если бы структура программы (разбиение на подпрограммы) была выбрана правильно, то замена отображения, например, на псевдографику, скажем на такую:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
function YachtR(n, r: Word): String;
const
  y: array [1..6] of Byte = (8,34,42,99,107,119);
  c: array [Boolean] of Char = ' o';
var s: String[9];
begin
  n:=y[n];
  case r of
  0,4: s:='+-------+';
  1:   s:='| '+c[n and $1<>0]+'   '+c[n and $2<>0]+' |';
  2:   s:='| '+c[n and $4<>0]+' '+c[n and $8<>0]+' '+c[n and $10<>0]+' |';
  3:   s:='| '+c[n and $20<>0]+'   '+c[n and $40<>0]+' |';
  else s:='';
  end;
  YachtR:=s;
end;
var i, j: Integer;
begin
  for i:=0 to 4 do begin
    for j:=1 to 6 do Write(' ',YachtR(j,i)); WriteLn;
  end;
end.
Код
 +-------+ +-------+ +-------+ +-------+ +-------+ +-------+
 |       | |     o | |     o | | o   o | | o   o | | o   o |
 |   o   | |       | |   o   | |       | |   o   | | o   o |
 |       | | o     | | o     | | o   o | | o   o | | o   o |
 +-------+ +-------+ +-------+ +-------+ +-------+ +-------+
не составляла бы труда
2
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
24.03.2017, 17:49

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь или здесь.

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

Написать игру кости
Здравствуйте, стоит вот такая задача: &quot;Основное правило игры в кости — каждый игрок по очереди...

Написать программу для игры в крестики-нолики с компьютером
Помогите пли) очень срочно) Заранее спасибо)

Описать логическую фунцию, показывающую, равна ли правая цифра очередной кости левой цифре следующей кости домино
type костьдомино = record лев,правый:0..6 end; ряд= array of костьдомино. Описать логическую...


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

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

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