//#sign:Max: MAXBOX10: 10/07/2017 17:30:31 
unit TicTacToeUnit1;

interface

{uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, Buttons, MPlayer;
  }
//#TODO: from close to free form in control loop  
{Form Declarations--Done by IDE of maXbox4 todo hard mode}
type
  TForm1 = TForm;
  var
    Label1: TLabel;
    MainMenu1: TMainMenu;
    cmGame: TMenuItem;
    cmNew: TMenuItem;
    cmOptionenabled: boolean; //TMenuItem;
    cmEasy: TMenuItem;
    cmNormal: TMenuItem;
    cm2Player: TMenuItem;
    cm1Player: TMenuItem;
    File1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    btn1: TButton;
    btn2: TButton;
    btn3: TButton;
    btn4: TButton;
    btn5: TButton;
    btn6: TButton;
    btn7: TButton;
    btn8: TButton;
    btn9: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    MediaPlayer1: TMediaPlayer;
    statusBar1: TStatusBar;
       procedure cm2PlayerClick(Sender: TObject);
       procedure cmEasyClick(Sender: TObject);
       procedure cmNormalClick(Sender: TObject);
       procedure cmNewClick(Sender: TObject);
       procedure FormCreate(Sender: TObject);
       procedure btn1Click(Sender: TObject);
       procedure btn2Click(Sender: TObject);
       procedure btn3Click(Sender: TObject);
       procedure btn4Click(Sender: TObject);
       procedure btn5Click(Sender: TObject);
       procedure btn6Click(Sender: TObject);
       procedure btn7Click(Sender: TObject);
       procedure btn8Click(Sender: TObject);
       procedure btn9Click(Sender: TObject);
     //private
    { Private declarations--Done by you}
       procedure DoPlay2;
       procedure EnableBoard;
       procedure InitBoard;
       procedure ResetBoard;
       procedure DisableBoard;
       procedure PaintBoard;
       procedure ControlLoop;
       procedure DoPlay1;
       procedure Cmd_Dispatch(choice:byte);
       procedure ShowBoard;
       procedure Think;
       procedure SetBoard;
       function WinnerO(tBoard:LongInt):Boolean;
       function WinnerX(tBoard:Longint):Boolean;
       function Tie:Boolean;
       function In1:Boolean;
       function In2:Boolean;
       function Def1:Boolean;
       function Def2:Boolean;
       function NotValid:Boolean;
     //public
    { Public declarations--done by you }
  //end;

var
  Form1: TForm1;
  I:Byte;
  //myButtons:Array [0..8] of ^TButton;
  ABtns: Array [0..8] of TButton;
  tempSimul,xPoints,oPoints,cat,guess:Integer;
  Board:LongInt;
  xTurn,Player1,Easy,aNormal,Hard,firstMove:Boolean;
  PrevPosition:Integer;

implementation

//{$R *.DFM}

Const SIG ='<--------->';
      ACOMPORT = 6;
      
Procedure BtnFactory(a,b,c,d: smallint; title,apic: string;
                        var abtn: TButton; anEvent: TNotifyEvent);
begin
  abtn:= TButton.create(form1);
  with abtn do begin
    parent:= form1;
    setBounds(a,b,c,d)
    font.size:= 50;
    font.color:= clgreen;
    //glyph.LoadFromResourceName(HINSTANCE, apic); 
    mXButton(5,5,width, height,12,12,handle);
    caption:= title;
    onClick:= anEvent As TNotifyEvent; 
  end;
end; 

Procedure LabelFactory(a,b,c,d: integer; title: shortstring);
begin
  with TLabel.create(self) do begin
    parent:= form1;
    SetBounds(a,b,c,d);
    Caption:= title
  end;
end;

procedure Exit1Click(Sender: TObject);
begin
if assigned(form1) then begin
  try
  form1.onClose:= Nil;
    form1.Release;
     form1:= Nil;
     writeln('Game form Release...')
   except
     writeln('exit click error')
   end;  
 end; 
end;

