Игра Maxit (клон)

Данная программа является клоном игры Maxit под DOS, созданной Dell Patrick Leabo еще в 1982 году.

Управление:

Стрелки вправо, влево - для перемещения курсора
Пробел - для выбора клетки
Escape - выход
Y - новая игра , при окончании текущей игры
N - выход , при окончании текущей игры

Правила:

Играют двое игроков (игрок и компьютер) на поле из 64 клеток. Клетки заполнены различными цифрами, в том числе отрицательными. Задача: к концу игры набрать больше очков, чем соперник. На поле есть курсор , который показывает на какой строке или столбце можно выбрать клетку. Игрок может выбирать только по горизонтали (на строке) . Компьютер выбирает клетку только по вертикали (на столбце). Курсор перемещается с каждым ходом в зависимости от выбранной клетки соперниками.

Например:
1) компьютер выбрал третью клетку по вертикали , игрок теперь может выбрать нужную клетку только на третьей строке.
2) игрок выбрал седьмую клетку по горизонтали, компьютер может выбирать клетку только на седьмом столбце.

При выборе клетки с нужным числом, сама клетка очищается. Игра заканчивается тогда, когда одному из игроков некуда ходить. Например у компьютера нет клеток с цифрами на указанном курсором столбце. Стратегия игры может строится не только на том, чтобы собрать побольше очков, но и на том, чтобы уменьшить кол-во очков у соперника за счет клеток с отрицательными числами. Так же можно подгадать вариант , когда у вас больше очков и выбрать ту клетку, при которой у компьютера не будет ходов.

Платформы: Windows , Linux
Автор: Станислав Будинов

maxit_clone.png

 

#INCLUDE "fbgfx.bi"

#DEFINE INFINITY &hFFF

Using FB

Const NoMove As Byte = -100

Const Pass As Byte = -101

Const PlayerWhite As Byte = 1

Const PlayerBlack As Byte = 0

Const Xmax As Byte = 10

Const Ymax As Byte = 10

Type TSaveMove

    move As Byte

    value As Byte

End Type

Type TBestAlpha

    best As Integer

    alpha_ As Integer

End Type

Randomize Timer

Dim Shared As Byte dimNumbers(63) = {-1,-1,-1,-1,-1,-2,-2,-2,-2,-3,-3,-3,-4,-4,-4,-5,-5,-6,-6,-7,-9,_
1,1,1,1,1,2,2,2,2,2,2,3,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,7,7,7,8,_
8,9,9,10,15,Pass,0,0,0,0,0,0}

Dim Shared As Byte Dimfield(1 To Xmax, 1 To Ymax)

Dim Shared As Byte bCurrentPos

Dim Shared iConstDepth As Integer = 12

Dim Shared As Integer iGlobDepth : iGlobDepth  = iConstDepth

Dim Shared As Integer iWScore,iWGlobalScore

Dim Shared As Integer iBScore,iBGlobalScore

Dim Shared As Integer iBestMove

Dim Shared As Byte bGameOver

Dim Shared As Byte bInterrupt

Declare Function  AlphaBetaBlack (depth As Integer, move As Byte, Alpha_ As Integer, beta As Integer) As Integer

Declare Function two_to_one(x As Byte, y As Byte) As Integer

Declare Function one_to_two(iNpos As Byte) As Integer

Declare Function StatusMove(move As Byte) As Byte

Declare Sub DRAWFIELD()

Declare Sub fillNumber()

Declare Sub DRAWMove(move As Byte)

Declare Sub DrawUpdate()

Sub MakeMove(move As Byte, player As Byte)

    Dim As Integer DoubleMove = one_to_two(move)

    Dim As Byte bx,by

    bx = DoubleMove Shr 4

    by = DoubleMove And &b00001111

    If player = PlayerWhite Then

        iWScore += Dimfield(bx,by)

    Else

        iBScore += Dimfield(bx,by)

    Endif

    Dimfield(bx,by) = Pass

End Sub

Sub UnMakeMove(move As Byte,bvalue As Byte,player As Byte)

    Dim As Integer DoubleMove = one_to_two(move)

    Dim As Byte bx,by

    bx = DoubleMove Shr 4

    by = DoubleMove And &b00001111

    Dimfield(bx,by) = bvalue

    If player = PlayerWhite Then

        iWScore -= Dimfield(bx,by)

    Else

        iBScore -= Dimfield(bx,by)

    Endif

End Sub

