"Fossies" - the Fresh Open Source Software Archive

Member "seed7/prg/hamu.sd7" (18 Dec 2019, 18762 Bytes) of package /linux/misc/seed7_05_20210223.tgz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 
    2 (********************************************************************)
    3 (*                                                                  *)
    4 (*  hamu.sd7      Game to govern the ancient kingdom of sumeria.    *)
    5 (*  Copyright (C) 1990, 1991, 1992, 1993, 1994, 2004  Thomas Mertes *)
    6 (*                                                                  *)
    7 (*  This program is free software; you can redistribute it and/or   *)
    8 (*  modify it under the terms of the GNU General Public License as  *)
    9 (*  published by the Free Software Foundation; either version 2 of  *)
   10 (*  the License, or (at your option) any later version.             *)
   11 (*                                                                  *)
   12 (*  This program is distributed in the hope that it will be useful, *)
   13 (*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
   14 (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
   15 (*  GNU General Public License for more details.                    *)
   16 (*                                                                  *)
   17 (*  You should have received a copy of the GNU General Public       *)
   18 (*  License along with this program; if not, write to the           *)
   19 (*  Free Software Foundation, Inc., 51 Franklin Street,             *)
   20 (*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
   21 (*                                                                  *)
   22 (********************************************************************)
   23 
   24 
   25 $ include "seed7_05.s7i";
   26   include "stdio.s7i";
   27 
   28 
   29 var boolean: fired is FALSE;
   30 var integer: year is 0;
   31 var integer: population is 0;
   32 var integer: population_total is 0;
   33 var integer: property_of_acres_soil is 0;
   34 var integer: stock_of_bushels is 0;
   35 var integer: immigrants is 0;
   36 var integer: killed_by_desease is 0;
   37 var integer: dead_this_year is 0;
   38 var integer: dead_total is 0;
   39 var integer: private_property is 0;
   40 
   41 
   42 const proc: read_number (in string: prompt, inout integer: number, inout boolean: quit) is func
   43 
   44   local
   45     var string: stri is "";
   46     var boolean: okay is FALSE;
   47 
   48   begin (* read_number *)
   49     repeat
   50       write(prompt);
   51       read(stri);
   52       if stri = "" then
   53         number := 0;
   54         okay := TRUE;
   55       elsif upper(stri) = "Q" then
   56         quit := TRUE;
   57         okay := TRUE;
   58       else
   59         block
   60           number := integer(stri);
   61           okay := TRUE;
   62         exception
   63           catch RANGE_ERROR:
   64             writeln("Please enter a number.");
   65         end block;
   66       end if;
   67     until okay;
   68     if not eoln(IN) then
   69       readln;
   70     end if;
   71   end func; (* read_number *)
   72 
   73 
   74 const proc: title is func
   75 
   76   begin
   77     case rand(1, 12) of
   78       when { 1}: write("Hamurabi, ");
   79       when { 2}: write("My ruler, ");
   80       when { 3}: write("My prince, ");
   81       when { 4}: write("My king, ");
   82       when { 5}: write("Noble hamurabi, ");
   83       when { 6}: write("Noble ruler, ");
   84       when { 7}: write("Noble prince, ");
   85       when { 8}: write("Noble king, ");
   86       when { 9}: write("Great prince, ");
   87       when {10}: write("Great king, ");
   88       when {11}: write("Good prince, ");
   89       when {12}: write("Good king, ");
   90     end case;
   91   end func;
   92 
   93 
   94 const proc: think_it_over is func
   95 
   96   begin (* think_it_over *)
   97     title;
   98     writeln("think it over.");
   99     write("You have only ");
  100   end func; (* think_it_over *)
  101 
  102 
  103 const proc: init_game is func
  104 
  105   begin (* init_game *)
  106     fired := FALSE;
  107     year := 0;
  108     killed_by_desease := 0;
  109     dead_this_year := 0;
  110     dead_total := 0;
  111     population := 100;
  112     population_total := 0;
  113     immigrants := 0;
  114     stock_of_bushels := 3000;
  115     property_of_acres_soil := 1000;
  116     private_property := 0;
  117   end func; (* init_game *)
  118 
  119 
  120 const proc: state_of_the_nation (
  121     in integer: profits_per_acre,
  122     in integer: destroyed_bushels) is func
  123 
  124   begin (* state_of_the_nation *)
  125     writeln;
  126     writeln;
  127     title;
  128     writeln("here is the report to the state of the nation in the year " <& year <& ":");
  129     writeln;
  130     if dead_this_year > 0 then
  131       writeln("people starved ........." <& dead_this_year lpad 6);
  132     end if;
  133     if killed_by_desease > 0 then
  134       writeln("died due to desease ...." <& killed_by_desease lpad 6);
  135     end if;
  136     if immigrants > 0 then
  137       writeln("immigrants ............." <& immigrants lpad 6);
  138     end if;
  139     writeln("population ............." <& population lpad 6);
  140     writeln("property of acres soil ." <& property_of_acres_soil lpad 6);
  141     if profits_per_acre > 0 then
  142       writeln("profits per acre ......." <& profits_per_acre lpad 6);
  143     end if;
  144     if destroyed_bushels > 0 then
  145       writeln("destroyed by rats ......" <& destroyed_bushels lpad 6);
  146     end if;
  147     writeln("stock of bushels corn .." <& stock_of_bushels lpad 6);
  148     if private_property > 0 then
  149       writeln("private property ......." <& private_property lpad 6);
  150     end if;
  151   end func; (* state_of_the_nation *)
  152 
  153 
  154 const proc: buy_soil (
  155     in integer: price_per_acre,
  156     inout integer: buy_acres,
  157     inout integer: acres_soil,
  158     inout integer: bushels_corn,
  159     inout boolean: quit) is func
  160 
  161   local
  162     var boolean: input_ok is TRUE;
  163 
  164   begin (* buy_soil *)
  165     repeat
  166       input_ok := TRUE;
  167       writeln;
  168       writeln("Soil is traded with " <& price_per_acre <& " bushels per acre.");
  169       read_number("  How many acres soil do you want to buy: ",
  170           buy_acres, quit);
  171       if not quit and buy_acres > 0 then
  172         if buy_acres <= bushels_corn div price_per_acre then
  173           acres_soil +:= buy_acres;
  174           bushels_corn -:= price_per_acre * buy_acres;
  175         else
  176           input_ok := FALSE;
  177           think_it_over;
  178           writeln(bushels_corn <& " bushels corn!");
  179         end if;
  180       end if;
  181     until input_ok;
  182   end func; (* buy_soil *)
  183 
  184 
  185 const proc: sell_soil (
  186     in integer: price_per_acre,
  187     inout integer: sell_acres,
  188     inout integer: acres_soil,
  189     inout integer: bushels_corn,
  190     inout boolean: quit) is func
  191 
  192   local
  193     var boolean: input_ok is TRUE;
  194 
  195   begin (* sell_soil *)
  196     repeat
  197       input_ok := TRUE;
  198       read_number("  How many acres soil do you want to sell: ",
  199           sell_acres, quit);
  200       if not quit and sell_acres > 0 then
  201         if sell_acres <= property_of_acres_soil then
  202           acres_soil -:= sell_acres;
  203           bushels_corn +:= price_per_acre * sell_acres;
  204         else
  205           input_ok := FALSE;
  206           think_it_over;
  207           writeln(acres_soil <& " acres soil!");
  208         end if;
  209       end if;
  210     until input_ok;
  211   end func; (* sell_soil *)
  212 
  213 
  214 const proc: support_population (
  215     inout integer: public_assistance,
  216     inout integer: bushels_corn,
  217     inout boolean: quit) is func
  218 
  219   local
  220     var boolean: input_ok is TRUE;
  221 
  222   begin (* support_population *)
  223     if not quit then
  224       repeat
  225         input_ok := TRUE;
  226         read_number("  How many bushel corn do you give to the population as food: ",
  227             public_assistance, quit);
  228         if not quit then
  229           if public_assistance <= bushels_corn then
  230             bushels_corn -:= public_assistance;
  231           else
  232             input_ok := FALSE;
  233             think_it_over;
  234             writeln(bushels_corn <& " bushels corn!");
  235           end if;
  236         end if;
  237       until input_ok;
  238     end if;
  239   end func; (* support_population *)
  240 
  241 
  242 const proc: cultivate_soil (
  243     inout integer: soil_to_work_on,
  244     in integer: acres_soil,
  245     inout integer: bushels_corn,
  246     inout boolean: quit) is func
  247 
  248   local
  249     var boolean: input_ok is TRUE;
  250     var integer: possible_to_work_on is 0;
  251 
  252   begin (* cultivate_soil *)
  253     if not quit then
  254       repeat
  255         input_ok := TRUE;
  256         read_number("  How many acres soil do you want to work on: ",
  257             soil_to_work_on, quit);
  258         if not quit then
  259           if acres_soil div 2 < bushels_corn then
  260             possible_to_work_on := acres_soil;
  261           else
  262             possible_to_work_on := bushels_corn * 2;
  263           end if;
  264           if (10 * population) < possible_to_work_on then
  265             possible_to_work_on := 10 * population;
  266           end if;
  267           if soil_to_work_on <= possible_to_work_on then
  268             bushels_corn -:= soil_to_work_on div 2;
  269           else
  270             input_ok := FALSE;
  271             think_it_over;
  272             if acres_soil = possible_to_work_on then
  273               writeln(acres_soil <& " acres soil!");
  274             else
  275               if (10 * population) = possible_to_work_on then
  276                 writeln(population <& " persons to gather in the harvest!");
  277               else
  278                 writeln(bushels_corn <& " bushels corn!");
  279               end if;
  280             end if;
  281           end if;
  282         end if;
  283       until input_ok;
  284     end if;
  285  end func; (* cultivate_soil *)
  286 
  287 
  288 const proc: budget (
  289     in integer: price_per_acre,
  290     inout integer: public_assistance,
  291     inout integer: soil_to_work_on,
  292     inout boolean: quit) is func
  293 
  294   local
  295     var integer: acres_soil is 0;
  296     var integer: bushels_corn is 0;
  297     var integer: buy_acres is 0;
  298     var integer: sell_acres is 0;
  299     var string: answer is "";
  300 
  301   begin (* budget *)
  302     repeat
  303       acres_soil := property_of_acres_soil;
  304       bushels_corn := stock_of_bushels;
  305       buy_soil(price_per_acre, buy_acres, acres_soil, bushels_corn, quit);
  306       if not quit and buy_acres = 0 then
  307         sell_soil(price_per_acre, sell_acres, acres_soil, bushels_corn, quit);
  308       else
  309         sell_acres := 0;
  310       end if;
  311       support_population(public_assistance, bushels_corn, quit);
  312       cultivate_soil(soil_to_work_on, acres_soil, bushels_corn, quit);
  313 
  314       if not quit then
  315         writeln;
  316         title;
  317         writeln("in your budget you:");
  318         if buy_acres > 0 then
  319           writeln("  Buy " <& buy_acres <& " acres of soil for a price of " <& price_per_acre <& ".");
  320         elsif sell_acres > 0 then
  321           writeln("  Sell " <& sell_acres <& " acres of soil for a price of " <& price_per_acre <& ".");
  322         else
  323           writeln("  Do not trade with soil.");
  324         end if;
  325         writeln("  Support the population with " <& public_assistance <& " bushels corn.");
  326         writeln("  Cultivate " <& soil_to_work_on <& " acres of soil.");
  327         writeln;
  328 
  329         repeat
  330           write("Do you approve the budget for the year " <& succ(year) <& " (Yes/No/Quit)? ");
  331           readln(answer);
  332           answer := upper(answer);
  333           quit := answer = "Q";
  334         until answer = "Y" or answer = "N" or quit;
  335         if answer = "Y" then
  336           property_of_acres_soil := acres_soil;
  337           stock_of_bushels := bushels_corn;
  338         end if;
  339       end if;
  340     until answer = "Y" or quit;
  341   end func; (* budget *)
  342 
  343 
  344 const proc: work_on_soil (
  345     in integer: soil_to_work_on,
  346     in integer: profits_per_acre,
  347     inout integer: destroyed_bushels,
  348     in boolean: quit) is func
  349 
  350   local
  351     var integer: bushels_harvest is 0;
  352 
  353   begin (* cultivate_soil *)
  354     if not quit then
  355       bushels_harvest := soil_to_work_on * profits_per_acre;
  356       if rand(0, 1) = 1 then
  357         destroyed_bushels := 0;
  358       else
  359         destroyed_bushels := stock_of_bushels div rand(1, 5);
  360       end if;
  361       stock_of_bushels +:= destroyed_bushels + bushels_harvest;
  362 (*    private_property +:= (private_property * profits_per_acre) div price_per_acre; *)
  363     end if;
  364   end func; (* cultivate_soil *)
  365 
  366 
  367 const proc: population_growth (
  368     inout integer: public_assistance,
  369     in boolean: quit) is func
  370 
  371   begin (* population_growth *)
  372     if not quit then
  373       incr(year);
  374       immigrants := rand(0, 9) *
  375           (property_of_acres_soil + private_property + stock_of_bushels div
  376           20) div (population * 5) + 1;
  377       population_total +:= population;
  378       killed_by_desease := 0;
  379       if population < public_assistance div 20 then
  380         dead_this_year := 0;
  381 (*      private_property +:= ((public_assistance div 20) - population); *)
  382       else
  383         (* There was not enough food *)
  384         dead_this_year := population - public_assistance div 20;
  385         if dead_this_year > private_property then
  386           dead_this_year -:= private_property;
  387           private_property := 0;
  388         else
  389           dead_this_year := 0;
  390 (*        private_property -:= dead_this_year; *)
  391         end if;
  392         if 100 * dead_this_year > 45 * population then
  393           writeln("You let die " <& dead_this_year <& " persons in one year.");
  394           writeln;
  395           if dead_this_year = population then
  396             writeln("Due to your crazy actions the whole population of your country died.");
  397             writeln("Fortunely you died also so it was not possible to lynch you.");
  398             writeln("Before the population died they prayed that you stay in the hell forever.");
  399           else
  400             writeln("Your are fired and accused of shameful mismanagement.");
  401             writeln("The people speak about you as the cretin of the century!");
  402             writeln("With the best lawyer you get a lifelong torture.");
  403             writeln("Pardon to a death penalty will in no case be possible.");
  404           end if;
  405           fired := TRUE;
  406           immigrants := 0;
  407         else
  408           if rand(1, 100) <= 15 then
  409             killed_by_desease := population div 2;
  410             population -:= killed_by_desease;
  411             writeln;
  412             writeln("There was a horrible desease!");
  413             writeln("Half of the population died.");
  414             writeln;
  415           end if;
  416         end if;
  417         population -:= dead_this_year;
  418         dead_total +:= dead_this_year;
  419       end if;
  420       population +:= immigrants;
  421     end if;
  422   end func; (* population_growth *)
  423 
  424 
  425 const proc: statistics (in integer: percent_population, in integer: acres_per_person) is func
  426 
  427   begin (* statistics *)
  428     writeln;
  429     writeln("In your " <& year <& "-year rulership you let die an");
  430     writeln("average of " <& percent_population <& "% of your population.");
  431     writeln("Altogether " <& dead_total <& " persons died due to hunger.");
  432     writeln;
  433     if acres_per_person <> -1 then
  434       writeln("Your rulership started with 10 acres per head");
  435       writeln("and ends with " <& acres_per_person <& " acres per head.");
  436     end if;
  437     writeln;
  438   end func; (* statistics *)
  439 
  440 
  441 const proc: evaluation (in integer: percent_population, in integer: acres_per_person) is func
  442 
  443   local
  444     var integer: population_factor is 0;
  445     var integer: acres_factor is 0;
  446     var integer: enemys_in_the_population is 0;
  447 
  448   begin (* evaluation *)
  449     if not fired then
  450       if percent_population > 20 then
  451         writeln("There is no word to describe you. The goal of the game is not to kill persons.");
  452         population_factor := 9;
  453       elsif percent_population > 10 then
  454         writeln("You act as a mass murderer. Your rating was better than that of stalin.");
  455         population_factor := 7;
  456       elsif percent_population > 6 then
  457         writeln("You are a really brutal butcher. Your rate is equal to Nero.");
  458         population_factor := 5;
  459       elsif percent_population > 3 then
  460         writeln("You have ice cool blood. Your rating is not good but may be worse.");
  461         population_factor := 3;
  462       elsif percent_population > 1 then
  463         writeln("You have provided almost enough food. Try to get better.");
  464         population_factor := 2;
  465       else
  466         writeln("You fought against hunger successful.");
  467         population_factor := 1;
  468       end if;
  469       if acres_per_person < 3 then
  470         writeln("You have absolutely no plan for the future.");
  471         acres_factor := 10;
  472       elsif acres_per_person < 5 then
  473         writeln("You sold out the country completely.");
  474         acres_factor := 9;
  475       elsif acres_per_person < 7 then
  476         writeln("You laid a very bad base for the future.");
  477         acres_factor := 7;
  478       elsif acres_per_person < 9 then
  479         writeln("The country has only little chances for the future.");
  480         acres_factor := 5;
  481       elsif acres_per_person < 11 then
  482         writeln("The country has a chance for the future.");
  483         acres_factor := 3;
  484       elsif acres_per_person < 13 then
  485         writeln("The future of the country has a good base.");
  486         acres_factor := 2;
  487       else
  488         writeln("The future in the country will be good.");
  489         acres_factor := 1;
  490       end if;
  491       enemys_in_the_population := population *
  492           rand(0, pred(population_factor * acres_factor)) div 100;
  493       if enemys_in_the_population > 0 then
  494         write(enemys_in_the_population <& " person");
  495         if enemys_in_the_population > 1 then
  496           write("s");
  497         end if;
  498         writeln(" would like to see you dead, but we all have our little problems.");
  499       end if;
  500     end if;
  501   end func; (* evaluation *)
  502 
  503 
  504 const proc: final_report is func
  505 
  506   local
  507     var integer: percent_population is 0;
  508     var integer: acres_per_person is 0;
  509 
  510   begin (* final_report *)
  511     if year = 0 then
  512       writeln;
  513       writeln("Everybody should be able to rule at least one year.");
  514     else
  515 (*    write("POP TOTAL " <& population_total);
  516       write("  dead_total " <& dead_total);
  517       write("  YEAR " <& year); *)
  518       percent_population := (dead_total * 100) div population_total;
  519       if population <> 0 then
  520         acres_per_person := property_of_acres_soil div population;
  521       else
  522         acres_per_person := -1;
  523       end if;
  524       statistics(percent_population, acres_per_person);
  525       evaluation(percent_population, acres_per_person);
  526     end if;
  527   end func; (* final_report *)
  528 
  529 
  530 const proc: game is func
  531 
  532   local
  533     var integer: price_per_acre is 0;
  534     var integer: public_assistance is 0;
  535     var integer: soil_to_work_on is 0;
  536     var integer: profits_per_acre is 0;
  537     var integer: destroyed_bushels is 0;
  538     var boolean: quit is FALSE;
  539 
  540   begin (* game *)
  541     init_game();
  542     repeat
  543       state_of_the_nation(profits_per_acre, destroyed_bushels);
  544       price_per_acre := rand(17, 26);
  545       budget(price_per_acre, public_assistance, soil_to_work_on, quit);
  546       profits_per_acre := rand(1, 5);
  547       work_on_soil(soil_to_work_on, profits_per_acre, destroyed_bushels, quit);
  548       population_growth(public_assistance, quit);
  549     until quit or fired;
  550     final_report();
  551   end func; (* game *)
  552 
  553 
  554 const proc: main is func
  555 
  556   local
  557     var string: answer is "";
  558 
  559   begin (* main *)
  560     writeln;
  561     writeln("HAMURABI - Where you govern the ancient kingdom of sumeria.");
  562     writeln("           To resign just type q and enter at any time.");
  563     repeat
  564       game;
  565       repeat
  566         writeln;
  567         write("Do you want to play again (Yes/No/Quit)? ");
  568         readln(answer);
  569         answer := upper(answer[.. 1]);
  570       until answer = "Y" or answer = "N" or answer = "Q";
  571     until answer = "N" or answer = "Q";
  572   end func; (* main *)