QB64.org Forum

Active Forums => Programs => Topic started by: FellippeHeitor on October 18, 2020, 11:43:54 am

Title: Pretentious not-yet-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 18, 2020, 11:43:54 am

Watch as I talk about Among Us while writing something that vaguely resembles a player moving around a map.

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. RANDOMIZE TIMER
3. SCREEN _NEWIMAGE(1000, 800, 32)
4.  
5. TYPE object
6.     x AS SINGLE
7.     y AS SINGLE
8. END TYPE
9.  
10. DIM SHARED player AS object
11. DIM SHARED camera AS object
12. DIM SHARED map AS LONG
13. DIM playerSpeed AS SINGLE
14. DIM i AS LONG
15.  
16. map = _NEWIMAGE(_WIDTH * 3, _HEIGHT * 2, 32)
17. _DEST map
18. FOR i = 1 TO 50
19.     CircleFill _WIDTH * RND, _HEIGHT * RND, 1000 * RND, _RGB32(255 * RND, 255 * RND, 255 * RND, 255 * RND)
20. NEXT
21. _DEST 0
22.  
23. player.x = _WIDTH / 2
24. player.y = _HEIGHT / 2
25.  
26. playerSpeed = 5
27.  
28. CONST keyUP = 18432
29. CONST keyDOWN = 20480
30. CONST keyLEFT = 19200
31. CONST keyRIGHT = 19712
32.  
33. DO
34.     IF _KEYDOWN(keyUP) THEN player.y = player.y - playerSpeed
35.     IF _KEYDOWN(keyDOWN) THEN player.y = player.y + playerSpeed
36.     IF _KEYDOWN(keyLEFT) THEN player.x = player.x - playerSpeed
37.     IF _KEYDOWN(keyRIGHT) THEN player.x = player.x + playerSpeed
38.  
39.     IF player.x < 0 THEN player.x = 0
40.     IF player.x > _WIDTH(map) THEN player.x = _WIDTH(map)
41.     IF player.y < 0 THEN player.y = 0
42.     IF player.y > _HEIGHT(map) THEN player.y = _HEIGHT(map)
43.  
44.     adjustCamera
45.     CLS
46.     _PUTIMAGE (camera.x, camera.y), map
47.  
48.     CircleFill player.x + camera.x, player.y + camera.y, 20, _RGB32(255)
49.     _DISPLAY
50.     _LIMIT 60
51. LOOP
52.  
53. SUB adjustCamera
54.     IF player.x + camera.x > _WIDTH / 2 OR player.x + camera.x < _WIDTH / 2 THEN
55.         camera.x = _WIDTH / 2 - player.x
56.     END IF
57.     IF camera.x > 0 THEN camera.x = 0
58.     IF camera.x < -(_WIDTH(map) - _WIDTH) THEN camera.x = -(_WIDTH(map) - _WIDTH)
59.  
60.     IF player.y + camera.y > _HEIGHT / 2 OR player.y + camera.y < _HEIGHT / 2 THEN
61.         camera.y = _HEIGHT / 2 - player.y
62.     END IF
63.     IF camera.y > 0 THEN camera.y = 0
64.     IF camera.y < -(_HEIGHT(map) - _HEIGHT) THEN camera.y = -(_HEIGHT(map) - _HEIGHT)
65. END SUB
66.  
67. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
68.     ' CX = center x coordinate
69.     ' CY = center y coordinate
70.     '  R = radius
71.     '  C = fill color
72.     DIM Radius AS INTEGER, RadiusError AS INTEGER
73.     DIM X AS INTEGER, Y AS INTEGER
74.     Radius = ABS(R)
75.     RadiusError = -Radius
76.     X = Radius
77.     Y = 0
78.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
79.     LINE (CX - X, CY)-(CX + X, CY), C, BF
80.     WHILE X > Y
81.         RadiusError = RadiusError + Y * 2 + 1
82.         IF RadiusError >= 0 THEN
83.             IF X <> Y + 1 THEN
84.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
85.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
86.             END IF
87.             X = X - 1
88.             RadiusError = RadiusError - X * 2
89.         END IF
90.         Y = Y + 1
91.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
92.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
93.     WEND
94. END SUB

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: Dav on October 18, 2020, 04:03:50 pm

Lol.  Thanks for leaving in the blooper.  I needed a laugh.. 

- Dav

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: bplus on October 18, 2020, 04:43:59 pm

Wow just add image of a map and player is walking around map, nice!

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 19, 2020, 04:29:25 pm

@Dav glad it was entertaining!

@bplus the illusion is the key, thanks for checking it out!

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 20, 2020, 12:53:07 pm

Run this and choose "Connect to server" - arbitrarily limited to 10 simultaneous "players" for now.

It's the map+player code of the first post, with networking added. Still not a game, but you can see other players in real time, which is cool.

If you have trouble connecting to 98.29.249.134 (kindly hosted by SpriggsySprigs in the US), replace that on line 97 with alephc.xyz (kindly hosted by Luke in Australia).

Code: QB64: [Select]

