Thread Rating:
  • 1 Vote(s) - 1 Average
  • 1
  • 2
  • 3
  • 4
  • 5
QBJS v0.9.0 - Release
#13
Hi @dbox,

I am stumped once again why this works in QB64 but not QBJS. I took out Timer and tried a couple of versions of mouse button catching but best I can do is move 3 blocks and then nothing???

QB64
Code: (Select All)
Option _Explicit
_Title "GUI Sliding Blocks Game "
'Randomize Timer
Dim As Long s, q, r, c, c0, r0, i, update, solved, mc, test, m, mb, mx, my, bx, by
Dim flash$
' get from user the desired board size = s
Do
    Locate 1, 3: Input "(0 quits) Enter your number of blocks per side 3 - 9 you want > ", s
    If s = 0 Then End
Loop Until s > 2 And s < 10

' screen setup: based on the square blocks q pixels a sides
q = 540 / s 'square size, shoot for 540 x 540 pixel board display
Screen _NewImage(q * s + 1, q * s + 1, 32) ': _ScreenMove 360, 60

'initialize board = solution
Dim board(s, s)
For r = 1 To s
    For c = 1 To s
        board(c, r) = c + (r - 1) * s
    Next
Next
board(s, s) = 0: c0 = s: r0 = s

'scramble board for puzzle
For i = 0 To s ^ 5 ' mix blocks
    Select Case Int(Rnd * 4) + 1
        Case 1: If c0 < s Then board(c0, r0) = board(c0 + 1, r0): board(c0 + 1, r0) = 0: c0 = c0 + 1
        Case 2: If c0 > 1 Then board(c0, r0) = board(c0 - 1, r0): board(c0 - 1, r0) = 0: c0 = c0 - 1
        Case 3: If r0 < s Then board(c0, r0) = board(c0, r0 + 1): board(c0, r0 + 1) = 0: r0 = r0 + 1
        Case 4: If r0 > 1 Then board(c0, r0) = board(c0, r0 - 1): board(c0, r0 - 1) = 0: r0 = r0 - 1
    End Select
Next

update = -1 'OK user here you go!
Do
    If update Then 'display status and determine if solved
        solved = -1: update = 0
        For r = 1 To s
            For c = 1 To s
                If board(c, r) Then
                    If board(c, r) <> (r - 1) * s + c Then solved = 0
                    Color _RGB32(255, 255, 255), _RGB32(0, 0, 255)
                    Line ((c - 1) * q + 1, (r - 1) * q + 2)-(c * q - 2, r * q - 2), _RGB32(0, 0, 255), BF
                    _PrintString ((c - 1) * q + .4 * q, (r - 1) * q + .4 * q), Right$(" " + Str$(board(c, r)), 2)
                Else
                    If board(s, s) <> 0 Then solved = 0
                    Color _RGB32(0, 0, 0), _RGB32(0, 0, 0)
                    Line ((c - 1) * q, (r - 1) * q)-(c * q, r * q), , BF
                End If
            Next
        Next
        If solved Then 'flash the Solved Report until user closes window else report status
            '_Display
            flash$ = "Solved!" + Str$(mc) + " Moves." ' in " + Str$(Int(Timer - t)) + " secs."
            While 1: _Title flash$: _Delay .2: _Title "  ": _Delay .2: Wend
        Else
            _Title Str$(mc) + " Moves." ' in " + Str$(Int(Timer - t)) + " secs." + Str$(test)
        End If
        '_Display
    End If

    'get next mouse click, check if on block next to empty space make move or beep
    While _MouseInput: Wend
    mb = _MouseButton(1): mx = _MouseX: my = _MouseY
    If mb And solved = 0 Then 'get last place mouse button was down
        _Delay .25 ' for user to release mb
        'mb = _MouseButton(1): mx = _MouseX: my = _MouseY
        'While mb 'left button down, wait for mouse button release
        'm = _MouseInput: mb = _MouseButton(1): mx = _MouseX: my = _MouseY
        'Wend

        'convert mouse position to board array (x, y) are we near empty space?
        bx = Int(mx / q) + 1: by = Int(my / q) + 1: update = -1
        If bx = c0 + 1 And by = r0 Then
            board(c0, r0) = board(c0 + 1, r0): board(c0 + 1, r0) = 0: c0 = c0 + 1: mc = mc + 1
        ElseIf bx = c0 - 1 And by = r0 Then
            board(c0, r0) = board(c0 - 1, r0): board(c0 - 1, r0) = 0: c0 = c0 - 1: mc = mc + 1
        ElseIf bx = c0 And by = r0 + 1 Then
            board(c0, r0) = board(c0, r0 + 1): board(c0, r0 + 1) = 0: r0 = r0 + 1: mc = mc + 1
        ElseIf bx = c0 And by = r0 - 1 Then
            board(c0, r0) = board(c0, r0 - 1): board(c0, r0 - 1) = 0: r0 = r0 - 1: mc = mc + 1
            'Else
            'Beep
        End If
    End If
