Message Boards Message Boards

Taking chess to 2.5 dimensions

Posted 1 year ago

In a previous thread we found that it is not too difficult, but also not very easy to Classify parts of 2D SNES maps in terms of their heights. What's much easier is to simply make our own voxelized height map, and use such a geometry as the scene of game involving voxel chess pieces. The purpose of this memo is to build on Keying's initial game design study by showing how to automate camera and character control by key pressing.

First we need to import pieces:

ToCubes[verts_, cols_] := With[
  {colRep = Rule[#[[1]], RGBColor[#[[2 ;; 4]]/255]] & /@ cols},
  {#[[4]] /. colRep, 
     Cuboid[(#[[1 ;; 3]] + {4, 4, 0})/8, (#[[1 ;; 3]] + {5, 5, 1})/
       8]} & /@ verts]

ImportVox[file_] := With[
  {lines = StringSplit[Import[file], "\n"]}, Function[{markers},
    ToCubes[Map[ToExpression, DeleteCases[
       StringSplit[lines[[markers[[2]] + 1 ;; markers[[3]] - 1]], 
        " "], "", Infinity], {2}],
     Map[ToExpression, 
      DeleteCases[StringSplit[lines[[markers[[4]] + 1 ;; -1]],
        " "], "", Infinity], {2}]]][
   Flatten[Position[lines, "---------------------"]]]]

AbsoluteTiming[
 primitives =  MapApply[RegionUnion, Map[Last, SortBy[GatherBy[ImportVox[
"https://raw.githubusercontent.com/bradklee/OpenAssets/main/WorldChess/TXT/Y" <> # <> "Vox.txt"
          ], First], Length], {2}]] & /@ {"Pawn", "Rook", "Knight", "Bishop", "Queen", "King"};]

Graphics3D/@primitives

chess pieces

(perhaps we should just make a WFR for these?)

Next we generate the setting:

HeightRules[mazeData_] := Module[{
   g1 = NearestNeighborGraph[Position[mazeData, 5]],
   wallComponents = WeaklyConnectedComponents[
     NearestNeighborGraph[Position[mazeData, 0],
      {4, 1}]], heightRulesLow, heightRulesHigh},
  heightRulesLow = Map[Function[{vertex},
     vertex -> Plus[1, Floor[Min[Catenate[Outer[
             GraphDistance[g1, {#1, #2}, vertex] &,
             MinMax[VertexList[g1]],
             MinMax[VertexList[g1]]]]]/6]/2]  ],
    VertexList[g1]];
  heightRulesHigh = MapThread[Rule, {Catenate[wallComponents],
     Map[# + 1/2 &, Catenate[Table[First[First[
            SortBy[Tally[DeleteCases[ReplaceAll[
                Union[Catenate[Outer[Plus, #,
                   CirclePoints[{1, 0}, 4], 1]]],
                heightRulesLow], _List]], Last]]],
          Length[#]] & /@ wallComponents]]}];
  {heightRulesLow, heightRulesHigh}
  ]

With[{heightRules = CompoundExpression[SeedRandom[21234312],
    HeightRules[ResourceFunction["RandomSierpinskiMaze"][2][[1, 1]]]
    ]},
 voxelSet = Graphics3D[Transpose[{{Lighter@Gray, Gray},
     Map[Cuboid[# {1, 1, 0}, # + {1, 1, 0}] &,
        MapApply[Append, #]] & /@ heightRules}],
   ViewPoint -> {Infinity, -Infinity, Infinity},
   ViewVertical -> {0, 0, 1},
   Boxed -> False];
 moveGraph = With[{g1 = NearestNeighborGraph[
      MapApply[Append, Catenate[heightRules]],
      {4, Sqrt[2]*.9}]}, Graph3D[g1,
    VertexCoordinates -> Map[# -> (# + {1/2, 1/2, 1/4}) &,
      VertexList[g1]],
    VertexStyle -> Black, EdgeStyle -> Black]];
 ]

(This could really be any height map you want, even one ripped from a console game).

Finally, we introduce a few functions for moving pieces around, and plot the whole thing using a DynamicModule with EventHandler for key logging:

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]]]}
  ]

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

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}]],
  allpos = If[False, {
     {3, 3, 1}, {4, 3, 1}, {5, 3, 1}, {6, 3, 1},
     {3, 2, 1}, {4, 2, 1}, {5, 2, 1}, {6, 2, 1},
     {29, 3, 1}, {29, 4, 1}, {29, 5, 1}, {29, 6, 1},
     {30, 3, 1}, {30, 4, 1}, {30, 5, 1}, {30, 6, 1},
     {3, 29, 1}, {4, 29, 1}, {5, 29, 1}, {6, 29, 1},
     {3, 30, 1}, {4, 30, 1}, {5, 30, 1}, {6, 30, 1},
     {29, 29, 1}, {28, 29, 1}, {27, 29, 1}, {26, 29, 1},
     {29, 30, 1}, {28, 30, 1}, {27, 30, 1}, {26, 30, 1}
     }, RandomSample[VertexList[moveGraph], 32]],
  allface = Join[
    ConstantArray[2, 8],
    ConstantArray[1, 8],
    ConstantArray[4, 16]
    ],
  allind = {
    1, 1, 1, 1, 2, 3, 4, 5,
    1, 1, 1, 1, 6, 4, 3, 2,
    1, 1, 1, 1, 2, 3, 4, 5,
    1, 1, 1, 1, 2, 3, 4, 6
    },
  allcolor = Join[
    ConstantArray[1, 16],
    ConstantArray[2, 16]
    ],
  who = 1,
  top = False,
  graph = False,
  pos, face, obstructedMoveGraph,
  dir = 0},
 pos = allpos[[who]];
 face = allface[[who]];
 obstructedMoveGraph = 
  VertexDelete[moveGraph, 
   Alternatives @@ Complement[allpos, {allpos[[who]]}]];
 EventHandler[Dynamic@Show[
    voxelSet,
    If[graph, obstructedMoveGraph, Graphics3D[{}]],
    PlacePiece[primitives][allind[[who]], -(allface[[who]] + 1) *Pi/2,
      allpos[[who]],
     Association[{
        1 -> {Red, Lighter[Orange, .5]}, 
        2 -> Lighter@{Red, Lighter[Yellow, .5]}}][allcolor[[who]]]
     ],
    MapThread[
     PlacePiece[primitives][#1, -(#2 + 1) *Pi/2, #3, Association[{
          1 -> {Yellow, Orange}, 2 -> {Orange, Yellow}}][#4]] &,
     {allind, allface, allpos, allcolor}[[All, 
       Complement[Range[32], {who}]]]
     ],
    ViewPoint -> If[top, {0, 0, Infinity}, views[[dir + 1]]],
    ViewVertical -> If[top, verticals[[dir + 1]], {0, 0, 1}],
    PlotRange -> {{0, 33}, {0, 33}, {0, 10}},
    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]]])
   }]]