1. OPTION _EXPLICIT
2.  
3. $LET DEBUGGING = FALSE
4. $IF DEBUGGING = TRUE THEN
5.     $CONSOLE
6. $END IF
7.  
8. CONST True = -1, False = 0
9. CONST mode_freeplay = 0
10. CONST mode_localhost = 1
11. CONST mode_localclient = 2
12. CONST mode_onlinehost = 3
13. CONST mode_onlineclient = 4
14.  
15. TYPE object
16.     name AS STRING
17.     handle AS LONG
18.     x AS SINGLE
19.     y AS SINGLE
20.     state AS INTEGER
21.     color AS INTEGER
22.     basicInfoSent AS _BYTE
23.     ping AS SINGLE
24. END TYPE
25.  
26. DIM SHARED mode AS INTEGER
27. DIM SHARED totalClients AS INTEGER
28. DIM SHARED playerStream(1 TO 10) AS STRING
29. DIM SHARED serverStream AS STRING
30. DIM SHARED player(1 TO 10) AS object, me AS INTEGER
31. DIM SHARED colors(1 TO 15) AS _UNSIGNED LONG, r AS INTEGER, g AS INTEGER, b AS INTEGER
32. DIM SHARED warning(1 TO 30) AS object
33. DIM idSet AS _BYTE
34. DIM i AS LONG, j AS LONG
35. DIM newClient AS LONG
36. DIM serverPing AS SINGLE
37. DIM key$, value$
38.  
39. DIM SHARED endSignal AS STRING
40. endSignal = "<" + CHR$(254) + ">"
41.  
42. vgaPalette:
43. DATA 0,0,170
44. DATA 0,170,0
45. DATA 0,170,170
46. DATA 170,0,0
47. DATA 170,0,170
48. DATA 170,85,0
49. DATA 170,170,170
50. DATA 85,85,85
51. DATA 85,85,255
52. DATA 85,255,85
53. DATA 85,255,255
54. DATA 255,85,85
55. DATA 255,85,255
56. DATA 255,255,85
57. DATA 255,255,255
58.  
59. RESTORE vgaPalette
60. FOR i = 1 TO 15
61.     READ r%, g%, b%
62.     colors(i) = _RGB32(r%, g%, b%)
63. NEXT
64.  
65. CONST timeout = 30
66. DIM userName$, userColor%
67. INPUT "Name: ", userName$
68. DO
69.     INPUT "Color (1-15): ", userColor%
70. LOOP WHILE userColor% < 1 OR userColor% > 15
71.  
72. DO
73.     COLOR 15
74.     PRINT "-------------------------"
75.     PRINT "(1) Free play"
76.     PRINT "(2) Connect to server"
77.  
78.     DIM choice AS STRING
79.     DO
80.         choice = INKEY$
81.         _LIMIT 30
82.     LOOP UNTIL choice >= "1" AND choice <= "5"
83.  
84.     DIM SHARED server AS object, host AS LONG
85.     DIM c AS INTEGER, attempt AS INTEGER
86.     CONST maxAttempts = 100
87.     SELECT CASE VAL(choice)
88.         CASE 1
89.             EXIT DO
90.         CASE 2
91.             COLOR 7
92.             PRINT "Attempting to connect to local host... ";
93.             r = CSRLIN: c = POS(1)
94.             attempt = 0
95.             DO
96.                 server.handle = 0
97.                 server.handle = _OPENCLIENT("TCP/IP:51512:98.29.249.134")
98.                 IF server.handle THEN EXIT DO
99.                 attempt = attempt + 1
100.                 LOCATE r, c: PRINT USING "###%"; (attempt / maxAttempts) * 100;
101.                 _LIMIT 30
102.             LOOP WHILE attempt < 100
103.             IF server.handle THEN serverPing = TIMER: mode = mode_localclient: EXIT DO
104.             PRINT: COLOR 14: PRINT "/\ ";: COLOR 12
105.             PRINT "Failed to connect to local host."
106.             CLOSE server.handle
107.     END SELECT
108. LOOP
109.  
110. SCREEN _NEWIMAGE(800, 600, 32)
111. _FONT 8
112. _PRINTMODE _KEEPBACKGROUND
113.  
114. DIM SHARED playerSpeed AS SINGLE
115. DIM SHARED map AS LONG
116. DIM SHARED camera AS object
117.  
118. map = _NEWIMAGE(_WIDTH * 3, _HEIGHT * 2, 32)
119. _DEST map
120. RANDOMIZE 6
121. FOR i = 1 TO 50
122.     CircleFill RND * _WIDTH, RND * _HEIGHT, RND * 1000, _RGB32(RND * 255, RND * 255, RND * 255, RND * 150)
123. NEXT
124. _DEST 0
125. RANDOMIZE TIMER
126.  
127. CONST keyUP = 18432
128. CONST keyDOWN = 20480
129. CONST keyLEFT = 19200
130. CONST keyRIGHT = 19712
131. CONST keyLSHIFT = 100304
132. CONST keyRSHIFT = 100303
133.  
134. CONST cameraWindow = 100
135.  
136. CONST minSpeed = 3
137. CONST maxSpeed = 5
138.  
139. playerSpeed = maxSpeed
140.  
141. IF mode > 1 THEN
142.     idSet = False
143. ELSE
144.     idSet = True
145.     me = 1
146.     player(me).name = userName$
147.     player(me).x = _WIDTH / 2 + COS(RND * _PI) * (RND * 100)
148.     player(me).y = _HEIGHT / 2 + SIN(RND * _PI) * (RND * 100)
149.     player(me).state = True
150.     player(me).color = userColor%
151. END IF
152. DO
153.     SELECT CASE mode
154.         CASE mode_localhost
155.             'check for new connections (unless already at max)
156.             IF idSet = False THEN
157.                 idSet = True
158.                 me = 1
159.                 player(me).name = userName$
160.                 player(me).x = _WIDTH / 2 + COS(RND * _PI) * (RND * 100)
161.                 player(me).y = _HEIGHT / 2 + SIN(RND * _PI) * (RND * 100)
162.                 player(me).state = True
163.                 player(me).color = userColor%
164.             END IF
165.  
166.             IF totalClients < UBOUND(player) THEN
167.                 newClient = 0
168.                 newClient = _OPENCONNECTION(host)
169.                 IF newClient THEN
170.                     totalClients = totalClients + 1
171.                     FOR i = 1 TO UBOUND(player)
172.                         IF player(i).state = False THEN
173.                             player(i).color = 0
174.                             player(i).handle = newClient
175.                             player(i).state = True
176.                             sendData player(i), "ID", MKI$(i)
177.                             player(i).ping = TIMER
178.                             EXIT FOR
179.                         END IF
180.                     NEXT
181.                 END IF
182.             END IF
183.  
184.             FOR i = 1 TO UBOUND(player)
185.                 IF player(i).state = False OR i = me THEN _CONTINUE
186.                 IF TIMER - player(i).ping > timeout THEN
187.                     'player inactive
188.                     player(i).state = False
189.                     CLOSE player(i).handle
190.                     addWarning player(i).name + " lost connection."
191.                     totalClients = totalClients - 1
192.                     _CONTINUE
193.                 END IF
194.  
195.                 getData player(i), playerStream(i)
196.  
197.                 DO WHILE parse(playerStream(i), key$, value$)
198.                     player(i).ping = TIMER
199.                     SELECT CASE key$
200.                         CASE "NAME"
201.                             player(i).name = value$
202.                         CASE "COLOR" 'received once per player
203.                             DIM newcolor AS INTEGER, changed AS _BYTE
204.                             newcolor = CVI(value$)
205.                             changed = False
206.                             'check if this color is already in use, so a random one can be assigned
207.                             FOR j = 1 TO UBOUND(player)
208.                                 IF player(j).state = True AND player(j).color = newcolor THEN
209.                                     newcolor = newcolor + 1
210.                                     IF newcolor > UBOUND(colors) THEN newcolor = 1
211.                                     changed = True
212.                                     j = 0 'check again
213.                                 END IF
214.                             NEXT
215.                             player(i).color = newcolor
216.                             IF changed THEN
217.                                 sendData player(i), "COLOR", MKI$(newcolor)
218.                             END IF
219.                         CASE "POS"
220.                             player(i).x = CVI(LEFT$(value$, 2))
221.                             player(i).y = CVI(RIGHT$(value$, 2))
222.                     END SELECT
223.                 LOOP
224.  
225.                 'send ping
226.                 sendData player(i), "PING", ""
227.  
228.                 'send all players' data
229.                 FOR j = 1 TO UBOUND(player)
230.                     IF j = i THEN _CONTINUE
231.                     IF player(j).state = True THEN
232.                         sendData player(i), "PLAYERCOLOR", MKI$(j) + MKI$(player(j).color)
233.                         sendData player(i), "PLAYERPOS", MKI$(j) + MKS$(player(j).x) + MKS$(player(j).y)
234.                         sendData player(i), "PLAYERNAME", MKI$(j) + player(j).name
235.                     ELSE
236.                         sendData player(i), "PLAYEROFFLINE", MKI$(j)
237.                     END IF
238.                 NEXT
239.             NEXT
240.  
241.         CASE mode_localclient, mode_onlineclient
242.             IF idSet THEN
243.                 IF player(me).basicInfoSent = False THEN
244.                     player(me).basicInfoSent = True
245.                     sendData server, "COLOR", MKI$(player(me).color)
246.                     sendData server, "NAME", player(me).name
247.                 END IF
248.  
249.                 sendData server, "POS", MKI$(player(me).x) + MKI$(player(me).y)
250.             END IF
251.  
252.             getData server, serverStream
253.             DO WHILE parse(serverStream, key$, value$)
254.                 SELECT CASE key$
255.                     CASE "ID" 'first info sent by server
256.                         idSet = True
257.                         me = CVI(value$)
258.                         player(me).name = userName$
259.                         player(me).x = _WIDTH / 2 + COS(RND * _PI) * (RND * 100)
260.                         player(me).y = _HEIGHT / 2 + SIN(RND * _PI) * (RND * 100)
261.                         player(me).state = True
262.                         player(me).color = userColor%
263.                     CASE "COLOR" 'server color changes must always be applied
264.                         player(me).color = CVI(value$)
265.                     CASE "PLAYERCOLOR"
266.                         player(CVI(LEFT$(value$, 2))).color = CVI(RIGHT$(value$, 2))
267.                     CASE "PLAYERPOS"
268.                         player(CVI(LEFT$(value$, 2))).state = True
269.                         player(CVI(LEFT$(value$, 2))).ping = TIMER
270.                         player(CVI(LEFT$(value$, 2))).x = CVS(MID$(value$, 3, 4))
271.                         player(CVI(LEFT$(value$, 2))).y = CVS(RIGHT$(value$, 4))
272.                     CASE "PLAYERNAME"
273.                         player(CVI(LEFT$(value$, 2))).name = MID$(value$, 3)
274.                     CASE "PLAYEROFFLINE"
275.                         IF player(CVI(value$)).state = True THEN
276.                             player(CVI(value$)).state = False
277.                             addWarning player(CVI(value$)).name + " left the game."
278.                         END IF
279.                     CASE "PING"
280.                         serverPing = TIMER
281.                 END SELECT
282.             LOOP
283.     END SELECT
284.  
285.     IF playerSpeed < minSpeed THEN playerSpeed = minSpeed
286.     IF playerSpeed > maxSpeed THEN playerSpeed = maxSpeed
287.  
288.     IF idSet THEN
289.         IF _KEYDOWN(keyUP) THEN player(me).y = player(me).y - playerSpeed
290.         IF _KEYDOWN(keyDOWN) THEN player(me).y = player(me).y + playerSpeed
291.         IF _KEYDOWN(keyLEFT) THEN player(me).x = player(me).x - playerSpeed
292.         IF _KEYDOWN(keyRIGHT) THEN player(me).x = player(me).x + playerSpeed
293.  
294.         IF player(me).x < 0 THEN player(me).x = 0
295.         IF player(me).y < 0 THEN player(me).y = 0
296.         IF player(me).x > _WIDTH(map) THEN player(me).x = _WIDTH(map)
297.         IF player(me).y > _HEIGHT(map) THEN player(me).y = _HEIGHT(map)
298.  
299.         adjustCamera
300.     END IF
301.  
302.     CLS
303.  
304.     DIM shipFlotation AS SINGLE, shipFloatIntensity AS SINGLE
305.     shipFlotation = shipFlotation + .05
306.     IF shipFlotation > _PI(2) THEN shipFlotation = shipFlotation - _PI(2)
307.     shipFloatIntensity = 1.5
308.  
309.     _DONTBLEND
310.     _PUTIMAGE (camera.x + COS(shipFlotation) * shipFloatIntensity, camera.y + SIN(shipFlotation) * shipFloatIntensity), map
311.     _BLEND
312.  
313.     IF (mode = mode_localclient OR mode = mode_onlineclient) THEN
314.         IF TIMER - serverPing > timeout THEN
315.             SCREEN 0
316.             PRINT: COLOR 14: PRINT "/\ ";: COLOR 12
317.             PRINT "Disconnected from host."
318.             END
319.         ELSE
320.             PRINT USING "###ms"; ((TIMER - serverPing) - FIX(TIMER - serverPing)) * 1000;
321.         END IF
322.     END IF
323.  
324.     DIM x AS SINGLE, y AS SINGLE
325.     FOR i = 1 TO UBOUND(player)
326.         IF player(i).state = False OR player(i).color = 0 THEN _CONTINUE
327.         x = player(i).x + camera.x + COS(shipFlotation) * shipFloatIntensity
328.         y = player(i).y + camera.y + SIN(shipFlotation) * shipFloatIntensity
329.         CircleFill x, y + 6, 15, _RGB32(0, 50)
330.         CircleFill x, y, 15, _RGB32(0)
331.         CircleFill x, y, 10, colors(player(i).color)
332.         COLOR _RGB32(0)
333.         _PRINTSTRING (1 + x - _PRINTWIDTH(player(i).name) / 2, 1 + y - 20), player(i).name
334.         COLOR _RGB32(255)
335.         _PRINTSTRING (x - _PRINTWIDTH(player(i).name) / 2, y - 20), player(i).name
336.     NEXT
337.     'LINE (_WIDTH / 2 - cameraWindow, _HEIGHT / 2 - cameraWindow)-STEP(cameraWindow * 2, cameraWindow * 2), , B
338.  
339.     'display warnings
340.     FOR i = 1 TO UBOUND(warning)
341.         COLOR _RGB32(128, 50, 22)
342.         IF warning(i).state = True THEN
343.             _PRINTSTRING (10, _HEIGHT / 2 + _FONTHEIGHT * i), warning(i).name
344.             IF TIMER - warning(i).ping > 2 THEN warning(i).state = False
345.         END IF
346.     NEXT
347.  
348.     _DISPLAY
349.     _LIMIT 60
350. LOOP UNTIL _KEYHIT = 27
351. CLOSE
352. SYSTEM
353.  
354. SUB addWarning (text$)
355.     DIM i AS INTEGER
356.     FOR i = 1 TO UBOUND(warning)
357.         IF warning(i).state = False THEN
358.             warning(i).state = True
359.             warning(i).name = text$
360.             warning(i).ping = TIMER
361.             EXIT FOR
362.         END IF
363.     NEXT
364. END SUB
365.  
366. SUB sendData (client AS object, id$, value$)
367.     DIM key$
368.     key$ = id$ + ">" + value$ + endSignal
369.     PUT #client.handle, , key$
370. END SUB
371.  
372. SUB getData (client AS object, buffer AS STRING)
373.     DIM incoming$
374.     GET #client.handle, , incoming$
375.     buffer = buffer + incoming$
376. END SUB
377.  
378. FUNCTION parse%% (buffer AS STRING, key$, value$)
379.     DIM endMarker AS LONG
380.     endMarker = INSTR(buffer, endSignal)
381.     IF endMarker THEN
382.         key$ = LEFT$(buffer, endMarker - 1)
383.         buffer = MID$(buffer, endMarker + LEN(endSignal))
384.         endMarker = INSTR(key$, ">")
385.         value$ = MID$(key$, endMarker + 1)
386.         key$ = LEFT$(key$, endMarker - 1)
387.         parse%% = True
388.     END IF
389. END FUNCTION
390.  
391. SUB adjustCamera
392.     IF player(me).x + camera.x > _WIDTH / 2 + cameraWindow THEN
393.         camera.x = _WIDTH / 2 - player(me).x + cameraWindow
394.     ELSEIF player(me).x + camera.x < _WIDTH / 2 - cameraWindow THEN
395.         camera.x = _WIDTH / 2 - player(me).x - cameraWindow
396.     END IF
397.     IF camera.x > 0 THEN camera.x = 0
398.     IF camera.x < -(_WIDTH(map) - _WIDTH) THEN camera.x = -(_WIDTH(map) - _WIDTH)
399.  
400.     IF player(me).y + camera.y > _HEIGHT / 2 + cameraWindow THEN
401.         camera.y = _HEIGHT / 2 - player(me).y + cameraWindow
402.     ELSEIF player(me).y + camera.y < _HEIGHT / 2 - cameraWindow THEN
403.         camera.y = _HEIGHT / 2 - player(me).y - cameraWindow
404.     END IF
405.     IF camera.y > 0 THEN camera.y = 0
406.     IF camera.y < -(_HEIGHT(map) - _HEIGHT) THEN camera.y = -(_HEIGHT(map) - _HEIGHT)
407. END SUB
408.  
409.  
410. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
411.     ' CX = center x coordinate
412.     ' CY = center y coordinate
413.     '  R = radius
414.     '  C = fill color
415.     DIM Radius AS INTEGER, RadiusError AS INTEGER
416.     DIM X AS INTEGER, Y AS INTEGER
417.     Radius = ABS(R)
418.     RadiusError = -Radius
419.     X = Radius
420.     Y = 0
421.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
422.     LINE (CX - X, CY)-(CX + X, CY), C, BF
423.     WHILE X > Y
424.         RadiusError = RadiusError + Y * 2 + 1
425.         IF RadiusError >= 0 THEN
426.             IF X <> Y + 1 THEN
427.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
428.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
429.             END IF
430.             X = X - 1
431.             RadiusError = RadiusError - X * 2
432.         END IF
433.         Y = Y + 1
434.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
435.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
436.     WEND
437. END SUB
438.  
439. SUB db (text$)
440.     $IF DEBUGGING = TRUE THEN
441.         _ECHO text$
442.     $ELSE
443.         DIM dummy$
444.         dummy$ = text$
445.     $END IF
446. END SUB

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: Rubidium on October 20, 2020, 05:16:44 pm

Impressive! do you have the code for the server as well? I'd like to try playing around with it :D

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 20, 2020, 05:29:17 pm

It's all included above, actually!

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: Rubidium on October 20, 2020, 06:09:22 pm

Really cool. With some messenger features and a few collision objects, a lot of kids could get so into this! -for getting into qb64- :D

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 21, 2020, 01:08:11 pm

True! I'm hoping to turn it into a real game soon.

If anyone decides to try the room and eventually finds no one currently logged in, just open two instances of the code above to see two instances of yourself running around.

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: SierraKen on October 21, 2020, 04:04:11 pm

This is great Felippe! I've been wondering how to do this for awhile. I'll try to learn it. I might also drop the CHR$(0) and inkey$ I use for the arrow keys, yours probably works better. Someone could make a really great dungeon type game this way. Thanks!

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 21, 2020, 04:08:07 pm

Thanks, Ken! Glad you enjoyed it.

Did you have luck joining either server? They've both been up since yesterday.

The advantage of using _KEYDOWN for character movement is that all directions can coexist simultaneously and there's no buffer. Once released, the keys immediately stop coming.

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: SierraKen on October 21, 2020, 05:33:55 pm

LOL I see you! I wonder if we can add chat to it? Like text over your nickname.

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 21, 2020, 05:34:35 pm

I'll be implementing chat soon, but for now there's no length limit for player name - it's a rudimentary messaging system as is!

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: Dav on October 21, 2020, 05:55:40 pm

Works for me.  Connected as is.  Code is so easy to understand. What a great learning example. 

- Dav 

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 21, 2020, 05:57:39 pm

Damn, I missed you! Australia or US?

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: Dav on October 21, 2020, 05:58:28 pm

US (North Carolina).

Edit: I saw you there.  I just wandered around a while and left.

- Dav

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 21, 2020, 06:01:35 pm

Glad to see you around!

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: johnno56 on October 21, 2020, 06:41:52 pm

