Skip to content

Instantly share code, notes, and snippets.

@bencbartlett
Created October 6, 2019 21:34
Show Gist options
  • Star 5 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save bencbartlett/d13ad66d151d2f7a466083cd16027b93 to your computer and use it in GitHub Desktop.
Save bencbartlett/d13ad66d151d2f7a466083cd16027b93 to your computer and use it in GitHub Desktop.
Mathematica code for photon pulse animation
<< MaTeX`
SetOptions[MaTeX, "Preamble" -> {"\\usepackage{color,txfonts}"}];
SetDirectory[NotebookDirectory[]];
c = 1;
\[Alpha] = .7;
\[Beta] = .05;
k0 = 7;
\[Omega]0 = 2 c;
vg = c;
\[Psi][x_, t_] :=
Sqrt[\[Pi]/(\[Alpha] + I \[Beta] t)]
Exp[I (k0 x - \[Omega]0 t)] Exp[-(x - vg t)^2/(
4 (\[Alpha] + I \[Beta] t))];
moveableText[str_, curve_, {s_, t_}, angle_: 0, ff_: "Comic Sans MS",
fs_: 16] := Module[{chars = Characters[str]},
Graphics3D[MapThread[
Text[Rotate[Style[#1, FontFamily -> ff, fs, Hue[#2/23]], angle],
curve[#2]] &,
{chars, Range[s, t - 1/Length[chars], (t - s)/Length[chars]]}]]
]
renderframe[t_] := Module[{points, zeros, numlines = 5000},
{points, zeros} =
Table[{x, r Re@\[Psi][x, t], r Im@\[Psi][x, t]}, {r, {1, 0}}, {x,
0, 20, 20/numlines}];
Show[{
ParametricPlot3D[{x, Re@\[Psi][x, t], Im@\[Psi][x, t]}, {x, 0,
20},
ColorFunction -> Function[{x, y, z}, Hue[x/23 ]],
ColorFunctionScaling -> False,
MaxRecursion -> 6,
PlotStyle -> Thickness[.0015],
PlotRange -> {{0, 20}, {-2.2, 2.2}, {-2.2, 2.2}},
BoxRatios -> Automatic, Ticks -> None, Boxed -> False,
AxesOrigin -> {0, 0, 0},
AxesStyle -> Directive[White, 10],
BaseStyle -> {FontFamily -> "Latin Modern Roman",
FontColor -> White},
ViewPoint -> {20, -30, 10}],
Graphics3D[{
Text[
MaTeX["\\color{white} x", Magnification -> 2.5], {20.2, 0, 0}],
Text[
MaTeX["\\color{white} \\Re( \\psi )",
Magnification -> 2], {0, -2.8, 0}],
Text[
MaTeX["\\color{white} \\Im ( \\psi )",
Magnification -> 2], {0, 0, 2.5}]
}],
MapThread[
Graphics3D[{Hue[#1[[1]]/
23(*Arg[#1\[LeftDoubleBracket]2\[RightDoubleBracket]+\
\[ImaginaryI] #1\[LeftDoubleBracket]3\[RightDoubleBracket]]*)],
Opacity[.4], Thick(*Thickness[7/numlines]*),
Line[{#1, #2}]}] &, {points, zeros}],
moveableText["@BENCBARTLETT",
Function[x, {x, 0, 1.1 Abs@\[Psi][x, t] + .12}], {18,
20}, -10 \[Degree], "Menlo", 18]
}, Background -> Black, ImagePadding -> {{130, 0}, {0, 50}},
ImageSize -> 2000]
];
Manipulate[renderframe[t], {{t, 10}, -10, 40}]
saveframe[t_] := Module[{frame, title},
frame = renderframe[t];
title = IntegerString[Floor[1000*(t + 5)], 10, 8] <> ".png";
Export["frames/" <> title, frame];
]
numframes = 20*60;
Monitor[Do[saveframe[t], {t, -5, 30, (30 + 5)/numframes}],
ProgressIndicator[t, {-5, 30}]]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment