faleichik

Mathematica Minecraft

Feb 19th, 2013
1,218
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},
  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[]
RAW Paste Data