@Dbox , @Qb64pefriends
Homework is done! Lazily...
Here is a first version of my TUI interface of CHESSJS API :
Now I can affirm that it took more time because lazily I started working on the code posted by Dbox at the beginning of the thread...
So I have had to adapt the little differences between QB64pe and QBJS...
well, here a screenshot
![[Image: Chess-Interface-0-1-for-CHESS-API.png]](https://i.ibb.co/QFp5dP2s/Chess-Interface-0-1-for-CHESS-API.png)
what has been coded is:
1) a bi-color chesstable, no more that ugly one color chesstable... we human need the two colors!
2) a improved keyboard input to avoid the input errors
3) a mouse implementation for choosing the piece to move and the square where to move
4) a customizable color setting for chesstable with mouse/keyboard input
5) a customizable view of chess table choosing where the white pieces are at the start of the game
6) a more human history list with at the same row both white both black moves
7) a level difficulty setting menu with mouse/keyboard input
8) a splashscreen at the start with the help for the different setting screens
and here the code
it seems that I got an issue from my Kubuntuland trying to paste the Share/export button into a QBJS code box
so I post here the code in a QB64pe box and at bottom the QBJS.org link.
Code: (Select All)
Import Chess From "https://boxgaming.github.io/qbjs-lib/chess/js-chess-engine.bas"
Option Explicit
const DOWN = 1, UP = 2, LEFT = 3, RIGHT = 4 ' where is the white?
const WF = 8, HF = 12 ' character's dimensions
Dim Shared levels() As String
Dim Shared aiLevel As Integer, COUNTER%, WhiteSide
dim shared as long WhiteSquare , BlackSquare
' default options
WhiteSquare = 11: BlackSquare = 1: WhiteSide = 1
Dim As String mstart, mend, mstr, mstart2, mend2
Dim as integer Mi, MX, MY, Mb
''todo A NEWGAME command after termination for Resign or Endgame
''todo highlighting selected cell and destination cells
''todo promotion issue--> player must chose what kind of piece
'' he takes back from promotion a pawn
''todo Navigable History of the game
''todo let choose color side for Human
''todo get the name for the player
''todo save the game as internal History
''todo save the game as .PGN
''todo free setup of the chess table
''todo loading a FEN
''todo use font pieces with images
''todo let choose set of notations: images or country's set of characters
Help
GetWhiteSide
while _mouseinput or _mousebutton(1):_limit 60: wend
GetColorChess
while _mouseinput:_limit 60: wend
GetAILevel
while _mouseinput or _mousebutton(1): _limit 60:wend
Do
Cls
PrintBoard WhiteSide
Locate 16, 40:print "Enter location of piece to move (e.g. C2)"
' TODO mouse input embedded with keyboard input
mstart = " "
' here it takes the letter of cell or Q-uit command
While LEN(mstart) > 0 and instr("ABCDEFGHQ",mstart) = 0
mstart = Ucase$(inkey$)
if mstart = "" then mstart = " "
' it waits that mouse stops
do
Mi = _mouseinput
_limit 60
loop until Mi = 0
Mb = _mousebutton(1)
MX = _mouseX
MY = _mouseY
if mstart = " " then
if Mb then
mstart = GetMousePosition$(MX, MY)
if len(mstart) = 2 then exit while
end if
end if
locate 24,4: print "Targeted square -> " ; GetMousePosition$(_mousex, _mousey);" ";
_limit 60
WEND
locate 17,40: print mstart;
if len(mstart) <2 then
If mstart = "Q" Or mstart = "q" Then Exit Do
' here it takes the digit of cell
mstart2 = " "
While LEN(mstart2) > 0 and instr("12345678",mstart2) = 0
mstart2 = Ucase$(inkey$)
if mstart2 = "" then mstart2 = " "
_limit 60
WEND
print mstart2
mstart = mstart+mstart2
end if
while _mouseinput or _mousebutton(1): _limit 60: wend
mstr = GetMoves(mstart)
If mstr = "" Then
Color 6: locate 18,40: Print " No available moves for this piece."
Color 7:
locate 19,40: Print " Press any key to continue... "
Sleep 3
Else
FOR COUNTER% = 1 TO (len(mstr)/24)+1
locate 18+ COUNTER%,40
Print "Available moves: "; mid$(mstr, 1+(COUNTER% -1) * 24, 24)
NEXT
end if
if mstr <>"" then
'36 characters
locate 18+ COUNTER%,40: print "Enter destination location (e.g. C4)"
' the chosen cell has passed also as mend
while _mouseinput: wend
' here it takes the letter of cell or Q-uit command
mend = " "
While LEN(mend) > 0 and instr("ABCDEFGHQ",mend) = 0
mend = Ucase$(inkey$)
if mend = "" then mend = " "
'mouse input
' it waits that mouse stops
Mi =0
do
Mi = _mouseinput
_limit 60
loop until Mi = 0
Mb = _mousebutton(1)
MX = _mouseX
MY = _mouseY
if mend = " " then
if Mb then
mend = GetMousePosition$(MX, MY)
if len(mend) = 2 then exit while
end if
end if
locate 24,4: print "Targeted square -> " ;GetMousePosition$(_mousex, _mousey);" ";
_limit 60
WEND
if len(mend)<2 then
locate 19+ COUNTER%,40: print mend;
If mend = "Q" Or mend = "q" Then Exit Do
' here it takes the digit of cell
mend2 = " "
While LEN(mend2) > 0 and instr("12345678",mend2) = 0
mend2 = Ucase$(inkey$)
if mend2 = "" then mend2 = " "
_limit 60
WEND
mend = mend + mend2
print mend
end if
If Not Chess.Move(mstart, mend) Then
Dim msg As String
msg = Chess.LastErrorMessage
Color 6: locate 19,40: Print " "; msg
Color 7: locate 20,40: Print " Press any key to continue... ";
Sleep 3
Else
Cls
PrintBoard WhiteSide
Delay .1
If Not Chess.IsFinished Then Chess.AIMove aiLevel - 1
End If
End If
Loop Until Chess.IsFinished
If Chess.IsFinished
Cls
PrintBoard WhiteSide
End If
Print
Print " Game Over";
If Not Chess.IsFinished Then
Print " - White Resigns"
ElseIf Chess.IsCheckMate Then
If Chess.Turn = "black" Then
Print " - White Wins!"
Else
Print " - Black Wins!"
End If
Else
Print " - Stalemate"
End If
'Console.Echo Chess.FEN
Function GetMousePosition$ (Y as single, X as single)
GetMousePosition$= " " ' we preset to failure of function
dim Column as Integer, Row as Integer
dim as string Line1, Line2
if (Y >= 20 + (4* WF)) and (Y< 20 + (4* WF)+ (3 * WF *1)) then
' column 1
Column = 1
elseif (Y>= 20 + (4* WF) + (3 * WF *1)+1) and (Y< 20 + (4* WF)+ (3 * WF *2)) then
' column 2
Column = 2
elseif (Y>= 20 + (4* WF) + (3 * WF *2)+1) and (Y< 20 + (4* WF)+ (3 * WF *3)) then
' column 3
Column = 3
elseif (Y>= 20 + (4* WF) + (3 * WF *3)+1) and (Y< 20 + (4* WF)+ (3 * WF *4)) then
' column 4
Column = 4
elseif (Y>= 20 + (4* WF) + (3 * WF *4)+1) and (Y< 20 + (4* WF)+ (3 * WF *5)) then
' column 5
Column = 5
elseif (Y>= 20 + (4* WF) + (3 * WF *5)+1) and (Y< 20 + (4* WF)+ (3 * WF *6)) then
' column 6
Column = 6
elseif (Y>= 20 + (4* WF) + (3 * WF *6)+1) and (Y<20 + (4* WF)+ (3 * WF *7)) then
' column 7
Column = 7
elseif (Y>= 20 + (4* WF) + (3 * WF *7)+1) and (Y< 20 + (4* WF)+ (3 * WF *8)) then
' column 8
Column = 8
else
column = 100
end if
if (X<=(34 + (3 *HF *9))+1) and (X > (34 + (3 *HF *8))) then
Row = 8
elseif (X<= (34 + (3 *HF *8))+1) and (X> (34 + (3 *HF *7))) then
Row = 7
elseif (X<= (34 + (3 *HF *7))+1) and (X> (34 + (3 *HF *6))) then
Row = 6
elseif (X<= (34 + (3 *HF *6))+1) and (X> (34 + (3 *HF *5))) then
Row = 5
elseif (X<= (34 + (3 *HF *5))+1) and (X> (34 + (3 *HF *4))) then
Row = 4
elseif (X<= (34 + (3 *HF *4))+1) and (X> (34 + (3 *HF *3))) then
Row = 3
elseif (X<= (34 + (3 *HF *3))+1) and (X> (34 + (3 *HF *2))) then
Row = 2
elseif (X<= (34 + (3 *HF *2))+1) and (X> (34+ (3 * HF *1))) then
Row = 1
else
Row = 200
end if
' if function fails it returns a space string
if Column = 100 or Row = 200 then exit function
select case WhiteSide
case down
line2 = "87654321"
line1 = "ABCDEFGH"
GetMousePosition$ = mid$(line1, Column,1) +mid$(line2, Row,1)
case up
line2 = "12345678"
line1 = "HGFEDCBA"
GetMousePosition$= mid$(line1, Column,1) +mid$(line2, Row,1)
case left
line2= "ABCDEFGH"
line1 = "12345678"
GetMousePosition$= mid$(line2,Row ,1) +mid$(line1,Column ,1)
case right
line2 = "HGFEDCBA"
line1 = "87654321"
GetMousePosition$= mid$(line2, Row,1) +mid$(line1,Column,1)
end select
end function
Function GetMoves (pos As String)
Dim result As String
ReDim m(0) As String
m = Chess.Moves(UCase$(pos))
Dim i As Integer
For i = 1 To UBound(m)
result = result + m(i) + " "
Next i
GetMoves = result
End Function
Sub GetWhiteSide
Dim WhiteAt(1 to 4) as string
WhiteAt(1) = " Down: at the bottom of chesstable "
WhiteAt(2) = " Up: at the top of chesstable "
WhiteAt(3) = " Left: at the left side of chesstable "
WhiteAt(4) = " Right: at the right side of chesstable"
Dim i As Integer
Whiteside = 1
do
cls
_printstring (160,100)," Select the side of White player"
For i = 1 To 4
if i = Whiteside then color 3, 14 else color 15, 0
_Printstring (160, 100 + (20 *i)), " -> "+i+WhiteAt(i) + " <- "
Next i
color 15, 0
_printstring (160,220), " Enter White side position 1-4"
do 'input loop
dim k, mw, lmb
k=0: mw = 0: lmb = 0
do ' mouse
mw = _mouseinput
loop until (mw = 0)
mw = _mousewheel
lmb = _mousebutton(1)
k = _keyhit ' keyboard
if (k = 32) or (k = 13) or (lmb = -1) then exit sub
if (k = 18432) or (mw = -1) then
if Whiteside >1 then
Whiteside = Whiteside -1
exit do
end if
end if
if (k = 20480) or (mw = 1) then
if Whiteside <4 then
Whiteside = Whiteside +1
exit do
end if
end if
_limit 60
loop
loop
End Sub
Sub GetAILevel
levels(1) = "Beginner"
levels(2) = "Easy"
levels(3) = "Intermediate"
levels(4) = "Advanced"
levels(5) = "Expert"
Dim i As Integer
aiLevel = 1
do
cls
_printstring (200,100)," Select a Difficulty Level" 'Print " Select a Difficulty Level"
For i = 1 To 5
if i = aiLevel then color 3, 14 else color 15, 0
_Printstring (200, 100 + (20 *i)), " -> " + i + "- " + levels(i)+space$( 12 -LEN(levels(i)))
Next i
color 15, 0
_printstring (200,220), " Enter Difficulty Level 1-5"
do 'input loop
dim k, mw, lmb
k=0: mw = 0: lmb = 0
do ' mouse
mw = _mouseinput
loop until (mw = 0)
mw = _mousewheel
lmb = _mousebutton(1)
k = _keyhit ' keyboard
if (k = 32) or (k = 13) or (lmb = -1) then exit sub
if (k = 18432) or (mw = -1) then
if aiLevel >1 then
aiLevel = aiLevel -1
exit do
end if
end if
if (k = 20480) or (mw = 1) then
if aiLevel <5 then
aiLevel = aiLevel +1
exit do
end if
end if
_limit 60
loop
loop
End Sub
Sub PrintBoard (W as integer)
Locate 4, 40: Print "Turn: "; Chess.Turn; " "
Locate 6, 40: Print "Level: "; levels(aiLevel)
Locate 15, 40: Print "Enter 'Q' to Quit or "
If Chess.IsCheckMate Then
Locate 8, 40: Color 4: Print "Check Mate"
ElseIf Chess.IsCheck Then
Locate 8, 40: Color 6: Print "Check"
End If
PrintHistory
Locate 1, 1
Dim As String bstate(), p, s
bstate = Chess.BoardPieces
Dim As Integer rank, file, FirstCell
Dim as string line1, line2, line3
' the output on the screen must be flexible
Color 7,0
select case W
case DOWN:
line1 = " A B C D E F G H"
line2 = "12345678"
FirstCell = 0
line3 = "ABCDEFGH"
case UP:
line1 = " H G F E D C B A"
line2 = "87654321"
FirstCell = 0
line3 = "HGFEDCBA"
case LEFT:
line1 = " 1 2 3 4 5 6 7 8"
line2 = "HGFEDCBA"
FirstCell = 7
line3 = "12345678"
case RIGHT:
line1 = " 8 7 6 5 4 3 2 1"
line2= "ABCDEFGH"
FirstCell = 7
line3 = "87654321"
end select
_printstring (20,34), line1
' con ciclo for disegnare le 64 caselle a colori alternati
for file = 8 to 1 step -1
_printstring(20,(34 + (3*HF *(9-file))))," "+ mid$(line2, file,1)
for rank = 1 to 8 step 1
if FirstCell = 0 then
' la prima cella è scura
if (file mod 2 = 0) then ' le righe pari
if (rank mod 2) = 0 then Color ,BlackSquare else Color ,WhiteSquare
' le celle pari sono scure e le celle dispari sono bianche
else
' le righe dispari
if (rank mod 2) = 0 then Color ,WhiteSquare else Color ,BlackSquare
' le celle pari sono bianche e le celle dispari sono scure
end if
else
' la prima cella è chiara
if (file mod 2 = 0) then ' le righe pari
if (rank mod 2) = 0 then Color ,WhiteSquare else Color ,BlackSquare
' le celle pari sono scure e le celle dispari sono bianche
else
' le righe dispari
if (rank mod 2) = 0 then Color ,BlackSquare else Color ,WhiteSquare
' le celle pari sono bianche e le celle dispari sono scure
end if
end if
_printstring(20 +(4 * WF)+(3 * WF *(rank -1)),(34 -HF+ (3* HF *(9-file))))," "
_printstring(20 +(4 * WF)+(3 * WF *(rank -1)),(34 + (3 *HF *(9-file))))," "
_printstring(20 +(4 * WF)+(3 * WF *(rank -1)),(34 + HF +(3 * HF *(9-file))))," "
'per mostrare i pezzi
' file = colonna rank = riga
select case W
case DOWN, UP:
s = mid$(line3,rank,1) +mid$(line2, file,1)
case LEFT , RIGHT:
s = mid$(line2,file,1) +mid$(line3, rank,1)
end select
's = Chr$(rank) + file prima la lettera poi il numero
p = bstate(s)
If p = "" Then
' p = " "
else
If p > "A" And p < "Z" Then Color 15 Else Color 0
_printstring(20 +(5 * WF)+(3 * WF *(rank -1)),(34 + (3 *HF *(9-file)))),p
end if
next rank
color 7,0
next file
End Sub
Sub PrintHistory
ReDim hist(0) As Object
hist = Chess.History
If UBound(hist) < 1 Then Exit Sub
Dim t As String
Locate 2, 58: Print "History: White | Black "
Locate 3, 58: Print "──────┬────────┬────────"
Dim row As Integer
row = 4 ' max 15 righe dalla 4rta
Dim i As Integer, min as integer, max as integer
if ubound(hist) > 20 then
min = ubound(hist)-19
max = ubound(hist)
else
min = 1
max = ubound(hist)
end if
For i = min To max Step 1
if hist(i).turn = "white" then
Locate row, 58
t = Right$(" " + Str$(fix(i/2)+1), 5)
Print t; " │ "; hist(i).from;"-";hist(i).to;
else
locate row,72: print " │ "; hist(i).from;"-";hist(i).to
row = row + 1
end if
If row > 19 Then Exit For
Next i
End Sub
Sub GetColorChess
ReDim i As Integer, WS(1 To 14) As Integer, BS(1 To 14) As Integer
ReDim Wi As Integer, Bi As Integer, Where As String, Bhere As String
ReDim k, rmb, lmb, mw, Olmb, Ormb
For i = 1 To 14
WS(i) = i
BS(i) = 15 - i
Next
Wi = 1: Bi = 1
Olmb = 0: Ormb = 0
Do
Cls
Color 15, 0
_PrintString (180, 100), " Select ChessSquare color combinations"
For i = 1 To 14
Color 15, WS(i)
If Wi = i Then Where = "->" Else Where = " "
If Bi = i Then Bhere = "<-" Else Bhere = " "
_PrintString (250, 100 + (20 * i)), " " + Where + "P "
Color 0, BS(i)
_PrintString (320, 100 + (20 * i)), " p" + Bhere + " "
Next i
Color 15, 0
_PrintString (160, 20), " ACTION KEYBOARD MOUSE "
_PrintString (160, 40), " choose colors Enter/Space MouseWheel "
_PrintString (160, 60), "change White square W/w Left click "
_PrintString (160, 80), "change Black square B/b Right click "
Do 'input loop
k = 0: rmb = 0: lmb = 0: mw = 0
Do ' mouse
mw = _MouseInput
_limit 60
Loop Until (mw = 0)
while _mouseinput: wend
if Ormb <> _mousebutton(2) then rmb = _MouseButton(2) :Ormb = rmb
if Olmb <> _mousebutton(1) then lmb = _MouseButton(1) : Olmb = lmb
mw = _MouseWheel
k = _KeyHit ' keyboard
If (k = 32) Or (k = 13) Or (mw <> 0) Then Exit Sub
If (k = 87) Or (k = 119) Or (lmb = -1) Then
If Wi =14 Then Wi = 1 Else Wi = Wi + 1
WhiteSquare = WS(Wi)
Exit Do
End If
If (k = 66) Or (k = 98) Or (rmb = -1) Then
If Bi =14 Then Bi = 1 Else Bi = Bi + 1
BlackSquare = BS(Bi)
Exit Do
End If
_Limit 60
Loop
Loop
End Sub
Sub Help
cls
_PrintString (160, 20), " CHESS INTERFACE version 0.1 for QBJS CHESS API "
sleep 1
_PrintString (200, 40), "by Lucky TempodiBasic"
sleep 2
_PrintString (160, 80), "Help:--> Color Settings "
_PrintString (160, 100), " ACTION KEYBOARD MOUSE "
_PrintString (160, 120), " choose colors Enter/Space MouseWheel "
_PrintString (160, 140), "change White square W/w Left click "
_PrintString (160, 160), "change Black square B/b Right click "
_PrintString (160, 200), "Help:--> Difficulty & WhiteSide Settings "
_PrintString (160, 220), " ACTION KEYBOARD MOUSE "
_PrintString (160, 240), " choose level/side Enter/Space Left click "
_PrintString (160, 260), " Up item Up key cursor MouseWheel "
_PrintString (160, 280), " Down item Down key cursor MouseWheel "
_printstring (200, 320), "Press a key to continue..."
while inkey$ = "" : _limit 60: wend
end sub
to copy and paste in
QBJS.ORG
I hope that you like to play chess by mouse on a colored chess table.
Good luck for the game!
