Die ASC Mega 2/ASC-Mega2-CD-ROM.iso/SPIELE/KAISER/KRIEG.PAS

Pascal/Delphi Source File | 1990-08-20 | 39.0 KB | 1,537 lines

procedure krieg;

(* !!! alle Zeilennummern beziehen sich auf KRIEG.BAS !!! *)

const verhalt_m: menue_typ = (xs:28;ys:19;xl:24;yl:4;at:att_verhalt_m);
      verhalt_m_tx: array[1..4] of string[25] =
        ('  Durchmarsch gewähren  ',
         '  Dem Angreifer helfen  ',
         'Dem Angegriffenen helfen',
         '         Neutral        ');
(* DATA Zeilen 3000 - 3263 *)
      max_wege = 28;
      Wege: array[1..MaxSpieler,1..max_wege] of word =
      ((2,23,53,43,983,4,5,6,47,67,537,237,9837,28,98,538,438,6738,9,0,0,0,0,0,
        0,0,0,0),
       (1,3,14,34,54,5,16,546,376,346,5376,37,147,167,547,8,9,0,0,0,0,0,0,0,0,
         0,0,0),
       (21,51,41,761,891,2,4,5,46,76,516,216,8916,7,8,29,89,519,419,7619,0,0,
        0,0,0,0,0,0),
       (1,12,32,52,3,5,6,7,38,528,198,329,529,389,19,0,0,0,0,0,0,0,0,0,0,0,0,
        0),
       (1,2,3,4,16,46,376,37,47,167,28,38,198,19,29,389,0,0,0,0,0,0,0,0,0,0,
        0,0),
       (1,12,452,432,732,43,73,153,123,1983,5,7,738,438,128,198,1538,4528,
        19,4529,4389,4329,7389,7329,0,0,0,0),
       (61,41,351,321,3891,32,452,412,612,3,4,35,45,615,6,38,4528,4128,4198,
        6128,6198,389,329,419,619,3519,4529,0),
       (91,21,351,341,3761,2,3,34,254,214,914,25,35,915,376,46,216,916,3516,
        2546,37,2547,2147,2167,9147,9167,9,0),
       (1,2,83,23,153,143,1673,14,254,234,834,25,15,835,16,2546,2376,8346,
        8376,237,167,147,2547,1537,8,0,0,0));

      hauptstadt: array[0..1,0..4] of byte =
        ((z_h,z_a,z_u,z_p,z_t),
         (z_s,z_t,z_a,z_d,z_t));

type VerhaltenTyp = (Durchmarsch, Hilfe_Angreifer, Hilfe_Verteidiger, Neutral);
     verhaltenset = set of verhaltentyp;
     string5      = string[5];

var Feind:    (* FEIND *) byte;
    geliehen: (* LEIH  *) array[1..maxspieler,0..2] of longint;


procedure clear_arrays;
var x,y: byte;
begin
  for x:=1 to maxspieler do
    for y:=0 to 2 do
      geliehen[x,y]:=0;
end;


procedure FeindWaehlen;

const ZLaenge = 40; (* Maximale Laenge eines Namens *)

var Liste:      array[1..MaxSpieler] of byte;
    Anzahl, nr: byte;
    s:          string[zlaenge];


begin
  Anzahl := 0;
  for nr:=1 to Anzahl_Spieler do
    if (Tod[nr] > 1700) and (nr<>AmZug) then begin
      inc(Anzahl);
      Liste[Anzahl] := nr
    end;
  NameUndJahr (att[att_feind_s]);
  wrm(6,40,att[att_feind_tit],' Wer soll angegriffen werden ? ');
  if Anzahl>0 then begin
    for nr:=1 to Anzahl do begin
      s:=copy(ganzername(liste[nr]),1,zlaenge);
      while length(s)<zlaenge do begin
        s:=' '+s;
        if length(s)<zlaenge then s:=s+' ';
      end;
      feind_m_tx[nr]:=s;
    end;
    feind_m_tx[succ(anzahl)]:='               Niemanden';
    with feind_m do begin
      xs:=(80-zLaenge) div 2;
      ys:=9;
      xl:=zlaenge;
      yl:=succ(anzahl);
      at:=att_feind_m;
    end;
    feind:=succ(anzahl);
    waehlen (@feind_m,feind);
    if feind=succ(anzahl) then feind:=0;
    if feind<>0 then begin
      if feind>=amzug then inc(feind);
      krieggefuehrt:=true
    end
  end
end;


procedure krieg_wenn_moeglich;
const y0=44; (* erste Y-Koordinate des Spielfelds *)
var Verhalten:   (* HELP$ *) array [1..MaxSpieler] of Verhaltentyp;
    truppen:     (* S *)     array[0..1,0..4] of integer;
    schaden:     (* P *)     array[0..1,0..3] of real;
    weglaenge,
    feld_laenge:             byte;
    schaden_a,   (* EA *)
    schaden_f,   (* EF *)
    erobert:                 longint;


procedure PruefVerhalten;
var y2,Spieler,Auswahl: byte;
    Rest,NameSpieler:  MaxString;
begin
  y:=4;
  for Spieler:=1 to Anzahl_Spieler do
    if (Spieler<>AmZug) and (Spieler<>Feind) then begin
      NameSpieler:=GanzerName(Spieler);
      wrm(y,40,att[att_verhalt_s],'Wie verhält sich '+NameSpieler+' ?');
      repeat
        Auswahl:=4;
        waehlen (@verhalt_m,auswahl);
      until auswahl<>0;
      case Auswahl of
        1: begin
             Verhalten[Spieler]:=Durchmarsch;
             Rest:=' gewährt dem Angreifer Durchmarsch.'
           end;
        2: begin
             Verhalten[Spieler]:=Hilfe_Angreifer;
             Rest:=' hilft dem Angreifer.'
           end;
        3: begin
             Verhalten[Spieler]:=Hilfe_Verteidiger;
             Rest:=' hilft dem Angegriffdnen.'
           end;
        4: begin
             Verhalten[Spieler]:=Neutral;
             Rest:=' verhält sich neutral.'
           end
      end;
      clear(1,78,y,y,att_verhalt_s);
      wrm(y,40,att[att_verhalt_s],NameSpieler+Rest);
      inc(y,2)
    end;
    if Anzahl_Spieler < MaxSpieler then
      for Spieler:=Anzahl_Spieler+1 to MaxSpieler do begin
        wrm(y,40,att_verhalt_s,'Der Herrscher von '+Reich[Spieler]+' verhält sich neutral.');
        Verhalten[Spieler]:=Neutral;
        inc(y,2)
      end;
    with verhalt_m do
      clear(xs-1,xs+xl,ys-1,ys+yl+1,att_verhalt_s);
    Taste_Druecken
