Tic-tac-toe: Difference between revisions
m
Fixed the name of the GitHub repo of the PostScript version
m (Fixed the name of the GitHub repo of the PostScript version) |
|||
| (21 intermediate revisions by 10 users not shown) | |||
Line 10:
''Tic-tac-toe'' is also known as:
::* ''
::* ''tic tac toe''
::* ''tick tack toe''
Line 1,365:
</syntaxhighlight>
==={{header|FreeBASIC}}===
====graphics mode====
<syntaxhighlight lang="freebasic">
'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
</syntaxhighlight>
====text mode====
<syntaxhighlight lang="freebasic">
Screenres 320,240,32
'global variables globales
Dim Shared As Integer b(3,3) 'tablero
Dim Shared As Integer mx, my, btns, ox, oy
'prueba para ganar posición
'3 victorias horizontales
Function TestWin(t As Integer) As Integer
Dim As Integer win = 0
If b(0,0)= t And b(1,0)= t And b(2,0)= t Then win = t
If b(0,1)= t And b(1,1)= t And b(2,1)= t Then win = t
If b(0,2)= t And b(1,2)= t And b(2,2)= t Then win = t
'3 en vertical gana
If b(0,0)= t And b(0,1)= t And b(0,2)= t Then win = t
If b(1,0)= t And b(1,1)= t And b(1,2)= t Then win = t
If b(2,0)= t And b(2,1)= t And b(2,2)= t Then win = t
'cruzada gana
If b(0,0)= t And b(1,1)= t And b(2,2)= t Then win = t
If b(2,0)= t And b(1,1)= t And b(0,2)= t Then win = t
Return win
End Function
Sub InicializarTablero()
For j As Integer = 0 To 2
For i As Integer = 0 To 2
b(i,j)=0
Next i
Next j
End Sub
Sub DibujaTablero()
Locate 1,1 : Print "+---+---+---+"
For j As Integer = 0 To 2
Print "|";
For i As Integer = 0 To 2
If b(i,j) = 0 Then Print " |";
If b(i,j) = 1 Then Print " x |";
If b(i,j) = 2 Then Print " o |";
Next i
Print !"\n+---+---+---+"
Next j
End Sub
Function MovimientoHumano() As Integer
DibujaTablero()
Print !"\n HAZ CLICK CON EL MOUSE"
Print "EN LA CASILLA QUE ELIJAS"
Dim As Integer opcion = -1
While opcion = -1
Getmouse mx,my,,btns
While btns <> 1 'esperar a pulsar botón
Getmouse mx,my,,btns
Wend
mx = (mx-4)\32
my = (my-4)\16
If mx >= 0 And mx < 3 And my >= 0 And my < 3 Then
If b(mx,my) = 0 Then opcion = mx+my*3 'Casilla vacía?
End If
While btns=1
Getmouse mx,my,,btns
Wend
Wend
Return opcion
End Function
Function MovimientoAleatorio() As Integer
Dim As Integer opcion, i, j
opcion = Int(Rnd(1)*9)
j = Int(opcion/3)
i = opcion - Int(opcion/3)*3
While b(i,j) <> 0 Or (opcion > 8 Or opcion < 0)
opcion = Int(Rnd(1)*9)
j = Int(opcion/3)
i = opcion - Int(opcion/3)*3
Wend
Return j*3+i
End Function
Function MovimientoInteligente(t As Integer) As Integer
Dim As Integer i, j, opcion, t2
opcion = -1 'opcion aún no seleccionada
'obtener la ficha t2 de los oponentes
If t = 1 Then t2 = 2 Else t2 = 1
'prueba para la casilla central
If b(1,1) = 0 Then opcion = 4
'prueba para ganar
If opcion = -1 Then
If b(0,0)= 0 And b(1,0)= t And b(2,0)= t Then opcion = 0
If b(0,0)= t And b(1,0)= 0 And b(2,0)= t Then opcion = 1
If b(0,0)= t And b(1,0)= t And b(2,0)= 0 Then opcion = 2
If b(0,1)= 0 And b(1,1)= t And b(2,1)= t Then opcion = 3
If b(0,1)= t And b(1,1)= 0 And b(2,1)= t Then opcion = 4
If b(0,1)= t And b(1,1)= t And b(2,1)= 0 Then opcion = 5
If b(0,2)= 0 And b(1,2)= t And b(2,2)= t Then opcion = 6
If b(0,2)= t And b(1,2)= 0 And b(2,2)= t Then opcion = 7
If b(0,2)= t And b(1,2)= t And b(2,2)= 0 Then opcion = 8
'3 bloques verticales
If b(0,0)= 0 And b(0,1)= t And b(0,2)= t Then opcion = 0
If b(0,0)= t And b(0,1)= 0 And b(0,2)= t Then opcion = 3
If b(0,0)= t And b(0,1)= t And b(0,2)= 0 Then opcion = 6
If b(1,0)= 0 And b(1,1)= t And b(1,2)= t Then opcion = 1
If b(1,0)= t And b(1,1)= 0 And b(1,2)= t Then opcion = 4
If b(1,0)= t And b(1,1)= t And b(1,2)= 0 Then opcion = 7
If b(2,0)= 0 And b(2,1)= t And b(2,2)= t Then opcion = 2
If b(2,0)= t And b(2,1)= 0 And b(2,2)= t Then opcion = 5
If b(2,0)= t And b(2,1)= t And b(2,2)= 0 Then opcion = 8
'bloques cruzados
If b(0,0)= 0 And b(1,1)= t And b(2,2)= t Then opcion = 0
If b(0,0)= t And b(1,1)= 0 And b(2,2)= t Then opcion = 4
If b(0,0)= t And b(1,1)= t And b(2,2)= 0 Then opcion = 8
If b(2,0)= 0 And b(1,1)= t And b(0,2)= t Then opcion = 2
If b(2,0)= t And b(1,1)= 0 And b(0,2)= t Then opcion = 4
If b(2,0)= t And b(1,1)= t And b(0,2)= 0 Then opcion = 6
End If
'prueba para bloques
If opcion = -1 Then
If b(0,0)= 0 And b(1,0)= t2 And b(2,0)= t2 Then opcion = 0
If b(0,0)= t2 And b(1,0)= 0 And b(2,0)= t2 Then opcion = 1
If b(0,0)= t2 And b(1,0)= t2 And b(2,0)= 0 Then opcion = 2
If b(0,1)= 0 And b(1,1)= t2 And b(2,1)= t2 Then opcion = 3
If b(0,1)= t2 And b(1,1)= 0 And b(2,1)= t2 Then opcion = 4
If b(0,1)= t2 And b(1,1)= t2 And b(2,1)= 0 Then opcion = 5
If b(0,2)= 0 And b(1,2)= t2 And b(2,2)= t2 Then opcion = 6
If b(0,2)= t2 And b(1,2)= 0 And b(2,2)= t2 Then opcion = 7
If b(0,2)= t2 And b(1,2)= t2 And b(2,2)= 0 Then opcion = 8
'3 bloques verticales
If b(0,0)= 0 And b(0,1)= t2 And b(0,2)= t2 Then opcion = 0
If b(0,0)= t2 And b(0,1)= 0 And b(0,2)= t2 Then opcion = 3
If b(0,0)= t2 And b(0,1)= t2 And b(0,2)= 0 Then opcion = 6
If b(1,0)= 0 And b(1,1)= t2 And b(1,2)= t2 Then opcion = 1
If b(1,0)= t2 And b(1,1)= 0 And b(1,2)= t2 Then opcion = 4
If b(1,0)= t2 And b(1,1)= t2 And b(1,2)= 0 Then opcion = 7
If b(2,0)= 0 And b(2,1)= t2 And b(2,2)= t2 Then opcion = 2
If b(2,0)= t2 And b(2,1)= 0 And b(2,2)= t2 Then opcion = 5
If b(2,0)= t2 And b(2,1)= t2 And b(2,2)= 0 Then opcion = 8
'bloques cruzados
If b(0,0)= 0 And b(1,1)= t2 And b(2,2)= t2 Then opcion = 0
If b(0,0)= t2 And b(1,1)= 0 And b(2,2)= t2 Then opcion = 4
If b(0,0)= t2 And b(1,1)= t2 And b(2,2)= 0 Then opcion = 8
If b(2,0)= 0 And b(1,1)= t2 And b(0,2)= t2 Then opcion = 2
If b(2,0)= t2 And b(1,1)= 0 And b(0,2)= t2 Then opcion = 4
If b(2,0)= t2 And b(1,1)= t2 And b(0,2)= 0 Then opcion = 6
End If
If opcion = -1 Then
If b(0,0) = 0 Then opcion = 0
If b(2,0) = 0 Then opcion = 2
If b(0,2) = 0 Then opcion = 6
If b(2,2) = 0 Then opcion = 8
End If
'no hay opción de hacer una elección al azar
If opcion = -1 Then
opcion = Int(Rnd(1)*9)
j = Int(opcion/3)
i = opcion - Int(opcion/3)*3
'encontrar una casilla vacía
While b(i,j) <> 0
opcion = Int(Rnd(1)*9)
j = Int(opcion/3)
i = opcion - Int(opcion/3)*3
Wend
End If
Return opcion
End Function
InicializarTablero()
DibujaTablero()
Dim As Integer resultado
Dim As Integer jugador = 1
Dim As Integer ContarMovimientos = 0
Dim As Integer ContarPartidas = 0
Dim As Integer movimiento = 0
Dim As Integer i, j
Do
'alternar jugadores
If jugador = 1 Then jugador = 2 Else jugador = 1
'selecciona tipo de movimiento para cada jugador
If jugador = 1 Then
movimiento = MovimientoHumano()
Else
movimiento = MovimientoInteligente(2)
End If
'print "movimiento ="; movimiento
'print "jugador ="; jugador
'convertir la elección a las coordenadas del tablero i,j
j = Int(movimiento/3)
i = movimiento - (j*3)
b(i,j) = jugador 'ingrese la ficha de jugador 1 o 2
resultado = TestWin(jugador) 'comprobar si el jugador ha ganado
DibujaTablero()
ContarMovimientos += 1
'=======================================================
'Comprobar final de partida y/o un resultado de victoria
'=======================================================
If ContarMovimientos = 9 Or resultado <> 0 Then
DibujaTablero()
If resultado = 0 Then Print !"\n EMPATE "
If resultado = 1 Then Print !"\n x GANA "
If resultado = 2 Then Print !"\n o GANA "
Print Space(28)
Print "PULSA BARRA ESPACIADORA PARA"
Print "OTRA PARTIDA, ESC PARA SALIR"
Sleep
Cls
InicializarTablero() 'reiniciar tablero
ContarMovimientos = 0
ContarPartidas += 1
End If
Loop Until Multikey(&H01)
End
</syntaxhighlight>
==={{header|Microsoft Small Basic}}===
This game has a simple AI.
<syntaxhighlight lang="smallbasic">place1 = 1
Line 1,513 ⟶ 2,188:
EndIf</syntaxhighlight>
===
{{works with|QuickBasic|4.5}}
<syntaxhighlight lang="qbasic">
' Tic-tac-toe
DECLARE FUNCTION Win% (Piece AS STRING)
DECLARE FUNCTION SpacesFilled% ()
DECLARE SUB ClearBoard ()
DECLARE SUB DisplayNumberedBoard ()
DECLARE SUB DisplayPiecedBoard ()
DECLARE FUNCTION Evaluate% (Me AS STRING, Him AS STRING)
DIM SHARED Board(8) AS STRING * 1, BestMove AS INTEGER
DIM SHARED WinPos(7, 2) AS INTEGER
DIM SHARED MyPiece AS STRING, HisPiece AS STRING
FOR I = 0 TO 7
FOR J = 0 TO 2
READ WinPos(I, J)
NEXT J
NEXT I
' Winning positions
DATA 0, 1, 2, 3, 4, 5, 6, 7, 8, 0, 3, 6, 1, 4, 7, 2, 5, 8, 0, 4, 8, 2, 4, 6
MyWinsCnt = 0: HisWinsCnt = 0: DrawsCnt = 0
CompFirst = -1 ' It be reversed, so human goes first
CLS
PRINT
PRINT " TIC-TAC-TOE"
PRINT
PRINT "In this version, X always goes first."
PRINT "The board is numbered:"
DO
CompFirst = NOT CompFirst ' reverse who goes first
MovesCnt = 0
PRINT
DisplayNumberedBoard
PRINT
IF CompFirst THEN PRINT "I go first." ELSE PRINT "You go first. ";
ClearBoard
IF CompFirst THEN MyPiece = "X": HisPiece = "O" ELSE MyPiece = "O": HisPiece = "X"
' -1: human; 1: computer; 0: nobody
IF CompFirst THEN Mover = 1 ELSE Mover = -1
WHILE Mover <> 0
SELECT CASE Mover
CASE 1
IF MovesCnt = 0 THEN
BestMove = INT(RND * 9)
ELSEIF MovesCnt = 1 THEN
IF Board(4) <> " " THEN BestMove = INT(RND * 2) * 6 + INT(RND * 2) * 2 ELSE BestMove = 4
ELSE
T = Evaluate(MyPiece, HisPiece)
END IF
Board(BestMove) = MyPiece
MovesCnt = MovesCnt + 1
PRINT
CALL DisplayPiecedBoard
PRINT
IF Win(MyPiece) THEN
MyWinsCnt = MyWinsCnt + 1
PRINT "I win!"
Mover = 0
ELSEIF SpacesFilled THEN
DrawsCnt = DrawsCnt + 1
PRINT "It's a draw. Thank you."
Mover = 0
ELSE
Mover = -1
END IF
CASE -1
DO
INPUT "Where do you move? ", I
IF I < 1 OR I > 9 THEN
PRINT "Illegal! ";
ELSEIF Board(I - 1) <> " " THEN
PRINT "Place already occupied. ";
ELSE
EXIT DO
END IF
LOOP
Board(I - 1) = HisPiece
MovesCnt = MovesCnt + 1
PRINT
CALL DisplayPiecedBoard
PRINT
IF Win(HisPiece) THEN
HisWinsCnt = HisWinsCnt + 1
PRINT "You beat me! Good game."
Mover = 0
ELSEIF SpacesFilled THEN
DrawsCnt = DrawsCnt + 1
PRINT "It's a draw. Thank you."
Mover = 0
ELSE
Mover = 1
END IF
END SELECT
WEND
PRINT
INPUT "Another game (y/n)? ", Answ$
LOOP UNTIL UCASE$(Answ$) <> "Y"
PRINT
PRINT "Final score:"
PRINT "You won", HisWinsCnt; "game";
IF HisWinsCnt <> 1 THEN PRINT "s";
PRINT "."
PRINT "I won", MyWinsCnt; "game";
IF MyWinsCnt <> 1 THEN PRINT "s";
PRINT "."
PRINT "We tied", DrawsCnt; "game";
IF DrawsCnt <> 1 THEN PRINT "s";
PRINT "."
PRINT "See you later!"
END
SUB ClearBoard
FOR I = 0 TO 8: Board(I) = " ": NEXT I
END SUB
SUB DisplayNumberedBoard
FOR I = 0 TO 8 STEP 3
PRINT I + 1; "|"; I + 2; "|"; I + 3
IF I <> 6 THEN PRINT "---+---+---"
NEXT I
END SUB
SUB DisplayPiecedBoard
FOR I = 0 TO 8 STEP 3
PRINT " "; Board(I); " | "; Board(I + 1); " | "; Board(I + 2)
IF I <> 6 THEN PRINT "---+---+---"
NEXT I
END SUB
FUNCTION Evaluate% (Me AS STRING, Him AS STRING)
' Recursive algorithm
IF Win(Me) THEN Evaluate = 1: EXIT FUNCTION
IF Win(Him) THEN Evaluate = -1: EXIT FUNCTION
IF SpacesFilled THEN Evaluate = 0: EXIT FUNCTION
LoseFlag = 1
FOR I = 0 TO 8
IF Board(I) = " " THEN
Board(I) = Me ' Try the move.
V = Evaluate(Him, Me)
Board(I) = " " ' Restore the empty space.
IF V = -1 THEN BestMove = I: Evaluate = 1: EXIT FUNCTION
IF V = 0 THEN LoseFlag = 0: SafeMove = I
END IF
NEXT
BestMove = SafeMove
Evaluate = -LoseFlag
END FUNCTION
FUNCTION SpacesFilled%
FOR I = 0 TO 8
IF Board(I) = " " THEN SpacesFilled = 0: EXIT FUNCTION
NEXT I
SpacesFilled = -1
END FUNCTION
FUNCTION Win% (Piece AS STRING)
FOR I = 0 TO 7
IF Board(WinPos(I, 0)) = Piece AND Board(WinPos(I, 1)) = Piece AND Board(WinPos(I, 2)) = Piece THEN Win = -1: EXIT FUNCTION
NEXT I
Win = 0
END FUNCTION
</syntaxhighlight>
==={{header|RapidQ}}===
{{trans|QuickBASIC}}
<syntaxhighlight lang="basic">
' Tic-tac-toe
' Console application
DECLARE FUNCTION Win (Piece AS STRING) AS INTEGER
DECLARE FUNCTION SpacesFilled () AS INTEGER
DECLARE SUB ClearBoard ()
DECLARE SUB DisplayNumberedBoard ()
DECLARE SUB DisplayPiecedBoard ()
DECLARE FUNCTION Evaluate (Me AS STRING, Him AS STRING) AS INTEGER
DIM Board(8) AS STRING * 1, BestMove AS INTEGER
DIM WinPos(7, 2) AS INTEGER
DIM MyPiece AS STRING, HisPiece AS STRING
FOR I = 0 TO 7
FOR J = 0 TO 2
READ WinPos(I, J)
NEXT J
NEXT I
' Winning positions
DATA 0, 1, 2, 3, 4, 5, 6, 7, 8, 0, 3, 6, 1, 4, 7, 2, 5, 8, 0, 4, 8, 2, 4, 6
MyWinsCnt = 0: HisWinsCnt = 0: DrawsCnt = 0
CompFirst = -1 ' It be reversed, so human goes first
CLS
PRINT
PRINT " TIC-TAC-TOE"
PRINT
PRINT "In this version, X always goes first."
PRINT "The board is numbered:"
DO
CompFirst = NOT CompFirst ' reverse who goes first
MovesCnt = 0
PRINT
DisplayNumberedBoard
PRINT
PRINT IIF(CompFirst, "I go first.", "You go first.")
ClearBoard
IF CompFirst THEN MyPiece = "X": HisPiece = "O" ELSE MyPiece = "O": HisPiece = "X"
' -1: human; 1: computer; 0: nobody
Mover = IIF(CompFirst, 1, -1)
WHILE Mover <> 0
SELECT CASE Mover
CASE 1
IF MovesCnt = 0 THEN
BestMove = INT(RND * 9)
ELSEIF MovesCnt = 1 THEN
BestMove = IIF(Board(4) <> " ", INT(RND * 2) * 6 + INT(RND * 2) * 2, 4)
ELSE
T = Evaluate(MyPiece, HisPiece)
END IF
Board(BestMove) = MyPiece
INC(MovesCnt)
PRINT
CALL DisplayPiecedBoard
PRINT
IF Win(MyPiece) THEN
INC(MyWinsCnt)
PRINT "I win!"
Mover = 0
ELSEIF SpacesFilled THEN
INC(DrawsCnt)
PRINT "It's a draw. Thank you."
Mover = 0
ELSE
Mover = -1
END IF
CASE -1
DO
INPUT "Where do you move? ",I
IF I < 1 OR I > 9 THEN
PRINT "Illegal! ";
ELSEIF Board(I - 1) <> " " THEN
PRINT "Place already occupied. ";
ELSE
EXIT DO
END IF
LOOP
Board(I - 1) = HisPiece
INC(MovesCnt)
PRINT
CALL DisplayPiecedBoard
PRINT
IF Win(HisPiece) THEN
INC(HisWinsCnt)
PRINT "You beat me! Good game."
Mover = 0
ELSEIF SpacesFilled THEN
INC(DrawsCnt)
PRINT "It's a draw. Thank you."
Mover = 0
ELSE
Mover = 1
END IF
END SELECT
WEND
PRINT
INPUT "Another game (y/n)? ", Answ$
LOOP UNTIL UCASE$(Answ$) <> "Y"
PRINT
PRINT "Final score:"
PRINT "You won "; HisWinsCnt; " game"; IIF(HisWinsCnt <> 1, "s.", ".")
PRINT "I won "; MyWinsCnt; " game"; IIF(MyWinsCnt <> 1, "s.", ".")
PRINT "We tied "; DrawsCnt; " game"; IIF(DrawsCnt <> 1, "s.", ".")
PRINT "See you later!"
END
SUB ClearBoard
FOR I = 0 TO 8: Board(I) = " ": NEXT I
END SUB
SUB DisplayNumberedBoard
FOR I = 0 TO 8 STEP 3
PRINT " "; I + 1; " | "; I + 2; " | "; I + 3
IF I <> 6 THEN PRINT "---+---+---"
NEXT I
END SUB
SUB DisplayPiecedBoard
FOR I = 0 TO 8 STEP 3
PRINT " "; Board(I); " | "; Board(I + 1); " | "; Board(I + 2)
IF I <> 6 THEN PRINT "---+---+---"
NEXT I
END SUB
FUNCTION Evaluate (Me AS STRING, Him AS STRING)
' Recursive algorithm
DIM I AS INTEGER, SafeMove AS INTEGER, V AS INTEGER, LoseFlag AS INTEGER
IF Win(Me) THEN Evaluate = 1: EXIT FUNCTION
IF Win(Him) THEN Evaluate = -1: EXIT FUNCTION
IF SpacesFilled THEN Evaluate = 0: EXIT FUNCTION
LoseFlag = 1
I = 0
WHILE I <= 8
IF Board(I) = " " THEN
Board(I) = Me ' Try the move.
V = Evaluate(Him, Me)
Board(I) = " " ' Restore the empty space.
IF V = -1 THEN BestMove = I: Evaluate = 1: EXIT FUNCTION
IF V = 0 THEN LoseFlag = 0: SafeMove = I
END IF
INC(I)
WEND
BestMove = SafeMove
Evaluate = -LoseFlag
END FUNCTION
FUNCTION SpacesFilled
FOR I = 0 TO 8
IF Board(I) = " " THEN SpacesFilled = 0: EXIT FUNCTION
NEXT I
SpacesFilled = -1
END FUNCTION
FUNCTION Win (Piece AS STRING)
FOR I = 0 TO 7
IF Board(WinPos(I, 0)) = Piece AND Board(WinPos(I, 1)) = Piece AND Board(WinPos(I, 2)) = Piece THEN Win = -1: EXIT FUNCTION
NEXT I
Win = 0
END FUNCTION
</syntaxhighlight>
==={{header|Run BASIC}}===
<syntaxhighlight lang="runbasic">' ---------------------------
' TIC TAC TOE
' ---------------------------
winBox$ = "123 456 789 159 147 258 369 357"
boxPos$ = "123 231 456 564 789 897 159 591 357 753 132 465 798 174 285 396 159 471 582 693 147 258 369 195 375"
ai$ = "519628374"
ox$ = "OX"
[newGame]
for i = 1 to 9
box$(i) = ""
next i
goto [shoTic]
[loop]
for j = 1 to 2
tic$ = mid$(ox$,j,1)
for i = 1 to 25
b$ = word$(boxPos$,i," ")
b1 = val(mid$(b$,1,1))
b2 = val(mid$(b$,2,1))
b3 = val(mid$(b$,3,1))
if box$(b1) = tic$ AND box$(b2) = tic$ AND box$(b3) = "" then
box$(b3) = "O"
goto [shoTic]
end if
next i
next j
if box$(1) = "O" AND box$(5) = "X" and box$(9) = "X" then
if box$(3) = "" then
box$(3) = "O"
goto [shoTic]
end if
if box$(7) = "" then
box$(7) = "O"
goto [shoTic]
end if
end if
for i = 1 to 9
b1 = val(mid$(ai$,i,1))
if box$(b1) = "" then
box$(b1) = "O"
exit for
end if
next i
[shoTic]
cls
' ----------------------------------------
' show tic tac toe screen
' ----------------------------------------
html "<table border=1 width=300px height=225px><TR>"
for i = 1 to 9
html "<td align=center width=33%><h1>"
if box$(i) <> "" then
html box$(i)
else
button #box, " ";box$(i);" ", [doTic]
#box setkey(str$(i))
end if
if i mod 3 = 0 then html "</tr><tr>"
next i
html "</table>"
gosub [checkWin]
wait
[doTic]
box$(val(EventKey$)) = "X"
turn = 1
gosub [checkWin]
goto [loop]
' --- check for a winner ----------
[checkWin]
for i = 1 to 8
b$ = word$(winBox$,i," ")
b1 = val(mid$(b$,1,1))
b2 = val(mid$(b$,2,1))
b3 = val(mid$(b$,3,1))
if box$(b1) = "O" and box$(b2) = "O" and box$(b3) = "O" then
print "You Lose!"
goto [playAgain]
end if
if box$(b1) = "X" and box$(b2) = "X" and box$(b3) = "X" then
print "You Win!"
goto [playAgain]
end if
next i
moveCount = 0
for i = 1 to 9
if box$(i) <> "" then moveCount = moveCount + 1
next i
if moveCount = 9 then
print "Draw!"
goto [playAgain]
end if
RETURN
[playAgain]
input "Play again (y/n)";p$
if upper$(p$) = "Y" then goto [newGame]
end</syntaxhighlight>
==={{Header|Tiny BASIC}}===
<syntaxhighlight lang="basic"> REM Tic-tac-toe for Tiny BASIC
REM
REM Released as public domain by Damian Gareth Walker, 2019
REM Created: 21-Sep-2019
REM --- Variables
REM A - first square in line examined
REM B - second square in line examined
REM C - third square in line examined
REM D - player whose pieces to count
REM E - number of DREM s pieces on a line
REM F - first square of line to examine
REM G - game winner
REM H - which side the human takes
REM I - increment for line to examine
REM L - line to examine
REM M - where to move (various uses)
REM N - piece found in a square
REM P - player currently playing
REM Q - square to examine
REM R-Z - contents of the board
REM --- Main Program
GOSUB 40
GOSUB 60
GOSUB 80
END
REM --- Subroutine to initialise the game
REM Outputs: H - Human play order
REM P - Whose turn it is
40 PRINT "Tic tac toe. Board positions are:"
PRINT " 1 2 3"
PRINT " 4 5 6"
PRINT " 7 8 9"
PRINT "Play first or second (1/2)?"
INPUT H
IF H<1 THEN GOTO 40
IF H>2 THEN GOTO 40
LET P=1
RETURN
REM --- Subroutine to take turns
REM Inputs: H - who is the human
REM P - whose turn it is
REM Outputs: G - who won the game
60 IF P=H THEN GOSUB 100
IF P<>H THEN GOSUB 120
GOSUB 200
IF G>0 THEN RETURN
LET P=3-P
IF R=0 THEN GOTO 60
IF S=0 THEN GOTO 60
IF T=0 THEN GOTO 60
IF U=0 THEN GOTO 60
IF V=0 THEN GOTO 60
IF W=0 THEN GOTO 60
IF X=0 THEN GOTO 60
IF Y=0 THEN GOTO 60
IF Z=0 THEN GOTO 60
RETURN
REM --- Victory
REM Inputs: H - which side was the human
REM P - player who won
80 IF G=H THEN PRINT "You win!"
IF G<>0 THEN IF G<>H THEN PRINT "Computer wins"
IF G=0 THEN PRINT "A draw"
RETURN
REM --- Subroutine to allow the player to move
REM Inputs: P - player number
REM Outputs: M - where the player wishes to move
100 PRINT "Move? "
INPUT Q
IF Q<1 THEN GOTO 100
IF Q>9 THEN GOTO 100
GOSUB 220
IF N<>0 THEN GOTO 100
LET M=Q
GOSUB 240
RETURN
REM --- Subroutine to make the computerREM s move
REM Inputs: P - player number
REM Outputs: M - the move chosen
120 LET M=0
LET D=3-H
GOSUB 145
IF M>0 THEN GOTO 135
LET D=H
GOSUB 145
IF M=0 THEN IF V=0 THEN LET M=5
IF M=0 THEN IF R=0 THEN LET M=1
IF M=0 THEN IF T=0 THEN LET M=3
IF M=0 THEN IF X=0 THEN LET M=7
IF M=0 THEN IF Z=0 THEN LET M=9
IF M=0 THEN IF S=0 THEN LET M=2
IF M=0 THEN IF U=0 THEN LET M=4
IF M=0 THEN IF Y=0 THEN LET M=8
IF M=0 THEN IF W=0 THEN LET M=6
135 GOSUB 240
PRINT "Computer move ",M
RETURN
REM --- Identify moves to win or avoid a loss
REM Inputs: D - player whose pieces weREM re counting
REM Changes: E - number of pieces on line being scanned
REM F - first square in winning line
REM I - increment of winning line
REM L - line being scanned (counter)
145 LET L=1
146 GOSUB 170
IF E<2 THEN GOTO 152
IF A=0 THEN LET M=F
IF B=0 THEN LET M=F+I
IF C=0 THEN LET M=F+I+I
IF M>0 THEN RETURN
152 LET L=L+1
IF L<9 THEN GOTO 146
RETURN
REM --- Count a playerREM s pieces on a line
REM Inputs: D - player whose pieces weREM re counting
REM L - line number
REM Changes: F - first square on the line
REM I - increment of the line
REM Q - individual squares to examine
REM Outputs: A - contents of first square
REM B - contents of second square
REM C - contents of third square
REM E - number of the playerREM s pieces
170 IF L>3 THEN GOTO 174
LET F=3*L-2
LET I=1
GOTO 180
174 IF L>6 THEN GOTO 178
LET F=L-3
LET I=3
GOTO 180
178 LET F=1+2*(L-7)
LET I=4-2*(L-7)
180 LET E=0
LET Q=F
GOSUB 220
LET A=N
IF N=D THEN LET E=E+1
LET Q=Q+I
GOSUB 220
LET B=N
IF N=D THEN LET E=E+1
LET Q=Q+I
GOSUB 220
LET C=N
IF N=D THEN LET E=E+1
RETURN
REM --- Subroutine to check for a win
REM Inputs: R-Z - board squares
REM Outputs: G - the winning player (0 for neither)
200 LET G=0
IF R>0 THEN IF R=S THEN IF S=T THEN LET G=R
IF U>0 THEN IF U=V THEN IF V=W THEN LET G=U
IF X>0 THEN IF X=Y THEN IF Y=Z THEN LET G=X
IF R>0 THEN IF R=U THEN IF U=X THEN LET G=R
IF S>0 THEN IF S=V THEN IF V=Y THEN LET G=S
IF T>0 THEN IF T=W THEN IF W=Z THEN LET G=T
IF R>0 THEN IF R=V THEN IF V=Z THEN LET G=R
IF T>0 THEN IF T=V THEN IF V=X THEN LET G=T
RETURN
REM --- Subroutine to see what piece is in a square
REM Inputs: Q - the square to check
REM R-Z - the contents of the squares
REM Outputs: N - the piece in that square
220 LET N=0
IF Q=1 THEN LET N=R
IF Q=2 THEN LET N=S
IF Q=3 THEN LET N=T
IF Q=4 THEN LET N=U
IF Q=5 THEN LET N=V
IF Q=6 THEN LET N=W
IF Q=7 THEN LET N=X
IF Q=8 THEN LET N=Y
IF Q=9 THEN LET N=Z
RETURN
REM --- Subroutine to put a piece in a square
REM Inputs: P - the player whose piece should be placed
REM M - the square to put the piece in
REM Changes: R-Z - the contents of the squares
240 IF M=1 THEN LET R=P
IF M=2 THEN LET S=P
IF M=3 THEN LET T=P
IF M=4 THEN LET U=P
IF M=5 THEN LET V=P
IF M=6 THEN LET W=P
IF M=7 THEN LET X=P
IF M=8 THEN LET Y=P
IF M=9 THEN LET Z=P
RETURN </syntaxhighlight>
==={{header|VBA}}===
Human play first with the "X". You must choose the row and the column you want to play...
<syntaxhighlight lang="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)
'check lines & columns
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
'check diagonales
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
</syntaxhighlight>
{{out}}
<pre>Loop 0
###
###
###
Human Play
Loop 1
X##
###
###
Computer Play
Loop 2
X#O
###
###
Human Play
Loop 3
X#O
#X#
###
Computer Play
Loop 4
XOO
#X#
###
Human Play
Loop 5
XOO
#X#
##X
Human Win !</pre>
==={{header|Yabasic}}===
In the classic style.
<syntaxhighlight lang="yabasic">5 REM Adaptation to Yabasic of the program published in Tim Hartnell's book "Artificial Intelligence: Concepts and Programs", with some minor modifications. 6/2018.
10 REM TICTAC
15 INPUT "English (0), Spanish (other key): " IDIOMA : IF NOT IDIOMA THEN RESTORE 2020 ELSE RESTORE 2010 END IF
20 GOSUB 1180: REM INICIALIZACION
30 REM *** REQUISITOS PREVIOS AL JUEGO ***
40 FOR J = 1 TO 9
50 A(J) = 32
60 NEXT J
70 FOR J = 1 TO 5
80 D(J) = 0
90 NEXT J
100 CCONTADOR = 0
110 R$ = ""
120 GOSUB 1070: REM IMPRESION DEL TABLERO
130 REM ** CICLO PRINCIPAL **
140 GOSUB 540: REM MOVIMIENTO DEL ORDENADOR
150 GOSUB 1070: REM IMPRESION DEL TABLERO
160 GOSUB 870: REM COMPRUEBA LA VICTORIA
170 IF R$ <> "" GOTO 240
180 GOSUB 980: REM SE ACEPTA EL MOVIMIENTO DE LA PERSONA
190 GOSUB 1070: REM IMPRESION DEL TABLERO
200 GOSUB 870: REM COMPRUEBA LA VICTORIA
210 IF R$ = "" GOTO 140
220 REM ** FIN DEL CICLO PRINCIPAL **
230 REM *****************************
240 REM FIN DEL JUEGO
250 GOSUB 1070: REM IMPRESION DEL TABLERO
260 PRINT: PRINT
270 IF R$ = "G" PRINT MENSAJE$(1): BANDERA = -1
280 IF R$ = "P" PRINT MENSAJE$(2): BANDERA = 1
290 IF R$ = "D" PRINT MENSAJE$(3): GOTO 430
300 REM ACTUALIZACION DE LA BASE DE DATOS
310 FOR B = 1 TO 5
320 FOR J = 2 TO 9
330 IF M(J) = D(B) GOSUB 370
340 NEXT J
350 NEXT B
360 GOTO 430
370 REM ** REORDENACION DE LOS ELEMENTOS DE LA MATRIZ M **
380 TEMP = M(J + BANDERA)
390 M(J + BANDERA) = M(J)
400 M(J) = TEMP
410 J = 9
420 RETURN
430 PRINT: PRINT
440 PRINT MENSAJE$(4)
450 PRINT: PRINT
460 FOR J = 1 TO 9
470 PRINT M(J), " ";
480 NEXT J
490 PRINT: PRINT
500 PRINT MENSAJE$(5)
510 INPUT A$
520 GOTO 30
530 REM ************************
540 REM MOVIMIENTO DEL ORDENADOR
550 P = ASC("O")
560 X = 0
570 J = 1
580 IF A(W(J)) = A(W(J + 1)) AND A(W(J + 2)) = 32 AND A(W(J)) = P X = W(J + 2): GOTO 750
590 IF A(W(J)) = A(W(J + 2)) AND A(W(J + 1)) = 32 AND A(W(J)) = P X = W(J + 1): GOTO 750
600 IF A(W(J + 1)) = A(W(J + 2)) AND A(W(J)) = 32 AND A(W(J + 1)) = P X = W(J): GOTO 750
610 IF J < 21 J = J + 3: GOTO 580
620 IF P = ASC("O") P = ASC("X"): GOTO 570
630 REM ** SI NO SE GANA SE BUSCA UN MOVIMIENTO DE BLOQUEO **
640 REM * ENTONCES SE USA LA SIGUIENTE SECCION *
650 J = 1
660 IF A(M(J)) = 32 X = M(J): GOTO 750
670 IF J < 10 J = J + 1: GOTO 660
680 H = 0
690 H = H + 1
700 X = INT(RAN(1) * 9): IF A(X) = 32 GOTO 750
710 IF H < 100 GOTO 690
720 R$ = "D": REM ES SIMPLEMENTE UN DIBUJO
730 RETURN
740 REM *********************
750 REM REALIZA EL MOVIMIENTO
760 A(X) = ASC("O")
770 CCONTADOR = CCONTADOR + 1
780 D(CCONTADOR) = X
790 BANDERA = 0
800 FOR J = 1 TO 9
810 IF A(J) = 32 BANDERA = 1
820 NEXT J
830 IF BANDERA = 0 AND R$ = "" R$ = "D"
840 REM SI TODAS LAS CASILLAS ESTAN LLENAS Y R$ ESTA VACIO, ENTONCES ES SIMPLEMENTE UN DIBUJO
850 RETURN
860 REM *********************
870 REM COMPRUEBA LA VICTORIA
880 J = 1
890 IF A(W(J)) = 32 J = J + 3
900 IF J > 23 RETURN
910 IF A(W(J)) = A(W(J + 1)) AND A(W(J)) = A(W(J + 2)) GOTO 940
920 IF J < 22 J = J + 3: GOTO 890
930 RETURN
940 IF A(W(J)) = ASC("O") R$ = "G": REM EL ORDENADOR GANA
950 IF A(W(J)) = ASC("X") R$ = "P": REM EL ORDENADOR PIERDE
960 RETURN
970 REM ************************
980 REM MOVIMIENTO DE LA PERSONA
990 PRINT: PRINT
1000 PRINT MENSAJE$(6)
1010 PRINT MENSAJE$(7); : INPUT MOVIMIENTO
1020 IF MOVIMIENTO < 1 OR MOVIMIENTO > 9 GOTO 1010
1030 IF A(MOVIMIENTO) <> 32 GOTO 1010
1040 A(MOVIMIENTO) = ASC("X")
1050 RETURN
1060 REM *********************
1070 REM IMPRESION DEL TABLERO
1080 CLEAR SCREEN
1090 PRINT: PRINT: PRINT
1100 PRINT " 1 : 2 : 3 ", CHR$(A(1)), " : ", CHR$(A(2)), " : ", CHR$(A(3))
1110 PRINT "----------- ------------"
1120 PRINT " 4 : 5 : 6 ", CHR$(A(4)), " : ", CHR$(A(5)), " : ", CHR$(A(6))
1130 PRINT "----------- ------------"
1140 PRINT " 7 : 8 : 9 ", CHR$(A(7)), " : ", CHR$(A(8)), " : ", CHR$(A(9))
1150 PRINT
1160 RETURN
1170 REM **************
1180 REM INICIALIZACION
1190 CLEAR SCREEN
1200 DIM A(9) : REM TABLERO
1210 DIM M(10) : REM ACCESO A LA BASE DE DATOS
1220 DIM W(24) : REM DATOS DE VICTORIA O BLOQUEO
1230 DIM D(5) : REM ACCESO AL MOVIMIENTO EN EL JUEGO ACTUAL
1235 DIM MENSAJE$(1) : READ M$ : N = TOKEN(M$,MENSAJE$(),",") : RESTORE
1240 REM DATOS DE VICTORIA O BLOQUEO
1250 FOR J = 1 TO 24
1260 READ W(J)
1270 NEXT J
1280 DATA 1, 2, 3, 4, 5, 6, 7, 8, 9
1290 DATA 1, 4, 7, 2, 5, 8, 3, 6, 9
1300 DATA 1, 5, 9, 3, 5, 7
1310 REM BASE INICIAL DE DATOS
1320 FOR J = 1 TO 10
1330 READ M(J)
1340 NEXT J
1350 DATA 2, 6, 8, 4, 7, 3, 1, 9, 5, 2
1360 RETURN
2000 REM MENSAJES EN ESPAÑOL
2010 DATA "YO GANO,TU GANAS,ES SIMPLEMENTE UN DIBUJO,ESTA ES MI PRIORIDAD ACTUALIZADA,PULSE LA TECLA <RETURN> PARA CONTINUAR,REALICE SU MOVIMIENTO,MOVIMIENTO: "
2020 DATA "I WIN,YOU WIN,IT'S JUST A DRAWING,THIS IS MY PRIORITY UPDATE,PRESS <RETURN> TO CONTINUE,TO MAKE YOUR MOVE,MOVEMENT: "
</syntaxhighlight>
Line 2,829 ⟶ 4,445:
You win!</pre>
=={{header|Delphi}}==
{{works with|Delphi|6.0}}
{{libheader|SysUtils,StdCtrls}}
This is a GUI, event driven version of the game. The game board is a "TStringGrid" component, which has a grid that can hold and display characters. In this case, the grid displays Xs and Ox using a large font.
When the user clicks on the grid, this generates an event that is handled by the program. The mouse click coordinates are converted to a cell coordinates and a large X is placed in the box. At this point program tests if this resulted in a win. Next it calculate the computer's response and it checks to see if the computer won. The process is repeated until there is a winner or a draw.
[[File:DelphiTicTacToe.png|frame|none]]
<syntaxhighlight lang="Delphi">
{Array contain possiple winning lines}
type TWinLine = array [0..3-1] of TPoint;
var WinLines: array [0..8-1] of TWinLine = (
((X:0; Y:0), (X:1; Y:0), (X:2; Y:0)),
((X:0; Y:1), (X:1; Y:1), (X:2; Y:1)),
((X:0; Y:2), (X:1; Y:2), (X:2; Y:2)),
((X:0; Y:0), (X:0; Y:1), (X:0; Y:2)),
((X:1; Y:0), (X:1; Y:1), (X:1; Y:2)),
((X:2; Y:0), (X:2; Y:1), (X:2; Y:2)),
((X:0; Y:0), (X:1; Y:1), (X:2; Y:2)),
((X:2; Y:0), (X:1; Y:1), (X:0; Y:2))
);
{Array containing all characters in a line}
type TCellArray = array [0..3-1] of char;
var WinLineInx: integer;
var GameOver: boolean;
procedure ClearGrid;
{Clear TTT Grid by setting all cells to a space}
var X,Y: integer;
begin
with TicTacToeDlg do
begin
for Y:=0 to GameGrid.RowCount-1 do
for X:=0 to GameGrid.ColCount-1 do GameGrid.Cells[X,Y]:=' ';
WinLineInx:=-1;
Status1Dis.Caption:='';
GameOver:=False;
end;
end;
function FirstEmptyCell(var P: TPoint): boolean;
{Find first empty grid i.e. the one containing a space}
{Returns false if there are no empty cells (a tie game)}
var X,Y: integer;
begin
Result:=True;
with TicTacToeDlg do
begin
{Iterate through all cells in array}
for Y:=0 to GameGrid.RowCount-1 do
for X:=0 to GameGrid.ColCount-1 do
if GameGrid.Cells[X,Y]=' ' then
begin
P.X:=X; P.Y:=Y;
Exit;
end;
end;
Result:=False;
end;
procedure GetLineChars(Inx: integer; var CA: TCellArray);
{Get all the characters in a specific win line}
var P1,P2,P3: TPoint;
begin
with TicTacToeDlg do
begin
{Get cell position of specific win line}
P1:=WinLines[Inx,0];
P2:=WinLines[Inx,1];
P3:=WinLines[Inx,2];
{Get the characters from each and put in array}
CA[0]:=GameGrid.Cells[P1.X,P1.Y][1];
CA[1]:=GameGrid.Cells[P2.X,P2.Y][1];
CA[2]:=GameGrid.Cells[P3.X,P3.Y][1];
end;
end;
function IsWinner(var Inx: integer; var C: char): boolean;
{Test if the specified line is a winner}
{Return index of line and the char of winner}
var I,J: integer;
var CA: TCellArray;
begin
with TicTacToeDlg do
begin
Result:=False;
{Go through all winning patterns}
for J:=0 to High(WinLines) do
begin
{Get one winning pattern}
GetLineChars(J,CA);
{Look for line that has the same char in all three places}
if (CA[0]<>' ') and (CA[0]=CA[1]) and (CA[0]=CA[2]) then
begin
Result:=True;
Inx:=J;
C:=CA[0];
end;
end;
end;
end;
procedure DrawWinLine(Inx: integer);
{Draw line through winning squares}
var Line: TWinLine;
var C1,C2: TPoint;
var P1,P2: TPoint;
var W2,H2: integer;
begin
with TicTacToeDlg do
begin
{Offset to center of cell}
W2:=GameGrid.ColWidths[0] div 2;
H2:=GameGrid.RowHeights[0] div 2;
{Get winning pattern of lines}
Line:=WinLines[Inx];
{Get beginning and ending cell of win}
C1:=Line[0]; C2:=Line[2];
{Convert to screen coordinates}
P1.X:=C1.X * GameGrid.ColWidths[0] + W2;
P1.Y:=C1.Y * GameGrid.RowHeights[0] + H2;
P2.X:=C2.X * GameGrid.ColWidths[0] + W2;
P2.Y:=C2.Y * GameGrid.RowHeights[0] + H2;
{Set line attributes}
GameGrid.Canvas.Pen.Color:=clRed;
GameGrid.Canvas.Pen.Width:=5;
{Draw line}
GameGrid.Canvas.MoveTo(P1.X,P1.Y);
GameGrid.Canvas.LineTo(P2.X,P2.Y);
end;
end;
procedure DoBestComputerMove;
{Analyze game board and execute the best computer move}
var I,J,Inx: integer;
var CA: TCellArray;
var P: TPoint;
function UrgentMove(CA: TCellArray; var EmptyInx: integer): boolean;
{Test row, column or diagonal for an urgent move}
{This would be either an immediate win or immediate loss}
{Returns True if there is an urgent move and the index of location to respond}
var I: integer;
var OCnt,XCnt,EmptyCnt: integer;
begin
Result:=False;
OCnt:=0; XCnt:=0;
EmptyCnt:=0; EmptyInx:=-1;
{Count number of Xs, Os or Spaces in line}
for I:=0 to High(CA) do
begin
case CA[I] of
'O': Inc(OCnt);
'X': Inc(XCnt);
' ':
begin
Inc(EmptyCnt);
if EmptyCnt=1 then EmptyInx:=I;
end;
end;
end;
{Look for pattern of one empty and two Xs or two Os}
{Which means it's one move away from a win}
Result:=(EmptyCnt=1) and ((OCnt=2) or (XCnt=2));
end;
begin
with TicTacToeDlg do
begin
{Look for urgent moves in all patterns of wins}
for J:=0 to High(WinLines) do
begin
{Get a winning pattern of chars}
GetLineChars(J,CA);
if UrgentMove(CA,Inx) then
begin
{Urgent move found - take it}
P:=WinLines[J,Inx];
GameGrid.Cells[P.X,P.Y]:='O';
exit;
end;
end;
{No urgent moves, so use first empty}
{If there is no empty, the game is stalemated}
if FirstEmptyCell(P) then GameGrid.Cells[P.X,P.Y]:='O';
end;
end;
function TestWin: boolean;
{Test if last move resulted in win/draw}
var Inx: integer; var C: char;
var P: TPoint;
var S: string;
begin
Result:=True;
{Test if somebody won}
if IsWinner(Inx,C) then
begin
WinLineInx:=Inx;
TicTacToeDlg.GameGrid.Invalidate;
if C='O' then S:=' Computer Won!!' else S:=' You Won!!';
TicTacToeDlg.Status1Dis.Caption:=S;
GameOver:=True;
exit;
end;
{Test if game is a draw}
if not FirstEmptyCell(P) then
begin
TicTacToeDlg.Status1Dis.Caption:=' Game is Draw.';
GameOver:=True;
exit;
end;
Result:=False;
end;
procedure PlayTicTacToe;
{Show TicTacToe dialog box}
begin
ClearGrid;
TicTacToeDlg.ShowModal
end;
procedure TTicTacToeDlg.GameGridMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
{Handle user click on TicTacToe grid}
var Row,Col: integer;
begin
with TicTacToeDlg do
begin
if GameOver then exit;;
{Convert Mouse X,Y to Grid row and column}
GameGrid.MouseToCell(X,Y,Col,Row);
{Mark user's selection by placing X in the cell}
if GameGrid.Cells[Col,Row]=' 'then
GameGrid.Cells[Col,Row]:='X';
{Did this result in a win? }
if TestWin then exit;
{Get computer's response}
DoBestComputerMove;
{Did computer win}
TestWin;
end;
end;
procedure TTicTacToeDlg.ReplayBtnClick(Sender: TObject);
begin
ClearGrid;
end;
procedure TTicTacToeDlg.GameGridDrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
{Draw winner line on top of Xs and Os}
begin
if WinLineInx>=0 then DrawWinLine(WinLineInx);
end;
</syntaxhighlight>
{{out}}
<pre>
Elapsed Time: 19.126 Sec.
</pre>
=={{header|EasyLang}}==
Line 2,834 ⟶ 4,741:
It uses minimax with alpha-beta pruning. Therefore, the computer never loses.
[https://easylang.
<syntaxhighlight
len f[] 9
state = 0
textsize 14
#
linewidth 2
clear
color 666
move 34
line 34
move 62
line 62
move 10
line 86
move 10
line 86
linewidth 2.5
for i
f[i] = 0
.
if state = 1
timer 0.2
.
.
c = (ind - 1) mod 3
r = (ind - 1) div 3
x = c * 28 + 20
y = r * 28 +
if f[ind] = 4
color 900
move x - 7 y - 7
line x + 7 y + 7
move x + 7 y - 7
line x - 7 y + 7
elif f[ind] = 1
color 009
move x y
circle 10
color -2
circle 7.5
.
.
for i
s += f[a]
a += d
.
if s = 3
st = -1
elif s = 12
st = 1
.
.
res = 0
for i
.
for i
.
cnt = 1
for i
if f[i] = 0
cnt += 1
.
.
res *= cnt
done = 1
if res = 0 and cnt > 1
done = 0
.
.
if done = 1
if player = 1
rval = -rval
.
else
start = randint 9
mov = start
repeat
if f[mov] = 0
f[mov] = player
minmax (5 - player) (-beta) (-rval) val h
val = -val
f[mov] = 0
if val > rval
rval = val
rmov = mov
.
.
mov = mov mod 9 + 1
until mov = start or rval >= beta
.
.
.
color 555
move 16
if val < 0
# this never happens
text "You won"
elif val > 0
text "You lost"
else
text "Tie"
.
state += 2
.
f[mov] = 4
state = 0
if done = 1
.
.
mov = floor ((mouse_x - 6) / 28) + 3 * floor ((mouse_y - 16) / 28) + 1
if f[mov] = 0
f[mov] = 1
state = 1
timer 0.5
.
.
on timer
if done = 1
else
.
.
on mouse_down
if state = 0
if mouse_x > 6 and mouse_x < 90 and mouse_y
.
elif state >= 2
state -= 2
.
.
init
</syntaxhighlight>
=={{header|Erlang}}==
Line 4,007 ⟶ 5,916:
end program
</syntaxhighlight>
=={{header|Go}}==
Line 7,658 ⟶ 8,892:
Game over. Computer wins!
</pre>
=={{header|Koka}}==
Effectful Version
<syntaxhighlight lang="koka">
import std/os/readline
fun member(x: a, xs: list<a>, compare: (a, a) -> bool) : bool
match xs
Nil -> False
Cons(y, ys) -> x.compare(y) || member(x, ys,compare)
fun member(xs: list<a>, x: a, compare: (a, a) -> bool) : bool
x.member(xs, compare)
struct coord
x: int
y: int
fun show(c: coord) : string {
"(" ++ c.x.show() ++ ", " ++ c.y.show() ++ ")"
}
fun (==)(c1: coord, c2: coord) : bool
c1.x == c2.x && c1.y == c2.y
effect ctl eject(): a
fun parse(str : string, moves : list<coord>) : <console, exn|_e>coord
match str.list()
Cons('0', Cons(' ', Cons('0', Nil))) -> Coord(0,0)
Cons('0', Cons(' ', Cons('1', Nil))) -> Coord(0,1)
Cons('0', Cons(' ', Cons('2', Nil))) -> Coord(0,2)
Cons('1', Cons(' ', Cons('0', Nil))) -> Coord(1,0)
Cons('1', Cons(' ', Cons('1', Nil))) -> Coord(1,1)
Cons('1', Cons(' ', Cons('2', Nil))) -> Coord(1,2)
Cons('2', Cons(' ', Cons('0', Nil))) -> Coord(2,0)
Cons('2', Cons(' ', Cons('1', Nil))) -> Coord(2,1)
Cons('2', Cons(' ', Cons('2', Nil))) -> Coord(2,2)
Cons('0', Cons(',', Cons('0', Nil))) -> Coord(0,0)
Cons('0', Cons(',', Cons('1', Nil))) -> Coord(0,1)
Cons('0', Cons(',', Cons('2', Nil))) -> Coord(0,2)
Cons('1', Cons(',', Cons('0', Nil))) -> Coord(1,0)
Cons('1', Cons(',', Cons('1', Nil))) -> Coord(1,1)
Cons('1', Cons(',', Cons('2', Nil))) -> Coord(1,2)
Cons('2', Cons(',', Cons('0', Nil))) -> Coord(2,0)
Cons('2', Cons(',', Cons('1', Nil))) -> Coord(2,1)
Cons('2', Cons(',', Cons('2', Nil))) -> Coord(2,2)
Cons('q', Nil) -> eject()
_ ->
println("Invalid move, please try again")
gen_move(moves)
fun gen_move(moves : list<coord>) : <console, exn|_e> coord
val move : coord = parse(readline(), moves)
if moves.any() fn (c : coord) { c == move } then {
println("Invalid move, please try again")
gen_move(moves)
} else {
move
}
fun create-board() : list<list<char>> {
[['.','.','.'],['.','.','.'],['.','.','.']]
}
fun show(grid: list<list<char>>) : string
var line := 0
grid.foldl(" 0 1 2\n") fn(acc, row: list<char>)
val out = row.foldl(acc ++ line.show() ++ " ") fn(acc, col: char)
acc ++ col.string() ++ " "
++ "\n"
line := line + 1
out
fun get_board_position(board : list<list<char>>, coord : coord) : maybe<char> {
match board[coord.y] {
Nothing -> Nothing
Just(row) -> row[coord.x]
}
}
fun mark_board(board: list<list<char>>,coord: coord, mark: char): maybe<list<list<char>>>
val new_row: maybe<list<char>> = match board[coord.y]
Nothing -> Nothing
Just(row) -> Just(row.take(coord.x) ++ mark.Cons(row.drop(coord.x + 1)))
match new_row
Nothing -> Nothing
Just(row) -> Just(board.take(coord.y) ++ row.Cons(board.drop(coord.y + 1)))
effect ctl not_full() : ()
fun check_full(board: list<list<char>>) : bool
fun helper()
var full := True
board.foreach() fn(row)
if '.'.member(row) fn (a, b) a == b then {
not_full()
}
full
with ctl not_full() False
helper()
fun check_win(board: list<list<char>>, mark: char) : <div, exn|_e>bool
var win := False
var i := 0
while {i < 3} {
if board.get_board_position(Coord(i,0)).unwrap() == mark && board.get_board_position(Coord(i,1)).unwrap() == mark && board.get_board_position(Coord(i,2)).unwrap() == mark then {
win := True
}
if board.get_board_position(Coord(0,i)).unwrap() == mark && board.get_board_position(Coord(1,i)).unwrap() == mark && board.get_board_position(Coord(2,i)).unwrap() == mark then {
win := True
}
i := i + 1
}
if board.get_board_position(Coord(0,0)).unwrap() == mark && board.get_board_position(Coord(1,1)).unwrap() == mark && board.get_board_position(Coord(2,2)).unwrap() == mark then {
win := True
}
if board.get_board_position(Coord(0,2)).unwrap() == mark && board.get_board_position(Coord(1,1)).unwrap() == mark && board.get_board_position(Coord(2,0)).unwrap() == mark then {
win := True
}
win
fun human_logic(board: list<list<char>>, moves: list<coord>, mark: char, other_mark: char) : <console,div,exn|_e> coord
gen_move(moves)
fun ai_logic(board: list<list<char>>, moves: list<coord>, mark: char, other_mark: char)
board.gen_ai_move(moves,mark, other_mark)
struct move
move : coord
score: int
fun (==)(m1 : move, m2 : move) : bool {
m1.move == m2.move && m1.score == m2.score
}
fun eval_board(board : list<list<char>>, mark: char, other-mark : char) {
if board.check_win(mark) then {
10
}
elif board.check_win(other-mark) then {
-10
}
else {
0
}
}
fun maximum-move(a : move, b : move) : move {
if a.score > b.score then {
a
}
else {
b
}
}
fun gen_ai_move(board : list<list<char>>, moves : list<coord>, mark : char, other-mark : char) {
val best_move : move = Move(Coord(-1,-1), -1000)
[0,1,2].foldl(best_move) fn (bstMove : move, i : int) {
[0,1,2].foldl(bstMove) fn (bstMve : move, j : int) {
if Coord(i,j).member(moves) fn (a,b) {a == b} then {
bstMve
}
else {
val new_board : list<list<char>> = board.mark_board(Coord(i,j), mark).unwrap()
val new-max = maximum-move(bstMve, Move(Coord(i,j), new_board.minimax(moves ++ [Coord(i,j)], 0, False, mark, other-mark)))
new-max
}
}
}.move
}
fun unwrap(x: maybe<a>): <exn> a
match x
Just(a) -> a
Nothing -> throw("value was Nothing")
// A basic implementation of Minimax
// This uses brace style to show that it is possible
fun minimax(board : list<list<char>>, moves: list<coord>, depth : int, isMaximizingPlayer : bool, mark : char, other-mark : char) : <div,exn|_e> int {
val score : int = board.eval_board(mark, other-mark)
if score == 10 then {
score
}
elif score == -10 then {
score
}
elif board.check_full() then {
0
}
else {
if isMaximizingPlayer then {
val bestVal: int = -1000
[0,1,2].foldl(bestVal) fn (bstVal : int, i : int) {
[0,1,2].foldl(bstVal) fn (bstVl : int, j : int) {
if Coord(i,j).member(moves) fn(a, b) {a == b} then {
bstVl
}
else {
val new_board : list<list<char>> = board.mark_board(Coord(i,j), mark).unwrap()
val value : int = new_board.minimax(moves ++ [Coord(i,j)], depth + 1, !isMaximizingPlayer, mark, other-mark)
max(bstVl, value)
}
}
}
}
else {
val bestVal: int = 1000
[0,1,2].foldl(bestVal) fn (bstVal : int, i : int) {
[0,1,2].foldl(bstVal) fn (bstVl : int, j : int) {
if Coord(i,j).member(moves) fn(a,b) {a == b} then {
bstVl
}
else {
val new_board : list<list<char>> = board.mark_board(Coord(i,j), other-mark).unwrap()
val value : int = new_board.minimax(moves ++ [Coord(i,j)], depth + 1, !isMaximizingPlayer, mark, other-mark)
min(bstVl, value)
}
}
}
}
}
}
// The main business logic of the entire game
// This function checks if there is a draw or a win
fun play_game()
val board = get_board()
if board.check_full() then
println("Draw!")
println("Final board:")
board.show().println
else
"Next Turn:".println
board.show().println
val current_mark = get_current_mark()
val other_mark = get_other_mark()
play_turn(current_mark, other_mark)
val new_board = get_board()
if new_board.check_win(current_mark) then
println("Player " ++ current_mark.show() ++ " wins!")
println("Final board:")
new_board.show().println
else
flip()
play_game()
effect human_turn
fun play_human_turn(pair: (list<list<char>>, list<coord>), marks: (char, char)) : coord
effect ai_turn
fun play_ai_turn(pair: (list<list<char>>, list<coord>), marks: (char, char)) : coord
effect player1
fun player1_turn(pair: (list<list<char>>, list<coord>), marks: (char, char)) : coord
fun get_player1_mark() : char
effect player2
fun player2_turn(pair: (list<list<char>>, list<coord>), marks: (char, char)) : coord
fun get_player2_mark() : char
effect turn
// Changes the current player to a different one
fun flip() : ()
// Calls the appropriate code for the current player
fun play_turn(mark: char, other_mark: char) : ()
// Gets the symbol of the active player
fun get_current_mark(): char
// Gets the symbol of the inactive player
fun get_other_mark(): char
// This allows us to access the board
fun get_board() : list<list<char>>
// This allows us to access the moves that have been made
fun get_moves(): list<coord>
type player
Human
AI
type players
One
Two
// This function encapsulates the state of the entire game
// Think of it as calling a method on an object but with pure functions
fun initialize_and_start_game(game_type: int)
var current_player := One
var current_board := create-board()
var all_moves := []
var player1 := Human
var player2 := AI
match game_type
1 -> {
player1 := Human
player2 := Human
}
2 -> {
player1 := Human
player2 := AI
}
3 -> {
player1 := AI
player2 := AI
}
_ -> throw("invalid game type")
with handler
ctl eject()
println("Have a nice day.")
with fun play_human_turn(pair: (list<list<char>>, list<coord>), marks: (char, char))
human_logic(pair.fst,pair.snd,marks.fst,marks.snd)
with fun play_ai_turn(pair: (list<list<char>>, list<coord>), marks: (char, char))
ai_logic(pair.fst,pair.snd,marks.fst,marks.snd)
with handler
fun player1_turn(pair: (list<list<char>>, list<coord>), marks: (char, char))
match player1
Human -> play_human_turn(pair, marks)
AI -> play_ai_turn(pair, marks)
fun get_player1_mark()
'X'
with handler
fun player2_turn(pair: (list<list<char>>, list<coord>), marks: (char, char))
match player2
Human -> play_human_turn(pair, marks)
AI -> play_ai_turn(pair, marks)
fun get_player2_mark()
'O'
with handler
return(x) ()
fun flip()
match current_player
One -> current_player := Two
Two -> current_player := One
fun play_turn(mark: char, other_mark: char)
match current_player
One -> {
val coord = player1_turn((current_board, all_moves), (mark, other_mark))
current_board := mark_board(current_board,coord,get_player1_mark()).unwrap
all_moves := Cons(coord, all_moves)
()
}
Two -> {
val coord = player2_turn((current_board, all_moves), (mark, other_mark))
current_board := mark_board(current_board,coord,get_player2_mark()).unwrap
all_moves := Cons(coord, all_moves)
()
}
fun get_current_mark() match current_player
One -> get_player1_mark()
Two -> get_player2_mark()
fun get_other_mark() match current_player
Two -> get_player1_mark()
One -> get_player2_mark()
fun get_board() current_board
fun get_moves() all_moves
play_game()
fun prompt_game_type()
match readline().list()
Cons('1', Nil) -> 1
Cons('2', Nil) -> 2
Cons('3', Nil) -> 3
_ ->
println("Invalid game mode, please try again")
prompt_game_type()
fun main ()
println("Welcome to Tic Tac Toe!")
println("Please select a game mode:")
println("1. Two player")
println("2. One player")
println("3. Zero player")
println("Enter the number of the game mode you want to play")
val game_type = prompt_game_type()
"Enter your input as 'x y' or 'x,y' when selecting a spot".println
initialize_and_start_game(game_type)
</syntaxhighlight>
=={{header|Kotlin}}==
Line 10,439 ⟶ 12,085:
+---+---+---+
a b c</pre>
=={{header|PostScript}}==
<syntaxhighlight lang="postscript">
%!PS
%
% Play Tic-Tac-Toe against your printer
% 2024-04 Nicolas Seriot https://github.com/nst/PSTicTacToe
%
% On GhostScript:
% gs -DNOSAFER -dBATCH -dNOPAUSE -sDEVICE=pdfwrite -sOutputFile="%d.pdf" ttt.ps
%
% On a real PostScript printer:
% cat ttt.ps - | nc 192.168.2.10 9100
<</PageSize[595 842]>>setpagedevice/Courier findfont 48 scalefont setfont/b
(.........)def/f{/n 0 def b{46 eq{/n n 1 add def}if}forall n}def/w{/c exch def
[(O)(X)]{/p exch def[[0 1 2][3 4 5][6 7 8][0 3 6][1 4 7][2 5 8][0 4 8][2 4 6]]{
/t exch def/o true def t{/pos exch def/o c pos 1 getinterval p eq o and def}
forall o{exit}if}forall o{exit}if}forall o}def/g{/s exch def/m null def f 0 eq{
/m(TIE)def}if b w{/m(XXXXXXX WINS)def m 0 s putinterval}if()= 0 3 6{b exch 3
getinterval =}for()= m null ne{m =}if 4 setlinewidth 200 700 moveto 200 400
lineto 300 700 moveto 300 400 lineto 100 600 moveto 400 600 lineto 100 500
moveto 400 500 lineto stroke 0 1 b length 1 sub{/i exch def b i 1 getinterval
(.)ne{gsave 0 0 moveto 100 i 3 mod 100 mul add 35 add 700 i 3 idiv 100 mul sub
65 sub moveto b i 1 getinterval show grestore}if}for m null ne{100 300 moveto m
show}if showpage m null ne{quit}if}def{/d false def 0 1 8{/i exch def/e b dup
length string cvs def e i 1 getinterval(.)eq{[(X)(O)]{/p exch def e i p
putinterval e w{b i(X)putinterval/d true def exit}if}forall}if d{exit}if}for d
not{/x rand f mod def/c 0 def 0 1 b length 1 sub{/i exch def b i 1 getinterval
(.)eq{c x eq{b i(X)putinterval exit}if/c c 1 add def}if}for}if(PRINTER)g b{
(human turn (1-9) >)print flush(%lineedit)(r)file( )readline pop dup length
0 gt{0 1 getinterval}{pop( )}ifelse/o exch def(123456789)o search{pop pop pop b
o cvi 1 sub 1 getinterval(.)eq{o cvi 1 sub exit}if}{pop}ifelse(bad input) ==}
loop(O)putinterval(HUMAN )g}loop
</syntaxhighlight>
=={{header|Prolog}}==
Line 11,043 ⟶ 12,724:
place.na[!is.na(place.na)] <<- NA
if(total.1==0 | total.2==0 | total.3==0 | total.4==0){
title(sub=list(
}else{
title(sub=list("You Don't Get Tired of Losing ?!", col="darkblue", font=2, cex=2.5), line=2)
Line 12,651 ⟶ 14,332:
--+---+--
X | O | X</pre>
=={{header|Rust}}==
Line 14,124 ⟶ 15,701:
X wins across [1, 4, 7]
</pre>
=={{header|UNIX Shell}}==
Line 14,485 ⟶ 15,859:
</pre>
=={{header|
{{trans|Kotlin}}
<syntaxhighlight lang="v (vlang)">
import rand
import os
Line 14,686 ⟶ 15,898:
if u {
for move !in [1,2,3,4,5,6,7,8,9] {
}
move--
Line 14,770 ⟶ 15,981:
{{trans|Kotlin}}
{{libheader|Wren-ioutil}}
<syntaxhighlight lang="
import "./ioutil" for Input
var r = Random.new()
Line 15,077 ⟶ 16,288:
];
]</syntaxhighlight>
{{omit from|GUISS}}
| |||