In the release announcement for 13.2, Mathematica is now seen to have built in capabilities for depicting chess games... But only in two dimensions.

Meanwhile, ChessVoxels was released through WFR, so it's now easier than ever to depict chess scenes in voxelated 3D, how to follows.

First pre-compute the primitives:

AbsoluteTiming[
 $ChessBoard = Graphics3D[Table[{If[Mod[i + j, 2] == 1,
       Lighter[#, .6] &@Orange, Lighter[#, .6] &@Yellow],
      Cuboid[{i, j, -1/2}, {i + 1, j + 1, 0}]}, {i, 0, 7}, {j, 0,  7}],
    ViewPoint -> {Infinity, Infinity, Infinity},
    ViewVertical -> {0, 0, 1}, Boxed -> False, ImageSize -> 500];
 ]


AbsoluteTiming[
 $ChessVoxels = 
   Association[Map[# -> ResourceFunction["ChessVoxels"][#] &,
     ResourceFunction["ChessVoxels"][]]];
 ]

Next define functions for interpreting chess notation and placing pieces accordingly:

PlacePiece[primitives_][
  index_, angle_, pos_, col_ : {Yellow, Orange}
  ] := Graphics3D[{EdgeForm[None],
   Riffle[col,
    Translate[Rotate[
        #, angle, {0, 0, 1}, {1/2, 1/2, 0}
        ], pos] & /@ primitives[[index]]]}
  ]

ChessArray[fen_] := ReplaceAll[
  Characters /@ StringSplit[fen, " " | "/"][[1 ;; 8]],
  x_String :> Switch[x,
    _?DigitQ, Splice[ConstantArray[True,
      ToExpression@x]],
    "p", {"Pawn", 1},
    "r", {"Rook", 1},
    "n", {"Knight", 1},
    "b", {"Bishop", 1},
    "q", {"Queen", 1},
    "k", {"King", 1},
    "P", {"Pawn", 2},
    "R", {"Rook", 2},
    "N", {"Knight", 2},
    "B", {"Bishop", 2},
    "Q", {"Queen", 2},
    "K", {"King", 2},
    _, x]
   ]

ChessDepict3D[fen_, opt : OptionsPattern[Show]] := Show[
  $ChessBoard,
  MapIndexed[If[ListQ[#],
     PlacePiece[$ChessVoxels][First[#], Pi (Last[#] - 1),
      Append[(#2 - {1, 1}), 0],
      {{Orange, Yellow}, {Yellow, Orange}}[[Last[#]]]],
     Nothing] &,
   ChessArray[fen], {2}], opt,
  ViewPoint -> {Infinity, Infinity, Infinity},
  ViewVertical -> {0, 0, 1}]

The 3D views compute relatively fast:

AbsoluteTiming[frames2D = ImportString[#, "FEN"] & /@ gameFens;]
Out[] = 0.3 s

AbsoluteTiming[ frames3D = ChessDepict3D[#, ImageSize -> 300] & /@ gameFens;]
Out[] = 0.1 s

And here is one state depicted:

{frames3D[[23]], First@frames2D[[23]]}

And with dynamic event handling, it's also possible to step into the game and move pieces or change camera angle just by pressing keys (a more simple case what we were doing before):

ChessState[fen_, opt : OptionsPattern[Show]] :=
 Transpose[Catenate@MapIndexed[
    If[ListQ[#],
      {First[#], Append[(#2 - {1, 1}), 0],
       Pi (Last[#] - 1), Last[#]},
      Nothing] &,
    ChessArray[fen], {2}]]

MovePiece[moveGraph_][pos_, step_] := With[
  {next = SelectFirst[
     VertexOutComponent[moveGraph, pos, {1}],
     #[[1 ;; 2]] == Plus[pos, step][[1 ;; 2]] &, True]},
  If[TrueQ[next], pos, next]
  ]

$ChessColors = {
   {{Orange, Yellow}, {Yellow, Orange}},
   {{Red, Lighter[Orange, .5]},
    Lighter@{Red, Lighter[Yellow, .5]}}
   };

DynamicModule[{
  views = Catenate[Outer[
      {#1 Infinity, #2 Infinity, Infinity} &,
      {1, -1}, {1, -1}]][[{1, 2, 4, 3}]],
  verticals = Catenate[Outer[
      {If[#1, #2, 0], If[#1, 0, #2], 0} &,
      {True, False}, {-1, 1}]][[{3, 1, 4, 2}]],
  gameInProgress = ChessState[gameFens[[32]]],
  moveGraph = NearestNeighborGraph[
    Catenate[Table[{i, j, 0},
      {i, 0, 7}, {j, 0, 7}]]],
  allpos, allface, alltype, allcolor, len,
  who = 1, top = False, graph = False, pos,
  face, bgPieces, obstructedMoveGraph, dir = 0},
 alltype = gameInProgress[[1]];
 allpos = gameInProgress[[2]];
 allface = gameInProgress[[3]] 2/Pi;
 allcolor = gameInProgress[[4]];
 len = Length[allcolor];
 pos = allpos[[who]];
 face = allface[[who]];
 obstructedMoveGraph = VertexDelete[moveGraph,
   Alternatives @@ Complement[allpos, {allpos[[who]]}]];
 EventHandler[
  Dynamic@Show[$ChessBoard,
    (*If[graph,obstructedMoveGraph,Graphics3D[{}]],*)
    PlacePiece[$ChessVoxels][alltype[[who]], -(allface[[who]])*Pi/2,
     allpos[[who]], $ChessColors[[2, allcolor[[who]]]]],
    Show[MapThread[
      PlacePiece[$ChessVoxels][#1, -(#2)*Pi/2, #3,
        $ChessColors[[1, #4]]] &, {alltype, allface, allpos, allcolor
        }[[All, Complement[Range[len], {who}]]]]],
    ViewPoint -> If[top, {0, 0, Infinity}, views[[dir + 1]]],
    ViewVertical -> If[top, verticals[[dir + 1]], {0, 0, 1}],
    PlotRange -> {{0, 8}, {0, 8}, {-1/2, 5}},
    Boxed -> False, ImageSize -> {1200, UpTo[800]}],
  {
   {"KeyDown", "w"} :> (dir = Mod[dir - 1, 4]),
   {"KeyDown", "q"} :> (dir = Mod[dir + 1, 4]),
   {"KeyDown", "t"} :> (top = Not[top]),
   (*{"KeyDown","g"}:>(graph=Not[graph]),*)
   {"KeyDown", "c"} :> (who = Mod[who + 1, 32, 1];
     obstructedMoveGraph = VertexDelete[moveGraph,
       Alternatives @@ Complement[allpos, {allpos[[who]]}]]),
   {"KeyDown", "x"} :> (who = Mod[who - 1, 32, 1];
     obstructedMoveGraph = VertexDelete[moveGraph,
       Alternatives @@ Complement[allpos, {allpos[[who]]}]]),
   "UpArrowKeyDown" :> (allpos[[who]] = 
      MovePiece[obstructedMoveGraph][allpos[[who]], 
       verticals[[Mod[allface[[who]] = dir, 4] + 1]]]), 
   "RightArrowKeyDown" :> (allpos[[who]] = 
      MovePiece[obstructedMoveGraph][allpos[[who]], 
       verticals[[Mod[allface[[who]] = dir + 1, 4] + 1]]]), 
   "DownArrowKeyDown" :> (allpos[[who]] = 
      MovePiece[obstructedMoveGraph][allpos[[who]], 
       verticals[[Mod[allface[[who]] = dir + 2, 4] + 1]]]), 
   "LeftArrowKeyDown" :> (allpos[[who]] = 
      MovePiece[obstructedMoveGraph][allpos[[who]], 
       verticals[[Mod[allface[[who]] = dir + 3, 4] + 1]]])}]]

For example, pressing "w" gets us to the orange view point:

However, when trying to move the king around with arrow keys, we notice that the lag time is much more than we would expect from time statistics. If it only takes about one 1/1000 of a second to draw the scene from scratch, why can't the event handling work instantly at 60 fps?

Thanks, looks like you caught a typo. The hang is there because the maze data becomes too large to compute (it might be nice to add a message if not rethinking the computation). The code changed above works, but it only required changing one integer $5 \rightarrow 2$:

ResourceFunction["RandomSierpinskiMaze"][1][[1, 1]]

It takes me about 2 seconds to generate the map data. Would be nice if that was faster, but what really matters for game play is how fast moves can be made... It's somewhat laggy with fast button presses, and I'm not sure how to improve that.

I decided yes about sending the pieces to WFR (with one edit making the king slightly taller), so the 10 second load time should probably also improve.

While we're waiting on that... Here's an interesting idea I'd like to see more results about: Now that FindExactCover is at first stable version at WFR, it's easy to take a rectangular domain and tile it by an exact cover made of polyomino pieces. Can anyone creative think of an algorithm to go from a polyomino exact cover to a height map? Here's something simple to get started:

This solution (from neat examples):

Determines the following height map:

With[{exactCoverRes = {
    {3, 3, 2, 4, 4, 4, 4, 4},
    {3, 2, 2, 2, 5, 5, 5, 6},
    {3, 3, 2, 5, 5, 6, 6, 6},
    {7, 7, 8, 0, 0, 13, 13, 6},
    {7, 7, 8, 0, 0, 11, 13, 13},
    {9, 7, 8, 11, 11, 11, 12, 13},
    {9, 8, 8, 11, 10, 12, 12, 12},
    {9, 9, 9, 10, 10, 10, 10, 12}}},
 Graphics3D[Cuboid[# {1, 1, 0},
     Floor[(#/{1, 1, 2})]/{1, 1, 2} + {1, 1, 0}] & /@
   Catenate[MapIndexed[Append[#2, #1] &,
     exactCoverRes /. {0 -> 6}, {2}]], Boxed -> False,
  ViewPoint -> {-Infinity, -Infinity, Infinity},
  ViewVertical -> {0, 0, 1}]]

This looks like a decent map since it has wide-enough sub-grids, and it could be interesting to write a scenario around one player having to move up hill. However, it is just a one-directional gradient (similar to what original SNES maps were like).

If certain tiles are associated with set decorations, I think pseudo-random maps could be generated very quickly this way. If necessary, heuristics could be added for finding good results in the whole space of possibilities.

Let me know if you come up with anything interesting!

--Brad

-- you have earned Featured Contributor Badge Your exceptional post has been selected for our editorial column Staff Picks http://wolfr.am/StaffPicks and Your Profile is now distinguished by a Featured Contributor Badge and is displayed on the Featured Contributor Board. Thank you!