This program is a clone of the game under DOS Maxit created Dell Patrick Leabo back in year 1982.
Management in a game:
Left-right arrow - to move the cursor
SPACE - to select cells
Escape - exit
Y - the new game at the end of the current game
N - output at the end of the current game
Rules:
Two players (the player and the computer) in the field from 64 cages play. Cages are filled with various digits, including negative. Task: by the end of the game to score more points, than the rival. In the field there is a cursor which shows on what line or a column it is possible to choose a cage. The player can choose only on a horizontal (at line). The computer chooses a cage only on a vertical (on a column). The cursor moves with each move depending on the chosen cage rivals.
For example:
1) the computer has chosen the third cage on a vertical, the player can choose the necessary cage only on the third line now.
2) the player has chosen the seventh cage on a horizontal, the computer can choose a cage only on the seventh column.
At the choice of a cage with the necessary number, the cage is cleared. A game comes to an end when one of players has no place to go. For example the computer has no cages with figures on the column specified by the cursor. The strategy of a game can is based not only on collecting more points, but also on reducing quantity of points at the rival at the expense of cages with negative numbers. It is also possible to do in time option when you have more points and to choose that cage at which the computer will have no courses.
Code: Select all
#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()