SC=2000;/*-M*/;/*-T*/;/*-L*/

MODULE KALAHA;

/*          K A L A H A   SPIEL (BOHNENSPIEL)   12.07.84 NT          */;
/*                        MODIFIED 15-03-1990 BY KIO                 */;
/*                                                                   */;
/* AUTOR: J.NOTDURFT, INSTITUT FUER REGELUNGSTECHNIK, UNI HANNOVER   */;
/*                                                                   */;
/* BESCHREIBUNG DES KALAHA SPIELFELDES                               */;
/*                                                                   */;
/*                       RECHNERTOEPFE                               */;
/*           NR.6    NR.5    NR.4    NR.3    NR.2    NR.1            */;
/*                                                                   */;
/* KALAHATOPF                                             KALAHATOPF */;
/*  RECHNER                                                SPIELER   */;
/*                                                                   */;
/*            NR.1    NR.2    NR.3    NR.4    NR.5    NR.6           */;
/*                       SPIELERTOPFE                                */;
/*                                                                   */;
/*                                                                   */;
/*                                                                   */;
/* GRUNDAUFSTELLUNG: DIE KALAHATOEPFE SIND LEER, ALLE ANDEREN        */;
/*                   ENTHALTEN DIE GLEICHE ANZAHL(Z.B. 6) KUGELN     */;
/*                                                                   */;
/* AUSFUEHREN EINES ZUGES: DER INHALT EINER DER 6 TOEPFE EINES SPIE- */;
/*                         LERS WIRD ENTNOMMEN UND IM GEGENUHEZEIGER-*/;
/*                         SINN WIRD JE EINE KUGEL AUF DIE NACHFOL-  */;
/*                         GENDEN TOEPFE VERTEILT, MIT DER AUSNAHME, */;
/*                         DASS DER GEGNERISCHE KALAHATOPF UEBER-    */;
/*                         SPRUNGEN WIRD.                            */;
/*                                                                   */;
/* SPEZIELLE ZUEGE: -K A L A H A Z U G                               */;
/*                   WENN DIE LETZTE ZU VERTEILENDE KUGEL IN DEN     */;
/*                   KALAHATOPF GELEGT WIRD, IST DERSELBE SPIELER    */;
/*                   NOCH EINMAL AM ZUG                              */;
/*                  -R A U B Z U G                                   */;
/*                   WENN DIE LETZTE ZU VERTEILENDE KUGEL IN EINEN   */;
/*                   EIGENEN LEEREN TOPF GELEGT WIRD UND DER GEGEN-  */;
/*                   UEBERLIEGENDE GEGNERISCHE TOPF NICHT LEER IST,  */;
/*                   SO WIRD DER INHALT BEIDER TOEPFE IN DEN EIGENEN */;
/*                   KALAHATOPF GELEGT.                              */;
/*                                                                   */;
/* SPIELENDE: -IN EINEM KALAHATOPF SIND MEHR ALS DIE HAELTE DER IM   */;
/*             SPIEL BEFINDLICHEN KUGELN                             */;
/*            -ALLE SPIELTOEPFE EINER SEITE SIND LEER                */;
/*                                                                   */;
/* SPIELGEWINN: -WENN IM EIGENEN KALAHATOPF MEHR ALS DIE HAELFTE DER */;
/*               IM SPIEL BEFINDLICHEN KUGELN SIND.                  */;
/*              -WENN ALLE GEGNERISCHEN SPIELTOEPFE LEER SIND UND IM */;
/*               GEGNERISCHEN KALAHATOPF NICHT MEHR ALS DIE HAELFTE  */;
/*               DER IM SPIEL BEFINDLICHEN KUGELN SIND.              */;
/*                                                                   */;
/* SPEZIELLE EINGABEN: -BEI EINGABE EINER NEGATIVEN ZUGNUMMER        */;
/*                      ERFOLGT EIN ZUGVORSCHLAG, WOBEI DIE          */;
/*                      ANALYSETIEFE = ABS(ZUGNUMMER) IST.           */;
/*                     -BEI EINGABE EINER NULL ALS ZUGNUMMER         */;
/*                      WERDEN DIE SEITEN GETAUSCHT.                 */;


