Behold...
A new data structure for qb64 - The Container
It has many advantages:
* very fast add and delete
* very fast access

Keep in mind that this is not an indexed list, which means:
It shouldn't be used to for search, though it can be used to maintain counts...
It is actually used in Entity Component Systems, and not in many other simple things.

But this can be used in AI projects, to maintain a huge amount of entities.
It is actually configured for 4 byte Unsigned Long values, but it can be configured for fixed length strings.

$Console:Only

Const Total = 16777216 ' 12 seconds on my arm64 laptop

ST! = Timer(0.01)

C$ = ContainerNewCapacity$(16777216)

Print "Container built in"; Timer(0.01) - ST!; "seconds"

Print "Length of C$: "; PrintSize(Len(C$))

For I = 1 To Total

    B~& = _RGBA32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))

    ContainerAdd C$, B~&

Next I

Print Timer(0.01) - ST!

Sleep

System

Function ContainerNew$ () Static

    Static I As _Unsigned Long

    Static __S$

    __S$ = String$(64, 0): For I = 1 To 64 Step 4: Mid$(__S$, I, 4) = MKL$(_ShR(I, 2)): Next I

    ContainerNew$ = Chr$(16) + MKL$(16) + MKL$(0) + __S$ + __S$ + String$(64, 0)

    ' Signature + Capacity + Length + Index + Index Inverse + Data

End Function

Function ContainerNewCapacity$ (Capacity As _Unsigned Long) Static

    Static As _Unsigned Long I, J

    Static __S$

    __S$ = String$(_ShL(Capacity, 2), 0)

    For I = 1 To _ShL(Capacity, 2) Step 4

        J = _ShR(I, 2)

        Asc(__S$, I) = _Blue32(J)

        Asc(__S$, I + 1) = _Green32(J)

        Asc(__S$, I + 2) = _Red32(J)

        Asc(__S$, I + 3) = _Alpha32(J)

    Next I

    ContainerNewCapacity$ = Chr$(16) + MKL$(Capacity) + MKL$(0) + __S$ + __S$ + String$(_ShL(Capacity, 2), 0)

End Function

Sub ContainerAdd (Container As String, Element As _Unsigned Long) Static

    Static Length~&, Capacity~&

    If Len(Container) < 9 _OrElse Asc(Container) <> 16 Then Container = ContainerNew$

    Capacity~& = _RGBA32(Asc(Container, 4), Asc(Container, 3), Asc(Container, 2), Asc(Container, 5))

    Length~& = _RGBA32(Asc(Container, 8), Asc(Container, 7), Asc(Container, 6), Asc(Container, 9))

    If Capacity~& <= Length~& Then ContainerResizeCapacity Container, _IIf(Capacity~& < 1048576, _ShL(Capacity~&, 1), Capacity~& + 1048576)

    Capacity~& = _RGBA32(Asc(Container, 4), Asc(Container, 3), Asc(Container, 2), Asc(Container, 5))

    Mid$(Container, 6, 4) = MKL$(Length~& + 1)

    Asc(Container, 10 + _ShL(Capacity~&, 3) + _ShL(Length~&, 2)) = _Blue32(Element)

    Asc(Container, 11 + _ShL(Capacity~&, 3) + _ShL(Length~&, 2)) = _Green32(Element)

    Asc(Container, 12 + _ShL(Capacity~&, 3) + _ShL(Length~&, 2)) = _Red32(Element)

    Asc(Container, 9 + _ShL(Capacity~&, 3) + _ShL(Length~&, 2)) = _Alpha32(Element)

End Sub

Function ContainerLength~& (Container As String) Static

    ContainerLength~& = _RGBA32(Asc(Container, 8), Asc(Container, 7), Asc(Container, 6), Asc(Container, 9))

End Function

Function ContainerCapacity~& (Container As String) Static

    ContainerCapacity~& = _RGBA32(Asc(Container, 4), Asc(Container, 3), Asc(Container, 2), Asc(Container, 5))

End Function

Sub ContainerResizeCapacity (Container As String, NewSize As _Unsigned Long) Static

    Static Length~&, Capacity~&

    Capacity~& = _RGBA32(Asc(Container, 4), Asc(Container, 3), Asc(Container, 2), Asc(Container, 5))

    Length~& = _RGBA32(Asc(Container, 8), Asc(Container, 7), Asc(Container, 6), Asc(Container, 9))

    __T~& = _ShL(Capacity~&, 2)

    __Index$ = Mid$(Container, 10, __T~&)

    __IndexInverse$ = Mid$(Container, 10 + __T~&, __T~&)

    __Data$ = Mid$(Container, 10 + _ShL(__T~&, 1), _ShL(__T~&, 2))

    NewSize = _Max(Length~&, NewSize)

    __T~& = NewSize - Capacity~&

    If NewSize > Capacity~& Then

        __Index$ = __Index$ + String$(_ShL(__T~&, 2), 0)

        __IndexInverse$ = __IndexInverse$ + String$(_ShL(__T~&, 2), 0)

        __Data$ = __Data$ + String$(_ShL(__T~&, 2), 0)

    Else

        __Index$ = Left$(__Index$, _ShL(NewSize, 2))

        __IndexInverse$ = Left$(__IndexInverse$, _ShL(NewSize, 2))

        __Data$ = Left$(__Data$, _ShL(Length~&, 2))

    End If

    For I = 1 + _ShL(Capacity~&, 2) To _ShL(NewSize, 2) Step 4

        Mid$(__Index$, I, 4) = MKL$(_ShR(I, 2))

        Mid$(__IndexInverse$, I, 4) = MKL$(_ShR(I, 2))

    Next I

    Container = Chr$(16) + MKL$(NewSize) + MKL$(Length~&) + __Index$ + __IndexInverse$ + __Data$

End Sub

Function ContainerGet~& (Container As String, Index As _Unsigned Long) Static

    Static Length~&, Capacity~&, __Index~&

    Capacity~& = _RGBA32(Asc(Container, 4), Asc(Container, 3), Asc(Container, 2), Asc(Container, 5))

    Length~& = _RGBA32(Asc(Container, 8), Asc(Container, 7), Asc(Container, 6), Asc(Container, 9))

    __T~& = _ShL(Index, 2)

    __Index~& = _RGBA32(Asc(Container, 12 + __T~&), Asc(Container, 11 + __T~&), Asc(Container, 10 + __T~&), Asc(Container, 13 + __T~&))

    __Index~& = 10 + _ShL(__Index~&, 2) + _ShL(Capacity~&, 3)

    ContainerGet~& = _RGBA32(Asc(Container, 2 + __Index~&), Asc(Container, 1 + __Index~&), Asc(Container, __Index~&), Asc(Container, 3 + __Index~&))

End Function

Function PrintSize$ (__T As _Unsigned Long)

    If __T = 0 Then

        PrintSize$ = "0 B"

        Exit Function

    End If

    Select Case Int(Log(__T) / Log(2) / 10)

        Case 0: PrintSize$ = _ToStr$(__T) + " B"

        Case 1: PrintSize$ = _ToStr$(Round(__T / _ShL(1, 10))) + " KB"

        Case 2: PrintSize$ = _ToStr$(Round(__T / _ShL(1, 20))) + " MB"

        Case 3: PrintSize$ = _ToStr$(Round(__T / _ShL(1, 30))) + " GB"

    End Select

End Function

Function Round! (__N As Double)

    Round! = Int(100 * __N) / 100

End Function

My goal with this one was to simulate a black hole's accretion disk using my standard vector library tools. It will eventually settle down to the entropic disk that I was after, but I wasn't expecting the initial splash patterns. I like how the particles will arrange themselves into discrete orbit shells. That said, this is NOT a gravity simulation, as attraction does not vary with distance.

Use the space bar to display a green "event horizon", which shows how close the orbits skim it.

It's an amusement to change some of the parameters and see how it affects the pattern and/or number of survivors.

The number in the upper right corner is the number of surviving particles, the rest are lost, forever lost!

If you stare at it long enough the world will start spinning too. Maybe you might also begin to feel sleepy and have an irresistible urge to send me a sizeable check.

I am.

   

   

I can make a million, all different

Here is Quick Sort versus Comb Demo with 1000000 randomly chosen "words" <<< this means they aren't actually all words you can find in a dictionary, they are made randomly from this:
b$ = b$ + Mid$("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789.?", (Rnd * 64) \ 1 + 1, 1))

' FiliSort v1.0

' This a very simple sorting method, a lot faster than Bubblesort

' For 50000 numbers in my pc, it takes 16.43 sec

' while the Bubble Sort takes 29.18 sec



Screen _NewImage(800, 700, 32)



Dim Shared tn As Long

tn = 20000 ' total numbers to sort

Dim Shared n(tn) As Single



Randomize Timer

For i = 1 To tn: n(i) = Rnd * 100 - 50: Next i



timer1! = Timer

Print "Sorting..."; tn; "numbers": Print "Timer starts:"; timer1!



FiliSort n()



timer2! = Timer

Print "Timer ends:"; timer2!; "    Seconds:"; (timer2! - timer1!) / 1.18



'For k = 1 To tn: Print n(k): Next k



End



Sub FiliSort (n())

    For k = 1 To tn / 2

        min = n(k): max = n(tn - k + 1)

        imin = 0: imax = 0

        For i = k To tn - k

            If min > n(i + 1) Then min = n(i + 1): imin = i + 1 'find the minimum of the numbers

            If max <= n(i) Then max = n(i): imax = i 'find the maximum of the numbers

        Next i

        If imin > 0 Then n(imin) = n(k): n(k) = min

        If imax = k Then imax = imin

        If imax > 0 Then n(imax) = n(tn - k + 1): n(tn - k + 1) = max

    Next k

End Sub

Hi to all.

In my early years as a Pascal programmer, I remember that I could do something like this:

Type T_Thing

    Namez As String

    Index(4) as integer

End Type

A.Index(1)=5

An updated version of the ebook file/folder tool which I shared on here somewhere in the past:

$Let RENAME = TRUE

$Let MOVEDIR = FALSE





Screen _NewImage(1280, 720, 32)



ReDim As String FileList(0), f '                be certain to reset your file listing to 0 files like this, before calling the recursive version

Dim i As Long



ChDir "Z:\Books Sorting\"

Disk.File.List "", "", 1, FileList() '      get a list of all files in the directory





$If RENAME Then

    'this will rename all the files from "LAST, FIRST -- BOOKTITLE" to "FIRST LAST -- BOOKTITLE"

    For i = 1 To UBound(FileList)

        b$ = FileList(i)

        comma = InStr(b$, ",")

        dash = InStr(b$, " - ")

        If comma <> 0 _AndAlso comma < dash Then

            n$ = Left$(b$, dash)

            last$ = _Trim$(Left$(n$, comma - 1))

            first$ = _Trim$(Mid$(n$, comma + 1))

            newname$ = first$ + " " + last$ + Mid$(FileList(i), InStr(FileList(i), " - "))

            Print FileList(i), newname$

            Name FileList(i) As newname$

        End If

    Next

$End If 





$If MOVEDIR Then

    'this will then take the properly named books and put them in their own subfolders

    'so all books by Stephen King are now in a folder called Stephen King

    For i = 1 To UBound(FileList)

        filename$ = FileList(i)

        Print filename$; " =>";

        If _FileExists(filename$) Then

            period = _InStrRev(filename$, ".")

            If period Then

                file_no_ext$ = Left$(filename$, period - 1)

            Else

                file_no_ext$ = filename$

            End If

        Else

            Print "File not found.  Check paths for error."

            _Continue

        End If

        dash = InStr(file_no_ext$, " -")

        If dash Then file_no_ext$ = Left$(file_no_ext$, dash - 1)

        If _DirExists(file_no_ext$) = 0 Then MkDir file_no_ext$

        Name filename$ As file_no_ext$ + "\" + filename$

        Print file_no_ext$ + "\" + filename$



    Next