end; (* Prüf Verhalten *)


function angriff_moeglich: boolean;
var zaehler,zaehler2: byte;
    s:                string5;
    moeglich:         boolean;
(* Zeile 4100 - *)
begin
  nameundjahr (att[att_weg_s]);
  angriff_moeglich:=true;
  for zaehler:=1 to max_wege do begin
    str(wege[amzug,zaehler],s);
    weglaenge:=length(s);
    if s='0' then begin
      wrm(12,40,att[att_weg_tit],' Alle Wege nach '+reich[feind]+' sind versperrt !!! ');
      angriff_moeglich:=false;
      taste_druecken;
      exit
    end
    else
      if s[weglaenge]=chr(ord('0')+feind) then begin
        if weglaenge=1 then begin
          wrm(12,40,att[att_weg_tit],'Direkter Angriff');
          taste_druecken;
          exit
        end
        else begin
          moeglich:=true;
          for zaehler2:=1 to weglaenge-1 do
            if verhalten[ord(s[zaehler2])-ord('0')]
                                            in [hilfe_verteidiger,neutral] then
              moeglich:=false;
          if moeglich then begin
            wrm(5,40,att[att_weg_tit],'Der Angriffsweg sieht folgendermaßen aus:');
            wrm(8,40,att[att_weg_s],reich[amzug]);
            for zaehler2:=1 to weglaenge do
              wrm(zaehler2*2+8,40,att[att_weg_s],reich[ord(s[zaehler2])-ord('0')]);
            taste_druecken;
            exit
          end;
        end;
      end;
  end;
  halt
end; (* Angriff möglich ? *)


procedure werte_aktualisieren;
var zaehler: byte;


function hilfe_moeglich(von: byte;ausnahmen: verhaltenset):boolean;
var counter,counter2,laenge: byte;
    s:                       string5;
    moeglich:                boolean;
begin
  hilfe_moeglich:=true;
  for counter:=1 to max_wege do begin
    str(wege[von,counter],s);
    laenge:=length(s);
    if s='0' then begin
      nameundjahr (att_weg_s);
      wrm(12,40,att_weg_tit,
              'Die Truppen aus '+reich[von]+' können nicht zu Hilfe kommen.');
      taste_druecken;
      hilfe_moeglich:=false;
      exit
    end
    else
      if ord(s[laenge])-ord('0')=feind then
        if laenge=1 then exit
        else begin
          moeglich:=true;
          for counter2:=1 to laenge-1 do
            if verhalten[ord(s[counter2])-ord('0')] in ausnahmen then
              moeglich:=false;
          if moeglich then exit
        end;
  end;
  halt
end;


procedure verbinde(nach: byte);
begin
  geliehen[zaehler,0]:=reiter[zaehler];
  inc(reiter[nach],reiter[zaehler]);
  geliehen[zaehler,1]:=artillerie[zaehler];
  inc(artillerie[nach],artillerie[zaehler]);
  geliehen[zaehler,2]:=infanterie[zaehler];
  inc(infanterie[nach],infanterie[zaehler]);
  varkfa[nach]:=(soldaten[nach]*varkfa[nach] +
                 soldaten[zaehler]*varkfa[zaehler]) /
                (soldaten[nach] + soldaten[zaehler]);
  varkfa[zaehler]:=varkfa[nach];
  soldaten[nach]:=20*(reiter[nach]+artillerie[nach]+
                      infanterie[nach]+miliz[nach]);
end;


procedure setzen(nr: byte; truppen_array: intarray);
begin
  truppen[0,nr]:=truppen_array[amzug];
  truppen[1,nr]:=truppen_array[feind];
end;


begin (* Werte aktualisieren *)
  varkfa[amzug]:=varkfa[amzug]*2/(weglaenge+1);
  for zaehler:=1 to anzahl_spieler do
    if (zaehler<>amzug) and (zaehler<>feind) then
      case verhalten[zaehler] of
        hilfe_angreifer:   if hilfe_moeglich(zaehler,
                           [neutral,hilfe_verteidiger]) then
                             verbinde(amzug);
        hilfe_verteidiger: if hilfe_moeglich(zaehler,
                           [durchmarsch,hilfe_angreifer]) then
                             verbinde(feind);
      end;
  setzen(0,soldaten);
  setzen(1,reiter);
  setzen(2,artillerie);
  setzen(3,infanterie);
  setzen(4,miliz);
end; (* Werte aktualisieren *)


procedure zeige_zeile(y: byte);
begin
  c_y:=y0+(y-feld_oben)*16;
  row(y-feld_oben)
end;


procedure feld_anzeigen(nach: shortint);
var x,y,wohin,diff,y_start,y_ende: shortint;
    p:                             pointer;
    groesse,zwischen:              word;
begin (* feld_anzeigen *)
  wohin:=nach;
  if wohin<0 then wohin:=0;
  if wohin>80-feld_laenge then wohin:=80-feld_laenge;
  if feld_oben<>wohin then begin
    y_start:=0; y_ende:=pred(feld_laenge); c_y:=y0;
    if langsam then begin
      diff:=abs(feld_oben-wohin);
      if diff<feld_laenge then
        if wohin<feld_oben
          then begin
            scroll (y0,y0+diff*16,(feld_laenge-diff)*16*80);
            y_ende:=pred(diff);
          end else begin
            scroll (y0+diff*16,y0,(feld_laenge-diff)*16*80);
            y_start:=feld_laenge-diff; inc(c_y,y_start*16);
          end;
    end;
    feld_oben:=wohin;
    for y:=y_start to y_ende do begin
      row(y); inc(c_y,16);
    end;
  end;
end; (* feld_anzeigen *)


procedure adjust_to(y: shortint; step: byte);
begin
  if (y<=feld_oben+step-1) and (feld_oben>0) then
    feld_anzeigen(y-step);
  if (y>=feld_oben+feld_laenge-step-1) and (feld_oben<80-feld_laenge) then
    feld_anzeigen(y-feld_laenge+step+1);
