'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(x,y,w,h,index,Rgb(133,136,116),Str(index)) Next x Next y boxes(0)=Type(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(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