frame 1

The controls are as follows. Press "q" (or reverse "w") rotates camera:

frame 2

Press "t" to toggle top down view:

frame 3

(notice pieces can be uniquely id'ed from top down view)

press "g" to toggle states adjacency graph:

frame 4

press "t" to toggle back to isomorphic view:

frame 5

Arrow keys move the current selected piece, shown in lighter colors with red accents, and "c" and "x" cycle the piece selector through 32 alternatives. Here's a good initial condition:

initial condition

Of course, this needs more automation, more flexible movement rules, menus, etc. etc. but I think it's already somewhat playable as is.

POSTED BY: Brad Klee
5 Replies

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]]}

compare frames

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:

alt view

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?

POSTED BY: Brad Klee

Hey Brad,

This is a very interesting project. However, when I ran your first code (the one intended to generate the 3D models of the chess pieces), I got this message along with the pieces:

{10.5059, Null}

Then, when I ran your second and last demonstrated code, Wolfram, for many minutes, was giving me a "(Running...)" message. I left the program running overnight, and when I checked on it the following morning, it was still giving me this "running" message. Any idea what might be going on here? (I am using v13, Student Edition)

Thanks,

Eleazar

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):

scott's pentomino

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}]]

chessboard height map

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

POSTED BY: Brad Klee

Thanks, Brad, it's working now! As for your question asking if anyone can come up with anything interesting for your new project, I'm still a student learning even just the mere basics of the WL so I'll just follow this post and see what the other, cleverer than I people come up with. :)

Best regards,

Eleazar

enter image description here -- you have earned Featured Contributor Badge enter image description here 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!

POSTED BY: Moderation Team
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract