Merge branch 'test' into demo

Conflicts:
	urb/urbit.pill
This commit is contained in:
C. Guy Yarvin 2015-06-01 10:59:17 -07:00
commit 4a8fd21963
7 changed files with 132 additions and 46 deletions

View File

@ -95,6 +95,10 @@
++ poke-kiln-mv (wrap poke-mv):from-kiln
++ poke-will (wrap poke-will):from-helm
++ mere-kiln (wrap take-mere):from-kiln
++ mere-kiln-sync (wrap take-mere-sync):from-kiln
::++ mere-kiln-sync
:: |= [then (each (set path) (pair term tang))]
:: (ably (take-mere-sync:(kiln-work [hid ost src] (able %kiln)) way +<+))
++ made-kiln (wrap take-made):from-kiln
++ init-helm |=([way=wire *] [~ +>])
++ note-helm (wrap take-note):from-helm
@ -103,4 +107,8 @@
++ peer-drum (wrap peer):from-drum
++ quit-drum (wrap quit):from-drum
++ went-helm (wrap take-went):from-helm
++ writ-kiln-sync (wrap take-writ):from-kiln
::++ writ-kiln-sync
:: |= [then riot]
:: (ably (take-writ:(kiln-work [hid ost src] (able %kiln)) way +<+))
--

View File

@ -48,12 +48,10 @@
++ abet [(flop moz) .(moz ~)] :: resolve
++ bike $+(_. _+>) :: self-transformer
++ dish |=(cad=card %_(+> moz [[ost cad] moz])) :: request
++ done (echo eels |=(_. (dish:+< %quit ~))) :: cancel everyone
++ echo |= [all=(list sink) fun=bike] =+ old=+>+<- :: publish to all
|- ^+ +>.^$ ?~ all +>.^$(+<- old) ::
=> .(ost p.i.all, src q.i.all) ::
$(all t.all, +>.^$ (fun +>.^$)) ::
++ eels (~(tap by sup)) :: all clients
++ flap |=(con=bike (echo (~(tap by sup)) con)) :: update all clients
++ here ~(. go src gam) :: game core
:: :: ::
@ -63,13 +61,11 @@
++ fect |=(sole-effect (dish %diff %sole-effect +<)) :: update console
++ heal |= old=axon =. +>+<+> (wake old) :: complete update
=- +>.$(gam -) ?. !=(1 +<-) gam ::
(muy:here (turn eels |=(sink q))) ::
(muy:here (turn (~(tap by sup)) |=(sink q))) ::
++ kick |= point =^ dud gam ~(m at:here +<) ::
?.(dud fail wild:kind) ::
++ kind =+(res:here ?~(- + (word(gam new:here) ->))) :: move result
++ hail |=(? tame(gam (hey:here +<))) :: toggle subscriber
++ plot |= (each point null) :: apply command
?-(+<- & (kick +<+), | done(gam new:here)) ::
++ prom (fect %pro %& %oct2 voy:here) :: update prompt
++ rend (turn `wall`tab:here |=(tape txt/+<)) :: table print
++ sawn (hail(eye (~(del by eye) ost)) |) :: console unsubscribe

View File

@ -27,7 +27,7 @@
++ axle-0 ,[eye=face gam=game-0] :: old axle
++ game-0 ,[who=? box=board boo=board] :: old game
++ wake |= axon :- %1 ?- +<- %1 +<+ :: coarse upgrade
%0 [eye ~ [who ~^~ ~ box boo]:gam]:+<+ ::
%0 [eye [who ~^~ ~ box boo]:gam]:+<+ ::
== -- ::
:: :: ::
:::: :::::: parsers
@ -50,7 +50,6 @@
++ abet [(flop moz) .(moz ~)] :: resolve
++ bike $+(_. _+>) :: self-transformer
++ dish |=(cad=card %_(+> moz [[ost cad] moz])) :: request
++ done (echo eels |=(_. (dish:+< %quit ~))) :: cancel everyone
++ echo |= [all=(list sink) fun=bike] =+ old=+>+<- :: publish to all
|- ^+ +>.^$ ?~ all +>.^$(+<- old) ::
=> .(ost p.i.all, src q.i.all) ::
@ -66,7 +65,7 @@
:: :: ::
++ fail ?:(soul (fect %bel ~) ~|(%invalid-move !!)) :: user error
++ fect |=(sole-effect (dish %diff %sole-effect +<)) :: update console
++ fact |=(play (diff %diff %oct3-update +<)) :: update partner
++ fact |=(play (dish %diff %oct3-update +<)) :: update partner
++ hail |=(? tame(gam (hey:here +<))) :: toggle subscriber
++ heal |= old=axon =. +>+<+> (wake old) :: complete update
=- +>.$(gam -) ?. !=(1 +<-) gam ::
@ -74,8 +73,6 @@
++ kick |= point =^ dud gam ~(m at:here +<) ::
?.(dud fail wild:kind) ::
++ kind =+(res:here ?~(- + (word(gam new:here) ->))) :: move result
++ plot |= (each point null) :: apply command
?-(+<- & (kick +<+), | done(gam new:here)) ::
++ prom (fect %pro %& %oct3 voy:here) :: update prompt
++ rend (turn `wall`tab:here |=(tape txt/+<)) :: table print
++ sawn (hail(eye (~(del by eye) ost)) |) :: console unsubscribe
@ -99,8 +96,8 @@
++ delt |= cal=sole-change :: edit command line
=^ cul say (~(remit cs say) cal good) ::
?~(cul abet fail:(fect:abet det/u.cul)) ::
++ dive =+ (rust (tufa buf.say) (punt comb)) :: apply command line
?~(- fail ?~(-> show (plot:wipe ->+))) ::
++ dive =+ (rust (tufa buf.say) (punt come)) :: apply command line
?~(- fail ?~(-> show (kick:wipe ->+))) ::
++ good |=((list ,@c) -:(rose (tufa +<) cusp)) :: validate input
++ wipe =^ cal say (~(transmit cs say) set/~) :: clear line
(fect:abet %det cal) ::
@ -108,7 +105,7 @@
:: :: ::
:::: :::::: arvo handlers
:: :: ::
++ peer-oct3 |=(* abet:tame:meet) :: urbit subscribe
++ peer-oct3 |=(* abet:tame:(hail &)) :: urbit subscribe
++ peer-sole |=(* abet:show:seen) :: console subscribe
++ poke-sole-action |=(sole-action abet:(work +<)) :: console input
++ poke-oct3-move |=(point abet:wild:(kick +<)) :: urbit move

