Program simuluje hru Bingo

{ BINGO.PAS                             Copyright (c) Jiri Grummich }
{ Program simuluje hru Bingo                                        }
{ Muzes sazet na sloupce,radky,cisla a barvu(suda,licha)            }
{   Sloupce: ůsloupec Xů X nabyva hodnot A,B,C                      }
{     Radky: ůrada Xů X nabyva hodnot 1 az 10                       }
{     Cislo: ůcisloů a pote na dotaz zadej cislo                    }
{     Barva: ůsudeů nebo ůlicheů                                    }
{                                                                   }
{ Datum:31.03.2003                             http://www.trsek.com }
 
Program BINGO;
uses crt;
var A,S,SA,SB,SC,R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,SUD,LICH,K,KS,A2,F,H,x,y,je,meza,bekl,K2,KS2,W,CHEAT : integer;
    B,Z,UG,JCH : string;
    VL : char;
Begin
     repeat
     textbackground (white);
     clrscr;
     textcolor (56);
     writeln ('              RULETA                ');
     writeln;
     writeln;
     textcolor (RED);
     writeln ('1.........HRAT');
     writeln ('2.........PRAVIDLA HRY');
     writeln ('3.........KONEC');
     writeln;
     writeln;
     writeln;
     writeln;
     textcolor (green);
     writeln (' Jiri Grummich ');
     VL := readkey;
     if VL = '2' then begin
                      clrscr;
                      textcolor (56);
                      writeln ('                  PRAVIDLA HRY              ');
                      writeln;
                      writeln;
                      textcolor (white);
                      writeln ('-Zacinas s 5000Kc v penezence (BANK).');
                      writeln ('-Muzes sazet na sloupce,radky,cisla a barvu(suda,licha)');
                      writeln ('-Sloupce: ůsloupec Xů X nabyva hodnot A,B,C');
                      writeln ('-Radky: ůrada Xů X nabyva hodnot 1 az 10');
                      writeln ('-Cislo: ůcisloů a pote na dotaz zadej cislo');
                      writeln ('-Barva: ůsudeů nebo ůlicheů');
                      writeln ('-Sazky ukoncis napises-li na dotaz: ůChcete vsadit?ů ůneů');
                      writeln ('-Nemuzete vsadit zapornou sazku ani se zadluzit v banku!');
                      writeln ('-Z programu vyjedes jestlize na otazku ůChcete vsadit?ů odpovis ůkoneců');
                      writeln ('-Je-li tvuj bank nad 10000Kc vyhral jsi!');
                      writeln ('-Je-li tvuj bank pod 500Kc prohral jsi!');
                      writeln ('-Kurzy:');
                      writeln ('-      Barva: 0.2x');
                      writeln ('-      Sloupec: 0.3x');
                      writeln ('-      Rada: 1x');
                      writeln ('-      Cislo: 4x');
                      writeln ('-      Cislo 0: 10x');
                      writeln ('-Program vytvoril Jiri Grummich');
                      Jch:=readkey;
                      if JCH = '0' then begin
                      writeln;
                      writeln;
                      writeln;
                      textcolor (89);
                      writeln ('Cheaty: Piste na otazku ůChcete vsadit?ů.');
                      writeln ('        - ůnavalprachytyjedenzkurvenejcurakuů - prida 1000Kc do banku');
                      writeln ('        - ůbozedejmicisloů (u posledni sazky) a pak zadejte cislo.');
                      readkey;
                                          end;
                                          end;
 
     if VL = '1' then begin
     A:=5000;
     A2:=A;
     repeat
     R1:=0;
     R2:=0;
     R3:=0;
     R4:=0;
     R5:=0;
     R6:=0;
     R7:=0;
     R8:=0;
     R9:=0;
     R10:=0;
     SUD:=0;
     LICH:=0;
     SA:=0;
     SB:=0;
     SC:=0;
     KS:=0;
     KS2:=0;
     x:=0;
     Y:=0;
     MEZA:=0;
     textcolor (red);
     textbackground (black);
     clrscr;
     K:=31;
     write (chr (201),chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
     write (chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
     write (chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
     write (chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
     write (chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
     writeln (chr (187));
     writeln (chr (186),'           A  B  C            ',chr (186));
     write (chr (204),chr (205),chr (205),chr (205),chr (205),chr (205));
     write (chr (205),chr (205),chr (205),chr (205),chr (203),chr (205));
     write (chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
     write (chr (205),chr (205),chr (205),chr (203),chr (205),chr (205));
     write (chr (205),chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
     writeln (chr (185));
     writeln (chr (186),'        1',chr (186),' 01 02 03 ',chr (186),'1        ',chr (186));
     writeln (chr (186),'    S   2',chr (186),' 04 05 06 ',chr (186),'2   L    ',chr (186));
     writeln (chr (186),'        3',chr (186),' 07 08 09 ',chr (186),'3        ',chr (186));
     writeln (chr (186),'    U   4',chr (186),' 10 11 12 ',chr (186),'4   I    ',chr (186));
     writeln (chr (186),'        5',chr (186),' 13 14 15 ',chr (186),'5        ',chr (186));
     writeln (chr (186),'        6',chr (186),' 16 17 18 ',chr (186),'6   C    ',chr (186));
     writeln (chr (186),'        7',chr (186),' 19 20 21 ',chr (186),'7        ',chr (186));
     writeln (chr (186),'    D   8',chr (186),' 22 23 24 ',chr (186),'8   H    ',chr (186));
     writeln (chr (186),'        9',chr (186),' 25 26 27 ',chr (186),'9        ',chr (186));
     writeln (chr (186),'    A  10',chr (186),' 28 29 30 ',chr (186),'10  A    ',chr (186));
     writeln (chr (186),'         ',chr (186),'    00    ',chr (186),'         ',chr (186));
     write (chr (200),chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
      write (chr (205),chr (205),chr (205),chr (202),chr (205),chr (205),chr (205));
      write (chr (205),chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
      write (chr (202),chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
      writeln (chr (205),chr (205),chr (205),chr (188));
     writeln;
     textcolor (white); {vkladni cast}
     repeat
     writeln ('Vas bank je: ',A2,' Kc.');
     writeln ('Chcete vsadit? ');
     readln (Z);
     if (Z<>'ne') and (Z<>'konec') then begin
     if (Z='navalprachytyjedenzkurvenejcuraku') then A2:=A2+1000;
     if (Z='bozedejmicislo') then  begin
                                   readln (H);
                                   cheat:=2;
                                   end
                             else cheat:=1;
     repeat
     write ('Napiste castku pro vklad: ');
     readln (S);   {nacte sazku}
     A2:=A2-S;       {pripad prohry}
     if (A2 <= 0) or (S<=0) then begin
                    writeln ('Zadali jste zapornou sazku!!');
                    A2:=A2+S+1;
                    S:=0;
                    end;
     until S > 0;
     write ('Na co sazet? ');
     read (B);     {nacte kam umistit sazku}
     if B='sloupec A' then SA:=trunc (S*1.3); {urceni sloupcu}
     if B='sloupec B' then SB:=trunc (S*1.3);
     if B='sloupec C' then SC:=trunc (S*1.3); {urceni sloupcu}
     if B='rada 1' then R1:=S*2;   {urceni rad}
     if B='rada 2' then R2:=S*2;
     if B='rada 3' then R3:=S*2;
     if B='rada 4' then R4:=S*2;
     if B='rada 5' then R5:=S*2;
     if B='rada 6' then R6:=S*2;
     if B='rada 7' then R7:=S*2;
     if B='rada 8' then R8:=S*2;
     if B='rada 9' then R9:=S*2;
     if B='rada 10' then R10:=S*2; {urceni rad}
     if B='suda' then SUD:=trunc (S*1.2);    {urceni sudych}
     if B='licha' then LICH:=trunc (S*1.2);  {urceni lichych}
     if B='cislo' then begin     {urceni cisla}
                       writeln ('Napis cislo: ');
                       if K = 31 then begin
                       read (K);
                       if K=0 then KS:=S*10
                              else KS:=S*4;
                                       end
                                 else begin
                                      read (K2);
                                      if K2=0 then KS2:=S*10
                                              else KS2:=S*4
                                       end
                       end;      {urceni cisla}
         readln;
         end;
         until (Z='ne') or (Z='konec');
     {2. cast}
     textbackground (blue);   {graf. cast}
     clrscr;
     gotoxy (1,1);
     write (chr (220));
     if CHEAT = 1 then begin
     randomize;
     H:=random (30);
                       end;
     repeat
           delay (50);
           x:=x+1;
           gotoxy (x,y);
           write (chr (220));
     until x=60;
 
     gotoxy (40,3);
     textcolor (45);
     write ('!S A Z K Y  J S O U  U Z A V R E N Y!');
     gotoxy (30,10);
     textcolor (12);             {graf. cast}
     write ('Vyhrava cislo   '); {inicializace vyherniho cisla}
     delay (100);
     writeln (H);
     writeln ('Vyhrava: ');
     delay (920);
     if H mod 2 = 0 then begin
                         writeln ('          Sude cislo');
                         MEZA:=MEZA+SUD;
                         end
                    else begin
                         writeln ('          Liche cislo');
                         MEZA:=MEZA+LICH;
                         end;
     delay (920);
     if H mod 3 = 0 then begin
                         writeln ('          3. sloupec');
                         MEZA:=MEZA+SC;
                         end
                    else if (H+2) mod 3 = 0 then  begin
                                                  writeln ('          1. sloupec');
                                                  MEZA:=MEZA+SA;
                                                  end
                                        else  begin
                                              writeln ('          2. sloupec');
                                              MEZA:=MEZA+SB;
                                              end;
     delay (920);
     if H mod 3 = 0 then begin
                              JE:=H div 3;
                              writeln ('          ',JE,'. rada');
                         end
                    else  begin
                          JE:=(H div 3) + 1;
                          writeln ('          ',JE,'. rada');
                          end;  {inicializace vyherniho cisla}
     if JE = 1 then MEZA:=MEZA+R1;
     if JE = 2 then MEZA:=MEZA+R2;
     if JE = 3 then MEZA:=MEZA+R3;
     if JE = 4 then MEZA:=MEZA+R4;
     if JE = 5 then MEZA:=MEZA+R5;
     if JE = 6 then MEZA:=MEZA+R6;
     if JE = 7 then MEZA:=MEZA+R7;
     if JE = 8 then MEZA:=MEZA+R8;
     if JE = 10 then MEZA:=MEZA+R10;
     if H = K then MEZA:=MEZA+KS;
     if H = K2 then MEZA:=MEZA+KS2;
     delay (920);
     writeln;
     writeln;
     textcolor (red);
     if MEZA<>0 then writeln ('             Vyhral jste ',MEZA,' Kc!!')
                else writeln ('             Bohuzel, nic jste nevyhral.');
     textcolor (yellow);
     write ('Vas aktualni bank je: ');
     delay (600);
     A2:=A2+MEZA;
     textcolor (black);
     write (A2,'Kc!');
     readkey;
     if A2 > 10000 then W:=1;
     if A2 < 500 then W:=2;
     until (A2 <= 500) or (Z = 'konec') or (A2 > 10000);
     if W = 1 then begin
                   clrscr;
                   textbackground (Blue);
                   gotoxy (10,15);
                   textcolor (68);
                   write ('V y h r a l   j s t e ! ! ! ! ');
                   readkey;
                   end;
     if W = 2 then begin
                   clrscr;
                   textbackground (Blue);
                   gotoxy (10,15);
                   textcolor (68);
                   write ('Z b a n k r o t o v a l  j s t e ! ! ! ! ! ');
                   readkey;
                   end;
     if W = 0 then begin
                   clrscr;
                   textbackground (Blue);
                   gotoxy (10,15);
                   textcolor (68);
                   write (' V z d a l   j s i   t o   s r a c k o ! ! ! ');
                   readkey;
                   end;
                   end;
     if VL = '3' then clrscr;
     until VL = '3';
End.