60
$\begingroup$

I've created the following scene with a Chinese-style building surrounded by trees, and a horse and a rabbit grazing on the grass in Mathematica (don't ask me why there's a bust of Beethoven in there...). The Chinese-style roof was created using J. M.'s equations in his answer to the question "Mathematical formula to generate a curved Chinese-style roof". The code to create this is at the very end of this post.

enter image description here

How can I use the various View* options to implement a first-person view of the objects in the scene? In other words, be able to walk around freely and see objects as if I were in the scene.


Code to create the scene

Begin["NonProprietaryCode`"];
Module[{roof, columns, base, ground, 
   fauxLame = {#2 Abs@Cos@#1 Cos@#1, #2 Abs@Sin@#1 Sin@#1, 
      9 #2 ((9 #2/10 - 2/3) Cos[2 #1]^2 - 4/3)/20} &,
   roofExt = 3/2, roofTex = ExampleData[{"ColorTexture", "Roof"}],
   colRad = 0.15, colOff = 1, colHt = 2.5,
   baseHt = 0.25, 
   baseTex = ExampleData[{"ColorTexture", "GrayMarble"}],
   vtc = {{0, 0}, {1, 0}, {1, 1}, {0, 1}},
   cubeCoords = {{{0, 0, 0}, {0, 1, 0}, {1, 1, 0}, {1, 0, 0}}, {{0, 0,
        0}, {1, 0, 0}, {1, 0, 1}, {0, 0, 1}}, {{1, 0, 0}, {1, 1, 
       0}, {1, 1, 1}, {1, 0, 1}}, {{1, 1, 0}, {0, 1, 0}, {0, 1, 
       1}, {1, 1, 1}}, {{0, 1, 0}, {0, 0, 0}, {0, 0, 1}, {0, 1, 
       1}}, {{0, 0, 1}, {1, 0, 1}, {1, 1, 1}, {0, 1, 1}}},
   groundTex = Import["https://i.stack.imgur.com/hMQwd.jpg"]
   },
  
  roof = ParametricPlot3D[{fauxLame[u, v]}, {u, -Pi, Pi}, {v, 0, 
     roofExt},
    Mesh -> None, Lighting -> "Neutral",
    PlotStyle -> Texture[roofTex]];
  columns = 
   ParametricPlot3D[
    With[{x = colOff + colRad Cos@t, y = colRad Sin@t, 
      u = Rescale[
        t, {-Pi, Pi}, {-#, #} &@
         ArcTan[colOff, colRad]]},
     {Sequence[#], 
        Min[v, Last@fauxLame[u, y/Sin@u/Abs@Sin@u]]} & /@ {{x, 
        y}, {-x, y}, {-y, x}, {y, -x}}], {t, -Pi, 
     Pi}, {v, -colHt, -0.585}, Mesh -> None, PlotStyle -> Red];
  base = Graphics3D[{Texture[baseTex], Lighting -> "Neutral", 
     EdgeForm[None], 
     Rotate[Polygon[
       cubeCoords /. {x_, y_, 
          z_} :> {2 roofExt x, 2 roofExt y, -baseHt z} - {roofExt, 
           roofExt, colHt}, 
       VertexTextureCoordinates -> Table[vtc, {6}]], 
      Pi/4, {0, 0, -(colHt + baseHt/2)}]}];
  ground = 
   Graphics3D[{Texture[groundTex], Lighting -> "Neutral", 
     EdgeForm[None], 
     Polygon[cubeCoords /. {x_, y_, 
         z_} :> {8 x, 8 y, -0.1 z} - {4, 4, colHt + baseHt}, 
      VertexTextureCoordinates -> Table[vtc, {6}]]}];
  
  building = Show[roof, columns, base, ground, PlotRange -> All];
  ];

Module[{treePoly = 
    ExampleData[{"Geometry3D", "Tree"}, "PolygonObjects"],
   trunkTex = ExampleData[{"ColorTexture", "Ash"}], 
   vtc = {{0, 1}, {1, 0}, {1, 1}}
   },
  trunk = 
   Graphics3D[{Texture[trunkTex], Lighting -> "Neutral", 
     EdgeForm[None], 
     treePoly[[;; 19000]] /. 
      Polygon[x__] :> Polygon[x, VertexTextureCoordinates -> vtc]}];
  leaves = 
   Graphics3D[{FaceForm[Darker@Green], Lighting -> "Neutral", 
     EdgeForm[None], 
     treePoly[[19001 ;;]] /. 
      Polygon[x__] :> Polygon[x, VertexTextureCoordinates -> vtc]}];
  
  tree = Show[trunk, leaves, PlotRange -> All];
  ];

Module[{
   bunnyVtx = 
    ExampleData[{"Geometry3D", "StanfordBunny"}, "VertexData"]
   },
  bunny = 
   ListSurfacePlot3D[bunnyVtx, MaxPlotPoints -> 35, Mesh -> None, 
    TextureCoordinateFunction -> (Normalize[{#1, #2, #3}] &), 
    PlotStyle -> Directive[Lighting -> "Neutral"]]
  ];

Module[{
   horseVtx = ExampleData[{"Geometry3D", "Horse"}, "VertexData"],
   horseTex = ExampleData[{"ColorTexture", "BurlOak"}]
   },
  horse = 
   ListSurfacePlot3D[horseVtx, MaxPlotPoints -> 35, Mesh -> None, 
    TextureCoordinateFunction -> (Normalize[{#1, #2, #3}] &), 
    PlotStyle -> Directive[Texture[horseTex], Lighting -> "Neutral"]]
  ];

Module[{bustPoly = 
    ExampleData[{"Geometry3D", "Beethoven"}, "PolygonObjects"]},
  bust = Graphics3D[{FaceForm[Gray], Lighting -> "Neutral", 
      EdgeForm[None], bustPoly}];
  ];

Draw := With[{c = -Mean /@ 
       AbsoluteOptions[tree, PlotRange][[1, 2]] - {0, 0, 0.75}, 
   treeLocs = {{-2, 2, 0}, {2, 2, 0}, {-2, -2, 0}}},
  Show[building,
   Graphics3D[{
     {FaceForm[Gray], EdgeForm[None], Lighting -> "Neutral", 
      Cylinder[{{0, 0, -3}, {0, 0, -2}}, 0.1]},
     Translate[Scale[bust[[1]], 0.05], {0, 0, -1.5}],
     Translate[Scale[horse[[1]], 5], {-3, 0, -2.25}],
     Translate[Scale[bunny[[1]], 1.5], {2, -2, -2.75}],
     Translate[Scale[tree[[1]], 0.013], 
      Outer[Plus, treeLocs, {c}, 1]]
     }], PlotRange -> All, Boxed -> False, Axes -> None]
  ]

End[];

Create a scene with scene = NonProprietaryCode`Draw. Feel free to modify the code as desired to implement the FPV.

$\endgroup$
2
  • 5
    $\begingroup$ Note: A similar question was first asked here a few weeks ago and received a good answer from Heike, but had to be deleted because the OP apparently posted proprietary code (which they didn't get permission to post) and the SE policy allows for take down in such cases. I don't think it was fair on the OP's part to bail after receiving an answer. This is my attempt at recreating the question with a ridiculous, yet non-trivial scene to preserve useful information from the answer to the first question. Such an example is very useful to fully understand the different View* functions. $\endgroup$
    – rm -rf
    May 17, 2012 at 0:56
  • $\begingroup$ Related demo: demonstrations.wolfram.com/AerialTourOfDifferentialGeometry $\endgroup$
    – Michael E2
    Nov 4, 2014 at 3:57

1 Answer 1

54
$\begingroup$

First of all let me tell you that you should wait for some great submissions from other members. Maybe @Yu-SungChang will post some FPS game here ;-). I just will give you the prototype I happen to write recently for an unrelated task. I could fly around your example too but it is too slow (and cool ;-) ) - I will demo some more fluid but simple environment. Let's still get some textures for realism:

texlis = ImageResize[ExampleData[{"ColorTexture", #}, "Image"], {50, 50}] & /@ 
         ExampleData["ColorTexture"][[All, 2]]

enter image description here

Now the main part

Manipulate[SeedRandom[13];
 Style[Overlay[{Show[
     Graphics3D[
      Table[{Hue[RandomReal[]], Specularity[White, 20], 
        Sphere[{RandomReal[{-5, 5}], RandomReal[{-5, 5}], 
          RandomReal[{-2, 2}]}, RandomReal[.5]]}, {130}]],
     ParametricPlot3D[{Cos[t] (3 + Cos[u]), Sin[t] (3 + Cos[u]), 
       Sin[u]}, {t, 0, 2 Pi}, {u, 0, 2 Pi}, PlotPoints -> Automatic, 
      TextureCoordinateFunction -> (4 {2 #4, #5} &), 
      PlotStyle -> 
       Directive[Specularity[White, 50], 
        Texture[ExampleData[{"ColorTexture", t}]]], Mesh -> None, 
      PerformanceGoal -> "Quality"]
     , Axes -> False, Boxed -> False,
     ViewAngle -> Dynamic[a],
     ViewVector -> 
      Dynamic[{{f[x, p[[1]]] Sin[v], Cos[v] f[x, p[[1]]], 
         g[x, p[[2]]]}, {f[x, p[[1]]] Sin[v + \[Pi] s[[1]]], 
         Cos[v + \[Pi] s[[1]]] f[x, p[[1]]], 
         g[x, p[[2]]] + 
          2 f[x, p[[1]]] Sin[1/2 \[Pi] s[[1]]] Tan[
            1/2 \[Pi] s[[2]]]}}], ImageSize -> {480, 480}, 
     Lighting -> "Neutral"], Graphics[{}, ImageSize -> {480, 480}]}], 
  Selectable -> False],
 {{t, "Metal4", ""}, 
  Rule @@@ Transpose[{ExampleData["ColorTexture"][[All, 2]], texlis}]},
 Delimiter,
 Item[Control[{{v, 0, Text[Style["move", Medium]]}, 0, Infinity, 
    ControlType -> Trigger, AnimationRate -> .5,
    AppearanceElements -> {"PlayPauseButton", 
      "FasterSlowerButtons"}}], Alignment -> Left],
 Delimiter,
 Column[{
   Item[Text[Style["zoom", Medium]], Alignment -> Left],
   Item[Control[{{a, \[Pi]/2., ""}, 0.01, .99 \[Pi], 
      ImageSize -> Tiny}], Alignment -> Left],
   }],
 Delimiter,
 Column[{
   Item[Text[Style["look around", Medium]], Alignment -> Left],
   Item[Control[{{s, {.17, 0.}, ""}, {.001, -.999}, {1.999, .999}}], 
    Alignment -> Left]
   }],
 Delimiter,
 Column[{
   Item[Text[Style["shift around", Medium]], Alignment -> Left],
   Item[Control[{{p, {3., 0.}, ""}, {6., -3.}, {.01, 3.}}], 
    Alignment -> Left]
   }],
 Delimiter,
 {{x, 0, ""}, {0 -> "subject", 1 -> "object"}},
 ControlPlacement -> Left, TrackedSymbols -> True, FrameMargins -> 0, 
 SynchronousUpdating -> False, SynchronousInitialization -> False,
 Initialization :> (f[x_, y_] := If[x == 0, y, 6.01 - y]; 
   g[x_, y_] := If[x == 0, y, -y];)]

enter image description here

The "look around" and "shift around" controls give you the basic tools for "head-eyes" navigation. You can probably even attach them to your mouse via EventHandler. Here is the piece of code above that makes it happen via 2D sliders:

............
ViewAngle -> Dynamic[a],
ViewVector -> 
 Dynamic[{{f[x, p[[1]]] Sin[v], Cos[v] f[x, p[[1]]], 
    g[x, p[[2]]]}, {f[x, p[[1]]] Sin[v + \[Pi] s[[1]]], 
    Cos[v + \[Pi] s[[1]]] f[x, p[[1]]], 
    g[x, p[[2]]] + 
     2 f[x, p[[1]]] Sin[1/2 \[Pi] s[[1]]] Tan[1/2 \[Pi] s[[2]]]}}]
............

Note, Dynamic is necessary to make it NOT lag and redraw all 3D graphics every time you change something inside Manipulate. Dynamic isolates tracked variables. I fly around because I pinned my Mathematica simulated camera on a parametric curve (circle) using ViewVector variable v as you can see in the code above. In your case I'd recommend to attach ViewVector variables to arrow keys via EventHandler and its specifications like "KeyDown" event and such.

Note that this app was created especially to test the virtual reality phenomenon called "Immersion". You can see two buttons "object" and "subject". The point of the game is to avoid being hit by the spheres. If one is "immersed" in the virtual tunnel, one imagines being inside of it and dodges spheres better by moving the view (subject) inside the cylinder. If one sees all as outsider (not immersed), one dodges spheres better by moving the cylinder (object) in his view.

Can't wait for other great submissions!

$\endgroup$
9
  • $\begingroup$ I tried, but I couldn't get my CPU usage to exceed 75%. +1 $\endgroup$
    – rcollyer
    May 17, 2012 at 3:27
  • 2
    $\begingroup$ Cooooooooooooool $\endgroup$
    – Rojo
    May 17, 2012 at 3:27
  • 2
    $\begingroup$ This is excellent! $\endgroup$
    – rm -rf
    May 17, 2012 at 3:36
  • $\begingroup$ +1! Although I'd be really really really cool if the look around would be attached to the mouse and perhaps the shift around to to the arrow keys :) $\endgroup$
    – Ajasja
    May 17, 2012 at 13:54
  • 1
    $\begingroup$ texlis = ImageResize[ExampleData[{"ColorTexture", #}, "Image"], {50, 50}] & /@ ExampleData["ColorTexture"][[All, 2]] now takes pretty long unfortunately (maybe 8 minutes?). Maybe my internet was just slow, who knows :). Anyway this is absolutely amazing :D $\endgroup$ Mar 23, 2014 at 20:49

Your Answer

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

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