Το παιχνίδι όπως το λέει και ο τίτλος είναι ένα ΣΚΑΚΙ. Ο κώδικας είναι γραμμένος με αγγλικές εντολές της Μ2000.
Σημαντικά στοιχεία του παιχνιδιού από προγραμματιστική άποψη
Το πρόγραμμα αν βρει το αρχείο engine.exe υποθέτει ότι είναι μια εξωτερική μηχανή σκακιού! Δείτε στις σημειώσεις στην αρχή του προγράμματος που βρίσκουμε μια μηχανή σκακιού!
Υπάρχουν δυο πιθανοί τίτλοι:
Chess Game for two
Chess Game UCI Engine
Με τη μηχανή σκακιού εμφανίζεται το δεύτερο όνομα. Στην πρώτη περίπτωση το πρόγραμμα δίνει διαδοχικά σε δυο παίχτες τη σειρά να παίξουν, και κοιτάει αν η κίνηση είναι δυνατή ή όχι. Στη δεύτερη περίπτωση ο υπολογιστής παίζει με τα μαύρα. Πρακτικά είναι αδύνατον να τον κερδίσουμε! Το engine.exe είναι ένα πρόγραμμα 22.2 Mbyte (τεράστιο), και δέχεται μια σειρά FEN (τρόπος να καταχωρηθεί μια στάση στο Σκάκι) και ένα χρόνο "σκέψης", εδώ είναι από 50 έως 200ms ( το τροφοδοτούμε με ένα τυχαίο νούμερο μεταξύ 50 και 200). Το πρόγραμμα αυτό το καλεί το δικό μας πρόγραμμα και περιμένει σε αναμονή να πάρει εντολές και επιστρέφει στοιχεία, από τα οποία μας ενδιαφέρει το bestmove το οποίο είναι μια σειρά FEN.
Να ένα παράδειγμα σειράς FEN (Forsyth-Edwards Notation)
rnbqkbnr/pppp1ppp/4p3/8/4P3/8/PPPP1PPP/RNBQKBNR w KQkq - 2 2
Για τα πιόνια του σκακιού χρησιμοποιούμε αυτά που υπάρχουν στην Arial Unicode MS και αν δεν υπάρχει αυτή η γραμματοσειρά γίνεται επιλογή της DejaVu Sans.
Άσπρα πιόνια ♙♘♗♖♕♔
Μαύρα πιόνια ♟♞♝♜♛♚
Όταν γράφτηκε η πρώτη έκδοση του προγράμματος δεν υπήρχε ο κώδικας για την κίνηση του πιονιού με το ποντίκι. Όλα γίνονταν με την εισαγωγή από το πληκτρολόγιο. Για να γίνουν και τα δυο ταυτόχρονα δυνατά, δηλαδή και να παίρνει εντολή από το ποντίκι αλλά και από το πληκτρολόγιο, επιστρατεύθηκαν τα NHMATA
Τα νήματα είναι κώδικας που εκτελείται ανά διαστήματα. Υπάρχουν δυο σχήματα για τα νήματα. Το ένα λέγεται στα ελληνικά Ταυτόχρονο (concurrent) και το άλλο Διαδοχικό. (sequential). Εδώ χρησιμοποιούμε το Διαδοχικό:
Thread.plan sequential
Στο διαδοχικό σχέδιο κάθε νήμα ολοκληρώνει μια φορά εκτέλεσης, και δίνει χρόνο στο σύστημα να αποφασίσει πιο νήμα θα εκτελέσει. Όσο τα νήματα βρίσκονται στο σύστημα εκτελούνται εκτός και αν μπουν σε αναμονή ή διαγραφούν.
Στον κώδικα θα κοιτάξουμε (με ctrl F3 δίνουμε αυτό που ψάχνουμε, και με τα F2 και F3 πάμε αντίστοιχα πάνω ή κάτω στην αναζήτηση). τις εντολές Thread και θα βρούμε τρια μπλοκ που ορίζονται τρία Thread με όνομα (το όνομα αντιστοιχεί σε ένα νούμερο, το νούμερο του χειριστή του νήματος).
Σε σειρά όπως είναι στο πρόγραμμα:
Handler: Χρησιμοποιείται για να διαβάζει το ποντίκι σε περιπτώσεις εκτός του κύριου παιχνιδιού.
pSp: Μετακινεί το πιόνι με το ποντίκι και κοιτάει από κάτω αν έχουμε άδεια θέση, δεν γίνεται έλεγχος εδώ. Τερματίζει την εκτέλεσή του όταν αφήσουμε το κουμπί του ποντικιού και στέλνει την θέση που υποδείξαμε στο πληκτρολόγιο
Sp: Επιλέγουμε πιόνι με το ποντίκι, ξεκινάει το pSp
Η Οθόνη του περιβάλλοντος της Μ2000 δεν διαχειρίζεται τα γεγονότα του ποντικιού όπως σε μια φόρμα χρήστη (παράθυρο), όπου στο τελευταίο έχουμε μια συνάρτηση δική μας που καλείται από το γεγονός κίνησης του ποντικιού. Για το λόγο αυτό αντί να συνδέσουμε μια συνάρτηση με το ποντίκι (προγραμματισμός με γεγονότα), κάνουμε το λεγόμενο polling ή ελληνικά την παρακολούθηση αλλαγής κατάστασης. Αυτό κάνουν τα νήματα για το πρόγραμμα.
Στο Game Loop (δεν ονομάζεται αλλά θα δείτε από τη 274η γραμμή δυο αγκύλες (μια στο 274 και μια στο 275), όπου η εσωτερική ανοίγει ένα μπλοκ εντολών του βασικού παιχνιδιού, ενώ αυτό στο 274 έχει στην αρχή το σκάκι και μετά τη συνέχεια όταν πατήσουμε Esc, με την εμφάνιση της FEN σειράς και τη δυνατότητα να πάμε πίσω τις κινήσεις ή να τερματίσουμε το πρόγραμμα.
Στο Game Loop, υπάρχει η εντολή Every 1000/60 { εντολές } (όπου 1000/60 msec είναι 1/60 sec)
Αυτήν την εντολή την έχουμε δει και στο πρώτο μάθημα στα ελληνικά ως Κάθε. Εκτελεί το μπλοκ εντολών και μετά κάνει καθυστέρηση ώστε ο συνολικός χρόνος, εκτέλεσης του μπλοκ και της καθηστέρησης να είναι όσο δηλώσαμε. Ενδέχεται να είναι λίγο μεγαλύτερος, ή αν ο χρόνος εκτέλεσης του μπλοκ είναι περισσότερος από το χρόνο που θέλουμε να καλείται τότε δεν έχουμε καθυστέρηση. Όμως μεταξύ δυο διαδοχικών εκτελέσεων της Κάθε ή Every έχουμε μια τουλάχιστον καθυστέρηση ασήμαντου μεν χρόνου αλλά μπορεί να προκύψει εκτέλεση νήματος.
Γενικά όταν χειριζόμαστε νήματα μπορούμε αντί του Every ή Κάθε να χρησιμοποιήσουμε το Main.Task ή Κύριο.Έργο όπου αποτελεί το ίδιο Νήμα, και έτσι μπορούμε να έχουμε και το ταυτόχρονο σχέδιο (όπου εκτελούνται παράλληλα τα νήματα). Στο πρόγραμμά μας δεν έχουμε πρόβλημα συγχρονισμού με την Every οπότε συνεχίζουμε ως έχει!
Δείτε ένα ενδιαφέρον τμήμα (Module)
Module Beep {
Layer {Print $(4)," Not Possible",$(0);}
if NoSound Else Beep
}
Το τμήμα έχει όνομα το Beep, δηλαδή αναπρογραμματίζουμε το Beep που κάνει έναν τόνο. Δείτε ότι ο αναπρογραμματισμός γίνεται στο επίπεδο που ορίζουμε το Beep, και όχι μέσα στο επίπεδο του τμήματος!
Η Οθόνη της κονσόλας έχει συνολικά 34 επίπεδα τα οποία μπορούν να προγραμματιστούν ως προς το μέγεθος και την θέση τους. Το πιο κάτω επίπεδο είναι το Back ή Περιθώριο. Το σκάκι φτιάχνεται στο Περιθώριο. Δείτε στη γραμμή 44 ξεκινάει το Back { γραμμές με εντολές }. Από την εικόνα πάνω βλέπουμε ένα Magenta (Μωβ) τμήμα προς τα κάτω που γράφονται οι κινήσεις του σκακιού με αρίθμηση. Αυτό το κομμάτι είναι το βασικό Επίπεδο ή Layer (πάνω από αυτό τα επίπεδα έχουν νούμερα από 1 μέχρι 32 και χρησιμοποιούνται ως κινούμενα αντικείμενα ή ως οθόνες, που μπορούμε να χρησιμοποιήσουμε χωρίς να δείχνουμε τι φτιάχνουμε, να είναι κρυμμένες, αθέατες). Κάθε επίπεδο μπορεί να έχει διαφορετικά χαρακτηριστικά όπως γραμματσσειρά, μέγεθος, φαρδιά ή όχι, πλάγια ή όχι, χρώμα φόντου, χρώμα κειμένου, δρομέας γραφικών και δρομέας χαρακτήρων (οι δρομείς ή κέρσορες νοητά δείχνουν που θα πάει το επόμενο που θα γραφτεί ή θα σχεδιαστεί).
Όλα τα επίπεδα από το Layer, Layer 1 μέχρι και το Layer 32 αν μπορούν να εξέχουν από το Περιθώριο δεν θα φαίνεται το μέρος που εξέχει γιατί τελικά η φόρμα του περιβάλλοντος της Μ2000 είναι το Περιθώριο! Η Μ2000 έχει και τις φόρμες χρήστες, που η καθεμία είναι μια άλλη φόρμα παρόμοια με το Περιθώριο, αλλά σε αυτές υπάρχουν γεγονότα και τα χειριζόμαστε με συναρτήσεις που φτιάχνουμε να ακούνε τα γεγονότα. Αυτός λέγεται προγραμματισμός με γεγονότα.
Στο τμήμα Beep επιλέγουμε το Layer για να στείλουμε σε αυτό μια ακολουθία χαρακτήρων. Το $(4) λέει ότι η ακολουθία θα γραφτεί με αναλογική γραφή (το ι θα έχει μικρό πάχος). Το $(0) λέει ότι θα επανέλθει στην σταθερού πλάτους γραφή, ένας χαρακτήρας κάτω από τον άλλο, όταν αλλάζουμε σειρές. Στην αναλογική δεν γίνεται αυτό αφού έχουμε διάφορα πλάτη χαρακτήρων. Αυτό που γίνεται όμως είναι να χρησιμοποιήσουμε τις νοητές στήλες και να στοιχίσουμε το κείμενό μας βάσει αυτών.
Ξεκινάμε το παιχνίδι δίνοντας ή όχι μια σειρά FEN. Δίνοντας μια σειρά βάζουμε στην ουσία στη σκακιέρα τα πιόνια και τις συνθήκες (πχ αν μπορεί ή όχι να γίνει το ροκέ) καθώς και το ποιος παίζει μετά (τα λευκά ή τα μαύρα).
Το παιχνίδι έχει μια απλή μορφή και η μετακίνηση των πιονιών γίνεται είτε με το ποντίκι είτε με τον αριθμό, για παράδειγμα e2e4 (μετακινεί αυτό που είναι στο e2 στο e4 αν είναι δυνατόν). Δείτε στην εικόνα πάνω το Nothing to move. Αυτό βγήκε καθώς μετακινήσαμε το πιόνι με το ποντίκι και το αφήσαμε στο ίδιο σημείο (από e2 στο e2).,
Δείτε ότι βάζει την σωστή αρίθμηση 1 για Άσπρα (White), μετά 1 για Μαύρα (Black). Στην εικόνα φαίνεται στο g2 το άλογο με διαφάνεια (όταν υπάρχει από κάτω ένα πιόνι τότε το μεταφερόμενο έχει διαφάνεια, και γέρνει και λίγο). Αν βγεί το ποντίκι από την περιοχή της σκακιέρας εξαφανίζεται το πιόνι, και εμφανίζεται ξανά μόλις επαναφέρουμε το ποντίκι στη σκακιέρα!
Το πρόγραμμα αναφέρει αν έχουμε απειλή στο βασιλιά ως (check) σε εκείνον που πρέπει να απαντήσει στην απειλή. Αν έχουμε MAT δεν μας το λέει, απλά δεν βρίσκουμε τρόπο να το αποφύγουμε!
Πρακτικά το τέλος του παιχνιδιού δεν το αναγνωρίζει το πρόγραμμα! Μπορεί να γίνει σε οποιαδήποτε κίνηση, με το Esc (το πλήκτρο διαφυγής). Πριν γίνει η πραγματική έξοδος από το πρόγραμμα μας εμφανίζει την τρέχουσα FEN και με τα βελάκια μπορούμε να πάρουμε πίσω κινήσεις, ή να παίξουμε πίσω στην αρχή και μετά μέχρι την τρέχουσα, βλέποντας όλη την εξέλιξη του παιχνιδιού. Μπορούμε να γυρίσουμε στο παιχνίδι από τη FEN που θέλουμε ή να κάνουμε έξοδο. Κατά την έξοδο μας ρωτάει αν θέλουμε την εξαγωγή όλων των FEN (από την αρχή δηλαδή) στο πρόχειρο των Windows.
\\ George Karras, 2020
\\ Chess Example (a big one)
\\ Example Using sprites
\\ Rev. 6
\\ to add a chess engine:
\\ at m2000 console type: win dir$
\\ paste to that folder the engine.exe
\\ this engine is an executable file like stockfish_20090216_x64_modern.exe
\\ from https://stockfishchess.org/
\\ so get the proper exe file, copy to m2000 user folder (use win dir$ from m2000 console)
\\ then rename it as engine.exe
enginepath$=dir$+"engine"
blackComputer=exist(enginepath$+".exe")
gosub initengine
chessfont$="Arial Unicode MS"
Font chessfont$
if not Fontname$="Arial Unicode MS" then
chessfont$="DejaVu Sans"
end if
Font "Verdana"
Thread.plan sequential
Set Fast
Hide
window 12, window
if random(1, 3)=1 then
window 12, scale.x*random(6,9)/10,scale.y*random(6,9)/10;
end if
form 48,34
def thismode
thismode=mode
global const NoSound = False
Module NothingToMove {
Layer {Print $(4)," Nothing to move",$(0);}
}
Module Proper {
Layer {Print $(4)," Wrong color",$(0);}
}
Module Beep {
Layer {Print $(4)," Not Possible",$(0);}
if NoSound Else Beep
}
back {
\\ we use a switch to alter the return code in Input ! variant, when we press Enter key
\\ normally "-inp" return in Field read only variable 1 when we press enter or down arrow
\\ using "+inp" we can get 13 for enter and 1 for down arrow
Cls 0,0
font "Times"
Pen 15
Mode thismode*5
cursor 0,height div 2
Report 2, "Wait...."
refresh 10000
Mode thismode
set switches "+inp"
Fkey Clear
Escape off
Cls #FFA000,0
Pen 14
bold 1
mode thismode
Def White$="PNBRQK", Black$="pnbrqk", WhiteDisp$="♙♘♗♖♕♔"
Def BlackDisp$="♟♞♝♜♛♚", empty$="12345678", disp$
disp$=WhiteDisp$+BlackDisp$
Def White_♔_file, White_♔_rank, Black_♚_rank, Black_♚_file
Def boolean White_♔_no_roke, Black_♚_no_roke
Def boolean White_no_left_roke, Black_no_left_roke
Def boolean White_no_right_roke, Black_no_right_roke
Def Halfmove_clock, Fullmove_number, threat, Clip$
Dim emptydisp$(1 to 8), BoardSq(1 to 8, 1 to 8)=(,)
Def en_passant_rank=0, en_passant_file=0
for i=1 to 8 :emptydisp$(i)=string$(" ",i):next i
Def board$, status$, oldI, color1, color2, C=14
color2=Color(209, 139, 71)
color1=Color(255, 206,158)
dim line$()
Def flashtime=300
Dim PastGames$(1 to 200)
Def freeSlot=0, cur=0, ok=true, k$, condition$
Def double ip, jp, ip1, jp1, si, sj, getone as boolean
Def st, fig$, tr, mx, my, lx,ly, key=0, mmx,mmy, mmb
Def movelogic as boolean=false, mvx, mvy
sa=(,) : sb=each(sa)
Double
OldI=Italic
Italic 1
Def upperlimit
Cursor 0,0
Pen 15 {Report 2, "Chess Game "+if$(blackComputer->"UCI Engine", "for two")}
Italic OldI
Normal
Move ! ' Move graphic cursor to character cursor - Cursor ! the other way
upperlimit=pos.y*1.6
move 0, upperlimit*6/8
Fill scale.x,scale.y-upperlimit*6/8, 3,5,1
Set Fast !
\\ calc based to height
HalfWidth=(scale.y*.65) div 16
def downlimit=0, White as boolean=True, fw
DrawEmptyBoard((scale.x/2-HalfWidth*8),upperlimit, HalfWidth, 15)
fw=HalfWidth*2-60
\\ hold
\\ set new game
\\ -1 for no FEN
def NoFEN(aGame$)=len(aGame$)<>len(filter$(aGame$,"/"))+7
Inventory OnBoard
Const NewGame$="rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1"
Def ThisGame$
\\ CHECK IF A STRING IS IN STACK (SO THIS MAYBE A FEN NOTATION FOR A STARTING POSITION)
if match("S") then
For this {
\\block for temporary definitions
Local row$(), i, nok, m
Read ThisGame$
row$()=piece$(ThisGame$, chr$(13)+chr$(10))
\\ we drop lines by redim the array (dim also is a "dim preserve")
while len(row$())>1
if row$(len(row$())-1)="" then dim row$(len(row$())-1) else exit
end while
if len(row$())>0 then
m=each(row$())
while m
if NoFEN(array$(m)) Then nok=true: exit
end while
End if
if nok then Push ThisGame$ : ThisGame$=NewGame$ : exit
PastGames$()=row$()
Dim PastGames$(1 to 200)
freeSlot=len(row$())
ThisGame$=PastGames$(freeSlot)
}
else
ThisGame$=NewGame$
End if
SetBoard(ThisGame$)
RedrawBoard(True)
sx=scale.x
sy=scale.y-downlimit
move 0,downlimit
fill sx,sy, 5
Layer {
font "Verdanal"
mode thismode, sx,sy
motion center
motion, downlimit
Cls 5,0
Pen 14
}
Refresh 60
flush
move$=""
refresh
\\ ctrl+F1 help
About ! "How to play", 14000,9000,{Give one or more moves in one input line.
Each move has a letter a number a letter and final a number
so:
e2e4 or e2-e4 or e2..e4
(symbols other than aebcdefgh and 123456789 are white space)
move something from e2 to e4, but this
e2e3e7e5
give two moves (so we can paste a number of moves)
before a move a new FEN string compiled and copied to clipboard.
if nothing exist in e2 then we get a beep sound. If a move break a rule then no move happen and we get a beep. If King have a threat then we have to do a proper move to eliminate threat otherwise we get a beep.
We can press enter without giving a move, so we asked for ending the game or not.
If we press Y then a new input start to get a FEN board notation, so we can use ctrl+V to paste the string and pressing enter we get the new boad.
* Castling work automatic. So if rules are ok wen can give a e1c1 for queen side castling for white king.
* En passant works fine
* A pawn at last rank turn to Queen
You can call this module passing a FEN string as parameter.
George Karras
}
Thread {
if control$<>"MAIN" then continue
mmb=mouse
If mmb=0 then continue
mmy=mouse.y : mmx=mouse.x
if mmy>downlimit then
if mmx<scale.x*.8 then
if mmb=2 then Field New 99 : Input End
else
if mmb=1 then Input End
end if
else.if mmy<downlimit and mmy>upperlimit then
Field New if(mmy>((downlimit+upperlimit)/2)->1,-1)
Input End
end if
} as Handler interval 100
Thread Handler Hold
Thread {
if control$<>"MAIN" then continue
if getone then
move lx, ly
Refresh 100
sprite sprite$
mx=mouse.x : my=mouse.y :mmb=mouse
sb=each(BoardSq())
St=(,)
While sb
sa=array(sb)
if sa#val(3)-twipsX<=mx and sa#val(5)+twipsX>=mx and sa#val(4)-twipsY<=my and sa#val(6)+twipsY>=my then St=sa : exit
End While
if len(st)>0 then
si=st#val(10) : sj=st#val(11)
if mmb=0 then
keyboard chr$(ip+96)+chr$(jp+48)+chr$(si+96)+chr$(sj+48)+chr$(13)
getone=false: refresh 100 : mouse.icon show
else
lx=mx : ly=my
move lx, ly
if st#val$(8)=" " or (si=ip and sj=jp) then
sprite fig$, tr
else
sprite fig$, tr,-10,,80
end if
refresh 100
end if
else.if mmb=0 then
RedrawBoard(?)
getone=false
mouse.icon show
Thread Sp restart
end if
if not getone then Thread this hold
} as pSp interval 1000/30
Thread pSp hold
Thread {
if control$<>"MAIN" then continue
if mouse=0 and movelogic then movelogic=false
if mouse.y<upperlimit then mouse.icon 15 else mouse.icon 1
if not movelogic then if mouse.y<upperlimit and mouse=1 then movelogic=true: mvx=mousea.x : mvy=mousea.y:continue
if movelogic then if mouse=1 then motion motion.wx- mvx+mousea.x, motion.wy-mvy+mousea.y : continue
mx=mouse.x : my=mouse.y
if mouse=1 and my>downlimit then input end : Thread this hold
if mouse=1 and not getone then{
move mx, my
if point=0 or point=#FFFFFF else exit
sb=each(OnBoard)
St=(,)
While sb
sa=eval(sb)
if sa#val(3)<mx and sa#val(5)>mx and sa#val(4)<my and sa#val(6)>my then St=sa : exit
End While
if len(st)=0 then exit
move st#val(3)+30, st#val(4)+30
refresh 1000
tr=point
copy fw,fw to fig$
Image fig$ to fig$,120,120
fill fw,fw, tr
move mx, my
lx=mx:ly=my
ip=st#val(10):jp=st#val(11)
sprite fig$, tr
mouse.icon hide
getone=true
Thread pSp restart
Thread this hold
}
} as Sp interval 100
mouse.icon show
isok=true
{
{
if white then
CheckThreat(white, White_♔_file, White_♔_rank, &threat)
else
CheckThreat(white, Black_♚_file, Black_♚_rank, &threat)
end if
if isok then
freeSlot++
GetBoard(&Clip$)
if freeSlot>Len(PastGames$()) then Dim PastGame$(1 to 2*Len(PastGames$()))
PastGames$(freeSlot)=Clip$
end if
\\\test
condition$=if$(White->"White move", "Black move") + if$(threat->" (check)","")+ if$(Halfmove_clock>50->"(You can draw)","")+":"
Layer {
Print Part $(4,5), right$(string$(chrcode$(8199), 3)+str$(Fullmove_number,""),3)+".", $(7,12),condition$,
}
if blackComputer then
if not White then mymove$=@GetMove$(PastGames$(freeSlot)): keyboard left$(mymove$,4)+chr$(13)
end if
White~
if empty then
Layer {
Pen 15 {Input "",move$;}
}
\\\test !
Thread Sp hold
Thread pSp Hold
mouse.icon 1
getone=false
if move$="" then
Layer {
wait 100
Refresh 60
profiler
Every 1000/60 {
if timecount>flashtime then
profiler
Cls
Pen C {Double : Report 2,"End this Game ?" : Normal}
C=20-C
Cursor width, Height
Move ! \\ copy character cursor to graphic cursor
Legend "Use Y or Left Mouse Click to exit | Right Mouse Click or N to continue", FontName$, Mode*.7, 0,1, 1,twipsX
end if
k$=""
if keypress(0x1B) then k$="Y":exit
if keypress(0x4E) then exit
if keypress(0x59) then k$="Y":exit
if keypress(1) then k$="Y": exit
if keypress(2) then exit
}
}
while not inkey$ ="" {Wait 1} 'drop key any
If k$="Y" else
\\ if stack has something then RedrawBoard may use it (because read for optional variable)
\\ we can be sure we set the optional value using ?
White~ :RedrawBoard(?): Layer {Cls}
getone=false
Thread Sp restart
flush ' make empty true (so stack is empty for sure)
loop ' set a flag for restart at end bracket of current block
end if
else
move$=lcase$(move$)
while len(move$)>0
select case left$(move$,1)
case "1" to "8"
data asc(move$)-48
case "a" to "h"
data asc(move$)-96
end select
insert 1,1 move$=""
end while
end if
isok=false
end if
if not empty then
if stack.size mod 4 = 0 then
try ok {
MakeAmove(&isok)
if not isok then flush : White~: exit
if not empty then
white~: refresh : wait 500 : loop
end if
}
Layer {Print}
getone=false
if isok else RedrawBoard(?)
if ok then loop : Thread Sp restart
else
flush : White~ : loop : Thread Sp restart' loop processed at the end of the block, so only a flag raised here
end if
end if
}
Thread Sp Hold
Thread pSp Hold
cur=freeSlot
Clip$=PastGames$(cur)
Layer {
if cur=0 then cur=1
if cur>freeSlot then cur=freeSlot
if Clip$<>PastGames$(cur) then
Clip$=PastGames$(cur)
if len(Clip$)=len(filter$(Clip$,"/"))+7 and trim$(Clip$)<>"" then Back {SetBoard(Clip$) :RedrawBoard(?)}
end if
Refresh 60
Cls
Cursor width, Height
Move !
Legend "Right Mouse Click or Esc to Quit | Left Mouse Click right of the FEN to continue play | About Ctrl+F1", FontName$, Mode*.7, 0,1, 1,twipsX
Cursor 0,0
Report 2, "Replay the Game,(arrows u/d) or Start a new one setting a new FEN"
Print Part $(7,7), "Board FEN: "
Field New 13
Thread Handler Restart
Pen 15 {Input ! Clip$, width-7 len=100}
Thread Handler Hold
Report Clip$
refresh 60
if field=13 then exit
if field=-1then cur-- : loop
if field=99 then Clip$="": exit
if field=1 then cur++ : loop
}
if len(Clip$)<>len(filter$(Clip$,"/"))+7 or trim$(Clip$)="" then SaveGame():Layer {Cls} : exit
if Clip$<>PastGames$(cur) then
SaveGame()
PastGames$(1)=Clip$:cur=1
end if
freeSlot=cur
SetBoard(Clip$)
RedrawBoard(?)
Layer {Cls}
Thread Sp restart
Loop
}
Cls 0,0
}
hide
threads erase
declare Engine nothing
wait 200
about ""
if module(info) then keyboard "info"+chr$(13)
Flush
set switches "-inp"
escape off
Window 12, window
form
form ;
About ! ""
end
Sub SaveGame()
if freeSlot=1 then exit sub
Local Out$
Document Out$ ' upgrade to Document
layer {
Cls
if ask("Copy the game to clipboard?","Finish","*Yes","No")=1 then
Report "Wait..."
for i=1 to freeSlot
Out$+=PastGames$(i)
if i<freeSlot then
Out$={
}
end if
next
Clipboard Out$
Save.Doc Out$, "LastGame.chess"
Report "Done..."
wait 300
end if
}
end sub
Sub SaveGame1()
local Out$, i
Document Out$ ' upgrate to document
layer {
}
End Sub
Sub DrawEmptyBoard(leftmargin, topmargin, squarewidth, labelcolor)
Local a=true, z=bold : bold 0
Local l=squarewidth, k=2*l, k1=k*.85, N1=6, N=6, M=4, B=k*8, B1
Local d=0, im=0, jm=0
Repeat
N=N1
N1+=.25
Until K1<size.Y("A",chessfont$, N1)
topmargin-=l
leftmargin-=l
move leftmargin+l,topmargin+l
B1=(l div 300)*twipsX
step -B1,-B1
B+=B1*2
Pen 0 {
Width b1 div 2+1 {
color color1 , 1{Polygon 0, B, 0, 0, B, -B, 0, 0, -B}
}
M=N*.65
For i=1 to 9
d=leftmargin
move d, topmargin
if i<9 then
step 0, k
Pen labelcolor{Legend str$(9-i,""), chessfont$, M,0,2}
step 0, -k
else
N=M
end if
for j=1 to 8
If i<9 then
step l, l
color color1,1 {fill k,k, if(a->color1,color2)}
step -l, -l
BoardSq(j, 9-i)=(N, pos.x, pos.y, pos.x-l+twipsX, pos.y-l+twipsX, pos.x+l-twipsX, pos.y+l-twipsX, k-twipsX*2, " ", a, j,9-i)
a~
else
step k, k
pen labelcolor {
Legend mid$("abcdefgh",j,1), chessfont$, N, 0, 2
}
end If
d+=k
move d, topmargin
next
a~ : topmargin+=k
next
}
bold z
downlimit=topmargin+500
end sub
Sub MakeAmove( &ok, i, j, i1, j1)
Local z=bold, p$, p1$ : bold 0
Local t,t1, N=BoardSq(1,1)#val(0), again as boolean, playroke as boolean
ok=false
Local rule=true, threat as boolean
refresh 10000
Pen 0 {
again=false
t=BoardSq(i,j)
t1=BoardSq(i1, j1)
p$=t#val$(8)
p1$=t1#val$(8)
if p$=" " then NothingToMove : exit
if t is t1 then NothingToMove : exit
if p1$<>" " then if p1$<"♚" and p$<"♚" then Proper : exit
if p1$<>" " then if p1$>="♚" and p$>="♚" then Proper : exit
\\ white change logic here
if not white and instr(WhiteDisp$, p$)=0 then Proper : exit
if white and instr(BlackDisp$, p$)=0 then Proper :exit
select case p$
case "♔"
{
If not White_♔_no_roke then
CheckThreat(not white, White_♔_file, White_♔_rank, &threat)
if not threat then
if i1=3 and j1=1 then
if p1$=" " and BoardSq(2,1)#val$(8)=" " and BoardSq(4,1)#val$(8)=" " and not White_no_left_roke then
CheckThreat(not white, 4, 1, &threat)
if not threat then push 1, 4, 1, 1 : again=true : playroke=true
end if
else.if i1=7 and j1=1 then
if p1$=" " and BoardSq(6,1)#val$(8)=" " and not White_no_right_roke then
CheckThreat(not white, 6, 1, &threat)
if not threat then push 1, 6, 1, 8 : again=true : playroke=true
end if
end if
end if
end if
if not playroke Then
if abs(i-i1)>1 then rule=false: exit
if abs(j-j1)>1 then rule=false: exit
White_♔_no_roke=true
White_no_right_roke=True
White_no_left_roke=true
end if
CheckKing()
if threat then
rule=false
if playroke then drop 4
else
White_♔_rank=j1
White_♔_file=i1
end if
}
case "♚"
{
If not Black_♚_no_roke then
CheckThreat(not white, Black_♚_file, Black_♚_rank, &threat)
if not threat then
if i1=3 and j1=8 then
if p1$=" " and BoardSq(2,8)#val$(8)=" " and BoardSq(4,8)#val$(8)=" " and not Black_no_left_roke then
CheckThreat(not white, 4, 8, &threat)
if not threat then push 8, 4, 8, 1 : again=true : playroke=true
end if
else.if i1=7 and j1=8 then
if p1$=" " and BoardSq(6,8)#val$(8)=" " and not Black_no_right_roke then
CheckThreat(not white, 6, 8, &threat)
if not threat then push 8, 6, 8, 8 : again=true : playroke=true
end if
end if
end if
end if
if not playroke Then
if abs(i-i1)>1 then rule=false: exit
if abs(j-j1)>1 then rule=false: exit
Black_♚_no_roke=true
Black_no_right_roke=true
Black_no_left_roke=true
end if
CheckKing()
if threat then
rule=false
if playroke then drop 4
else
Black_♚_rank=j1
Black_♚_file=i1
end if
}
case "♕","♛"
{
if i1<>i and j1<>j then
if abs(i1-i)<>abs(j1-j) then rule=false: exit
jm=0
if abs(i1-i)>1 then
jm=j+sgn(j1-j)
for im=i+sgn(i1-i) to i1-sgn(i1-i)
if BoardSq(im,jm)#val$(8)<>" " then jm=-1: exit for
jm+=sgn(j1-j)
next
end if
else
jm=0:im=0
if abs(i1-i)>1 then
for im=i+sgn(i1-i) to i1-sgn(i1-i)
if BoardSq(im,j)#val$(8)<>" " then jm=-1: exit for
next
else.if abs(j1-j)>1 then
for jm=j+sgn(j1-j) to j1-sgn(j1-j)
if BoardSq(i,jm)#val$(8)<>" " then im=-1 :exit for
next
end if
if im=-1 or jm=-1 then rule=false:exit
end if
CheckIt()
}
case "♜"
{
If playroke then Black_no_right_roke=true : Black_no_left_roke=true : Black_♚_no_roke=True : exit
if i1<>i and j1<>j then rule=false: exit
jm=0:im=0
if abs(i1-i)>1 then
for im=i+sgn(i1-i) to i1-sgn(i1-i)
if BoardSq(im,j)#val$(8)<>" " then jm=-1: exit for
next
else.if abs(j1-j)>1 then
for jm=j+sgn(j1-j) to j1-sgn(j1-j)
if BoardSq(i,jm)#val$(8)<>" " then im=-1 :exit for
next
end if
if im=-1 or jm=-1 then rule=false:exit
CheckIt()
if not rule then exit
if i=1 and j=8 then Black_no_left_roke=true
if i=8 and j=8 then Black_no_right_roke=true
}
case "♖"
{
If playroke then White_no_right_roke=true : White_no_left_roke=true : White_♔_no_roke=True : exit
if i1<>i and j1<>j then rule=false: exit
jm=0:im=0
if abs(i1-i)>1 then
for im=i+sgn(i1-i) to i1-sgn(i1-i)
if BoardSq(im,j)#val$(8)<>" " then jm=-1: exit for
next
else.if abs(j1-j)>1 then
for jm=j+sgn(j1-j) to j1-sgn(j1-j)
if BoardSq(i,jm)#val$(8)<>" " then im=-1 :exit for
next
end if
if im=-1 or jm=-1 then rule=false:exit
CheckIt()
if not rule then exit
if i=1 and j=1 then White_no_left_roke=true
if i=8 and j=1 then White_no_right_roke=true
}
case "♗","♝"
{
if i1=i or j1=j then rule=false: exit
if abs(i1-i)<>abs(j1-j) then rule=false: exit
jm=0
if abs(i1-i)>1 then
jm=j+sgn(j1-j)
for im=i+sgn(i1-i) to i1-sgn(i1-i)
if BoardSq(im,jm)#val$(8)<>" " then jm=-1: exit for
jm+=sgn(j1-j)
next
end if
if jm=-1 then rule=false:exit
Checkit()
}
case "♘","♞"
{
if abs(i1-i)=abs(j1-j) then rule=false: exit
if abs(i1-i)=0 or abs(j1-j)=0 then rule=false: exit
if abs(i1-i)+abs(j1-j)<>3 then rule=false: exit
Checkit()
}
case "♙"
{
if j1<=j then rule=false:exit
if i<>i1 then if i1<i-1 or i1>i+1 then rule=false: exit
if j>2 then if j1>j+1 then rule=false:exit
if j=2 and j1>j+2 then rule=false:exit
if i=i1 and p1$<>" " then rule=false:exit
if i<>i1 and p1$=" "and not (en_passant_file=i1 and en_passant_rank=j1-1) then rule=false:exit
if i<>i1 and j1>j+1 then rule=false exit
if en_passant_file=i1 and en_passant_rank=j1-1 then
Checkit2()
else
Checkit()
End if
en_passant_file=0
en_passant_rank=0
if j1=8 then p$="♕" else if j1=j+2 then en_passant_file=i1:en_passant_rank=j1
}
case "♟"
{
if j1>=j then rule=false:exit
if i<>i1 then if i1<i-1 or i1>i+1 then rule=false: exit
if j<7 then if j1<j-1 then rule=false:exit
if j=7 and j1<j-2 then rule=false:exit
if i=i1 and p1$<>" " then rule=false:exit
if i<>i1 and p1$=" " and not (en_passant_file=i1 and en_passant_rank=j1+1) then rule=false:exit
if i<>i1 and j1<j-1 then rule=false:exit
if en_passant_file=i1 and en_passant_rank=j1+1 then
Checkit2()
else
Checkit()
End if
en_passant_file=0
en_passant_rank=0
if j1=1 then p$="♛" else if j1=j-2 then en_passant_file=i1:en_passant_rank=j1
}
end select
If not rule then beep : exit
move t#val(3), t#val(4)
return t, 8:=" "
delete OnBoard, i*9+j
if t#val(9) then fill t#val(7), t#val(7),color1 else fill t#val(7), t#val(7), color2
t=t1
move t#val(3), t#val(4)
fill t#val(7), t#val(7),15
if p1$<>" " then
Halfmove_clock=0
Return OnBoard, i1*9+j1:=t
else
Halfmove_clock++
Append OnBoard, i1*9+j1:=t
end if
return t, 8:=p$
move t#val(1), t#val(2): Legend p$, chessfont$, N, 0, 2,0
move t#val(3)+twipsx*2, t#val(4)+twipsy*2
if t#val(9) then floodfill ,,color1 else floodfill , , color2
if again then read i, j, i1, j1 : Restart
if p$<>"♙" and p$<>"♟" then en_passant_file=0 : en_passant_rank=0
if white then Fullmove_number++
Ok=true
}
bold z
refresh 10000
end Sub
Sub RedrawBoard(NoRefresh as boolean=False)
Local z=bold, p$ : bold 0
Local t, N=BoardSq(1,1)#val(0)
If NoRefresh Else refresh 10000
Pen 0 {
For j=1 to 8
For i=1 to 8
t=BoardSq(i,j)
move t#val(3), t#val(4)
fill t#val(7), t#val(7),15
p$=t#val$(8)
if p$=" " else move t#val(1), t#val(2): Legend p$, chessfont$, N, 0, 2,0
move t#val(3)+twipsx*2, t#val(4)+twipsy*2
if t#val(9) then floodfill ,,color1 else floodfill , , color2
Next
Next
}
bold z
If NoRefresh Else refresh 60
end Sub
Sub GetBoard(&chessboard$)
chessboard$=""
local i, j,a$, spc, line$
for j=8 to 1
line$=""
for i=1 to 8
a$=BoardSq(i,j)#val$(8)
if a$<>" " then
if spc>0 then line$+=str$(spc,""): spc=0
line$+=mid$("PNBRQKpnbrqk", instr("♙♘♗♖♕♔♟♞♝♜♛♚", a$),1)
else
spc++
end if
next
if spc>0 then line$+=str$(spc,""): spc=0
if j>1 then chessboard$+=line$+"/" else chessboard$+=line$+" "
next
if white then chessboard$+="w " else chessboard$+="b "
if White_♔_no_roke and Black_♚_no_roke then
chessboard$+="-"
else
if White_no_right_roke else chessboard$+="K"
if White_no_left_roke else chessboard$+="Q"
if Black_no_right_roke else chessboard$+="k"
if Black_no_left_roke else chessboard$+="q"
end if
if not en_passant_file=0 then
chessboard$+=" "+chr$(96+en_passant_file)+chr$(48+en_passant_rank)
else
chessboard$+=" -"
end if
chessboard$+=str$(Halfmove_clock)
chessboard$+=str$(Fullmove_number)
End Sub
Sub SetBoard(chessboard$)
Rem https://en.wikipedia.org/wiki/Forsyth–Edwards_Notation
Clear OnBoard
board$=leftpart$(chessboard$," ")
if len(filter$(board$,"K"))<>len(board$)-1 Then Error "Problem with White King"
if len(filter$(board$,"k"))<>len(board$)-1 Then Error "Problem with Black King"
status$=ltrim$(rightpart$(chessboard$," "))
white=left$(status$,1)="w"
status$=ltrim$(mid$(status$,2))
if left$(status$,1)="-" then
White_no_right_roke=True
White_no_left_roke=True
White_♔_no_roke =True
Black_no_right_roke=True
Black_no_left_roke=True
Black_♚_no_roke=True
status$=ltrim$(mid$(status$,2))
else
local L=len(status$)
status$=filter$(status$,"K")
White_no_right_roke= len(status$)=L
L=len(status$) : status$=filter$(status$,"Q")
White_no_left_roke= len(status$)=L
White_♔_no_roke = White_no_right_roke and White_no_left_roke
L=len(status$) : status$=filter$(status$,"k")
Black_no_right_roke= len(status$)=L
L=len(status$) : status$=filter$(status$,"q")
Black_no_left_roke= len(status$)=L
Black_♚_no_roke=Black_no_right_roke and Black_no_left_roke
status$=ltrim$(status$)
End if
if left$(status$,1)="-" then
en_passant_file=0
en_passant_rank=0
status$=mid$(status$,2)
else
en_passant_file=Asc(left$(status$,1))-96
en_passant_rank=Asc(Mid$(status$,2,1))-48
if en_passant_rank=3 then en_passant_rank=4 else en_passant_rank=5
status$=mid$(status$,3)
end if
Local m
Halfmove_clock=val(status$, "int", &m)
status$=mid$(status$,m)
Fullmove_number=max.data(val(status$, "int", &m), 1)
nl$={
}
for i=1 to 6
board$=replace$(mid$(White$,i,1),mid$(WhiteDisp$,i,1), board$)
board$=replace$(mid$(Black$,i,1),mid$(BlackDisp$,i,1), board$)
next
for j=1 to 8
board$=replace$(str$(j,""),emptydisp$(j), board$)
next
line$()=piece$(board$,"/")
local t
dim line$(1 to 8)
For j=1 to 8: For i=1 to 8
t=BoardSq(i,j)
return t, 8:=mid$(line$(9-j), i, 1)
if t#val$(8)<>" " then Append OnBoard, i*9+j:=t
if t#val$(8)="♔" then
White_♔_rank=j
White_♔_file=i
if i<>5 and j<>1 then White_♔_no_roke=True : White_no_left_roke=true : White_no_right_roke=true
else.if t#val$(8)="♚" then
Black_♚_rank=j
Black_♚_file=i
if i<>5 and j<>8 then Black_♚_no_roke=True: Black_no_left_roke=true : Black_no_right_roke=true
end if
next : next
end Sub
Sub CheckIt()
return t, 8:=" "
return t1, 8:=p$
if not white then
CheckThreat(not white, White_♔_file, White_♔_rank, &threat)
else
CheckThreat(not white, Black_♚_file, Black_♚_rank, &threat)
end if
if threat then rule=false
return t, 8:=p$
return t1, 8:=p1$
end Sub
Sub CheckIt2()
return t, 8:=" "
return t1, 8:=p$
local t2=BoardSq(en_passant_file, en_passant_rank)
local p2$=t2#val$(8)
return t2, 8:=" "
if not white then
CheckThreat(not white, White_♔_file, White_♔_rank, &threat)
else
CheckThreat(not white, Black_♚_file, Black_♚_rank, &threat)
end if
if threat then rule=false
return t, 8:=p$
return t1, 8:=p1$
if threat then
return t2, 6:=p2$
else
move t2#val(3), t2#val(4)
if t2#val(9) then
fill t2#val(7), t2#val(7),color1
else
fill t2#val(7), t2#val(7), color2
end if
Halfmove_clock=-1
end if
end Sub
Sub CheckKing()
return t, 8:=" "
return t1, 8:=p$
CheckThreat(not white, i1, j1,&threat)
if threat then rule=false
return t, 8:=p$
return t1, 8:=p1$
end Sub
Sub CheckThreat(White as boolean, c, c1, &Yes)
local i=1, i1=8, j=1, j1=8, k=c, k1=c1
if white then
local oKin$="♚",hor$="♜♛", dia$="♝♛", Kni$="♞"
else
local oKin$="♔",hor$="♖♕", dia$="♗♕", Kni$="♘"
end if
' WhiteDisp$="♙♘♗♖♕♔"
' BlackDisp$="♟♞♝♜♛♚"
Yes=false
if c1<7 and white then
if c>1 then
if BoardSq(c-1, c1+1)#val$(8)="♟" then Yes=True :exit sub
end if
if c<8 then
if BoardSq(c+1, c1+1)#val$(8)="♟" then Yes=True :exit sub
end If
else.if c1>1 and not white then
if c>1 then
if BoardSq(c-1, c1-1)#val$(8)="♙" then Yes=True :exit sub
end if
if c<8 then
if BoardSq(c+1, c1-1)#val$(8)="♙" then Yes=True :exit sub
end If
end if
for k=max.data(c-1, 1) to min.data(c+1, 8)
for k1=max.data(c1-1, 1) to min.data(c1+1, 8)
if k1=c1 and k=c else if BoardSq(k, k1)#val$(8) =oKin$ then Yes=True : Exit Sub
next
next
for k=c to i
if Instr(hor$,BoardSq(k,c1)#val$(8))>0 then Yes=True :exit sub
if k<>c then if Instr(disp$,BoardSq(k,c1)#val$(8))>0 then exit for
next
if c>1 and c1<8 then {
k1=c1+1
for k=c-1 to i \\ look up left
if Instr(Dia$,BoardSq(k,k1)#val$(8))>0 then Yes=True :exit sub
if k<>c then if Instr(disp$,BoardSq(k,k1)#val$(8))>0 then exit for
K1++
if k1>8 then exit for
next
}
for k=c to i1
if Instr(hor$,BoardSq(k,c1)#val$(8))>0 then Yes=True :exit sub
if k<>c then if Instr(disp$,BoardSq(k,c1)#val$(8))>0 then exit for
next
if c<i1 and c1>1 then {
k1=c1-1
for k=c+1 to i1 \\ look down right
if Instr(Dia$,BoardSq(k,k1)#val$(8))>0 then Yes=True :exit sub
if Instr(disp$,BoardSq(k,k1)#val$(8))>0 then exit for
K1--
if k1<1 then exit for
next
}
for k1=c1 to j
if Instr(hor$,BoardSq(c,k1)#val$(8))>0 then Yes=True :exit sub
if k1<>c1 then if Instr(disp$,BoardSq(c,k1)#val$(8))>0 then exit for
next
if c1>j and c>1 then {
k=c-1
for k1=c1-1 to j \\ look down left
if Instr(Dia$,BoardSq(k,k1)#val$(8))>0 then Yes=True :exit sub
if Instr(disp$,BoardSq(k,k1)#val$(8))>0 then exit for
k--
if k<1 then exit for
next
}
for k1=c1 to j1
if Instr(hor$,BoardSq(c,k1)#val$(8))>0 then Yes=True :exit sub
if k1<>c1 then if Instr(disp$,BoardSq(c,k1)#val$(8))>0 then exit for
next
if c1<j1 and c<8 then {
k=c+1
for k1=c1+1 to j1 \\ look up right
if Instr(Dia$,BoardSq(k,k1)#val$(8))>0 then Yes=True :exit sub
if Instr(disp$,BoardSq(k,k1)#val$(8))>0 then exit for
k++
if k>8 then exit for
next
}
rem test "here"
for k=max.data(c-2,i) to min.data(c+2, i1)
for k1=max.data(c1-2,j) to min.data(c1+2, j1)
if Abs(k-c)+Abs(k1-c1)=3 then if BoardSq(k,k1)#val$(8)=Kni$ then Yes=True :exit sub
next
next
end Sub
\\ new from revision 5
Function GetMove$(Fen$)
local aLine$
method Engine, "SendLine" , "position fen "+Fen$
method Engine, "SendLine" ,"go movetime"+str$(random(50, 200))
every 50 {
Method Engine, "ProcessLoop"
if not Engine.Active then exit
while Engine.HasLine
method Engine, "GetLine" as aLine$
if left$(aLine$,8)="bestmove" then exit
End While
if left$(aLine$,8)="bestmove" then =piece$(aLine$," ", 2) : exit
}
End Function
initengine:
declare Engine SHELLPIPE
with Engine, "Active" as Engine.Active, "Hasline" as Engine.HasLine
Method Engine, "Run", enginepath$ as OkEngine
if OkEngine=0 then Method Engine, "SendLine", "ucinewgame"
Return