Found it.
But it sends the 'whole' board via UDP.
The code is not from me, it is from a former trainee.
Code: Select all
EnableExplicit
Enumeration
#playground
EndEnumeration
Enumeration #PB_Event_FirstCustomValue
#Network_DataReceived
EndEnumeration
Structure ThreadParameter
Thread.i
Exit.i
Port.i
Semaphore.i
Active.i
*RxDBuffer
EndStructure
Procedure.i dropStone(xstart,playerNumber,playground,Start)
Static y
Protected x, Result, playerColor
If playerNumber = 0
playerColor = #Yellow
Else
playerColor = #Red
EndIf
If StartDrawing(CanvasOutput(#playground))
x = ((xstart - 50) / 100 + 1) * 100
If Start
y = 100
If Point(xstart, y) <> #White
Result = 2
EndIf
EndIf
If Not Result
If Point(x, y) = #White
FillArea(x, y, -1, playerColor)
If Y > 100
FillArea(x, y - 100, -1, #White)
EndIf
y + 100
If y = 700 Or Point(x, y) <> #White
Result = 1
EndIf
EndIf
EndIf
StopDrawing()
EndIf
;Debug "Drop Y: " + Str(y)
ProcedureReturn Result
EndProcedure
Procedure checkForWin(Array PlayGroundArr.a(2))
Protected Result, x, y, counter, countingColor = #White, stoneColor = #White, i
If StartDrawing(CanvasOutput(#playground))
; check lines
For y = 1 To 6
For x = 1 To 7
stoneColor = Point(100 * x, 100 * y)
If stoneColor = #Red Or stoneColor = #Yellow
If countingColor = stoneColor
counter + 1
Else
countingColor = stoneColor
counter = 1
EndIf
EndIf
If counter = 4
For i = x - 3 To x
FillArea(i * 100, y * 100, -1, #Green)
Next i
Result = #True
Break 2
EndIf
Next x
Next y
If Not Result
counter = 0
; check columnes
For x = 1 To 7
For y = 1 To 6
stoneColor = Point(100 * x, 100 * y)
If stoneColor = #Red Or stoneColor = #Yellow
If countingColor = stoneColor
counter + 1
Else
countingColor = stoneColor
counter = 1
EndIf
EndIf
If counter = 4
For i = y - 3 To y
FillArea(x * 100, i * 100, -1, #Green)
Next i
Result = #True
Break 2
EndIf
Next y
Next x
EndIf
; checkDiagonal
; For y = 1 To 7
; For x = 1 To 6
; If Point(100 * x, 100 * y) = #White
;
; EndIf
; Next x
; Next y
For y = 1 To 6
For x = 1 To 7
stoneColor = Point(100 * x, 100 * y)
Select stoneColor
Case #White : stoneColor = 0
Case #Red : stoneColor = 1
Case #Yellow : stoneColor = 2
Case #Green : stoneColor = 3
EndSelect
PlayGroundArr(x - 1, y - 1) = stoneColor
Next x
Next y
StopDrawing()
EndIf
ProcedureReturn Result
EndProcedure
Procedure UDPServer(*Parameter.ThreadParameter)
Protected RxDLen, Client
If CreateNetworkServer(0, *Parameter\Port, #PB_Network_UDP)
*Parameter\RxDBuffer = AllocateMemory(100)
If *Parameter\RxDBuffer
Repeat
Select NetworkServerEvent()
Case #PB_NetworkEvent_None
Delay(10)
Case #PB_NetworkEvent_Data
Client = EventClient()
RxDLen = ReceiveNetworkData(Client, *Parameter\RxDBuffer, MemorySize(*Parameter\RxDBuffer))
If RxDLen = 42
;MessageRequester("Info", "bin da")
PostEvent(#Network_DataReceived)
WaitSemaphore(*Parameter\Semaphore)
EndIf
EndSelect
Until *Parameter\Exit
FreeMemory(*Parameter\RxDBuffer)
EndIf
EndIf
EndProcedure
;Main
Define playerOneTurn, Timer, DropActive, DropStart, DropResult, Index, i, Byte, con
Define exit, event, Col, x, y
Define PartnerIP$
Define Parameter.ThreadParameter
Dim PlayGroundArr.a(6, 5)
InitNetwork()
PartnerIP$ = InputRequester("Partner IP", "Bitte geben sie die IP Adresse des Partners ein.", "")
Parameter\Port = 4444
Parameter\Semaphore = CreateSemaphore()
Parameter\Thread = CreateThread(@UDPServer(), @Parameter)
OpenWindow(0,0,0,820,720,"Vier Gewinnt", #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered)
CanvasGadget(#playground, 10, 10, 800, 700)
If StartDrawing(CanvasOutput(#playground))
Box(0, 0, 800, 700, $FF0000)
For x = 1 To 7
For y = 1 To 6
Circle(100 * x, 100 * y, 40, #White)
Next y
Next x
StopDrawing()
EndIf
Repeat
event = WaitWindowEvent()
Select Event
Case #Network_DataReceived
CopyMemory(Parameter\RxDBuffer, @PlayGroundArr(0, 0), 42)
If StartDrawing(CanvasOutput(#playground))
For y = 1 To 6
For x = 1 To 7
Byte = PlayGroundArr(x - 1, y - 1)
;Debug Str(x) + "/" + Str(y) + ": " + Str(byte)
Select Byte
Case 0 : FillArea(100 * x, 100 * y, -1, #White)
Case 1 : FillArea(100 * x, 100 * y, -1, #Red)
Case 2 : FillArea(100 * x, 100 * y, -1, #Yellow)
Case 3 : FillArea(100 * x, 100 * y, -1, #Green)
EndSelect
Next x
Next y
StopDrawing()
EndIf
Parameter\Active = #True
DropActive = #False
SignalSemaphore(Parameter\Semaphore)
Case #PB_Event_Timer
If EventTimer() = 1
If PartnerIP$ <> "" And Not Parameter\Active And DropStart
playerOneTurn = ~playerOneTurn
Parameter\Active = #True
EndIf
Debug playerOneTurn
DropResult = dropStone(x,playerOneTurn,#playground,DropStart)
If DropResult > 0
RemoveWindowTimer(0, 1)
DropActive = #False
If DropResult = 1
If checkForWin(PlayGroundArr())
;MessageRequester("Gewonnen", "Gewonnen!")
EndIf
If PartnerIP$ <> ""
con = OpenNetworkConnection(PartnerIP$, 4444, #PB_Network_UDP)
If con
SendNetworkData(Con, @PlayGroundArr(0, 0), 42)
CloseNetworkConnection(con)
EndIf
EndIf
If Parameter\Active
DropActive = #True
Else
playerOneTurn = ~playerOneTurn
DropActive = #False
EndIf
EndIf
Else
DropActive = #True
EndIf
DropStart = #False
EndIf
Case #PB_Event_Gadget
Select EventGadget()
Case #playground
If EventType() = #PB_EventType_LeftClick
If Not DropActive
x = GetGadgetAttribute(#playground, #PB_Canvas_MouseX)
DropStart = #True
AddWindowTimer(0, 1, 100)
EndIf
EndIf
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)
EndIf
EndIf
FreeSemaphore(Parameter\Semaphore)
.
