# Mathematica Minecraft

Some time ago I asked myself: with all these great graphics and interactive capabilities of Mathematica, what kinds of 3D games can be implemented in it? And the answer which came to mind is Minecraft classic. The scene in this game is almost static, the first person view and controls can be easily implemented, the terrain textures are freely available, and the overall functionality does not seem to be complicated... There is even a related demonstration on the Demonstrations Project!

So, can Mathematica really handle Minecraft classic game functionality?

-
Personally I have always found Mathematica extremely wanting when it comes to game-loop like constructs. Naively working out dynamics or updating frames seems like a bad approach, and it's not easy to get down to the lower level functions. Though I'd love to see someone do something like this. – jVincent Feb 15 '13 at 22:27
You know it's funny--I had about the opposite thought. How easy it would be to implement some nice calculation software and use Minecraft to visualize the results. Minecraft has all the drawing/graphing abilities, just interface it and learn to look at your data from a new angle (possibly by climing it) – Bill K Feb 16 '13 at 1:30

Well, the answer seems to be YES :)

Here is my implementation of Minecraft classic game in Mathematica. Let’s start with some screenshots which were taken during the construction of the final scene which will be displayed an the end of this post.

Features

• Blocks are creatable and removable
• One texture per block
• Player automatically jumps to the obstacles of one block height and on the blocks which are created directly underneath. You can also try to fall down.
• Simplified selection tracking, which can miss cube corners, is implemented. Anyway it is still quite intuitive and allows to put blocks diagonally.
• Big action range: you can place and remove blocks located far away.

Controls

• W-A-S-D: move forward-left-backward-right. By default double steps are used, Shift key enables single step.
• Arrow keys: look up-down-left-right
• Mouse selects current block
• 1…9: select new block type
• B: show blocks selector
• Left mouse click: delete block
• Right mouse click or Space: create block
• R: set respawn position
• Enter: respawn
• X: Save game state

Performance tuning

Terrain construction. Simple random walk terrain generation is implemented. The following parameters can by adjusted:

prmTERRAINBLOCKSN – approximate number of terrain blocks

prmCLOUDSN – number of clouds. Each cloud consists of random number of blocks.

prmTERRAINGRAIN and prmTERRAINOFFSET control the landscape properties. On the first picture below prmTERRAINOFFSET is 8, and is 3 for the second one.

Hardware issues. On some systems the presence of a single opacity directive drastically decreases performance. In this case one can set prmDISABLETRANSPARENCY to True or/and try to use prmRENDERINGENGINE=”BSPTree”.

Conclusion

To be honest I am myself surprised how well the final code performs. On average system it easily handles thousands and even tens of thousands blocks. With the growth of this number the “gameplay” becomes too slow. It is also should be noted that what really matters is the number of faces, because hidden faces are not included in the final Graphics3D, so clustered blocks are preferable.

The result of my first construction session is

prmWORLDWIDTH = 200;
prmWORLDHEIGHT = 100;
prmVIEWERHEIGHT = 2.75;
prmVIEWRANGE = {0.01, 300};
prmMOVESTEP = .95;
prmACTIONRANGE = 300;
prmTRACESTEP = 0.33;
prmVIEWANGLE = 45 Degree;
prmFALLINGPAUSE = 0;
prmVERTLOOKANGLEDELTA = 4.99 Degree;
prmHORLOOKANGLEDELTA = 90 Degree/4.;
prmSKYCOLOR = RGBColor[0.58, 0.77, 0.96];
prmTEXTURESIZE = 16;
prmTERRAINBLOCKSN = 5000;
prmCLOUDSN = 3;
prmFLOORMATERIAL = matSand;
prmRENDERINGENGINE = Automatic;
prmDISABLETRANSPARENCY = False;
prmSMOOTHTERRAIN = True;
prmTERRAINGRAIN = 3;
prmTERRAINOFFSET = 3;

terrainImg = Import["http://i.imgur.com/2uAswvI.png"];
ClearAll["mat*"];
materials =
{matGrass -> {1, 1},
matStone -> {1, 2},
matDirt -> {1, 3},
matPlanks -> {1, 5},
matPlate -> {1, 7},
matBricks -> {1, 8},
matCobblestone -> {2, 1},
matBedrock -> {2, 2},
matSand -> {2, 3},
matGravel -> {2, 4},
matWood -> {2, 5},
matLeaves -> {2, 7},
matMossStone -> {3, 5},
matObsidian -> {3, 6},
matGlass -> {4, 2},
matWhiteWool -> {5, 16},
matGrayWool -> {5, 15},
matDarkGrayWool -> {5, 14},
matMagentaWool -> {5, 13},
matPinkWool -> {5, 12},
matPurpleWool -> {5, 10},
matBlueWool -> {5, 9},
matLightBlueWool -> {5, 8},
matCyanWool -> {5, 7},
matGreenWool -> {5, 5},
matLimeWool -> {5, 4},
matYellowWool -> {5, 3},
matOrangeWool -> {5, 2},
matRedWool -> {5, 1},
matClouds -> {1, 12},
matSilver -> {2, 8},
matGold -> {2, 9}
};

dirVectors = {{0, 1, 0}, {1, 0, 0}, {0, -1, 0}, {-1, 0, 0}, {0,
0, -1}, {0, 0, 1}};
vtc = {{0, 0}, {1, 0}, {1, 1}, {0, 1}};
vertCoords = # - {1, 1, 1} & /@ {{0, 0, 0}, {0, 0, 1}, {1, 0, 1}, {1,
0, 0}, {0, 1, 0}, {0, 1, 1}, {1, 1, 1}, {1, 1, 0}};
faceCoords = {{7, 6, 5, 8}, {3, 7, 8, 4}, {2, 3, 4, 1}, {6, 2, 1,
5}, {5, 8, 4, 1}, {3, 2, 6, 7}};

filename = "save.mmc";

initMaterials[] := Block[{},
nMat = Length@materials;
Evaluate[materials[[All, 1]]] = Range[nMat];
matAir = 0;
With[{ts = prmTEXTURESIZE},
textures =
ImageTake[terrainImg, ts (#1 - 1) + {1, ts},
ts (#2 - 1) + {1, ts}] &
@@@ (materials[[All, 2]])
];
textures[[matClouds]] =
Image[Array[{1, 1, 1} &, {prmTEXTURESIZE, prmTEXTURESIZE}]];
ClearAll[transparentQ];
Do[transparentQ[mat] =
MemberQ[{matLeaves, matGlass, matClouds, matAir}, mat], {mat, 0,
nMat}];
If[! prmDISABLETRANSPARENCY,
textures[[matLeaves]] =
ImageData[
textures[[
matLeaves]]] /. {{1., 1., 1.} -> {0., .5, 0., 0.}, {r_, g_,
b_} :> {r, g, b, 1.}};
textures[[matGlass]] =
ImageData[
textures[[
matGlass]]] /. {{1., 1., 1.} -> {5., .5, .1, 0.}, {r_, g_,
b_} :> {r, g, b, 1.}};
textures[[matClouds]] =
Array[{1, 1, 1, .75} &, {prmTEXTURESIZE, prmTEXTURESIZE}];
];
];

initIcons[] := Block[{},
icons = Graphics3D[{ EdgeForm@None, Texture[#],
Polygon[# & /@ vertCoords[[#]],
VertexTextureCoordinates -> vtc] & /@ faceCoords},
Lighting -> "Neutral", Boxed -> False, ImageSize -> 64,
Background -> Black] &
/@ textures;
setterbar = Column[SetterBar[
Dynamic[
palette[[
curBlockType]], {(palette[[
curBlockType]] = #) &, (updatePalette[];
DialogReturn[]) &}], #] &
/@ Partition[Thread[Range[nMat] -> icons], 6, 6, {1, 1}, {}]
];
palette = {matStone, matCobblestone, matBricks, matDirt, matPlanks,
matWood, matLeaves, matGlass, matPlate};
curBlockType = 1;
updatePalette[];
];

updatePalette[] := (paletteGfx = Image[
GraphicsRow[icons[[palette]],
Evaluate[Frame -> Array[# == curBlockType &, 9]],
Evaluate[FrameStyle -> Directive[White, AbsoluteThickness@3]],
Background -> Black
], ImageSize -> 500]);

updateCubes[] := (cucubes = Flatten@cubes;);

saveGame[file_] :=
Export[file, {pos, viewDir, moveDir, strafeDir, palette,
curBlockType, SparseArray@blocks} // Compress, "Text"];

loadGame[file_] := Block[{p, vd, md, sd, pal, cbt, bl},
{p, vd, md, sd, pal, cbt, bl} = Uncompress@Import[file, "Text"];
{pos, viewDir, moveDir, strafeDir, palette, curBlockType} = {p, vd,
md, sd, pal, cbt};
blocks = Normal@bl;
dim = Dimensions@blocks;
{prmWORLDWIDTH, prmWORLDHEIGHT} = Rest@dim;
initFloor[];
initCubes[]; updateCubes[]; updatePalette[]; getSelection[];
FinishDynamic[];
];

saveDialog[] := CreateDialog[
Grid@{{Dynamic["Save to file: " <> filename],
FileNameSetter[Dynamic[filename], "Save"]},
{DefaultButton[saveGame[filename]; DialogReturn[]],
CancelButton[]
}}
];

Grid@{{Dynamic["Load from file: " <> filename],
FileNameSetter[Dynamic[filename], "Open", {"mmc" -> {"*"}}]},
CancelButton[]
}}
];

showBlockChooser[] := CreateDialog[setterbar, {},
WindowSize -> 500,
Background -> Black,
Modal -> True,
WindowFrame -> "Frameless",
TextAlignment -> Center
];

initBlocks[] := (
dim = {prmWORLDWIDTH, prmWORLDWIDTH, prmWORLDHEIGHT};
blocks = Array[0 &, dim];
);

initCamera[] := Block[{},
pos = {1.5, 1.5, prmVIEWERHEIGHT};
height = Ceiling@prmVIEWERHEIGHT;
moveDir = {1, 1, 0} // Normalize;
viewDir = moveDir;
strafeDir = {1, -1, 0} // Normalize;
respawnPos = Null;
currentBlockPos = newBlockPos = Null;
selection = {};
viewAngle = 0;
];

initFloor[] := (floor = With[{w = prmWORLDWIDTH},
{EdgeForm[None],
Texture[textures[[prmFLOORMATERIAL]]],
Polygon[{{0, 0, 0}, {0, w, 0}, {w, w, 0}, {w, 0, 0}},
VertexTextureCoordinates -> {{0, 0}, {w, 0}, {w, w}, {0, w}}]}
]);

initCubes[] := Block[{g, type, pointers, faces},
cubes = {Texture@#} & /@ textures;
cubePointers = DeveloperToPackedArray[{{0, 0, 0}}] & /@ textures;
g = ParallelMap[{#, createCube[#]} &,
Position[blocks, b_ /; b > 0]];
Scan[({pointers, faces} = Transpose@#;
type = blockAt@First@pointers;
cubes[[type]] = cubes[[type]]~Join~faces;
cubePointers[[type]] = cubePointers[[type]]~Join~pointers;
) &,
GatherBy[g, blockAt@First@# &]
];
];

processFalling[] := Block[{i, j, k}, While[
({i, j, k} = blockPos[pos])[[3]] > height &&
blocks[[i, j, k - height]] == 0,
pos -= {0, 0, 1}; FinishDynamic[]; Pause[prmFALLINGPAUSE]
]];

lookHor[da_] := ({moveDir, strafeDir, viewDir} =
RotationTransform[da, {0., 0., 1.}] /@ {moveDir, strafeDir,
viewDir});
lookVert[da_] :=
If[Abs[viewAngle + da] <= Pi/2,
viewAngle += da;
viewDir = RotationTransform[da, strafeDir]@viewDir
];

move[dv_, n_Integer] := Do[move@dv, {n}];
move[dv_] := Block[{newpos, i, j, k, space},
newpos = pos + dv;
If[! inRange@newpos, Return[]];
{i, j, k} = blockPos@newpos;
If[k + 1 > prmWORLDHEIGHT, Return[]];
space = blocks[[i, j, (k - height + 1) ;; k + 1]];
Which[
And @@ Thread[Most@space == 0], pos = newpos,
First@space != 0 && (And @@ Thread[Rest@space == 0]),
pos = newpos + {0, 0, 1}
];
processFalling[];
];

processKeyboard[] := (
Switch[CurrentValue["EventKey"],
"W", move[prmMOVESTEP  moveDir],
"S", move[-prmMOVESTEP moveDir],
"A", move[-prmMOVESTEP strafeDir],
"D", move[prmMOVESTEP strafeDir],
"w", move[prmMOVESTEP  moveDir, 2],
"s", move[-prmMOVESTEP  moveDir, 2],
"a", move[-prmMOVESTEP  strafeDir, 2],
"d", move[prmMOVESTEP  strafeDir, 2],
"q", pos += {0, 0, 1},
"b", showBlockChooser[],
"r", (respawnPos = pos),
"x", saveDialog[],
"1", curBlockType = 1; updatePalette[],
"2", curBlockType = 2; updatePalette[],
"3", curBlockType = 3; updatePalette[],
"4", curBlockType = 4; updatePalette[],
"5", curBlockType = 5; updatePalette[],
"6", curBlockType = 6; updatePalette[],
"7", curBlockType = 7; updatePalette[],
"8", curBlockType = 8; updatePalette[],
"9", curBlockType = 9; updatePalette[]
];
getSelection[];
)

actions = {
{"MouseDown", 1} :> deleteCurrentBlock[],
"MouseMoved" :> getSelection[],
"LeftArrowKeyDown" :> lookHor[prmHORLOOKANGLEDELTA],
"RightArrowKeyDown" :> lookHor[-prmHORLOOKANGLEDELTA],
"UpArrowKeyDown" :> lookVert[prmVERTLOOKANGLEDELTA],
"DownArrowKeyDown" :> lookVert[-prmVERTLOOKANGLEDELTA],
"ReturnKeyDown" :> If[respawnPos =!= Null, move[respawnPos - pos]],
"KeyDown" :> processKeyboard[],
PassEventsDown -> False
};

inRange = And @@ Thread[{0, 0, 0} < # <= dim] &;
blockAt = blocks[[Sequence @@ #]] &;
setBlock = (blocks[[Sequence @@ #1]] = #2) &;
setMouse[expr_] := MouseAppearance[expr, "Arrow"];
blocksCount[] := Count[blocks, b_ /; b != 0, {3}];
facesCount[] := Count[cubes, Polygon[__], {3}];
blockPos = Ceiling;

neighborList[p_] := Block[{cf},
cf = If[transparentQ@blockAt@p,
(blockAt[#] == matAir) &,
(transparentQ@blockAt[#] &)
];
Quiet[Flatten@
Position[p + # & /@ dirVectors, _?(inRange[#] && cf[#] &), {1},
];

createCube[coords_] :=
Polygon[coords + # & /@ vertCoords[[#]],
VertexTextureCoordinates -> vtc] & /@
faceCoords[[neighborList@coords]];

setCube[coords_, type_] := (
AppendTo[cubes[[type]], createCube[coords]];
AppendTo[cubePointers[[type]], coords];
)

addBlock[bp : {_Integer, _Integer, _Integer}?inRange] := (
setBlock[bp, palette[[curBlockType]]];
setCube[bp, palette[[curBlockType]]];
updateNeighbors@bp;
);

neighborCoords[p_] :=
Quiet[Cases[
p + # & /@ dirVectors, _?(inRange[#] && blockAt[#] != matAir &),
1]];

updateNeighbors[p_] := Block[{np, locs},
np = neighborCoords@p;
locs =
ParallelMap[Position[cubePointers, #, {2}, Heads -> False] &, np];
(cubes[[Sequence @@ (First@#1)]] = createCube@#2) & @@@
Transpose@{locs, np};
];

deleteBlock[bp : {_Integer, _Integer, _Integer}?inRange] :=
Block[{loc},
loc = Position[cubePointers, bp, {2}, Heads -> False];
setBlock[bp, 0];
cubePointers = Delete[cubePointers, loc[[1]]];
cubes = Delete[cubes, loc[[1]]];
updateNeighbors@bp;
];

If[newBlockPos != blockPos@pos,
getSelection[];
move@{0, 0, 0};
getSelection[];
updateCubes[];
];

deleteCurrentBlock[] := (
getSelection[];
deleteBlock@currentBlockPos;
getSelection[];
processFalling[];
updateCubes[];
);

getSelection[] := Block[{flag, found, chain, mp},
flag = False;
mp = MousePosition["Graphics3DBoxIntercepts", Null];
currentBlockPos = newBlockPos = Null;
selection = {};
If[mp === Null, Return[]];
v = Normalize[Subtract @@ mp];
If[v.viewDir < 0, v = -v];
found = (flag = (Last@# < 0 || blockAt[blockPos@#] != 0)) &;
chain = NestWhileList[
# + prmTRACESTEP v &,
pos,
(And @@ Thread[{0, 0, -1} < # < dim]) && (! found@#) &,
1, Ceiling[prmACTIONRANGE/prmTRACESTEP]];
If[flag,
currentBlockPos = blockPos@chain[[-1]];
selection = {EdgeForm@{Black, Thick},
FaceForm[None],
Cuboid[currentBlockPos - 1, currentBlockPos]
};
If[Length@chain > 1, newBlockPos = blockPos@chain[[-2]]];
];
];

(*World generation*)

randomWalkPattern[nb_, m_, d_] :=
Module[{n = prmWORLDWIDTH, q, i0, j0, i1, j1, field, applyAt,
offset, ok, p, next},
field = Array[0 &, {n, n}];
applyAt =
Function[{i, j}, field[[i - m ;; i + m, j - m ;; j + m]] += 1];
offset = RandomInteger[d {-1, 1}, {2}] &;
ok = (m < #1 <= n - m) && (m < #2 <= n - m ) &;
next = (While[! ok @@ (q = # + offset[]), q]; q) &;
p = Floor[{n, n}/2];
Do[applyAt @@ p; p = next@p, {Round[nb/(2 m + 1)^2]}];
If[prmSMOOTHTERRAIN,
ListConvolve[BoxMatrix[2]/25, field] // Round,
field]
];

createTerrain[bc_] := Block[{field},
field = randomWalkPattern[bc, prmTERRAINGRAIN, prmTERRAINOFFSET];
With[{h = Min[field[[##]], prmWORLDHEIGHT]},
blocks[[#1, #2, 1 ;; h]] =
RandomChoice[{matGravel, matStone}, h];
blocks[[#1, #2, 1]] = RandomChoice@{matBedrock, matDirt};
If[1 < h < RandomInteger@{4, 9},
blocks[[#1, #2, h - 1 ;; h]] = matDirt;
If[RandomChoice@{True, False}, blocks[[#1, #2, h]] = matGrass];
];
] & @@@ Position[field, b_ /; b > 0, {2}];
];

createClouds[nClouds_] :=
Block[{cloud, ww = prmWORLDWIDTH, wh = prmWORLDHEIGHT, i, j, h},
Do[
cloud = randomWalkPattern[RandomInteger@{200, 1000}, 1, 2];
{i, j} = RandomInteger[{-ww, ww}/2, 2];
h = RandomInteger@{wh/2, wh};
Quiet[blocks[[#1 + i, #2 + j, h]] = matClouds] & @@@
Position[cloud, b_ /; b != 0, {2}],
{nClouds}
];
];

initMaterials[];
initIcons[];
initBlocks[];
createTerrain[prmTERRAINBLOCKSN];
createClouds[prmCLOUDSN];
initFloor[];
initCubes[];
initCamera[];

updateCubes[];

scene = Graphics3D[{Dynamic@floor, EdgeForm@None, Dynamic@cucubes,
Dynamic@selection},
ViewVector -> Dynamic@{pos, pos + viewDir},
ViewRange -> prmVIEWRANGE,
PlotRange -> All,
Lighting -> "Neutral",
Boxed -> False,
BoxRatios -> Automatic,
ImageSize ->
Dynamic@AbsoluteCurrentValue[EvaluationNotebook[], WindowSize],
ViewAngle -> prmVIEWANGLE,
Background -> prmSKYCOLOR,
Epilog -> {crosshair, Inset[Dynamic@paletteGfx, Scaled@{.5, .05}]}
];

crosshair = {White, AbsoluteThickness@2,
Line[{Scaled@{.49, .5}, Scaled@{.51, .5}}],
Line[{Scaled@{.5, .49}, Scaled@{.5, .51}}]
};

CreateDocument[
EventHandler[
setMouse@Style[scene, Selectable -> False, Editable -> False],
actions
],
CellMargins -> 0,
ShowCellBracket -> False,
ShowCellLabel -> False,
"TrackCellChangeTimes" -> False,
WindowElements -> {},
WindowFrame -> "Normal",
WindowSize -> Full,
"CellInsertionPointCell" -> {},
WindowMargins -> Automatic,
WindowTitle -> "Mathematicraft",
Background -> Black,
Editable -> False,
NotebookEventActions -> actions,
TextAlignment -> Center,
Deployed -> True,
RenderingOptions -> {"Graphics3DRenderingEngine" ->
prmRENDERINGENGINE}
];

blocksCount[]
facesCount[]


The code has been tested on Mathematica version 8.0.4 and WinXP and Win7 operation systems. Further improvements are appreciated as well as the comments about the code organisation and style. Thank you!

## Update

First of all I'd like to thank the community for the votes and comments. In this update I will make some considerations about the performance of the above code (here is the link to it on Pastebin for convenience).

As I see from the comments, the speed of current implementation is both hardware and version specific. There are two main characteristics: the smoothness of motion and the speed of scene update after block creation or removal. I guess that the smoothness depends on graphics card, and the update speed on both the processor and GPU.

On my working G860 3Hz Intel processor with integrated Intel HD graphics and Win7 OS I have the following:

• The default scene with 5000 terrain blocks and 3 clouds is smooth enough for comfortable movement with disabled transparency. It speeds up a bit when no dynamic selection is displayed (when I point to the sky).

• The update speed is approximately 1-2 seconds per operation.

• The overall performance deteriorates significantly with enabled transparency. One way out is to set prmCLOUDSN=0 since it is clouds what is transparent on the default scene.

• With 20 000 terrain blocks and disabled opacity the movement is still pretty smooth, the scene update takes 2-3 seconds.

• No performance differences between versions 8 and 9 on my system.

• The scene I've constructed began with 1000 terrain blocks, no clouds (I added them manually) and no transparency. With this inital settings the scene updates momentally and is comfortable for construction. Honestly I am not sure about how transparency is handled on different systems, but on the system with an old discrete GeForce card it seemed to work faster than on integrated GPUs.

So my advices on performance improvement still are:

• Use prmTERRAINBLOCKSN and prmCLOUDSN wisely. Try to set them to zero at all.

• Try prmDISABLETRANSPARENCY=True

• Point to the sky when move

-
Well you knocked this question out of the park on the first pitch... – Guillochon Feb 15 '13 at 22:48
@rm-rf Or run this : NotebookPut@ImportString[Uncompress@FromCharacterCode@Flatten@ImageData[Import@ "http://i.stack.imgur.com/QHOSk.png","Byte"],"NB"]` :DD – Dr. belisarius Feb 16 '13 at 2:29
Created an account on the Mathematica boards just to upvote this post. – Kevin Feb 16 '13 at 5:22
This is amazing and mind boggling. But is very slow in my PC on Mathematica 9. What is the hardware requirement for this to run smoothly? – PlatoManiac Feb 16 '13 at 10:27
@faleichik you are right in Mathematica 8 its much much faster and quite smooth. But in 9 its too slow! – PlatoManiac Feb 16 '13 at 12:17