$End If 













Sub Disk.File.List (SearchDir As String, Extension As String, Flag As Long, ReturnArray() As String)

    'flags are binary bits which represent the following

    'Note that a quick value of -1 will set all bits and return everything for us

    '1 -- file listing

    '2 -- directory listing

    '4 -- sorted (directory before file, like windows explorer does) -- implies 1 + 2 both are wanted.

    '8 -- return full path info

    Dim As Long FileCount, pass

    Dim As String Search, File, Slash

    ReDim ReturnArray(1000) As String

    If SearchDir = "" Then SearchDir = _CWD$: If Extension = "" Then Extension = "*"

    If InStr(_OS$, "WIN") Then Slash = "\" Else Slash = "/"

    If Right$(SearchDir, 1) <> "/" _AndAlso Right$(SearchDir, 1) <> "\" Then SearchDir = SearchDir + Slash

    Search = SearchDir + Extension

    If Flag And 4 Then 'sorted so we get directory listings then files

        For pass = 1 To 2 'two passes, first to get directory listings then files

            File = _Files$(Search)

            Do While Len(File)

                If File = ".\" _OrElse File = "..\" Then



                Else

                    If ((pass = 1) _AndAlso _DirExists(SearchDir + File)) _OrElse ((pass = 2) _AndAlso _FileExists(SearchDir + File)) Then

                        FileCount = FileCount + 1

                        If FileCount > UBound(ReturnArray) Then ReDim _Preserve ReturnArray(FileCount + 1000) As String

                        If Flag And 8 Then File = SearchDir + File 'we want the full path info

                        ReturnArray(FileCount) = File

                    End If

                End If

                File = _Files$

            Loop

        Next

    Else 'unsorted so files and directories are simply listed in alphabetical order

        File = _Files$(Search) 'one single pass where we just grab all the info at once

        Do While Len(File)

            If File = ".\" _OrElse File = "..\" Then



            Else

                If ((Flag And 1) _AndAlso _FileExists(SearchDir + File)) _OrElse ((Flag And 2) _AndAlso _DirExists(SearchDir + File)) Then

                    FileCount = FileCount + 1

                    If FileCount > UBound(ReturnArray) Then ReDim _Preserve ReturnArray(FileCount + 1000) As String

                    If Flag And 8 Then File = SearchDir + File 'we want the full path info

                    ReturnArray(FileCount) = File

                End If

            End If

            File = _Files$

        Loop

    End If

    ReDim _Preserve ReturnArray(FileCount) As String

End Sub

Revisiting an old old game puzzle I made years ago! Then, I filled the board randomly with red and blue squares and had no idea if you could actually get down to only one red and one blue cell. So I revised the BoardSetup code to start with a red and blue cell at a given spot 1,1 and 2,1 for 4x4 and reversed engineered clicks to build a puzzle with an exact solution. Trouble WAS most puzzles built this way were trivial to solve ie a sea of red and a sea of blue with no islands of the opposite color to make the puzzle challenging. What I needed was an expansion function that could isolate a cell, one color surrounded by the opposite. Still it takes awhile to get a non trivial puzzle built but finally got it all worked out so you can use a little logic and solve each puzzle perfectly returning the Puzzle state back to the seed start state.

You have solved the Puzzle "good" when you can get it down to 2 cells:
   

You have solved the Puzzle "better" when you get 2 cells adjacent to each other:
   

You have Not solved the Puzzle when you see this:
   

And you have solved the Puzzle Perfectly with exact positioning of red and blue like this:
   

So here is the Puzzle code:

_Title "4x4 Square Elimination Puzzle 2026-03-04" ' b+ port and severely updated mods from

'square elimination v4.bas SmallBASIC 0.12.7 [B+=MGA] 2016-10-03 one of the first games I ever made in BASIC



Randomize Timer

Screen _NewImage(400, 400, 32)

_Delay .25

_ScreenMove _Middle



Const BS = 360 'BS = Board Size in pixels notice 360 divisible 4, 9, 5

Dim Shared SPS, SPSm1, SS, State, LastX, LastY, Quit, WatchBoardSetup, MoreBlue, NRed, NBlue, SaveRX, SaveRY

' SPS = Squares Per Side this 4x4 Puzzle comes from a bigger version where you say how many SPS you want.

' SPSm1 = SPS minus 1

' SS = Square Side size in pixels

' State = tracks mouse clicks 0 no cliciks and 1 on 2nd click

' LastX, LastY = last mouse click

' Quit signals done with p[uzzle

' WatchBoardSetup for watching Puzzle builds to create non trivial puzzles

' MoreBlue used to balance number of red squares and blue

' NRed, NBlue track how many of each square used to rate solutions

' SaveRX, SaveRY used to track first red cell found, again for rating a puzzle solution.



ReDim Shared Board(1, 1) ' Board needed dynamic ReDim for various possible sizes



WatchBoardSetup = 0 ' watching board builds step by boring step, even watching just the expansions,

'                  it takes a lot of builds to get a board with an isolated cell = non trivial puzzle !!



Instructions ' only once for 4x4 puzzle

While _KeyDown(27) = 0

    'continue = Instructions 'gets the number of squares per side, SPS

    'If continue < 3 Or continue > 20 Then Stop Else SPS = continue

    SPS = 4

    SPSm1 = SPS - 1

    SS = BS / SPS



    State = 0

    Cls

    BoardSetup

    Update

    Quit = 0

    Do ' puzzle Loop

        While _MouseInput: Wend

        mx = _MouseX - 20: my = _MouseY: mb = _MouseButton(1)

        k$ = InKey$

        If k$ = "q" Or _KeyDown(27) Then Quit = 1

        If mb And mx < BS And my < BS Then

            _Delay .25

            col = Int(mx / SS)

            row = Int(my / SS)

            If State = 0 Then

                If (Board(col, row) = -1 Or Board(col, row) = 1) Then

                    LastX = col: LastY = row: State = 1

                End If

            Else

                moov = Moved(LastX, LastY, col, row)

                Select Case moov

                    Case 1 ' Moved up

                        For i = LastY To SPSm1

                            Board(LastX, i - 1) = Board(LastX, i)

                        Next

                        Board(LastX, SPSm1) = 0

                    Case 2 ' Moved right

                        For i = LastX To 0 Step -1

                            Board(i + 1, LastY) = Board(i, LastY)

                        Next

                        Board(0, LastY) = 0

                    Case 3 ' Moved down

                        For i = LastY To 0 Step -1

                            Board(LastX, i + 1) = Board(LastX, i)

                        Next

                        Board(LastX, 0) = 0

                    Case 4 ' Moved left

                        For i = LastX To SPSm1

                            Board(i - 1, LastY) = Board(i, LastY)

                        Next

                        Board(SPSm1, LastY) = 0

                End Select

                LastX = -10: LastY = -10: State = 0

            End If

            Update

            _Limit 30

        End If 'mouse on board

    Loop Until Quit

Wend

System



Sub BoardSetup

    'attempting to setup Board so that it is possible to eliminate squares down to 2 one of each color

    'and not be a trivial puzzle to solve ie 1 sea of red and one sea of blue, no islands of opposite color.

    ' ideally islands of blue in sea of red and vice versa BTW it doesn't work for 3x3.

    '

    ' Non trivial solutions have a least one isolated cell, that's what we will display for puzzle.



    ' If WatchBoardSetup Then Sleep code was for watching puzzle builds kinda fun except for stopping all



    ReDim Board(SPSm1, SPSm1) ' clears array

    ' seed

    Board(SPSm1 \ 2, SPSm1 \ 2) = -1 '    red cell at 1,1 for 4x4 board

    Board(SPSm1 \ 2 + 1, SPSm1 \ 2) = 1 ' blue cell at 2, 1 for 4x4 board

    DrawBoard

    Do While EmptySpace ' drawing board to show program is thinking up a non trivial puzzle, takes awhile

        try = 0

        While 1

            x = Int(Rnd * SPS): y = Int(Rnd * SPS)

            ok = 0



            If Board(x, y) = turn Then

                ok = Expand(x, y) ' <<< without one good one of these, the puzzle will be trivial!

                If ok Then

                    DrawBoard

                    If WatchBoardSetup Then Sleep

                End If



            ElseIf Board(x, y) = 0 Then ' this works but takes awhile to isolate

                'ElseIf Board(x, y) <> turn Then ' no this makes it harder to isolate



                '    ' Do I need ElseIf ? would I not get a harder board without it

                '    ' NO IT IS NEEDED! What if we try first? eh not terrible but...

                If LikeColorNextTo(turn, x, y) And Rnd < .1 Then ' decrease these  with rnd

                    Board(x, y) = turn: DrawBoard: ok = -1

                    ''dummy = Expand(x, y) ' test for more expansions, nope! ?

                End If



            End If

            If ok = 0 Then

                try = try + 1

                If try > SPSm1 ^ 3 Then

                    If turn = -1 Then turn = 1 Else turn = -1

                    try = 0

                End If

            Else

                Exit While

            End If

        Wend

        If MoreBlue Then turn = -1 Else turn = 1

    Loop

    ' will this work?  yes back this up 2026-03-02_11_11A



    ' now that board is set does it have an isolated cell? if not a 3x3 board

    If SPS <> 3 _AndAlso BoardHasIsolatedCell = 0 Then BoardSetup ' get us a non trivial board

    ' backup = SEG 2026-03-02_11_41A

End Sub



Function EmptySpace

    For y = 0 To SPSm1

        For x = 0 To SPSm1

            If Board(x, y) = 0 Then EmptySpace = -1: Exit Function

        Next

    Next

End Function



Function BoardHasIsolatedCell

    BoardHasIsolatedCell = 0 ' assume NOT and see if can find exception

    For y = 0 To SPSm1

        For x = 0 To SPSm1

            If LikeColorNextTo(Board(x, y), x, y) = 0 Then BoardHasIsolatedCell = -1: Exit Function

        Next

    Next

End Function



Function LikeColorNextTo (colr, x, y) ' for setup

    If x - 1 >= 0 Then

        If Board(x - 1, y) = colr Then LikeColorNextTo = -1: Exit Function

    End If

    If x + 1 <= SPSm1 Then

        If Board(x + 1, y) = colr Then LikeColorNextTo = -1: Exit Function

    End If

    If y - 1 >= 0 Then

        If Board(x, y - 1) = colr Then LikeColorNextTo = -1: Exit Function

    End If

    If y + 1 <= SPSm1 Then

        If Board(x, y + 1) = colr Then LikeColorNextTo = -1: Exit Function

    End If

    ' else LikeColorNextTo returns 0

End Function



