'=============
'SURABIKKU.BAS
'=============
'QB64 version of a SURABIKKU like puzzle.
'Coded by Dav, OCT/2021
'define deminsions for chessboard
DIM SHARED row
, col
, size: row
= 3: col
= 3: size
= 175
'define box value, x/y, values...
DIM SHARED bv&
(boxes
) 'box values (scrambled) DIM SHARED bx1
(boxes
), by1
(boxes
) 'top x/y cords of box DIM SHARED bx2
(boxes
), by2
(boxes
) ' bottom x/y cords of box
'draw color boxes
'init box x.y values
bc = 1 'counter
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
'assign scramble 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
_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
slidespeed = 300
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
'draw top arrows
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) 'draw bottom arrows
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) 'draw left arrows
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) 'draw right arrows
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)
'LOCATE 1, 1: PRINT mx, my, _MOUSEBUTTON(1)
'_DISPLAY
clicked = 1
'===== if top-left button clicked...
'slide column up
'just move bottom two images up
'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
'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
'===== if bottom-left button clicked...
'slide column down
'expand top location with bottom image
_PUTIMAGE (bx1
(1), by1
(1))-(bx2
(1), by2
(1) + y
), bv&
(7) 'just move top two images down
'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
'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
'===== if top-middle button clicked...
'slide column up
'just move bottom two images up
'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
'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
'===== if bottom-middle button clicked...
'slide column down
'expand top location with bottom image
_PUTIMAGE (bx1
(2), by1
(2))-(bx2
(2), by2
(2) + y
), bv&
(8) 'just move top two images down
'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
'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
'===== if top-right button clicked...
'slide column up
'just move bottom two images up
'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
'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
'===== if bottom-right button clicked...
'slide column down
'expand top location with bottom image
_PUTIMAGE (bx1
(3), by1
(3))-(bx2
(3), by2
(3) + y
), bv&
(9) 'just move top two images down
'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
'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
'===== if left-top button clicked...
'slide column left
'just move right two images left
'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
'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
'===== if right-top button clicked...
'slide column left
'just move left two images right
'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
'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
'===== if left-middle button clicked...
'slide column left
'just move right two images left
'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
'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
'===== if right-middle button clicked...
'slide column left
'just move left two images right
'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
'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
'===== if left-bottom button clicked...
'slide column left
'just move right two images left
'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
'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
'===== if right-bottom button clicked...
'slide column left
'just move left two images right
'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
'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
'==== check for solved here....
solved = 1
IF bv&
(s
) <> slv&
(s
) THEN solved
= 0
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
'=== if you are using an 8 or 32 bit screen
'=== step through your text
'=== make a temp screen to use
'=== set colors and print text
'== make background color the transprent one
'=== go back to original screen to output
'=== 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&