Игра Maxit (клон)
Данная программа является клоном игры Maxit под DOS, созданной Dell Patrick Leabo еще в 1982 году.
Управление:
Стрелки вправо, влево - для перемещения курсора
Пробел - для выбора
клетки
Escape - выход
Y - новая игра , при окончании текущей игры
N -
выход , при окончании текущей игры
Правила:
Играют двое игроков (игрок и компьютер) на поле из 64 клеток. Клетки заполнены различными цифрами, в том числе отрицательными. Задача: к концу игры набрать больше очков, чем соперник. На поле есть курсор , который показывает на какой строке или столбце можно выбрать клетку. Игрок может выбирать только по горизонтали (на строке) . Компьютер выбирает клетку только по вертикали (на столбце). Курсор перемещается с каждым ходом в зависимости от выбранной клетки соперниками.
Например:
1) компьютер выбрал третью клетку по вертикали , игрок теперь
может выбрать нужную клетку только на третьей строке.
2) игрок выбрал седьмую
клетку по горизонтали, компьютер может выбирать клетку только на седьмом
столбце.
При выборе клетки с нужным числом, сама клетка очищается. Игра заканчивается тогда, когда одному из игроков некуда ходить. Например у компьютера нет клеток с цифрами на указанном курсором столбце. Стратегия игры может строится не только на том, чтобы собрать побольше очков, но и на том, чтобы уменьшить кол-во очков у соперника за счет клеток с отрицательными числами. Так же можно подгадать вариант , когда у вас больше очков и выбрать ту клетку, при которой у компьютера не будет ходов.
Платформы: Windows , Linux
Автор: Станислав Будинов
#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()
Онлайн версия игры здесь
