-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathLevelSpaceXWGUI.nlogo
1838 lines (1596 loc) · 60.7 KB
/
LevelSpaceXWGUI.nlogo
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
extensions [ls table string xw cf ]
__includes [ "notebook.nls" ]
breed [models model]
breed [entities-breed entity-breed]
directed-link-breed [relationship-links relationship-link]
to show-models
foreach all-observers[
let model-id first ?
let model-table last ?
let model-name table:get model-table "name"
create-models 1 [set label model-name ]
]
layout-circle models 10
end
globals [
tasks ;; this is a table that contains all custom made tasks (i.e. left hand side stuff)
relationships ;; this is a table that contains all relationships (i.e. center stuff)
setup-relationships ;; this is a table that contains all relationships that are run at setup
test-var
wsp
cc
left-column-width
center-column-width
entity-serial
relationship-serial
setup-relationships-serial
base-relationship-height
static-widget-color
]
to startup
setup
end
to setup
ca
ls:reset
set tasks table:make
set relationships table:make
set setup-relationships table:make
;; Adding a levelspace model
let the-type "observer"
;; observers are different so we just manually create them here
let observer-entity table:make
table:put observer-entity "to-string" "LevelSpace"
table:put observer-entity "model" "x"
table:put observer-entity "type" "observer"
table:put observer-entity "args" []
table:put observer-entity "name" "LevelSpace"
table:put observer-entity "builtin" true
table:put observer-entity "visible" true
table:put observer-entity "path" "none"
add-entity observer-entity
set left-column []
set left-column-width 400
set center-column-width 450
set center-column []
set base-relationship-height 110
set static-widget-color blue + 1
set margin 10
setup-notebook
reset-gui
file-open ("LevelSpace_logging.txt")
log-to-file (list "setup run")
reset-ticks
end
to draw-GUI
draw-entity-lister
draw-aux-buttons
draw-relationship-builder
draw-center
end
to draw-aux-buttons
let aux-x (margin * 3) + (left-column-width + center-column-width)
xw:ask "lsgui" [
xw:create-button "run-setups" [
xw:set-label "Run Setup Commands"
xw:set-commands "run-setup-relationships-once"
xw:set-x aux-x
xw:set-y margin
xw:set-width 200
]
xw:create-button "go-once-button" [
xw:set-label "Go once"
xw:set-commands "run-go-relationships-once log-to-file \"go once pressed\""
xw:set-x aux-x
xw:set-y margin + 50
xw:set-width 200
]
xw:create-toggle-button "go-forever" [
xw:set-label "Update commands"
xw:set-label "Go"
xw:set-height 50
xw:set-x aux-x
xw:on-selected?-change [
log-to-file (list "go pressed" xw:selected? relationships )
while [ [ xw:selected? ] xw:of "go-forever"] [
run-go-relationships-once
]
]
xw:set-x aux-x
xw:set-y margin + 100
xw:set-width 200
]
xw:create-slider "run-speed" [
xw:set-color static-widget-color
xw:set-label "Run Step Delay"
xw:set-units "ms"
xw:set-maximum 1000
xw:set-value 300
xw:set-increment 100
xw:set-x aux-x
xw:set-y margin + 150
xw:set-width 200
]
xw:create-button "load-new-model" [
xw:set-label "Open Model"
xw:set-commands "load-and-setup-model user-file"
xw:set-x aux-x
xw:set-y margin + 200
xw:set-width 200
]
xw:create-button "save-work" [
xw:set-label "Save LevelSpace System"
xw:set-commands "save-to-one-file"
xw:set-x aux-x
xw:set-y margin + 250
xw:set-width 200
]
xw:create-button "load-work" [
xw:set-label "Load LevelSpace System"
xw:set-commands "load-from-one-file"
xw:set-x aux-x
xw:set-y margin + 300
xw:set-width 200
]
]
end
;; AH: this isc alled at the wrong times.
to draw-relationship-builder
xw:ask "lsgui"
[
xw:create-chooser "setup-or-go" [
xw:set-color static-widget-color
xw:set-label "Show setup or go relationships: "
xw:set-items ["Setup" "Go"]
xw:set-x margin * 2 + left-column-width
xw:set-width center-column-width
;; only find the height of them all except the last because that is itself
xw:set-y margin + sum map [[xw:height] xw:of ?] center-column
set center-column fput "setup-or-go" center-column
]
xw:on-change "setup-or-go" [draw-center]
]
end
to layout-center
let y margin
xw:ask center-column [
xw:set-y y
set y y + xw:height
]
end
to draw-center
clear-center
xw:create-relationship "new-rel"
[
xw:set-color static-widget-color
xw:set-y margin + sum map [[xw:height] xw:of ?] center-column
xw:set-width center-column-width
xw:set-x margin * 2 + left-column-width
xw:set-available-agent-reporters map [(word table:get last ? "model" ":" name-of last ?)] filter [table:get last ? "visible"] all-agent-entities
xw:set-available-procedures []
xw:set-selected-agent-reporter-index 0
xw:on-selected-agent-reporter-change [
update-commands-in-gui "new-rel"
update-agent-args "new-rel"
xw:ask "new-rel" [
xw:set-selected-procedure-arguments []
xw:set-selected-agentset-arguments []
]
layout-center
]
xw:on-selected-procedure-change [
update-command-args "new-rel"
layout-center
]
xw:set-save-command "save-relationship-from-gui \"new-rel\""
set center-column lput "new-rel" center-column
resize-relationship
]
;
;; list existing relationships; first find out if we're looking at startup or go relationships
let the-relationships ifelse-value (xw:get "setup-or-go" = "Go") [relationships][setup-relationships]
foreach table:to-list the-relationships [
let relationship-id first ?
let the-entity last ?
let widget-name (word relationship-id)
let agent-id table:get the-entity "agent-id"
let command-id table:get the-entity "command-id"
xw:create-relationship widget-name [
xw:set-y margin + sum [xw:height] xw:of center-column
xw:set-width center-column-width
set center-column lput (word first ?) center-column
xw:set-x margin * 2 + left-column-width
xw:set-height base-relationship-height
xw:set-available-agent-reporters map [(word table:get last ? "model" ":" name-of last ?)] all-agent-entities
;; in order to set the indices, we need to turn our list of tuples of varname->entity-id into a
;; list of tuples of varname->item.
; let command-arg-id-tuples table:get the-entity "command-arg-id-tuples"
;; AH: we find the dropdown index and set it for agents
xw:set-selected-agent-reporter-index agent-item-from-id agent-id
;; we then update the commands and the agent arts
update-commands-in-gui widget-name
update-agent-args widget-name
let temp-widget-name widget-name
xw:set-up-command (word "move-up " first ? " draw-center")
xw:set-down-command (word "move-down " first ? " draw-center")
xw:on-selected-agent-reporter-change [
update-commands-in-gui temp-widget-name
update-agent-args temp-widget-name
xw:ask temp-widget-name [
xw:set-selected-procedure-arguments []
xw:set-selected-agentset-arguments []
]
]
xw:on-selected-procedure-change [
update-command-args temp-widget-name
]
;; AH: We are finding the item and then setting the procedure/command entity
let command-item command-item-from-agent-and-command-id agent-id command-id
xw:set-selected-procedure-index command-item
;; set the available command args
update-command-args temp-widget-name
;; and finally set the selected args for both agents and procedures
;; at that point we can set the agent arg indices because the agent args are in the dropdowns ( "command-arg-id-tuples")
let agent-arg-id-tuples table:get the-entity "agent-arg-id-tuples"
let agent-arg-item-tuples map [(list (first ?) (item-from-entity-and-id entity-from-id table:get the-entity "agent-id" last ?))] agent-arg-id-tuples
xw:set-selected-agentset-argument-indices agent-arg-item-tuples
let command-arg-id-tuples table:get the-entity "command-arg-id-tuples"
let command-arg-item-tuples map [(list (first ?) (item-from-entity-and-id entity-from-id table:get the-entity "agent-id" last ?))] command-arg-id-tuples
xw:set-selected-procedure-argument-indices command-arg-item-tuples
ifelse xw:get "setup-or-go" = "Go"[
xw:set-delete-command (word "delete-relationship" " " widget-name " draw-center")
xw:set-run-command (word "run-relationship-by-id " relationship-id)
]
[
xw:set-delete-command (word "delete-setup-relationship" " " widget-name " draw-center")
xw:set-run-command (word "run-setup-relationship-by-id " relationship-id)
]
xw:set-save-command (word "save-relationship-from-gui \"" relationship-id "\" xw:remove \"" relationship-id "\" set center-column remove \"" relationship-id "\" center-column draw-center")
]
]
end
;; call this when available-agent-reporters changes.
to update-commands-in-gui [a-relationship-widget]
xw:ask a-relationship-widget [
let chosen-agent-entity selected-agent-entity-from-relationship-widget a-relationship-widget
xw:set-available-procedures map [(word table:get entity-from-id ? "model" ":" name-of entity-from-id ?) ] get-eligible-interactions chosen-agent-entity
]
end
to update-command-args [a-relationship-widget]
xw:ask a-relationship-widget [
;; first find agent-id
let chosen-agent-item [xw:selected-agent-reporter-index] xw:of a-relationship-widget
;; Ok, now we have the item. Since this is always the same, it's easy to look this up.
let acting-entity-id agent-entity-id-from-item chosen-agent-item
;; then find command-id
let chosen-command-item [xw:selected-procedure-index] xw:of a-relationship-widget
;; then get the from the agent selector
let chosen-agent selected-agent-entity-from-relationship-widget a-relationship-widget
;; so that we can get the command entity-id (because agent disambiguates that)
let command-entity-id command-entity-id-from-item chosen-agent chosen-command-item
let args get-arg-tuples-with-deps acting-entity-id command-entity-id
xw:set-available-procedure-arguments args
resize-relationship
]
end
;;AH: @TODO this (and with command args) is where we need to deal with getting them without the string splitting. It shouldn't be that hard
;; I just need to pass the list of indices or something. Or maybe the entity itself.
to update-agent-args [a-relationship-widget ]
xw:ask a-relationship-widget [
let chosen-agent-item [xw:selected-agent-reporter-index] xw:of a-relationship-widget
;; Ok, now we have the item. Since this is always the same, it's easy to look this up.
let acting-entity-id agent-entity-id-from-item chosen-agent-item
let args get-arg-tuples-with-deps acting-entity-id acting-entity-id
xw:set-available-agentset-arguments args
resize-relationship
]
end
to resize-relationship
;; 29 was determined empirically - bch
xw:set-height base-relationship-height + 29 * (length xw:available-agentset-arguments + length xw:available-procedure-arguments)
end
to-report get-arg-tuples-with-deps [identity-id-elig identity-id-args ]
let eligibility-entity entity-from-id identity-id-elig
let arg-entity entity-from-id identity-id-args
let the-args get-args arg-entity
let outer []
let eligible-args get-eligible-arguments eligibility-entity
foreach the-args [
let tuple (list ? map [(word table:get last ? "model"":" table:get last ? "name")] eligible-args)
set outer lput tuple outer
]
report outer
end
to delete-relationship [a-widget]
log-to-file (list "deleting go-relationship " a-widget table:get relationships a-widget)
table:remove relationships a-widget
end
to delete-setup-relationship [a-widget]
log-to-file (list "deleting setup-relationship " a-widget table:get setup-relationships a-widget)
table:remove setup-relationships a-widget
end
to save-relationship-from-gui [a-widget]
;; find the agent
let chosen-agent-item [xw:selected-agent-reporter-index] xw:of a-widget
;; Ok, now we have the item. Since this is always the same, it's easy to look this up.
let acting-entity-id agent-entity-id-from-item chosen-agent-item
let acting-entity entity-from-id acting-entity-id
let acting-entity-name name-of acting-entity
; and now do the same for the procedure
let chosen-command-item [xw:selected-procedure-index] xw:of a-widget
let command-entity-id command-entity-id-from-item acting-entity chosen-command-item
let command-entity entity-from-id command-entity-id
let command-entity-name name-of command-entity
let acting-args get-args acting-entity
let agent-arg-indices [xw:selected-agentset-argument-indices] xw:of a-widget
let acting-actuals actuals-from-item-tuples acting-entity agent-arg-indices
let command-args get-args command-entity
let command-arg-indices [xw:selected-procedure-argument-indices ] xw:of a-widget
; The agent determined which arguments are eligible. BCH 5/6/2015
let command-actuals actuals-from-item-tuples acting-entity command-arg-indices
;; and create a relationship (a table with all the info we want )
let the-relationship add-relationship "N/A" acting-entity-name acting-actuals command-entity-name command-actuals command-args acting-args acting-entity-id command-entity-id
;; and now add it to the right place
let relationship-type xw:get "setup-or-go"
;;AH: instead, we will create a list of args + the ENTITY id (not just their item number). We can do a loookup later.
let command-arg-id-tuples map [(list first ? (arg-from-entity-and-index acting-entity last ?) )] command-arg-indices
let agent-arg-id-tuples map [(list first ? (arg-from-entity-and-index acting-entity last ?) )] agent-arg-indices
table:put the-relationship "command-arg-id-tuples" command-arg-id-tuples
table:put the-relationship "agent-arg-id-tuples" agent-arg-id-tuples
let the-table ifelse-value (relationship-type = "Go") [relationships] [setup-relationships]
log-to-file (list "saving relationships" (list the-relationship relationship-type a-widget))
ifelse a-widget = "new-rel"[
let rel-id 1 + max (sentence [-1] (table:keys relationships) (table:keys setup-relationships))
table:put the-table rel-id the-relationship
]
[
;; runresult because a-widget is a string, we want a number
table:put the-table (runresult a-widget) the-relationship
]
draw-center
end
; AH: ATTENTION BRYAN, this is where we need to deal with wrapping literals in tasks
to-report actuals-from-item-tuples [the-entity list-of-var-item-tuples]
;; we get a list of tuples, e.g. [["m" 0] ["n" 0]] ["name" item]. We need to turn that into a list of tasks
let ids-of-eligible-args map [first ?] get-eligible-arguments the-entity
let ids-of-actuals []
foreach list-of-var-item-tuples [
;; AH: if (last ?) = -1, it is a literal.
;; get the id at the position of the selected item from the dropdown
let the-actual-id item (last ?) ids-of-eligible-args
set ids-of-actuals lput the-actual-id ids-of-actuals
]
report map [get-task entity-from-id ?] ids-of-actuals
end
to draw-entity-lister
xw:ask "lsgui" [
;; create the models chooser
xw:create-chooser "Models" [
xw:set-color static-widget-color
xw:set-label "Models"
xw:set-items map [name-of entity-from-id ?] map [first ?] all-observers
xw:set-width left-column-width
xw:set-x margin
xw:set-y margin
; xw:on-selected-item-change [show-it]
set left-column lput "Models" left-column
]
xw:create-chooser "data-types" [
xw:set-color static-widget-color
xw:set-label "Show this model's entities of type: "
xw:set-items ["Extended Agents" "Reporters" "Commands"]
xw:set-selected-item "Extended Agents"
xw:set-x margin
xw:set-width left-column-width
;; only find the height of them all except the last because that is itself
xw:set-y margin + sum map [[xw:height] xw:of ?] butlast xw:widgets
set left-column lput "data-types" left-column
]
;; take last letter out to remove pluralization
let the-type substring xw:get "data-types" 0 (length xw:get "data-types" - 1)
;; add widget for creating new entities:
xw:create-procedure-widget "new thing" [
xw:set-name (word "New " the-type)
xw:set-x margin
xw:set-height 150
xw:set-width left-column-width
xw:set-y margin + sum map [[xw:height] xw:of ?] left-column
set left-column lput "new thing" left-column
xw:set-color static-widget-color
xw:set-save-command (word "save-entity-from-widget \"new thing\" \"new\" ")
]
]
xw:on-change "Models" [show-it]
xw:on-change "data-types" [show-it xw:ask "new thing" [xw:set-name (word "New " substring xw:get "data-types" 0 (length xw:get "data-types" - 1))] ]
end
to show-it
;; first remove everythign in left column except the three main buttons
clear-left
let the-entities [] ;; this contains all the types of this widget
let the-type 0 ;; this goes in the 'new' entity widget
if xw:get "data-types" = "Extended Agents"[
set the-entities sentence get-from-model-all-types table:get entity xw:get "Models" "model" "observer" get-from-model-all-types table:get entity xw:get "Models" "model" "agentset"
set the-type "agentset"
]
if xw:get "data-types" = "Reporters"[
set the-entities sentence get-from-model-all-types table:get entity xw:get "Models" "model" "value" get-from-model-all-types table:get entity xw:get "Models" "model" "reporter"
set the-type "reporter"
]
if xw:get "data-types" = "Commands"[
set the-entities get-from-model-all-types table:get entity xw:get "Models" "model" "command"
set the-type "command"
]
; add entities to the gui
foreach reverse the-entities [add-entity-to-col ?]
end
to add-entity-to-col [an-entity ]
let the-entity last an-entity ;; ok, this naming is shit. we need to fix that at some point
let the-name name-of the-entity
let entity-id first an-entity
;; if it's builtin we just create a display widget for it
ifelse table:get the-entity "builtin"[
xw:create-procedure-display-widget name-of entity-from-id entity-id [
; xw:set-code to-string an-entity
xw:set-name the-name
xw:set-x margin
xw:set-height 68
xw:set-color grey
xw:set-width left-column-width
xw:set-args string:from-list get-args the-entity " "
xw:set-y margin + sum map [[xw:height] xw:of ?] left-column
set left-column lput the-name left-column
xw:on-visible?-change [
if table:get the-entity "visible" != xw:visible? [
table:put the-entity "visible" xw:visible?
draw-center
]
]
xw:set-visible? table:get the-entity "visible"
]
]
[
;; create a widget for it that has its name
xw:create-procedure-widget name-of entity-from-id entity-id [
xw:set-code to-string an-entity
xw:set-name the-name
xw:set-x margin
xw:set-height 150
xw:set-width left-column-width
xw:set-args string:from-list get-args the-entity " "
xw:set-y margin + sum map [[xw:height] xw:of ?] left-column
set left-column lput the-name left-column
xw:set-save-command (word "save-entity-from-widget \"" the-name "\" " entity-id "")
xw:set-delete-command (word "delete-entity " entity-id " true")
]
]
end
to delete-entity [an-id prompt-user?]
;; check if it is being used first
let entity-name name-of entity-from-id an-id
let no-of-relationships length relationships-with-entity-id an-id
if no-of-relationships = 0 or prompt-user? or
user-yes-or-no? (word entity-name " is in " no-of-relationships " relationships. If you delete it, these relationships will be deleted too")
[
log-to-file (word "deleting entity " (list an-id entity-name table:get tasks an-id))
;; delete relationships first
delete-dependencies an-id
table:remove tasks an-id
]
show-it
draw-center
end
to delete-dependencies [ entity-id ]
foreach map [first ?] relationships-with-entity-id entity-id [
table:remove relationships ?
]
end
to-report to-string [an-entity]
report table:get last an-entity "to-string"
end
to run-relationship [ rel-obj ]
let agent-obj table:get tasks (table:get rel-obj "agent-id")
let cmd-obj table:get tasks (table:get rel-obj "command-id")
let cmd-model table:get cmd-obj "model"
let cmd-args map last table:get rel-obj "command-arg-id-tuples"
let agent-type table:get agent-obj "type"
let agent-model table:get agent-obj "model"
let agent-args map last table:get rel-obj "agent-arg-id-tuples"
let agent-arg-vals eval-args "x" "" agent-args
(cf:match agent-type
cf:= "observer" [
let cmd-arg-vals eval-args "x" "" cmd-args
let code get-code cmd-obj 1
ifelse agent-model = "x" [
;; Kinda gross, but we need to be able to run with task args
(run (runresult (word "task [" code "]")) cmd-arg-vals)
] [
(ls:ask cmd-model code cmd-arg-vals)
]
]
cf:case [ ? = "agentset" and agent-model = cmd-model ] [
;; BCH - Since the arguments may be from other models, and since they may change from
;; agent to agent, we have to do this looping ourselves.
foreach (get-agent-list agent-obj agent-arg-vals) [
let cmd-arg-vals eval-args agent-model ? cmd-args
(ls:ask cmd-model (word "ask " ? " [ " (get-code cmd-obj 1) " ]") cmd-arg-vals)
]
]
cf:= "agentset" [
foreach (get-agent-list agent-obj agent-arg-vals) [
let cmd-arg-vals eval-args agent-model ? cmd-args
(ls:ask cmd-model (get-code cmd-obj 1) cmd-arg-vals)
]
]
)
end
to-report get-agent-list [ agent-obj args ]
report (ls:report
(table:get agent-obj "model")
(word "[(word self)] of " (get-code agent-obj 1))
args
)
end
to-report eval-args [agent-model self-string args]
report map [ eval-raw agent-model self-string table:get tasks ? ] args
end
to-report eval-raw [agent-model self-string obj]
let model table:get obj "model"
let code table:get obj "to-string"
report (cf:cond-value
cf:case [ model = "x" ] [ runresult code ]
cf:case [ model = agent-model ] [ (ls:report agent-model (word "[ " code " ] of " self-string)) ]
cf:else [ ls:report model code ]
)
end
to-report get-code [ obj arg-num ]
report make-variadic-task (table:get obj "to-string") (table:get obj "args") arg-num
end
;; arg-num is the number that the single argument will be given
to-report make-variadic-task [astring args arg-num]
;; first turn args into a list, so we can compare full words. (If it's a string, 'test' is a member of 'test2')
; show (list astring args)
let arg-no 0
let sb []
;; add spaces so that we can test for hard brackets
set astring add-spaces astring
foreach string:rex-split astring "\\s" [
ifelse member? ? args[
set sb lput (word "(item " (position ? args) " ?" arg-num ")") sb
]
[
set sb lput ? sb
]
]
report string:from-list sb " "
end
to-report new-entity [name model task-string args the-type permitted-contexts]
let task-table table:make
table:put task-table "name" name
table:put task-table "model" model
table:put task-table "to-string" task-string
if length args > 0 [
set task-string (make-variadic-task task-string args 1)
]
table:put task-table "args" args
table:put task-table "type" the-type
table:put task-table "contexts" permitted-contexts
table:put task-table "visible" true
table:put task-table "builtin" false
;; special case tasks created in the LevelSpace/Metaverse or whatever stupid name Bryan insists on. <3 <3
ifelse model = "x" [
table:put task-table "task" task [ run-result task-string ]
] [
let task-from-model ls:report model (word "task [ " task-string " ]")
;; in terms of knowing how to compile the tasks, we need to know two things:
;; first, is it a command or a reporter - this is in the 'the-type' variable
;; second, is it runnable from the Observer context.
;; Observer commands/reporters need to be compiled like this:
;;;;; task [ls:report model task-string]
;; non-observer ones need to be compiled like thi:
;;;;; ls:report model (word "task [ " task-string " ]")
; show task-from-model task-string
ifelse is-reporter-task? task-from-model
[
;; observer reproters here
ifelse member? "O" permitted-contexts[
table:put task-table "task" task [(ls:report model task-string ?)]
]
;; turtle reporters here
[
table:put task-table "task" ls:report model (word "task [ " task-string " ]")
]
]
;; or it is a command task\
[
;; observer commands are command tasks that are compiled in the observer of the parent model,
ifelse member? "O" permitted-contexts[
table:put task-table "task" task [(ls:ask model task-string ?)]
]
;; turtle commands here:
[
;; turtle commands are tasks that are compiled in the context of the child model's observer
table:put task-table "task" ls:report model (word "task [ " task-string " ]")
]
]
]
report task-table
end
to-report get-eligible-interactions [an-entity]
let the-type table:get an-entity "type"
;; if it's an observer, they can call observer commands in their own model
if the-type = "observer"[
report map [first ?] filter [
table:get last ? "type" = "command" and
member? "O" table:get last ? "contexts"
and table:get last ? "visible"
]
table:to-list tasks
]
;; if it's an agentset, they can call turtle commands in their own model or observer commands in other models
if the-type = "agentset"[
report map [first ?] filter [
((table:get last ? "type" = "command" and
member? "T" table:get last ? "contexts" and
table:get last ? "model" = table:get an-entity "model"
)
or
(table:get last ? "type" = "command" and
member? "O" table:get last ? "contexts" and
table:get last ? "model" != table:get an-entity "model"))
and table:get last ? "visible"
]
table:to-list tasks
]
if the-type = "value"[
report filter [
table:get last ? "type" = "value" and
table:get last ? "visible"
]
table:to-list tasks
]
user-message (word "Something went wrong getting interactions for " name-of an-entity)
; report
end
to load-and-setup-model [model-path]
if is-string? model-path [
let load-file last string:rex-split model-path "/"
print (word "loading: " load-file)
let the-model 0
(ls:load-gui-model load-file [set the-model ?])
;; add the observer of the model
add-observer the-model load-file
;; add all a models procedures
add-model-procedures the-model
;; and globals
add-model-globals the-model
;; and breeds
add-model-breeds the-model
;; and breed variables
add-model-breed-vars the-model
log-to-file (list "model loaded" load-file)
reset-gui
]
end
to add-observer [the-model model-path]
let name (word the-model ":" ls:name-of the-model)
let the-type "observer"
;; observers are different so we just manually create them here
let observer-entity table:make
table:put observer-entity "to-string" name
table:put observer-entity "model" the-model
table:put observer-entity "type" the-type
table:put observer-entity "args" []
table:put observer-entity "name" name
table:put observer-entity "visible" true
table:put observer-entity "builtin" true
table:put observer-entity "path" model-path
add-entity observer-entity
end
to add-model-procedures [the-model]
foreach ls:_model-procedures the-model [
let procedure-name string:lower-case first ?
let args map [string:lower-case ?] last ?
let the-type string:lower-case item 1 ?
let args-string ""
;; procedures always have postfix argument, so this is easy:
repeat length args [set args-string (word args-string " ?")]
let task-string string:lower-case (word procedure-name args-string)
let the-entity new-entity procedure-name the-model task-string args the-type item 2 ?
table:put the-entity "visible" true
table:put the-entity "builtin" true
add-entity the-entity
]
end
to add-model-globals [the-model]
foreach ls:_globals the-model [
let global-name string:lower-case ?
let args []
;; not sure if these should be reporters (which they technically are) or 'globals' since we probably don't want to SET
;; reporters, but we may want to set globals?
;; setting to value now, might not be right though......
let the-type "reporter"
let the-entity new-entity global-name the-model global-name args the-type "OTLP"
table:put the-entity "builtin" true
add-entity the-entity
]
end
to add-model-breeds [the-model]
foreach map [first ?] ls:_list-breeds the-model [
let agents string:lower-case ?
let args []
;; not sure if these should be reporters (which they technically are) or 'globals' since we probably don't want to SET
;; reporters, but we may want to set globals?
;; setting to value now, might not be right though......
let the-type "agentset"
let the-entity new-entity agents the-model agents args the-type "OTLP"
table:put the-entity "builtin" true
add-entity the-entity
]
;; finally add patches, links, and turtles
foreach (list "patches" "links")[
let agents ?
let args []
;; not sure if these should be reporters (which they technically are) or 'globals' since we probably don't want to SET
;; reporters, but we may want to set globals?
;; setting to value now, might not be right though......
let the-type "agentset"
let the-entity new-entity agents the-model agents args the-type "OTLP"
table:put the-entity "builtin" true
add-entity the-entity
]
end
;; this needs to be rewritten so that it takes an entity and a literal, and then figures out how to turn
;; the literal into a task that takes into account the entity
to-report literal-to-task [an-entity a-literal]
; show (list an-entity a-literal)
let the-type type-of an-entity
if the-type = "agentset"[
let the-task ls:report table:get an-entity "model" (word "task [ " a-literal " ]")
report the-task
]
if the-type = "observer" [
let atask task [ls:report table:get an-entity "model" a-literal]
report atask
]
;; if it's neither, something went wrong
report false
end
to-report entity-name-to-task [entity-name]
report get-task entity entity-name
end
to-report arg-to-task [arg]
;; it's either an entity key, or it's a literal. In the case of the former we get the task
if member? arg table:keys tasks[
report get-task table:get tasks arg
]
;; incase of the latter, we wrap literal arguments in a reporter task here
if (is-number? arg or is-string? arg or is-list? arg)[
report task [arg]
]
end
to-report all-relationships
report map [?] table:to-list relationships
end
;;; accessing tasks and relationships
to-report get-task [the-entity]
report table:get the-entity "task"
end
to-report get-string [the-entity]
report table:get the-entity "to-string"
end
to-report get-model [the-entity]
report table:get the-entity "model"
end
;;; test this and see.
to-report entity [entity-name]
; show entity-name
report last last filter [table:get last ? "name" = entity-name] table:to-list tasks
end
;;AH: Turn this into a reporter, pass it back, and then decide back in the previous
to-report add-relationship [atask entity1-name arg1 entity2-name arg2 arg1string arg2string ent1-id ent2-id]
let relationship-table table:make
table:put relationship-table "agent-name" entity1-name
table:put relationship-table "agent-id" ent1-id
table:put relationship-table "command-name" entity2-name
table:put relationship-table "command-id" ent2-id
table:put relationship-table "agent-actuals" arg1
table:put relationship-table "command-actuals" arg2
table:put relationship-table "command-arg-names" arg1string
table:put relationship-table "agent-arg-names" arg2string
table:put relationship-table "task" atask
report relationship-table
end
to add-entity [atask-table]
table:put tasks entity-serial atask-table
set entity-serial entity-serial + 1
end
;; We use this for loading old stuff to ensure ids match
to add-entity-with-id [atask-table an-id]
table:put tasks an-id atask-table
set entity-serial entity-serial + 1
end
to-report all-agent-entities
report filter [table:get last ? "type" = "agentset" or table:get last ? "type" = "observer"] table:to-list tasks
end
to-report all-observers
report filter [table:get last ? "type" = "observer"] table:to-list tasks
end
to-report model-entities [model-id]
report filter [table:get last ? "model" = model-id] table:to-list tasks
end
to-report get-from-model-all-types [model-id a-type]
report filter [table:get last ? "type" = a-type and table:get last ? "model" = model-id ] table:to-list tasks
end
to-report get-eligible-arguments [an-entity]
let observer? table:get an-entity "type" = "observer"
let model table:get an-entity "model"
let args filter [
table:get last ? "type" = "reporter" and
table:get last ? "args" = [] and
(not observer? or member? "O" table:get last ? "contexts") and
(model = table:get last ? "model" or member? "O" table:get last ? "contexts") and
table:get last ? "visible"
] table:to-list tasks
report args
end
to-report agent-names
report map [first ?] all-agent-entities
end
;; I'm not sure how (or even if) this deals with patches and links. Only turtles so far
to add-model-breed-vars [a-model]
foreach ls:_list-breeds a-model [
let the-breed first ?
let the-vars last ?
foreach the-vars [
let entity-name (word ? " (" the-breed ")" )
let entity-type "reporter"
let entity-otpl "-T--"
; let the-task task [runresult ?]
let the-string ?
let args []
let the-entity new-entity entity-name a-model the-string args entity-type entity-otpl
table:put the-entity "builtin" true
add-entity the-entity
]
]
end
to-report get-args [an-entity]
report table:get an-entity "args"
end
to update-output