(* ::Package:: *)

(* ::Chapter:: *)
(*Preliminaries*)


ClearAll["Global`*"]
$HistoryLength=2;


(* ::Section:: *)
(*Note on sound samples*)


(* ::Subsection:: *)
(*Code*)


(* ::Input::Initialization:: *)
audfileslic={
{"586101__slaking_97__free-music-background-loop-003-var-08.wav","Free Music Background Loop 003 - Var 08" ,"freesound.org/people/Slaking_97/sounds/586101/","Slaking_97", "Attribution 4.0 License"},
{"545198__theplax__pop-4.wav","Pop 4","freesound.org/people/theplax/sounds/545198/", "theplax", "Attribution 4.0 License"},
{"202230__deraj__pop-sound.wav","Pop sound","freesound.org/people/deraj/sounds/202230/", "deraj","Creative Commons 0 License"},
{"161122__reelworldstudio__cartoon-boing.wav","Cartoon Boing.wav","freesound.org/people/reelworldstudio/sounds/161122/", "reelworldstudio", "Creative Commons 0 License"},
{"376936__maralvarez9__clase1.wav","clase1.wav","freesound.org/people/maralvarez9/sounds/376936/", "maralvarez9", "Creative Commons 0 License"},
{"47127__gyzhor__lightsaber5.mp3","lightsaber5.mp3","freesound.org/people/gyzhor/sounds/47127/", "gyzhor", "Creative Commons 0 License"},
{"47125__gyzhor__lightsaber3.mp3","lightsaber3.mp3","freesound.org/people/gyzhor/sounds/47125/", "gyzhor", "Creative Commons 0 License"},
{"454610__richcraftstudios__richcraft-chime-4-20181219.wav","Richcraft - chime 4 20181219.wav","freesound.org/people/richcraftstudios/sounds/454610/", "richcraftstudios", "Attribution 4.0 License"},
{"657936__matrixxx___satellite-signal-02.wav","Satellite Signal 02.wav","freesound.org/people/MATRIXXX_/sounds/657936/", "MATRIXXX_", "Creative Commons 0 License"},
{"243468__mark_ian__whoop.wav","Whoop.wav","freesound.org/people/Mark_Ian/sounds/243468/", "Mark_Ian", "Creative Commons 0 License"},
{"176146__swagmuffinplus__sliding-doors.wav","Sliding Doors","freesound.org/people/SwagMuffinPlus/sounds/176146/","SwagMuffinPlus","Creative Commons 0 License"}
};


(* ::Input::Initialization:: *)
urlLic[{file_,name_,url_,user_,lic_},text_:False]:=Module[{link},
link=Switch[lic,
"Attribution 4.0 License",{"CC BY 4.0","creativecommons.org/licenses/by/4.0/"},
"Creative Commons 0 License",{"CC0 1.0","creativecommons.org/publicdomain/zero/1.0/"},
"Noncommercial 4.0 License",{"CC BY-NC 4.0","creativecommons.org/licenses/by-nc/4.0/"}
];
If[text,
"\[FilledCircle] \[OpenCurlyDoubleQuote]"<>name<>"\[CloseCurlyDoubleQuote] by user "<>user <>" (https://"<>url<>") licensed under "<>link[[1]]<>" (https://"<>link[[2]]<>")",
"\""<>name<>"\" by user "<>user <>" (https://"<>url<>") licensed under "<>link[[1]]<>" (https://"<>link[[2]]<>")"
]
]