Function Expand (x, y) ' this will leave x, y same color

    'and slide all cells in a direction that has an opening if there is one

    startDir = Int(Rnd * 4) + 1 ' pick random direction

    dir = startDir

    Do ' try each dir until we find an opening to expand

        Select Case dir

            Case 1 ' Move up

                If y <> 0 Then ' y is not at top so look for space

                    For yy = y - 1 To 0 Step -1

                        If Board(x, yy) = 0 Then 'yes a space, expand this dir

                            For yyy = yy To y - 1 ' reassign board cells but not x, y

                                Board(x, yyy) = Board(x, yyy + 1)

                            Next

                            Expand = -1: Exit Function

                        End If

                    Next yy

                End If

            Case 2 ' Move right

                If x <> SPSm1 Then ' not all the way right so look for space to right

                    For xx = x + 1 To SPSm1

                        If Board(xx, y) = 0 Then 'yes a space, expand this dir

                            For xxx = xx To x + 1 Step -1 'reassign from right to left

                                Board(xxx, y) = Board(xxx - 1, y) ' but leave x, y as is

                            Next

                            Expand = -1: Exit Function

                        End If

                    Next xx

                End If

            Case 3 ' Move down

                If y <> SPSm1 Then ' going down board, look for space to expand

                    For yy = y + 1 To SPSm1

                        If Board(x, yy) = 0 Then 'expand this dir

                            For yyy = yy To y + 1 Step -1 ' expand from bottom up

                                Board(x, yyy) = Board(x, yyy - 1) ' by reassign to above value

                            Next

                            Expand = -1: Exit Function

                        End If

                    Next yy

                End If

            Case 4 ' Move left

                If x <> 0 Then ' x is not at left of board, look for space

                    For xx = x - 1 To 0 Step -1

                        If Board(xx, y) = 0 Then 'yes a space! expand this dir

                            For xxx = xx To x - 1 ' reassign from left to right

                                Board(xxx, y) = Board(xxx + 1, y)

                            Next

                            Expand = -1: Exit Function

                        End If

                    Next xx

                End If

        End Select

        dir = dir + 1 ' still here? then dir failed so try next one unless we are back to startDir

        If dir = 5 Then dir = 1 ' dir 1 to 4 only

    Loop Until dir = startDir ' failed to expand at x, y  we are done here returning 0

End Function



Sub DrawBoard

    Line (0, 0)-(BS + 1, BS + 1), &HFF000000, BF

    NRed = 0: NBlue = 0

    For y = 0 To SPSm1

        For x = 0 To SPSm1

            If Board(x, y) = -1 Then

                c~& = &HFFFF0000: NRed = NRed + 1

                If NRed = 1 Then SaveRX = x: SaveRY = y ' <<< save these shared values for rating solution

            End If

            If Board(x, y) = 1 Then c~& = &HFF0000FF: NBlue = NBlue + 1

            If Board(x, y) = 0 Then c~& = &HFF000000

            Line (x * SS + 21, y * SS + 1)-Step(SS - 2, SS - 2), c~&, BF

        Next

    Next

    If NBlue > NRed Then MoreBlue = -1 Else MoreBlue = 0 ' flag for balancing red and blue

    _Display

End Sub



Sub Update ()

    Cls

    DrawBoard

    If PuzzleDone% Then ' messagebox that no moves are left and soluition is: good, better or perfect!

        rate = 1 ' = no more moves left

        ' has a perfect puzzle been played?

        ' 2 cells remain  = good

        If NBlue + NRed = 2 Then

            rate = 2

            ' the red is at 1,1 and the blue at 2,1 = Perfect!!!

            If Board(1, 1) = -1 _AndAlso Board(2, 1) = 1 Then

                rate = 3

            Else

                ' they are next to each other even better

                ' when I am drawing the board and counting cells I could save the location of

                ' the first red cell SaveRX, SaveRY

                If LikeColorNextTo(1, SaveRX, SaveRY) Then rate = 4

            End If



        End If ' 2 cells

        Select Case rate

            Case 1: _MessageBox "Puzzle Done", "No more moves are available.", "info"

            Case 2: _MessageBox "Puzzle Done", "Good job, only 2 Squares left!", "info"

            Case 3: _MessageBox "Puzzle Done", "A Perfect Puzzle solution!!!", "info"

            Case 4: _MessageBox "Puzzle Done", "Better than Good Solution, the 2 cells are adjacent.", "info"

        End Select

        Quit = 1

    Else

        _PrintString (46, 370), "esc or q to quit board and get new one."

        If State = 1 Then ' highlite  first cell clicked

            Line (LastX * SS + 21, LastY * SS)-Step(SS - 1, SS - 1), &HFFFFFFFF, B

        End If

        _Display

    End If

End Sub



Function Moved (x1, y1, x2, y2) ' moved returns the direction of move for sliding cells

    Moved = 0 ' not a legal move!

    If Board(x1, y1) = Board(x2, y2) Then 'same color and next to each other

        If x1 = x2 Then 'cols match

            If y1 - y2 = 1 Then Moved = 1 'up

            If y2 - y1 = 1 Then Moved = 3 'down

        Else

            If y1 = y2 Then 'rows match

                If x1 - x2 = 1 Then Moved = 4 'left

                If x2 - x1 = 1 Then Moved = 2 'right

            End If

        End If

    End If

End Function



Sub Instructions

    Cls

    Print '"12345678901234567890123456789012345678901234567890"

    Print "        The 4x4 Square Elimination Puzzle:"

    Print

    Print " The object is to eliminate as many squares as"

    Print " possible. A perfect puzzle leaves one red square"

    Print " and one blue square on the board next to each"

    Print " other: red on left at 1,1 blue on right 2,1."

    Print " that was how this Puzzle was seeded."

    Print

    Print " To eliminate a square, click the square to be"

    Print " removed. It will be highlighted, then click a"

    Print " like colored square directly above, below, left"

    Print " or right of the highlighted square. The square"

    Print " will be removed and all the squares behind it"

    Print " (if any) will be slid over one space."

    Print

    Print " If you change your mind after clicking a square,"

    Print " click that square again or a square of opposite"

    Print " color or a square of like color but not next to"

    Print " the square you clicked, to start again."

    Print

    Print

    Print "          Press any to continue... zzz"

    Sleep

End Sub



Function PuzzleDone%

    PuzzleDone% = -1 ' just find 2 like colored squares next to each other = there is a move left

    For y = 0 To SPSm1

        For x = 0 To SPSm1

            If Board(x, y) Then ' not a blank square

                If x + 1 <= SPSm1 Then ' horizontal move is left

                    If Board(x, y) = Board(x + 1, y) Then PuzzleDone% = 0: Exit Function

                End If

                If y + 1 <= SPSm1 Then ' vertical move is left

                    If Board(x, y) = Board(x, y + 1) Then PuzzleDone% = 0: Exit Function

                End If

            End If

        Next

    Next

End Function

I came across this neat little Haiku screensaver and couldn't resist porting it to QB64‑PE.

Enjoy!

' =========================================================================

' Neon Lights

' Ported from a Haiku C++ screensaver to QB64-PE by a740g

' Original Author: Adrien Destugues (MIT License)

' https://github.com/pulkomandy/neonlights

' =========================================================================



_DEFINE A-Z AS LONG

OPTION _EXPLICIT



$COLOR:32



CONST SCREEN_WIDTH = 1024

CONST SCREEN_HEIGHT = 768

CONST PARTICLES = 3000

CONST CITIES = 64

CONST SPOTS = 22 ' must be <= CITIES



TYPE City

    x AS SINGLE

    y AS SINGLE

    oldX AS SINGLE

    oldY AS SINGLE

    vx AS SINGLE

    vy AS SINGLE

    other AS LONG

    r AS LONG

    g AS LONG

    b AS LONG

END TYPE



DIM SHARED cities(0 TO CITIES - 1) AS City

DIM SHARED goodColor(0 TO 5) AS _UNSIGNED LONG

goodColor(0) = Blue

goodColor(1) = Cyan

goodColor(2) = Magenta

goodColor(3) = Green

goodColor(4) = Red

goodColor(5) = Yellow



SCREEN _NEWIMAGE(SCREEN_WIDTH, SCREEN_HEIGHT, 32)

_TITLE "Neon Lights"



RANDOMIZE TIMER



DIM frame AS LONG



DO

    IF (frame AND 1023) = 0 THEN

        Restart

    END IF



    DIM a AS LONG, b AS LONG, tr AS LONG

    DIM t AS SINGLE, dx AS SINGLE, dy AS SINGLE



    DIM n AS LONG

    WHILE n < PARTICLES

        a = INT(RND * SPOTS)

        tr = 0

        DO

            b = INT(RND * SPOTS)

            tr = tr + 1

        LOOP WHILE tr < 100 _ANDALSO CityDistance(a, b) < (SCREEN_WIDTH * SCREEN_HEIGHT) / (10 * (SCREEN_WIDTH + SCREEN_HEIGHT))



        IF tr < 100 THEN

            t = _PI(RND)



            dx = SIN(t) * (cities(b).x - cities(a).x) + cities(a).x

            dy = SIN(t) * (cities(b).y - cities(a).y) + cities(a).y



            dx = dx + (RND * 3!) - 1.5!

            dy = dy + (RND * 3!) - 1.5!



            DIM mixedR AS LONG: mixedR = (cities(a).r + cities(b).r) \ 2

            DIM mixedG AS LONG: mixedG = (cities(a).g + cities(b).g) \ 2

            DIM mixedB AS LONG: mixedB = (cities(a).b + cities(b).b) \ 2



            PSET (dx, dy), _RGB32(mixedR, mixedG, mixedB, 32)

        END IF



        n = n + 1

    WEND

    n = 0



    DIM c AS LONG

    WHILE c < SPOTS

        cities(c).vx = cities(c).vx + (cities(cities(c).other).x - cities(c).x) / SCREEN_WIDTH

        cities(c).vy = cities(c).vy + (cities(cities(c).other).y - cities(c).y) / SCREEN_HEIGHT



        cities(c).vx = cities(c).vx * 0.986!

        cities(c).vy = cities(c).vy * 0.979!



        IF RND < 0.01! THEN

            cities(c).other = INT(RND * SPOTS)

        END IF



        cities(c).x = cities(c).x + cities(c).vx

        cities(c).y = cities(c).y + cities(c).vy



        LINE (cities(c).oldX, cities(c).oldY)-(cities(c).x, cities(c).y), White



        cities(c).oldX = cities(c).x

        cities(c).oldY = cities(c).y



        c = c + 1

    WEND

    c = 0



    _DISPLAY

    _LIMIT 60



    frame = frame + 1

LOOP UNTIL _KEYHIT = _KEY_ESC



SYSTEM



SUB Restart

    CLS



    DIM tinc AS SINGLE: tinc = _PI(2! / SPOTS)



    DIM i AS LONG

    WHILE i < SPOTS

        cities(i).x = SCREEN_WIDTH \ 2

        cities(i).y = SCREEN_HEIGHT \ 2

        cities(i).oldX = cities(i).x

        cities(i).oldY = cities(i).y



        cities(i).vx = (1! + INT(RND * 11!)) * SIN(tinc * i)

        cities(i).vy = (1! + INT(RND * 11!)) * COS(tinc * i)



        DIM cIdx AS LONG: cIdx = INT(RND * 6!)

        cities(i).r = _RED32(goodColor(cIdx))

        cities(i).g = _GREEN32(goodColor(cIdx))

        cities(i).b = _BLUE32(goodColor(cIdx))



        DO

            cities(i).other = INT(RND * SPOTS)

        LOOP WHILE cities(i).other = i



        i = i + 1

    WEND

END SUB



FUNCTION CityDistance! (a AS LONG, b AS LONG)

    IF a <> b THEN

        DIM dx AS SINGLE: dx = cities(b).x - cities(a).x

        DIM dy AS SINGLE: dy = cities(b).y - cities(a).y

        CityDistance = SQR(dx * dx + dy * dy)

    END IF

END FUNCTION

Greetings Folks,

This was one of the first programs I wrote when I discovered QB64PE, and it really shows. I thought I'd post it anyway in case anyone happens to find it useful. I collect '80s music and find it extremely helpful to be able to randomize all or some of the songs in my collection, either for listening or cleaning. Some of the file naming conventions I use are built into the program so that may or may not work for anyone else. It will randomize any group of songs of course, but it does have a number of '80s artist associations built in to better avoid two or more songs in a row by the same artist - hence the title.

Have a great day everyone!

'$ExeIcon: '.\Icon.ico'



_Title "'80s Song Randomizer"



DefInt A - Z



Screen 12



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Const FALSE = 0

