+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://staging.qb64phoenix.com/forumdisplay.php?fid=26)
+---- Forum: Dav (https://staging.qb64phoenix.com/forumdisplay.php?fid=34)
+---- Thread: QB64 Surabikku - Sliding block puzzle (/showthread.php?tid=347)
Pages:
1
2
RE: QB64 Surabikku - Sliding block puzzle - PhilOfPerth - 05-08-2022
(05-05-2022, 04:39 PM)Dav Wrote: QB64 Surabikku is a clone of an online sliding block puzzle I was playing called Surabikku. Click the arrows to slide the blocks until the puzzle board looks the same as the smaller image shown. Simple to play but not so simple to solve. May update this to use images instead of blocks, one day.I always thought surabikku was a dessert, with custarty stuff in it!
- Dav
EDIT: bplus made an update to this puzzle, you can find it HERE. Thanks, bplus!
Code: (Select All)'=============
'SURABIKKU.BAS
'=============
'QB64 version of a SURABIKKU like puzzle.
'Use Arrows to slide pieces so board matches the solved image.
'Coded by Dav, MAY/2022
SCREEN _NEWIMAGE(1024, 675, 32)
'=== define deminsions for board
DIM SHARED row, col, size: row = 3: col = 3: size = 175
DIM SHARED boxes: boxes = row * col
'=== define box value, x/y, values...
DIM SHARED bv&(boxes) 'box values (scrambled)
DIM SHARED slv&(boxes) 'box values (solved)
DIM SHARED bx1(boxes), by1(boxes) 'top x/y cords of box
DIM SHARED bx2(boxes), by2(boxes) ' bottom x/y cords of box
'=== make color box images
DIM SHARED red&, blu&, grn&
red& = _NEWIMAGE(size, size, 32): _DEST red&: CLS , _RGB(255, 0, 0)
blu& = _NEWIMAGE(size, size, 32): _DEST blu&: CLS , _RGB(0, 0, 255)
grn& = _NEWIMAGE(size, size, 32): _DEST grn&: CLS , _RGB(0, 255, 0)
_DEST 0: _DISPLAY
'=== init box x.y values
bc = 1 'counter
FOR r = 1 TO row
FOR c = 1 TO col
x = 75 + (c * size): y = 75 + (r * size)
bx1(bc) = x - size: bx2(bc) = x ' generate x/y values
by1(bc) = y - size: by2(bc) = y
bc = bc + 1
NEXT
NEXT
'=== assign scrambled up box values
bv&(1) = red&: bv&(2) = grn&: bv&(3) = red&
bv&(4) = blu&: bv&(5) = grn&: bv&(6) = blu&
bv&(7) = grn&: bv&(8) = blu&: bv&(9) = red&
'=== assign solved box values
slv&(1) = red&: slv&(2) = red&: slv&(3) = grn&
slv&(4) = red&: slv&(5) = blu&: slv&(6) = grn&
slv&(7) = blu&: slv&(8) = blu&: slv&(9) = grn&
'=== draw puzzle
CLS , _RGB(32, 32, 32)
FOR b = 1 TO boxes
_PUTIMAGE (bx1(b), by1(b))-(bx2(b), by2(b)), bv&(b)
LINE (bx1(b), by1(b))-(bx2(b), by2(b)), _RGB(0, 0, 0), B
NEXT
'=== print info
PPRINT 668, 28, 25, _RGB(128, 128, 128), 255, "QB64 SURABIKKU"
PPRINT 665, 25, 25, _RGB(255, 255, 0), 255, "QB64 SURABIKKU"
PPRINT 725, 75, 20, _RGB(128, 128, 128), 255, "Click Arrow."
PPRINT 725, 110, 20, _RGB(128, 128, 128), 255, "Move Blocks."
PPRINT 725, 250, 20, _RGB(255, 255, 255), 255, "Make it like:"
'=== draw solved puzzle on right
_PUTIMAGE (725, 300)-(800, 375), slv&(1)
_PUTIMAGE (800, 300)-(875, 375), slv&(2)
_PUTIMAGE (875, 300)-(950, 375), slv&(3)
_PUTIMAGE (725, 375)-(800, 450), slv&(4)
_PUTIMAGE (800, 375)-(875, 450), slv&(5)
_PUTIMAGE (875, 375)-(950, 450), slv&(6)
_PUTIMAGE (725, 450)-(800, 525), slv&(7)
_PUTIMAGE (800, 450)-(875, 525), slv&(8)
_PUTIMAGE (875, 450)-(950, 525), slv&(9)
'=== draw top arrows
FOR t = 0 TO 450 STEP 175
LINE (130 + t, 55)-(160 + t, 25), _RGB(128, 128, 128)
LINE (160 + t, 25)-(190 + t, 55), _RGB(128, 128, 128)
LINE (130 + t, 55)-(190 + t, 55), _RGB(128, 128, 128)
NEXT
'=== draw bottom arrows
FOR t = 0 TO 450 STEP 175
LINE (130 + t, 620)-(160 + t, 650), _RGB(128, 128, 128)
LINE (160 + t, 650)-(190 + t, 620), _RGB(128, 128, 128)
LINE (130 + t, 620)-(190 + t, 620), _RGB(128, 128, 128)
NEXT
'=== draw left arrows
FOR t = 0 TO 450 STEP 175
LINE (20, 160 + t)-(50, 130 + t), _RGB(128, 128, 128)
LINE (20, 160 + t)-(50, 190 + t), _RGB(128, 128, 128)
LINE (50, 130 + t)-(50, 190 + t), _RGB(128, 128, 128)
NEXT
'=== draw right arrows
FOR t = 0 TO 450 STEP 175
LINE (620, 130 + t)-(650, 160 + t), _RGB(128, 128, 128)
LINE (620, 190 + t)-(650, 160 + t), _RGB(128, 128, 128)
LINE (620, 130 + t)-(620, 190 + t), _RGB(128, 128, 128)
NEXT
_DISPLAY
slidespeed = 300
DO
IF _MOUSEBUTTON(1) = 0 THEN clicked = 0
mi = _MOUSEINPUT: mx = _MOUSEX: my = _MOUSEY
IF _MOUSEBUTTON(1) = -1 AND clicked = 0 THEN
clicked = 1
'===== if top-left button clicked...
IF mx > 75 AND mx < 250 AND my > 0 AND my < 75 THEN
'=== slide column up
FOR y = 0 TO size
'=== just move bottom two images up
_PUTIMAGE (bx1(4), by1(4) - y), bv&(4)
_PUTIMAGE (bx1(7), by1(7) - y), bv&(7)
'=== expand bottom location with top image
_PUTIMAGE (bx1(7), by2(7) - y)-(bx2(7), by2(7)), bv&(1)
'=== redraw boxes around them, for looks
LINE (bx1(1), by1(1))-(bx2(1), by2(1)), _RGB(0, 0, 0), B
LINE (bx1(4), by1(4))-(bx2(4), by2(4)), _RGB(0, 0, 0), B
LINE (bx1(7), by1(7))-(bx2(7), by2(7)), _RGB(0, 0, 0), B
_DISPLAY
_LIMIT slidespeed
NEXT
'=== update/assign new values
t1& = bv&(1): t2& = bv&(4): t3& = bv&(7) 'old values
bv&(1) = t2&: bv&(4) = t3&: bv&(7) = t1& 'new values
END IF
'===== if bottom-left button clicked...
IF mx > 75 AND mx < 250 AND my > 600 AND my < 675 THEN
'=== slide column down
FOR y = 0 TO size
'=== expand top location with bottom image
_PUTIMAGE (bx1(1), by1(1))-(bx2(1), by2(1) + y), bv&(7)
'=== just move top two images down
_PUTIMAGE (bx1(1), by1(1) + y), bv&(1)
_PUTIMAGE (bx1(4), by1(4) + y), bv&(4)
'=== redraw boxes around them, for looks
LINE (bx1(1), by1(1))-(bx2(1), by2(1)), _RGB(0, 0, 0), B
LINE (bx1(4), by1(4))-(bx2(4), by2(4)), _RGB(0, 0, 0), B
LINE (bx1(7), by1(7))-(bx2(7), by2(7)), _RGB(0, 0, 0), B
_DISPLAY
_LIMIT slidespeed
NEXT
'=== update/assign new values
t1& = bv&(1): t2& = bv&(4): t3& = bv&(7) 'old values
bv&(1) = t3&: bv&(4) = t1&: bv&(7) = t2& 'new values
END IF
'===== if top-middle button clicked...
IF mx > 250 AND mx < 425 AND my > 0 AND my < 75 THEN
'=== slide column up
FOR y = 0 TO size
'=== just move bottom two images up
_PUTIMAGE (bx1(5), by1(5) - y), bv&(5)
_PUTIMAGE (bx1(8), by1(8) - y), bv&(8)
'=== expand bottom location with top image
_PUTIMAGE (bx1(8), by2(8) - y)-(bx2(8), by2(8)), bv&(2)
'=== redraw boxes around them, for looks
LINE (bx1(2), by1(2))-(bx2(2), by2(2)), _RGB(0, 0, 0), B
LINE (bx1(5), by1(5))-(bx2(5), by2(5)), _RGB(0, 0, 0), B
LINE (bx1(8), by1(8))-(bx2(8), by2(8)), _RGB(0, 0, 0), B
_DISPLAY
_LIMIT slidespeed
NEXT
'=== update/assign new values
t1& = bv&(2): t2& = bv&(5): t3& = bv&(8) 'old values
bv&(2) = t2&: bv&(5) = t3&: bv&(8) = t1& 'new values
END IF
'===== if bottom-middle button clicked...
IF mx > 250 AND mx < 425 AND my > 600 AND my < 675 THEN
'=== slide column down
FOR y = 0 TO size
'=== expand top location with bottom image
_PUTIMAGE (bx1(2), by1(2))-(bx2(2), by2(2) + y), bv&(8)
'=== just move top two images down
_PUTIMAGE (bx1(2), by1(2) + y), bv&(2)
_PUTIMAGE (bx1(5), by1(5) + y), bv&(5)
'=== redraw boxes around them, for looks
LINE (bx1(2), by1(2))-(bx2(2), by2(2)), _RGB(0, 0, 0), B
LINE (bx1(5), by1(5))-(bx2(5), by2(5)), _RGB(0, 0, 0), B
LINE (bx1(8), by1(8))-(bx2(8), by2(8)), _RGB(0, 0, 0), B
_DISPLAY
_LIMIT slidespeed
NEXT
'=== update/assign new values
t1& = bv&(2): t2& = bv&(5): t3& = bv&(8) 'old values
bv&(2) = t3&: bv&(5) = t1&: bv&(8) = t2& 'new values
END IF
'===== if top-right button clicked...
IF mx > 425 AND mx < 600 AND my > 0 AND my < 75 THEN
'=== slide column up
FOR y = 0 TO size
'=== just move bottom two images up
_PUTIMAGE (bx1(6), by1(6) - y), bv&(6)
_PUTIMAGE (bx1(9), by1(9) - y), bv&(9)
'=== expand bottom location with top image
_PUTIMAGE (bx1(9), by2(9) - y)-(bx2(9), by2(9)), bv&(3)
'=== redraw boxes around them, for looks
LINE (bx1(3), by1(3))-(bx2(3), by2(3)), _RGB(0, 0, 0), B
LINE (bx1(6), by1(6))-(bx2(6), by2(6)), _RGB(0, 0, 0), B
LINE (bx1(9), by1(9))-(bx2(9), by2(9)), _RGB(0, 0, 0), B
_DISPLAY
_LIMIT slidespeed
NEXT
'=== update/assign new values
t1& = bv&(3): t2& = bv&(6): t3& = bv&(9) 'old values
bv&(3) = t2&: bv&(6) = t3&: bv&(9) = t1& 'new values
END IF
'===== if bottom-right button clicked...
IF mx > 425 AND mx < 600 AND my > 600 AND my < 675 THEN
'=== slide column down
FOR y = 0 TO size
'=== expand top location with bottom image
_PUTIMAGE (bx1(3), by1(3))-(bx2(3), by2(3) + y), bv&(9)
'=== just move top two images down
_PUTIMAGE (bx1(3), by1(3) + y), bv&(3)
_PUTIMAGE (bx1(6), by1(6) + y), bv&(6)
'=== redraw boxes around them, for looks
LINE (bx1(3), by1(3))-(bx2(3), by2(3)), _RGB(0, 0, 0), B
LINE (bx1(6), by1(6))-(bx2(6), by2(6)), _RGB(0, 0, 0), B
LINE (bx1(9), by1(9))-(bx2(9), by2(9)), _RGB(0, 0, 0), B
_DISPLAY
_LIMIT slidespeed
NEXT
'=== update/assign new values
t1& = bv&(3): t2& = bv&(6): t3& = bv&(9) 'old values
bv&(3) = t3&: bv&(6) = t1&: bv&(9) = t2& 'new values
END IF
'===== if left-top button clicked...
IF mx > 0 AND mx < 75 AND my > 75 AND my < 250 THEN
'=== slide column left
FOR x = 0 TO size
'=== just move right two images left
_PUTIMAGE (bx1(2) - x, by1(2)), bv&(2)
_PUTIMAGE (bx1(3) - x, by1(3)), bv&(3)
'=== and expand far right location with far left image
_PUTIMAGE (bx2(3) - x, by1(3))-(bx2(3) - x, by2(3)), bv&(1)
'=== redraw boxes around them, for looks
LINE (bx1(1), by1(1))-(bx2(1), by2(1)), _RGB(0, 0, 0), B
LINE (bx1(2), by1(2))-(bx2(2), by2(2)), _RGB(0, 0, 0), B
LINE (bx1(3), by1(3))-(bx2(3), by2(3)), _RGB(0, 0, 0), B
_DISPLAY
_LIMIT slidespeed
NEXT
'=== update/assign new values
t1& = bv&(1): t2& = bv&(2): t3& = bv&(3) 'old values
bv&(1) = t2&: bv&(2) = t3&: bv&(3) = t1& 'new values
END IF
'===== if right-top button clicked...
IF mx > 600 AND mx < 675 AND my > 75 AND my < 250 THEN
'=== slide column left
FOR x = 0 TO size
'=== just move left two images right
_PUTIMAGE (bx1(1) + x, by1(1)), bv&(1)
_PUTIMAGE (bx1(2) + x, by1(2)), bv&(2)
'=== and expand far left location with far right image
_PUTIMAGE (bx1(1), by1(1))-(bx1(1) + x, by2(1)), bv&(3)
'=== redraw boxes around them, for looks
LINE (bx1(1), by1(1))-(bx2(1), by2(1)), _RGB(0, 0, 0), B
LINE (bx1(2), by1(2))-(bx2(2), by2(2)), _RGB(0, 0, 0), B
LINE (bx1(3), by1(3))-(bx2(3), by2(3)), _RGB(0, 0, 0), B
_DISPLAY
_LIMIT slidespeed
NEXT
'=== update/assign new values
t1& = bv&(1): t2& = bv&(2): t3& = bv&(3) 'old values
bv&(1) = t3&: bv&(2) = t1&: bv&(3) = t2& 'new values
END IF
'===== if left-middle button clicked...
IF mx > 0 AND mx < 75 AND my > 250 AND my < 425 THEN
'=== slide column left
FOR x = 0 TO size
'=== just move right two images left
_PUTIMAGE (bx1(5) - x, by1(5)), bv&(5)
_PUTIMAGE (bx1(6) - x, by1(6)), bv&(6)
'=== and expand far right location with far left image
_PUTIMAGE (bx2(6) - x, by1(6))-(bx2(6) - x, by2(6)), bv&(4)
'=== redraw boxes around them, for looks
LINE (bx1(4), by1(4))-(bx2(4), by2(4)), _RGB(0, 0, 0), B
LINE (bx1(5), by1(5))-(bx2(5), by2(5)), _RGB(0, 0, 0), B
LINE (bx1(6), by1(6))-(bx2(6), by2(6)), _RGB(0, 0, 0), B
_DISPLAY
_LIMIT slidespeed
NEXT
'=== update/assign new values
t1& = bv&(4): t2& = bv&(5): t3& = bv&(6) 'old values
bv&(4) = t2&: bv&(5) = t3&: bv&(6) = t1& 'new values
END IF
'===== if right-middle button clicked...
IF mx > 600 AND mx < 675 AND my > 250 AND my < 425 THEN
'=== slide column left
FOR x = 0 TO size
'=== just move left two images right
_PUTIMAGE (bx1(4) + x, by1(4)), bv&(4)
_PUTIMAGE (bx1(5) + x, by1(5)), bv&(5)
'=== and expand far left location with far right image
_PUTIMAGE (bx1(4), by1(4))-(bx1(4) + x, by2(4)), bv&(6)
'=== redraw boxes around them, for looks
LINE (bx1(4), by1(4))-(bx2(4), by2(4)), _RGB(0, 0, 0), B
LINE (bx1(5), by1(5))-(bx2(5), by2(5)), _RGB(0, 0, 0), B
LINE (bx1(6), by1(6))-(bx2(6), by2(6)), _RGB(0, 0, 0), B
_DISPLAY
_LIMIT slidespeed
NEXT
'=== update/assign new values
t1& = bv&(4): t2& = bv&(5): t3& = bv&(6) 'old values
bv&(4) = t3&: bv&(5) = t1&: bv&(6) = t2& 'new values
END IF
'===== if left-bottom button clicked...
IF mx > 0 AND mx < 75 AND my > 425 AND my < 600 THEN
'=== slide column left
FOR x = 0 TO size
'=== just move right two images left
_PUTIMAGE (bx1(8) - x, by1(8)), bv&(8)
_PUTIMAGE (bx1(9) - x, by1(9)), bv&(9)
'=== and expand far right location with far left image
_PUTIMAGE (bx2(9) - x, by1(9))-(bx2(9) - x, by2(9)), bv&(7)
'=== redraw boxes around them, for looks
LINE (bx1(7), by1(7))-(bx2(7), by2(7)), _RGB(0, 0, 0), B
LINE (bx1(8), by1(8))-(bx2(8), by2(8)), _RGB(0, 0, 0), B
LINE (bx1(9), by1(9))-(bx2(9), by2(9)), _RGB(0, 0, 0), B
_DISPLAY
_LIMIT slidespeed
NEXT
'=== update/assign new values
t1& = bv&(7): t2& = bv&(8): t3& = bv&(9) 'old values
bv&(7) = t2&: bv&(8) = t3&: bv&(9) = t1& 'new values
END IF
'===== if right-bottom button clicked...
IF mx > 600 AND mx < 675 AND my > 425 AND my < 600 THEN
'=== slide column left
FOR x = 0 TO size
'=== just move left two images right
_PUTIMAGE (bx1(7) + x, by1(7)), bv&(7)
_PUTIMAGE (bx1(8) + x, by1(8)), bv&(8)
'=== and expand far left location with far right image
_PUTIMAGE (bx1(7), by1(7))-(bx1(7) + x, by2(7)), bv&(9)
'=== redraw boxes around them, for looks
LINE (bx1(7), by1(7))-(bx2(7), by2(7)), _RGB(0, 0, 0), B
LINE (bx1(8), by1(8))-(bx2(8), by2(8)), _RGB(0, 0, 0), B
LINE (bx1(9), by1(9))-(bx2(9), by2(9)), _RGB(0, 0, 0), B
_DISPLAY
_LIMIT slidespeed
NEXT
'=== update/assign new values
t1& = bv&(7): t2& = bv&(8): t3& = bv&(9) 'old values
bv&(7) = t3&: bv&(8) = t1&: bv&(9) = t2& 'new values
END IF
'==== check if puzzle is solved....
solved = 1 'assume it is first
FOR s = 1 TO boxes
'=== if piece doesnt match, not solved
IF bv&(s) <> slv&(s) THEN solved = 0
NEXT
'=== Solved? END
IF solved = 1 THEN BEEP: BEEP: END
END IF
LOOP
END
SUB PPRINT (x, y, size, clr&, trans&, text$)
'This sub outputs to the current _DEST set
'It makes trans& the transparent color
'x/y is where to print text
'size is the font size to use
'clr& is the color of your text
'trans& is the background transparent color
'text$ is the string to print
'=== get users current write screen
orig& = _DEST
'=== if you are using an 8 or 32 bit screen
bit = 32: IF _PIXELSIZE(0) = 1 THEN bit = 256
'=== step through your text
FOR t = 0 TO LEN(text$) - 1
'=== make a temp screen to use
pprintimg& = _NEWIMAGE(16, 16, bit)
_DEST pprintimg&
'=== set colors and print text
CLS , trans&: COLOR clr&
PRINT MID$(text$, t + 1, 1);
'== make background color the transprent one
_CLEARCOLOR _RGB(0, 0, 0), pprintimg&
'=== go back to original screen to output
_DEST orig&
'=== set it and forget it
x1 = x + (t * size): x2 = x1 + size
y1 = y: y2 = y + size
_PUTIMAGE (x1 - (size / 2), y1)-(x2, y2 + (size / 3)), pprintimg&
_FREEIMAGE pprintimg&
NEXT
END SUB
RE: QB64 Surabikku - Sliding block puzzle - Dav - 05-08-2022
Wow, @bplus! You sure took this game to a higher level. Great addition. Very challenging now.
- Dav