Making a Circular Slider

George Woodrow

(RowDefault[, (Spacer1), , (Spacer1), ])  #WolframTechConf

ABSTRACT

Wolfram Language has a number of useful controls, but has no circular slider. In this presentation, I develop one, from a useful documentation example to a polished control.

Column[{GraphicsRow[{Style["From This: ↓", 18, "Text"], Style["to this: ↓",18, "Text"]},Alignment->Center,  ImageSize->{360, 45}, Spacings->60],GraphicsRow[{DynamicModule[{pt={0,1}},LocatorPane[Dynamic[pt],Graphics[{Circle[],PointSize[Large],Dynamic[Point[pt/Norm[pt]]]},ImageSize -> {150, 150}],Appearance->None]],CircularSlider[a9, 2π, circSliderDir-> "CCW", circSliderStart-> Right] }]}, Frame->All]

The Plan

My goal is to create a new UI widget that has the same functionality as the built-in Slider[], including defaults, options, and, with any luck, documentation.

I looked at the documentation for Slider[], and came up with the basic design:

The function will take a dynamic argument, and will return a value between 0 and max, with a step size dx. Just like Slider[], if one or both these values are not specified, default values are used.

Specifications for appearance and optional functionality will be handled using options. Here is a list:

circSliderStart — where the 0 point is (Top, Right, Bottom, Left).

circSliderDir — whether the value increase clockwise or anti-clockwise.

circSliderDrawArrowQ — whether to draw an arrow instead of the control knob.

circSliderShowValueQ — whether to show the value of the control at the center of the widget

circSliderControlColor — the color of the control knob

circSliderTrackColor — the color inside the control’s track

circSliderBackground — the color of the background.

circSliderSize — The size of the control.

Step 1: make a function

Just using LocatorPanel[] ‘Raw’ is insufficient

The example code from the LocaterPane[] documentation can be expanded to add a lot of interesting details, as I did when I made Mathematica Trek:

direction = 45;
warpVec = {Sin[direction * π/180.], Cos[direction * π/180.]};
LocatorPane[Dynamic[warpVec],Graphics[{White,Disk[],LightGray,Thickness[0.11],Circle[{0,0}, 0.8],Thin, Black,Table[Line[{{Sin[i π/4], Cos[i π/4]},{.1Sin[i π/4], .1Cos[i π/4]}}], {i, 0, 7}],
 Thick,Table[Line[{{Sin[i π/4], Cos[i π/4]},{.9Sin[i π/4], .9Cos[i π/4]}}], {i, 0, 7}],Red,Disk[{0,0}, .1],Arrowheads[Medium],Arrowheads[.15],Arrowheads[Medium],
 Arrow[{{0,0},Dynamic[Normalize[warpVec]]}]},ImageSize -> 100, PlotRange -> 1.1],{{-1,-1},{1,1}},Appearance->None]

I could make a proper circular slider using this technique:

DynamicModule[{pt={0,1}},LocatorPane[Dynamic[pt],Graphics[{LightGray, Rectangle[{-1.1,-1.1},{1.1,1.1}],Yellow,EdgeForm[{Thickness[0.01], Black}],Annulus[{0,0}, {.98, 1.02}],Red,PointSize[0.05],Dynamic[Disk[pt/Norm[pt],0.05]]}, ImageSize->{200, 200}, PlotRange->1.1],Appearance->None, FrameMargins->20]]

The problem, of course, is that I had to cut and paste the code when I wanted a second widget, and the internals of the code was totally exposed to the rest of the function.

Make a proper function

To make a proper function, we want to pass a (dynamic) variable which has a range from 0 to some maximum value, and have it dynamically update when I move the slider. Although the value of the point clicked is used internally to the function, we are not really interested in it.

After a lot of experimentation, I came up with something that works. The key things I learned were the following:

I had to use SetAttributes[] to set the attributes of the function to HoldFirst. This effectively passes the parameter by reference.

