Proggies

[bplus]

Hot off the presses today, a new proggie (for QB64) called Lights On which is old as the 86's, Fellippe did 910+ LOC here's one a little less complex.

Code: (Select All)

Option _Explicit ' avoid typo's
_Title "Lights On - all the [x, y] cells lit up." ' b+ 2022-04-27 trans Felixp7
' 2022-05-01 Mod for n levels levels

Dim Shared As Long n ' used in most all procedures
Dim As Long x, y, moves, xx, yy
Dim answer$

restart:
Input "Please enter n for n x n board to run, < 2 quits"; n
If n < 2 Or n > 10 Then GoTo restart
ReDim Shared As Long board(1 To n, 1 To n)
moves = 0
For y = 1 To n 'setup puzzle
    For x = 1 To n
        If (Int(Rnd * 2) Mod 2) = 0 Then
            toggle x, y
        End If
    Next
Next
Do 'run the game
    Cls
    showBoard
    Print "Moves: "; moves;
    Input " Your move x,y "; xx, yy ' get user choice, laugh moo ha, ha
    If ((xx > 0) And (xx <= n)) And ((yy > 0) And (yy <= n)) Then ' input OK
        toggle xx, yy
        moves = moves + 1
    Else 'bad input see if want to quit
        Input "Quit game? "; answer$
        answer$ = UCase$(Left$(answer$, 1))
        If answer$ <> "N" Then
            Print "Thanks for playing!"
            End
        End If
    End If
Loop Until lightsOn
Cls
showBoard
Print "You win in"; moves; "moves."
GoTo restart

Sub showBoard () ' default color is 7,0 white on black background unless a lit cell
    Dim As Long x, y
    For y = 1 To n
        For x = 1 To n
            Print " ";
            If board(x, y) Then Color 0, 7 ' light up cell
            Print "["; ns$(x); ","; ns$(y); "]";
            Color 7, 0
        Next
        Print
        Print
    Next
End Sub

Sub toggle (x, y) ' toogle 4 lites around point up, down, left right
    board(x, y) = Not board(x, y) ' switch  x, y
    If x > 1 Then board(x - 1, y) = Not board(x - 1, y)
    If x < n Then board(x + 1, y) = Not board(x + 1, y)
    If y > 1 Then board(x, y - 1) = Not board(x, y - 1)
    If y < n Then board(x, y + 1) = Not board(x, y + 1)
End Sub

Function lightsOn () ' check if lights are all through board return -1 = true if so
    Dim As Long x, y
    For y = 1 To n
        For x = 1 To n
            If board(x, y) = 0 Then Exit Function 'something still off
        Next
    Next
    lightsOn = -1
End Function

Function ns$ (num) ' formated number string for 2 digit integers
    ns$ = Right$("  " + _Trim$(Str$(num)), 2) ' trim because QB64 adds space to pos integers
End Function