2
$\begingroup$

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!

$\endgroup$
5
  • 2
    $\begingroup$ With or without teeth? $\endgroup$
    – J. M.'s torpor
    Jun 2 '15 at 12:40
  • $\begingroup$ It would be great to have teeth :) But actually I'd like to learn how to do both. $\endgroup$
    – SuTron
    Jun 2 '15 at 12:54
  • $\begingroup$ Okay, so a Yellow Disk[], two Point[]s with the appropriate PointSize[] set, and then use a ParametricPlot[] to make a transitioning set of circle arcs… $\endgroup$
    – J. M.'s torpor
    Jun 2 '15 at 12:59
  • $\begingroup$ A better idea for a simple smile: use a symmetric Bézier curve, and just shift the central control points vertically… $\endgroup$
    – J. M.'s torpor
    Jun 2 '15 at 13:11
  • 1
    $\begingroup$ @J.M. Without teeth: demonstrations.wolfram.com/SmileyChanger $\endgroup$ Jun 2 '15 at 14:05
7
$\begingroup$

Here'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];)]

enter image description here

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}]};
$\endgroup$
0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.