View File

@ -73,7 +73,7 @@
++ fail ?:(soul (fect %bel ~) ~|(%invalid-move !!)) :: user error
++ fect |=(sole-effect (emit %sole-effect +<)) :: update console
++ fact |=(play (emit %oct4-update +<)) :: update partner
++ hail |=(? ?^(rem . tame(gam (hey:here +<)))) :: toggle subscriber
++ hail |=(? ?^(rem +> tame(gam (hey:here +<)))) :: toggle subscriber
++ harp |=(game ?:(=(gam +<) +> wild(gam +<))) :: update game
++ heal |= old=axon =. +>+<+> (wake old) :: complete update
=- +>.$(gam -) ?. !=(1 +<-) gam ::
@ -127,12 +127,12 @@
++ reap-oct4 |=([* (unit)] abet:(with =(~ +<+))) :: linked to friend
++ coup-oct4 |=([* (unit)] abet:?~(+<+ +> fail)) :: move acknowledge
++ diff-oct4-update |=([* play] abet:(hear +<+)) :: network update
++ peer-oct4 |=(* abet:tame:meet) :: urbit subscribe
++ peer-oct4 |=(* abet:tame:(hail &)) :: urbit subscribe
++ peer-sole |=(* abet:show:seen) :: console subscribe
++ poke-sole-action |=(sole-action abet:(work +<)) :: console input
++ poke-oct4-move |=(point abet:wild:(kick +<)) :: urbit move
++ prep |=(agon abet:?~(+< +> (heal +<+>))) :: load state
++ pull-oct4 |=(* abet:lose) :: urbit unsubscribe
++ pull-oct4 |=(* abet:(hail |)) :: urbit unsubscribe
++ pull-sole |=(* abet:sawn) :: console unsubscribe
++ quit-oct4 |=(* abet:?~(rem +> wild(rem ~))) :: unlinked by friend
--

View File

@ -1050,9 +1050,9 @@
=+ vid=(read-at-aeon:ze u.nao p.q.i.xiq)
:: ~& %red-at-aeon
?~ vid
?~ u.nao
?: =(0 u.nao)
~& [%oh-poor `path`[syd '0' r.p.q.i.xiq]]
$(xiq t.xiq)
$(xiq t.xiq)
~& [%oh-well desk=syd mood=p.q.i.xiq aeon=u.nao]
$(xiq t.xiq, xaq [i.xiq xaq])
$(xiq t.xiq, ..wake (balk p.i.xiq u.vid p.q.i.xiq))

View File

@ -1030,6 +1030,7 @@
%plug `%c
%them `%e
%want `%a
%warp `%c
==
--
--

View File