SYSTEM;
  TY: A1<->;
PROBLEM;
  TYPE FIX   FIXED;
  SPC TY     DATION INOUT ALPHIC CONTROL(ALL);
  SPC ASSIGN ENTRY GLOBAL;

  DCL ANZKUG    FIX INIT(6) /* ANZ KUGELN PRO TOPF IN GRUNDST. */,
      FELD(14)  FIX         /* AKTUELLER SPIELSTAND            */,
      KFELD(25) FIX         /* ZUGFOLGE BEI KALAHA-ZUEGEN      */;
  DCL KWERT     FIX         /* WERT DER STELLUNG NACH ZUG      */,
      STIEFE    FIX         /* SOLL-RECHENTIEFE                */,
      SKT       FIX         /* ANZ ZÜGE(GRUND- + KALAHAZÜGE)   */;

  DCL TEX1 CHAR(14) INIT('GRUNDSTELLUNG:'),
      TEX2 CHAR(17) INIT('SEITEN GETAUSCHT!'),
      TEX3 CHAR(11) INIT('KALAHA-ZUG!');
  DCL TEX4 CHAR(19) INIT('RECHNER WÄHLT TOPF '),
      TEX5 CHAR(17) INIT(' ZUEGEN GEWONNEN!'),
      TEX6 CHAR(33) INIT('BESTEN DANK FÜR DAS SCHÖNE SPIEL.'),
      TEX7 CHAR(19) INIT('SPIELER WÄHLT TOPF ');

/* ------------------------------------------------------------------ */

/* SPIELFELD AUSGEBEN:
   FELD = AUSZUGEBENDES SPIELFELD(MODULVARIABLE) */;

SPOUT: PROC;
  ZWEI: FORMAT(SKIP,X(37),F(3),X(20),F(3),SKIP,X(40));
  FOR K FROM 13 BY -1 TO 8 REPEAT;PUT FELD(K) TO TY BY F(3);END;
  PUT FELD(14),FELD(7) TO TY BY R(ZWEI);
  FOR K TO 6 REPEAT;PUT FELD(K) TO TY BY F(3);END;
  PUT TO TY BY SKIP;
END;


VETEIL: PROC ( IH       FIX,       FLDNEU() FIX IDENT,
               WEICHE   FIX IDENT, JAY      BIT );
