11
$\begingroup$

How to make a harmless ghost (one that looks like a flying bed sheet)?

One can always make a Ghost Curve.

Or one can define define a clever wiggly function with a random fluctuation.

My initial guess is a parabolic top with some sinusoidal bottom.

ghost[t_] = If[t > 0, {Sin[2 t Pi], Cos[2 t Pi]^2}, 
                {{Sin[2 Pi t], -0.2 Sin[8 Pi t]^2}}]
ParametricPlot[ghost[t], {t, -1, 1}]

enter image description here

and put some random oscillation to make it move.

Have anyone come across any better ghost in their shell (or notebook)?

Pac-Ghost

A simple ghost from Pacman.

h = 1.0; w = 1.0;
x[t_, t0_] = Piecewise[{{w/2, 0 <= t < 1/8}, {-w (t - 1/4) 4, 
 1/8 <= t < 3/8}, {-w/2, 3/8 <= t < 5/8}, {w (t - 3/4) 4, 
 5/8 <= t < 7/8}, {w/2, 7/8 <= t < 1}}, w/2];
y[t_, t0_] = Piecewise[{{4 h t, 0 <= t < 1/8}, {h/2 + 2 w (1/4 - (4 t - 1)^2), 
 1/8 <= t < 3/8}, {-4 h (t - 1/2), 3/8 <= t < 5/8}, {-h/2 + 
  0.2 (Sin[8 (t - t0 - 3/2) Pi]^2 - Sin[8 (t0 - 3/2) Pi]^2), 
 5/8 <= t < 7/8}, {4 h (t - 1), 7/8 <= t < 1.0}}];

Animate[ParametricPlot[{x[t, t0], y[t, t0]}, {t, 0, 1}, 
  PlotRange -> {{-1, 1}, {-0.8, 1.2}}, 
  Epilog -> {Disk[{w/4, h/2}, w/10], Disk[{-w/4, h/2}, w/10]}]
,{t0, 0, 1, 0.1}]

enter image description here

$\endgroup$

1 Answer 1

14
$\begingroup$

One approach can be using BSplineFunction which can take care of the smoothness of the ghost. Here I start from a triangle for the base shape and keep updating the ghost profile with a random fluctuation for the bottom part.

pt0 = {{-1, 0}, {0, 2}, {1, 0}};
c0 = BSplineFunction[pt0, SplineClosed -> True, SplineDegree -> 3];
a = Area[Polygon[c0[#] & /@ Range[0, 1, 0.01]]];
ListAnimate@Table[pt0 = c0[#]/a & /@ Range[0, 1, 0.02];
 pt1 = (# - Mean[pt0] + 
       (1 - HeavisideTheta[#[[2]]]) RandomReal[0.025 {-1, 1}, 2]) & /@ pt0;
 e0 = Mean@Select[pt1, #[[2]] > 0 &];
 c0 = BSplineFunction[pt1, SplineClosed -> True, SplineDegree -> 3];
 a = Area[Polygon[c0[#] & /@ Range[0, 1, 0.01]]];
 Graphics[{Gray, Polygon[c0[#]/a & /@ Range[0, 1, 0.01]], 
           White, Disk[e0 + {# 0.1, -0.05}, a/20] & /@ {-1, 1}}, 
           PlotRange -> {{-1, 1}, {-1, 1}}, AspectRatio -> 1, Background -> Black]
,{n, 100}]

enter image description here

Probably it can be done in three dimension as well starting from a pyramid.

$\endgroup$

Your Answer

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

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