I had to make use of the second argument to Dynamic so that I could  update the pos (returned parameter) using pt (internal dynamic variable). Think Dynamic[expr, (expr=#)&] instead of just Dynamic[expr].

Using a helper function, in the following code pointToVal[], to handle the conversion made the job a lot easier.

In the following function, I hard coded some of the parameters that later will be turned into options. Since this is a copy-and-paste from an intermediate notebook, some of the ideas did not make the final cut.

x=0.0;
SetAttributes[simpleSliderFunction, HoldFirst];
pointToVal[thePoint_, maxVal_] := Mod[ArcTan[thePoint[[2]], thePoint[[1]]]/Degree, 360]* maxVal/360.
simpleSliderFunction[pos_,max_] :=DynamicModule[{pt={0,1}},
LocatorPane[Dynamic[pt,(pt=#; pos=pointToVal[#,max])&],
Graphics[{Black, Rectangle[{-1.1,-1.1},{1.1,1.1}],Yellow,EdgeForm[{Thickness[0.01], Black}],Annulus[{0,0}, {.98, 1.02}],Black,Text[Style[Dynamic[pos], 30, White, FontWeight->"Heavy", FontVariations->{"Shadow" -> True}],{0,0}], Red,PointSize[0.05],Dynamic[Disk[pt/Norm[pt],0.05]]}, ImageSize->{200, 200}, PlotRange->1.1],Appearance->None, FrameMargins->20, Exclusions->{0,0}]]
{simpleSliderFunction[x,360], Dynamic[x]}

Step 2: add options

Adding options to the simple function seems simple enough:

Use Options[] to set up the list of options we want to use with their default values.

replace all the hard-coded variables with values given by the options.

It’s not that simple.

Define the options

For each option, I needed to define it with its default value, protect it, and define a usage statement.

Options[fn] = {opt1 -> 1, opt2 -> "a"};
Protect[opt1, opt2];
opt1::usage = "opt1 does something.";
opt2::usage = "opt1 does something else.";

Use them in the function

I needed to set up the options in the function argument list, and then interpret them inside the function.

fn[x_, y_, opts:OptionsPattern[]] := Module[{myOpt1, myOpt2},
myOpt1 = OptionValue[opt1, FilterRules[ {opts},Options[fn]],   opt1];
myOpt2 = OptionValue[opt2, FilterRules[ {opts},Options[fn]],   opt2];
(x * y + myOpt1)* LetterNumber[myOpt2]
]

This syntax is not the simplest way to get an option value. However, it does filter out any options that may be passed that are not associated with the function.

Step 3: Polish the code

Now that we have some working code, we want to add as much of the functionality present in the built-in Slider[] as possible. This includes usage statements for the function and the options, and error codes.

The Section, The final code, shows the code at this point.

Add error handling

I added error messages for common errors specific to the passed parameters and options. The main decision to make was what to do after notifying the user of the error. My choice is to substitute a ‘neutral’ parameter value so that the widget will still appear. I found that this action was most useful during development. The error would point out what’s wrong, and I would still get some result. Other design choices, including WL’s default of returning the function unevaluated, are just as valid.

Enable optional parameters

Slider[] permits the user to execute the function with zero parameters. For our case, since CircularSlider[x] requires a dynamic variable, we require this parameter. However, we want the function to work with default values for max and dx, even when options are being used.
In order to do this, we had to use Except[] so that the function would not use an option as an optional variable:

max:Except[_Rule]:360

This tells the function to ignore any rules, and use the default value of 360 if the parameter is missing. Note that, just like the built-in functions, there is no way to use an optional value for the second parameter (max), and pass a value for the third (dx)

Step 4: Make a package

Packages have been around since version 1 of Mathematica, and was a primary way to ‘wrap up’ code for distribution. With a package, you can expose only the functionality that you want, hiding all the internal or helper functions. Once the package is installed on your system, you need only execute Needs[mypackage] to make use of the functionality, just like a built-in function.

For our purposes, since we already have polished code, all we need to do is to wrap the special syntax of packages around the code, and we are done. The package for CircularSlider is included with the documents for this talk, and there are comments there about the specifics of building a simple package.

With a package, there is minimal documentation, provided by the usage statements for the function and the options. In many cases, this level of documentation would be sufficient:

However, if we want our new function to be on par with the built-in functions, we need proper documentation.

Step 6: Putting the package in a paclet

Starting with version 12.2, new tools have been exposed so that users can make paclets. This is a more modern way of packing up code for re-use and transmission.

For this project, the main advantage of using a paclet over a package is that I can use the paclet documentation tools from within Mathematica.

The Paclet tools are still experimental and incomplete as of version 12.3.1. Watch this space!

Future development

Before I consider this code to be ‘final’, I need to test it in other programs. I may need some additional functionality, or I may have too much functionality.
I added the option to use an arrow as a convenience to me, since, strictly speaking, using a arrow would make it a gauge, rather than a slider. It would be cleaner to split the function into two, adding CircularGauge[], for example, and removing the option to draw an arrow.

It would be useful to incorporate some of the new functionality in version 12.3.1, such as AxisObject.

Acknowledgements

I want to thank several people from tech support who have been instrumental in the success of this project. In a very real sense, everyone who uses Wolfram Language has dozens of collaborators, although we never see them or take a tea break with them.

EunHyun Park for pointing to the second parameter in Dynamic[].
Duncan Pettengill for telling me about the novel use of Except[].
Vamshi Krishna for help coloring option symbols. Akshat Puri for help with the finer points of Packages.

I have had a lot of help from support for a lot of projects, and I have not acknowledged their help in previous talks. For all of you, a belated thank you.

The final code

This section has the final code for CircularSlider[], with comments. It is the same code that appears in the package and paclet.

The main function

Set up

Options

Note that I use already-defined symbols, such as Top, whenever appropriate. All the option names (symbols) start with “circSlider” to prevent any collisions with already defined symbols. These symbols must be protected so that the user will not define the symbols for their own use.

Options[CircularSlider] = {circSliderStart -> Top,  circSliderDir -> "CW", circSliderControlColor -> Red,  circSliderBackground -> White, circSliderTrackColor -> LightYellow, circSliderShowValueQ -> True, circSliderDrawArrowQ -> False, circSliderSize -> 150};
Protect[circSliderStart, circSliderDir, circSliderControlColor, circSliderBackground, circSliderTrackColor, circSliderShowValueQ,circSliderDrawArrowQ,  circSliderSize];

Add the usage statements and the syntax coloring changes to black. Thanks to Vamshi Krishna. This code is also used when making packages, since with the usage statements, each option has its own documentation when executing Definition[] or similar functionality.

circSliderStart::usage = "circularSliderStart sets the 0 point, and can take the values Top, Right, Bottom, Left";
circSliderDir::usage = "circSliderDir sets the direction for increasing values: CW, CCW or ACW";
circSliderControlColor::usage = "circSliderControlColor sets the color of the control knob.";
circSliderBackground::usage = "circSliderBackground sets the background color. Use 'None' for a transparent background.";
circSliderTrackColor::usage = "circSliderTrackColor sets the color inside the track.";
circSliderShowValueQ::usage = "circSliderShowValueQ, when True, shows the value of the slider in the center.";
circSliderDrawArrowQ::usage = "circSliderDrawArrowQ, when True, shows an arrow indicating the slider's value instead of the track and knob.";
circSliderSize::usage = "circSliderSize sets the size of the control. It must be ≥ 0.";

Error handling

CircularSlider::size = "circSliderSize must be a size greater than 0. Substututing 100.";
CircularSlider::size2 = "circSliderSize must be a number or standard shortcut (Tiny, etc.). Substututing 100.";
circularSlider::direction = "circSliderDir must be CW, CCW, or ACW. Substututing CW.";
CircularSlider::start = "circSliderStart must be Top, Right, Bottom, Left. Substututing Top.";
CircularSlider::max = "Max value must be > 0. Substututing 1.0.";
CircularSlider::dx = "dx value must be a number > 0 and less than max. Substituting 0.1 * max.";

Attributes

Setting the Attributes for the function to HoldFirst so that the dynamic variable is not evaluated immediately, effectively passing the parameter by reference.

SetAttributes[CircularSlider, HoldFirst];

The function

Note the use of Except[] to prevent max and dx from taking any of the options as parameters. (Thanks to Duncan Pettengill.)

CircularSlider[pos_, max:Except[_Rule]:360, dx:Except[_Rule]:0, opts:OptionsPattern[]] := DynamicModule[
(* set up *)
     {start,direction, pt, bkgd ,conClr ,trkClr,showValQ ,drawArrow ,size , dirPos, myMax, myDx }
    ,
(* check input *)
(* rules *)start = OptionValue[CircularSlider, FilterRules[ {opts},Options[CircularSlider
        ]], circSliderStart];
 direction = OptionValue[CircularSlider,
         FilterRules[{opts},Options[ CircularSlider]], circSliderDir ];
(* rules for rendering the slider *)
 bkgd = OptionValue[CircularSlider,
         FilterRules[{opts},Options[ CircularSlider]],circSliderBackground];
conClr = OptionValue[CircularSlider,
         FilterRules[{opts},Options[ CircularSlider]],circSliderControlColor];
trkClr = OptionValue[CircularSlider,
         FilterRules[{opts},Options[ CircularSlider]],circSliderTrackColor];
showValQ = OptionValue[CircularSlider,
         FilterRules[{opts},Options[ CircularSlider]],circSliderShowValueQ];
drawArrow = OptionValue[CircularSlider,
         FilterRules[{opts},Options[ CircularSlider]],circSliderDrawArrowQ];
size = OptionValue[CircularSlider,
         FilterRules[{opts},Options[ CircularSlider]],circSliderSize];
(* error checking on inputs. Note we have to use local copies. *)
myMax =max;
myMax = If[NumericQ[myMax],N[myMax],  Message[CircularSlider::max ]; 1.0 ];
myMax = If[myMax > 0, myMax, Message[CircularSlider::max ]; 1.0 ];
myDx = dx;
myDx = If[NumericQ[myDx],N[myDx],  Message[CircularSlider::dx ]; 0.1*myMax ];
myDx = If[myDx >= 0 && myDx < myMax, myDx, Message[CircularSlider::dx ]; 0.1*myMax ];

start = If[MemberQ[{Top, Right, Bottom, Left},start], start, Message[CircularSlider::start ]; Top ];
 dirPos =Switch[direction,  "CW",True, "CCW", False, "ACW", False, _, Message[circularSlider::direction ]; True ];
pt = valueToPoint[pos, myMax, myDx, start, dirPos];

(* handle special cases for bkgd *)
If[bkgd == Automatic, bkgd = White];
(*  test background -> None and background -> a non-color *)
(* set size for named sizes *)
If[size == Tiny, size = 50];
If[size == Small, size = 100];
If[size == Medium, size = 150];
If[size == Large, size = 200];
If[size == Automatic, size = 150];
(* at this point, if size is not a strictly positive number, we should return an error and stop. *)
size = If[NumericQ[size],size, Message[CircularSlider::size2 ]; 100 ];
size =If[size >0,size, Message[CircularSlider::size ]; 100 ];
    
(* now do the locator pane. *)
LocatorPane[Dynamic[pt, (pt = #; pos = pointToValue[#, myMax, myDx,
         start, dirPos])&], Dynamic[showCircularSliderGraphics[pos, myMax, myDx, start, dirPos,
         bkgd, conClr, trkClr, showValQ, drawArrow, size]], Appearance -> None, FrameMargins
         -> 20, Exclusions -> {0, 0}, LocatorAutoCreate -> False], SaveDefinitions->True
]

These are functions that mimic the Slider[] function. Right now, they do not work if we pass options. I have the functions listed here, but need to make them work. (It does work with one option, but not two.)

Graphics function

It is certainly possible to write a version of CircularSlider[] incorporating this function. However, it is much easier to develop the code if we separate the visual elements from the rest of the code. It is also much easier to maintain the code.
Note that during development, I had passed option rules to this function, instead of decoding the graphics-specific options in the main function. This is one reason why I used the more robust syntax for OptionValue[]. However, I was not sure that options set up in this way would need special treatment when I put the code in a package.

showCircularSliderGraphics[theValue_,max_, dx_, start_, dirPosQ_, bkgd_,conClr_, trkClr_,showValQ_,drawArrow_, size_] := Module[{myPoint = valueToPoint[theValue,max, dx, start, dirPosQ],
fontSize,
startTick,
decimalsToShow,
myBkgd = bkgd,
bkgdOpacity = 1.0,
fontColor,
arrowStart
},
(* take care of background -> None. Note that the passed value in immutable, so we need to make a local copy. *)
If[myBkgd == None,{bkgdOpacity = 0.0, myBkgd = White}];
(* scale font to size of image *)
fontSize = Floor[0.15 * size];
(* Note the need to use === here to compare colors -- they are alreay turned into swatches before comparing. *)
fontColor = If[ColorDistance[ColorConvert[myBkgd, "Grayscale"], White]< 0.5, Black, White];
startTick = Switch[start, Top, {{0,.9},{0, 1.05} }, Right, {{1.05, 0},{0.9,0}}, Bottom, {{0, -0.9},{0, -1.05}}, Left,{{-1.05,0},{-0.9,0}}];
(* compute number of decimals to show *)
decimalsToShow = 2;
If[dx >=1, decimalsToShow = 0];
If[1>dx >0, decimalsToShow = -Round[Log10[dx]]];
(* If we show both the arrow and the value, start the arrow at a point away friom the center. *)
arrowStart = If[showValQ, arrowStart = 0.3* myPoint, {0,0}];
Graphics[{Opacity[bkgdOpacity],myBkgd, Rectangle[{-1.1,-1.1},{1.1,1.1}],Opacity[1.0],ColorNegate[myBkgd],Thick, Line[startTick],
(* Draw the arrow, otherwise, draw the annulus and control handle *)
If[drawArrow,{Opacity[0.3],Lighter[myBkgd, 0.6],Disk[],Opacity[1.0],trkClr,EdgeForm[{Thickness[0.005], Black}],Annulus[{0,0}, {.99, 1.01}],conClr,Thickness[0.025], Arrowheads[0.15],Arrow[{arrowStart,myPoint}]},
{trkClr,EdgeForm[{Thickness[0.01], Black}],Annulus[{0,0}, {.975, 1.025}],conClr,PointSize[0.06],Disk[myPoint,0.08] }],
(* Show value if the option is set. *)
If[showValQ,{Black,Text[Style[If[NumericQ[theValue],NumberForm[theValue,{10,decimalsToShow}, NumberPadding->{"", "0"}], "—"], fontSize, fontColor, FontWeight->"Heavy"],{0,0}]}]
 }, ImageSize->{size, size}, PlotRange->1.1]]

Auxiliary Functions

pointToValue

This code is used internally to take the point provided by the locator panel and turning it into the value that circularSlider[] returns.

It is certainly possible to put the code for pointToValTop[], etc., inside the main function. However, it is easier to code and maintain separate functions.

pointToValue[thePoint_, maxVal_, dx_, startPos_, dirPosQ_]  := Switch[startPos,
Top, pointToValTop[thePoint, maxVal, dx, dirPosQ],
Right, pointToValRight[thePoint, maxVal, dx, dirPosQ],
Bottom, pointToValBottom[thePoint, maxVal, dx, dirPosQ],
Left, pointToValLeft[thePoint, maxVal, dx, dirPosQ],
_, pointToValTop[thePoint, maxVal, dx, True]
]

pointToValTop[thePoint_, maxVal_, dx_, dirQ_] := Module[{rawVal, roundVal, defval =  0.00000001, dirMult},
dirMult = If[dirQ, 1, -1];
rawVal =Mod[ArcTan[  thePoint[[2]], dirMult *thePoint[[1]]]/Degree, 360]* maxVal/360.;
roundVal =If[dx == 0,defval, dx];
If[roundVal > maxVal, roundVal  = defval];
Floor[rawVal, roundVal]
]

pointToValRight[thePoint_, maxVal_, dx_, dirQ_] := Module[{rawVal, roundVal, defval =  0.00000001, dirMult},
dirMult = If[dirQ, -1, 1];
rawVal =Mod[ArcTan[thePoint[[1]], dirMult*thePoint[[2]]]/Degree, 360]* maxVal/360.;
roundVal =If[dx == 0,defval, dx];
If[roundVal > maxVal, roundVal  = defval];
Floor[rawVal, roundVal]
]

pointToValBottom[thePoint_, maxVal_, dx_, dirQ_] := Module[{rawVal, roundVal, defval =  0.00000001, dirMult},
dirMult = If[dirQ, -1, 1];
rawVal =Mod[ArcTan[- thePoint[[2]], dirMult *thePoint[[1]]]/Degree, 360]* maxVal/360.;
roundVal =If[dx == 0,defval, dx];
If[roundVal > maxVal, roundVal  = defval];
Floor[rawVal, roundVal]
]

pointToValLeft[thePoint_, maxVal_, dx_, dirQ_] := Module[{rawVal, roundVal, defval =  0.00000001, dirMult},
dirMult = If[dirQ, 1, -1];
rawVal =Mod[ArcTan[-thePoint[[1]], dirMult * thePoint[[2]]]/Degree, 360]* maxVal/360.;
roundVal =If[dx == 0,defval, dx];
If[roundVal > maxVal, roundVal  = defval];
Floor[rawVal, roundVal]
]

valueToPoint

This function is the inverse of pointToValue, and takes the value and makes a point for the locator to use.

valueToPoint[pos_,max_, dx_, start_, dirPosQ_] := Module[{ value, dirMult, addToBase, gran},
(* set up internal varianbles from passed parameters *)
addToBase = Switch[start, 
Top, π/2,
Right, 0.0,
Bottom, -π/2,
Left, π,
_, π/2
];
dirMult = If[dirPosQ == True, -1, 1];
gran = If[dx == 0, 0.000000001, dx];
(*  See if pos is numeric. If not, set default. *)
value = If[NumericQ[pos], pos, 0.0];
(* make sure number is in range *)
value = Mod[value, max];
(* Use Floor to make use of dx *)
value = Floor[value, gran];
(* turn value is to radians. Take care of direction here as well *)
value = dirMult * N[2π * value/max];
(* handle starting point *)
value = N[value + addToBase];
Chop[{Cos[value],Sin[value]}]
]