@ -9,7 +9,8 @@
++ kiln-part ,[%kiln %0 kiln-pith] :: kiln state
++ kiln-pith ::
$: rem=(map desk kiln-desk) ::
==
syn=(map hood-sync ,[let=@ud ust=bone]) ::
== ::
++ kiln-desk :: per-desk state
$: auto=? :: escalate on failure
gem=germ :: strategy
@ -54,6 +55,7 @@
[%merg wire @p @tas @p @tas germ] ::
[%plug wire @p @tas @p @tas] ::
[%poke wire dock pear] ::
[%warp wire sock riff] ::
== ::
++ pear :: poke fruit
$% [%talk-command command:talk] ::
@ -76,8 +78,11 @@
abet:(emit %lynx /kiln our syd syn)
::
++ poke-sync ::
|= hood-sync
abet:(emit %font /kiln our syd her sud)
|= hos=hood-sync
?: (~(has by syn) hos)
=+ "already syncing from {<sud.hos>} on {<her.hos>} to {<syd.hos>}"
abet:(spam leaf/- ~)
abet:abet:start:(auto hos)
::
++ poke-merge ::
|= hood-merge
@ -115,6 +120,106 @@
|= [way=wire saw=(unit tang)]
abet:abet:(coup-fancy:(take way) saw)
::
++ take-mere-sync ::
|= [way=wire mes=(each (set path) (pair term tang))]
?> ?=([@ @ @ ~] way)
=+ ^- hos=hood-sync
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
abet:abet:(mere:(auto hos) mes)
::
++ take-writ ::
|= [way=wire rot=riot]
?> ?=([@ @ @ ~] way)
=+ ^- hos=hood-sync
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
abet:abet:(writ:(auto hos) rot)
::
++ spam
|= mes=(list tank)
%- emit
:* %poke /kiln/spam
[our %talk] %talk-command
^- command:talk
:- %publish
%- flop
=< acc
%+ roll mes
=< .(eny ^eny)
|= [tan=tank acc=(list thought:talk) eny=@uvI]
^- [acc=(list thought:talk) eny=@uvI]
=+ (sham eny mes)
:_ -
:_ acc
^- thought:talk
:+ -
[[[%& our (main our)] [*envelope:talk %pending]] ~ ~]
[now *bouquet:talk [%app (crip ~(ram re tan))]]
==
::
++ auto
|= hood-sync
=+ (fall (~(get by syn) syd her sud) [let=*@ud ust=ost])
|%
++ abet
..auto(syn (~(put by syn) [syd her sud] let ust))
::
++ blab
|= new=(list move)
^+ +>
+>.$(moz (welp new moz))
::
++ spam |*(* %_(+> ..auto (^spam +<)))
++ start
%- blab :_ ~
:* ost %warp
/kiln/sync/[syd]/(scot %p her)/[sud]
[our her] sud ~ %sing %w [%da now] /
==
::
++ writ
|= rot=riot
?~ rot
%^ spam
leaf/"bad %writ response on autosync"
leaf/"from {<sud>} on {<her>} to {<syd>}"
~
=. let ?. ?=(%w p.p.u.rot) let ((hard ,@ud) q.q.r.u.rot)
%- blab :_ ~
:* ost %merg
/kiln/sync/[syd]/(scot %p her)/[sud]
our syd her sud
?: =(0 .^(%cw /(scot %p our)/[syd]/(scot %da now)))
%init
%mate
==
::
++ mere
|= mes=(each (set path) (pair term tang))
=. let +(let)
=. +>.$
%- spam
?: ?=(%& -.mes)
[leaf/"autosync succeeded from {<sud>} on {<her>} to {<syd>}" ~]
:* leaf/"autosync failed from {<sud>} on {<her>} to {<syd>}"
leaf/"please manually merge the desks with"
leaf/":+merge %{(trip syd)} {(scow %p her)} %{(trip sud)}"
leaf/""
leaf/"error code: {<p.p.mes>}"
q.p.mes
==
%- blab :_ ~
:* ost %warp
/kiln/sync/[syd]/(scot %p her)/[sud]
[our her] sud ~ %sing %y [%ud let] /
==
--
::
++ work :: state machine
|= syd=desk
=+ ^- kiln-desk
@ -125,7 +230,7 @@
++ abet :: resolve
..work(rem (~(put by rem) syd auto gem her sud cas))
::
++ blab :: emit, XX remove
++ blab
|= new=(list move)
^+ +>
+>.$(moz (welp new moz))
@ -134,7 +239,7 @@
++ lose
^+ .
~| %kiln-work-fail
!!
.
::
++ ford-fail
|=(tan=tang ~|(%ford-fail (mean tan)))
@ -179,28 +284,7 @@
%- blab :_ ~
[ost %poke /kiln/fancy/[^syd] [our %hood] %hood-merge [syd her sud gem]]
::
++ spam
|= mes=(list tank)
%- blab :_ ~
:* ost %poke /kiln/spam/[syd]
[our %talk] %talk-command
^- command:talk
:- %publish
%- flop
=< acc
%+ roll mes
=< .(eny eny)
|= [tan=tank acc=(list thought:talk) eny=@uvI]
^- [acc=(list thought:talk) eny=@uvI]
=+ (sham eny mes)
:_ -
:_ acc
^- thought:talk
:+ -
[[[%& our (main our)] [*envelope:talk %pending]] ~ ~]
[now *bouquet:talk [%app (crip ~(ram re tan))]]
==
::
++ spam |*(* +>(..work (^spam +<)))
++ merge
|= [her=@p sud=@tas gim=?(%auto germ)]
^+ +>
@ -341,7 +425,7 @@
=< win
%- blab:(spam tan)
:_ ~
:* ost %info /kiln/[syd]/dash
:* ost %info /kiln/[syd]
our (cat 3 syd '-scratch')
%& *cart
%+ murn can