Advent of Code Day 4

This was a fun one. I’ve been reading tutorials for QB64 (the unauthorized successor to QBasic) the past week or so, because I have that kind of time. Decided to add a bit of visualization too.

Quickly relearned the importance of Option Explicit! IYKYK.

Option Base 0 'Arrays zero-indexed for sanity
Option _Explicit ' Also for sanity

' Declare Variables
Dim CurrentRow%, CurrentCol%, AccessibleRolls%, InaccessibleRolls%, AdjacentRolls%
Dim InnerRow%, InnerCol%, Ch$, i%, RemovedRolls%
Dim FileName$
Dim Shared InputRowCount%
ReDim Shared InputArray$(200) 'create dynamic array

' Configure output screen
Screen 0
Width 138, 138

' Get the input file and read it into array
ChDir "C:\Users\burgd\source\repos\Advent2025\day4"
Print "Enter the input filename:"
Input FileName$

InputRowCount% = 0
If _FileExists(FileName$) Then
    Print "FIle Found"
    i% = 0
    Open FileName$ For Input As #1
    Do Until EOF(1)
        Line Input #1, InputArray$(i%)
        i% = i% + 1
        InputRowCount% = InputRowCount% + 1
    Loop
    Close #1
Else
    Print "File Not FOUND!"
End If
Print "Press any key to continue"
Sleep

Cls

'Main logic for determining movable rolls
CurrentRow% = 0
AccessibleRolls% = 1
InaccessibleRolls% = 0
RemovedRolls% = 0

While AccessibleRolls% > 0
    AccessibleRolls% = 0
    CurrentRow% = 0
    InaccessibleRolls% = 0
    While CurrentRow% < InputRowCount%
        CurrentCol% = 1 ' Mid function starts at 1
        While CurrentCol% <= Len(InputArray$(CurrentRow%))
            Ch$ = Mid$(InputArray$(CurrentRow%), CurrentCol%, 1)
            If Ch$ = "@" Or Ch$ = "x" Then
                Cls
                AdjacentRolls% = 0
                For InnerRow% = Max(CurrentRow% - 1, 0) To Min(CurrentRow% + 1, InputRowCount% - 1)
                    For InnerCol% = Max(CurrentCol% - 1, 1) To Min(CurrentCol% + 1, Len(InputArray$(InnerRow%)))
                        If Not (InnerRow% = CurrentRow% And InnerCol% = CurrentCol%) Then
                            Ch$ = Mid$(InputArray$(InnerRow%), InnerCol%, 1)
                            If Ch$ = "@" Or Ch$ = "x" Then
                                AdjacentRolls% = AdjacentRolls% + 1
                            End If
                        End If
                    Next InnerCol%
                Next InnerRow%
                If AdjacentRolls% < 4 Then
                    Mid$(InputArray$(CurrentRow%), CurrentCol%, 1) = "x"
                    Cls
                    PrintDiagram
                    AccessibleRolls% = AccessibleRolls% + 1
                End If
            End If
            CurrentCol% = CurrentCol% + 1
        Wend
        CurrentRow% = CurrentRow% + 1
    Wend
    Cls
    RemovedRolls% = RemovedRolls% + AccessibleRolls%
    ClearRemovedRolls
Wend

Cls
Print "Total rolls removed!: " + Str$(RemovedRolls%)
Sleep

Sub PrintDiagram ()
    Dim i%, j%, ch$
    For i% = 0 To InputRowCount%
        For j% = 1 To Len(InputArray$(i%))
            ch$ = Mid$(InputArray$(i%), j%, 1)
            If ch$ = "x" Then
                Color 11
            Else
                Color 15
            End If
            Print ch$;
        Next j%
        Print
    Next i%
    Color 15
    _Display
End Sub

Sub ClearRemovedRolls ()
    Dim i%, j%, ch$
    For i% = 0 To InputRowCount%
        For j% = 1 To Len(InputArray$(i%))
            ch$ = Mid$(InputArray$(i%), j%, 1)
            If ch$ = "x" Then
                Mid$(InputArray$(i%), j%, 1) = "."
            End If
        Next j%
    Next i%
End Sub

Function Min% (Number1%, Number2%)
    If Number1% <= Number2% Then
        Min% = Number1%
    Else
        Min% = Number2%
    End If
End Function

Function Max% (Number1%, Number2%)
    If Number1% >= Number2% Then
        Max% = Number1%
    Else
        Max% = Number2%
    End If
End Function