procedure TFormClose(Sender: TObject; var Action: TCloseAction);
begin
  try
  if assigned(form1) then begin
    form1.modalresult:=MrOK;
    //action:= caFree;
    //form1.release;
  writeln('Game form not free and just close...')
 end;
 except
   writeln(exceptiontoString(exceptiontype, exceptionparam))
 end; 
end;

procedure InitGameForm;
var lbls: byte;
begin
 //MainMenu1:= TMainMenu.create(self)
 form1:= TForm.create(self);
 with form1 do begin
   FormStyle := fsStayOnTop;
   Position:= poScreenCenter;
   caption:='COM Port meets Arduino TicTacToe Pin PortB';
   width:= 700; height:= 560;
    Icon.LoadFromResourceName(HInstance, 'NEWWORKSPACE');
   Menu := MainMenu1;
   //onCreate:= @TFrm_FormCreate;        
   //onCloseQuery:= @FormCloseQuery;
   onClose:= @TFormClose;
   Show;
   //canvas.brush.bitmap:= getBitmapObject(Exepath+BACKMAP);
   //Canvas.FillRect(Rect(600,400,410,100));
 end;
  //Constructors & settings
  //iniPath:= ChangeFileExt(maxform1.scriptname, '.ini');
 
  BtnFactory(260,60,100,100,'&COM','LEDbulbon',btn1,@btn1click);
  BtnFactory(360,60,100,100,'&COM','CL_MPNEXT',btn2,@btn2click);
  BtnFactory(460,60,100,100,'&COM','CL_MPPLAY',btn3,@btn3click);
  BtnFactory(260,160,100,100,'&COM','LEDbulbon',btn4,@btn4click);
  BtnFactory(360,160,100,100,'&COM','CL_MPNEXT',btn5,@btn5click);
  BtnFactory(460,160,100,100,'&COM','CL_MPPLAY',btn6,@btn6click);
  BtnFactory(260,260,100,100,'&COM','LEDbulbon',btn7,@btn7click);
  BtnFactory(360,260,100,100,'&COM','CL_MPNEXT',btn8,@btn8click);
  BtnFactory(460,260,100,100,'&COM','CL_MPPLAY',btn9,@btn9click);
 
  //BtnFactory(500,440,150,55,'&COM About','LEDbulbon',btn1,@btn1click);
  //BtnFactory(440,55,'&COM Setup','CL_MPNEXT',btn2,@btn2click);
  //BtnFactory(340,440,55,'&COM Send','CL_MPPLAY',btn3,@btn3click);
  LabelFactory(265,40,39,13, 'Tic Tac Toe Template for Arduino LED:');

  label1:= TLabel.create(form1)
  with label1 do begin
    parent:= form1;
     setBounds(260,400,50,13)
     Caption:= 'Game Control';
     Font.Color:= clMaroon;
     Font.Size:= 16;
     Font.Style:= [fsBold];
  end;
  label2:= TLabel.create(form1)
  with label2 do begin
    parent:= form1;
     setBounds(400,400,50,13)
     Caption:= 'GameControl2';
     Font.Color:= clyellow;
     Font.Size:= 16;
     Font.Style:= [fsBold];
  end;
  label3:= TLabel.create(form1)
  with label3 do begin
    parent:= form1;
     setBounds(260,430,50,13)
     Caption:= 'Game Control3';
     Font.Color:= clred;
     Font.Size:= 16;
     Font.Style:= [fsBold];
  end;
  label4:= TLabel.create(form1)
  with label4 do begin
    parent:= form1;
     setBounds(400,430,50,13)
     Caption:= 'Game Control4';
     Font.Color:= clred;
     Font.Size:= 16;
     Font.Style:= [fsBold];
  end;
 label5:= TLabel.create(form1)
  with label5 do begin
    parent:= form1;
     setBounds(488,430,50,13)
     Caption:= 'Game Control5';
     Font.Color:= clgreen;
     Font.Size:= 16;
     Font.Style:= [fsBold];
  end;
  with TLabel.create(self) do begin
    parent:= form1;
     setBounds(24,12,69,13)
     Caption:= 'PIN Control';
     Font.Color:= clMaroon;
     Font.Size:= 13;
     Font.Style:= [fsBold];
  end;
  with TLabel.create(self) do begin
    parent:= form1;
     setBounds(155,12,69,13)
     Caption:= 'Arduino PIN';
     Font.Color:= clNavy;
     Font.Size:= 13;
     Font.Style:= [fsBold];
  end;
  lbls:= 42;
  for it:= 1 to 6 do begin
    LabelFactory(80,lbls,39,13, SIG);
    lbls:= lbls+24
  end;
  lbls:= 42;
  for it:= 1 to 9 do begin
    LabelFactory(156,lbls,38,13,'Digit '+inttoStr(it+7));
    lbls:= lbls+24
  end;
  lbls:= 42;
  for it:= 1 to 6 do begin
    LabelFactory(25,lbls,38,13,'LED '+inttoStr(it+9));
    lbls:= lbls+24
  end;
  //MainMenu1:= TMainMenu.create(self)
 { File1:= TMenuItem.create(form1)
    with file1 do begin
      //parent:= form1;
      Caption := 'File'
      mainmenu1.Items.Add(file1); 
      end; 
      N1:= TMenuItem.create(form1)
      with n1 do begin
      parent:= file1;
      file1.add(n1)
        Caption := '-'
      end;
      Exit1:= TMenuItem.create(form1)
      with exit1 do begin
        parent:= file1;
        file1.add(exit1)
        Caption := 'E&xit'
        OnClick := @Exit1Click
      end; }
 
  with TDateTimePicker.Create(self) do begin
    parent:= form1;
    Date;
    top:= 265; left:= 15;
    calAlignment:= albottom;
  end;
  statusBar1:= TStatusBar.create(self);
  with statusBar1 do begin
    parent:= form1;
    //simplepanel:= true;
    showhint:= true;
    hint:= 'this is LED BOX TIC State';
     Panels.add;
     panels.items[0].width:= 200;
     Panels.add;
     panels.items[1].width:= 150;
     statusBar1.panels[0].text:= datetimetostr(now)
  end;
  //COMPortCreate(self); 
