libraryextensions/scene/demos/Rubik.xtl
Rubik.xtl -- a Rubik's cube as arrays, for the voxel cube demos (voxels-rubik and after). The cube is its 54 stickers; each sticker is where it is -- its cubie's position x y z, each -1 0 or 1 -- and which way it faces, a unit normal. A turn rotates the stickers of one layer by a quarter turn; matching the rotated stickers against the stickers gives where each one goes, a permutation of 54, and turning the cube is selecting its colors by that permutation. Every position reached by turns is a real cube's. Import: "rb:" u_se< "Rubik"
Stickers
normals : Int
normals ← 6 3 r̲eshape 0 1 0 0 -1 0 1 0 0 -1 0 0 0 0 1 0 0 -1
cubies : Int
cubies ← 2 1 t̲ranspose 3 27 r̲eshape ((q d̲iv 9) − 1) c̲at (((q d̲iv 3) m̲od 3) − 1) c̲at (q m̲od 3) − 1
ʰm̲akeStickers : Any a => a -> Int
h:m_akeStickers 0: the stickers, face by face: the cubies whose coordinate along the face's normal is the normal's sign
ʰm̲akeStickers ← { z → pick ← cubies '+ '× i̲nner 2 1 t̲ranspose normals on ← pick = 1 rows ← '{ (⍵ s̲elect₂ on) r̲eplicate cubies } m̲ap r̲ange 6 ns ← '{ 9 3 r̲eshape ⍵ s̲elect normals } m̲ap r̲ange 6 pos ← d̲isclose '{ e̲nclose (d̲isclose ⍺) c̲at d̲isclose ⍵ } r̲/ rows nrm ← d̲isclose '{ e̲nclose (d̲isclose ⍺) c̲at d̲isclose ⍵ } r̲/ ns pos c̲at₂ nrm }
ˡstickers : Int
a sticker for each face and each of its 9 cubies, 54 by 6: x y z of the cubie, then the normal; the faces in the order up down right left front back, 9 stickers each
ʳᵇ⁼u̲se< "Rubik"
s̲hape ʳᵇstickers 54 6
ˡstickers ← ʰm̲akeStickers 0
ˡsolved : Int
the solved cube's colors: each sticker its face's number, 0 to 5 (up down right left front back)
ʳᵇ⁼u̲se< "Rubik"
10 t̲ake ʳᵇsolved 0 0 0 0 0 0 0 0 0 1
ˡsolved ← 9 r̲eplicate (r̲ange 6) − 1
Turns
ʰk̲ey : Num a => a -> a
h:k_ey m: one number for each sticker row (x y z nx ny nz), the same for the same place and facing
ʰk̲ey ← { m → (3 3 3 3 3 3 d̲ecode 2 1 t̲ranspose m + 1) }
ʰr̲otate : (Num a, Num b) => a -> b -> b
k h:r_otate m: the rows (x y z, and the normal) turned a quarter turn counterclockwise about the axis k (1 x, 2 y, 3 z), seen from its positive end -- x y z goes to x -z y about x, z y -x about y, -y x z about z
ʰr̲otate ← { k m → x ← 1 s̲elect₂ m y ← 2 s̲elect₂ m z ← 3 s̲elect₂ m a ← 4 s̲elect₂ m b ← 5 s̲elect₂ m c ← 6 s̲elect₂ m k = 1 ? 2 1 t̲ranspose 6 54 r̲eshape x c̲at (0 − z) c̲at y c̲at a c̲at (0 − c) c̲at b k = 2 ? 2 1 t̲ranspose 6 54 r̲eshape z c̲at y c̲at (0 − x) c̲at c c̲at b c̲at 0 − a 2 1 t̲ranspose 6 54 r̲eshape (0 − y) c̲at x c̲at z c̲at (0 − b) c̲at a c̲at c }
ˡp̲ermutation : Any a => Int -> a -> Int
(axis layer quarters) rb:p_ermutation 0: the permutation of the 54 stickers for turning the layer (the cubies whose coordinate on the axis is the layer, -1 or 1) by that many counterclockwise quarter turns about the axis: the colors after the turn are this selection of the colors before
ˡp̲ermutation ← { t z → k ← 1 s̲elect t v ← 2 s̲elect t n ← 3 s̲elect t m ← ˡstickers turned ← n '{ k ʰr̲otate ⍵ } p̲ower m inlayer ← v = k s̲elect₂ m moved ← (2 1 t̲ranspose 6 54 r̲eshape inlayer) + 0 after ← (moved × turned) + (1 − moved) × m g̲rade (ʰk̲ey m) i̲ndexOf ʰk̲ey after }
ˡnames : Char
the twelve turns' names: a face turned clockwise as you look at it, and with ' counterclockwise
ˡnames ← "U U' D D' R R' L L' F F' B B'"
specs : Int
specs ← 12 3 r̲eshape 2 1 3 2 1 1 2 -1 1 2 -1 3 1 1 3 1 1 1 1 -1 1 1 -1 3 3 1 3 3 1 1 3 -1 1 3 -1 3
ˡmoves : Int
the twelve turns' permutations, 12 by 54, in the order of rb:names
ˡmoves ← 12 54 r̲eshape r̲avel d̲isclose '{ e̲nclose (d̲isclose ⍺) c̲at d̲isclose ⍵ } r̲/ '{ (⍵ s̲elect specs) ˡp̲ermutation 0 } m̲ap r̲ange 12
ˡt̲urn : Int -> a -> a
i rb:t_urn c: the colors c after turn i (1 to 12, in the order of rb:names)
ʳᵇ⁼u̲se< "Rubik"
(4 '{ 1 ʳᵇt̲urn ⍵ } p̲ower ʳᵇsolved) m̲atch ʳᵇsolved 1
ˡt̲urn ← { i c → (i s̲elect ˡmoves) s̲elect c }
Drawing
ʰs̲quaresAt : Float -> Int -> Float
(offset half) h:s_quaresAt rows: a square for each row (x y z of a cubie, then a normal), its center offset along the normal, its half side half, its 4 corners in order round it; 4n by 3, row by row
ʰs̲quaresAt ← { oh pn → p ← f̲loat 1 2 3 s̲elect₂ pn n ← f̲loat 4 5 6 s̲elect₂ pn ax ← (a̲bs 4 s̲elect₂ pn) + (2 × a̲bs 5 s̲elect₂ pn) + 3 × a̲bs 6 s̲elect₂ pn u ← ax s̲elect 3 3 r̲eshape 0.0 1.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 w ← ax s̲elect 3 3 r̲eshape 0.0 0.0 1.0 0.0 0.0 1.0 0.0 1.0 0.0 c ← p + (1 s̲elect oh) × n h ← 2 s̲elect oh k1 ← c + h × (0.0 − u) − w k2 ← c + h × u − w k3 ← c + h × u + w k4 ← c + h × w − u m ← t̲ally pn ((4 × m) c̲at 3) r̲eshape 2 1 3 t̲ranspose (4 c̲at m c̲at 3) r̲eshape k1 c̲at k2 c̲at k3 c̲at k4 }
ˡsquares : Float
the stickers as squares for scene, 4 corners each in order round them (216 by 3), in the stickers' order, just outside the cubies' dark bodies
ˡsquares ← 0.485 0.42 ʰs̲quaresAt ˡstickers
bodyrows : Int
bodyrows ← d̲isclose '{ e̲nclose (d̲isclose ⍺) c̲at d̲isclose ⍵ } r̲/ '{ shell c̲at₂ 26 3 r̲eshape ⍵ s̲elect normals } m̲ap r̲ange 6
ˡbodies : Float
the cubies' dark bodies as squares for scene (624 by 3): six faces each, 0.96 wide
ˡbodies ← 0.48 0.48 ʰs̲quaresAt bodyrows
ˡc̲olorSquares : Eq a => a -> a -> Float
k rb:c_olorSquares c: the squares of the stickers that are color k in the colors c (k 0 to 5), for one object of quads
ʳᵇ⁼u̲se< "Rubik"
s̲hape 0 ʳᵇc̲olorSquares ʳᵇsolved 36 3
ˡc̲olorSquares ← { k c → i ← w̲here c = k (r̲avel (4 × i − 1) '+ t̲able 1 2 3 4) s̲elect ˡsquares }