libraryextensions/scene/demos/RubikPlay.xtl
RubikPlay.xtl -- playing the voxel Rubik's cube (Rubik.xtl) with buttons and keys, shared by voxels-rubik-buttons and voxels-rubik-solve: a row of labeled buttons drawn over the scene and found under a click, and turns queued and animated one after another -- each a quarter turn of one layer seen as it happens, the next starting as soon as it is done, so a press always answers at once. Import: "rp:" u_se< "RubikPlay"
Buttons
ˡw̲ords : Char -> Box Char
rp:w_ords t: the words of a text, boxed (the names of the buttons)
ʳᵖ⁼u̲se< "RubikPlay"
t̲ally ʳᵖw̲ords "U U' R R'" 4
ˡw̲ords ← { t → (n̲ot t = f̲irst " ") p̲artition t }
ˡl̲efts : Any a => (Int, Float, Float) -> a -> Float
(n, wide, bw) rp:l_efts 0: the left edges of a row of n buttons, bw wide, centered across a window wide points wide
ʳᵖ⁼u̲se< "RubikPlay"
(2, 200.0, 64.0) ʳᵖl̲efts 0 31.0 105.0
ˡl̲efts ← { (n, wide, bw) z → m ← f̲loat n ((wide − (m × bw) + (m − 1.0) × ˡgap) ÷ 2.0) + (bw + ˡgap) × f̲loat (r̲ange n) − 1 }
ˡd̲rawRow : Num a => (a, Char, Float, Float, Int, Float) -> Int -> Float
(w, names, top, wide, first, bw) rp:d_rawRow lit: a row of buttons bw wide drawn over window w (wide points wide), their tops at top, labeled by the words of names, their labels' ids from first, button lit (1 to n; 0 none) lit up; the row's rectangles, n by 7, for the overlay (the caller puts all its rows at once)
ˡd̲rawRow ← { (w, names, top, wide, first, bw) lit → ws ← ˡw̲ords names n ← t̲ally ws ls ← (n, wide, bw) ˡl̲efts 0 on ← f̲loat lit = r̲ange n rects ← 2 1 t̲ranspose (7 c̲at n) r̲eshape ls c̲at (n r̲eshape top) c̲at (n r̲eshape bw) c̲at (n r̲eshape ˡbh) c̲at (0.22 + 0.2 × on) c̲at (0.24 + 0.3 × on) c̲at 0.3 + 0.5 × on put ← '{ (ʰl̲abelHead (w, first + ⍵, ⍵ s̲elect ls, top, bw, t̲ally d̲isclose ⍵ s̲elect ws)) ˢᶜl̲abel! d̲isclose ⍵ s̲elect ws } m̲ap r̲ange n rects }
ʰl̲abelHead : Num a => (a, Int, Float, Float, Float, Int) -> Float
ʰl̲abelHead ← { (w, id, left, top, bw, chars) → wide ← 2.0 × f̲loat (6 × chars) − 1 (f̲loat w) c̲at (f̲loat id) c̲at (left + (bw − wide) ÷ 2.0) c̲at (top + (ˡbh − 14.0) ÷ 2.0) c̲at 14.0 1.0 1.0 1.0 }
ˡh̲it : Any a => (Char, Int, Float, Float, Float) -> a -> Int
(v, n, top, wide, bw) rp:h_it 0: which of a row of n buttons (1 to n), bw wide, a left click v ("click left X Y") is on, else 0
ʳᵖ⁼u̲se< "RubikPlay"
("click left 200 520", 6, 500.0, 640.0, 64.0) ʳᵖh̲it 0 2
ˡh̲it ← { (v, n, top, wide, bw) z → 0 = (10 t̲ake v) m̲atch "click left" ? 0 p ← n̲umbers 11 d̲rop v x ← 1 s̲elect p y ← 2 s̲elect p ls ← (n, wide, bw) ˡl̲efts 0 on ← (x ≥ ls) × (x < ls + bw) × (y ≥ top) × y < top + ˡbh 0 = '+ r̲/ on ? 0 f̲irst w̲here on }
Turning, queued
ˡstart : (Int, Int, Int, Int, Int)
the state of a solved cube, nothing turning
ˡstart ← (ʳᵇsolved, 0 r̲eshape 0, 0 r̲eshape 0, 0, 0)
ˡq̲ueue : (Any b, Any c, Any d, Any e) => a -> (b, c, a, d, e) -> (b, c, a, d, e)
t rp:q_ueue st: turns t (1 to 12) waiting after the others
ˡq̲ueue ← { t (c, h, q, i, f) → (c, h, q c̲at t, i, f) }
ˡa̲dvance : Num a => (a, a) -> (Int, Int, Int, Int, a) -> (Int, Int, Int, Int, a)
(w, frames) rp:a_dvance st: one frame of turning in window w: the turn under way a frame further (frames to a quarter turn), or, done, the colors turned and the turn remembered; with none under way the next waiting one starts. A waiting turn queued negative (-t) is made (turn t) but not remembered: an undo, whose turn has already left the history.
ˡa̲dvance ← { wf st → (c, h, q, i, f) ← st (w, frames) ← wf (i = 0) × 0 = t̲ally q ? st i = 0 ? (c, h, 1 d̲rop q, f̲irst q, 0) f ← f + 1 f < frames ? (c, h, q, i, f) ʰs̲how w c̲at frames c ← (a̲bs i) ʳᵇt̲urn c z ← (c, 0, 0.0) ʳᵇd̲raw w (c, h c̲at (i > 0) r̲eplicate i, q, 0, 0) }
ʰs̲how : Num a => (Int, Int, Int, Int, a) -> a -> (Int, Int, Int, Int, a)
ʰs̲how ← { st wfr → (c, h, q, i, f) ← st z ← (c, a̲bs i, (f̲loat f) ÷ f̲loat 2 s̲elect wfr) ʳᵇd̲raw 1 s̲elect wfr st }
ˡu̲ndo : (Any a, Num b, Any c) => (a, Int, Int, b, c) -> (a, Int, Int, b, c)
rp:u_ndo st: the last turn made taken from the history and its undoing queued (made, not remembered), when nothing is turning
ˡu̲ndo ← { st → (c, h, q, i, f) ← st 0 = (0 < t̲ally h) × ˡi̲dle st ? st (c, -1 d̲rop h, q c̲at 0 − ʳᵇu̲ndo f̲irst -1 t̲ake h, i, f) }
ˡa̲pplied : Int -> Int
rp:a_pplied ts: the colors of a solved cube after the turns ts, made at once (to check what was animated)
ʳᵖ⁼u̲se< "RubikPlay"
ʳᵇ⁼u̲se< "Rubik"
(ʳᵖa̲pplied 1 2) m̲atch ʳᵇsolved 1
ˡa̲pplied ← { ts → (ts, ʳᵇsolved) ʰa̲pply 0 }
ʰa̲pply : Num a => (Int, Int) -> a -> Int
ʰa̲pply ← { (ts, c) z → 0 = t̲ally ts ? c (1 d̲rop ts, (f̲irst ts) ʳᵇt̲urn c) ʰa̲pply 0 }
ˡi̲dle : (Any a, Num b, Any c, Num d, Truthy d) => (a, Int, Int, b, c) -> d
rp:i_dle st: whether nothing is turning or waiting
ˡi̲dle ← { (_, _, q, i, _) → (i = 0) × 0 = t̲ally q }