{ 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.