Const TRUE  = Not FALSE



Const NULL$        = ""

Const ESC$        = Chr$ (27)

Const CR$          = Chr$ (13)

Const BACKSPACE$  = Chr$ (8)



Const DOUBLEQUOTE$ = Chr$ (34)



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Const PROGRAMTITLE$ = "'80s Song Randomizer"

Const PROGRAMTITLE_R = 180

Const PROGRAMTITLE_G = 255

Const PROGRAMTITLE_B = 0



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Const INVALID          = 0

Const VALID            = 1

Const ILLEGALCHARACTER = 2



Const NOMATCH      = 0

Const POSSIBLEMATCH = 1

Const EXACTMATCH    = 2



Const RESULT_Y = 0

Const RESULT_N = 1

Const RESULT_R = 2



Const ASCENDING  = 0

Const DESCENDING = 1



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Const COLOR_PROMPT    = 13

Const COLOR_FILENAME  = 10

Const COLOR_FOLDERNAME = 11

Const COLOR_WARNING    = 14

Const COLOR_FAILURE    = 12



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Const MAXFILES = 20000



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Const VARIATION_FACTOR = .15 'The program will attempt to place songs by the same artist an equal distance apart, +/- (VARIATION_FACTOR * 100)%



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



'Data for extended ASCII characters: Set these values to the correct values (before QB64 scrambles them).

'These values can be found in the "Extended ASCII Characters.pov" file.

'When adding a new value, also add a corresponding entry to the "FormatFileName_Screen$ ()" function.



Const BULLET$            = Chr$ (149)

Const CENT_SYMBOL$        = Chr$ (162)

Const DEGREE_SYMBOL$      = Chr$ (176)

Const SINGLE_QUOTE_LEFT$  = Chr$ (145)

Const SINGLE_QUOTE_RIGHT$ = Chr$ (146)

Const DOUBLE_QUOTE_LEFT$  = Chr$ (147)

Const DOUBLE_QUOTE_RIGHT$ = Chr$ (148)

Const ELIPSIS$            = Chr$ (133)

Const EXTENDED_DASH_0$    = Chr$ (150)

Const EXTENDED_DASH_1$    = Chr$ (151)

Const a_GRAVE$            = Chr$ (224)

Const a_ACUTE$            = Chr$ (225)

Const a_CIRCUMFLEX$      = Chr$ (226)

Const a_TILDE$            = Chr$ (227)

Const a_DIAERESIS$        = Chr$ (228)

Const a_RING$            = Chr$ (229)

Const e_GRAVE$            = Chr$ (232)

Const e_ACUTE$            = Chr$ (233)

Const e_CIRCUMFLEX$      = Chr$ (234)

Const e_DIAERESIS$        = Chr$ (235)

Const i_GRAVE$            = Chr$ (236)

Const i_ACUTE$            = Chr$ (237)

Const i_CIRCUMFLEX$      = Chr$ (238)

Const i_DIAERESIS$        = Chr$ (239)

Const n_TILDE$            = Chr$ (241)

Const o_GRAVE$            = Chr$ (242)

Const o_ACUTE$            = Chr$ (243)

Const o_CIRCUMFLEX$      = Chr$ (244)

Const o_TILDE$            = Chr$ (245)

Const o_DIAERESIS$        = Chr$ (246)

Const o_SLASH$            = Chr$ (248)

Const u_GRAVE$            = Chr$ (249)

Const u_ACUTE$            = Chr$ (250)

Const u_CIRCUMFLEX$      = Chr$ (251)

Const u_DIAERESIS$        = Chr$ (252)

Const y_ACUTE$            = Chr$ (253)

Const y_DIAERESIS$        = Chr$ (255)

Const A__GRAVE$          = Chr$ (192)

Const A__ACUTE$          = Chr$ (193)

Const A__CIRCUMFLEX$      = Chr$ (194)

Const A__TILDE$          = Chr$ (195)

Const A__DIAERESIS$      = Chr$ (196)

Const A__RING$            = Chr$ (197)

Const E__GRAVE$          = Chr$ (200)

Const E__ACUTE$          = Chr$ (201)

Const E__CIRCUMFLEX$      = Chr$ (202)

Const E__DIAERESIS$      = Chr$ (203)

Const I__GRAVE$          = Chr$ (204)

Const I__ACUTE$          = Chr$ (205)

Const I__CIRCUMFLEX$      = Chr$ (206)

Const I__DIAERESIS$      = Chr$ (207)

Const N__TILDE$          = Chr$ (209)

Const O__GRAVE$          = Chr$ (210)

Const O__ACUTE$          = Chr$ (211)

Const O__CIRCUMFLEX$      = Chr$ (212)

Const O__TILDE$          = Chr$ (213)

Const O__DIAERESIS$      = Chr$ (214)

Const O__SLASH$          = Chr$ (216)

Const U__GRAVE$          = Chr$ (217)

Const U__ACUTE$          = Chr$ (218)

Const U__CIRCUMFLEX$      = Chr$ (219)

Const U__DIAERESIS$      = Chr$ (220)

Const Y__ACUTE$          = Chr$ (221)

Const Y__DIAERESIS$      = Chr$ (159)



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Const SEPARATOR$ = " " + BULLET$ + " "



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Dim Shared ListOfSongs_Initialized$ (0 To MAXFILES)

Dim Shared ListOfSongs_Current$    (0 To MAXFILES)

Dim Shared ListOfSongs_New$        (0 To MAXFILES)

Dim Shared ListOfSongs_Best$        (0 To MAXFILES)



Dim Shared ListOfSongs_Artist$ (0 To 200)



Dim Shared CrossBandArtist$ (0 To 2000)



'PCG-32 variables

Dim Shared PCG_State~&& 'For PCG-32 Random Number Generator

Dim Shared PCG_Inc~&&  'For PCG-32 Random Number Generator



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* * INTRODUCTION                                                                                                    * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Call DisplayProgramTitle (PROGRAMTITLE$, PROGRAMTITLE_R, PROGRAMTITLE_G, PROGRAMTITLE_B)



Color 7 : Print : Print "This program will rename all songs within a directory by giving them each a"

Print "prefix consisting of a unique random number. If the songs within the chosen"

Print "directory are already randomized, the old randomization data will be stripped"

Print "and new data will be created."



Print : Print "The program will identify cross-band artists (e.g." + DOUBLEQUOTE$ + "Blondie" + DOUBLEQUOTE$ + " / " + DOUBLEQUOTE$ +_

  "Deborah Harry" + DOUBLEQUOTE$ + ")."

Print "The data for these associations is contained within the program itself and may"

Print "need to be updated as new bands are added to the collection."



Color 15 : Print : Print "Note that song names containing a COLON, SLASH, or QUESTION MARK will be"

Print "skipped."



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* * INITIALIZATION                                                                                                  * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'Read cross-band artist data



Restore CrossBandArtists



NCrossBandArtists = 0



Do

  Read CrossBandArtist$ (NCrossBandArtists), CrossBandArtist$ (NCrossBandArtists + 1)

  CrossBandArtist$ (NCrossBandArtists) = UCase$ (CrossBandArtist$ (NCrossBandArtists))

  CrossBandArtist$ (NCrossBandArtists + 1) = UCase$ (CrossBandArtist$ (NCrossBandArtists + 1))

  NCrossBandArtists = NCrossBandArtists + 2

Loop Until (CrossBandArtist$ (NCrossBandArtists - 2) = "*")



NCrossBandArtists = NCrossBandArtists - 2



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'Determine the last directory used



DirectoryFilename$ = "Directory.txt"



If _FileExists (DirectoryFilename$) Then

  DefaultDirectory$ = _ReadFile$ (DirectoryFilename$)

Else

  DefaultDirectory$ = NULL$

End If



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'Allow the user to select a current directory



Directory$ = _SelectFolderDialog$ ("Select the directory containing the files to rename:", DefaultDirectory$)



If (Directory$ = NULL$) Then

  System

End If



Directory$ = Directory$ + "\"



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'Save the current directory for the next use



_WriteFile DirectoryFilename$, Directory$



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'Read the filenames from the current directory



NSongs = 0

NSkippedSongs = 0



CurrentFileName$ = _Files$ (Directory$)



While Len (CurrentFileName$) > 0

  CurrentFileNameStatus = CheckValidFileName (CurrentFileName$)

  If (CurrentFileNameStatus = VALID) Then

      ListOfSongs_Initialized$ (NSongs) = CurrentFileName$

      NSongs = NSongs + 1

  End If

  If (CurrentFileNameStatus = ILLEGALCHARACTER) Then

      NSkippedSongs = NSkippedSongs + 1

  End If

  CurrentFileName$ = _Files$

Wend



If (NSongs < 2) Then

  Color COLOR_WARNING : Print : Print "There are too few songs in ";

  Color COLOR_FOLDERNAME : Print Directory$;

  Color COLOR_WARNING : Print "."

  Color 9

  End

End If



Call CheckForBadFileNames (NSongs, ListOfSongs_Initialized$ ())



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'Strip away old randomization data from filenames in memory and on the storage device



Confirmed = FALSE



For i = 0 To NSongs - 1

  EntryIsRandomized = FALSE

  If Left$ (ListOfSongs_Initialized$ (i), 1) = "[" Then

      L = InStr (ListOfSongs_Initialized$ (i), "] ")

      If (L > 0) Then

        EntryIsRandomized = TRUE

        For J = 2 To L - 1

            T$ = Mid$ (ListOfSongs_Initialized$ (i), J, 1)

            If (T$ < "0" Or T$ > "9") Then

              EntryIsRandomized = FALSE

              Exit For

            End If

        Next

        If (EntryIsRandomized And Not Confirmed) Then

            Color COLOR_WARNING : Print : Print "Warning: ";

            Color 7 : Print "Randomization data will be removed from the filenames in"

            Color COLOR_FOLDERNAME : Print Directory$;

            Color 7 : Print ". ";

            Color COLOR_PROMPT : Print "Continue? ";

            If (Not GetYN) Then

              Color 9

              End

            End If

            Confirmed = TRUE

        End If

        If (EntryIsRandomized) Then

            OldSongName$ = Directory$ + ListOfSongs_Initialized$ (i)

            ListOfSongs_Initialized$ (i) = Right$ (ListOfSongs_Initialized$ (i), Len (ListOfSongs_Initialized$ (i)) - L - 1)

            NewSongName$ = Directory$ + ListOfSongs_Initialized$ (i)

            Name OldSongName$ As NewSongName$

        End If

      End If

  End If

Next



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'Sort songs into descending order by number of songs per artist (5 step process)



'Step 1: Sort songs into ascending alphabetical order



If (NSongs > 1) Then

  Call QuickSort (0, NSongs - 1, ListOfSongs_Initialized$ (), ASCENDING)

End If



'Step 2: Determine how many digits are necessary



HighestCount = NSongs 'Don't subtract 1 in case all songs are by the same artist (songs will be numbered 1 .. N)



NDigits = 1



If (HighestCount >= 10) Then NDigits = 2

If (HighestCount >= 100) Then NDigits = 3

If (HighestCount >= 1000) Then NDigits = 4

If (HighestCount >= 10000) Then NDigits = 5



'Step 3: Add number of songs per artist to each song name



CurrentArtist$ = GetArtistName$ (ListOfSongs_Initialized$ (0))

NSongsByCurrentArtist = 1



For i = 1 To NSongs

  NextArtist$ = GetArtistName$ (ListOfSongs_Initialized$ (i))

  If (NextArtist$ <> CurrentArtist$) Then

      StartIndex = i - NSongsByCurrentArtist

      EndIndex = i - 1

      ArtistCount$ = GenerateDigit$ (NSongsByCurrentArtist, NDigits) + " "

      For J = StartIndex To EndIndex

        ListOfSongs_Initialized$ (J) = ArtistCount$ + ListOfSongs_Initialized$ (J)

      Next

      CurrentArtist$ = NextArtist$

      NSongsByCurrentArtist = 1

  Else

      NSongsByCurrentArtist = NSongsByCurrentArtist + 1

  End If

