Yes, exactly, I know that. This is it. But I would need a practical demonstration of how to do it in Purebasicinfratec wrote:You know UCI ?
https://en.wikipedia.org/wiki/Universal_Chess_Interface
If you implemet UCI you can use many engines.
Like stockfish
Code: Select all
UCIProg = RunProgram("stockfish_10_x32", "", "",#PB_Program_Hide|#PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_UTF8)
If UCIProg
*OutBuffer = AllocateMemory(1024)
If *OutBuffer
WriteProgramStringN(UCIProg, "uci")
While ProgramRunning(UCIProg)
OutDataLen = AvailableProgramOutput(UCIProg)
If OutDataLen
OutDataReadLen = ReadProgramData(UCIProg, *OutBuffer, OutDataLen)
If OutDataReadLen
OutData$ + PeekS(*OutBuffer, OutDataReadLen, #PB_UTF8)
Debug OutData$
Select OutState
Case 0
If FindString(OutData$, "uciok")
OutData$ = ""
OutState = 1
Debug "OutState 1"
WriteProgramStringN(UCIProg, "go")
EndIf
Case 1
;WriteProgramStringN(UCIProg, "quit")
EndSelect
EndIf
EndIf
Delay(10)
Wend
FreeMemory(*OutBuffer)
EndIf
EndIf
And top 4 current Chess Engines1 2882 Magnus Carlsen
2 2851 Garry Kasparov
3 2844 Fabiano Caruana
4 2830 Levon Aronian
Code: Select all
1 SugaR NN 1.1 64-bit 4CPU 3489
2 Lc0 0.22.0 T40B.4-160 GTX1050 3471
3 Komodo 13.02 64-bit 4CPU 3401
4 Houdini 6 64-bit 4CPU 3398 id name Rybka 2.3.2a mp 32-bit
id author Vasik Rajlich
option name Hash type spin min 2 max 4096 default 32
option name Max CPUs type spin min 1 max 2048 default 2048
option name Display PV Tips type check default false
option name CPU Usage type spin min 1 max 100 default 100
option name Win Percentage to Hash Usage type check default false
option name Display Current Move type check default true
option name NalimovPath type string default <empty>
option name NalimovCache type spin min 1 max 256 default 1
option name NalimovUsage type combo default Rarely var Frequently var Normally var Rarely var Never
option name Preserve Analysis type check default false
option name Clear Hash type button
option name Ponder type check default true
option name MultiPV type spin default 1 min 1 max 100
option name UCI_LimitStrength type check default false
option name UCI_Elo type spin default 1200 min 1200 max 2400
option name Server Buffer type check default false
option name UCI_AnalyseMode type check default false
option name UCI_Opponent type string default <empty>
option name UCI_EngineAbout type string default http://www.rybkachess.com
option name Contempt type spin default 0 min -100 max 100
option name Outlook type combo default Neutral var Very Pessimistic var Slightly Pessimistic var Neutral var Slightly Optimistic var Very Optimistic var Ultra Optimistic
option name Rate Of Play type combo default Normal var Ultraslow var Slow var Normal var Fast var Ultrafast
option name Time Usage type combo default Varied var Constant var Varied
option name Emergency Time Buffer type combo default Medium var Small var Medium var Large
uciok
Code: Select all
;Helles asmFishW-Player, 7.Oct.2019
;For asmFishW!
;PB 5.70 LTS (x64)
;UNICODE!
;UNDER CONSTRUCTION!
;No move-check!!!
;No table-bases
;No ponderhit
;No ...
;German
;Download asmFishW-Engines:
;https://github.com/lantonov/asmFish/tree/master/WindowsOS_binaries
;https://github.com/lantonov/asmFish/blob/executables/Windows/Windows_OldBinaries.7z
;Unicode einschalten für ältere PB-Versionen!
;Unicode-Schachfiguren:
;Weisser König = 9812
;Weisse Dame = 9813
;Weisser Turm = 9814
;Weisser Läufer = 9815
;Weisser Springer = 9816
;Weisser Bauer = 9817
;Schwarzer König = 9818
;Schwarze Dame = 9819
;Schwarzer Turm = 9820
;Schwarzer Läufer = 9821
;Schwarzer Springer = 9822
;Schwarzer Bauer = 9823
;Engines that use aspiration of the search window in the root, instead of setting it to {-INF, INF} can have fail highs (beta cutoffs) or fail lows in the root.
;The returned score is then a lower bound or a upper bound, respectively. This is what the UCI keywords indicate. How the GUI displays it, is the choice of the GUI designer.
;Most logical solution would be to write a + or - with the score, e.g. 1.25+ indicating a score of at least 1.25 (i.e. a lower bound).
;UCI-Kommandos:
;erst setoptions!
;- "setoption name threads value 8" praktisch 8 logische Cores nutzen
;- "setoption name hash value 2048" Hash 2 GB
;- "position startpos moves a2a4 b7b5" starte Berechnung nach den angegebenen Zügen
;- "go depth 25" starte Programm und rechne bis einschl. Tiefe 25
;- "go movetime 10000" starte Programm und rechne 10s lang
;"rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1" ;Grundstellung
;option name Hash type spin Default 16 min 1 max 65536
;option name LargePages type check Default false
;option name Threads type spin Default 1 min 1 max 256
;option name NodeAffinity type string Default all
;option name Priority type combo Default none var none var normal var low var idle
;option name TTFile type string Default <empty>
;option name TTSave type button
;option name TTLoad type button
;option name Clear Hash type button
;option name Ponder type check Default false
;option name UCI_Chess960 type check Default false
;option name MultiPV type spin Default 1 min 1 max 224
;option name Contempt type spin Default 0 min -100 max 100
;option name MoveOverhead type spin Default 30 min 0 max 5000
;option name MinThinkTime type spin Default 20 min 0 max 5000
;option name SlowMover type spin Default 89 min 10 max 1000
;option name SyzygyProbeDepth type spin Default 1 min 1 max 100
;option name SyzygyProbeLimit type spin Default 6 min 0 max 6
;option name Syzygy50MoveRule type check Default true
;option name SyzygyPath type string Default <empty>
;uciok
;info string hash set To 2048 MB no large pages
;info string node 0 has threads 0 1 2 3 4 5 6 7
;Original Structure Options
;byte[rdx+Options.displayInfoMove], -1 ;hier wohl uninteressant
;dword[rdx+Options.contempt], 0
;dword[rdx+Options.threads], 1
;dword[rdx+Options.hash], 16
;byte[rdx+Options.ponder], 0
;dword[rdx+Options.multiPV], 1
;dword[rdx+Options.moveOverhead], 30
;dword[rdx+Options.minThinkTime], 20
;dword[rdx+Options.slowMover], 89
;byte[rdx+Options.chess960], 0
;dword[rdx+Options.syzygyProbeDepth], 1
;byte[rdx+Options.syzygy50MoveRule], -1
;dword[rdx+Options.syzygyProbeLimit], 6
;byte[rdx+Options.largePages], 0
;Gadgets: 0-63 : Brett
; 64-79 : Brett-Beschriftung:
; 80-81 : Hinweis-Finger
; 82 : Button-Gadget Brett drehen $21c5
; 83 : Button-Gadget Zug zurück $21e6
; 84 : Button-Gadget Zug vor $21e8
; 85 : Button-Gadget zurück zur Startstellung
; 86 : Button-Gadget vor zur Endstellung
; 87 : Button-Gadget Stellung ändern/anpassen
; 90 : TextGadget EngineName$
; 91 : TextGadget CPUName$
; 92 : TextGadget CPU-Threads$
; 93 : TextGadget Hash-Größe$
; 94-95 : TextGadget Teststellung$ (falls gewählt)
; 100-101: TextGadget Aktuelle_Suchtiefe$
; 102-103: TextGadget Aktueller_Zug$
; 104-105: TextGadget Aktuelle_ Zug-Nr.$
; 106-107: TextGadget Hauptvariante$
; 108-109: TextGadget Bewertung$
; 110-111: TextGadget Tiefe$
; 112-113: TextGadget Zeit$
; 114-115: TextGadget Knoten$
; 116-117: TextGadget Knoten_Sek$
; 118-119: TextGadget Hashfull$
; 120-121: TextGadget TB_Hits$
; 122 : EditorGadget das rechte Hauptfenster
Declare Test2Stellung()
Declare Brettmal(Width.i, Height.i, StartPosX.i, StartPosY.i)
Declare Brettmal_Leer(Width.i, Height.i, StartPosX.i, StartPosY.i)
Declare FENString(AdrStellung)
Declare Zug()
Declare FEN2Stellung()
Declare wc(hWnd.i, uMsg.i, wParam.i, lParam.i)
Declare Umwandlung()
Declare Finger()
Declare Restoring() ;z.B. Rochade-Recht bei Zug vor/zurück
Declare.s DeziPoint(In$)
Global ORand.i = 40 ;Brett-Position oben
Pixel0.f = 30.0
Pixel1.f = 9.0
Pixel2.f = 24.0
Pixel3.f = 20.0
Pixel4.f = 48.0 ;Figur für Stellungseingabe
Global Font0.i
Global Font4.i
Global GrossRochS.i = 1 ;Rochade-Recht, erstmal auf vorhanden setzen
Global KleinRochS.i = 1
Global GrossRochW.i = 1
Global KleinRochW.i = 1
Global Schlag_Bauer.i
Global ZugNr.i = 1
Global UFig.b ;Bauern-Umwandlung
Dran.i = 0 ;1=DIESER PC fängt an, macht ersten Zug
Threads.i
BackColor.l = $99FFFF
Global PID.l
Global Cores.l = 1 ;ist Bit-Muster!
AnzCore.l
Global CMN_Max.i ;currmovenumber
Port$ = "COM10"
Global EngineName$
Global Farbe_am_Zug$ = " w" ;oder " b"
Global Rochade$ = " KQkq"
Global EnPassant$ = " -"
Global Schlag_Bauer$ = " 0"
Global ZugNr$ = " 1"
Global FEN$ = "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1" ;Grundstellung
Global Zug$ ;bestmove
Global FigArtOri.i = ?Figuren ;Festwert
Global FigArt.i = FigArtOri ;zeigt auf jeweilige Figur
Global BlackWhite.i = 0 ;0=Weiss, 12=Schwarz
Global Weiss_unten.i = 1
Global Finger80.i
Global Finger81.i
Global FEN_Strings.i
Global FEN_Strings_Pointer.i = 0
Global FEN_Strings_Pointer_Max.i
hWnd = OpenWindow(0, 0, 100, 1000, 750, "Helles asmFishW-Player", #PB_Window_MinimizeGadget);, #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget); | #PB_Window_SizeGadget)
If hWnd
SetWindowColor(0, BackColor) ;dann auch Background für TextGadgets
StickyWindow(0, 1)
FontHigh0 = Int(Pixel0 / (GetDeviceCaps_(GetDC_(hWnd), #LOGPIXELSY) / 96.0)) ;Font anpassen Figuren auf Brett
;LoadFont(0, "Arial Unicode MS", FontHigh0)
;LoadFont(0, "Arial Unicode MS Bold", FontHigh0) ;Geschmacks-Sache
LoadFont(0, "Lucida Sans Unicode Standard", FontHigh0) ;Geschmacks-Sache
Font0 = FontID(0)
FontHigh1 = Int(Pixel1 / (GetDeviceCaps_(GetDC_(hWnd), #LOGPIXELSY) / 96.0))
LoadFont(1, "Trebuchet MS Fett", FontHigh1)
Font1 = FontID(1)
FontHigh2 = Int(Pixel2 / (GetDeviceCaps_(GetDC_(hWnd), #LOGPIXELSY) / 96.0))
LoadFont(2, "Trebuchet MS Fett", FontHigh2)
Font2 = FontID(2)
FontHigh3 = Int(Pixel3 / (GetDeviceCaps_(GetDC_(hWnd), #LOGPIXELSY) / 96.0))
LoadFont(3, "Trebuchet MS Fett", FontHigh3)
Font3 = FontID(3)
FontHigh4 = Int(Pixel4 / (GetDeviceCaps_(GetDC_(hWnd), #LOGPIXELSY) / 96.0)) ;Figur für Stellungseingabe
LoadFont(4, "Lucida Sans Unicode Standard", FontHigh4) ;Geschmacks-Sache
Font4 = FontID(4)
;----------------------------------------------
CPUName.i = AllocateMemory(48) ;48 Characters
;Lese CPU-String
!MOV r9,[v_CPUName]
!XOR r8,r8
!@@:
!MOV eax,80000002h
!ADD eax,r8d
!CPUID
!MOV [r9],eax
!MOV [r9+4],ebx
!MOV [r9+8],ecx
!MOV [r9+12],edx
!INC r8
!CMP r8,3
!JE @f
!ADD r9,16
!JMP @b
!@@:
;----------------------------------------------
TextGadget(1, 20, 20, 150, 15, "System-Infos:")
;CPU ------------------------------------------
CPUName$ = PeekS(CPUName, 48, #PB_Ascii) ;wird nochmal verwendet
TextGadget(2, 20, 40, 325, 15, "CPU: " + CPUName$)
j = 1
hThread = GetCurrentThread_()
OldThreadAffinityMask = SetThreadAffinityMask_(hThread, j)
While SetThreadAffinityMask_(hThread, j)
!INC [v_AnzCore]
!MOV eax,1
!CPUID
!SHR ebx,24 ;Initial APIC ID. Bit24: 0=phys., 1=log.Core. Bit 25-31: "Basic"-Core
!AND ebx,0FFh
!TEST ebx,1
!JNZ @f
CoreSequence$ + "P"
P_Cores + 1 ;für kein HT/SMT
Cores | j
!JMP NextCore
!@@:
CoreSequence$ + "L"
HTAV + 1
!NextCore:
j << 1
Wend
SetThreadAffinityMask_(hThread, OldThreadAffinityMask) ;Restore
;Debug Bin(Cores)
If HTAV
HTAV$ = "Ja"
Else
HTAV$ = "Nein"
EndIf
TextGadget(3, 20, 55, 325, 15, "Verfügbare Anzahl CPU-Threads: " + Str(AnzCore))
TextGadget(4, 20, 70, 325, 15, "HT/SMT: " + HTAV$)
TextGadget(5, 20, 85, 325, 15, "Core-Sequenz (0-" + Str(AnzCore - 1) + "): " + CoreSequence$)
;RAM für Hash ---------------------------------
Memory.MEMORYSTATUSEX
Memory\dwLength = SizeOf(MEMORYSTATUSEX)
GlobalMemoryStatusEx_(@Memory)
FreeMemory = Memory\ullAvailPhys / 1024 / 1024 ;so in MB
TextGadget(6, 20, 100, 325, 15, "Freier Arbeitsspeicher: " + Str(FreeMemory) + " MB")
TextGadget(7, 20, 130, 100, 15, "SETTINGS:")
TextGadget(8, 20, 150, 100, 15, "Engine: " + UCI_Prog$)
For i = 1 To 8
SetGadgetColor(i, #PB_Gadget_BackColor, BackColor)
Next
;erstmal Test, ob Fish.ini existiert
If ReadFile(0, GetCurrentDirectory() + "Fish.ini", #PB_Ascii)
UCI_Prog_All$ = ReadString(0, #PB_Ascii) ;kompletter Programm-Pfad
UCI_Prog$ = GetFilePart(UCI_Prog_All$, #PB_FileSystem_NoExtension)
CloseFile(0)
EndIf
OptionGadget(9, 20, 165, 425, 15, "Letztgewählte Engine verwenden: " + UCI_Prog$)
OptionGadget(10, 20, 180, 300, 15, "Andere Engine wählen")
If UCI_Prog$ <> ""
SetGadgetState(9, 1)
Else
SetGadgetText(9, "Letztgewählte Engine verwenden: Keine ausgewählt")
DisableGadget(9, 1)
SetGadgetState(10, 1)
EndIf
TextGadget(11, 20, 200, 175, 15, "Hashgröße setzen (MB):")
SetGadgetColor(11, #PB_Gadget_BackColor, BackColor)
HashMemMax = 1 ;Startwert in MB
HashMemWert = 0
FreeMemory - 1024 ;1GB Reserve lassen
While HashMemMax < FreeMemory
HashMemWert + 1
HashMemMax << 1
Wend
HashMem = HashMemMax >> 1
SpinGadget (12, 180, 198, 75, 20, 0, HashMemWert - 1, #PB_Spin_ReadOnly)
SetGadgetState (12, HashMem)
SetGadgetText(12, Str(HashMem))
CheckBoxGadget(13, 20, 220, 180, 15, "Large Pages anfordern")
TextGadget(14, 20, 240, 150, 15, "Festlegung Threads:")
SetGadgetColor(14, #PB_Gadget_BackColor, BackColor)
OptionGadget(15, 20, 255, 125, 15, "1 Thread")
OptionGadget(16, 20, 270, 125, 15, "Kein HT/SMT")
OptionGadget(17, 20, 285, 125, 15, "Alle Threads")
SetGadgetState(17, 1)
TextGadget(18, 20, 305, 150, 15, "Startposition:")
SetGadgetColor(18, #PB_Gadget_BackColor, BackColor)
OptionGadget(19, 20, 320, 200, 15, "Grundstellung")
OptionGadget(20, 20, 335, 200, 15, "Teststellung laden (EPD)")
OptionGadget(21, 20, 350, 200, 15, "Stellungseingabe")
OptionGadget(22, 20, 365, 200, 15, "Stellung aus Zwischenablage")
SetGadgetState(19, 1)
;----------------------------------------------
ButtonGadget(23, 25, 400, 150, 30, "L o s g e h t s !")
For i = 1 To 23
SetGadgetFont(i, Font1)
Next
;----------------------------------------------
FEN_Strings = AllocateMemory(128 * 1000) ;für 1000 Stellungen, jeweils 128 Bytes; sollte reichen. Muss für Stellungseingabe schon vorhanden sein, deshalb hier vorn
HashMemAkt = HashMemOld
Repeat
HashMemAkt = GetGadgetState(12)
If HashMemAkt <> HashMemOld
HashMemOld = HashMemAkt
HashMem = (1 << HashMemAkt)
SetGadgetText(12, Str(HashMem))
EndIf
If GetGadgetState(10) And HaveEngine = 0 ;Engine auswählen
DisableGadget(23, 1)
HaveEngine = 1
TextGadget(24, 450, 20, 540, 15, "Engine auswählen:", #PB_Text_Center)
SetGadgetFont(24, Font1)
ExplorerTreeGadget(25, 450, 40, 540, 650, GetCurrentDirectory() + "*.EXE", #PB_Explorer_NoDriveRequester)
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_CloseWindow
End
EndIf
If GetGadgetState(9) And HaveEngine
HaveEngine = 0
DisableGadget(23, 0)
SetGadgetText(9, "Letztgewählte Engine verwenden: " + UCI_Prog$)
DisableGadget(9, 0)
SetGadgetState(9, 1)
Break
EndIf
Until EventType() = #PB_EventType_LeftDoubleClick And GetGadgetState(25) = #PB_Explorer_File
If HaveEngine
HaveEngine = 0
DisableGadget(23, 0)
UCI_Prog_All$ = GetGadgetText(25) ;kompletter Programm-Pfad
UCI_Prog$ = GetFilePart(UCI_Prog_All$, #PB_FileSystem_NoExtension)
EndIf
FreeGadget(24) : FreeGadget(25)
SetGadgetText(9, "Letztgewählte Engine verwenden: " + UCI_Prog$)
DisableGadget(9, 0)
SetGadgetState(9, 1)
EndIf
Event = WaitWindowEvent()
If Event = #PB_Event_CloseWindow
End
EndIf
If EventGadget() = 23 And Not IsGadget(25)
If GetGadgetState(13) = #PB_Checkbox_Checked ;Large Pages
LargePages = 1
ElseIf GetGadgetState(13) = #PB_Checkbox_Unchecked ;hier mal so
LargePages = 0
EndIf
If GetGadgetState(15) ;nur 1 Thread
Threads = 1
P_Cores = 0
ElseIf GetGadgetState(16) ;kein HT/SMT
Threads = P_Cores
ElseIf GetGadgetState(17) ;alle Threads
Threads = P_Cores + HTAV
P_Cores = 0
EndIf
If GetGadgetState(19)
Grundstellung = 1
ElseIf GetGadgetState(20)
Teststellung = 1
ElseIf GetGadgetState(21)
Stellungseingabe = 1
ElseIf GetGadgetState(22) ;Stellung aus Zwischenablage
Zwischenablage = 1
EndIf
Break
EndIf
ForEver
For i = 1 To 23
FreeGadget(i)
Next
CreateFile(0, GetCurrentDirectory() + "Fish.ini", #PB_Ascii)
WriteStringN(0, UCI_Prog_All$, #PB_Ascii)
CloseFile(0)
If Teststellung
;EPD-Datei laden --------------------------------------
TextGadget(1, 20, 25, 340, 15, "Teststellung wählen:", #PB_Text_Center)
SetGadgetColor(1, #PB_Gadget_BackColor, BackColor)
SetGadgetFont(1, Font1)
FileExt$ = "*.EPD"
ExplorerTreeGadget(2, 10, 50, 450, 440, GetCurrentDirectory() + "Tests\" + FileExt$, #PB_Explorer_NoDriveRequester)
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_CloseWindow
End
EndIf
Until EventType() = #PB_EventType_LeftDoubleClick And GetGadgetState(2) = #PB_Explorer_File
EPD$ = GetGadgetText(2) ;Programm-Pfad
;Debug EPD$
FreeGadget(1) : FreeGadget(2)
ReadFile(0, EPD$, #PB_Ascii)
E$= ReadString(0, #PB_Ascii, Lof(0))
CloseFile(0)
;Debug E$
Quot = FindString(E$, Chr(34))
If Quot ;erstmal das erste " entfernen und alles danach
F$ = Mid(E$, 1, Len(E$) - (Len(E$) - Quot + 1))
EndIf
;Debug F$
AM = FindString(F$, " am ")
If AM
F$ = Mid(F$, 1, Len(F$) - (Len(F$) - AM + 1))
EndIf
;Debug F$
BM = FindString(F$, " bm ") ;best move
If BM
F$ = Mid(F$, 1, Len(F$) - (Len(F$) - BM + 1))
EndIf
;Debug F$
FS$ = RTrim(FS$)
If FindString(F$, " 0 1") ;oder anders...
FEN$ = F$
Else
FEN$ = F$ + " 0 1"
EndIf
;Debug FEN$
EndIf ;Teststellung
;------------------------------------------------
If Stellungseingabe
Brettmal_Leer(40, 40, 20, ORand) ;leeres Brett
Figur = PeekW(?Figuren) ;wB als Anfang
TextGadget(200, 400, 200, 70, 70, Chr(Figur), #PB_Text_Center)
SetGadgetFont(200, Font4)
ButtonGadget(201, 425, 700, 150, 30, "L o s g e h t s !")
CheckBoxGadget(202, 20, 400, 200, 15, "Weiss kleine Rochade")
CheckBoxGadget(203, 20, 420, 200, 15, "Weiss große Rochade")
CheckBoxGadget(204, 20, 440, 200, 15, "Schwarz kleine Rochade")
CheckBoxGadget(205, 20, 460, 200, 15, "Schwarz kleine Rochade")
OptionGadget(206, 20, 480, 200, 15, "Weiß am Zug")
OptionGadget(207, 20, 500, 200, 15, "Schwarz am Zug")
SetGadgetState(206, 1)
For i = 201 To 207
If IsGadget(i)
SetGadgetFont(i, Font1)
EndIf
Next
SetWindowCallback(@wc())
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_CloseWindow
End
EndIf
If EventGadget() = 201
Break
EndIf
ForEver
SetWindowCallback(0)
Rochade$ = " " ;" KQkq"
If GetGadgetState(202) = #PB_Checkbox_Checked
Rochade$ + "K"
EndIf
If GetGadgetState(203) = #PB_Checkbox_Checked
Rochade$ + "Q"
EndIf
If GetGadgetState(204) = #PB_Checkbox_Checked
Rochade$ + "k"
EndIf
If GetGadgetState(205) = #PB_Checkbox_Checked
Rochade$ + "q"
EndIf
If Rochade$ = " "
Rochade$ = " -"
EndIf
If GetGadgetState(206)
Farbe_am_Zug$ = " w"
Else
Farbe_am_Zug$ = " b"
EndIf
FEN_Strings_Pointer = -128
FENString(?StellungEingabe) ;FEN_Strings_Pointer wird dort also wieder 0
For i = 200 To 207
FreeGadget(i)
Next
EndIf ;Stellungseingabe
;------------------------------------------------
If Zwischenablage
E$ = GetClipboardText()
;Debug E$
F$ = E$
Quot = FindString(E$, Chr(34))
If Quot ;erstmal das erste " entfernen und alles danach
F$ = Mid(E$, 1, Len(E$) - (Len(E$) - Quot + 1))
EndIf
;Debug F$
AM = FindString(F$, " am ") ;avoid move
If AM
F$ = Mid(F$, 1, Len(F$) - (Len(F$) - AM + 1))
EndIf
;Debug F$
BM = FindString(F$, " bm ") ;best move
If BM
F$ = Mid(F$, 1, Len(F$) - (Len(F$) - BM + 1))
EndIf
;Debug F$
FEN$ = RTrim(F$)
; If FindString(F$, " 0 1") ;oder anders...
;FEN$ = F$
; Else
; FEN$ = F$ + " 0 1"
; EndIf
Debug FEN$
Leer = FindString(FEN$, " ") ;Leerzeichen zwischen Stellung und Farbe am Zug
Debug Leer
Farbe_am_Zug$ = Mid(FEN$, Leer, 2) ;wird hier evtl. nicht benötigt
Debug Farbe_am_Zug$
Leer + 2 ;Rochade
LeerRA = FindString(FEN$, " ", Leer)
Debug LeerRA
;Leer+2
LeerRE = FindString(FEN$, " ", LeerRA+2)
Debug LeerRE
Rochade$ = Mid(FEN$, Leer, LeerRE-LeerRA)
Debug Rochade$
If FindString(Rochade$, "K", Leer + 1)
KleinRochW = 1
Rochade$ + "K"
Else
KleinRochW = 0
EndIf
If FindString(Rochade$, "Q", Leer + 1)
GrossRochW = 1
Rochade$ + "Q"
Else
GrossRochW = 0
EndIf
If FindString(Rochade$, "k", Leer + 1)
KleinRochS = 1
Rochade$ + "k"
Else
KleinRochS = 0
EndIf
If FindString(Rochade$, "q", Leer + 1)
GrossRochS = 1
Rochade$ + "q"
Else
GrossRochS = 0
EndIf
EndIf ;Zwischenablage
;------------------------------------------------
;Test2Stellung()
;-----------------------------------------
;Debug FEN$
;==================================================================
Chessprog = RunProgram(UCI_Prog_All$, "", "", #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide | #PB_Program_Write | #PB_Program_Ascii)
If ProgramRunning(Chessprog)
PID = ProgramID(Chessprog) ;für Core-Zuordnung
;Gadgets definieren und ggf.setzen
TextGadget(80, 340, 330, 35, 35, Chr($261C), #PB_Text_Center) ;weisser Hinweis-Finger, wenn Weiß am Zug
SetGadgetColor(80, #PB_Gadget_BackColor, BackColor)
TextGadget(81, 340, 45, 35, 35, Chr($20), #PB_Text_Center) ;schwarzer Hinweis-Finger $261A, wenn Schwarz am Zug
SetGadgetColor(81, #PB_Gadget_BackColor, BackColor)
ButtonGadget(82, 105, 5, 30, 30, Chr($21d5), #PB_Text_Center) ;Brett drehen
ButtonGadget(83, 135, 5, 30, 30, Chr($21e6), #PB_Text_Center) ;Zug zurück
ButtonGadget(84, 165, 5, 30, 30, Chr($21e8), #PB_Text_Center) ;Zug vor
ButtonGadget(85, 195, 5, 30, 30, Chr($21da), #PB_Text_Center) ;zurück zur Startstellung
ButtonGadget(86, 225, 5, 30, 30, Chr($21db), #PB_Text_Center) ;vor zur Endstellung
ButtonGadget(87, 20, 5, 30, 30, Chr($21c6), #PB_Text_Center | #PB_Button_Toggle) ;Stellung ändern/anpassen
For i = 80 To 87
SetGadgetFont(i, Font3)
Next
If Teststellung Or Stellungseingabe Or Zwischenablage ;bei Teststellungen wird FEN$ selbst erzeugt
FEN2Stellung()
; Else
; FENString(?Stellung)
EndIf
;Debug FEN$
Brettmal(40, 40, 20, ORand) ;hier Grundstellung, sonst auch ...
;Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
;FEN_Strings = AllocateMemory(128 * 1000) ;für 1000 Stellungen, jeweils 128 Bytes; sollte reichen
PokeS(FEN_Strings, FEN$, -1, #PB_Ascii) ;Ausgangsstellung an Adresse 0
;grundlegende Angaben
WriteProgramStringN(Chessprog, "uci", #PB_Ascii)
WriteProgramStringN(Chessprog, "setoption name threads value " + Str(Threads), #PB_Ascii)
WriteProgramStringN(Chessprog, "setoption name hash value " + Str(HashMem), #PB_Ascii)
If LargePages
WriteProgramStringN(Chessprog, "setoption name largepages value true", #PB_Ascii)
EndIf
;WriteProgramStringN(Chessprog, "setoption name ucinewgame", #PB_Ascii)
;WriteProgramStringN(Chessprog, "setoption name clear hash", #PB_Ascii) ;nur mal Test
While AvailableProgramOutput(Chessprog) = 0
EngineName$ = ReadProgramString(Chessprog, #PB_Ascii) ;ist der Engine-Name
Break
Wend
;Debug EngineName$
;diese Tests erst hier, da die Datei ja umbenannt sein kann
IsFish = FindString(EngineName$, "asmFish", 1, #PB_String_NoCase) ;nicht "asmFishW" wegen älterer Versionen
If IsFish = 0
MessageRequester("Abbruch!", "Dies ist keine Windows-asmFish-Version!", #PB_MessageRequester_Error)
End
EndIf
IsPOPCNT = FindString(EngineName$, "popcnt", 10, #PB_String_NoCase)
If IsPOPCNT
!mov eax,1
!cpuid
!test ecx,800000h ;Bit23=POPCNT
!jnz ISPOPCNT ;na ja...
MessageRequester("Abbruch!", "Diese CPU kann kein popcnt!" + #LF$ + "base nehmen!", #PB_MessageRequester_Error)
End
EndIf
!ISPOPCNT:
IsBMI = FindString(EngineName$, "bmi", 10, #PB_String_NoCase) ;bmi2
If IsBMI
!xor eax,eax
!cpuid
!cmp eax,7 ;max. ID
!jb NOBMI
!mov eax,7
!xor ecx,ecx
!cpuid
!test ebx,8 ;Bit3=BMI(1) wird auch genutzt
!jz NOBMI
!test ebx,100h ;Bit8=BMI2
!jnz ISBMI ;na ja...
!NOBMI:
MessageRequester("Abbruch!", "Diese CPU kann kein bmi!" + #LF$ + "popcnt oder base nehmen!", #PB_MessageRequester_Error)
End
EndIf
!ISBMI:
TextGadget(90, 10, ORand + 350, 350, 15, "Engine: " + EngineName$)
TextGadget(91, 10, ORand + 365, 350, 15, "CPU: " + PeekS(CPUName, 48, #PB_Ascii))
TextGadget(92, 10, ORand + 380, 350, 15, "CPU-Threads: " + Str(Threads))
TextGadget(93, 10, ORand + 395, 350, 15, "") ;Platzhalter für Hash-Größe
For i = 90 To 93
SetGadgetColor(i, #PB_Gadget_BackColor, BackColor)
SetGadgetFont(i, Font1)
Next
;nur für geladene Teststellung
If Teststellung
TextGadget(94, 10, ORand + 410, 980, 15, "Teststellung: " + EPD$)
SetGadgetFont(94, Font1)
SetGadgetColor(94, #PB_Gadget_BackColor, BackColor)
TextGadget(95, 10, ORand + 425, 980, 15, E$)
SetGadgetFont(95, Font1)
SetGadgetColor(95, #PB_Gadget_BackColor, BackColor)
EndIf
TextGadget(100, 10, ORand + 500, 120, 15, "Aktuelle Suchtiefe:")
TextGadget(101, 140, ORand + 500, 60, 15, Akt_Tiefe$)
TextGadget(102, 10, ORand + 515, 120, 15, "Aktueller Zug:")
TextGadget(103, 140, ORand + 514, 60, 15, Curr_Move$)
TextGadget(104, 10, ORand + 530, 120, 15, "Aktuelle Zug-Nr.:")
TextGadget(105, 140, ORand + 530, 60, 15, Curr_Move_Nr$)
TextGadget(106, 250, ORand + 580, 100, 15, "Hauptvariante:")
EditorGadget(107, 250, ORand + 600, 740, 100, #PB_Editor_ReadOnly | #PB_Editor_WordWrap) ;100 für 5 Zeilen
TextGadget(108, 10, ORand + 600, 100, 15, "Bewertung cp:")
TextGadget(109, 120, ORand + 600, 120, 15, Score$)
TextGadget(110, 10, ORand + 615, 100, 15, "Tiefe:")
TextGadget(111, 120, ORand + 615, 120, 15, Tiefe$)
TextGadget(112, 10, ORand + 630, 100, 15, "Zeit ms:")
TextGadget(113, 120, ORand + 630, 120, 15, Zeit$)
TextGadget(114, 10, ORand + 645, 100, 15, "Knoten:")
TextGadget(115, 120, ORand + 645, 120, 15, Knoten$)
TextGadget(116, 10, ORand + 660, 100, 15, "Knoten/s:")
TextGadget(117, 120, ORand + 660, 120, 15, Knoten_Sek$)
Hashfull$ = "0" ;Optik
TextGadget(118, 10, ORand + 675, 100, 15, "Hash voll " + Chr(8240) + ":") ;Chr(8240)=Promille
TextGadget(119, 120, ORand + 675, 120, 15, Hashfull$)
TB_Hits$ = "0" ;Optik
TextGadget(120, 10, ORand + 690, 100, 15, "TB-Treffer:")
TextGadget(121, 120, ORand + 690, 120, 15, TB_Hits$)
For i = 100 To 121
SetGadgetFont(i, Font1)
Next
For i = 100 To 120 Step 2
SetGadgetColor(i, #PB_Gadget_BackColor, BackColor)
Next
EditorGadget(122, 380, 10, 610, 360) ;das rechte Hauptfenster
Delay(10)
hProcess = OpenProcess_(#PROCESS_ALL_ACCESS, #False, PID)
;Debug "FEN$: " + FEN$
;If IsCPUSet = 0
;Debug Bin(Cores)
If P_Cores
Delay(10) ;10
SetProcessAffinityMask_(hProcess, Cores)
EndIf
;IsCPUSet = 1
;CloseHandle_(hProcess)
;EndIf
;--------------------------------------------------------------------------------------------------
;Test Analyse von Grundstellung an, mit Zug-Ausführung
Repeat
WriteProgramStringN(Chessprog, "position fen " + FEN$, #PB_Ascii)
;WriteProgramStringN(Chessprog, "position startpos moves a2b3 ", #PB_Ascii) ;Test
WriteProgramStringN(Chessprog, "go infinite", #PB_Ascii)
;Debug "------------------------------------"
;==============================================================================
;Ausgabe-Werte für Hash und Tiefe 1 auslesen und anzeigen. Tiefe 1 um sicher zu sein, das gerechnet wird wegen setzen der CPU-Core-Affinity
;wenn Tiefe1=0, dann wurde Fish Matt gesetzt!
Repeat
If AvailableProgramOutput(Chessprog)
Ausgabe$ = ReadProgramString(Chessprog, #PB_Ascii)
;Debug Ausgabe$
HashWert = FindString(Ausgabe$, "hash set to ", 13, #PB_String_NoCase)
If HashWert
SetGadgetText(93, "Hash-Größe: " + Mid(Ausgabe$, HashWert + 12))
EndIf
Tiefe1 = FindString(Ausgabe$, "info depth", 1, #PB_String_NoCase) ;hier nur für Tiefe 1 "info depth" ist Zeichen dafür, das Berechnung läuft
If Tiefe1
Akt_Tiefe$ = Mid(Ausgabe$, 12, 3) ;muss "1" sein, trotzdem auslesen
Akt_Tiefe$ = RTrim(Akt_Tiefe$, "s") ;"s" von seldepth bei Suchtiefe < 10 oder score!
;Debug Akt_Tiefe$
;Debug "???????????????????"
SetGadgetText(101, Akt_Tiefe$)
If FindString(Ausgabe$, "se", 13) ;seldepth
AddGadgetItem(122, Zeile, Ausgabe$)
Zeile + 1
SetActiveGadget(122)
EndIf
Break
EndIf
EndIf
ForEver
;==============================================================================
;==============================================================================
;Ausgabe-Werte ab Tiefe 2
Repeat
If AvailableProgramOutput(Chessprog)
Ausgabe$ = ReadProgramString(Chessprog, #PB_Ascii)
;Debug Ausgabe$
If IsCPUSet = 0
If P_Cores
Delay(10) ;10
SetProcessAffinityMask_(hProcess, Cores)
EndIf
IsCPUSet = 1
CloseHandle_(hProcess)
EndIf
;evtl.Test auf "info" oder "info depth" oder " depth"
P_Ausgabe = 12 ;Pointer in Ausgabe$, 12=Stelle nach "info depth "
If FindString(Ausgabe$, "rmove ", 14, #PB_String_NoCase) ;"rmove" von "currmove ", oder kürzer
Akt_Tiefe$ = Mid(Ausgabe$, P_Ausgabe, 3) ;aktuelle Suchtiefe
Akt_Tiefe$ = RTrim(Akt_Tiefe$, "c") ;"c" von currmove bei Suchtiefe < 10
Akt_Tiefe$ = Trim(Akt_Tiefe$)
SetGadgetText(101, Akt_Tiefe$)
Curr_Move$ = Trim(Mid(Ausgabe$, P_Ausgabe + 12, 5)) ;war (P_Ausgabe + 11, 6) geändert wegen Tiefe >=100 5 für ep???? 6
SetGadgetText(103, Curr_Move$)
P_CMN = FindString(Ausgabe$, "er ", 14, #PB_String_NoCase) ;currmovenumber
If P_CMN
Curr_Move_Nr$ = Mid(Ausgabe$, P_CMN + 3, 3) ;Länge=3 geht hier wohl ohne weitere Maßnahmen
CMN = Val(Curr_Move_Nr$)
If CMN > CMN_Max
CMN_Max = CMN
EndIf
SetGadgetText(105, Curr_Move_Nr$ + "/" + Str(CMN_Max))
EndIf
Else
Tiefe$ = Mid(Ausgabe$, P_Ausgabe, 3)
Tiefe$ = RTrim(Tiefe$, "s") ;"s" von seldepth bei Suchtiefe < 10. Ist hier nicht die aktuelle Tiefe sondern Tiefe der Haupvariante
Tiefe$ = Trim(Tiefe$)
SetGadgetText(101, Tiefe$) ;Optik
SetGadgetText(103, "")
SetGadgetText(105, "")
P_Ausgabe + 6
ST = FindString(Ausgabe$, "pth ", P_Ausgabe, #PB_String_NoCase) ;"pth " von "seldepth ", oder kürzer
If ST
Sel_Tiefe$ = Mid(Ausgabe$, ST + 4, 3)
Sel_Tiefe$ = RTrim(Sel_Tiefe$, "m") ;"m" von multipv bei Suchtiefe < 10
Sel_Tiefe$ = Trim(Sel_Tiefe$)
EndIf
SetGadgetText(111, Tiefe$ + "/" + Sel_Tiefe$)
P_Ausgabe = ST + 6
T = FindString(Ausgabe$, "time ", P_Ausgabe, #PB_String_NoCase)
If T
TT = FindString(Ausgabe$, " ", T + 6) ;T+6=erstes Leerzeichen nach Ziffer, z.B. "time 5 "
Zeit$ = Mid(Ausgabe$, T + 5, TT - T - 5);5=Länge von "time "; erste Ziffer nach "time "
Zeit$ = Trim(Zeit$) ;erstmal drinlassen
Zeit$ = DeziPoint(Zeit$)
SetGadgetText(113, Zeit$)
P_Ausgabe = T + 6
EndIf
NPS = FindString(Ausgabe$, "nps ", P_Ausgabe, #PB_String_NoCase)
If NPS
TT = FindString(Ausgabe$, " ", NPS + 5) ;NPS+5=erstes Leerzeichen nach Ziffer, z.B. "nps 5 "
Knoten_Sek$ = Mid(Ausgabe$, NPS + 4, TT - NPS - 4) ;4=Länge von "nps "; erste Ziffer nach "nps "
Knoten_Sek$ = Trim(Knoten_Sek$) ;erstmal drinlassen
Knoten_Sek$ = DeziPoint(Knoten_Sek$)
SetGadgetText(117, Knoten_Sek$)
P_Ausgabe = NPS + 5
EndIf
Score = FindString(Ausgabe$, "cp ", P_Ausgabe + 6, #PB_String_NoCase) ;+6 von Länge "score "; cp=centipawn
If Score
TT = FindString(Ausgabe$, " ", Score + 4) ;CP+4=erstes Leerzeichen nach Ziffer, z.B. "cp 5 "
Score$ = Mid(Ausgabe$, Score + 3, TT - Score - 3) ;3=Länge von "cp "; erste Ziffer nach "cp "
Score$ = Trim(Score$) ;erstmal drinlassen
P_Ausgabe = Score + 4
Bound = FindString(Ausgabe$, " upp", P_Ausgabe, #PB_String_NoCase)
If Bound
Score$ + " upperbound"
P_Ausgabe = Bound + 11
EndIf
Bound = FindString(Ausgabe$, " low", P_Ausgabe, #PB_String_NoCase)
If Bound
Score$ + " lowerbound"
P_Ausgabe = Bound + 11
EndIf
SetGadgetText(109, Score$)
EndIf
Score = FindString(Ausgabe$, " ma", P_Ausgabe + 6, #PB_String_NoCase) ;+6 von Länge "score "; ma=mate
If Score
TT = FindString(Ausgabe$, " ", Score + 6) ;Score+6=erstes Leerzeichen nach Ziffer, z.B. "mate 5 "
Score$ = Mid(Ausgabe$, Score + 5, TT - Score - 5) ;5=Länge von "mate "; erste Ziffer nach "mate "
Score$ = Trim(Score$) ;erstmal drinlassen
SetGadgetText(109, "Matt in " + Score$)
P_Ausgabe = Score + 6
EndIf
Knoten = FindString(Ausgabe$, " nod", P_Ausgabe, #PB_String_NoCase) ;nod=nodes
If Knoten
TT = FindString(Ausgabe$, " ", Knoten + 7) ;Knoten+7=erstes Leerzeichen nach Ziffer, z.B. "nodes 5 "
Knoten$ = Mid(Ausgabe$, Knoten + 6, TT - Knoten - 6) ;6=Länge von "nodes "; erste Ziffer nach "nodes "
Knoten$ = Trim(Knoten$) ;erstmal drinlassen
Knoten$ = DeziPoint(Knoten$)
SetGadgetText(115, Knoten$)
P_Ausgabe = Knoten + 7
EndIf
Hashfull = FindString(Ausgabe$, "ll", 13, #PB_String_NoCase) ;"ll" von hashfull 13?
If Hashfull
Hashfull$ = Trim(Mid(Ausgabe$, Hashfull + 3, 3))
Hashfull$ = RTrim(Hashfull$, "t") ;"t" von tbhits bei hashfull < 10
SetGadgetText(119, Hashfull$)
EndIf
TBH = FindString(Ausgabe$, " tbh", P_Ausgabe, #PB_String_NoCase)
If TBH
TT = FindString(Ausgabe$, " ", TBH + 8) ;TBH+8=erstes Leerzeichen nach Ziffer, z.B. "tbhits 0 "
TB_Hits$ = Mid(Ausgabe$, TBH + 7, TT - TBH - 7) ;7=Länge von "tbhits "; erste Ziffer nach "tbhits "
TB_Hits$ = Trim(TB_Hits$) ;erstmal drinlassen
SetGadgetText(121, TB_Hits$)
P_Ausgabe = TBH + 8
EndIf
PV = FindString(Ausgabe$, " pv", 13, #PB_String_NoCase) ;Leerzeichen wegen "multipv"! pv=principal variation = Hauptvariante
If PV
PV$ = Trim(Mid(Ausgabe$, PV + 3))
SetGadgetText(107, PV$) ;ist EditorGadget
EndIf
If FindString(Ausgabe$, "se", 13, #PB_String_NoCase) ;seldepth
AddGadgetItem(122, Zeile, Ausgabe$)
Zeile + 1
SetActiveGadget(122)
; Debug Ausgabe$
EndIf
; If FindString(Ausgabe$, "best") ;bestmove, könnte hier für Matt genutzt werden!
; Break
; EndIf
EndIf ;FindString(Ausgabe$, "rmove ", 14)
EndIf ;AvailableProgramOutput(Chessprog)
;==============================================================================
;Maus-Abfrage und evtl. Programm-Ende
Event = WindowEvent();WaitWindowEvent(250)
If #PB_Event_Gadget
Select EventGadget()
Case 82 ;Brett drehen
Weiss_unten ! 1
Brettmal(40, 40, 20, ORand)
Finger()
Case 83 ;Zug zurück
If FEN_Strings_Pointer > 0
WriteProgramStringN(Chessprog, "stop", #PB_Ascii)
FEN_Strings_Pointer - 128
FEN$ = PeekS(FEN_Strings + FEN_Strings_Pointer, -1, #PB_Ascii)
WriteProgramStringN(Chessprog, "position fen " + FEN$, #PB_Ascii)
WriteProgramStringN(Chessprog, "go infinite", #PB_Ascii)
Restoring() ;z.B. Rochade-Recht bei Zug vor/zurück aktualisieren
Debug FEN$
FEN2Stellung()
Brettmal(40, 40, 20, ORand)
Finger()
EndIf
Case 84 ;Zug vor
If FEN_Strings_Pointer < FEN_Strings_Pointer_Max
WriteProgramStringN(Chessprog, "stop", #PB_Ascii)
FEN_Strings_Pointer + 128
FEN$ = PeekS(FEN_Strings + FEN_Strings_Pointer, -1, #PB_Ascii)
WriteProgramStringN(Chessprog, "position fen " + FEN$, #PB_Ascii)
WriteProgramStringN(Chessprog, "go infinite", #PB_Ascii)
Restoring() ;z.B. Rochade-Recht bei Zug vor/zurück aktualisieren
Debug FEN$
FEN2Stellung()
Brettmal(40, 40, 20, ORand)
Finger()
EndIf
Case 85 ;zurück zur Startstellung
WriteProgramStringN(Chessprog, "stop", #PB_Ascii)
;FEN_Strings_Pointer + 128
FEN$ = PeekS(FEN_Strings, -1, #PB_Ascii)
WriteProgramStringN(Chessprog, "position fen " + FEN$, #PB_Ascii)
WriteProgramStringN(Chessprog, "go infinite", #PB_Ascii)
Restoring() ;z.B. Rochade-Recht bei Zug vor/zurück aktualisieren
Debug FEN$
FEN2Stellung()
Brettmal(40, 40, 20, ORand)
Finger()
Case 86 ;vor zur Endstellung
WriteProgramStringN(Chessprog, "stop", #PB_Ascii)
;FEN_Strings_Pointer + 128
FEN$ = PeekS(FEN_Strings + FEN_Strings_Pointer_Max, -1, #PB_Ascii)
WriteProgramStringN(Chessprog, "position fen " + FEN$, #PB_Ascii)
WriteProgramStringN(Chessprog, "go infinite", #PB_Ascii)
Restoring() ;z.B. Rochade-Recht bei Zug vor/zurück aktualisieren
Debug FEN$
FEN2Stellung()
Brettmal(40, 40, 20, ORand)
Finger()
Case 87 ;Stellung ändern/anpassen
For i = 90 To 93
HideGadget(i, 1)
Next
If Teststellung
HideGadget(94, 1)
HideGadget(95, 1)
EndIf
HideGadget(122, 1) ;das rechte Hauptfenster verstecken
WriteProgramStringN(Chessprog, "stop", #PB_Ascii)
For i = 0 To 63
PokeB(?StellungEingabe + i, PeekB(?Stellung + i))
Next
Figur = PeekW(?Figuren) ;wB als Anfang
TextGadget(200, 400, 200, 70, 70, Chr(Figur), #PB_Text_Center)
SetGadgetFont(200, Font4)
CheckBoxGadget(202, 20, 400, 200, 15, "Weiss kleine Rochade")
CheckBoxGadget(203, 20, 420, 200, 15, "Weiss große Rochade")
CheckBoxGadget(204, 20, 440, 200, 15, "Schwarz kleine Rochade")
CheckBoxGadget(205, 20, 460, 200, 15, "Schwarz kleine Rochade")
OptionGadget(206, 20, 480, 200, 15, "Weiß am Zug")
OptionGadget(207, 20, 500, 200, 15, "Schwarz am Zug")
SetGadgetState(206, 1)
For i = 202 To 207
SetGadgetFont(i, Font1)
Next
SetWindowCallback(@wc()) ;aktivieren
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_CloseWindow
End
EndIf
If EventGadget() = 87
Break
EndIf
ForEver
SetWindowCallback(0) ;deaktivieren
For i = 0 To 63
PokeB(?Stellung + i, PeekB(?StellungEingabe + i)) ;umkopieren
Next
;Rochade$ = " " ;" KQkq"
;If GetGadgetState(102) = #PB_Checkbox_Checked
; Rochade$ + "K"
;EndIf
;If GetGadgetState(103) = #PB_Checkbox_Checked
; Rochade$ + "Q"
;EndIf
;If GetGadgetState(104) = #PB_Checkbox_Checked
; Rochade$ + "k"
;EndIf
;If GetGadgetState(105) = #PB_Checkbox_Checked
; Rochade$ + "q"
;EndIf
;If Rochade$ = " "
; Rochade$ = " -"
;EndIf
If GetGadgetState(206)
Farbe_am_Zug$ = " w"
Else
Farbe_am_Zug$ = " b"
EndIf
Finger()
FENString(?StellungEingabe)
WriteProgramStringN(Chessprog, "position fen " + FEN$, #PB_Ascii)
WriteProgramStringN(Chessprog, "go infinite", #PB_Ascii)
For i = 200 To 207
If IsGadget(i)
FreeGadget(i)
EndIf
Next
For i = 90 To 93
HideGadget(i, 0)
Next
If Teststellung
HideGadget(94, 0)
HideGadget(95, 0)
EndIf
HideGadget(122, 0) ;das rechte Hauptfenster wieder anzeigen
EndSelect
EndIf ;#PB_Event_Gadget
If Event = #PB_Event_LeftClick
MX = WindowMouseX(0)
MY = WindowMouseY(0)
If Weiss_unten = 0
MX = 360 - MX
MY = 400 - MY
EndIf
If MX >= 20 And MX <= 340
MX - 20
MX / 40
Maus_Linie = MX + 97 ;97="a"
If MY >= ORand And MY <= ORand + 320
MY - ORand
MY / 40
Maus_Reihe = 56 - MY ;56="8"
Pos = MX + (MY * 8) ;ist die Textgadget-Nr. und Zeiger in Stellung
;Debug "Pos " + Str(Pos)
;Debug "Figur " + Hex(PeekB(?Stellung+Pos))
If Maus_AFeld$ = ""
If GetGadgetText(Pos) <> Chr($20) ;Leerfeld kann nicht Ausgangs-Feld sein
If (PeekB(?Stellung + Pos) < $62 And Farbe_am_Zug$ = " w") Or (PeekB(?Stellung + Pos) > $61 And Farbe_am_Zug$ = " b") ;angefasste Figur muss von Farbe_am_Zug sein $62=b=schw.Bishop
Maus_AFeld$ = Chr(Maus_Linie) + Chr(Maus_Reihe)
;Debug Maus_AFeld$
Feld_Color = GetGadgetColor(Pos, #PB_Gadget_BackColor) ;"alte" Feldfarbe sichern für rückgängig
SetGadgetColor(Pos, #PB_Gadget_BackColor, $FF00F0)
EndIf
EndIf
Else
;If (PeekB(?Stellung + Pos) < $62 And Farbe_am_Zug$ = " w")
Maus_ZFeld$ = Chr(Maus_Linie) + Chr(Maus_Reihe)
;Debug Maus_ZFeld$
;Debug Pos
If Maus_ZFeld$ <> Maus_AFeld$ ;so kann angefangener Zug ungültig gemacht werden
Zug$ = Maus_AFeld$ + Maus_ZFeld$
Break ;Zug wird ausgeführt
Else
Maus_AFeld$ = "" ;wieder frei für nächsten Zug
SetGadgetColor(Pos, #PB_Gadget_BackColor, Feld_Color) ;"Versehen" wieder ausbügeln
EndIf
;EndIf
EndIf
EndIf
EndIf
ElseIf Event = #PB_Event_CloseWindow
KillProgram(Chessprog) ;muss vor Close!
CloseProgram(Chessprog)
End
EndIf ;#PB_Event_LeftClick
;==============================================================================
Delay(1)
ForEver ;Ausgabe-Werte ab Tiefe 2
;Debug Zug$
Zug()
Maus_AFeld$ = "" ;frei für nächste Zug
FENString(?Stellung)
;Debug FEN$
WriteProgramStringN(Chessprog, "stop", #PB_Ascii)
ForEver ;Zug wird oben an Programm übergeben
EndIf ;ProgramRunning(Chessprog)
EndIf ;hWnd
End
;==================================================================================================
Procedure FEN2Stellung() ;FEN in Stellung, es interessieren nur die 64 Felder!
j = 1
For i = 0 To 63
Feld = Asc(Mid(FEN$, j, 1))
Select Feld
Case 47 ;"/" wegen Korrektur und Default
i - 1 ;Korrektur
Case 49 To 56 ;1-8
For k = 1 To Feld - 48
PokeB(?Stellung + i, 32)
i + 1
Next
i - 1 ;Korrektur
Default
PokeB(?Stellung + i, Feld)
EndSelect
j + 1
Next
Farbe_am_Zug$ = Mid(FEN$, j, 2) ;hier mal drangehängt
Finger()
EndProcedure
Procedure Test2Stellung() ;wenn beide nicht dann automatisch Grundstellung
If FEN;PNG
ElseIf EPD
EndIf
EndProcedure
Procedure Zug() ;für Weiß und Schwarz
;Ausgangsfeld
LinieA$=Mid(Zug$, 1, 1)
ReiheA$=Mid(Zug$, 2, 1)
AFeld = Asc(LinieA$)+Asc(ReiheA$) + 8*(56-Asc(ReiheA$)) - (97+Asc(ReiheA$)) ;56=Asc("8"), 97=asc("a")
;Zielfeld
LinieZ$=Mid(Zug$, 3, 1)
ReiheZ$=Mid(Zug$, 4, 1)
ZFeld = Asc(LinieZ$)+Asc(ReiheZ$) + 8*(56-Asc(ReiheZ$)) - (97+Asc(ReiheZ$))
Inhalt_AFeld = PeekB(?Stellung + AFeld)
Inhalt_ZFeld = PeekB(?Stellung + ZFeld) ;auch für z.B.ep
If Inhalt_ZFeld > $20 Or Inhalt_AFeld = $50 Or Inhalt_AFeld = $70 ;irgendeine Figur geschlagen oder weisser oder schwarzer Bauer gezogen
Schlag_Bauer$ = " 0"
Schlag_Bauer = 0
Else
Schlag_Bauer + 1
Schlag_Bauer$ = " " + Str(Schlag_Bauer)
;Debug Schlag_Bauer$
EndIf
PokeB(?Stellung + ZFeld, PeekB(?Stellung + AFeld))
PokeB(?Stellung + AFeld, $20)
;---------------- Bauern-Umwandlung -----------
If Inhalt_AFeld = $50 And ZFeld < 8 ;Umwandlung weisser Bauer
PokeB(?Stellung + ZFeld, $3f) ;3f=? optischer Spaß mit Fragezeichen
Brettmal(40, 40, 20, ORand)
Umwandlung() ;liefert UFig
PokeB(?Stellung + ZFeld, UFig - $20) ;weil UFig in Kleinbuchstabe!
Zug$ + Chr(UFig)
EndIf
If Inhalt_AFeld = $70 And ZFeld > 55 ;Umwandlung schwarzer Bauer
PokeB(?Stellung + ZFeld, $3f) ;3f=? optischer Spaß mit Fragezeichen
Brettmal(40, 40, 20, ORand)
Umwandlung() ;liefert UFig
PokeB(?Stellung + ZFeld, UFig)
Zug$ + Chr(UFig)
EndIf
;---------------- EnPassant, der gegnerische Bauer muss weg!
If PeekB(?Stellung + ZFeld) = $50 ;=P=weisser Bauer hat gezogen
If LinieZ$ <> LinieA$ ;war also ein Schlagzug
If Inhalt_ZFeld = $20 ;wenn Leerfeld, dann schwarzen Bauer weg
PokeB(?Stellung + ZFeld + 8, $20)
Schlag_Bauer$ = " 0"
Schlag_Bauer = 0
EndIf
EndIf
EndIf
If PeekB(?Stellung + ZFeld) = $70 ;=p=schwarzer Bauer hat gezogen
If LinieZ$ <> LinieA$ ;war also ein Schlagzug
If Inhalt_ZFeld = $20 ;wenn Leerfeld, dann weissen Bauer weg
PokeB(?Stellung + ZFeld - 8, $20)
Schlag_Bauer$ = " 0"
Schlag_Bauer = 0
EndIf
EndIf
EndIf
;---------------- Rochaden --------------------
If GrossRochS And (AFeld = 0 Or AFeld = 4) ;A8 oder E8
Rochade$ = RemoveString(Rochade$, "q", #PB_String_CaseSensitive, 2, 1)
GrossRochS = 0 ;Rochade-Recht verloren
If Len(Rochade$) = 1
Rochade$ = " -"
EndIf
If Zug$ = "e8c8" ;war sogar Rochade, den Turm-Zug bei Rochade ausführen
PokeB(?Stellung, $20)
PokeB(?Stellung + 3, $72)
EndIf
EndIf
If KleinRochS And (AFeld = 7 Or AFeld = 4) ;H8 oder E8
Rochade$ = RemoveString(Rochade$, "k", #PB_String_CaseSensitive, 2, 1)
KleinRochS = 0 ;Rochade-Recht verloren
If Len(Rochade$) = 1
Rochade$ = " -"
EndIf
If Zug$ = "e8g8" ;war sogar Rochade, den Turm-Zug bei Rochade ausführen
PokeB(?Stellung + 7, $20)
PokeB(?Stellung + 5, $72)
EndIf
EndIf
If GrossRochW And (AFeld = 56 Or AFeld = 60) ;A1 oder E1
Rochade$ = RemoveString(Rochade$, "Q", #PB_String_CaseSensitive, 2, 1)
GrossRochW = 0 ;Rochade-Recht verloren
If Len(Rochade$) = 1
Rochade$ = " -"
EndIf
If Zug$ = "e1c1" ;war sogar Rochade, den Turm-Zug bei Rochade ausführen
PokeB(?Stellung + 56, $20)
PokeB(?Stellung + 59, $52)
EndIf
EndIf
If KleinRochW And (AFeld = 63 Or AFeld = 60) ;H1 oder E1
Rochade$ = RemoveString(Rochade$, "K", #PB_String_CaseSensitive, 2, 1)
KleinRochW = 0 ;Rochade-Recht verloren
If Len(Rochade$) = 1
Rochade$ = " -"
EndIf
If Zug$ = "e1g1" ;war sogar Rochade, den Turm-Zug bei Rochade ausführen
PokeB(?Stellung + 63, $20)
PokeB(?Stellung + 61, $52)
EndIf
EndIf
;----------------------------------------------
;---------------- EnPassant ------------------- es wird nur das Zielfeld angegeben, auch wenn kein gegnerischer Bauer in der Nähe ist
If (AFeld - ZFeld = 16) And (PeekB(?Stellung + ZFeld) = $50) ;=P=weisser Bauer, ZFeld auf Bauer testen, AFeld schon leer!
EP$ = Mid(Zug$, 4, 1) ;Ziel-Reihe
EP = Val(EP$) - 1
EnPassant$ = " " + Mid(Zug$, 3, 1) + Str(EP)
ElseIf (ZFeld - AFeld = 16) And (PeekB(?Stellung + ZFeld) = $70) ;=p=schwarzer Bauer
EP$ = Mid(Zug$, 4, 1) ;Ziel-Reihe
EP = Val(EP$) + 1
EnPassant$ = " " + Mid(Zug$, 3, 1) + Str(EP)
Else
EnPassant$ = " -"
EndIf
;----------------------------------------------
If Farbe_am_Zug$ = " w"
Farbe_am_Zug$ = " b" ;nicht s!!!
Else
Farbe_am_Zug$ = " w"
ZugNr + 1
ZugNr$ = " " + Str(ZugNr)
EndIf
Finger()
CMN_Max = 0 ;currmovenumber
Brettmal(40, 40, 20, ORand)
EndProcedure
Procedure FENString(AdrStellung) ;wird an Programm gesendet
;zuerst Stellung
Leer = 0
FEN$ = ""
For i = 0 To 63 ;64 Felder, 0=A8, 63=H1
F = PeekB(AdrStellung + i)
If F > $20 ;Figur
If Leer
FEN$ + Chr($30 + Leer)
Leer = 0
EndIf
FEN$ + Chr(F)
Else
Leer + 1
EndIf
If i > 0 And ((i + 1) % 8 = 0) ;nächste Reihe
If Leer
FEN$ + Chr($30 + Leer)
EndIf
If i < 56
FEN$ + "/"
EndIf
Leer = 0
EndIf
Next
;dann Farbe am Zug
FEN$ + Farbe_am_Zug$
;dann Rochade-Möglichkeiten usw.
FEN$ + Rochade$
FEN$ + EnPassant$
FEN$ + Schlag_Bauer$
FEN$ + ZugNr$
Debug FEN$
FEN_Strings_Pointer + 128
FEN_Strings_Pointer_Max = FEN_Strings_Pointer
Debug FEN_Strings
Debug FEN_Strings_Pointer
PokeS(FEN_Strings + FEN_Strings_Pointer, FEN$, -1, #PB_Ascii)
Debug PeekS(FEN_Strings + FEN_Strings_Pointer, -1, #PB_Ascii)
EndProcedure
Procedure Brettmal(Width, Height, StartPosX, StartPosY)
PosX = StartPosX
PosY = StartPosY
Feldfarbe = $ffffff ;Weiss
Restore Stellung
Restore Figuren
For i = 0 To 63 ;64 Felder
Feld = PeekB(?Stellung + i) & $FF
Select Feld
Case $70 ;p=schwarzer Bauer
Figur = PeekW(?Figuren + 12)
Case $6e ;n=schwarzer Springer
Figur = PeekW(?Figuren + 14)
Case $62 ;b=schwarzer Läufer
Figur = PeekW(?Figuren + 16)
Case $72 ;r=schwarzer Turm
Figur = PeekW(?Figuren + 18)
Case $71 ;q=schwarze Dame
Figur = PeekW(?Figuren + 20)
Case $6b ;k=schwarzer König
Figur = PeekW(?Figuren + 22)
Case $50 ;P=weisser Bauer
Figur = PeekW(?Figuren)
Case $4e ;N=weisser Springer
Figur = PeekW(?Figuren + 2)
Case $42 ;B=weisser Läufer
Figur = PeekW(?Figuren + 4)
Case $52 ;R=weisser Turm
Figur = PeekW(?Figuren + 6)
Case $51 ;Q=weisse Dame
Figur = PeekW(?Figuren + 8)
Case $4b ;K=weisser König
Figur = PeekW(?Figuren + 10)
Case $3f ;optischer Spaß mit Fragezeichen bei Bauern-Umwandlung
Figur = $3f
Default
Figur = $20 ;Leerfeld
EndSelect
If i > 0 And (i % 8 = 0)
PosX = StartPosX
PosY + Height
Feldfarbe ! ($ffffff - $cc99) ;Wechsel Weiss <-> Grün
EndIf
If Weiss_unten
TextGadget(i, PosX, PosY, Width, Height, Chr(Figur), #PB_Text_Center)
Else
TextGadget(i, 40 * 8 - PosX, 40 * 9 - PosY, Width, Height, Chr(Figur), #PB_Text_Center)
EndIf
SetGadgetColor(i, #PB_Gadget_BackColor, Feldfarbe) ;muss vor Font!!!
SetGadgetFont(i, Font0)
PosX + Width
Feldfarbe ! ($ffffff - $cc99) ;Wechsel Weiss <-> Grün
Next
;Brettbeschriftung
j = 0
For i = 1 To 8
If Weiss_unten
TextGadget(63 + i, 5, ORand + 295 - j, 12, 16, Str(i)) ;1-8
SetGadgetFont(63 + i, Font1)
TextGadget(71 + i, 35 + j, ORAnd + 320, 14, 16, Chr(64 + i)) ;A-H
SetGadgetFont(71 + i, Font1)
Else
TextGadget(72 - i, 5, ORand + 295 - j, 12, 16, Str(9 - i)) ;8-1
SetGadgetFont(72 - i, Font1)
TextGadget(80 - i, 35 + j, ORAnd + 320, 14, 16, Chr(73 - i)) ;H-A
SetGadgetFont(80 - i, Font1)
EndIf
j + 40
Next
; ;"Icons"
; TextGadget(80, 20, 10, 25, 25, Chr($2713), #PB_Text_Center) ;
; SetGadgetFont(80, Font2)
; SetGadgetColor(80, #PB_Gadget_BackColor, $ff00)
EndProcedure
Procedure Brettmal_Leer(Width, Height, StartPosX, StartPosY)
PosX = StartPosX
PosY = StartPosY
Feldfarbe = $ffffff ;Weiss
Restore Figuren
For i = 0 To 63 ;64 Felder
Figur = $20 ;Leerfeld
If i > 0 And (i % 8 = 0)
PosX = StartPosX
PosY + Height
Feldfarbe ! ($ffffff - $cc99) ;Wechsel Weiss <-> Grün
EndIf
TextGadget(i, PosX, PosY, Width, Height, Chr(Figur), #PB_Text_Center)
SetGadgetColor(i, #PB_Gadget_BackColor, Feldfarbe) ;muss vor Font!!!
SetGadgetFont(i, Font0)
PosX + Width
Feldfarbe ! ($ffffff - $cc99) ;Wechsel Weiss <-> Grün
Next
;Brettbeschriftung
j = 0
For i = 1 To 8
TextGadget(63 + i, 5, ORand + 295 - j, 12, 16, Str(i)) ;1-8
SetGadgetFont(63 + i, Font1)
TextGadget(71 + i, 35 + j, ORAnd + 320, 14, 16, Chr(i + 64)) ;A-H
SetGadgetFont(71 + i, Font1)
j + 40
Next
; ;"Icons"
; TextGadget(80, 20, 10, 25, 25, Chr($2713), #PB_Text_Center) ;
; SetGadgetFont(80, Font2)
; SetGadgetColor(80, #PB_Gadget_BackColor, $ff00)
EndProcedure
Code: Select all
Procedure wc(hWnd, uMsg, wParam, lParam) ;WindowCallback, nur für Stellungseingabe!
Select uMsg
Case #WM_LBUTTONUP
MX = WindowMouseX(0)
MY = WindowMouseY(0)
If MX > 20 And MX < 340 ;Vergleiche ohne "=" !
MX - 20
MX / 40
Maus_Linie = MX + 97 ;97="a"
If MY > ORand And MY < ORand + 320
MY - ORand
MY / 40
Maus_Reihe = 56 - MY ;56="8"
Pos = MX + (MY * 8) ;ist die Textgadget-Nr.
SetGadgetText(Pos, Chr(PeekW(FigArt + BlackWhite)))
Select PeekW(FigArt + BlackWhite)
Case 9812 ;wK
FigEin = $4b
Case 9813 ;wD
FigEin = $51
Case 9814 ;wT
FigEin = $52
Case 9815 ;wL
FigEin = $42
Case 9816 ;wS
FigEin = $4e
Case 9817 ;wB
FigEin = $50
Case 9818 ;sK
FigEin = $6b
Case 9819 ;sD
FigEin = $71
Case 9820 ;sT
FigEin = $72
Case 9821 ;sL
FigEin = $62
Case 9822 ;sS
FigEin = $6e
Case 9823 ;sB
FigEin = $70
EndSelect
PokeB(?StellungEingabe + Pos, FigEin)
EndIf
EndIf
Case #WM_RBUTTONUP
MX = WindowMouseX(0)
MY = WindowMouseY(0)
If MX > 20 And MX < 340
MX - 20
MX / 40
Maus_Linie = MX + 97 ;97="a"
If MY > ORand And MY < ORand + 320
MY - ORand
MY / 40
Maus_Reihe = 56 - MY ;56="8"
Pos = MX + (MY * 8) ;ist die Textgadget-Nr.
SetGadgetText(Pos, Chr(32)) ;Leerfeld
PokeB(?StellungEingabe + Pos, $20)
EndIf
EndIf
Case #WM_MBUTTONUP
If BlackWhite
BlackWhite = 0
Else
BlackWhite = 12
EndIf
SetGadgetText(200, Chr(PeekW(FigArt + BlackWhite)))
Case #WM_MOUSEWHEEL
If wParam > 0 And FigArt > FigArtOri ;Wheel Button Up
FigArt - 2 ;2 weil Word
SetGadgetText(200, Chr(PeekW(FigArt + BlackWhite)))
ElseIf wParam < 0 And FigArt < (FigArtOri + 10) ;Wheel Button Down
FigArt + 2
SetGadgetText(200, Chr(PeekW(FigArt + BlackWhite)))
EndIf
EndSelect
ProcedureReturn #PB_ProcessPureBasicEvents ;muss!
EndProcedure
Procedure Umwandlung() ;für Weiß und Schwarz
If Farbe_am_Zug$ = " w" ;wB
BlackWhite = 0
Else
BlackWhite = 6
EndIf
j = 0
k = 0
For i = 200 To 203
ButtonGadget(i, 340, 120 + j, 40, 40, Chr(9813 + k + BlackWhite), #PB_Text_Center)
SetGadgetFont(i, Font0)
j + 40
k + 1
Next
SetActiveGadget(200)
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_CloseWindow
End
EndIf
Select EventGadget()
Case 200
UFig = 113 ;q
Break
Case 201
UFig = 114 ;r
Break
Case 202
UFig = 98 ;b
Break
Case 203
UFig = 110 ;n
Break
EndSelect
ForEver
For i = 200 To 203
FreeGadget(i)
Next
EndProcedure
Procedure Finger()
Finger80 = 80 ;unten, weißer Finger
Finger81 = 81 ;oben, schwarzer Finger
If Weiss_unten = 0 ;also oben
Finger80 = 81
Finger81 = 80
EndIf
If Farbe_am_Zug$ = " b"
SetGadgetText(Finger80, Chr($20))
SetGadgetText(Finger81, Chr($261A)) ;der schwarze Hinweis-Finger
Else
SetGadgetText(Finger81, Chr($20))
SetGadgetText(Finger80, Chr($261C)) ;der weisse Hinweis-Finger
EndIf
EndProcedure
Procedure Restoring() ;z.B. Rochade-Recht bei Zug vor/zurück
Debug "!!"
Debug FEN$
RochPos = FindString(FEN$, " ", 15) ;1.Leerzeichen vor Farbe am Zug 15 könnte man mal ausloten :-)
Rest$ = Mid(FEN$, RochPos + 3) ;Rochaden-Status
Debug Rest$
If FindString(Rest$, "K") ;vereinfachen?
KleinRochW = 1
Else
KleinRochW = 0
EndIf
If FindString(Rest$, "k")
KleinRochS = 1
Else
KleinRochS = 0
EndIf
If FindString(Rest$, "Q")
GrossRochW = 1
Else
GrossRochW = 0
EndIf
If FindString(Rest$, "q")
GrossRochS = 1
Else
GrossRochS = 0
EndIf
EndProcedure
Procedure.s DeziPoint(In$)
;Debug In$
Out$ = In$
LenIn = Len(In$)
;Debug LenIn
LenIn + 1
While LenIn > 4
LenIn - 3
;Debug LenIn
Out$ = InsertString(Out$, ".", LenIn)
;Debug Out$
Wend
ProcedureReturn Out$
EndProcedure
;=========================================================================
;Test Spieler=W - Prog=S
Repeat
Repeat
;Maus-Abfrage
Event = WaitWindowEvent(250)
If Event = #PB_Event_LeftClick
MX = WindowMouseX(0)
MY = WindowMouseY(0)
If MX >= 20 And MX <= 340
MX - 20
MX / 40
Maus_Linie = MX + 97 ;97="a"
If MY >= ORand And MY <= ORand + 320
MY - ORand
MY / 40
Maus_Reihe = 56 - MY ;56="8"
Pos = MX + (MY * 8) ;ist die Textgadget-Nr.
If Maus_AFeld$ = ""
Maus_AFeld$ = Chr(Maus_Linie) + Chr(Maus_Reihe)
Debug Maus_AFeld$
Debug Pos
SetGadgetColor(Pos, #PB_Gadget_BackColor, $FF00F0)
Else
Maus_ZFeld$ = Chr(Maus_Linie) + Chr(Maus_Reihe)
Debug Maus_ZFeld$
Debug Pos
SetGadgetColor(Pos, #PB_Gadget_BackColor, $FF00F0)
Zug$ = Maus_AFeld$ + Maus_ZFeld$
Break
EndIf
EndIf
EndIf
ElseIf Event = #PB_Event_CloseWindow
End
EndIf
ForEver
;Debug Zug$
Zug()
Maus_AFeld$ = "" ;frei für nächste Zug
FENString(?Stellung)
;Debug FEN$
WriteProgramStringN(Chessprog, "position fen " + FEN$, #PB_Ascii)
;WriteProgramStringN(Chessprog, "go movetime 5000", #PB_Ascii)
WriteProgramStringN(Chessprog, "go infinite", #PB_Ascii)
Repeat
Event = WindowEvent()
If Event = #PB_Event_LeftClick
MX = WindowMouseX(0)
MY = WindowMouseY(0)
If MX >= 20 And MX <= 45 And MY >= 10 And MY <= 35 ;Textgadget80
Break
EndIf
ElseIf Event = #PB_Event_CloseWindow
End
EndIf
If AvailableProgramOutput(Chessprog)
Ausgabe$ = ReadProgramString(Chessprog, #PB_Ascii)
;Debug Ausgabe$
; If FindString(Ausgabe$, "seld", 13)
If FindString(Ausgabe$, "sc", 13, #PB_String_NoCase) ;score
AddGadgetItem(120, Zeile, Ausgabe$)
Zeile + 1
SetActiveGadget(120)
;Debug Ausgabe$
EndIf
If FindString(Ausgabe$, "best") ;bestmove, könnte hier für Matt genutzt werden!
Break
EndIf
EndIf
;Until WindowEvent() = #PB_Event_CloseWindow ;Forever baut hier irgendwie Mist
ForEver
WriteProgramStringN(Chessprog, "stop", #PB_Ascii)
Repeat
If AvailableProgramOutput(Chessprog); = 0
Ausgabe$ = ReadProgramString(Chessprog, #PB_Ascii)
If FindString(Ausgabe$, "best", #PB_String_NoCase) ;bestmove
Debug Ausgabe$
AddGadgetItem(120, Zeile, Ausgabe$)
Zeile + 1
SetActiveGadget(120)
Break
EndIf
EndIf
;Until WindowEvent() = #PB_Event_CloseWindow
ForEver
Space_weg$ = RemoveString(Ausgabe$, " ") ;Leerzeichen entfernen
;Debug Space_weg$
LC_Space_weg$ = LCase(Space_weg$) ;in Kleinbuchstaben
;Debug LC_Space_weg$
Zug$ = Mid(LC_Space_weg$, 9, 4)
;Debug Zug$
;evtl. Umwandlung
If Len(LC_Space_weg$) > 12 ;z.B.wegen ponder, Umwandlungs-Figur
UFig = Asc(Mid(LC_Space_weg$, 13, 1)) ;UFig ist hier mehr ein Platzhalter!
;Debug Hex(UFig)
EndIf
Zug() ;Zug$ wird in Brett-Stellung geschrieben, auch Erweiterung bei echter Bauern-Umwandlung (dann 5-stellig)
ForEver
;=========================================================================
;Test COM
Port = OpenSerialPort(0, Port$, 9600, #PB_SerialPort_NoParity, 8, 1, #PB_SerialPort_NoHandshake, 1024, 1024)
If Port = 0
; MessageRequester("Information", "SerialPort opened with success")
;Else
MessageRequester("Fehler!", "Kann den Port " + Port$ + " nicht öffnen!")
EndIf
BufferR=AllocateMemory(1024) ;Lese-Buffer
BufferW=AllocateMemory(1024) ;Schreib-Puffer
;grundlegende Angaben
WriteProgramStringN(Chessprog, "uci", #PB_Ascii)
WriteProgramStringN(Chessprog, "setoption name threads value 8", #PB_Ascii)
WriteProgramStringN(Chessprog, "setoption name hash value 2048", #PB_Ascii)
;WriteProgramStringN(Chessprog, "setoption name ucinewgame", #PB_Ascii)
While AvailableProgramOutput(Chessprog) = 0
Ausgabe$ = ReadProgramString(Chessprog, #PB_Ascii)
AddGadgetItem(120, Zeile, "Engine: " + Ausgabe$)
Zeile + 1
Break
Wend
While ProgramRunning(Chessprog)
If Dran
;Debug FEN$
WriteProgramStringN(Chessprog, "position fen " + FEN$, #PB_Ascii)
WriteProgramStringN(Chessprog, "go movetime 5000", #PB_Ascii)
Repeat
If AvailableProgramOutput(Chessprog)
Ausgabe$ = ReadProgramString(Chessprog, #PB_Ascii)
;Debug Ausgabe$
; If FindString(Ausgabe$, "seld", 13)
If FindString(Ausgabe$, "sc", 13, #PB_String_NoCase) ;score
AddGadgetItem(120, Zeile, Ausgabe$)
Zeile + 1
SetActiveGadget(120)
Debug Ausgabe$
EndIf
If FindString(Ausgabe$, "best", #PB_String_NoCase) ;bestmove
Break
EndIf
EndIf
; Until WindowEvent() = #PB_Event_CloseWindow
If WindowEvent() = #PB_Event_CloseWindow
End
EndIf
ForEver
;Debug Ausgabe$
Space_weg$ = RemoveString(Ausgabe$, " ") ;Leerzeichen entfernen
;Debug Space_weg$
LC_Space_weg$ = LCase(Space_weg$) ;in Kleinbuchstaben
;Debug LC_Space_weg$
Zug$ = Mid(LC_Space_weg$, 9, 4)
;Debug Zug$
;evtl. Umwandlung
If Len(LC_Space_weg$) > 12 ;z.B.wegen ponder, Umwandlungs-Figur
UFig = Asc(Mid(LC_Space_weg$, 13, 1)) ;UFig ist hier mehr ein Platzhalter!
;Debug Hex(UFig)
EndIf
; WriteProgramStringN(chessprog, "ponderhit")
Zug() ;Zug$ wird in Brett-Stellung geschrieben, auch Erweiterung bei echter Bauern-Umwandlung (dann 5-stellig)
; FENString() ;wird gesendet
;Debug FEN$
Dran = 0
PokeB(BufferW, Len(Zug$)) ;Len=4 oder 5
WriteSerialPortData(0, BufferW, 1)
;Delay(10)
Ergebnis = WriteSerialPortString(0, Zug$, #PB_Ascii)
If Ergebnis <> Len(Zug$)
;Fehler
EndIf
;------------------------------------------------
Else
Repeat
If WindowEvent() = #PB_Event_CloseWindow
End
EndIf
;- Gegner-Zug
;While AvailableSerialPortInput(0) = 0
;ReadSerialPortData(0, BufferR, 1)
;Wend
If AvailableSerialPortInput(0)
ReadSerialPortData(0, BufferR, 1)
ZugLaenge = PeekB(BufferR)
For i = 0 To ZugLaenge - 1
ReadSerialPortData(0, BufferR + i, 1)
Next
; Zug$ = PeekS(BufferR, ZugLaenge, #PB_Ascii)
Zug$ = PeekS(BufferR, 4, #PB_Ascii) ;hier ohne evtl. Umwandlung, wird bei Zug() ermittelt
If ZugLaenge = 5
UFig = PeekB(BufferR + 4)
EndIf
; Zug$ = InputRequester("Zugeingabe", "Bitte machen Sie Ihre Eingabe:", "")
;If Zug$ = "stop" ;erstmal so
; Break
;EndIf
Zug()
FENString(?Stellung)
;Debug FEN$
Dran = 1
Break
EndIf
ForEver
EndIf
;-------
Wend
;WriteProgramStringN(chessprog, "ponderhit")
;WriteProgramStringN(chessprog, "go ponder", #PB_Ascii)
; While WaitWindowEvent() <> #PB_Event_CloseWindow : Wend
CloseSerialPort(0)
CloseProgram(Chessprog)
;==================================================================================================
DataSection
Stellung: ;hier erstmal Grundstellung
Data.b $72, $6e, $62, $71, $6b, $62, $6e, $72 ;0-7
Data.b $70, $70, $70, $70, $70, $70, $70, $70 ;8-15
Data.b $20, $20, $20, $20, $20, $20, $20, $20 ;16-23
Data.b $20, $20, $20, $20, $20, $20, $20, $20 ;24-31
Data.b $20, $20, $20, $20, $20, $20, $20, $20 ;32-39
Data.b $20, $20, $20, $20, $20, $20, $20, $20 ;40-47
Data.b $50, $50, $50, $50, $50, $50, $50, $50 ;48-55
Data.b $52, $4e, $42, $51, $4b, $42, $4e, $52 ;56-63
StellungEingabe: ;leeres Brett für Stellungseingabe
Data.b $20, $20, $20, $20, $20, $20, $20, $20 ;0-7
Data.b $20, $20, $20, $20, $20, $20, $20, $20 ;8-15
Data.b $20, $20, $20, $20, $20, $20, $20, $20 ;16-23
Data.b $20, $20, $20, $20, $20, $20, $20, $20 ;24-31
Data.b $20, $20, $20, $20, $20, $20, $20, $20 ;32-39
Data.b $20, $20, $20, $20, $20, $20, $20, $20 ;40-47
Data.b $20, $20, $20, $20, $20, $20, $20, $20 ;48-55
Data.b $20, $20, $20, $20, $20, $20, $20, $20 ;56-63
Figuren:
Data.w 9817, 9816, 9815, 9814, 9813, 9812 ;wB, wS, wL, wT, wD, wK
Data.w 9823, 9822, 9821, 9820, 9819, 9818 ;sB, sS, sL, sT, sD, sK
EndDataSection
infratec wrote:You have to run this in a thread and send your stuff to it (via structure parameter)Code: Select all
UCIProg = RunProgram("stockfish_10_x32", "", "",#PB_Program_Hide|#PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_UTF8) If UCIProg *OutBuffer = AllocateMemory(1024) If *OutBuffer WriteProgramStringN(UCIProg, "uci") While ProgramRunning(UCIProg) OutDataLen = AvailableProgramOutput(UCIProg) If OutDataLen OutDataReadLen = ReadProgramData(UCIProg, *OutBuffer, OutDataLen) If OutDataReadLen OutData$ + PeekS(*OutBuffer, OutDataReadLen, #PB_UTF8) Debug OutData$ Select OutState Case 0 If FindString(OutData$, "uciok") OutData$ = "" OutState = 1 Debug "OutState 1" WriteProgramStringN(UCIProg, "go") EndIf Case 1 ;WriteProgramStringN(UCIProg, "quit") EndSelect EndIf EndIf Delay(10) Wend FreeMemory(*OutBuffer) EndIf EndIf
How do you put the new parameters in there now? E.g. E2E4 ... answer E7E5Code: Select all
;
; http://download.shredderchess.com/div/uci.zip
;
CompilerIf Not #PB_Compiler_Thread
CompilerError "Enable Thread safe!"
CompilerEndIf
EnableExplicit
Enumeration #PB_Event_FirstCustomValue
#UCIEvent_Ready
#UCIEvent_Result
EndEnumeration
Structure UCIProgStructure
Thread.i
Mutex.i
Filename$
Ready.i
Comand$
Answer$
MoveTime.i
Exit.i
EndStructure
Procedure UCIThread(*Parameter.UCIProgStructure)
Protected.i UCIProg, OutDataLen, OutDataReadLen, OutState, Pos
Protected OutData$
Protected *OutBuffer
UCIProg = RunProgram(*Parameter\Filename$, "", "",#PB_Program_Hide|#PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_UTF8)
If UCIProg
*OutBuffer = AllocateMemory(10240)
If *OutBuffer
WriteProgramStringN(UCIProg, "uci")
While ProgramRunning(UCIProg)
OutDataLen = AvailableProgramOutput(UCIProg)
If OutDataLen
OutDataReadLen = ReadProgramData(UCIProg, *OutBuffer, OutDataLen)
If OutDataReadLen
OutData$ + PeekS(*OutBuffer, OutDataReadLen, #PB_UTF8)
Debug OutData$
Select OutState
Case 0
If FindString(OutData$, "uciok")
OutData$ = ""
OutState = 1
WriteProgramStringN(UCIProg, "isready")
EndIf
Case 1
If FindString(OutData$, "readyok")
OutData$ = ""
OutState = 2
PostEvent(#UCIEvent_Ready)
EndIf
Case 2
Pos = FindString(OutData$, "bestmove")
If Pos
*Parameter\Answer$ = Mid(OutData$, Pos + 9, 4)
OutData$ = ""
PostEvent(#UCIEvent_Result)
EndIf
EndSelect
EndIf
EndIf
If TryLockMutex(*Parameter\Mutex)
If *Parameter\Comand$ <> ""
*Parameter\Ready = #False
Debug *Parameter\Comand$
WriteProgramStringN(UCIProg, *Parameter\Comand$)
*Parameter\Comand$ = ""
EndIf
UnlockMutex(*Parameter\Mutex)
EndIf
If *Parameter\Exit
*Parameter\Exit = #False
WriteProgramStringN(UCIProg, "quit")
Debug "quit"
EndIf
Delay(10)
Wend
CloseProgram(UCIProg)
FreeMemory(*OutBuffer)
EndIf
EndIf
EndProcedure
Procedure UCISendCommand(*Parameter.UCIProgStructure, Command$)
LockMutex(*Parameter\Mutex)
*Parameter\Comand$ = Command$
UnlockMutex(*Parameter\Mutex)
EndProcedure
Define.i Exit, Event, GameState
Define Move$
Define Parameter.UCIProgStructure
Parameter\Mutex = CreateMutex()
Parameter\Filename$ = "stockfish_10_x32"
Parameter\Thread = CreateThread(@UCIThread(), @Parameter)
OpenWindow(0, 0, 0, 260, 80, "UCI", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
TextGadget(0, 10, 10, 50, 20, "Cmd:")
StringGadget(1, 70, 10, 50, 20, "")
ButtonGadget(2, 140, 10, 50, 20, "Ok")
TextGadget(3, 70, 40, 50, 20, "", #PB_Text_Center|#PB_Text_Border)
Repeat
Event = WaitWindowEvent()
Select Event
Case #UCIEvent_Ready
Select GameState
Case 0
UCISendCommand(@Parameter, "ucinewgame")
Move$ = ""
GameState + 1
Case 1
Case 2
EndSelect
Case #UCIEvent_Result
SetGadgetText(1, "")
SetGadgetText(3, Parameter\Answer$)
Move$ + " " + Parameter\Answer$
DisableGadget(2, #False)
Case #PB_Event_Gadget
Select EventGadget()
Case 2
If GetGadgetText(1) <> ""
Move$ + " " + GetGadgetText(1)
UCISendCommand(@Parameter, "position startpos moves" + Move$ + #LF$ + "go")
Else
UCISendCommand(@Parameter, "go")
EndIf
DisableGadget(2, #True)
EndSelect
Case #PB_Event_CloseWindow
Exit = #True
EndSelect
Until Exit
If IsThread(Parameter\Thread)
Parameter\Exit = #True
If WaitThread(Parameter\Thread, 3000) = 0
KillThread(Parameter\Thread)
Debug "UCI Killed! (should not happen)"
EndIf
EndIf
Code: Select all
Parameter\Filename$ = "C:\bs\stockfish-10-win\Windows\stockfish_10_x32.exe"