2016-04-08 20:08:05 +03:00
|
|
|
:: :: ::
|
|
|
|
|
:::: /hoon/womb/lib :: ::
|
|
|
|
|
:: :: ::
|
|
|
|
|
/? 310 :: version
|
|
|
|
|
/+ talk
|
|
|
|
|
:: :: ::
|
|
|
|
|
:::: :: ::
|
|
|
|
|
:: :: ::
|
|
|
|
|
|%
|
2016-04-12 22:02:59 +03:00
|
|
|
++ foil :: ship allocation map
|
2016-04-08 20:08:05 +03:00
|
|
|
|* mold :: entry mold
|
2016-04-12 22:02:59 +03:00
|
|
|
$: min/@p :: minimum entry
|
|
|
|
|
ctr/@p :: next allocated
|
|
|
|
|
und/(set @p) :: free under counter
|
|
|
|
|
ove/(set @p) :: alloc over counter
|
|
|
|
|
max/@p :: maximum entry
|
|
|
|
|
box/(map @p +<) :: entries
|
2016-04-08 20:08:05 +03:00
|
|
|
== ::
|
|
|
|
|
-- ::
|
2016-04-12 22:02:59 +03:00
|
|
|
:: $: min/@p
|
|
|
|
|
:: mid/@p
|
|
|
|
|
:: max/@p
|
|
|
|
|
:: box/(map @p (each mail ))
|
|
|
|
|
:: ==
|
|
|
|
|
|
|
|
|
|
:: |%
|
|
|
|
|
:: ++ ships (list {min/@p mid/@p max/@p ish/(map @p state)})
|
|
|
|
|
:: ++ state ?($given $split {$~ mail})
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
:: ++
|
2016-04-08 20:08:05 +03:00
|
|
|
|% ::
|
|
|
|
|
++ managed :: managed plot
|
|
|
|
|
|* mold ::
|
2016-04-12 22:02:59 +03:00
|
|
|
%- unit :: unsplit
|
2016-04-08 20:08:05 +03:00
|
|
|
%+ each +< :: subdivided
|
|
|
|
|
mail :: delivered
|
|
|
|
|
:: ::
|
2016-04-12 22:02:59 +03:00
|
|
|
++ divided
|
|
|
|
|
|* (managed)
|
|
|
|
|
?- +<
|
|
|
|
|
$~ ~
|
|
|
|
|
{$~ $| *} ~
|
|
|
|
|
{$~ $& *} (some p.u.+<)
|
|
|
|
|
==
|
|
|
|
|
::
|
|
|
|
|
++ moon (managed _!!) :: undivided moon
|
|
|
|
|
::
|
2016-04-08 20:08:05 +03:00
|
|
|
++ planet :: subdivided planet
|
|
|
|
|
(managed (lone (foil moon))) ::
|
|
|
|
|
:: ::
|
|
|
|
|
++ star :: subdivided star
|
|
|
|
|
(managed (pair (foil moon) (foil planet))) ::
|
|
|
|
|
:: ::
|
|
|
|
|
++ galaxy :: subdivided galaxy
|
|
|
|
|
(managed (trel (foil moon) (foil planet) (foil star)))::
|
|
|
|
|
:: ::
|
2016-04-12 22:02:59 +03:00
|
|
|
:: ++ new-office
|
|
|
|
|
:: $: galaxies/(map ship state)
|
|
|
|
|
:: planets/(map ship state)
|
|
|
|
|
:: stars/(map ship state)
|
|
|
|
|
:: ==
|
|
|
|
|
:: ++ state
|
|
|
|
|
|
2016-04-08 20:08:05 +03:00
|
|
|
++ passcode @pG :: 64-bit passcode
|
|
|
|
|
++ mail @ta :: email address
|
|
|
|
|
++ balance :: invitation balance
|
|
|
|
|
$: planets/@ud :: planet count
|
|
|
|
|
stars/@ud :: star count
|
|
|
|
|
owner/mail :: owner's email
|
|
|
|
|
history/(list mail) :: transfer history
|
|
|
|
|
== ::
|
|
|
|
|
++ client :: per email
|
|
|
|
|
$: sta/@ud :: unused star refs
|
|
|
|
|
has/(set @p) :: planets owned
|
|
|
|
|
== ::
|
2016-04-13 00:07:02 +03:00
|
|
|
++ property :: subdivided plots
|
|
|
|
|
$: galaxies/(map @p galaxy) :: galaxy
|
|
|
|
|
planets/(map @p planet) :: star
|
|
|
|
|
stars/(map @p star) :: planet
|
2016-04-08 20:08:05 +03:00
|
|
|
== ::
|
|
|
|
|
++ invite ::
|
|
|
|
|
$: who/mail :: who to send to
|
|
|
|
|
pla/@ud :: planets to send
|
|
|
|
|
sta/@ud :: stars to send
|
|
|
|
|
wel/welcome :: welcome message
|
|
|
|
|
== ::
|
|
|
|
|
++ welcome :: welcome message
|
|
|
|
|
$: intro/tape :: in invite email
|
|
|
|
|
hello/tape :: as talk message
|
|
|
|
|
== ::
|
|
|
|
|
++ reference :: affiliate credit
|
|
|
|
|
(unit (each @p mail)) :: ship or email
|
|
|
|
|
-- ::
|
|
|
|
|
:: :: ::
|
|
|
|
|
:::: :: ::
|
|
|
|
|
:: :: ::
|
|
|
|
|
|%
|
|
|
|
|
++ womb-part {$womb $0 womb-pith} :: womb state
|
|
|
|
|
++ womb-pith :: womb content
|
|
|
|
|
$: boss/(unit @p) :: outside master
|
|
|
|
|
bureau/(map passcode balance) :: active invitations
|
2016-04-13 00:07:02 +03:00
|
|
|
office/property :: properties managed
|
2016-04-08 20:08:05 +03:00
|
|
|
hotel/(map mail client) :: everyone we know
|
|
|
|
|
== ::
|
|
|
|
|
-- ::
|
|
|
|
|
:: :: ::
|
|
|
|
|
:::: :: ::
|
|
|
|
|
:: :: ::
|
|
|
|
|
|% :: arvo structures
|
|
|
|
|
++ card ::
|
|
|
|
|
$% {$flog wire flog} ::
|
2016-04-12 22:02:59 +03:00
|
|
|
::{$wait $~}
|
|
|
|
|
:: {$poke
|
|
|
|
|
{$next p/ring} :: update private key
|
|
|
|
|
{$tick p/@pG q/@p} :: save ticket
|
2016-04-08 20:08:05 +03:00
|
|
|
== ::
|
|
|
|
|
++ move (pair bone card) :: user-level move
|
|
|
|
|
--
|
2016-04-12 22:02:59 +03:00
|
|
|
|%
|
|
|
|
|
++ murn-by
|
|
|
|
|
|* {a/(map) b/$-(* (unit))}
|
|
|
|
|
^- ?~(a !! (map _p.n.a _(need (b q.n.a))))
|
|
|
|
|
%- malt
|
|
|
|
|
%+ murn (~(tap by a))
|
|
|
|
|
?~ a $~
|
|
|
|
|
|= _c=n.a ^- (unit _[p.n.a (need (b q.n.a))])
|
|
|
|
|
=+ d=(b q.c)
|
|
|
|
|
?~(d ~ (some [p.c u.d]))
|
|
|
|
|
::
|
|
|
|
|
++ unsplit
|
|
|
|
|
|= a/(map ship (managed)) ^- (list {ship *})
|
|
|
|
|
%+ skim (~(tap by a))
|
|
|
|
|
|=({@ a/(managed)} ?=($~ a))
|
|
|
|
|
::
|
|
|
|
|
++ issuing
|
|
|
|
|
|* a/(map ship (managed))
|
|
|
|
|
^- (list _(need (divided *~(got by a))))
|
|
|
|
|
(turn (sort (~(tap by (murn-by a divided))) lor) tail)
|
|
|
|
|
::
|
|
|
|
|
++ grand-map (map @p czar/(map @p king/(map @p duke/(map @p (set @p)))))
|
|
|
|
|
::++ deep-uni-by
|
|
|
|
|
++ fo
|
|
|
|
|
|_ (foil)
|
|
|
|
|
++ get :: nth
|
|
|
|
|
|= a/@u ^- {(unit @p) @u}
|
|
|
|
|
?: (lth a ~(wyt in und))
|
|
|
|
|
=+ out=(snag a (sort (~(tap in und)) lth))
|
|
|
|
|
[(some out) 0]
|
|
|
|
|
=. a (sub a ~(wyt in und))
|
|
|
|
|
|- ^- {(unit @p) @u}
|
|
|
|
|
?: =(ctr +(max)) [~ a]
|
|
|
|
|
?: =(0 a) [(some ctr) a]
|
|
|
|
|
$(a (dec a), +<.get new)
|
|
|
|
|
::
|
|
|
|
|
++ new :: alloc
|
|
|
|
|
?: =(ctr +(max)) +<
|
|
|
|
|
=. ctr +(ctr)
|
|
|
|
|
?. (~(has in ove) ctr) +<
|
|
|
|
|
new(ove (~(del in ove) ctr))
|
|
|
|
|
::
|
|
|
|
|
++ fit |=(a/@p &((lte min a) (lte a max))) :: in range
|
|
|
|
|
++ gud :: invariant
|
|
|
|
|
?& (fit(max +(max)) ctr)
|
|
|
|
|
(~(all in und) fit(max ctr))
|
|
|
|
|
(~(all in ove) fit(min ctr))
|
|
|
|
|
(~(all in box) |=({a/@p *} (fit a)))
|
|
|
|
|
|- ^- ?
|
|
|
|
|
?: =(min max) &
|
|
|
|
|
=- &(- $(min +(min)))
|
|
|
|
|
%+ gte 1 :: at most one of
|
|
|
|
|
;: add
|
|
|
|
|
?:(=(min ctr) 1 0)
|
|
|
|
|
?:((~(has in und) min) 1 0)
|
|
|
|
|
?:((~(has in ove) min) 1 0)
|
|
|
|
|
?:((~(has by box) min) 1 0)
|
|
|
|
|
==
|
|
|
|
|
==
|
|
|
|
|
--
|
|
|
|
|
--
|
2016-04-08 20:08:05 +03:00
|
|
|
:: :: ::
|
|
|
|
|
:::: :: ::
|
|
|
|
|
!: :: ::
|
|
|
|
|
|= {bowl womb-part} :: main womb work
|
|
|
|
|
|_ moz/(list move)
|
|
|
|
|
++ abet :: resolve
|
2016-04-13 00:07:02 +03:00
|
|
|
^- (quip move *womb-part)
|
|
|
|
|
[(flop moz) +>+<+]
|
2016-04-08 20:08:05 +03:00
|
|
|
::
|
|
|
|
|
++ emit |=(card %_(+> moz [[ost +<] moz])) :: return card
|
|
|
|
|
++ emil :: return cards
|
|
|
|
|
|= (list card)
|
|
|
|
|
^+ +>
|
|
|
|
|
?~(+< +> $(+< t.+<, +> (emit i.+<)))
|
|
|
|
|
::
|
2016-04-12 22:02:59 +03:00
|
|
|
:: ++ huge-set
|
|
|
|
|
:: ^- (map @p ?($xeno $free $divd))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
:: ++ to-grand-map :: XX state format?
|
|
|
|
|
:: ^- grand-map
|
|
|
|
|
:: =+ ofc=invert-office
|
|
|
|
|
:: ;: deep-uni-by
|
|
|
|
|
:: ::
|
|
|
|
|
:: ++ from-grand-map
|
|
|
|
|
:: |= a/grand-map
|
|
|
|
|
:: ^+ office
|
|
|
|
|
|
|
|
|
|
::
|
|
|
|
|
++ cursor (pair (unit ship) @u)
|
|
|
|
|
++ take-3
|
|
|
|
|
|= {nth/@u get/$-(@u cursor)}
|
|
|
|
|
^- (list ship)
|
|
|
|
|
:: =. nth (mul 3 nth)
|
|
|
|
|
:(weld (drop p:(get nth)) (drop p:(get +(nth))) (drop p:(get +(+(nth)))))
|
|
|
|
|
::
|
|
|
|
|
++ available
|
|
|
|
|
|= all/(map ship (managed)) ^- $-(@u cursor)
|
|
|
|
|
=+ pur=(sort (turn (unsplit all) head) lth)
|
|
|
|
|
=+ len=(lent pur)
|
|
|
|
|
|=(a/@u ?:((gte a len) [~ (sub a len)] [(some (snag a pur)) a]))
|
|
|
|
|
::
|
|
|
|
|
++ shop-galaxies
|
|
|
|
|
|= nth/@u ^- (list ship)
|
|
|
|
|
(take-3 nth (available galaxies:invert-office))
|
|
|
|
|
::
|
|
|
|
|
:: Stars can be either whole or children of galaxies
|
|
|
|
|
++ shop-stars
|
|
|
|
|
|= nth/@u ^- (list ship)
|
|
|
|
|
%+ take-3 nth
|
|
|
|
|
|= nth/@u
|
2016-04-13 00:07:02 +03:00
|
|
|
=^ out nth %.(nth (available stars.office))
|
2016-04-12 22:02:59 +03:00
|
|
|
?^ out [out nth]
|
2016-04-13 00:07:02 +03:00
|
|
|
(shop-star nth (issuing galaxies.office))
|
2016-04-12 22:02:59 +03:00
|
|
|
::
|
|
|
|
|
++ shop-star
|
|
|
|
|
|= {nth/@u lax/(list {* * r/(foil star)})} ^- cursor
|
|
|
|
|
?~ lax [~ nth]
|
|
|
|
|
=^ out nth (~(get fo r.i.lax) nth)
|
|
|
|
|
?^ out [out nth]
|
|
|
|
|
$(lax t.lax)
|
|
|
|
|
::
|
|
|
|
|
++ shop-planets
|
|
|
|
|
|= nth/@u ^- (list ship)
|
|
|
|
|
%+ take-3 nth
|
|
|
|
|
|= nth/@u ^- cursor
|
2016-04-13 00:07:02 +03:00
|
|
|
=^ out nth %.(nth (available planets.office))
|
2016-04-12 22:02:59 +03:00
|
|
|
?^ out [out nth]
|
2016-04-13 00:07:02 +03:00
|
|
|
=^ out nth (shop-planet nth (issuing stars.office))
|
2016-04-12 22:02:59 +03:00
|
|
|
?^ out [out nth]
|
2016-04-13 00:07:02 +03:00
|
|
|
(shop-planet-gal nth (issuing galaxies.office))
|
2016-04-12 22:02:59 +03:00
|
|
|
::
|
|
|
|
|
++ shop-planet
|
|
|
|
|
|= {nth/@u sat/(list {* q/(foil planet)})} ^- cursor
|
|
|
|
|
?~ sat [~ nth]
|
|
|
|
|
=^ out nth (~(get fo q.i.sat) nth)
|
|
|
|
|
?^ out [out nth]
|
|
|
|
|
$(sat t.sat)
|
|
|
|
|
::
|
|
|
|
|
++ shop-planet-gal
|
|
|
|
|
|= {nth/@u lax/(list {* * r/(foil star)})} ^- cursor
|
|
|
|
|
?~ lax [~ nth]
|
|
|
|
|
=^ out nth (shop-planet nth (issuing box.r.i.lax))
|
|
|
|
|
?^ out [out nth]
|
|
|
|
|
$(lax t.lax)
|
|
|
|
|
::
|
|
|
|
|
++ peek-x-shop
|
|
|
|
|
|= tyl/path ^- (unit (unit {$ships (list @p)}))
|
|
|
|
|
=; res (some (some [%ships res]))
|
|
|
|
|
=+ ~|(bad-path+tyl (raid tyl typ=%tas nth=%ud ~))
|
|
|
|
|
?. ?=(_-:*property typ)
|
|
|
|
|
~|(bad-type+typ !!)
|
|
|
|
|
?- typ
|
|
|
|
|
$galaxy (shop-galaxies nth)
|
|
|
|
|
$planet (shop-planets nth)
|
|
|
|
|
$star (shop-stars nth)
|
|
|
|
|
==
|
|
|
|
|
::
|
|
|
|
|
++ stats-ship
|
|
|
|
|
|= who/@p ^- (unit (unit (cask _!!)))
|
|
|
|
|
~
|
|
|
|
|
::
|
|
|
|
|
++ peek-x-stats
|
|
|
|
|
|= tyl/path
|
|
|
|
|
?^ tyl
|
|
|
|
|
(stats-ship ~|(bad-path+tyl (raid tyl who=%p ~)))
|
|
|
|
|
^- (unit (unit (cask _!!)))
|
|
|
|
|
~
|
|
|
|
|
::
|
|
|
|
|
++ peek-x-invite
|
|
|
|
|
|= tyl/path ^- (unit (unit {$womb-balance balance}))
|
|
|
|
|
=+ ~|(bad-path+tyl (raid tyl pas=%p ~))
|
|
|
|
|
%- some
|
|
|
|
|
%+ bind (~(get by bureau) pas)
|
|
|
|
|
|=(bal/balance [%womb-balance bal])
|
|
|
|
|
::
|
2016-04-08 20:08:05 +03:00
|
|
|
++ peek
|
|
|
|
|
|= {ren/@tas tyl/path}
|
2016-04-12 22:02:59 +03:00
|
|
|
:: ^- (unit (unit (pair mark *)))
|
|
|
|
|
?. =(ren %x) ~
|
|
|
|
|
?~ tyl ~
|
|
|
|
|
?+ -.tyl ~
|
|
|
|
|
:: /shop/planet/@ud (list @p) up to 3 planets
|
|
|
|
|
:: /shop/star/@ud (list @p) up to 3 stars
|
|
|
|
|
:: /shop/galaxy/@ud (list @p) up to 3 galaxies
|
|
|
|
|
$shop (peek-x-shop +.tyl)
|
2016-04-08 20:08:05 +03:00
|
|
|
:: /stats general stats dump
|
|
|
|
|
:: /stats/@p what we know about @p
|
2016-04-12 22:02:59 +03:00
|
|
|
$stats (peek-x-stats +.tyl)
|
|
|
|
|
:: /invite/passcode invitation status
|
|
|
|
|
$invite (peek-x-invite +.tyl)
|
|
|
|
|
==
|
2016-04-08 20:08:05 +03:00
|
|
|
::
|
|
|
|
|
++ poke-invite :: create invitation
|
|
|
|
|
|= {ref/reference inv/invite}
|
|
|
|
|
=< abet
|
|
|
|
|
?> |(=(our src) =([~ src] boss)) :: me or boss
|
|
|
|
|
.
|
|
|
|
|
::
|
|
|
|
|
++ poke-obey :: set/reset boss
|
|
|
|
|
|= who/(unit @p)
|
|
|
|
|
=< abet
|
|
|
|
|
?> =(our src) :: me only
|
|
|
|
|
.
|
|
|
|
|
::
|
|
|
|
|
++ poke-rekey :: extend will
|
2016-04-12 22:02:59 +03:00
|
|
|
|= $~
|
2016-04-08 20:08:05 +03:00
|
|
|
=< abet
|
|
|
|
|
?> |(=(our src) =([~ src] boss)) :: privileged
|
|
|
|
|
.
|
|
|
|
|
::
|
|
|
|
|
++ poke-report :: report will
|
|
|
|
|
|= {her/@p wyl/will} ::
|
|
|
|
|
=< abet
|
|
|
|
|
?> =(src src) :: self-authenticated
|
|
|
|
|
.
|
|
|
|
|
::
|
|
|
|
|
++ poke-claim :: claim plot, send ticket
|
|
|
|
|
|= {aut/@uvH her/@p} ::
|
|
|
|
|
=< abet
|
2016-04-12 22:02:59 +03:00
|
|
|
?> =(src src)
|
2016-04-08 20:08:05 +03:00
|
|
|
.
|
|
|
|
|
::
|
|
|
|
|
++ poke-release :: release to subdivide
|
|
|
|
|
|= {gal/@ud sta/@ud} ::
|
|
|
|
|
=< abet
|
|
|
|
|
?> =(our src) :: privileged
|
|
|
|
|
.
|
|
|
|
|
::
|
|
|
|
|
++ poke-reinvite :: split invitation
|
|
|
|
|
|= $: aut/@uvH :: hash w/passcode
|
|
|
|
|
inv/invite :: further invite
|
|
|
|
|
==
|
|
|
|
|
?> =(src src) ::
|
|
|
|
|
=< abet
|
|
|
|
|
.
|
|
|
|
|
--
|