/* VERTEILT DEN INHALT EINES TOPFES UND PRÜFT AUF GEWINN-, */;
/* VERLUST-, KALAHA- ODER RAUB-ZUG                         */;
/* IH = NUMMER DES TOPFES(1-6: SPIELER  /  8-13: RECHNER)  */;
/* FLDNEU = ZU BEHANDELNDES SPIELFELD                      */;
/* WEICHE = 1: GEWINNZUG                                   */;
/*        = 2: VERLUSTZUG                                  */;
/*        = 3: KALAHAZUG                                   */;
/*        = 4: NORMALZUG                                   */;
/* JAY = '0'B: SPIELER  / '1'B: RECHNER                    */;
  DCL ANZ          FIX /* ANZAHL DER ZU VERTEILENDEN KUGELN */,
     (EIGEN,ANDER) FIX /* INDEX KALAHA                      */,
     (SUM1,SUM2)   FIX /* SUMME DER TÖPFE                   */;

  WEICHE=4;
  ANZ=FLDNEU(IH);
  FLDNEU(IH)=0;          /* INHALT TOPF NULL SETZEN */;
  IF JAY THEN EIGEN=14; ANDER=7; ELSE EIGEN=7; ANDER=14; FIN;
  /* VERTEILUNG DER KUGELN */;
  WHILE ANZ>0 REPEAT;
    IF IH==14 THEN IH=1; ELSE IH=IH+1; FIN;
    IF IH/=ANDER THEN
      FLDNEU(IH)=FLDNEU(IH)+1;
      ANZ=ANZ-1;
    FIN;
  END;
  /* TEST KALAHA- ODER RAUBZUG */;
  IF IH==EIGEN THEN
    WEICHE=3;
  ELSE
    IF FLDNEU(IH)==1 AND FLDNEU(14-IH)/=0 AND
                    (JAY AND IH>7 OR NOT(JAY) AND IH<7) THEN
      FLDNEU(EIGEN)=FLDNEU(EIGEN)+FLDNEU(IH)+FLDNEU(14-IH);
      FLDNEU(IH)=0;
      FLDNEU(14-IH)=0;
    FIN;
  FIN;
  /* TEST GEWINNZUG DURCH KALAHA-TOPF */;
  IF FLDNEU(EIGEN) GT 6*ANZKUG THEN WEICHE=1; RETURN; FIN;
  /* TEST VERLUSTZUG DURCH KALAHA-TOPF */;
  IF FLDNEU(ANDER) GT 6*ANZKUG THEN WEICHE=2; RETURN; FIN;
  /* SUMMEN DER TÖPFE BILDEN */;
  SUM1=0; SUM2=0;
  FOR I TO 6 REPEAT;
    SUM1=SUM1+FLDNEU(I);
    SUM2=SUM2+FLDNEU(14-I);
  END;
  /* TEST GEWINNZUG DURCH LEERE GEGNERTÖPFE */;
  IF JAY AND SUM1==0 OR NOT(JAY) AND SUM2==0 THEN
    WEICHE=1; RETURN;
  FIN;
  /* TEST VERLUSTZUG DURCH LEERE EIGENE TÖPFE */;
  IF JAY AND SUM2==0 OR NOT(JAY) AND SUM1==0 THEN
    WEICHE=2; RETURN;
  FIN;
END;


ANALYS: PROC ( FLDALT() FIX IDENT, JAY BIT,
               TIEFE FIX,          WERT FIX IDENT,
               KAH FIX IDENT,      KT FIX,
               IND FIX );
/* REKURSIVE PROZEDUR ZUR ANALYSE DES SPIELFELDES                  */
/* FLDALT = SPIELFELD VOR DEM ZUG                                  */
/* JAY    = '0'B: SPIELER / '1'B: RECHNER                          */
/* TIEFE  = TIEFE IN DER ANALYSIERT WIRD(STIEFE -> 1)              */
/* WERT   = MAXIMALER WERT DER STELLUNG(VON MAX 6 MÖGLICHEN ZÜGEN) */
/* KAH    = NUMMER DES OPTIMALZUGES                                */
/* KT     = KALAHATIEFE IN DER ANALYSIERT WIRD(0 -> -?)            */
/* IND    = TOPFNUMMER DES ZUGES AUF DEM FLDALT BERUHT             */

  DCL FLDNEU(14) FIX,/* ZU ANALYSIERENDES SPIELFELD                */
     (WEICHE,        /* VERZWEIGUNG NACH VERTEILUNG DER KUGELN     */
      IH,            /* NUMMER DES GEZOGENEN FELDES                */
      LH,            /* NUMMER DES OPTIMALEN ZUGES                 */
      UESCHS,MAXLST,STZAHL,SUM,H1,H2) FIX;     /* HILFSGRÖSSEN     */

