MasterGy's Return - bplus - 07-03-2022
Hi all, I am starting a thread for MasterGy who has just PM'd me today asking about a spot of his own in Prolific Programmers. Until Steve can get him setup, I offer a place here like with vince to show off his talents in QB64.
To kick off this thread I found an interesting start of a game possibly, anyway it's interesting and fun to play:
Code: (Select All) ' ref 2021-03-29 https://www.qb64.org/forum/index.php?topic=3714.msg131236#msg131236
' checkout how he reorientates the whole screen when the mouse is moved, no tan, atan nor atan2 used but it is way smoother than my mouse action
Randomize Timer
Const pip180 = 3.141592654 / 180
global_speed = 1.5
space_grav = 15
space = 1000 'space size x-y
planets = 600
planetsize_min = 1
planetsize_max = 12
planet_dif = .05
cr_c_max = 199
zoom = 10
me_buffer_size = 5000
'creating 2d planet
Dim cr(planets - 1, cr_c_max - 1, 1), cr_dat(planets - 1, 3), me_buffer(me_buffer_size - 1, 1)
'cd_dat 0-x,1-y,2-size,3-polars
For aplanet = 0 To planets - 1
cr_dat(aplanet, 2) = planetsize_min + (planetsize_max - planetsize_min) * Rnd(1) 'planet size
cr_l1 = (1 - planet_dif) * cr_dat(aplanet, 2)
cr_l2 = (1 + planet_dif) * cr_dat(aplanet, 2)
cr_dat(aplanet, 0) = space * Rnd(1) - space / 2 'X position
cr_dat(aplanet, 1) = space * Rnd(1) - space / 2 'Y position
cr_dat(aplanet, 3) = Int(cr_dat(aplanet, 2) * 6) 'polars
For t = 0 To cr_dat(aplanet, 3) - 1
cr_r = cr_l1 + (cr_l2 - cr_l1) * Rnd(1)
cr(aplanet, t, 0) = Sin(360 / cr_dat(aplanet, 3) * t * pip180) * cr_r
cr(aplanet, t, 1) = Cos(360 / cr_dat(aplanet, 3) * t * pip180) * cr_r
Next t, aplanet
me_x = 0 'my Xpos
me_y = 0 'my Ypos
me_a = 30 'my angle
me_size = 2 'arrow size
me_size_a = .4
mon = _NewImage(800, 600, 32): Screen mon: _FullScreen: _MouseHide
centx = _Width(mon) / 2: centy = _Height(mon) / 2
Do
'draw me
y1 = centy - me_size / 2 * zoom
y2 = y1 + me_size * zoom
Line (centx, y1)-(centx, y2)
y2 = y1 + me_size_a * zoom
Line (centx, y1)-(centx - me_size_a * zoom, y2)
Line (centx, y1)-(centx + me_size_a * zoom, y2)
'my position center, but where any object ?
grav_x = 0: grav_y = 0: grav_active = 0
For aplanet = 0 To planets - 1
angle1 = degree(me_x - cr_dat(aplanet, 0), me_y - cr_dat(aplanet, 1)) 'how many degree
angle2 = angle1 + angle_me '+arrow
distance = Sqr((me_x - cr_dat(aplanet, 0)) ^ 2 + (me_y - cr_dat(aplanet, 1)) ^ 2)
cr_cx = (Sin(angle2 * pip180)) * distance 'planet origo position on monitor
cr_cy = (Cos(angle2 * pip180)) * distance
For t = 0 To cr_dat(aplanet, 3)
If t = cr_dat(aplanet, 3) Then t2 = 0 Else t2 = t
px = cr(aplanet, t2, 0)
py = cr(aplanet, t2, 1)
angle_r = angle_me * pip180
px2 = (px * Cos(angle_r)) + (py * Sin(angle_r))
py2 = (py * Cos(angle_r)) - (px * Sin(angle_r))
px = (px2 + cr_cx) * zoom + centx
py = (py2 + cr_cy) * zoom + centy
If t Then Line (px, py)-(px_l, py_l)
px_l = px: py_l = py
Next t
'gravity planet
If distance < space / 100 * space_grav Then
grav_active = grav_active + 1
gravity = cr_dat(aplanet, 2) ^ 2 / distance ^ 2
'IF gravity > .01 THEN gravity = .01
grav_x = grav_x + Sin(angle1 * pip180) * gravity
grav_y = grav_y + Cos(angle1 * pip180) * gravity
End If
Next aplanet
'draw my way
For a_buff = 0 To me_buffer_size - 1: If me_buffer(a_buff, 0) = 0 Then _Continue
angle1 = degree(me_x - me_buffer(a_buff, 0), me_y - me_buffer(a_buff, 1)) 'how many degree
angle2 = angle1 + angle_me '+arrow
distance = Sqr((me_x - me_buffer(a_buff, 0)) ^ 2 + (me_y - me_buffer(a_buff, 1)) ^ 2)
cr_cx = (Sin(angle2 * pip180)) * distance 'planet origo position on monitor
cr_cy = (Cos(angle2 * pip180)) * distance
PSet (centx + cr_cx * zoom, centy + cr_cy * zoom)
Next a_buff
'control
mw = 0: mousex = 0: While _MouseInput: mousex = mousex + _MouseMovementX: mw = mw + _MouseWheel: Wend: angle_me = angle_me + mousex
If _MouseButton(1) Then speed = speed + .05
If _MouseButton(2) Then speed = speed - .05
'inertia vector
speed = speed - .01 * Sgn(speed)
If Abs(speed) > .5 Then speed = .5 * Sgn(speed)
vector_x_my = -Sin(pip180 * angle_me) * speed * global_speed
vector_y_my = -Cos(pip180 * angle_me) * speed * global_speed
'gravity vector
angle_g = degree(grav_x, grav_y)
strong = Sqr((grav_x - me_x) ^ 2 + (grav_y - me_y) ^ 2): If strong > 2 Then strong = 2
If Abs(strong) > 1 Then strong = 1 * Sgn(strong)
vector_x_grav = -Sin(pip180 * angle_g) * strong / 5 * global_speed
vector_y_grav = -Cos(pip180 * angle_g) * strong / 5 * global_speed
'resulting vector
me_x = me_x + vector_x_my + vector_x_grav
me_y = me_y - vector_y_my + vector_y_grav
If me_x > space / 2 Then me_x = me_x - space
If me_x < -space / 2 Then me_x = me_x + space
If me_y > space / 2 Then me_y = me_y - space
If me_y < -space / 2 Then me_y = me_y + space
me_buffer(me_buffer_a, 0) = me_x
me_buffer(me_buffer_a, 1) = me_y
me_buffer_a = me_buffer_a + 1: If me_buffer_a = me_buffer_size Then me_buffer_a = 0
zoom = zoom + mw / 2
If zoom > 50 Then zoom = 50
If zoom < .5 Then zoom = .5
'view
_Display
_Limit 30
Cls
'LOCATE 1, 1
'PRINT speed, SQR(grav_x ^ 2 + grav_y ^ 2)
' PRINT "grav_active:"; grav_active
Loop Until _KeyDown(27)
Function degree (a, b)
qarany = (a + .00001) / (b + .00001): d = honnan + Atn(qarany) / pip180
If 0 > b Then d = d - 180
If d < 0 Then d = d + 360
degree = d
End Function
That opening comment might be mine. I fixed up the degree function for version 2.0+ and added an escape from Do Loop since we are in Full Screen.
MasterGy, you are most welcome to add to this thread as you see fit. Thankyou for sharing all your interesting creations!
RE: MasterGy's Return - MasterGy - 07-03-2022
Thank you very much for your kindness Bplus! He opened a thread for me where I can post my programs. I have written separate explanations for larger programs. Operation. It would be nice if you could use as much of it as possible. If I were to display them here in bulk, it would be impossible to see. For the smaller programs, which do not need a special explanation, I will put them here. I apologize in advance if it reads nonsense, unfortunately google.translate often translates in an unintelligible way.
I don't remember if this was out.
Code: (Select All) '5 ball MasterGy 2022
DIM SHARED colors(9) AS _INTEGER64, map_s
'-------- SETTINGS
monx = 1000 'windows X size
colors(0) = _RGB32(255, 50, 50) 'player1 color - ME
colors(1) = _RGB32(50, 50, 255) 'player2 color - COMPUTER
tsq_size = 25 '1 square texture size
ball_rad = .6 'ball size
map_s = 100 'XxX map size
pos_z = 5 'zoom map
near = 3 'test field empty field full field distance
text_h = monx * .05
'------------------
'MAP_MEM array 0 original balls ,1 winner color foggy area, 2 winner-puppet sin signal
txt_text(0) = txt_to_text("I WANT TO PLAY !!! -ENTER, exit-ESC")
txt_text(1) = txt_to_text("BOARD ZOOM - mousewheel, BOARD MOVING - mouse right button and moving")
txt_text(2) = txt_to_text("BACK-backspace, TIP-T button, EMPTY BOARD-E button, EXIT-Esc")
'map texture
temp = _NEWIMAGE(tsq_size, tsq_size, 32): _DEST temp: CLS , _RGB32(100, 100, 200)
marg = tsq_size * .07: LINE (marg, marg)-(tsq_size - marg, tsq_size - marg), _RGB32(200, 200, 200), BF: text(0) = _COPYIMAGE(temp, 33): _FREEIMAGE temp
'balls and foggy texture
FOR ac = 0 TO 1: temp = _NEWIMAGE(tsq_size, tsq_size, 32): _DEST temp: CLS: PAINT (0, 0), _RGB32(10, 10, 10)
CIRCLE (tsq_size / 2, tsq_size / 2), tsq_size * ball_rad / 2, colors(ac): PAINT (tsq_size / 2, tsq_size / 2), colors(ac), colors(ac)
_CLEARCOLOR _RGB32(10, 10, 10): text(1 + ac) = _COPYIMAGE(temp, 33): IF ac = 0 THEN _SETALPHA 100, colors(ac), temp: text(9) = _COPYIMAGE(temp, 33)
_FREEIMAGE temp: temp = _NEWIMAGE(20, 20, 32): _DEST temp: PAINT (0, 0), colors(ac), colors(ac): _SETALPHA 100, colors(ac), temp
text(4 + ac) = _COPYIMAGE(temp, 33): _FREEIMAGE temp: NEXT ac
'map near texture
temp = _NEWIMAGE(tsq_size, tsq_size, 32): _DEST temp: CLS , _RGB32(100, 100, 200)
marg = tsq_size * .05: LINE (marg, marg)-(tsq_size - marg, tsq_size - marg), _RGB32(100, 100, 100), BF: text(3) = _COPYIMAGE(temp, 33): _FREEIMAGE temp
'preparation
DIM steps(map_s * map_s - 1, 2) '0- 1 or 2 ,1-x, 2-y
mony = monx / 16 * 9: mon = _NEWIMAGE(monx, mony, 32): SCREEN mon: pos_x = (monx - (pos_z * map_s)) / 2: pos_y = (mony - (pos_z * map_s)) / 2
REDIM SHARED map_mem(map_s - 1, map_s - 1, 9)
nc = 1
DO: _LIMIT 50
winsin = winsin + .2: winsin_n = SIN(winsin) * pos_z * .1 'winner puppets sin
'moving and zooming map
mousew = 0: WHILE _MOUSEINPUT: mousew = mousew + _MOUSEWHEEL: WEND: apos_x = (_MOUSEX - pos_x) / (pos_z * map_s): apos_y = (_MOUSEY - pos_y) / (pos_z * map_s)
on_the_map = apos_x > 0 AND apos_x < 1 AND apos_y > 0 AND apos_y < 1
IF on_the_map THEN
pos_x = pos_x - (move_x - _MOUSEX) * ABS(_MOUSEBUTTON(2) AND mb2_last): pos_y = pos_y - (move_y - _MOUSEY) * ABS(_MOUSEBUTTON(2) AND mb2_last)
IF _MOUSEBUTTON(2) THEN move_x = _MOUSEX: move_y = _MOUSEY
mb2_last = _MOUSEBUTTON(2): pos_z = pos_z - mousew * 1.5: IF pos_z < 5 THEN pos_z = 5 ELSE IF pos_z > 60 THEN pos_z = 60
apos_x2 = (_MOUSEX - pos_x) / (pos_z * map_s): apos_y2 = (_MOUSEY - pos_y) / (pos_z * map_s)
mousew = (pos_z * map_s) * SGN(ABS(mousew)): pos_x = pos_x + (apos_x2 - apos_x) * mousew: pos_y = pos_y + (apos_y2 - apos_y) * mousew
END IF
pos_xa = pos_xa + (pos_x - pos_xa) * .1: pos_ya = pos_ya + (pos_y - pos_ya) * .1: pos_za = pos_za + (pos_z - pos_za) * .1: mon_limit = monx * .05
IF pos_xa + (map_s - 1) * pos_za < mon_limit THEN pos_xa = mon_limit - ((map_s - 1) * pos_za) + mon_re: pos_x = pos_xa
IF pos_xa > monx - mon_limit THEN pos_xa = monx - mon_limit - mon_re: pos_x = pos_xa
IF pos_ya + (map_s - 1) * pos_za < mon_limit THEN pos_ya = mon_limit - ((map_s - 1) * pos_za) + mon_re: pos_y = pos_ya
IF pos_ya > mony - mon_limit THEN pos_ya = mony - mon_limit - mon_re: pos_y = pos_ya
'fill map array
REDIM SHARED map(map_s - 1, map_s - 1, 9): FOR a = 0 TO steps_c - 1: map(steps(a, 1), steps(a, 2), 0) = steps(a, 0): NEXT a
FOR a = 0 TO steps_c - 1: FOR tx2 = -near TO near: FOR ty2 = -near TO near: IF tx2 = 0 AND ty2 = 0 THEN _CONTINUE
px = tx2 + steps(a, 1): py = ty2 + steps(a, 2): IF px < 0 OR px > map_s - 1 OR py < 0 OR py > map_s - 1 THEN _CONTINUE
map(px, py, 1) = ABS(map(px, py, 0) = 0) AND ABS(map_mem(px, py, 1) = 0): NEXT ty2, tx2, a
'draw map
FOR tx = 0 TO map_s - 1: x1 = pos_xa + tx * pos_za: x2 = x1 + pos_za: FOR ty = 0 TO map_s - 1: y1 = pos_ya + ty * pos_za: y2 = y1 + pos_za
ww = winsin_n * map_mem(tx, ty, 2): _PUTIMAGE (x1, y1)-(x2, y2), text(0), , , _SMOOTH
IF steps_c THEN IF steps(steps_c - 1, 1) = tx AND steps(steps_c - 1, 2) = ty AND ls_step > 0 AND step_flash THEN _CONTINUE
IF map(tx, ty, 0) THEN _PUTIMAGE (x1 - ww, y1 - ww)-(x2 + ww, y2 + ww), text(map(tx, ty, 0)), , , _SMOOTH
IF map_mem(tx, ty, 0) THEN _PUTIMAGE (x1 - ww, y1 - ww)-(x2 + ww, y2 + ww), text(map_mem(tx, ty, 0)), , , _SMOOTH
IF map_mem(tx, ty, 1) THEN _PUTIMAGE (x1, y1)-(x2, y2), text(4 + map_mem(tx, ty, 1) - 1), , , _SMOOTH
NEXT ty, tx
IF on_the_map THEN real_x = INT(map_s * apos_x): real_y = INT(map_s * apos_y) 'which block is the mouse on?
REDIM c(2): FOR tx = 0 TO map_s - 1: FOR ty = 0 TO map_s - 1: c(map(tx, ty, 0)) = c(map(tx, ty, 0)) + 1: NEXT ty, tx 'how many balls
'draw putty if need
IF on_the_map AND c(2) >= c(1) AND connect_game AND _MOUSEBUTTON(2) = 0 THEN
elt = pos_za / 2 + winsin_n
_PUTIMAGE (_MOUSEX - elt, _MOUSEY - elt)-(_MOUSEX + elt, _MOUSEY + elt), text(9), , , _SMOOTH
END IF
IF nc THEN map(0, 0, 8) = 0: calculation: nc = 0 'calculating the best move for both players
'draw tip
IF (_KEYDOWN(ASC("t")) OR _KEYDOWN(ASC("T"))) AND INT(2 * RND(1)) AND connect_game THEN
calculation: x1 = pos_xa + map(0, 0, 4) * pos_za: x2 = x1 + pos_za: y1 = pos_ya + map(0, 0, 5) * pos_za: y2 = y1 + pos_za
_PUTIMAGE (x1, y1)-(x2, y2), text(1), , , _SMOOTH
END IF
'next step
IF c(1) > c(2) THEN 'who's next?
steps(steps_c, 0) = 2: steps(steps_c, 1) = map(0, 0, 6): steps(steps_c, 2) = map(0, 0, 7): steps_c = steps_c + 1 'COMPUTER MOVING
ELSE
IF connect_game THEN
IF on_the_map AND _MOUSEBUTTON(1) AND mb1_last = 0 THEN
IF map(real_x, real_y, 0) = 0 AND map_mem(real_x, real_y, 1) = 0 THEN
steps(steps_c, 0) = 1: steps(steps_c, 1) = real_x: steps(steps_c, 2) = real_y: steps_c = steps_c + 1
END IF
END IF
mb1_last = _MOUSEBUTTON(1): IF bill$ = CHR$(8) AND steps_c > 3 THEN steps_c = steps_c - 2
ELSE
IF steps_c = 0 THEN
empty = 5: DO: x = INT(map_s * RND(1)): y = INT(map_s * RND(1)): no_ok = 0: FOR tx = -empty TO empty: FOR ty = -empty TO empty
px = x + tx: py = y + ty: IF px < 0 OR px > map_s - 1 OR py < 0 OR py > map_s - 1 THEN no_ok = 1: _CONTINUE
no_ok = no_ok OR SGN(map_mem(px, py, 1)): NEXT ty, tx: LOOP WHILE no_ok
steps(steps_c, 0) = 1: steps(steps_c, 1) = x: steps(steps_c, 2) = y: steps_c = steps_c + 1
ELSE
steps(steps_c, 0) = 1: steps(steps_c, 1) = map(0, 0, 4): steps(steps_c, 2) = map(0, 0, 5): steps_c = steps_c + 1
END IF
END IF
END IF
'text control
th = text_h / _HEIGHT(txt_text(1)) * _WIDTH(txt_text(1)): x1 = (monx - th) / 2: x2 = x1 + th: y1 = mony - text_h: y2 = mony
_PUTIMAGE (x1, y1)-(x2, y2), txt_text(1), , , _SMOOTH: IF connect_game THEN atext = txt_text(2) ELSE atext = txt_text(0)
th = text_h / _HEIGHT(atext) * _WIDTH(atext): x1 = (monx - th) / 2: x2 = x1 + th: y1 = 0: y2 = text_h: _PUTIMAGE (x1, y1)-(x2, y2), atext, , , _SMOOTH
_DISPLAY: CLS , _RGB32(30, 0, 0)
IF map(0, 0, 8) THEN 'one player won!
fill = 2: FOR tx = 0 TO map_s - 1: FOR ty = 0 TO map_s - 1: IF map(tx, ty, 0) = 0 THEN _CONTINUE
map_mem(tx, ty, 0) = map(tx, ty, 0): FOR tx2 = -fill TO fill: FOR ty2 = -fill TO fill
px = tx2 + tx: py = ty2 + ty: IF px < 0 OR px > map_s - 1 OR py < 0 OR py > map_s - 1 THEN _CONTINUE
map_mem(px, py, 1) = map(0, 0, 8): NEXT ty2, tx2, ty, tx: steps_c = 0
winner_table = winner_table + 1: IF winner_table > 15 AND connect_game = 0 THEN winner_table = 0: REDIM SHARED map_mem(map_s - 1, map_s - 1, 9)
END IF
bill$ = LCASE$(INKEY$)
IF bill$ = CHR$(13) AND connect_game = 0 THEN connect_game = 1: steps_c = 0
IF bill$ = CHR$(27) THEN IF connect_game THEN connect_game = 0: pos_z = 5: pos_x = (monx - (pos_z * map_s)) / 2: pos_y = (mony - (pos_z * map_s)) / 2 ELSE SYSTEM
IF bill$ = "e" THEN REDIM SHARED map_mem(map_s - 1, map_s - 1, 9)
'last step flash
IF steps_c <> l_steps_c THEN ls_step = 10: nc = 1
l_steps_c = steps_c: ls_step = ls_step - 1: step_flash = step_flash XOR 1
LOOP
SUB calculation
REDIM d(3, 1), xval(4), p(1, 4): d(0, 0) = 0: d(0, 1) = 1: d(1, 0) = 1: d(1, 1) = 1: d(2, 0) = 1: d(2, 1) = 0: d(3, 0) = -1: d(3, 1) = 1
xval(1) = 565: xval(2) = 2130: xval(3) = 7483: xval(4) = 43848
'winning search
FOR tx = 0 TO map_s - 1: FOR ty = 0 TO map_s - 1: IF map(tx, ty, 0) = 0 THEN _CONTINUE
FOR ad = 0 TO 3: FOR av = 0 TO 4: REDIM c(2) AS _BYTE: FOR av2 = -4 TO 0
p(0, ABS(av2)) = d(ad, 0) * (av + av2) + tx: p(1, ABS(av2)) = d(ad, 1) * (av + av2) + ty
IF p(0, ABS(av2)) < 0 OR p(0, ABS(av2)) > map_s - 1 OR p(1, ABS(av2)) < 0 OR p(1, ABS(av2)) > map_s - 1 THEN _CONTINUE
c(map(p(0, ABS(av2)), p(1, ABS(av2)), 0)) = c(map(p(0, ABS(av2)), p(1, ABS(av2)), 0)) + 1: NEXT av2: winner = ABS(c(1) = 5) + ABS(c(2) = 5) * 2
IF winner THEN FOR ax = 0 TO 4: map_mem(p(0, ax), p(1, ax), 2) = 1: NEXT ax: map(0, 0, 8) = winner: EXIT SUB
NEXT av, ad, ty, tx
'most effective steps
REDIM max(1): FOR tx = 0 TO map_s - 1: FOR ty = 0 TO map_s - 1: IF map(tx, ty, 1) = 0 OR map_mem(tx, ty, 1) THEN _CONTINUE
REDIM line_val(1), lv(1): FOR ad = 0 TO 3: FOR av = 0 TO 4: REDIM c(2) AS _BYTE: FOR av2 = -4 TO 0
px = d(ad, 0) * (av + av2) + tx: py = d(ad, 1) * (av + av2) + ty: IF px < 0 OR px > map_s - 1 OR py < 0 OR py > map_s - 1 THEN _CONTINUE
c(map(px, py, 0)) = c(map(px, py, 0)) + 1: NEXT av2: IF c(2) THEN lv(0) = 0 ELSE lv(0) = xval(c(1))
IF c(1) THEN lv(1) = 0 ELSE lv(1) = xval(c(2))
line_val(0) = line_val(0) + lv(0): line_val(1) = line_val(1) + lv(1): NEXT av, ad
FOR ax = 0 TO 1: map(tx, ty, 2 + ax) = line_val(ax) * 1.7 + line_val(ax XOR 1) + 3 * RND(1)
IF map(tx, ty, 2 + ax) > max(ax) THEN max(ax) = map(tx, ty, 2 + ax): map(0, 0, 4 + ax * 2) = tx: map(0, 0, 5 + ax * 2) = ty
NEXT ax, ty, tx
END SUB
FUNCTION txt_to_text (x$): _FONT 16: marg = 10: temp = _NEWIMAGE(8 * LEN(x$) + 2 * marg, 16 + marg * 2, 32): _DEST temp: CLS , _RGBA32(0, 0, 0, 150)
COLOR _RGB32(255, 255, 255), 0: _PRINTSTRING (marg, marg), x$: txt_to_text = _COPYIMAGE(temp, 33): _FREEIMAGE temp: END FUNCTION
RE: MasterGy's Return - bplus - 07-03-2022
Yeah there is a 2 MB limit on posts that I've already run into, even with one .png image!
@MasterGy, I confess I am a little confused, what is to be done?
Update: Oh! I think it's who gets 5 in a row first, gets the area painted in their color?
RE: MasterGy's Return - vince - 07-03-2022
nice, the bplus section is prime real estate, i'd hold onto it!
|