Function eval() As Integer

    If bInterrupt = 1 Then

        bInterrupt = 0

        If ((iWGlobalScore + iWScore) - (iBGlobalScore + iBScore)) < 0 Then

            Return -400

        Elseif ((iWGlobalScore + iWScore) - (iBGlobalScore + iBScore)) > 0 Then

            Return 400

        Endif

    Else

        Return (iWGlobalScore + iWScore) - (iBGlobalScore + iBScore)

    Endif

End Function

Function AlphaBetaWhite(depth As Integer, move As Byte, Alpha_ As Integer, beta As Integer) As Integer

    Dim As Integer tmp

    Dim As Integer max = -INFINITY

    If(depth <= 0)  Then Return eval()

    Dim As TSaveMove bTempDim(1 To (Ymax-2))

    Dim As Integer DoubleMove = one_to_two(move)

    Dim As Byte bx,by

    bx = DoubleMove Shr 4

    by = DoubleMove And &b00001111

    Dim j As Integer = 1

    For i As Integer = 1 To Ymax

        If StatusMove(two_to_one(bx,i)) = 0 Then

            bTempDim(j).move = two_to_one(bx,i)

            bTempDim(j).value = Dimfield(bx,i)

            j+=1

        Endif

    Next

    If bTempDim(1).move = 0 Then

        If (depth > 0) Then bInterrupt = 1

        Return eval()

    Endif


    Dim i As Integer = 1

    While bTempDim(i).move

        MakeMove(bTempDim(i).move, PlayerWhite)

        tmp = AlphaBetaBlack(depth-1,bTempDim(i).move, Alpha_, beta)

        UnMakeMove(bTempDim(i).move,bTempDim(i).value,PlayerWhite)

        If(tmp > max) Then

            max = tmp

            If iGlobDepth = depth Then

                iBestMove = bTempDim(i).move

            Endif

        Endif

        If(tmp > alpha_) Then alpha_ = tmp

        If(max >= beta) Then Return max

        i+=1

        If i>(Ymax-2) Then

            Exit While

        Endif

    Wend

    Return max

End Function

Function  AlphaBetaBlack (depth As Integer, move As Byte, Alpha_ As Integer, beta As Integer) As Integer

    Dim As Integer tmp

    Dim As Integer min = INFINITY

    If(depth <= 0) Then Return eval()

    Dim As TSaveMove bTempDim(1 To Xmax-2)

    Dim As Integer DoubleMove = one_to_two(move)

    Dim As Byte bx,by

    bx = DoubleMove Shr 4

    by = DoubleMove And &b00001111

    Dim j As Integer = 1

    For i As Integer = 1 To Xmax

        If StatusMove(two_to_one(i,by)) = 0 Then

            bTempDim(j).move = two_to_one(i,by)

            bTempDim(j).value = Dimfield(i,by)

            j+=1

        Endif

    Next

    If bTempDim(1).move = 0 Then

        If (depth > 0) Then bInterrupt = 1

        Return eval()

    Endif

    Dim i As Integer = 1

    While bTempDim(i).move

        MakeMove(bTempDim(i).move,PlayerBlack)

        tmp = AlphaBetaWhite (depth-1,bTempDim(i).move, Alpha_, beta)

        UnMakeMove(bTempDim(i).move,bTempDim(i).value,PlayerBlack)

        If(tmp < min) Then min = tmp

        If(tmp < beta) Then beta = tmp

        If(min <=alpha_) Then Return min

        i+=1

        If i>(Xmax-2) Then

            Exit While

        Endif

    Wend

    Return min

End Function

Function two_to_one(x As Byte, y As Byte) As Integer

    Return (y-1)*Xmax+x

End Function

Function one_to_two(iNpos As Byte) As Integer

    Dim iBI As Integer

    Dim As Integer x,y

    x = iNpos Mod 10

    If x = 0 Then

        y = iNpos\10

        x = 10

    Else

        y = iNpos\10 +1

    Endif

    iBI = x Shl 4

    iBI Or= y

    Return iBI

End Function

Function StatusMove(move As Byte) As Byte

    Dim As Integer DoubleMove = one_to_two(move)

    Dim As Byte bx,by

    bx = DoubleMove Shr 4

    by = DoubleMove And &b00001111

    If Dimfield(bx,by) = NoMove Then

        Return NoMove

    Elseif Dimfield(bx,by) = Pass Then

        Return Pass

    Else

        Return 0

    Endif

End Function

Sub DRAWFIELD()

    Paint (1, 1), &h002432

    For x As Integer = 1 To Xmax-1

        Line (50+(x-1)*50,50)- (50+(x-1)*50,50*(yMax-1)),&h088154

    Next

    For y As Integer = 1 To Ymax-1

        Line (50,50+(y-1)*50)- (50*(xMax-1),50+(y-1)*50),&h088154

    Next