/* ANALYSIERE DIE 6 MÖGLICHEN ZÜGE */
  MAXLST=-10000;
  FOR I TO 6 REPEAT;
    IH=I; IF JAY THEN IH=I+7; FIN;
    IF FLDALT(IH)/=0 /* TEST */ THEN
      /* FELD KOPIEREN */;
      FOR K TO 14 REPEAT; FLDNEU(K)=FLDALT(K); END;
      CALL VETEIL(IH,FLDNEU,WEICHE,JAY);
      CASE WEICHE
        ALT /* GEWINNZUG */;
          KAH=IH; WERT=9999;
          GOTO KZUEGE;
        ALT /* VERLUSTZUG */;
          WERT=-9999;
        ALT /* KALAHA-ZUG: WEITER ANALYS */;
          CALL ANALYS(FLDNEU,JAY,TIEFE,WERT,KAH,KT-1,IH);
        ALT /* NORMALZUG */;
          IF TIEFE==1 /* TEST WEITERANALYS */ THEN
            /* STELLUNGSWERT BERECHNEN */;
            WERT=0;
            FOR X FROM -1 BY 2 TO 1 REPEAT;
              SUM=0;
              FOR L TO 6 REPEAT;
                LH=L; IF JAY THEN LH=L+7; FIN;
                IF FLDNEU(LH)/=0 THEN
                  UESCHS=FLDNEU(LH)-7+L;
                  IF UESCHS<0 THEN
                    SUM = SUM+FLDNEU(LH)+7;
                  ELSE
                    UESCHS=(UESCHS+12) REM 13+1;
                    SUM=SUM+ABS(UESCHS-6)-L+7;
                  FIN;
                FIN;
              END;
              WERT=WERT-SUM*FLDNEU(LH+1)*X;
              JAY=NOT JAY;
            END;
          ELSE /* TIEFER ANALYS */;
            CALL ANALYS(FLDNEU,NOT JAY,TIEFE-1,WERT,KAH,KT,IH);
            WERT=-WERT;
          FIN;
      FIN;
      IF WERT GT MAXLST THEN MAXLST=WERT; STZAHL=IH; FIN;
      IF WERT EQ 9999 THEN
        GOTO OPTZUG;
      FIN;
    FIN;
  END;

OPTZUG:
  KAH=STZAHL;
  WERT=MAXLST;
  /* KALAHA-ZUEGE(OPT) ABSPEICHERN */;

KZUEGE:
  IF TIEFE EQ STIEFE AND WERT GE KWERT THEN
    H1=ABS(KT)+1;
    KFELD(H1)=KAH;
    IF WERT GT KWERT THEN SKT=H1; FIN;
    KWERT=WERT;
  FIN;
END;

/* ================================================================== */

KALAHA: TASK;
  F1: FORMAT(A,SKIP);
  F2: FORMAT(SKIP,A,F(3),X(18));
  F4: FORMAT(A,F(3),(2)(A,SKIP));

  DCL (WEICHE,ZUGNR,ZUGCNT,TIEFE,KAH,WERT,REZUG) FIX,
       HLF FIX INIT(1),SK FIX INIT(0),
       ANTW CHAR(1), T1 CHAR(7);

  CALL ASSIGN(TY,'TY');
  PUT 'HERZLICH WILLKOMMEN ZUM KALAH-SPIEL!',
      'ANFÄNGER HABEN SPIELSTÄRKE 1',
      'GUTE SPIELER ETWA SPIELSTÄRKE 3.' TO TY BY R(F1);

NORM:
  IF HLF EQ 1 THEN
    TIEFE=0;
    WHILE TIEFE<=0 REPEAT;
      PUT 'WELCHE SPIELSTAERKE HABEN SIE (>0)? ' TO TY BY SKIP,A;
      GET TIEFE FROM TY BY SKIP(SK),F(2); SK=1;
    END;
    STIEFE=TIEFE;
  FIN;

  FOR I TO 13 REPEAT;FELD(I)=ANZKUG;END;
  FELD(7)=0;
  FELD(14)=0;
  ZUGNR=0;
  ZUGCNT=0;
  ANTW=' ';
  WHILE ANTW NE 'J' AND ANTW NE 'N' REPEAT;
    PUT 'WOLLEN SIE BEGINNEN (J/N)? ' TO TY BY SKIP,A;
    GET ANTW FROM TY BY SKIP,A(1);
  END;
  PUT TEX1,'(SPIELERTOPF NR 1 IST LINKS UNTEN)' TO TY
    BY SKIP,(2) R(F1),X(40);
  CALL SPOUT;
  IF ANTW EQ 'N' THEN GOTO REBEG; FIN;

