- It chooses higher rated songs more often than lower rated songs
- If you've listened to a song recently, it won't repeat for X number of days (defined in the script)
- It boosts the chances of a song being selected based on when it was last played (or added to the DB if it hasn't been played)
Also, I'm on MM3. The 'CASE WHEN' won't work in MM2, you'd have to make it an 'iif' statement. Of course, I'm not even sure if auto DJ was available in MM2.
Anyway, give it a try and let me know what you think.
Code: Select all
' An AutoDJ version of Radio Free Monkey ' by Peter Risser ' v1.0 ' 2009-05-07 Option Explicit ' ' [AutoDJRadioFreeMonkey] ' FileName=autoDJ-RFM.vbs ' DisplayName=Radio Free Monkey ' Language=VBScript ' ScriptType=4 ' %%% Add 1 to weighting for each X days since last played Const DayFactor = 30 ' %%% Anything rated this or below will not receive the 'date boost' Const DateBoostCutoff = 1.5 ' %%% The minimum number of days that must pass before a song is repeated. Zero means, go ahead ' and repeat it right away. Const MinDaysRepeat = 4 Dim weightedRatingFormula, dateBoostFormula, ratingFormula, weightedPlayCountFormula Dim daysSinceAdded : daysSinceAdded = "round((julianday('now') - julianday('1899-12-30') - Songs.DateAdded),0)" Dim daysSincePlayed : daysSincePlayed = "round((julianday('now') - julianday('1899-12-30') - Songs.LastTimePlayed),0)" Dim numberOfDays : numberOfDays = "CASE WHEN (lastTimePlayed > 0) THEN "&daysSincePlayed&" ELSE "&daysSinceAdded&" END" dateBoostFormula = "Round((Songs.rating > "&(DateBoostCutoff*20)&") * "&numberOfDays &" / "&DayFactor&",3)" ratingFormula = "((Songs.rating > 0) * Songs.rating / 10)" weightedRatingFormula = ratingFormula & " + " & dateBoostFormula Sub InitConfigSheet( Panel) ' TODO: Make the configurable items actual options in the dialog. End Sub ' Panel = Panel where UI controls were previously placed by the script ' SaveConfig = Whether user pressed Ok and values in the dialog should be applied and saved (to registry, ini file, or so) Sub CloseConfigSheet( Panel, SaveConfig) ' TODO: Save values to Registry, apply them to our internal variables. End Sub Function GenerateNewTrack Dim SQLStatement, TotalsSQLStatement Dim SELECT_Clause, SELECT_TOTALS_Clause, FROM_Clause, WHERE_Clause, ORDER_Clause Dim Iter, res, total, max, min, delta, cutoff, ID Randomize SELECT_Clause = " SELECT Songs.Id, "&weightedRatingFormula&" as rate " SELECT_TOTALS_Clause = " SELECT count(Songs.Id), max("&weightedRatingFormula&"), min("&weightedRatingFormula&") " FROM_Clause = " FROM Songs " WHERE_Clause = " WHERE " & daysSincePlayed & " > " & MinDaysRepeat ORDER_Clause = " ORDER BY random(*)" TotalsSQLStatement = SELECT_TOTALS_Clause & FROM_Clause & WHERE_Clause 'res = SDB.MessageBox(SQLStatement, mtError, Array(mbOk)) Set Iter = SDB.Database.OpenSQL(TotalsSQLStatement) total = Iter.ValueByIndex(0) max = Iter.ValueByIndex(1) min = Iter.ValueByIndex(2) delta = max - min cutoff = rnd() * delta + min SQLStatement = SELECT_Clause & FROM_Clause & WHERE_Clause & " and rate >= "&cutoff& ORDER_Clause Set Iter = SDB.Database.OpenSQL(SQLStatement) ID = Iter.ValueByIndex(0) 'res = SDB.MessageBox("max: "&max&"; cutoff:"&cutoff&"; result:"&Iter.ValueByIndex(1), mtError, Array(mbOk)) Set Iter = SDB.Database.QuerySongs( "ID=" & ID) Set GenerateNewTrack = Iter.Item End Function