Next



'Step 4: Sort songs into descending order by number of songs per artist



If (NSongs > 1) Then

  Call QuickSort (0, NSongs - 1, ListOfSongs_Initialized$ (), DESCENDING)

End If



'Step 5: Remove number of songs per artist data from song names



For i = 0 To NSongs - 1

  ListOfSongs_Initialized$ (i) = Right$ (ListOfSongs_Initialized$ (i), Len (ListOfSongs_Initialized$ (i)) - NDigits - 1)

Next



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'Add dummy entry to the end of the song list to trigger the last group of songs



ListOfSongs_Initialized$ (NSongs) = "*" + SEPARATOR$ + "DUMMY ENTRY"



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* * DISPLAY STATISTICS AND DETERMINE MODE OF OPERATION                                                              * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Color 7 : Print : Print "There are ";

Color 15 : Print LTrim$ (Str$ (NSongs));

Color 7 : Print " songs in ";

Color COLOR_FOLDERNAME : Print ShortenFolderName$ (Directory$);

Color 7 : Print "."



Print



If (NSkippedSongs > 0) Then

  Color COLOR_FAILURE : Print "DIRE WARNING: ";

End If



Color 15 : Print LTrim$ (Str$ (NSkippedSongs));

Color 7

If (NSkippedSongs = 1) Then

  Print " song was";

Else

  Print " songs were";

End If

Print " skipped due to a COLON, SLASH, or QUESTION MARK."



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Color COLOR_PROMPT

Print : Print "Attempt to randomize the song list continuously until no warnings occur? ";



If (GetYN) Then

  RunForever = TRUE

Else

  RunForever = FALSE

  _Delay .5

End If



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* * START OF RANDOMIZATION ATTEMPTS LOOP                                                                            * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



NAttempts_Collection~&& = 0



LeastNWeightedWarnings = 32760



Call PCG32_Seed ((MonthlyTimer~&))



Do



  If (Not RunForever) Then

      Call DisplayProgramTitle (PROGRAMTITLE$, PROGRAMTITLE_R, PROGRAMTITLE_G, PROGRAMTITLE_B)

  End If



  '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

  'Fill the song array with the initialized song list



  For i = 0 To NSongs

      ListOfSongs_Current$ (i) = ListOfSongs_Initialized$ (i)

      ListOfSongs_New$ (i) = NULL$

  Next



  '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

  'Randomize the song list



  CurrentArtist$ = GetArtistName$ (ListOfSongs_Current$ (0))

  NSongsByCurrentArtist = 1



  For i = 1 To NSongs



      NextArtist$ = GetArtistName$ (ListOfSongs_Current$ (i))



      If (NextArtist$ <> CurrentArtist$) Then



        TargetDistance = Int (NSongs / NSongsByCurrentArtist + .5)

        VFMultiplier = VARIATION_FACTOR * TargetDistance

        CurrentRandomLocation = FindRandomAvailable (NSongs)



        StartIndex = i - NSongsByCurrentArtist

        EndIndex = i - 1



        If (NSongsByCurrentArtist > 1) Then 'Randomize songs by the same artist



            For J = 0 To NSongsByCurrentArtist - 1 'Copy block of songs by the current artist into a working array

              ListOfSongs_Artist$ (J) = ListOfSongs_Current$ (StartIndex + J)

            Next



            MaxNVersionsOfOneSong = 1 'Determine the maximum number of versions of any one song by the current artist

            PreviousSongName$ = NULL$

            For J = 0 To NSongsByCurrentArtist - 1

              CurrentSongName$ = GetSongName$ (ListOfSongs_Artist$ (J))

              If (CurrentSongName$ <> PreviousSongName$) Then

                  NVersionsOfCurrentSong = 1

                  PreviousSongName$ = CurrentSongName$

              Else

                  NVersionsOfCurrentSong = NVersionsOfCurrentSong + 1

                  If (NVersionsOfCurrentSong > MaxNVersionsOfOneSong) Then

                    MaxNVersionsOfOneSong = NVersionsOfCurrentSong

                  End If

              End If

            Next



            Half = Int (NSongsByCurrentArtist / 2 + .1)



            If (MaxNVersionsOfOneSong <= Half) Then

              PerfectScore = NSongsByCurrentArtist

            Else

              PerfectScore = (NSongsByCurrentArtist - MaxNVersionsOfOneSong) * 2

            End If



            BestScoreSoFar = -1

            NAttempts_Artist = 0



            Do



              For J = 0 To NSongsByCurrentArtist - 1 'Scramble the working array

                  K = Int (PCG32_RandomFloat! * NSongsByCurrentArtist)

                  If (K <> J) Then Swap ListOfSongs_Artist$ (J), ListOfSongs_Artist$ (K)

              Next



              CurrentScore = 0 'Compute score for current combination of songs

              PreviousSongName$ = GetSongName$ (ListOfSongs_Artist$ (NSongsByCurrentArtist - 1))

              For J = 0 To NSongsByCurrentArtist - 1

                  CurrentSongName$ = GetSongName$ (ListOfSongs_Artist$ (J))

                  If (CurrentSongName$ <> PreviousSongName$) Then

                    CurrentScore = CurrentScore + 1

                    PreviousSongName$ = CurrentSongName$

                  End If

              Next



              If (CurrentScore > BestScoreSoFar) Then 'Update the master song list

                  For J = 0 To NSongsByCurrentArtist - 1

                    ListOfSongs_Current$ (StartIndex + J) = ListOfSongs_Artist$ (J)

                  Next

                  BestScoreSoFar = CurrentScore

              End If



              NAttempts_Artist = NAttempts_Artist + 1



            Loop Until (CurrentScore = PerfectScore Or NAttempts_Artist = 10000)



        End If



        For J = StartIndex To EndIndex

            ListOfSongs_New$ (CurrentRandomLocation) = ListOfSongs_Current$ (J)

            TargetDistanceOffset = Int (PCG32_RandomFloat! * VFMultiplier * 2 - VFMultiplier)

            CurrentRandomLocation = FindNextAvailable (CurrentRandomLocation + TargetDistance + TargetDistanceOffset, NSongs)

        Next



        CurrentArtist$ = NextArtist$

        NSongsByCurrentArtist = 1



      Else



        NSongsByCurrentArtist = NSongsByCurrentArtist + 1



      End If



  Next



  '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

  'Check for warnings



  NWarnings = 0

  NWeightedWarnings = 0



  Restart = FALSE



  CurrentArtist$ = GetArtistName$ (ListOfSongs_New$ (NSongs - 1))

  CurrentSongName$ = GetSongName$ (ListOfSongs_New$ (NSongs - 1))



  For i = 0 To NSongs - 1



      NextArtist$ = GetArtistName$ (ListOfSongs_New$ (i))

      NextSongName$ = GetSongName$ (ListOfSongs_New$ (i))



      L0 = Len (CurrentArtist$)

      L1 = Len (NextArtist$)



      TwoInARow = NOMATCH



      If (L0 = L1) Then



        If (NextArtist$ = CurrentArtist$) Then

            TwoInARow = EXACTMATCH

            NWeightedWarnings = NWeightedWarnings + 5 'Exact artist match counts heavily

            If (NextSongName$ = CurrentSongName$) Then

              NWeightedWarnings = NWeightedWarnings + 10 'Two versions of the same song by the same artist in a row

            End If

        End If



      Else



        Test0$ = " " + CurrentArtist$ + " "

        Test1$ = " " + NextArtist$ + " "



        If (L0 > L1) Then

            If (InStr (Test0$, Test1$) > 0) Then

              TwoInARow = POSSIBLEMATCH

              NWeightedWarnings = NWeightedWarnings + 4 'High probability of matching artists

            End If

        Else

            If (InStr (Test1$, Test0$) > 0) Then

              TwoInARow = POSSIBLEMATCH

              NWeightedWarnings = NWeightedWarnings + 4

            End If

        End If



      End If



      If (TwoInARow = NOMATCH) Then

        'Check for cross-band artists

        For J = 0 To NCrossBandArtists - 2 Step 2

            If (CurrentArtist$ = CrossBandArtist$ (J) Or NextArtist$ = CrossBandArtist$ (J)) Then

              If (CurrentArtist$ = CrossBandArtist$ (J + 1) Or NextArtist$ = CrossBandArtist$ (J + 1)) Then

                  TwoInARow = POSSIBLEMATCH

                  NWeightedWarnings = NWeightedWarnings + 3 'Matching artists, but possibly different vocalists

                  Exit For

              End If

            End If

        Next

      End If



      If (TwoInARow = NOMATCH) Then

        'Check for the same song by different artists

        If (NextSongName$ = CurrentSongName$) Then

            TwoInARow = POSSIBLEMATCH

            NWeightedWarnings = NWeightedWarnings + 1 'Lots of songs with the same name but totally different

        End If

      End If



      If (TwoInARow = EXACTMATCH Or TwoInARow = POSSIBLEMATCH) Then



        NWarnings = NWarnings + 1



        If (Not RunForever) Then



            PreviousIndex = i - 1

            If (PreviousIndex = -1) Then

              PreviousIndex = NSongs - 1

            End If



            PeriodLocation = _InStrRev (ListOfSongs_New$ (PreviousIndex), ".")

            Test0$ = Left$ (ListOfSongs_New$ (PreviousIndex), PeriodLocation - 1)



            PeriodLocation = _InStrRev (ListOfSongs_New$ (i), ".")

            Test1$ = Left$ (ListOfSongs_New$ (i), PeriodLocation - 1)



            Print



            If (TwoInARow = POSSIBLEMATCH) Then

              Color COLOR_WARNING : Print "WARNING: ";

              Color 7 : Print "Possibly two similar artists/bands or songs in a row:"

            Else

              Color COLOR_FAILURE : Print "DIRE WARNING: ";

              Color 7 : Print "Two songs by the same artist in a row:"

            End If



            Color COLOR_FILENAME

            Print FormatFileName_Screen$ (Test0$)

            Print FormatFileName_Screen$ (Test1$)



            If (NWarnings > 5) Then

              Color COLOR_PROMPT : Print : Print "Continue? ";

              Color 7 : Print "(Press" + DOUBLEQUOTE$ + "R" + DOUBLEQUOTE$ + " to restart the randomization process) ";

              Continue$ = Pick1Of3$ ("YES", "NO", "RESTART")

              If (Continue$ = "N") Then

                  Color 9

                  End

              End If

              If (Continue$ = "R") Then

                  Restart = TRUE

                  _Delay .5

                  Exit For

              End If

            End If



        End If



      End If



      CurrentArtist$ = NextArtist$

      CurrentSongName$ = NextSongName$



  Next



  If (Not RunForever And NWarnings > 0 And NWarnings <= 5) Then

      Color COLOR_PROMPT : Print : Print "Continue? ";

      Color 7 : Print "(Press" + DOUBLEQUOTE$ + "R" + DOUBLEQUOTE$ + " to restart the randomization process) ";

      Continue$ = Pick1Of3$ ("YES", "NO", "RESTART")

      If (Continue$ = "N") Then

        Color 9

        End

      End If

      If (Continue$ = "R") Then

        Restart = TRUE

        _Delay .5

      End If

  End If



  '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



  If (RunForever) Then



      If (NWeightedWarnings < LeastNWeightedWarnings) Then

        For i = 0 To NSongs

            ListOfSongs_Best$ (i) = ListOfSongs_New$ (i)

        Next

        LeastNWeightedWarnings = NWeightedWarnings

      End If



      If (NWarnings > 0) Then

        NAttempts_Collection~&& = NAttempts_Collection~&& + 1

        If (NAttempts_Collection~&& = 100) Then

            Print

            CursorY = CsrLin

        End If



        If (NAttempts_Collection~&& Mod 100 = 0) Then

            Locate CursorY, 1

            Color 7 : Print "Attempts: ";

            Color 15 : Print Commatize$ (NAttempts_Collection~&&);

            Color 7 : Print "    Best score so far: ";

            Color 15 : Print LTrim$ (Str$ (LeastNWeightedWarnings)) + "    "

        End If



      End If



  End If



  Done = FALSE

  Aborted = FALSE



  If (InKey$ = ESC$) Then

      For i = 0 To NSongs

        ListOfSongs_New$ (i) = ListOfSongs_Best$ (i)

      Next

      Aborted = TRUE

      Done = TRUE

  End If



  If (NWarnings = 0) Then

      Done = TRUE

  End If



  If (Not RunForever And Not Restart) Then

      Done = TRUE

  End If



