MasterGy's Return

[bplus]

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!

[MasterGy]

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

[bplus]

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?

[vince]

nice, the bplus section is prime real estate, i'd hold onto it!