This concept (A background larger than the main window) reminded me of the game Agario (homework...) but this method could easily be used for a 'space shooter'. Instead of a circular player; a ship. Instead of random circles; a star-field....

You did an excellent job in explaining everything... even 'I' could understand it... lol

Well done!

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: SierraKen on October 21, 2020, 10:07:18 pm

Felippe, I'm working on a game right now using your code. But I need help detecting colors on the map. I can't seem to figure out the coordinates to use with the POINT command when your guy goes over a certain color. I have deleted my attempts at the code. I've even tried specific variable detection but the problem is, the camera variable goes into negative numbers and the player.x and player.y variables only change when the map stops moving and your guy moves. I'm not sure what to use. Here is the game I have so far. You have to find the GOLD bar and then I want it to go to the next level. Instead of all circles I use filled-in squares and blue circular lakes. Plus I made the map 8x so it's fairly big. It might take a couple of seconds to load from the black screen. I'm using your first code you posted on this thread, not the one with Internet access.

Code: QB64: [Select]

1.  
2. RANDOMIZE TIMER
3. SCREEN _NEWIMAGE(1000, 800, 32)
4.  
5. TYPE object
6.     x AS SINGLE
7.     y AS SINGLE
8. END TYPE
9.  
10. DIM SHARED player AS object
11. DIM SHARED camera AS object
12. DIM SHARED map AS LONG
13. DIM playerSpeed AS SINGLE
14.  
15. start:
16. player.x = _WIDTH / 2
17. player.y = _HEIGHT / 2
18.  
19. map = _NEWIMAGE(_WIDTH * 7, _HEIGHT * 7, 32)
20. _DEST map
21. PAINT (2, 2), _RGB32(0, 200, 0)
22.  
23. FOR blocks = 1 TO 400
24.     blocks:
25.     xx = (RND * _WIDTH)
26.     yy = (RND * _HEIGHT)
27.     sz = INT(RND * 50) + 10
28.     c1 = INT(RND * 155) + 100
29.     c2 = INT(RND * 155) + 100
30.     c3 = INT(RND * 155) + 100
31.     LINE (xx, yy)-(xx + sz, yy + sz), _RGB32(c1, c2, c3), BF
32.     IF POINT(_WIDTH / 2, _HEIGHT / 2) = _RGB32(c1, c2, c3) THEN GOTO blocks:
33. NEXT
34. FOR lakes = 1 TO 10
35.     w = RND
36.     h = RND
37.     sze = (RND * 150) + 50
38.     FOR sz = .25 TO sze STEP .25
39.         CIRCLE (w * _WIDTH, h * _HEIGHT), sz, _RGB32(0, 0, 255)
40.     NEXT sz
41. NEXT lakes
42. w2 = INT(RND * _WIDTH) - 14
43. h2 = INT(RND * _HEIGHT) - 7
44.  
45. 'Gold
46. COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 128)
47. _PRINTSTRING (w2, h2), "GOLD"
48.  
49. _DEST 0
50.  
51. playerSpeed = 5
52.  
53. CONST keyUP = 18432
54. CONST keyDOWN = 20480
55. CONST keyLEFT = 19200
56. CONST keyRIGHT = 19712
57.  
58. DO
59.     CLS
60.  
61.     _PUTIMAGE (camera.x, camera.y), map
62.  
63.     IF _KEYDOWN(keyUP) THEN player.y = player.y - playerSpeed
64.     IF _KEYDOWN(keyDOWN) THEN player.y = player.y + playerSpeed
65.     IF _KEYDOWN(keyLEFT) THEN player.x = player.x - playerSpeed
66.     IF _KEYDOWN(keyRIGHT) THEN player.x = player.x + playerSpeed
67.  
68.     IF player.x < 0 THEN player.x = 0
69.     IF player.x > _WIDTH(map) THEN player.x = _WIDTH(map)
70.     IF player.y < 0 THEN player.y = 0
71.     IF player.y > _HEIGHT(map) THEN player.y = _HEIGHT(map)
72.  
73.     adjustCamera
74.  
75.     'Draw Head
76.     FOR sz = .25 TO 10 STEP .25
77.         CIRCLE (player.x + camera.x, player.y + camera.y), sz, _RGB32(255, 166, 127)
78.     NEXT sz
79.     'Draw Smile
80.     CIRCLE (player.x + camera.x, player.y + camera.y + 2), 7, _RGB32(255, 0, 0), _PI, 2 * _PI, .5
81.     'Draw Eyes
82.     CIRCLE (player.x + camera.x - 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
83.     CIRCLE (player.x + camera.x + 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
84.     'hat
85.     LINE (player.x + camera.x - 10, player.y + camera.y - 10)-(player.x + camera.x + 10, player.y + camera.y - 9), _RGB32(155, 0, 0), BF
86.     LINE (player.x + camera.x - 5, player.y + camera.y - 9)-(player.x + camera.x + 5, player.y + camera.y - 15), _RGB32(155, 0, 0), BF
87.  
88.  
89.     _DISPLAY
90.     _LIMIT 60
91. LOOP
92.  
93. SUB adjustCamera
94.     IF player.x + camera.x > _WIDTH / 2 OR player.x + camera.x < _WIDTH / 2 THEN
95.         camera.x = _WIDTH / 2 - player.x
96.     END IF
97.     IF camera.x > 0 THEN camera.x = 0
98.     IF camera.x < -(_WIDTH(map) - _WIDTH) THEN camera.x = -(_WIDTH(map) - _WIDTH)
99.  
100.     IF player.y + camera.y > _HEIGHT / 2 OR player.y + camera.y < _HEIGHT / 2 THEN
101.         camera.y = _HEIGHT / 2 - player.y
102.     END IF
103.     IF camera.y > 0 THEN camera.y = 0
104.     IF camera.y < -(_HEIGHT(map) - _HEIGHT) THEN camera.y = -(_HEIGHT(map) - _HEIGHT)
105. END SUB
106.  

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: bplus on October 21, 2020, 10:10:31 pm

Try setting _SOURCE to image handle before using POINT.

Oh coordinates should be same as camera + player?

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 21, 2020, 10:14:01 pm

In your case, like bplus said, you will need to set _SOURCE first:

Code: QB64: [Select]

1. _SOURCE map

This way you can read its pixels with POINT().

Since your player will roam around the map, you will use player.x and player.y to read POINT with, you can ignore the camera variable.

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: SierraKen on October 21, 2020, 10:54:18 pm

I did it!!! Thanks guys!!!

This is an example game, which is my first mapped out game like this. I hope to expand it sometime soon and make it more fun. For now, you can move your cowboy around and find one gold bar per map. When you move your guy next to or on the bar, it gives you 100 points and starts over with a brand new map. If I expand on this game, I'll make a new forum thread for it. But this is what I have so far. I also doubled the cowboy speed from my last post. Oh also, the gold bar is labeled "GOLD" so you know what it is.

Code: QB64: [Select]

1. 'Find the Gold! by SierraKen
2. 'October 21, 2020
3. 'Thanks for the great mapping code by FellipeHeitor and help from B+!
4. 'This is mostly an example game, I hope to expand on it sometime soon.
5.  
6.  
7. RANDOMIZE TIMER
8. SCREEN _NEWIMAGE(1000, 800, 32)
9.  
10. TYPE object
11.     x AS SINGLE
12.     y AS SINGLE
13. END TYPE
14.  
15. DIM SHARED player AS object
16. DIM SHARED camera AS object
17. DIM SHARED map AS LONG
18. DIM playerSpeed AS SINGLE
19.  
20. _TITLE "Find The Gold! One gold bar per map. Use your arrow keys."
21.  
22. start:
23. player.x = _WIDTH / 2
24. player.y = _HEIGHT / 2
25.  
26. map = _NEWIMAGE(_WIDTH * 7, _HEIGHT * 7, 32)
27.  
28. _DEST map
29. PAINT (2, 2), _RGB32(0, 200, 0)
30.  
31. FOR blocks = 1 TO 400
32.     blocks:
33.     xx = (RND * _WIDTH)
34.     yy = (RND * _HEIGHT)
35.     sz = INT(RND * 50) + 10
36.     c1 = INT(RND * 155) + 100
37.     c2 = INT(RND * 155) + 100
38.     c3 = INT(RND * 155) + 100
39.     LINE (xx, yy)-(xx + sz, yy + sz), _RGB32(c1, c2, c3), BF
40.     IF POINT(_WIDTH / 2, _HEIGHT / 2) = _RGB32(c1, c2, c3) THEN GOTO blocks:
41. NEXT
42. FOR lakes = 1 TO 10
43.     w = RND
44.     h = RND
45.     sze = (RND * 150) + 50
46.     FOR sz = .25 TO sze STEP .25
47.         CIRCLE (w * _WIDTH, h * _HEIGHT), sz, _RGB32(0, 0, 255)
48.     NEXT sz
49. NEXT lakes
50. w2 = INT(RND * _WIDTH) - 15
51. h2 = INT(RND * _HEIGHT) - 10
52. IF w2 < 15 THEN w2 = 15
53. IF h2 < 10 THEN h2 = 10
54.  
55. 'Gold
56. COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 128)
57. _PRINTSTRING (w2, h2), "GOLD"
58.  
59. _DEST 0
60.  
61. _SOURCE map
62.  
63. playerSpeed = 10
64.  
65. CONST keyUP = 18432
66. CONST keyDOWN = 20480
67. CONST keyLEFT = 19200
68. CONST keyRIGHT = 19712
69.  
70. DO
71.     CLS
72.  
73.     _PUTIMAGE (camera.x, camera.y), map
74.  
75.     IF _KEYDOWN(keyUP) THEN player.y = player.y - playerSpeed
76.     IF _KEYDOWN(keyDOWN) THEN player.y = player.y + playerSpeed
77.     IF _KEYDOWN(keyLEFT) THEN player.x = player.x - playerSpeed
78.     IF _KEYDOWN(keyRIGHT) THEN player.x = player.x + playerSpeed
79.  
80.     IF player.x < 0 THEN player.x = 0
81.     IF player.x > _WIDTH(map) THEN player.x = _WIDTH(map)
82.     IF player.y < 0 THEN player.y = 0
83.     IF player.y > _HEIGHT(map) THEN player.y = _HEIGHT(map)
84.  
85.     adjustCamera
86.  
87.     'Draw Head
88.     FOR sz = .25 TO 10 STEP .25
89.         CIRCLE (player.x + camera.x, player.y + camera.y), sz, _RGB32(255, 166, 127)
90.     NEXT sz
91.     'Draw Smile
92.     CIRCLE (player.x + camera.x, player.y + camera.y + 2), 7, _RGB32(255, 0, 0), _PI, 2 * _PI, .5
93.     'Draw Eyes
94.     CIRCLE (player.x + camera.x - 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
95.     CIRCLE (player.x + camera.x + 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
96.     'hat
97.     LINE (player.x + camera.x - 10, player.y + camera.y - 10)-(player.x + camera.x + 10, player.y + camera.y - 9), _RGB32(155, 0, 0), BF
98.     LINE (player.x + camera.x - 5, player.y + camera.y - 9)-(player.x + camera.x + 5, player.y + camera.y - 15), _RGB32(155, 0, 0), BF
99.     FOR check = -15 TO 15
100.         IF POINT(player.x + check, player.y + check) = _RGB32(255, 255, 128) THEN SOUND 500, .5: score = score + 100: score$ = STR$(score): _TITLE "Score: " + score$: GOTO start:
101.         IF POINT(player.x + check, player.y - check) = _RGB32(255, 255, 128) THEN SOUND 500, .5: score = score + 100: score$ = STR$(score): _TITLE "Score: " + score$: GOTO start:
102.         IF POINT(player.x - check, player.y + check) = _RGB32(255, 255, 128) THEN SOUND 500, .5: score = score + 100: score$ = STR$(score): _TITLE "Score: " + score$: GOTO start:
103.     NEXT check
104.  
105.     _DISPLAY
106.     _LIMIT 60
107. LOOP
108.  
109. SUB adjustCamera
110.     IF player.x + camera.x > _WIDTH / 2 OR player.x + camera.x < _WIDTH / 2 THEN
111.         camera.x = _WIDTH / 2 - player.x
112.     END IF
113.     IF camera.x > 0 THEN camera.x = 0
114.     IF camera.x < -(_WIDTH(map) - _WIDTH) THEN camera.x = -(_WIDTH(map) - _WIDTH)
115.  
116.     IF player.y + camera.y > _HEIGHT / 2 OR player.y + camera.y < _HEIGHT / 2 THEN
117.         camera.y = _HEIGHT / 2 - player.y
118.     END IF
119.     IF camera.y > 0 THEN camera.y = 0
120.     IF camera.y < -(_HEIGHT(map) - _HEIGHT) THEN camera.y = -(_HEIGHT(map) - _HEIGHT)
121. END SUB
122.  

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 21, 2020, 11:14:10 pm

Cool mod, Ken!

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: SierraKen on October 21, 2020, 11:41:26 pm

Thanks Felippe, glad you like it. :)). I can add all kinds of stuff to the map now that I have color detection. :))). Can also make enemies where if you see one on your screen, they come after you. lol I hope I can do that anyway. :) I hope to work on it sometime soon.

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 22, 2020, 03:22:08 am

