sourceextensions/scene/demos/RubikPlay.xtl
1⍝# RubikPlay.xtl -- playing the voxel Rubik's cube (Rubik.xtl) with
2⍝# buttons and keys, shared by voxels-rubik-buttons and voxels-rubik-solve:
3⍝# a row of labeled buttons drawn over the scene and found under a click,
4⍝# and turns queued and animated one after another -- each a quarter
5⍝# turn of one layer seen as it happens, the next starting as soon as it
6⍝# is done, so a press always answers at once.
7⍝# Import: "rp:" u_se< "RubikPlay"
8
9ʳᵇ⁼u̲se< "Rubik"
10ˢᶜ⁼u̲se< "Scene"
11
12⍝## Buttons
13
14⍝# a button's width when a row does not say (the window's logical
15⍝# pixels)
16ˡbw ← 64.0
17⍝# a button's height
18ˡbh ← 40.0
19⍝# the gap between buttons in a row
20ˡgap ← 10.0
21
22⍝# rp:w_ords t: the words of a text, boxed (the names of the buttons)
23⍝# >> "rp:" u_se< "RubikPlay"
24⍝# >> t_ally rp:w_ords "U U' R R'"
25⍝# 4
26ˡw̲ords ← { t → (n̲ot t = f̲irst " ") p̲artition t }
27
28⍝# (n, wide, bw) rp:l_efts 0: the left edges of a row of n buttons, bw
29⍝# wide, centered across a window wide points wide
30⍝# >> "rp:" u_se< "RubikPlay"
31⍝# >> (2, 200.0, 64.0) rp:l_efts 0
32⍝# 31.0 105.0
33ˡl̲efts ← { (n, wide, bw) z →
34 m ← f̲loat n
35 ((wide − (m × bw) + (m − 1.0) × ˡgap) ÷ 2.0) + (bw + ˡgap) × f̲loat (r̲ange n) − 1
36}
37
38⍝# (w, names, top, wide, first, bw) rp:d_rawRow lit: a row of buttons
39⍝# bw wide drawn over window w (wide points wide), their tops at top,
40⍝# labeled by the words of names, their labels' ids from first, button
41⍝# lit (1 to n; 0 none) lit up; the row's rectangles, n by 7, for the
42⍝# overlay (the caller puts all its rows at once)
43ˡd̲rawRow ← { (w, names, top, wide, first, bw) lit →
44 ws ← ˡw̲ords names
45 n ← t̲ally ws
46 ls ← (n, wide, bw) ˡl̲efts 0
47 on ← f̲loat lit = r̲ange n
48 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
49 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
50 rects
51}
52
53⍝ the header of a button's label: centered in it, 14 points tall
54ʰl̲abelHead ← { (w, id, left, top, bw, chars) →
55 wide ← 2.0 × f̲loat (6 × chars) − 1
56 (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
57}
58
59⍝# (v, n, top, wide, bw) rp:h_it 0: which of a row of n buttons (1 to
60⍝# n), bw wide, a left click v ("click left X Y") is on, else 0
61⍝# >> "rp:" u_se< "RubikPlay"
62⍝# >> ("click left 200 520", 6, 500.0, 640.0, 64.0) rp:h_it 0
63⍝# 2
64ˡh̲it ← { (v, n, top, wide, bw) z →
65 0 = (10 t̲ake v) m̲atch "click left" ? 0
66 p ← n̲umbers 11 d̲rop v
67 x ← 1 s̲elect p
68 y ← 2 s̲elect p
69 ls ← (n, wide, bw) ˡl̲efts 0
70 on ← (x ≥ ls) × (x < ls + bw) × (y ≥ top) × y < top + ˡbh
71 0 = '+ r̲/ on ? 0
72 f̲irst w̲here on
73}
74
75⍝## Turning, queued
76
77⍝# The turning state is a tuple: (the colors, the turns made -- 1 to 12
78⍝# in the order of rb:names -- the turns waiting, the turn under way (0
79⍝# none) and its frame).
80
81⍝# the state of a solved cube, nothing turning
82ˡstart ← (ʳᵇsolved, 0 r̲eshape 0, 0 r̲eshape 0, 0, 0)
83
84⍝# t rp:q_ueue st: turns t (1 to 12) waiting after the others
85ˡq̲ueue ← { t (c, h, q, i, f) → (c, h, q c̲at t, i, f) }
86
87⍝# (w, frames) rp:a_dvance st: one frame of turning in window w: the
88⍝# turn under way a frame further (frames to a quarter turn), or, done,
89⍝# the colors turned and the turn remembered; with none under way the
90⍝# next waiting one starts. A waiting turn queued negative (-t) is made
91⍝# (turn t) but not remembered: an undo, whose turn has already left the
92⍝# history.
93ˡa̲dvance ← { wf st →
94 (c, h, q, i, f) ← st
95 (w, frames) ← wf
96 (i = 0) × 0 = t̲ally q ? st
97 i = 0 ? (c, h, 1 d̲rop q, f̲irst q, 0)
98 f ← f + 1
99 f < frames ? (c, h, q, i, f) ʰs̲how w c̲at frames
100 c ← (a̲bs i) ʳᵇt̲urn c
101 z ← (c, 0, 0.0) ʳᵇd̲raw w
102 (c, h c̲at (i > 0) r̲eplicate i, q, 0, 0)
103}
104
105⍝ st h:s_how (w frames): the turn under way drawn that far
106ʰs̲how ← { st wfr →
107 (c, h, q, i, f) ← st
108 z ← (c, a̲bs i, (f̲loat f) ÷ f̲loat 2 s̲elect wfr) ʳᵇd̲raw 1 s̲elect wfr
109 st
110}
111
112⍝# rp:u_ndo st: the last turn made taken from the history and its
113⍝# undoing queued (made, not remembered), when nothing is turning
114ˡu̲ndo ← { st →
115 (c, h, q, i, f) ← st
116 0 = (0 < t̲ally h) × ˡi̲dle st ? st
117 (c, -1 d̲rop h, q c̲at 0 − ʳᵇu̲ndo f̲irst -1 t̲ake h, i, f)
118}
119
120⍝# rp:a_pplied ts: the colors of a solved cube after the turns ts, made
121⍝# at once (to check what was animated)
122⍝# >> "rp:" u_se< "RubikPlay"
123⍝# >> "rb:" u_se< "Rubik"
124⍝# >> (rp:a_pplied 1 2) m_atch rb:solved
125⍝# 1
126ˡa̲pplied ← { ts → (ts, ʳᵇsolved) ʰa̲pply 0 }
127ʰa̲pply ← { (ts, c) z →
128 0 = t̲ally ts ? c
129 (1 d̲rop ts, (f̲irst ts) ʳᵇt̲urn c) ʰa̲pply 0
130}
131
132⍝# rp:i_dle st: whether nothing is turning or waiting
133ˡi̲dle ← { (_, _, q, i, _) → (i = 0) × 0 = t̲ally q }
134
135⍝# rp:n_ames ts: the turns ts (1 to 12) by name, "U R' F"
136⍝# >> "rp:" u_se< "RubikPlay"
137⍝# >> rp:n_ames 1 6 9
138⍝# U R' F
139ˡn̲ames ← { ts →
140 0 = t̲ally ts ? ""
141 nm ← ˡw̲ords ʳᵇnames
142 d̲isclose '{ e̲nclose (d̲isclose ⍺) c̲at " " c̲at d̲isclose ⍵ } r̲/ ts s̲elect nm
143}