Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

Mathematica Minecraft

By: faleichik on Feb 19th, 2013  |  syntax: None  |  size: 14.60 KB  |  views: 369  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  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},
  143.    If[! FileExistsQ[file], MessageDialog["File not found"]; Return[]];
  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.  
  163. loadDialog[] := CreateDialog[
  164.    Grid@{{Dynamic["Load from file: " <> filename],
  165.       FileNameSetter[Dynamic[filename], "Open", {"mmc" -> {"*"}}]},
  166.      {DefaultButton[loadGame[filename]; DialogReturn[]],
  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[],
  263.    "l", loadDialog[],
  264.    " ", addCurrentBlock[],
  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},
  307.       Heads -> False]]
  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.  
  348. addCurrentBlock[] :=
  349.   If[newBlockPos != blockPos@pos,
  350.    getSelection[];
  351.    addBlock@newBlockPos;
  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,
  454.    PlotRangePadding -> 0,
  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,
  475.   "BlinkingCellInsertionPoint" -> False,
  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[]