Smallish Games

[bplus]

Nonogram Trainer

Inspired and made aware of Nonograms by RokCoder here:
https://qb64phoenix.com/forum/showthread...7#pid12467

I made a Nonogram Trainer here to get up to speed on solving these kinds of puzzles. You can start with trivial 1x1 and work your way up to 9x9 puzzles. Then you might be ready for RokCoder's puzzle with the works!

Instructions: after choosing the number of cells per side you want to try, you will be presented a grid with number along each row and col. Those numbers represent a run of white squares in that row or col. By clicking the cells on or off, your goal is to match those runs in rows and cols.

Code: (Select All)

_Title "Nonogram Trainer" ' b+ 2023-01-12
DefLng A-Z
Randomize Timer
Dim Shared As _Unsigned Long White, Black, Blue
White = &HFFFFFFFF: Black = &HFF000000: Blue = &HFF0000FF
ReDim Shared Sq, Game(1 To 1, 1 To 1), Board(1 To 1, 1 To 1), RowRuns$(1 To 1), ColRuns$(1 To 1)
Screen _NewImage(800, 600, 32)
makeGame
Do
    10 If _MouseInput Then GoTo 10
    mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
    If mb Then
        _Delay .2
        If mx > 20 And mx <= Sq * 20 + 40 Then
            If my > 20 And my <= Sq * 20 + 40 Then
                x = Int(mx / 20): y = Int(my / 20)
                If Board(x, y) Then Board(x, y) = 0 Else Board(x, y) = 1
                If Board(x, y) Then Color White Else Color Black
                Line (x * 20, y * 20)-Step(20, 20), , BF
                Line (x * 20, y * 20)-Step(20, 20), Blue, B
            End If
        End If
    End If
    If Solved Then _MessageBox "Solved", "Hurray you've solved the puzzle!": makeGame
    _Limit 60
Loop Until _KeyDown(27)

Sub makeGame
    Cls
    inputAgain:
    Input "How many cells per square side (1 to 9) "; test
    If test < 1 Or test > 9 Then GoTo inputAgain Else Cls: Sq = test
    ReDim Game(1 To Sq, 1 To Sq), Board(1 To Sq, 1 To Sq), RowRuns$(1 To Sq), ColRuns$(1 To Sq)
    Line (18, 18)-(Sq * 20 + 22, Sq * 20 + 22), White, B
    For y = 1 To Sq
        For x = 1 To Sq
            If Rnd < .5 Then Game(x, y) = 0 Else Game(x, y) = 1
            Line (x * 20, y * 20)-Step(20, 20), Blue, B
        Next
    Next
    Color White
    For i = 1 To Sq
        RowRuns$(i) = Runs$(1, i, Game())
        _PrintString (Sq * 20 + 30, i * 20 + 4), RowRuns$(i)
        ColRuns$(i) = Runs$(0, i, Game())
    Next
    For i = 1 To Sq
        row = Sq + 1: lastp = 1: start = 1
        p = InStr(ColRuns$(i), " ")
        While p
            _PrintString (i * 20 + 6, row * 20 + 10), Mid$(ColRuns$(i), start, 1)
            start = start + 2: row = row + 1
            p = InStr(start, ColRuns$(i), " ")
        Wend
        _PrintString (i * 20 + 6, row * 20 + 10), Mid$(ColRuns$(i), start)
    Next
End Sub

Function Runs$ (rowTF, number, arr())
    If rowTF Then
        If arr(1, number) Then flag = 1
        For i = 2 To Sq
            If arr(i, number) Then
                If flag Then flag = flag + 1 Else flag = 1
            Else
                If flag Then
                    If Len(b$) Then b$ = b$ + " " + _Trim$(Str$(flag)) Else b$ = _Trim$(Str$(flag))
                    flag = 0
                End If
            End If
        Next
        If flag Then
            If Len(b$) Then b$ = b$ + " " + _Trim$(Str$(flag)) Else b$ = _Trim$(Str$(flag))
        End If
    Else
        If arr(number, 1) Then flag = 1
        For i = 2 To Sq
            If arr(number, i) Then
                If flag Then flag = flag + 1 Else flag = 1
            Else
                If flag Then
                    If Len(b$) Then b$ = b$ + " " + _Trim$(Str$(flag)) Else b$ = _Trim$(Str$(flag))
                    flag = 0
                End If
            End If
        Next
        If flag Then
            If Len(b$) Then b$ = b$ + " " + _Trim$(Str$(flag)) Else b$ = _Trim$(Str$(flag))
        End If
    End If
    Runs$ = b$
End Function

Function Solved
    For i = 1 To Sq
        If RowRuns$(i) <> Runs$(1, i, Board()) Then Exit Function 'not done
        If ColRuns$(i) <> Runs$(0, i, Board()) Then Exit Function
    Next
    Solved = -1
End Function

   

Thanks for sharing your Nonogram app RokCoder.