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!

Improve this question
$\endgroup$
5
  • 2
    $\begingroup$ With or without teeth? $\endgroup$
    – J. M.'s eventual burnout ♦
    Jun 2, 2015 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, 2015 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 eventual burnout ♦
    Jun 2, 2015 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 eventual burnout ♦
    Jun 2, 2015 at 13:11
  • 1
    $\begingroup$ @J.M. Without teeth: demonstrations.wolfram.com/SmileyChanger $\endgroup$
    – Dr. belisarius
    Jun 2, 2015 at 14:05

1 Answer 1

Reset to default
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}]};
Improve this answer
$\endgroup$
0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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