End Sub

Sub DRAWMove(move As Byte)


    Dim As Integer DoubleMove = one_to_two(move)

    Dim As Byte bx,by

    bx = DoubleMove Shr 4

    by = DoubleMove And &b00001111

    Line (((bx-1)*50)+3, ((by-1)*50)+3) - Step(44,44),&h088154,BF

End Sub

Sub fillNumber()

    For y As Integer = 1 To Ymax

        For x As Integer = 1 To Xmax

            If Dimfield(x,y) = NoMove Orelse Dimfield(x,y) = Pass Then

            Else

                Draw String (((x-1)*50)+21,((y-1)*50)+17),Str(Dimfield(x,y)),&hFFDBCD

            Endif

        Next

    Next

End Sub

Sub RandomSpace()


    For i As Integer = 0 To 10000

        Dim As Integer j1, j2

        Dim As Byte b1, b2

        j1 = Rnd*63

        j2 = Rnd*63

        b1 = dimNumbers(j1)

        b2 = dimNumbers(j2)

        dimNumbers(j1) = b2

        dimNumbers(j2) = b1

    Next

    Dim As Integer iCounter = 0

    For y As Integer = 1 To Ymax

        For x As Integer = 1 To Xmax

            If x = 1 OrElse x = xMax OrElse y = 1 OrElse y = yMax Then

                Dimfield(x,y) = NoMove

            Else

                Dimfield(x,y) = dimNumbers(iCounter)

                If dimNumbers(iCounter) = Pass Then

                    If Dimfield(x-1,y)<> NoMove Then

                        bCurrentPos = two_to_one(x-1,y)

                    Else

                        bCurrentPos = two_to_one(x+1,y)

                    Endif

                Endif

                iCounter+=1

            Endif

        Next

    Next

End Sub

Sub Init()

    Static bInit As Byte

    Dim As Integer iDepth

    iWScore = 0

    iWGlobalScore = 0

    iBScore = 0

    iBGlobalScore = 0

    iBestMove = 0

    bGameOver = 0

    If bInit = 0 Then

        Screenres 500,500,32,2

        Width 500\8, 500\16

        bInit = 1

        Cls

        Paint (1, 1), &h002432

        Locate 240,240

        Print "Depth by default = " & iConstDepth

        Input "Select Depth:"; iDepth

        If iDepth > 0 Then

            iConstDepth = iDepth

            iGlobDepth = iConstDepth

        Else

            iGlobDepth = iConstDepth

        Endif

        Screenset 1

    Endif

    RandomSpace()

    DrawUpdate()

End Sub

Sub OnKeyArrow(istepM As Integer)

    Dim As Integer iCursor

    iCursor = bCurrentPos

    While TRUE

        If StatusMove(iCursor+istepM) = 0 Then

            bCurrentPos = iCursor+istepM

            DrawUpdate()

            Exit While

        Elseif StatusMove(iCursor+istepM) = NoMove Then

            Exit While

        Elseif StatusMove(iCursor+istepM) = Pass Then

            iCursor+=istepM

        Endif

    Wend

End Sub

Sub Anim(bx As Byte, by As Byte, bvalue As Byte, player As Byte)

    For i As Integer = 0 To 2

        Line (((bx-1)*50)+3, ((by-1)*50)+3) - Step(44,44), &h002432,BF

        If player = PlayerBlack Then
            
            Line (((bx-1)*50)+3, ((by-1)*50)+3) - Step(44,44),&h68D05A,B
            
        Else
            
            Line (((bx-1)*50)+3, ((by-1)*50)+3) - Step(44,44),&h8DB8FF,B
            
        Endif
        
        

        Draw String (((bx-1)*50)+21,((by-1)*50)+17),Str(bvalue),&hFFDBCD

        Pcopy

        Sleep(100)

        Line (((bx-1)*50)+3, ((by-1)*50)+3) - Step(44,44),&h002432,B

        Pcopy

        Sleep(100)

    Next

    If player = PlayerBlack Then
        
        Line (65,10) - Step(50,15), &h002432,BF

        Draw String (20,10),"You:  " & iWGlobalScore,&hFFDBCD

    Else
        
        Line (65,25) - Step(50,15), &h002432,BF

        Draw String (20,25),"Comp: " & iBGlobalScore,&hFFDBCD

    Endif

    Line (((bx-1)*50)+3, ((by-1)*50)+3) - Step(44,44), &h002432,BF

    Pcopy
    
    If player = PlayerBlack Then
        
        Sleep(200)
        
    Endif   

