The only thing I don't like is that I wanted to make this a playlist, rather than a regular track list, but I wasn't sure how to do that.
The selection is random, but if you've sorted any columns, the results will be sorted. To remove sorting, click on any playlist (Now Playing) will do. After that, the results from the Radio List will be unsorted.
If anyone knows how to create & populate an actual playlist, let me know. (Of course, you could populate Now Playing, but I use WinAmp as a player, so that wouldn't work for me.)
This is an auto-script.
Thanks,
Peter
Code: Select all
' RadioFreeMonkey
' Version 1.0
' A script to create a "radio station" for you based on your song ratings.
' This script creates a root node in the tree, beneath the library node, called "RadioFreeMonkey".
' Under this node, you have a Radio List node, a Done node and a Weightings node.
' - The Radio List node lists 20 songs, in random order. These are weighted, so songs
' with a higher weighting have a higher chance of getting selected.
' - If you have selected a sorting column, even though the songs are selected randomly, the
' radio list will be sorted based on that column. To return the list to "random" sorting, click
' on any playlist (Now Playing works nicely). When you visit the Radio List node, the songs will
' be unsorted, in true random order.
' - The Done list shows you which songs aren't going to be played. This includes songs that have
' passed their maximum playcount, or anything within MinDaysRepeat.
' - The Weighting node shows all tunes, sorted by their calculated weights. This can help you
' determine what the optimal weighting choices are for you. Plus, it's just nice to see what's
' more likely to be played.
' Songs are weighted as follows:
' Rating * 2 (5 stars = 10, 3.5 stars = 7, 0 stars = 0)
' - Number of Plays (if Reduce if Played is TRUE)
' + Days since added to library / DayFactor (always rounded down)
' TO DO: At some point, I'd like to make the main 'list' node a PlayList instead of a regular
' list of tracks, but I'm not sure how to do this.
'
' This script can be freely used and modified.
' This is an early release and there may be bugs. If it's causing you problems, simply delete
' it or move it out of the scripts\auto folder.
'
' The script does not modify the database, registry or INI file.
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' Global Variables and Declarations
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Option Explicit
' %%% The caption for the root node.
Const RootNodeCaption = "RadioFreeMonkey"
' %%% Add 1 to weighting for each X days since added to library
Const DayFactor = 30
' %%% Anything rated this or below will not receive the 'date boost'
Const DateBoostCutoff = 1
' %%% The minimum number of days that must pass before a song is repeated. Zero means, go ahead
' and repeat it right away.
Const MinDaysRepeat = 1
' %%% Reduce the weighting by the number of times played. This means, as songs are played more often,
' they are less likely to be played again
Const ReduceIfPlayed = True
' %%% Number of Songs in list
Const NumberOfSongs = 20
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' The Meat. Don't change anything under here.
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Dim weightFormula, cutOff
cutOff = "(IIF(Songs.rating < 0, 0, Songs.rating) / 10) + IIF(Songs.rating <= "&(DateBoostCutoff*20)&", 0, FIX(DateDiff('d',Songs.DateAdded,Now) / "&DayFactor&"))"
weightFormula = cutOff & " - Songs.playCounter "
Sub FillStandardProperties(parentNode, childNode)
With childNode
.CustomNodeId = parentNode.CustomNodeId
.CustomDataId = parentNode.CustomDataId + 1
.UseScript = Script.ScriptPath
End With
End Sub
Sub FillGoodLeaf(Node)
Randomize
Dim SplitCustomData, Tracks
Dim SQLCondition, SQLStatement
Dim SELECT_Clause, FROM_Clause, WHERE_Clause, ORDER_Clause
Dim Iter, res, i, total, sum, index, weight
Dim hold, weights
Set hold = CreateObject("Scripting.Dictionary")
Set weights = CreateObject("Scripting.Dictionary")
SELECT_Clause = " SELECT Songs.Id, "&weightFormula&" "
FROM_Clause = " FROM Songs "
' WHERE_Clause = " WHERE Songs.PlayCounter < "&weightFormula&" "
WHERE_Clause = " WHERE Songs.PlayCounter < "&cutoff & " AND DateDiff('d',Songs.LastTimePlayed, Now) > " & MinDaysRepeat
SQLStatement = SELECT_Clause & FROM_Clause & WHERE_Clause
Set Iter = SDB.Database.OpenSQL(SQLStatement)
total=0
sum = 0
While Not Iter.EOF
hold.add total,Iter.StringByIndex(0)
weights.add total,Iter.StringByIndex(1)
total = total + 1
sum = sum + Iter.StringByIndex(1)
Iter.Next
Wend
Dim R, max : max = NumberOfSongs
If (total < max) Then
max = total
End If
Dim inStr : inStr = ""
Set Tracks = SDB.MainTracksWindow
While i < max
' R = Round((rnd() * (total+1))-0.5, 0)
R = rnd() * sum
For index = 0 to total
If R < cdbl(weights.item(index)) Then
Exit For
Else
R = R - cdbl(weights.item(index))
End If
Next 'index
inStr = inStr & hold.item(index) & ", "
i = i + 1
Wend
inStr = Left(inStr,Len(inStr)-2)
'res = SDB.MessageBox(inStr, mtError, Array(mbOk))
Tracks.AddTracksFromQuery("AND Songs.ID IN (" & inStr & ") ORDER BY Rnd((1000*Songs.ID)*Now())")
Tracks.FinishAdding
' function WeightedRandom(const Weights : array of Double) : Integer ;
' var R : Double ;
' begin
' R := Random * Sum(Weights) ;
' for Result := 0 to High(Weights) do
' if (R < Weights[Result]) then BREAK
' else R := R - Weights[Result] ;
' end ;
End Sub
Sub FillWeightNode(Node)
Dim SplitCustomData ' Auxiliary Array used to collect the pieces of Node.CustomData
Dim SQLLinking ' Piece of SQL Code (WHERE statement) defining the relations between tables
Dim SQLTables ' Part of FROM clause indicating which tables to query
Dim SQLCondition ' String containing the part of the WHERE statement coming from the ancestor nodes
Dim fullMask, curLevelMask
Dim Tree, newNode, nextIsLeaf
Dim FldTxt ' Text identifying the field by which the created nodes will be filtered
Dim Field, IdField, OrderField ' Fields to be queried
' Variables that store qualifier values and related expressions
Dim TopQualifier, TopClause, SortCondition, minTracks, maxTracks, trimValue, doFormatting
Dim ContentIndex ' An index to the field to be displayed
Dim SELECT_Clause, FROM_Clause, WHERE_Clause, GROUP_BY_Clause, ORDER_BY_Clause, HAVING_Clause
Dim SQLStatement ' SQL query to the database
Dim CaptionPrefix ' Used to modify the caption when a sorting has been specified
Dim EscapedId ' Used to escape a text value in the database to be used as a test
Dim idArgument ' The first argument submitted to the Format function
Dim Iter ' SDBD Iterator obtained by running the SQL query to get the nodes
Set Tree = SDB.MainTree
Node.HasChildren = false ' To delete all old children
SQLStatement = "SELECT DISTINCT " & weightFormula & " from Songs "
Set Iter = SDB.Database.OpenSQL(SQLStatement)
While Not Iter.EOF
Set newNode = Tree.CreateNode
NewNode.Caption = Iter.StringByIndex(0)
NewNode.iconIndex = 32
newNode.CustomData = Iter.StringByIndex(0)
FillStandardProperties node,newNode
newNode.onFillTracksFunct = "FillWeightLeaf"
newNode.hasChildren = False
Tree.AddNode Node, NewNode, 3
Iter.Next
Wend
End Sub
Sub FillWeightLeaf(Node)
Dim Weight
Dim Tracks
Dim SELECT_Clause, FROM_Clause, WHERE_Clause
Weight = Node.CustomData
SELECT_Clause = " SELECT Songs.Id "
FROM_Clause = " FROM Songs "
WHERE_Clause = " WHERE " & WeightFormula & " = " & Weight & " AND DateDiff('d',Songs.LastTimePlayed, Now) > " & MinDaysRepeat
Set Tracks = SDB.MainTracksWindow
Tracks.AddTracksFromQuery("AND Songs.ID IN (" & SELECT_Clause & FROM_Clause & WHERE_Clause & ")")
Tracks.FinishAdding
End Sub
Sub FillDoneLeaf(Node)
Dim Tracks
Dim SELECT_Clause, FROM_Clause, WHERE_Clause
SELECT_Clause = " SELECT Songs.Id "
FROM_Clause = " FROM Songs "
WHERE_Clause = " WHERE Songs.PlayCounter >= "&cutoff & " OR DateDiff('d',Songs.LastTimePlayed, Now) <= " & MinDaysRepeat
Set Tracks = SDB.MainTracksWindow
Tracks.AddTracksFromQuery("AND Songs.ID IN (" & SELECT_Clause & FROM_Clause & WHERE_Clause & ")")
Tracks.FinishAdding
End Sub
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' Startup Function
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Sub onStartUp
Dim Tree, RadioFreeMonkeyRoot
Dim RadioMonkeyGood, RadioMonkeyBad, RadioMonkeyWeight
Set Tree = Sdb.MainTree
Set RadioFreeMonkeyRoot = Tree.createNode
RadioFreeMonkeyRoot.Caption = RootNodeCaption
RadioFreeMonkeyRoot.IconIndex = 14
RadioFreeMonkeyRoot.UseScript = Script.ScriptPath
RadioFreeMonkeyRoot.hasChildren = True
Tree.AddNode Tree.Node_Library, RadioFreeMonkeyRoot, 1
SDB.Objects("RadioFreeMonkeyRoot") = RadioFreeMonkeyRoot
Set RadioMonkeyGood = Tree.createNode
RadioMonkeyGood.Caption = "Radio List"
RadioMonkeyGood.IconIndex = 14
RadioMonkeyGood.UseScript = Script.ScriptPath
RadioMonkeyGood.hasChildren = False
RadioMonkeyGood.onFillTracksFunct = "FillGoodLeaf"
Tree.AddNode RadioFreeMonkeyRoot, RadioMonkeyGood, 2
SDB.Objects("RadioMonkeyGood") = RadioMonkeyGood
Set RadioMonkeyWeight = Tree.createNode
RadioMonkeyWeight.Caption = "Weightings"
RadioMonkeyWeight.IconIndex = 32
RadioMonkeyWeight.UseScript = Script.ScriptPath
RadioMonkeyWeight.hasChildren = True
RadioMonkeyWeight.onFillTracksFunct = "FillWeightNode"
Tree.AddNode RadioFreeMonkeyRoot, RadioMonkeyWeight, 3
SDB.Objects("RadioMonkeyWeight") = RadioMonkeyWeight
Set RadioMonkeyBad = Tree.createNode
RadioMonkeyBad.Caption = "Done"
RadioMonkeyBad.IconIndex = 15
RadioMonkeyBad.UseScript = Script.ScriptPath
RadioMonkeyBad.hasChildren = False
RadioMonkeyBad.onFillTracksFunct = "FillDoneLeaf"
Tree.AddNode RadioFreeMonkeyRoot, RadioMonkeyBad, 3
SDB.Objects("RadioMonkeyBad") = RadioMonkeyBad
End Sub