Loop Until (Done)



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* * END OF LOOP                                                                                                    * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Print



If (Aborted) Then

  Color COLOR_WARNING : Print "Notice: ";

  Color 7 : Print "Attempts to randomize the song list until no warnings occur have been"

  Print "discontinued by the user. The best ordering found will be used."

End If



If (RunForever And Not Aborted) Then

  Color 15 : Print "Songs have been successfully randomized."

End If



If (Not RunForever) Then

  Color 15 : Print LTrim$ (Str$ (NWarnings));

  Color 7

  If (NWarnings = 1) Then

      Print " warning occurred."

  Else

      Print " warnings occurred."

  End If

End If



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Color COLOR_PROMPT : Print : Print "Would you like to update the filenames on the storage device? ";



If (Not GetYN) Then

  Color 9

  End

End If



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Print



StartNumber = InputNumber ("Start number: ", 1, 32000 - NSongs, COLOR_PROMPT)



If (StartNumber = -1) Then

  System

End If



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



HighestCount = NSongs + StartNumber - 1



NDigits = 1



If (HighestCount >= 10) Then NDigits = 2

If (HighestCount >= 100) Then NDigits = 3

If (HighestCount >= 1000) Then NDigits = 4

If (HighestCount >= 10000) Then NDigits = 5



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



For i = 0 To NSongs - 1

  OldSongName$ = Directory$ + ListOfSongs_New$ (i)

  NewSongName$ = Directory$ + "[" + GenerateDigit$ (i + StartNumber, NDigits) + "] " + ListOfSongs_New$ (i)

  Name OldSongName$ As NewSongName$

Next



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Color 15

Print : Print "Operation complete."



Color 9

End



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* * CROSS-BAND ARTIST DATA                                                                                          * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



CrossBandArtists:

'List artists/bands that should not be played consecutively. It is not necessary to list artist/band names wherein one

'artist/band name is entirely contained within the other, such as "Doro" and "Doro & Classic Night Orchestra."

Data "ABBA", "Agnetha Fältskog"

Data "Arabesque", "Enigma"

Data "Arabesque", "Sandra"

Data "B-52's", "Kate Pierson & Iggy Pop"

Data "Babies", "John Waite"

Data "Bad Company", "Firm"

Data "Bad English", "Babies"

Data "Bad English", "John Waite"

Data "Benjamin Orr", "Ric Ocasek"

Data "Black Sabbath", "Dio"

Data "Black Sabbath", "Rainbow"

Data "Blondie", "Deborah Harry"

Data "Boston", "Orion The Hunter"

Data "Cars", "Benjamin Orr"

Data "Cars", "Ric Ocasek"

Data "Chicago", "Peter Cetera"

Data "Chicago", "Peter Cetera & Amy Grant"

Data "Damn Yankees", "Ted Nugent"

Data "Damn Yankees", "Tommy Shaw"

Data "Duran Duran", "Arcadia"

Data "English Beat", "General Public"

Data "Enigma", "Sandra"

Data "Eurythmics", "Annie Lennox"

Data "Fleetwood Mac", "Stevie Nicks"

Data "Fleetwood Mac", "Stevie Nicks & Tom Petty And The Heartbreakers"

Data "FM Attack & Kristine", "Shadoworks & Kristine"

Data "Foreigner", "Lou Gramm"

Data "Genesis", "Peter Gabriel"

Data "Genesis", "Phil Collins"

Data "Genesis", "Phil Collins & Philip Bailey"

Data "Glass Tiger", "Bryan Adams"

Data "Go-Go's", "Belinda Carlisle"

Data "Heart", "Mike Reno & Ann Wilson"

Data "Heart", "Nancy Wilson"

Data "Honeydrippers", "Robert Plant"

Data "Jan Hammer", "London Starlight Orchestra"

Data "Journey", "Steve Perry"

Data "Katz", "Nilla Backman"

Data "Keel", "Badlands House Band"

Data "Kingdom Come", "Stone Fury"

Data "Loverboy", "Mike Reno & Ann Wilson"

Data "Miami Sound Machine", "Gloria Estefan"

Data "Mike + The Mechanics", "Paul Carrack"

Data "Mike + The Mechanics", "Paul Young"

Data "New Order", "Electronic"

Data "Night Ranger", "Damn Yankees"

Data "Rainbow", "Dio"

Data "Roxy Music", "Bryan Ferry"

Data "Smiths", "Morrissey"

Data "Soft Cell", "Marc Almond"

Data "Styx", "Damn Yankees"

Data "Styx", "Tommy Shaw"

Data "Van Halen", "David Lee Roth"

Data "Van Halen", "Sammy Hagar"

Data "Wall of Voodoo", "Stan Ridgway"

Data "Warlock", "Doro"

Data "Warlock", "Doro & Classic Night Orchestra"



'Not currently in use:

'Data "ABBA", "Frida"

'Data "Black Sabbath", "Ozzy Osbourne"

'Data "Black Sabbath", "Ozzy Osbourne & Lita Ford"

'Data "Culture Club", "Boy George"

'Data "Eagles", "Don Henley"

'Data "Eagles", "Glenn Frey"

'Data "Police", "Sting"

'Data "Propaganda", "Claudia Brücken"

'Data "Scandal", "Patty Smyth"

'Data "Siouxsie And The Banshees", "Creatures"



Data "*", "*"



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* * MACROS                                                                                                          * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Sub DisplayProgramTitle (X_Title$, X_R, X_G, X_B)



  Title$ = X_Title$

  R = X_R

  G = X_G

  B = X_B



  Cls



  _PaletteColor 1, _RGB32 (R * .5, G * .5, B * .5)

  _PaletteColor 2, _RGB32 (R * .87, G * .87, B * .87)

  _PaletteColor 3, _RGB32 (R, G, B)



  Print : Print Space$ (40 - (Len (Title$) + 12) / 2);



  Color 1 : Print " ";

  Color 2 : Print " ";

  Color 3 : Print " ";



  Color 15 : Print Title$;

  Color 3 : Print " ";

  Color 2 : Print " ";

  Color 1 : Print " "



End Sub 'DisplayProgramTitle







Function ReportBadFileName (X_Message0Color, X_Message0$, X_Message1$, X_FileName$, X_PauseForEachBadFileName)



  Message0Color          = X_Message0Color

  Message0$              = X_Message0$

  Message1$              = X_Message1$

  FileName$              = X_FileName$

  PauseForEachBadFileName = X_PauseForEachBadFileName



  Continue$ = "S"



  Color Message0Color : Print : Print Message0$ + " ";

  Color 7 : Print Message1$



  Color COLOR_FILENAME : Print FormatFileName_Screen$ (FileName$)



  If (PauseForEachBadFileName) Then

      Color COLOR_PROMPT : Print "Continue? ";

      Color 7 : Print "(Press " + DOUBLEQUOTE$ + "S" + DOUBLEQUOTE$ + " to skip confirmations) ";

      Continue$ = Pick1Of3$ ("YES", "NO", "SKIP")

      If (Continue$ = "N") Then

        Color 9

        End

      End If

  End If



  If (Continue$ = "S") Then

      ReportBadFileName = FALSE

  Else

      ReportBadFileName = TRUE

  End If



End Function 'ReportBadFileName







Sub CheckForBadFileNames (X_NFileNames, FileName$ ())



  NFileNames = X_NFileNames



  SFN$ = "Suspicious file name:"

  BFN$ = "Bad file name:"



  ConfirmEachBadFileName = TRUE



  For I = 0 To NFileNames - 1



      CurrentFileName$ = FileName$ (I)



      NBrackets = 0

      NParenthesis = 0

      PreviousChar$ = " "

      BadLowerCaseChar = FALSE



      L = Len (CurrentFileName$)



      For J = 1 To L

        CurrentChar$ = Mid$ (CurrentFileName$, J, 1)

        If (CurrentChar$ = "[") Then NBrackets = NBrackets + 1

        If (CurrentChar$ = "]") Then NBrackets = NBrackets - 1

        If (CurrentChar$ = "(") Then NParenthesis = NParenthesis + 1

        If (CurrentChar$ = ")") Then NParenthesis = NParenthesis - 1

        If (NBrackets = 0 And CurrentChar$ >= "a" And CurrentChar$ <= "z" And PreviousChar$ = " ") Then

            BadLowerCaseChar = TRUE

        End If

        PreviousChar$ = CurrentChar$

      Next



      If (BadLowerCaseChar) Then

        ConfirmEachBadFileName = ReportBadFileName (COLOR_WARNING, SFN$, "(lower case character)", CurrentFileName$, ConfirmEachBadFileName)

      End If



      If (NBrackets <> 0) Then

        ConfirmEachBadFileName = ReportBadFileName (COLOR_FAILURE, BFN$, "(mis-matched brackets)", CurrentFileName$, ConfirmEachBadFileName)

      End If



      If (NParenthesis <> 0) Then

        ConfirmEachBadFileName = ReportBadFileName (COLOR_FAILURE, BFN$, "(mis-matched parenthesis)", CurrentFileName$, ConfirmEachBadFileName)

      End If



      If (InStr (CurrentFileName$, "][") <> 0) Then

        ConfirmEachBadFileName = ReportBadFileName (COLOR_FAILURE, BFN$, "(missing space between brackets)", CurrentFileName$, ConfirmEachBadFileName)

      End If



      If (InStr (CurrentFileName$, "  ") <> 0) Then

        ConfirmEachBadFileName = ReportBadFileName (COLOR_FAILURE, BFN$, "(double spaces)", CurrentFileName$, ConfirmEachBadFileName)

      End If



      If (InStr (CurrentFileName$, " .") <> 0) Then

        ConfirmEachBadFileName = ReportBadFileName (COLOR_FAILURE, BFN$, "(extra space)", CurrentFileName$, ConfirmEachBadFileName)

      End If



      If (InStr (CurrentFileName$, "...") <> 0) Then

        ConfirmEachBadFileName = ReportBadFileName (COLOR_FAILURE, BFN$, "(periods instead of ellipsis)", CurrentFileName$, ConfirmEachBadFileName)

      End If



      If (InStr (CurrentFileName$, SINGLE_QUOTE_LEFT$) <> 0) Then

        ConfirmEachBadFileName = ReportBadFileName (COLOR_FAILURE, BFN$, "(wrong single quote mark)", CurrentFileName$, ConfirmEachBadFileName)

      End If



      If (InStr (CurrentFileName$, SINGLE_QUOTE_RIGHT$) <> 0) Then

        ConfirmEachBadFileName = ReportBadFileName (COLOR_FAILURE, BFN$, "(wrong single quote mark)", CurrentFileName$, ConfirmEachBadFileName)

      End If



      If (InStr (CurrentFileName$, DOUBLE_QUOTE_LEFT$) <> 0) Then

        ConfirmEachBadFileName = ReportBadFileName (COLOR_FAILURE, BFN$, "(wrong double quote mark - use ASCII symbol #148)", CurrentFileName$, ConfirmEachBadFileName)

      End If



      If (InStr (CurrentFileName$, EXTENDED_DASH_0$) <> 0) Then

        ConfirmEachBadFileName = ReportBadFileName (COLOR_FAILURE, BFN$, "(wrong dash mark)", CurrentFileName$, ConfirmEachBadFileName)

      End If



      If (InStr (CurrentFileName$, EXTENDED_DASH_1$) <> 0) Then

        ConfirmEachBadFileName = ReportBadFileName (COLOR_FAILURE, BFN$, "(wrong dash mark)", CurrentFileName$, ConfirmEachBadFileName)

      End If



      If (InStr (CurrentFileName$, SEPARATOR$) = 0) Then

        ConfirmEachBadFileName = ReportBadFileName (COLOR_FAILURE, BFN$, "(missing artist/song name separator)", CurrentFileName$, ConfirmEachBadFileName)

      End If



      TempFileName$ = UCase$ (CurrentFileName$)



      PeriodLocation = _InStrRev (TempFileName$, ".")



      TempFileName$ = Left$ (TempFileName$, PeriodLocation - 1)



      PeriodLocation = _InStrRev (TempFileName$, ".")



      If (PeriodLocation <> 0) Then

        Extension$ = Right$ (TempFileName$, Len (TempFileName$) - PeriodLocation)

        If (                      _

            Extension$ = "FLAC" Or _

            Extension$ = "MP1"  Or _

            Extension$ = "MP2"  Or _

            Extension$ = "MP3"  Or _

            Extension$ = "M4A"  Or _

            Extension$ = "OGG"  Or _

            Extension$ = "WAV"    _

        ) Then

            ConfirmEachBadFileName = ReportBadFileName (COLOR_FAILURE, BFN$, "(extra extension)", CurrentFileName$, ConfirmEachBadFileName)

        End If

      End If



      'If (InStr (CurrentFileName$, BULLET$) <> _InStrRev (CurrentFileName$, BULLET$)) Then

      '  ConfirmEachBadFileName = ReportBadFileName (COLOR_FAILURE, BFN$, "(conflicting song name separators) ", CurrentFileName$, ConfirmEachBadFileName)

      'End If



  Next



