25
$\begingroup$

Insipred by this question and the corresponding answer I've written a code for full-screen exploration of 3D scenes using standard WASD and mouse look controls. Here it is.

enter image description here

Begin["wasd`"];
prmWORLDWIDTH = 300;
prmVIEWERHEIGHT = 2.5;
prmMOUSESENS = 0.01;
prmKEYSENS = 2;

pos = {-146.2715891902948`, -154.52068004641723`, 2.5`}(*{0.,-200,prmVIEWERHEIGHT}*);
moveDir = {0.6365371822219685`, 0.7712460149971068`, 0.`}(*{0,1,0}*);
viewDir = moveDir;
strafeDir = {0.7712460149971068`, -0.6365371822219685`, 0.`}(*{1,0,0}*);

cube = {Gray, EdgeForm[None],
   CapForm[None], Tube[{{-150, -150, 0}, {-50, 0, 0}, {50, 0, 0}}, 20
    ],
   Blue // Lighter,
   Translate[
    ExampleData[{"Geometry3D", "SpaceShuttle"}, "PolygonObjects"]~
     Scale~3, {0, 0, 6}]
   };
floor = {
    Texture@ExampleData[{"ColorTexture", "GreenMarble"}],
    EdgeForm@None,
    Polygon[{{-w, -w, 0}, {-w, w, 0}, {w, w, 0}, {w, -w, 0}},
     VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]
    } /. w -> prmWORLDWIDTH;

rotTrans := Function[x, Evaluate[RotationTransform[x, {0., 0., 1.}]]];
mp0 = MousePosition[];
getMouseOffset := (mousePos = MousePosition[];
   {mouseDx, mouseDy} = mousePos - mp0;
   mp0 = mousePos;
   );
processMouse := (getMouseOffset;
   viewDir = 
    RotationTransform[-prmMOUSESENS mouseDy, strafeDir]@viewDir;
   {moveDir, strafeDir, viewDir} = 
    rotTrans[-prmMOUSESENS mouseDx] /@ {moveDir, strafeDir, viewDir}; 
   );

processKeyboard := Switch[CurrentValue["EventKey"],
   "w", pos += prmKEYSENS moveDir,
   "s", pos -= prmKEYSENS moveDir,
   "a", pos -= prmKEYSENS strafeDir,
   "d", pos += prmKEYSENS strafeDir
   ];

actions = {
   "MouseMoved" :> processMouse,
   "KeyDown" :> processKeyboard
   };

hideMouse[expr_] := 
  MouseAppearance[expr, Graphics[{Opacity@.01, Point@{0, 0}}]];

nb = MessageDialog[
   Dynamic@EventHandler[
     hideMouse@
      Style[
       Graphics3D[{cube, floor},
        ViewVector -> {pos, pos + viewDir},
        ViewRange -> {0.1, 300},
        Lighting -> "Neutral",
        Boxed -> False,
        ImageSize -> Full,
        Background -> LightBlue,
        PlotRangePadding -> 0
        ],
       Selectable -> False,
       Editable -> False
       ],
     actions
     ],
   CellMargins -> 0,
   ShowCellBracket -> False,
   ShowCellLabel -> False,
   "TrackCellChangeTimes" -> False,
   WindowElements -> {},
   WindowFrame -> "Normal",
   WindowSize -> Full,
   WindowMargins -> Automatic,
   WindowTitle -> "WASD"
   ];

SetOptions[nb, NotebookEventActions -> actions];
End[];

To implement 'pure' full screen look I used this answer.

Though I'm pretty satisfied with the result there are some issues here which require tweaking.

  1. Since mouse offset events are implemented using MousePosition it is quite easy to get mouse look stucked (e.g. when you try to turn around). This happens when hidden mouse cursor hits screen borders. So, how to correctly handle mouse offset events?

  2. It is impossible to move diagonally because KeyDown events do not handle simultaneous keystrokes. Can something be done with this?

  3. The duplication of event handlers at the end (SetOptions[nb, NotebookEventActions -> actions]) does not seem logical to me, but without it KeyDown events do not work. Why?

  4. hideMouse hack is what I discussed here. Unfortunately the elegant construction MouseAppearance[expr, Spacer[0]] proposed by Mike does not work on v. 8.0.4 and WinXP and Win7.

  5. And finally are there any possibilities for speeding this up?

$\endgroup$
  • 9
    $\begingroup$ Next up: "How do I implement Quake 3 in Mathematica?" =) $\endgroup$ – rm -rf Jan 11 '13 at 1:50
  • $\begingroup$ +1 This is awesome. How might your function for other 3DGraphics for example to something like the following example? Graphics3D[{ Cylinder[], Sphere[{0, 0, 2}], Line[{{-2, 0, 2}, {2, 0, 2}, {0, 0, 4}, {-2, 0, 2}}], Yellow, Cuboid[{-2, -2, -2}, {2, 2, -1}], }] For example would it be easy to create a function of the form wasd[gr_]. I thinking of starting such a question. $\endgroup$ – William Sep 14 '14 at 3:39
  • $\begingroup$ Posted a similar question here in case you are interested mathematica.stackexchange.com/q/59655 $\endgroup$ – William Sep 14 '14 at 4:14
2
$\begingroup$
  1. One way to fix the cursor bounding problem is to periodically force the cursor back to the center of the window. (I've seen this technique in OpenGL.) This way the cursor never leaves the area of the window. You'll probably need J/Link to achieve this, here is an example: Programmatically move the cursor...
  2. Probably you should keep a list of key states (which is updated at every key up or down event) and use that list to manipulate the scene at every key event.
  3. I think it might be cleaner to use J/Link entirely to manage mouse and key events, therefore this issue might actually disappear after you move to J/Link.
  4. Perhaps you can query the Mathematica/OS version, but on V10 the current hack works fine.
  5. I'll need to further investigate this one. My first try would be to decrease the rendering resolution or try to dynamically remove/add non-visible/visible objects from the scene. I don't know how smart Mathematica does the rendering with Graphics3D
$\endgroup$
  • $\begingroup$ Actually you can move the cursor with a front end packet. Finally there's a use for that! $\endgroup$ – b3m2a1 Mar 10 '17 at 2:18

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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