Loop

This code I think would be great Sample:
  724  855  599  923  575  468  400  206  147  564  878  823  652  556 bxor cross forever
Reply


Messages In This Thread
QBJS v0.9.0 - Release - by dbox - 01-13-2025, 09:47 PM
RE: QBJS v0.9.0 - Release - by bplus - 01-13-2025, 10:07 PM
RE: QBJS v0.9.0 - Release - by SMcNeill - 01-13-2025, 10:12 PM
RE: QBJS v0.9.0 - Release - by dbox - 01-13-2025, 11:06 PM
RE: QBJS v0.9.0 - Release - by bplus - 01-13-2025, 11:01 PM
RE: QBJS v0.9.0 - Release - by dbox - 01-13-2025, 11:15 PM
RE: QBJS v0.9.0 - Release - by SMcNeill - 01-13-2025, 11:47 PM
RE: QBJS v0.9.0 - Release - by bplus - 01-13-2025, 11:49 PM
RE: QBJS v0.9.0 - Release - by hsiangch_ong - 01-14-2025, 01:09 AM
RE: QBJS v0.9.0 - Release - by vince - 01-14-2025, 01:06 PM
RE: QBJS v0.9.0 - Release - by hsiangch_ong - 01-14-2025, 10:34 PM
RE: QBJS v0.9.0 - Release - by dbox - 01-15-2025, 12:44 AM
RE: QBJS v0.9.0 - Release - by bplus - 01-15-2025, 01:52 AM
RE: QBJS v0.9.0 - Release - by dbox - 01-15-2025, 04:18 AM
RE: QBJS v0.9.0 - Release - by bplus - 01-15-2025, 05:50 AM
RE: QBJS v0.9.0 - Release - by dbox - 01-15-2025, 05:03 PM
RE: QBJS v0.9.0 - Release - by dbox - 01-20-2025, 09:54 PM
RE: QBJS v0.9.0 - Release - by SMcNeill - 01-20-2025, 10:28 PM
RE: QBJS v0.9.0 - Release - by dbox - 01-20-2025, 10:31 PM
RE: QBJS v0.9.0 - Release - by PhilOfPerth - 04-09-2025, 03:40 AM
RE: QBJS v0.9.0 - Release - by grymmjack - 01-15-2025, 05:11 PM
RE: QBJS v0.9.0 - Release - by hsiangch_ong - 01-16-2025, 12:25 AM
RE: QBJS v0.9.0 - Release - by bplus - 01-20-2025, 10:42 PM
RE: QBJS v0.9.0 - Release - by SMcNeill - 01-20-2025, 10:51 PM
RE: QBJS v0.9.0 - Release - by bplus - 01-20-2025, 11:30 PM
RE: QBJS v0.9.0 - Release - by Pete - 01-21-2025, 05:31 PM
RE: QBJS v0.9.0 - Release - by bplus - 01-21-2025, 07:49 PM
RE: QBJS v0.9.0 - Release - by dbox - 02-04-2025, 08:54 PM
RE: QBJS v0.9.0 - Release - by eoredson - 04-09-2025, 02:46 AM
RE: QBJS v0.9.0 - Release - by dbox - 04-09-2025, 12:13 PM
RE: QBJS v0.9.0 - Release - by mdijkens - 04-22-2025, 10:23 AM
RE: QBJS v0.9.0 - Release - by dbox - 04-23-2025, 01:14 AM

Possibly Related Threads…
Thread Author Replies Views Last Post
  QBJS v0.10.0 - Release dbox 12 1,155 Yesterday, 12:38 PM
Last Post: bplus
  QBJS v0.8.0 - Release dbox 11 2,388 02-13-2024, 10:11 PM
Last Post: grymmjack
  QBJS v0.8.2 - Release dbox 0 574 02-02-2024, 11:29 PM
Last Post: dbox
  BAM: Release notes in the works for upcoming release CharlieJV 6 1,445 10-12-2023, 01:42 AM
Last Post: CharlieJV
  QBJS v0.7.0 - Release dbox 19 4,227 06-12-2023, 07:48 PM
Last Post: dbox

Forum Jump:


Users browsing this thread: 2 Guest(s)