SPZUG:
  ZUGNR=7;
  WHILE (ZUGNR LE 0 OR ZUGNR GT 6 OR FELD(ZUGNR) EQ 0)
                          AND ZUGNR NE 0 REPEAT;
    SKT=0;
    KWERT=-10000;
    PUT 'WELCHEN TOPF WÄHLEN SIE (1-6)? ' TO TY BY SKIP,A;
    GET ZUGNR FROM TY BY SKIP,F(2);
    IF ZUGNR LT 0 THEN
      STIEFE=ABS(ZUGNR);
      CALL ANALYS(FELD,'0'B,ABS(ZUGNR),WERT,KAH,0,-100);
      IF WERT EQ 9999 OR WERT EQ (-9999) THEN SKT=1; FIN;
      PUT 'VORSCHLAG:' TO TY BY SKIP,A;
      FOR I TO SKT REPEAT; PUT KFELD(I) TO TY BY F(2); END;
      STIEFE=TIEFE;
    FIN;
    SKT=1;
    KFELD(1)=ZUGNR;
  END;
  IF ZUGNR EQ 0 THEN
      FOR K TO 7 REPEAT;
          HLF=FELD(K);
          FELD(K)=FELD(K+7);
          FELD(K+7)=HLF;
      END;
      PUT TEX2 TO TY BY A(40);
      CALL SPOUT;
      GOTO REBEG;
  FIN;
  FOR I TO SKT REPEAT;
      CALL VETEIL(KFELD(I),FELD,WEICHE,'0'B);
      PUT TEX7,KFELD(I) TO TY BY R(F2);
      CALL SPOUT;
      CASE WEICHE
          ALT GOTO SPGWN;
          ALT GOTO REGWN;
          ALT PUT TEX3 TO TY BY A;
              IF I EQ SKT THEN GOTO SPZUG; FIN;
          ALT GOTO REBEG;
      FIN;
  END;

REBEG:
  ZUGCNT=ZUGCNT+1;
  SKT=0;
  KWERT=-10000;
  CALL ANALYS(FELD,'1'B,TIEFE,WERT,KAH,0,0);
  IF WERT EQ 9999 OR WERT EQ (-9999) THEN SKT=1; FIN;
  REZUG=KAH-7;
  FOR I TO SKT REPEAT;
    CALL VETEIL(KFELD(I),FELD,WEICHE,'1'B);
    PUT TEX4,KFELD(I)-7 TO TY BY R(F2);
    CALL SPOUT;
    CASE WEICHE
      ALT GOTO REGWN;
      ALT GOTO SPGWN;
      ALT PUT TEX3 TO TY BY A;
          IF I EQ SKT THEN GOTO REBEG; FIN;
      ALT GOTO SPZUG;
    FIN;
  END;

SPGWN:
  TIEFE=TIEFE+1;
  STIEFE=TIEFE;
  PUT 'SIE HABEN NACH',ZUGCNT,TEX5,'MEIN GLÜCKWUNSCH!',
   'SIE HABEN JETZT SPIELSTÄRKE',TIEFE,TEX6 TO TY
   BY R(F4),A,F(3),SKIP,R(F1);
  T1='SPIELER';
  HLF=0;
  GOTO ENDE;

REGWN:
  PUT 'ICH HABE NACH',ZUGCNT,TEX5,'MEIN BEILEID',TEX6 TO TY
   BY R(F4),A,SKIP;
  T1='RECHNER';
  HLF=1;

ENDE:
  ANTW=' ';
  WHILE ANTW NE 'J' AND ANTW NE 'N' REPEAT;
      PUT 'WÜNSCHEN SIE NOCH EIN SPIEL (J/N)? ' TO TY BY SKIP,A;
      GET ANTW FROM TY BY SKIP,A(1);
  END;
  IF ANTW EQ 'J' THEN GOTO NORM; FIN;
  IF HLF EQ 1 THEN
    PUT TO TY BY X(40);
    TO 60 REPEAT;
      PUT '   HAPPYNESS IS TO WIN AGAINST MAN' TO TY BY A;
    END;
  ELSE
    PUT 'DIE SPIELSTÄRKE IST WOHL ZU HOCH, WAS?' TO TY BY SKIP,A,SKIP;
  FIN;
END;

MODEND;