End Sub

Sub SetCurentPosMove(player As Byte)

    Dim As Byte ix,iy

    Dim As Integer iBI, iStep

    If player = PlayerWhite Then

        iStep  = 1

    Else

        iStep  = 10

    Endif

    iBI = one_to_two(bCurrentPos)

    ix = iBI Shr 4

    iy = iBI And &b00001111

    Anim(ix,iy,Dimfield(ix,iy),player)

    Dimfield(ix,iy) = Pass

    While TRUE

        If StatusMove(bCurrentPos+iStep) = 0 Then

            bCurrentPos = bCurrentPos+iStep

            Exit While

        Elseif  StatusMove(bCurrentPos+iStep) = NoMove And iStep > 0 Then

            iStep = 0

        Elseif StatusMove(bCurrentPos+iStep) = NoMove Then

            Exit While

        Endif

        If iStep > 0 Then

            If player = PlayerWhite Then

                iStep+=1

            Else

                iStep+=10

            Endif


        Else

            If player = PlayerWhite Then

                iStep-=1

            Else

                iStep-=10

            Endif

        Endif

    Wend

End Sub

Sub DrawUpdate()

    Cls

    DRAWFIELD()

    DRAWMove(bCurrentPos)

    fillNumber()

    Draw String (20,10),"You:  " & iWGlobalScore,&hFFDBCD

    Draw String (20,25),"Comp: " & iBGlobalScore,&hFFDBCD

    If bGameOver = 1 Then

        Draw String (140,470),"Game over! Play again? (y\n)",&hFFDBCD

    Endif

    Pcopy

End Sub

Sub MoveProc()

    If bGameOver = 0 Then

        Dim As Integer iBI

        Dim As Byte bx , by , bc

        iBI = one_to_two(bCurrentPos)

        bx = iBI Shr 4

        by = iBI And &b00001111

        iWGlobalScore += Dimfield(bx , by)

        SetCurentPosMove(PlayerBlack)

        For y As Integer = 2 To (Ymax-1)

            If Dimfield(bx , y) <> Pass Then

                bc+=1

            Endif

        Next

        Dim DimBest(iConstDepth) As TBestAlpha

        If bc > 1 Then

            For k As Integer = 1 To iConstDepth

                iBestMove = -INFINITY

                iGlobDepth = k

                Dim As Integer iscoreAlpha

                iscoreAlpha = AlphaBetaWhite(iGlobDepth,bCurrentPos,-INFINITY, INFINITY)

                If iscoreAlpha = - INFINITY Then

                    Exit For

                Else

                    DimBest(k).best = iBestMove

                    DimBest(k).alpha_ = iscoreAlpha

                Endif

            Next

            iGlobDepth = iConstDepth


            For k As Integer = 0 To iConstDepth

                If DimBest(k).alpha_ > 250  Then

                    iBestMove = DimBest(k).best

                    Exit For

                Else

                    If DimBest(k).best <> 0 Then

                        iBestMove = DimBest(k).best

                    Endif

                Endif

            Next

            bCurrentPos = iBestMove

        Endif

        iBI = one_to_two(bCurrentPos)

        bx = iBI Shr 4

        by = iBI And &b00001111

        If bc = 0 Then

            Dimfield(bx,by) = pass

            bGameOver = 1

        Else

            iBGlobalScore += Dimfield(bx,by)

            SetCurentPosMove(PlayerWhite)

            bc = 0

            iBI = one_to_two(bCurrentPos)

            bx = iBI Shr 4

            by = iBI And &b00001111

            For x As Integer = 2 To (Xmax-1)

                If Dimfield(x , by) <> Pass Then

                    bc+=1

                Endif

            Next

            If bc = 0 Then

                bGameOver = 1

            Endif

        Endif

        DrawUpdate()

    Endif

    While Asc(Inkey):Wend

End Sub

Sub EventProc()

    Dim As Integer iKey

    Do

        iKey = Getkey

        If iKey = 19455 Then

            If bGameOver = 0 Then OnKeyArrow(-1)

        Elseif iKey = 19967 Then

            If bGameOver = 0 Then OnKeyArrow(1)

        Elseif iKey = 32 Then

            MoveProc()

        Endif

        If Multikey(SC_ESCAPE) Then

            Exit Sub

        Elseif Multikey(SC_Y) Then

            If bGameOver Then

                Init()

                Inkey

            Endif

        Elseif Multikey(SC_N) Then

            If bGameOver Then

                Exit Sub

            Endif

        Endif

        Sleep(10)

    Loop

End Sub

Init()

EventProc()