FreeBasic

Реализация знаменитой игры палочки, только вместо палочек выступают кружки. Для тех кто не знаком с этой игрой:  соперники по очереди могут убирать не более 3 кружков, тот кому достанется последний проиграл. Игра ведется с компьютером. Кол-во кружков всегда разное. Управление мышкой.
Платформы: Windows , Linux.
Автор: Станислав Будинов, создано 2011 году.

#INCLUDE "fbgfx.bi"

Using FB
Randomize Timer

Screenres 320,240

Windowtitle "Circles"

Type D
    MASS(35) As Integer

    Num As Integer

    Lw As Integer=25

    Lh As Integer=1

End Type

Type Koord
    x As Integer

    y As Integer

End Type


Dim Shared Dp As D
Dim Shared K As EVENT
Dim Shared EvM As Koord
'Neo?aeiia ?enei
Sub RND_()
    Dp.Num=Int(Rnd*20)+15

    Erase(Dp.MASS)
End Sub

' i?iaa?ea ia naiia aieuoia eie-ai auaaeaiiuo e?o?eia
Function CheckFull() As Integer

    Dim As Integer R
    For a As Integer=1 To Dp.num
        If Dp.MASS(a)=1 Then

            R+=1

        Endif
    Next

    If R=3 Then

        Return 1

    Elseif R=0 Then

        Return 2

    Endif
End Function

' ?eniaaiea aieiaoee i?eaaiey
Sub wait_(p As Any Ptr)
    For v As Integer=1 To 2

        For a As Integer=1 To 10

            Circle (122, 24), a\2,a,,,,F
            Circle (200, 24), a\2,a,,,,F
            Sleep(100)
        Next

    Next

    Circle (122, 24), 5,0,,,,F
    Circle (200, 24), 5,0,,,,F
End Sub

'?eniaaiea eiiiee
Sub But(butF As Integer)
    Dim As Integer a,b
    If butF=0 Then

        a=3:b=1

    Else

        a=5:b=4

    Endif
    Line (270, 210)-(300, 225), a, bf
    Line (271, 211)-(299, 224), b, bf
    Draw String (278, 214), "Ok"
End Sub

'?eniaaiea e?o?eia
Sub drC()
    For n As Integer=1 To Dp.Num
        Select Case Dp.MASS(n)
            Case 0

                Circle (Dp.Lw, Dp.Lh*50), 10,2,,,,F
            Case 1

                Circle (Dp.Lw, Dp.Lh*50), 10,6,,,,F
            Case 2

                Circle (Dp.Lw, Dp.Lh*50), 10,0,,,,F
        End Select

        Dp.Lw+=30

        If Dp.Lw > 300 Then

            Dp.Lh+=1: Dp.Lw=25

        Endif
    Next

    Dp.Lw=25

    Dp.Lh=1

End Sub

' ?eniaaiea ?aiee e caaieiaea
Sub EnotherDraw()
    Draw "BM 5,5 R310 D230 L310 U230"
    Draw String (135, 20), "Circles"
End Sub

' Oaaeaiea aua?aiiuo y?aae
Sub ClearSel()
    For a As Integer=1 To Dp.num
        If Dp.MASS(a)=1 Then

            Dp.MASS(a)=2

        Endif
    Next

End Sub

' Caione iiaie ea?u
Sub newGame()
    RND_()
    drC()
    EnotherDraw()
    But(0)
End Sub

'Ieii auea?uoa eee i?iea?uoa
Sub PV(st As String)
    Cls

    Draw String (45, 100),ST & " Want to play again?"
    Draw String (97, 130),"Y - Yes , N - No"
    Do

        If Multikey(SC_Y) Then

            Cls

            newGame()
            Exit Sub

        Elseif Multikey(SC_N) Then

            End

        Endif
    Loop

End Sub

'I?iaa?ea eia?ueony y?aae
Sub Check(RR() As Integer)
    Dim As Integer R
    For a As Integer=1 To Dp.num
        If Dp.MASS(a)=0 Then

            R+=1

            RR(R)=a
        Endif
    Next

    RR(0)=R
End Sub

' I?iaa?ea ia i?iea?uo
Function finish() As Integer

    For a As Integer=1 To Dp.num
        If Dp.MASS(a)<>2 Then Return 1

    Next

End Function

'Oia eiiiu?oa?a
Sub AI(p As Any Ptr)
    Setmouse(,,0)
    Sleep(2000,1)
    Dim As Integer RR(35),R1,R2
    Check(RR())
    If  RR(0)-1=1 Or RR(0)-1=5 Or RR(0)-1=9 Or RR(0)-1=13 Or RR(0)-1=17 Then R2=1

    If  RR(0)-2=1 Or RR(0)-2=5 Or RR(0)-2=9 Or RR(0)-2=13 Or RR(0)-2=17 Then R2=2

    If  RR(0)-3=1 Or RR(0)-3=5 Or RR(0)-3=9 Or RR(0)-3=13 Or RR(0)-3=17 Then R2=3

    If R2<>0 Then

        For a As Integer=1 To R2
            R1=Int(Rnd*RR(0))+1

            Dp.MASS(RR(R1))=2

            Erase(RR)
            Check(RR())
        Next

    Else

        For a As Integer=1 To Int(Rnd*3)+1

            R1=Int(Rnd*RR(0))+1

            Dp.MASS(RR(R1))=2

            If finish()<>1 Then

                PV("You won!")
                Exit For

            Endif
            Erase(RR)
            Check(RR())
        Next

    Endif
    drC()
    Setmouse(,,1)
End Sub

' ?aniiciaaaiea e?o?ea a no?iea
Function RK() As Integer

    Dim As Integer xx=15,yy=35

    For a As Integer=1 To 10

        If EvM.x>xx And EvM.x<yy Then
            Return a
        Endif
        xx+=30:yy+=30

    Next

End Function


' ii?aaaeaiea niauoey a eiiiea eee a e?o?eao e ii?aaaeaiea e?o?ea
Sub Ev()
    If EvM.x>270 And EvM.x<300 And EvM.y>210 And EvM.y<225 Then

        If CheckFull=2 Then Exit Sub

        But(1)
        ClearSel()
        If finish()=1 Then

            Threadcreate(Cast(Any Ptr,@wait_()))
            Threadcreate(Cast(Any Ptr,@AI()))
        Else

            PV("You lost!")
        Endif
    Endif
    Dim As Integer xx=40,yy=60

    For a As Integer=1 To 4

        If EvM.y>xx And EvM.y<yy Then

            If CheckFull=1 Then

                If Dp.MASS(RK+(a-1)*10)<>1 Then

                    Exit Sub

                Endif
            Endif
            If RK<>0 Then

                Dp.MASS(RK+(a-1)*10)=Dp.MASS(RK+(a-1)*10) Xor 1

            Endif
        Endif
        xx+=50:yy+=50

    Next

End Sub

newGame()
Do

    If (Screenevent(@K)) Then

        If K.type=EVENT_MOUSE_BUTTON_PRESS Then

            If K.button=1 Then

                Getmouse(EvM.x,EvM.y)
                Ev()
                drC()
                EnotherDraw()
            Endif
        Elseif K.type=EVENT_MOUSE_BUTTON_release Then

            But(0)
        Endif
    Endif
    Sleep(1)
Loop Until K.type=EVENT_WINDOW_CLOSE