-
Notifications
You must be signed in to change notification settings - Fork 108
/
core.clj
1536 lines (1312 loc) · 55.3 KB
/
core.clj
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
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(ns arcadia.core
(:require [clojure.string :as string]
[clojure.spec.alpha :as s]
arcadia.internal.protocols
clojure.set
[arcadia.internal.events :as events]
[arcadia.internal.macro :as mac]
[arcadia.internal.map-utils :as mu]
[arcadia.internal.name-utils :refer [camels-to-hyphens]]
[arcadia.internal.state-help :as sh]
arcadia.data)
(:import ArcadiaBehaviour
ArcadiaBehaviour+IFnInfo
ArcadiaState
System.Text.RegularExpressions.Regex
[Arcadia UnityStatusHelper
Util
HookStateSystem JumpMap
JumpMap+KeyVal JumpMap+PartialArrayMapView
DefmutableDictionary]
[clojure.lang RT]
[UnityEngine
Vector3
Quaternion
Application
MonoBehaviour
GameObject
Transform
Component
PrimitiveType
Debug]
[System Type]))
;; ============================================================
;; application
;; ============================================================
(defn
^{:doc/see-also {"Unity Console" "https://docs.unity3d.com/Manual/Console.html"}}
log
"Log message to the Unity console. Arguments are combined into a string."
[& args]
(Debug/Log (clojure.string/join " " args)))
;; ============================================================
;; null obj stuff
(defn null->nil
"Same as `identity`, except if `x` is a null `UnityEngine.Object`,
will return `nil`.
More details and rationale are available in [the wiki](https://github.com/arcadia-unity/Arcadia/wiki/Null,-Nil,-and-UnityEngine.Object)."
[x]
(Util/TrueNil x))
(defn null?
"Should `x` be considered `nil`? `(null? x)` will evalute to `true` if
`x` is in fact `nil`, or if `x` is a `UnityEngine.Object` instance
such that `(UnityEngine.Object/op_Equality x nil)` returns
`true`. Otherwise will return `false`.
More details and rationale are available in [the wiki](https://github.com/arcadia-unity/Arcadia/wiki/Null,-Nil,-and-UnityEngine.Object)."
[x]
(Util/IsNull x))
;; ============================================================
;; wrappers
;; ============================================================
;; definline does not support arity overloaded functions...
(defn instantiate
"Clones the original object and returns the clone. The clone can
optionally be given a new position or rotation as well.
Wraps `Object/Instantiate`."
{:inline (fn
([^UnityEngine.Object original]
`(UnityEngine.Object/Instantiate ~original))
([^UnityEngine.Object original ^Vector3 position]
`(UnityEngine.Object/Instantiate ~original ~position Quaternion/identity))
([^UnityEngine.Object original ^Vector3 position ^Quaternion rotation]
`(UnityEngine.Object/Instantiate ~original ~position ~rotation)))}
([^UnityEngine.Object original]
(UnityEngine.Object/Instantiate original))
([^UnityEngine.Object original ^Vector3 position]
(UnityEngine.Object/Instantiate original position Quaternion/identity))
([^UnityEngine.Object original ^Vector3 position ^Quaternion rotation]
(UnityEngine.Object/Instantiate original position rotation)))
(defn create-primitive
"Creates a game object with a primitive mesh renderer and appropriate
collider. `prim` can be a `PrimitiveType` or one of `:sphere`
`:capsule` `:cylinder` `:cube` `:plane` `:quad`. If supplied, the
third argument should be a string, and will be set as the name of
the newly created GameObject. Wraps `GameObject/CreatePrimitive`."
(^GameObject [prim] (create-primitive prim nil))
(^GameObject [prim name]
(let [prim' (if (instance? PrimitiveType prim)
prim
(case prim
:sphere PrimitiveType/Sphere
:capsule PrimitiveType/Capsule
:cylinder PrimitiveType/Cylinder
:cube PrimitiveType/Cube
:plane PrimitiveType/Plane
:quad PrimitiveType/Quad))
obj (GameObject/CreatePrimitive prim')]
(when name
(set! (.name obj) name))
obj)))
(defn destroy
"Removes a GameObject, component or asset. When called with `t`, the removal
happens after `t` seconds. Wraps `Object/Destroy`."
([^UnityEngine.Object obj]
(UnityEngine.Object/Destroy obj))
([^UnityEngine.Object obj ^double t]
(UnityEngine.Object/Destroy obj t)))
(defn destroy-immediate
"Removes a GameObject, component or asset immediately.
Wraps `Object/DestroyImmediate`."
[^UnityEngine.Object obj]
(UnityEngine.Object/DestroyImmediate obj))
(defn retire
"If in Play mode, calls `Object/Destroy`, otherwise calls `Object/DestroyImmediate`."
([^UnityEngine.Object obj]
(if UnityStatusHelper/IsInPlayMode
(UnityEngine.Object/Destroy obj)
(UnityEngine.Object/DestroyImmediate obj))))
(defn object-typed
"Returns one live instance of UnityEngine.Object subclass type `t`
from the scene graph, or `nil` if no such object can be found. Wraps
`Object/FindObjectOfType`."
[^Type t]
(null->nil (UnityEngine.Object/FindObjectOfType t)))
(defn objects-typed
"Returns a sequence of all live instances of UnityEngine.Object subclass
type `t` in the scene graph. Wraps `Object/FindObjectsOfType`."
[^Type t]
(remove null? (UnityEngine.Object/FindObjectsOfType t)))
(defn object-named
"Returns one live GameObject from the scene graph, the name of which
matches `name-or-regex`. `name-or-regex` may be a string or a
regular expression object."
^GameObject [name-or-regex]
(cond
(string? name-or-regex)
(UnityEngine.GameObject/Find ^String name-or-regex)
(instance? Regex name-or-regex)
(let [objs (UnityEngine.Object/FindObjectsOfType GameObject)]
(loop [i (int 0)]
(when (< i (count objs))
(let [obj (aget objs i)]
(if (and (not (null? obj))
(re-matches name-or-regex (.name obj)))
obj
(recur (inc i)))))))
:else
(throw
(ArgumentException.
(str "Expects string or Regex, instead got instance of "
(class name-or-regex))
"name-or-regex"))))
(defn objects-named
"Returns a sequence of all live `GameObject`s in the scene graph, the
name of which match `name-or-regex`. `name-or-regex` may be a string
or a regular expression object."
[name-or-regex]
(cond
(string? name-or-regex)
(for [^GameObject obj (objects-typed GameObject)
:when (= (.name obj) name-or-regex)]
obj)
(instance? Regex name-or-regex)
(for [^GameObject obj (objects-typed GameObject)
:when (re-matches name-or-regex (.name obj))]
obj)
:else
(throw
(ArgumentException.
(str "Expects string or Regex, instead got instance of "
(class name-or-regex))
"name-or-regex"))))
(defn object-tagged
"Returns one live `GameObject` tagged `t` from the scene graph,
or `nil` if no such GameObjects exist.
Wraps `GameObject/FindWithTag`."
^GameObject [^String t]
(null->nil (UnityEngine.GameObject/FindWithTag t)))
(defn objects-tagged
"Returns a sequence of live `GameObject`s tagged tag. Returns empty
array if no `GameObject` was found.
Wraps `GameObject/FindGameObjectsWithTag`."
[^String t]
(remove null? (UnityEngine.GameObject/FindGameObjectsWithTag t)))
;; ------------------------------------------------------------
;; Scene graph traversal and manipulation
(extend-protocol clojure.core.protocols/CollReduce
UnityEngine.GameObject
(coll-reduce [coll f]
(coll-reduce coll f (f)))
(coll-reduce [coll f val]
(let [^Transform tr (.transform ^GameObject coll)
e (.GetEnumerator tr)]
(loop [ret val]
(if (.MoveNext e)
(let [^Transform tr2 (.Current e)
ret (f ret (.gameObject tr2))]
(if (reduced? ret)
@ret
(recur ret)))
ret)))))
(defn gobj
"Coerces `x`, expected to be a GameObject or Component, to a
corresponding live (non-destroyed) GameObject instance or to `nil` by
the following policy:
- If `x` is a live GameObject, returns it.
- If `x` is a destroyed GameObject, returns `nil`.
- If `x` is a live Component, returns its containing GameObject.
- If `x` is a destroyed Component, returns `nil`.
- If `x` is `nil`, returns `nil`.
- Otherwise throws an ArgumentException."
^GameObject [x]
(Util/ToGameObject x))
(defmacro ^:private gobj-arg-fail-exception [param]
(let [param-str (name param)]
`(if (some? ~param)
(throw
(ArgumentException.
(str
"Expects non-destroyed instance of UnityEngine.GameObject or UnityEngine.Component, instead received destroyed instance of "
(class ~param))
~param-str))
(throw
(ArgumentNullException.
~param-str ; the message and the param are backwards in this subclass for some reason
"Expects instance of UnityEngine.GameObject or UnityEngine.Component, instead received nil")))))
;; Should this return the parent or the child?
;; child- should return either the gameobject or nil,
;; more consistent with that to return the parent,
;; unless we want to change child- to return nil
;; just to keep the api consistent.
;; otoh cmpt+ returns the component (and HAS to).
;; assoc returns the new map, of course.
;; aset returns the val. and method chaining
;; isn't a strong idiom in Clojure.
(defn child+
"Makes GameObject `x` the new parent of GameObject `child`. Returns `child`.
If `world-position-stays` is true, `child` retains its world position after
being reparented."
(^GameObject [x child]
(child+ x child false))
(^GameObject [x child world-position-stays]
(let [x (Util/CastToGameObject x)
child (Util/CastToGameObject child)]
(.SetParent
(.transform child)
(.transform x)
^Boolean world-position-stays)
child)))
(defn child-
"Removes GameObject `x` as the parent of GameObject `child`,
moving `child` to the top of the scene graph hierarchy. Returns `nil`.
If `world-position-stays` is `true`, `child` retains its world
position after being reparented."
([x child]
(child- x child false))
([x child world-position-stays]
(let [x (Util/CastToGameObject x)
child (Util/CastToGameObject child)]
(when (= (.. child transform parent) (.transform x))
(.SetParent (.transform child) nil ^Boolean world-position-stays)))))
(defn children
"Gets the live children of GameObject `x` as a persistent vector of
GameObjects."
[x]
(let [x (Util/CastToGameObject x)]
(persistent!
(reduce
(fn [acc ^UnityEngine.Transform x]
(if-let [g (null->nil (.gameObject x))]
(conj! acc g)
acc))
(transient [])
(.transform x)))))
(defn parent
"Returns the live parent of GameObject `x` or `nil` if it has none.
GameObjects at the top of the hierarchy do not have parents."
[x]
(when-let [^Transform parent (-> x
Util/CastToGameObject
(.. transform parent)
null->nil)]
(.gameObject parent)))
;; ------------------------------------------------------------
;; IEntityComponent
;; TODO: get rid of this forward declaration by promoting ISceneGraph functions
;; above this
(defn cmpt
"Returns the first live Component of type `t` attached to GameObject
`x`. Returns `nil` if no such Component is attached."
^UnityEngine.Component [^GameObject x ^Type t]
(null->nil (.GetComponent (Util/CastToGameObject x) t)))
(defn cmpts
"Returns all live Components of type `t` attached to GameObject `x`
as a (possibly empty) array."
^|UnityEngine.Component[]| [x ^Type t]
(Util/WithoutNullObjects (.GetComponents (Util/CastToGameObject x) t)))
(defn cmpt+
"Adds a new Component of type `t` to GameObject `x`. Returns the new Component."
^UnityEngine.Component [x ^Type t]
(.AddComponent (Util/CastToGameObject x) t))
;; returns nil because returning x would be inconsistent with cmpt+,
;; which must return the new component
(defn cmpt-
"Removes *every* Component of type `t` from GameObject `x`. Returns `nil`."
[x ^Type t]
(let [^|UnityEngine.Component[]| a (.GetComponents (Util/CastToGameObject x) t)]
(loop [i (int 0)]
(when (< i (count a))
(retire (aget a i))
(recur (inc i))))))
;; ------------------------------------------------------------
;; repercussions
(defn ensure-cmpt
"If GameObject `x` has a component of type `t`, returns it. Otherwise, adds
a component of type `t` and returns the new instance."
^UnityEngine.Component [x ^Type t]
(let [x (Util/CastToGameObject x)]
(or (cmpt x t) (cmpt+ x t))))
;; ------------------------------------------------------------
;; sugar macros
(defn- meta-tag [x t]
(vary-meta x assoc :tag t))
(defn- gentagged
([t]
(meta-tag (gensym) t))
([s t]
(meta-tag (gensym s) t)))
(defmacro with-cmpt
"`binding => name component-type`
For each binding, binds `name` to an instance of class
`component-type` attached to GameObject `gob`. If no such instance
is currently attached to `x`, a new instance of `component-type`
will be created, attached to `x`, and bound to `name`. `body` is
then evaluated in the lexical context of all bindings."
([gob bindings & body]
(assert (vector? bindings))
(assert (even? (count bindings)))
(let [gobsym (gentagged "gob__" 'UnityEngine.GameObject)
dcls (->> bindings
(partition 2)
(mapcat (fn [[n t]]
[(meta-tag n t) `(ensure-cmpt ~gobsym ~t)])))]
`(let [~gobsym (Arcadia.Util/CastToGameObject ~gob)]
(let [~@dcls]
~@body)))))
(defmacro if-cmpt
"If a component of type `cmpt-type` is attached to GameObject `gob`,
binds it to `cmpt-name`, then evaluates and returns `then` in the
lexical scope of that binding. Otherwise evaluates and returns
`else`, if provided, or returns `nil` if `else` is not provided."
[gob [cmpt-name cmpt-type] then & else]
(let [gobsym (gentagged "gob__" 'UnityEngine.GameObject)]
`(let [~gobsym ~gob]
(if-let [~cmpt-name (cmpt ~cmpt-type)]
~then
~@else))))
;; ============================================================
;; sugar for imperative programming
(defmacro sets!
"Set multiple fields or properties on an object instance `o` simultaneously.
assignment => field-name value
For each assignment, field-name is the name of a field or property
of `o`, and `value` is the new value it will be set to.
Returns the final set value.
```clj
(sets! (.transform some-game-object)
position (arcadia.linear/v3 1 2 3)
localScale (arcadia.linear/v3 1 2 3))
```"
[o & assignments]
(let [osym (gensym "obj__")
asgns (->> (partition 2 assignments)
(map (fn [[lhs rhs]]
`(set! (. ~osym ~lhs) ~rhs))))]
`(let [~osym ~o]
~@asgns)))
(defmacro set-with!
"Access and set a field or property `prop` on object instance
`obj`. The new value at `(. obj prop)` will be set to the value of
`body`, evaluated in an implicit `do`, with `name` bound to the
preexisting value of `(. obj prop)`. This operation is not atomic,
and should be used with caution in concurrent contexts.
As an example,
```clj
(set-with! (.transform some-game-object) [pos position]
(arcadia.linear/v3+ pos (arcadia.linear/v3 1 0 0)))
```
is equivalent to
```
(let [tr (.transform some-game-object)
pos (.position tr)]
(set!
(.position tr)
(arcadia.linear/v3+ (.position tr) (arcadia.linear/v3 1 0 0))))
```
Since the object is the first argument, multiple such assignments on
an object may be chained using `doto`. Returns the new value of the
field or property."
[obj [name prop :as bindings] & body]
(assert (vector? bindings))
(assert (symbol? name))
(assert (symbol? prop))
`(let [obj# ~obj
~name (. obj# ~prop)]
(set! (. obj# ~prop) (do ~@body))))
;; ============================================================
;; traversal
(defn descendents
"Returns a sequence containing all descendents of GameObject `x` in
depth-first order. The descendents of `x` are all GameObjects
attached as children to `x` in the Unity hierarchy; all of those
GameObject's children; and so on."
[x]
(tree-seq identity children x))
;; ============================================================
;; hooks
(defn- clojurized-keyword [m]
(-> m str camels-to-hyphens string/lower-case keyword))
(def ^:private hook-types
"Map of keywords to hook component types. Unstable."
(->> events/all-events
keys
(map name)
(map #(do [(clojurized-keyword %), (RT/classForName (str % "Hook"))]))
(into {})))
(defn available-hooks
"Returns a sorted seq of all permissible hook event keywords."
[]
(sort (keys hook-types)))
(defn- ensure-hook-type [hook]
(or (get hook-types hook)
(throw (ArgumentException. (str hook " is not a valid Arcadia hook")))))
(s/def ::scenegraphable
#(or (instance? GameObject %)
(instance? Component %)))
(s/def ::hook-kw
#(contains? hook-types %))
(s/fdef hook+
:args (s/cat
:obj ::scenegraphable
:hook ::hook-kw
:rest (s/alt
:n3 (s/cat
:f ifn?)
:n4+ (s/cat
:k any?
:f ifn?
:keys (s/? (s/nilable sequential?))))))
(defn
^{:doc/see-also {"Unity Event Functions" "https://docs.unity3d.com/Manual/EventFunctions.html"}}
hook+
"Attach a Clojure function, preferrably a Var instance, to GameObject
`obj` on key `k`. The function `f` will be invoked every time the event
identified by `event-kw` is triggered by Unity.
`f` must be a function of 2 arguments, plus however many arguments
the corresponding Unity event function takes. The first argument is
the GameObject `obj` that `f` is attached to. The second argument is
the key `k` it was attached with. The remaining arguments are the
arguments normally passed to the corresponding Unity event function.
Returns `f`."
([obj event-kw k f]
(let [hook-type (ensure-hook-type event-kw)
^ArcadiaBehaviour hook-cmpt (ensure-cmpt obj hook-type)]
(.AddFunction hook-cmpt k f)
f)))
(defn hook-
"Removes hook function from GameObject `obj` on the Unity event
corresponding to `event-kw` at `key`, if it exists. Reverse of
```clj
(hook+ obj event-kw key hook-function)
```
Returns `nil`."
([obj event-kw key]
(when-let [^ArcadiaBehaviour hook-cmpt (cmpt obj (ensure-hook-type event-kw))]
(.RemoveFunction hook-cmpt key))
nil))
(defn clear-hooks
"Removes all hook functions on the Unity event corresponding to
`event-kw`, regardless of their keys."
[obj event-kw]
(when-let [^ArcadiaBehaviour hook-cmpt (cmpt obj (ensure-hook-type event-kw))]
(.RemoveAllFunctions hook-cmpt))
nil)
(defn hook
"Retrieves an attached hook function from GameObject
`obj`. `event-kw` is a keyword specifying the Unity event of the
hook function, and `key` is the key of the hook function.
In other words, retrieves any hook function attached via
```clj
(hook+ obj event-kw key hook-function)
```
or the equivalent."
[obj event-kw key]
(when-let [^ArcadiaBehaviour hook-cmpt (cmpt obj (ensure-hook-type event-kw))]
(.CallbackForKey hook-cmpt key)))
;; ============================================================
;; defmutable support methods
(defn snapshot
"Converts `defmutable` instance `x` to a persistent representation."
[x]
(arcadia.internal.protocols/snapshot x))
;; public for macros
(defn maybe-snapshot
"Unstable implementation detail, please don't use."
[x]
(if (arcadia.internal.protocols/snapshotable? x)
(snapshot x)
x))
(defn mutable
"Given a persistent representation of a mutable datatype defined via
`defmutable`, constructs and returns a matching instance of that
datatype.
Roundtrips with `snapshot`; that is, for any instance `x` of a type defined via `defmutable`,
```clj
(= (snapshot x) (snapshot (mutable (snapshot x))))
```"
[x]
(arcadia.internal.protocols/mutable x))
;; public for macros
(defn maybe-mutable
"Unstable implementation detail, please don't use."
[x]
(if (and (map? x)
(contains? x ::mutable-type))
(mutable x)
x))
;; ============================================================
;; state
(defn lookup
"Returns the state of GameObject `go` at key `k`. Does not convert
defmutable instances to persistent representations."
[go k]
(Arcadia.HookStateSystem/Lookup go k))
(defn state
"With one argument, returns the state of GameObject `go` on all keys
as a map. With two arguments, returns the state of GameObject `go`
at key `k`. If this state is a `defmutable` instance, will return a
persistent representation instead. To avoid this behavior use
`lookup`."
([go]
(when-let [^ArcadiaState s (cmpt go ArcadiaState)]
(let [m (persistent!
(reduce (fn [m, ^Arcadia.JumpMap+KeyVal kv]
(assoc! m (.key kv) (maybe-snapshot (.val kv))))
(transient {})
(.. s state KeyVals)))]
(when-not (zero? (count m))
m))))
([go k]
(maybe-snapshot
(Arcadia.HookStateSystem/Lookup go k))))
(defn state+
"Sets the state of GameObject `go` to value `v` at key `k`. Returns
`v`. If `v` is a persistent representation of a `defmutable`
instance, will convert it to a mutable instance before inserting in
the scene graph."
([go k v]
(with-cmpt go [arcs ArcadiaState]
(.Add arcs k (maybe-mutable v))
v)))
(defn state-
"Removes the state of object `go` at key `k`."
([go k]
(with-cmpt go [arcs ArcadiaState]
(.Remove arcs k)
nil)))
(defn clear-state
"Removes all state from the GameObject `go`."
[go]
(with-cmpt go [arcs ArcadiaState]
(.Clear arcs)
nil))
(defmacro ^:private update-state-impl-form [go k f & args]
`(with-cmpt ~go [arcs# ArcadiaState]
(let [v# (~f (maybe-snapshot (.ValueAtKey arcs# ~k)) ~@args)]
(.Add arcs# ~k (maybe-mutable v#))
v#)))
(defn update-state
"Updates the state of GameObject `go` at key `k` with function `f` and
additional arguments `args`. Args are applied in the same order as
`clojure.core/update`. Returns the new value of the state at `k`.
In the special case that the value in state is a defmutable
instance, `f` will be applied to the persistent representation of
that value, which will then be converted to a mutable instance
again, and inserted into state at `k`. The returned value will be
`f` applied to the persistent representation."
([go k f]
(update-state-impl-form go k f))
([go k f x]
(update-state-impl-form go k f x))
([go k f x y]
(update-state-impl-form go k f x y))
([go k f x y z]
(update-state-impl-form go k f x y z))
([go k f x y z & args]
(with-cmpt go [arcs ArcadiaState]
(let [v (apply f (snapshot (.ValueAtKey arcs k)) x y z args)]
(.Add arcs k (maybe-mutable v))
v))))
;; ============================================================
;; roles
(def ^:private hook-type->hook-type-key
(clojure.set/map-invert hook-types))
(defn- hook->hook-type-key [hook]
(get hook-type->hook-type-key (class hook)))
(def ^:private hook-type-key->fastkeys-key
(let [ks (keys hook-types)]
(zipmap ks (map #(keyword (str (name %) "-ks")) ks))))
;; sketched this while not connected to repl, check it all
(def ^:private hook-ks
(let [ks (keys hook-types)]
(zipmap ks
(map #(keyword (str (name %) "-ks"))
ks))))
(def ^:private hook-fastkeys
(set (vals hook-type-key->fastkeys-key)))
;; spec isn't very informative for our role system, but the following
;; is at least true of it.
;; Note that ::role's also support :state, which can't really be
;; spec'd (could be anything)
(s/def ::role
(s/and
map?
(s/coll-of
(fn hook-type-keys-to-ifns [[k v]]
(if (contains? hook-types k)
(ifn? v)
true)))
(s/coll-of
(fn hook-fastkeys-to-sequentials [[k v]]
(if (contains? hook-fastkeys k)
(sequential? v)
true)))))
(defn role-
"Removes a role from GameObject `obj` on key `k`. Any hook or state
attached to `obj` on key `k` will be removed. Returns `nil`."
[obj k]
(let [abs (cmpts obj ArcadiaBehaviour)]
(loop [i (int 0)]
(when (< i (count abs))
(let [^ArcadiaBehaviour ab (aget abs i)]
(.RemoveFunction ab k)
(recur (inc i))))))
(state- obj k)
nil)
(s/fdef role+
:args (s/cat :obj any? ;; for now #(satisfies? ISceneGraph %)
:k any?
:spec ::role)
:ret any?
:fn (fn [{:keys [obj]} ret]
(= obj ret)))
(defn role+
"Adds a role `r` to GameObject `obj` on key `k`, replacing any
previous role on `k`. Keys in `r` corresponding to Unity event
functions, such as `:update`, `:on-collision-enter`, etc, are
expected to have values meeting the criteria for hook functions
described in the docstring for `hook+`. For such a key `event-kw`,
values will be attached to `obj` as though by `(hook+ obj event-kw
k (get r event-kw))`.
If present, the value of the key `:state` in `r` will be attached to
`obj` as though by `(state+ obj k (get r :state))`.
For example,
```clj
(role+
obj,
:example-role,
{:state 45, {:update #'on-update, :on-collision-enter #'on-collision-enter}})
```
has the same effect as
```clj
(role- obj :example-role)
(state+ obj :example-role 45)
(hook+ obj :update :example-role #'on-update)
(hook+ obj :on-collision-enter :example-role #'on-collision-enter)
```
As with `state+`, persistent reprsentations `defmutable` data as
values in `:state` will be converted to mutable instances.
Returns `r`."
[obj k r]
(role- obj k)
(reduce-kv
(fn [_ k2 v]
(cond
(hook-types k2)
(hook+ obj k2 k v)
(= :state k2)
(state+ obj k (maybe-mutable v))))
nil
r)
r)
(defn roles+
"Takes a GameObject `obj` and map `rs` containing role keys and role
maps as entries. For each entry in `rs` with key `k` and value `r`,
adds `r` to `obj` on key `k` as though calling
```clj
(role+ obj k r)
```
Returns `rs`."
[obj rs]
(reduce-kv #(role+ obj %2 %3) nil rs)
rs)
(defn roles-
"Takes a GameObject `obj` and collection of keys `ks`. For each key
`k` in `ks`, will remove `k` from `obj`, as if calling
```clj
(role- obj k)
```
Returns `nil`."
[obj ks]
(reduce role- obj ks)
nil)
(s/fdef role
:args (s/cat :obj any? ;; for now ;; #(satisfies? ISceneGraph %)
:k any?)
:ret ::role)
;; TODO: better name
;; also instance vs satisfies, here
;; maybe this should be a definterface or something
;; yeah definitely should be a definterface, this is just here for `defmutable`
(defn- inner-role-step [bldg, ^ArcadiaBehaviour+IFnInfo inf, hook-type-key]
(assoc bldg hook-type-key (.fn inf)))
(defn role
"Returns a map of all hooks and state attached to GameObject `obj` on
key `k`. Within the returned map, keys will be either hook event
keywords such as `:update`, `:on-collision-enter`, etc, or `:state`.
```clj
(hook+ obj :update :test #'on-update)
(state+ obj :test {:speed 3, :mass 4})
(role obj :test)
;; returns:
;; {:state {:speed 3, :mass 4},
;; :update #'on-update}
```"
[obj k]
(let [step (fn [bldg ^ArcadiaBehaviour ab]
(let [hook-type-key (hook->hook-type-key ab)]
(reduce
(fn [bldg ^ArcadiaBehaviour+IFnInfo inf]
(if (= (.key inf) k)
(reduced
(inner-role-step bldg, inf, hook-type-key))
bldg))
bldg
(.ifnInfos ab))))
init (if-let [s (state obj k)]
{:state (maybe-snapshot s)}
{})]
(let [m (reduce step init (cmpts obj ArcadiaBehaviour))]
(if (zero? (count m))
nil
m))))
(defn- roles-step [bldg ^ArcadiaBehaviour ab]
(let [hook-type-key (hook->hook-type-key ab)]
(reduce
(fn [bldg ^ArcadiaBehaviour+IFnInfo inf]
(update bldg (.key inf)
(fn [m]
(inner-role-step m, inf, hook-type-key))))
bldg
(.ifnInfos ab))))
;; map from hook, state keys to role specs
(defn roles
"Returns a map containing all the roles attached to GameObject
`obj`. For each entry in this map, the key is the key of some hooks
or state attached to `obj`, and the value is the map one would get
by calling `(role obj k)` for that key `k`. For example:
```clj
(hook+ obj :update :key-a #'on-update)
(state+ obj :key-a {:speed 3, :mass 4})
(hook+ obj :update :key-b #'other-on-update)
(state+ obj :key-b {:name \"bob\", :health 5})
(roles obj)
;; returns:
;; {:key-a {:state {:speed 3, :mass 4},
;; :update #'on-update},
;; :key-b {:state {:name \"bob\", :health 5},
;; :update #'other-on-update}}
```
Roundtrips with `roles+`."
[obj]
(let [init (if-let [^ArcadiaState arcs (cmpt obj ArcadiaState)]
(reduce-kv
(fn [bldg k v]
(assoc-in bldg [k :state] (maybe-snapshot v)))
{}
(.ToPersistentMap arcs))
{})]
(reduce roles-step init (cmpts obj ArcadiaBehaviour))))
;; ------------------------------------------------------------
;; defrole
(def ^:private hook->args
(-> events/all-events
(mu/map-keys clojurized-keyword)))
(s/def ::defrole-impl
(s/and
(s/cat
:name (s/and symbol? #(contains? hook-types (keyword (name %))))
:args (s/coll-of any? :kind vector?)
:body (s/* any?))
(fn [{:keys [args], nm :name}]
(= (count args) (+ 2 (count (hook->args (keyword (name nm)))))))))
(s/def ::defrole-args
(s/cat
:name symbol?
:body (s/*
(s/alt
:impl ::defrole-impl
:literal-impl (s/cat
:key #(contains? hook-types %)
:val any?)
:state (s/cat :state-kw #{:state} :state any?)))))
(defn- defrole-map-entries [role-name body]
(for [[kind entry] body]
(case kind
:state (let [{state :state} entry]
{:kind kind
:key :state
:value state})
:impl (let [{nm :name, :keys [args body]} entry
nm' (symbol (str role-name "-" (name nm)))]
{:kind kind
:key (clojurized-keyword nm)
:value `(var ~nm')
:def `(defn ~nm' "Role function generated by arcadia.core/defrole." ~args ~@body)})
:literal-impl (let [{:keys [key val]} entry]
{:kind kind
:key key
:value val}))))
;; add documentation string
(defmacro ^:doc/no-syntax
defrole
"`(defrole name entry*)`
Macro for defining roles quickly.
Each entry can be either a key-value pair with a keyword key, such as would normally occur
in a map intended as an Arcadia role, or an inlined function definition.
Normal key-value pairs get inserted into the generated map. For example,
```clj
(defrole movement
:state {:speed 3}
:update #'movement-update)
```
will expand into
```clj
(def movement
{:state {:speed 3}
:update #'movement-update})
```
Inlined function definitions have the following syntax:
`(name [args*] body)`