Jsi vrchním radcem panovnika ve starovekém Egypte Ramesse II

{ endturnu.pas                          Copyright (c) Petr Masopust  }
{ Unit pre hru pyramida.pas                                          }
{ Urceny hlavne k ukladany a nacitani rozohratej hry na disk.        }
{                                                                    }
{ Datum:03.09.2018                              http://www.trsek.com }
unit endturnu;
interface
const
  kukalchalli=1;
  superbus=2;
  koronuta=4;
  bigpolis=8;
  djpolis=16;
  svopakov=32;
  iqpolis=64;
  killpolis=128;
 
  zaclidi=1000;
  zacsypek=1000;
  zacpole=250;
  zacotroci=500;
  zacnastroje=100;
  zacpenize=100;
 
type
  jednaprovincie=record
                   lidi: integer;
                   pole: longint;
                   sypky: longint;
                   otroci: longint;
                   nastroje: longint;
                   penize: longint;
                   stupnu: real;
                 end;
  celahra=array[0..20]of jednaprovincie; {588 byte}
  zazrobsazene=array[0..3] of byte;
  saveload=record     {590 byte}
             jmeno:string[30];
             provhrace:byte;
             rok:byte;
             structure:celahra;
             z:zazrobsazene;
           end;
{cislo hracovy provincie z hlavniho programu}
{zobrazovaci procedura pro zazraky take {v ni nejlepe i beep}
{v trhu udelat prilakani lidi za penize}
 
var hp:byte;
    rok:byte;
    jmeno:string;
    lidinapolich,lidinanastrojich,lidinapyramide,lidinapenize:longint;
    otrokunapolich,otrokunanastrojich,otrokunapyramide,otrokunapenize:longint;
    error,zobrzazraku:procedure(s:string);
 
procedure endturn(var v:jednaprovincie);
procedure newgame(var v:jednaprovincie);
procedure save(var p:saveload);
procedure load(p:saveload;var pr:jednaprovincie);
 
implementation
var
    c:celahra;
    za:zazrobsazene;
 
procedure ochrana;
begin
  if rok > 20 then error('Spatny letopocet !');
  if c[rok].lidi <= 0 then error('Vymrela provincie !');
  if lidinapolich+lidinanastrojich+lidinapyramide+lidinapenize > c[rok].lidi then error('Mnoho lidi pracuje !');
  if otrokunapolich+otrokunanastrojich+otrokunapyramide+otrokunapenize > c[rok].otroci then error('Mas mene otroku !');
end;
 
function sgn(x:integer):shortint;
begin
  if x > 0 then sgn:=1 else
  if x < 0 then sgn:=-1 else
  sgn:=0;
end;
 
function IntToStr(a: Longint): String;
var
  St: string;
begin
  Str(a, St);
  IntToStr := St;
end;
 
procedure zazraky;
var i:byte;
begin
  repeat
    i:=random(31);
  until za[i div 8] and round(exp(ln(2)*(i mod 8))) <> round(exp(ln(2)*(i mod 8)));
  za[i div 8]:=za[i div 8] or round(exp(ln(2)*(i mod 8)));
  case i of
  1: begin
       zobrzazraku('Faraon omylem pohledl na mape'+#13+'na tvou provincii a daroval ti'+#13+'10 sypek obili.');
       inc(c[rok-1].sypky,10);
     end;
  4..5: begin
          c[rok-1].lidi:=c[rok-1].lidi div (i-2);
          zobrzazraku('Epidemie moru mezi obyvatelstvem!'+#13+
                      'Mas nyni jen 1/'+inttostr(i-2)+' obyvatel !');
        end;
  6: begin
          c[rok-1].lidi:=c[rok-1].lidi * (i-4);
          zobrzazraku('Obrovska populacni vlna !'+#13+
                      'Obyvatelstva je nyni '+inttostr(i-4)+'x vice !');
        end;
  8..9: if c[rok-1].stupnu > 2 then begin
          c[rok-1].stupnu:=c[rok-1].stupnu / (i-6);
          zobrzazraku('Tvoji provincii zasahlo'+#13+' velke zemetreseni !'+#13+
                      'Zborila se ti 1/'+inttostr(i-6)+' pyramidy !');
        end;
        {$B-}
  10: if (rok >= 2) and (c[rok-1].stupnu - c[rok-2].stupnu >= 1) then begin
        zobrzazraku('Faraon je mile potesen tvymi'+#13+'vysledky a daroval ti 100 sypek'+#13+'plnych obili.');
        inc(c[rok-1].sypky,100);
      end;
  11..13: begin
            c[rok-1].pole:=c[rok-1].pole div (i-9);
            zobrzazraku('Nil se straslive rozvodnil !'+#13+
                        'Mas nyni jen 1/'+inttostr(i-9)+' poli !');
          end;
  15..16: begin
            c[rok-1].pole:=c[rok-1].pole * (i-13);
            zobrzazraku('Novy zpusob obdelavani poli !'+#13+
                        'Mas jich nyni '+inttostr(i-13)+'x vice !');
          end;
  17..18: begin
            c[rok-1].penize:=c[rok-1].penize * (i-15);
            zobrzazraku( 'Krach na egyptske burze !'+#13+
                         'Mas nyni jen 1/'+inttostr(i-15)+' tragu !');
          end;
  19..20: begin
            c[rok-1].sypky:=c[rok-1].sypky * (i-17);
            zobrzazraku( 'Mimoradna cirkevni premie !'+#13+
                         'Mas nyni '+inttostr(i-17)+'x vice sypek obili !');
          end;
  21..22: begin
            c[rok-1].penize:=c[rok-1].penize * (i-19);
            zobrzazraku( 'Tvym lidem se podarila velka'+#13+'financni transakce !'+#13+
                         'Mas nyni '+inttostr(i-19)+'x vice penez !');
          end;
  23..25: begin
          c[rok-1].sypky:=c[rok-1].sypky div (i-21);
          zobrzazraku( 'Premnozeni krys !'+#13+
                       'Sezraly Ti obili, takze ho'+#13+'mas nyni jen 1/'+inttostr(i-21)+' !');
        end;
  2..3,7,26..30: begin end;
  end;
end;
 
function hladkolik:byte;
var i,j:byte;
begin
  j:=0;
  for i:=0 to rok do if c[i].sypky <= 0 then inc(j);
  hladkolik:=j;
end;
 
procedure urobprovincii(i:byte);
var doplnek,dnastr:longint;
    koef:real;
begin
  case i of
  kukalchalli:begin
                c[rok-1].sypky:=c[rok-1].sypky-50;
                c[rok-1].nastroje:=c[rok-1].nastroje+25;
                c[rok-1].otroci:=c[rok-1].otroci+25;
              end;
  superbus:begin
             c[rok-1].lidi:=c[rok-1].lidi-25;
             c[rok-1].otroci:=0;
             c[rok-1].penize:=c[rok-1].penize+25;
           end;
  koronuta:begin
             c[rok-1].pole:=c[rok-1].pole-25;
             c[rok-1].sypky:=c[rok-1].sypky-25;
             c[rok-1].otroci:=c[rok-1].otroci+50;
           end;
  bigpolis:begin
             c[rok-1].lidi:=c[rok-1].lidi+50;
             c[rok-1].penize:=c[rok-1].penize-25;
             c[rok-1].nastroje:=c[rok-1].nastroje-25;
           end;
  djpolis:begin
            c[rok-1].nastroje:=c[rok-1].nastroje+25;
            c[rok-1].lidi:=c[rok-1].lidi+25;
            c[rok-1].sypky:=c[rok-1].sypky-50;
          end;
  svopakov:begin
             c[rok-1].pole:=c[rok-1].pole+25;
             c[rok-1].sypky:=c[rok-1].sypky+25;
             c[rok-1].otroci:=c[rok-1].otroci-50;
           end;
  iqpolis:begin
            c[rok-1].lidi:=c[rok-1].lidi+25;
            c[rok-1].penize:=c[rok-1].penize+75;
            c[rok-1].sypky:=c[rok-1].sypky-100;
          end;
  killpolis:begin
              c[rok-1].lidi:=c[rok-1].lidi-75;
              c[rok-1].otroci:=c[rok-1].otroci+50;
              c[rok-1].nastroje:=c[rok-1].nastroje+25;
            end;
  end;
    dnastr:=c[rok-1].nastroje;
    if dnastr > 0 then
    if dnastr <= (lidinanastrojich+otrokunanastrojich) then begin
      koef:=1+dnastr / (lidinanastrojich+otrokunanastrojich);
      dec(dnastr,round((koef-1) * (lidinanastrojich+otrokunanastrojich)));
    end else begin
      koef:=2;
      dec(dnastr,(lidinanastrojich+otrokunanastrojich));
    end else koef:=1;
    c[rok].nastroje:=c[rok-1].nastroje + round((lidinanastrojich+otrokunanastrojich)*koef);
 
    c[rok].lidi:=c[rok-1].lidi + ((c[rok-1].lidi + random(51) * sgn(random(5)-3)) div 100);
 
    doplnek:=lidinapolich+otrokunapolich;
    if doplnek = 0 then doplnek:=1;
    if dnastr > 0 then
    if dnastr <= (lidinapolich+otrokunapolich) then begin
      koef:=1+dnastr / (lidinapolich+otrokunapolich);
      dec(dnastr,round((koef-1) * (lidinapolich+otrokunapolich)));
    end else begin
      koef:=2;
      dec(dnastr,doplnek);
    end else koef:=1;
    if doplnek = 0 then doplnek:=1;
    c[rok].sypky:=c[rok-1].sypky + round(((lidinapolich+otrokunapolich*2)*koef) * (15+random(10))) div (doplnek * 5)
                     - (c[rok-1].lidi+c[rok-1].otroci+doplnek div 5) div 5;
    if c[rok].sypky < 0 then begin
      c[rok-1].otroci:=c[rok-1].otroci - abs(c[rok].sypky)*10 + random(6) * sgn(random(5)-3);
      doplnek:=0;
      if c[rok-1].otroci < 0 then doplnek:=-c[rok-1].otroci;
      if doplnek > 0 then c[rok].lidi:=c[rok].lidi - doplnek;
      if c[rok].lidi > 0 then
      case hladkolik of
      1: begin
           zobrzazraku('V tve provincii vypukl hladomor,'+#13+'zemrelo '+inttostr(abs(c[rok].lidi-c[rok-1].lidi))+' lidi a '
                       +inttostr(abs(c[rok].otroci-c[rok-1].otroci))+' otroku.'+#13+
                       'Faraon se po dlouhem premlouvani'+#13+'dal obmekcit a dal ti jeste jednu'+#13+
                       'sanci a k tomu 100 plnych sypek.');
           c[rok].sypky:=100;
        end;
    2: begin
         if c[rok].penize > 10 then begin
           zobrzazraku('V tve provincii vypukl OPET hladomor,'+#13+'zemrelo '+inttostr(abs(c[rok].lidi-c[rok-1].lidi))+
                       ' lidi a'+#13+inttostr(abs(c[rok].otroci-c[rok-1].otroci))+' otroku. Faraon se po dlouhem premlouvani a'
                       +#13+'primlouvani radcu (musel jsi je uplatit'+#13+
                       'vsemi penezi) dal jeste obmekcit,'+#13+'ale priste se ti to uz nepovede !'+#13+
                       'Mas tentokrat jen 50 plnych sypek.');
           c[rok].sypky:=50;c[rok].penize:=0;
         end else begin
           rok:=30;
           zobrzazraku('Bohuzel nemel jsi dostatek penez'+#13+'na uplaceni faraonovych radcu a proto'+#13+
                       'te faraon nechal popravit !');
         end;
       end;
    3: begin
         rok:=30;
         zobrzazraku('Treti chybu ti faraon opravdu'+#13+
                     'neprominul a byl jsi okamzite popraven !');
       end;
    end;
  end;
 
    c[rok].otroci:=c[rok-1].otroci + random(100)*sgn(random(5)-3);
    if c[rok-1].otroci < 0 then c[rok].otroci:=0;
    c[rok].penize:=c[rok-1].penize + (lidinapenize*2+otrokunapenize + random(21) * sgn(random(5)-3))  div 10;
    if rok > 1 then c[rok].penize:=round(c[rok].penize+(c[rok].penize-c[rok-1].penize)*0.1);
    c[rok].stupnu:=c[rok-1].stupnu + (lidinapyramide+otrokunapyramide*3+random(101)*sgn(random(5)-3)) / 1000;
    c[rok].pole:=c[rok-1].pole;
end;
 
procedure endturn(var v:jednaprovincie);
var i:byte;
begin
  c[rok]:=v;
  ochrana;
  inc(rok);
  zazraky;
  urobprovincii(hp);
  v:=c[rok];
end;
 
procedure newgame(var v:jednaprovincie);
var I:byte;
    s:string;
begin
  for i:=0 to 3 do za[i]:=0;
  rok:=0;
  with c[rok] do begin
    lidi:=zaclidi;
    sypky:=zacsypek;
    otroci:=zacotroci;
    nastroje:=zacnastroje;
    penize:=zacpenize;
    pole:=zacpole;
    stupnu:=0;
  end;
  endturn(c[rok]);
  v:=c[rok];
end;
 
procedure save(var p:saveload);
begin
  p.provhrace:=hp;
  p.rok:=rok;
  p.jmeno:=jmeno;
  p.structure:=c;
  p.z:=za;
end;
 
procedure load(p:saveload;var pr:jednaprovincie);
begin
  hp:=p.provhrace;
  rok:=p.rok;
  jmeno:=p.jmeno;
  c:=p.structure;
  pr:=c[rok];
  za:=p.z;
end;
 
begin
  randomize;
end.