This commit is contained in:
Philip Monk 2019-03-07 21:15:42 -08:00
parent dab83cd28e
commit ae8966e5ad
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
8 changed files with 100 additions and 77 deletions

View File

@ -35,12 +35,12 @@
++ emit-aqua-events ++ emit-aqua-events
|= aes=(list aqua-event) |= aes=(list aqua-event)
%- emit-moves %- emit-moves
[%poke /aqua-events [our %aqua] %aqua-events aes]~ [ost %poke /aqua-events [our %aqua] %aqua-events aes]~
:: ::
++ poke-aqua-vane-control ++ poke-aqua-vane-control
|= command=?(%subscribe %unsubscribe) |= command=?(%subscribe %unsubscribe)
:_ this(subscribed =(command %subscribe) :_ this(subscribed =(command %subscribe))
(aqua-vane-control-handler subscribed) (aqua-vane-control-handler our ost subscribed command)
:: ::
++ diff-aqua-effects ++ diff-aqua-effects
|= [way=wire afs=aqua-effects] |= [way=wire afs=aqua-effects]
@ -51,12 +51,13 @@
this this
=. this =. this
?+ -.q.i.ufs.afs this ?+ -.q.i.ufs.afs this
%restore handle-restore %restore (handle-restore who.afs)
%send (handle-send i.ufs.afs) %send (handle-send i.ufs.afs)
-- ==
$(ufs.afs t.ufs.afs) $(ufs.afs t.ufs.afs)
:: ::
++ handle-restore ++ handle-restore
|= who=@p
%- emit-aqua-events %- emit-aqua-events
[%event who [//newt/0v1n.2m9vh %barn ~]]~ [%event who [//newt/0v1n.2m9vh %barn ~]]~
:: ::

View File

@ -13,8 +13,10 @@
+$ state +$ state
$: %0 $: %0
subscribed=_| subscribed=_|
piers=(map ship next-timer=(unit @da)) piers=(map ship pier)
== ==
::
+$ pier next-timer=(unit @da)
-- --
=, gall =, gall
=| moves=(list move) =| moves=(list move)
@ -31,12 +33,12 @@
++ emit-aqua-events ++ emit-aqua-events
|= aes=(list aqua-event) |= aes=(list aqua-event)
%- emit-moves %- emit-moves
[%poke /aqua-events [our %aqua] %aqua-events aes]~ [ost %poke /aqua-events [our %aqua] %aqua-events aes]~
:: ::
++ poke-aqua-vane-control ++ poke-aqua-vane-control
|= command=?(%subscribe %unsubscribe) |= command=?(%subscribe %unsubscribe)
:_ this(subscribed =(command %subscribe) :_ this(subscribed =(command %subscribe))
(aqua-vane-control-handler subscribed) (aqua-vane-control-handler our ost subscribed command)
:: ::
++ diff-aqua-effects ++ diff-aqua-effects
|= [way=wire afs=aqua-effects] |= [way=wire afs=aqua-effects]
@ -50,7 +52,7 @@
%sleep abet-pe:handle-sleep:(pe who.afs) %sleep abet-pe:handle-sleep:(pe who.afs)
%restore abet-pe:handle-restore:(pe who.afs) %restore abet-pe:handle-restore:(pe who.afs)
%doze abet-pe:(handle-doze:(pe who.afs) i.ufs.afs) %doze abet-pe:(handle-doze:(pe who.afs) i.ufs.afs)
-- ==
$(ufs.afs t.ufs.afs) $(ufs.afs t.ufs.afs)
:: ::
:: Received timer wake :: Received timer wake
@ -82,15 +84,17 @@
:: ::
++ handle-restore ++ handle-restore
^+ ..abet-pe ^+ ..abet-pe
=. this
%- emit-aqua-events %- emit-aqua-events
[%event who [//behn/0v1n.2m9vh %born ~]]~ [%event who [//behn/0v1n.2m9vh %born ~]]~
..abet-pe
:: ::
++ handle-doze ++ handle-doze
|= [way=wire %doze tim=(unit @da)] |= [way=wire %doze tim=(unit @da)]
^+ ..abet-pe ^+ ..abet-pe
?~ tim ?~ tim
?~ next-timer ?~ next-timer
this ..abet-pe
cancel-timer cancel-timer
?~ next-timer ?~ next-timer
(set-timer u.tim) (set-timer u.tim)
@ -101,16 +105,18 @@
=. tim +(tim) :: nobody's perfect =. tim +(tim) :: nobody's perfect
~& [who=who %setting-timer tim] ~& [who=who %setting-timer tim]
=. next-timer `tim =. next-timer `tim
(emit-moves [ost.hid %wait /(scot %p who) tim]~) =. this (emit-moves [ost %wait /(scot %p who) tim]~)
..abet-pe
:: ::
++ cancel-timer ++ cancel-timer
~& [who=who %cancell-timer (need next-timer)] ~& [who=who %cancell-timer (need next-timer)]
=. next-timer ~ =. next-timer ~
(emit-moves [ost.hid %rest /(scot %p who) (need next-timer)]~) =. this (emit-moves [ost %rest /(scot %p who) (need next-timer)]~)
..abet-pe
:: ::
++ take-wake ++ take-wake
|= [way=wire ~] |= [way=wire ~]
~& [who=who %aqua-behn-wake now.hid] ~& [who=who %aqua-behn-wake now]
=. next-timer ~ =. next-timer ~
=. this =. this
%- emit-aqua-events %- emit-aqua-events

View File

@ -37,12 +37,12 @@
++ emit-aqua-events ++ emit-aqua-events
|= aes=(list aqua-event) |= aes=(list aqua-event)
%- emit-moves %- emit-moves
[%poke /aqua-events [our %aqua] %aqua-events aes]~ [ost %poke /aqua-events [our %aqua] %aqua-events aes]~
:: ::
++ poke-aqua-vane-control ++ poke-aqua-vane-control
|= command=?(%subscribe %unsubscribe) |= command=?(%subscribe %unsubscribe)
:_ this(subscribed =(command %subscribe) :_ this(subscribed =(command %subscribe))
(aqua-vane-control-handler subscribed) (aqua-vane-control-handler our ost subscribed command)
:: ::
++ diff-aqua-effects ++ diff-aqua-effects
|= [way=wire afs=aqua-effects] |= [way=wire afs=aqua-effects]
@ -53,13 +53,13 @@
this this
=. this =. this
?+ -.q.i.ufs.afs this ?+ -.q.i.ufs.afs this
%blit (handle-blit i.ufs.afs) %blit (handle-blit who.afs i.ufs.afs)
-- ==
$(ufs.afs t.ufs.afs) $(ufs.afs t.ufs.afs)
:: ::
++ handle-blit ++ handle-blit
|= [way=wire %blit blits=(list blit:dill)] |= [who=@p way=wire %blit blits=(list blit:dill)]
^+ ..abet-pe ^+ this
=/ last-line =/ last-line
%+ roll blits %+ roll blits
|= [b=blit:dill line=tape] |= [b=blit:dill line=tape]
@ -74,5 +74,5 @@
%url ~& [%activate-url p.b] line %url ~& [%activate-url p.b] line
== ==
~& last-line ~& last-line
..abet-pe this
-- --

View File

@ -14,8 +14,10 @@
+$ state +$ state
$: %0 $: %0
subscribed=_| subscribed=_|
piers=(map ship http-requests=(set @ud)) piers=(map ship pier)
== ==
::
+$ pier http-requests=(set @ud)
-- --
=, gall =, gall
=| moves=(list move) =| moves=(list move)
@ -32,12 +34,12 @@
++ emit-aqua-events ++ emit-aqua-events
|= aes=(list aqua-event) |= aes=(list aqua-event)
%- emit-moves %- emit-moves
[%poke /aqua-events [our %aqua] %aqua-events aes]~ [ost %poke /aqua-events [our %aqua] %aqua-events aes]~
:: ::
++ poke-aqua-vane-control ++ poke-aqua-vane-control
|= command=?(%subscribe %unsubscribe) |= command=?(%subscribe %unsubscribe)
:_ this(subscribed =(command %subscribe) :_ this(subscribed =(command %subscribe))
(aqua-vane-control-handler subscribed) (aqua-vane-control-handler our ost subscribed command)
:: ::
++ diff-aqua-effects ++ diff-aqua-effects
|= [way=wire afs=aqua-effects] |= [way=wire afs=aqua-effects]
@ -51,7 +53,7 @@
%sleep abet-pe:handle-sleep:(pe who.afs) %sleep abet-pe:handle-sleep:(pe who.afs)
%restore abet-pe:handle-restore:(pe who.afs) %restore abet-pe:handle-restore:(pe who.afs)
%thus abet-pe:(handle-thus:(pe who.afs) i.ufs.afs) %thus abet-pe:(handle-thus:(pe who.afs) i.ufs.afs)
-- ==
$(ufs.afs t.ufs.afs) $(ufs.afs t.ufs.afs)
:: ::
:: Received inbound HTTP response :: Received inbound HTTP response
@ -59,7 +61,7 @@
++ sigh-httr ++ sigh-httr
|= [way=wire res=httr:eyre] |= [way=wire res=httr:eyre]
^- (quip move _this) ^- (quip move _this)
=. this apex-aqua =< abet-aqua =. this apex =< abet
?> ?=([@ *] way) ?> ?=([@ *] way)
=/ who (,@p (slav %p i.way)) =/ who (,@p (slav %p i.way))
~& [%received-httr who] ~& [%received-httr who]
@ -70,7 +72,7 @@
++ sigh-tang ++ sigh-tang
|= [way=wire tan=tang] |= [way=wire tan=tang]
^- (quip move _this) ^- (quip move _this)
=. this apex-aqua =< abet-aqua =. this apex =< abet
?> ?=([@ *] way) ?> ?=([@ *] way)
=/ who (,@p (slav %p i.way)) =/ who (,@p (slav %p i.way))
~& [%received-httr who] ~& [%received-httr who]
@ -92,8 +94,10 @@
:: ::
++ handle-restore ++ handle-restore
^+ ..abet-pe ^+ ..abet-pe
=. this
%- emit-aqua-events %- emit-aqua-events
[%event who [//http/0v1n.2m9vh %born ~]]~ [%event who [//http/0v1n.2m9vh %born ~]]~
..abet-pe
:: ::
++ handle-thus ++ handle-thus
|= [way=wire %thus num=@ud req=(unit hiss:eyre)] |= [way=wire %thus num=@ud req=(unit hiss:eyre)]
@ -110,14 +114,16 @@
..abet-pe ..abet-pe
~& [who=who %aqua-eyre-requesting u.req] ~& [who=who %aqua-eyre-requesting u.req]
=. http-requests (~(put in http-requests) num) =. http-requests (~(put in http-requests) num)
=. this
%- emit-moves :_ ~ %- emit-moves :_ ~
:* ost.hid :* ost
%hiss %hiss
/(scot %p who)/(scot %ud num) /(scot %p who)/(scot %ud num)
~ ~
%httr %httr
[%hiss u.req] [%hiss u.req]
== ==
..abet-pe
:: ::
:: Pass HTTP response back to virtual ship :: Pass HTTP response back to virtual ship
:: ::
@ -130,7 +136,9 @@
~& [who=who %ignoring-httr num=num] ~& [who=who %ignoring-httr num=num]
..abet-pe ..abet-pe
=. http-requests (~(del in http-requests) num) =. http-requests (~(del in http-requests) num)
(emit-aqua-events [%event who [//http/0v1n.2m9vh %they num res]~) =. this
(emit-aqua-events [%event who [//http/0v1n.2m9vh %they num res]]~)
..abet-pe
:: ::
:: Got error in HTTP response :: Got error in HTTP response
:: ::
@ -146,3 +154,4 @@
%- (slog tan) %- (slog tan)
..abet-pe ..abet-pe
-- --
--

View File

@ -92,9 +92,9 @@
:: Enqueue events to child arvo :: Enqueue events to child arvo
:: ::
++ push-events ++ push-events
|= ova=(list unix-event) |= ues=(list unix-event)
^+ ..abet-pe ^+ ..abet-pe
=. next-events (~(gas to next-events) ova) =. next-events (~(gas to next-events) ues)
..abet-pe ..abet-pe
:: ::
:: Send moves to host arvo :: Send moves to host arvo
@ -271,7 +271,7 @@
++ peer-effects ++ peer-effects
|= pax=path |= pax=path
^- (quip move _this) ^- (quip move _this)
?: ?=([@ @ *] pax) ?. ?=([@ *] pax)
~& [%aqua-bad-peer-effects pax] ~& [%aqua-bad-peer-effects pax]
`this `this
?~ (slaw %p i.pax) ?~ (slaw %p i.pax)
@ -524,11 +524,11 @@
:: ::
++ peek-x-ships ++ peek-x-ships
|= pax=path |= pax=path
^- (unit (unit %noun (list ship))) ^- (unit (unit [%noun (list ship)]))
?. ?=(~ pax) ?. ?=(~ pax)
~ ~
:^ ~ ~ %noun :^ ~ ~ %noun
(turn ~(tap by piers) head) `(list ship)`(turn ~(tap by piers) head)
:: ::
:: Trivial scry for mock :: Trivial scry for mock
:: ::

View File

@ -14,14 +14,20 @@
=> $~ |% => $~ |%
+$ move (pair bone card) +$ move (pair bone card)
+$ card +$ card
$% [%poke wire dock poke-types] $% [%poke wire dock poke-type]
[%peer wire dock path] [%peer wire dock path]
[%pull wire dock ~] [%pull wire dock ~]
[%diff diff-type]
== ==
:: ::
+$ poke-types +$ poke-type
$% [%aqua-events (list aqua-event)] $% [%aqua-events (list aqua-event)]
[%drum-start term term] [%drum-start term term]
[%aqua-vane-control ?(%subscribe %unsubscribe)]
==
::
+$ diff-type
$% [%aqua-effects aqua-effects]
== ==
:: ::
+$ state +$ state
@ -74,7 +80,7 @@
|= [now=@da who=ship uf=unix-effect] |= [now=@da who=ship uf=unix-effect]
^- [? (quip ph-event _..start)] ^- [? (quip ph-event _..start)]
~& [%num num] ~& [%num num]
:- ? :- &
:_ ..start :_ ..start
(expect-dojo-output ~bud who uf "[%test-result 5]") (expect-dojo-output ~bud who uf "[%test-result 5]")
-- --
@ -97,7 +103,7 @@
++ route ++ route
|= [now=@da who=ship uf=unix-effect] |= [now=@da who=ship uf=unix-effect]
^- [? (quip ph-event _..start)] ^- [? (quip ph-event _..start)]
:- ? :- &
:_ ..start :_ ..start
(expect-dojo-output ~bud who uf "hi ~dev successful") (expect-dojo-output ~bud who uf "hi ~dev successful")
-- --
@ -202,7 +208,7 @@
^- (unit move) ^- (unit move)
?. ?=([%effects ~] pax) ?. ?=([%effects ~] pax)
~ ~
`[b %diff %aqua-effects ae] `[ost.hid %diff %aqua-effects afs]
:: ::
++ run-events ++ run-events
|= [lab=term what=(list ph-event)] |= [lab=term what=(list ph-event)]
@ -305,34 +311,35 @@
++ diff-aqua-effects ++ diff-aqua-effects
|= [way=wire afs=aqua-effects] |= [way=wire afs=aqua-effects]
^- (quip move _this) ^- (quip move _this)
:: ~& [%diff-aqua-effect way who.ae] :: ~& [%diff-aqua-effect way who.afs]
?> ?=([@tas @ ~] way) ?> ?=([@tas @ ~] way)
=/ lab i.way =/ lab i.way
=/ test-cor (~(get by test-cores) lab) =/ test-cor (~(get by test-cores) lab)
?~ test-cor ?~ test-cor
~& [%ph-dropping lab] ~& [%ph-dropping lab]
`this `this
=+ |- ^- $: thru-effects=(list unix-effects) =+ |- ^- $: thru-effects=(list unix-effect)
events=(list ph=event) events=(list ph-event)
cor=_u.test-cor cor=_u.test-cor
== ==
?~ ufs.ae ?~ ufs.afs
[~ ~ u.test-cor] [~ ~ u.test-cor]
=. effect-log.u.test-cor =. effect-log.u.test-cor
[[who i.ufs]:ae effect-log.u.test-cor] [[who i.ufs]:afs effect-log.u.test-cor]
=+ ^- [[thru=? events-1=(list ph-event)] cor=cor.u.test-cor] =+ ^- [thru=? events-1=(list ph-event) cor=_cor.u.test-cor]
(route:cor.u.test-cor now.hid who.ae i.ufs.ae) (route:cor.u.test-cor now.hid who.afs i.ufs.afs)
=. cor.u.test-cor cor =. cor.u.test-cor cor
=+ $(ufs.ae t.ufs.ae) =+ $(ufs.afs t.ufs.afs)
:+ ?: thru :+ ?: thru
[i.ufs.ae thru-effects] [i.ufs.afs thru-effects]
thru-efects thru-effects
(weld events-1 events) (weld events-1 events)
cor cor
=. u.test=cor cor =. u.test-cor cor
=. test-cores (~(put by test-cores) lab u.test-cor) =. test-cores (~(put by test-cores) lab u.test-cor)
=^ moves this (publish-aqua-effects who.ae thru-effects) =/ moves-1 (publish-aqua-effects who.afs thru-effects)
(run-events lab events) =^ moves-2 this (run-events lab events)
[(weld moves-1 moves-2) this]
:: ::
:: Subscribe to effects :: Subscribe to effects
:: ::

View File

@ -27,7 +27,7 @@
:: ::
:: Called on every effect from a ship. :: Called on every effect from a ship.
:: ::
++ route |~([now=@da ship unix-effect] *[? (quip ph-event _^?(..start)])) ++ route |~([now=@da ship unix-effect] *[? (quip ph-event _^?(..start))])
-- --
:: ::
++ porcelain-test-core ++ porcelain-test-core

View File

@ -69,28 +69,28 @@
snap=(unit snapshot:jael) snap=(unit snapshot:jael)
== ==
:: ::
+$ vane-card +$ vane-move
%+ pair bone
$% [%peer wire dock path] $% [%peer wire dock path]
[%pull wire dock ~] [%pull wire dock ~]
== ==
:: ::
++ aqua-vane-control-handler ++ aqua-vane-control-handler
|= subscribed=? |= [our=@p ost=bone subscribed=? command=?(%subscribe %unsubscribe)]
|= command=?(%subscribe %unsubscribe) ^- (list vane-move)
^- (list vane-cards)
?- command ?- command
%subscribe %subscribe
%+ weld %+ weld
^- (list vane-card) ^- (list vane-move)
?. subscribed ?. subscribed
~ ~
[%pull /aqua [our %ph]]~ [ost %pull /aqua [our %ph] ~]~
^- (list vane-card) ^- (list vane-move)
[%peer /aqua [our %ph] /effects]~ [ost %peer /aqua [our %ph] /effects]~
:: ::
%unsubscribe %unsubscribe
?. subscribed ?. subscribed
~ ~
[%pull /aqua [our %ph]]~ [ost %pull /aqua [our %ph] ~]~
-- ==
-- --