
Task

Play a game of tic-tac-toe.

Ensure that legal moves are played and that a winning position is notified.


Tic-tac-toe   is also known as:

   naughts and crosses 
   tic tac toe 
   tick tack toe 
   three in a row 
   tres en rayo       and
   Xs  and  Os


See also
   MathWorld™, Tic-Tac-Toe game.
   Wikipedia tic-tac-toe.


 
 
'About 400 lines of code, but it is a graphical (GUI ish) i.e. mouse driven.
'I have made provision for the player to beat the computer now and then.
 
 
Type box
    As long x,y           
    As long wide,high,index
    Dim As ulong colour
    As String caption
    Declare Sub show       
    Declare Sub NewCaption(s As String)
    Declare Constructor
    Declare Constructor(x As long,y As long,wide As long,_
    high As long,index As long,colour As ulong,caption As String)
End Type
Constructor box
End Constructor
Constructor box(x As long,y As long,wide As long,_
high As long,index As long,colour As ulong,caption As String)
this.x=x
this.y=y
this.wide=wide
this.high=high
this.index=index
this.colour=colour
this.caption=caption
End Constructor
'ALL PROCEDURES:
Declare Function inside(B As box,px As long,py As long) As long
Declare Sub make_frame_image(im As ulong Pointer)
Declare Sub setup_grid(boxes() As box,cellsacross As long,cellsdown As long,xp As long,yp As long,w As long,h As long)
Declare Function all_clicked(b() As box) As long
Declare Sub OnCLICK(a() As box,b As box)
Declare Sub refresh_screen(b() As box,f1 As long=0,f2 As long=0)
Declare Function Get_Mouse_Events(boxes() As box) As long
Declare Sub thickline(x1 As long,y1 As long,x2 As long,y2 As long,thickness As Single,colour As ulong,im As Any Pointer=0)
Declare Sub lineto(x1 As long,y1 As long,x2 As long,y2 As long,l As long,th As Single,col As ulong,im As Any Pointer=0)
Declare Sub thickcircle(x As long,y As long,rad As long,th As Single,col As ulong,im As Any Pointer=0)
Declare Sub startup(b() As box)
Declare Sub get_computer_events(b() As box)
 
