@@ -1,20 +1,25 @@
11/- *astrolabe
2−/+ naive, default-agent, dbug, agentio
2+/+ *astrolabe, naive, default-agent, dbug, agentio
33/$ udon-to-docu %udon %docu
44|%
55+$ versioned-state
66 $% state-0
7+ state-1
78 ==
8−+$ state-0
9++$ state-0
910 $: %0
1011 spa=spawned
1112 ==
13++$ state-1
14+ $: %1
15+ =opoints
16+ ==
1217::
1318+$ spawned (jug ship ship)
1419+$ card card:agent:gall
1520--
1621%- agent:dbug
17−=| state-0
22+=| state-1
1823=* state -
1924^- agent:gall
2025=<
@@ -26,16 +31,18 @@
2631++ on-init
2732 ^- (quip card _this)
2833 :_ this
29− [%pass /azimuth-events %agent [our.bowl %azimuth] %watch /event]~
34+ [az-events-card:hc]~
3035::
3136++ on-save !>(state)
3237++ on-load
3338 |= old-state=vase
3439 ^- (quip card _this)
3540 =/ old !<(versioned-state old-state)
36− ?- -.old
37− %0 `this(state old)
38− ==
41+ =^ cards-0 old
42+ ?. ?=(%0 -.old) `old
43+ (on-naive-state:hc get-nas:hc)
44+ ?> ?=(%1 -.old)
45+ [cards-0 this(state old)]
3946++ on-poke on-poke:def
4047++ on-watch on-watch:def
4148++ on-leave on-leave:def
@@ -46,15 +53,18 @@
4653 ?+ path (on-peek:def path)
4754 [%x %point @ ~]
4855 ``astrolabe-point+!>((get-point:hc &3.path))
56+ [%x %point @ %spawned ~]
57+ =/ =ship `@p`(slav %p &3.path)
58+ ``astrolabe-point-set+!>((get-spawned-points:hc ship))
59+ [%x %search @ ~]
60+ =/ =search-text (trip &3.path)
61+ ``astrolabe-point-set+!>((search-opoints:hc search-text))
4962 [%x %doc ^]
5063 =/ doc-path=^path t.t.path
5164 =/ doc (read-doc:hc doc-path)
5265 ?~ doc
5366 `~
5467 ``json+!>(s+u.doc)
55− [%x %spawned @ ~]
56− =/ =ship `@p`(slav %p &3.path)
57− ``astrolabe-point-set+!>((~(get ju spa) ship))
5868 ==
5969++ on-agent
6070 |= [=wire =sign:agent:gall]
@@ -97,35 +107,34 @@
97107++ on-fail on-fail:def
98108--
99109::
110+:: Helper Core
100111|_ =bowl:gall
101112++ scrio ~(scry agentio bowl)
102−++ put-in-spa
113+++ az-events-card [%pass /azimuth-events %agent [our.bowl %azimuth] %watch /event]
114+++ get-nas .^(^state:naive %gx (scrio %azimuth /nas/noun))
115+++ put-in-opoints
103116 |= =ship
104− ^- _spa
105− =/ parent=^ship (^sein:title ship)
106− ?: =(parent ship)
107− spa
108− (~(put ju spa) parent ship)
117+ ^- _opoints
118+ (put:ors opoints (to-q ship) ~)
109119++ on-naive-state
110120 |= nas=^state:naive
111121 ^- (quip card _state)
112− =+ points=points.nas :: =points, eh?
113− =. spa
122+ =+ points=points.nas :: =points, eh?
123+ =. opoints
114124 |-
115− ^- _spa
116− ?~ points spa
125+ ^- _opoints
126+ ?~ points opoints
117127 =/ =ship -.n.points
118− :: traverse tree of points and add @ps to spa with ^sein, you know
119− =. spa (put-in-spa ship)
120− $(points l.points, spa $(points r.points))
128+ :: traverse tree of points and add @ps to opoints with ^sein, you know
129+ =. opoints (put-in-opoints ship)
130+ $(points l.points, opoints $(points r.points))
121131 `state
122132::
123133++ on-naive-diff
124134 |= =diff:naive
125135 ^- (quip card _state)
126− :: =? spa (is-spawn-tx diff)
127− =? spa ?=([%tx [* * * %spawn ship *] *] diff)
128− %- put-in-spa
136+ =? opoints ?=([%tx [* * * %spawn ship *] *] diff)
137+ %- put-in-opoints
129138 ship.tx.raw-tx.diff
130139 `state
131140::
@@ -149,12 +158,81 @@
149158 |= ship-name=term
150159 .^(unpoint %gx (scrio %azimuth /point/[ship-name]/noun))
151160::
161+++ run-spawned-points
162+ |* [agg=mold targ=ship]
163+ |= f=$-([agg ship] agg)
164+ ^- agg
165+ =/ nas get-nas
166+ =+ points=points.nas
167+ =| agg=agg
168+ |-
169+ ^- _agg
170+ ?~ points
171+ agg
172+ =* n -.n.points
173+ =/ gt=? (por:naive targ n)
174+ ?: |(=(targ n) !gt)
175+ $(points r.points)
176+ =? agg =(targ (end (add 2 (xeb (met 3 targ))) n))
177+ $(points r.points)
178+ =? agg =(targ (^sein:title n))
179+ (f agg n)
180+ $(points l.points)
181+++ get-spawned-points
182+ |= targ=ship
183+ %- (run-spawned-points (list ship) targ)
184+ |= [agg=(list ship) spawn=ship]
185+ [spawn agg]
186+::
152187++ spa-count
153− |= =ship
154− ^- @ud
155− %~ wyt
156− in
157− (~(get ju spa) ship)
188+ |= targ=ship
189+ %- (run-spawned-points @ud targ)
190+ |= [agg=@ud spawn=ship]
191+ +(agg)
192+::
193+++ run-wildcard-search
194+ |* [agg=mold search=search-full =page-info]
195+ |= f=$-([agg @q] agg)
196+ ^- agg
197+ =/ s-syls search-syls.search
198+ ~& s-syls
199+ =/ s-opts search-opts.search
200+ =+ =agg
201+ =+ [llb=.~zod rrb=`@q`(sub (bex 32) 1)]
202+ =| agg-count=@
203+ |-
204+ ^- _agg
205+ ?~ opoints
206+ :: ~& "nothing here, going up"
207+ agg
208+ =* n=@q `@`-.n.opoints
209+ =/ lrb=@q ?: (gth n 0) (sub-d n 1) .~zod
210+ =/ rlb=@q (add-d n 1)
211+ =/ left-view (range-contains-search llb lrb s-opts)
212+ :: ~& "arrived at {<n>}"
213+ :: ~& "left side: {<?:(contains.left-view 'Y' 'N')>} {<llb>} - {<lrb>} contains {<s-opts>}"
214+ =/ right-view (range-contains-search rlb rrb s-opts)
215+ =? agg contains.left-view
216+ $(opoints l.opoints, rrb lrb, s-opts opts.left-view)
217+ =? agg (matches-search s-syls n)
218+ =/ fits (fits-on-page agg-count page-info)
219+ =. agg-count +(agg-count)
220+ ?: fits (f agg n) agg
221+ :: ~& "right side: {<?:(contains.right-view 'Y' 'N')>} {<rlb>} - {<rrb>} contains {<s-opts>}"
222+ =? agg contains.right-view
223+ $(opoints r.opoints, llb rlb, s-opts opts.right-view)
224+ agg
225+::
226+++ search-opoints
227+ |= =search-text
228+ ^- (list ship)
229+ =/ =search-full (search-text-to-search-full search-text)
230+ =/ results
231+ %- (run-wildcard-search (list @q) search-full *page-info)
232+ |= [agg=(list @q) result=@q]
233+ [result agg]
234+ %- flop
235+ (turn results to-p)
158236::
159237++ sponsor-chain
160238 |= =unpoint
@@ -162,14 +240,14 @@
162240 ?~ unpoint ~
163241 =/ sponsor sponsor.net.u.unpoint
164242 ?. has.sponsor ~
165− [who.sponsor ~] :: todo: lookup parent
243+ [who.sponsor ~] :: todo: lookup parent
166244::
167245++ probable-dominion
168246 |= =unpoint
169247 ^- dominion:naive
170248 ?^ unpoint
171249 dominion.u.unpoint
172− %l1 :: todo: lookup parent
250+ %l1 :: todo: lookup parent
173251::
174252++ read-doc
175253 |= =path