home *** CD-ROM | disk | FTP | other *** search
/ Die ASC Mega 2 / ASC-Mega2-CD-ROM.iso / SPIELE / KAISER / KAISER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-24  |  43.4 KB  |  1,567 lines
  1. program Kaiser; (* Version 4.1 *)
  2.  
  3. (*
  4.   Umsetzung des Programmes KAISER vom guten alten ATARI 800 XL, dort in
  5. ATARI BASIC geschrieben.
  6.  
  7.   Beginn:      26.12.1989
  8.  
  9.   Fortführung: ziemlich ununterbrochen bis Mitte April 1990
  10.  
  11.                02.06.1990 ab jetzt genaue Daten
  12.                23.06.1990
  13.                25.07.1990
  14.                03.08.1990
  15.                12.08.1990 (Start neue Grafikroutinen)
  16. *)
  17.  
  18. uses crt,dos,screen,kausgabe;
  19.  
  20. {$DEFINE notime}
  21. const TestSpiel = false; (* Standard: false *)
  22.       Rundenzeit = 5500; (* 1/100 Sekunden, die man Zeit hat für eine Runde. *
  23.                           * Braucht man länger, lebt man kürzer ...          *)
  24.       TimeOut = 50; (* Zeit, nach deren Verstreichen die Zufallsroutine des *
  25.                      * Grafikaufbaus abbricht.                              *)
  26.       MaxSpieler = 9;
  27.       MaxTitel = 9;
  28.       Titel: array [false..true,1..MaxTitel] of Titelstring =
  29.         (('Frau','Baronin','Landgräfin','Markgräfin','Fürstin','Herzogin',
  30.          'Großherzogin','Königin','Kaiserin'),
  31.         ('Herr','Baron','Landgraf','Markgraf','Fürst','Herzog',
  32.          'Großherzog','König','Kaiser'));
  33.       Reich: array [1..MaxTitel] of ReichString =
  34.         ('Preußen',  'Hessen', 'Bayern',   'Böhmen', 'Sachsen',
  35.          'Mähren',   'Tirol',  'der Pfalz','Flandern');
  36.       Ernteguete: array [1..5] of string[26] = (
  37.         'Dürre     Hungersnot droht',
  38.         'Regen      Schlechte Ernte',
  39.         '    Gewöhnliche  Ernte    ',
  40.         'Gutes Wetter  Reiche Ernte',
  41.         'Tolles Wetter  Rekordernte');
  42.       spiel_m: menue_typ = (xs:30;ys:20;xl:20;yl:2;at:att_spiel_m);
  43.       spiel_m_tx: array[1..2] of string[21] =
  44.         (' ^Altes Spiel laden  ','^Neues Spiel beginnen');
  45.       justiz_m: menue_typ = (xs:60;ys:19;xl:10;yl:4;at:att_justiz_m);
  46.       justiz_m_tx: array[1..4] of string[11] =
  47.         ('^Sehr fair ',
  48.          '^Bescheiden',
  49.          '^Hart      ',
  50.          '^Gierig    ');
  51.       justiztext: array[1..4] of string[10] =
  52.         ('Sehr fair ',
  53.          'Bescheiden',
  54.          'Hart      ',
  55.          'Gierig    ');
  56.       Mass = ' Maß';
  57.       Taler = ' Taler';
  58.       prz = ' %        ';
  59.       Schlecht = 'Wegen schlechter ';
  60.       politik = 'politik';
  61.       SpeicherHoehe = 15;
  62.       korn_m: menue_typ = (xs:53;ys:18;xl:20;yl:5;at:att_korn_m);
  63.       korn_m_tx: array[1..5] of string[21] =
  64.         ('    Korn kaufen     ',
  65.          '   Korn verkaufen   ',
  66.          '    Land kaufen     ',
  67.          '   Land verkaufen   ',
  68.          ' Zur Kornverteilung ');
  69.       zuteil_m: menue_typ = (xs:56;ys:19;xl:19;yl:4;at:att_zuteil_m);
  70.       zuteil_m_tx: array[1..4] of string[20] =
  71.         ('    Das Ma^ximum    ',
  72.          '    Das Mi^nimum    ',
  73.          '   Das ^Benötigte   ',
  74.          'Eine bestimmte ^Zahl');
  75.       einn_m: menue_typ = (xs:19;ys:17;xl:22;yl:5;at:att_einn_m);
  76.       einn_m_tx: array[1..5] of string[23] =
  77.         ('     ^Zoll ändern      ',
  78.          '^Mehrwertsteuer  ändern',
  79.          '^Einkommensteuer ändern',
  80.          '    ^Justiz ändern     ',
  81.          '        ^Weiter        ');
  82.       einkauf_m: menue_typ = (xs:23;ys:14;xl:34;yl:9;at:att_einkauf_m);
  83.       einkauf_m_tx: array[1..9] of string[35] =
  84.         ('Markt kaufen .......... 1000 Taler',
  85.          'Mühle kaufen .......... 2000 Taler',
  86.          'Palastteil kaufen ..... 5000 Taler',
  87.          'Kathedralenteil kaufen  9000 Taler',
  88.          '             ^Militär              ',
  89.          '       ^Spielstand anzeigen        ',
  90.          '           ^Karte malen            ',
  91.          '           Zug beenden            ',
  92.          'Spielstand speichern & Zug beenden');
  93.       militaer_m: menue_typ = (xs:29;ys:18;xl:22;yl:5;at:att_militaer_m);
  94.       militaer_m_tx: array[1..5] of string[23] =
  95.         (' Soldaten rekrutieren ',
  96.          '   Söldner anwerben   ',
  97.          ' Manöver veranstalten ',
  98.          '     Krieg führen     ',
  99.          'Zu den Staatseinkäufen');
  100.       rekrut_m: menue_typ = (xs:22;ys:18;xl:37;yl:4;at:att_rekrut_m);
  101.       rekrut_m_tx: array[1..4] of string[38] =
  102.         ('Eine Schwadron Kavallerie: ',
  103.          'Eine Batterie Artillerie:  ',
  104.          'Eine Kompanie Infanterie:  ',
  105.          '       Keine weiteren Truppen');
  106.       Stadt: array[0..3,0..4] of byte =
  107.         ((lo, hz,  hz,  hz,  ro),
  108.          (sk, leer,leer,leer,toro),
  109.          (sk, leer,leer,leer,toru),
  110.          (lu, hz,  hz,  hz,  ru));
  111.       Palace: array[1..16] of Bauwerktyp =
  112.         ((0,3,ZweiFenster),
  113.          (1,3,ZweiFenster),
  114.          (2,3,Tuerlinks),
  115.          (3,3,Tuerrechts),
  116.          (4,3,ZweiFenster),
  117.          (5,3,ZweiFenster),
  118.          (1,2,ZweiFenster),
  119.          (4,2,ZweiFenster),
  120.          (1,1,Kuppel),
  121.          (4,1,Kuppel),
  122.          (0,2,Spitzen),
  123.          (2,2,Spitzen),
  124.          (3,2,Spitzen),
  125.          (5,2,Spitzen),
  126.          (1,0,Fahne),
  127.          (4,0,Fahne));
  128.       Cathedral: array[1..14] of Bauwerktyp =
  129.         ((0,3,Tuerrechts),
  130.          (1,3,ZweiFenster),
  131.          (2,3,ZweiFenster),
  132.          (3,3,ZweiFenster),
  133.          (4,3,Tuerlinks),
  134.          (0,2,Kuppelfenster),
  135.          (2,2,ZweiFenster),
  136.          (4,2,Kuppelfenster),
  137.          (2,1,Kuppelfenster),
  138.          (1,2,Kreuz),
  139.          (3,2,Kreuz),
  140.          (0,1,Kreuz),
  141.          (4,1,Kreuz),
  142.          (2,0,Kreuz));
  143.  
  144. type RekrutArt = (Soldat, Soeldner);
  145.      intarray = array [1..MaxSpieler] of integer;
  146.      bytearray = array [1..MaxSpieler] of byte;
  147.  
  148. var Anzahl_Spieler, (* A3 *)
  149.     AmZug:          (* A2 *)   byte;
  150.     Zeit:           (* ZEIT *) word;
  151.  
  152.     Name:          (* NAME$ *) array [1..MaxSpieler] of NamenString;
  153.     Maennlich:     (* A7 *)    array [1..MaxSpieler] of boolean;
  154.     VarGSTL,       (* GSTL *)
  155.     Tod,           (* TOD *)
  156.     EnthobenBis:   (* B8 *)    array [1..MaxSpieler] of word;
  157.     Rang,          (* RANG *)
  158.     Land,          (* A9 *)
  159.     Geld,          (* A8 *)
  160.     Korn:          (* KORN *)  array [1..MaxSpieler] of longint;
  161.     Punkte,        (* STND *)
  162.     Maerkte,       (* B3 *)
  163.     Muehlen,       (* B4 *)
  164.     Palast,        (* B5 *)
  165.     Kathedrale,    (* B6 *)
  166.     Justiz,        (* B2 *)
  167.     Zoll,          (* ZOLL *)
  168.     MwSt,          (* MWST *)
  169.     EkSt:          (* EKST *)  bytearray;
  170.     VarWSFT,       (* WSFT *)
  171.     Haeuser,       (* H *)
  172.     VarKFA:        (* KFA *)   array [1..MaxSpieler] of real;
  173.     Soldpflichtig, (* SOL *)
  174.     Miliz,         (* MIL *)
  175.     Einwohner,     (* B1 *)
  176.     Artillerie,    (* OFF *)
  177.     Infanterie,    (* DEF *)
  178.     Reiter,        (* REI *)
  179.     Soldaten:      (* B7 *)    intarray;
  180.  
  181.     feind_m:    menue_typ;
  182.     feind_m_tx: array[1..maxspieler] of string[41];
  183.  
  184.  
  185. procedure Speichern;
  186.  
  187. var Spieler: byte;
  188.     Zeichen: char;
  189.  
  190. (* Zeile 10000- *)
  191. begin
  192.   Miliz[AmZug] := ( Maerkte[AmZug] div 5) * 2;
  193.   rewrite(j);
  194.   writeln(j, Anzahl_Spieler );
  195.   writeln(j, AmZug          );
  196.   writeln(j, Zeit           );
  197.   for Spieler := 1 to Anzahl_Spieler do begin
  198.     writeln(j, Name[Spieler]      );
  199.     writeln(j, Land[Spieler]      );
  200.     writeln(j, Geld[Spieler]      );
  201.     writeln(j, Rang[Spieler]      );
  202.     writeln(j, Einwohner[Spieler] );
  203.     writeln(j, Korn[Spieler]      );
  204.     writeln(j, Zoll[Spieler]      );
  205.     writeln(j, MwSt[Spieler]      );
  206.     writeln(j, EkSt[Spieler]      );
  207.     writeln(j, Justiz[Spieler]    );
  208.     writeln(j, Tod[Spieler]       );
  209.     writeln(j, Maerkte[Spieler]   );
  210.     writeln(j, Muehlen[Spieler]   );
  211.     writeln(j, Palast[Spieler]    );
  212.     writeln(j, Kathedrale[Spieler]);
  213.     writeln(j, Soldaten[Spieler]  );
  214.     writeln(j, VarGSTL[Spieler]   );
  215.     writeln(j, Punkte[Spieler]    );
  216.     writeln(j, int( VarWSFT[Spieler] ));
  217.     writeln(j, Haeuser[Spieler]   );
  218.     writeln(j, Miliz[Spieler]     );
  219.     writeln(j, abs( Artillerie[Spieler]) );
  220.     writeln(j, abs( Infanterie[Spieler]) );
  221.     writeln(j, abs( Reiter[Spieler]) );
  222.     writeln(j, EnthobenBis[Spieler] );
  223.     writeln(j, int( VarKFA[Spieler] * 100) / 100);
  224.     writeln(j, Soldpflichtig[Spieler] );
  225.     if Maennlich[Spieler] then
  226.       writeln(j, 'M')
  227.     else
  228.       writeln(j, 'W')
  229.   end;
  230.   close(j)
  231. end;
  232.  
  233. function Laden: boolean;
  234.  
  235. var Spieler: byte;
  236.     Zeichen: char;
  237.  
  238. (* Zeile 10900- *)
  239. begin
  240.   reset(j);
  241.   readln(j, Anzahl_Spieler );
  242.   readln(j, AmZug          );
  243.   readln(j, Zeit           );
  244.   for Spieler := 1 to Anzahl_Spieler do begin
  245.     readln(j, Name[Spieler]      );
  246.     readln(j, Land[Spieler]      );
  247.     readln(j, Geld[Spieler]      );
  248.     readln(j, Rang[Spieler]      );
  249.     readln(j, Einwohner[Spieler] );
  250.     readln(j, Korn[Spieler]      );
  251.     readln(j, Zoll[Spieler]      );
  252.     readln(j, MwSt[Spieler]      );
  253.     readln(j, EkSt[Spieler]      );
  254.     readln(j, Justiz[Spieler]    );
  255.     readln(j, Tod[Spieler]       );
  256.     readln(j, Maerkte[Spieler]   );
  257.     readln(j, Muehlen[Spieler]   );
  258.     readln(j, Palast[Spieler]    );
  259.     readln(j, Kathedrale[Spieler]);
  260.     readln(j, Soldaten[Spieler]  );
  261.     readln(j, VarGSTL[Spieler]   );
  262.     readln(j, Punkte[Spieler]    );
  263.     readln(j, VarWSFT[Spieler]   );
  264.     readln(j, Haeuser[Spieler]   );
  265.     readln(j, Miliz[Spieler]     );
  266.     readln(j, Artillerie[Spieler] );
  267.     readln(j, Infanterie[Spieler] );
  268.     readln(j, Reiter[Spieler]    );
  269.     readln(j, EnthobenBis[Spieler] );
  270.     readln(j, VarKFA[Spieler]    );
  271.     readln(j, Soldpflichtig[Spieler] );
  272.     readln(j, Zeichen);
  273.     if Zeichen = 'M' then
  274.       Maennlich[Spieler] := true
  275.     else
  276.       Maennlich[Spieler] := false
  277.   end;
  278.   close(j);
  279.   Laden := IOResult = 0
  280. end;
  281.  
  282.  
  283.  
  284.  
  285. procedure Neues_oder_altes_Spiel;
  286.  
  287. var Spieler:    1..MaxSpieler;
  288.     Taste:      char;
  289.     Auswahl:    byte;
  290.     OK:         boolean;
  291.     SaveSpiel:  PathStr;
  292.  
  293. procedure Grundwerte;
  294.  
  295. (* Zeile 110- *)
  296.  
  297. var Spieler: 1..MaxSpieler;
  298.  
  299. begin
  300.   AmZug := 0;
  301.   Zeit := 1700;
  302.   for Spieler := 1 to Anzahl_Spieler do begin
  303.     Land[Spieler] := 10000;
  304.     if TestSpiel then
  305.       Geld[Spieler] := 1000000
  306.     else
  307.       Geld[Spieler] := 15000;
  308.     Rang[Spieler] := 1;
  309.     Einwohner[Spieler] := 2000;
  310.     Korn[Spieler] := 10000;
  311.     Zoll[Spieler] := 25;
  312.     MwSt[Spieler] := 10;
  313.     EkSt[Spieler] := 5;
  314.     Justiz[Spieler] := 2;
  315.     Tod[Spieler] := 1760;
  316.     Maerkte[Spieler] := 0;
  317.     Muehlen[Spieler] := 0;
  318.     Palast[Spieler] := 0;
  319.     Kathedrale[Spieler] := 0;
  320.     Soldaten[Spieler] := 20;
  321.     Punkte[Spieler] := 4;
  322.     VarGSTL[Spieler] := 5;
  323.     VarWSFT[Spieler] := 25;
  324.     Haeuser[Spieler] := 1;
  325.     EnthobenBis[Spieler] := 1700;
  326.     VarKFA[Spieler] := 1;
  327.     Artillerie[Spieler] := 0;
  328.     Infanterie[Spieler] := 1;
  329.     Miliz[Spieler] := 1;
  330.     Reiter[Spieler] := 0;
  331.     Soldpflichtig[Spieler] := 0;
  332.   end
  333. end;
  334.  
  335. procedure CLS;
  336. begin
  337.   Clear(1,78,3,23,ord(crt_screen^[0,0,1]))
  338. end;
  339.  
  340.  
  341. procedure NeuesSpiel;
  342. var Spieler: byte;
  343. begin
  344.   OK := false;
  345.   repeat
  346.     Anzahl_Spieler := Eingabe(1, 'Wieviele Spieler wollen mitspielen ?');
  347.     if Anzahl_Spieler = 0 then Exit
  348.   until Anzahl_Spieler in [1..MaxSpieler];
  349.   for Spieler := 1 to Anzahl_Spieler do begin
  350.     CLS;
  351.     wrm(10,40,att[att_tit_back],'Wie heißt der Herrscher von '+Reich[Spieler]+' ?');
  352.     Name[Spieler] := EingCapStr(20);
  353.     if Name[Spieler] = '' then Exit;
  354.     CLS;
  355.     wrm(10,40,att[att_tit_back],'Ist '+Name[Spieler]+' von '+Reich[Spieler] +
  356.                 ' männlich oder weiblich (M/W) ?');
  357.     repeat
  358.       Taste := UpperCase(Readkey);
  359.       if Taste = #27 then Exit;
  360.       if Taste = #0 then begin
  361.         taste:=readkey;
  362.         taste:=#0
  363.       end
  364.     until Taste in ['M','W'];
  365.     Maennlich[Spieler] := (Taste = 'M')
  366.   end;
  367.   Grundwerte;
  368.   repeat
  369.     CLS;
  370.     wrm(10,40,att[att_tit_back],'Unter welchem Namen soll das Spiel gespeichert werden ?');
  371.     SaveSpiel := EingFilename;
  372.     if SaveSpiel = '' then Exit;
  373.     SaveSpiel := SaveSpiel + Extension;
  374.     wrm(13,40,att[att_tit_schr],SaveSpiel);
  375.     assign(j, SaveSpiel);
  376.     reset(j);
  377.     close(j);
  378.     if IOResult = 0 then begin
  379.       wrm(16,40,att[att_tit_back],'Ein gespeichertes Spiel dieses Namens existiert schon.');
  380.       wrm(17,40,att[att_tit_back],'Soll es überschrieben werden (J/N) ?');
  381.       OK := ja
  382.     end
  383.     else
  384.       OK := true
  385.   until OK
  386. end;
  387.  
  388.  
  389. begin (* Neues oder altes Spiel ? *)
  390.  
  391. (* Zeile 35- *)
  392.  
  393.   repeat
  394.     TitelSchirm;
  395.     repeat
  396.       auswahl:=2;
  397.       waehlen (@spiel_m,auswahl);
  398.     until auswahl<>0;
  399.     if Auswahl=2 then begin
  400.       NeuesSpiel;
  401.       if OK then Speichern
  402.     end
  403.     else begin
  404.       SaveSpiel := FileSelect('*' + Extension, SavePath);
  405.       if SaveSpiel <> '' then begin
  406.         assign(j, SaveSpiel);
  407.         OK := Laden end
  408.       else
  409.         OK := false
  410.     end
  411.   until OK
  412. end;
  413.  
  414.  
  415. procedure Spiel;
  416. (* Der Hauptteil des Programms *)
  417.  
  418. var Faul,        (* FAUL *)
  419.     Ernte:       (* C5 *)     byte;
  420.     Noetig,      (* NOETIG *)
  421.     VarI,        (* I *)
  422.     VarJ,        (* J *)
  423.     KornGekauft, (* C6 *)
  424.     Landpreis,   (* C7 *)
  425.     Kornpreis,   (* C8 *)
  426.     VarFR,       (* FR *)
  427.     VarFR2:      (* FR2 *)    real;
  428.     Menge,       (* MENGE *)
  429.     KavallPreis, (* KP *)
  430.     ArtillPreis, (* AP *)
  431.     InfantPreis: (* IP *)     longint;
  432.  
  433.     Startzeit, Endzeit: longint;
  434.  
  435.     Bankrott, SchlechtePolitik, KaiserF, EndeF, Save, KriegGefuehrt: boolean;
  436.  
  437.  
  438.  
  439. function GanzerName(Spieler: byte): MaxString;
  440. begin
  441.   GanzerName := Titel[Maennlich[Spieler],Rang[Spieler]] +
  442.                 ' ' + Name[Spieler] +
  443.                 ' von ' + Reich[Spieler]
  444. end;
  445.  
  446.  
  447. procedure NameUndJahr (att: byte);
  448. begin
  449.   Rahmen (att);
  450.   wr(1,2,att,GanzerName(AmZug));
  451.   wr(1,51,att,'Wir schreiben das Jahr '+Strg(Zeit));
  452. end;
  453.  
  454.  
  455. procedure GrNameUndJahr;
  456. var s: maxstring;
  457. begin
  458.   OpenGraph;
  459.   rectangle(0,0,XWeite, 13);
  460.   OutText(1,3,GanzerName(AmZug));
  461.   s:='Wir schreiben das Jahr '+Strg(Zeit);
  462.   OutText((xweite shr 3)-length(s)-1,3,s)
  463. end;
  464.  
  465.  
  466. procedure AnzahlMilitaer;
  467. (* Zeile 11111 *)
  468. begin
  469.   Miliz[AmZug] := round( int( Maerkte[AmZug] / 5) * 2);
  470.   if Miliz[AmZug] > round( int( Muehlen[AmZug] / 3) * 2) then
  471.     Miliz[AmZug] := round( int( Muehlen[AmZug] / 3) * 2);
  472.   Soldaten[AmZug] := (Reiter[AmZug] + Artillerie[AmZug] + Infanterie[AmZug] +
  473.                       Miliz[AmZug]) * 20;
  474.   if Soldpflichtig[AmZug] > Soldaten[AmZug] then
  475.     Soldpflichtig[AmZug] := Soldaten[AmZug] - Miliz[AmZug];
  476.   if Soldpflichtig[AmZug] < 0 then
  477.     Soldpflichtig[AmZug] := 0;
  478.   if Soldaten[AmZug] < 20 then begin
  479.     Soldaten[AmZug] := 20;
  480.     Infanterie[AmZug] := 1;
  481.     Reiter[AmZug] := 0;
  482.     Artillerie[AmZug] := 0
  483.   end
  484. end;
  485.  
  486.  
  487. procedure BerechneErnte;
  488.  
  489. procedure BerechneNoetig;
  490.  
  491. (* Zeile 3000- *)
  492. begin
  493.   Noetig := round( abs( int( Punkte[AmZug] * 100 + VarGSTL[AmZug] * 40 +
  494.             VarWSFT[AmZug] * 30 + Einwohner[AmZug] * 5 +
  495.             Soldaten[AmZug] * 10)));
  496.   if VarJ < 1 then
  497.     VarFR := 2
  498.   else begin
  499.     VarFR := Noetig / VarJ;
  500.     if VarFR > 2 then
  501.       VarFR := 2
  502.   end;
  503.   if VarFR < 0.8 then
  504.     VarFR := 0.8;
  505.   Landpreis := int( 10 * Landpreis * VarFR) / 10
  506. end;
  507.  
  508.  
  509. (* Zeile 1003- *)
  510. begin (* Berechne Ernte *)
  511.   Ernte := random(5) + 1;
  512.   KornGekauft := 0;
  513.   VarFR2 := Land[AmZug];
  514.   VarFR := (Einwohner[AmZug] - Muehlen[AmZug] * 100) * 5;
  515.   if VarFR < 0 then
  516.     VarFR := 0;
  517.   If VarFR < VarFR2 then
  518.     VarFR2 := VarFR;
  519.   repeat
  520.     VarFR := Korn[AmZug] * 2;
  521.     if VarFR < VarFR2 then
  522.       VarFR2 := VarFR;
  523.     VarFR := Ernte - 0.5;
  524.     VarJ := VarFR2 * VarFR;
  525.     Korn[AmZug] := Korn[AmZug] + round( int( VarJ ));
  526.     Landpreis := (3 * Ernte + 12 + random(12)) / 10;
  527.     StartZeit := MomentZeit;
  528.     BerechneNoetig;
  529.     Faul := random(50) + 1;
  530.     Korn[AmZug] := round( int( Korn[AmZug] * (1 - Faul/100 )));
  531.     Kornpreis := int((( 6 - Ernte) * 3 + (random(10) + 2)) *8 * VarFR)
  532.   until Kornpreis >= 1
  533. end;
  534.  
  535. procedure KornUndLand;
  536.  
  537. var Auswahl,Y: byte;
  538.  
  539. procedure Bildschirm; (* Korn und Land *)
  540.  
  541. var Y: byte;
  542.  
  543. procedure SpeicherFuellen;
  544.  
  545. var WieVoll: (* B *)   real;
  546.     Hoehe, Zaehler,x:  byte;
  547.  
  548. (* Zeile 1080- *)
  549. begin
  550.   box(all_single_box,3,6,20,1+SpeicherHoehe,att[att_speicher],att[att_speicher]);
  551.   wr(6,2,att[att_speicher],'▄▄▄▄▄▄▄▄████████▄▄▄▄▄▄▄▄');
  552.   WieVoll := abs( Korn[AmZug] * 0.8 / Noetig);
  553.   if WieVoll > 1 then
  554.     WieVoll := 1;
  555.   Hoehe := round( Int( WieVoll * Speicherhoehe));
  556.   if Hoehe > 0 then
  557.     for Zaehler := 7+Speicherhoehe downto 7+Speicherhoehe-Hoehe do
  558.       for x:=4 to 23 do
  559.         crt_screen^[Zaehler,x,0] := '█';
  560.   wr(4,3,att[att_speicher],'Sie haben '+Strg(round( int( WieVoll * 100)))+
  561.            '% des benötigten Kornes.')
  562. end;
  563.  
  564. (* Zeile 1014- *)
  565. begin (* Bildschirm Korn und Land *)
  566.   NameUndJahr (att[att_korn_b]);
  567.   wr(4,48,att[att_speicher],Strg(Faul)+'% Ihrer Ernte sind verfault.');
  568.   wr(6,50,att[att_korn_s],Ernteguete[Ernte]);
  569.   wr(8,49,att[att_korn_s],'Kornreserve:  '+StrgR(Korn[AmZug],8)+Mass);
  570.   wr(9,49,att[att_korn_s],'Nötiges Korn: '+StrgR(round(Noetig),8)+Mass);
  571.   wr(10,49,att[att_korn_s],'Kornpreis:    '+StrgR(round(Kornpreis),8)+Taler);
  572.   wr(12,49,att[att_korn_s],'Landpreis:    '+StrgR(round(Landpreis*10),8)+Taler);
  573.   wr(13,49,att[att_korn_s],'Landbesitz:   '+StrgR(Land[AmZug],8)+' Hektar');
  574.   wr(15,49,att[att_korn_s],'Vermögen:     '+StrgR(Geld[AmZug],8)+Taler);
  575.   SpeicherFuellen
  576. end;
  577.  
  578.  
  579. procedure KornKaufen;
  580.  
  581. var Zahl : longint;
  582. (* Zeile 1110- *)
  583. begin
  584.   Zahl := Eingabe(6, 'Wieviel Korn wollen Sie kaufen ?');
  585.   VarFR2 := Noetig * 3;
  586.   If KornGekauft + Zahl > VarFR2 then begin
  587.     Hinweis('Vorräte erschöpft !!!');
  588.     Zahl := round( VarFR2 - KornGekauft)
  589.   end;
  590.   KornGekauft := KornGekauft + Zahl;
  591.   Korn[AmZug] := Korn[AmZug] + Zahl;
  592.   Geld[AmZug] := Geld[AmZug] - round( Zahl * Kornpreis / 1000 )
  593. end;
  594.  
  595. procedure KornVerkaufen;
  596.  
  597. var Zahl: longint;
  598. (* Zeile 1120- *)
  599. begin
  600.   Zahl := Eingabe(6, 'Wieviel Korn wollen Sie verkaufen ?');
  601.   if Zahl <= Korn[AmZug] then begin
  602.     KornGekauft := Korngekauft - Zahl;
  603.     Korn[AmZug] := Korn[AmZug] - Zahl;
  604.     Geld[AmZug] := Geld[AmZug] + round( Kornpreis * Zahl / 1111)
  605.   end
  606. end;
  607.  
  608.  
  609. procedure Landkaufen;
  610.  
  611. var Zahl: longint;
  612. (* Zeile 1130- *)
  613. begin
  614.   Zahl := Eingabe(5, 'Wieviel Hektar Land wollen Sie kaufen ?');
  615.   Land[AmZug] := Land[AmZug] + Zahl;
  616.   Geld[AmZug] := Geld[AmZug] - round( Zahl * Landpreis)
  617. end;
  618.  
  619.  
  620. procedure LandVerkaufen;
  621.  
  622. var Zahl: longint;
  623. (* Zeile 1140- *)
  624. begin
  625.   Zahl := Eingabe(5,'Wieviel Hektar Land wollen Sie verkaufen ?');
  626.   if Zahl <= Land[AmZug] then begin
  627.     Land[AmZug] := Land[AmZug] - Zahl;
  628.     Geld[AmZug] := Geld[AmZug] + round( Zahl * Landpreis * 0.9)
  629.   end
  630. end;
  631.  
  632.  
  633. procedure Kornzuteilung;
  634. var x,y:    byte;
  635.     s1,s2:  string[5];
  636.     Fertig: boolean;
  637. begin
  638.   Bildschirm;
  639.   box(all_single_box,27,17,25,5,att[att_zuteil_b],att[att_zuteil_b]);
  640.   wrm(18,40,att[att_zuteil_b],'Sie müssen Ihrem Volk');
  641.   wrm(19,40,att[att_zuteil_b],'20 - 80% Ihrer Reserven');
  642.   wrm(20,40,att[att_zuteil_b],'zuteilen.');
  643.   s1:=strg(korn[amzug] div 5); s2:=strg((korn[amzug]*8) div 10);
  644.   x:=40-(8+length(s1)+length(s2)) div 2;
  645.   wr(22,x,att[att_zuteil_b],'(');
  646.   wr(22,x+1,att[att_zuteil_s],s1);
  647.   wr(22,x+2+length(s1),att[att_zuteil_b],'-');
  648.   wr(22,x+4+length(s1),att[att_zuteil_s],s2);
  649.   wr(22,x+5+length(s1)+length(s2),att[att_zuteil_b],'Maß)');
  650.   auswahl:=4;
  651.   Fertig := false;
  652.   repeat
  653.     repeat
  654.       if auswahl=0 then auswahl:=4;
  655.       waehlen (@zuteil_m,auswahl);
  656.     until auswahl<>0;
  657.     case auswahl of
  658.       1: Menge := (Korn[AmZug] * 8) div 10;
  659.       2: Menge := Korn[AmZug] div 5;
  660.       3: Menge := round(Noetig);
  661.       4: Menge := Eingabe(6,'Wieviel Korn wollen Sie Ihrem Volk zuteilen?')
  662.     end;
  663.     if Menge > (Korn[AmZug] * 8) div 10 then
  664.       Hinweis('Das ist zu viel !!!')
  665.     else
  666.       if Menge < Korn[AmZug] div 5 then
  667.         Hinweis('Das ist zu wenig !!!')
  668.       else
  669.         Fertig := True
  670.   until Fertig;
  671.   Korn[AmZug] := Korn[AmZug] - Menge;
  672.   VarFR := Menge / Noetig - 1;
  673. end;
  674.  
  675.  
  676.  
  677.  
  678. begin (* Korn und Land *)
  679.   auswahl:=1;
  680.   repeat
  681.     Bildschirm;
  682.     waehlen (@korn_m,auswahl);
  683.     case Auswahl of
  684.       1: KornKaufen;
  685.       2: KornVerkaufen;
  686.       3: Landkaufen;
  687.       4: LandVerkaufen
  688.     end
  689.   until Auswahl in [0,5];
  690.   Kornzuteilung
  691. end;
  692.  
  693.  
  694. procedure Uebersicht;
  695.  
  696. var Geboren, Gestorben,
  697.     Einwanderer,
  698.     Staatsopfer,
  699.     Marktverdienst,
  700.     Muehlenverdienst,
  701.     Sold:             word;
  702.  
  703. procedure Bildschirm;
  704. begin
  705.   NameUndJahr (att[att_uebers]);
  706. end;
  707.  
  708. Function TodGeburt(VarVAR: real): word;
  709. (* Zeile 3100- *)
  710. begin
  711.   TodGeburt := round(int( (random * VarVAR + 1) * Einwohner[AmZug] / 100))
  712. end;
  713.  
  714. procedure Opfer;
  715. (* Zeile 3140- *)
  716. begin
  717.    Staatsopfer := round( int((random + 2) * Einwohner[AmZug] / 100 *
  718.                          sqr( Justiz[AmZug] - 2)))
  719. end;
  720.  
  721.  
  722. (* Zeile 1360- *)
  723. begin (* Übersicht *)
  724.   Bildschirm;
  725.   Staatsopfer := 0;
  726.   Einwanderer := 0;
  727.   if Menge >= (Noetig - 1) then begin
  728.     Geboren := TodGeburt(7);
  729.     Gestorben := TodGeburt(3);
  730.     if MwSt[AmZug] < random(20) +1 then
  731.       Punkte[AmZug] := Punkte[AmZug] + random(2);
  732.     if EkSt[AmZug] < random(20) + 1 then
  733.       VarGSTL[AmZug] := VarGSTL[AmZug] + random(3);
  734.     if Menge >= round (Noetig * (1.1 + random * 0.4)) then begin
  735.       VarFR := Einwohner[AmZug] / 7;
  736.       VarFR2 := ((Menge - Noetig) / Noetig * 10) * VarFR * (random(65) + 2);
  737.       if VarFR2 > Einwohner[AmZug] / 10 then
  738.         VarFR2 := int( Einwohner[AmZug] / 10);
  739.       VarFR2 := int((random * VarFR2 + 2) * (1.1 - MwSt[AmZug] / 100) *
  740.                 (1.1 - Zoll[AmZug] / 100) * (1.1 - EkSt[AmZug] / 100));
  741.       Einwanderer := round( VarFR2);
  742.       VarFR2 := random * VarFR2 / 5 + 1;
  743.       if VarFR2 > 50 then
  744.         VarFR2 := 50;
  745.       VarWSFT[AmZug] := VarWSFT[AmZug] + VarFR2;
  746.       Punkte[AmZug] := Punkte[AmZug] + 1;
  747.       VarGSTL[AmZug] := VarGSTL[AmZug] + 2
  748.     end;
  749.     if (Justiz[AmZug] > 2) or (90 - Zoll[AmZug] - MwSt[AmZug] - EkSt[AmZug]
  750.                                < 0) then Opfer end
  751.  
  752.   else begin
  753. (* Zeile 1420- *)
  754.     VarJ := (Noetig - Menge) / Noetig * 100 - 9;
  755.     VarI := VarJ;
  756.     if VarJ > 65 then VarJ := 65;
  757.     if VarJ < 0 then
  758.       VarJ := 0; VarI := 0;
  759.     Geboren := TodGeburt(3);
  760.     Gestorben := TodGeburt(VarI + 8);
  761.     Opfer
  762.   end;
  763.   wrm(8,40,att[att_uebers],Numerus(Geboren,'Einwohner wurde','n')+' heuer geboren.');
  764.   wrm(10,40,att[att_uebers],Numerus(Gestorben,'Einwohner starb','en')+' heuer.');
  765.   if Einwanderer > 0 then
  766.     wrm(13,40,att[att_uebers],Numerus(Einwanderer,'Einwanderer kam','en')+' heuer.');
  767.   if Staatsopfer > 0 then
  768.     wrm(15,40,att[att_uebers],Numerus(Staatsopfer,'Opfer des Staatshaushaltes verließ',
  769.                 'en')+' das Land.');
  770.   Einwohner[AmZug] := Einwohner[AmZug]
  771.                          + Geboren - Gestorben + Einwanderer - Staatsopfer;
  772.   Marktverdienst := Maerkte[AmZug] * ( 127 + random(127));
  773.   Muehlenverdienst := Muehlen[AmZug] * ( 250 + random(250));
  774.   Sold := round( Soldaten[AmZug] * 3 + Soldpflichtig[AmZug] * 12 );
  775.   if Marktverdienst > 0 then
  776.     wrm(18,40,att[att_uebers],'An Ihren Märkten verdienten Sie '+Strg(Marktverdienst)+Taler+'.');
  777.   if Muehlenverdienst > 0 then
  778.     wrm(20,40,att[att_uebers],'Ihre Mühlen erwirtschafteten '+Strg(Muehlenverdienst)+Taler+'.');
  779.   wrm(22,40,att[att_uebers],'Ihre Armee erhielt Sold in Höhe von '+Strg(Sold)+Taler+'n.');
  780.   Geld[AmZug] := Geld[AmZug] + Marktverdienst + Muehlenverdienst - Sold;
  781.   Taste_Druecken
  782. end;
  783.  
  784.  
  785.  
  786. procedure Einnahmen;
  787.  
  788. var VarFACA, (* FACA *)
  789.     VarFACB, (* FACB *)
  790.     VarFACC, (* FACC *)
  791.     VarFACD, (* FACD *)
  792.     VarFACE: (* FACE *) real;
  793.  
  794.     EinnMwSt,
  795.     EinnEkSt,
  796.     EinnZoll,
  797.     EinnJustiz,
  798.     EinnTotal:  longint;
  799.  
  800.     Auswahl: byte;
  801.  
  802. procedure Berechnen;
  803.  
  804. (* Zeile 3400- *)
  805. begin
  806.   VarFR := VarFACE - Zoll[AmZug] - MwSt[AmZug] - EkSt[AmZug];
  807.   VarFR2 := int (( Punkte[AmZug] * 180 + Rang[AmZug] * 75 + VarWSFT[AmZug] *
  808.                 20) * ( VarFR / 100) + Haeuser[AmZug] * 100);
  809.   VarJ := int (( Punkte[AmZug] * 50 + VarWSFT[AmZug] * 75 + Haeuser[AmZug] * 10)
  810.               * (VarFR / 100) * (5 - Justiz[AmZug]) / 2);
  811.   VarI := int ( Punkte[AmZug] * 250 + Haeuser[AmZug] * 20 +
  812.               (10 * Justiz[AmZug] * Punkte[AmZug]) * (VarFR / 100));
  813.   EinnZoll := round( int ( VarFR2 * Zoll[AmZug] * VarFACA));
  814.   EinnMwSt := round( int( VarJ * MwSt[AmZug] * VarFACB ));
  815.   EinnEkSt := round( int( VarI * EkSt[AmZug] * VarFACC ));
  816.   EinnJustiz := round( int(( Justiz[AmZug] * 300 - 500) * Rang[AmZug] *
  817.                 VarFACD));
  818.   EinnTotal := EinnZoll + EinnMwSt + EinnEkSt + EinnJustiz
  819. end;
  820.  
  821. procedure Bildschirm;
  822. var y: byte;
  823. (* Zeile 1518- *)
  824. begin
  825.   wrm(4,40,att[att_einn_tit],' STAATSEINNAHMEN ');
  826.   wrm(7,40,att[att_einn_s], 'Zoll:              '+prz+taler);
  827.   wr(7,40,att[att_einn_z],strgr(zoll[amzug],2));
  828.   wr(7,47,att[att_einn_z],strgr(einnzoll,5));
  829.   wrm(9,40,att[att_einn_s], 'Mehrwertsteuer:    '+prz+taler);
  830.   wr(9,40,att[att_einn_z],strgr(mwst[amzug],2));
  831.   wr(9,47,att[att_einn_z],strgr(einnmwst,5));
  832.   wrm(11,40,att[att_einn_s],'Einkommensteuer:   '+prz+taler);
  833.   wr(11,40,att[att_einn_z],strgr(ekst[amzug],2));
  834.   wr(11,47,att[att_einn_z],strgr(einnekst,5));
  835.   wrm(13,40,att[att_einn_s],'Justiz:                      '+taler);
  836.   wr(13,34,att[att_einn_z],justiztext[justiz[amzug]]);
  837.   wr(13,47,att[att_einn_z],strgr(einnjustiz,5));
  838.   wr(14,46,att[att_einn_s],'─────────────');
  839.   wr(15,47,att[att_einn_z],strgr(einntotal,5));
  840.   wr(15,52,att[att_einn_s],taler);
  841.   wr(16,46,att[att_einn_s],'═════════════');
  842. end;
  843.  
  844.  
  845. procedure JustizAendern;
  846. var neu: byte;
  847. begin
  848.   neu:=justiz[amzug];
  849.   waehlen (@justiz_m,neu);
  850.   if neu>0 then justiz[amzug]:=neu;
  851. end;
  852.  
  853.  
  854.  
  855. (* Zeile 1499- *)
  856. begin
  857.   VarFR := Einwohner[AmZug] / 100;
  858.   VarFACA := VarFR / ( random * 3000 + 2500 );
  859.   VarFACB := VarFR / ( random * 4000 + 2000 );
  860.   VarFACC := VarFR / ( random * 2000 + 3000 );
  861.   VarFACD := VarFR / ( random * 3000 + 2500 ) * 100;
  862.   VarFACE := int( 70 + random * 82 );
  863.   Auswahl := 5;
  864.   repeat
  865.     Berechnen;
  866.     NameUndJahr (att[att_einn_s]);
  867.     Bildschirm;
  868.     waehlen (@einn_m,auswahl);
  869.     case Auswahl of
  870.       1: begin
  871.            Zoll[AmZug] := Eingabe(2,'Zoll');
  872.            Auswahl := 2
  873.          end;
  874.       2: begin
  875.            MwSt[AmZug] := Eingabe(2,'Mehrwertsteuer');
  876.            Auswahl := 3
  877.          end;
  878.       3: begin
  879.            EkSt[AmZug] := Eingabe(2,'Einkommensteuer');
  880.            Auswahl := 4
  881.          end;
  882.       4: Justizaendern;
  883.     end
  884.   until Auswahl in [0,5];
  885.   Geld[AmZug] := Geld[AmZug] + EinnTotal
  886. end;
  887.  
  888. procedure Spielertod;
  889.  
  890. var y: byte;
  891.  
  892. (* 7000- *)
  893. begin
  894.   Rahmen (norm);
  895.   save:=cfg.autosave;
  896.   wrm (40,1,inv,'EINE SEHR SCHLECHTE NACHRICHT');
  897.   wrm (40,20,inv,' '+GanzerName(AmZug)+' ');
  898.   for y:=4 to 18 do setattr(y,38,5,inv);
  899.   for y:=8 to 9 do setattr(y,32,17,inv);
  900.   wrm(22,40,norm,'ist leider verstorben.');
  901.   Taste_Druecken;
  902.   Tod[AmZug] := 1;
  903.   for y:=1 to Anzahl_Spieler do
  904.     if Tod[y] > 1700 then exit;
  905.   EndeF := true;
  906.   Hinweis('SPIELENDE');
  907. end;
  908.  
  909.  
  910. procedure TestBankrott;
  911. (* Zeile 4900- *)
  912. begin
  913.   Bankrott := false;
  914.   if Geld[AmZug] < round(-10000*Rang[AmZug]*int(8+random(6))/10) then begin
  915.     Bankrott := true;
  916.     save:=cfg.autosave;
  917.     Geld[AmZug] := Geld[AmZug] + Kathedrale[AmZug] * 2500
  918.                                + Palast[AmZug]     * 1500
  919.                                + Muehlen[AmZug]    * 1000
  920.                                + Maerkte[AmZug]    * 500;
  921.     Kathedrale[AmZug] := 0;
  922.     Palast[AmZug]     := 0;
  923.     Muehlen[AmZug]    := 0;
  924.     Maerkte[AmZug]    := 0;
  925.     Soldpflichtig[AmZug] := Soldpflichtig[AmZug] div 2;
  926.     VarKFA[AmZug] := VarKFA[AmZug] * 0.5;
  927.     if Land[AmZug] > 3000 then begin
  928.       Land[AmZug] := Land[AmZug] - 3000;
  929.       Geld[AmZug] := Geld[AmZug] + round(Land[AmZug]*Landpreis*0.8);
  930.       Land[AmZug] := 3000
  931.     end;
  932.     if Geld[AmZug] > 0 then begin
  933.       Land[AmZug] := Land[AmZug] + round(Geld[AmZug]/Landpreis);
  934.       Geld[AmZug] := 0
  935.     end;
  936.     Tod[AmZug] := Tod[AmZug] - 2;
  937.     if Tod[AmZug] < Zeit + 1 then
  938.       Spielertod
  939.     else begin
  940.       NameUndJahr (att[att_nachr]);
  941.       wrm(10,40,att[att_nachr],'Sie sind leider bankrott');
  942.       wrm(12,40,att[att_nachr],'Gläubiger haben große Teile Ihres');
  943.       wrm(13,40,att[att_nachr],'Besitzes gepfändet.');
  944.       if cfg.soundf then NachrichtSound;
  945.       Taste_Druecken
  946.     end
  947.   end
  948. end;
  949.  
  950. procedure TestPolitik;
  951. (* Zeile 1575- *)
  952. begin
  953.   SchlechtePolitik := false;
  954.   if (Land[AmZug] < Einwohner[AmZug]) or (Einwohner[AmZug] < 500) then begin
  955.     SchlechtePolitik := true;
  956.     save:=cfg.autosave;
  957.     EnthobenBis[AmZug] := Zeit + 2;
  958.     NameUndJahr (att[att_nachr]);
  959.     if Land[AmZug] < Einwohner[AmZug] then
  960.       wrm(12,40,att[att_nachr],Schlecht+'Land'+politik)
  961.     else begin
  962.       wrm(12,40,att[att_nachr],Schlecht+'Einwohner'+politik);
  963.       Einwohner[AmZug] := 500
  964.     end;
  965.     wrm(14,40,att[att_nachr],'sind Sie 1 Jahr Ihres Amtes');
  966.     wrm(15,40,att[att_nachr],'enthoben worden.');
  967.     if cfg.soundf then NachrichtSound;
  968.     Taste_Druecken
  969.   end
  970. end;
  971.  
  972. procedure Landmangel;
  973.  
  974. var Platz, Markt, Muehle: integer;
  975.     Palas, Kath:          boolean;
  976.  
  977. (* Zeile 1580 / 6100- *)
  978. begin
  979.   KavallPreis := 3680 + 2 * random(256);
  980.   ArtillPreis := 2300 + 2 * random(256);
  981.   InfantPreis := 1500 + 2 * random(128);
  982.   Platz := Land[AmZug] div 1000;
  983.   Markt := 0;
  984.   Muehle := 0;
  985.   Palas := false;
  986.   Kath := false;
  987.   if Maerkte[AmZug] > Platz then
  988.     Markt := Maerkte[AmZug] - Platz;
  989.   if Muehlen[AmZug] > Platz then
  990.     Muehle := Muehlen[AmZug] - Platz;
  991.   Palas := ((Platz < 12) and (Palast[AmZug] > 0));
  992.   Kath := ((Platz < 24) and (Kathedrale[AmZug] > 0));
  993.   if (Markt + Muehle > 0) or Palas or Kath then begin
  994.     NameUndJahr (att[att_nachr]);
  995.     save:=cfg.autosave;
  996.     wrm(5,40,att[att_nachr],'Sie haben wegen Landmangels folgende Gebäude verloren:');
  997.     if Markt > 0 then begin
  998.       Maerkte[AmZug] := Maerkte[AmZug] - Markt;
  999.       wrm(8,40,att[att_nachr],sgpl(markt,'Markt','Märkte'))
  1000.     end;
  1001.     if Muehle > 0 then begin
  1002.       Muehlen[AmZug] := Muehlen[AmZug] - Muehle;
  1003.       wrm(10,40,att[att_nachr],numerus(muehle,'Mühle','n'))
  1004.     end;
  1005.     if Palas then begin
  1006.       Palast[AmZug] := 0;
  1007.       wrm(12,40,att[att_nachr],'Ihren Palast')
  1008.     end;
  1009.     if Kath then begin
  1010.       Kathedrale[AmZug] := 0;
  1011.       wrm(14,40,att[att_nachr],'Ihre Kathedrale')
  1012.     end;
  1013.     Taste_Druecken
  1014.   end
  1015. end;
  1016.  
  1017.  
  1018. procedure Einkaeufe;
  1019.  
  1020. var Auswahl: byte;
  1021.  
  1022. procedure NeuesBild;
  1023. var y: byte;
  1024. begin
  1025.   NameUndJahr (att[att_einkauf_s]);
  1026.   wrm(4,40,att[att_einkauf_tit],' STAATSEINKÄUFE ');
  1027. end;
  1028.  
  1029.  
  1030. procedure Bildschirm;
  1031. var Platz: string[11];
  1032. begin
  1033.   Platz:=' (max. '+Strg(Land[AmZug] div 1000)+')';
  1034.   clear(1,78,6,12,att[att_einkauf_s]);
  1035.   wrm(6,40,att[att_einkauf_s],'Sie besitzen: '+StrgR(Geld[AmZug],6)+Taler);
  1036.   wrm(8,40,att[att_einkauf_s],SgPl(Maerkte[AmZug],'Markt','Märkte')+Platz);
  1037.   wrm(9,40,att[att_einkauf_s],Numerus(Muehlen[AmZug],'Mühle','n')+Platz);
  1038.   wrm(11,40,att[att_einkauf_s],Strg(Palast[AmZug])+' von 16 Palastteilen');
  1039.   wrm(12,40,att[att_einkauf_s],Strg(Kathedrale[AmZug])+' von 14 Kathedralenteilen')
  1040. end;
  1041.  
  1042. procedure Bauland;
  1043. begin
  1044.   Hinweis('Zu wenig Bauland !!!')
  1045. end;
  1046.  
  1047.  
  1048. procedure MarktKaufen;
  1049. (* Zeile 1626- *)
  1050. begin
  1051.   if Maerkte[AmZug] > Land[AmZug] div 1000 - 1 then
  1052.     Bauland
  1053.   else begin
  1054.     inc(Maerkte[AmZug]);
  1055.     Geld[AmZug] := Geld[AmZug] - 1000;
  1056.     Haeuser[AmZug] := Haeuser[AmZug] + 1;
  1057.     AnzahlMilitaer
  1058.   end
  1059. end;
  1060.  
  1061. procedure MuehleKaufen;
  1062. (* Zeile 1630- *)
  1063. begin
  1064.   if Muehlen[AmZug] > Land[AmZug] div 1000 - 1 then
  1065.     Bauland
  1066.   else begin
  1067.     inc(Muehlen[AmZug]);
  1068.     Geld[AmZug] := Geld[AmZug] - 2000;
  1069.     Haeuser[AmZug] := Haeuser[AmZug] + 0.25;
  1070.     AnzahlMilitaer
  1071.   end
  1072. end;
  1073.  
  1074. procedure PalastKaufen;
  1075. (* Zeile 1640- *)
  1076. begin
  1077.   if (Land[AmZug] < 13000) or (Palast[AmZug] > 15) then
  1078.     Bauland
  1079.   else begin
  1080.     inc(Palast[AmZug]);
  1081.     Geld[AmZug] := Geld[AmZug] - 5000;
  1082.     Haeuser[AmZug] := Haeuser[AmZug] + 0.5
  1083.   end
  1084. end;
  1085.  
  1086. procedure KathKaufen;
  1087. (* Zeile 1650- *)
  1088. begin
  1089.   if (Land[AmZug] < 25000) or (Kathedrale[AmZug] > 13) then
  1090.     Bauland
  1091.   else begin
  1092.     inc(Kathedrale[AmZug]);
  1093.     Geld[AmZug] := Geld[AmZug] - 9000;
  1094.     Haeuser[AmZug] := Haeuser[AmZug] + 1;
  1095.     VarGSTL[AmZug] := VarGSTL[AmZug] + 1 + random(6)
  1096.   end
  1097. end;
  1098.  
  1099. procedure Spielstand;
  1100. var y,Spieler: byte;
  1101.  
  1102. begin
  1103.   Rahmen (att[att_spielst_s]);
  1104.   wrm(1,40,att[att_spielst_tit],' SPIELSTAND ');
  1105.   wrm(4,40,att[att_spielst_tit],
  1106.     ' Name                          Punkte  Soldaten  Land   Geld    Einwohner ');
  1107.   for Spieler:=1 to Anzahl_Spieler do begin
  1108.     y:= Spieler * 2 + 5;
  1109.     if Tod[Spieler] < Zeit then
  1110.       wr(y-1,4,att[att_spielst_s],GanzerName(Spieler)+' (verstorben)')
  1111.     else
  1112.       wr(y-1,4,att[att_spielst_s],GanzerName(Spieler));
  1113.     wr(y,34,att[att_spielst_s],StrgR(Punkte[Spieler],2) + '     ' +
  1114.               StrgR(Soldaten[Spieler],4) + '       ' +
  1115.               StrgR(Land[Spieler],5) + '  ' +
  1116.               StrgR(Geld[Spieler],6) + '  ' +
  1117.               StrgR(Einwohner[Spieler],4));
  1118.  
  1119.   end;
  1120.   Taste_Druecken
  1121. end;
  1122.  
  1123.  
  1124. procedure Karte;
  1125.  
  1126. var LRand, ORand:          word;
  1127.     RRand, URand, Groesse: byte;
  1128.     Feld:                  array[0..44, 0..21] of boolean;
  1129.     Taste:                 char;
  1130.     KeinPlatz:             boolean;
  1131.  
  1132.  
  1133. procedure Grenzen;
  1134. var x,y: byte;
  1135. begin
  1136.   midtext(17,'Bitte eine Taste !!!');
  1137.   Groesse := round( int( Land[AmZug] / 1000));
  1138.   if Groesse > 35 then
  1139.     Groesse := 35;
  1140.   LRand := (succ(XWeite)-(Groesse shl 4)) div 2;
  1141.   RRand := Groesse;
  1142.   ORand := 32;
  1143.   URand := (YWeite-ORand-17) div 16;
  1144.   rectangle
  1145.         (LRand - 4, ORand - 4, LRand + RRand*16+3, ORand + URand * 16 + 3);
  1146.   for x:= 0 to RRand - 1 do
  1147.     for y:= 0 to URand -1 do
  1148.       Feld[x,y] := false;
  1149. end;
  1150.  
  1151.  
  1152. procedure Plot(x,y, ZNummer: byte);
  1153. begin
  1154.   Mal((LRand+(x shl 4)) shr 3,ORand+(y shl 4),ZNummer);
  1155.   Feld[x,y]:=true
  1156. end;
  1157.  
  1158.  
  1159. function Empty(x1,x2,y1,y2: byte): boolean;
  1160. var x,y: byte;
  1161. begin
  1162.   Empty := false;
  1163.   for x:=x1 to x2 do
  1164.     for y:=y1 to y2 do
  1165.       if Feld[x,y] then Exit;
  1166.   Empty := true
  1167. end;
  1168.  
  1169.  
  1170. procedure Zufall(xl, yl: byte; var x,y: byte);
  1171. var Zeit: longint;
  1172. begin
  1173.   Zeit := MomentZeit;
  1174.   KeinPlatz := false;
  1175.   repeat
  1176.     x := random(RRand - xl + 1);
  1177.     y := random(URand - yl + 1)
  1178.   until Empty(x, x+xl-1, y, y+yl-1) or (Zeit + TimeOut < Momentzeit);
  1179.   if Momentzeit > Zeit + TimeOut then
  1180.     KeinPlatz := true
  1181. end;
  1182.  
  1183.  
  1184. procedure Malpalast;
  1185. var nr: byte;
  1186. begin
  1187.   for nr:=1 to Palast[AmZug] do
  1188.     Plot(Palace[nr,0]+6,Palace[nr,1]+1,Palace[nr,2])
  1189. end;
  1190.  
  1191. procedure MalKathedrale;
  1192. var nr: byte;
  1193. begin
  1194.   for nr:=1 to Kathedrale[AmZug] do
  1195.     Plot(Cathedral[nr,0]+19,Cathedral[nr,1]+URand-5,Cathedral[nr,2])
  1196. end;
  1197.  
  1198.  
  1199. procedure MalMarkt;
  1200. var x, y, x1, y1, Staedte, Hoefe, Nr: byte;
  1201.  
  1202. begin
  1203.   Hoefe := min(Maerkte[AmZug], 35);
  1204.   Staedte := min( Hoefe div 5, Muehlen[AmZug] div 3);
  1205.   Hoefe := Hoefe - Staedte * 5;
  1206.   if Staedte > 0 then begin
  1207.     for nr:=1 to Staedte do begin
  1208.       Zufall(5,4,x1,y1);
  1209.       for x:=0 to 4 do
  1210.         for y:=0 to 3 do
  1211.           if not ((x=3) and (y=2)) then
  1212.             if ((x in [1..3]) and (y in [1..2]))
  1213.               then Plot(x1+x, y1+y, ZMarkt + random(3))
  1214.               else Plot(x1+x, y1+y, Stadt[y,x]);
  1215.     end;
  1216.   end;
  1217.   if Hoefe > 0 then
  1218.     for nr:=1 to Hoefe do begin
  1219.       Zufall(1,1,x,y);
  1220.       plot(x,y,ZMarkt + random(3))
  1221.     end
  1222. end;
  1223.  
  1224.  
  1225. procedure MalMuehle;
  1226. var x, y, nr: byte;
  1227. begin
  1228.   for nr:=1 to min(Muehlen[AmZug], 35) do begin
  1229.     Zufall(1,1,x,y);
  1230.     plot(x,y,ZMuehle)
  1231.   end
  1232. end;
  1233.  
  1234.  
  1235. procedure Baeume;
  1236. var x, y, z, nr: byte;
  1237. begin
  1238.   for nr := 1 to min(Land[AmZug] div 1500, 23) do begin
  1239.     Zufall(1,1,x,y);
  1240.     if random(2) = 0 then
  1241.       plot(x,y,Laubbaum)
  1242.     else
  1243.       plot(x,y,Tanne)
  1244.   end;
  1245.   nr := min( abs(Geld[AmZug]*XWeite) div 3200000 + 1, XWeite div 32);
  1246.   if nr > 0 then begin
  1247.     if Geld[Amzug] > 0 then z:=GeldSack
  1248.                        else z:=SchuldBrief;
  1249.       for x:= 0 to nr - 1 do
  1250.         Mal(x*2, YWeite - 15, z)
  1251.   end;
  1252.   nr := min( (Einwohner[AmZug]*XWeite) div 192000, XWeite div 32);
  1253.   for x:=0 to nr-1 do
  1254.     Mal(XWeite div 16 + x * 2, YWeite-15, Mensch)
  1255. end;
  1256.  
  1257. procedure Malen;
  1258. begin
  1259.   if Palast[AmZug] > 0 then
  1260.     MalPalast;
  1261.   if Kathedrale[AmZug] > 0 then
  1262.     MalKathedrale;
  1263.   if Maerkte[AmZug] > 0 then begin
  1264.     MalMarkt;
  1265.     if KeinPlatz then Exit
  1266.   end;
  1267.   if Muehlen[AmZug] > 0 then begin
  1268.     MalMuehle;
  1269.     if KeinPlatz then Exit
  1270.   end;
  1271.   Baeume
  1272. end;
  1273.  
  1274.  
  1275.  
  1276.  
  1277. (* Zeile 5000- *)
  1278. begin (* Karte *)
  1279.   repeat
  1280.     GrNameUndJahr;
  1281.     Grenzen;
  1282.     Malen
  1283.   until not KeinPlatz;
  1284.   Taste:=ReadKey; if taste=#0 then taste:=readkey;
  1285.   ShutGraph
  1286. end;
  1287.  
  1288.  
  1289. procedure Militaer;
  1290.  
  1291. var y,auswahl: byte;
  1292.  
  1293. procedure ZeigeZahlen;
  1294. begin
  1295.   Clear(1,78,6,10,att[att_milit_s]);
  1296.   wrm(6,40,att[att_milit_s],'Sie besitzen:   '+Strg(Geld[Amzug])+Taler);
  1297.   wrm(8,40,att[att_milit_s],Numerus(Reiter[AmZug],'Schwadron','en')+' Kavallerie');
  1298.   wrm(9,40,att[att_milit_s],Numerus(Artillerie[AmZug],'Batterie','n')+' Artillerie');
  1299.   wrm(10,40,att[att_milit_s],Numerus(Infanterie[AmZug],'Kompanie','n')+' Infanterie')
  1300. end;
  1301.  
  1302. procedure Loesch;
  1303. begin
  1304.   Clear(1,78,11,23,att[att_milit_s])
  1305. end;
  1306.  
  1307. procedure Rekrutieren(Art: RekrutArt);
  1308.  
  1309. var KavPreis, ArtPreis, InfPreis: longint;
  1310.     y,Auswahl:                    byte;
  1311.  
  1312. function ZuViele: boolean;
  1313. var Flag: boolean;
  1314. begin
  1315.   Flag := (Einwohner[AmZug] / (Soldaten[AmZug] - Soldpflichtig[AmZug] + 1)
  1316.                                                                       <= 7)
  1317.              and (Art = Soldat);
  1318.   if Flag then
  1319.     Hinweis('Zu viele Soldaten !!!');
  1320.   ZuViele := Flag
  1321. end;
  1322.  
  1323. procedure Anwerben(Preis: longint; var Truppe: integer);
  1324. begin
  1325.   dec( Geld[AmZug], Preis );
  1326.   inc( Truppe );
  1327.   AnzahlMilitaer;
  1328.   if Art = Soldat then
  1329.     dec( Einwohner[AmZug], 20)
  1330.   else begin
  1331.     inc( Soldpflichtig[AmZug], 20);
  1332.     VarKFA[AmZug] := (VarKFA[AmZug]*(Soldaten[AmZug]+20.0))
  1333.                      / Soldaten[AmZug]
  1334.   end;
  1335.   VarKFA[AmZug] := (20*(VarKFA[AmZug]*(Soldaten[AmZug]/20.0-1)+1))
  1336.                    / Soldaten[Amzug];
  1337. end;
  1338.  
  1339.  
  1340.  
  1341. (* Zeile 4091- *)
  1342. begin (* Rekrutieren *)
  1343.   if not ZuViele then begin
  1344.     KavPreis := KavallPreis + 600;
  1345.     ArtPreis := ArtillPreis + 400;
  1346.     InfPreis := InfantPreis + 200;
  1347.     if Art = Soeldner then begin
  1348.       inc( KavPreis, KavallPreis div 2 );
  1349.       inc( ArtPreis, ArtillPreis div 2 );
  1350.       inc( InfPreis, InfantPreis div 2 )
  1351.     end;
  1352.     Loesch;
  1353.     rekrut_m_tx[1]:=copy(rekrut_m_tx[1],1,27)+StrgR(KavPreis,4)+Taler;
  1354.     rekrut_m_tx[2]:=copy(rekrut_m_tx[2],1,27)+StrgR(artPreis,4)+Taler;
  1355.     rekrut_m_tx[3]:=copy(rekrut_m_tx[3],1,27)+StrgR(infPreis,4)+Taler;
  1356.     Auswahl := 4;
  1357.     repeat
  1358.       ZeigeZahlen;
  1359.       waehlen (@rekrut_m,auswahl);
  1360.       case Auswahl of
  1361.         1: Anwerben(KavPreis, Reiter[AmZug]);
  1362.         2: Anwerben(ArtPreis, Artillerie[AmZug]);
  1363.         3: Anwerben(InfPreis, Infanterie[AmZug])
  1364.       end
  1365.     until (auswahl in [0,4]) or ZuViele;
  1366.     Loesch
  1367.   end
  1368. end;
  1369.  
  1370.  
  1371. procedure Manoever;
  1372. begin
  1373.   dec( Geld[AmZug], 4 * Soldaten[AmZug] + 1000);
  1374.   VarKFA[AmZug] := VarKFA[AmZug] + 0.1;
  1375.   if cfg.SoundF then sound(40);
  1376.   warte(50);
  1377.   nosound
  1378. end;
  1379.  
  1380. {$I KRIEG}
  1381.  
  1382.  
  1383. (* Zeile 4000- *)
  1384. begin (* Militär *)
  1385.   if Anzahl_Spieler = 1 then
  1386.     Hinweis('Wozu ?')
  1387.   else begin
  1388.     Auswahl:=5;
  1389.     repeat
  1390.       NameUndJahr (att[att_milit_s]);
  1391.       wrm(4,40,att[att_milit_tit],' MILITÄR ');
  1392.       repeat
  1393.         ZeigeZahlen;
  1394.         waehlen(@militaer_m,auswahl);
  1395.         case Auswahl of
  1396.           1: Rekrutieren(Soldat);
  1397.           2: Rekrutieren(Soeldner);
  1398.           3: Manoever;
  1399.           4: Krieg
  1400.         end;
  1401.         TestBankrott
  1402.       until (auswahl in [0,4,5]) or Bankrott or KriegGefuehrt
  1403.     until krieggefuehrt or (Auswahl<>4)
  1404.   end
  1405. end;
  1406.  
  1407. (* Zeile 1600- *)
  1408. begin  (* Einkäufe *)
  1409.   Karte;
  1410.   auswahl:=8;
  1411.   KriegGefuehrt := false;
  1412.   repeat
  1413.     NeuesBild;
  1414.     repeat
  1415.       TestBankrott;
  1416.       if not Bankrott then begin
  1417.         Bildschirm;
  1418.         waehlen (@einkauf_m,auswahl);
  1419.         case auswahl of
  1420.           1: MarktKaufen;
  1421.           2: MuehleKaufen;
  1422.           3: PalastKaufen;
  1423.           4: KathKaufen;
  1424.           5: Militaer;
  1425.           6: Spielstand;
  1426.           7: Karte
  1427.         end
  1428.       end
  1429.     until (auswahl=0) or (auswahl>=5) or bankrott or krieggefuehrt
  1430.   until (auswahl in [0,8,9]) or bankrott or krieggefuehrt;
  1431.   if Auswahl = 9 then Save := true
  1432. end;
  1433.  
  1434. procedure ZugEnde;
  1435.  
  1436. procedure Addiere(Zahl: real);
  1437. begin
  1438.   if Zahl > 17 then Zahl := 17;
  1439.   VarFR2 := VarFR2 + int(Zahl)
  1440. end;
  1441.  
  1442. procedure NeuerTitel;
  1443. begin
  1444.   if (Geld[AmZug] >= 0) and
  1445.      ((Rang[AmZug] <= 6) or (Palast[AmZug] >= 16)) and
  1446.      ((Rang[AmZug] <= 7) or ((Kathedrale[AmZug] >= 14) and
  1447.                              (Muehlen[AmZug] >= 15) and
  1448.                              (Maerkte[AmZug] >= 25))) and
  1449.      (not ((Rang[AmZug] = 8) and (Geld[AmZug] < 100000))) then begin
  1450.      inc( Rang[AmZug]);
  1451.      if Rang[AmZug] = 9 then
  1452.        KaiserF := true
  1453.      else begin
  1454.        box(all_single_box,0,0,78,23,att[att_befoer_s],att[att_befoer_s]);
  1455.        wrm(10,40,att[att_befoer_s],'Ihnen wurde ein neuer Titel verliehen.');
  1456.        wrm(11,40,att[att_befoer_s],'Sie sind jetzt:');
  1457.        wrm(13,40,att[att_befoer_tit],' '+GanzerName(AmZug)+' ');
  1458.        if cfg.SoundF then NeuerTitelSound;
  1459.        Taste_Druecken
  1460.      end
  1461.   end
  1462. end;
  1463.  
  1464.  
  1465.  
  1466. (* Zeile 1700- *)
  1467. begin (* Zug Ende 1 *)
  1468.   VarFR2 := 0;
  1469.   Addiere(Maerkte[AmZug]);
  1470.   Addiere(Palast[AmZug]);
  1471.   Addiere(Kathedrale[AmZug]);
  1472.   Addiere(Muehlen[AmZug]);
  1473.   Addiere(Geld[AmZug] / 5000);
  1474.   Addiere(Land[AmZug] / 6000);
  1475.   Addiere(VarWSFT[AmZug] / 50);
  1476.   Addiere(Punkte[AmZug] / 5);
  1477.   Addiere(Soldaten[AmZug] / 50);
  1478.   Addiere(VarGSTL[AmZug] / 10);
  1479.   Addiere(Einwohner[AmZug] / 2000);
  1480.   Addiere(Haeuser[AmZug] / 5);
  1481.   VarFR := int( VarFR2 / 9);
  1482.   if VarFR > 9 then VarFR := 9;
  1483.   if Rang[AmZug] < VarFR then
  1484.     NeuerTitel;
  1485.   EndZeit := MomentZeit - Startzeit;
  1486. {$IFNDEF notime}
  1487.   if EndZeit > Rundenzeit then
  1488.     Tod[AmZug] := Tod[AmZug] - 1 - random(3)
  1489. {$ENDIF}
  1490. end;
  1491.  
  1492.  
  1493. procedure TestTod;
  1494. (* Zeile 1775- *)
  1495. begin
  1496.   if Zeit >= Tod[AmZug] then
  1497.     Spielertod;
  1498.   VarKFA[AmZug] := VarKFA[AmZug] * 0.9
  1499. end;
  1500.  
  1501.  
  1502. procedure Kroenung;
  1503.  
  1504. var KName: MaxString;
  1505.  
  1506. begin
  1507.   Rand (att[att_kaiser_s]);
  1508.   wrm(8,40,att[att_kaiser_s],'Der letzte Kaiser des');
  1509.   wrm(10,40,att[att_kaiser_s],'HEILIGEN RÖMISCHEN REICHES DEUTSCHER NATION');
  1510.   wrm(12,40,att[att_kaiser_s],'war');
  1511.   wrm(15,40,att[att_kaiser_tit],AlterKaiser);
  1512.   Taste_Druecken;
  1513.   KName := Name[AmZug] + ' von ' + Reich[AmZug];
  1514.   NeuerKaiser(KName);
  1515.   Rand (att[att_kaiser_s]);
  1516.   wrm(9,40,att[att_kaiser_s],'ES LEBE');
  1517.   wrm(11,40,att[att_kaiser_tit],KName);
  1518.   wrm(13,40,att[att_kaiser_s],'KAISER VON GOTTES GNADEN');
  1519.   Hinweis('Für ein neues Spiel eine Taste drücken')
  1520. end;
  1521.  
  1522.  
  1523.  
  1524. (* Zeile 1000- *)
  1525. begin (* Spiel *)
  1526.   KaiserF := false;
  1527.   EndeF := false;
  1528.   repeat
  1529.     repeat
  1530.       inc(AmZug);
  1531.       if AmZug > Anzahl_Spieler then begin
  1532.         AmZug := 1;
  1533.         inc(Zeit)
  1534.       end;
  1535.     until not((Tod[AmZug] < 1700) or (EnthobenBis[AmZug] > Zeit));
  1536.     AnzahlMilitaer;
  1537.     BerechneErnte;
  1538.     KornUndLand;
  1539.     Uebersicht;
  1540.     Einnahmen;
  1541.     TestBankrott;
  1542.     Save := false;
  1543.     if not Bankrott then begin
  1544.       TestPolitik;
  1545.       if not SchlechtePolitik then begin
  1546.         Landmangel;
  1547.         Einkaeufe;
  1548.         if not (Bankrott or KriegGefuehrt) then ZugEnde
  1549.       end;
  1550.       if not (Bankrott or KriegGefuehrt) then TestTod
  1551.     end;
  1552.     if save then Speichern
  1553.   until KaiserF or EndeF;
  1554.   if KaiserF then Kroenung
  1555. end;
  1556.  
  1557.  
  1558. (*****************************************************************************)
  1559.  
  1560. begin  (* Hauptprogramm *)
  1561.   while true do begin
  1562.  
  1563.     Neues_oder_altes_Spiel;
  1564.     Spiel
  1565.  
  1566.   end
  1567. end.