07-03-2022, 09:22 PM
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.
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