end;   //*********************End Form Build************************


procedure cm2PlayerClick(Sender: TObject);
begin
  Player1:=False;
  cmOptionenabled:=False;
  DoPlay2;
  statusBar1.panels[1].text:= 'DoPlay2; click';
end;

procedure cm1PlayerClick(Sender: TObject);
begin
  Player1:=true;
  cmOptionenabled:=False;
  DoPlay1;
  statusBar1.panels[1].text:= 'DoPlay1; click';
end;

procedure cmEasyClick(Sender: TObject);
begin
  Player1 := True;
  xTurn := True;
  Easy := True;
  aNormal := False;
  cmOptionEnabled := False;
  InitBoard;
end;

procedure cmNormalClick(Sender: TObject);
begin
  Player1 := True;
  aNormal  := True;
  Easy    := False;
  cmOptionEnabled := False;
  InitBoard;
end;

procedure ShowBoard;
begin
  if Boolean(1 and Board) then btn1.Caption := 'O';
  if Boolean(2 and Board) then btn2.Caption := 'O';
  if Boolean(4 and Board) then btn3.Caption := 'O';
  if Boolean(8 and Board) then btn4.Caption := 'O';
  if Boolean(16 and Board) then btn5.Caption := 'O';
  if Boolean(32 and Board) then btn6.Caption := 'O';
  if Boolean(64 and Board) then btn7.Caption := 'O';
  if Boolean(128 and Board) then btn8.Caption := 'O';
  {Boolean Only works on bytes--this means they only use Boolean8 type}
  {Shl are a lot faster than multiplies and they are equivalent to multiplying by 2}
  if (256 and Board) = 256 then btn9.Caption := 'O';
  if ((1 shl 16) and Board) = (1 shl 16) then btn1.Caption := 'X';
  if ((2 shl 16) and Board) = (2 shl 16) then btn2.Caption := 'X';
  if ((4 shl 16) and Board) = (4 shl 16) then btn3.Caption := 'X';
  if ((8 shl 16) and Board) = (8 shl 16) then btn4.Caption := 'X';
  if ((16 shl 16) and Board)= (16 shl 16) then btn5.Caption := 'X';
  if ((32 shl 16) and Board)= (32 shl 16) then btn6.Caption := 'X';
  if ((64 shl 16) and Board)= (64 shl 16) then btn7.Caption := 'X';
  if ((128 shl 16) and Board)=(128 shl 16) then btn8.Caption := 'X';
  if ((256 shl 16) and Board)=(256 shl 16) then btn9.Caption := 'X';
  if(xTurn) then Label1.Caption := 'X''s Turn' else
     Label1.Caption := 'O''s Turn';
