(*  hmrabi.c--Govern Ancient Sumeria
    Translated to Pascal by Eric Olson July 6, 2013
    Translated to C by Eric Olson June 6, 2013
    Converted from the original Focal program and modified for the
    Edusystem 70 by David Ahl, DIGITAL *)

program main(input,output);

const nl:char=chr(10);

function str2int(a:string):integer;
label 99;
var i:integer;
    d,r:integer;
    minus:boolean;
begin
    minus:=false;
    r:=0;
    for i:=1 to length(a) do begin
        if (i=1) and (a[1]='-') then minus:=true
        else begin
            d:=ord(a[i])-ord('0');
            if (d>=0) and (d<=9) then r:=r*10-d
            else goto 99
        end
    end;
99:
    if minus then str2int:=r else str2int:=-r;
end;

var seed:integer;
function rndseq(n:integer):integer;
begin
    seed:=(seed*1255+6173) mod 29282;
    rndseq:=(seed*n) div 29282;
end;

function upcase(c:char):char;
var d:integer;
begin
    d:=ord(c);
    if (d>=ord('a')) or (d<=ord('z')) then
        d:=d+ord ('A')-ord ('a');
    upcase:=chr(d);
end;

procedure intro;
begin
    write(
    nl,'Description',nl,
    nl,
    'In this game you direct the adminitrator of Sumeria, Hammurabi,',nl,
    'how to manage the city.  The city initially has 1,000 acres, 100',nl,
    'people and 3,000 bushels of grain in storage.',nl,
    nl,
    'You may buy and sell land with your neighboring city-states for',nl,
    'bushels of grain--the price will vary between 17 and 26 bushels',nl,
    'per acre.  You also must use grain to feed your people and as',nl,
    'seed to plant the next year''s crop.',nl,
    nl,
    'You will quickly find that a certain number of people can only',nl,
    'tend a certain amount of land and that people starve if they',nl,
    'are not fed anough.  You also have the unexpected to contend',nl,
    'with such as a plague, rats destroying stored grain, and variable',nl,
    'harvests.',nl,
    nl,
    'You will also find that managing just the few resources in this',nl,
    'game is not a trivial job over a period of say ten years.  The',nl,
    'crisis of population density rears its head very rapidly.',nl,
    nl,
    'Source',nl,
    nl,
    'This program translated to Pascal, Java and C by Eric Olson from',nl,
    '101 BASIC Computer Games by David Ahl.  In turn that program was',nl,
    'translated from the original FOCAL program which was floating',nl,
    'around DIGITAL in the late 1970''s.',nl);
end;

var acres,people,year,land,store:integer;
    starve,rats,plague,yield,harvest,immigrant:integer;
    buy,sell,feed,plant:integer;
    starvetotal:integer;
    starveperct:real;

procedure status;
begin
    write(nl,nl,'Hammurabi:  I beg to report to you,',nl,
        'In year ',year,' , ',starve,' people starved, ',
        immigrant,' came to the city.',nl);
    people:=people+immigrant;
    if(plague<=0) then begin
        people:=people div 2;
        write('A horrible plague struck!  Half the people died.',nl)
    end;
    write('Population is now ',people,nl,
        'The city now owns ',acres,' acres.',nl,
        'You harvested ',yield,' bushels per acre.',nl,
        'Rats ate ',rats,' bushels.',nl,
        'You now have ',store,' bushels in store.',nl,nl);
    land:=rndseq(10)+17;
    write('Land is trading at ',land,' bushels per acre.',nl)
end;

procedure quitnow;
begin
    write(nl,'Hammurabi:  I cannot do what you wish.',nl,
        'Get yourself another steward!!!!!',nl);
    halt(0)
end;

procedure inputs;
    procedure notacres;
    begin
        write('Hammurabi:  Think again.  You have only ',
            acres,' acres.  Now then,',nl)
    end;
    procedure notgrain;
    begin
        write('Hammurabi:  Think again.  You have only',nl,
            store,' bushels of grain.  Now then,',nl)
    end;
    procedure notpeople;
    begin
        write('But you have only ',people,' people to tend the fields.',
            '  Now then,',nl)
    end;
    function getbuy:integer;    
    label 99;
    var buf:string[255];
        q:integer;
    begin
        while(true) do begin
            write('How many acres do you wish to buy?  ');
            readln(buf);
            q:=str2int(buf); 
            if(q<0) then quitnow;
            if(land*q<=store) then begin
                getbuy:=q;
                goto 99
            end;
            notgrain
        end;
99:
    end;
    function getsell:integer;
    label 99;
    var buf:string[255];
        q:integer;
    begin
        while(true) do begin
            write('How many acres do you wish to sell?  ');
            readln(buf);
            q:=str2int(buf);
            if(q<0) then quitnow;
            if(q<acres) then begin
                getsell:=q;
                goto 99
            end;
            notacres
        end;
