Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
425
Task/Tic-tac-toe/FreeBASIC/tic-tac-toe-1.basic
Normal file
425
Task/Tic-tac-toe/FreeBASIC/tic-tac-toe-1.basic
Normal file
|
|
@ -0,0 +1,425 @@
|
|||
'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
|
||||
241
Task/Tic-tac-toe/FreeBASIC/tic-tac-toe-2.basic
Normal file
241
Task/Tic-tac-toe/FreeBASIC/tic-tac-toe-2.basic
Normal file
|
|
@ -0,0 +1,241 @@
|
|||
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
|
||||
Loading…
Add table
Add a link
Reference in a new issue