Seed7: prg/hamu.sd7

"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 *)