End;

procedure cmNewClick(Sender: TObject);
begin
  ResetBoard;
  oPoints:=0;
  xPoints:=0;
  cat:=0;
  PaintBoard;
  cmOptionEnabled:=True;
  DisableBoard;
  xTurn := True;
  Label1.Caption := 'X''s Turn';
end;

Procedure SetBoard;
begin
  if ((tempSimul and Board) = 0) and (((tempSimul shl 16) and Board) = 0) then
  begin
    if(xTurn) then begin
      Board := Board or (tempSimul shl 16);
      xTurn := False;
      writeln('debug: xturn:= false')
    end
    else begin
      Board := Board or tempSimul;
      xTurn := True;
      writeln('debug: xturn:= true')
    end;
  end;
  statusBar1.panels[0].text:= datetimetostr(now)
end;

function WinnerO(tBoard:LongInt):Boolean;
begin
  if(((tBoard and 7) = 7) or ((tBoard and 73)=73) or ((tBoard and 273) = 273)
      or ((tBoard and 292) = 292) or ((tBoard and 84) = 84) or
      ((tBoard and 146) = 146) or ((tBoard and 56) = 56) or
      ((tBoard and 448) = 448)) and ((tBoard and 90) <> 90) then
      result := True
    else
      result := False;
end;

function WinnerX(tBoard:LongInt):Boolean;
begin
    if(((tBoard and (7 shl 16)) = (7 shl 16)) or
       ((tBoard and (73 shl 16))=(73 shl 16)) or
       ((tBoard and (273 shl 16)) = (273 shl 16)) or
       ((tBoard and (292 shl 16)) = (292 shl 16)) or
       ((tBoard and (84 shl 16)) = (84 shl 16)) or
       ((tBoard and (146 shl 16)) = (146 shl 16)) or
       ((tBoard and (56 shl 16)) = (56 shl 16)) or
       ((tBoard and (448 shl 16)) = (448 shl 16))) then
      result := True
    else
      result := False;
end;

Procedure EnableBoard;
Begin
  //PrevPosition := MediaPlayer1.Position;
  For I := 0 to 8 do
    //myButtons[I]^.Enabled := True;
    ABtns[I].Enabled := True;
End;

procedure ControlLoop;
Begin
  if(Player1 and xTurn) then DoPlay1 Else DoPlay2;
End;

Procedure DoPlay2;
Begin
  EnableBoard;
  statusBar1.panels[1].text:= 'Human Think DoPlay2;'
End;

Function Tie:Boolean;
begin
  result := True;
  For I:=0 to 8 do
   // if myButtons[I]^.Caption = '' then
    if ABtns[I].Caption = '' then
      result := False;
end;

procedure DoPlay1;
begin
  if(firstMove) then
    guess:=trunc(random(8))
  Else begin
    Think;    //get a guess back!
     statusBar1.panels[1].text:= 'Machine Think DoPlay1;';
    end; 
  Cmd_Dispatch(guess);
  //end;
end;

