03-03-2026, 07:31 AM
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!
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!
Code: (Select All)
'$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!
