programextensions/scene/demos/voxels-rubik-solve.xtl
Voxels, 13: the Rubik's cube solved. Scramble it, or turn it with the six buttons, then Solve: the cube's turns so far are handed to the Eigencube library (X_eTaL-libraries, at LIBRARIES_COMMIT), which holds the cube as 26 rotation matrices and solves it by search, stage by stage -- the first layer by plain search over the twelve turns, the middle and last layers over known move sequences (slot inserts, an edge flip, Sune, a corner cycle), which is what makes it fast enough (2 to 3 seconds; a hundred and some moves). Then Step through the solution a turn at a time, Back to undo one, or Play it through, every turn animated on the voxel cube. The two models are checked to agree (tests/rubik-eigencube.xtl). Run: just demo scene voxels-rubik-solve the buttons, or keys: u r f turn (Shift for '), Space scramble, Enter solve, n step, b back, p play or pause, 0 solved again, drag to look around, q quit
k : Int
k ← w ˢᶜc̲amera! 0.6 0.45 7.5 0.25
The two models
map : Int
Rubik's turns (1 to 12: U U' D D' R R' L L' F F' B B') as Eigencube's (U U' D D' F F' B B' R R' L L'), and back: the same vector
map ← 1 2 3 4 9 10 11 12 5 6 7 8
Used in: ᵘs̲olution
The buttons
names : Char
the turns: six buttons, their turns, the keys that press them
names ← "U U' R R' F F'"
Used in: ᵘb̲uttons
controls : Char
the controls: a second row, wider buttons
controls ← "Scramble Solve Back Step Play"
Used in: ᵘb̲uttons
ᵘb̲uttons : Int -> Int
ᵘb̲uttons ← { i → a ← (w, names, top, 640.0, 100, ʳᵖbw) ʳᵖd̲rawRow turns i̲ndexOf a̲bs i b ← (w, controls, top2, 640.0, 200, cw) ʳᵖd̲rawRow 0 o ← w ˢᶜo̲verlay! a c̲at b i }
ᵘt̲ell : Char -> Char
ᵘt̲ell ← { m → said ← ((f̲loat w) c̲at 3.0 20.0 44.0 14.0 0.6 1.0 0.6) ˢᶜl̲abel! m m }
Playing
ᵘs̲ay : (Any a, Any b, Any c, Any d, Any e) => (a, Int, b, c, d) -> e -> (a, Int, b, c, d)
ᵘs̲ay ← { st z → (_, h, _, _, _) ← st said ← ((f̲loat w) c̲at 2.0 100.0 20.0 14.0 1.0 1.0 0.6) ˢᶜl̲abel! ʳᵖn̲ames (0 − 12 m̲in t̲ally h) t̲ake h st }
ᵘs̲crambled : Num a => a -> Int
u:s_crambled n: n random turns, never the same face twice in a row
ᵘs̲crambled ← { n → (_, ts) ← (n, 0 r̲eshape 0) ᵘm̲ore 0 ts }
Used in: ᵘs̲cramble
ᵘm̲ore : (Num a, Num b) => (a, Int) -> b -> (a, Int)
ᵘm̲ore ← { (n, ts) z → n = 0 ? (n, ts) t ← r̲oll! 12 prev ← f̲irst -1 t̲ake 0 c̲at ts ((t + 1) d̲iv 2) = (prev + 1) d̲iv 2 ? (n, ts) ᵘm̲ore 0 (n − 1, ts c̲at t) ᵘm̲ore 0 }
Used in: ᵘs̲crambled, ᵘm̲ore
ᵘs̲olution : (Any a, Any b, Any c, Any d) => (a, Int, b, c, d) -> Int
u:s_olution st: the turns that solve the cube made so far (Rubik's numbers), found by Eigencube from the same turns
ᵘs̲olution ← { st → (_, h, _, _, _) ← st (m, _, _) ← 1 ᵉᶜs̲olve (h s̲elect map) ᵉᶜd̲o ᵉᶜsolved m s̲elect map }
Used in: ᵘs̲olveNow
ᵘp̲ressed : Char -> Int
ᵘp̲ressed ← { v → b ← (v, 6, top, 640.0, ʳᵖbw) ʳᵖh̲it 0 b > 0 ? b s̲elect turns c ← (v, 5, top2, 640.0, cw) ʳᵖh̲it 0 c > 0 ? 0 − c i ← keys i̲ndexOf f̲irst -1 t̲ake v ((5 = t̲ally v) × i ≤ 6) ? i s̲elect turns ks ← (v m̲atch "key Space") c̲at (v m̲atch "key Enter") c̲at (v m̲atch "key b") c̲at (v m̲atch "key n") c̲at v m̲atch "key p" 0 < '+ r̲/ ks ? 0 − f̲irst w̲here ks 0 }
Used in: ᵘf̲rame
ᵘt̲urnBy : (Any b, Any c, Any d, Any e, Any f, Any g, Any h, Any i, Num j, Num k, Num l) => a -> ((b, c, a, d, e), f, g, h, i) -> ((b, c, a, d, e), j, k, l, i)
ᵘt̲urnBy ← { t (st, sol, pos, mode, on) → z ← ᵘt̲ell " " (t ʳᵖq̲ueue st, 0 r̲eshape 0, 0, 0, on) }
Used in: ᵘa̲ct
ᵘc̲ontrol : (Num a, Num b, Any c, Num d, Any e) => a -> ((Int, Int, Int, b, c), Int, Int, d, e) -> ((Int, Int, Int, b, c), Int, Int, d, e)
ᵘc̲ontrol ← { k all → (st, sol, pos, mode, on) ← all 0 = ʳᵖi̲dle st ? all k = 1 ? ᵘs̲cramble all k = 2 ? ᵘs̲olveSoon all k = 3 ? ᵘb̲ack all k = 4 ? ᵘs̲tep all ᵘp̲lay all }
Used in: ᵘa̲ct
ᵘs̲cramble : (Num a, Any b, Num c, Any d) => ((Int, Int, Int, a, b), Int, Int, c, d) -> ((Int, Int, Int, a, b), Int, Int, c, d)
ᵘs̲cramble ← { (st, sol, pos, mode, on) → z ← ᵘt̲ell "Scrambled: 20 turns" ((ᵘs̲crambled 20) ʳᵖq̲ueue st, 0 r̲eshape 0, 0, 0, on) }
Used in: ᵘc̲ontrol
ᵘs̲olveSoon : (Num a, Any b, Num c, Any d) => ((Int, Int, Int, a, b), Int, Int, c, d) -> ((Int, Int, Int, a, b), Int, Int, c, d)
ᵘs̲olveSoon ← { (st, sol, pos, mode, on) → (c, _, _, _, _) ← st c m̲atch ʳᵇsolved ? (st, sol, pos, mode, on) ᵘs̲ayIt "Already solved" z ← ᵘt̲ell "Solving..." (st, sol, pos, 2, on) }
Used in: ᵘc̲ontrol
ᵘs̲ayIt : (Num a, Any b, Num c, Any d) => ((Int, Int, Int, a, b), Int, Int, c, d) -> Char -> ((Int, Int, Int, a, b), Int, Int, c, d)
ᵘs̲ayIt ← { all m → z ← ᵘt̲ell m all }
Used in: ᵘs̲olveSoon, ᵘp̲layOn
ᵘb̲ack : (Num a, Any b, Num c, Any d) => ((Int, Int, Int, a, b), Int, Int, c, d) -> ((Int, Int, Int, a, b), Int, Int, c, d)
ᵘb̲ack ← { (st, sol, pos, mode, on) → pos = 0 ? (st, sol, pos, mode, on) z ← ᵘt̲ell "Solution: " c̲at (f̲ormat pos − 1) c̲at " of " c̲at (f̲ormat t̲ally sol) c̲at " made" (ʳᵖu̲ndo st, sol, pos − 1, 0, on) }
Used in: ᵘc̲ontrol
ᵘs̲tep : (Num a, Any b, Num c, Any d) => ((Int, Int, Int, a, b), Int, Int, c, d) -> ((Int, Int, Int, a, b), Int, Int, c, d)
ᵘs̲tep ← { (st, sol, pos, mode, on) → pos ≥ t̲ally sol ? (st, sol, pos, 0, on) z ← ᵘt̲ell "Solution: " c̲at (f̲ormat pos + 1) c̲at " of " c̲at (f̲ormat t̲ally sol) c̲at " made" (((pos + 1) s̲elect sol) ʳᵖq̲ueue st, sol, pos + 1, mode, on) }
ᵘp̲lay : (Num a, Any b, Num c, Any d) => ((Int, Int, Int, a, b), Int, Int, c, d) -> ((Int, Int, Int, a, b), Int, Int, c, d)
ᵘp̲lay ← { (st, sol, pos, mode, on) → pos ≥ t̲ally sol ? (st, sol, pos, 0, on) (st, sol, pos, 1 − mode, on) }
Used in: ᵘc̲ontrol
ᵘs̲olveNow : (Any a, Any b, Any c, Any d, Any e, Any f, Any g, Any h, Num i, Num j) => ((a, Int, b, c, d), e, f, g, h) -> ((a, Int, b, c, d), Int, i, j, h)
ᵘs̲olveNow ← { (st, sol, pos, mode, on) → sol ← ᵘs̲olution st (_, h, _, _, _) ← st said ← p̲rint! "solved by " c̲at (f̲ormat t̲ally sol) c̲at " turns; the cube solved by them: " c̲at f̲ormat (ʳᵖa̲pplied h c̲at sol) m̲atch ʳᵇsolved z ← ᵘt̲ell "Solution: " c̲at (f̲ormat t̲ally sol) c̲at " turns -- Step or Play" (st, sol, 0, 0, on) }
Used in: ᵘs̲olveIf
ᵘp̲layOn : (Num a, Any b, Num c, Any d) => ((Int, Int, Int, a, b), Int, Int, c, d) -> ((Int, Int, Int, a, b), Int, Int, c, d)
ᵘp̲layOn ← { all → (st, sol, pos, mode, on) ← all 0 = (mode = 1) × ʳᵖi̲dle st ? all pos ≥ t̲ally sol ? (st, sol, pos, 0, on) ᵘs̲ayIt "Solved in " c̲at (f̲ormat t̲ally sol) c̲at " turns" ᵘs̲tep all }
Used in: ᵘf̲rame
ᵘr̲eset : (Any a, Any b, Any c, Any d, Any e, Num f, Num g, Num h) => (a, b, c, d, e) -> ((Int, Int, Int, Int, Int), f, g, h, e)
ᵘr̲eset ← { (st, sol, pos, mode, on) → d ← (ʳᵇsolved, 0, 0.0) ʳᵇd̲raw w z ← ᵘt̲ell " " (ʳᵖstart ᵘs̲ay 0, 0 r̲eshape 0, 0, 0, on) }
Used in: ᵘf̲rame
ᵘm̲ade : (Any a, Any c, Any d, Any e) => (a, b, c, d, e) -> Int
ᵘm̲ade ← { (_, h, _, _, _) → t̲ally h }
Used in: ᵘf̲rame
ᵘu̲nder : (Any a, Any b, Any c, Any d, Any e) => (a, b, c, d, e) -> d
ᵘu̲nder ← { (_, _, _, i, _) → i }
Used in: ᵘf̲rame
ᵘs̲ayIf : (Truthy a, Any b, Any c, Any d, Any e) => a -> (b, Int, c, d, e) -> (b, Int, c, d, e)
ᵘs̲ayIf ← { yes st → yes ? st ᵘs̲ay 0 st }
Used in: ᵘf̲rame
ᵘf̲rame : (Num a, Num b) => ((Int, Int, Int, Int, Int), Int, Int, a, b) -> ((Int, Int, Int, Int, Int), Int, Int, a, b)
one frame: an event (a turn, a control, solved again, quit), the solve if it is due, playing, then a frame of turning: 4 frames a quarter turn while more wait, 5 while playing, else 8
ᵘf̲rame ← { all → (st, sol, pos, mode, on) ← all 0 = on ? all v ← ˢᶜn̲ext! w ((v m̲atch "close") + v m̲atch "key q") > 0 ? (st, sol, pos, mode, 0) (v m̲atch "key 0") ? ᵘr̲eset all all ← (mode = 2) ᵘs̲olveIf all p ← ᵘp̲ressed v all ← (p, all) ᵘa̲ct 0 all ← ᵘp̲layOn all (st, sol, pos, mode, on) ← all (_, _, q, _, _) ← st fr ← ((mode = 1) × 5) + (mode ≠ 1) × 8 − 4 × 0 < t̲ally q n ← ᵘm̲ade st was ← ᵘu̲nder st st ← (w, fr) ʳᵖa̲dvance st lit ← (was ≠ ᵘu̲nder st) ᵘl̲ightIf ᵘu̲nder st ((n ≠ ᵘm̲ade st) ᵘs̲ayIf st, sol, pos, mode, on) }
Used in: last
ᵘs̲olveIf : (Truthy a, Num b, Num c) => a -> ((Int, Int, Int, Int, Int), Int, Int, b, c) -> ((Int, Int, Int, Int, Int), Int, Int, b, c)
ᵘs̲olveIf ← { yes all → yes ? ᵘs̲olveNow all all }
Used in: ᵘf̲rame
ᵘa̲ct : (Num a, Num b, Num c) => (Int, ((Int, Int, Int, Int, Int), Int, Int, a, b)) -> c -> ((Int, Int, Int, Int, Int), Int, Int, a, b)
ᵘa̲ct ← { (p, all) z → p > 0 ? p ᵘt̲urnBy all p < 0 ? (0 − p) ᵘc̲ontrol all all }
Used in: ᵘf̲rame
ᵘl̲ightIf : Truthy a => a -> Int -> Int
ᵘl̲ightIf ← { yes i → yes ? ᵘb̲uttons i i }
Used in: ᵘf̲rame
last : ((Int, Int, Int, Int, Int), Int, Int, Int, Int)
last ← 100000 'ᵘf̲rame p̲ower (ʳᵖstart, 0 r̲eshape 0, 0, 0, 1)
ᵘc̲olorsOf : (Any a, Any b, Any c, Any d, Any e, Any f, Any g, Any h, Any i) => ((a, b, c, d, e), f, g, h, i) -> a
ᵘc̲olorsOf ← { ((c, _, _, _, _), _, _, _, _) → c }
Used in: c
ᵘt̲urnsOf : (Any a, Any b, Any c, Any d, Any e, Any f, Any g, Any h, Any i) => ((a, b, c, d, e), f, g, h, i) -> b
ᵘt̲urnsOf ← { ((_, h, _, _, _), _, _, _, _) → h }
Used in: h
ᵘm̲adeOf : (Any a, Any b, Any c, Any d, Any e) => (a, b, c, d, e) -> c
ᵘm̲adeOf ← { (_, _, pos, _, _) → pos }
Used in: pos
c : Int
c ← ᵘc̲olorsOf last