procedure Cmd_Dispatch(choice:byte);
begin
  firstMove := False;
  tempSimul := 1 shl Choice;
  SetBoard;
  ShowBoard;
  if(xTurn) then begin
    writeln('debug O '+itoa(choice+1))
    ABtns[choice].font.color:= clblue;
    if WinnerO(Board) then begin
      ShowMessage('*** O won ***');
      if(MessageBox(form1.handle,'Play again?','Tic Tac Toe',
                    mb_YesNo or mb_IconQuestion) = idYes) then
        inc(oPoints)
      else
        //Exit1Click(self);
        form1.close;
      ResetBoard;
      ControlLoop;
    end;
    ControlLoop;
  end else begin
    ABtns[choice].font.color:= clgreen;
    writeln('debug X: '+itoa(choice+1))
    if(WinnerX(Board)) then begin
      ShowMessage('*** X won ***');
      if(MessageBox(form1.handle,'Play again?','Tic Tac Toe',
                    mb_YesNo or mb_IconQuestion) = idYes) then
        inc(xPoints)
      else form1.close; //Exit1Click(self);
      ResetBoard;
      ControlLoop;
    end;
    ControlLoop;
  end;
  if(Tie) then begin
    ShowMessage('Cat half wins this time');
    if(MessageBox(form1.handle,'Play again?','Tic Tac Toe',
                  mb_YesNo or mb_IconQuestion) = idYes) then
      inc(Cat)
    else
      form1.close; //Exit1Click(self);
    ResetBoard;
    ControlLoop;
  end;
  PaintBoard;
end;

procedure Think;
begin
  //prethink: guess:= Trunc(Random(9));
  if(Tie) then Exit;
  if(Easy) then begin
    if(Def1) then Exit;
    if(In1) then
      Exit
    else
      While (NotValid) do
        guess:= trunc(Random(9));
  end
  Else if(aNormal) then begin
    if(In1) then
      Exit
    else if(Def1) then
      Exit
    else if (In2) then
      Exit
    else if (Def2) then
      Exit
    else begin
      while (NotValid) do
        guess:= Trunc(Random(9));
    end;
  end;
end;

Procedure InitBoard;
Begin
  firstMove:= True;
  ControlLoop;
End;

Procedure DisableBoard;
Begin
  For I:=0 to 8 do
    //myButtons[I]^.Enabled := False;
    ABtns[I].Enabled := False;
End;

Procedure ResetBoard;
Begin
  {if(MediaPlayer1.Position = PrevPosition) then
    MediaPlayer1.Rewind;
  if(MediaPlayer1.Position = 0) then
    MediaPlayer1.Play;  }
  Board := 0;
  firstMove := True;
  xTurn := True;
  For I:= 0 to 8 do
    //myButtons[I]^.Caption := '';
    ABtns[I].Caption:= '';
  //PrevPosition:=MediaPlayer1.Position;
End;

procedure FormCreate(Sender: TObject);
var ik: byte;
   button: string;
begin
  {Had to make my own indexed command buttons}
//  --> myButtons[0]:=@Button1;
 //for ik:= 0 to 8 do
   // myButtons[ik]:= button+'1' as TButton;
  ABtns[0]:=btn1;
  ABtns[1]:=btn2;
  ABtns[2]:=btn3;
  ABtns[3]:=btn4;
  ABtns[4]:=btn5;
  ABtns[5]:=btn6;
  ABtns[6]:=btn7;
  ABtns[7]:=btn8;
  ABtns[8]:=btn9;
  randomize;
  DisableBoard;
  //MediaPlayer1.FileName := 'mk.mid';
  //MediaPlayer1.Open;
  ResetBoard;
  firstMove := True;
  PrevPosition := -1;
end;

procedure PaintBoard;
begin
  Label3.Caption:='X   : ' + IntToStr(xPoints);
  {Form1.}Label4.Caption:='O   : ' + IntToStr(oPoints);
  Label5.Caption:='Cat: ' + IntToStr(cat);
end;

procedure btn1Click(Sender: TObject);
begin
  Cmd_Dispatch(0);
end;

procedure btn2Click(Sender: TObject);
begin
  Cmd_Dispatch(1);
end;

procedure btn3Click(Sender: TObject);
begin
  Cmd_Dispatch(2);
end;

procedure btn4Click(Sender: TObject);
begin
  Cmd_Dispatch(3);
end;

procedure btn5Click(Sender: TObject);
begin
  Cmd_Dispatch(4);
