fock[n_, q_, p_] := (-1)^n / Pi Exp[-q ^2 - p^2] LaguerreL[n, 2 q^2 + 2 p^2]; rq = 4; rp = 4; t = 0.003; FontS = 20; For[n = 0, n <= 4, n++, plot = Show[Plot3D[fock[n, q, p], {q, -rq, rq}, {p, -rp, rp}, ImageSize -> 800, Mesh -> {Range[-Floor[rq], Floor[rq] ], Range[-Floor[rp], Floor[rp] ], Range[-1, 1, 1/4]/Pi}, MeshFunctions -> {#1 &, #2 &, #3 &}, MeshStyle -> {Directive[Black, Thickness[t] ], Directive[Black, Thickness[t] ], Directive[White, Thickness[t] ]}, PlotRange -> {-1/Pi, 1/Pi}, PlotPoints -> 81, MaxRecursion -> 4, Method -> {Refinement -> {ControlValue -> 0.02} }, PerformanceGoal -> "Quality", PlotStyle -> Opacity[0.85], Lighting -> "Classic", ColorFunction -> ({RGBColor[1, 1, 0.75], Glow[GrayLevel[0.06] ], Specularity[0.5, 60]} &), Axes -> False, Boxed -> False, ViewPoint -> FromSphericalCoordinates[{Sqrt[229/20], Pi/3, -0.64 Pi}] ], Graphics3D[{Thickness -> t, Black, Line[{ {-rq, rp, 0}, {-rq, -rp, 0}, {rq, -rp, 0} }]}], Graphics3D[{Thickness -> t, Black, Line[{ {-rq, rp, -1/Pi}, {-rq, rp, 1/Pi} }]}], (* q ticks *) Sequence @@ Table[Graphics3D[{Thickness -> t, Black, Line[{ {x, -rp, 0}, {x, -0.2 - rp, 0} }]}], {x, -Floor[rq], Floor[rq]}], (* p ticks *) Sequence @@ Table[Graphics3D[{Thickness -> t, Black, Line[{ {-rq, y, 0}, {-rq - 0.2, y, 0} }]}], {y, -Floor[rp], Floor[rp - 1/2]}], (*W ticks *) Sequence @@ Table[Graphics3D[{Thickness -> t, Black, Line[{ {-rq, rp, z/(2 Pi)}, {-rq - 0.2, rp, z/(2 Pi)} }]}], {z, -2, 2}], (* box *) (*Graphics3D[{Thickness\[Rule]t/2,Gray,Line[{ {rq,-rp,1/Pi},{rq,rp, 1/Pi},{-rq,rp,1/Pi} }],Line[{ {rq,rp,0},{rq,rp,1/Pi} }], Line[{ {rq,-rp,0},{rq,-rp,1/Pi} }]}],*) (* axes labels *) Graphics3D[Text[Style["q", FontS, Black], {0, -rp*1.15, -0.07}] ], Graphics3D[Text[Style["p", FontS, Black], {-rq*1.15, 0, -0.07}] ], Graphics3D[ Text[Style["W", FontS, Black], {-rq*0.93, rp*0.93, 0.8/Pi}] ], Sequence @@ Table[Graphics3D[{Text[ Style[TextString[x], FontS, Black], {x, -rp - 0.10 Max[rq, rp], 0}, {0, 1}]}], {x, -Floor[rq], Floor[rq]}], Sequence @@ Table[Graphics3D[{Text[ Style[TextString[y], FontS, Black], {-rq - 0.10 Max[rq, rp], y, 0}, {0, 1}]}], {y, -Floor[rp], Floor[rp - 1/2]}], Sequence @@ Table[Graphics3D[{Text[ Style[If[z == 0, "0", ToString[z/(2 Pi), TraditionalForm] ], FontS, Black], {-rq - 0.3, rp, z/2/Pi}, {1, 0}]}], {z, -2, 2}], BoxRatios -> {Automatic, Automatic, 6}, PlotRange -> All ]; trim = { {0., .25}, {.95, .91} }; imgname = "Wignerfunction_fock_" <> TextString[n] <> ".png"; Export[imgname, ImageResize[ ImageTrim[Image[plot, ImageResolution -> 400], trim, DataRange -> { {0, 1}, {0, 1} }], 2000, Resampling -> "Linear"] ]; ]