Mathematica Graphics Language and New Features

Chris Hill and Yuzhu Lu

Wolfram Research, Inc.

About this talk

Mathematica Graphics Language Overview

New Graphics Features:

Texture

Support Inset in 3D

Build your own functions:

Examples

Mathematica Graphics Language

2D and 3D

Graphics[{Blue,Opacity[0.5],EdgeForm[{Thickness[0.025],Red}],Disk[],Disk[{1,0},0.9],Disk[{0.5,-1},0.75],Rectangle[{-0.5,-1.25},{0,-0.75}]}]

Graphics3D[{Yellow,EdgeForm[{Thickness[0.025],Dashing[{0.1,0.03}]}],Cone[],Red,Sphere[{0,0,1},0.1],Black,Arrow[{{1,1,1},{0.1,0.1,1}}]}]

Graphics Primitives

2D

Arrow,BezierCurve,BSplineCurve,Circle,Disk,FilledCurve,Inset,GraphicsComplex,GraphicsGroup,JoinedCurve,Line,Locator,Point,Polygon,Raster,Rectangle,Text

Grid[{Show[#,ImageSize->50]&/@{Graphics[{Arrowheads[0.3],Arrow[{{0,0},{1,1}}]}],Graphics[BezierCurve[{{0,0},{1,2},{3,1},{5,6},{3,6},{3,1},{0,0}}]],Graphics[Circle[]],Graphics[Disk[]],Graphics[FilledCurve[BezierCurve[{{0,0},{1,2},{3,1},{5,6},{3,6},{3,1},{0,0}}]]],Graphics[Line[{{0,0},{1,1}}]],Graphics[Point[{{0,0},{1,0},{1,1}}]],Graphics[Polygon[{{0,0},{1,0},{0,1}}]],Graphics[Raster[{{0.3,0.2,0.6},{0.9,0.6,0.1},{0.5,0.3,0.2}}]],
Graphics[Rectangle[]],Graphics[Text["Text"]]}}]

3D

Arrow,BezierCurve,BSplineCurve,BSplineSurface,Cone,Cuboid,Cylinder,GraphicsComplex,GraphicsGroup,Line,Point,Polygon,Sphere,Text,Tube

Grid[{Show[#,ImageSize->50,Boxed->False]&/@{Graphics3D[{Arrowheads[0.3],Arrow[{{0,0,0},{1,1,1}}]}],Graphics3D[BezierCurve[Append[#,0]&/@{{0,0},{1,2},{3,1},{5,6},{3,6},{3,1},{0,0}}]],Graphics3D[BSplineSurface[Table[{i,j,RandomReal[{-1,1}]},{i,5},{j,5}]]],Graphics3D[Cuboid[]],Graphics3D[Sphere[]],Graphics3D[Cone[]],Graphics3D[Cylinder[]],Graphics3D[Tube[{{0,0,0},{1,1,1}},0.1]],Graphics3D[Line[{{0,0,0},{1,1,1}}]],Graphics3D[Point[{{0,0,0},{1,0,0},{1,0,1},{1,1,0}}]],Graphics3D[Polygon[{{0,0,0},{1,0,0},{0,1,0}}]],Graphics3D[Text["Text"]]}}]

Interactive Elements

Tooltip,EventHandler,Mouseover

Graphics3D[{Tooltip[Cylinder[{{2,2,0},{2,2,1}}],Style["Cylinder",FontSize->30]], Mouseover[{Red,Sphere[]},{Blue,Sphere[]}],Green,DynamicModule[{b=False},EventHandler[Cone[Dynamic[{{4,4,0},{4,4,2If[b,-1,1]}}]],{"MouseDown":>(b=!b)}]]},PlotRange->{Automatic,Automatic,{-2,2}}]

Locator

Graphics[GraphicsComplex[{{0,0},{1,1}},{Arrow[{1,2},0.1],Locator[2]}],PlotRange->{{0,2},{0,2}}]

Functions that generate graphics

Plotting

ParametricPlot3D[ {Cos[ ϕ] Sin[θ], Sin[ϕ]Sin[θ], Cos[θ]},{ϕ, 0, 2π}, {θ, 0, π}, MeshFunctions->{Function[{x,y,z, ϕ, θ}, Sin[6 ϕ]Sin[6θ]]},Mesh->{{1/4}},PlotPoints -> 50,MeshShading->{FaceForm[Green,Red],None}]

Charts

BarChart3D[Range[-5,5],ChartStyle->53,ChartElementFunction->"ProfileCube",ChartBaseStyle->Directive[EdgeForm[Gray],Opacity[0.8],Specularity[White,30]]]

Graphs

CompleteGraph[10]

Graphics can be freely mixed with text and user interfaces

Graphics in input and output expressions

((-b±(Sqrt[(b^2)-4a c]))/(2a))/.{a->,b->,c->}

Graphics in user interfaces

Panel[TabView[#->Image[EdgeDetect[#],ImageSize->400]&/@{,,}]]

3D Inset in 2D

Graphics[{Circle[],Inset[Graphics3D[Cone[],Background->LightRed,PlotLabel->"3D",SphericalRegion->True]]},Background->LightBlue,PlotLabel->"2D"]

2D Inset in 3D

Graphics3D[
{Cone[],Inset[Graphics[Circle[],Background->LightBlue,PlotLabel->"2D",ImageSize->100],{0,0,2}]},Background->LightRed,PlotLabel->"3D",SphericalRegion->True]

Dynamic in graphics

Extracting 3D ViewPoint with Dynamic

vp={2,3,4};
Graphics3D[Cone[],ViewPoint->Dynamic[vp]]

vp=Left;

Dynamic[vp]

View Option Display

ParametricPlot3D[{{4+(3+Cos[v]) Sin[u],4+(3+Cos[v]) Cos[u],4+Sin[v]},{8+(3+Cos[v]) Cos[u],3+Sin[v],4+(3+Cos[v]) Sin[u]}},{u,0,2 π},{v,0,2 π},Axes->None,SphericalRegion->True]

Synchronized Views

{ParametricPlot3D[{{4+(3+Cos[v]) Sin[u],4+(3+Cos[v]) Cos[u],4+Sin[v]},{8+(3+Cos[v]) Cos[u],3+Sin[v],4+(3+Cos[v]) Sin[u]}},{u,0,2 π},{v,0,2 π},Axes->None,SphericalRegion->True],ParametricPlot3D[{Sin[u],Cos[u],(u/10)},{u,0,20},Axes->None,SphericalRegion->True],Graphics3D[Cone[],SphericalRegion->True]}

Recording Interactions

g=;

recordInteract[g]

settings=interactSettings[];

playbackInteract[g,settings]

Implementation

recordInteract[g_Graphics3D]:=Module[{},nonrecordedoptions=Sequence[Boxed->False,SphericalRegion->True,ImageSize->{300,300}];
vp=ViewPoint/.Options[Graphics3D,ViewPoint];vpl={};
vv=ViewVertical/.Options[Graphics3D,ViewVertical];vvl={};
va=ViewAngle/.Options[Graphics3D,ViewAngle];val={};
vc=ViewCenter/.Options[Graphics3D,ViewCenter];vcl={};
t0=Infinity;tn=0;tl={};
update[]:=With[{t=AbsoluteTime[]},If[t<t0,t0=t];tn=t;AppendTo[vpl,vp];AppendTo[vvl,vv];AppendTo[val,va];AppendTo[vcl,vc];AppendTo[tl,t-t0]];
Graphics3D[First[g],nonrecordedoptions,ViewPoint->Dynamic[vp,(update[];vpl[[Length[vpl]]]=vp=#)&],ViewVertical->Dynamic[vv,(update[];vvl[[Length[vvl]]]=vv=#)&],ViewAngle->Dynamic[va,(update[];val[[Length[val]]]=va=#)&],
ViewCenter->Dynamic[vc,(update[];vcl[[Length[vcl]]]=vc=#)&]]]

animateview[g_,duration_,tl_,vpl_,vvl_,val_,vcl_,opts___]:=DynamicModule[{i=1},DynamicWrapper[Graphics3D[First[g],opts,If[Length[vpl]>0,ViewPoint->Dynamic[vpl[[i]]],Unevaluated@Sequence[]],If[Length[vvl]>0,ViewVertical->Dynamic[vvl[[i]]],Unevaluated@Sequence[]],If[Length[vcl]>0,ViewCenter->Dynamic[vcl[[i]]],Unevaluated@Sequence[]],If[Length[val]>0,ViewAngle->Dynamic[val[[i]]],Unevaluated@Sequence[]]],i=Max[1,Length[Select[tl,#<Clock[duration]&]]]]]

fb[f_]:=Join[f,Reverse[f]];

animateviewfb[g_,duration_,tl_,vpl_,vvl_,val_,vcl_,opts___]:=animateview[g,2*duration,Join[tl,tl+duration],fb[vpl],fb[vvl],fb[val],fb[vcl],opts];

interactSettings[]:={tn-t0,tl,vpl,vvl,val,vcl,nonrecordedoptions};

playbackInteract[g_Graphics3D,settings_]:=animateviewfb[g,Sequence@@settings];

inspectViewOptions[g_]:=DynamicModule[{viewpoint=ViewPoint/. Options[g,ViewPoint],viewvertical=ViewVertical/. Options[g,ViewVertical],viewcenter=ViewCenter/. Options[g,ViewCenter],viewangle=ViewAngle/. Options[g,ViewAngle],imagesize=ImageSize/. Options[g,ImageSize]},Grid[{{Show[g,ViewPoint->Dynamic[viewpoint],ViewVertical->Dynamic[viewvertical],ViewCenter->Dynamic[viewcenter],ViewAngle->Dynamic[viewangle],ImageSize->Dynamic[imagesize]]},{Panel[Dynamic@Grid[{{ViewPoint->viewpoint},{ViewVertical->viewvertical},{ViewCenter->viewcenter},{ViewAngle->viewangle},{ImageSize->imagesize}},Alignment->Left],ImageSize->400]}}]]

synchronizeViewOptions[g__Graphics3D]:=DynamicModule[{viewpoint=ViewPoint/. Options[First[{g}],ViewPoint],viewvertical=ViewVertical/. Options[First[{g}],ViewVertical],viewcenter=ViewCenter/. Options[First[{g}],ViewCenter],viewangle=ViewAngle/. Options[First[{g}],ViewAngle],imagesize=ImageSize/. Options[First[{g}],ImageSize]},Grid[{Show[#,ViewPoint->Dynamic[viewpoint],ViewVertical->Dynamic[viewvertical],ViewCenter->Dynamic[viewcenter],ViewAngle->Dynamic[viewangle],ImageSize->Dynamic[imagesize]]&/@{g}}]]

New Graphics Features: Texture

KeyWords:  ▪ Texture . VertexTextureCoordinates . Polygon   . FaceForm . ParametricPlot3D

Texture mapping has been added to the new version of Mathematica for both 2D and 3D polygons.

Manipulate[Graphics[{Texture[],Polygon[{{1,1},{3,1},{1+2a,3}},VertexTextureCoordinates->{{0,0},{1,0},{a,1}}]}],{a,0,1}]

DynamicModule[{vertexcoords={{0,0},{0,1},{1,0.5}},texturecoords={{0.2,0.2},{0.9,0.1},{0.1,0.9}},img=},Grid[{{"Texture Space","","Image Space"},{Graphics[{Inset[img,Automatic,Automatic,Scaled[1]],{Opacity[0.8],White,Polygon[Dynamic[texturecoords]]},Locator[Dynamic[texturecoords[[#]]],Graphics[{{Yellow,Disk[]},Text[#]},ImageSize->20]]&/@Range[3]},ImagePadding->None],Style["→",FontSize->50],Graphics[{Texture[img],Polygon[Dynamic[vertexcoords],VertexTextureCoordinates->Dynamic[texturecoords]],Locator[Dynamic[vertexcoords[[#]]],Graphics[{{Yellow,Disk[]},Text[#]},ImageSize->20]]&/@Range[3]}]}}]]

v={{-1,-1,-1},{1,-1,-1},{1,1,-1},{-1,1,-1},{-1,-1,1},{1,-1,1},{1,1,1},{-1,1,1}};
i={{1,2,3,4},{1,2,6,5},{2,3,7,6},{3,4,8,7},{4,1,5,8},{5,6,7,8}};
t={{0,0},{0,1},{1,1},{1,0}};
box=;
Graphics3D[{Texture[box],Black,GraphicsComplex[v,Polygon[i,VertexTextureCoordinates->{t,t,t,t,t,t}]]}]

2 Sided Texture

v={{-1,-1,-1},{1,-1,-1},{1,1,-1},{-1,1,-1},{-1,-1,1},{1,-1,1},{1,1,1},{-1,1,1}};
i={{1,2,3,4},{1,2,6,5},{2,3,7,6},{3,4,8,7},{4,1,5,8},{5,6,7,8}};
t={{0,0},{0,1},{1,1},{1,0}};
i2={{1,4,3,2},{1,2,6,5},{2,3,7,6},{3,4,8,7},{4,1,5,8}};
box=;
checker=Graphics[{Polygon[Join@@Table[{{i,j},{i+1,j},{i+1,j+1},{i,j+1}},{i,0,7,2},{j,0,7,2}]],Polygon[Join@@Table[{{i,j},{i+1,j},{i+1,j+1},{i,j+1}},{i,1,8,2},{j,1,8,2}]]},PlotRange->{{0,8},{0,8}}];
Graphics3D[{FaceForm[Texture[box],Texture[checker]],Black,GraphicsComplex[v,Polygon[i2,VertexTextureCoordinates->{t,t,t,t,t}]]}]

Using Texture in PlotStyle

Using Texture in PlotStyle will use a default mapping

ParametricPlot[r^2{ Sqrt[t]Cos[t], Sin[t]},{t,0,3Pi/2},{r,1,2},PlotStyle->{Opacity[1],Texture[]},Axes->False,Frame->False]

ParametricPlot3D[{Cos[u] Sin[v],Sin[u] Sin[v],1-Cos[v]} ,{u, 0, 2π}, {v, 0, π},Background->Black,Axes->False,Mesh->None,Boxed->False,SphericalRegion->True,Lighting->{{"Ambient",White}},PlotStyle->Texture[]]

More control of texture coordinate generation with TextureCoordinateFunction

ParametricPlot[r^2{ Sqrt[t]Cos[t], Sin[t]},{t,0,3Pi/2},{r,1,2},PlotStyle->{Opacity[1],Texture[]},Axes->False,Frame->False,TextureCoordinateFunction->({ #1,#2}&)]

Texture Materials with ExampleData

ExampleData[#]&/@ExampleData["ColorTexture"]

ParametricPlot3D[{Cos[t] (3+Cos[u]),Sin[t] (3+Cos[u]),Sin[u]},{t,0,2Pi},{u,0,2Pi},PlotStyle->{Texture[]},TextureCoordinateFunction->({#1,#2,0}+{.5,.5,0}&),Axes->False,Lighting->"Neutral",Mesh->None,Boxed->False]

ParametricPlot3D[{Cos[t] (3+Cos[u]),Sin[t] (3+Cos[u]),Sin[u]},{t,0,2Pi},{u,0,2Pi},PlotStyle->{Texture[],Specularity[White,10]},TextureCoordinateFunction->({#1,#2,0}+{.5,.5,0}&),Axes->False,Lighting->"Neutral",Mesh->None,Boxed->False]

Sky Box

sides={,,,,,};
v={{-1,-1,-1},{1,-1,-1},{1,1,-1},{-1,1,-1},{-1,-1,1},{1,-1,1},{1,1,1},{-1,1,1}};
idx={{1,2,3,4},{1,2,6,5},{2,3,7,6},{3,4,8,7},{4,1,5,8},{5,6,7,8}};
vtc={{0.01,0.01},{0.99,0.01},{0.99,0.99},{0.01,0.99}};
Graphics3D[{Black,EdgeForm[None],
Table[{Texture[sides[[i]]],GraphicsComplex[v,Polygon[idx[[i]],VertexTextureCoordinates->vtc]]},{i,6}]},ViewVector->{{0.6,0.6,0},{0,0,0}},ViewAngle->1,Boxed->False,Method->{"RotationControl"->"Globe"}]

New Graphics Features: Support Inset in 3D

KeyWords:  ▪ Inset . Text   .  Graphics . Graphics3D

Inset provides a way to put 2D graphics/expressions into 3D. The 2D Graphics is always oriented to facing the view point.

Graphics3D[{Opacity[.99],Sphere[{0,-1,0},0.5],Cuboid[{{-0.25,0.5,-0.25},{0.25,1,0.25}}],Inset[Graphics[{Disk[{0,0},.25]},ImageSize->50],{0,0,0}]},PlotRange->2]

Graphics3D[{Opacity[.99],Sphere[{0,-1,0},0.5],Cuboid[{{-0.25,0.5,-0.25},{0.25,1,0.25}}],Inset[Style["Mathematica",Blue,30],{0,0,0}]},PlotRange->2]

Graphics3D[{Opacity[.99],Sphere[{0,-1,0},0.5],Cuboid[{{-0.25,0.5,-0.25},{0.25,1,0.25}}],Inset[DynamicModule[{x=0},Button[Dynamic[x],x++;EmitSound[Sound[SoundNote[]]]]],{0,0,0}]},PlotRange->2]

Application

fire={,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,};
DynamicModule[{b=First@Range[1]},{Graphics3D[{CapForm[None],Tube[BSplineCurve[{{0,0,-1},{0,0,5},{0,0,10},{0,0,17},{0,0,25},{0,0,32},{0,0,35}}],{20,25,26,30,26,20,16}],Inset[Dynamic[Image[fire[[b]],ColorSpace-> "RGB",ImageSize->200]],{0,0,45}]},Boxed->False,ImageSize->{400,400},Lighting->"Neutral"],Dynamic[If[b<31,b++,b=First@Range[1]]]}]

dust=;
DynamicModule[{pos=RandomReal[{-1,1},3],obj=Sphere[pos,.5],a=100},{Graphics3D[{Opacity[.99],EventHandler[Dynamic[{obj}],{"MouseClicked":>(obj=obj/.{Sphere[pos,.5]->Inset[Image[dust,ColorSpace-> "RGB",ImageSize->Dynamic[a]],pos]};a=50;"shot"[[2]])}]},ImageSize->400,PlotRange->2.5],Dynamic[If[0<a<600,a=a+5,(pos=RandomReal[{-1,1},3];obj=Sphere[pos,.5];a=1)]]}]

imageProcessing=;
DynamicModule[{theta=0},{Graphics3D[{Tooltip[Annotation[Inset[Hyperlink[Image[imageProcessing,ImageSize->Dynamic[150/Norm[{2*Cos[theta]-1,2*Sin[theta],1}]]],"paclet:guide/ImageProcessing"],{1,0,0}],"Label","Mouse"],"Image Processing"],
Inset[Tooltip[Annotation[Hyperlink[Framed[LocatorPane[{1,1}/2,Graphics[{Blue,Opacity[Dynamic[1/Norm[{2*Cos[theta],2*Sin[theta]-1,1}]]],Disk[]},ImageSize->Dynamic[150/Norm[{2*Cos[theta],2*Sin[theta]-1,1}]]]]],"paclet:guide/GraphicsInteractivityAndDrawing"],"Label","Mouse"],"Interactive Graphics"],{0,1,0}],Inset[Tooltip[Annotation[Hyperlink[Framed[Style["Plots","Title",FontSize->Dynamic[Dynamic[100/Norm[{2*Cos[theta]+1,2*Sin[theta],1}]]]]],"paclet:guide/FunctionVisualization"],"Label","Mouse"],"Mathematica Plot Functions"],{-1,0,0}],Tooltip[Annotation[Inset[Hyperlink[Framed[PieChart[{1,2,3,4},ImageSize->Dynamic[150/Norm[{2*Cos[theta],2*Sin[theta]+1,1}]]]],"paclet:guide/ChartingAndInformationVisualization"],{0,-1,0}],"Label","Mouse"],"Charting and Information Visualization"]},Boxed->False,ImageSize->{400,400},SphericalRegion->True,PlotLabel->"Please mouse over and click objects.",ViewVector->Dynamic[{{10*Cos[theta],10*Sin[theta],2},{0,0,0}}]],Dynamic[If[theta<2Pi,theta =If[MouseAnnotation[]=!="Label",theta+0.04+.02*If[Mod[theta,Pi/2]>Pi/4,Pi/2-Mod[theta,Pi/2],Mod[theta,Pi/2]],theta],theta=0]]}]

Example 1: X ray effects

Graphics3D[{Opacity[.1],Specularity[White,5],EdgeForm[None],Cylinder[],Sphere[{0,0,2}],Thick,Dashed,Polygon[{{-3,-3,-2},{-3,3,-2},{3,3,-2},{3,-3,-2}}],Cuboid[{-2,-2,-1.99},{2,2,-1}]},Background->Black,Boxed->False,Lighting->"Neutral"]

XYay[data_]:=Graphics3D[{Opacity[.1],EdgeForm[None],data},Background->Black,Boxed->False,Lighting->"Neutral"];

XYay[First@ParametricPlot3D[{1.16^v Cos[v](1+Cos[u]),-1.16^v Sin[v](1+Cos[u]),-2 1.16^v(1+Sin[u])},{u,0,2Pi},{v,-15,6},Mesh->None,PlotRange->All,PlotPoints->100]]

XYay[{Specularity[White,5],First@Import[FileNameJoin[{NotebookDirectory[],"car.3ds"}]]}]

XYay[{Specularity[White,5],First@Import[FileNameJoin[{NotebookDirectory[],"bed.3ds"}]]}]

Make your own visualization functions: Line animator

Line Animation - Basic examples

pts=RandomReal[{0,1},{10,2}];
dist=0;
For[ii=1,ii<Length[pts],ii++,dist=dist+EuclideanDistance[pts[[ii]],pts[[ii+1]]]]
DynamicModule[{i=dist-0.001},
Graphics[{Dynamic[i = If[i>0,i=i-0.01,0];Arrow[pts,{0,i}]]}]
]

pen=Graphics[{Thickness[.02],JoinedCurve[{{Line[100{{0.9,1},{0.08,0.18},{0,0},{0.18,0.08},{1,0.9}}],BezierCurve[100{{1,1},{0.9,1}}]},{Line[100{{0.97,0.97},{0.15,0.15}}],BezierCurve[100{{0.1,0.12},{0.1,0.18},{0.1,0.2}}]},{Line[100{{0.97,0.97},{0.15,0.15}}],BezierCurve[100{{0.12,0.1},{0.18,0.1},{0.2,0.1}}]}}],Polygon[100{{0,0},{0.03,0.06},{0.06,0.03}}],FilledCurve[BezierCurve[100{{1,0.9},{1,1},{0.9,1}}]]},PlotRange->100{{0,1.5},{0,1.5}}];

pts=RandomReal[{0,1},{10,2}];
dist=0;
For[ii=1,ii<Length[pts],ii++,dist=dist+EuclideanDistance[pts[[ii]],pts[[ii+1]]]]
DynamicModule[{i=dist-0.001},
Dynamic[i = If[i>0,i=i-0.01,0];Graphics[{Arrowheads[{{0.001,1,pen}}],Arrow[pts,{0,i}]},PlotRange->{{0,1},{0,1}}]]
]

Line Animation - Plots

PlotLineAnimator[data_,speed_]:=DynamicModule[{pts=data[[1,1,3,2,1]],dist=0,ii=0,obj,i},
First@{obj=Length[pts];For[ii=1,ii<obj,ii++,dist=dist+EuclideanDistance[pts[[ii]],pts[[ii+1]]]];i=dist-0.1;Graphics[{Arrowheads[0.0],Dynamic[i = If[i>0,i=i-speed,0];Arrow[Line[pts],{0,i}]]},ImageSize->400]
}];

PlotLineAnimator[Plot[{x Sin[1/x],Abs[x],-Abs[x]}, {x,-1/2,1/2}],0.005]

StreamPlotLineAnimator[data_]:=DynamicModule[{stream=data[[1,2]],pts,obj,size,dist,currentObj,step},
First@{obj=Length[stream];
pts=Join@@Table[Table[stream[[i,2,j,2,1]],{j,1,Length[stream[[i,2]]]}],{i,1,obj}];
obj=Length[pts];
size=1000;
dist=0;
currentObj=1;
dist=Table[0,{i,1,obj}];
For[j=1,j≤obj,j++,{For[i=1,i<Length[pts[[j]]],i++,dist[[j]]=dist[[j]]+EuclideanDistance[pts[[j]][[i]],pts[[j]][[i+1]]]]}];
step=Max[dist]/3;
DynamicModule[{a=dist[[1]]*0.99},
Graphics[{Blue,Thickness[0.004],Arrowheads[{0.0}],Dynamic[a = If[a>dist[[currentObj]]*0.001,a-step,If[currentObj<obj, dist[[++currentObj]]*0.99,0]];{Arrow[Line[{pts[[currentObj]]}],{0,a}],If[currentObj>1,Line[Table[pts[[i]],{i,1,currentObj-1}]]]}],Opacity[0],Point[pts]},ImageSize->400]
]}];

StreamPlotLineAnimator[StreamPlot[{-1-x^2+y,1+x-y^2},{x,-3,3},{y,-3,3}]]

StreamPlotLineAnimator[StreamPlot[{y,-y+x-x^3},{x,-3,3},{y,-3,3}]]

StreamPlotLineAnimator[StreamPlot[{-y +(1-x^2-y^2)^2x,x+(1-x^2-y^2)^2y},{x,-3,3},{y,-3,3}]]

3D Line Animation

ModelConstructionLineAnimator[data_,speed_]:=DynamicModule[{pts=data[[1,2,1]],normals=data[[1,2,3,2]],dist=0,ii=0,obj,i},
First@{obj=Length[pts];For[ii=1,ii<obj,ii++,dist=dist+EuclideanDistance[pts[[ii]],pts[[ii+1]]]];i=dist-0.1;Graphics3D[{Arrowheads[0.0],Dynamic[i = If[i>0,i=i-speed,0];Arrow[Line[pts,VertexNormals->normals],{0,i}]]},Boxed->False,ImageSize->400]
}];

ModelConstructionLineAnimator[ExampleData[{"Geometry3D","Beethoven"}],1]

ModelConstructionLineAnimator[ExampleData[{"Geometry3D","Cow"}],1]

ModelConstructionLineAnimator[ExampleData[{"Geometry3D","Galleon"}],10]

Country boundary

CountryLineAnimator[data_]:=DynamicModule[{country=data[[1]],size=1000,dist=0,currentObj=1,step,obj},
First@{obj=Length[country];dist=Table[0,{i,1,obj}];
For[j=1,j≤obj,j++,{For[i=1,i<Length[country[[j]]],i++,dist[[j]]=dist[[j]]+EuclideanDistance[country[[j]][[i]],country[[j]][[i+1]]]]}];
step=Max[dist]/100;
DynamicModule[{a=dist[[1]]*0.99},
Graphics[{Blue,Thickness[0.004],Arrowheads[0],Dynamic[a = If[a>dist[[currentObj]]*0.001,a-step,If[currentObj<obj, dist[[++currentObj]]*0.99,0]];{Arrow[Line[country[[currentObj]]],{0,Dynamic@a}],If[currentObj>1,Line[Table[country[[ii]],{ii,1,currentObj-1}]]]}],Opacity[0],Line[country]},ImageSize->400]
]}]

CountryLineAnimator[CountryData["USA","Polygon"]]

CountryLineAnimator[CountryData["UK","Polygon"]]

Fonts

FontsLineAnimator[data_]:=DynamicModule[{curve=First[First[ImportString[ExportString[data,"PDF"],"TextMode"->"Outlines"]]][[2]][[1]][[1]]/.FilledCurve[args__]:>JoinedCurve[args,CurveClosed->True],size=1000,dist=0,currentObj=1},
First@{pts=curve[[2]];obj=Length[pts];dist=Table[0,{i,1,obj}];
For[j=1,j≤obj,j++,{For[i=1,i<Length[pts[[j]]],i++,dist[[j]]=dist[[j]]+EuclideanDistance[pts[[j]][[i]],pts[[j]][[i+1]]]]}];
step=Max[dist]/100;
DynamicModule[{a=dist[[1]]*0.99},
Graphics[{Blue,Thickness[0.004],Arrowheads[{0.0}],Dynamic[a = If[a>dist[[currentObj]]*0.001,a-step,If[currentObj<obj, dist[[++currentObj]]*0.99,0]];{Arrow[JoinedCurve[{curve[[1]][[currentObj]]},{pts[[currentObj]]},CurveClosed->True],{0,Dynamic@a}],If[currentObj>1,JoinedCurve[Table[curve[[1]][[ii]],{ii,1,currentObj-1}],Table[curve[[2]][[ii]],{ii,1,currentObj-1}],CurveClosed->True]]}],Opacity[0],curve},ImageSize->800]
]}]

FontsLineAnimator[Style["Mathematica",FontFamily->"Times",FontSize->72]]

FontsLineAnimatorWithPen[data_]:=DynamicModule[{pen=Graphics[{Thickness[.02],Red,JoinedCurve[{{Line[100{{0.9,1},{0.08,0.18},{0,0},{0.18,0.08},{1,0.9}}],BezierCurve[100{{1,1},{0.9,1}}]},{Line[100{{0.97,0.97},{0.15,0.15}}],BezierCurve[100{{0.1,0.12},{0.1,0.18},{0.1,0.2}}]},{Line[100{{0.97,0.97},{0.15,0.15}}],BezierCurve[100{{0.12,0.1},{0.18,0.1},{0.2,0.1}}]}}],Polygon[100{{0,0},{0.03,0.06},{0.06,0.03}}],FilledCurve[BezierCurve[100{{1,0.9},{1,1},{0.9,1}}]]},PlotRange->100{{0,1.5},{0,1.5}}],curve=First[First[ImportString[ExportString[data,"PDF"],"TextMode"->"Outlines"]]][[2]][[1]][[1]]/.FilledCurve[args__]:>JoinedCurve[args,CurveClosed->True],size=1000,dist=0,currentObj=1},
First@{pts=curve[[2]];obj=Length[pts];dist=Table[0,{i,1,obj}];
For[j=1,j≤obj,j++,{For[i=1,i<Length[pts[[j]]],i++,dist[[j]]=dist[[j]]+EuclideanDistance[pts[[j]][[i]],pts[[j]][[i+1]]]]}];
step=Max[dist]/300;
DynamicModule[{a=dist[[1]]*0.99},
Graphics[{Blue,Thickness[0.004],Arrowheads[{{0.001,1,pen}}],Dynamic[a = If[a>dist[[currentObj]]*0.001,a-step,If[currentObj<obj, dist[[++currentObj]]*0.99,0]];{If[a≤0,Arrowheads[0]],Arrow[JoinedCurve[{curve[[1]][[currentObj]]},{pts[[currentObj]]},CurveClosed->True],{0,Dynamic@a}],If[currentObj>1,JoinedCurve[Table[curve[[1]][[ii]],{ii,1,currentObj-1}],Table[curve[[2]][[ii]],{ii,1,currentObj-1}],CurveClosed->True]]}],Opacity[0],curve},ImagePadding->None,ImageSize->800,PlotRange->{{0,300},{0,60}}]
]}]

FontsLineAnimatorWithPen[Style["Mathematica",FontFamily->"Mathematica1",FontSize->72]]

Free hand paint

FreePaintLineAnimator[data_,speed_]:=DynamicModule[{paint=First[data],size=1000,dist=0,currentObj=1,obj,pts,step},
First@{obj=Length[paint];pts=Table[First@paint[[i,3]],{i,1,obj}];dist=Table[0,{i,1,obj}];
For[j=1,j≤obj,j++,{For[i=1,i<Length[pts[[j]]],i++,dist[[j]]=dist[[j]]+EuclideanDistance[pts[[j]][[i]],pts[[j]][[i+1]]]]}];
step=Max[dist]/speed;
DynamicModule[{a=dist[[1]]*0.99},
Graphics[{Blue,Thickness[0.004],Arrowheads[{0.0}],Dynamic[a = If[a>dist[[currentObj]]*0.001,a-step,If[currentObj<obj, dist[[++currentObj]]*0.99,0]];{Arrow[Line[{pts[[currentObj]]}],{0,a}],If[currentObj>1,Line[Table[pts[[i]],{i,1,currentObj-1}]]]}],Opacity[0],Point[pts]},ImageSize->400]
]}]

FreePaintLineAnimator[,300]

pen=Graphics[{Thickness[.02],Red,JoinedCurve[{{Line[100{{0.9,1},{0.08,0.18},{0,0},{0.18,0.08},{1,0.9}}],BezierCurve[100{{1,1},{0.9,1}}]},{Line[100{{0.97,0.97},{0.15,0.15}}],BezierCurve[100{{0.1,0.12},{0.1,0.18},{0.1,0.2}}]},{Line[100{{0.97,0.97},{0.15,0.15}}],BezierCurve[100{{0.12,0.1},{0.18,0.1},{0.2,0.1}}]}}],Polygon[100{{0,0},{0.03,0.06},{0.06,0.03}}],FilledCurve[BezierCurve[100{{1,0.9},{1,1},{0.9,1}}]]},PlotRange->100{{0,1.5},{0,1.5}}];
FreePaintLineAnimatorWithPen[data_,speed_]:=DynamicModule[{paint=First[data],size=1000,dist=0,currentObj=1,obj,step,pts},
First@{obj=Length[paint];pts=Table[First@paint[[i,3]],{i,1,obj}];dist=Table[0,{i,1,obj}];
For[j=1,j≤obj,j++,{For[i=1,i<Length[pts[[j]]],i++,dist[[j]]=dist[[j]]+EuclideanDistance[pts[[j]][[i]],pts[[j]][[i+1]]]]}];
step=Max[dist]/speed;
DynamicModule[{a=dist[[1]]*0.99},
Graphics[{Blue,Thickness[0.004],Arrowheads[{{0.001,1,pen}}],Dynamic[a = If[a>dist[[currentObj]]*0.001,a-step,If[currentObj<obj, dist[[++currentObj]]*0.99,0]];{If[a≤0,Arrowheads[0]],Arrow[Line[{pts[[currentObj]]}],{0,a}],If[currentObj>1,Line[Table[pts[[i]],{i,1,currentObj-1}]]]}],Opacity[0],Point[pts]},ImageSize->400,ImagePadding->None]
]}]

FreePaintLineAnimatorWithPen[,100]

Sketch processed data from image

DynamicModule[{lines=[[1,1]],size=1000,dist=0,currentObj=1,obj,pts, step},
{Image[,ImageSize->400],obj=Length[lines];pts=lines;dist=Table[0,{i,1,obj}];
For[j=1,j≤obj,j++,{For[i=1,i<Length[pts[[j]]],i++,dist[[j]]=dist[[j]]+EuclideanDistance[pts[[j]][[i]],pts[[j]][[i+1]]]]}];
step=Max[dist]/100;
DynamicModule[{a=dist[[1]]*0.99},
Graphics[{Blue,Thickness[0.004],Arrowheads[{0.0}],Dynamic[a = If[a>dist[[currentObj]]*0.001,a-step,If[currentObj<obj, dist[[++currentObj]]*0.99,0]];{If[a≥0,Arrow[Line[{pts[[currentObj]]}],{0,a}]],If[currentObj>1,Line[Table[pts[[i]],{i,1,currentObj-1}]]]}],Opacity[0],Point[lines]},ImageSize->400]
]}]

DynamicModule[{lines=[[1,1]],size=1000,dist=0,currentObj=1,obj,step,pts},
First@{obj=Length[lines];b=0;pts=lines;dist=Table[0,{i,1,obj}];
For[j=1,j≤obj,j++,{For[i=1,i<Length[pts[[j]]],i++,dist[[j]]=dist[[j]]+EuclideanDistance[pts[[j]][[i]],pts[[j]][[i+1]]]]}];
step=Max[dist]/100;
DynamicModule[{a=dist[[1]]*0.99},
Graphics[{Blue,Thickness[0.004],Arrowheads[{0.0}],Dynamic[a = If[a>dist[[currentObj]]*0.001,a-step,If[currentObj<obj, dist[[++currentObj]]*0.99,0]];{If[a>0,Arrow[Line[{pts[[currentObj]]}],{0,a}]],If[currentObj>1,Line[Table[pts[[i]],{i,1,currentObj-1}]]],If[currentObj>=obj-1,Inset[Graphics[Inset[Image[,ImageSize->440]],ImageSize->b++]]]}],Opacity[0],Point[lines]},ImageSize->400]
]}]

DynamicModule[{lines=[[1,1]],size=1000,dist=0,currentObj=1,obj,step,pts},
First@{obj=Length[lines];pts=lines;dist=Table[0,{i,1,obj}];
For[j=1,j≤obj,j++,{For[i=1,i<Length[pts[[j]]],i++,dist[[j]]=dist[[j]]+EuclideanDistance[pts[[j]][[i]],pts[[j]][[i+1]]]]}];
step=Max[dist]/100;
DynamicModule[{a=dist[[1]]*0.99},
Graphics[{Rotate[{Blue,Thickness[0.004],Arrowheads[{0.0}],Dynamic[a = If[a>dist[[currentObj]]*0.001,a-step,If[currentObj<obj, dist[[++currentObj]]*0.99,0]];{If[a≥0,Arrow[Line[{pts[[currentObj]]}],{0,a}]],If[currentObj>1,Line[Table[pts[[i]],{i,1,currentObj-1}]]]}],Opacity[0],Point[lines]},-00Degree]},ImageSize->400]
]}]