(* ::Input:: *)
(*StringRiffle[urlLic[#,False]&/@audfileslic,"\n"]*)


(* ::Subsection:: *)
(*Statement*)


(* ::Text:: *)
(*This video uses these sounds from freesound:*)


(* ::Text:: *)
(*\[FilledCircle] "Free Music Background Loop 003 - Var 08" by user Slaking_97 (https://freesound.org/people/Slaking_97/sounds/586101/) licensed under CC BY 4.0 (https://creativecommons.org/licenses/by/4.0/)*)
(*\[FilledCircle] "Pop 4" by user theplax (https://freesound.org/people/theplax/sounds/545198/) licensed under CC BY 4.0 (https://creativecommons.org/licenses/by/4.0/)*)
(*\[FilledCircle] "Pop sound" by user deraj (https://freesound.org/people/deraj/sounds/202230/) licensed under CC0 1.0 (https://creativecommons.org/publicdomain/zero/1.0/)*)
(*\[FilledCircle] "Cartoon Boing.wav" by user reelworldstudio (https://freesound.org/people/reelworldstudio/sounds/161122/) licensed under CC0 1.0 (https://creativecommons.org/publicdomain/zero/1.0/)*)
(*\[FilledCircle] "clase1.wav" by user maralvarez9 (https://freesound.org/people/maralvarez9/sounds/376936/) licensed under CC0 1.0 (https://creativecommons.org/publicdomain/zero/1.0/)*)
(*\[FilledCircle] "lightsaber5.mp3" by user gyzhor (https://freesound.org/people/gyzhor/sounds/47127/) licensed under CC0 1.0 (https://creativecommons.org/publicdomain/zero/1.0/)*)
(*\[FilledCircle] "lightsaber3.mp3" by user gyzhor (https://freesound.org/people/gyzhor/sounds/47125/) licensed under CC0 1.0 (https://creativecommons.org/publicdomain/zero/1.0/)*)
(*\[FilledCircle] "Richcraft - chime 4 20181219.wav" by user richcraftstudios (https://freesound.org/people/richcraftstudios/sounds/454610/) licensed under CC BY 4.0 (https://creativecommons.org/licenses/by/4.0/)*)
(*\[FilledCircle] "Satellite Signal 02.wav" by user MATRIXXX_ (https://freesound.org/people/MATRIXXX_/sounds/657936/) licensed under CC0 1.0 (https://creativecommons.org/publicdomain/zero/1.0/)*)
(*\[FilledCircle] "Whoop.wav" by user Mark_Ian (https://freesound.org/people/Mark_Ian/sounds/243468/) licensed under CC0 1.0 (https://creativecommons.org/publicdomain/zero/1.0/)*)
(*\[FilledCircle] "Sliding Doors" by user SwagMuffinPlus (https://freesound.org/people/SwagMuffinPlus/sounds/176146/) licensed under CC0 1.0 (https://creativecommons.org/publicdomain/zero/1.0/)*)


(* ::Section:: *)
(*Constants*)


(* ::Input::Initialization:: *)
idxGlob=4;(*global index of the measurement result*)


(* ::Input::Initialization:: *)
totaldur=25; (*total duration of the video in seconds*)


(* ::Input::Initialization:: *)
opts3D={ViewPoint->Above,Boxed->False,Lighting->"ThreePoint"};
opts2D={PlotRange->{4{-1,1},2{-0.9,1.1}},ImageSize->700};
fontFamily="Times";
blurMax=50; (*maximum blurring of background*)

hoff=2.5; (*horizontal position of large Bob's box*)
hoffExt=3; (*horizontal position of small Bob's box*)
hoffQ=1.1; (*horizontal position of a moved qubit*)
voffQ=0.8; (*vertical position of a still qubit*)

voffTextS=-0.6; (*vertical position of text labels for small stations of Alice and Bob*)
voffTextL=-1.4; (*vertical position of text labels for large stations of Alice and Bob*)


(* ::Input::Initialization:: *)
With[{colfun=RGBColor["#"<>#]&},
aliCol=colfun["00464a"]; (*Alice's color*)
bobCol=colfun["F77F00"]; (*Bob's color*)
entCol=colfun["A877FD"]; (*color of entangled photons*)
entColAfter=RGBColor[1, 0.07, 0.74];(*color of entangled photons after Alice's device*)
qubCol=colfun["94f000"]; (*color of the qubit*)
devCol=Purple;(*color of active device*)
meaCol=colfun["EAE2B7"]; (*color of the measured qubits*)
sorCol=Lighter@entCol; (*color of the source*)
idleCol=Lighter@Gray; (*color of idle parts of the "clock"*)
]


(* ::Section:: *)
(*Auxiliary functions*)


(* ::Input::Initialization:: *)
aliText[pos_:{-hoff,voffTextS},fade_:0]:=Text[styleText["A",Blend[{aliCol,White},fade]],pos,{0,0}]
bobText[pos_:{hoff,voffTextS},fade_:0]:=Text[styleText["B",Blend[{bobCol,White},fade]],pos,{0,0}]
qubText[pos_:{-hoffExt,voffQ},fade_:0]:=Text[styleText["Q",Blend[{qubCol,White},fade]],pos,{0,-3}]


(* ::Input::Initialization:: *)
unfadeImg[img_,lev_]:=SetAlphaChannel[img,ImageMultiply[AlphaChannel[img],GrayLevel[lev]]]
styleText[text_,col_,size_:35]:=Style[text,col,size,Bold,FontFamily->fontFamily]
rastFun[obj_]:=Rasterize[obj,Background->None]
insetWrap[obj_,size_:1,pos_:{0,0}]:=Inset[obj,pos,ImageScaled[{1,1}/2],size]
fadFun[t_]:=Piecewise[{{0,t<=0.8},{Rescale[t,{0.8,1},{0,1}],t>0.8}}]
popFun=Function[\[FormalT], Piecewise[{{0., \[FormalT] == 0}}, 2^(10\[FormalT] - 10)]];(* see ResourceFunction["EasingFunction"]*)


(* ::Input::Initialization:: *)
With[{defmat=(*"Rubber"*)"Plastic"(*"Glazed"*)},
shadingFun[col_,mat_:defmat]:=If[mat===None,col,MaterialShading[{mat,col}]]
(*MaterialShading rendering  is time-consuming, faster alternative is setting it to None*)
]


(* ::Input::Initialization:: *)
disk3D=ResourceFunction["Disk3D"]
rcub3D=ResourceFunction["RoundedCuboid"]
rcyl3D=ResourceFunction["RoundedCylinder"]
rann3D=ResourceFunction["RoundedAnnulus3D"]


(* ::Input::Initialization:: *)
ClearAll[serialize]
serialize[fun_,numstages_,idx_:0][t_,tglob_]:=Module[{n=numstages,q,r},
{q,r}=QuotientRemainder[t,1/n];
fun[idx,If[t<1,q+1,q],If[t<1,n r,1],tglob]
]


(* ::Input::Initialization:: *)
ballFun[col_]:=ballFun[col]=insetWrap[rastFun[Graphics[insetWrap[Graphics3D[{shadingFun[col,None(*"Foil"*)],Ball[]},Lighting->"Accent",Sequence@@opts3D],.3],PlotRange->.153]],.3]
{qubBallRast,meaBallRast}=rastFun[Graphics[ballFun[#],PlotRange->.153]]&/@{qubCol,meaCol};


(* ::Section:: *)
(*Source and entangled photons*)


(* ::Input::Initialization:: *)
sourceRast=With[{fontcol=Darker[sorCol,.5]},
rastFun@Graphics3D[{
shadingFun[sorCol],rcub3D[-{6,5,2},{6,5,2},RoundingRadius->1.5],rcyl3D[{{0,6,-2.3},{0,0,-2.3}},4]
},Sequence@@opts3D,Epilog->{Thickness[.03],fontcol,Circle[ImageScaled[{1,1}/2],.28],Text[styleText["S",fontcol,45],ImageScaled[{1,1}/2],{0,0}]},PlotRange->{6.71{-1,1},5.72{-1,1},2.2{-1,1}},ImageSize->150]
];


(* ::Input::Initialization:: *)
(*assumes that pt1 and pt2 have identical y-component:*)
wavyLine=Cases[InputForm@Plot[(1+Pi^2 x^2)/(1+Pi^2)Sin[10x Pi]/10,{x,-1,1}],_Line,Infinity,1];
entWavyFun[pt1_,pt2_,t_]:={entCol,AbsoluteThickness[2],CapForm["Round"],Translate[Scale[wavyLine,.001+Norm[pt2-pt1]/2{1,Cos[6\[Pi] t]}],(pt1+pt2)/2]}


(* ::Section:: *)
(*Landscape*)


(* ::Input::Initialization:: *)
sun={AbsoluteThickness[3],Circle[{-0.534,0.498},{0.069,0.068}]};
roof={CapForm["Square"],Line[{{0.257,0.180},{0.636,0.430}}],Line[{{0.590,0.392},{0.853,0.159}}]};
house={CapForm["Square"],Line[{{0.364,0.221},{0.339,0.004}}],Line[{{0.364,0.221},{0.693,0.204}}],Line[{{0.760,0.183},{0.782,0}}]};
{hill1,hill2}={CapForm["Round"],{White,FilledCurve[#]},#}&/@{BezierCurve[{{-0.568,0.113},{-0.568,0.113},{-0.219,0.359},{0.257,0.113}}],BezierCurve[{{-0.864,0.236},{-0.864,0.236},{-0.585,0.446},{-0.204,0.236}}]};


(* ::Input::Initialization:: *)
popLandFun[obj_,inity_][t_]:=Translate[{GrayLevel[1-t],obj},{0,inity(1-t)}]


(* ::Input::Initialization:: *)
optsLand={PlotRange->{1.1{-1,1},{-.2,.8}}};


(* ::Input::Initialization:: *)
landBoxFun[idx_,stage_,t_,tglob_]:=Module[{ts,th,th1,th2,tr,yoff=-0.1},
(*idx and tglob unused*)
{ts,th,th1,th2,tr}=Switch[stage,
0,{1,1,1,1,1},
1,{0,0,0,0,t},
2,{0,0,0,t,1},
3,{0,0,t,1,1},
4,{0,t,1,1,1},
5,{t,1,1,1,1},
6,{1,1,1,1,1}
];
Graphics[{AbsoluteThickness[4],JoinForm[{"Miter",3.8}],
Translate[sun,{0,-.5(1-ts)}],
popLandFun[roof,yoff][tr],
popLandFun[house,yoff][th],
popLandFun[{{White,Translate[Rectangle[-{.1,.2},{.1,.2}],{-.55,0.1}]},hill2},yoff][th2],
popLandFun[hill1,yoff][th1]
},Sequence@@optsLand]
]


(* ::Input::Initialization:: *)
sceneBackgroundRaw=serialize[landBoxFun,6];
sceneBackground[t_]:=sceneBackgroundRaw[t,0]


(* ::Input::Initialization:: *)
landBg=sceneBackground[1];
landBlurBg=Blur[landBg,blurMax];


(* ::Input::Initialization:: *)
sceneFadingBackground[t_]:=Graphics[{AbsoluteThickness[4],JoinForm[{"Miter",3.8}],GrayLevel[t],
sun,roof,house,{{White,Translate[Rectangle[-{.1,.2},{.1,.2}],{-.55,0.1}]},hill2},hill1},Sequence@@optsLand]


(* ::Section:: *)
(*Alice*)


(* ::Input::Initialization:: *)
aliBgRaw={Lighter[aliCol,.8],EdgeForm[],Rectangle[-{1.1,1.7},{1.1,1.1},RoundingRadius->.1],Disk[{1.1,0},.25],White,Disk[{-1.1,0},.2]};
aliBg=Translate[aliBgRaw,{-hoff,0}];


(* ::Input::Initialization:: *)
aliCube=Graphics3D[{{Transparent,rcyl3D[{{0,0,-.1},{0,0.6,-.1}},.4]},
{shadingFun[aliCol,"Glazed"],rcub3D[-.5{1,1,1},.5{1,1,1},RoundingRadius->.12],rcyl3D[{{-0.6,0,0},{0.6,0,0}},.3],rcyl3D[{{0,0,-.1},{0,-0.6,-.1}},.4]}},Sequence@@opts3D];
aliCubeRast=rastFun[aliCube];


(* ::Input::Initialization:: *)
pointer[col_]:=With[{w=0.24,wf=0.06,l=0.75,h=0.24},
{col,EdgeForm[],Cone[{{0,0,0},{0,0,1}},.3],GraphicsComplex[Join[{{0,w,0},{l,wf,0},{l,-wf,0},{0,-w,0}},ScalingTransform[{1,.8,.8}]@{{0,w,h},{l,wf,h},{l,-wf,h},{0,-w,h}}],Polyhedron[{{1,2,3,4},{5,6,7,8},{1,2,6,5},{3,4,8,7},{2,3,7,6},{4,1,5,8}}]]
}];


(* ::Input::Initialization:: *)
gauge[idx_,idle_,t_]:=With[{col=Lighter[aliCol,.6],endang=\[Pi]/2(idx-1)+\[Pi]/4,notch=rcub3D[{0.8,-0.15,-0.15},{1.4,0.15,0.15},RoundingRadius->.02]},
Graphics3D[{
(*background*)
{If[idle,col,Blend[{col,White},1-t]],disk3D[{0,0,0},1.4]},

(*rim*)
aliCol,rann3D[{{0,0,0},{0,0,.2}},{1.3,1.5}],

(*notches*)
Rotate[notch,# \[Pi]/4,{0,0,1}]&/@{1,3,5,7},

(*pointer*)
Rotate[pointer[Lighter[col,.7]],If[idle,\[Pi]/2,Rescale[t,{0,1},{\[Pi]/2,endang}]],{0,0,1}]
},Sequence@@opts3D,PlotRange->{2{-1,1},2{-1,1},{-0.01,1}}
]]


(* ::Input::Initialization:: *)
aliBoxFunRaw[idx_,stage_,t_]:=Module[{},
(*stages: 0 - idle state, 1 - flashing box and moving gauge*)
{(*device*)
insetWrap[aliCubeRast,2],
insetWrap[gauge[idx,stage==0,Switch[stage,1,t,_,1]],1.2]
}
]


(* ::Input::Initialization:: *)
aliBoxFun[idx_,stage_,t_]:=Translate[aliBoxFunRaw[idx,stage,t],{-hoff,0}]


(* ::Section:: *)
(*Bob*)


(* ::Input::Initialization:: *)
bobBgRaw={Lighter[bobCol,.8],EdgeForm[],Rectangle[-{1.1,1.7},{1.1,1.1},RoundingRadius->.1],Disk[{-1.1,0},.25],White,Disk[{1.1,0},.2]};
bobBg=Translate[bobBgRaw,{hoff,0}];


(* ::Input::Initialization:: *)
clockRaw[a_,col_]:=clockRaw[a,col]={col,EdgeForm[],rann3D[{{0,0,0},{0,0,.2}},{1.3,1.5}],Rotate[rcub3D[{0.15,-0.1,-0.15},{1.4,0.1,0.15},RoundingRadius->.02],a,{0,0,1}]};


(* ::Input::Initialization:: *)
ClearAll[bobDev]
bobDev[idx_,brightness_]:=bobDev[idx,brightness]=Module[{maxbr=.6,ligthfac,cubept={5,5,2},dev},
ligthfac=Rescale[brightness,{1,0},{0,maxbr}];
dev=rastFun@Graphics3D[{{shadingFun[Lighter[bobCol,ligthfac]],rcub3D[-cubept,cubept,RoundingRadius->2]},{Lighter[bobCol,ligthfac],Scale[Translate[clockRaw[\[Pi]/2(idx-1)+ \[Pi]/4,Lighter[Darker@bobCol,ligthfac]],{0,0,2.1}],2]}},
Sequence@@opts3D,PlotRange->1.1{5.1{-1,1},5.1{-1,1},2.5{-1,1}}];
insetWrap[dev,.84]
]


(* ::Input::Initialization:: *)
bobDevActive[idx_,br_,altcol_]:=Module[{cubept={5,5,2},colbody,colcont},
colbody=Blend[{bobCol,altcol},4br(1-br)];
colcont=Blend[{Darker@bobCol,White},4br(1-br)];
insetWrap[Graphics3D[{{shadingFun[colbody],rcub3D[-cubept,cubept,RoundingRadius->2]},{Scale[Translate[clockRaw[\[Pi]/2(idx-1)+ \[Pi]/4,colcont],{0,0,2.1}],2]}},
Sequence@@opts3D,PlotRange->1.1{5.1{-1,1},5.1{-1,1},2.5{-1,1}}],1.1]
]


(* ::Input::Initialization:: *)
bobBoxFunRaw[idx_,stage_,t_]:=Module[{rad=0.95,rad1=0.5,dev,devAct,idxidle=Complement[Range[4],{idx}],t0=0.8,movef},
(*stage: 0 - idle state, 1 - active box coloring, 2 - moving boxes, 3 - active box lights up when qubit passes through*)

movef[tloc_]:=Piecewise[{{-((tloc(tloc - 2t0))/t0^2), tloc < t0}, {1, tloc <= 1}}];
dev[idxl_,br_:0,rad_:rad1]:=Translate[bobDev[idxl,br],rad  AngleVector[(2idxl-1)\[Pi]/4]];
devAct[idxl_,fac_:1]:=Translate[bobDevActive[idxl,fac,devCol],{0,0} ];

{(*devices*)
Switch[stage,
0,dev/@Range[4],
1,{dev[idx,t],dev/@idxidle},
2,{dev[idx,1,Rescale[popFun[t],{0,1},{rad1,0}]],dev[#,0,Rescale[1-popFun[1-t],{0,1},{rad1,rad}]]&/@idxidle},
3,{devAct[idx,t],dev[#,0,rad]&/@idxidle}
]
}
]


(* ::Input::Initialization:: *)
bobBoxFun[idx_,stage_,t_]:=Translate[bobBoxFunRaw[idx,stage,t],{hoff,0}]


(* ::Section:: *)
(*Waves and antennas*)


(* ::Input::Initialization:: *)
wavefrontFun[tloc_,{lb_,up_}]:=If[lb<=tloc<up,Circle[{0,0},Rescale[tloc,{lb,up},{.3,2.1}],.2{-1,1}],{}];


(* ::Input::Initialization:: *)
aliAntFun[t_]:=Translate[#,{-hoff,0}]&@{EdgeForm[],JoinForm["Round"],Thickness[.005],Hue[0,0,0,t],Line[{{0,0},{0,1.5},{1.3-.1,1.5}}],Disk[{1.3,1.5},.1]};


(* ::Input::Initialization:: *)
bobAntFun[t_]:=Module[{hue=Hue[bobCol][[1]],darklev=2/3},
Translate[#,{hoff,0}]&@{{Hue[0,0,0,t],JoinForm["Round"],Thickness[0.005],Circle[{-5.3,1.5},4,.15{-1,1}],Line[{{0,0.8+0.02},{0,1.5},{-1.3,1.5}}]},Hue[hue,t,1,t],EdgeForm[{Hue[hue,t,darklev,t],Thickness[.01]}],Disk[{0,0},.8]}
];


(* ::Input::Initialization:: *)
clock[idx_]:=Graphics@{idleCol,EdgeForm[],Thickness[0.06],Circle[{0,0},1.4],Rotate[Rectangle[{0.15,-0.1},{1.4,0.1},RoundingRadius->.02],\[Pi]/2(idx-1)+\[Pi]/4,{0,0}]}


(* ::Input::Initialization:: *)
wavesBoxFun[idx_,stage_,ti_]:=Module[{t=ti,hoffClock=0.4,voffClock=1.5,(*clockRast=clockA,*)scaleclock=0.5,aliClock,bobClock},
(*stage: 0 - idle state, 1 - antennae pop up, 2 - clock appears for Alice, 3 - wave propagation, 4 - clock appears for Bob, 5 - static antennas and clocks,6 - antennae and clocks fade away*)

aliClock[tloc_]:=Translate[insetWrap[unfadeImg[clock[idx],tloc],scaleclock],{-hoffClock-hoff,voffClock}];
bobClock[tloc_]:=Translate[insetWrap[unfadeImg[clock[idx],tloc],scaleclock],{hoffClock+hoff,voffClock}];

Switch[stage,
0,{(*static antennae*)
aliAntFun[1],bobAntFun[1]
},

1,{(*unfading antennae*)
t=fadFun[t];
aliAntFun[t],bobAntFun[t]
},

2,{(*clock for Alice*)
aliAntFun[1],bobAntFun[1],
aliClock[t]
},

3,{(*propagating waves*)
aliAntFun[1],bobAntFun[1],
aliClock[1],
Translate[#,{-1.1,1.5}]&@{Black,Thickness[0.003],wavefrontFun[t,{0,.7}],wavefrontFun[t,{.1,.8}],wavefrontFun[t,{.2,.9}]}
},

4,{(*clock for Bob*)
aliAntFun[1],bobAntFun[1],
aliClock[1],
bobClock[t]
},

5,{(*static antennas and clocks*)
aliAntFun[1],bobAntFun[1],
aliClock[1],
bobClock[1]
},

6,{(*fading out antennae*)
t=fadFun[1-t];
aliAntFun[t],bobAntFun[t],
aliClock[t],
bobClock[t]
}
]
]


(* ::Chapter:: *)
(*Scene 0*)


(* ::Section:: *)
(*Subroutines*)


(* ::Input::Initialization:: *)
lineSegFun[t_,initpt_:{-3,0},endpt_:{0,0},tt_:.8]:=initpt+Piecewise[{{Rescale[t,{0,tt},{0,1}],t<=tt},{1,True}}](endpt-initpt)


(* ::Input::Initialization:: *)
entTraj={Rescale[#1,{0,1},{0.1,2.5-1.1}],Rescale[#2,{0,1},{-1,0}]}&@@@{{0,0},{.1,.9},{.2,1}{.4,1},{1,1}};
{entTrajFunR,entTrajFunL}=BezierFunction/@{entTraj,{-#1,#2}&@@@entTraj};


(* ::Input::Initialization:: *)
entDistrFun[tloc_,tglob_]:={
entWavyFun[entTrajFunL[tloc],entTrajFunR[tloc],tglob],
Translate[ballFun[entCol],entTrajFunL[tloc]],
Translate[ballFun[entCol],entTrajFunR[tloc]]
}


(* ::Input::Initialization:: *)
{aliSquare,bobSquare}=rastFun[Graphics3D[{shadingFun[#],rcub3D[-{1,1,1},{1,1,1},RoundingRadius->.2]},Sequence@@opts3D]]&/@{aliCol,bobCol};
aliSquareFun[t_]:=aliSquareFun[t]=Translate[insetWrap[unfadeImg[aliSquare,t],0.7],{-hoffExt,0}];
bobSquareFun[t_]:=bobSquareFun[t]=Translate[insetWrap[unfadeImg[bobSquare,t],0.7],{hoffExt,0}];


(* ::Input::Initialization:: *)
qubInFun[tloc_]:=BezierFunction[{{-hoffExt,voffQ},{-hoff-hoffQ,voffQ},{-hoff-hoffQ,0}}][tloc]


(* ::Input::Initialization:: *)
aliBoxRast=rastFun[Graphics[aliBoxFunRaw[0,0,0],PlotRange->1]];
bobBoxRast=rastFun[Graphics[bobBoxFunRaw[0,0,0],PlotRange->1]];


(* ::Input::Initialization:: *)
aliBoxEndRast=rastFun[Graphics[aliBoxFunRaw[idxGlob,1,1],PlotRange->1]];
bobBoxEndRast=rastFun[Graphics[bobBoxFunRaw[idxGlob,1,1],PlotRange->1]];


(* ::Input::Initialization:: *)
aliTransf[t_]:=TranslationTransform[Rescale[t,{0,1},{{0,0},{-0.492,0.066}}]]@*ScalingTransform[Rescale[t,{0,1},{{1,1},{0.407,0.332}}]]
bobTransf[t_]:=TranslationTransform[Rescale[t,{0,1},{{0,0},{0.492,0.099}}]]@*ScalingTransform[Rescale[t,{0,1},{{1,1},{0.407,0.332}}]]


(* ::Input::Initialization:: *)
ClearAll[boxTransProtBg]
boxTransProtBg[bck_,trfun_][t_]:=Piecewise[{
{{},t<0.3},
{GeometricTransformation[bck,trfun[Rescale[t,{0.3,0.6},{1,0}]]],t<0.6},
{bck,True}
}]
aliBoxTransBg=Translate[boxTransProtBg[aliBgRaw,aliTransf][#],{-hoff,0}]&;
bobBoxTransBg=Translate[boxTransProtBg[bobBgRaw,bobTransf][#],{hoff,0}]&;


(* ::Input::Initialization:: *)
ClearAll[boxTransProtFg]
boxTransProtFg[img_][t_]:=Piecewise[{
{{},t<=0.5},
{insetWrap[unfadeImg[img,Rescale[t,{0.5,1},{0,1}]],2],0.5<t<0.8},
{insetWrap[img,2],True}
}]
aliBoxTransFg=Translate[boxTransProtFg[aliBoxRast][#],{-hoff,0}]&;
bobBoxTransFg=Translate[boxTransProtFg[bobBoxRast][#],{hoff,0}]&;
aliBoxTransRevFg=Translate[boxTransProtFg[aliBoxEndRast][#],{-hoff,0}]&;
bobBoxTransRevFg=Translate[boxTransProtFg[bobBoxEndRast][#],{hoff,0}]&;


(* ::Section:: *)
(*Scene*)


(* ::Input::Initialization:: *)
ClearAll[scene0]
scene0[idx_,stage_,t_,tglob_]:=Module[{},
(*stage: 0 - idle state, 1 - landscape pops up, 2 - stations pop up, 3 - qubit pops up, 4 - waiting, 5 - qubit moves, 6 - waiting, 7 - landscape blurs away, 8 - large stations and source pop up, 9 - waiting, 10 - entangled photons fly out, 11 - source fades away, 12 - waiting *)

Graphics[{
{(*landscape*)
insetWrap[Switch[stage,
0,Graphics[],
1,sceneBackground[t],
2|3|4|5|6,landBg,
7,Blur[landBg,Rescale[t,{0,1},{0,blurMax}]],
_,landBlurBg
],5]
},
{(*stations*)
Switch[stage,
0|1,{},
2,{(*small stations pop up*)
aliSquareFun[t],bobSquareFun[t],aliText[{-hoffExt,voffTextS},1-t],bobText[{hoffExt,voffTextS},1-t]
},
3|4|5|6|7,{(*small stations stay static*)
aliSquareFun[1],bobSquareFun[1],aliText[{-hoffExt,voffTextS}],bobText[{hoffExt,voffTextS}]
},
8,{(*large stations pop up and small stations fade away*)
aliSquareFun[1-t],bobSquareFun[1-t],
aliBoxTransBg[t],bobBoxTransBg[t],
wavesBoxFun[idx,1,t],
aliBoxTransFg[t],bobBoxTransFg[t],
aliText[lineSegFun[t,{-hoffExt,voffTextS},{-hoff,voffTextL}]],
bobText[lineSegFun[t,{hoffExt,voffTextS},{hoff,voffTextL}]]
},
_,{(*large stations stay static*)
aliBg,bobBg,
wavesBoxFun[idx,1,1],
aliBoxFun[idx,0,0],aliText[{-hoff,voffTextL}],bobBoxFun[idx,0,0],bobText[{hoff,voffTextL}]
}
]
},
{(*qubit*)
Switch[stage,
0|1|2,{},
3,{qubText[{-hoffExt,voffQ},1-t],Translate[Scale[ballFun[qubCol],popFun[t]],{-hoffExt,voffQ}]},
4,{qubText[{-hoffExt,voffQ},0],Translate[Scale[ballFun[qubCol],1],{-hoffExt,voffQ}]},
5,{qubText[{-hoffExt,voffQ},t],Translate[ballFun[qubCol],qubInFun[t]]},
_,Translate[ballFun[qubCol],qubInFun[1]]
]
},
{(*entangled state*)
Switch[stage,10,entDistrFun[t,tglob],11|12,entDistrFun[1,tglob],_,{}]
},
{(*source*)
insetWrap[Switch[stage,8,unfadeImg[sourceRast,t],9|10,unfadeImg[sourceRast,1],11,unfadeImg[sourceRast,1-popFun[t]],_,Graphics[]],1.3,{0,-1.2}]
}
},Sequence@@opts2D]]


(* ::Input::Initialization:: *)
mainStage[0]=serialize[scene0,12,idxGlob]


(* ::Chapter:: *)
(*Scene 1*)


(* ::Section:: *)
(*Subroutines*)


(* ::Input::Initialization:: *)
meaBoxFun[stage_,ti_]:=Module[{t=ti,inix=0.15,iniy=-0.6,finx=0.20,finy=-1,ball=insetWrap[meaBallRast,0.3]},
(*stage: 0 - idle state, 1 - photons fly out of Alice's device, 2 - photons fade away *)
Switch[stage,
0,{},
1,{(*outgoing photons*)
Translate[ball,{
{-hoff,0}+Rescale[popFun[t],{0,1},{{-inix,iniy},{-finx,finy}}],
{-hoff,0}+Rescale[popFun[t],{0,1},{{inix,iniy},{finx,finy}}]
}]
},
2,{(*static measured photons*)
ball=insetWrap[unfadeImg[meaBallRast,fadFun[t]],0.3];
Translate[ball,{{-hoff-finx,finy},{-hoff+finx,finy}}]
}
]
]


(* ::Input::Initialization:: *)
(*left entangled photon flies into Alice's device*)
entMeasFun[tloc_,tglob_]:=With[{pt={-.65,0}},{If[tloc<0.65,entWavyFun[entTrajFunL[1]+tloc pt,entTrajFunR[1],tglob],{}],Translate[ballFun[entCol],entTrajFunL[1]+tloc pt],Translate[ballFun[entCol],entTrajFunR[1]]}]


(* ::Section:: *)
(*Scene*)


(* ::Input::Initialization:: *)
ClearAll[scene1]
scene1[idx_,stage_,t_,tglob_]:=Module[{},
(*stage: 0 - idle state, 1 - photons fly into Alice's device, 2 - device returns value, 3 - device spits out photons, 4 - signal travels to antenna,5 - waves travel to Bob, 6 - signal travels to Bob, 7 - Bob chooses unitary which lights up, 8 - the unitary moves to center, 9 - waiting*)
Graphics[{
{(*landscape*)
insetWrap[landBlurBg,5]
},
{(*colored boxes*)
aliBg,bobBg
},
{(*entangled state*)
Switch[stage,
0,{},
1,entMeasFun[t,tglob],
2,Translate[ballFun[Blend[{entCol,entColAfter},t]],entTrajFunR[1]],
_,Translate[ballFun[entColAfter],entTrajFunR[1]]
]},
{(*qubit*)
Switch[stage,
0,Translate[ballFun[qubCol],{-hoff-hoffQ,0}],
1,Translate[ballFun[qubCol],{t-hoff-hoffQ,0}],
_,{}]
},
{(*waves*)
wavesBoxFun[idx,Switch[stage,0|1|2|3,0,4,2,5,3,6,4,_,5],t]
},
{(*stations*)
Switch[stage,
0|1,aliBoxFun[idx,0,0],
2,aliBoxFun[idx,1,t],
3,{meaBoxFun[1,t],aliBoxFun[idx,1,1]},
_,{meaBoxFun[1,1],aliBoxFun[idx,1,1]}
],
Switch[stage,
7,bobBoxFun[idx,1,t],
8,bobBoxFun[idx,2,t],
9,bobBoxFun[idx,2,1],
_,bobBoxFun[idx,0,0]
],
aliText[{-hoff,voffTextL}],bobText[{hoff,voffTextL}]
}
},Sequence@@opts2D]]


(* ::Input::Initialization:: *)
mainStage[1]=serialize[scene1,9,idxGlob]


(* ::Chapter:: *)
(*Scene 2*)


(* ::Section:: *)
(*Subroutines*)


(* ::Input::Initialization:: *)
qubOutFun[tloc_]:=BezierFunction[{{hoffExt,voffQ},{hoff+hoffQ,voffQ},{hoff+hoffQ,0}}][1-tloc];


(* ::Input::Initialization:: *)
(*created with the help of ResourceFunction["EasingFunction"]:*)
jumpFun[t_]:=Piecewise[{
{-13.444t(-0.545+t),0<=t<=3/11},
{-0.063+7.799t-14.298t^2,3/11<t<65/121},
{-6.157+19.143t-14.298t^2,65/121<=t<=97/121},
{-10.704+24.814t-14.298t^2,97/121<=t<=113/121},
{-13.353+27.650t-14.298t^2,t>=113/121}
},-(11/3)t - (121/9)t^2]


(* ::Section:: *)
(*Scene*)


(* ::Input::Initialization:: *)
ClearAll[scene2]
scene2[idx_,stage_,t_,tglob_]:=Module[{finpt={hoffQ+hoff,0}},
(*stage: 0 - idle state, 1 - Bob's photon flies through Bob's device, 2 - moving boxes, 3 - waiting, 4 - both devices shrink, 5 - landscape appears, 6 - Bob's qubit moves, 7 - qubit jumps, 8 - waiting, 9 - everything fades away *)
Graphics[{
{(*landscape*)
insetWrap[Switch[stage,
0|1|2|3,landBlurBg,
4,Blur[landBg,Rescale[t,{0,1},{blurMax,0}]],
5|6|7|8,landBg,
9,sceneFadingBackground[t]
],5]
},
{(*stations*)
Switch[stage,
0|1,{(*static stations, photon flies through Bob's device*)
aliBg,bobBg,
wavesBoxFun[idx,5,1],
Translate[ballFun[If[t<0.5,entColAfter,qubCol]],entTrajFunR[1]+t (finpt-entTrajFunR[1])],
meaBoxFun[1,1],
aliBoxFun[idx,1,1],bobBoxFun[idx,3,t],
aliText[{-hoff,voffTextL}],bobText[{hoff,voffTextL}]
},
2,{(*moving boxes*)
aliBg,bobBg,
wavesBoxFun[idx,5,1],
Translate[ballFun[qubCol],finpt],
meaBoxFun[1,1],
aliBoxFun[idx,1,1],bobBoxFun[idx,2,1-t],
aliText[{-hoff,voffTextL}],bobText[{hoff,voffTextL}]
},
3,{(*waiting*)
aliBg,bobBg,wavesBoxFun[idx,5,1],
Translate[ballFun[qubCol],finpt],
meaBoxFun[1,1],aliBoxFun[idx,1,1],bobBoxFun[idx,2,0],
aliText[{-hoff,voffTextL}],bobText[{hoff,voffTextL}]
},
4,{(*stations transition from large versions to the small ones*)
aliSquareFun[t],bobSquareFun[t],
aliBoxTransBg[1-t],bobBoxTransBg[1-t],
wavesBoxFun[idx,6,t],
meaBoxFun[2,1-t],aliBoxTransRevFg[1-t],bobBoxTransRevFg[1-t],
aliText[lineSegFun[1-t,{-hoffExt,voffTextS},{-hoff,voffTextL}]],
bobText[lineSegFun[1-t,{hoffExt,voffTextS},{hoff,voffTextL}]]
},
5|6|7|8,{(*static small stations*)
aliText[{-hoffExt,voffTextS}],aliSquareFun[1],
bobText[{hoffExt,voffTextS}],bobSquareFun[1]
},
9,{(*stations fade away*)
aliText[{-hoffExt,voffTextS},t],aliSquareFun[1-popFun[t]],
bobText[{hoffExt,voffTextS},t],bobSquareFun[1-popFun[t]]
}
]
},
{(*Bob's qubit continuation*)
Switch[stage,
2|3|4|5,Translate[ballFun[qubCol],finpt],
6,Translate[ballFun[qubCol],qubOutFun[t]],
7,{qubText[{hoffExt,voffQ},1-popFun[t]],Translate[ballFun[qubCol],{hoffExt,voffQ+jumpFun[t]/2}]},
8,{qubText[{hoffExt,voffQ},1-popFun[1]],Translate[ballFun[qubCol],{hoffExt,voffQ+jumpFun[1]/2}]},
9,{qubText[{hoffExt,voffQ},1-popFun[1-t]],Translate[insetWrap[unfadeImg[qubBallRast,popFun[1-t]],0.3],qubOutFun[1]]},
_,{}]
}
},Sequence@@opts2D]]


(* ::Input::Initialization:: *)
mainStage[2]=serialize[scene2,9,idxGlob]


(* ::Chapter:: *)
(*Audio*)


(* ::Text:: *)
(*The code assumes that all the sound-sample files lie in subdirectory "sounds"*)


(* ::Input::Initialization:: *)
SetDirectory[NotebookDirectory[]]
SetDirectory["sounds"]


(* ::Input::Initialization:: *)
audfiles=audfileslic[[;;,1]];
{backSound,popSound,popSound2,jumpSound,incSoundRaw,entSound,flySound,ringSound,sigSound,garbSound,dragSound}=Normal@*Audio/@audfiles;


(* ::Input::Initialization:: *)
(*background music*)
Module[{tstart=.5,tend=totaldur-4,audioEnvelope},
audioEnvelope[t_]:=Piecewise[{{Rescale[t,{0,tstart},{0,1}],t<tstart},{1,tstart<=t<tend},{Rescale[t,{tend,totaldur},{1,0}],tend<=t<totaldur}}];
backSound=AudioGenerator[audioEnvelope,totaldur]AudioJoin[0.05{backSound,backSound}];
backSound=AudioTrim[backSound,totaldur];
]


(* ::Input::Initialization:: *)
(*transitions*)
incSoundFun[dur_]:=AudioGenerator[Rescale[#,{0,dur},{1,0}]&,dur]AudioTrim[incSoundRaw,3+{0,dur}]
incSoundLong=incSoundFun[1.2];
incSound=AudioJoin[{incSoundFun[0.5],popSound2}];


(* ::Input::Initialization:: *)
(*entangled qubits*)
entSound=AudioTrim[5 entSound,3.5];


(* ::Input::Initialization:: *)
(*flight of qubits*)
flySound=AudioTrim[flySound,2];


(* ::Input::Initialization:: *)
(*radio signal*)
sigSound*=0.7;


(* ::Input::Initialization:: *)
(*flight of measured qubits*)
garbSound=AudioTrim[garbSound,{6,7}];


(* ::Input::Initialization:: *)
(*moving of Bob's device*)
dragSound=AudioTrim[0.3dragSound,1];


(* ::Input::Initialization:: *)
(*soundtrack*)
aud=AudioOverlay[{
(*backSound*)
{backSound,0},

(*landscape appears*)
{popSound,0.1},{popSound,0.2},{popSound,0.35},{popSound,0.55},{popSound,0.65},

(*qubit appears*)
{incSound,1.9},

(*stations enlarge*)
{incSoundLong,6},

(*entangled qubits*)
{entSound,7.5},

(*entangled qubit flies to Alice, her device rings and spits out qubits*)
{flySound,10.},{ringSound,11.},{garbSound,12.5},

(*signal sent to Bob*)
{sigSound,13.3},

(*Bob moves his devices*)
{dragSound,15.8},

(*qubit flies through Bob's device*)
{flySound,17.2},

(*Bob moves his devices back*)
{dragSound,17.3},

(*stations shrink*)
{AudioReverse@incSoundLong,19.8},

(*qubit jumps*)
{jumpSound,22.4}
}];


(* ::Chapter:: *)
(*Composition and export*)


(* ::Section:: *)
(*Video*)


(* ::Input::Initialization:: *)
sceneAll[t_]:=Module[{q,r,t0=0.4,t1=0.7},
{q,r}=Which[
t<t0,{0,Rescale[t,{0,t0},{0,1}]},
t<t1,{1,Rescale[t,{t0,t1},{0,1}]},
True,{2,Rescale[t,{t1,1},{0,1}]}
];
mainStage[q][r,3t]
]


(* ::Input::Initialization:: *)
frameVideo[inumframes_]:=Module[{anim,numframes,time,frames},
numframes=Floor[inumframes/totaldur]totaldur;
Print["Actual number of frames: ",numframes];
{time,frames}=AbsoluteTiming[Most@ParallelTable[Rasterize[sceneAll[t]],{t,0,1,1/numframes}]];
Print["Generation of frames took ",time," seconds."];
anim=Video@AnimatedImage[frames,FrameRate->numframes/totaldur];
anim
]


(* ::Input:: *)
(*(*may take tens of minutes...*)*)
(*AbsoluteTiming[vid=VideoGenerator[sceneAll[#/totaldur]&,totaldur,RasterSize->2500];]*)


(* ::Input:: *)
(*(*--- alternative that does not take that long: ---*)*)
(*(*anim=frameVideo[500]*)*)


(* ::Section:: *)
(*Combine with audio and export*)


(* ::Input:: *)
(*vidaud=VideoCombine[{vid,aud}];*)


(* ::Input:: *)
(*SetDirectory[NotebookDirectory[]]*)
(*Export["video_teleportation.ogg",vidaud]*)