Task: Tic-tac-toe








VB: Option Explicit

Private Lines(1 To 3, 1 To 3) As String
Private Nb As Byte, player As Byte
Private GameWin As Boolean, GameOver As Boolean

Sub Main_TicTacToe()
Dim p As String

    InitLines
    printLines Nb
    Do
        p = WhoPlay
        Debug.Print p & " play"
        If p = "Human" Then
            Call HumanPlay
            GameWin = IsWinner("X")
        Else
            Call ComputerPlay
            GameWin = IsWinner("O")
        End If
        If Not GameWin Then GameOver = IsEnd
    Loop Until GameWin Or GameOver
    If Not GameOver Then
        Debug.Print p & " Win !"
    Else
        Debug.Print "Game Over!"
    End If
End Sub

Sub InitLines(Optional S As String)
Dim i As Byte, j As Byte
    Nb = 0: player = 0
    For i = LBound(Lines, 1) To UBound(Lines, 1)
        For j = LBound(Lines, 2) To UBound(Lines, 2)
            Lines(i, j) = "#"
        Next j
    Next i
End Sub

Sub printLines(Nb As Byte)
Dim i As Byte, j As Byte, strT As String
    Debug.Print "Loop " & Nb
    For i = LBound(Lines, 1) To UBound(Lines, 1)
        For j = LBound(Lines, 2) To UBound(Lines, 2)
            strT = strT & Lines(i, j)
        Next j
        Debug.Print strT
        strT = vbNullString
    Next i
End Sub

Function WhoPlay(Optional S As String) As String
    If player = 0 Then
        player = 1
        WhoPlay = "Human"
    Else
        player = 0
        WhoPlay = "Computer"
    End If
End Function

Sub HumanPlay(Optional S As String)
Dim L As Byte, C As Byte, GoodPlay As Boolean

    Do
        L = Application.InputBox("Choose the row", "Numeric only", Type:=1)
        If L > 0 And L < 4 Then
            C = Application.InputBox("Choose the column", "Numeric only", Type:=1)
            If C > 0 And C < 4 Then
                If Lines(L, C) = "#" And Not Lines(L, C) = "X" And Not Lines(L, C) = "O" Then
                    Lines(L, C) = "X"
                    Nb = Nb + 1
                    printLines Nb
                    GoodPlay = True
                End If
            End If
        End If
    Loop Until GoodPlay
End Sub

Sub ComputerPlay(Optional S As String)
Dim L As Byte, C As Byte, GoodPlay As Boolean

    Randomize Timer
    Do
        L = Int((Rnd * 3) + 1)
        C = Int((Rnd * 3) + 1)
        If Lines(L, C) = "#" And Not Lines(L, C) = "X" And Not Lines(L, C) = "O" Then
            Lines(L, C) = "O"
            Nb = Nb + 1
            printLines Nb
            GoodPlay = True
        End If
    Loop Until GoodPlay
End Sub

Function IsWinner(S As String) As Boolean
Dim i As Byte, j As Byte, Ch As String, strTL As String, strTC As String

    Ch = String(UBound(Lines, 1), S)
    
    For i = LBound(Lines, 1) To UBound(Lines, 1)
        For j = LBound(Lines, 2) To UBound(Lines, 2)
            strTL = strTL & Lines(i, j)
            strTC = strTC & Lines(j, i)
        Next j
        If strTL = Ch Or strTC = Ch Then IsWinner = True: Exit For
        strTL = vbNullString: strTC = vbNullString
    Next i
    
    strTL = Lines(1, 1) & Lines(2, 2) & Lines(3, 3)
    strTC = Lines(1, 3) & Lines(2, 2) & Lines(3, 1)
    If strTL = Ch Or strTC = Ch Then IsWinner = True
End Function

Function IsEnd() As Boolean
Dim i As Byte, j As Byte

    For i = LBound(Lines, 1) To UBound(Lines, 1)
        For j = LBound(Lines, 2) To UBound(Lines, 2)
            If Lines(i, j) = "#" Then Exit Function
        Next j
    Next i
    IsEnd = True
End Function



Fortran: 







module tic
   implicit none
   integer :: b(9)
contains
   logical function iswin(p)
      integer,intent(in) :: p
      iswin = &
         all(b([1,2,3])==p).or.all(b([4,5,6])==p).or.all(b([7,8,9])==p).or.&
         all(b([1,4,7])==p).or.all(b([2,5,8])==p).or.all(b([3,6,9])==p).or.&
         all(b([1,5,9])==p).or.all(b([3,5,7])==p)
   end function iswin
   subroutine printb(mes)
      character(len=*) :: mes
      integer          :: i,j
      character        :: s(0:2) = ['.','X','O']
      print "(3a3,'   ',3i3)",(s(b(3*i+1:3*i+3)),(j,j=3*i+1,3*i+3),i=0,2)
      if(mes /= ' ') print "(/,a)",mes
   end subroutine printb
   integer recursive function minmax(player,bestm) result(bestv)
      integer :: player,bestm,move,v,bm,win=1000,inf=100000
      real    :: x
      if (all(b .ne. 0)) then
         bestv = 0
      else
         bestv = -inf
         do move=1,9
            if (b(move) == 0) then
               b(move) = player
               if (iswin(player)) then
                  v = win
               else
                  call random_number(x)
                  v = -minmax(3-player,bm) - int(10*x)
               endif
               if (v > bestv) then
                  bestv = v
                  bestm = move
               endif
               b(move) = 0
               if (v == win) exit
            endif
         enddo
      endif
   end function minmax
end module tic
program tictactoe
   
   use tic
   implicit none 
   integer :: move,ios,v,bestmove,ply,player=2,k,values(8)
   integer,allocatable :: seed(:)
   call date_and_time(values=values)
   call random_seed(size=k)
   allocate(seed(k))
   seed = values(8)+1000*values(7)+60*1000*values(6)+60*60*1000*values(5)
   call random_seed(put=seed)
   mainloop: do
      b = 0
      call printb('You have O, I have X. You enter 0: game ends.')
      plyloop: do ply=0,4
         if (player == 2 .or. ply >0 ) then  
            write(*,"(/,a)",advance='no'),'Your move? (0..9) '
            getloop: do
               readloop: do
                  read (*,*,iostat=ios),move
                  if (ios == 0 .and. move  >= 0 .and. move <= 9) exit readloop
                  write(*,"(a)",advance='no'),'huh? Try again (0..9): '
               enddo readloop
               if (  move  == 0) exit mainloop
               if (b(move) == 0) exit getloop
               write(*,"(a)",advance='no'),'Already occupied, again (0..9): '
            enddo getloop
            b(move) = 2
            if(iswin(2)) then   
               call printb('***** You win *****')
               exit plyloop
            endif
         endif
         v = minmax(1,bestmove)   
         b(bestmove) = 1
         if(iswin(1)) then
            call printb('***** I win *****')
            exit plyloop
         endif
         write(*,"(/,a,i3)"), 'My move: ',bestmove
         call printb(' ')
      enddo plyloop
      if(ply == 5) write(*,"('***** Draw *****',/)")
      player = 3-player
   enddo mainloop
end program