Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (*
- 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[]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement