(*
Mathematica Minecraft classic implementation
see http://mathematica.stackexchange.com/q/19669 for details
*)
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},
If[! FileExistsQ[file], MessageDialog["File not found"]; Return[]];
{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[]
}}
];
loadDialog[] := CreateDialog[
Grid@{{Dynamic["Load from file: " <> filename],
FileNameSetter[Dynamic[filename], "Open", {"mmc" -> {"*"}}]},
{DefaultButton[loadGame[filename]; DialogReturn[]],
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 = Developer`ToPackedArray[{{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[],
"l", loadDialog[],
" ", addCurrentBlock[],
"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[],
{"MouseUp", 2} :> (addCurrentBlock[]; getSelection[]),
"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},
Heads -> False]]
];
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;
];
addCurrentBlock[] :=
If[newBlockPos != blockPos@pos,
getSelection[];
addBlock@newBlockPos;
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]]];
];
];
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,
PlotRangePadding -> 0,
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,
"BlinkingCellInsertionPoint" -> False,
"CellInsertionPointCell" -> {},
WindowMargins -> Automatic,
WindowTitle -> "Mathematicraft",
Background -> Black,
Editable -> False,
NotebookEventActions -> actions,
TextAlignment -> Center,
Deployed -> True,
RenderingOptions -> {"Graphics3DRenderingEngine" ->
prmRENDERINGENGINE}
];
blocksCount[]
facesCount[]