home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 08 / kalaha / kalaha.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-04-21  |  14.2 KB  |  458 lines
  1. (***********************************************************************
  2. Strategiespiel KALAHA
  3. (c) by Günter Rau
  4.        Pfullinger Str. 87
  5.        7000 Stuttgart 70
  6.  
  7. Usage:
  8.   KALAHA [OFF]
  9.  
  10. Der optionale Parameter gibt an, ob der Lautsprecher eingeschaltet sein
  11. soll oder nicht. (OFF muß groß geschrieben sein!)
  12.  
  13. ************************************************************************)
  14.  
  15.  
  16. program kalaha;
  17. uses constkal,slavekal,crt;
  18.  
  19. type
  20.   wertebereich = 0..steine;
  21.   tzug         = 1..feldlen;
  22.   tzugfolge    = record
  23.                    folge : array[1..maxzug] of tzug;
  24.                    anzahl: 0..maxzug;
  25.                  end;
  26.   tspieler     = (computer,mensch);
  27.   tfeld        = record
  28.                    feld  :  array[1..feldlen] of wertebereich;
  29.                    kalaha:  wertebereich;
  30.                  end;
  31.   tspielstand  = record
  32.                    brett :  array[tspieler] of tfeld;
  33.                    amzug:  tspieler;
  34.                  end;
  35.   inoutfeld    =  record
  36.              x0,y0 : integer;
  37.              hoehe,breite : integer;
  38.           end;
  39.  
  40. var
  41.   anfangsstand,
  42.   endstand         :  tspielstand;
  43.   gewinner         :  tspieler;
  44.   gegner           :  array[tspieler] of tspieler;
  45.   ende,beep        :  boolean;
  46.   staerke          :  integer;
  47.  
  48. procedure init;
  49. var i :integer;
  50. begin
  51.   with brett do begin
  52.   x0 := 5; y0 := 1; xabstand := 5; yabstand := 0; breite := 10; hoehe := 3;
  53.   kalaha1[1] := x0; kalaha1[2] := y0;
  54.   kalaha2[1] := x0; kalaha2[2] := y0+(feldlen+1)*(yabstand+hoehe);
  55.   for i := 1 to feldlen do
  56.     begin
  57.       feld1[i,1] := x0;                 feld1[i,2] := y0 + (yabstand + hoehe)*i;
  58.       feld2[i,1] := x0+breite+xabstand; feld2[i,2] := y0 + (yabstand + hoehe)*i;
  59.     end;
  60.   with infofeld do begin
  61.     x0     := 32; y0    := 22;
  62.     breite := 46; hoehe := 3;
  63.   end;
  64.   with computerinfo do begin
  65.     x0     := 32; y0    := 1;
  66.     breite := 46; hoehe := 3;
  67.   end;
  68.   end;
  69.   gegner[computer] := mensch ; gegner[mensch] := computer;
  70.   spielbrettaufbau;
  71. end;
  72.  
  73. procedure Start;
  74. var
  75.   i : integer;
  76.   antwort : char;
  77.   spieler : tspieler;
  78. begin
  79.   repeat
  80.     infoausgabe('Wer beginnt, Mensch oder Computer ? (m/c) ');
  81.     antwort := readkey;
  82.     if antwort = chr(27) then antwort := 'e';
  83.   until antwort in ['m','M','c','C','e'];
  84.   if antwort <> 'e' then begin
  85.   infoausgabe('Eingabe der Spielstärke (0..10) ');
  86.   readln(staerke);
  87.   end;
  88.   with anfangsstand do
  89.     begin
  90.       case antwort of
  91.         'c','C'  : amzug := computer;
  92.         'm','M'  : amzug := mensch;
  93.     'e'      : begin ende := true; amzug := computer; end;
  94.       end;
  95.       for spieler := computer to mensch do
  96.         begin
  97.           brett[spieler].kalaha := 0;
  98.           for i := 1 to feldlen do
  99.             brett[spieler].feld[i] := steine div (2*feldlen);
  100.         end;
  101.     end;
  102. end;
  103.  
  104. procedure partie;
  105. var
  106.   spielstand  : tspielstand;
  107.   zug : tzug;
  108.  
  109.   function zulaessig(zug : tzug; spieler:tspieler;stand:tspielstand) :
  110.                                                             boolean;
  111.   begin
  112.     zulaessig := stand.brett[spieler].feld[zug] > 0;
  113.   end;
  114.  
  115.   procedure ausgabe(stand : tspielstand);
  116.   var
  117.     i : tzug;
  118.     spieler : tspieler;
  119.   begin
  120.         gotoxy(brett.x0 + (brett.breite*2 + brett.xabstand) div 2,brett.y0+1);
  121.         write(stand.brett[computer].kalaha:2);
  122.         for i := 1 to feldlen do
  123.           begin
  124.         gotoxy(brett.feld1[i,1]+brett.breite div 2-1,brett.feld1[i,2]+1);
  125.             write(stand.brett[mensch].feld[i]:2);
  126.             gotoxy(brett.feld2[i,1]+brett.breite div 2-1,brett.feld2[i,2]+1);
  127.             write(stand.brett[computer].feld[feldlen - i + 1]:2);
  128.           end;
  129.     gotoxy(brett.x0 + (brett.breite*2 + brett.xabstand) div 2,brett.y0 +
  130.                             (feldlen+1)*(brett.yabstand+brett.hoehe)+1);
  131.         write(stand.brett[mensch].kalaha:2);
  132.   end;  (* of ausgabe *)
  133.  
  134.   function spielende(stellung : tspielstand) : boolean;
  135.   var
  136.     i,sum : integer;
  137.   begin
  138.     sum := 0;
  139.     with stellung do
  140.       for i := 1 to feldlen do
  141.         inc(sum,brett[amzug].feld[i]);
  142.     spielende := sum = 0;
  143.   end;
  144.  
  145.   procedure erzeuge(var neu:tspielstand; zug:tzug; alt:tspielstand;
  146.                     anzeige : boolean);
  147.   var
  148.     zugsteine : wertebereich;
  149.     index     : 0..feldlen;
  150.     ich,gegenspieler,spieler : tspieler;
  151.   procedure ziehe;
  152.   begin
  153.     if beep then begin
  154.       sound(300);
  155.       delay(100);
  156.       nosound;
  157.     end;
  158.     delay(300);
  159.   end;
  160.   begin
  161.     neu := alt;
  162.     index := zug;
  163.     with alt do
  164.       begin
  165.         zugsteine := brett[amzug].feld[zug];
  166.         ich := amzug;
  167.       end;
  168.     gegenspieler := gegner[ich];
  169.     spieler := ich;
  170.     neu.brett[spieler].feld[index] := 0;
  171.     if (spieler = mensch) and anzeige then begin
  172.       gotoxy(brett.feld1[index,1]+brett.breite div 2-1,
  173.              brett.feld1[index,2]+1);
  174.       write(neu.brett[spieler].feld[index]:2);ziehe;
  175.     end;
  176.     if (spieler = computer) and anzeige then begin
  177.       gotoxy(brett.feld2[feldlen-index+1,1]+brett.breite div 2-1,
  178.              brett.feld2[feldlen-index+1,2]+1);
  179.       write(neu.brett[spieler].feld[index]:2);ziehe;
  180.     end;
  181.     neu.amzug := gegenspieler;
  182.     repeat
  183.       if index < feldlen then
  184.         begin
  185.           index := index + 1;
  186.           if (zugsteine = 1) and
  187.              (neu.brett[spieler].feld[index] = 0) and
  188.              (spieler = ich) then
  189.              begin
  190.                inc(neu.brett[spieler].kalaha,
  191.                    neu.brett[gegenspieler].feld[feldlen - index +1]+1);
  192.                if (spieler = computer) and anzeige then begin
  193.                  gotoxy(brett.x0 + (brett.breite*2 + brett.xabstand) div 2,brett.y0+1);
  194.                  write(neu.brett[spieler].kalaha:2);ziehe;
  195.                end;
  196.                if (spieler = mensch) and anzeige then begin
  197.               gotoxy(brett.x0 + (brett.breite*2 + brett.xabstand) div 2,brett.y0 +
  198.                             (feldlen+1)*(brett.yabstand+brett.hoehe)+1);
  199.                  write(neu.brett[spieler].kalaha:2);ziehe;
  200.                end;
  201.                neu.brett[gegenspieler].feld[feldlen - index + 1] := 0;
  202.                if (gegenspieler = mensch) and anzeige then begin
  203.              gotoxy(brett.feld1[feldlen - index + 1,1]+brett.breite div 2-1,
  204.                       brett.feld1[feldlen - index + 1,2]+1);
  205.                  write(neu.brett[gegenspieler].feld[feldlen - index + 1]:2);ziehe;
  206.                end;
  207.                if (gegenspieler = computer) and anzeige then begin
  208.                  gotoxy(brett.feld2[index,1]+brett.breite div 2-1,
  209.                         brett.feld2[index,2]+1);
  210.                  write(neu.brett[gegenspieler].feld[feldlen - index + 1]:2);ziehe;
  211.                end;
  212.              end
  213.           else
  214.              begin
  215.                inc(neu.brett[spieler].feld[index],1);
  216.                if (spieler = mensch) and anzeige then begin
  217.              gotoxy(brett.feld1[index,1]+brett.breite div 2-1,
  218.                       brett.feld1[index,2]+1);
  219.                  write(neu.brett[spieler].feld[index]:2);ziehe;
  220.                end;
  221.                if (spieler = computer) and anzeige then begin
  222.                  gotoxy(brett.feld2[feldlen-index+1,1]+brett.breite div 2-1,
  223.                         brett.feld2[feldlen-index+1,2]+1);
  224.                  write(neu.brett[spieler].feld[index]:2);ziehe;
  225.                end;
  226.              end;
  227.           dec(zugsteine,1);
  228.         end
  229.       else
  230.         begin
  231.           if spieler = ich then
  232.             begin
  233.               if zugsteine = 1 then
  234.                 neu.amzug := ich;
  235.               inc(neu.brett[spieler].kalaha,1);
  236.               if (spieler = computer) and anzeige then begin
  237.                 gotoxy(brett.x0 + (brett.breite*2 + brett.xabstand) div 2,brett.y0+1);
  238.                 write(neu.brett[spieler].kalaha:2);ziehe;
  239.               end;
  240.               if (spieler = mensch) and anzeige then begin
  241.             gotoxy(brett.x0 + (brett.breite*2 + brett.xabstand) div 2,brett.y0 +
  242.                             (feldlen+1)*(brett.yabstand+brett.hoehe)+1);
  243.                 write(neu.brett[spieler].kalaha:2);ziehe;
  244.               end;
  245.               dec(zugsteine,1);
  246.               index := 0;
  247.             end
  248.           else
  249.             begin
  250.               index := 0;
  251.             end;
  252.           spieler := gegner[spieler];
  253.         end;
  254.     until zugsteine = 0;
  255.   end;  (* of erzeuge *)
  256.  
  257.   procedure derMenschZieht(var stellung : tspielstand);
  258.   var
  259.     antwort  :  char;
  260.     eingabeEnde : boolean;
  261.   begin
  262.     eingabeEnde := false;
  263.     repeat
  264.       repeat
  265.         infoausgabe('Sie sind am Zug, welches Feld ? ');
  266.         antwort := readkey;
  267.       until antwort in (['1' .. '6' ] + [chr(27)]);
  268.       if antwort = chr(27) then
  269.         begin
  270.           ende := true;
  271.           eingabeEnde := true;
  272.         end
  273.       else
  274.         begin
  275.           zug := ord(antwort) - ord('0');
  276.           if zulaessig(zug,mensch,stellung) then
  277.             begin
  278.               eingabeEnde := true;
  279.               erzeuge(stellung,zug,stellung,true);
  280.             end;
  281.         end;
  282.     until eingabeEnde;
  283.   end; (* of derMenschZieht *)
  284.  
  285.   procedure derComputerZieht(var stellung : tspielstand);
  286.   var
  287.     zugfolge,bestfolge : tzugfolge;
  288.     bestwert,wert : integer;
  289.     i : integer;
  290.     ans : char;
  291.     endermittle : boolean;
  292.  
  293.     function wertung(stand:tspielstand; zfolge:tzugfolge) : integer;
  294.     var
  295.       endstand : tspielstand;
  296.       i : integer;
  297.       spieler : tspieler;
  298.     begin  (* wertung *)
  299.       spieler := stand.amzug;
  300.       endstand := stand;
  301.       for i := 1 to zfolge.anzahl do
  302.         erzeuge(endstand,zfolge.folge[i],endstand,false);
  303.       wertung := endstand.brett[spieler].kalaha -
  304.                     stand.brett[spieler].kalaha;
  305.     end; (* of wertung *)
  306.  
  307.     function maxwert(start : tspielstand) : integer;
  308.     var
  309.       max,wert : integer;
  310.       spieler : tspieler;
  311.       bestzug : tzugfolge;
  312.  
  313.     procedure analyse(var bestzug : tzugfolge; altstand:tspielstand);
  314.     var
  315.       probezug : tzug;
  316.       neustand : tspielstand;
  317.     begin
  318.       for probezug := 1 to feldlen do
  319.         begin
  320.           if altstand.amzug = spieler then
  321.             begin
  322.               if zulaessig(probezug,spieler,altstand) then
  323.                 begin
  324.                   inc(bestzug.anzahl,1);
  325.                   erzeuge(neustand,probezug,altstand,false);
  326.                   bestzug.folge[bestzug.anzahl] := probezug;
  327.                   analyse(bestzug,neustand);
  328.                   dec(bestzug.anzahl,1);
  329.                 end;
  330.             end
  331.           else
  332.             begin
  333.               wert := wertung(start,bestzug);
  334.               if max < wert then max := wert;
  335.             end;
  336.         end;
  337.     end;  (* of analyse *)
  338.  
  339.     begin  (* maxwert *)
  340.       bestzug.anzahl := 0;
  341.       max := 0;
  342.       spieler := start.amzug;
  343.       analyse(bestzug,start);
  344.       maxwert := max;
  345.     end;   (* of maxwert *)
  346.  
  347.     procedure ermittle( var bestzug : tzugfolge; stand : tspielstand);
  348.     var
  349.       probezug : integer;
  350.       i : integer;
  351.       neustand : tspielstand;
  352.       ans : char;
  353.     begin (* ermittle *)
  354.       if spielende(stand) then
  355.         begin
  356.           endermittle := true;
  357.         end;
  358.       probezug := 1;
  359.       while (probezug <= feldlen) and (not endermittle) do
  360.         begin
  361.           if stand.amzug = computer then
  362.             begin
  363.               if zulaessig(probezug,computer,stand) then
  364.                 begin
  365.                   inc(bestzug.anzahl,1);
  366.                   erzeuge(neustand,probezug,stand,false);
  367.                   bestzug.folge[bestzug.anzahl] := probezug;
  368.                   ermittle(bestzug,neustand);
  369.                   dec(bestzug.anzahl,1);
  370.                 end;
  371.             end
  372.           else
  373.             begin
  374.               wert := wertung(stellung,bestzug)-maxwert(stand);
  375.               if bestwert < wert then
  376.                 begin
  377.                   bestwert := wert;
  378.                   bestfolge := bestzug;
  379.                 end;
  380.               if bestwert >= staerke then endermittle := true;
  381.             end;
  382.           inc(probezug,1);
  383.         end; (* of while *)
  384.     end;  (* of ermittle *)
  385.  
  386.   begin (* derComputerZieht *)
  387.     bestwert := -100;
  388.     infoausgabe('der Computer zieht ... ');
  389.     cinfoausgabe('                                          ');
  390.     zugfolge.anzahl := 0;   bestfolge.anzahl := 0;
  391.     endermittle := false;
  392.     ermittle(zugfolge,stellung);
  393.     infoausgabe('fertig mit rechnen, drücke CR ');
  394.     ans := readkey;
  395.     cinfoausgabe('Zugfolge : ');
  396.     for i := 1 to bestfolge.anzahl do write(bestfolge.folge[i]:2,' ');
  397.     for i := 1 to bestfolge.anzahl do
  398.       begin
  399.         infoausgabe('Zug Nummer : ');write(i:2,'         Drücke CR ');
  400.         ans := readkey;
  401.         erzeuge(stellung,bestfolge.folge[i],stellung,true);
  402. (*    if i <> bestfolge.anzahl then
  403.            ausgabe(stellung);        *)
  404.       end;
  405.     cinfoausgabe('                                          ');
  406.     stellung.amzug := mensch;
  407.   end;  (* of derComputerZieht *)
  408.  
  409. begin (* Partie *)
  410.   spielstand := anfangsstand;
  411.   endstand := spielstand;
  412.   ausgabe(spielstand);
  413.  
  414.   while (not spielende(spielstand)) and (not ende) do
  415.     begin
  416.       case spielstand.amzug of
  417.         computer : derComputerZieht(spielstand);
  418.         mensch   : derMenschzieht(spielstand);
  419.       end;
  420.       endstand := spielstand;
  421.     (*  ausgabe(spielstand); *)
  422.     end;
  423. end; (* of Partie *)
  424.  
  425. procedure gewinnentscheidung;
  426. var csteine,msteine,i : integer;
  427. begin
  428. csteine := 0; msteine := 0;
  429.   for i := 1 to feldlen do
  430.     begin
  431.       csteine := csteine + endstand.brett[computer].feld[i];
  432.       msteine := msteine + endstand.brett[mensch].feld[i];
  433.     end;
  434.   csteine := csteine + endstand.brett[computer].kalaha;
  435.   msteine := msteine + endstand.brett[mensch].kalaha;
  436.   if msteine = csteine then
  437.     cinfoausgabe('unentschieden');
  438.   if msteine > csteine then
  439.     cinfoausgabe('Sie haben gewonnen ! ');
  440.   if msteine < csteine then
  441.     cinfoausgabe('Der Computer hat gewonnen ! ');
  442. end;
  443.  
  444. begin  (* main *)
  445.   beep := true;
  446.   if paramcount > 0 then begin
  447.     if paramstr(1) = 'OFF' then beep := false;
  448.   end;
  449.   ende := false;
  450.   Beschreibung;
  451.   init;
  452.   repeat
  453.     start;
  454.     partie;
  455.     gewinnentscheidung;
  456.   until ende;
  457. end.
  458.