
(********************************************************************)
(*                                                                  *)
(*  hamu.sd7      Game to govern the ancient kingdom of sumeria.    *)
(*  Copyright (C) 1990, 1991, 1992, 1993, 1994, 2004  Thomas Mertes *)
(*                                                                  *)
(*  This program is free software; you can redistribute it and/or   *)
(*  modify it under the terms of the GNU General Public License as  *)
(*  published by the Free Software Foundation; either version 2 of  *)
(*  the License, or (at your option) any later version.             *)
(*                                                                  *)
(*  This program is distributed in the hope that it will be useful, *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
(*  GNU General Public License for more details.                    *)
(*                                                                  *)
(*  You should have received a copy of the GNU General Public       *)
(*  License along with this program; if not, write to the           *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


$ include "seed7_05.s7i";
  include "stdio.s7i";


var boolean: fired is FALSE;
var integer: year is 0;
var integer: population is 0;
var integer: population_total is 0;
var integer: property_of_acres_soil is 0;
var integer: stock_of_bushels is 0;
var integer: immigrants is 0;
var integer: killed_by_desease is 0;
var integer: dead_this_year is 0;
var integer: dead_total is 0;
var integer: private_property is 0;


const proc: read_number (in string: prompt, inout integer: number, inout boolean: quit) is func

  local
    var string: stri is "";
    var boolean: okay is FALSE;

  begin (* read_number *)
    repeat
      write(prompt);
      read(stri);
      if stri = "" then
        number := 0;
        okay := TRUE;
      elsif upper(stri) = "Q" then
        quit := TRUE;
        okay := TRUE;
      else
        block
          number := integer parse stri;
          okay := TRUE;
        exception
          catch RANGE_ERROR:
            writeln("Please enter a number.");
        end block;
      end if;
    until okay;
    if not eoln(IN) then
      readln;
    end if;
  end func; (* read_number *)


const proc: title is func

  begin
    case rand(1, 12) of
      when { 1}: write("Hamurabi, ");
      when { 2}: write("My ruler, ");
      when { 3}: write("My prince, ");
      when { 4}: write("My king, ");
      when { 5}: write("Noble hamurabi, ");
      when { 6}: write("Noble ruler, ");
      when { 7}: write("Noble prince, ");
      when { 8}: write("Noble king, ");
      when { 9}: write("Great prince, ");
      when {10}: write("Great king, ");
      when {11}: write("Good prince, ");
      when {12}: write("Good king, ");
    end case;
  end func;


const proc: think_it_over is func

  begin (* think_it_over *)
    title;
    writeln("think it over.");
    write("You have only ");
  end func; (* think_it_over *)


const proc: init_game is func

  begin (* init_game *)
    fired := FALSE;
    year := 0;
    killed_by_desease := 0;
    dead_this_year := 0;
    dead_total := 0;
    population := 100;
    population_total := 0;
    immigrants := 0;
    stock_of_bushels := 3000;
    property_of_acres_soil := 1000;
    private_property := 0;
  end func; (* init_game *)


const proc: state_of_the_nation (
    in integer: profits_per_acre,
    in integer: destroyed_bushels) is func

  begin (* state_of_the_nation *)
    writeln;
    writeln;
    title;
    writeln("here is the report to the state of the nation in the year " <& year <& ":");
    writeln;
    if dead_this_year > 0 then
      writeln("people starved ........." <& dead_this_year lpad 6);
    end if;
    if killed_by_desease > 0 then
      writeln("died due to desease ...." <& killed_by_desease lpad 6);
    end if;
    if immigrants > 0 then
      writeln("immigrants ............." <& immigrants lpad 6);
    end if;
    writeln("population ............." <& population lpad 6);
    writeln("property of acres soil ." <& property_of_acres_soil lpad 6);
    if profits_per_acre > 0 then
      writeln("profits per acre ......." <& profits_per_acre lpad 6);
    end if;
    if destroyed_bushels > 0 then
      writeln("destroyed by rats ......" <& destroyed_bushels lpad 6);
    end if;
    writeln("stock of bushels corn .." <& stock_of_bushels lpad 6);
    if private_property > 0 then
      writeln("private property ......." <& private_property lpad 6);
    end if;
  end func; (* state_of_the_nation *)


const proc: buy_soil (
    in integer: price_per_acre,
    inout integer: buy_acres,
    inout integer: acres_soil,
    inout integer: bushels_corn,
    inout boolean: quit) is func

  local
    var boolean: input_ok is TRUE;

  begin (* buy_soil *)
    repeat
      input_ok := TRUE;
      writeln;
      writeln("Soil is traded with " <& price_per_acre <& " bushels per acre.");
      read_number("  How many acres soil do you want to buy: ",
          buy_acres, quit);
      if not quit and buy_acres > 0 then
        if buy_acres <= bushels_corn div price_per_acre then
          acres_soil +:= buy_acres;
          bushels_corn -:= price_per_acre * buy_acres;
        else
          input_ok := FALSE;
          think_it_over;
          writeln(bushels_corn <& " bushels corn!");
        end if;
      end if;
    until input_ok;
  end func; (* buy_soil *)


const proc: sell_soil (
    in integer: price_per_acre,
    inout integer: sell_acres,
    inout integer: acres_soil,
    inout integer: bushels_corn,
    inout boolean: quit) is func

  local
    var boolean: input_ok is TRUE;

  begin (* sell_soil *)
    repeat
      input_ok := TRUE;
      read_number("  How many acres soil do you want to sell: ",
          sell_acres, quit);
      if not quit and sell_acres > 0 then
        if sell_acres <= property_of_acres_soil then
          acres_soil -:= sell_acres;
          bushels_corn +:= price_per_acre * sell_acres;
        else
          input_ok := FALSE;
          think_it_over;
          writeln(acres_soil <& " acres soil!");
        end if;
      end if;
    until input_ok;
  end func; (* sell_soil *)


const proc: support_population (
    inout integer: public_assistance,
    inout integer: bushels_corn,
    inout boolean: quit) is func

  local
    var boolean: input_ok is TRUE;

  begin (* support_population *)
    if not quit then
      repeat
        input_ok := TRUE;
        read_number("  How many bushel corn do you give to the population as food: ",
            public_assistance, quit);
        if not quit then
          if public_assistance <= bushels_corn then
            bushels_corn -:= public_assistance;
          else
            input_ok := FALSE;
            think_it_over;
            writeln(bushels_corn <& " bushels corn!");
          end if;
        end if;
      until input_ok;
    end if;
  end func; (* support_population *)


const proc: cultivate_soil (
    inout integer: soil_to_work_on,
    in integer: acres_soil,
    inout integer: bushels_corn,
    inout boolean: quit) is func

  local
    var boolean: input_ok is TRUE;
    var integer: possible_to_work_on is 0;

  begin (* cultivate_soil *)
    if not quit then
      repeat
        input_ok := TRUE;
        read_number("  How many acres soil do you want to work on: ",
            soil_to_work_on, quit);
        if not quit then
          if acres_soil div 2 < bushels_corn then
            possible_to_work_on := acres_soil;
          else
            possible_to_work_on := bushels_corn * 2;
          end if;
          if (10 * population) < possible_to_work_on then
            possible_to_work_on := 10 * population;
          end if;
          if soil_to_work_on <= possible_to_work_on then
            bushels_corn -:= soil_to_work_on div 2;
          else
            input_ok := FALSE;
            think_it_over;
            if acres_soil = possible_to_work_on then
              writeln(acres_soil <& " acres soil!");
            else
              if (10 * population) = possible_to_work_on then
                writeln(population <& " persons to gather in the harvest!");
              else
                writeln(bushels_corn <& " bushels corn!");
              end if;
            end if;
          end if;
        end if;
      until input_ok;
    end if;
 end func; (* cultivate_soil *)


const proc: budget (
    in integer: price_per_acre,
    inout integer: public_assistance,
    inout integer: soil_to_work_on,
    inout boolean: quit) is func

  local
    var integer: acres_soil is 0;
    var integer: bushels_corn is 0;
    var integer: buy_acres is 0;
    var integer: sell_acres is 0;
    var string: answer is "";

  begin (* budget *)
    repeat
      acres_soil := property_of_acres_soil;
      bushels_corn := stock_of_bushels;
      buy_soil(price_per_acre, buy_acres, acres_soil, bushels_corn, quit);
      if not quit and buy_acres = 0 then
        sell_soil(price_per_acre, sell_acres, acres_soil, bushels_corn, quit);
      else
        sell_acres := 0;
      end if;
      support_population(public_assistance, bushels_corn, quit);
      cultivate_soil(soil_to_work_on, acres_soil, bushels_corn, quit);

      if not quit then
        writeln;
        title;
        writeln("in your budget you:");
        if buy_acres > 0 then
          writeln("  Buy " <& buy_acres <& " acres of soil for a price of " <& price_per_acre <& ".");
        elsif sell_acres > 0 then
          writeln("  Sell " <& sell_acres <& " acres of soil for a price of " <& price_per_acre <& ".");
        else
          writeln("  Do not trade with soil.");
        end if;
        writeln("  Support the population with " <& public_assistance <& " bushels corn.");
        writeln("  Cultivate " <& soil_to_work_on <& " acres of soil.");
        writeln;

        repeat
          write("Do you approve the budget for the year " <& succ(year) <& " (Yes/No/Quit)? ");
          readln(answer);
          answer := upper(answer);
          quit := answer = "Q";
        until answer = "Y" or answer = "N" or quit;
        if answer = "Y" then
          property_of_acres_soil := acres_soil;
          stock_of_bushels := bushels_corn;
        end if;
      end if;
    until answer = "Y" or quit;
  end func; (* budget *)


const proc: work_on_soil (
    in integer: soil_to_work_on,
    in integer: profits_per_acre,
    inout integer: destroyed_bushels,
    in boolean: quit) is func

  local
    var integer: bushels_harvest is 0;

  begin (* cultivate_soil *)
    if not quit then
      bushels_harvest := soil_to_work_on * profits_per_acre;
      if rand(0, 1) = 1 then
        destroyed_bushels := 0;
      else
        destroyed_bushels := stock_of_bushels div rand(1, 5);
      end if;
      stock_of_bushels +:= destroyed_bushels + bushels_harvest;
(*    private_property +:= (private_property * profits_per_acre) div price_per_acre; *)
    end if;
  end func; (* cultivate_soil *)


const proc: population_growth (
    inout integer: public_assistance,
    in boolean: quit) is func

  begin (* population_growth *)
    if not quit then
      incr(year);
      immigrants := rand(0, 9) *
          (property_of_acres_soil + private_property + stock_of_bushels div
          20) div (population * 5) + 1;
      population_total +:= population;
      killed_by_desease := 0;
      if population < public_assistance div 20 then
        dead_this_year := 0;
(*      private_property +:= ((public_assistance div 20) - population); *)
      else
        (* There was not enough food *)
        dead_this_year := population - public_assistance div 20;
        if dead_this_year > private_property then
          dead_this_year -:= private_property;
          private_property := 0;
        else
          dead_this_year := 0;
(*        private_property -:= dead_this_year; *)
        end if;
        if 100 * dead_this_year > 45 * population then
          writeln("You let die " <& dead_this_year <& " persons in one year.");
          writeln;
          if dead_this_year = population then
            writeln("Due to your crazy actions the whole population of your country died.");
            writeln("Fortunely you died also so it was not possible to lynch you.");
            writeln("Before the population died they prayed that you stay in the hell forever.");
          else
            writeln("Your are fired and accused of shameful mismanagement.");
            writeln("The people speak about you as the cretin of the century!");
            writeln("With the best lawyer you get a lifelong torture.");
            writeln("Pardon to a death penalty will in no case be possible.");
          end if;
          fired := TRUE;
          immigrants := 0;
        else
          if rand(1, 100) <= 15 then
            killed_by_desease := population div 2;
            population -:= killed_by_desease;
            writeln;
            writeln("There was a horrible desease!");
            writeln("Half of the population died.");
            writeln;
          end if;
        end if;
        population -:= dead_this_year;
        dead_total +:= dead_this_year;
      end if;
      population +:= immigrants;
    end if;
  end func; (* population_growth *)


const proc: statistics (in integer: percent_population, in integer: acres_per_person) is func

  begin (* statistics *)
    writeln;
    writeln("In your " <& year <& "-year rulership you let die an");
    writeln("average of " <& percent_population <& "% of your population.");
    writeln("Altogether " <& dead_total <& " persons died due to hunger.");
    writeln;
    if acres_per_person <> -1 then
      writeln("Your rulership started with 10 acres per head");
      writeln("and ends with " <& acres_per_person <& " acres per head.");
    end if;
    writeln;
  end func; (* statistics *)


const proc: evaluation (in integer: percent_population, in integer: acres_per_person) is func

  local
    var integer: population_factor is 0;
    var integer: acres_factor is 0;
    var integer: enemys_in_the_population is 0;

  begin (* evaluation *)
    if not fired then
      if percent_population > 20 then
        writeln("There is no word to describe you. The goal of the game is not to kill persons.");
        population_factor := 9;
      elsif percent_population > 10 then
        writeln("You act as a mass murderer. Your rating was better than that of stalin.");
        population_factor := 7;
      elsif percent_population > 6 then
        writeln("You are a really brutal butcher. Your rate is equal to Nero.");
        population_factor := 5;
      elsif percent_population > 3 then
        writeln("You have ice cool blood. Your rating is not good but may be worse.");
        population_factor := 3;
      elsif percent_population > 1 then
        writeln("You have provided almost enough food. Try to get better.");
        population_factor := 2;
      else
        writeln("You fought against hunger successful.");
        population_factor := 1;
      end if;
      if acres_per_person < 3 then
        writeln("You have absolutely no plan for the future.");
        acres_factor := 10;
      elsif acres_per_person < 5 then
        writeln("You sold out the country compleatly.");
        acres_factor := 9;
      elsif acres_per_person < 7 then
        writeln("You layed a very bad base for the future.");
        acres_factor := 7;
      elsif acres_per_person < 9 then
        writeln("The country has only little chances for the future.");
        acres_factor := 5;
      elsif acres_per_person < 11 then
        writeln("The country has a chance for the future.");
        acres_factor := 3;
      elsif acres_per_person < 13 then
        writeln("The future of the country has a good base.");
        acres_factor := 2;
      else
        writeln("The future in the country will be good.");
        acres_factor := 1;
      end if;
      enemys_in_the_population := population *
          rand(0, pred(population_factor * acres_factor)) div 100;
      if enemys_in_the_population > 0 then
        write(enemys_in_the_population <& " person");
        if enemys_in_the_population > 1 then
          write("s");
        end if;
        writeln(" would like to see you dead, but we all have our little problems.");
      end if;
    end if;
  end func; (* evaluation *)


const proc: final_report is func

  local
    var integer: percent_population is 0;
    var integer: acres_per_person is 0;

  begin (* final_report *)
    if year = 0 then
      writeln;
      writeln("Everybody should be able to rule at least one year.");
    else
(*    write("POP TOTAL " <& population_total);
      write("  dead_total " <& dead_total);
      write("  YEAR " <& year); *)
      percent_population := (dead_total * 100) div population_total;
      if population <> 0 then
        acres_per_person := property_of_acres_soil div population;
      else
        acres_per_person := -1;
      end if;
      statistics(percent_population, acres_per_person);
      evaluation(percent_population, acres_per_person);
    end if;
  end func; (* final_report *)


const proc: game is func

  local
    var integer: price_per_acre is 0;
    var integer: public_assistance is 0;
    var integer: soil_to_work_on is 0;
    var integer: profits_per_acre is 0;
    var integer: destroyed_bushels is 0;
    var boolean: quit is FALSE;

  begin (* game *)
    init_game();
    repeat
      state_of_the_nation(profits_per_acre, destroyed_bushels);
      price_per_acre := rand(17, 26);
      budget(price_per_acre, public_assistance, soil_to_work_on, quit);
      profits_per_acre := rand(1, 5);
      work_on_soil(soil_to_work_on, profits_per_acre, destroyed_bushels, quit);
      population_growth(public_assistance, quit);
    until quit or fired;
    final_report();
  end func; (* game *)


const proc: main is func

  local
    var string: answer is "";

  begin (* main *)
    writeln;
    writeln("HAMURABI - Where you govern the ancient kingdom of sumeria.");
    writeln("           To resign just type q and enter at any time.");
    repeat
      game;
      repeat
        writeln;
        write("Do you want to play again (Yes/No/Quit)? ");
        readln(answer);
        answer := upper(answer[.. 1]);
      until answer = "Y" or answer = "N" or answer = "Q";
    until answer = "N" or answer = "Q";
  end func; (* main *)