New version updated with chat!

https://github.com/FellippeHeitor/amongus/blob/main/amongst.bas

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: SierraKen on October 22, 2020, 01:20:19 pm

Felippe that is totally cool! I felt like I was in a tank game chatting with my counterpart. lol

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: qbkiller101 on October 22, 2020, 02:03:01 pm

Quote from: SierraKen on October 21, 2020, 10:54:18 pm

I did it!!! Thanks guys!!!

This is an example game, which is my first mapped out game like this. I hope to expand it sometime soon and make it more fun. For now, you can move your cowboy around and find one gold bar per map. When you move your guy next to or on the bar, it gives you 100 points and starts over with a brand new map. If I expand on this game, I'll make a new forum thread for it. But this is what I have so far. I also doubled the cowboy speed from my last post. Oh also, the gold bar is labeled "GOLD" so you know what it is.

Code: QB64: [Select]

1. 'Find the Gold! by SierraKen
2. 'October 21, 2020
3. 'Thanks for the great mapping code by FellipeHeitor and help from B+!
4. 'This is mostly an example game, I hope to expand on it sometime soon.
5.  
6.  
7. RANDOMIZE TIMER
8. SCREEN _NEWIMAGE(1000, 800, 32)
9.  
10. TYPE object
11.     x AS SINGLE
12.     y AS SINGLE
13. END TYPE
14.  
15. DIM SHARED player AS object
16. DIM SHARED camera AS object
17. DIM SHARED map AS LONG
18. DIM playerSpeed AS SINGLE
19.  
20. _TITLE "Find The Gold! One gold bar per map. Use your arrow keys."
21.  
22. start:
23. player.x = _WIDTH / 2
24. player.y = _HEIGHT / 2
25.  
26. map = _NEWIMAGE(_WIDTH * 7, _HEIGHT * 7, 32)
27.  
28. _DEST map
29. PAINT (2, 2), _RGB32(0, 200, 0)
30.  
31. FOR blocks = 1 TO 400
32.     blocks:
33.     xx = (RND * _WIDTH)
34.     yy = (RND * _HEIGHT)
35.     sz = INT(RND * 50) + 10
36.     c1 = INT(RND * 155) + 100
37.     c2 = INT(RND * 155) + 100
38.     c3 = INT(RND * 155) + 100
39.     LINE (xx, yy)-(xx + sz, yy + sz), _RGB32(c1, c2, c3), BF
40.     IF POINT(_WIDTH / 2, _HEIGHT / 2) = _RGB32(c1, c2, c3) THEN GOTO blocks:
41. NEXT
42. FOR lakes = 1 TO 10
43.     w = RND
44.     h = RND
45.     sze = (RND * 150) + 50
46.     FOR sz = .25 TO sze STEP .25
47.         CIRCLE (w * _WIDTH, h * _HEIGHT), sz, _RGB32(0, 0, 255)
48.     NEXT sz
49. NEXT lakes
50. w2 = INT(RND * _WIDTH) - 15
51. h2 = INT(RND * _HEIGHT) - 10
52. IF w2 < 15 THEN w2 = 15
53. IF h2 < 10 THEN h2 = 10
54.  
55. 'Gold
56. COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 128)
57. _PRINTSTRING (w2, h2), "GOLD"
58.  
59. _DEST 0
60.  
61. _SOURCE map
62.  
63. playerSpeed = 10
64.  
65. CONST keyUP = 18432
66. CONST keyDOWN = 20480
67. CONST keyLEFT = 19200
68. CONST keyRIGHT = 19712
69.  
70. DO
71.     CLS
72.  
73.     _PUTIMAGE (camera.x, camera.y), map
74.  
75.     IF _KEYDOWN(keyUP) THEN player.y = player.y - playerSpeed
76.     IF _KEYDOWN(keyDOWN) THEN player.y = player.y + playerSpeed
77.     IF _KEYDOWN(keyLEFT) THEN player.x = player.x - playerSpeed
78.     IF _KEYDOWN(keyRIGHT) THEN player.x = player.x + playerSpeed
79.  
80.     IF player.x < 0 THEN player.x = 0
81.     IF player.x > _WIDTH(map) THEN player.x = _WIDTH(map)
82.     IF player.y < 0 THEN player.y = 0
83.     IF player.y > _HEIGHT(map) THEN player.y = _HEIGHT(map)
84.  
85.     adjustCamera
86.  
87.     'Draw Head
88.     FOR sz = .25 TO 10 STEP .25
89.         CIRCLE (player.x + camera.x, player.y + camera.y), sz, _RGB32(255, 166, 127)
90.     NEXT sz
91.     'Draw Smile
92.     CIRCLE (player.x + camera.x, player.y + camera.y + 2), 7, _RGB32(255, 0, 0), _PI, 2 * _PI, .5
93.     'Draw Eyes
94.     CIRCLE (player.x + camera.x - 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
95.     CIRCLE (player.x + camera.x + 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
96.     'hat
97.     LINE (player.x + camera.x - 10, player.y + camera.y - 10)-(player.x + camera.x + 10, player.y + camera.y - 9), _RGB32(155, 0, 0), BF
98.     LINE (player.x + camera.x - 5, player.y + camera.y - 9)-(player.x + camera.x + 5, player.y + camera.y - 15), _RGB32(155, 0, 0), BF
99.     FOR check = -15 TO 15
100.         IF POINT(player.x + check, player.y + check) = _RGB32(255, 255, 128) THEN SOUND 500, .5: score = score + 100: score$ = STR$(score): _TITLE "Score: " + score$: GOTO start:
101.         IF POINT(player.x + check, player.y - check) = _RGB32(255, 255, 128) THEN SOUND 500, .5: score = score + 100: score$ = STR$(score): _TITLE "Score: " + score$: GOTO start:
102.         IF POINT(player.x - check, player.y + check) = _RGB32(255, 255, 128) THEN SOUND 500, .5: score = score + 100: score$ = STR$(score): _TITLE "Score: " + score$: GOTO start:
103.     NEXT check
104.  
105.     _DISPLAY
106.     _LIMIT 60
107. LOOP
108.  
109. SUB adjustCamera
110.     IF player.x + camera.x > _WIDTH / 2 OR player.x + camera.x < _WIDTH / 2 THEN
111.         camera.x = _WIDTH / 2 - player.x
112.     END IF
113.     IF camera.x > 0 THEN camera.x = 0
114.     IF camera.x < -(_WIDTH(map) - _WIDTH) THEN camera.x = -(_WIDTH(map) - _WIDTH)
115.  
116.     IF player.y + camera.y > _HEIGHT / 2 OR player.y + camera.y < _HEIGHT / 2 THEN
117.         camera.y = _HEIGHT / 2 - player.y
118.     END IF
119.     IF camera.y > 0 THEN camera.y = 0
120.     IF camera.y < -(_HEIGHT(map) - _HEIGHT) THEN camera.y = -(_HEIGHT(map) - _HEIGHT)
121. END SUB
122.  

I added 4 lines for wasd at 79 to 82
but, as always, BUGS:
pressing both keys of movement in specific direction: e.g. w and right arrow, maks faster movement
ITS A FEATURE

Code: QB64: [Select]

1. 'Find the Gold! by SierraKen
2. 'October 21, 2020
3. 'Thanks for the great mapping code by FellipeHeitor and help from B+!
4. 'This is mostly an example game, I hope to expand on it sometime soon.
5.  
6.  
7. RANDOMIZE TIMER
8. SCREEN _NEWIMAGE(800, 600, 32)
9.  
10. TYPE object
11.     x AS SINGLE
12.     y AS SINGLE
13. END TYPE
14.  
15. DIM SHARED player AS object
16. DIM SHARED camera AS object
17. DIM SHARED map AS LONG
18. DIM playerSpeed AS SINGLE
19.  
20. _TITLE "Find The Gold! One gold bar per map. Use your arrow keys."
21.  
22. start:
23. player.x = _WIDTH / 2
24. player.y = _HEIGHT / 2
25.  
26. map = _NEWIMAGE(_WIDTH * 7, _HEIGHT * 7, 32)
27.  
28. _DEST map
29. PAINT (2, 2), _RGB32(0, 200, 0)
30.  
31. FOR blocks = 1 TO 400
32.     blocks:
33.     xx = (RND * _WIDTH)
34.     yy = (RND * _HEIGHT)
35.     sz = INT(RND * 50) + 10
36.     c1 = INT(RND * 155) + 100
37.     c2 = INT(RND * 155) + 100
38.     c3 = INT(RND * 155) + 100
39.     LINE (xx, yy)-(xx + sz, yy + sz), _RGB32(c1, c2, c3), BF
40.     IF POINT(_WIDTH / 2, _HEIGHT / 2) = _RGB32(c1, c2, c3) THEN GOTO blocks:
41. NEXT
42. FOR lakes = 1 TO 10
43.     w = RND
44.     h = RND
45.     sze = (RND * 150) + 50
46.     FOR sz = .25 TO sze STEP .25
47.         CIRCLE (w * _WIDTH, h * _HEIGHT), sz, _RGB32(0, 0, 255)
48.     NEXT sz
49. NEXT lakes
50. w2 = INT(RND * _WIDTH) - 15
51. h2 = INT(RND * _HEIGHT) - 10
52. IF w2 < 15 THEN w2 = 15
53. IF h2 < 10 THEN h2 = 10
54.  
55. 'Gold
56. COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 128)
57. _PRINTSTRING (w2, h2), "GOLD"
58.  
59. _DEST 0
60.  
61. _SOURCE map
62.  
63. playerSpeed = 10
64.  
65. CONST keyUP = 18432
66. CONST keyDOWN = 20480
67. CONST keyLEFT = 19200
68. CONST keyRIGHT = 19712
69.  
70. DO
71.     CLS
72.  
73.     _PUTIMAGE (camera.x, camera.y), map
74.  
75.     IF _KEYDOWN(keyUP) THEN player.y = player.y - playerSpeed
76.     IF _KEYDOWN(keyDOWN) THEN player.y = player.y + playerSpeed
77.     IF _KEYDOWN(keyLEFT) THEN player.x = player.x - playerSpeed
78.     IF _KEYDOWN(keyRIGHT) THEN player.x = player.x + playerSpeed
79.     IF _KEYDOWN(119) THEN player.y = player.y - playerSpeed 'Omer Hijazi
80.     IF _KEYDOWN(115) THEN player.y = player.y + playerSpeed 'Omer Hijazi
81.     IF _KEYDOWN(97) THEN player.x = player.x - playerSpeed 'Omer Hijazi
82.     IF _KEYDOWN(100) THEN player.x = player.x + playerSpeed 'Omer Hijazi
83.  
84.  
85.     IF player.x < 0 THEN player.x = 0
86.     IF player.x > _WIDTH(map) THEN player.x = _WIDTH(map)
87.     IF player.y < 0 THEN player.y = 0
88.     IF player.y > _HEIGHT(map) THEN player.y = _HEIGHT(map)
89.  
90.     adjustCamera
91.  
92.     'Draw Head
93.     FOR sz = .25 TO 10 STEP .25
94.         CIRCLE (player.x + camera.x, player.y + camera.y), sz, _RGB32(255, 166, 127)
95.     NEXT sz
96.     'Draw Smile
97.     CIRCLE (player.x + camera.x, player.y + camera.y + 2), 7, _RGB32(255, 0, 0), _PI, 2 * _PI, .5
98.     'Draw Eyes
99.     CIRCLE (player.x + camera.x - 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
100.     CIRCLE (player.x + camera.x + 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
101.     'hat
102.     LINE (player.x + camera.x - 10, player.y + camera.y - 10)-(player.x + camera.x + 10, player.y + camera.y - 9), _RGB32(155, 0, 0), BF
103.     LINE (player.x + camera.x - 5, player.y + camera.y - 9)-(player.x + camera.x + 5, player.y + camera.y - 15), _RGB32(155, 0, 0), BF
104.     FOR check = -15 TO 15
105.         IF POINT(player.x + check, player.y + check) = _RGB32(255, 255, 128) THEN SOUND 500, .5: score = score + 100: score$ = STR$(score): _TITLE "Score: " + score$: GOTO start:
106.         IF POINT(player.x + check, player.y - check) = _RGB32(255, 255, 128) THEN SOUND 500, .5: score = score + 100: score$ = STR$(score): _TITLE "Score: " + score$: GOTO start:
107.         IF POINT(player.x - check, player.y + check) = _RGB32(255, 255, 128) THEN SOUND 500, .5: score = score + 100: score$ = STR$(score): _TITLE "Score: " + score$: GOTO start:
108.     NEXT check
109.  
110.     _DISPLAY
111.     _LIMIT 60
112. LOOP
113.  
114. SUB adjustCamera
115.     IF player.x + camera.x > _WIDTH / 2 OR player.x + camera.x < _WIDTH / 2 THEN
116.         camera.x = _WIDTH / 2 - player.x
117.     END IF
118.     IF camera.x > 0 THEN camera.x = 0
119.     IF camera.x < -(_WIDTH(map) - _WIDTH) THEN camera.x = -(_WIDTH(map) - _WIDTH)
120.  
121.     IF player.y + camera.y > _HEIGHT / 2 OR player.y + camera.y < _HEIGHT / 2 THEN
122.         camera.y = _HEIGHT / 2 - player.y
123.     END IF
124.     IF camera.y > 0 THEN camera.y = 0
125.     IF camera.y < -(_HEIGHT(map) - _HEIGHT) THEN camera.y = -(_HEIGHT(map) - _HEIGHT)
126. END SUB
127.  

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: Petr on October 22, 2020, 03:00:12 pm

Perfect work, Fellippe. I like this.

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 22, 2020, 03:01:08 pm

@SierraKen lol, I was away from the keyboard and I just saw your messages in the game chat! Glad you enjoyed it.

@qbkiller101 that doesn't qualify as a bug - you are indeed reading two keys and changing the player's position, so it all seems to be working exactly as you wrote it ;-)

@Petr glad you enjoyed it! You just helped me find a bug just by joining the US server, thank you for trying it :-)

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: Petr on October 22, 2020, 03:07:07 pm

Really? Which bug? I don´t see none bug :)

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 22, 2020, 03:10:36 pm

