I want to create a yellow smile, with normal mouth which smiles in cycle. I only know that I need to use CDF player and Manipulate, but do not have any idea how to do that.
Thanks!
Mathematica Stack Exchange is a question and answer site for users of Wolfram Mathematica. It only takes a minute to sign up.
Sign up to join this communityHere's one without teeth, but it does have eyebrows, the eyes can change size, and the mouth smiles (or not):
Manipulate[
eyeMat = {{1/(eyeRadius - pupilRadius/2), 0}, {0,
1/(0.15 + eyes - pupilRadius/2)}};
If[Norm[eyeMat.(pup - eyeCenter[[left]])] < 1,
pupNow = pup - eyeCenter[[left]];];
If[Norm[eyeMat.(pup - eyeCenter[[right]])] < 1,
pupNow = pup - eyeCenter[[right]];];
Graphics[{face, eye[left, eyes], eye[right, eyes], Blue,
pupil[left, pupNow, eyes], pupil[right, pupNow, eyes], Black,
browDraw[left, brows, eyes], browDraw[right, brows, eyes],
Inset[mouthDraw[mouth], {0, -0.5}]}, ImageSize -> {400, 450}],
{{brows, {-Pi/20, 0}}, {-0.6, 0}, {0.6, 0.15},
ControlPlacement -> Left},
{{eyes, 0}, -0.07, 0.07, ControlPlacement -> Left,
ControlType -> VerticalSlider},
{{mouth, 0.15}, -0.401, 0.4, 0.01, ControlPlacement -> Left,
ControlType -> VerticalSlider},
{{pup, {0, 0}}, Locator, Appearance -> None},
Initialization :> (face = Circle[{0, 0}, {1, 1.2}]; pupNow = {0, 0};
left = 1; right = 2;
eyeRadius = 0.18; eyeCenter = {{-0.4, 0.15}, {0.4, 0.15}};
pupilRadius = 0.09;
browUp = 0.25; browW = 0.2; browAng = Pi/20;
eye[side_, eccen_] := {Black,
Circle[eyeCenter[[side]], {eyeRadius + 0.05, eyeRadius + eccen}]};
pupil[side_, pup_,
eccen_] := {Disk[eyeCenter[[side]] + pup + {0, pup[[2]] eccen},
pupilRadius + Max[0, eccen/3]], Black,
Disk[eyeCenter[[side]] + pup + {0, pup[[2]] eccen}, 0.03]};
browDraw[side_, {browAng_, browLift_}, eccen_] :=
Rotate[{Thickness[0.01],
Line[{{eyeCenter[[side]] + {-browW,
browLift + browUp + 0.5 eccen},
eyeCenter[[side]] + {browW,
browLift + browUp + 0.5 eccen}}}]}, 2 (side - 1.5) browAng];
mouthDraw[s_] :=
ParametricPlot[{Cos[u], -s Sin[u]}, {u, Pi/6, Pi - Pi/6},
Axes -> False, PlotStyle -> {Red, Thickness[0.02]},
PlotRange -> All];)]
As suggested by "Guess who it is", you can make the face yellow by changing the first line of the Initialization to
face = {Yellow, Disk[{0, 0}, {1, 1.2}]};
Yellow
Disk[]
, twoPoint[]
s with the appropriatePointSize[]
set, and then use aParametricPlot[]
to make a transitioning set of circle arcs… $\endgroup$