Declare Sub finish
'Macro used by more than one procedure
#macro incircle(cx,cy,radius,x,y)
(cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
#endmacro
'===============  RUN  ============================
Screen 19,32',1,16
Color ,Rgb(233,236,216)              'background colour
windowtitle string(100," ")+"Noughts and crosses"
'Globals:
Dim Shared As ulong Pointer frame
Dim Shared As long computer,player
Dim Shared As String msg1,msg2,message
message="In Play"
msg1="Computer Start"
msg2="Player Start"
'Custom Frame
frame=Imagecreate(800,600)
 
Dim  As box boxes(0 To 9)
 
setup_grid(boxes(),3,3,175,85,150,150)
make_frame_image(frame)
 
Do
    If player=0 And computer=0 Then
        startup(boxes())
    End If
 
    If player  Then
        Get_Mouse_Events(boxes())
    End If
 
    If computer Then
        get_computer_events(boxes())
    End If
 
    If all_clicked(boxes()) Then get_computer_events(boxes())
Loop Until Inkey=Chr(27)
finish
 
Sub box.show
    Line(this.x,this.y)-(this.x+this.wide,this.y+this.high),this.colour,bf
    Line(this.x,this.y)-(this.x+this.wide,this.y+this.high),Rgb(200,200,200),b
    ''Draw String(this.x+.5*this.wide-4*Len(this.caption),this.y+(.5*this.high-4)),this.caption,Rgb(0,0,0)
    If this.index=0 Then
        Draw String(this.x+.5*this.wide-4*Len(this.caption),this.y+.5*this.high-6),this.caption,Rgb(0,0,0)
    End If
End Sub
Sub box.NewCaption(s As String)
    Var cx=(this.x+this.x+this.wide)/2
    Var cy=(this.y+this.y+this.high)/2
    If s="X" Then
        For k As long=20 To 0 Step -1
            lineto(cx,cy,this.x,this.y,50,k,Rgb(50+10*k,5*k,0),frame)
            lineto(cx,cy,this.x+this.wide,this.y+this.high,50,k,Rgb(50+10*k,5*k,0),frame)
            lineto(cx,cy,this.x,this.y+this.high,50,k,Rgb(50+10*k,5*k,0),frame)
            lineto(cx,cy,this.x+this.wide,this.y,50,k,Rgb(50+10*k,5*k,0),frame)
        Next k
    Else
        For k As long=20 To 0 Step -1
            thickcircle(cx,cy,40,k,Rgb(50+10*k,5*k,0),frame)
        Next k
    End If
End Sub
Sub get_computer_events(b() As box)
    #define other(n)  b(n).caption<>"0" And b(n).caption<>"C"
    #define another(n) b(n).caption="0"
    #define rr(f,l) (Rnd*((l)-(f))+(f))
    Dim As long flag,i,k,Cwin,Pwin,NoWin
    Static As long firstclick
    var chance="001100"
    dim as long ch
    'horiz player finish
    For x As long=1 To 3
        If b(1+k).caption="0" And b(2+k).caption="0" And another((3+k)) Then b(3+k).Caption="0":Pwin=1:Goto fin
        If b(2+k).caption="0" And b(3+k).caption="0" And another((1+k))Then b(1+k).Caption="0":Pwin=1=1:Goto fin
        If b(1+k).caption="0" And b(3+k).caption="0" And another((2+k))Then b(2+k).Caption="0":Pwin=1:Goto fin
        k=k+3
    Next x
    k=0
    'vert player finish
    For x As long=1 To 3
        If b(1+k).caption="0" And b(4+k).caption="0" And another((7+k)) Then b(7+k).Caption="0":Pwin=1:Goto fin
        If b(4+k).caption="0" And b(7+k).caption="0" And another((1+k))Then b(1+k).Caption="0":Pwin=1:Goto fin
        If b(1+k).caption="0" And b(7+k).caption="0" And another((4+k))Then b(4+k).Caption="0":Pwin=1:Goto fin
        k=k+1
    Next x
    k=0
    'player finish main diag
    If b(1+k).caption="0" And b(5+k).caption="0" And another((9+k)) Then b(9+k).Caption="0":Pwin=1:Goto fin
    If b(1+k).caption="0" And b(9+k).caption="0" And another((5+k))Then b(5+k).Caption="0":Pwin=1:Goto fin
    If b(5+k).caption="0" And b(9+k).caption="0" And another((1+k))Then b(1+k).Caption="0":Pwin=1:Goto fin
    'player finish other diag
    If b(7+k).caption="0" And b(5+k).caption="0" And another((3+k)) Then b(3+k).Caption="0":Pwin=1:Goto fin
    If b(5+k).caption="0" And b(3+k).caption="0" And another((7+k))Then b(7+k).Caption="0":Pwin=1:Goto fin
    If b(7+k).caption="0" And b(3+k).caption="0" And another((5+k))Then b(5+k).Caption="0":Pwin=1:Goto fin
 
    'horiz computer finish
    For x As long=1 To 3
        If b(1+k).caption="C" And b(2+k).caption="C" And other((3+k)) Then b(3+k).Caption="C":Cwin=1:Goto fin
        If b(2+k).caption="C" And b(3+k).caption="C" And other((1+k))Then b(1+k).Caption="C":Cwin=1:Goto fin
        If b(1+k).caption="C" And b(3+k).caption="C" And other((2+k))Then b(2+k).Caption="C":Cwin=1:Goto fin
        k=k+3
    Next x
    k=0
    'vert computer finish
    For x As long=1 To 3
        If b(1+k).caption="C" And b(4+k).caption="C" And other((7+k)) Then b(7+k).Caption="C":Cwin=1:Goto fin
        If b(4+k).caption="C" And b(7+k).caption="C" And other((1+k))Then b(1+k).Caption="C":Cwin=1:Goto fin
        If b(1+k).caption="C" And b(7+k).caption="C" And other((4+k))Then b(4+k).Caption="C":Cwin=1:Goto fin
        k=k+1
    Next x
    k=0
    'computer finish main diag
    If b(1+k).caption="C" And b(5+k).caption="C" And other((9+k)) Then b(9+k).Caption="C":Cwin=1:Goto fin
    If b(1+k).caption="C" And b(9+k).caption="C" And other((5+k))Then b(5+k).Caption="C":Cwin=1:Goto fin
    If b(5+k).caption="C" And b(9+k).caption="C" And other((1+k))Then b(1+k).Caption="C":Cwin=1:Goto fin
    'computer finish other diag
    If b(7+k).caption="C" And b(5+k).caption="C" And other((3+k)) Then b(3+k).Caption="C":Cwin=1:Goto fin
    If b(5+k).caption="C" And b(3+k).caption="C" And other((7+k))Then b(7+k).Caption="C":Cwin=1:Goto fin
    If b(7+k).caption="C" And b(3+k).caption="C" And other((5+k))Then b(5+k).Caption="C":Cwin=1:Goto fin
 
    'block horizontals
    For x As long=1 To 3
        If b(1+k).caption="0" And b(2+k).caption="0" And other((3+k)) Then b(3+k).Caption="C":flag=1:Goto fin
        If b(2+k).caption="0" And b(3+k).caption="0" And other((1+k))Then b(1+k).Caption="C":flag=1:Goto fin
        If b(1+k).caption="0" And b(3+k).caption="0" And other((2+k))Then b(2+k).Caption="C":flag=1:Goto fin
        k=k+3
    Next x
    k=0
    'block verticals
    For x As long=1 To 3
        If b(1+k).caption="0" And b(4+k).caption="0" And other((7+k)) Then b(7+k).Caption="C":flag=1:Goto fin
        If b(4+k).caption="0" And b(7+k).caption="0" And other((1+k))Then b(1+k).Caption="C":flag=1:Goto fin
        If b(1+k).caption="0" And b(7+k).caption="0" And other((4+k))Then b(4+k).Caption="C":flag=1:Goto fin
        k=k+1
    Next x
    k=0
    'block main diag
    If b(1+k).caption="0" And b(5+k).caption="0" And other((9+k)) Then b(9+k).Caption="C":flag=1:Goto fin
    If b(1+k).caption="0" And b(9+k).caption="0" And other((5+k))Then b(5+k).Caption="C":flag=1:Goto fin
    If b(5+k).caption="0" And b(9+k).caption="0" And other((1+k))Then b(1+k).Caption="C":flag=1:Goto fin
    'block other diag
    If b(7+k).caption="0" And b(5+k).caption="0" And other((3+k)) Then b(3+k).Caption="C":flag=1:Goto fin
    If b(5+k).caption="0" And b(3+k).caption="0" And other((7+k))Then b(7+k).Caption="C":flag=1:Goto fin
    If b(7+k).caption="0" And b(3+k).caption="0" And other((5+k))Then b(5+k).Caption="C":flag=1:Goto fin
 
    If firstclick=0 Then
        firstclick=1
       var st="1379"
       dim as long i=rr(0,3)
    If Valint(b(5).caption)=0  and b(5).caption <> "C" Then b(st[i]-48).caption="C":Goto fin
 
    End If
 
     ch=rr(0,5)
    if chance[ch]-48=1 then
    If Valint(b(5).caption)<>0 Then b(5).caption="C":Goto fin
    end if
    If all_clicked(b()) Then Nowin=1:Goto fin
    If flag=0 Then
        Randomize
        Do
            i=rr(1,9)
            If Valint(b(i).caption) <> 0  Then b(i).caption="C":Exit Do
        Loop 
    End If
    fin:
    If Cwin=1 Or Pwin=1 Or NoWin=1 Then
        Dim As long mx,my,mb
        dim as integer x,y
        screencontrol 0,x,y
        for z as single=0 to 8*atn(1) step .001
            dim as integer xx=x+100*cos(z)
            dim as integer yy=y+100*sin(z)
            screencontrol 100,xx,yy
        next z
        screencontrol 100,x,y
        If Cwin=1 Then Message="You Loose"
        If Pwin=1 Then Message="You WIN"
        If Nowin=1 Then Message="DRAW"
 
        cwin=0:k=0:pWin=0:Nowin=0:firstclick=0'i
        Do
            Getmouse mx,my,,mb
            If inside(b(0),mx,my) And mb=1 Then finish
 
            Var ic=incircle(500,55,20,mx,my)
            If incircle(500,55,20,mx,my) And mb=1 Then Exit Do
            refresh_screen(b(),ic)
        Loop Until Inkey=chr(27)
        For z As long=1 To Ubound(b)
            b(z).caption=Str(b(z).index)
        Next z
        Imagedestroy frame
        frame=Imagecreate(800,600)
        make_frame_image(frame)
        computer=0:player=0
        Exit Sub
    End If
    player=1:computer=0
End Sub
 
Sub startup(b() As box)
    message="In Play"
    Dim As long mx,my,mb
    Getmouse mx,my,,mb
 
    For n As long=0 To Ubound(b)
        If inside(b(n),mx,my) And mb=1 Then
            If b(n).index=0 Then
                finish
            End If
        End If
        b(0).colour=Rgb(200,0,0)
    Next n
    Dim As long f1,f2
    If incircle(80,230,10,mx,my) Then
        f1=1:f2=0
        If mb=1 Then computer=1:player=0
    End If
    If incircle(670,230,10,mx,my) Then
        f1=0:f2=1
        If mb=1 Then player=1:computer=0
    End If
    refresh_screen(b(),f1,f2)
End Sub
Sub thickcircle(x As long,y As long,rad As long,th As Single,col As ulong,im As Any Pointer=0)
    Circle(x,y),rad+th/2,col
    Circle(x,y),rad-th/2,col
    Paint(x,y+rad),col,col
End Sub
 
Sub thickline(x1 As long,_
    y1 As long,_
    x2 As long,_
    y2 As long,_
    thickness As Single,_
    colour As ulong,_
    im As Any Pointer=0)
    Dim p As ulong=Rgb(255, 255, 255)
    If thickness<2 Then
        Line(x1,y1)-(x2,y2),colour
    Else               
        Dim As Double s,h,c
        h=Sqr((x2-x1)^2+(y2-y1)^2) 
        If h=0 Then h=1e-6
        s=(y1-y2)/h               
        c=(x2-x1)/h                 
        For x As long=1 To 2
            Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),p
            Line im,(x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
            Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),p
            Line im,(x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
            Paint im,((x1+x2)/2, (y1+y2)/2), p, p
            p=colour
        Next x
    End If
End Sub
Sub lineto(x1 As long,y1 As long,x2 As long,y2 As long,l As long,th As Single,col As ulong,im As Any Pointer=0)
    Dim As long diffx=x2-x1,diffy=y2-y1,ln=Sqr(diffx*diffx+diffy*diffy)
    Dim As Single nx=diffx/ln,ny=diffy/ln
    thickline(x1,y1,(x1+l*nx),(y1+l*ny),th,col,im)
End Sub
 
 
Function inside(B As box,px As long,py As long) As long
    Return (px>B.x)*(px<(B.x+B.wide))*(py>B.y)*(py<(B.y+B.high))
End Function
Sub make_frame_image(im As ulong Pointer)
    #macro map(a,b,x,d,c)
    ((d)-(c))*((x)-(a))/((b)-(a))+(c)
    #endmacro
    #macro logo(sx,sy,rad)
For k As Single=-rad/10 To rad/10 Step .5:Circle im,(sx,sy),rad+k,Rgb(15,118,155):Next
For k As Single=-rad/10 To rad/10 Step .5:Circle im,(sx+1.3*rad,sy+rad),rad+k,Rgb(230,193,78),2.,1.7:Next
For k As Single=-rad/10 To rad/10 Step .5:Circle im,(sx+2*1.3*rad,sy),rad+k,Rgb(21,3,0),3.25,3.05:Next
For k As Single=-rad/10 To rad/10 Step .5:Circle im,(sx+3*1.3*rad,sy+rad),rad+k,Rgb(26,143,76),2,1.8:Next
For k As Single=-rad/10 To rad/10 Step .5:Circle im,(sx+4*1.3*rad,sy),rad+k,Rgb(200,63,87),3.25,3.05:Next
#endmacro
    For k As long=0 To 50
        Var r=map(0,50,k,233,193-20)
        Var g=map(0,50,k,236,153-20)
        Var b=map(0,50,k,216,19-19)
        Line im,(0+k,20+k)-(800-k,600-k),Rgb(r,g,b),b
    Next k
    For k As long=0 To 20
        Var r=map(0,20,k,250,0)
        Var g=map(0,20,k,250,0)
        Var b=map(0,20,k,250,255)
        Line im,(0,k)-(780,k),Rgb(r,g,b)',bf
    Next k
    logo(60,8,5)
    logo(380,8,5)
    logo(720,8,5)
End Sub
Sub setup_grid(boxes() As box,cellsacross As long,cellsdown As long,xp As long,yp As long,w As long,h As long)
    Dim As long index
    For y As long=yp To yp+h*(cellsdown-1) Step h
        For x As long=xp To xp+w*(cellsacross-1)   Step w
            index=index+1
            boxes(index)=Type<box>(x,y,w,h,index,Rgb(133,136,116),Str(index))
        Next x
    Next y
    boxes(0)=Type<box>(780,-2,20,24,0,Rgb(200,0,0),"X")
End Sub
 
Function all_clicked(b() As box) As long
    Dim As long sum
    For z As long=1 To Ubound(b)
        sum=sum+Valint(b(z).caption)
    Next z
    If sum<=0 Then Return -1
End Function
 
Sub OnCLICK(a() As box,b As box)
    If b.caption="0" Then Exit Sub
    If b.caption="C" Then Exit Sub
    If b.caption <> "C" Then b.caption="0"
    If b.index=0 Then finish
    player=0:computer=1
End Sub
 
Sub refresh_screen(b() As box,f1 As long=0,f2 As long=0)
    Screenlock:Cls
    For n As long=0 To Ubound(b)
        b(n).show 'draw boxes
        If b(n).caption="0" Then b(n).NewCaption("X")
        If b(n).caption="C" Then b(n).NewCaption("O")
    Next n
    Put(0,0),frame,trans
    Draw String (390,50),message,Rgb(0,0,0)
    If message <>"In Play" Then
        Circle(500,55),20,Rgb(255,20,255),,,,f
        If f1=-1 Then Circle(500,55),20,Rgb(202,200,200),,,,f
        Draw String(480,50),"Click",Rgb(0,0,0)
    End If
    If computer=0 And player=0 Then
        Draw String (60,200),msg1,Rgb(0,0,0)
        Circle(80,230),10,Rgb(0,0,0)
        Circle(80,230),5,Rgb(100,100,100),,,,f
        If f1=1 Then Circle(80,230),10,Rgb(200,0,0),,,,f
        Draw String (650,200),msg2,Rgb(0,0,0)
        Circle(670,230),10,Rgb(0,0,0)
        Circle(670,230),5,Rgb(100,100,100),,,,f
        If f2=1 Then Circle(670,230),10,Rgb(200,0,0),,,,f
    End If
    Screenunlock:Sleep 1,1
End Sub
 
Function Get_Mouse_Events(boxes() As box) As long
    Static released As long
    Static pressed As long
    Dim As long mousex,mousey,mousebutton ,x,y
    Getmouse mousex,mousey,,mousebutton
    Dim As box bar=Type<box>(0,0,780,50,0,0,"")
 
    refresh_screen(boxes())
    For n As long=0 To Ubound(boxes)
        If inside(boxes(n),mousex,mousey)  Then
            If released Then
                boxes(n).colour=Rgb(120,123,103) 
                If n=0 Then boxes(0).colour=Rgb(255,0,0)
            End If
            If mousebutton=1 Then
                If released Then OnCLICK(boxes(),boxes(n))
                Exit For
            End If
        Else
            boxes(n).colour=Rgb(133,136,116)
            If n=0 Then boxes(0).colour=Rgb(200,0,0)
        End If
    Next n
    If mousebutton=0 Then released=1 Else released=0 'clean clicks
    Return 0
End Function
Sub finish
    Screenunlock
    Imagedestroy frame
    End
End Sub
 