99:
    end;
    function getfeed:integer;
    label 99;
    var buf:string[255];
        q:integer;
    begin
        while(true) do begin
            write('How many bushels do you wish',
                ' to feed your people?  ');
            readln(buf);
            q:=str2int(buf);
            if(q<0) then quitnow;
            if(q<=store) then begin
                getfeed:=q;
                goto 99
            end;
            // Trying to use more grain that in the silos?
            notgrain
        end;
99:
    end;
    function getplant:integer;
    label 99;
    var buf:string[255];
        d:integer;
    begin
        while(true) do begin
            write('How many acres do you wish ',
                'to plant with seed?  ');
            readln(buf);
            d:=str2int(buf);
            if(d<0) then quitnow;
            // Trying to plant more acres than you own?
            if(d>acres) then notacres
            // Enough grain for seed?
            else if(d div 2>store) then notgrain
            // Enough people to tend the crops?
            else if(d>=10*people) then notpeople
            else begin
                getplant:=d;
                goto 99
            end
        end;
99:
    end;

begin
    buy:=getbuy;
    acres:=acres+buy; store:=store-land*buy;
    if buy=0 then begin
        sell:=getsell;
        acres:=acres-sell; store:=store+land*sell
    end;
    feed:=getfeed;
    store:=store-feed;
    plant:=getplant;
    store:=store-plant div 2;
end;

procedure finish;
var n:integer;
begin
    for n:=1 to 10 do write(chr(7));
    write(nl,'So long for now.',nl,nl);
    halt(0);
end;

procedure failure;
begin
    write('Due to this extreme mismanagement you have not only',nl,
        'been impeached and thrown out of office but you have',nl,
        'also been declared ''national fink'' !!',nl)
end;

procedure score;
var l,p1:real;
begin
    p1:=starveperct/year;    
    l:=acres/people;
    write(nl,'In your 10-year term of office ',p1:0:1,' percent of the',nl,
        'population starved per year on average, i.e., a total of',nl,
        starvetotal,' people died!!',nl,
        'You started with 10 acres per person and ended with',nl,
        l:0:1,' acres per person.',nl,nl);
    if (p1>33) or (l<7) then failure
    else if (p1>10) or (l<9) then
        write('Your heavy-handed performance smacks of Nero and Ivan IV.',nl,
            'The people (remaining) find you an unpleasant ruler, and,',nl,
            'frankly, hate your guts!',nl)
    else if (p1>3) or (l<10) then
        write('Your performance could have been somewhat better, but',nl,
            'Really wasn''t too bad at all.  ',(people*rndseq(80)) div 100,
            ' people would',nl,
            'dearly like to see you assassinated but we all have our',nl,
            'trivial problems.',nl)
    else
        write('A fantastic performance!!!  Charlemange, Disraeli, and',nl,
            'Jefferson combined could not have done better!',nl)
end;

var buf:string[255];
    c:integer;

begin
    write('hmrabi--Govern Ancient Sumeria',nl,nl,
        'Try your hand at governing ancient Sumeria',nl,
        'Successfully for a 10-year term of office.',nl,nl);
    write('Would you like more information?  ');
    readln(buf);
    if(upcase(buf[1])='Y') then intro;

    write(nl,'Please enter a random seed between 0 and 29282:  ');
    readln(buf);
    seed:=str2int(buf);

    starveperct:=0; starvetotal:=0;
    people:=95; store:=2800; harvest:=3000; rats:=harvest-store; 
    yield:=3; acres:=harvest div yield; immigrant:=5; plague:=1; starve:=0;
    year:=1;
    while(true) do begin
        status;
        inputs;

        // A Bountyfull Harvest!!
        yield:=rndseq(5)+1;
        harvest:=plant*yield;

        // The rats are running wild!!
        c:=rndseq(5)+1;
        if(c mod 2=0) then rats:=store div c
        else rats:=0;
        store:=store+harvest-rats;

        // Determine how many people immigrated.
        immigrant:=trunc((rndseq(5)+1)*(20.0*acres+store)/people/100+1);

        // How many people had full tummies?
        starve:=people-trunc(feed/20);
        if(starve<0) then starve:=0
        // Starve enough for impeachment?
        else if(starve>0.45*people) then begin
            write(nl,'You starved ',starve,' people in one year!!!',nl);
            failure;
            finish
        end;
        starveperct:=starveperct+starve*100.0/people;
        starvetotal:=starvetotal+starve;
        people:=people-starve;

        // Horrors, a 15% chance of plague
        plague:=rndseq(20)-3;
        if(year mod 10=0) then begin
            score;
            write(nl);
            write('Would you like to continue playing?  ');
            readln(buf);
            if(upcase(buf[1])='N') then finish
        end;
        year:=year+1
    end;
end.