end;

procedure btn6Click(Sender: TObject);
begin
  Cmd_Dispatch(5);
end;

procedure btn7Click(Sender: TObject);
begin
  Cmd_Dispatch(6);
end;

procedure btn8Click(Sender: TObject);
begin
  Cmd_Dispatch(7);
end;

procedure btn9Click(Sender: TObject);
begin
  Cmd_Dispatch(8);
end;

function In1:Boolean;
var currPos,tBoard:LongInt;
begin
  result:=True;
  I := 0;
  if(xTurn) then begin
    currPos := 1 shl 16;
    while(currPos <= 1 shl 24) do begin
      guess := I;
      //writeln('in1 X think guess '+itoa(guess))
      if(not NotValid) then begin
        tBoard := Board or currPos;
        if(WinnerX(tBoard)) then Exit;
      end;
      inc(I);
      currPos := currPos shl 1;
    end;
  end
  else begin
    currPos:=1;
    while(currPos <= 256) do begin
      guess := I;
         //writeln('else think guess '+itoa(guess))
      if(not NotValid) then begin
        tBoard := Board or currPos;
        if(WinnerO(tBoard)) then Exit;
      end;
      inc(I);
      currPos:=currPos shl 1;
    end;
  end;
  result:=False;
  writeln('in1 false with guess '+itoa(guess))
End;

function In2:Boolean;
var currPos,secPos,tBoard:LongInt;
  J:Byte;
begin
  result:=True;
  I := 0;
  if(xTurn) then begin
    currPos := 1 shl 16;
    while(currPos <= 1 shl 24) do begin
      guess := I;
      //writeln('in2 X think guess '+itoa(guess))
      j:=0;
      secPos := 1 shl 16;
      if(not NotValid) then begin
        tBoard := Board or currPos;
        while(secPos <= 1 shl 24) do begin
          if(J<>I) then begin
            guess := J;
            if(not NotValid) then begin
              tBoard:=tBoard or secPos;
              if(WinnerX(tBoard)) then Exit;
            end;
          end;
          inc(J);
          secPos := secPos shl 1;
        end;
      end;
      inc(I);
      currPos := currPos shl 1;
    end;
  end else begin
    currPos := 1;
    while(currPos <= 1 shl 8) do begin
      //writeln('in2 think guess '+itoa(guess))
      guess := I;
      j:=0;
      secPos := 1;
      if(not NotValid) then begin
        tBoard := Board or currPos;
        while(secPos <= 1 shl 8) do begin
          if(J<>I) then begin
            guess := J;
            if(not NotValid) then begin
              tBoard:=tBoard or secPos;
              guess := 1;
              if(WinnerO(tBoard)) then Exit;
            end;
          end;
          inc(J);
          secPos := secPos shl 1;
        end;
      end;
      inc(I);
      currPos := currPos shl 1;
    end;
  end;
  result:=False;
   writeln('in2 false with guess '+itoa(guess))
End;

function Def1: boolean;
Begin
  result:=False;
  xTurn := not xTurn;
  if(In1) then result := True;
  xTurn := not xTurn;
End;

function Def2: boolean;
Begin
  result:=False;
  xTurn := not xTurn;
  if(In2) then result := True;
  xTurn := not xTurn;
End;

function NotValid: boolean;
begin
  result := True;
  //if(myButtons[guess]^.Caption = '') then NotValid := False;
  if(ABtns[guess].Caption = '') then result := False;
end;

begin  //@main
//writeln(GetProcessId) 
  writeln(GetProcessNameFromPid(GetWindowProcessID(application.handle)))
  writeln(GetWindowProcessName(application.handle));
  
  InitGameForm;
  FormCreate(self)
  //procedure cmNewClick(Sender: TObject);
  cmNewClick(self);
  cmNormalClick(self);
  //procedure cm2PlayerClick(Sender: TObject);
  //cm1PlayerClick(self);
  //cm2PlayerClick(self);
End.


//----app_template_loaded_code----
//----File newtemplate.txt not exists - now saved!----