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-13 01:42:49 +03:00
|
|
|
$: min/@u :: minimum entry
|
|
|
|
ctr/@u :: next allocated
|
|
|
|
und/(set @u) :: free under counter
|
|
|
|
ove/(set @u) :: alloc over counter
|
|
|
|
max/@u :: maximum entry
|
|
|
|
box/(map @u +<) :: 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-14 00:06:58 +03:00
|
|
|
++ divided :: get division state
|
|
|
|
|* (managed) ::
|
|
|
|
?- +< ::
|
|
|
|
$~ ~ :: unsplit
|
|
|
|
{$~ $| *} ~ :: delivered
|
|
|
|
{$~ $& *} (some p.u.+<) :: subdivided
|
|
|
|
== ::
|
|
|
|
:: ::
|
2016-04-12 22:02:59 +03:00
|
|
|
++ 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)))::
|
|
|
|
:: ::
|
|
|
|
++ 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
|
2016-04-14 01:03:05 +03:00
|
|
|
:: ::
|
2016-04-15 02:37:13 +03:00
|
|
|
++ reference-rate 2 :: star refs per star
|
2016-04-14 01:03:05 +03:00
|
|
|
++ stat :: external info
|
|
|
|
$% {$free $~} :: unallocated
|
|
|
|
{$owned mail} :: granted
|
|
|
|
{$split (map ship stat)} :: all given ships
|
|
|
|
== ::
|
2016-04-08 20:08:05 +03:00
|
|
|
-- ::
|
|
|
|
:: :: ::
|
|
|
|
:::: :: ::
|
|
|
|
:: :: ::
|
|
|
|
|%
|
2016-04-13 03:10:53 +03:00
|
|
|
++ part {$womb $0 pith} :: womb state
|
|
|
|
++ pith :: womb content
|
2016-04-08 20:08:05 +03:00
|
|
|
$: 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-15 02:37:13 +03:00
|
|
|
hotel/(map (each @p mail) client) :: everyone we know
|
2016-04-08 20:08:05 +03:00
|
|
|
== ::
|
|
|
|
-- ::
|
|
|
|
:: :: ::
|
|
|
|
:::: :: ::
|
|
|
|
:: :: ::
|
|
|
|
|% :: arvo structures
|
|
|
|
++ card ::
|
|
|
|
$% {$flog wire flog} ::
|
2016-04-19 01:15:35 +03:00
|
|
|
{$info wire @p @tas nori} :: fs write (backup)
|
2016-04-15 00:37:16 +03:00
|
|
|
:: {$wait $~} :: delay acknowledgment
|
2016-04-15 04:36:48 +03:00
|
|
|
{$poke wire pear} :: app RPC
|
2016-04-15 00:37:16 +03:00
|
|
|
{$next wire p/ring} :: update private key
|
|
|
|
{$tick wire p/@pG q/@p} :: save ticket
|
|
|
|
{$knew wire p/ship q/will} :: learn will (old pki)
|
2016-04-08 20:08:05 +03:00
|
|
|
== ::
|
2016-04-15 04:36:48 +03:00
|
|
|
++ pear ::
|
|
|
|
$? {{ship $gmail} {$email mail tape}} :: send email
|
|
|
|
{{ship $hood} {$womb-do-claim mail @p}} :: issue ship
|
|
|
|
== ::
|
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))
|
2016-04-13 01:42:49 +03:00
|
|
|
^- (list {ship _(need (divided *~(got by a)))})
|
|
|
|
(sort (~(tap by (murn-by a divided))) lor)
|
|
|
|
::
|
|
|
|
++ issuing-under
|
|
|
|
|* {a/bloq b/ship c/(map @u (managed))}
|
|
|
|
^- (list {ship _(need (divided *~(got by c)))})
|
|
|
|
%+ turn (sort (~(tap by (murn-by c divided))) lor)
|
|
|
|
|*(d/{@u *} [(rep a b -.d ~) +.d])
|
2016-04-12 22:02:59 +03:00
|
|
|
::
|
2016-04-13 00:54:50 +03:00
|
|
|
++ cursor (pair (unit ship) @u)
|
2016-04-15 04:38:31 +03:00
|
|
|
++ neis |=(a/ship ^-(@u (rsh (dec (xeb (dec (xeb a)))) 1 a))) :: postfix
|
2016-04-13 01:59:26 +03:00
|
|
|
::
|
|
|
|
:: Create new foil of size
|
2016-04-13 00:54:50 +03:00
|
|
|
++ fo-init
|
2016-04-13 01:42:49 +03:00
|
|
|
|= a/bloq :: ^- (foil *)
|
|
|
|
[min=1 ctr=1 und=~ ove=~ max=(dec (bex (bex a))) box=~]
|
2016-04-13 00:54:50 +03:00
|
|
|
::
|
2016-04-12 22:02:59 +03:00
|
|
|
++ fo
|
2016-04-14 02:16:23 +03:00
|
|
|
|_ (foil $@($~ *))
|
|
|
|
++ nth :: index
|
2016-04-13 01:42:49 +03:00
|
|
|
|= a/@u ^- (pair (unit @u) @u)
|
2016-04-12 22:02:59 +03:00
|
|
|
?: (lth a ~(wyt in und))
|
|
|
|
=+ out=(snag a (sort (~(tap in und)) lth))
|
|
|
|
[(some out) 0]
|
|
|
|
=. a (sub a ~(wyt in und))
|
2016-04-13 01:42:49 +03:00
|
|
|
|- ^- {(unit @u) @u}
|
2016-04-12 22:02:59 +03:00
|
|
|
?: =(ctr +(max)) [~ a]
|
|
|
|
?: =(0 a) [(some ctr) a]
|
2016-04-14 02:16:23 +03:00
|
|
|
$(a (dec a), +<.nth new)
|
2016-04-12 22:02:59 +03:00
|
|
|
::
|
2016-04-13 00:54:50 +03:00
|
|
|
+- fin +< :: abet
|
2016-04-12 22:02:59 +03:00
|
|
|
++ new :: alloc
|
|
|
|
?: =(ctr +(max)) +<
|
|
|
|
=. ctr +(ctr)
|
|
|
|
?. (~(has in ove) ctr) +<
|
|
|
|
new(ove (~(del in ove) ctr))
|
|
|
|
::
|
2016-04-14 02:16:23 +03:00
|
|
|
+- get :: nullable
|
|
|
|
|= a/@p ^+ ?~(box ~ q.n.box)
|
|
|
|
(fall (~(get by box) (neis a)) ~)
|
|
|
|
::
|
2016-04-13 00:54:50 +03:00
|
|
|
+- put
|
2016-04-13 01:42:49 +03:00
|
|
|
|* {a/@u b/*} ^+ fin :: b/_(~(got by box))
|
|
|
|
~| put+[a fin]
|
2016-04-13 00:54:50 +03:00
|
|
|
?> (fit a)
|
|
|
|
=; adj adj(box (~(put by box) a b))
|
|
|
|
?: (~(has in box) a) fin
|
|
|
|
?: =(ctr a) new
|
|
|
|
?: (lth a ctr)
|
|
|
|
?. (~(has in und) a) fin
|
|
|
|
fin(und (~(del in und) a))
|
|
|
|
?. =(a ctr:new) :: heuristic
|
|
|
|
fin(ove (~(put in ove) a))
|
|
|
|
=+ n=new(+< new)
|
|
|
|
n(und (~(put in und.n) ctr))
|
|
|
|
::
|
2016-04-13 01:42:49 +03:00
|
|
|
++ fit |=(a/@u &((lte min a) (lte a max))) :: in range
|
2016-04-12 22:02:59 +03:00
|
|
|
++ gud :: invariant
|
|
|
|
?& (fit(max +(max)) ctr)
|
|
|
|
(~(all in und) fit(max ctr))
|
|
|
|
(~(all in ove) fit(min ctr))
|
2016-04-13 01:42:49 +03:00
|
|
|
(~(all in box) |=({a/@u *} (fit a)))
|
2016-04-12 22:02:59 +03:00
|
|
|
|- ^- ?
|
|
|
|
?: =(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
|
|
|
:: :: ::
|
|
|
|
:::: :: ::
|
|
|
|
!: :: ::
|
2016-04-13 03:10:53 +03:00
|
|
|
|= {bowl part} :: main womb work
|
2016-04-08 20:08:05 +03:00
|
|
|
|_ moz/(list move)
|
|
|
|
++ abet :: resolve
|
2016-04-13 03:10:53 +03:00
|
|
|
^- (quip move *part)
|
2016-04-13 00:07:02 +03:00
|
|
|
[(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
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ take-n :: compute range
|
2016-04-13 00:07:50 +03:00
|
|
|
|= {{index/@u count/@u} get/$-(@u cursor)}
|
2016-04-12 22:02:59 +03:00
|
|
|
^- (list ship)
|
2016-04-13 00:07:50 +03:00
|
|
|
?~ count ~
|
|
|
|
%+ biff p:(get index)
|
|
|
|
|= a/ship ^- (list ship)
|
|
|
|
[a ^$(index +(index), count (dec count))]
|
2016-04-12 22:02:59 +03:00
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ available :: enumerate free ships
|
2016-04-12 22:02:59 +03:00
|
|
|
|= 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]))
|
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
:: foil cursor to ship cursor, using sized parent
|
2016-04-13 01:42:49 +03:00
|
|
|
++ prefix
|
|
|
|
|= {a/bloq b/@p {c/(unit @u) d/@u}} ^- cursor
|
|
|
|
?~ c [c d]
|
|
|
|
[(some (rep a b u.c ~)) d]
|
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ in-list :: distribute among options
|
2016-04-13 01:59:36 +03:00
|
|
|
|* {a/(list) b/@u} ^+ [(snag *@ a) b]
|
|
|
|
=+ c=(lent a)
|
|
|
|
[(snag (mod b c) a) (div b c)]
|
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
::
|
|
|
|
++ shop-galaxies (available galaxies.office) :: unassigned %czar
|
|
|
|
::
|
|
|
|
:: Stars can be either whole or children of galaxies
|
|
|
|
++ shop-stars :: unassigned %king
|
|
|
|
|= nth/@u ^- cursor
|
|
|
|
=^ out nth %.(nth (available stars.office))
|
|
|
|
?^ out [out nth]
|
|
|
|
(shop-star nth (issuing galaxies.office))
|
|
|
|
::
|
|
|
|
++ shop-star :: star from galaxies
|
2016-04-13 01:42:49 +03:00
|
|
|
|= {nth/@u lax/(list {who/@p * * r/(foil star)})} ^- cursor
|
2016-04-13 01:59:36 +03:00
|
|
|
?: =(~ lax) [~ nth]
|
|
|
|
=^ sel nth (in-list lax nth)
|
2016-04-14 02:16:23 +03:00
|
|
|
(prefix 3 who.sel (~(nth fo r.sel) nth))
|
2016-04-12 22:02:59 +03:00
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ shop-planets :: unassigned %duke
|
2016-04-12 22:02:59 +03:00
|
|
|
|= 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
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ shop-planet :: planet from stars
|
2016-04-13 01:59:36 +03:00
|
|
|
|= {nth/@u sta/(list {who/@p * q/(foil planet)})} ^- cursor
|
|
|
|
?: =(~ sta) [~ nth]
|
|
|
|
=^ sel nth (in-list sta nth)
|
2016-04-14 02:16:23 +03:00
|
|
|
(prefix 4 who.sel (~(nth fo q.sel) nth))
|
2016-04-12 22:02:59 +03:00
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ shop-planet-gal :: planet from galaxies
|
2016-04-13 01:42:49 +03:00
|
|
|
|= {nth/@u lax/(list {who/@p * * r/(foil star)})} ^- cursor
|
2016-04-13 01:59:36 +03:00
|
|
|
?: =(~ lax) [~ nth]
|
|
|
|
=^ sel nth (in-list lax nth)
|
|
|
|
(shop-planet nth (issuing-under 3 who.sel box.r.sel))
|
2016-04-12 22:02:59 +03:00
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ peek-x-shop :: available ships
|
2016-04-12 22:02:59 +03:00
|
|
|
|= tyl/path ^- (unit (unit {$ships (list @p)}))
|
2016-04-13 03:10:53 +03:00
|
|
|
=; a ~& peek-x-shop+[tyl a] a
|
2016-04-12 22:02:59 +03:00
|
|
|
=; res (some (some [%ships res]))
|
2016-04-13 03:10:53 +03:00
|
|
|
=+ [typ nth]=~|(bad-path+tyl (raid tyl typ=%tas nth=%ud ~))
|
2016-04-13 00:07:50 +03:00
|
|
|
:: =. nth (mul 3 nth)
|
|
|
|
?+ typ ~|(bad-type+typ !!)
|
2016-04-13 03:10:53 +03:00
|
|
|
$galaxies (take-n [nth 3] shop-galaxies)
|
|
|
|
$planets (take-n [nth 3] shop-planets)
|
|
|
|
$stars (take-n [nth 3] shop-stars)
|
2016-04-12 22:02:59 +03:00
|
|
|
==
|
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ get-managed-galaxy ~(got by galaxies.office) :: office read
|
|
|
|
++ mod-managed-galaxy :: office write
|
2016-04-13 23:32:45 +03:00
|
|
|
|= {who/@p mod/$-(galaxy galaxy)} ^+ +>
|
|
|
|
=+ gal=(mod (get-managed-galaxy who))
|
|
|
|
+>.$(galaxies.office (~(put by galaxies.office) who gal))
|
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ get-managed-star :: office read
|
2016-04-13 23:32:45 +03:00
|
|
|
|= who/@p ^- star
|
|
|
|
=+ (~(get by stars.office) who)
|
|
|
|
?^ - u
|
|
|
|
=+ gal=(get-managed-galaxy (sein who))
|
2016-04-14 23:49:39 +03:00
|
|
|
?. ?=({$~ $& *} gal) ~|(unavailable-star+(sein who) !!)
|
2016-04-13 23:32:45 +03:00
|
|
|
(fall (~(get by box.r.p.u.gal) (neis who)) ~)
|
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ mod-managed-star :: office write
|
2016-04-13 23:32:45 +03:00
|
|
|
|= {who/@p mod/$-(star star)} ^+ +>
|
2016-04-14 00:06:58 +03:00
|
|
|
=+ sta=(mod (get-managed-star who)) :: XX double traverse
|
2016-04-13 23:32:45 +03:00
|
|
|
?: (~(has by stars.office) who)
|
|
|
|
+>.$(stars.office (~(put by stars.office) who sta))
|
|
|
|
%+ mod-managed-galaxy (sein who)
|
|
|
|
|= gal/galaxy ^- galaxy
|
|
|
|
?> ?=({$~ $& *} gal)
|
|
|
|
gal(r.p.u (~(put fo r.p.u.gal) (neis who) sta))
|
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ get-managed-planet :: office read
|
2016-04-13 23:32:45 +03:00
|
|
|
|= who/@p ^- planet
|
|
|
|
=+ (~(get by planets.office) who)
|
|
|
|
?^ - u
|
|
|
|
?: (~(has by galaxies.office) (sein who))
|
|
|
|
=+ gal=(get-managed-galaxy (sein who))
|
|
|
|
?. ?=({$~ $& *} gal) ~|(unavailable-galaxy+(sein who) !!)
|
2016-04-14 02:16:23 +03:00
|
|
|
(~(get fo q.p.u.gal) who)
|
2016-04-13 23:32:45 +03:00
|
|
|
=+ sta=(get-managed-star (sein who))
|
|
|
|
?. ?=({$~ $& *} sta) ~|(unavailable-star+(sein who) !!)
|
2016-04-14 02:16:23 +03:00
|
|
|
(~(get fo q.p.u.sta) who)
|
2016-04-13 23:32:45 +03:00
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ mod-managed-planet :: office write
|
2016-04-13 23:32:45 +03:00
|
|
|
|= {who/@p mod/$-(planet planet)} ^+ +>
|
2016-04-14 00:06:58 +03:00
|
|
|
=+ pla=(mod (get-managed-planet who)) :: XX double traverse
|
2016-04-13 23:32:45 +03:00
|
|
|
?: (~(has by planets.office) who)
|
|
|
|
+>.$(planets.office (~(put by planets.office) who pla))
|
|
|
|
?: (~(has by galaxies.office) (sein who))
|
|
|
|
%+ mod-managed-galaxy (sein who)
|
|
|
|
|= gal/galaxy ^- galaxy
|
|
|
|
?> ?=({$~ $& *} gal)
|
|
|
|
gal(q.p.u (~(put fo q.p.u.gal) (neis who) pla))
|
|
|
|
%+ mod-managed-star (sein who)
|
|
|
|
|= sta/star ^- star
|
|
|
|
?> ?=({$~ $& *} sta)
|
|
|
|
sta(q.p.u (~(put fo q.p.u.sta) (neis who) pla))
|
|
|
|
::
|
2016-04-14 01:03:05 +03:00
|
|
|
++ stat-any |=(a/(managed _!!) `stat`?~(a [%free ~] [%owned p.u.a]))
|
|
|
|
++ stat-planet
|
|
|
|
|= {who/@p man/planet} ^- stat
|
|
|
|
?. ?=({$~ $& ^} man) (stat-any man)
|
|
|
|
=+ pla=u:(divided man)
|
|
|
|
:- %split
|
|
|
|
%- malt
|
|
|
|
%+ turn (~(tap by box.p.pla))
|
|
|
|
|=({a/@u b/moon} [(rep 5 who a ~) (stat-any b)])
|
|
|
|
::
|
|
|
|
++ stat-star
|
|
|
|
|= {who/@p man/star} ^- stat
|
|
|
|
?. ?=({$~ $& ^} man) (stat-any man)
|
|
|
|
=+ sta=u:(divided man)
|
|
|
|
:- %split
|
|
|
|
%- malt
|
|
|
|
%+ welp
|
|
|
|
%+ turn (~(tap by box.p.sta))
|
|
|
|
|=({a/@u b/moon} [(rep 5 who a ~) (stat-any b)])
|
|
|
|
%+ turn (~(tap by box.q.sta))
|
|
|
|
|=({a/@u b/planet} =+((rep 4 who a ~) [- (stat-planet - b)]))
|
|
|
|
::
|
|
|
|
++ stat-galaxy
|
|
|
|
|= {who/@p man/galaxy} ^- stat
|
|
|
|
?. ?=({$~ $& ^} man) (stat-any man)
|
|
|
|
=+ gal=u:(divided man)
|
|
|
|
:- %split
|
|
|
|
%- malt
|
|
|
|
;: welp
|
|
|
|
%+ turn (~(tap by box.p.gal))
|
|
|
|
|=({a/@u b/moon} [(rep 5 who a ~) (stat-any b)])
|
|
|
|
::
|
|
|
|
%+ turn (~(tap by box.q.gal))
|
|
|
|
|=({a/@u b/planet} =+((rep 4 who a ~) [- (stat-planet - b)]))
|
|
|
|
::
|
|
|
|
%+ turn (~(tap by box.r.gal))
|
|
|
|
|=({a/@u b/star} =+((rep 3 who a ~) [- (stat-star - b)]))
|
|
|
|
==
|
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ stats-ship :: inspect ship
|
2016-04-14 01:03:05 +03:00
|
|
|
|= who/@p ^- (unit (unit {$womb-stat stat}))
|
|
|
|
?- (clan who)
|
|
|
|
$pawn !!
|
|
|
|
$earl !!
|
|
|
|
$duke ``womb-stat+(stat-planet who (get-managed-planet who))
|
|
|
|
$king ``womb-stat+(stat-star who (get-managed-star who))
|
|
|
|
$czar ``womb-stat+(stat-galaxy who (get-managed-galaxy who))
|
|
|
|
==
|
2016-04-12 22:02:59 +03:00
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ peek-x-stats :: inspect ship/system
|
2016-04-12 22:02:59 +03:00
|
|
|
|= tyl/path
|
|
|
|
?^ tyl
|
|
|
|
(stats-ship ~|(bad-path+tyl (raid tyl who=%p ~)))
|
2016-04-14 01:03:05 +03:00
|
|
|
^- (unit (unit {$womb-stat-all (map ship stat)}))
|
|
|
|
:^ ~ ~ %womb-stat-all
|
|
|
|
%- ~(uni by (~(urn by planets.office) stat-planet))
|
|
|
|
%- ~(uni by (~(urn by stars.office) stat-star))
|
|
|
|
(~(urn by galaxies.office) stat-galaxy)
|
2016-04-12 22:02:59 +03:00
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ peek-x-invite :: inspect invitation
|
2016-04-12 22:02:59 +03:00
|
|
|
|= tyl/path ^- (unit (unit {$womb-balance balance}))
|
2016-04-13 03:10:53 +03:00
|
|
|
=+ pas=~|(bad-path+tyl (raid tyl pas=%p ~))
|
2016-04-12 22:02:59 +03:00
|
|
|
%- some
|
|
|
|
%+ bind (~(get by bureau) pas)
|
|
|
|
|=(bal/balance [%womb-balance bal])
|
|
|
|
::
|
2016-04-13 03:10:53 +03:00
|
|
|
++ peek-x
|
|
|
|
|= tyl/path :: ^- (unit (unit (pair mark *)))
|
|
|
|
~& peek-x+tyl
|
2016-04-12 22:02:59 +03:00
|
|
|
?~ tyl ~
|
|
|
|
?+ -.tyl ~
|
2016-04-13 03:10:53 +03:00
|
|
|
:: /shop/planets/@ud (list @p) up to 3 planets
|
|
|
|
:: /shop/stars/@ud (list @p) up to 3 stars
|
|
|
|
:: /shop/galaxies/@ud (list @p) up to 3 galaxies
|
2016-04-12 22:02:59 +03:00
|
|
|
$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
|
|
|
::
|
2016-04-15 02:52:37 +03:00
|
|
|
++ poke-manage :: add to property
|
|
|
|
|= a/(list ship)
|
|
|
|
=< abet
|
|
|
|
?> |(=(our src) =([~ src] boss)) :: privileged
|
|
|
|
|-
|
|
|
|
?~ a .
|
|
|
|
?+ (clan i.a) ~|(bad-size+(clan i.a) !!)
|
|
|
|
$duke
|
|
|
|
?. (~(has by stars.office) i.a)
|
|
|
|
$(a t.a, stars.office (~(put by stars.office) i.a ~))
|
|
|
|
~|(already-managing+i.a !!)
|
|
|
|
::
|
|
|
|
$king
|
|
|
|
?. (~(has by planets.office) i.a)
|
|
|
|
$(a t.a, planets.office (~(put by planets.office) i.a ~))
|
|
|
|
~|(already-managing+i.a !!)
|
|
|
|
::
|
|
|
|
$czar
|
|
|
|
?. (~(has by galaxies.office) i.a)
|
|
|
|
$(a t.a, galaxies.office (~(put by galaxies.office) i.a ~))
|
|
|
|
~|(already-managing+i.a !!)
|
|
|
|
==
|
|
|
|
::
|
2016-04-14 23:49:39 +03:00
|
|
|
++ email
|
2016-04-15 04:36:48 +03:00
|
|
|
|= {wir/wire adr/mail msg/tape} ^+ +>
|
2016-04-15 04:38:31 +03:00
|
|
|
(emit %poke [%mail wir] [our %gmail] %email adr msg)
|
|
|
|
::~&([%email-stub adr msg] +>)
|
2016-04-14 23:49:39 +03:00
|
|
|
::
|
2016-04-08 20:08:05 +03:00
|
|
|
++ poke-invite :: create invitation
|
|
|
|
|= {ref/reference inv/invite}
|
|
|
|
=< abet
|
2016-04-15 02:37:13 +03:00
|
|
|
=. hotel
|
|
|
|
?~ ref hotel
|
|
|
|
?~ sta.inv hotel
|
|
|
|
%+ ~(put by hotel) u.ref
|
|
|
|
=+ cli=(fall (~(get by hotel) u.ref) *client)
|
|
|
|
cli(sta +(sta.cli))
|
2016-04-14 23:49:39 +03:00
|
|
|
(invite-from ~ inv)
|
|
|
|
::
|
2016-04-15 02:37:13 +03:00
|
|
|
++ invite-from :: traced invitation
|
2016-04-14 23:49:39 +03:00
|
|
|
|= {hiz/(list mail) inv/invite} ^+ +>
|
2016-04-15 03:04:19 +03:00
|
|
|
?> |(=(our src) =([~ src] boss)) :: priveledged
|
2016-04-14 23:49:39 +03:00
|
|
|
=+ pas=`passcode`(shaf %pass eny)
|
|
|
|
=. bureau
|
|
|
|
:: ?< (~(has by bureau) pas) :: somewhat unlikely
|
2016-04-15 00:37:16 +03:00
|
|
|
(~(put by bureau) pas [pla.inv sta.inv who.inv hiz])
|
2016-04-15 04:36:48 +03:00
|
|
|
(email /invite who.inv "{intro.wel.inv}: {<pas>}")
|
2016-04-14 23:49:39 +03:00
|
|
|
::
|
|
|
|
:: ++ coup-invite :: invite sent
|
|
|
|
::
|
|
|
|
++ poke-reinvite :: split invitation
|
|
|
|
|= {aut/passcode inv/invite} :: further invite
|
|
|
|
?> =(src src) ::
|
|
|
|
=< abet
|
2016-04-15 02:37:13 +03:00
|
|
|
=+ ~|(%bad-passcode bal=(~(got by bureau) aut))
|
2016-04-14 23:49:39 +03:00
|
|
|
=. stars.bal (sub stars.bal sta.inv)
|
|
|
|
=. planets.bal (sub planets.bal pla.inv)
|
|
|
|
=. bureau (~(put by bureau) aut bal)
|
|
|
|
(invite-from [owner.bal history.bal] inv)
|
2016-04-08 20:08:05 +03:00
|
|
|
::
|
|
|
|
++ poke-obey :: set/reset boss
|
|
|
|
|= who/(unit @p)
|
|
|
|
=< abet
|
|
|
|
?> =(our src) :: me only
|
2016-04-15 00:37:16 +03:00
|
|
|
.(boss who)
|
2016-04-08 20:08:05 +03:00
|
|
|
::
|
2016-04-19 01:15:35 +03:00
|
|
|
++ poke-save :: write backup
|
|
|
|
|= pax/path
|
|
|
|
=< abet
|
|
|
|
(emit %info /backup [our (foal pax [%womb-part !>(`part`+:abet)])])
|
|
|
|
::
|
2016-04-08 20:08:05 +03:00
|
|
|
++ 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
|
2016-04-15 00:37:16 +03:00
|
|
|
:: (emit /rekey %next sec:ex:(brew 128 (shas %next eny)))
|
|
|
|
~&(rekey-stub+sec:ex:(brew 128 (shas %next eny)) .)
|
2016-04-08 20:08:05 +03:00
|
|
|
::
|
|
|
|
++ poke-report :: report will
|
|
|
|
|= {her/@p wyl/will} ::
|
|
|
|
=< abet
|
|
|
|
?> =(src src) :: self-authenticated
|
2016-04-15 00:37:16 +03:00
|
|
|
(emit %knew /report her wyl)
|
2016-04-08 20:08:05 +03:00
|
|
|
::
|
2016-04-15 02:37:13 +03:00
|
|
|
++ use-reference
|
|
|
|
|= a/(each @p mail) ^- (unit _+>)
|
|
|
|
?. (~(has by hotel) a) ~
|
|
|
|
=+ cli=(~(get by hotel) a)
|
|
|
|
?~ cli ~
|
|
|
|
?. (gte sta.u.cli reference-rate) ~
|
|
|
|
=. sta.u.cli (sub sta.u.cli reference-rate)
|
|
|
|
`+>.$(hotel (~(put by hotel) a u.cli))
|
|
|
|
::
|
2016-04-15 03:04:19 +03:00
|
|
|
++ poke-do-claim :: issue child ticket
|
|
|
|
|= {who/mail her/@p}
|
|
|
|
=< abet
|
|
|
|
?> =(our (sein her))
|
|
|
|
?> |(=(our src) =([~ src] boss)) :: privileged
|
|
|
|
=+ tik=.^(@p %a /(scot %p our)/tick/(scot %da now)/(scot %p her))
|
|
|
|
:: =. emit (emit /tick %tick tik her)
|
2016-04-15 04:36:48 +03:00
|
|
|
(email /ticket who "Ticket for {<her>}: {<`@pG`tik>}")
|
2016-04-15 03:04:19 +03:00
|
|
|
::
|
|
|
|
++ poke-claim :: claim plot, req ticket
|
2016-04-14 23:49:39 +03:00
|
|
|
|= {aut/passcode her/@p}
|
2016-04-08 20:08:05 +03:00
|
|
|
=< abet
|
2016-04-12 22:02:59 +03:00
|
|
|
?> =(src src)
|
2016-04-15 02:37:13 +03:00
|
|
|
=+ ~|(%bad-passcode bal=(~(got by bureau) aut))
|
2016-04-15 03:04:19 +03:00
|
|
|
=; claimed
|
|
|
|
(emit.claimed %poke /tick [(sein her) %hood] [%womb-do-claim owner.bal her])
|
2016-04-14 23:49:39 +03:00
|
|
|
?+ (clan her) ~|(bad-size+(clan her) !!)
|
|
|
|
$king
|
2016-04-15 03:04:19 +03:00
|
|
|
=; all (claim-star.all owner.bal her)
|
2016-04-15 02:37:13 +03:00
|
|
|
=+ (use-reference &+src)
|
|
|
|
?^ - u :: prefer using references
|
|
|
|
=+ (use-reference |+owner.bal)
|
|
|
|
?^ - u
|
2016-04-14 23:49:39 +03:00
|
|
|
=. stars.bal ~|(%no-stars (dec stars.bal))
|
2016-04-15 02:38:25 +03:00
|
|
|
+>.$(bureau (~(put by bureau) aut bal))
|
2016-04-14 23:49:39 +03:00
|
|
|
::
|
|
|
|
$duke
|
|
|
|
=. planets.bal ~|(%no-planets (dec planets.bal))
|
|
|
|
=. bureau (~(put by bureau) aut bal)
|
|
|
|
(claim-planet owner.bal her)
|
|
|
|
==
|
|
|
|
::
|
|
|
|
++ claim-star :: register
|
|
|
|
|= {who/mail her/@p} ^+ +>
|
|
|
|
%+ mod-managed-star her
|
|
|
|
|= a/star ^- star
|
|
|
|
?^ a ~|(impure-star+[her a] !!)
|
|
|
|
(some %| who)
|
|
|
|
::
|
|
|
|
++ claim-planet :: register
|
|
|
|
|= {who/mail her/@p} ^+ +>
|
|
|
|
=. hotel
|
2016-04-15 02:37:13 +03:00
|
|
|
%+ ~(put by hotel) |+who
|
|
|
|
=+ cli=(fall (~(get by hotel) |+who) *client)
|
2016-04-14 23:49:39 +03:00
|
|
|
cli(has (~(put in has.cli) her))
|
|
|
|
%+ mod-managed-planet her
|
|
|
|
|= a/planet ^- planet
|
|
|
|
?^ a ~|(impure-planet+[her a] !!)
|
|
|
|
(some %| who)
|
2016-04-08 20:08:05 +03:00
|
|
|
::
|
|
|
|
++ poke-release :: release to subdivide
|
|
|
|
|= {gal/@ud sta/@ud} ::
|
2016-04-13 00:54:50 +03:00
|
|
|
=< abet ^+ +>
|
2016-04-08 20:08:05 +03:00
|
|
|
?> =(our src) :: privileged
|
2016-04-13 00:54:50 +03:00
|
|
|
=. +>
|
|
|
|
?~ gal +>
|
|
|
|
=+ all=(take-n [0 gal] shop-galaxies)
|
|
|
|
?. (gth gal (lent all))
|
|
|
|
(roll all release-galaxy)
|
|
|
|
~|(too-few-galaxies+[want=gal has=(lent all)] !!)
|
|
|
|
^+ +>
|
|
|
|
?~ sta +>
|
|
|
|
=+ all=(take-n [0 sta] shop-stars)
|
|
|
|
~& got-stars+all
|
|
|
|
?. (gth sta (lent all))
|
|
|
|
(roll all release-star)
|
|
|
|
~|(too-few-stars+[want=sta has=(lent all)] !!)
|
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ release-galaxy :: subdivide %czar
|
2016-04-13 00:54:50 +03:00
|
|
|
=+ [who=*@p res=.]
|
|
|
|
|. ^+ res
|
2016-04-13 23:32:45 +03:00
|
|
|
%+ mod-managed-galaxy:res who
|
|
|
|
|= gal/galaxy ^- galaxy
|
2016-04-13 03:10:53 +03:00
|
|
|
~& release+who
|
2016-04-13 00:54:50 +03:00
|
|
|
?^ gal ~|(already-used+who !!)
|
2016-04-13 23:32:45 +03:00
|
|
|
(some %& (fo-init 5) (fo-init 4) (fo-init 3))
|
2016-04-13 00:54:50 +03:00
|
|
|
::
|
2016-04-14 00:06:58 +03:00
|
|
|
++ release-star :: subdivide %king
|
2016-04-13 00:54:50 +03:00
|
|
|
=+ [who=*@p res=.]
|
|
|
|
|. ^+ res
|
2016-04-13 23:32:45 +03:00
|
|
|
%+ mod-managed-star:res who
|
|
|
|
|= sta/star ^- star
|
2016-04-13 00:54:50 +03:00
|
|
|
~& release+who
|
2016-04-13 23:32:45 +03:00
|
|
|
?^ sta ~|(already-used+[who u.sta] !!)
|
|
|
|
(some %& (fo-init 4) (fo-init 3))
|
2016-04-08 20:08:05 +03:00
|
|
|
--
|