• API
• FAQ
• Tools
• Archive
SHARE
TWEET

# Mathematica Minecraft

faleichik Feb 19th, 2013 774 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. (*
2. Mathematica Minecraft classic implementation
3. see http://mathematica.stackexchange.com/q/19669 for details
4. *)
5.
6. prmWORLDWIDTH = 200;
7. prmWORLDHEIGHT = 100;
8. prmVIEWERHEIGHT = 2.75;
9. prmVIEWRANGE = {0.01, 300};
10. prmMOVESTEP = .95;
11. prmACTIONRANGE = 300;
12. prmTRACESTEP = 0.33;
13. prmVIEWANGLE = 45 Degree;
14. prmFALLINGPAUSE = 0;
15. prmVERTLOOKANGLEDELTA = 4.99 Degree;
16. prmHORLOOKANGLEDELTA = 90 Degree/4.;
17. prmSKYCOLOR = RGBColor[0.58, 0.77, 0.96];
18. prmTEXTURESIZE = 16;
19. prmTERRAINBLOCKSN = 5000;
20. prmCLOUDSN = 3;
21. prmFLOORMATERIAL = matSand;
22. prmRENDERINGENGINE = Automatic;
23. prmDISABLETRANSPARENCY = False;
24. prmSMOOTHTERRAIN = True;
25. prmTERRAINGRAIN = 3;
26. prmTERRAINOFFSET = 3;
27.
28. terrainImg = Import["http://i.imgur.com/2uAswvI.png"];
29. ClearAll["mat*"];
30. materials =
31.   {matGrass -> {1, 1},
32.    matStone -> {1, 2},
33.    matDirt -> {1, 3},
34.    matPlanks -> {1, 5},
35.    matPlate -> {1, 7},
36.    matBricks -> {1, 8},
37.    matCobblestone -> {2, 1},
38.    matBedrock -> {2, 2},
39.    matSand -> {2, 3},
40.    matGravel -> {2, 4},
41.    matWood -> {2, 5},
42.    matLeaves -> {2, 7},
43.    matMossStone -> {3, 5},
44.    matObsidian -> {3, 6},
45.    matGlass -> {4, 2},
46.    matWhiteWool -> {5, 16},
47.    matGrayWool -> {5, 15},
48.    matDarkGrayWool -> {5, 14},
49.    matMagentaWool -> {5, 13},
50.    matPinkWool -> {5, 12},
51.    matPurpleWool -> {5, 10},
52.    matBlueWool -> {5, 9},
53.    matLightBlueWool -> {5, 8},
54.    matCyanWool -> {5, 7},
55.    matGreenWool -> {5, 5},
56.    matLimeWool -> {5, 4},
57.    matYellowWool -> {5, 3},
58.    matOrangeWool -> {5, 2},
59.    matRedWool -> {5, 1},
60.    matClouds -> {1, 12},
61.    matSilver -> {2, 8},
62.    matGold -> {2, 9}
63.    };
64.
65. dirVectors = {{0, 1, 0}, {1, 0, 0}, {0, -1, 0}, {-1, 0, 0}, {0,
66.     0, -1}, {0, 0, 1}};
67. vtc = {{0, 0}, {1, 0}, {1, 1}, {0, 1}};
68. vertCoords = # - {1, 1, 1} & /@ {{0, 0, 0}, {0, 0, 1}, {1, 0, 1}, {1,
69.      0, 0}, {0, 1, 0}, {0, 1, 1}, {1, 1, 1}, {1, 1, 0}};
70. faceCoords = {{7, 6, 5, 8}, {3, 7, 8, 4}, {2, 3, 4, 1}, {6, 2, 1,
71.     5}, {5, 8, 4, 1}, {3, 2, 6, 7}};
72.
73. filename = "save.mmc";
74.
75.
76. initMaterials[] := Block[{},
77.    nMat = Length@materials;
78.    Evaluate[materials[[All, 1]]] = Range[nMat];
79.    matAir = 0;
80.    With[{ts = prmTEXTURESIZE},
81.     textures =
82.      ImageTake[terrainImg, ts (#1 - 1) + {1, ts},
83.         ts (#2 - 1) + {1, ts}] &
84.       @@@ (materials[[All, 2]])
85.     ];
86.    textures[[matClouds]] =
87.     Image[Array[{1, 1, 1} &, {prmTEXTURESIZE, prmTEXTURESIZE}]];
88.    ClearAll[transparentQ];
89.    Do[transparentQ[mat] =
90.      MemberQ[{matLeaves, matGlass, matClouds, matAir}, mat], {mat, 0,
91.      nMat}];
92.    If[! prmDISABLETRANSPARENCY,
93.     textures[[matLeaves]] =
94.      ImageData[
95.        textures[[
96.         matLeaves]]] /. {{1., 1., 1.} -> {0., .5, 0., 0.}, {r_, g_,
97.          b_} :> {r, g, b, 1.}};
98.     textures[[matGlass]] =
99.      ImageData[
100.        textures[[
101.         matGlass]]] /. {{1., 1., 1.} -> {5., .5, .1, 0.}, {r_, g_,
102.          b_} :> {r, g, b, 1.}};
103.     textures[[matClouds]] =
104.      Array[{1, 1, 1, .75} &, {prmTEXTURESIZE, prmTEXTURESIZE}];
105.     ];
106.    ];
107.
108. initIcons[] := Block[{},
109.    icons = Graphics3D[{ EdgeForm@None, Texture[#],
110.         Polygon[# & /@ vertCoords[[#]],
111.            VertexTextureCoordinates -> vtc] & /@ faceCoords},
112.        Lighting -> "Neutral", Boxed -> False, ImageSize -> 64,
113.        Background -> Black] &
114.      /@ textures;
115.    setterbar = Column[SetterBar[
116.         Dynamic[
117.          palette[[
118.           curBlockType]], {(palette[[
119.               curBlockType]] = #) &, (updatePalette[];
120.             DialogReturn[]) &}], #] &
121.       /@ Partition[Thread[Range[nMat] -> icons], 6, 6, {1, 1}, {}]
122.      ];
123.    palette = {matStone, matCobblestone, matBricks, matDirt, matPlanks,
124.       matWood, matLeaves, matGlass, matPlate};
125.    curBlockType = 1;
126.    updatePalette[];
127.    ];
128.
129. updatePalette[] := (paletteGfx = Image[
130.      GraphicsRow[icons[[palette]],
131.       Evaluate[Frame -> Array[# == curBlockType &, 9]],
132.       Evaluate[FrameStyle -> Directive[White, AbsoluteThickness@3]],
133.       Background -> Black
134.       ], ImageSize -> 500]);
135.
136. updateCubes[] := (cucubes = Flatten@cubes;);
137.
138. saveGame[file_] :=
139.   Export[file, {pos, viewDir, moveDir, strafeDir, palette,
140.      curBlockType, SparseArray@blocks} // Compress, "Text"];
141.
142. loadGame[file_] := Block[{p, vd, md, sd, pal, cbt, bl},
144.    {p, vd, md, sd, pal, cbt, bl} = Uncompress@Import[file, "Text"];
145.    {pos, viewDir, moveDir, strafeDir, palette, curBlockType} = {p, vd,
146.       md, sd, pal, cbt};
147.    blocks = Normal@bl;
148.    dim = Dimensions@blocks;
149.    {prmWORLDWIDTH, prmWORLDHEIGHT} = Rest@dim;
150.    initFloor[];
151.    initCubes[]; updateCubes[]; updatePalette[]; getSelection[];
152.    FinishDynamic[];
153.    ];
154.
155. saveDialog[] := CreateDialog[
156.    Grid@{{Dynamic["Save to file: " <> filename],
157.       FileNameSetter[Dynamic[filename], "Save"]},
158.      {DefaultButton[saveGame[filename]; DialogReturn[]],
159.       CancelButton[]
160.       }}
161.    ];
162.
164.    Grid@{{Dynamic["Load from file: " <> filename],
165.       FileNameSetter[Dynamic[filename], "Open", {"mmc" -> {"*"}}]},
167.       CancelButton[]
168.       }}
169.    ];
170.
171. showBlockChooser[] := CreateDialog[setterbar, {},
172.    WindowSize -> 500,
173.    Background -> Black,
174.    Modal -> True,
175.    WindowFrame -> "Frameless",
176.    TextAlignment -> Center
177.    ];
178.
179. initBlocks[] := (
180.    dim = {prmWORLDWIDTH, prmWORLDWIDTH, prmWORLDHEIGHT};
181.    blocks = Array[0 &, dim];
182.    );
183.
184. initCamera[] := Block[{},
185.    pos = {1.5, 1.5, prmVIEWERHEIGHT};
186.    height = Ceiling@prmVIEWERHEIGHT;
187.    moveDir = {1, 1, 0} // Normalize;
188.    viewDir = moveDir;
189.    strafeDir = {1, -1, 0} // Normalize;
190.    respawnPos = Null;
191.    currentBlockPos = newBlockPos = Null;
192.    selection = {};
193.    viewAngle = 0;
194.    ];
195.
196. initFloor[] := (floor = With[{w = prmWORLDWIDTH},
197.      {EdgeForm[None],
198.       Texture[textures[[prmFLOORMATERIAL]]],
199.       Polygon[{{0, 0, 0}, {0, w, 0}, {w, w, 0}, {w, 0, 0}},
200.        VertexTextureCoordinates -> {{0, 0}, {w, 0}, {w, w}, {0, w}}]}
201.      ]);
202.
203. initCubes[] := Block[{g, type, pointers, faces},
204.    cubes = {Texture@#} & /@ textures;
205.    cubePointers = Developer`ToPackedArray[{{0, 0, 0}}] & /@ textures;
206.    g = ParallelMap[{#, createCube[#]} &,
207.      Position[blocks, b_ /; b > 0]];
208.    Scan[({pointers, faces} = Transpose@#;
209.       type = blockAt@First@pointers;
210.       cubes[[type]] = cubes[[type]]~Join~faces;
211.       cubePointers[[type]] = cubePointers[[type]]~Join~pointers;
212.       ) &,
213.     GatherBy[g, blockAt@First@# &]
214.     ];
215.    ];
216.
217. processFalling[] := Block[{i, j, k}, While[
218.     ({i, j, k} = blockPos[pos])[[3]] > height &&
219.      blocks[[i, j, k - height]] == 0,
220.     pos -= {0, 0, 1}; FinishDynamic[]; Pause[prmFALLINGPAUSE]
221.     ]];
222.
223.
224. lookHor[da_] := ({moveDir, strafeDir, viewDir} =
225.     RotationTransform[da, {0., 0., 1.}] /@ {moveDir, strafeDir,
226.       viewDir});
227. lookVert[da_] :=
228.   If[Abs[viewAngle + da] <= Pi/2,
229.    viewAngle += da;
230.    viewDir = RotationTransform[da, strafeDir]@viewDir
231.    ];
232.
233. move[dv_, n_Integer] := Do[move@dv, {n}];
234. move[dv_] := Block[{newpos, i, j, k, space},
235.    newpos = pos + dv;
236.    If[! inRange@newpos, Return[]];
237.    {i, j, k} = blockPos@newpos;
238.    If[k + 1 > prmWORLDHEIGHT, Return[]];
239.    space = blocks[[i, j, (k - height + 1) ;; k + 1]];
240.    Which[
241.     And @@ Thread[Most@space == 0], pos = newpos,
242.     First@space != 0 && (And @@ Thread[Rest@space == 0]),
243.     pos = newpos + {0, 0, 1}
244.     ];
245.    processFalling[];
246.    ];
247.
248.
249. processKeyboard[] := (
250.   Switch[CurrentValue["EventKey"],
251.    "W", move[prmMOVESTEP  moveDir],
252.    "S", move[-prmMOVESTEP moveDir],
253.    "A", move[-prmMOVESTEP strafeDir],
254.    "D", move[prmMOVESTEP strafeDir],
255.    "w", move[prmMOVESTEP  moveDir, 2],
256.    "s", move[-prmMOVESTEP  moveDir, 2],
257.    "a", move[-prmMOVESTEP  strafeDir, 2],
258.    "d", move[prmMOVESTEP  strafeDir, 2],
259.    "q", pos += {0, 0, 1},
260.    "b", showBlockChooser[],
261.    "r", (respawnPos = pos),
262.    "x", saveDialog[],
265.    "1", curBlockType = 1; updatePalette[],
266.    "2", curBlockType = 2; updatePalette[],
267.    "3", curBlockType = 3; updatePalette[],
268.    "4", curBlockType = 4; updatePalette[],
269.    "5", curBlockType = 5; updatePalette[],
270.    "6", curBlockType = 6; updatePalette[],
271.    "7", curBlockType = 7; updatePalette[],
272.    "8", curBlockType = 8; updatePalette[],
273.    "9", curBlockType = 9; updatePalette[]
274.    ];
275.   getSelection[];
276.   )
277.
278. actions = {
279.    {"MouseDown", 1} :> deleteCurrentBlock[],
280.    {"MouseUp", 2} :> (addCurrentBlock[]; getSelection[]),
281.    "MouseMoved" :> getSelection[],
282.    "LeftArrowKeyDown" :> lookHor[prmHORLOOKANGLEDELTA],
283.    "RightArrowKeyDown" :> lookHor[-prmHORLOOKANGLEDELTA],
284.    "UpArrowKeyDown" :> lookVert[prmVERTLOOKANGLEDELTA],
285.    "DownArrowKeyDown" :> lookVert[-prmVERTLOOKANGLEDELTA],
286.    "ReturnKeyDown" :> If[respawnPos =!= Null, move[respawnPos - pos]],
287.    "KeyDown" :> processKeyboard[],
288.    PassEventsDown -> False
289.    };
290.
291. inRange = And @@ Thread[{0, 0, 0} < # <= dim] &;
292. blockAt = blocks[[Sequence @@ #]] &;
293. setBlock = (blocks[[Sequence @@ #1]] = #2) &;
294. setMouse[expr_] := MouseAppearance[expr, "Arrow"];
295. blocksCount[] := Count[blocks, b_ /; b != 0, {3}];
296. facesCount[] := Count[cubes, Polygon[__], {3}];
297. blockPos = Ceiling;
298.
299.
300. neighborList[p_] := Block[{cf},
301.    cf = If[transparentQ@blockAt@p,
302.      (blockAt[#] == matAir) &,
303.      (transparentQ@blockAt[#] &)
304.      ];
305.    Quiet[Flatten@
306.      Position[p + # & /@ dirVectors, _?(inRange[#] && cf[#] &), {1},
308.    ];
309.
310. createCube[coords_] :=
311.   Polygon[coords + # & /@ vertCoords[[#]],
312.      VertexTextureCoordinates -> vtc] & /@
313.    faceCoords[[neighborList@coords]];
314.
315. setCube[coords_, type_] := (
316.   AppendTo[cubes[[type]], createCube[coords]];
317.   AppendTo[cubePointers[[type]], coords];
318.   )
319.
320. addBlock[bp : {_Integer, _Integer, _Integer}?inRange] := (
321.    setBlock[bp, palette[[curBlockType]]];
322.    setCube[bp, palette[[curBlockType]]];
323.    updateNeighbors@bp;
324.    );
325.
326. neighborCoords[p_] :=
327.   Quiet[Cases[
328.     p + # & /@ dirVectors, _?(inRange[#] && blockAt[#] != matAir &),
329.     1]];
330.
331. updateNeighbors[p_] := Block[{np, locs},
332.    np = neighborCoords@p;
333.    locs =
334.     ParallelMap[Position[cubePointers, #, {2}, Heads -> False] &, np];
335.    (cubes[[Sequence @@ (First@#1)]] = createCube@#2) & @@@
336.     Transpose@{locs, np};
337.    ];
338.
339. deleteBlock[bp : {_Integer, _Integer, _Integer}?inRange] :=
340.   Block[{loc},
341.    loc = Position[cubePointers, bp, {2}, Heads -> False];
342.    setBlock[bp, 0];
343.    cubePointers = Delete[cubePointers, loc[[1]]];
344.    cubes = Delete[cubes, loc[[1]]];
345.    updateNeighbors@bp;
346.    ];
347.
349.   If[newBlockPos != blockPos@pos,
350.    getSelection[];
352.    move@{0, 0, 0};
353.    getSelection[];
354.    updateCubes[];
355.    ];
356.
357. deleteCurrentBlock[] := (
358.    getSelection[];
359.    deleteBlock@currentBlockPos;
360.    getSelection[];
361.    processFalling[];
362.    updateCubes[];
363.    );
364.
365. getSelection[] := Block[{flag, found, chain, mp},
366.    flag = False;
367.    mp = MousePosition["Graphics3DBoxIntercepts", Null];
368.    currentBlockPos = newBlockPos = Null;
369.    selection = {};
370.    If[mp === Null, Return[]];
371.    v = Normalize[Subtract @@ mp];
372.    If[v.viewDir < 0, v = -v];
373.    found = (flag = (Last@# < 0 || blockAt[blockPos@#] != 0)) &;
374.    chain = NestWhileList[
375.      # + prmTRACESTEP v &,
376.      pos,
377.      (And @@ Thread[{0, 0, -1} < # < dim]) && (! found@#) &,
378.      1, Ceiling[prmACTIONRANGE/prmTRACESTEP]];
379.    If[flag,
380.     currentBlockPos = blockPos@chain[[-1]];
381.     selection = {EdgeForm@{Black, Thick},
382.       FaceForm[None],
383.       Cuboid[currentBlockPos - 1, currentBlockPos]
384.       };
385.     If[Length@chain > 1, newBlockPos = blockPos@chain[[-2]]];
386.     ];
387.    ];
388.
389. randomWalkPattern[nb_, m_, d_] :=
390.   Module[{n = prmWORLDWIDTH, q, i0, j0, i1, j1, field, applyAt,
391.     offset, ok, p, next},
392.    field = Array[0 &, {n, n}];
393.    applyAt =
394.     Function[{i, j}, field[[i - m ;; i + m, j - m ;; j + m]] += 1];
395.    offset = RandomInteger[d {-1, 1}, {2}] &;
396.    ok = (m < #1 <= n - m) && (m < #2 <= n - m ) &;
397.    next = (While[! ok @@ (q = # + offset[]), q]; q) &;
398.    p = Floor[{n, n}/2];
399.    Do[applyAt @@ p; p = next@p, {Round[nb/(2 m + 1)^2]}];
400.    If[prmSMOOTHTERRAIN,
401.     ListConvolve[BoxMatrix[2]/25, field] // Round,
402.     field]
403.    ];
404.
405. createTerrain[bc_] := Block[{field},
406.    field = randomWalkPattern[bc, prmTERRAINGRAIN, prmTERRAINOFFSET];
407.    With[{h = Min[field[[##]], prmWORLDHEIGHT]},
408.       blocks[[#1, #2, 1 ;; h]] =
409.        RandomChoice[{matGravel, matStone}, h];
410.       blocks[[#1, #2, 1]] = RandomChoice@{matBedrock, matDirt};
411.       If[1 < h < RandomInteger@{4, 9},
412.        blocks[[#1, #2, h - 1 ;; h]] = matDirt;
413.        If[RandomChoice@{True, False}, blocks[[#1, #2, h]] = matGrass];
414.        ];
415.       ] & @@@ Position[field, b_ /; b > 0, {2}];
416.    ];
417.
418. createClouds[nClouds_] :=
419.   Block[{cloud, ww = prmWORLDWIDTH, wh = prmWORLDHEIGHT, i, j, h},
420.    Do[
421.      cloud = randomWalkPattern[RandomInteger@{200, 1000}, 1, 2];
422.      {i, j} = RandomInteger[{-ww, ww}/2, 2];
423.      h = RandomInteger@{wh/2, wh};
424.      Quiet[blocks[[#1 + i, #2 + j, h]] = matClouds] & @@@
425.       Position[cloud, b_ /; b != 0, {2}],
426.      {nClouds}
427.      ];
428.    ];
429.
430.
431. initMaterials[];
432. initIcons[];
433. initBlocks[];
434. createTerrain[prmTERRAINBLOCKSN];
435. createClouds[prmCLOUDSN];
436. initFloor[];
437. initCubes[];
438. initCamera[];
439.
440. updateCubes[];
441.
442. scene = Graphics3D[{Dynamic@floor, EdgeForm@None, Dynamic@cucubes,
443.     Dynamic@selection},
444.    ViewVector -> Dynamic@{pos, pos + viewDir},
445.    ViewRange -> prmVIEWRANGE,
446.    PlotRange -> All,
447.    Lighting -> "Neutral",
448.    Boxed -> False,
449.    BoxRatios -> Automatic,
450.    ImageSize ->
451.     Dynamic@AbsoluteCurrentValue[EvaluationNotebook[], WindowSize],
452.    ViewAngle -> prmVIEWANGLE,
453.    Background -> prmSKYCOLOR,
455.    Epilog -> {crosshair, Inset[Dynamic@paletteGfx, Scaled@{.5, .05}]}
456.    ];
457.
458. crosshair = {White, AbsoluteThickness@2,
459.    Line[{Scaled@{.49, .5}, Scaled@{.51, .5}}],
460.    Line[{Scaled@{.5, .49}, Scaled@{.5, .51}}]
461.    };
462.
463. CreateDocument[
464.   EventHandler[
465.    setMouse@Style[scene, Selectable -> False, Editable -> False],
466.    actions
467.    ],
468.   CellMargins -> 0,
469.   ShowCellBracket -> False,
470.   ShowCellLabel -> False,
471.   "TrackCellChangeTimes" -> False,
472.   WindowElements -> {},
473.   WindowFrame -> "Normal",
474.   WindowSize -> Full,
476.   "CellInsertionPointCell" -> {},
477.   WindowMargins -> Automatic,
478.   WindowTitle -> "Mathematicraft",
479.   Background -> Black,
480.   Editable -> False,
481.   NotebookEventActions -> actions,
482.   TextAlignment -> Center,
483.   Deployed -> True,
484.   RenderingOptions -> {"Graphics3DRenderingEngine" ->
485.      prmRENDERINGENGINE}
486.   ];
487.
488. blocksCount[]
489. facesCount[]
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.
Not a member of Pastebin yet?