{*****************************************************}
{ 4Gewinnt Game  "the fantastic four"                 }
{ RECHNER.INC: Include-File mit der implementierten   }
{              Strategieroutine für 4GEWINNT.PAS      }
{ --------------------------------------------------- }
{ Autor       : Max Kleiner T-Ask                     }
{ Lang        : Borland Pascal for Win  
  loc's= 616  : 1995 - 2019 remake for maXbox4        }
{*****************************************************}

//Task: Set an event-handler for On_Maximize and On_Minimize to reDraw the Game!

Const { maximale Bewertung }
      Unendlich = 32000;
      { Wert einer Reihe wo schon drei Steine einer Farbe sind}
      Wert2 = 8;
      { Wert einer Reihe wo schon zwei Steine einer Farbe sind}
      Wert3 = 30;
      N                    = 6;       //N * M   row * col
      M                    = 7;       //col
      BLAU                 = 1;
      ROT                  = 10;
      BORDER               = 20;
      BSUM                 = 256;

 Type
      { Rechentiefe für die einzelnen Spielstärken }
      TRechentiefe = Array[0..3] Of Integer;
      TZeilenVektor = array[1..M] of Integer;    //Row inside
      TSpielMatrix = array[1..N] of TZeilenVektor;
  
      { Wert der Stein Position - Stone Position Value SPV }
      {PosWert : SpielMatrix = ((3, 4, 5, 7, 5, 4, 3),
                               ( 4, 6, 8,10, 8, 6, 4),
                               ( 5, 8,11,13,11, 8, 5),
                               ( 5, 8,11,13,11, 8, 5),
                               ( 4, 6, 8,10, 8, 6, 4),
                               ( 3, 4, 5, 7, 5, 4, 3));}
                               
 var  deepc: TRechentiefe;                           
      SM, SpM, p: TSpielMatrix;
      ZA, Count:  TZeilenVektor;
      Drei_Rot, Drei_Blau, Ende, Equal, compute,
                      Sieg_Rot, Sieg_Blau, ChangeColor: Boolean;
      RWert: Array[0..40] of Integer;
      CompStart, Best, Delta, StX, StY, L1, Color: Integer;
      Abbruch: Boolean;    
      pForm: TForm;   // _4Gewinnt: TVierGewinnt;
      Grad: Byte;
      Score: Longint;

 
procedure WMRechner; forward;

procedure initMatrix;
begin
  deepc[0]:= 4;   deepc[1]:= 4;
  deepc[2]:= 5;   deepc[3]:= 6;
  
  //ZeilenVektor = (4,3,5,2,6,7,1);
  ZA[1]:= 4; ZA[2]:= 3; ZA[3]:= 5;
  ZA[4]:= 2; ZA[5]:= 6; ZA[6]:= 7; ZA[7]:= 1;

  p[1][1]:=3; p[1][2]:=4; p[1][3]:=5;  p[1][4]:=7;  p[1][5]:=5;  p[1][6]:=4; p[1][7]:=3;
  p[2][1]:=4; p[2][2]:=6; p[2][3]:=8;  p[2][4]:=10; p[2][5]:=8;  p[2][6]:=6; p[2][7]:=4;
  p[3][1]:=5; p[3][2]:=8; p[3][3]:=11; p[3][4]:=13; p[3][5]:=11; p[3][6]:=8; p[3][7]:=5;
  p[4][1]:=5; p[4][2]:=8; p[4][3]:=11; p[4][4]:=13; p[4][5]:=11; p[4][6]:=8; p[4][7]:=5;
  p[5][1]:=4; p[5][2]:=6; p[5][3]:=8;  p[5][4]:=10; p[5][5]:=8;  p[5][6]:=6; p[5][7]:=4;
  p[6][1]:=3; p[6][2]:=4; p[6][3]:=5;  p[6][4]:=7;  p[6][5]:=5;  p[6][6]:=4; p[6][7]:=3;
end;

Procedure T4GwWindow_Anfaenger;   //cm prototype 1995!
Begin
  {MyMenu:= GetMenu(HWindow);
  CheckMenuItem(MyMenu,cm_Anfaenger+Grad,
                mf_ByCommand+mf_Unchecked);
  Grad:= 0;}
End;


Function Auswertung(stufe: integer; rs: byte): integer;
var BW: integer;
Begin
  Drei_Rot:= rS=30;
  Drei_Blau:= rS=3;
  If rS>1 Then
    If rS=40 Then Begin
      result:= -30000-Stufe;
      If Stufe=100 Then
        result:= -Unendlich;
      Ende:= True;
    End Else
    If rS=4 Then Begin
      result:= 30000+Stufe;
      If Stufe=100 Then
        result:= Unendlich;
      Ende:= True;
    End Else
      BW:= BW + RWert[rS];
     //Inc(BW,RWert[S]);
End;

{-----------------------------------------------------}
{*****************************************************}
{ T4GwWindow.Rechner: Reaktion auf Meldung wm_rechner }
{                     In dieser Routine wird der Zug  }
{                     für den Computer mit Hilfe      }
{                     Minimaxstrategie und AlphaBeta- }
{                     Abschneidung ermittelt.         }
{*****************************************************}
{*****************************************************}
{ Mit Hilfe dieser Funktion wird die jeweilige Spiel- }
{ stellung bewertet.                                  }
{*****************************************************}

Function Bewertung(Stufe: Integer): Integer;
Var BW, S, i, j, k, Help: Integer;
  {-------------------------------------------------}
  { Hilfsprozedur zur Auswertung der Spielstellung  }
  {-------------------------------------------------}
Begin
  BW:= 0;
  {-------------------------------------------------}
  { Bewertungskriterium 1:                          }
  {   Werte der einzelnen Spielsteinpositionen      }
  {-------------------------------------------------}
  For j:= 1 To M Do
    For i:= 1 To Count[j] Do Begin
      If SM[i][j]=1 Then
        BW:= BW+P[i][j];
      If SM[i][j]=10 Then
        BW:= BW-P[i][j];
    End;
  {-------------------------------------------------}
  { Bewertungskriterium 2:                          }
  {   Bewertung der jeweiligen Zweier-, Dreier- und }
  {   Viererreihen der Spielstellung                }
  {-------------------------------------------------}
  Ende:= False;

  {-------- senkrechte Reihen --------}
  For j:= 1 To M Do Begin
    Help:= Count[j];
    If Help>3 Then Help:= 3;
    For i:= 1 To Help Do Begin
      S:= SM[i][j]+SM[i+1][j]+SM[i+2][j]+SM[i+3][j];
      result:= Auswertung(stufe,S);
      If Ende Then Exit;
      If Drei_Rot Then
        For k:= 0 To 3 Do
          If SM[i+k][j]=0 Then
            If i+k And 1=CompStart Then
              BW:= BW-RWert[3];
              //Dec(BW,RWert[3]);
      If Drei_Blau Then
        For k:= 0 To 3 Do
          If SM[i+k][j]=0 Then
            If i+k And 1=1-CompStart Then
              BW:= BW + RWert[3];
              //Inc(BW,RWert[3]);
    End; //for
  End; //for

  {-------- waagrechte Reihen --------}
  For j:= 1 To M-3 Do
    For i:= 1 To N Do Begin
      S:= SM[i][j]+SM[i][j+1]+SM[i][j+2]+SM[i][j+3];
      result:= Auswertung(stufe,S);
      If Ende Then Exit;
      If Drei_Rot And (j>1) Then
        If j And 1=CompStart Then
          BW:= BW-3*RWert[3];
          //Dec(BW,3*RWert[3]);
      If Drei_Blau And (j>1) Then
        If j And 1=1-CompStart Then
          BW:= BW + 3*RWert[3];
          //Inc(BW,3*RWert[3]);
    End;
  {-------- diagonale Reihen --------}
  For i:= 1 To N-3 Do
    For j:= 1 To M-3 Do Begin
      S:= SM[i][j]+SM[i+1][j+1]+SM[i+2][j+2]+SM[i+3][j+3];
      result:= Auswertung(stufe,S);
      If Ende Then Exit;
      If Drei_Rot Then
        For k:=0 To 3 Do
          If SM[i+k][j+k]=0 Then
            If i+k And 1=CompStart Then
              BW:= BW - 2*RWert[3];
              //Dec(BW,2*RWert[3]);
      If Drei_Blau Then
        For k:=0 To 3 Do
          If SM[i+k][j+k]=0 Then
            If i+k And 1=1-CompStart Then
              BW:= BW-2*RWert[3];
              //Inc(BW,2*RWert[3]);
      S:= SM[i+3][j]+SM[i+2][j+1]+SM[i+1][j+2]+SM[i][j+3];
      result:= Auswertung(stufe,S);
      If Ende Then Exit;
      If Drei_Rot Then
        For k:=0 To 3 Do
          If SM[i+3-k][j+k]=0 Then
            If i+3-k And 1=CompStart Then
              BW:= BW-2*RWert[3];
      If Drei_Blau Then
        For k:= 0 To 3 Do
          If SM[i+3-k][j+k]=0 Then
            If i+3-k And 1=1-CompStart Then
              BW:= BW+2*RWert[3];
    End; //for
  result:= BW;
End;

{*****************************************************}
{ Ermittlung des besten Zuges für den Computer mit    }
{ Hilfe der MiniMax-Strategie und dem AlphaBetaCut    }
{ Diese rekursive Funktion liefert schließlich den    }
{ Wert der Spielstellung zurück. Der beste Spielzug   }
{ ist dann in der Variable Bester abgelegt.           }
{*****************************************************}

Function MiniMax(Wert,Tiefe,Alpha: Integer): Integer;
Var i,j, Help, Zug, Beta: Integer;
             AlphaBetaCut: Boolean;
Begin
  If Not Abbruch Then Begin
    If (Abs(Bewertung(Tiefe+1))>=29000) OR
       (Count[1]+Count[2]+Count[3]+Count[4]+
        Count[5]+Count[6]+Count[7]>= 42) Then
      result:= Bewertung(Tiefe+1)
    Else Begin
      {While PeekMessage(HMsg,HWindow,0,0,pm_Remove) Do
        If (HMsg.Message=wm_SysCommand) And
           (HMsg.WParam=sc_Close) Then Abbruch:=True
        Else while Application.ProcessMesages do
         //Abbruch:= true; }
      If Wert=1 Then
        Beta:= -Unendlich
      Else
        Beta:= Unendlich;
      Zug:= 0;
      AlphaBetaCut:=False;
      If Tiefe>0 Then Begin
        For i:= 1 To M Do Begin
          j:= ZA[i];
          If (Count[j]<N) AND NOT AlphaBetaCut Then Begin
            Inc(Count[j]);
            SM[Count[j]][j]:= Wert;
            If Tiefe>1 Then
              Help:= MiniMax(Blau+Rot-Wert,Tiefe-1,Beta)
            Else
              Help:= Bewertung(Tiefe);
            SM[Count[j]][j]:= 0;
            Dec(Count[j]);
            If Wert=Blau Then Begin
              If Help>Beta Then Begin
                Beta:= Help;
                Zug:= j;
              End;
              If Beta>Alpha Then
                AlphaBetaCut:=True;
            End
            Else Begin
              If Help<Beta Then Begin
                Beta:= Help;
                Zug:= j;
              End;
              If Beta<Alpha Then
                AlphaBetaCut:= True;
            End;
          End; //If
        End; //For
        result:= Beta;
      End //If
      Else result:= Bewertung(Tiefe+1);
      pform.Canvas.TextOut(3, BORDER-15, 'Think Level: '+intToStr(Tiefe));
    End;
   Best:= Zug;
  End;
End;

{**************************************************************}
{ Hilfsfunktion zur Bestimmung, ob das Spiel noch weiter geht  }
{**************************************************************}
Function SpielEnde: Boolean;
Begin
  result:= True;
  If Bewertung(100)<=-Unendlich Then
    Sieg_Rot:= True
  Else
    If Bewertung(100)>=Unendlich Then
      Sieg_Blau:= True
  Else
    If Count[1]+Count[2]+Count[3]+Count[4]+
         Count[5]+Count[6]+Count[7]= N*M Then
           Equal:= True
    Else
      result:= False;
End;

/////from main game form
Function FarbWert(W: Word): TColorRef;  //TColor?
Begin
  Case W Of
    0: result:= RGB2TColor($BF,$BF,$BF);
    1: result:= RGB2TColor($00,$00,$00);
    2: result:= RGB2TColor($FF,$FF,$FF);
    3: result:= RGB2TColor($FF,$00,$ff);
    4: result:= RGB2TColor($00,$00,$00);
    5: result:= RGB2TColor($00,$00,$FF);
    6: result:= RGB2TColor($F7,$00,$00);
    7: result:= RGB2TColor($7F,$7F,$7F);
  End;
End;


Procedure Reset;
Var i,j: Integer;
Begin
  compute:= False;
  Sieg_Rot:= False;
  Sieg_Blau:= False;
  Equal:= False;
  For i:= 1 To N Do
    For j:= 1 To M Do SpM[i][j]:= 0;
  For j:= 1 To M Do Count[j]:= 0;
  Delta:= 0;
End;


Procedure WM_SetzeStein(wparam, lparam: integer);
Var //DC: HDC;
    XPos, YPos, X, Y: Integer;
Begin
  Y:= 7-wParam Mod BSUM;
  X:= wParam Div BSUM;
  XPos:= StX+(X-1)*L1+2;
  YPos:= StY+(Y-1)*L1+2;
  //DC:=GetDC(HWindow);
    if changeColor then 
      pForm.Canvas.brush.Color:= FarbWert(lparam+2)
    else
      pForm.Canvas.brush.Color:= FarbWert(lparam+color);
   //SelectObject(DC,Brush);
   pForm.Canvas.Ellipse(XPos,Ypos,Xpos+L1-3,Ypos+L1-3);
   //pform.Canvas.TextOut(xpos,ypos,inttostr(p[y][x])); //debug the values
   //ReleaseDC(HWindow,DC);
End;

//********************** Set the Game Board Form *****************************     
Procedure Spielfeld;
Var NRect: TRect;
    Breite, Hoehe, i: Integer;
Begin
  //pForm.canvas.GetClientRect(HWindow,Rect);
  //DC:=GetDC(HWindow);
  with pForm.Canvas do begin
    brush.color:= FarbWert(0+color);
    NRect:= Rect(0,0,pform.width-BORDER,pform.height-(2*BORDER)-1);
    FillRect(NRect);
    Breite:= (NRect.Right-BORDER) Div M;
    Hoehe:= (NRect.Bottom-(2*BORDER)) Div N;
    If Breite>Hoehe Then L1:= Hoehe Else L1:= Breite;
    Brush.color:= FarbWert(3+color);
    StX:= (NRect.Right-L1*M) Div 2;
    StY:= (NRect.Bottom-L1*N) Div 2;
    Rectangle(StX,StY,L1*M+StX+1,L1*N+StY+1);
    For i:= 1 To M-1 Do Begin
      MoveTo(L1*i+StX,StY);
      LineTo(L1*i+StX,StY+L1*N);
    End;
    For i:= 1 To N-1 Do Begin
      MoveTo(StX,L1*i+StY);
      LineTo(L1*M+StX,L1*i+StY);
    End;
  End; //with  
  //Sbutton.top:= pForm.height-4*BORDER; debug
  //ReleaseDC(HWindow,DC);
End;

Procedure Gewonnen;
Var mRect: TRect; GMsg: PChar;
Begin
  GMsg:='';
  If Sieg_Rot Then GMsg:='  Wow Gratulation to win!!';
  If Sieg_Blau Then GMsg:='  Sorry, You lost!';
  If Equal Then GMsg:='  Same for two ';
  If Sieg_Rot Or Sieg_Blau Or Equal Then Begin
    //GetClientRect(HWindow,Rect);
    mRect.Bottom:= BORDER;
    //Showmessage(GMsg);  //debug
    pform.Canvas.TextOut(3, mrect.bottom-BORDER+5, GMsg);
  End;
End;


//**************************** Event Handler ******************************
Procedure aWM_Paint(Sender: TObject);
Var i, j: Word;
Begin
  Color:= 4;
  Spielfeld;
  For i:= 1 To M Do
    For j:= 1 To Count[i] Do Begin
      If SpM[j][i]=Rot Then 
         WM_Setzestein(i*BSUM+j,2);
      If SpM[j][i]=Blau Then
         WM_Setzestein(i*BSUM+j,1);
    End;
  Gewonnen;
End;

procedure FormCloseClick(Sender: TObject; var Action: TCloseAction);
begin
  //myImage.Free;
  Writeln('4Gewinnt Form Closed at: '+ TimeToStr(Time));
  //pFrm.Free;
  Abbruch:= True;
  Screen.Cursor:= crDefault;
  Action:= caFree;
end;

     
//Procedure WMMouseMove;
procedure GewinntMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
Var XPos, X1: Integer;
    Help1, Help2: Integer;
begin
  If Not compute Then Help1:= crArrow
    Else Help1:= crHourglass;
  If Not compute Then Help2:= crCross  //idc_cross
    Else Help2:= crHourglass;
  XPos:= X;
  If (XPos>StX) AND (XPos<StX+M*L1) AND NOT
     (Sieg_Rot OR Sieg_Blau Or Equal) Then Begin
       X1:=(XPos-StX) Div L1+1;     //shows possible move
       If X1>7 Then X1:= 7;
       If X1<1 Then X1:= 1;
       If Count[X1]<N Then Screen.Cursor:= Help2
         Else Screen.Cursor:= help1   //SetCursor(LoadCursor(0,Help1));
     End
  Else Screen.Cursor:= help1;
End;

//Procedure T4GwWindow.WMLButtonDown;
procedure MouseDownLeft(sender: TObject; Button: TMouseButton; 
                          Shift: TShiftState; X, Y: Integer);
Var XPos, X1, cntint: Word;
Begin
  XPos:= X;  
  If (XPos>StX) AND (XPos<StX+M*L1) AND NOT
    (Sieg_Rot OR Sieg_Blau OR Equal) Then
  Begin
    X1:= (XPos-StX) Div L1+1;
    If X1> M Then X1:= M;
    If X1< 1 Then X1:= 1;
    If Count[X1] < N Then Begin
      Inc(Count[X1]);
      If Count[X1]= N Then Inc(Delta);
      cntint:= Count[X1]
      SpM[cntint][X1]:= Rot;
      WM_Setzestein(X1*BSUM+Count[X1],2);
      WMRechner; //Bewertung, Auswertung(1);
    End;
  End;
End;
    

Procedure InitGame;
Begin
  //TWindow.Init(NIL,AName);
  //Attr.Menu:=LoadMenu(HInstance,'MENU');
  Grad:= 1;         //levels 0 - 3;  3 as Expert
  CompStart:= 1;
  changeColor:= false;
  Reset;
End;

procedure ButtonReset(sender: TObject);
begin
  InitGame;
  Spielfeld;
end;  

procedure EChangeColor(sender: TObject);
begin
  changeColor:= NOT changeColor;
end; 

procedure EChangeLevel(sender: TObject);
begin
  Grad:= 3;  //highest level 
end;  


procedure FormTCreate(Sender: TObject);
//var label1: TLabel; bevel1,bevel2: TBevel;  for future expansion
var mi, mi1, mi2: TMenuItem;
    mt: TMainMenu; 
    sbutton: TButton;
begin
  //SetFigures;
  //RedrawSheet:= True;
  {bevel1:= TBevel.create(pform)
  bevel1.parent:= pForm;
  bevel2:= TBevel.create(pform)
  bevel2.parent:= pForm;
  label1:= TLabel.create(pform)
  label1.parent:= pForm;}

  pform:= TForm.Create(self);   //constructors
  sButton:= TButton.Create(pform)
  with pform do begin
    caption:= '4Gewinnt GameBox 2019 for maXbox4';  
    //BorderStyle:= bsDialog;
    Position:= poScreenCenter;
    onMouseDown:= @MouseDownLeft;
    onMouseMove:= @GewinntMouseMove;
    onPaint:= @aWM_Paint;
    onClose:= @FormCloseClick;
    Icon.LoadFromResourceName(HInstance, 'NEWDELPHIDATA');
    //KeyPreview:= true;
    //height:= 155;
    ClientWidth:= pForm.Width+150; 
    ClientHeight:= pForm.height+150;
    Show;
  end;  
  with SButton do begin
    parent:= pForm;
    caption:= 'Reset'
    top:= pForm.height-4*BORDER-5;
    width:= 4*BORDER;
    onclick:= @ButtonReset;
  end; 
  mt:= TMainMenu.Create(pForm)
  with mt do begin
   //parent:= frmMon;
  end;  
  mi:= TMenuItem.Create(mt)
  mi1:= TMenuItem.Create(mt)
  mi2:= TMenuItem.Create(mt)
  with mi do begin
    //parent:= frmMon;
    Caption:='New Game';
    Name:='ITEM';
    mt.Items.Add(mi);   
    OnClick:= @ButtonReset;
  end;
  with mi1 do begin
    //parent:= frmMon;
    Caption:='Change Color';
    mt.Items.Add(mi1) ;
    OnClick:= @EChangeColor
  end;
  with mi2 do begin
    //parent:= frmMon;
    Caption:='High Level';
    mt.Items.Add(mi2);
    OnClick:= @EChangeLevel;
  end;
  Spielfeld;
  //Grad:= 1;
  Score:= 0;
end;

{*****************************************************}
{      Hauptteil der Methode T4GwWindow.Rechner       }
{*****************************************************}
//Procedure T4GwWindow_Rechner;

procedure WMRechner;
var i,j: Integer;   // from Rechner
begin
  For i:=0 To 40 Do RWert[i]:= 0;
  RWert[3]:= Wert3;
  RWert[30]:= -Wert3;
  RWert[2]:= Wert2;
  RWert[20]:= -Wert2;
  SM:= SpM;
    {for I:= 1 to N do
      for j:= 1 to M do SM[i][j]:= SpM[i][j];}
  If Not SpielEnde Then Begin
    Screen.Cursor:= crHourglass;//SetCursor(LoadCursor(0,idc_wait));
    compute:= True;
    Abbruch:= False;
    MiniMax(Blau, deepc[Grad]+Delta,Unendlich);
    If Abbruch Then Showmessage('PostQuitMessage(0) or Game Closed')
    Else
    If (Count[Best]<N) AND (Best>0) Then Begin
      Inc(Count[Best]);
      If (Count[Best]=N) AND (Grad>0) Then
        Inc(Delta);
      SpM[Count[Best]][Best]:= Blau;
      WM_Setzestein(Best*BSUM+Count[Best],Blau);
      SM:= SpM;  //!
    End; //If
  End;
  SpielEnde;
  Gewonnen;  //SendMessage(HWindow,wm_gewonnen,0,0);
  compute:= False;
  //SetCursor(LoadCursor(0,idc_arrow));
  Screen.Cursor:= crArrow;
end;

Procedure InitComputerStart;
Begin
  Reset;
  CompStart:= 1;
  WMRechner;
End;


Begin     //Main Control
  initMatrix;
  initGame;
  FormTCreate(self);
  WMRechner;
End.
{******************************T-Ask maXPlay4 Series***********************}