Author Topic: Come try and play with my balls!  (Read 1594 times)

0 Members and 1 Guest are viewing this topic.

Offline SMcNeill

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

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!!
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Come try and play with my balls!
« Reply #1 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.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Come try and play with my balls!
« Reply #2 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
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/