End Sub 'CheckForBadFileNames







Function FindRandomAvailable (X_NSongs)



  NSongs = X_NSongs



  Dim AvailableSpot (0 To NSongs - 1)



  NAvailableSpots = 0



  For I = 0 To NSongs - 1

      If (ListOfSongs_New$ (I) = NULL$) Then

        AvailableSpot (NAvailableSpots) = I

        NAvailableSpots = NAvailableSpots + 1

      End If

  Next



  FindRandomAvailable = AvailableSpot (Int (PCG32_RandomFloat! * NAvailableSpots))



End Function 'FindRandomAvailable







Function FindNextAvailable (X_StartLocation, X_NSongs)



  StartLocation = X_StartLocation

  NSongs        = X_NSongs



  For I = 0 To NSongs - 1

      AdjustedIndex0 = (StartLocation + I) Mod NSongs

      AdjustedIndex1 = (StartLocation - I) Mod NSongs

      If (AdjustedIndex1 < 0) Then AdjustedIndex1 = NSongs + AdjustedIndex1

      If (ListOfSongs_New$ (AdjustedIndex0) = NULL$) Then AdjustedIndex = AdjustedIndex0 : Exit For

      If (ListOfSongs_New$ (AdjustedIndex1) = NULL$) Then AdjustedIndex = AdjustedIndex1 : Exit For

  Next



  If (AdjustedIndex0 <> AdjustedIndex1 And ListOfSongs_New$ (AdjustedIndex0) = NULL$ And ListOfSongs_New$ (AdjustedIndex1) = NULL$) Then

      Which = Int (PCG32_RandomFloat! * 2)

      If (Which = 0) Then

        AdjustedIndex = AdjustedIndex0

      Else

        AdjustedIndex = AdjustedIndex1

      End If

  End If



  FindNextAvailable = AdjustedIndex



End Function 'FindNextAvailable







Function GetYN ()



  Color 15 : Print "_";



  Locate CsrLin, Pos (0) - 1



  Do

      _Limit 20

      KeyPress$ = UCase$ (InKey$)

  Loop Until (KeyPress$ = "Y" Or KeyPress$ = "N" Or KeyPress$ = ESC$)



  If (KeyPress$ = ESC$) Then

      System

  End If



  If (KeyPress$ = "Y") Then

      Answer = TRUE

      Print "YES"

  Else

      Answer = FALSE

      Print "NO"

  End If



  GetYN = Answer



End Function 'GetYN







Function Pick1Of3$ (X_Option0$, X_Option1$, X_Option2$)



  Option0$ = X_Option0$

  Option1$ = X_Option1$

  Option2$ = X_Option2$



  K0$ = UCase$ (Left$ (Option0$, 1))

  K1$ = UCase$ (Left$ (Option1$, 1))

  K2$ = UCase$ (Left$ (Option2$, 1))



  Color 15 : Print "_";



  Locate CsrLin, Pos (0) - 1



  Do

      _Limit 20

      KeyPress$ = UCase$ (InKey$)

  Loop Until (KeyPress$ = K0$ Or KeyPress$ = K1$ Or KeyPress$ = K2$ Or KeyPress$ = ESC$)



  If (KeyPress$ = ESC$) Then

      System

  End If



  Select Case KeyPress$

      Case K0$:

        Print Option0$

      Case K1$:

        Print Option1$

      Case K2$:

        Print Option2$

  End Select



  Pick1Of3$ = KeyPress$



End Function 'Pick1Of3$







Function GetArtistName$ (X_FileName$)



  ArtistName$ = X_FileName$



  ArtistName$ = UCase$ (ArtistName$)



  I = InStr (ArtistName$, SEPARATOR$)



  ArtistName$ = RTrim$ (Left$ (ArtistName$, I - 1)) 'RTrim$ in case there's an extra space



  GetArtistName$ = ArtistName$



End Function 'GetArtistName$







Function GetSongName$ (X_FileName$)



  SongName$ = X_FileName$



  SongName$ = UCase$ (SongName$)



  PeriodLocation = _InStrRev (SongName$, ".")

  SongName$ = Left$ (SongName$, PeriodLocation - 1)



  I = InStr (SongName$, SEPARATOR$)



  SongName$ = Right$ (SongName$, Len (SongName$) - (I + 2))



  L = Len (SongName$)

  NBrackets = 0

  TempSongName$ = NULL$



  For I = 1 To L

      CurrentChar$ = Mid$ (SongName$, I, 1)

      If (CurrentChar$ = "[") Then NBrackets = NBrackets + 1

      If (NBrackets = 0) Then

        TempSongName$ = TempSongName$ + CurrentChar$

      End If

      If (CurrentChar$ = "]") Then NBrackets = NBrackets - 1

  Next



  SongName$ = RTrim$ (TempSongName$)



  GetSongName$ = SongName$



End Function 'GetSongName$







Function CheckValidFileName (X_FileName$)



  FileName$ = X_FileName$



  FileName$ = UCase$ (FileName$)



  FileNameStatus = VALID



  PeriodLocation = _InStrRev (FileName$, ".")



  If PeriodLocation = 0 Then

      FileNameStatus = INVALID

  Else

      Extension$ = Right$ (FileName$, Len (FileName$) - PeriodLocation)

      If not (                  _

        Extension$ = "FLAC" Or _

        Extension$ = "MP1"  Or _

        Extension$ = "MP2"  Or _

        Extension$ = "MP3"  Or _

        Extension$ = "M4A"  Or _

        Extension$ = "OGG"  Or _

        Extension$ = "WAV"    _

      ) Then

        FileNameStatus = INVALID

      End If

  End If



  If (InStr (FileName$, SEPARATOR$) = 0) Then

      FileNameStatus = INVALID

  End If



  If (InStr (FileName$, ":") <> 0 Or InStr (FileName$, "/") <> 0 Or InStr (FileName$, "?") <> 0) Then

      FileNameStatus = ILLEGALCHARACTER

  End If



  CheckValidFileName = FileNameStatus



End Function 'CheckValidFileName







Sub QuickSort (ListStart, ListEnd, ListElement$ (), SortOrder)



  High = ListEnd

  Low = ListStart

  Middle$ = UCase$ (ListElement$ ((Low + High) / 2))



  Do

      Select Case SortOrder

        Case ASCENDING:

            Do While (UCase$ (ListElement$ (Low)) < Middle$) : Low = Low + 1 : Loop

            Do While (UCase$ (ListElement$ (High)) > Middle$) : High = High - 1 : Loop

        Case DESCENDING:

            Do While (UCase$ (ListElement$ (Low)) > Middle$) : Low = Low + 1 : Loop

            Do While (UCase$ (ListElement$ (High)) < Middle$) : High = High - 1 : Loop

      End Select

      If (Low <= High) Then

        Swap ListElement$ (Low), ListElement$ (High)

        Low = Low + 1

        High = High - 1

      End If

  Loop Until (Low > High)



  If (High > ListStart) Then Call QuickSort (ListStart, High, ListElement$ (), SortOrder)

  If (Low < ListEnd) Then Call QuickSort (Low, ListEnd, ListElement$ (), SortOrder)



End Sub 'QuickSort







Function GenerateDigit$ (X_Value, X_NDigits)



  Value  = X_Value

  NDigits = X_NDigits



  Digits$ = LTrim$ (Str$ (Value))



  While (Len (Digits$) < NDigits)

      Digits$ = "0" + Digits$

  Wend



  GenerateDigit$ = Digits$



End Function 'GenerateDigit$







