DZone Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

Snippets has posted 5883 posts at DZone. View Full User Profile

# Images In PopupMenu

05.02.2012
| 3433 views |
```        This Mathematica code corresponds to a question at the Mathematica Stackexchange site ( http://mathematica.stackexchange.com/questions/5014/why-do-images-in-a-popupmenu-sometimes-make-a-program-load-sluggishly).
The code builds on code originally developed by Eric Schulz (http://demonstrations.wolfram.com/NumberLineSolutionsToAbsoluteValueEquationsAndInequalities/).

Here I used characters in the popup menu.  I would like to use images, as explained in the post.

```
```Manipulate[

If[newProblem, {op2, a2, b2, newProblem} = {RandomInteger[{1, 6}],
RandomInteger[{-5, 5}], RandomInteger[4], False}];
(*If[reset,{a,b,reset}={1,2,False}];*)

If[a >= 0, a = Min[a, 10 - Abs[b]], a = Max[a, -10 + Abs[b]]];
solution = solutions[op2, a2, b2];
attempt = solutions[s, a, b];
If[ problemDisplay != 3 && solution === attempt, success, plunk[]];

Pane[Grid[DeleteCases[{

If[problemDisplay ==
1, {Style[
solution /. {Or[b7_, a7__] :>
Row[ Riffle[{b7, a7}, Style["  Or  ", Gray]]]}, 19,
FontFamily -> "Times"] // Panel}],
If[problemDisplay == 2, {absValueEquation[op2, a2, b2] // Panel}],

{Show[{
axes[{{-10.9, 10.9}, {-.5,
If[MemberQ[display, 3] \[Or] MemberQ[display, 4], 2.5,
1]}}],
arrows[a, b],
segments[s(*oper*), Blue, a, b]},
BaseStyle -> 16, ImageSize -> 550, AspectRatio -> Automatic]
},

If[MemberQ[display,
1], {Style[
attempt /. {Or[b_, a__] :>
Row[ Riffle[{b, a}, Style["  Or  ", Gray]]]}, 19,
FontFamily -> "Times"]}],
If[MemberQ[display, 2], {absValueEquation[s, a, b]}],

(*{Row[{"center:",a}]},
{Row[{"span:",b}]},*)

}, Null],

Spacings -> {2, 1} ], 540, Alignment -> Center],

{{problemDisplay, 3, "problem:"}, {1 -> "solutions",
2 -> "equation or inequality", 3 -> "none"},
ControlType -> RadioButtonBar, ControlPlacement -> Top},

(*{{showProblem,True},{False,True},ControlPlacement->Top},
*)
{{newProblem, False}, {False, True},
Enabled -> problemDisplay != 3, ControlPlacement -> Top},

{{s, 2, ""}, {1 -> "=", 2 -> "<", 3 -> "\[LessEqual]", 4 -> ">",
5 -> "\[GreaterEqual]", 6 -> "\[NotEqual]"}, PopupMenu,
ControlPlacement -> Bottom},

{{display, {1}, "display:"}, {1 -> "solutions",
2 -> "equation or inequality", 3 -> "a", 4 -> "b  "},
ControlType -> CheckboxBar, ControlPlacement -> Bottom},

{{a, 1}, -10, 10, 1, Appearance -> "Labeled", ImageSize -> 500,
ControlPlacement -> Bottom},
{{b, 2}, -10, 10, 1, Appearance -> "Labeled", ImageSize -> 500,
ControlPlacement -> Bottom},

{{a, 1}, -10, 10, 1, ControlType -> None},
{{b, 2}, -10, 10, 1, ControlType -> None},
{{a2, 3}, -10, 10, 1, ControlType -> None},
{{b2, 4}, -10, 10, 1, ControlType -> None},
{{op2, 1}, 1, 6, 1, ControlType -> None},
(*{{pts,{{1,0},{3,0}}},ControlType-> None},*)

(*{{reset,False},{False,True},ControlPlacement->Bottom},*)

AutorunSequencing -> {1, {2, 3}, {3, 3}},
TrackedSymbols :> Manipulate,
(*SaveDefinitions->True,*)

Initialization :> {

axes[plotRange_] :=
Plot[0, {x, -10, 10}, Axes -> {True, False},
Ticks -> {Range[-10, 10, 1], None}, PlotRange -> plotRange,
BaseStyle -> 16, ImageSize -> {550, 55},
AspectRatio -> Automatic];

absValueEquation[operator_, center_, span_] :=
Tooltip[Style[If[MemberQ[display, 3],
Row[{"|", Style["x", Italic], " - (", center, ")|",
operator /. {1 -> " = ", 2 -> " < ", 3 -> " \[LessEqual] ",
4 -> " > ", 5 -> " \[GreaterEqual] ",
6 -> " \[NotEqual] "}, span}],
Row[{"|", Style["x", Italic],
Which[center < 0, " + ", center == 0, "", center > 0,
" - "],
Which[center < 0, Abs[center], center == 0, "", center > 0,
center], "|",
operator /. {1 -> " = ", 2 -> " < ", 3 -> " \[LessEqual] ",
4 -> " > ", 5 -> " \[GreaterEqual] ",
6 -> " \[NotEqual] "}, span}]], 19, FontFamily -> "Times"],
Row[{Style["|", 14], Style["x-a", 12, Italic], Style["| ", 14],
operator /. opRules, Style["b", 12, Italic]}]];

arrows[center_, span_] := Graphics[
(* center arrow *)
{If[
MemberQ[display,
3], {{AbsoluteThickness[2], Gray, Arrowheads[.03],
Arrow[{{center, 2.2}, {center, 0}}, .25]},
Text[Style["a", Italic], {center, 2.2}]}, Black],

(* +b arrow *)

If[MemberQ[display, 4] &&
span != 0, {{Brown, AbsoluteThickness[1], Arrowheads[{.02}],
Arrow[{{center, 1.25}, {center + span, 1.25}}, .05]},
Text[Style["+b", Italic], {center + span/2, 1.65}]}, Black],

(* -b arrow *)

If[MemberQ[display, 4] &&
span != 0, {{Brown, AbsoluteThickness[1], Arrowheads[{.02}],
Arrow[{{center, 1.25}, {center - span, 1.25}}, .05]},
Text[Style["-b", Italic], {center - span/2, 1.65}]}, Black],

(* (b+a) arrow *)

If[MemberQ[display, 3] && MemberQ[display, 4] &&
span != 0, {{AbsoluteThickness[2], Gray, Arrowheads[.03],
Arrow[{{span + center, 2.2}, {span + center, 0}}, .25]},
Text[Style["a+b", Italic], {span + center, 2.2}]}, Black],

(* (a-b) arrow *)

If[MemberQ[display, 3] && MemberQ[display, 4] &&
span != 0, {{AbsoluteThickness[2], Gray, Arrowheads[.03],
Arrow[{{center - span, 2.2}, {center - span, 0}}, .25]},
Text[Style["a-b", Italic], {center - span, 2.2}]}, Black],

(* b=0 *)

If[MemberQ[display, 4] &&
span == 0, {Text[Style["b=0", Italic], {center, 1.65}]},
Black]}];

solutions[op_, center_, span_] :=
Module[{operator =
op /. {1 -> Equal, 2 -> Less, 3 -> LessEqual, 4 -> Greater,
5 -> GreaterEqual, 6 -> Unequal}},
Reduce[operator[Abs[x - center], span], x, Reals]];

plunk[n_: 0] := EmitSound@Sound[SoundNote[n, .25, "Woodblock"]];
success := EmitSound@Sound[SoundNote["F", 1, 99]];

radius = 0.2;
opRules = {1 -> Style["=  ", 14], 2 -> Style["<  ", 14],
3 -> Style["\[LessEqual]  ", 14], 4 -> Style[">  ", 13],
5 -> Style["\[GreaterEqual] ", 14],
6 -> Style["\[NotEqual] ", 14]};

pt[loc_, type_: "Closed"] :=
If[type == "Open", Circle[loc, radius], Disk[loc, radius]];

segments[o_, c_, a1_, b1_] :=
Graphics[{{
(* Open interval *)

If[And[o == 2 || o == 4 || o == 6, b1 >= 0], {c,
pt[{b1 + a1, 0}, "Open"], pt[{-b1 + a1, 0}, "Open"]}, c],

(* Closed interval or points *)

If[And[o == 1 || o == 3 || o == 5, b1 >= 0], {c,
pt[{b1 + a1, 0}], pt[{-b1 + a1, 0}]}, c],
AbsoluteThickness[4],

(*interval between key points *)

If[And[o == 2 || o == 3 || o == 6, b1 > 0],
{Line[{{Abs[b1] + a1 - radius, 0}, {-Abs[b1] + a1 + radius,
0}}]},
Black],
If[And[o == 4 || o == 5 || o == 6, b1 >= 0],
{c, Arrow[{{Abs[b1] + a1 + radius, 0}, {10.9, 0}}],
Arrow[{{-Abs[b1] + a1 - radius, 0}, {-10.9, 0}}]}, Black],

(*Draw complete number line: always True *)

If[And[o == 4 || o == 5 || o == 6, b1 < 0],
{c, Line[{{a1 - radius, 0}, {a1 + radius, 0}}],
Arrow[{{a1 + radius, 0}, {10.9, 0}}],
Arrow[{{a1 - radius, 0}, {-10.9, 0}}]},
Black]}(*,Black]*)}]}]
```
`    `
"Starting from scratch" is seductive but disease ridden
-Pithy Advice for Programmers