-
Notifications
You must be signed in to change notification settings - Fork 0
/
Main.elm
386 lines (352 loc) · 17.6 KB
/
Main.elm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
import Html exposing (Html)
import Matrix4 exposing (Float4x4)
import GL exposing (Mesh, triangle, toMesh)
import Keyboard
import Window
import Task
import Meshes exposing (getMesh,M,Object)
import Set exposing (Set)
import AnimationFrame
import Time exposing (Time)
import InfiniteList as IL
import Element
import Element.Attributes as Element
import Element.Events as Element
import Element.Input as Input
import Style
import Style.Color
import Style.Border
import Color
type alias Model =
{ win : Window.Size
, state : State
, mat : Float4x4
, keys : Set Keyboard.KeyCode
, inputDuoprism1 : String
, inputDuoprism2 : String
, inputAntiprismPrism : String
, fov : Float
, speed : Float
}
type State
= Select
| View {object : Object}
type Msg
= KeyDown Keyboard.KeyCode
| KeyUp Keyboard.KeyCode
| WindowResize Window.Size
| SetObject Object
| Tick Time
| InputDuoprism1 String
| InputDuoprism2 String
| InputAntiprismPrism String
| SetFov String
| SetSpeed String
main : Program Never Model Msg
main = Html.program {init = init, update = \msg model -> (update msg model, Cmd.none), view = view, subscriptions = subscriptions}
init : (Model, Cmd Msg)
init =
( { state = Select
, mat = Matrix4.identity
, win = Window.Size 0 0
, keys = Set.empty
, inputDuoprism1 = "8"
, inputDuoprism2 = "8"
, inputAntiprismPrism = "8"
, fov = 80
, speed = 10
}
, Task.perform WindowResize Window.size)
relevantKeys : Set Keyboard.KeyCode
relevantKeys = Set.fromList [27,87,83,65,68,69,81,73,74,75,76,79,85]
update : Msg -> Model -> Model
update msg model =
case msg of
WindowResize win -> {model | win = win}
InputDuoprism1 str -> {model | inputDuoprism1 = str}
InputDuoprism2 str -> {model | inputDuoprism2 = str}
InputAntiprismPrism str -> {model | inputAntiprismPrism = str}
SetFov str ->
case String.toFloat str of
Ok fov -> {model | fov = fov}
Err _ -> model
SetSpeed str ->
case String.toFloat str of
Ok speed -> {model | speed = speed}
Err _ -> model
SetObject object -> {model | state = View {object = object}}
KeyDown key -> {model | keys = Set.insert key model.keys}
KeyUp key -> {model | keys = Set.remove key model.keys}
Tick dt ->
let c1 = cos (degrees (model.speed*Time.inSeconds dt))
s1 = sin (degrees (model.speed*Time.inSeconds dt))
c2 = cos (degrees (20*Time.inSeconds dt))
s2 = sin (degrees (20*Time.inSeconds dt))
in Set.foldl
(\k m ->
let move mat = {m | mat = Matrix4.mul mat m.mat}
in case k of
27 -> {m | state = Select}
87 -> move
( ( 1 , 0 , 0 , 0 )
, ( 0 , 1 , 0 , 0 )
, ( 0 , 0 , c1, s1)
, ( 0 , 0 ,-s1, c1))
83 -> move
( ( 1 , 0 , 0 , 0 )
, ( 0 , 1 , 0 , 0 )
, ( 0 , 0 , c1,-s1)
, ( 0 , 0 , s1, c1))
65 -> move
( ( c1, 0 , 0 , s1)
, ( 0 , 1 , 0 , 0 )
, ( 0 , 0 , 1 , 0 )
, (-s1, 0 , 0 , c1))
68 -> move
( ( c1, 0 , 0 ,-s1)
, ( 0 , 1 , 0 , 0 )
, ( 0 , 0 , 1 , 0 )
, ( s1, 0 , 0 , c1))
69 -> move
( ( 1 , 0 , 0 , 0 )
, ( 0 , c1, 0 , s1)
, ( 0 , 0 , 1 , 0 )
, ( 0 ,-s1, 0 , c1))
81 -> move
( ( 1 , 0 , 0 , 0 )
, ( 0 , c1, 0 ,-s1)
, ( 0 , 0 , 1 , 0 )
, ( 0 , s1, 0 , c1))
74 -> move
( ( c2, 0 ,-s2, 0 )
, ( 0 , 1 , 0 , 0 )
, ( s2, 0 , c2, 0 )
, ( 0 , 0 , 0 , 1 ))
76 -> move
( ( c2, 0 , s2, 0 )
, ( 0 , 1 , 0 , 0 )
, (-s2, 0 , c2, 0 )
, ( 0 , 0 , 0 , 1 ))
75 -> move
( ( 1 , 0 , 0 , 0 )
, ( 0 , c2,-s2, 0 )
, ( 0 , s2, c2, 0 )
, ( 0 , 0 , 0 , 1 ))
73 -> move
( ( 1 , 0 , 0 , 0 )
, ( 0 , c2, s2, 0 )
, ( 0 ,-s2, c2, 0 )
, ( 0 , 0 , 0 , 1 ))
85 -> move
( ( c2,-s2, 0 , 0 )
, ( s2, c2, 0 , 0 )
, ( 0 , 0 , 1 , 0 )
, ( 0 , 0 , 0 , 1 ))
79 -> move
( ( c2, s2, 0 , 0 )
, (-s2, c2, 0 , 0 )
, ( 0 , 0 , 1 , 0 )
, ( 0 , 0 , 0 , 1 ))
_ -> model)
model
model.keys
type Style
= None
| Input
| Box
styleSheet : Style.StyleSheet Style v
styleSheet =
Style.styleSheet
[ Style.style None []
, Style.style Input
[ Style.Color.border Color.gray
, Style.Border.all 1
, Style.Border.solid
]
, Style.style Box
[ Style.Color.background Color.gray
]
]
description : String
description =
"""These are all of the uniform polytopes in four dimensions. Click one to view it.
When viewing, you are in the three-dimensional surface of a four dimensional hypersphere.
The polytope being viewed is "balloned out" onto the hypersphere.
You can use WASDQE to move, and IJKLUO to turn. Use the escape key to return to this screen.
Warning: For reasons I have not yet debugged, the 120 and 600-cell variants take a very long time to generate.
The worst is the omnitruncated 120-cell, which on my computer takes 18 minutes!
Fortunately, the polytope will not have to regenerate unless you reload the page.
"""
view : Model -> Html Msg
view model =
case model.state of
View info ->
GL.render
model.win.width
model.win.height
model.fov
(getMesh info.object)
model.mat
Select ->
Element.layout styleSheet <|
Element.el None [Element.center] <|
Element.column None
[ Element.spacing 10, Element.center ]
[ Element.textLayout Box
[ Element.padding 10
]
[ Element.text description
]
, Element.row None [ Element.spacing 10 ]
[ Element.column None []
[ Element.text "1-3 seconds to generate"
, button (SetObject .regular5cell) "regular 5-cell"
, button (SetObject .rectified5cell) "rectified 5-cell"
, button (SetObject .truncated5cell) "truncated 5-cell"
, button (SetObject .cantellated5cell) "cantellated 5-cell"
, button (SetObject .runcinated5cell) "runcinated 5-cell"
, button (SetObject .bitruncated5cell) "bitruncated 5-cell"
, button (SetObject .cantitruncated5cell) "cantitruncated 5-cell"
, button (SetObject .runcitruncated5cell) "runcitruncated 5-cell"
, button (SetObject .omnitruncated5cell) "omnitruncated 5-cell"
]
, Element.column None []
[ Element.text "2-6 seconds to generate"
, button (SetObject .regular8cell) "regular 8-cell"
, button (SetObject .rectified8cell) "rectified 8-cell"
, button (SetObject .regular16cell) "regular 16-cell"
, button (SetObject .truncated8cell) "truncated 8-cell"
, button (SetObject .cantellated8cell) "cantellated 8-cell"
, button (SetObject .runcinated8cell) "runcinated 8-cell"
, button (SetObject .bitruncated8cell) "bitruncated 8-cell"
, button (SetObject .truncated16cell) "truncated 16-cell"
, button (SetObject .cantitruncated8cell) "cantitruncated 8-cell"
, button (SetObject .runcitruncated8cell) "runcitruncated 8-cell"
, button (SetObject .runcitruncated16cell) "runcitruncated 16-cell"
, button (SetObject .omnitruncated8cell) "omnitruncated 8-cell"
]
, Element.column None []
[ Element.text "3-15 seconds to generate"
, button (SetObject .regular24cell) "regular 24-cell"
, button (SetObject .rectified24cell) "rectified 24-cell"
, button (SetObject .truncated24cell) "truncated 24-cell"
, button (SetObject .cantellated24cell) "cantellated 24-cell"
, button (SetObject .runcinated24cell) "runcinated 24-cell"
, button (SetObject .bitruncated24cell) "bitruncated 24-cell"
, button (SetObject .cantitruncated24cell) "cantitruncated 24-cell"
, button (SetObject .runcitruncated24cell) "runcitruncated 24-cell"
, button (SetObject .omnitruncated24cell) "omnitruncated 24-cell"
, button (SetObject .snub24cell) "snub 24-cell"
]
, Element.column None []
[ Element.text "18-1000+ seconds to generate :("
, button (SetObject .regular120cell) "regular 120-cell"
, button (SetObject .rectified120cell) "rectified 120-cell"
, button (SetObject .rectified600cell) "rectified 600-cell"
, button (SetObject .regular600cell) "regular 600-cell"
, button (SetObject .truncated120cell) "truncated 120-cell"
, button (SetObject .cantellated120cell) "cantellated 120-cell"
, button (SetObject .runcinated120cell) "runcinated 120-cell"
, button (SetObject .bitruncated120cell) "bitruncated 120-cell"
, button (SetObject .cantellated600cell) "cantellated 600-cell"
, button (SetObject .truncated600cell) "truncated 600-cell"
, button (SetObject .cantitruncated120cell) "cantitruncated 120-cell"
, button (SetObject .runcitruncated120cell) "runcitruncated 120-cell"
, button (SetObject .runcitruncated600cell) "runcitruncated 600-cell"
, button (SetObject .cantitruncated600cell) "cantitruncated 600-cell"
, button (SetObject .omnitruncated120cell) "omnitruncated 120-cell"
]
]
, Element.spacer 1
, Element.text "These take a couple of seconds to generate."
, Element.column None []
[ button (SetObject .grandAntiprism) "grand antiprism"
]
, Element.row None [ Element.spacing 10 ]
[ Element.column None []
[ button (SetObject .tetrahedralPrism) "tetrahedral prism"
, button (SetObject .truncatedTetrahedralPrism) "truncated tetrahedral prism"
]
, Element.column None []
[ button (SetObject .regular8cell) "cubical prism"
, button (SetObject .cubeoctahedralPrism) "cubeoctahedral prism"
, button (SetObject .octahedralPrism) "octahedral prism"
, button (SetObject .rhombicubeoctahedralPrism) "rhombicubeoctahedral prism"
, button (SetObject .truncatedCubicPrism) "truncated cubic prism"
, button (SetObject .truncatedOctahedralPrism) "truncated octahedral prism"
, button (SetObject .truncatedCubeoctahedralPrism) "truncated cubeoctahedral prism"
, button (SetObject .snubCubicPrism) "snub cubic prism"
]
, Element.column None []
[ button (SetObject .dodecahedralPrism) "dodecahedral prism"
, button (SetObject .icosidodecahedralPrism) "icosidodecahedral prism"
, button (SetObject .icosahedralPrism) "icosahedral prism"
, button (SetObject .truncatedDodecahedralPrism) "truncated dodecahedral prism"
, button (SetObject .rhombicosidodecahedralPrism) "rhombicosidodecahedral prism"
, button (SetObject .truncatedIcosahedralPrism) "truncated icosahedral prism"
, button (SetObject .truncatedIcosidodecahedralPrism) "truncated icosidodecahedral prism"
, button (SetObject .snubDodecahedralPrism) "snub dodecahedral prism"
]
]
, Element.row None
[ Element.spacing 10 ]
[ case String.toInt model.inputAntiprismPrism of
Ok n ->
if n >= 3
then button (SetObject (.antiprismPrism >> IL.get (n-3))) "antiprism prism"
else Element.empty
Err _ -> Element.empty
, input InputAntiprismPrism model.inputAntiprismPrism
]
, Element.row None
[ Element.spacing 10 ]
[ case (String.toInt model.inputDuoprism1, String.toInt model.inputDuoprism2) of
(Ok m,Ok n) ->
if m >= 3 && n >= 3
then button (SetObject (.duoprism >> IL.get (m-3) >> IL.get (n-3))) "duoprism"
else Element.empty
_ -> Element.empty
, input InputDuoprism1 model.inputDuoprism1
, input InputDuoprism2 model.inputDuoprism2
]
, Element.spacer 2
, Element.row None
[ Element.spacing 10 ]
[ Element.text "FOV"
, input SetFov (toString model.fov)
]
, Element.row None
[ Element.spacing 10 ]
[ Element.text "Speed"
, input SetSpeed (toString model.speed)
]
]
button : msg -> String -> Element.Element Style v msg
button msg str =
Element.button None
[Element.onClick msg]
(Element.text str)
input : (String -> msg) -> String -> Element.Element Style v msg
input msg str =
Element.el None []
( Input.text Input
[ Element.width (Element.px 100) ]
{ onChange = msg
, value = str
, label = Input.hiddenLabel ""
, options = []
}
)
subscriptions : Model -> Sub Msg
subscriptions model =
Sub.batch
[ Keyboard.downs KeyDown
, Keyboard.ups KeyUp
, Window.resizes WindowResize
, case model.state of
Select -> Sub.none
View _ ->
if Set.isEmpty (Set.intersect relevantKeys model.keys)
then Sub.none
else AnimationFrame.diffs Tick
]