Function FormatFileName_Screen$ (X_FileName$)



  'These characters can be copy-and-pasted from the "Extended ASCII Characters.bas" file.



  FileName$ = X_FileName$



  NewFileName$ = NULL$



  For I = 1 To Len (FileName$)

      CurrentChar$ = Mid$ (FileName$, I, 1)

      Select Case CurrentChar$

        Case Chr$ (32) To Chr$ (127): NewFileName$ = NewFileName$ + CurrentChar$

        Case BULLET$:                NewFileName$ = NewFileName$ + "ù"

        Case CENT_SYMBOL$:            NewFileName$ = NewFileName$ + "›"

        Case DEGREE_SYMBOL$:          NewFileName$ = NewFileName$ + "§"

        Case SINGLE_QUOTE_LEFT$:      NewFileName$ = NewFileName$ + "'"

        Case SINGLE_QUOTE_RIGHT$:    NewFileName$ = NewFileName$ + "'"

        Case DOUBLE_QUOTE_LEFT$:      NewFileName$ = NewFileName$ + DOUBLEQUOTE$

        Case DOUBLE_QUOTE_RIGHT$:    NewFileName$ = NewFileName$ + DOUBLEQUOTE$

        Case ELIPSIS$:                NewFileName$ = NewFileName$ + "..." 'QB64 doesn't include the correct character

        Case EXTENDED_DASH_0$:        NewFileName$ = NewFileName$ + "-"

        Case EXTENDED_DASH_1$:        NewFileName$ = NewFileName$ + "-"

        Case a_GRAVE$:                NewFileName$ = NewFileName$ + "…"

        Case a_ACUTE$:                NewFileName$ = NewFileName$ + "a" 'QB64 doesn't include the correct character

        Case a_CIRCUMFLEX$:          NewFileName$ = NewFileName$ + "ƒ"

        Case a_TILDE$:                NewFileName$ = NewFileName$ + "a" 'QB64 doesn't include the correct character

        Case a_DIAERESIS$:            NewFileName$ = NewFileName$ + "„"

        Case a_RING$:                NewFileName$ = NewFileName$ + "†"

        Case e_GRAVE$:                NewFileName$ = NewFileName$ + "Š"

        Case e_ACUTE$:                NewFileName$ = NewFileName$ + "‚"

        Case e_CIRCUMFLEX$:          NewFileName$ = NewFileName$ + "ˆ"

        Case e_DIAERESIS$:            NewFileName$ = NewFileName$ + "‰"

        Case i_GRAVE$:                NewFileName$ = NewFileName$ + "i" 'QB64 doesn't include the correct character

        Case i_ACUTE$:                NewFileName$ = NewFileName$ + "¡"

        Case i_CIRCUMFLEX$:          NewFileName$ = NewFileName$ + "Œ"

        Case i_DIAERESIS$:            NewFileName$ = NewFileName$ + "‹"

        Case n_TILDE$:                NewFileName$ = NewFileName$ + "¤"

        Case o_GRAVE$:                NewFileName$ = NewFileName$ + "•"

        Case o_ACUTE$:                NewFileName$ = NewFileName$ + "¢"

        Case o_CIRCUMFLEX$:          NewFileName$ = NewFileName$ + "“"

        Case o_TILDE$:                NewFileName$ = NewFileName$ + "o" 'QB64 doesn't include the correct character

        Case o_DIAERESIS$:            NewFileName$ = NewFileName$ + "”"

        Case o_SLASH$:                NewFileName$ = NewFileName$ + "o" 'QB64 doesn't include the correct character

        Case u_GRAVE$:                NewFileName$ = NewFileName$ + "—"

        Case u_ACUTE$:                NewFileName$ = NewFileName$ + "£"

        Case u_CIRCUMFLEX$:          NewFileName$ = NewFileName$ + "–"

        Case u_DIAERESIS$:            NewFileName$ = NewFileName$ + "u" 'QB64 doesn't include the correct character

        Case y_ACUTE$:                NewFileName$ = NewFileName$ + "y" 'QB64 doesn't include the correct character

        Case y_DIAERESIS$:            NewFileName$ = NewFileName$ + "˜"

        Case A__GRAVE$:              NewFileName$ = NewFileName$ + "A" 'QB64 doesn't include the correct character

        Case A__ACUTE$:              NewFileName$ = NewFileName$ + "A" 'QB64 doesn't include the correct character

        Case A__CIRCUMFLEX$:          NewFileName$ = NewFileName$ + "A" 'QB64 doesn't include the correct character

        Case A__TILDE$:              NewFileName$ = NewFileName$ + "A" 'QB64 doesn't include the correct character

        Case A__DIAERESIS$:          NewFileName$ = NewFileName$ + "Ž"

        Case A__RING$:                NewFileName$ = NewFileName$ + "A" 'QB64 doesn't include the correct character

        Case E__GRAVE$:              NewFileName$ = NewFileName$ + "E" 'QB64 doesn't include the correct character

        Case E__ACUTE$:              NewFileName$ = NewFileName$ + "E" 'QB64 doesn't include the correct character

        Case E__CIRCUMFLEX$:          NewFileName$ = NewFileName$ + "E" 'QB64 doesn't include the correct character

        Case E__DIAERESIS$:          NewFileName$ = NewFileName$ + "E" 'QB64 doesn't include the correct character

        Case N__TILDE$:              NewFileName$ = NewFileName$ + "¥"

        Case O__GRAVE$:              NewFileName$ = NewFileName$ + "O" 'QB64 doesn't include the correct character

        Case O__ACUTE$:              NewFileName$ = NewFileName$ + "O" 'QB64 doesn't include the correct character

        Case O__CIRCUMFLEX$:          NewFileName$ = NewFileName$ + "O" 'QB64 doesn't include the correct character

        Case O__TILDE$:              NewFileName$ = NewFileName$ + "O" 'QB64 doesn't include the correct character

        Case O__DIAERESIS$:          NewFileName$ = NewFileName$ + "™"

        Case O__SLASH$:              NewFileName$ = NewFileName$ + "O" 'QB64 doesn't include the correct character

        Case U__GRAVE$:              NewFileName$ = NewFileName$ + "U" 'QB64 doesn't include the correct character

        Case U__ACUTE$:              NewFileName$ = NewFileName$ + "U" 'QB64 doesn't include the correct character

        Case U__CIRCUMFLEX$:          NewFileName$ = NewFileName$ + "U" 'QB64 doesn't include the correct character

        Case U__DIAERESIS$:          NewFileName$ = NewFileName$ + "š"

        Case Y__ACUTE$:              NewFileName$ = NewFileName$ + "Y" 'QB64 doesn't include the correct character

        Case Y__DIAERESIS$:          NewFileName$ = NewFileName$ + "Y" 'QB64 doesn't include the correct character

        Case Else:

            Color COLOR_WARNING : Print "Unsupported extended ASCII character: ";

            Color 15 : Print CurrentChar$;

            Color 7 : Print " (ASCII value: " + LTrim$ (Str$ (Asc (CurrentChar$))) + ")"

            Color COLOR_FILENAME

            NewFileName$ = NewFileName$ + CurrentChar$

      End Select

  Next



  FormatFileName_Screen$ = NewFileName$



End Function 'FormatFileName_Screen$







Function ShortenFolderName$ (X_FolderName$)



  FolderName$ = X_FolderName$



  If (Right$ (FolderName$, 1) = "\") Then

      FolderName$ = Left$ (FolderName$, Len (FolderName$) - 1)

  End If



  I = _InStrRev (Left$ (FolderName$, Len (FolderName$) - 1), "\")



  If I = 0 Then

      NewFolderName$ = FolderName$

  Else

      NewFolderName$ = Right$ (FolderName$, Len (FolderName$) - I)

  End If



  ShortenFolderName$ = NewFolderName$



End Function 'ShortenFolderName$







Function Commatize$ (X_N~&&)



  N~&& = X_N~&&



  N$ = LTrim$ (Str$ (N~&&))



  Result$ = NULL$

  NDigits = 0



  For I = Len (N$) To 1 Step -1

      Result$ = Mid$ (N$, I, 1) + Result$

      NDigits = NDigits + 1

      If (NDigits = 3 And I > 1) Then

        Result$ = "," + Result$

        NDigits = 0

      End If

  Next



  Commatize$ = Result$



End Function 'Commatize$







Function InputNumber (X_Prompt$, X_DefaultValue, X_MaxValue, X_PromptColor)



  'Returns -1 if the ESC key is pressed



  Prompt$      = X_Prompt$

  DefaultValue = X_DefaultValue

  MaxValue    = X_MaxValue

  PromptColor  = X_PromptColor

  AnswerColor  = X_AnswerColor



  MaxNSpaces = 2 'Includes one space for the underscore character

  If (MaxValue >= 10) Then MaxNSpaces = 3

  If (MaxValue >= 100) Then MaxNSpaces = 4

  If (MaxValue >= 1000) Then MaxNSpaces = 5

  If (MaxValue >= 10000) Then MaxNSpaces = 6



  Answer$ = LTrim$ (Str$ (DefaultValue))



  Color PromptColor : Print Prompt$;



  CursorX = Pos (0)

  CursorY = CsrLin



  Color 7 : Print Answer$;

  Color 15 : Print "_";



  KeyPressed = FALSE

  DoneTyping = FALSE

  Escape    = FALSE



  Do



      Do

        _Limit 20

        KeyPress$ = InKey$

      Loop Until (KeyPress$ <> NULL$)



      UpdateDisplay = FALSE



      If (KeyPress$ = ESC$) Then

        Answer$ = NULL$

        Escape = TRUE

        UpdateDisplay = TRUE

        DoneTyping = TRUE

      End If



      If (KeyPress$ = CR$) Then

        UpdateDisplay = TRUE

        DoneTyping = TRUE

      End If



      If (KeyPress$ = BACKSPACE$) Then

        L = Len (Answer$)

        If (L > 1) Then

            Answer$ = Left$ (Answer$, L - 1)

        Else

            Answer$ = "0"

        End If

        KeyPressed = TRUE

        UpdateDisplay = TRUE

      End If



      If (KeyPress$ >= "0" And KeyPress$ <= "9") Then

        If (Not KeyPressed) Then

            NewAnswer$ = KeyPress$

            NewAnswer~& = Val (NewAnswer$)

            If (NewAnswer~& <= MaxValue) Then

              Answer$ = NewAnswer$

              KeyPressed = TRUE

            End If

        Else

            NewAnswer$ = Answer$ + KeyPress$

            NewAnswer~& = Val (NewAnswer$)

            If (NewAnswer~& <= MaxValue) Then

              If (Answer$ = "0") Then

                  Answer$ = KeyPress$

              Else

                  Answer$ = NewAnswer$

              End If

            End If

        End If

        UpdateDisplay = TRUE

      End If



      If (UpdateDisplay) Then

        Locate CursorY, CursorX

        If (Answer$ = "0") Then

            Color 7

        Else

            Color 15

        End If

        Print Answer$;

        If (Not DoneTyping) Then

            Color 15 : Print "_";

            NSpacesLeft = MaxNSpaces - Len (Answer$) - 1

        Else

            NSpacesLeft = MaxNSpaces - Len (Answer$)

        End If

        Print Space$ (NSpacesLeft);

      End If



  Loop Until DoneTyping



  If (Escape) Then Answer$ = "-1"



  Print



  InputNumber = Val (Answer$)



End Function 'InputNumber



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* *  PCG-32 RANDOM NUMBER GENERATOR                                                                                * *

'* *                                                                                                                * *

'* *                                                                                                                * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *



Function MonthlyTimer~&



  MonthlyTimer~& = Val (Mid$ (Date$, 4, 2)) * 86400000 + Timer (.001) * 1000



End Function 'MonthlyTimer~&







Sub PCG32_Seed (Seed~&)



  'Initialize with seed



  PCG_State~&& = 0

  PCG_Inc~&& = (Seed~& * 2) Or 1

  Dummy& = PCG32_Random&

  PCG_State~&& = PCG_State~&& + &H853C49E6748FEA9B

  Dummy& = PCG32_Random&



End Sub 'PCG32_Seed







Function PCG32_Random& ()



  'Returns a 32-bit random integer



  Dim OldState~&&

  Dim Shift18~&&

  Dim Shift59~&&

  Dim XorShifted~&

  Dim Result~&

  Dim Right_Part~&

  Dim Left_Part~&

  Dim Rotate_Amount~&



  OldState~&&    = PCG_State~&&

  PCG_State~&&    = OldState~&& * &H5851F42D4C957F2D + PCG_Inc~&&

  Shift18~&&      = OldState~&& \ 262144

  XorShifted~&    = (Shift18~&& Xor OldState~&&) \ 134217728

  Shift59~&&      = OldState~&& \ 576460752303423488#

  Rotate_Amount~& = Shift59~&& And 31

  Right_Part~&    = XorShifted~& \ (2 ^ Rotate_Amount~&)

  Left_Part~&    = (XorShifted~& * (2 ^ (32 - Rotate_Amount~&))) And &HFFFFFFFF

  Result~&        = Right_Part~& Or Left_Part~&



  PCG32_Random& = Result~&



End Function 'PCG32_Random&







Function PCG32_RandomFloat! ()



  'Returns a random float in [0, 1) range

  'The Result~& can be exactly 0, but always less than 1



  PCG32_RandomFloat! = (PCG32_Random& And &HFFFFFF) / 16777216.0



End Function 'PCG32_RandomFloat!