sourcegames/stargazer/Sky.xtl
1⍝# Stargazer's rules and its sky, a library: stargazer.xtl (scripted),
2⍝# play.xtl (the game: a sky you click) and the web page all use these.
3⍝# The data is in two TOML files, read with []L_IST and []T_ABLE:
4⍝# assets/cache/sky.toml (the Bright Star Catalog's stars and the IAU's
5⍝# named stars, fetched by assets/fetch.sh, not tracked) and stars.toml
6⍝# (the parts of the sky, the brightness bands, stars of your own). The
7⍝# sky is SVG written here, with the pieces of lib/Svg.xtl.
8⍝#
9⍝# Sky units are hundredths of a degree: x = 100 (360 - ra), so right
10⍝# ascension grows to the left as on the sky seen from Earth, and
11⍝# y = 100 (90 - dec) south from the north pole. A game's state: the part
12⍝# of the sky (0 all of it), the star whose menu is open (0 none), the
13⍝# score, the number of stars n, the round's random number, then the n
14⍝# stars, the n results (0 not yet, 1 right, 2 wrong), then the last star
15⍝# answered and the star chosen for it.
16
17ᵗ⁼u̲se< "Text"
18ˢᵛ⁼u̲se< "Svg"
19
20⍝## The data
21
22⍝# The named stars, then any of your own: name, ra, dec, magnitude and
23⍝# constellation, as texts.
24named ← (("assets/cache/sky.toml" "star") ⎕T̲ABLE ("stars" "fields")) c̲at ("stars.toml" "star") ⎕T̲ABLE ("stars" "fields")
25names ← 1 s̲elect₂ named
26ra ← 'ˢᵛn̲um e̲ach 2 s̲elect₂ named
27dec ← 'ˢᵛn̲um e̲ach 3 s̲elect₂ named
28mag ← 'ˢᵛn̲um e̲ach 4 s̲elect₂ named
29⍝# The second and third numbers in a text (h:, private to this file).
30ʰs̲econd ← { x → 2 s̲elect n̲umbers d̲isclose x }
31ʰt̲hird ← { x → 3 s̲elect n̲umbers d̲isclose x }
32⍝# The parts of the sky: name, ra0, ra1, dec0, dec1.
33parts ← ("stars.toml" "area") ⎕T̲ABLE ("areas" "areafields")
34ra0 ← 'ˢᵛn̲um e̲ach 2 s̲elect₂ parts
35ra1 ← 'ˢᵛn̲um e̲ach 3 s̲elect₂ parts
36dec0 ← 'ˢᵛn̲um e̲ach 4 s̲elect₂ parts
37dec1 ← 'ˢᵛn̲um e̲ach 5 s̲elect₂ parts
38⍝# The brightness bands' upper edges, each star's band (1 the brightest),
39⍝# and how many of each band a round takes.
40edges ← 'ʰs̲econd e̲ach "stars.toml" ⎕L̲IST "bands"
41band ← 1 + '+ r̲/₂ 0 + mag '> t̲able -1 d̲rop edges
42mix ← f̲loor 'ˢᵛn̲um e̲ach "stars.toml" ⎕L̲IST "mix"
43⍝# The sky behind: every catalog star to magnitude 5.5, as paths of
44⍝# points (one per brightness class, a round dot of a fixed size on the
45⍝# screen at every zoom), joined once.
46sky ← "assets/cache/sky.toml" ⎕L̲IST "sky"
47sx ← 100 × 360 − 'ˢᵛn̲um e̲ach sky
48sy ← 100 × 90 − 'ʰs̲econd e̲ach sky
49class ← 1 + '+ r̲/₂ 0 + ('ʰt̲hird e̲ach sky) '> t̲able 1.0 2.0 3.0 4.0
50ʰp̲oints ← { k → ᵗj̲oin '{ j → e̲nclose "M" c̲at (ˢᵛw̲hole j s̲elect sx) c̲at " " c̲at (ˢᵛw̲hole j s̲elect sy) c̲at "h0" } e̲ach w̲here class = k }
51ʰw̲idth ← { k → d̲isclose k s̲elect "7" "5.5" "4" "2.8" "1.8" }
52layer ← ᵗj̲oin '{ k → e̲nclose @ f̲ormat< "<path d=\"{h:p_oints k}\" stroke-width=\"{h:w_idth k}\" vector-effect=\"non-scaling-stroke\"/>" } e̲ach r̲ange 5
53
54⍝## Where things are
55
56⍝ :: Num a => a -> a
57⍝# Sky x of right ascensions, and sky y of declinations (sky units).
58ˡs̲x ← { r → 100 × 360 − r }
59⍝ :: Num a => a -> a
60⍝# Sky y of declinations (sky units): hundredths of a degree south of the north pole.
61ˡs̲y ← { d → 100 × 90 − d }
62⍝# Which named stars lie in part a's right ascensions (through 0h when
63⍝# ra0 is above ra1).
64ʰi̲nRa ← { a →
65 (a s̲elect ra0) ≤ a s̲elect ra1 ? (ra ≥ a s̲elect ra0) ∧ ra < a s̲elect ra1
66 (ra ≥ a s̲elect ra0) ∨ ra < a s̲elect ra1
67}
68⍝ :: Int -> Int
69⍝# The named stars in part a of the sky (0 all of it), by number.
70ˡp̲ool ← { a →
71 0 = a ? r̲ange t̲ally names
72 w̲here (ʰi̲nRa a) ∧ (dec ≥ a s̲elect dec0) ∧ dec ≤ a s̲elect dec1
73}
74⍝ :: Unit -> Box Char
75⍝# The parts of the sky, by name, in the menu's order.
76ˡp̲arts ← { @ → 1 s̲elect₂ parts }
77⍝ :: Int -> Char
78⍝# Star i's name.
79ˡn̲ame ← { i → d̲isclose i s̲elect names }
80⍝ :: Int -> Float
81⍝# What the sky shows for part a: x, y, width and height (sky units), in
82⍝# the shape of a picture (5 by 2) with room at the top for the buttons;
83⍝# the whole sky (a 0) a little wider than one turn, drawn again on both
84⍝# sides.
85ˡv̲iew ← { a →
86 0 = a ? -4500.0 -1000.0 45000.0 18000.0
87 r1 ← (a s̲elect ra1) + 360 × f̲loat (a s̲elect ra0) > a s̲elect ra1
88 w ← 100 × r1 − a s̲elect ra0
89 h ← 100 × (a s̲elect dec1) − a s̲elect dec0
90 cx ← (ˡs̲x r1) + w ÷ 2
91 cy ← (ˡs̲y a s̲elect dec1) + h ÷ 2
92 w ← w m̲ax 2.5 × h
93 h ← w ÷ 2.5
94 (cx − 0.6 × w) c̲at (cy − 0.7 × h) c̲at (1.2 × w) c̲at 1.2 × h
95}
96⍝ :: Int -> Int -> Float
97⍝# Star i's point in part a's view: x and y, x moved by a whole turn when
98⍝# that brings it nearer the middle of the view (the sky wraps at 0h).
99ˡa̲t ← { a i →
100 v ← ˡv̲iew a
101 x ← ˡs̲x i s̲elect ra
102 mid ← (f̲irst v) + 0.5 × 3 s̲elect v
103 (x − 36000.0 × f̲loat f̲loor 0.5 + (x − mid) ÷ 36000) c̲at ˡs̲y i s̲elect dec
104}
105⍝ :: Int -> Int -> Int
106⍝# Star i's choices, with the round's random number q: it and one star
107⍝# from each brightness band (another star, from anywhere in the sky,
108⍝# picked by q and i), in the order of right ascension.
109ˡc̲hoices ← { q i →
110 c ← i c̲at '{ b → q ʰo̲ne i c̲at b } e̲ach r̲ange t̲ally mix
111 (g̲rade c s̲elect n̲eg ra) s̲elect c
112}
113⍝# Band b's star for star i: a star of that band other than i, at a
114⍝# place fixed by q, i and b.
115ʰo̲ne ← { q ib →
116 l ← w̲here band = 2 s̲elect ib
117 l ← (l ≠ f̲irst ib) r̲eplicate l
118 (1 + (q + (7919 × f̲irst ib) + 104729 × 2 s̲elect ib) m̲od t̲ally l) s̲elect l
119}
120
121⍝## The game
122
123⍝# The first n items of v, or all of them when v has fewer (a band with
124⍝# no star in a part of the sky: the round is filled from the rest).
125ʰu̲pTo ← { n v → (n m̲in t̲ally v) t̲ake v }
126⍝ :: Int -> Int
127⍝# A new round in part a of the sky (0 all of it): its named stars in a
128⍝# random order, mix of each band taken in turn (bright, middling, faint),
129⍝# filled up from the rest when a band has too few; five, or all of them
130⍝# when the part has fewer.
131ˡn̲ew ← { a →
132 p ← ˡp̲ool a
133 o ← (g̲rade r̲oll! (t̲ally p) r̲eshape 1000000) s̲elect p
134 b ← o s̲elect band
135 pick ← d̲isclose '{ x y → e̲nclose (d̲isclose x) c̲at d̲isclose y } r̲/ '{ k → (k s̲elect mix) ʰu̲pTo (b = k) r̲eplicate o } m̲ap r̲ange t̲ally mix
136 n ← 5 m̲in t̲ally p
137 stars ← n t̲ake pick c̲at (n̲ot o m̲ember? pick) r̲eplicate o
138 a c̲at 0 0 c̲at n c̲at (r̲oll! 1000000) c̲at stars c̲at (n r̲eshape 0) c̲at 0 0
139}
140⍝ :: a -> a
141⍝# The round's score.
142ˡs̲core ← { s → 3 s̲elect s }
143⍝ :: Int -> Int
144⍝# The round's stars, and each one's result (0 not yet, 1 right, 2 wrong).
145ˡm̲arks ← { s → (4 s̲elect s) t̲ake 5 d̲rop s }
146⍝ :: Int -> Int
147⍝# Each star's result in the round: 0 not yet, 1 right, 2 wrong.
148ˡr̲esults ← { s → (4 s̲elect s) t̲ake (5 + 4 s̲elect s) d̲rop s }
149⍝ :: (Num a, Truthy a) => Int -> a
150⍝# 0 playing, 1 when every star is answered.
151ˡs̲tatus ← { s → 0 + 0 = '+ r̲/ 0 + 0 = ˡr̲esults s }
152⍝ :: Int -> Int
153⍝# The open star's choices.
154ˡo̲ffered ← { s → (5 s̲elect s) ˡc̲hoices (2 s̲elect s) s̲elect ˡm̲arks s }
155⍝ :: Int -> Float
156⍝# The open star's menu: four rectangles beside it (Svg's menu).
157ˡm̲enu ← { s → (ˡv̲iew f̲irst s) ˢᵛm̲enu (f̲irst s) ˡa̲t (2 s̲elect s) s̲elect ˡm̲arks s }
158⍝# The marked stars' x and y in their view.
159ʰx̲s ← { s → '{ i → f̲irst (f̲irst s) ˡa̲t i } e̲ach ˡm̲arks s }
160ʰy̲s ← { s → '{ i → 2 s̲elect (f̲irst s) ˡa̲t i } e̲ach ˡm̲arks s }
161⍝# Which unanswered star is at xy: the nearest within reach, 1 to n, 0
162⍝# for none.
163ʰs̲tarAt ← { s xy →
164 u ← ˢᵛu̲nit ˡv̲iew f̲irst s
165 dx ← (ʰx̲s s) − f̲irst xy
166 dy ← (ʰy̲s s) − 2 s̲elect xy
167 d2 ← (dx × dx) + dy × dy
168 ok ← (d2 ≤ (u × 16) × u × 16) ∧ 0 = ˡr̲esults s
169 0 = '+ r̲/ 0 + ok ? 0
170 f̲irst g̲rade d2 + 1e12 × f̲loat n̲ot ok
171}
172⍝ :: Int -> Float -> Int
173⍝# A click at xy (sky units): a part's button starts a round there; in
174⍝# an open menu a choice answers its star; a star not yet answered opens
175⍝# its menu; anywhere else closes the menu.
176ˡc̲lick ← { s xy →
177 b ← ((ˡv̲iew f̲irst s) ˢᵛb̲uttons 1 + t̲ally ˡp̲arts @) ˢᵛh̲it xy
178 b > 0 ? ˡn̲ew b − 1
179 (2 s̲elect s) > 0 ? s ʰo̲pen xy
180 (2 c̲at s ʰs̲tarAt xy) ʰs̲et s
181}
182⍝# A click while a menu is open: a choice answers; elsewhere, another
183⍝# star's menu opens or the menu closes.
184ʰo̲pen ← { s xy →
185 k ← (ˡm̲enu s) ˢᵛh̲it xy
186 k > 0 ? s ʰa̲nswer k
187 (2 c̲at s ʰs̲tarAt xy) ʰs̲et s
188}
189⍝# The state with item k (from 1) replaced by v: kv is k v.
190ʰs̲et ← { kv s → s + ((2 s̲elect kv) − (f̲irst kv) s̲elect s) × (f̲irst kv) = r̲ange t̲ally s }
191⍝# Choice k of the open star: right or wrong, the score, the menu closed.
192ʰa̲nswer ← { s k →
193 d ← 2 s̲elect s
194 i ← d s̲elect ˡm̲arks s
195 pick ← k s̲elect ˡo̲ffered s
196 right ← pick = i
197 n ← 4 s̲elect s
198 t ← (5 + n + d) c̲at 2 − right
199 s ← (2 c̲at 0) ʰs̲et (3 c̲at (3 s̲elect s) + right) ʰs̲et t ʰs̲et s
200 (-2 d̲rop s) c̲at d c̲at pick
201}
202
203⍝## What the game says and draws
204
205⍝# The end of a round, said after its last answer (else nothing).
206ʰr̲oundOver ← { s →
207 0 = ˡs̲tatus s ? ""
208 @ f̲ormat< " Round over: {l:s_core s} of {4 s_elect s}. Choose a part of the sky for another round."
209}
210⍝ :: Int -> Char
211⍝# What has happened, in a line: the open menu, the last answer, the
212⍝# round's end.
213ˡs̲ay ← { s →
214 (2 s̲elect s) > 0 ? "Which star is this?"
215 d ← ((t̲ally s) − 1) s̲elect s
216 last ← (1 + d) s̲elect 0 c̲at ˡr̲esults s
217 note ← ʰr̲oundOver s
218 0 = d ? "Click a ringed star: which is it?"
219 i ← d s̲elect ˡm̲arks s
220 1 = last ? @ f̲ormat< "Right: {l:n_ame i}, in {d_isclose i s_elect 5 s_elect_2 named}.{note}"
221 @ f̲ormat< "No: that is {l:n_ame i}, not {l:n_ame (t_ally s) s_elect s}.{note}"
222}
223⍝# A ring's color by its result (0 not yet, red; 1 right, green; 2
224⍝# wrong, orange).
225ʰr̲ingColor ← { r → d̲isclose (1 + r) s̲elect "#ff4d4d" "#3ddc84" "#ffa630" }
226⍝# The round's stars: a ring around each (its color its result), each
227⍝# answered one named.
228ʰr̲ings ← { s u →
229 x ← ʰx̲s s
230 y ← ʰy̲s s
231 r ← ˡr̲esults s
232 rings ← '{ k → e̲nclose @ f̲ormat< "<circle class=\"dot\" cx=\"{sv:w_hole k s_elect x}\" cy=\"{sv:w_hole k s_elect y}\" r=\"{sv:w_hole u * 13}\" fill=\"none\" stroke=\"{h:r_ingColor k s_elect r}\" stroke-width=\"{sv:w_hole u * 3}\"/>" } e̲ach r̲ange t̲ally x
233 rings c̲at '{ k → (((k s̲elect x) + u × 16) c̲at ((k s̲elect y) + u × 6) c̲at u × 18) ˢᵛw̲ords ˡn̲ame k s̲elect ˡm̲arks s } e̲ach w̲here r > 0
234}
235⍝# The parts' buttons (the part shown filled), and the score below them
236⍝# at the right (seven buttons fill the row).
237ʰb̲ar ← { s v →
238 u ← ˢᵛu̲nit v
239 score ← ((f̲irst v) + (3 s̲elect v) − u × 190) c̲at ((2 s̲elect v) + u × 80) c̲at u × 22
240 ((v c̲at f̲loat 1 + f̲irst s) ˢᵛl̲abeled (e̲nclose "All") c̲at ˡp̲arts @) c̲at score ˢᵛw̲ords @ f̲ormat< "Score {l:s_core s} of {4 s_elect s}"
241}
242⍝# What happened, along the bottom.
243ʰs̲aid ← { s v →
244 u ← ˢᵛu̲nit v
245 (((f̲irst v) + u × 12) c̲at ((2 s̲elect v) + (4 s̲elect v) − u × 16) c̲at u × 22) ˢᵛw̲ords ˡs̲ay s
246}
247⍝# The open menu: the four names, each a button.
248ʰc̲hoose ← { s →
249 0 = 2 s̲elect s ? 0 r̲eshape e̲nclose ""
250 (ˡm̲enu s) ˢᵛc̲hoices '{ i → e̲nclose ˡn̲ame i } e̲ach ˡo̲ffered s
251}
252⍝ :: Int -> Char
253⍝# The picture, as SVG text: the night, the sky's stars (drawn three
254⍝# times, a turn apart, so a view across 0h is whole), the round's rings,
255⍝# the parts' buttons and the score, what happened, and the open menu.
256⍝# Every coordinate is computed here; the page only shows the picture.
257ˡd̲raw ← { s →
258 v ← ˡv̲iew f̲irst s
259 u ← ˢᵛu̲nit v
260 night ← v ˢᵛr̲ect "fill=\"#0b1d3a\""
261 stars ← e̲nclose "<g id=\"sky\" stroke=\"#ffffff\" stroke-linecap=\"round\" fill=\"none\">" c̲at layer c̲at "</g><use href=\"#sky\" x=\"-36000\"/><use href=\"#sky\" x=\"36000\"/>"
262 v ˢᵛp̲icture night c̲at stars c̲at (s ʰr̲ings u) c̲at (s ʰb̲ar v) c̲at (s ʰs̲aid v) c̲at ʰc̲hoose s
263}
f̲ormat< expands to
("<path d=\"" c̲at (f̲ormat (ʰp̲oints k)) c̲at "\" stroke-width=\"" c̲at (f̲ormat (ʰw̲idth k)) c̲at "\" vector-effect=\"non-scaling-stroke\"/>")
f̲ormat< expands to
" Round over: " c̲at (f̲ormat (ˡs̲core s)) c̲at " of " c̲at (f̲ormat (4 s̲elect s)) c̲at ". Choose a part of the sky for another round."
f̲ormat< expands to
("Right: " c̲at (f̲ormat (ˡn̲ame i)) c̲at ", in " c̲at (f̲ormat (d̲isclose i s̲elect 5 s̲elect₂ named)) c̲at "." c̲at (f̲ormat (note)))
f̲ormat< expands to
"No: that is " c̲at (f̲ormat (ˡn̲ame i)) c̲at ", not " c̲at (f̲ormat (ˡn̲ame (t̲ally s) s̲elect s)) c̲at "." c̲at (f̲ormat (note))
f̲ormat< expands to
("<circle class=\"dot\" cx=\"" c̲at (f̲ormat (ˢᵛw̲hole k s̲elect x)) c̲at "\" cy=\"" c̲at (f̲ormat (ˢᵛw̲hole k s̲elect y)) c̲at "\" r=\"" c̲at (f̲ormat (ˢᵛw̲hole u × 13)) c̲at "\" fill=\"none\" stroke=\"" c̲at (f̲ormat (ʰr̲ingColor k s̲elect r)) c̲at "\" stroke-width=\"" c̲at (f̲ormat (ˢᵛw̲hole u × 3)) c̲at "\"/>")