The messages sent earlier by SierraKen were registered to you when you joined, because you used up his free slot.

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: Petr on October 22, 2020, 03:14:06 pm

It is possible. I ran the first version without chat.

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: Ashish on October 23, 2020, 03:20:15 am

GREAT JOB!!! :D

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: qbkiller101 on October 23, 2020, 10:18:38 am

Added choosing the dimensions, working on wasd mode and arrow keys mode:

Code: QB64: [Select]

1. 'Find the Gold! by SierraKen
2. 'October 21, 2020
3. 'Thanks for the great mapping code by FellipeHeitor and help from B+!
4. 'This is mostly an example game, I hope to expand on it sometime soon.
5. 'October 22, 2020
6. 'Edits by Omer H., or qbkiller101 in the forums
7. 'Added wasd support, fast and normal mode (see 113), and choosing
8. 'dimensions for people with small screens (like me)
9.  
10.  
11. RANDOMIZE TIMER
12. SCREEN _NEWIMAGE(500, 400, 256)
13. LINE (125, 100)-(375, 175), 15, BF
14. LINE (125, 225)-(375, 300), 15, BF
15. _PRINTSTRING (150, 0), "Choose the dimensions:"
16. _PRINTSTRING (210, 125), "800 x 600"
17. _PRINTSTRING (175, 250), "Default (1000 x 800)"
18. dimx% = 800
19. dimy% = 600
20. ischosen = false
21. WHILE ischosen = false
22.     DO WHILE _MOUSEINPUT
23.         IF _MOUSEX > 125 AND _MOUSEX < 375 THEN
24.             IF _MOUSEY > 100 AND _MOUSEY < 175 THEN
25.                 IF _MOUSEBUTTON(1) = -1 THEN
26.                     dimx% = 800
27.                     dimy% = 600
28.                     ischosen = true
29.                     EXIT WHILE
30.                 END IF
31.             END IF
32.         END IF
33.         IF _MOUSEX > 125 AND _MOUSEX < 375 THEN
34.             IF _MOUSEY > 225 AND _MOUSEY < 300 THEN
35.                 IF _MOUSEBUTTON(1) = -1 THEN
36.                     dimx% = 1000
37.                     dimy% = 800
38.                     ischosen = true
39.                     EXIT WHILE
40.                 END IF
41.             END IF
42.         END IF
43.  
44.     LOOP
45. WEND
46. SCREEN _NEWIMAGE(dimx%, dimy%, 32)
47.  
48. TYPE object
49.     x AS SINGLE
50.     y AS SINGLE
51. END TYPE
52.  
53. DIM SHARED player AS object
54. DIM SHARED camera AS object
55. DIM SHARED map AS LONG
56. DIM playerSpeed AS SINGLE
57.  
58. _TITLE "Find The Gold! One gold bar per map. Use your arrow keys."
59.  
60. start:
61. player.x = _WIDTH / 2
62. player.y = _HEIGHT / 2
63.  
64. map = _NEWIMAGE(_WIDTH * 7, _HEIGHT * 7, 32)
65.  
66. _DEST map
67. PAINT (2, 2), _RGB32(0, 200, 0)
68.  
69. FOR blocks = 1 TO 400
70.     blocks:
71.     xx = (RND * _WIDTH)
72.     yy = (RND * _HEIGHT)
73.     sz = INT(RND * 50) + 10
74.     c1 = INT(RND * 155) + 100
75.     c2 = INT(RND * 155) + 100
76.     c3 = INT(RND * 155) + 100
77.     LINE (xx, yy)-(xx + sz, yy + sz), _RGB32(c1, c2, c3), BF
78.     IF POINT(_WIDTH / 2, _HEIGHT / 2) = _RGB32(c1, c2, c3) THEN GOTO blocks:
79. NEXT
80. FOR lakes = 1 TO 10
81.     w = RND
82.     h = RND
83.     sze = (RND * 150) + 50
84.     FOR sz = .25 TO sze STEP .25
85.         CIRCLE (w * _WIDTH, h * _HEIGHT), sz, _RGB32(0, 0, 255)
86.     NEXT sz
87. NEXT lakes
88. w2 = INT(RND * _WIDTH) - 15
89. h2 = INT(RND * _HEIGHT) - 10
90. IF w2 < 15 THEN w2 = 15
91. IF h2 < 10 THEN h2 = 10
92.  
93. 'Gold
94. COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 128)
95. _PRINTSTRING (w2, h2), "GOLD"
96.  
97. _DEST 0
98.  
99. _SOURCE map
100.  
101. playerSpeed = 10
102.  
103. CONST keyUP = 18432
104. CONST keyDOWN = 20480
105. CONST keyLEFT = 19200
106. CONST keyRIGHT = 19712
107.  
108. DO
109.     CLS
110.  
111.     _PUTIMAGE (camera.x, camera.y), map
112.  
113.     IF _KEYDOWN(keyUP) THEN player.y = player.y - playerSpeed
114.     IF _KEYDOWN(keyDOWN) THEN player.y = player.y + playerSpeed
115.     IF _KEYDOWN(keyLEFT) THEN player.x = player.x - playerSpeed
116.     IF _KEYDOWN(keyRIGHT) THEN player.x = player.x + playerSpeed
117.     IF _KEYDOWN(119) THEN player.y = player.y - playerSpeed 'Omer Hijazi
118.     IF _KEYDOWN(115) THEN player.y = player.y + playerSpeed 'Omer Hijazi
119.     IF _KEYDOWN(97) THEN player.x = player.x - playerSpeed 'Omer Hijazi
120.     IF _KEYDOWN(100) THEN player.x = player.x + playerSpeed 'Omer Hijazi
121.  
122.  
123.     IF player.x < 0 THEN player.x = 0
124.     IF player.x > _WIDTH(map) THEN player.x = _WIDTH(map)
125.     IF player.y < 0 THEN player.y = 0
126.     IF player.y > _HEIGHT(map) THEN player.y = _HEIGHT(map)
127.  
128.     adjustCamera
129.  
130.     'Draw Head
131.     FOR sz = .25 TO 10 STEP .25
132.         CIRCLE (player.x + camera.x, player.y + camera.y), sz, _RGB32(255, 166, 127)
133.     NEXT sz
134.     'Draw Smile
135.     CIRCLE (player.x + camera.x, player.y + camera.y + 2), 7, _RGB32(255, 0, 0), _PI, 2 * _PI, .5
136.     'Draw Eyes
137.     CIRCLE (player.x + camera.x - 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
138.     CIRCLE (player.x + camera.x + 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
139.     'hat
140.     LINE (player.x + camera.x - 10, player.y + camera.y - 10)-(player.x + camera.x + 10, player.y + camera.y - 9), _RGB32(155, 0, 0), BF
141.     LINE (player.x + camera.x - 5, player.y + camera.y - 9)-(player.x + camera.x + 5, player.y + camera.y - 15), _RGB32(155, 0, 0), BF
142.     FOR check = -15 TO 15
143.         IF POINT(player.x + check, player.y + check) = _RGB32(255, 255, 128) THEN SOUND 500, .5: score = score + 100: score$ = STR$(score): _TITLE "Score: " + score$: GOTO start:
144.         IF POINT(player.x + check, player.y - check) = _RGB32(255, 255, 128) THEN SOUND 500, .5: score = score + 100: score$ = STR$(score): _TITLE "Score: " + score$: GOTO start:
145.         IF POINT(player.x - check, player.y + check) = _RGB32(255, 255, 128) THEN SOUND 500, .5: score = score + 100: score$ = STR$(score): _TITLE "Score: " + score$: GOTO start:
146.     NEXT check
147.  
148.     _DISPLAY
149.     _LIMIT 60
150. LOOP
151.  
152. SUB adjustCamera
153.     IF player.x + camera.x > _WIDTH / 2 OR player.x + camera.x < _WIDTH / 2 THEN
154.         camera.x = _WIDTH / 2 - player.x
155.     END IF
156.     IF camera.x > 0 THEN camera.x = 0
157.     IF camera.x < -(_WIDTH(map) - _WIDTH) THEN camera.x = -(_WIDTH(map) - _WIDTH)
158.  
159.     IF player.y + camera.y > _HEIGHT / 2 OR player.y + camera.y < _HEIGHT / 2 THEN
160.         camera.y = _HEIGHT / 2 - player.y
161.     END IF
162.     IF camera.y > 0 THEN camera.y = 0
163.     IF camera.y < -(_HEIGHT(map) - _HEIGHT) THEN camera.y = -(_HEIGHT(map) - _HEIGHT)
164. END SUB
165.  

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: TempodiBasic on October 24, 2020, 02:33:47 pm

Hi Guys
Hi Fellippe

1. I think that this your project that you share and let be our is wonderful!!!!!!!!!!!

2.  I find wonderful also your video that brings the audience with you along the developing of the first version of the game

3. some feedback (I hope these are useful!)
I have tryed to run the first online version and I got a strange result ( I have used US server but trying also on Australia server it is the same result)  after a while I run happy on the map I lost connection to the server. And I'm the one on that map. It happens also when I do a double connection (as you have suggested I have run two instances of the same .EXE).
Another strange result is this showed into this screenshot.
  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Now I try to donwload the version with chat from your github!

Thanks to share!!!!

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 24, 2020, 02:37:17 pm

The client in this thread is slightly outdated now. We're working on getting the servers updated with the latest version and will update you guys here too.

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 24, 2020, 02:38:14 pm

In the meantime, you can get the new server+client files from the repository and run a local instance. Just run the server then run the client and choose "local host".

https://github.com/FellippeHeitor/amongus

Title: Re: Pretentious not-really-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 24, 2020, 04:17:55 pm

Server in Brazil updated. Here's the latest client:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2.  
3. DIM SHARED gameVersion AS INTEGER
4. 'this is to be increased everytime the client
5. 'becomes incompatible with previous versions
6. gameVersion = 2
7.  
8. $LET DEBUGGING = FALSE
9. $IF DEBUGGING = TRUE THEN
10.     $CONSOLE
11. $END IF
12.  
13. CONST True = -1, False = 0
14. CONST mode_freeplay = 0
15. CONST mode_onlineclient = 1
16.  
17. CONST id_SERVERFULL = 1
18. CONST id_PING = 2
19. CONST id_ID = 3
20. CONST id_NEWCOLOR = 4
21. CONST id_NEWNAME = 5
22. CONST id_COLOR = 6
23. CONST id_POS = 7
24. CONST id_NAME = 8
25. CONST id_CHAT = 9
26. CONST id_PLAYERONLINE = 10
27. CONST id_PLAYEROFFLINE = 11
28. CONST id_PONG = 12
29. CONST id_PLAYERQUIT = 13
30. CONST id_GAMEVERSION = 14
31. CONST id_SHOOT = 15
32. CONST id_SIZE = 16
33. CONST id_UPDATESERVER = 17
34. CONST id_KICK = 18
35.  
36. CONST timeout = 10
37.  
38. CONST windowWidth = 800
39. CONST windowHeight = 600
40.  
41. TYPE object
42.     name AS STRING
43.     handle AS LONG
44.     x AS SINGLE
45.     prevX AS SINGLE
46.     y AS SINGLE
47.     prevY AS SINGLE
48.     xv AS SINGLE
49.     yv AS SINGLE
50.     xa AS SINGLE
51.     ya AS SINGLE
52.     w AS INTEGER
53.     h AS INTEGER
54.     state AS INTEGER
55.     start AS SINGLE
56.     duration AS SINGLE
57.     color AS INTEGER
58.     basicInfoSent AS _BYTE
59.     broadcastOffline AS _BYTE
60.     ping AS SINGLE
61.     id AS INTEGER
62.     text AS STRING
63.     size AS INTEGER
64.     r AS INTEGER
65.     g AS INTEGER
66.     b AS INTEGER
67. END TYPE
68.  
69. DIM SHARED particle(1000) AS object
70. DIM SHARED mode AS INTEGER
71. DIM SHARED totalClients AS INTEGER
72. DIM SHARED serverStream AS STRING
73. DIM SHARED player(1 TO 10) AS object, me AS INTEGER
74. 'DIM SHARED playerStream(1 TO 10) AS STRING
75. DIM SHARED colors(1 TO 12) AS _UNSIGNED LONG, r AS INTEGER, g AS INTEGER, b AS INTEGER
76. DIM SHARED warning(1 TO 30) AS object
77. DIM SHARED chat(1 TO 14) AS object, hasUnreadMessages AS _BYTE, chatOpen AS _BYTE
78. DIM idSet AS _BYTE
79. DIM shipMovement AS _BYTE
80. DIM i AS LONG
81. DIM serverPing AS SINGLE, currentPing AS SINGLE, waitingForPong AS _BYTE
82. DIM id AS INTEGER, value$
83. DIM choice AS STRING
84. DIM exitSign AS INTEGER
85. DIM target AS INTEGER
86. DIM score AS LONG
87.  
88. DIM SHARED ui(1 TO 1) AS object, focus AS INTEGER
89.  
90. DIM serverList(1 TO 4) AS STRING, chosenServer$
91. i = 0
92. i = i + 1: serverList(i) = "localhost Local host"
93. i = i + 1: serverList(i) = "spriggsyspriggs.ddns.net North America"
94. i = i + 1: serverList(i) = "alephc.xyz Australia"
95. i = i + 1: serverList(i) = "187.94.219.178 Brazil"
96.  
97. DIM SHARED endSignal AS STRING
98. endSignal = CHR$(253) + CHR$(254) + CHR$(255)
99.  
100. playerColorPalette:
101. DATA 195,17,16
102. DATA 14,51,196
103. DATA 18,125,46
104. DATA 236,84,187
105. DATA 239,125,17
106. DATA 248,245,91
107. DATA 62,71,77
108. DATA 216,225,241
109. DATA 107,48,187
110. DATA 112,73,28
111. DATA 93,250,220
112. DATA 79,240,58
113.  
114. RESTORE playerColorPalette
115. FOR i = 1 TO UBOUND(colors)
116.     READ r%, g%, b%
117.     colors(i) = _RGB32(r%, g%, b%)
118. NEXT
119.  
120. DIM SHARED mainWindow AS LONG
121. DIM SHARED mapImage AS LONG
122. DIM SHARED messageIcon AS LONG
123.  
124. mainWindow = _NEWIMAGE(windowWidth, windowHeight, 32)
125.  
126. mapImage = _NEWIMAGE(windowWidth * 4, windowHeight * 3, 32)
127. _DEST mapImage
128. RANDOMIZE 6
129. 'FOR i = 1 TO 500
130. '    CircleFill RND * _WIDTH, RND * _HEIGHT, RND * 2, _RGB32(255, 80)
131. 'NEXT
132. FOR i = 1 TO 50
133.     CircleFill RND * _WIDTH, RND * _HEIGHT, RND * 1000, _RGB32(RND * 255, RND * 255, RND * 255, RND * 150)
134. NEXT
135. _DEST 0
136.  
137. messageIcon = _NEWIMAGE(32, 32, 32)
138. _DEST messageIcon
139. LINE (0, 0)-(31, 31), _RGB32(0), BF
140. LINE (4, 4)-(27, 27), _RGB32(200), BF
141. FOR i = 8 TO 23 STEP 5
142.     LINE (5, i)-(25, i), _RGB32(0)
143. NEXT
144. ui(1).name = "messageicon"
145. ui(1).x = windowWidth - 50
146. ui(1).y = 10
147. ui(1).w = _WIDTH
148. ui(1).h = _HEIGHT
149. _DEST 0
150.  
151.  
152. DIM userName$, userColor%
153. IF _FILEEXISTS(COMMAND$) THEN
154.     OPEN COMMAND$ FOR BINARY AS #1
155.     GET #1, , i
156.     userName$ = SPACE$(i)
157.     GET #1, , userName$
158.     GET #1, , userColor%
159.     CLOSE #1
160.     choice = "1"
161.     GOTO clientTemp
162. ELSE
163.     INPUT "Name: ", userName$
164.     userName$ = LEFT$(userName$, 20)
165.     DO
166.         PRINT "Color (1-"; LTRIM$(STR$(UBOUND(colors))); "): ";
167.         INPUT "", userColor%
168.     LOOP WHILE userColor% < 1 OR userColor% > UBOUND(colors)
169. END IF
170.  
171. start:
172. DO
173.     COLOR 15
174.     PRINT "-------------------------"
175.     PRINT "(1) Free play"
176.     PRINT "(2) Connect to server"
177.  
178.     DO
179.         choice = INKEY$
180.  
181.         exitSign = _EXIT
182.         IF exitSign THEN
183.             SYSTEM
184.         END IF
185.  
186.         _LIMIT 30
187.     LOOP UNTIL choice >= "1" AND choice <= "3"
188.  
189.     DIM SHARED server AS object
190.     DIM c AS INTEGER, attempt AS INTEGER
191.     SELECT CASE VAL(choice)
192.         CASE 1
193.             mode = mode_freeplay
194.             EXIT DO
195.         CASE 2
196.             COLOR 7
197.             PRINT "Choose a server: "
198.             FOR i = 1 TO UBOUND(serverList)
199.                 PRINT i; " " + MID$(serverList(i), INSTR(serverList(i), " ") + 1)
200.             NEXT
201.             DO
202.                 choice = INKEY$
203.  
204.                 exitSign = _EXIT
205.                 IF exitSign THEN
206.                     SYSTEM
207.                 END IF
208.  
209.                 _LIMIT 30
210.             LOOP UNTIL VAL(choice) >= 1 AND VAL(choice) <= UBOUND(serverList)
211.             clientTemp:
212.             chosenServer$ = LEFT$(serverList(VAL(choice)), INSTR(serverList(VAL(choice)), " ") - 1)
213.  
214.             PRINT "Attempting to connect to server... ";
215.             r = CSRLIN: c = POS(1)
216.             CONST maxAttempts = 100
217.             attempt = 0
218.             DO
219.                 server.handle = 0
220.                 server.handle = _OPENCLIENT("TCP/IP:51512:" + chosenServer$)
221.                 IF server.handle THEN EXIT DO
222.                 attempt = attempt + 1
223.                 LOCATE r, c: PRINT USING "###%"; (attempt / maxAttempts) * 100;
224.  
225.                 exitSign = _EXIT
226.                 IF exitSign THEN
227.                     SYSTEM
228.                 END IF
229.  
230.                 _LIMIT 30
231.             LOOP WHILE attempt < maxAttempts
232.             IF server.handle THEN
233.                 mode = mode_onlineclient
234.                 serverStream = ""
235.                 EXIT DO
236.             END IF
237.             CLS
238.             COLOR 14: PRINT "/\ ";: COLOR 12
239.             PRINT "Failed to connect to server."
240.     END SELECT
241. LOOP
242.  
243. IF mode = mode_onlineclient THEN
244.     serverPing = TIMER
245.     DO
246.         getData server, serverStream
247.         WHILE parse(serverStream, id, value$)
248.             SELECT CASE id
249.                 CASE id_SERVERFULL
250.                     CLS
251.                     COLOR 14: PRINT "/\ ";: COLOR 12
252.                     PRINT "Server full."
253.                     CLOSE server.handle
254.                     GOTO start
255.                 CASE id_GAMEVERSION
256.                     IF CVI(value$) <> gameVersion THEN
257.                         CLS
258.                         COLOR 14: PRINT "/\ ";: COLOR 12
259.                         PRINT "Server version incompatible."
260.                         sendData server, id_GAMEVERSION, ""
261.                         sendData server, id_PLAYERQUIT, ""
262.                         CLOSE server.handle
263.                         GOTO start
264.                     ELSE
265.                         EXIT DO
266.                     END IF
267.             END SELECT
268.         WEND
269.         IF TIMER - serverPing > 10 THEN
270.             CLS
271.             COLOR 14: PRINT "/\ ";: COLOR 12
272.             PRINT "No response from server."
273.             GOTO start
274.         END IF
275.         _LIMIT 30
276.     LOOP
277. END IF
278.  
279. SCREEN mainWindow
280. _FONT 8
281. _PRINTMODE _KEEPBACKGROUND
282.  
283. DIM SHARED playerSpeed AS SINGLE
284. DIM SHARED camera AS object
285.  
286. RANDOMIZE TIMER
287.  
288. CONST keyUP = 18432
289. CONST keyDOWN = 20480
290. CONST keyLEFT = 19200
291. CONST keyRIGHT = 19712
292. CONST keySPACE = 32
293.  
294. CONST cameraWindow = 100
295.  
296. CONST minSpeed = 3
297. CONST maxSpeed = 5
298.  
299. playerSpeed = maxSpeed
300. shipMovement = True
301.  
302. IF mode > 0 THEN
303.     idSet = False
304. ELSE
305.     idSet = True
306.     me = 1
307.     player(me).name = userName$
308.     player(me).x = _WIDTH / 2 + COS(RND * _PI) * (RND * 100)
309.     player(me).y = _HEIGHT / 2 + SIN(RND * _PI) * (RND * 100)
310.     player(me).state = True
311.     player(me).color = userColor%
312.     player(me).size = 15
313. END IF
314. DO
315.     CLS
316.  
317.     DIM shipFlotation AS SINGLE, shipFloatAmplitude AS SINGLE
318.     IF shipMovement THEN
319.         shipFlotation = shipFlotation + .05
320.         IF shipFlotation > _PI(2) THEN shipFlotation = shipFlotation - _PI(2)
321.         shipFloatAmplitude = 1.5
322.     END IF
323.  
324.     _DONTBLEND
325.     _PUTIMAGE (camera.x + COS(shipFlotation) * shipFloatAmplitude, camera.y + SIN(shipFlotation) * shipFloatAmplitude), mapImage
326.     _BLEND
327.  
328.     SELECT CASE mode
329.         CASE mode_onlineclient
330.             IF waitingForPong = False THEN
331.                 serverPing = TIMER
332.                 sendData server, id_PING, ""
333.                 waitingForPong = True
334.             END IF
335.  
336.             getData server, serverStream
337.             DO WHILE parse(serverStream, id, value$)
338.                 SELECT EVERYCASE id
339.                     CASE id_ID 'first piece of data sent by server if not full
340.                         idSet = True
341.                         me = CVI(value$)
342.                         player(me).name = userName$
343.                         player(me).x = _WIDTH / 2 + COS(RND * _PI) * (RND * 100)
344.                         player(me).y = _HEIGHT / 2 + SIN(RND * _PI) * (RND * 100)
345.                         player(me).state = True
346.                         player(me).color = userColor%
347.                         player(me).size = 15
348.                     CASE id_NEWCOLOR 'server color changes must always be applied
349.                         player(me).color = CVI(value$)
350.                     CASE id_NEWNAME 'server name changes must always be applied
351.                         player(me).name = value$
352.                     CASE id_COLOR
353.                         player(CVI(LEFT$(value$, 2))).color = CVI(RIGHT$(value$, 2))
354.                     CASE id_SIZE
355.                         player(CVI(LEFT$(value$, 2))).size = CVI(RIGHT$(value$, 2))
356.                     CASE id_POS
357.                         'playerStream(CVI(LEFT$(value$, 2))) = playerStream(CVI(LEFT$(value$, 2))) + MID$(value$, 3)
358.                         player(CVI(LEFT$(value$, 2))).x = CVS(MID$(value$, LEN(value$) - 7, 4))
359.                         player(CVI(LEFT$(value$, 2))).y = CVS(RIGHT$(value$, 4))
360.                     CASE id_NAME
361.                         player(CVI(LEFT$(value$, 2))).name = MID$(value$, 3)
362.                     CASE id_CHAT
363.                         addMessageToChat CVI(LEFT$(value$, 2)), MID$(value$, 3)
364.                         hasUnreadMessages = True
365.                     CASE id_SHOOT
366.                         target = CVI(RIGHT$(value$, 2))
367.                         IF target = me THEN score = score - 100
368.                         addParticles player(target).x, player(target).y, 5, _RGB32(255)
369.                         addParticles player(target).x, player(target).y, 100, colors(player(target).color)
370.                         thickLine player(CVI(LEFT$(value$, 2))).x + camera.x, player(CVI(LEFT$(value$, 2))).y + camera.y, player(target).x + camera.x, player(target).y + camera.y, 8, _RGB32(227, 78, 6, 80)
371.                     CASE id_PLAYERONLINE
372.                         player(CVI(value$)).state = True
373.                     CASE id_PLAYEROFFLINE
374.                         IF player(CVI(value$)).state = True THEN
375.                             player(CVI(value$)).state = False
376.                             addWarning player(CVI(value$)).name + " left the game."
377.                         END IF
378.                     CASE id_PONG
379.                         waitingForPong = False
380.                     CASE id_KICK
381.                         SCREEN 0
382.                         _AUTODISPLAY
383.                         COLOR 14: PRINT "/\ ";: COLOR 12
384.                         PRINT "Kicked from server. Reason: "
385.                         COLOR 14
386.                         PRINT "   "; value$
387.                         CLOSE server.handle
388.                         GOTO start
389.                 END SELECT
390.             LOOP
391.  
392.             IF idSet THEN
393.                 IF player(me).basicInfoSent = False THEN
394.                     player(me).basicInfoSent = True
395.                     sendData server, id_COLOR, MKI$(player(me).color)
396.                     sendData server, id_NAME, player(me).name
397.                     sendData server, id_SIZE, MKI$(player(me).size)
398.                 END IF
399.  
400.                 IF player(me).x <> player(me).prevX OR player(me).y <> player(me).prevY THEN
401.                     player(me).prevX = player(me).x
402.                     player(me).prevY = player(me).y
403.                     sendData server, id_POS, MKS$(player(me).x) + MKS$(player(me).y)
404.                 END IF
405.             END IF
406.  
407.             totalClients = 0
408.             FOR i = 1 TO UBOUND(player)
409.                 IF player(i).state = True THEN totalClients = totalClients + 1
410.             NEXT
411.     END SELECT
412.  
413.     IF playerSpeed < minSpeed THEN playerSpeed = minSpeed
414.     IF playerSpeed > maxSpeed THEN playerSpeed = maxSpeed
415.  
416.     IF idSet THEN
417.         IF chatOpen = False THEN
418.             IF _KEYDOWN(keyUP) THEN player(me).y = player(me).y - playerSpeed
419.             IF _KEYDOWN(keyDOWN) THEN player(me).y = player(me).y + playerSpeed
420.             IF _KEYDOWN(keyLEFT) THEN player(me).x = player(me).x - playerSpeed
421.             IF _KEYDOWN(keyRIGHT) THEN player(me).x = player(me).x + playerSpeed
422.  
423.             IF player(me).x < 0 THEN player(me).x = 0
424.             IF player(me).y < 0 THEN player(me).y = 0
425.             IF player(me).x > _WIDTH(mapImage) THEN player(me).x = _WIDTH(mapImage)
426.             IF player(me).y > _HEIGHT(mapImage) THEN player(me).y = _HEIGHT(mapImage)
427.         END IF
428.         adjustCamera
429.     END IF
430.  
431.     exitSign = _EXIT
432.     IF exitSign THEN
433.         IF mode = mode_onlineclient THEN sendData server, id_PLAYERQUIT, ""
434.         EXIT DO
435.     END IF
436.  
437.     IF (mode = mode_onlineclient) THEN
438.         DIM k AS LONG
439.         k = _KEYHIT
440.  
441.         IF k = 27 THEN
442.             IF chatOpen THEN
443.                 chatOpen = False
444.             END IF
445.         END IF
446.  
447.         COLOR _RGB32(255)
448.  
449.         DIM m$
450.         currentPing = TIMER - serverPing
451.         IF currentPing > timeout THEN
452.             SCREEN 0
453.             _AUTODISPLAY
454.             COLOR 14: PRINT "/\ ";: COLOR 12
455.             PRINT "Connection lost (timed out)"
456.             CLOSE server.handle
457.             GOTO start
458.         END IF
459.         m$ = LTRIM$(STR$(currentPing))
460.         m$ = MID$(m$, INSTR(m$, ".") + 1)
461.         m$ = LEFT$(STRING$(3 - LEN(m$), "0") + m$, 3) + "ms"
462.         _PRINTSTRING (_WIDTH - 150 - _PRINTWIDTH(m$), 0), m$
463.  
464.         _FONT 16
465.         m$ = LTRIM$(STR$(totalClients)) + "/" + LTRIM$(STR$(UBOUND(player)))
466.         _PRINTSTRING ((_WIDTH - _PRINTWIDTH(m$)) / 2, _HEIGHT - _FONTHEIGHT), m$
467.         _FONT 8
468.     END IF
469.  
470.     DIM x AS SINGLE, y AS SINGLE
471.     target = 0
472.     FOR i = 1 TO UBOUND(player)
473.         'proximity
474.         IF i <> me AND player(i).state = True THEN
475.             IF dist(player(me).x, player(me).y, player(i).x, player(i).y) < 150 THEN target = i
476.         END IF
477.     NEXT
478.  
479.     IF target THEN
480.         DIM targetAnimation AS SINGLE
481.         targetAnimation = targetAnimation - .1
482.         IF targetAnimation < 0 THEN targetAnimation = 5
483.  
484.         x = player(target).x + camera.x + COS(shipFlotation) * shipFloatAmplitude
485.         y = player(target).y + camera.y + SIN(shipFlotation) * shipFloatAmplitude
486.         CircleFill x, y, player(target).size + 10 + targetAnimation, _RGB32(255, 0, 0, 100)
487.     END IF
488.  
489.     FOR i = 1 TO UBOUND(player)
490.         IF player(i).state = False OR player(i).color = 0 THEN _CONTINUE
491.         'IF i <> me AND LEN(playerStream(i)) > 0 THEN
492.         '    'process player stream of coordinates
493.         '    player(i).x = CVS(MID$(playerStream(i), 1, 4))
494.         '    player(i).y = CVS(MID$(playerStream(i), 5, 4))
495.         '    playerStream(i) = MID$(playerStream(i), 9)
496.         'END IF
497.  
498.         x = player(i).x + camera.x + COS(shipFlotation) * shipFloatAmplitude
499.         y = player(i).y + camera.y + SIN(shipFlotation) * shipFloatAmplitude
500.         CircleFill x, y + 6, player(i).size + 5, _RGB32(0, 50)
501.         CircleFill x, y, player(i).size + 5, _RGB32(0)
502.         CircleFill x, y, player(i).size, colors(player(i).color)
503.         COLOR _RGB32(0)
504.         _PRINTSTRING (1 + x - _PRINTWIDTH(player(i).name) / 2, 1 + y - 20), player(i).name
505.         COLOR _RGB32(255)
506.         _PRINTSTRING (x - _PRINTWIDTH(player(i).name) / 2, y - 20), player(i).name
507.     NEXT
508.  
509.     IF _KEYDOWN(keySPACE) THEN
510.         DIM lastShot AS SINGLE
511.         IF target > 0 THEN
512.             IF TIMER - lastShot > .5 THEN
513.                 lastShot = TIMER
514.                 score = score + 100
515.                 sendData server, id_SHOOT, MKI$(target)
516.                 addParticles player(target).x, player(target).y, 5, _RGB32(255)
517.                 addParticles player(target).x, player(target).y, 100, colors(player(target).color)
518.                 thickLine player(me).x + camera.x, player(me).y + camera.y, player(target).x + camera.x, player(target).y + camera.y, 8, _RGB32(227, 78, 6, 80)
519.             END IF
520.         END IF
521.     END IF
522.  
523.     updateParticles
524.  
525.     'LINE (_WIDTH / 2 - cameraWindow, _HEIGHT / 2 - cameraWindow)-STEP(cameraWindow * 2, cameraWindow * 2), , B
526.  
527.     'display warnings
528.     FOR i = 1 TO UBOUND(warning)
529.         IF warning(i).state = True THEN
530.             COLOR _RGB32(0)
531.             _PRINTSTRING (11, 1 + _HEIGHT / 2 + _FONTHEIGHT * i), warning(i).name
532.             COLOR _RGB32(238, 50, 22)
533.             _PRINTSTRING (10, _HEIGHT / 2 + _FONTHEIGHT * i), warning(i).name
534.             IF TIMER - warning(i).ping > 2.5 THEN warning(i).state = False
535.         END IF
536.     NEXT
537.  
538.     'display messagebox icon
539.     IF mode = mode_onlineclient THEN
540.         _PUTIMAGE (ui(1).x, ui(1).y), messageIcon
541.         IF hasUnreadMessages THEN
542.             CircleFill _WIDTH - 50, 10, 8, _RGB32(0)
543.             CircleFill _WIDTH - 50, 10, 5, _RGB32(205, 6, 0)
544.         END IF
545.  
546.         IF chatOpen THEN
547.             hasUnreadMessages = False
548.             LINE (50, 50)-(_WIDTH - 50, _HEIGHT - 50), _RGB32(0, 150), BF
549.             LINE (50, 50)-(_WIDTH - 50, _HEIGHT - 50), _RGB32(0), B
550.             _FONT 16
551.             COLOR _RGB32(0)
552.             FOR i = 1 TO UBOUND(chat)
553.                 IF chat(i).state THEN
554.                     y = 65 + _FONTHEIGHT * ((i - 1) * 2)
555.                     LINE (55, y - 10)-(_WIDTH - 55, y + 18), _RGB32(255, 80), BF
556.                     _FONT 8
557.                     x = 60
558.                     IF chat(i).id = me THEN x = _WIDTH - 60 - _PRINTWIDTH(chat(i).name)
559.                     COLOR _RGB32(100)
560.                     _PRINTSTRING (1 + x, 1 + y - 8), chat(i).name
561.                     COLOR colors(chat(i).color)
562.                     _PRINTSTRING (x, y - 8), chat(i).name
563.                     _FONT 16
564.                     x = 60
565.                     IF chat(i).id = me THEN x = _WIDTH - 60 - _PRINTWIDTH(chat(i).text)
566.                     COLOR _RGB32(100)
567.                     _PRINTSTRING (1 + x, 1 + y), LEFT$(chat(i).text, (_WIDTH - 100) \ _FONTWIDTH)
568.                     COLOR _RGB32(255)
569.                     _PRINTSTRING (x, y), LEFT$(chat(i).text, (_WIDTH - 100) \ _FONTWIDTH)
570.                 END IF
571.             NEXT
572.  
573.             DIM myMessage$, char$, tooFast AS _BYTE
574.             CONST messageSpeed = 1.5
575.             char$ = INKEY$
576.             SELECT CASE char$
577.                 CASE CHR$(22) 'ctrl+v
578.                     myMessage$ = myMessage$ + _CLIPBOARD$
579.                 CASE " " TO "z"
580.                     myMessage$ = myMessage$ + char$
581.                 CASE CHR$(8)
582.                     IF LEN(myMessage$) THEN
583.                         myMessage$ = LEFT$(myMessage$, LEN(myMessage$) - 1)
584.                     END IF
585.                 CASE CHR$(13)
586.                     DIM lastSentChat AS SINGLE
587.                     IF myMessage$ = ">reset" THEN
588.                         player(me).size = 15
589.                         sendData server, id_SIZE, MKI$(player(me).size)
590.                         myMessage$ = ""
591.                         chatOpen = False
592.                     ELSEIF myMessage$ = ">big" THEN
593.                         player(me).size = 25
594.                         sendData server, id_SIZE, MKI$(player(me).size)
595.                         myMessage$ = ""
596.                         chatOpen = False
597.                     ELSEIF myMessage$ = ">updateserver" THEN
598.                         'temporary solution for triggering auto-update checks
599.                         sendData server, id_UPDATESERVER, ""
600.                         myMessage$ = ""
601.                         chatOpen = False
602.                     ELSE
603.                         IF LEN(myMessage$) > 0 AND TIMER - lastSentChat > messageSpeed THEN
604.                             lastSentChat = TIMER
605.                             addMessageToChat me, myMessage$
606.                             sendData server, id_CHAT, myMessage$
607.                             myMessage$ = ""
608.                         ELSEIF LEN(myMessage$) > 0 AND TIMER - lastSentChat < messageSpeed THEN
609.                             tooFast = True
610.                         END IF
611.                     END IF
612.             END SELECT
613.  
614.             COLOR _RGB32(0)
615.             _PRINTSTRING (61, 61 + _FONTHEIGHT * (i * 2) - 24), "> " + myMessage$ + "_"
616.             COLOR _RGB32(255)
617.             _PRINTSTRING (60, 60 + _FONTHEIGHT * (i * 2) - 24), "> " + myMessage$ + "_"
618.             _FONT 8
619.  
620.             IF tooFast THEN
621.                 DIM s AS INTEGER
622.                 s = _CEIL(messageSpeed - (TIMER - lastSentChat))
623.                 m$ = "(too fast - wait" + STR$(s) + " second" + LEFT$("s", ABS(s > 1)) + ")"
624.                 y = _HEIGHT - 50 - _FONTHEIGHT
625.                 COLOR _RGB32(0)
626.                 _PRINTSTRING (61, 1 + y), m$
627.                 COLOR _RGB32(200, 177, 44)
628.                 _PRINTSTRING (60, y), m$
629.                 IF TIMER - lastSentChat > messageSpeed THEN tooFast = False
630.             END IF
631.         ELSE
632.             char$ = INKEY$
633.             SELECT CASE char$
634.                 CASE CHR$(13)
635.                     chatOpen = True
636.             END SELECT
637.         END IF
638.     END IF
639.  
640.     DIM mouseIsDown AS _BYTE, mouseDownOn AS INTEGER, mouseWheel AS INTEGER
641.     DIM mb1 AS _BYTE, mb2 AS _BYTE, mx AS INTEGER, my AS INTEGER
642.     mouseWheel = 0
643.     IF _MOUSEINPUT THEN
644.         mouseWheel = mouseWheel + _MOUSEWHEEL
645.         IF _MOUSEBUTTON(1) = mb1 AND _MOUSEBUTTON(2) = mb2 THEN
646.             DO WHILE _MOUSEINPUT
647.                 mouseWheel = mouseWheel + _MOUSEWHEEL
648.                 IF NOT (_MOUSEBUTTON(1) = mb1 AND _MOUSEBUTTON(2) = mb2) THEN EXIT DO
649.             LOOP
650.         END IF
651.         mb1 = _MOUSEBUTTON(1)
652.         mb2 = _MOUSEBUTTON(2)
653.         mx = _MOUSEX
654.         my = _MOUSEY
655.     END IF
656.  
657.     focus = 0
658.     FOR i = UBOUND(ui) TO 1 STEP -1
659.         IF mx > ui(i).x AND mx < ui(i).x + ui(i).w AND my > ui(i).y AND my < ui(i).y + ui(i).h THEN
660.             focus = i
661.             EXIT FOR
662.         END IF
663.     NEXT
664.  
665.     IF mb1 THEN
666.         mouseDownOn = focus
667.         mouseIsDown = True
668.     ELSE
669.         IF mouseIsDown THEN
670.             IF mouseDownOn THEN
671.                 SELECT CASE ui(mouseDownOn).name
672.                     CASE "messageicon"
673.                         IF mode = mode_onlineclient THEN chatOpen = NOT chatOpen
674.                 END SELECT
675.             END IF
676.         END IF
677.         mouseIsDown = False
678.     END IF
679.  
680.     IF mode = mode_onlineclient THEN
681.         _FONT 16
682.         COLOR _RGB32(0)
683.         _PRINTSTRING (1, 1), "Score:" + STR$(score)
684.         COLOR _RGB32(255)
685.         _PRINTSTRING (0, 0), "Score:" + STR$(score)
686.         _FONT 8
687.     END IF
688.  
689.     _DISPLAY
690.     _LIMIT 60
691. LOOP
692. CLOSE
693. SYSTEM
694.  
695. SUB addMessageToChat (id AS INTEGER, text$)
696.     DIM i AS INTEGER
697.     FOR i = 2 TO UBOUND(chat)
698.         SWAP chat(i), chat(i - 1)
699.     NEXT
700.     chat(UBOUND(chat)).id = id
701.     chat(UBOUND(chat)).state = True
702.     IF id > 0 THEN
703.         chat(UBOUND(chat)).name = player(id).name
704.         chat(UBOUND(chat)).color = player(id).color
705.     ELSE
706.         chat(UBOUND(chat)).name = "SYSTEM:"
707.         chat(UBOUND(chat)).color = 7
708.         chatOpen = True
709.     END IF
710.     chat(UBOUND(chat)).text = text$
711. END SUB
712.  
713. SUB addWarning (text$)
714.     DIM i AS INTEGER
715.     FOR i = 1 TO UBOUND(warning)
716.         IF warning(i).state = False THEN
717.             warning(i).state = True
718.             warning(i).name = text$
719.             warning(i).ping = TIMER
720.             EXIT FOR
721.         END IF
722.     NEXT
723. END SUB
724.  
725. SUB sendData (client AS object, id AS INTEGER, value$)
726.     DIM packet$
727.     packet$ = MKI$(id) + value$ + endSignal
728.     IF client.handle THEN PUT #client.handle, , packet$
729. END SUB
730.  
731. SUB getData (client AS object, buffer AS STRING)
732.     DIM incoming$
733.     GET #client.handle, , incoming$
734.     buffer = buffer + incoming$
735. END SUB
736.  
737. FUNCTION parse%% (buffer AS STRING, id AS INTEGER, value$)
738.     DIM endMarker AS LONG
739.     endMarker = INSTR(buffer, endSignal)
740.     IF endMarker THEN
741.         id = CVI(LEFT$(buffer, 2))
742.         value$ = MID$(buffer, 3, endMarker - 3)
743.         buffer = MID$(buffer, endMarker + LEN(endSignal))
744.         parse%% = True
745.     END IF
746. END FUNCTION
747.  
748. SUB adjustCamera
749.     IF player(me).x + camera.x > _WIDTH / 2 + cameraWindow THEN
750.         camera.x = _WIDTH / 2 - player(me).x + cameraWindow
751.     ELSEIF player(me).x + camera.x < _WIDTH / 2 - cameraWindow THEN
752.         camera.x = _WIDTH / 2 - player(me).x - cameraWindow
753.     END IF
754.     IF camera.x > 0 THEN camera.x = 0
755.     IF camera.x < -(_WIDTH(mapImage) - _WIDTH) THEN camera.x = -(_WIDTH(mapImage) - _WIDTH)
756.  
757.     IF player(me).y + camera.y > _HEIGHT / 2 + cameraWindow THEN
758.         camera.y = _HEIGHT / 2 - player(me).y + cameraWindow
759.     ELSEIF player(me).y + camera.y < _HEIGHT / 2 - cameraWindow THEN
760.         camera.y = _HEIGHT / 2 - player(me).y - cameraWindow
761.     END IF
762.     IF camera.y > 0 THEN camera.y = 0
763.     IF camera.y < -(_HEIGHT(mapImage) - _HEIGHT) THEN camera.y = -(_HEIGHT(mapImage) - _HEIGHT)
764. END SUB
765.  
766.  
767. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
768.     ' CX = center x coordinate
769.     ' CY = center y coordinate
770.     '  R = radius
771.     '  C = fill color
772.     DIM Radius AS INTEGER, RadiusError AS INTEGER
773.     DIM X AS INTEGER, Y AS INTEGER
774.     Radius = ABS(R)
775.     RadiusError = -Radius
776.     X = Radius
777.     Y = 0
778.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
779.     LINE (CX - X, CY)-(CX + X, CY), C, BF
780.     WHILE X > Y
781.         RadiusError = RadiusError + Y * 2 + 1
782.         IF RadiusError >= 0 THEN
783.             IF X <> Y + 1 THEN
784.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
785.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
786.             END IF
787.             X = X - 1
788.             RadiusError = RadiusError - X * 2
789.         END IF
790.         Y = Y + 1
791.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
792.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
793.     WEND
794. END SUB
795.  
796. SUB db (text$)
797.     $IF DEBUGGING = TRUE THEN
798.         _ECHO text$
799.     $ELSE
800.         DIM dummy$
801.         dummy$ = text$
802.     $END IF
803. END SUB
804.  
805. FUNCTION dist! (x1!, y1!, x2!, y2!)
806.     dist! = _HYPOT((x2! - x1!), (y2! - y1!))
807. END FUNCTION
808.  
809. SUB thickLine (x1 AS SINGLE, y1 AS SINGLE, x2 AS SINGLE, y2 AS SINGLE, lineWeight%, c~&)
810.     DIM a AS SINGLE, x0 AS SINGLE, y0 AS SINGLE
811.     DIM prevDest AS LONG
812.     DIM colorSample AS LONG
813.  
814.     colorSample = _NEWIMAGE(1, 1, 32)
815.  
816.     prevDest = _DEST
817.     _DEST colorSample
818.     PSET (0, 0), c~&
819.     _DEST prevDest
820.  
821.     a = _ATAN2(y2 - y1, x2 - x1)
822.     a = a + _PI / 2
823.     x0 = 0.5 * lineWeight% * COS(a)
824.     y0 = 0.5 * lineWeight% * SIN(a)
825.  
826.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), colorSample TO(x1 - x0, y1 - y0)-(x1 + x0, y1 + y0)-(x2 + x0, y2 + y0), , _SMOOTH
827.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), colorSample TO(x1 - x0, y1 - y0)-(x2 + x0, y2 + y0)-(x2 - x0, y2 - y0), , _SMOOTH
828.  
829.     _FREEIMAGE colorSample
830. END SUB
831.  
832. SUB addParticles (x AS SINGLE, y AS SINGLE, total AS INTEGER, c AS _UNSIGNED LONG)
833.     DIM addedP AS INTEGER, p AS INTEGER
834.     DIM a AS SINGLE
835.  
836.     addedP = 0: p = 0
837.     DO
838.         p = p + 1
839.         IF p > UBOUND(particle) THEN EXIT DO
840.         IF particle(p).state = True THEN _CONTINUE
841.         addedP = addedP + 1
842.         particle(p).state = True
843.         particle(p).x = x
844.         particle(p).y = y
845.         a = RND * _PI(2)
846.         particle(p).xv = COS(a) * (RND * 10)
847.         particle(p).yv = SIN(a) * (RND * 10)
848.         particle(p).r = _RED32(c)
849.         particle(p).g = _GREEN32(c)
850.         particle(p).b = _BLUE32(c)
851.         particle(p).size = _CEIL(RND * 3)
852.         particle(p).start = TIMER
853.         particle(p).duration = RND
854.     LOOP UNTIL addedP >= total
855. END SUB
856.  
857. SUB updateParticles
858.     DIM i AS INTEGER
859.  
860.     FOR i = 1 TO UBOUND(particle)
861.         CONST gravity = .1
862.         IF particle(i).state THEN
863.             particle(i).xv = particle(i).xv + particle(i).xa
864.             particle(i).x = particle(i).x + particle(i).xv
865.             particle(i).yv = particle(i).yv + particle(i).ya + gravity
866.             particle(i).y = particle(i).y + particle(i).yv
867.  
868.             IF particle(i).x > _WIDTH(mapImage) OR particle(i).x < 0 OR particle(i).y > _HEIGHT(mapImage) OR particle(i).y < 0 THEN
869.                 particle(i).state = False
870.             ELSE
871.                 CircleFill particle(i).x + camera.x, particle(i).y + camera.y, particle(i).size, _RGB32(particle(i).r, particle(i).g, particle(i).b, map(TIMER - particle(i).start, 0, particle(i).duration, 255, 0))
872.             END IF
873.         END IF
874.     NEXT
875. END SUB
876.  
877. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
878.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
879. END FUNCTION
880.  

Title: Re: Pretentious not-yet-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 26, 2020, 01:08:41 am

Version 3 of the client attached to this post. Notice that previous versions won't be able to connect to the servers now.

 

Title: Re: Pretentious not-yet-a-clone clone of Among Us in QB64
Post by: SMcNeill on October 26, 2020, 04:52:25 am

Question:  Can you have the game simply try to share itself across all three servers, much like IRC and freenode does?  QB64 has a limited user base, and having to divide your chances into thirds to find someone else playing, seems like it'd just make it harder to find others to join with. 

Title: Re: Pretentious not-yet-a-clone clone of Among Us in QB64
Post by: qbkiller101 on October 26, 2020, 06:02:27 am

Hey, @FellippeHeitor can you add an option on the main screen to choose controls? WASD, arrow keys, or mouse, cuz I can't figure out graphics, I have written the code for movement of each option though.

Title: Re: Pretentious not-yet-a-clone clone of Among Us in QB64
Post by: FellippeHeitor on October 26, 2020, 12:32:30 pm

@SMcNeill We're still researching a way to keep it in sync across clients in the same server, that might at some point be considered. When you're at Discord let me know and I'll tell you in which server I currently am logged in.

@qbkiller101 I'll check it out, thanks!

Text Only | Text with Attachments