QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: SMcNeill on November 10, 2020, 11:28:39 pm

Title: Come try and play with my balls!
Post by: SMcNeill on November 10, 2020, 11:28:39 pm

Code: QB64: [Select]

1. TYPE Data_Transfer
2.     handle AS INTEGER
3.     x AS INTEGER
4.     y AS INTEGER
5.     color AS INTEGER
6. END TYPE
7.  
8. DIM SHARED Users(1 TO 10) AS Data_Transfer ' array to hold client info
9. DIM SHARED Info AS Data_Transfer
10. DIM SHARED b AS _BYTE, MyHandle AS INTEGER
11. DEFLNG A-Z
12. DIM SHARED Kolors(10) AS _UNSIGNED LONG
13.  
14.  
15.  
16. SCREEN _NEWIMAGE(800, 600, 32)
17. $COLOR:32
18. Kolors(1) = Red
19. Kolors(2) = Blue
20. Kolors(3) = Yellow
21. Kolors(4) = Green
22. Kolors(5) = Orange
23. Kolors(6) = Purple
24. Kolors(7) = White
25. Kolors(8) = Pink
26. Kolors(9) = Silver
27. Kolors(10) = Gold
28.  
29.  
30.  
31. _TITLE "[Block Wars Client]"
32. client = _OPENCLIENT("TCP/IP:7993:172.93.60.23")
33. IF client THEN
34.     DO
35.         GET #client, , Info
36.     LOOP UNTIL Info.color <> 0
37.     MyHandle = Info.color
38.     Users(MyHandle).handle = Info.handle
39.     Users(MyHandle).x = Info.x
40.     Users(MyHandle).y = Info.y
41.     Users(MyHandle).color = Info.color
42. ELSE
43.     PRINT "ERROR: Could not connect to Steve's PC!"
44.     END
45. END IF ' host
46.  
47.  
48. DO ' host main loop
49.  
50.     FOR i = 1 TO 10 'Get an update from where all the clients are at.
51.         b = 0
52.         GET #client, , b 'get the ok signal for transfer
53.         IF b = -1 THEN 'start transfer
54.             GET #client, , Users(i) 'then get the data
55.         END IF
56.     NEXT
57.  
58.  
59.     CLS
60.     FOR i = 1 TO 10
61.         IF Users(i).handle <> 0 AND Users(i).color > 0 AND Users(i).color < 11 THEN
62.             CircleFill Users(i).x, Users(i).y, 10, Kolors(Users(i).color)
63.         END IF
64.     NEXT
65.  
66.  
67.     IF _KEYDOWN(ASC("W")) OR _KEYDOWN(ASC("w")) THEN Users(MyHandle).y = Users(MyHandle).y - 3
68.     IF _KEYDOWN(ASC("A")) OR _KEYDOWN(ASC("a")) THEN Users(MyHandle).x = Users(MyHandle).x - 3
69.     IF _KEYDOWN(ASC("S")) OR _KEYDOWN(ASC("s")) THEN Users(MyHandle).y = Users(MyHandle).y + 3
70.     IF _KEYDOWN(ASC("D")) OR _KEYDOWN(ASC("d")) THEN Users(MyHandle).x = Users(MyHandle).x + 3
71.     IF _KEYDOWN(27) THEN SYSTEM
72.     _DISPLAY
73.  
74.     b = -1
75.     PUT #client, , b
76.     PUT #client, , Users(MyHandle)
77.  
78.  
79.     _LIMIT 300
80. LOOP
81.  
82. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
83.     ' CX = center x coordinate
84.     ' CY = center y coordinate
85.     '  R = radius
86.     '  C = fill color
87.     DIM Radius AS INTEGER, RadiusError AS INTEGER
88.     DIM X AS INTEGER, Y AS INTEGER
89.     Radius = ABS(R)
90.     RadiusError = -Radius
91.     X = Radius
92.     Y = 0
93.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
94.     LINE (CX - X, CY)-(CX + X, CY), C, BF
95.     WHILE X > Y
96.         RadiusError = RadiusError + Y * 2 + 1
97.         IF RadiusError >= 0 THEN
98.             IF X <> Y + 1 THEN
99.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
100.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
101.             END IF
102.             X = X - 1
103.             RadiusError = RadiusError - X * 2
104.         END IF
105.         Y = Y + 1
106.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
107.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
108.     WEND
109. END SUB
110.  

The start of a little game I was playing around with.  At the moment, up to 10 people can connect, and you can play with the little balls with the WASD keys and move them.

No chatting.
No collisions.
No error checking to see if you lose your ball off the screen.
No point to this really, except to have fun and experiment with sending/receiving data for a game, which I'll end up finishing when (if) I get more free time later...

The host is the red ball.  You guys can be one of the others.  The more people who log in, the more balls we can move at once!  LOL!

In all honestly, this is nothing more than a lag test to see how much lag might be generated as more than one player connects to the "game" and information has to be sent out to multiple parties, keeping them all in sync.  Feel free to stop by and wiggle your own personal balls on my screen for a while.  The more the merrier.  LOL!!

Title: Re: Come try and play with my balls!
Post by: SMcNeill on November 10, 2020, 11:47:33 pm

Scratch that.  My balls are still broken.  Folks on Discord popped in to help test the program, and it seems to work good here, but not anywhere else.  Debugging ensues, and the ball court is down for maintenance, at the moment.

Title: Re: Come try and play with my balls!
Post by: Pete on November 11, 2020, 03:18:12 am

While Steve scratches his balls, I'm working on some other text highlighting routines. Stay tuned.

Pete

Text Only | Text with Attachments