//#sign:Max: MAXBOX10: 11/07/2017 10:46:15 
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;

var il: byte;      
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:= 65;
    font.color:= clgreen;
    inc(il)
    name:= 'btn'+itoa(il);
     //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;
    sleep(500)
    //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;
   color:= clGreen;
   //onCreate:= @TFrm_FormCreate;        
   //onCloseQuery:= @FormCloseQuery;
   onClose:= @TFormClose;
   Show;
   //canvas.stretchdraw(rect(0,0,width,height), 
     //        getbitmap(Exepath+'\examples\brightfullmoon.bmp'));
   //canvas.brush.bitmap:= getBitmapObject(Exepath+BACKMAP);
   //Canvas.FillRect(Rect(600,400,410,100));
 end;
  //Constructors & settings
  BtnFactory(260,80,100,100,'&COM','LEDbulbon',btn1,@btn1click);
  BtnFactory(360,80,100,100,'&COM','CL_MPNEXT',btn2,@btn2click);
  BtnFactory(460,80,100,100,'&COM','CL_MPPLAY',btn3,@btn3click);
  BtnFactory(260,180,100,100,'&COM','LEDbulbon',btn4,@btn4click);
  BtnFactory(360,180,100,100,'&COM','CL_MPNEXT',btn5,@btn5click);
  BtnFactory(460,180,100,100,'&COM','CL_MPPLAY',btn6,@btn6click);
  BtnFactory(260,280,100,100,'&COM','LEDbulbon',btn7,@btn7click);
  BtnFactory(360,280,100,100,'&COM','CL_MPNEXT',btn8,@btn8click);
  BtnFactory(460,280,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,42,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:= 18;
     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:= 18;
     Font.Style:= [fsBold];
  end;
  label4:= TLabel.create(form1)
  with label4 do begin
    parent:= form1;
     setBounds(360,430,50,13)
     Caption:= 'Game Control4';
     Font.Color:= clred;
     Font.Size:= 18;
     Font.Style:= [fsBold];
  end;
 label5:= TLabel.create(form1)
  with label5 do begin
    parent:= form1;
     setBounds(488,430,50,13)
     Caption:= 'Game Control5';
     Font.Color:= clyellow;
     Font.Size:= 18;
     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)
  with TDateTimePicker.Create(self) do begin
    parent:= form1;
    Date;
    top:= 280; 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
    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 
    Think;    //get a guess back!
  statusBar1.panels[1].text:= 'Machine Think DoPlay1;';
  Cmd_Dispatch(guess);
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
    case in1 of
      true: exit
    end;  
    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
    ABtns[I].Caption:= '';
  //PrevPosition:=MediaPlayer1.Position;
End;

procedure FormCreate(Sender: TObject);
var ik: byte;
begin
  {Had to make my own indexed command buttons} //  --> myButtons[0]:=@Button1;
 for ik:= 0 to 8 do
    ABtns[ik]:= TButton(form1.FindComponent('btn'+itoa(ik+1)));
    
    {for I := 0 to Form1.ControlCount - 1 do
      if form1.Controls[I] is TButton then
           writeln(TButton(Form1.Controls[I]).name);  }
  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;
      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.

{ref: Declaration
function FindComponent(const AName: string): TComponent;

Description
The FindComponent method returns the component in the Components
array property with the name that matches the string in the AName
parameter. FindComponent is not case sensitive. 

Der folgende Satz ist richtig!
Der vorherige Satz ist falsch!

}


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