end;


procedure window_cls;
var x,y: byte;
    s:   string;
begin
  s[0]:=chr(succ(xweite) shr 3); fillchar(s[1],length(s),' ');
  for y:=0 to (y0-10) shr 3 do outtext(0,y shl 3,s);
end;


function occupied(x,y: byte): boolean;
begin
  occupied:=((spielfeld[y,x]<>z_leer) or (spielfeld[y,x+1]<>z_leer))
end;


procedure bewege_ausschnitt;
type control_type = (nix,auf,ab,b_auf,b_ab,pos1,ende);
var taste:    char;
    control:  control_type;
    position: shortint;
begin
  keinetaste;
  repeat
    taste:=readkey;
    control:=nix;
    position:=feld_oben;
    if taste=#0 then begin
      taste:=readkey;
      case taste of
        #72: control:=auf;
        #80: control:=ab;
        #73: control:=b_auf;
        #81: control:=b_ab;
        #71: control:=pos1;
        #79: control:=ende
      end
    end
    else
      case taste of
        '8': control:=auf;
        '2': control:=ab;
        '9': control:=b_auf;
        '3': control:=b_ab;
        '7': control:=pos1;
        '1': control:=ende;
      end;
    case control of
      auf:   dec(position);
      ab:    inc(position);
      b_auf: dec(position,feld_laenge-1);
      b_ab:  inc(position,feld_laenge-1);
      pos1:  position:=0;
      ende:  position:=80-feld_laenge;
    end;
    if control<>nix then begin
      if position<0 then position:=0;
      if position>80-feld_laenge then position:=80-feld_laenge;
      feld_anzeigen(position)
    end;
  until rebuild or (taste=#13);
end;


procedure zeige_array;
var lauf: byte;
begin
  for lauf:=1 to 4 do begin
    wipetext(feld_x+150,lauf*8+1,3);
    wipetext(feld_x+465,lauf*8+1,3);
    outtext((feld_x+150) shr 3,lauf*8+1,strgr(truppen[0,lauf],3));
    outtext((feld_x+465) shr 3,lauf*8+1,strgr(truppen[1,lauf],3));
  end;
end;


procedure spielfeld_init;
var maerkte_gesetzt, muehlen_gesetzt: array[0..1] of integer;


procedure clear_spielfeld;
var x,y: byte;
begin
  for y:=0 to 79 do
    for x:=0 to 39 do
      spielfeld[y,x]:=z_leer;
  for x:=0 to 1 do begin
    maerkte_gesetzt[x]:=0;
    muehlen_gesetzt[x]:=0
  end;
end;


procedure grenze_setzen;
var x,y: byte;
    i:   shortint;
begin (* Grenze setzen *)
  x:=20;
  for y:=0 to 79 do begin
    repeat
      i:=random(3)-1;
    until (i=0) or ((i=-1) and (x>=19)) or ((i=1) and (x<=21));
    case i of
      -1: begin
            spielfeld[y,x-1]:=grenze1;
            spielfeld[y,x]:=grenze2;
          end;
      0:  spielfeld[y,x]:=grenze0;
      1:  begin
            spielfeld[y,x]:=grenze3;
            spielfeld[y,x+1]:=grenze4;
          end;
    end;
    x:=x+i;
  end;
end; (* Grenze setzen *)


procedure hauptstaedte_setzen;
var haupt_x,haupt_y,spieler: byte;


procedure schrift;
var x,y: byte;
begin
  haupt_y:=random(71)+4;
  for y:=0 to 1 do
    for x:=0 to 4 do
      spielfeld[haupt_y+y,haupt_x+x]:=hauptstadt[y,x];
end;


procedure gebaeude;
var x:byte;


procedure setzen(was,wieoft: byte);
var count: byte;
begin
  for count:=1 to wieoft do begin
    x:=random(7)+haupt_x;
    y:=random(8)-3+haupt_y;
    if not occupied(x,y) then begin
      spielfeld[y,x]:=was;
      spielfeld[y,x+1]:=was+1;
      inc(maerkte_gesetzt[spieler]);
    end;
  end;
end;


begin (* Gebäude *)
  setzen(z_kirche,3);
  setzen(z_markt2,15);
  for x:=0 to 7 do begin
    spielfeld[haupt_y-4,haupt_x+x]:=hz;
    spielfeld[haupt_y+5,haupt_x+x]:=hz;
  end;
end; (* Gebäude *)


procedure mauer;
var y:byte;
begin
  for y:=haupt_y-3 to haupt_y+4 do
    spielfeld[y,haupt_x+8]:=sk;
  spielfeld[haupt_y,haupt_x+8]:=toro;
  spielfeld[haupt_y+1,haupt_x+8]:=toru;
end;


procedure palast_und_kath(von: byte);


procedure setze_palast_1;
begin
  spielfeld[haupt_y-2,haupt_x]:=z_kuppel2;
  spielfeld[haupt_y-2,haupt_x+1]:=z_spitzen2;
  spielfeld[haupt_y-1,haupt_x]:=z_palast2;
  spielfeld[haupt_y-1,haupt_x+1]:=z_palast2
end;


procedure setze_palast_2;
begin
  spielfeld[haupt_y-2,haupt_x+2]:=z_kuppel2;
  spielfeld[haupt_y-1,haupt_x+2]:=z_palast2;
end;


procedure setze_kath_1;
begin
  spielfeld[haupt_y+2,haupt_x]:=z_kreuz2;
  spielfeld[haupt_y+2,haupt_x+1]:=z_kreuz3;
  spielfeld[haupt_y+3,haupt_x]:=z_kath2;
  spielfeld[haupt_y+3,haupt_x+1]:=z_kath2;
end;


procedure setze_kath_2;
begin
  spielfeld[haupt_y+2,haupt_x+2]:=z_kreuz2;
  spielfeld[haupt_y+3,haupt_x+2]:=z_kath2
end;


begin
  if palast[von]>4 then begin
    setze_palast_1;
    if palast[von]>10 then
      setze_palast_2;
  end;
  if kathedrale[von]>0 then begin
    setze_kath_1;
    if kathedrale[von]>5 then
      setze_kath_2
  end;
end;


(* Zeile 15100- *)
begin (* Hauptstädte setzen *)
  spieler:=0;
  haupt_x:=0;
  schrift;
  palast_und_kath(amzug);
  gebaeude;
  spielfeld[haupt_y-4,8]:=ro;
  spielfeld[haupt_y+5,8]:=ru;
  mauer;

  spieler:=1;
  haupt_x:=35;
  schrift;
  haupt_x:=37;
  palast_und_kath(feind);
  haupt_x:=32;
  gebaeude;
  spielfeld[haupt_y-4,31]:=lo;
  spielfeld[haupt_y+5,31]:=lu;
  haupt_x:=23;
  mauer;
end; (* Hauptstädte setzen *)


procedure muehlen_und_maerkte_setzen;


procedure zufall(was1,was2,wer: byte);
var x,y: byte;
begin
  repeat
    x:=random(14);
    if wer=feind then inc(x,25);
    y:=random(80);
  until (spielfeld[y,x]=z_leer) and (spielfeld[y,x+1]=z_leer);
  spielfeld[y,x]:=was1;
  spielfeld[y,x+1]:=was2
end;


procedure s_muehlen(wer: byte);
var lauf,anzahl: integer;
begin
  anzahl:=muehlen[wer];
  if anzahl>0 then
    for lauf:=1 to anzahl do
      zufall(zmuehle,z_muehle2,wer);
end;


procedure s_maerkte(wer: byte);
var lauf,anzahl: integer;
begin
  anzahl:=maerkte[wer];
  if wer=amzug then
    anzahl:=anzahl-maerkte_gesetzt[0]
  else
    anzahl:=anzahl-maerkte_gesetzt[1];
  if anzahl>0 then
    for lauf:=1 to anzahl do
      zufall(z_markt2,z_markt2+1,wer);
end;


begin
  s_muehlen(feind);
  s_muehlen(amzug);
  s_maerkte(feind);
  s_maerkte(amzug);
end;


procedure fluesse_setzen;
var lauf: byte;


procedure seite(links: boolean);
var next,x,xalt,stumpf,stumpf_neu,r,hori: byte;
    y,yalt:                                shortint;
begin
  if links then begin
    x:=0;
    hori:=fl_str
  end
  else begin
    x:=39;
    hori:=fl_stl
  end;
  y:=random(80);
  next:=fl_hz;
  stumpf_neu:=hori;
  r:=random(100);
  while (y>=0) and (y<80) and
        (spielfeld[y,x]=z_leer) and (r>=3) do
  begin
    r:=random(100);
    xalt:=x;
    yalt:=y;
    spielfeld[y,x]:=next;
    if links then
      inc(x)
    else
      dec(x);
    stumpf:=stumpf_neu;
    if (spielfeld[y,x]=z_leer) and (r>=3) then begin
      xalt:=x;
      case random(3) of
        0: begin
             if links then begin
               spielfeld[y,x]:=fl_lo;
               next:=fl_ru;
             end
             else begin
               spielfeld[y,x]:=fl_ro;
               next:=fl_lu
             end;
             stumpf:=hori;
             stumpf_neu:=fl_stu;
             dec(y);
           end;
        1: begin
             if links then begin
               spielfeld[y,x]:=fl_lu;
               next:=fl_ro;
             end
             else begin
               spielfeld[y,x]:=fl_ru;
               next:=fl_lo
             end;
             stumpf:=hori;
             stumpf_neu:=fl_sto;
             inc(y);
           end;
        2: begin
             next:=fl_hz;
             stumpf_neu:=hori
           end
      end;
    end;
  end;
  if (y>=0) and (y<80) and (x<>0) and (x<>39) then
    spielfeld[yalt,xalt]:=stumpf;
end;


begin (* Flüsse setzen *)
  for lauf:=0 to 7 do begin
    seite(true);
    seite(false);
  end;
end; (* Flüsse setzen *)


procedure baeume_setzen;
var x,y: byte;

procedure baum(welcher,wieoft: byte);
var lauf: byte;
begin
  for lauf:=0 to wieoft do begin
    x:=random(40);
    y:=random(80);
    if not occupied(x,y) then begin
      spielfeld[y,x]:=welcher;
      spielfeld[y,x+1]:=welcher+1
    end;
  end;
end;

begin
  baum(z_baum1,110);
  baum(z_baum2,60);
end;


(* Zeile 15000- *)
begin (* Spielfeld Init *)
  clear_spielfeld;
  grenze_setzen;
  hauptstaedte_setzen;
  muehlen_und_maerkte_setzen;
  fluesse_setzen;
  baeume_setzen;
end; (* Spielfeld Init *)


procedure grafik_ein;

procedure groesse_berechnen;
begin
  feld_laenge:=(yweite-y0) div 16;
  feld_x:=(xweite-639) div 2;
  if feld_x>2 then begin
    verline(feld_x-2,y0-1,y0+feld_laenge*16+1);
    verline(feld_x+642,y0-1,y0+feld_laenge*16+1);
    if y0+feld_laenge*16+1<yweite then
      horline(feld_x-1,feld_x+641,y0+feld_laenge*16+1);
  end
  else
    if y0+feld_laenge*16+1<yweite then
      horline(feld_x,feld_x+639,y0+feld_laenge*16+1);
  feld_oben:=127;
end;

begin
  opengraph;
  horline(0,xweite,y0-2);
  groesse_berechnen;
end;   (* grafik_ein *)


procedure grafik_spielfeld;
begin  (* grafik_spielfeld *)
  grafik_ein;
  midtext(0,ganzername(amzug));
  midtext(12,'Das ist das Schlachtfeld.');
  midtext(20,
          'Links befinden sich Ihre Truppen. Rechts ist das Grenzgebiet von '+
          reich[feind]+'.');
  midtext(32,
      'Rollen Sie die Karte mit den Cursor-Tasten oder druecken Sie RETURN!');
  feld_anzeigen(0);
end;   (* grafik_spielfeld *)


procedure truppen_setzen;
var taste: char;
    x,y:   shortint;
    cy:    array[0..1] of shortint;

procedure setz_truppe(nummer: byte);
var trupp_nr,
    zeichen:  byte;

procedure bewege_cursor;
type control_type = (nix,links,rechts,auf,ab,b_auf,b_ab,pos1,ende,return);
var taste:      char;
    control:    control_type;
    fertig,
    b_moeglich: boolean;

procedure grund_x;
begin
  if nummer=0 then
    x:=10
  else
    x:=28;
end;

procedure invertieren;
var xx: byte;
    yy: word;
begin
  xx:=(feld_x+x shl 4) shr 3; yy:=y0+(y-feld_oben) shl 4;
  xorput:=true;
  mal(xx,yy,zeichen); mal(xx+2,yy,succ(zeichen));
  mal(xx,yy,z_cursor); mal(xx+2,yy,succ(z_cursor));
  xorput:=false;
end;

begin (* Bewege Cursor *)
  keinetaste;
  fertig:=false;
  grund_x; adjust_to(y,2);
  repeat
    invertieren;
    taste:=readkey;
    if not rebuild then invertieren;
    control:=nix;
    if nummer=0 then
      b_moeglich:=(x<=17)
    else
      b_moeglich:=(x>=23);
    if taste=#0 then begin
      taste:=readkey;
      case taste of
        #72: control:=auf;
        #80: control:=ab;
        #75: control:=links;
        #77: control:=rechts;
        #73: control:=b_auf;
        #81: control:=b_ab;
        #71: control:=pos1;
        #79: control:=ende
      end
    end
    else
      case taste of
        '8': control:=auf;
        '2': control:=ab;
        '4': control:=links;
        '6': control:=rechts;
        '9': control:=b_auf;
        '3': control:=b_ab;
        '7': control:=pos1;
        '1': control:=ende;
        #13: control:=return;
      end;
    case control of
      auf:    dec(y);
      ab:     inc(y);
      links:  dec(x);
      rechts: inc(x);
      b_auf:  dec(y,feld_laenge-1);
      b_ab:   inc(y,feld_laenge-1);
      pos1:   y:=0;
      ende:   y:=79;
      return: fertig:=not occupied(x,y);
    end;
    if not (control in [nix,return]) then begin
      if (not b_moeglich) and (control in [b_auf..ende]) then grund_x;
      if y<0 then y:=0;
      if y>79 then y:=79;
      if x<0 then x:=0;
      if x>38 then x:=38;
      if (spielfeld[y,x] in [grenze0..grenze4])  or
         (spielfeld[y,x+1] in [grenze0..grenze4]) then
        if nummer=0 then
          x:=pred(x)
        else
          x:=succ(x);
      adjust_to(y,2);
    end;
  until rebuild or fertig;
end; (* Bewege Cursor *)

begin (* Setz 1 Truppe *)
  trupp_nr:=1;
  while truppen[nummer,trupp_nr]<=0 do
    inc(trupp_nr);
  zeichen:=z_truppen+nummer*8+trupp_nr*2;
  bewege_cursor;
  if not rebuild then begin
    spielfeld[y,x]:=zeichen;
    spielfeld[y,x+1]:=zeichen+1;
    zeige_zeile(y);
    dec(truppen[nummer,0],20);
    dec(truppen[nummer,trupp_nr]);
  end;
end; (* Setz 1 Truppe *)


procedure grafik_truppen;
begin
  grafik_ein;
  midtext(0,'Verteilen Sie jetzt bitte Ihre Truppen!');
  outtext(feld_x shr 3,9, 'Kavallerie:');
  outtext(feld_x shr 3,17,'Artillerie:');
  outtext(feld_x shr 3,25,'Infanterie:');
  outtext(feld_x shr 3,33,'Miliz:');
end;   (* grafik_truppen *)


begin (* Truppen setzen *)
  y:=feld_oben+(feld_laenge div 2); cy[0]:=y; cy[1]:=y; rebuild:=true;
  while truppen[0,0]+truppen[1,0]>0 do begin
    if rebuild then grafik_truppen;
    zeige_array;
    if truppen[0,0]>=truppen[1,0]
      then begin y:=cy[0]; setz_truppe(0); cy[0]:=y; end
      else begin y:=cy[1]; setz_truppe(1); cy[1]:=y; end;
  end;
end; (* Truppen setzen *)


procedure angriff;
var x,y,step,
    trupp_nr:     (* I *)      byte;
    gegenangriff,
    zaehlt:       (* ZAEHLT *) boolean;
    energie:      (* ZZ *)     real;
    taste:                     char;

procedure clear_schaden;
var x,y: byte;
begin
  schaden_a:=0;
  schaden_f:=0;
  for x:=0 to 1 do
    for y:=0 to 3 do
      schaden[x,y]:=0;
end;

procedure vorruecken;
var left,right, (* P1,P2 *)
    old_left,
    x2,         (* J *)
    zeichen,    (* FR2 *)
    strecke:    (* A *)         byte;
    staerke:    (* FR *)        real;
    rueckkehr:                  boolean;

procedure kampf;
var staerke2:  real;
    trupp_nr2: byte;
(* Zeile 700- *)
begin (* Kampf *)
  if gegenangriff then begin
    case zeichen of
      z_reiter1:     begin staerke2:=0.7; trupp_nr2:=1 end;
      z_artillerie1: begin staerke2:=0.6; trupp_nr2:=2 end;
      z_infanterie1: begin staerke2:=1;   trupp_nr2:=3 end;
      z_miliz1:      begin staerke2:=1.5; trupp_nr2:=4 end;
    end;
    staerke2:=staerke2*varkfa[feind];
  end
  else begin
    case zeichen of
      z_reiter2:     begin staerke2:=0.7; trupp_nr2:=1 end;
      z_artillerie2: begin staerke2:=0.6; trupp_nr2:=2 end;
      z_infanterie2: begin staerke2:=1;   trupp_nr2:=3 end;
      z_miliz2:      begin staerke2:=1.5; trupp_nr2:=4 end;
    end;
    staerke2:=staerke2*varkfa[feind];
  end;
  if random*(staerke2+staerke+energie)<=staerke2 then begin
    (* Angreifer verliert *)
    if gegenangriff then begin
      spielfeld[y,x2]:=left;
      spielfeld[y,x2+1]:=right;
      inc(truppen[1,trupp_nr]);
    end
    else begin
      spielfeld[y,x2-1]:=left;
      spielfeld[y,x2]:=right;
      inc(truppen[0,trupp_nr]);
    end;
    energie:=energie+staerke;
    zeige_array;
    zeige_zeile(y);
    rueckkehr:=true;
  end
  else begin
    (* Verteidiger verliert *)
    if gegenangriff then begin
      spielfeld[y,x2-1]:=z_leer;
      spielfeld[y,x2-2]:=z_leer;
      inc(truppen[0,trupp_nr2]);
    end
    else begin
      spielfeld[y,x2+1]:=z_leer;
      spielfeld[y,x2+2]:=z_leer;
      inc(truppen[1,trupp_nr2]);
    end;
    energie:=0;
    staerke:=staerke-staerke2;
    zeige_array
  end;
end; (* Kampf *)

procedure zerstoerung;
var gebaeude: byte;
(* Zeile 800- *)
begin (* Zerstörung *)
  if (gegenangriff and (x2>17)) or
     ((not gegenangriff) and (x2<23)) then exit; (* Eigene(r) Mühle/Markt *)
  if zeichen in [zmuehle,z_muehle2] then
    gebaeude:=1
  else
    gebaeude:=0;
  energie:=energie+staerke;
  staerke:=energie-0.3-gebaeude*0.25;
  if staerke<0 then
    rueckkehr:=true
  else begin
    if gegenangriff then begin
      spielfeld[y,x2-2]:=z_ruine;
      spielfeld[y,x2-1]:=z_ruine+1;
      schaden[0,gebaeude]:=schaden[0,gebaeude]+1;
    end
    else begin
      spielfeld[y,x2+1]:=z_ruine;
      spielfeld[y,x2+2]:=z_ruine+1;
      schaden[1,gebaeude]:=schaden[1,gebaeude]+1;
    end;
    zeige_zeile(y);
    energie:=0;
  end;
end; (* Zerstörung *)

procedure mauer_ueberwinden;
(* Zeile 850- *)
begin (* Mauer überwinden *)
  energie:=energie+staerke;
  staerke:=2*energie-0.4;
  if staerke<0 then
    rueckkehr:=true
  else begin
    if gegenangriff then
      spielfeld[y,x2-1]:=z_leer
    else
      spielfeld[y,x2+1]:=z_leer;
    energie:=0;
  end;
end; (* Mauer überwinden *)

procedure ansturm(gegen: byte);
(* Zeile 875 *)
begin (* Ansturm *)
  if gegenangriff then
    schaden[0,gegen]:=schaden[0,gegen]+staerke/(0.5*gegen)
  else
    schaden[1,gegen]:=schaden[1,gegen]+staerke/(0.5*gegen);
  rueckkehr:=true;
end; (* Ansturm *)

(* Zeile 500- *)
begin (* Vorrücken *)
  left:=z_leer;
  right:=z_leer;
  x2:=x;
  if spielfeld[y,x] in [z_reiter1,z_reiter2] then begin
    strecke:=19;
    staerke:=0.7;
    trupp_nr:=1;
  end
  else begin
    strecke:=13;
    staerke:=1;
    trupp_nr:=3;
  end;
  if gegenangriff then
    staerke:=staerke+varkfa[feind]
  else
    staerke:=staerke+varkfa[amzug];
  rueckkehr:=false;
  repeat
    if gegenangriff then
      zeichen:=spielfeld[y,pred(x2)]
    else
      zeichen:=spielfeld[y,succ(x2)];
    case zeichen of
      z_baum1..z_baum2+1:        staerke:=staerke*0.95;
      fl_hz..fl_sto:             staerke:=staerke*0.6;
      grenze0..grenze4:          zaehlt:=true;
      z_reiter1,z_artillerie1,
      z_infanterie1,z_miliz1:    if gegenangriff then kampf;
      z_reiter2,z_artillerie2,
      z_infanterie2,z_miliz2:    if not gegenangriff then kampf;
      zmuehle,
      z_markt2..z_kirche+1:      zerstoerung;
      sk,toro,toru:              mauer_ueberwinden;
      lo,ro,lu,ru,hz:            rueckkehr:=true;
      z_kuppel2..z_palast2:      ansturm(2);
      z_kreuz2..z_kath2:         ansturm(3);
    end;
    if not rueckkehr then begin
      if gegenangriff then begin
        old_left:=right;
        right:=left;
        left:=spielfeld[y,x2-1];
        spielfeld[y,x2-1]:=spielfeld[y,x2];
        spielfeld[y,x2]:=spielfeld[y,x2+1];
        spielfeld[y,x2+1]:=old_left;
        if zaehlt then begin
          erobert:=erobert-(land[amzug] div 800);
          schaden_a:=schaden_f-erobert;
        end;
        dec(x2);
      end
      else begin
        old_left:=left;
        left:=right;
        right:=spielfeld[y,x2+1];
        spielfeld[y,x2+1]:=spielfeld[y,x2];
        spielfeld[y,x2]:=spielfeld[y,x2-1];
        spielfeld[y,x2-1]:=old_left;
        if zaehlt then begin
          erobert:=erobert+(land[feind] div 800);
          schaden_f:=erobert;
        end;
        inc(x2);
      end;
      zeige_zeile(y);
      delay(100);
      dec(strecke);
      if (x2>38) or (x2<1) or (strecke=0) then
        rueckkehr:=true;
    end;
  until rueckkehr
end; (* Vorrücken *)

procedure beschiessen;
var faktor,
    teil,
    staerke: (* FR *)   real;
    weit,    (* WEIT *)
    schuesse,
    zeichen: (* A *)    byte;
    x2:                 shortint;
    im_feld:            boolean;
    start,
    abweichung,
    k_x, k_y,
    ziel:               word;

procedure mal_kugel;
begin
  kugel(k_x,k_y-abweichung);
end;

procedure zerstoert(was,abweichung: byte);
var spieler: byte;
begin
  spielfeld[y,x2-abweichung]:=z_ruine;
  spielfeld[y,x2+1-abweichung]:=z_ruine+1;
  if x2<20 then
    spieler:=0
  else
    spieler:=1;
  schaden[spieler,was]:=schaden[spieler,was]+1;
end;

procedure rest_malen;
var davor,danach,zeichen2,spieler: byte;

procedure krater_bei(wo: byte);
begin
  spielfeld[y,x2-wo]:=z_krater;
  spielfeld[y,x2+1-wo]:=z_krater+1;
end;

begin (* Rest malen *)
  davor:=spielfeld[y,x2-1];
  (* leer oder Baum, rechtes Ende *)
  if ((zeichen=z_leer) and (davor=z_leer)) or
     ((zeichen=z_baum1+1) and (davor=z_baum1)) or
     ((zeichen=z_baum2+1) and (davor=z_baum2)) then
     begin
       krater_bei(1);
       exit
     end;
  danach:=spielfeld[y,x2+1];
  (* leer oder Baum, linkes Ende *)
  if ((zeichen=z_leer) and (danach=z_leer)) or
     ((zeichen=z_baum1) and (danach=z_baum1+1)) or
     ((zeichen=z_baum2) and (danach=z_baum2+1)) then
     begin
       krater_bei(0);
       exit
     end;
  (* Truppe *)
  if zeichen in [z_reiter1-1..z_miliz2+1] then begin
    zeichen2:=zeichen;
    zeichen2:=zeichen2-z_reiter1+1;
    krater_bei(zeichen2 and 1);
    zeichen2:=zeichen2 shr 1;
    if zeichen2>=4 then
      spieler:=1
    else
      spieler:=0;
    zeichen2:=zeichen2 and 3;
    inc(truppen[spieler,succ(zeichen2)]);
    zeige_array;
    exit
  end;
end; (* Rest malen *)

procedure rest_berechnen;
var spieler: byte;
begin
  if gegenangriff then
    spieler:=0
  else
    spieler:=1;
  case zeichen of
    z_kuppel2..z_palast2:  schaden[spieler,2]:=schaden[spieler,2]+1;
    z_kreuz2..z_kath2:     schaden[spieler,3]:=schaden[spieler,3]+1;
    z_reiter1-1..z_miliz1: varkfa[amzug]:=varkfa[amzug]-0.02;
    z_reiter2..z_miliz2+1: varkfa[feind]:=varkfa[feind]-0.02
  end;
end;

(* Zeile 900- *)
begin (* Beschiessen *)
  if gegenangriff then
    staerke:=varkfa[feind]
  else
    staerke:=varkfa[amzug];
  if staerke>1 then staerke:=1;
  schuesse:=trunc(staerke/0.2);
  while schuesse>0 do begin
    weit:=16+random(6);
    if gegenangriff then
      x2:=x-weit
    else
      x2:=x+weit;
    im_feld:=true;
    k_y:=y0+(y-feld_oben)*16+2;
    ziel:=feld_x+x2*16+4;
    if (x2>39) or (x2<0) then begin
      if x2<0 then
        ziel:=feld_x
      else
        ziel:=feld_x+635;
      im_feld:=false;
    end;
    start:=feld_x+x*16+6;
    faktor:=8.0/(longint(ziel)-longint(start));
    if gegenangriff then
      for k_x:=start downto ziel do begin
        teil:=(longint(k_x)-longint(start))*faktor;
        abweichung:=trunc(8*teil-teil*teil);
        mal_kugel;
        delay(10);
        mal_kugel;
      end
    else
      for k_x:=start to ziel do begin
        teil:=(longint(k_x)-longint(start))*faktor;
        abweichung:=trunc(8*teil-teil*teil);
        mal_kugel;
        delay(10);
        mal_kugel;
      end;
    if im_feld then begin
      zeichen:=spielfeld[y,x2];
      case zeichen of
        z_kirche,  z_markt2:   zerstoert(0,0);
        z_kirche+1,z_markt2+1: zerstoert(0,1);
        zmuehle:               zerstoert(1,0);
        z_muehle2:             zerstoert(1,1);
        sk,toro,toru:          spielfeld[y,x2]:=z_leer;
        else                   begin
                                 rest_malen;
                                 rest_berechnen
                               end;
      end;
    end;
    zeige_zeile(y);
    dec(schuesse);
  end;
end; (* Beschiessen *)

procedure verlorene_einheiten;
begin
  wipetext(feld_x,0,80);
  outtext(feld_x shr 3,0,'Verlorene Einheiten:');
end;


begin (* Angriff *)
  clear_schaden;
  step:=(feld_laenge div 2)-1;
  erobert:=0;
  verlorene_einheiten;
  midtext(0,'Der Angriff laeuft...');
  zeige_array;
  gegenangriff:=false;
  for y:=0 to 79 do begin
    adjust_to(y,step);
    zaehlt:=false;
    energie:=0;
    for x:=25 downto 0 do begin
      if spielfeld[y,x] in [z_reiter1,z_infanterie1] then
        vorruecken;
      if spielfeld[y,x]=z_artillerie1 then
        beschiessen;
    end;
  end;

  verlorene_einheiten;
  midtext(0,'Der Gegenangriff laeuft...');
  gegenangriff:=true;
  for y:=79 downto 0 do begin
    adjust_to(y,step);
    zaehlt:=false;
    energie:=0;
    for x:=14 to 39 do begin
      if spielfeld[y,x] in [z_reiter2,z_infanterie2] then
        vorruecken;
      if spielfeld[y,x]=z_artillerie2 then
        beschiessen;
    end;
  end;

  verlorene_einheiten;
  midtext(0,'Karte rollen oder RETURN druecken!');
  bewege_ausschnitt;
  shutgraph;
end; (* Angriff *)


procedure verluste;
var schaden2:   array[0..1,0..5] of longint;

procedure rechnen;
var spieler,
    lauf,lauf2: byte;
begin
  for lauf:=0 to 1 do begin
    for lauf2:=0 to 3 do
      schaden2[lauf,lauf2]:=trunc(schaden[lauf,lauf2]);
    if lauf=0 then
      spieler:=amzug
    else
      spieler:=feind;
    sub0_int(reiter[spieler],truppen[lauf,1]);
    sub0_int(artillerie[spieler],truppen[lauf,2]);
    sub0_int(infanterie[spieler],truppen[lauf,3]);
    soldaten[spieler]:=20*
                    (reiter[spieler]+artillerie[spieler]+infanterie[spieler]);
  end;
  if erobert>land[feind]-1 then begin
    erobert:=land[feind]-1;
    schaden_f:=erobert;
  end;
  if -erobert>land[amzug]-1 then begin
    erobert:=1-land[amzug];
    schaden_a:=abs(erobert);
  end;
end;

procedure praemie_verteilen;
type string8 = string[8];
const partizip: array[boolean] of string8 = ('verloren','gewonnen');
var gewinn: boolean;
    praemie: longint;
(* Zeile 4420- *)
begin
  nameundjahr (att[att_praemie]);
  wrm(8,40,att[att_praemie],ganzername(amzug));
  gewinn:=erobert>=0;
  wrm(10,40,att[att_praemie],'hat '+strg(abs(erobert))+' Hektar Land '+partizip[gewinn]+'.');
  if gewinn then begin
    praemie:=soldaten[amzug]*trunc(clog(erobert+1))*2;
    wrm(12,40,att[att_praemie],'Die überlebenden Soldaten bekommen');
    wrm(13,40,att[att_praemie],'eine großzügige Prämie von '+strg(praemie)+taler+'n.');
    dec(geld[amzug],praemie)
  end;
  taste_druecken;
end;

procedure verluste_anzeigen;
type string17 = string[17];
const art: array[0..5] of string17 = ('Märkte:          ',
                                      'Mühlen:          ',
                                      'Palastteile:     ',
                                      'Kathedralenteile:',
                                      'Einwohner:       ',
                                      'Staatskasse:     ');
var lauf,y,spieler: byte;
    schaden_:       longint;

procedure abziehen(nr: byte; var gebaeude: bytearray);
begin
  if schaden2[lauf,nr]>gebaeude[spieler] then
    schaden2[lauf,nr]:=gebaeude[spieler];
  dec(gebaeude[spieler],schaden2[lauf,nr]);
end;

(* Zeile 4452- *)
begin
  for lauf:=0 to 1 do begin
    if lauf=0 then
      spieler:=amzug
    else
      spieler:=feind;
    abziehen(0,maerkte);
    miliz[spieler]:=(maerkte[spieler] div 5)*4;
    abziehen(1,muehlen);
    abziehen(2,palast);
    abziehen(3,kathedrale);
    schaden2[lauf,4]:=0;
    schaden2[lauf,5]:=0;
    if lauf=0 then schaden_:=schaden_a
              else schaden_:=schaden_f;
    if geld[spieler]>0 then
      schaden2[lauf,5]:=trunc((geld[spieler]/land[spieler])*schaden_);
    schaden2[lauf,4]:=
      trunc(int((einwohner[spieler]/2/land[spieler])*schaden_));
    dec(einwohner[spieler],schaden2[lauf,4]);
    dec(geld[spieler],schaden2[lauf,5]);
  end;
  land[amzug]:=land[amzug]+erobert;
  land[feind]:=land[feind]-erobert;
  nameundjahr (att[att_verluste]);
  wrm(4,40,att[att_verluste],'Außer an Soldaten entstanden folgende Verluste:');
  wrm(7,40,att[att_verluste],'Angreifer:');
  wrm(7,60,att[att_verluste],'Verteidiger:');
  for lauf:=0 to 5 do begin
    y:=10+lauf*2;
    wr(y,10,att[att_verluste],art[lauf]);
    wr(y,33,att[att_verluste],strgr(schaden2[0,lauf],6));
    wr(y,53,att[att_verluste],strgr(schaden2[1,lauf],6));
  end;
  taste_druecken;
end;

procedure truppen_zurueck;
var lauf:   byte;
    strafe: array[1..maxspieler] of longint;

procedure zurueck(spieler: byte);

procedure pruef(hoehe: longint; nr: byte; var truppe: intarray);
var teilstrafe: longint;
begin
  if truppe[spieler]>=geliehen[lauf,nr] then
    dec(truppe[spieler],geliehen[lauf,nr])
  else begin
    dec(geliehen[lauf,nr],truppe[spieler]);
    truppe[spieler]:=0;
    dec(truppe[lauf],geliehen[lauf,nr]);
    teilstrafe:=geliehen[lauf,nr]*hoehe;
    inc(strafe[spieler],teilstrafe);
    dec(geld[spieler],teilstrafe);
    inc(geld[spieler],teilstrafe);
  end;
end;

begin (* zurück *)
  pruef(1200,0,reiter    );
  pruef(800, 1,artillerie);
  pruef(500, 2,infanterie);
end; (* zurück *)

procedure anzeigen(y,wer: byte);
begin
  wrm(y,40,att[att_verluste],ganzername(wer));
  wrm(y+2,40,att[att_verluste],'kann nicht alle geliehenen Truppen zurückzahlen und muß deshalb');
  wrm(y+3,40,att[att_verluste],'eine Wiedergutmachung von');
  wrm(y+5,40,att[att_verluste],strg(strafe[wer])+taler+'n');
  wrm(y+7,40,att[att_verluste],'zahlen.');
end;

(* Zeile 4475- *)
begin (* Truppen zurück *)
  strafe[amzug]:=0;
  strafe[feind]:=0;
  for lauf:=1 to anzahl_spieler do
    if not (lauf in [amzug,feind]) then
      case verhalten[lauf] of
        hilfe_angreifer:   zurueck(amzug);
        hilfe_verteidiger: zurueck(feind);
      end;
  if strafe[amzug]+strafe[feind]>0 then begin
    nameundjahr (att[att_verluste]);
    if strafe[amzug]>0 then
      anzeigen(4,amzug);
    if strafe[feind]>0 then
      anzeigen(14,feind);
    taste_druecken;
  end;
end; (* Truppen zurück *)


begin (* Verluste *)
  rechnen;
  praemie_verteilen;
  verluste_anzeigen;
  truppen_zurueck;
end; (* Verluste *)


(* Zeile 4000- *)
begin (* Krieg, wenn möglich *)
  if cfg.autosave then speichern;
  NameUndJahr (att[att_verhalt_s]);
  if anzahl_spieler>2
    then begin
      pruefverhalten;
      if not angriff_moeglich then exit;
    end else weglaenge:=1;
  werte_aktualisieren;
  spielfeld_init;
  repeat
    grafik_spielfeld;
    bewege_ausschnitt;
  until not rebuild;
  truppen_setzen;
  angriff;
  verluste;
  anzahlmilitaer;
  save:=cfg.autosave;
end; (* Krieg, wenn möglich *)


begin (* Krieg *)
  clear_arrays;
  if Rang[AmZug] = 1 then begin
    Hinweis('Es ist noch zu früh !!!');
    Exit
  end;
  FeindWaehlen;
  if Feind = 0 then Exit;
  krieg_wenn_moeglich;
end;