ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-12-18 04:11:49 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into time-tools

Browse Source 
Conflicts:
	urb/urbit.pill
This commit is contained in:
Philip C Monk 2015-05-19 18:07:54 -04:00
commit 1a275ef482
154 changed files with 5247 additions and 18623 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

219
base/ape/acto/core.hook
View File

@ -1,122 +1,121 @@
:: :: ::
:::: /hook/core/acto/ape :: ::
:: :: ::
:: :::::::::::::::
:::: /hook/core/acto/ape :: :: :: build
:: :::::::::::::::
/- *sole :: structures
/+ sole :: libraries
:: ::
:::: ::
!: ::
:: :::::::::::::::
:::: :: :: :: logic
!: :::::::::::::::
=> |% :: board logic
++ board ,@ :: one-player bitfield
++ point ,[x=@ y=@] :: coordinate
++ bo :: board core
|_ bud=board :: state
++ off |=(point (add x (mul 3 y))) :: bitfield address
++ game ,[who=? box=board boo=board] :: game state
++ icon |=(? ?:(+< 'X' 'O')) :: display at
++ bo :: per board
|_ bud=board ::
++ get |=(point =(1 (cut 0 [(off +<) 1] bud))) :: get point
++ off |=(point (add x (mul 3 y))) :: bitfield address
++ set |=(point (con bud (bex (off +<)))) :: set point
++ win %- lien :_ |=(a=@ =(a (dis a bud))) :: test for win
(rip 4 0wl04h0.4A0Aw.4A00s.0e070) :: with bitmasks
-- ::
-- ::
=> |% :: game logic
++ game ,[tun=? box=board boo=board] :: game state
++ go :: game core
++ go :: per game
|_ game ::
++ pro ": {?:(tun "X" "O")} to move (x/y): " :: prompt
++ say |= point :: point value
?: (~(get bo box) +<) 'X'
?: (~(get bo boo) +<) 'O' '.'
::
++ mov :: move at
|= point
^- [bean game]
?: |((~(get bo box) +<) (~(get bo boo) +<))
[| +>+<]
:- & ?: tun
+>+<(tun |, box (~(set bo box) +<))
+>+<(tun &, boo (~(set bo boo) +<))
::
++ res ^- (unit tape) :: result
?: ~(win bo box) `"X wins!"
?: ~(win bo boo) `"O wins!"
?: =(511 (con boo box)) `"X and O tied." ~
::
++ ray :: render row
|= y=@ ^- tape
:~ (add y '1')
' ' (say y 0)
' ' (say y 1)
' ' (say y 2)
==
++ red ~["+ 1 2 3" (ray 0) (ray 1) (ray 2)] :: render board
--
--
=> |% :: arvo tools
++ card ,[%diff %sole-effect sole-effect] ::
++ move (pair bone card)
++ room (pair sole-share game)
--
|_ $: hid=hide :: system state
hoc=(map bone room)
==
++ yo
|_ [[ost=bone moz=(list move)] rom=room]
++ abet :: resolve
^- (quip move +>)
[(flop moz) +>(hoc (~(put by hoc) ost rom))]
::
++ emit :: produce move
|= fec=sole-effect
^+ +>
+>(moz [[ost %diff %sole-effect fec] moz])
::
++ emil :: emit multiple
|= fex=(list sole-effect)
?~(fex +> $(fex t.fex, +> (emit i.fex)))
::
++ show :: update ui
%+ emil [%pro & %toe ~(pro go q.rom)]
(turn ~(red go q.rom) |=(a=tape [%txt a]))
::
++ wipe :: clear input line
=^ cal p.rom (~(transmit cs p.rom) [%set ~])
(emit %det cal)
::
++ numb (cook |=(a=@ (sub a '1')) (shim '1' '3')) :: row/column
++ come ;~(plug numb ;~(pfix fas numb)) :: command
++ good |=(a=(list ,@c) -:(rose (tufa a) come)) :: validate
++ work ::
|= act=sole-action
^+ +>
?- -.act
%det
=^ cul p.rom (~(remit cs p.rom) +.act good)
?~(cul +>.$ (emit ~[%mor bel/~ det/u.cul]))
::
%ret
=+ dur=(rust (tufa buf.p.rom) come)
?~ dur (emit %bel ~)
=^ dud q.rom (~(mov go q.rom) u.dur)
?. dud (emit %bel ~)
=+ rus=~(res go q.rom)
=< show
?~ rus wipe
wipe:(emit(q.rom *game) %txt u.rus)
==
--
++ peer-sole :: console-subscribe
|= [from pax=path]
^- (quip move +>)
?> =(src our.hid)
abet:~(show yo [ost ~] *room)
::
++ poke-sole-action :: console command
|= [from act=sole-action]
^- (quip move +>)
?> =(src our.hid)
abet:(~(work yo [ost ~] (~(got by hoc) ost)) act)
::
++ pull :: stop subscription
|= then
[~ +>(hoc (~(del by hoc) ost))]
++ at |_ point :: per point
++ g +>+< :: game
++ k !|(x o) :: ok move
++ m ?.(k [| g] [& g:t:?:(who y p)]) :: move
++ o (~(get bo boo) +<) :: old at o
++ p .(boo (~(set bo boo) +<)) :: play at o
++ t .(who !who) :: take turn
++ v ?:(x (icon &) ?:(o (icon |) '.')) :: view
++ x (~(get bo box) +<) :: old at x
++ y .(box (~(set bo box) +<)) :: play at x
-- ::
++ res ?: ~(win bo box) `"{~[(icon &)]} wins" :: result
?: ~(win bo boo) `"{~[(icon |)]} wins" ::
?: =(511 (con boo box)) `"tie :-(" ~ ::
++ row |= y=@ :~ (add y '1') :: print row
' ' ~(v at y 0) ::
' ' ~(v at y 1) ::
' ' ~(v at y 2) ::
== ::
++ tab ~["+ 1 2 3" (row 0) (row 1) (row 2)] :: print table
-- ::
-- ::
:: :::::::::::::::
:::: :: :: :: agent
:: :::::::::::::::
=> |% :: arvo structures
++ axle ,[%0 eye=face gam=game] :: agent state
++ card ,[%diff lime] :: update
++ face (pair (list ,@c) (map bone sole-share)) :: interface
++ lime ,[%sole-effect sole-effect] :: :sole update
++ move (pair bone card) :: cause and action
-- ::
=> |% :: parsers
++ colm (cook |=(a=@ (sub a '1')) (shim '1' '3')) :: row or column
++ come ;~(plug colm ;~(pfix fas colm)) :: coordinate
-- ::
|_ [hid=hide moz=(list move) axle] :: per server
++ et ::
|_ [from say=sole-share] :: per console client
++ abet +>(q.eye (~(put by q.eye) ost say)) :: continue
++ amok +>(q.eye (~(del by q.eye) ost)) :: discontinue
++ beep (emit %bel ~) :: bad user
++ delt |= cal=sole-change :: input line change
=^ cul say (remit:sole cal good) ::
?~ cul (park:abet(p.eye buf.say) | ~) ::
abet:beep:(emit det/u.cul) ::
++ emit |= fec=sole-effect ^+ +> :: send effect
+>(moz [[ost %diff %sole-effect fec] moz]) ::
++ emil |= fex=(list sole-effect) :: send effects
?~(fex +> $(fex t.fex, +> (emit i.fex))) ::
++ good |=((list ,@c) -:(rose (tufa +<) come)) :: valid input
++ kick |= point :: move command
=^ dud gam ~(m ~(at go gam) +<) ::
?. dud abet:beep =+ mus=~(res go gam) ::
(park:abet(gam ?^(mus *game gam)) %2 mus) ::
++ line =^ cal say (transmit:sole set/p.eye) :: update command
(emit %det cal) ::
++ make =+ dur=(rust (tufa p.eye) come) ::
?~ dur abet:beep ::
(kick:line(p.eye ~) +.dur) ::
++ mean |=((unit tape) ?~(+< +> (emit txt/+<+))) :: optional message
++ play |= lev=?(%0 %1 %2) :: update by level
?-(lev %0 +>, %1 line, %2 line:show:prom) ::
++ plow |= [lev=?(%0 %1 %2) mus=(unit tape)] :: complete print
abet:(mean:(play lev) mus) ::
++ prom %^ emit %pro %& :- %acto :: update prompt
": {~[(icon who.gam)]} to move (row/col): " ::
++ rend (turn `wall`~(tab go gam) |=(tape txt/+<)) :: table print
++ show (emit %mor rend) :: update board
++ sole ~(. cs say) :: console library
++ work |= act=sole-action :: console input
?:(?=(%det -.act) (delt +.act) make) ::
-- ::
++ abet [(flop moz) .(moz ~)] :: resolve core
++ flet |=(from ~(. et +< (~(got by q.eye) ost))) :: in old client
++ fret |=(from ~(. et +< *sole-share)) :: in new client
++ pals %+ turn (pale hid (prix /sole)) |= sink :: per console
[[p=p.+< q=q.+<] r=(~(got by q.eye) p.+<)] ::
++ park |= [lev=?(%0 %1 %2) mus=(unit tape)] :: update all
=+ pals ::
|- ^+ +>.^$ ?~ +< +>.^$ ::
$(+< t.+<, +>.^$ (~(plow et i.+<) lev mus)) ::
:: :::::::::::::::
:::: :: :: :: hooks
:: :::::::::::::::
++ peer-sole :: console subscribe
|= [from *] =< abet ::
(plow:(fret +<-) %2 ~) ::
++ poke-sole-action :: console input
|= [from act=sole-action] =< abet ::
(work:(flet +<-) act) ::
++ prep |= [from old=(unit ,[(list move) axle])] :: initialize
=< abet ?~ old +> =< (park %2 ~) ::
+>(+<+ u.old) ::
++ pull-sole :: disconnect console
|= [from *] =< abet ::
amok:(flet +<-) ::
--

57
base/ape/dojo/core.hook
View File

@ -70,10 +70,6 @@
== ::
++ bead ,[p=(set beam) q=cage] :: computed result
++ goal ,[p=ship q=term] :: flat application
++ note :: general note
$% [%exec @p (unit silk)] ::
[%deal sock term club] ::
== ::
++ clap :: action, user
$% [%peer p=path] :: subscribe
[%poke p=term q=*] :: apply
@ -87,7 +83,7 @@
++ card :: general card
$% [%diff %sole-effect sole-effect] ::
[%send wire [ship term] clap] ::
[%exec wire @p (unit silk)] ::
[%exec wire @p beak (unit silk)] ::
[%deal wire sock term club] ::
== ::
++ move (pair bone card) :: user-level move
@ -128,23 +124,32 @@
[%sic p=tile q=horn] :: /^ cast
[%toy p=mark] :: /mark/ static
== ::
++ milk (trel ship desk silk) :: sourced silk
++ silk :: construction layer
$& [p=silk q=silk] :: cons
$% [%bake p=mark q=beam r=path] :: local synthesis
[%boil p=mark q=beam r=path] :: general synthesis
[%bunt p=mark] :: example of mark
[%call p=silk q=silk] :: slam
[%cast p=mark q=silk] :: translate
[%done p=(set beam) q=cage] :: literal
[%diff p=silk q=silk] :: diff
[%done p=(set beam) q=gage] :: literal
[%dude p=tank q=silk] :: error wrap
[%dune p=(set beam) q=(unit cage)] :: unit literal
[%dune p=(set beam) q=(unit gage)] :: unit literal
[%file p=beam] :: from clay
[%join p=mark q=silk r=silk] :: merge
[%mash p=mark q=milk r=milk] :: annotate
[%mute p=silk q=(list (pair wing silk))] :: mutant
[%pact p=silk q=silk] :: patch
[%plan p=beam q=spur r=hood] :: structured assembly
[%reef ~] :: kernel reef
[%ride p=twig q=silk] :: silk thru twig
[%tabl p=(list (pair silk silk))] :: list
[%vale p=mark q=ship r=*] :: validate [our his]
[%volt p=(set beam) q=(cask ,*)] :: unsafe add type
== ::
++ sign ::
$% [%made p=@uvH q=(each cage tang)] ::
$% [%made p=@uvH q=(each gage tang)] ::
[%unto p=cuft] ::
== ::
-- ::
@ -230,7 +235,7 @@
;~(pfix fas sym)
==
(cook |=(a=term `goal`[our.hid a]) sym)
(easy [our.hid %helm])
(easy [our.hid %hood])
==
++ dp-model-cat ;~(plug dp-server-cat dp-config) :: ++dojo-model
++ dp-model-dog ;~(plug dp-server-dog dp-config) :: ++dojo-model
@ -271,16 +276,20 @@
|_ dojo-project ::
++ dy-abet +>(poy `+<) :: resolve
++ dy-amok +>(poy ~) :: terminate
++ dy-beak :: XX rethink
^- beak
[our.hid %home [%da lat.hid]]
::
++ dy-ford :: send work to ford
|= [way=wire kas=silk]
^+ +>+>
?> ?=(~ pux)
(he-card(poy `+>+<(pux `way)) %exec way our.hid `kas)
(he-card(poy `+>+<(pux `way)) %exec way our.hid dy-beak `kas)
::
++ dy-stop :: stop work
^+ +>
?~ pux +>
(he-card(poy ~) %exec u.pux our.hid ~)
(he-card(poy ~) %exec u.pux our.hid dy-beak ~)
::
++ dy-slam :: call by ford
|= [way=wire gat=vase sam=vase]
@ -496,6 +505,10 @@
^- silk
[%boil %gate [he-beak (flop way)] ~]
::
++ dy-twig-head :: dynamic state
^- vase
:(slop !>(`our=@p`our.hid) !>(`tym=@da`lat.hid) !>(`eny=@uvI`eny.hid))
::
++ dy-made-dial :: dialog product
|= cag=cage
^+ +>+>
@ -531,7 +544,7 @@
%di [/dial (dy-silk-init-modo (dy-cage p.p.p.q.u.cud) q.p.q.u.cud)]
%ge [/gent (dy-silk-init-modo (dy-cage p.p.p.q.u.cud) q.p.q.u.cud)]
%dv [/hand (dy-silk-device p.q.u.cud)]
%ex [/hand [%ride p.q.u.cud [%reef ~]]]
%ex [/hand [%ride p.q.u.cud [[%done ~ %$ dy-twig-head] [%reef ~]]]]
%tu :- /hand
:+ %done ~
:- %noun
@ -613,12 +626,13 @@
[& %$ "> "]
::
++ he-made :: result from ford
|= [way=wire dep=@uvH rey=(each cage tang)]
|= [way=wire dep=@uvH reg=(each gage tang)]
^+ +>
?> ?=(^ poy)
=< he-pine
?- -.rey
%& %. p.rey
?- -.reg
%& ?> ?=(@ p.p.reg)
%. p.reg
=+ dye=~(. dy u.poy(pux ~))
?+ way !!
[%hand ~] dy-hand:dye
@ -626,8 +640,7 @@
[%gent ~] dy-made-gent:dye
[%edit ~] dy-made-edit:dye
==
%| ~& [%he-made-fail way]
(he-diff(poy ~) %tan p.rey)
%| (he-diff(poy ~) %tan p.reg)
==
::
++ he-unto :: result from behn
@ -701,19 +714,19 @@
==
--
::
++ peer
++ peer-sole
|= [from pax=path]
^- (quip move +>)
~? !=(src our.hid) [%dojo-peer-stranger ost src pax]
:: ?> =(src our.hid)
?< (~(has by hoc) ost)
?> =(/sole pax)
?> =(~ pax)
=< he-abet
%~ he-peer he
:- [ost ~]
^- session
:* *sole-share :: say=sole-share
%main :: syd=desk
%home :: syd=desk
~ :: luc=(unit case)
~ :: poy=(unit dojo-project)
~ :: var=(map term cage)
@ -728,8 +741,8 @@
he-abet:(~(he-type he [ost ~] (~(got by hoc) ost)) act)
::
++ made
|= [then dep=@uvH rey=(each cage tang)]
he-abet:(~(he-made he [[ost ~] (~(got by hoc) ost)]) way dep rey)
|= [then dep=@uvH reg=(each gage tang)]
he-abet:(~(he-made he [[ost ~] (~(got by hoc) ost)]) way dep reg)
::
++ unto
|= [then cit=cuft]

183
base/ape/helm/core.hook
View File

@ -1,183 +0,0 @@
:: :: ::
:::: /hook/core/helm/ape :: ::
:: :: ::
/? 314 :: zuse version
/- *sole :: structures
/+ sole :: libraries
:: :: ::
:::: :: ::
!: :: ::
=> |% :: principal structures
++ helm-house :: all state
$: %0 :: state version
bur=(unit (pair ship mace)) :: requesting ticket
hoc=(map bone helm-session) :: consoles
== ::
++ helm-session ::
$: say=sole-share ::
mud=(unit (sole-dialog ,@ud)) ::
== ::
++ funk (pair ,@ ,@) ::
++ begs ,[his=@p tic=@p eny=@t ges=gens] :: begin data
++ suss ,[term @tas @da] :: config report
++ helm-wish ::
$| $? %reset :: reset kernel
%verb :: verbose mode
== ::
$% [%reload p=(list term)] :: reload vanes
== ::
++ dill :: sent to %dill
$% [%crud p=term q=(list tank)] :: fat report
[%text p=tape] :: thin report
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ card ::
$% [%cash wire p=@p q=buck] ::
[%conf wire dock %load ship term] ::
[%flog wire dill] ::
[%plug wire @p @tas @p @tas] ::
[%want wire sock path *] :: send message
== ::
++ move (pair bone card) :: user-level move
-- ::
:: ::
:::: ::
:: ::
|_ $: hid=hide :: system state
helm-house :: program state
== ::
++ he :: per session
|_ [[ost=bone moz=(list move)] helm-session] ::
++ he-abet :: resolve
[(flop moz) %_(+> hoc (~(put by hoc) ost +<+))] ::
:: ::
++ he-wish-start
|= dap=term
%_(+> moz :_(moz [ost %conf /start [our.hid dap] %load our.hid %main]))
::
++ he-wish-reset
^+ .
=- %_(+ moz (weld zum moz))
^= zum %- flop ^- (list move)
=+ top=`path`/(scot %p our.hid)/arvo/(scot %da lat.hid)
:- [ost %flog /reset %vega (weld top `path`/hoon)]
%+ turn
^- (list ,[p=@tas q=@tas])
:~ [%$ %zuse]
[%a %ames]
[%c %clay]
[%d %dill]
[%e %eyre]
[%f %ford]
[%g %gall]
[%t %time]
==
|= [p=@tas q=@tas]
=+ way=`path`(welp top /[q])
=+ txt=((hard ,@) .^(%cx (welp way /hoon)))
[ost %flog /reset %veer p way txt]
::
++ he-wish-reload
|= all=(list term)
%_ +>.$
moz
%- weld
:_ moz
%+ turn all
=+ ark=(arch .^(%cy /(scot %p our.hid)/arvo/(scot %da lat.hid)))
=+ van=(~(tap by r.ark))
|= nam=@tas
=. nam
?. =(1 (met 3 nam))
nam
=+ ^- zaz=(list ,[p=span ~])
(skim van |=([a=term ~] =(nam (end 3 1 a))))
?> ?=([[@ ~] ~] zaz)
`term`p.i.zaz
=+ tip=(end 3 1 nam)
=+ way=[(scot %p our.hid) %arvo (scot %da lat.hid) nam %hoon ~]
=+ fil=(,@ .^(%cx way))
:* ost
%flog
/reload
[%veer ?:(=('z' tip) %$ tip) way (,@ .^(%cx way))]
==
==
::
++ he-wish-verb
%_ .
moz
:_ moz
[ost %flog /verb %verb ~]
==
++ he-wish-init
|= him=ship
%_ +>.$
moz
:_ moz
[ost %flog /init %crud %hax-init leaf/(scow %p him) ~]
==
--
::
++ hake :: poke core
|= [ost=bone src=ship]
?> =(src our.hid)
~(. he [ost ~] (fall (~(get by hoc) ost) *helm-session))
::
++ poke-helm-reset
|= [from ~]
~& %poke-helm-reset
he-abet:he-wish-reset:(hake ost src)
::
++ poke-helm-verb
|= [from ~]
~& %poke-helm-verb
he-abet:he-wish-verb:(hake ost src)
::
++ poke-helm-init
|= [from him=ship]
~& %poke-helm-init
he-abet:(he-wish-init:(hake ost src) him)
::
++ poke-helm-reload
|= [from all=(list term)]
he-abet:(he-wish-reload:(hake ost src) all)
::
++ poke-helm-start
|= [from dap=term]
he-abet:(he-wish-start:(hake ost src) dap)
::
++ poke-helm-begin
|= [from begs]
~& %behn-helm-begin
?> ?=(~ bur)
=+ buz=(shax :(mix (jam ges) eny))
=+ loy=(bruw 2.048 buz)
:_ +>.$(bur `[his [0 sec:ex:loy]~])
:~ :* ost %want /ticketing [our.hid (sein his)] /q/ta
his tic ges pub:ex:loy
==
==
::
++ poke-will
|= [from wil=(unit will)]
?> ?=(^ bur)
:_ +>.$(bur ~)
?~ wil
!!
:~ [ost %cash ~ p.u.bur q.u.bur u.wil]
[ost %plug ~ our.hid %main (sein our.hid) %main]
[ost %plug ~ our.hid %arvo (sein our.hid) %arvo]
[ost %plug ~ our.hid %try (sein our.hid) %try]
==
::
++ onto
|= [then saw=(each suss tang)]
:_ +> :_ ~
?- -.saw
%| [ost %pass ~ %flog %crud `@tas`-.way `tang`p.saw]
%& [ost %pass ~ %flog %text "<{<p.saw>}>"]
==
--

152
base/ape/hood/core.hook Normal file
View File

@ -0,0 +1,152 @@
:: :: ::
:::: /hook/core/hood/ape :: ::
:: :: ::
/? 314 :: zuse version
/+ sole, talk, helm, kiln, drum :: libraries
:: :: ::
:::: :: ::
!: :: ::
=> |% :: module boilerplate
++ hood-0 ::
,[%0 lac=(map ,@tas hood-part)] ::
++ hood-good ::
|* hed=hood-head ::
|= paw=hood-part ::
?- hed ::
%drum ?>(?=(%drum -.paw) `drum-part`paw) ::
%helm ?>(?=(%helm -.paw) `helm-part`paw) ::
%kiln ?>(?=(%kiln -.paw) `kiln-part`paw) ::
== ::
++ hood-head ,_-:*hood-part ::
++ hood-make ::
|* [our=@p hed=hood-head] ::
?- hed ::
%drum (drum-port our) ::
%helm *helm-part ::
%kiln *kiln-part ::
== ::
++ hood-part ::
$% [%drum %0 drum-pith] ::
[%helm %0 helm-pith] ::
[%kiln %0 kiln-pith] ::
== ::
-- ::
:: :: ::
:::: :: ::
:: :: ::
|_ $: hid=hide :: system state
hood-0 :: server state
== ::
++ able :: find/make part
|* hed=hood-head
=+ rep=(~(get by lac) hed)
=+ par=?^(rep u.rep `hood-part`(hood-make our.hid hed))
((hood-good hed) par)
::
++ ably :: save part
|* [moz=(list) rep=hood-part]
[(flop moz) %_(+> lac (~(put by lac) -.rep rep))]
:: :: ::
:::: :: ::
:: :: ::
++ coup-kiln-fancy ::
|= [then saw=(unit tang)]
(ably (take-coup-fancy:(kiln-work [hid ost src] (able %kiln)) way +<+))
::
++ coup-kiln-spam ::
|= [then saw=(unit tang)]
~? ?=(^ saw) [%kiln-spam-lame u.saw]
[~ +>]
::
++ coup-drum ::
|= [then saw=(unit tang)]
(ably (take-coup:(drum-work [hid ost src] (able %drum)) way +<+))
::
++ diff-sole-effect-drum
|= [then sole-effect]
(ably (diff-sole-effect:(drum-work [hid ost src] (able %drum)) way +<+))
::
++ poke-hood-begin ::
|= [from hood-begin]
(ably (poke-begin:(helm-work [hid +<-] (able %helm)) +<+))
::
++ poke-helm-init ::
|= [from hood-init]
(ably (poke-init:(helm-work [hid +<-] (able %helm)) +<+))
::
++ poke-hood-mass ::
|= [from ~]
(ably poke-mass:(helm-work [hid +<-] (able %helm)))
::
++ poke-hood-merge ::
|= [from hood-merge]
(ably (poke-merge:(kiln-work [hid +<-] (able %kiln)) +<+))
::
++ poke-hood-reload ::
|= [from hood-reload]
(ably (poke-reload:(helm-work [hid +<-] (able %helm)) +<+))
::
++ poke-hood-reset ::
|= [from ~]
(ably (poke-reset:(helm-work [hid +<-] (able %helm)) +<+))
::
++ poke-hood-sync ::
|= [from hood-sync]
(ably (poke-sync:(kiln-work [hid +<-] (able %kiln)) +<+))
::
++ poke-hood-unix ::
|= [from hood-unix]
(ably (poke-unix:(kiln-work [hid +<-] (able %kiln)) +<+))
::
++ poke-hood-verb ::
|= [from ~]
(ably (poke-verb:(helm-work [hid +<-] (able %helm)) +<+))
::
++ poke-hood-start ::
|= [from drum-start]
(ably (poke-start:(drum-work [hid +<-] (able %drum)) +<+))
::
++ poke-dill-belt
|= [from dill-belt]
(ably (poke-dill-belt:(drum-work [hid +<-] (able %drum)) +<+))
::
++ poke-will ::
|= [from (unit will)]
(ably (poke-will:(helm-work [hid +<-] (able %helm)) +<+))
::
++ mere-kiln ::
|= [then are=(each (set path) (pair term tang))]
(ably (take-mere:(kiln-work [hid ost src] (able %kiln)) way +<+))
::
++ made-kiln ::
|= [then @uvH (each gage tang)]
(ably (take-made:(kiln-work [hid ost src] (able %kiln)) way +<+))
::
++ init-helm ::
|= [then *]
[~ +>]
::
++ note-helm ::
|= [then (pair ,@tD tank)]
(ably (take-note:(helm-work [hid ost src] (able %helm)) way +<+))
::
++ reap-drum
|= [then saw=(unit tang)]
(ably (reap:(drum-work [hid ost src] (able %drum)) way +<+))
::
++ onto-drum ::
|= [then saw=(each ,[term @tas @da] tang)]
(ably (take-onto:(drum-work [hid ost src] (able %drum)) way +<+))
::
++ peer-drum
|= [from pax=path]
(ably (peer:(drum-work [hid +<-] (able %drum)) +<+))
::
++ quit-drum
|= then
(ably (quit:(drum-work [hid ost src] (able %drum)) way))
::
++ went-helm ::
|= [then her=ship kay=cape]
(ably (take-went:(helm-work [hid ost src] (able %helm)) way +<+))
--

179
base/ape/octo/core.hook Normal file
View File

@ -0,0 +1,179 @@
:: :: ::
:::: /hook/core/acto/ape :: :: dependencies
:: :: ::
/- *sole :: structures
/+ sole :: libraries
:: :: ::
:::: :: :: structures
!: :: ::
=> |% :: board logic
++ board ,@ :: one-player bitfield
++ point ,[x=@ y=@] :: coordinate
++ game ,[who=? box=board boo=board] :: game state
++ icon |=(? ?:(+< 'X' 'O')) :: display at
++ bo :: per board
|_ bud=board ::
++ get |=(point =(1 (cut 0 [(off +<) 1] bud))) :: get point
++ off |=(point (add x (mul 3 y))) :: bitfield address
++ set |=(point (con bud (bex (off +<)))) :: set point
++ win %- lien :_ |=(a=@ =(a (dis a bud))) :: test for win
(rip 4 0wl04h0.4A0Aw.4A00s.0e070) :: with bitmasks
-- ::
++ go :: per game
|_ game ::
++ at |_ point :: per point
++ g +>+< :: game
++ k !|(x o) :: ok move
++ m ?.(k [| g] [& g:t:?:(who y p)]) :: move
++ o (~(get bo boo) +<) :: old at o
++ p .(boo (~(set bo boo) +<)) :: play at o
++ t .(who !who) :: take turn
++ v ?:(x (icon &) ?:(o (icon |) '.')) :: view
++ x (~(get bo box) +<) :: old at x
++ y .(box (~(set bo box) +<)) :: play at x
-- ::
++ res ?: ~(win bo box) `"{~[(icon &)]} wins" :: result
?: ~(win bo boo) `"{~[(icon |)]} wins" ::
?: =(511 (con boo box)) `"tie :-(" ~ ::
++ row |= y=@ :~ (add y '1') :: print row
' ' ~(v at y 0) ::
' ' ~(v at y 1) ::
' ' ~(v at y 2) ::
== ::
++ tab ~["+ 1 2 3" (row 0) (row 1) (row 2)] :: print table
-- ::
-- ::
:: :: ::
:::: :: :: server
:: :: ::
=> |% :: arvo structures
++ axle ,[%1 eye=face but=tube gam=game] :: agent state
++ axon $?(axle [%0 eye=face gam=game]) :: historical state
++ card $% [%diff lime] :: update
[%quit ~] :: cancel
[%peer wire dock path] :: subscribe
[%pull wire dock ~]
== ::
++ face (pair (list ,@c) (map bone sole-share)) :: interface
++ lime $% [%sole-effect sole-effect] :: :sole update
[%octo-game game] :: :octo update
== ::
++ move (pair bone card) :: cause and action
++ mote (pair ship ,?) :: remote binding
++ tube (unit (pair ,? mote)) :: alive, remote
-- ::
=> |% :: parsers
++ colm (cook |=(a=@ (sub a '1')) (shim '1' '3')) :: row or column
++ come ;~(plug colm ;~(pfix fas colm)) :: coordinate
++ comb (pick come (punt ;~(pfix sig comp))) :: all command input
++ comp ;~(plug fed:ag ;~(pfix ace (flag %x %o))) :: login command
++ cope |=(? ?:(+< (stag %| (cold ~ sig)) comb)) :: with wait mode
-- ::
|_ [hid=hide moz=(list move) axle] :: per agent
++ et ::
|_ [from say=sole-share] :: per console client
++ abet +>(q.eye (~(put by q.eye) ost say)) :: continue
++ amok +>(q.eye (~(del by q.eye) ost)) :: discontinue
++ beep (emit %bel ~) :: bad user
++ cusp (cope wait) :: parsing rule
++ delt |= cal=sole-change :: input line change
=^ cul say (remit:sole cal good) ::
?~ cul (park:abet(p.eye buf.say) | ~) ::
abet:beep:(emit det/u.cul) ::
++ emit |= fec=sole-effect ^+ +> :: send effect
+>(moz [[ost %diff %sole-effect fec] moz]) ::
++ emil |= fex=(list sole-effect) :: send effects
?~(fex +> $(fex t.fex, +> (emit i.fex))) ::
++ good |=((list ,@c) -:(rose (tufa +<) cusp)) :: valid input
++ kick |= point :: move command
=^ dud gam ~(m ~(at go gam) +<) ::
?. dud abet:beep =+ mus=~(res go gam) ::
(park:abet(gam ?^(mus *game gam)) %2 mus) ::
++ line =^ cal say (transmit:sole set/p.eye) :: update command
(emit %det cal) ::
++ make =+ dur=(rust (tufa p.eye) comb) ::
?~ dur abet:beep ::
=. + line(p.eye ~) ::
?-(+<.dur & (kick +>.dur), | (plan +>.dur)) ::
++ mean |=((unit tape) ?~(+< +> (emit txt/+<+))) :: optional message
++ play |= lev=?(%0 %1 %2) :: update by level
?-(lev %0 +>, %1 line, %2 line:show:prom) ::
++ plow |= [lev=?(%0 %1 %2) mus=(unit tape)] :: complete print
abet:(mean:(play lev) mus) ::
++ prom %^ emit %pro %& :- %octo :: update prompt
?: wait "(xir turn) " ::
": {~[(icon who.gam)]} to move (row/col): " ::
++ plan |= mut=(unit mote) :: peer command
?~ mut ?~(but abet:beep stop:abet) ::
?^(but abet:beep (link:abet u.mut)) ::
++ rend (turn `wall`~(tab go gam) |=(tape txt/+<)) :: table print
++ show (emit %mor rend) :: update board
++ sole ~(. cs say) :: console library
++ wait &(?=(^ but) !=(q.q.u.but who.gam)) :: waiting turn
++ work |= act=sole-action :: console input
?:(?=(%det -.act) (delt +.act) make) ::
-- ::
++ abet [(flop moz) .(moz ~)] :: resolve core
++ dump |=(mov=move %_(+> moz [mov moz])) :: send move
++ dish |=(cad=card (dump 0 cad)) :: forward move
++ flet |=(from ~(. et +< (~(got by q.eye) ost))) :: in old client
++ fret |=(from ~(. et +< *sole-share)) :: in new client
++ like |=(xir=ship |*(* [/octo [xir %octo] +<])) :: to friend
++ link |= mot=mote %- dish(but `[| mot]) :: subscribe to friend
peer/((like p.mot) /octo/[?:(q.mot %x %o)]) ::
++ pals %+ turn (pale hid (prix /sole)) |= sink :: per console
[[p=p.+< q=q.+<] r=(~(got by q.eye) p.+<)] ::
++ park |= [lev=?(%0 %1 %2) mus=(unit tape)] :: update all
=. +> ?:(=(%2 lev) push +>) ::
=+ pals ::
|- ^+ +>.^$ ?~ +< +>.^$ ::
$(+< t.+<, +>.^$ (~(plow et i.+<) lev mus)) ::
++ push =+ pey=(pale hid (prix /octo)) |- ^+ +> :: update friends
?~(pey +> $(pey t.pey, +> (sell p.i.pey))) ::
++ sell |=(ost=bone (dump ost %diff %octo-game gam)) :: update friend
++ stop (dish(but ~) pull/((like +>-.but) ~)) :: cancel subscribe
:: :::::::::::::::
:::: :: :: :: hooks
:: :::::::::::::::
++ diff-octo-game :: friend update
|= [then gam=game] =< abet ::
?. &(?=([~ %& *] but) =(src p.q.u.but)) +> ::
?: =(^gam gam) +> ::
(park(gam gam) %2 ~) ::
++ peer-octo :: linked by friend
|= [from pax=path] =< abet ::
=+ who==(%x -.pax) ::
?^ but (park %2 ~) :: [~ %& !who src]
(park:(link src !who) %2 `"link by {<src>}") ::
++ peer-sole :: console subscribe
|= [from pax=path] =< abet ::
(plow:(fret +<-) %2 ~) ::
++ poke-sole-action :: console input
|= [from act=sole-action] =< abet ::
(work:(flet +<-) act) ::
++ poke-octo-move ::
|= [from wha=point] =< abet ::
=^ dud gam ~(m ~(at go gam) wha) ::
?> dud =+ mus=~(res go gam) ::
(park(gam ?^(mus *game gam)) %2 mus) ::
++ prep |= [from old=(unit ,[(list move) axon])] :: initialize
=< abet ?~ old +> ::
=< (park %2 ~) ::
?- -.+>.old ::
%1 +>(+<+ u.old) ::
%0 +>(eye.+< eye.+>.old, gam.+< gam.+>.old)::
== ::
++ pull-octo ::
|= [from *] =< abet ::
(park(but ~) %0 `"dropped") ::
++ pull-sole :: disconnect console
|= [from *] =< abet ::
amok:(flet +<-) ::
++ quit-octo :: unlinked by friend
|=([then ~] abet:(park(but ~) %0 `"removed")) ::
++ reap-octo :: linked to friend
|= [then saw=(unit tang)] =< abet ::
?> ?=([~ %| *] but) ::
?^ saw (park:stop %0 `"fail to {<src>}") ::
(park(p.u.but %&) %0 `"link to {<src>}") ::
--

47
base/ape/sole/core.hook
View File

@ -65,7 +65,6 @@
[%peer wire dock path] ::
[%poke wire dock pear] ::
[%pull wire dock ~] ::
[%pass wire note] ::
== ::
++ move (pair bone card) :: user-level move
-- ::
@ -134,8 +133,9 @@
++ se-drop :: passive drop
|= gyl=gill
^+ +>
?. (~(has by feg) gyl) +>
=. +> (se-blit %out (tuba "[disconnected from {<gyl>}]"))
=< se-prom
?> (~(has by feg) gyl)
%_ +>
feg (~(del by feg) gyl)
apt (skip apt |=(a=gill =(gyl a)))
@ -198,7 +198,7 @@
|= gyl=gill
^+ +>
=. +> ?. =(p.gyl src) +>
(se-emit ost %conf (se-path gyl) gyl %load src %main)
(se-emit ost %conf (se-path gyl) gyl %load src %home)
(se-join:(se-peer gyl /sole) gyl)
::
++ se-blit :: give output
@ -253,10 +253,6 @@
|= gyl=gill
(se-emit ost %pull (se-path gyl) gyl ~)
::
++ se-pass :: pass an action
|= [gyl=gill noh=note]
(se-emit ost %pass (se-path gyl) noh)
::
++ se-tame
|= gyl=gill
^+ ta
@ -614,6 +610,10 @@
==
==
::
++ gull
|= way=wire ^- (pair ship gill)
?>(?=([@ @ @ ~] way) [(slav %p i.way) (slav %p i.t.way) i.t.t.way])
::
++ poke-dill-belt
|= [from bet=dill-belt]
^- (quip move +>)
@ -634,18 +634,23 @@
?~ yog
~& [%sole-diff-stale ost way]
[~ +>.$]
?> ?=([@ @ @ ~] way)
=< se-abet
=< se-view
=+ gyl=[(slav %p i.t.way) i.t.t.way]
(~(se-diff se [~ ~] [(slav %p i.way) ost] u.yog) gyl fec)
=+ yaw=(gull way)
(~(se-diff se [~ ~] [p.yaw ost] u.yog) q.yaw fec)
::
++ coup
|= [then saw=(unit tang)]
^- (quip move +>)
?~ saw [~ +>]
:_ +> :_ ~
[ost %flog ~ %crud %coup u.saw]
=+ yog=(~(get by bin) ost)
?~ yog
~& [%sole-coup-stale ost way]
[~ +>.$]
=< se-abet
=< se-view
=+ yaw=(gull way)
(~(se-drop se [[ost %flog ~ %crud %coup u.saw]~ ~] [p.yaw ost] u.yog) q.yaw)
::
++ reap
|= [then saw=(unit tang)]
@ -657,18 +662,26 @@
++ quit
|= then
^- (quip move +>)
[~ +>]
=+ yog=(~(get by bin) ost)
?~ yog
~& [%sole-quit-stale ost way]
[~ +>.$]
=< se-abet
=< se-view
=+ yaw=(gull way)
(~(se-drop se [~ ~] [p.yaw ost] u.yog) q.yaw)
::
++ onto
|= [then saw=(each suss tang)]
:_ +> :_ ~
:_ +>
?- -.saw
%| [ost %flog ~ %crud `@tas`-.way `tang`p.saw]
%& [ost %flog ~ %text "<{<p.saw>}>"]
%| [[ost %flog ~ %crud `@tas`-.way `tang`p.saw] ~]
%& :: [ost %flog ~ %text "<{<p.saw>}>"]
~
==
::
++ pull
|= from
|= [from pax=path]
^- (quip move +>)
:: ~& [%sole-pull ost]
=^ moz +>

86
base/ape/talk/core.hook
View File

@ -1,6 +1,6 @@
::
:::: /hook/core/talk/app
::
:: :: ::
:::: /hook/core/talk/app :: ::
:: :: ::
/? 314
/- *talk, *sole
/+ talk, sole
@ -957,13 +957,10 @@
|= mov=move
%_(+> moves [mov moves])
::
++ ra-ever :: emit success
.
::
++ ra-evil :: emit error
|= msg=cord
~& [%ra-evil msg]
+>
~| [%ra-evil msg]
!!
::
++ ra-house :: emit partners
|= ost=bone
@ -999,13 +996,11 @@
?~ q.cod
?. (~(has by stories) p.cod)
(ra-evil %talk-no-story)
=. +>.$ (ra-config p.cod *config)
ra-ever(stories (~(del by stories) p.cod))
=. +>.$ (ra-config p.cod u.q.cod)
ra-ever
(ra-config(stories (~(del by stories) p.cod)) p.cod *config)
(ra-config p.cod u.q.cod)
::
%review ra-ever:(ra-think | her +.cod)
%publish ra-ever:(ra-think & her +.cod)
%review (ra-think | her +.cod)
%publish (ra-think & her +.cod)
==
::
++ ra-config :: configure story
@ -1036,6 +1031,11 @@
%- (ra-know man) |= par=_pa =< pa-abet
(pa-quit:par %& cuz)
::
++ ra-retry :: subscription resend
|= [man=span cuz=station]
%- (ra-know man) |= par=_pa =< pa-abet
(pa-acquire:par [%& cuz]~)
::
++ ra-coup-repeat ::
|= [[num=@ud her=@p man=span] saw=(unit tang)]
(ra-repeat num [%& her man] saw)
@ -1055,13 +1055,12 @@
(ra-think | our.hid u.oot ~)
::
++ ra-cancel :: drop a bone
^+ .
=+ hep=(~(get by sup.hid) ost)
?~ hep +
?. ?=([@ @ *] q.u.hep)
+(general (~(del in general) ost))
%- (ra-know i.t.q.u.hep) |= par=_pa =< pa-abet
(pa-notify:pa-cancel:par p.u.hep %gone *human)
|= [src=ship pax=path]
^+ +>
?. ?=([@ @ *] pax)
+>(general (~(del in general) ost))
%- (ra-know i.t.pax) |= par=_pa =< pa-abet
(pa-notify:pa-cancel:par src %gone *human)
::
++ ra-human :: look up person
|= her=ship
@ -1238,6 +1237,9 @@
++ pa-diff-talk-report :: subscribed update
|= [cuz=station rad=report]
^+ +>
?. (~(has in sources.shape) [%& cuz])
~& [%pa-diff-unexpected cuz rad]
+>
?+ -.rad ~|([%talk-odd-friend rad] !!)
%cabal (pa-cabal cuz +.rad)
%group (pa-remind [%& cuz] +.rad)
@ -1307,7 +1309,7 @@
pa-monitor
::
++ pa-cancel :: unsubscribe from
:: ~& [%pa-cancel ost]
~& [%pa-cancel ost]
%_ .
guests (~(del by guests) ost)
viewers (~(del in viewers) ost)
@ -1549,7 +1551,7 @@
==
==
++ ta-best :: most relevant
|=(two=partner ?:((ta-beat two) one two))
|=(two=partner ?:((ta-beat two) two one))
::
++ ta-full (ta-show ~) :: render full width
++ ta-show :: render partner
@ -1649,12 +1651,16 @@
?: oug
(weld "@ " txt)
(weld " " txt)
::
%app
[' ' (trip p.sep)]
==
--
::
++ peer :: accept subscription
|= [from pax=path]
^- [(list move) _+>]
:: ~& [%talk-peer src ost pax]
?: ?=([%sole *] pax)
?> =(our.hid src)
?< (~(has by shells) ost)
@ -1679,7 +1685,7 @@
::
++ coup-repeat ::
|= [then saw=(unit tang)]
%+ etch-repeat way |= [num=@ud src=@p man=span]
%+ etch-repeat [%repeat way] |= [num=@ud src=@p man=span]
ra-abet:(~(ra-coup-repeat ra ost ~) [num src man] saw)
::
++ etch :: parse wire
@ -1705,24 +1711,32 @@
=+ wer=(etch way)
?>(?=(%repeat -.wer) (fun p.wer q.wer r.wer))
::
++ quit-friend ::
|= then
%+ etch-friend way |= [man=span cuz=station]
++ reap-friend ::
|= [then saw=(unit tang)]
^- (quip move +>)
?~ saw [~ +>]
%+ etch-friend [%friend way] |= [man=span cuz=station]
~& [%reap-friend-fail man cuz u.saw]
ra-abet:(~(ra-quit ra ost ~) man cuz)
::
++ quit-friend ::
|= then
%+ etch-friend [%friend way] |= [man=span cuz=station]
ra-abet:(~(ra-retry ra ost ~) man cuz)
::
++ pull ::
|= [from ~]
|= [from pax=path]
^- [(list move) _+>]
:: ~& [%talk-pull `*`ost]
=^ moz +>.$ ra-abet:ra-ever:~(ra-cancel ra ost ~)
~& [%talk-pull src ost pax]
=^ moz +>.$ ra-abet:(~(ra-cancel ra ost ~) src pax)
[moz +>.$(shells (~(del by shells) ost))]
::
++ poke-bit
|= [from ~]
^- (quip move +>)
:_ +>.$
=+ paf=/(scot %p our.hid)/try/(scot %da lat.hid)/talk/backlog/jam
[ost %info /jamfile our.hid (foal paf (jam +<+.+>.$))]~
::++ poke-bit
:: |= [from ~]
:: ^- (quip move +>)
:: :_ +>.$
:: =+ paf=/(scot %p our.hid)/try/(scot %da lat.hid)/talk/backlog/jam
:: [ost %info /jamfile our.hid (foal paf (jam +<+.+>.$))]~
::
++ prep
|= [from old=(unit house)]

123
base/ape/ucto/core.hook Normal file
View File

@ -0,0 +1,123 @@
:: :: ::
:::: /hook/core/acto/ape :: :: dependencies
:: :: ::
/- *sole :: structure
/+ sole :: library
:: :: ::
:::: :: :: structures
!: :: ::
=> |% :: board logic
++ board ,@ :: one-player bitfield
++ point ,[x=@ y=@] :: coordinate
++ game ,[who=? box=board boo=board] :: game state
++ icon |=(? ?:(+< 'X' 'O')) :: display at
++ bo :: per board
|_ bud=board ::
++ get |=(point =(1 (cut 0 [(off +<) 1] bud))) :: get point
++ off |=(point (add x (mul 3 y))) :: bitfield address
++ set |=(point (con bud (bex (off +<)))) :: set point
++ win %- lien :_ |=(a=@ =(a (dis a bud))) :: test for win
(rip 4 0wl04h0.4A0Aw.4A00s.0e070) ::
-- ::
:: :: ::
:::: :: :: semantics
:: :: ::
++ go :: per game
|_ game ::
++ at |_ point :: per point
++ g +>+< :: game
++ k !|(x o) :: ok move
++ m ?.(k [| g] [& g:t:?:(who y p)]) :: move
++ o (~(get bo boo) +<) :: old at o
++ p .(boo (~(set bo boo) +<)) :: play at o
++ t .(who !who) :: take turn
++ v ?:(x (icon &) ?:(o (icon |) '.')) :: view
++ x (~(get bo box) +<) :: old at x
++ y .(box (~(set bo box) +<)) :: play at x
-- ::
++ res ?: ~(win bo box) `"{~[(icon &)]} wins" :: result
?: ~(win bo boo) `"{~[(icon |)]} wins" ::
?: =(511 (con boo box)) `"tie :-(" ~ ::
++ row |= y=@ :~ (add y '1') :: print row
' ' ~(v at y 0) ::
' ' ~(v at y 1) ::
' ' ~(v at y 2) ::
== ::
++ tab ~["+ 1 2 3" (row 0) (row 1) (row 2)] :: print table
-- ::
-- ::
:: :: ::
:::: :: :: server
:: :: ::
=> |% :: arvo structures
++ axle ,[%0 eye=face gam=game] :: agent state
++ card ,[%diff lime] :: update
++ face (pair (list ,@c) (map bone sole-share)) :: interface
++ lime ,[%sole-effect sole-effect] :: console update
++ move (pair bone card) :: cause and action
-- ::
=> |% :: parsers
++ colm (cook |=(a=@ (sub a '1')) (shim '1' '3')) :: row or column
++ come ;~(plug colm ;~(pfix fas colm)) :: coordinate
-- ::
|_ [hid=hide moz=(list move) axle] :: per agent
++ et ::
|_ [from say=sole-share] :: per console
++ abet +>(q.eye (~(put by q.eye) ost say)) :: continue
++ amok +>(q.eye (~(del by q.eye) ost)) :: discontinue
++ beep (emit %bel ~) :: bad user
++ delt |= cal=sole-change :: input line change
=^ cul say (remit:sole cal good) ::
?~ cul (park:abet(p.eye buf.say) | ~) ::
abet:beep:(emit det/u.cul) ::
++ emit |= fec=sole-effect ^+ +> :: send effect
+>(moz [[ost %diff %sole-effect fec] moz]) ::
++ emil |= fex=(list sole-effect) :: send effects
?~(fex +> $(fex t.fex, +> (emit i.fex))) ::
++ good |=((list ,@c) -:(rose (tufa +<) come)) :: valid input
++ kick |= point :: move command
=^ dud gam ~(m ~(at go gam) +<) ::
?. dud abet:beep =+ mus=~(res go gam) ::
(park:abet(gam ?^(mus *game gam)) %2 mus) ::
++ line =^ cal say (transmit:sole set/p.eye) :: update command
(emit %det cal) ::
++ make =+ dur=(rust (tufa p.eye) come) ::
?~ dur abet:beep ::
(kick:line(p.eye ~) +.dur) ::
++ mean |=((unit tape) ?~(+< +> (emit txt/+<+))) :: optional message
++ play |= lev=?(%0 %1 %2) :: update by level
?-(lev %0 +>, %1 line, %2 line:show:prom) ::
++ plow |= [lev=?(%0 %1 %2) mus=(unit tape)] :: complete print
abet:(mean:(play lev) mus) ::
++ prom %^ emit %pro %& :- %acto :: update prompt
": {~[(icon who.gam)]} to move (row/col): " ::
++ rend (turn `wall`~(tab go gam) |=(tape txt/+<)) :: table print
++ show (emit %mor rend) :: update board
++ sole ~(. cs say) :: console library
++ work |= act=sole-action :: console input
?:(?=(%det -.act) (delt +.act) make) ::
-- ::
++ abet [(flop moz) .(moz ~)] :: resolve core
++ flet |=(from ~(. et +< (~(got by q.eye) ost))) :: in old client
++ fret |=(from ~(. et +< *sole-share)) :: in new client
++ pals %+ turn (pale hid (prix /sole)) |= sink :: per console
[[p=p.+< q=q.+<] r=(~(got by q.eye) p.+<)] ::
++ park |= [lev=?(%0 %1 %2) mus=(unit tape)] :: general update
=+ pals |- ^+ +>.^$ ?~ +< +>.^$ ::
$(+< t.+<, +>.^$ (~(plow et i.+<) lev mus)) ::
:: :: ::
:::: :: :: events
:: :: ::
++ peer-sole :: console subscribe
|= [from *] =< abet ::
(plow:(fret +<-) %2 ~) ::
++ poke-sole-action :: console input
|= [from act=sole-action] =< abet ::
(work:(flet +<-) act) ::
++ prep |= [from old=(unit ,[(list move) axle])] :: initialize
=< abet ?~ old +> =< (park %2 ~) ::
+>(+<+ u.old) ::
++ pull-sole :: disconnect console
|= [from *] =< abet ::
amok:(flet +<-) ::
--

21
base/app/bang/core.hook
View File

@ -1,21 +0,0 @@
:: Bang: send cards to arvo
::
:::: /hook/core/bang/app
::
/+ sh-utils
!:
::::
::
|_ [hide ~]
++ lima |*(a=(pole) ?~(a ~ [i t]=a(+ (..$ +.a))))
++ poke--args
|* [ost=bone @ a=[* (pole)]]
=> .(a ^.(lima a))
:_(+> (turn a |*(b=_i.a [ost %pass / b])))
::
++ pour
%- add-exit
|= [@ * sih=*]
~& bang-resp/(,[term term] [&1 &2]:sih)
`+>.$
--

58
base/app/began/core.hook
View File

@ -1,58 +0,0 @@
|%
++ sign
$% $: %a
$% [%went p=ship q=cape]
[%init p=@p]
== == ==
++ began-args ,[his=@p tic=@p eny=@t ges=gens ~]
--
::
!:
::::
::
|_ [hid=hide %0 ust=bone his=@p mac=mace]
++ peer ,_`.
++ poke-began-args
|= [ost=bone you=ship began-args]
=+ bur=(shax :(mix (jam ges) eny))
=+ loy=(bruw 2.048 bur)
:_ +>.$(ust ost, his his, mac [0 sec:ex:loy]~)
:~ :* ost %pass /ticketing %a %want [our.hid (sein his)] /q/ta
his tic ges pub:ex:loy
==
==
::
++ poke-will
|= [ost=bone you=ship wil=(unit will)]
:_ +>.$
?~ wil
[ust %give %mean ~ %rejected ~]~
:~ [ust %pass / %a %cash his mac u.wil]
[ust %pass / %c %plug our.hid %main (sein our.hid) %main]
[ust %pass / %c %plug our.hid %arvo (sein our.hid) %arvo]
[ust %pass / %c %plug our.hid %try (sein our.hid) %try]
[ust %give %nice ~]
==
::
++ pour
|= [ost=bone pax=path sih=*]
=+ sih=((soft sign) sih) :: seem to get blits
?~ sih `+>.$
:_ +>.$
?- +<.u.sih
%init [ost %give +.u.sih]~
%went ~
==
::
++ poke-will
|= [ost=bone you=ship wil=(unit will)]
:_ +>.$
?~ wil
[ust %give %mean ~ %rejected ~]~
:~ [ust %pass / %a %cash his mac u.wil]
[ust %pass / %c %plug our.hid %main (sein our.hid) %main]
[ust %pass / %c %plug our.hid %arvo (sein our.hid) %arvo]
[ust %pass / %c %plug our.hid %try (sein our.hid) %try]
[ust %give %nice ~]
==
--

442
base/app/begin/core.hook
View File

@ -1,442 +0,0 @@
|%
++ sign
$% $: %g
$% [%init p=@p]
[%nice ~]
[%mean p=ares]
[%rush %txt p=cord]
== == ==
++ form ,[his=@p tic=@p eny=@t ges=gens]
++ state
$? %begin %his %tic %eny %lag
%name %form %psect %pname %year
%govt %sect %fname %mname %nname
%lname %done
==
++ tepe ,[(unit ,[cord prom cord]) (list cord)]
--
::
!:
::::
::
|_ [hid=hide sat=state form]
++ peer ,_`.
++ done
|= ost=bone
:_ +>.$
:* :* ost %pass /to-gan %g %mess [our.hid /began] our.hid
%began-args !>([his tic eny ges ~])
==
(spam %rush %prompt '[waiting...]' %text '')
==
::
++ loon
%+ cook
|= all=(list ,@t)
|- ^- @t
?~ all %$
?~ t.all i.all
(cat 3 i.all (cat 3 ' ' $(all t.all)))
(most ace (cook |=(a=(list ,@) (rap 3 a)) (plus prn)))
::
++ next
|= txt=cord
^- [tepe _+>.$]
?- sat
%begin
:_ +>.$(sat %his)
:- `['Your ship: ~' %text '']
%- lore %- crip
"""
Do you have a ship and a ticket? If not, please ask
urbit@urbit.org for one.
"""
%his
=+ a=(rush txt fed:ag)
?~ a [[~ 'invalid input' ~] +>.$]
=> .(-.q.ges (clan u.a))
=+ ^= cow
|- ^- @ud
?- -.q.ges
%czar 256
%king (mul 255 $(-.q.ges %czar))
%duke (mul 65.535 $(-.q.ges %king))
%earl (mul (dec (bex 32)) $(-.q.ges %duke))
%pawn (sub (bex 128) $(-.q.ges %earl))
==
=+ ^= ves ^- tape
?- -.q.ges
%czar "carriers"
%king "cruisers"
%duke "destroyers"
%earl "yachts"
%pawn "submarines"
==
:_ ^+ +>.$ +>.$(his u.a, sat %tic)
:- `['Your ticket: ~' %text '']
%- lore %- crip
"""
Launching {(scow %p u.a)}, one of {<cow>} Urbit {ves}...
If I did not build for myself
for whom should I build?
-- Bunting, _Chomei at Toyama_
Let's configure your identity. Warning - it's nontrivial to
change this data once you've sent it to the server. If you enter
something wrong, hit ^D to cancel, then run the program again.
"""
::
%tic
=+ a=(rush txt fed:ag)
?~ a [[~ 'invalid input' ~] +>.$]
:_ +>.$(tic u.a, sat %eny)
:- `['Entropy: ' %pass '']
%- lore %- crip
"""
Enter a passphrase or other unusual text. You (or your enemies)
can regenerate your ship from this entropy.
"""
::
%eny
=+ a=(rush txt (boss 256 (more gon qit)))
?~ a [[~ 'invalid input' ~] +>.$]
=. u.a (shax u.a)
:_ +>.$(eny u.a, sat %lag)
:- `['Language: ' %text 'en']
%- lore %- crip
"""
Entropy check: {<`@p`(mug u.a)>}
What language would your ship rather speak? Enter it as a
two-letter (ISO 639-1) code, like "en" for English. Whatever
language you pick, it'll all be English now, but in future
we'll be more sensitive to your needs.
"""
::
%lag
=+ ^= par
%+ sear
|= [a=@ b=@]
^- (unit ,@ta)
=+ c=(cat 3 a b)
=+(d=(glon c) ?~(d ~ [~ c]))
;~(plug low low)
=+ a=(rush txt par)
?~ a [[~ 'invalid input' ~] +>.$]
?. ?=(%duke -.q.ges)
:_ +>.$(p.ges u.a, sat %name)
[`['Name: ' %text ''] ~]
:_ +>.$(p.ges u.a, sat %form)
:- `['Form: %' %text 'lady']
%- lore %- crip
"""
Please select one of the pre-chosen forms:
%lady female-identified individual
%lord male-identified individual
%punk opaque handle
%anon totally anonymous
"""
::
%name
?> ?=(?(%earl %king) -.q.ges)
=+ a=(rush txt (boss 256 (more gon qit)))
?~ a [[~ 'invalid input' ~] +>.$]
=+ gos=?-(-.q.ges %earl [%earl u.a], %king [%king u.a])
:_ +>.$(q.ges gos, sat %done)
[`['' %text ''] ~]
::
%form
=+ ^= par
;~ pose
(jest %anon)
(jest %lady)
(jest %lord)
(jest %punk)
==
=+ a=(rush txt par)
?~ a [[~ 'invalid input' ~] +>.$]
?+ u.a !!
%anon [[`['' %text ''] ~] +>.$(q.ges [%duke %anon ~], sat %done)]
%punk
:_ +>.$(q.ges [%duke %punk *sect ''], sat %pname)
[`['Handle: ' %text ''] ~]
?(%lady %lord)
=+ wat=?-(u.a %lady [%lady *whom], %lord [%lord *whom])
:_ +>.$(q.ges `gcos`[%duke wat], sat %year)
:- `['Year you were born: ' %text '19']
%- lore %- crip
"""
You've selected a personal identity. For a %lord or a %lady,
please use your real name only. If you'd prefer a fictitious
handle, you can hit ^D and start over as a %punk. Or you can
use %anon and go by your ship name alone.
As a real person, we're going to ask you for a little bit of
personal information - not enough to compromise your privacy,
just enough to make everyone on Urbit feel like a neighbor.
What we're going to ask you for is information that's (a)
public (would be obvious, or at least easy to guess, for
someone who met you in person); (b) durable (doesn't change
often); and (c) relevant (helps you connect with friends).
For example, we'll ask for the year (not day) you were born,
because your age is easy to guess in person, doesn't change,
and has a big effect on how people perceive you.
"""
==
::
%pname
=+ a=(rush txt loon)
?~ a [[~ 'invalid input' ~] +>.$]
:_ +>.$(q.ges [%duke %punk *sect u.a], sat %psect)
:- `['Banner: %' %text 'white']
%- lore %- crip
"""
One basic human instinct is the urge to form political tribes.
In a network that fights this need, these tribes form anyway and
they form badly. Urbit designs them into the infrastructure.
Inspired by the Qing Dynasty, you'll align yourself with one of
five colored "banners" - %red, %blue, %orange, %black or %white.
Political discourse across tribal boundaries is almost always an
antisocial act - less communication, than symbolic violence. In
Urbit, messages marked political stay within your own banner;
your friends in other banners simply won't see them. Between
banners, politics doesn't erode apolitical relationships; inside
each banner, political discourse is harmonious and productive.
Pick a banner by the adjective you feel best describes you:
%red far left: radical, anarchist
%blue center-left: moderate, liberal
%orange center-right: conservative, libertarian
%black far right: traditionalist, reactionary
Or if digital agitation isn't your cup of tea, choose %white, and
your Urbit experience will remain politics-free.
"""
::
%psect
?> ?=(%duke -.q.ges)
?> ?=(%punk -.p.q.ges)
=+ ^= par
;~ pose
(jest %white)
(jest %blue)
(jest %red)
(jest %black)
(jest %orange)
==
=+ a=(rush txt par)
?~ a [[~ 'invalid input' ~] +>.$]
:- [`['' %text ''] ~]
%= +>.$
q.ges [%duke %punk ((hard sect) u.a) q.p.q.ges]
sat %done
==
::
%year
?> ?=(%duke -.q.ges)
?> ?=(?(%lord %lady) -.p.q.ges)
=+ a=(rush txt dim:ag)
?~ a [[~ 'invalid input' ~] +>.$]
=+ woh=`whom`[u.a *govt *sect *name]
=+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh])
:_ +>.$(q.ges [%duke wat], sat %govt)
:- `['Location ' %text 'us/94103']
%- lore %- crip
"""
Where are you? This is totally optional, but we'd like to
know your vague general location. You can enter nothing at
all, just a country code, or country and postal code.
"""
::
%govt
?> ?=(%duke -.q.ges)
?> ?=(?(%lord %lady) -.p.q.ges)
=+ ^= par
;~ pose
;~ plug (cook |=([a=@ b=@] (cat 3 a b)) ;~(plug low low))
;~ pfix fas
%+ cook
|=(a=tape (rap 3 ^-((list ,@) a)))
(star ;~(pose hig hep nud))
==
(easy ~)
==
==
=+ a=(rush txt par)
?~ a [[~ 'invalid input' ~] +>.$]
=+ woh=`whom`[p.p.p.q.ges u.a *sect *name]
=+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh])
:_ +>.$(q.ges [%duke wat], sat %sect)
:- `['Banner: %' %text 'white']
%- lore %- crip
"""
One basic human instinct is the urge to form political tribes.
In a network that fights this need, these tribes form anyway and
they form badly. Urbit designs them into the infrastructure.
Inspired by the Qing Dynasty, you'll align yourself with one of
five colored "banners" - %red, %blue, %orange, %black or %white.
Political discourse across tribal boundaries is almost always an
antisocial act - less communication, than symbolic violence. In
Urbit, messages marked political stay within your own banner;
your friends in other banners simply won't see them. Between
banners, politics doesn't erode apolitical relationships; inside
each banner, political discourse is harmonious and productive.
Pick a banner by the adjective you feel best describes you:
%red far left: radical, anarchist
%blue center-left: moderate, liberal
%orange center-right: conservative, libertarian
%black far right: traditionalist, reactionary
Or if digital agitation isn't your cup of tea, choose %white, and
your Urbit experience will remain politics-free.
"""
::
%sect
?> ?=(%duke -.q.ges)
?> ?=(?(%lord %lady) -.p.q.ges)
=+ ^= par
;~ pose
(jest %white)
(jest %blue)
(jest %red)
(jest %black)
(jest %orange)
==
=+ a=(rush txt par)
?~ a [[~ 'invalid input' ~] +>.$]
=+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges (sect u.a) *name]
=+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh])
:_ +>.$(q.ges [%duke wat], sat %fname)
[`['First name: ' %text ''] ~]
::
%fname
?> ?=(%duke -.q.ges)
?> ?=(?(%lord %lady) -.p.q.ges)
=+ a=(rush txt loon)
?~ a [[~ 'invalid input' ~] +>.$]
=+ nam=[u.a *(unit ,@t) *(unit ,@t) *@t]
=+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nam]
=+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh])
:_ +>.$(q.ges [%duke wat], sat %mname)
[`['Middle name (or blank): ' %text ''] ~]
::
%mname
?> ?=(%duke -.q.ges)
?> ?=(?(%lord %lady) -.p.q.ges)
=+ a=(rush txt ;~(pose (stag ~ loon) (easy ~)))
?~ a [[~ 'invalid input' ~] +>.$]
=+ nam=[p.s.p.p.q.ges u.a *(unit ,@t) *@t]
=+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nam]
=+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh])
:_ +>.$(q.ges [%duke wat], sat %nname)
[`['Nickname/handle (or blank): ' %text ''] ~]
::
%nname
?> ?=(%duke -.q.ges)
?> ?=(?(%lord %lady) -.p.q.ges)
=+ a=(rush txt ;~(pose (stag ~ loon) (easy ~)))
?~ a [[~ 'invalid input' ~] +>.$]
=+ nam=[p.s.p.p.q.ges q.s.p.p.q.ges u.a *@t]
=+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nam]
=+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh])
:_ +>.$(q.ges [%duke wat], sat %lname)
[`['Last name: ' %text ''] ~]
::
%lname
?> ?=(%duke -.q.ges)
?> ?=(?(%lord %lady) -.p.q.ges)
=+ a=(rush txt loon)
?~ a [[~ 'invalid input' ~] +>.$]
=+ nam=[p.s.p.p.q.ges q.s.p.p.q.ges r.s.p.p.q.ges u.a]
=+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nam]
=+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh])
:_ +>.$(q.ges [%duke wat], sat %done)
[`['' %text ''] ~]
::
%done !! :: can't actually complete event because vere commits suicide
::[[`['[waiting...]' %text ''] ~] +>.$]
==
::
++ poke-begin-args
|= [ost=bone you=ship arg=$|(~ [his=ship ~])]
=^ res +>.$
^- [[pot=(unit ,[cord prom cord]) tak=(list cord)] _+>.$]
?~ arg
(next(sat %begin) '')
(next(sat %his) (rsh 3 1 (scot %p his.arg)))
:_ +>.$
%+ welp
:~ [ost %pass /in %g %show [our.hid +.imp.hid] you /in/[-.imp.hid]]
[ost %give %nice ~]
==
%+ welp
?~(pot.res ~ (spam %rush %prompt u.pot.res))
%^ spam %rush %tang
(turn tak.res |=(a=cord [%leaf (trip a)]))
::
++ pour
|= [ost=bone pax=path sih=*]
=+ sih=((hard sign) sih)
?: ?=(%init +<.sih)
[[ost %give +.sih]~ +>.$]
?: ?=([%in ~] pax)
?. ?=(%rush +<.sih) `+>.$
=^ res +>.$
^- [[pot=(unit ,[cord prom cord]) tak=(list cord)] _+>.$]
(next p.sih)
?: ?=(%done sat)
(done ost)
:_ +>.$
%+ welp
?~(pot.res ~ (spam %rush %prompt u.pot.res))
%^ spam %rush %tang
(turn tak.res |=(a=cord [%leaf (trip a)]))
:_ +>.$
:- [ost %give +.sih]
?+ +<.sih ~
%nice
%+ turn (~(tap by sup.hid))
|= [ost=bone *]
:^ ost %give %rush
:- %tang :_ ~
[%leaf "begin successful"]
%mean
%+ turn (~(tap by sup.hid))
|= [ost=bone *]
:^ ost %give %rush
:- %tang :_ ~
[%leaf "begin failed"]
==
::
++ spam
|* git=*
%+ turn
(~(tap in (~(get ju pus.hid) /out)))
|=(a=bone [a %give git])
--

35
base/app/cat/core.hook
View File

@ -1,35 +0,0 @@
:: ConCATenate file listings
::
:::: /hook/core/cat/app
::
/+ sh-utils
// /%%%/ls/subdir
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke--args
%+ args-into-gate .
|= [arg=(list path)]
=- tang/(zing -)
%+ turn arg
|= pax=path
^- tang
=+ ark=;;(arch .^(%cy pax))
?^ q.ark
:- leaf/(spud pax)
%+ turn (lore ;;(@t .^(%cx pax)))
|=(a=cord leaf/(trip a))
?- r.ark :: handle ambiguity
~
[rose/[" " `~]^~[leaf/"~" (smyt pax)]]~
[[@t ~] ~ ~]
$(pax (welp pax /[p.n.r.ark]))
*
=- [palm/[": " ``~]^-]~
:~ rose/[" " `~]^~[leaf/"*" (smyt pax)]
`tank`(subdir pax r.ark)
==
==
--

496
base/app/chat/core.hook
View File

@ -1,496 +0,0 @@
/- mess,user,users,zing,zong,zung
::
[sed=!>(.) .]
::
!:
=> |%
++ axle
$: %0
air=(map path station)
pom=(unit ship)
sen=(set mess)
$= fal
$: eth=?
qit=?
let=?
sat=path
pad=ship
==
==
++ blitz
$% [%prompt p=cord q=prom r=cord]
[%tang p=(list tank)]
[%txt p=cord]
[%zong p=zong]
[%user p=user]
==
++ chat :: user action
$% [%all p=mess] :: say
[%back p=?(%da %dr %ud) q=@] :: backlog
[%def p=mess] :: use current prompt
[%how ~] :: help
[%priv p=@p q=mess] :: private
[%who ~] :: who
== ::
++ chat-arg
$? %monitor %quiet %noob %leet %time
[%s p=path]
[%tower p=ship]
==
++ idad ,[p=@p q=@t]
++ iron
$% [%prompt p=cord q=prom r=cord]
[%txt p=cord]
[%zongs p=(list zong)]
[%users p=users]
[%hymn p=manx] :: HTML format
[%json p=json] :: JSON format
==
++ gift
$% [%mean ares]
[%nice ~]
[%rush blitz]
[%rust iron]
==
++ hapt ,[p=ship q=path]
++ move ,[p=bone q=(mold note gift)]
++ note
$? $: %g
$% [%mess p=hapt q=ship r=cage]
[%nuke p=hapt q=ship]
[%show p=hapt q=ship r=path]
[%took p=hapt q=ship]
== == ==
++ sign
$? $: %g
$% [%mean p=ares]
[%nice ~]
$: %rush
$= p
$% [%txt p=cord]
[%user p=user]
[%zong p=zong]
== ==
$: %rust
$= p
$% [%txt p=cord]
[%users p=users]
[%zongs p=(list zong)]
== ==
== == ==
++ station
$: msg=(list zong)
sub=(unit bone)
ami=(map ,@p ,@t)
==
--
!:
::::
::
=| lat=@da
|%
++ chat
=<
%+ cook |=(a=^chat a)
;~ pose
(cold [%how ~] wut)
(cold [%who ~] tis)
(stag %back dat)
(stag %priv ;~(plug ;~(pfix sig fed:ag) ;~(pfix ace mess)))
(stag %all ;~(pfix pam mess))
(stag %def mess)
==
|%
++ dat
%+ sear
|= p=coin
?. ?=([%$ ?(%da %dr %ud) @] p) ~
(some +.p)
;~(pfix bas bas (star ace) nuck:so)
::
++ expn
%- sear
:_ text
|= a=@t
^- (unit ,[p=@t q=tank])
=+ hun=(rush a wide:(vang | &1:% &2:% (scot %da lat) |3:%))
?~ hun ~
?~(a ~ [~ a (sell (slap sed u.hun))])
::
++ mess
%+ cook |=(a=^mess a)
;~ pose
(stag %do ;~(pfix pat text))
(stag %exp ;~(pfix hax expn))
(stag %do (full (easy '')))
(stag %say text)
==
::
++ text (boss 256 (star prn))
--
--
!:
::::
::
|_ [hid=hide axle]
++ exec-cmd
|= [ost=bone txt=cord]
^- [(list move) _+>]
?: =(0 txt) [~ +>.$]
=+ rey=(rush txt chat(lat lat.hid))
?~ rey
[(print %leaf "invalid input") +>.$]
|-
?- -.u.rey
%all =+ ^= mof
?~ pom ~
(send /out %rush %prompt '& ' %text '')
=^ mow +>.^$
(poke-zung(pom ~) ost our.hid %mess sat.fal p.u.rey)
[(welp mof mow) +>.^$(sen (~(put in sen) p.u.rey))]
%back
:_ +>.^$
%+ send /out :+ %rush %tang
%- turn :_ |=(a=zong (zong-to-tank | a))
%- flop
?- p.u.rey
%ud (scag q.u.rey msg:(grab sat.fal))
%da (since msg:(grab sat.fal) q.u.rey)
%dr (since msg:(grab sat.fal) (sub lat.hid q.u.rey))
==
%def $(u.rey ?~(pom [%all p.u.rey] [%priv u.pom p.u.rey]))
%priv
:_ +>.^$(pom `p.u.rey)
:- :* ost %pass /priv %g
%mess [p.u.rey %chat ~] our.hid %mess !>(q.u.rey)
==
?: =(pom [~ p.u.rey]) ~
(send /out %rush %prompt (cat 3 (scot %p p.u.rey) ' ') %text '')
%who
:_ +>.^$
%^ print %rose [", " "" ""]
%+ turn (~(tap by ami:(grab sat.fal)))
|= a=idad
:- %leaf
%- trip %^ cat 3 %^ cat 3 (scot %p p.a) ' ' q.a
%how
:_ +>.^$
%+ send /out :+ %rush %tang
%- turn :_ |=(a=@t [%leaf (trip a)])
%- lore
%- (hard ,@t)
.^(/cx/(scot %p our.hid)/main/(scot %da lat.hid)/pub/src/doc/chat/help/txt)
==
::
++ grab
|= sta=path
(fall (~(get by air) sta) *station)
::
++ iden
|= her=ship
^- tape
?: let.fal (scow %p her)
=+ ide=(trip (fall (~(get by ami:(grab sat.fal)) her) ''))
%+ welp (scow %p her)
?~ ide ""
[' ' ide]
::
++ peer
|= [ost=bone you=ship pax=path]
^- [(list move) _+>]
:_ +>.$
?: ?=(~ pax)
[ost %give %rust %hymn page]~
=+ ya=(grab t.pax)
?+ i.pax !!
%out
[ost %give %rust %prompt '& ' %text '']~
%private
~
%amigos
[ost %give %rust %users (~(tap by ami.ya))]~
%mensajes
[ost %give %rust %zongs msg.ya]~
==
++ page
^- manx
;html
;head
;title: Radio
;script(type "text/javascript", src "//use.typekit.net/fkv0sjk.js");
;script(type "text/javascript", src "//cdnjs.cloudflare.com/ajax/libs".
"/jquery/2.1.1/jquery.min.js");
;script:'try{Typekit.load();}catch(e){}'
;link(rel "stylesheet", type "text/css", href "/main/pub/src/chat/main.css");
==
;body
;div#c;
;script(type "text/javascript", src "/main/lib/urb.js");
;script(type "text/javascript", src "/main/pub/src/chat/main.js");
==
==
::
++ poke-chat-args
|= [ost=bone you=ship arg=(list chat-arg)]
^- [(list move) _+>]
=. fal (process-args arg)
=^ mow +>.$ (poke-zung ost you %init pad.fal sat.fal)
:_ +>.$
%+ welp
:+ [ost %pass /cmd-in %g %show [our.hid +.imp.hid] you /in/[-.imp.hid]]
[ost %pass /private %g %show [our.hid /chat] you /private]
(send /out %rush %prompt '& ' %text '')
mow
::
++ poke-mess
|= [ost=bone you=ship mes=mess]
^- [(list move) _+>]
[[[ost %give %nice ~] (spam & %mess lat.hid you mes)] +>.$]
::
++ poke-zung :: nice should be moved out
|= [ost=bone you=ship zug=zung]
^- [(list move) _+>]
?. =(you our.hid)
[[ost %give %mean ~ %no-sos-mi-amigo ~]~ +>.$]
?- -.zug
%mess
:: ~& [%send-mess zug]
:_ +>.$ :_ ~
:* ost %pass /mesg %g
%mess [pad.fal %radio ~] you %zing !>(zug)
==
::
%init
=+ ya=(grab q.zug)
?: =(sub.ya ~)
=. pad.fal p.zug
=. sub.ya `ost
=. air (~(put by air) q.zug ya)
:_ +>.$
:~
:* ost %pass radi-m/q.zug %g
%show [[p.zug /radio] you mensajes/q.zug]
==
:* ost %pass radi-a/q.zug %g
%show [[p.zug /radio] you amigos/q.zug]
==
==
[[ost %give %nice ~]~ +>.$]
==
::
++ pull
|= ost=bone
^- [(list move) _+>]
?: ?=([* ~ ~] sup.hid)
:_ +>.$(pad.fal *@p, air ~)
%- ^zing %+ turn (~(tap by air))
|= [pax=path sta=station]
?~ sub.sta
~
:~ [u.sub.sta %pass radi-a/pax %g %nuke [[pad.fal /radio] our.hid]]
[u.sub.sta %pass radi-m/pax %g %nuke [[pad.fal /radio] our.hid]]
==
[~ +>.$]
::
++ took
|= [ost=bone pax=path imp=path moz=(list move)]
:_ +>.$
:_(moz [ost %pass pax %g %took [our.hid imp] our.hid])
::
++ pour
|= [ost=bone pax=path sih=*]
^- [(list move) _+>]
:: ~& sih=sih
=+ sih=((hard sign) sih)
?~ pax ~& %chat-pour-strange-path !!
:: ~& [%pour-mess pax]
?+ i.pax ~& %chat-pour-strange-path !!
%cmd-in
?- +<.sih
%nice [~ +>.$]
%mean [(send /out +.sih) +>.$]
?(%rush %rust)
?> ?=(%txt -.p.sih)
=^ moz +>.$ (exec-cmd ost p.p.sih)
(took ost pax +.imp.hid moz)
==
::
?(%mesg %priv)
?> ?=(?(%mean %nice) +<.sih)
[[ost %give +.sih]~ +>.$]
::
%private
?: ?=(?(%nice %mean) +<.sih)
[~ +>.$]
?> ?=(%rush +<.sih)
?> ?=(%zong -.p.sih)
(took ost pax /chat (print (zong-to-tank & p.p.sih)))
::
?(%radi-a %radi-m)
?: ?=(%nice +<.sih)
:_ +>.$
?: ?=(%radi-a i.pax) ~
[ost %give +.sih]~
?: ?=(%mean +<.sih)
:_ +>.$ :_ ~
=- ~& [%trying-again -] -
:* ost %pass pax %g %show
[pad.fal /radio] our.hid
?-(i.pax %radi-a %amigos, %radi-m %mensajes)
sat.fal
==
=+ ya=(grab t.pax)
=. ya
?- i.pax
%radi-a
%_ ya
ami
^- (set idad)
?- +<.sih
%rust ?>(?=(%users -.p.sih) (sa p.p.sih))
%rush
?> ?=(%user -.p.sih)
?- -.p.p.sih
%in (~(put by ami.ya) p.p.p.sih)
%out (~(del by ami.ya) p.p.p.p.sih)
==
==
==
%radi-m
%_ ya
msg
^- (list zong)
?- +<.sih
%rush ?>(?=(%zong -.p.sih) [p.p.sih msg.ya])
%rust ?>(?=(%zongs -.p.sih) p.p.sih)
==
==
==
=+ ^= pout ?:(=(i.pax %radi-a) %amigos %mensajes)
=. air (~(put by air) t.pax ya)
=+ mow=(send [pout t.pax] +.sih)
=< (took ost pax /radio mow)
:: =< [mow +>.$]
:: XX yes, I just used an inline comment
:: XX and multiple XX's. why? because
:: XX tmi is incredibly lame.
^+ .
?: =(%zong -.p.sih)
=+ zog=((hard zong) p.p.sih)
:: ?: &(=(our.hid q.zog) (~(has in sen) r.zog))
:: + :: suppress own messages
:: ?: &(=(our.hid q.zog) =(`r.zog ~(top to sen)))
:: %_(+ sen ^+(sen ~(nap to sen)))
%_ +
mow
(welp mow (print (zong-to-tank | zog)))
==
?: =(%zongs -.p.sih)
=+ zos=(scag 200 ((hard (list zong)) p.p.sih))
|- ^+ +>.$
?: =(~ zos) +>.$ :: XX tm freakin i
=+ zoy=((hard zong) -.zos)
=. +>.$ $(zos +.zos)
?: &(=(our.hid &3.zoy) (~(has in sen) &4.zoy))
+>.$
:: ?: &(=(our.hid &3.zoy) =(`&4.zoy ~(top to sen)))
:: %_(+>.$ sen `(qeu mess)`~(nap to sen))
%_ +>.$
mow
(welp mow (print (zong-to-tank | zoy)))
==
?: =(%user -.p.sih)
=+ use=((hard user) p.p.sih)
%_ +
mow
?: let.fal ~
%+ print %leaf
%+ weld
?: eth.fal "" (timestamp lat.hid)
%+ weld "{(iden p.p.use)} "
?- -.use
%in "comes on the air"
%out "signs off"
==
==
. :: XX users?
==
::
++ process-args
|= arg=(list chat-arg)
^- [? ? ? path ship]
%+ roll arg
=< .(|4.b (sein our.hid))
|= [a=chat-arg b=[? ? ? path ship]]
?- a
%time b(&1 |)
%monitor b(&2 |)
%quiet b(&2 &)
%noob b(&3 |)
%leet b(&3 &)
[%s *] b(&4 p.a)
[%tower *] b(|4 p.a)
==
::
++ print |=(a=tank (send /out %rush %tang [a]~))
++ send
|= [pax=path msg=gift]
^- (list move)
:: ~& [%send pus.hid]
%+ turn (~(tap in (~(get ju pus.hid) pax)))
|=(ost=bone [ost %give msg])
::
++ since
|= [ya=msg=(list zong) tim=@da]
|- ^- (list zong)
?: |(?=(~ msg.ya) (lth p.i.msg.ya tim)) ~
[i.msg.ya $(msg.ya t.msg.ya)]
::
++ spam
|= [pri=? zog=zong]
^- (list move)
%+ welp
(send /private %rush %zong zog)
%+ welp
(print (zong-to-tank pri zog))
%+ murn (~(tap by sup.hid))
|= [ost=bone her=ship pax=path]
?~ pax ~
?. ?=(%mensajes i.pax) ~
(some [ost %give %rush %zong zog])
::
++ timestamp
|= t=@da
=+ da=(yell t)
"{?:((gth 10 h.da) "0" "")}{(scow %ud h.da)}:".
"{?:((gth 10 m.da) "0" "")}{(scow %ud m.da)} "
::
++ zong-to-tank
|= [pri=? zog=zong]
^- tank
=+ pre=?.(pri "" "(private) ")
?- -.r.zog
%do
=+ mes=?:(=(0 p.r.zog) "remains quietly present" (trip p.r.zog))
:- %leaf
%+ weld
?: eth.fal "" (timestamp p.zog)
"{pre}{(iden q.zog)} {mes}"
::
%exp
:~ %rose
[" " "" ""]
:- %leaf
%+ weld
?: eth.fal "" (timestamp p.zog)
"{pre}{(iden q.zog)} {(trip p.r.zog)}"
q.r.zog
==
::
%say
:- %leaf
%+ weld
?: eth.fal "" (timestamp p.zog)
"{pre}{(iden q.zog)}: {(trip p.r.zog)}"
==
--

9
base/app/code/core.hook
View File

@ -1,9 +0,0 @@
:: Show passcode
/+ sh-utils
|_ [hide ~]
++ peer ,_`.
++ poke--args
%+ args-into-gate .
=+ pax=/(crip <our>)/code/(crip <lat>)/(crip <our>)
,_tang/~[leaf/"{<(,@p .^(%a pax))>}"]
--

18
base/app/cp/core.hook
View File

@ -1,18 +0,0 @@
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke-cp-args
|= [ost=bone you=ship input=path output=path ~]
:_ +>.$
:* [ost %pass /cp %c %info our.hid (foal output .^(%cx input))]
[ost %pass / %g %cide %$]
[ost %give %nice ~]
%+ turn (~(tap by sup.hid))
|= [ost=bone *]
:^ ost %give %rush
:- %tang :_ ~
leaf/"copied"
==
--

20
base/app/curl/core.hook
View File

@ -1,20 +0,0 @@
:: Command-line URL fetch, :curl "http://example.com"
::
::::
::
/+ sh-utils
!:
|_ [hide *]
++ peer ,_`.
++ poke--args
%+ gate-bang
|=([a=tape ~] [%e %them ~ ~|([%bad-url a] (scan a auri:epur)) %get ~ ~])
,_`.
::
++ pour
%+ args-into-gate .
|= [%e %thou @ mess a=(unit octs)]
:- %tang
?~ a ~
(turn (lore q.u.a) |=(b=cord leaf/(trip b)))
--

736
base/app/dojo/core.hook
View File

@ -1,736 +0,0 @@
:: :: ::
:::: /hook/core/dojo/app :: ::::
:: :: ::
/? 314 :: arvo kelvin
/- *sole :: console structures
/+ sole :: console library
:: :: ::
:::: :: ::::
!: :: ::
=> |% :: external structures
++ house :: all state
$: hoc=(map bone session) :: conversations
== ::
++ session :: per conversation
$: say=sole-share :: command-line state
syd=desk :: active desk
luc=(unit case) :: special case
poy=(unit dojo-project) :: working
var=(map term cage) :: variable state
old=(set term) :: used TLVs
== ::
++ dojo-command ::
$% [%flat p=path q=dojo-source] :: noun to unix atom
[%pill p=path q=dojo-source] :: noun to unix pill
:: [%tree p=path q=dojo-source] :: noun to unix tree
[%poke p=goal q=dojo-source] :: make and poke
[%show p=dojo-source] :: print
[%verb p=term q=dojo-source] :: store variable
== ::
++ dojo-source :: construction node
$: p=@ud :: assembly index
q=dojo-build :: general build
== ::
++ dojo-build :: one ford step
$% [%ex p=twig] :: hoon expression
[%di p=dojo-model] :: dialog
[%dv p=path] :: gate from source
[%fi p=dojo-filter q=dojo-source] :: filter
[%ge p=dojo-model] :: generator
[%sc p=dojo-model] :: script
[%tu p=(list dojo-source)] :: tuple
[%va p=term] :: dojo variable
== ::
++ dojo-filter :: pipeline filter
$% [%a p=twig] :: function gate
[%b p=mark] :: simple transmute
[%c p=dojo-model] :: formal filter
== ::
++ dojo-model :: data construction
$: p=dojo-server :: core source
q=dojo-config :: configuration
== ::
++ dojo-server :: numbered device
$: p=@ud :: assembly index
q=path :: gate path
== ::
++ dojo-config :: configuration
$: p=(list dojo-source) :: by order
q=(map term (unit dojo-source)) :: by keyword
== ::
++ dojo-project :: construction state
$: mad=dojo-command :: operation
num=@ud :: number of tasks
cud=(unit dojo-source) :: now solving
pux=(unit path) :: ford working
pro=(unit vase) :: prompting loop
per=(unit sole-edit) :: pending reverse
job=(map ,@ud dojo-build) :: problems
rez=(map ,@ud cage) :: results
== ::
++ bead ,[p=(set beam) q=cage] :: computed result
++ goal ,[p=ship q=term] :: flat application
++ gift :: out result <-$
$% [%mean p=ares] :: error
[%nice ~] :: acknowledge
[%rush %sole-effect sole-effect] ::
== ::
++ hapt ,[p=ship q=path] ::
++ move ,[p=bone q=(mold note gift)] ::
++ hood :: assembly plan
$: zus=@ud :: zuse kelvin
sur=(list hoot) :: structures
lib=(list hoof) :: libraries
fan=(list horn) :: resources
src=(list hoop) :: program
== ::
++ hoof (pair term (unit (pair case ship))) :: resource reference
++ hoot (pair bean hoof) :: structure gate/core
++ hoop :: source in hood
$% [%& p=twig] :: direct twig
[%| p=beam] :: resource location
== ::
++ horn :: resource tree
$% [%ape p=twig] :: /~ twig by hand
[%arg p=twig] :: /$ argument
[%day p=horn] :: /| list by @dr
[%dub p=term q=horn] :: /= apply face
[%fan p=(list horn)] :: /. list
[%for p=path q=horn] :: /, descend
[%hel p=@ud q=horn] :: /% propagate heel
[%hub p=horn] :: /@ list by @ud
[%man p=(map span horn)] :: /* hetero map
[%nap p=horn] :: /_ homo map
[%now p=horn] :: /& list by @da
[%saw p=twig q=horn] :: /; operate on
[%see p=beam q=horn] :: /: relative to
[%sic p=tile q=horn] :: /^ cast
[%toy p=mark] :: /mark/ static
== ::
++ silk :: construction layer
$& [p=silk q=silk] :: cons
$% [%bake p=mark q=beam r=path] :: local synthesis
[%boil p=mark q=beam r=path] :: general synthesis
[%call p=silk q=silk] :: slam
[%cast p=mark q=silk] :: translate
[%done p=(set beam) q=cage] :: literal
[%dude p=tank q=silk] :: error wrap
[%dune p=(set beam) q=(unit cage)] :: unit literal
[%mute p=silk q=(list (pair wing silk))] :: mutant
[%plan p=beam q=spur r=hood] :: structured assembly
[%reef ~] :: kernel reef
[%ride p=twig q=silk] :: silk thru twig
[%vale p=mark q=ship r=*] :: validate [our his]
== ::
++ note-ford :: note to ford
$% [%exec p=@p q=beak r=(unit silk)] :: make / kill
== ::
++ note-gall :: note to %gall
$% [%mess p=[p=ship q=path] q=ship r=cage] ::
== ::
++ sign-gall :: sign from %gall
$% [%mean p=ares] ::
[%nice ~] ::
== ::
++ sign-ford :: sign from ford
$% [%made p=@uvH q=(each gage tang)] :: computed result
== ::
++ note :: out request $->
$% [%f note-ford] ::
[%g note-gall] ::
== ::
++ sign :: in result $<-
$% [%f sign-ford] ::
[%g sign-gall] ::
== ::
-- ::
:: ::
:::: ::
:: ::
|_ $: hid=hide :: system state
house :: program state
== ::
++ he :: per session
|_ [[ost=bone moz=(list move)] session] ::
++ dp :: dojo parser
|%
++ dp-command :: ++dojo-command
%+ knee *dojo-command |. ~+
;~ pose
%+ stag %poke
;~ pfix col
%+ cook
|= [a=goal b=(each dojo-source (trel term path dojo-config))]
^- (pair goal dojo-source)
:- a
?- -.b
%& p.b
%| ?+ p.p.b !!
%di [0 %di [0 [%dog q.a q.p.b]] r.p.b]
%ge [0 %ge [0 [%cat q.a q.p.b]] r.p.b]
%sc [0 %sc [0 [%pig q.a q.p.b]] r.p.b]
==
==
;~ plug
dp-goal
;~ pose
(stag %& ;~(pfix ace dp-source))
%+ stag %|
;~ plug
;~ pose
(cold %di wut)
(cold %ge lus)
(cold %sc pam)
==
(most fas sym)
dp-config
==
==
==
==
::
%+ stag %verb
;~ pfix tis
;~(plug sym ;~(pfix ace dp-source))
==
::
%+ stag %flat
;~ pfix pat
;~(plug (most fas sym) ;~(pfix ace dp-source))
==
::
%+ stag %pill
;~ pfix dot
;~(plug (most fas sym) ;~(pfix ace dp-source))
==
::
(stag %show dp-source)
==
++ dp-source (stag 0 dp-build) :: ++dojo-source
++ dp-build :: ++dojo-build
%+ knee *dojo-build |. ~+
;~ pose
;~(pfix lus (stag %ge dp-model-cat))
;~(pfix wut (stag %di dp-model-dog))
;~(pfix pam (stag %sc dp-model-pig))
;~(pfix buc (stag %va sym))
(stag %ex dp-twig)
(ifix [sel ser] (stag %tu (most ace dp-source)))
==
::
++ dp-goal :: ++goal
%+ cook |=(a=goal a)
;~ pose
;~ plug
;~(pfix sig fed:ag)
;~(pfix fas sym)
==
(cook |=(a=term `goal`[our.hid a]) sym)
==
++ dp-model-cat ;~(plug dp-server-cat dp-config) :: ++dojo-model
++ dp-model-dog ;~(plug dp-server-dog dp-config) :: ++dojo-model
++ dp-model-pig ;~(plug dp-server-pig dp-config) :: ++dojo-model
++ dp-server-cat (stag 0 (stag %cat dp-device)) :: ++dojo-server
++ dp-server-dog (stag 0 (stag %dog dp-device)) :: ++dojo-server
++ dp-server-pig (stag 0 (stag %pig dp-device)) :: ++dojo-server
++ dp-twig wide:(vang | ~) :: ++twig
++ dp-device (most fas sym) :: ++dojo-device
++ dp-value :: ++dojo-source
%+ cook |=(a=dojo-source a)
%+ stag 0
;~ pose
(ifix [kel ker] (stag %tu (most ace dp-source)))
(stag %va ;~(pfix buc sym))
(stag %ex dp-twig)
==
::
++ dp-config :: ++dojo-config
%+ cook |=(a=dojo-config a)
;~ plug
(star ;~(pfix ace dp-value))
%+ cook
~(gas by *(map term (unit dojo-source)))
%+ more
;~(plug com ace)
;~ plug
;~(pfix tis sym)
;~ pose
;~(pfix ace (stag ~ dp-value))
(easy ~)
==
==
==
--
::
++ dy :: project work
|_ dojo-project ::
++ dy-abet +>(poy `+<) :: resolve
++ dy-amok +>(poy ~) :: terminate
++ dy-ford :: send work to ford
|= [pax=path kas=silk]
^+ +>+>
?> ?=(~ pux)
=+ bek=[our.hid %home %da lat.hid]
(he-pass(poy `+>+<.$(pux `pax)) pax %f %exec our.hid bek `kas)
::
++ dy-stop :: stop work
^+ +>
?~ pux +>
=+ bek=[our.hid %home %da lat.hid]
(he-pass(poy ~) u.pux %f %exec our.hid bek ~)
::
++ dy-slam :: call by ford
|= [pax=path gat=vase sam=vase]
^+ +>+>
(dy-ford pax %call [%done ~ %noun gat] [%done ~ %noun sam])
::
++ dy-rush :: send effects, abet
|= fec=sole-effect
^+ +>+>
(he-rush(poy `+>+<) fec)
::
++ dy-rash :: send effects, amok
|= fec=sole-effect
^+ +>+>
(he-rush(poy ~) fec)
::
++ dy-init-command :: ++dojo-command
|= mad=dojo-command
^+ [mad +>]
?- -.mad
%flat =^(src +>.$ (dy-init-source q.mad) [[%flat p.mad src] +>.$])
%pill =^(src +>.$ (dy-init-source q.mad) [[%pill p.mad src] +>.$])
%poke =^(src +>.$ (dy-init-source q.mad) [[%poke p.mad src] +>.$])
%show =^(src +>.$ (dy-init-source p.mad) [[%show src] +>.$])
%verb =^(src +>.$ (dy-init-source q.mad) [[%verb p.mad src] +>.$])
==
::
++ dy-init-source-unit :: (unit dojo-source)
|= urc=(unit dojo-source)
^+ [urc +>]
?~ urc [~ +>]
=^ src +> (dy-init-source u.urc)
[`src +>.$]
::
++ dy-init-source :: ++dojo-source
|= src=dojo-source
^+ [src +>]
=^ bul +> (dy-init-build q.src)
=: p.src num
q.src bul
==
[src +>.$(num +(num), job (~(put by job) num q.src))]
::
++ dy-init-build :: ++dojo-build
|= bul=dojo-build
^+ [bul +>]
?- -.bul
%ex [bul +>.$]
%di =^(mod +>.$ (dy-init-model p.bul) [[%di mod] +>.$])
%dv [bul +>.$]
%fi !!
%ge =^(mod +>.$ (dy-init-model p.bul) [[%ge mod] +>.$])
%sc !!
%tu =^ dof +>.$
|- ^+ [p.bul +>.^$]
?~ p.bul [~ +>.^$]
=^ dis +>.^$ (dy-init-source i.p.bul)
=^ mor +>.^$ $(p.bul t.p.bul)
[[dis mor] +>.^$]
[[%tu dof] +>.$]
%va [bul +>.$]
==
::
++ dy-init-model :: ++dojo-model
|= mol=dojo-model
^+ [mol +>]
=^ one +>.$ (dy-init-server p.mol)
=^ two +>.$ (dy-init-config q.mol)
[[one two] +>.$]
::
++ dy-init-server :: ++dojo-server
|= srv=dojo-server
=. p.srv num
[srv +>.$(num +(num), job (~(put by job) num [%dv q.srv]))]
::
++ dy-init-config :: prepare config
|= cig=dojo-config
^+ [cig +>]
=^ ord +>.$ (dy-init-ordered p.cig)
=^ key +>.$ (dy-init-named q.cig)
[[ord key] +>.$]
::
++ dy-init-ordered :: (list dojo-source)
|= ord=(list dojo-source)
^+ [ord +>]
?~ ord [~ +>.$]
=^ fir +>.$ (dy-init-source i.ord)
=^ mor +>.$ $(ord t.ord)
[[fir mor] +>.$]
::
++ dy-init-named :: (map @tas dojo-src)
|= key=(map term (unit dojo-source))
^+ [key +>.$]
?~ key [~ +>.$]
=^ top +>.$ (dy-init-source-unit q.n.key)
=^ lef +>.$ $(key l.key)
=^ rit +>.$ $(key r.key)
[[[p.n.key top] lef rit] +>.$]
::
++ dy-init :: full initialize
^+ .
=^(dam . (dy-init-command mad) +(mad dam))
::
++ dy-hand :: complete step
|= cag=cage
^+ +>+>
?> ?=(^ cud)
(dy-step(cud ~, rez (~(put by rez) p.u.cud cag)) +(p.u.cud))
::
++ dy-meal :: vase to cage
|= vax=vase
?. &(?=(@ -.q.vax) ((sane %tas) -.q.vax))
~& %dy-meal-cage
(dy-rash %bel ~)
(dy-hand -.q.vax (slot 3 vax))
::
++ dy-made-edit :: sole edit
|= cag=cage
^+ +>+>
?> ?=(^ per)
?: ?| ?=(^ q.q.cag)
=((lent buf.say) q.q.cag)
!&(?=(%del -.u.per) =(+(p.u.per) (lent buf.say)))
==
dy-abet(per ~)
=^ lic say (~(transmit cs say) u.per)
(dy-rush(per ~) %mor [%det lic] [%err q.q.cag] ~)
::
++ dy-done :: dialog submit
|= txt=tape
?> ?=(^ pro)
(dy-slam /dial u.pro !>(txt))
::
++ dy-over :: finish construction
^+ +>
?- -.mad
%poke
%- he-pass(poy ~)
:* /poke
%g
%mess
[p.p.mad [q.p.mad ~]]
our.hid
(~(got by rez) p.q.mad)
==
::
%flat
=+ out=q.q:(~(got by rez) p.q.mad)
?^ out
(dy-rash %tan [%leaf "not an atom"]~)
(dy-rash %sav p.mad out)
::
%pill
(dy-rash %sag p.mad q.q:(~(got by rez) p.q.mad))
::
%verb
dy-amok(var (~(put by var) p.mad (~(got by rez) p.q.mad)))
::
%show
(dy-rash %tan (sell q:(~(got by rez) p.p.mad)) ~)
==
::
++ dy-edit :: handle edit
|= cal=sole-change
^+ +>+>
=^ dat say (~(transceive cs say) cal)
?: |(?=(^ per) ?=(^ pux) ?=(~ pro))
~& %dy-edit-busy
=^ lic say (~(transmit cs say) dat)
(dy-rush %mor [%det lic] [%bel ~] ~)
(dy-slam(per `dat) /edit u.pro !>((tufa buf.say)))
::
++ dy-type :: sole action
|= act=sole-action
?- -.act
%det (dy-edit +.act)
%ret (dy-done (tufa buf.say))
==
::
++ dy-cage |=(num=@ud (~(got by rez) num)) :: known cage
++ dy-vase |=(num=@ud q:(dy-cage num)) :: known vase
++ dy-silk-vase |=(vax=vase [%done ~ %noun vax]) :: vase to silk
++ dy-silk-config :: configure
|= [cag=cage cig=dojo-config]
^- silk
:+ %ride [%cnzy %$]
:+ %mute [%done ~ cag]
^- (list (pair wing silk))
:* :- [[~ 12] ~]
(dy-silk-vase !>([now=lat.hid eny=eny.hid bec=he-beak]))
::
:- [[~ 26] ~]
%- dy-silk-vase
|- ^- vase
?~ p.cig !>(~)
(slop (dy-vase p.i.p.cig) $(p.cig t.p.cig))
::
%+ turn (~(tap by q.cig))
|= [a=term b=(unit dojo-source)]
^- (pair wing silk)
:- [a [~ 27] ~]
%- dy-silk-vase
?~(b !>([~ ~]) (dy-vase p.u.b))
==
::
++ dy-silk-init-modo :: init and config
|= [cag=cage cig=dojo-config]
^- silk
(dy-silk-config cag cig)
::
++ dy-silk-device :: device to silk
|= pax=path
^- silk
[%boil %gate [he-beak (flop pax)] ~]
::
++ dy-made-dial :: dialog product
|= cag=cage
^+ +>+>
?. ?=(^ q.q.cag)
(dy-rush %err q.q.cag)
=+ tan=((list tank) +2.q.q.cag)
=. +>+>.$ (he-rush %tan tan)
=+ vax=(spec (slot 3 q.cag))
?+ -.q.vax !!
%&
?~ +.q.vax
~& %dy-made-dial-abort
(dy-rash %bel ~)
(dy-meal (slot 7 vax))
::
%|
=< he-pone
%- dy-rush(pro `(slap (slot 7 vax) [%cnzy %q]))
=+ pom=(sole-prompt +<.q.vax)
[%pro pom(cad [':' ' ' cad.pom])]
==
::
++ dy-made-gent :: generator product
|= cag=cage
(dy-meal q.cag)
::
++ dy-make :: build step
^+ +>
?> ?=(^ cud)
%- dy-ford
^- (pair path silk)
?+ -.q.u.cud !!
%di [/dial (dy-silk-init-modo (dy-cage p.p.p.q.u.cud) q.p.q.u.cud)]
%ge [/gent (dy-silk-init-modo (dy-cage p.p.p.q.u.cud) q.p.q.u.cud)]
%dv [/hand (dy-silk-device p.q.u.cud)]
%ex [/hand [%ride p.q.u.cud [%reef ~]]]
%tu :- /hand
:+ %done ~
:- %noun
|- ^- vase
?~ p.q.u.cud !!
=+ hed=(dy-vase p.i.p.q.u.cud)
?~ t.p.q.u.cud hed
(slop hed $(p.q.u.cud t.p.q.u.cud))
==
::
++ dy-step :: advance project
|= nex=@ud
^+ +>+>
?> ?=(~ cud)
?: =(nex num)
dy-over
dy-make(cud `[nex (~(got by job) nex)])
--
::
++ he-dope :: sole user of ++dp
|= txt=tape ::
^- (each (unit dojo-command) hair) :: prefix/result
=+ vex=(dp-command:dp [1 1] txt) ::
?. =(+((lent txt)) q.p.vex) :: fully parsed
[%| p.p.vex (dec q.p.vex)] :: syntax error
[%& ?~(q.vex ~ `p.u.q.vex)] :: prefix/complete
::
++ he-duke :: ++he-dope variant
|= txt=tape
^- (each dojo-command ,@ud)
=+ foy=(he-dope txt)
?- -.foy
%| [%| q.p.foy]
%& ?~(p.foy [%| (lent txt)] [%& u.p.foy])
==
::
++ he-abet :: resolve
[(flop moz) %_(+> hoc (~(put by hoc) ost +<+))]
::
++ he-beak :: logical beam
^- beak
[our.hid syd ?^(luc u.luc [%da lat.hid])]
::
++ he-give :: emit gift
|= git=gift
^+ +>
%_(+> moz [[ost %give git] moz])
::
++ he-pass
|= [pax=path noy=note]
%_(+> moz [[ost %pass pax noy] moz])
::
++ he-rush :: emit update
|= fec=sole-effect
^+ +>
(he-give %rush %sole-effect fec)
::
++ he-stop :: abort work
^+ .
?~(poy . ~(dy-stop dy u.poy))
::
++ he-peer :: subscribe to
he-prom
::
++ he-pine :: restore prompt
^+ .
?^ poy .
he-prom:he-pone
::
++ he-pone :: clear prompt
^+ .
=^ cal say (~(transmit cs say) [%set ~])
(he-rush %mor [%det cal] ~)
::
++ he-prom :: send prompt
%- he-rush
:- %pro
[& %$ "> "]
::
++ he-made :: result from ford
|= [pax=path dep=@uvH rey=(each gage tang)]
^+ +>
?> ?=(^ poy)
=< he-pine
?- -.rey
%& ?> ?=(@ p.p.rey)
%. p.rey
=+ dye=~(. dy u.poy(pux ~))
?+ pax !!
[%hand ~] dy-hand:dye
[%dial ~] dy-made-dial:dye
[%gent ~] dy-made-gent:dye
[%edit ~] dy-made-edit:dye
==
%| ~& [%he-made-fail pax]
(he-rush(poy ~) %tan p.rey)
==
::
++ he-like :: accept line
|= buf=(list ,@c)
=(%& -:(he-dope (tufa buf)))
::
++ he-stir :: apply change
|= cal=sole-change
^+ +>
:: ~& [%his-clock ler.cal]
:: ~& [%our-clock ven.say]
=^ dat say (~(transceive cs say) cal)
?. ?& ?=(%del -.dat)
=(+(p.dat) (lent buf.say))
==
+>.$
=+ foy=(he-dope (tufa buf.say))
?: ?=(%& -.foy) +>.$
:: ~& [%bad-change dat ted.cal]
=^ lic say (~(transmit cs say) dat)
:: ~& [%our-leg leg.say]
(he-rush %mor [%det lic] [%err q.p.foy] ~)
::
++ he-plan :: execute command
|= mad=dojo-command
^+ +>
?> ?=(~ poy)
he-pine:(dy-step:~(dy-init dy mad [0 ~ ~ ~ ~ ~ ~]) 0)
::
++ he-done :: parse command
|= txt=tape
^+ +>
?~ txt
%- he-rush
:~ %mor
[%txt "> "]
[%nex ~]
==
=+ doy=(he-duke txt)
?- -.doy
%| (he-rush [%err p.doy])
%&
=+ old=(weld "> " (tufa buf.say))
=^ cal say (~(transmit cs say) [%set ~])
%. p.doy
=< he-plan
%- he-rush
:~ %mor
[%txt old]
[%nex ~]
[%det cal]
==
==
::
++ he-type :: apply input
|= act=sole-action
^+ +>
?^ poy
he-pine:(~(dy-type dy u.poy) act)
?- -.act
%det (he-stir +.act)
%ret (he-done (tufa buf.say))
==
--
::
++ peer
|= [ost=bone her=ship pax=path]
^- [(list move) _+>]
~? !=(her our.hid) [%dojo-peer ost her pax]
?< (~(has by hoc) ost)
?> =(/sole pax)
:: ?> =(her our.hid)
=< he-abet
%~ he-peer he
:- [ost ~]
^- session
:* *sole-share :: say=sole-share
%home :: syd=desk
~ :: luc=(unit case)
~ :: poy=(unit dojo-project)
~ :: var=(map term cage)
~ :: old=(set term)
==
::
++ poke-sole-action
|= [ost=bone her=ship act=sole-action]
^- [(list move) _+>]
:: ~? !=(her our.hid) [%dojo-poke ost her]
he-abet:(~(he-type he [ost [ost %give %nice ~]~] (~(got by hoc) ost)) act)
::
++ pour
|= [ost=bone pax=path sih=sign]
^- [(list move) _+>]
:: ~& [%dojo-pour pax]
?- -.sih
%f
he-abet:(~(he-made he [[ost ~] (~(got by hoc) ost)]) pax +>.sih)
::
%g
[~ +>.$]
==
::
++ pull
|= ost=bone
^- [(list move) _+>]
=^ moz +>
he-abet:~(he-stop he [[ost ~] (~(got by hoc) ost)])
[moz +>.$(hoc (~(del by hoc) ost))]
--

21
base/app/gnab/core.hook
View File

@ -1,21 +0,0 @@
:: gnaB: send gift to arvo
::
:::: /hook/core/gnab/app
::
/+ sh-utils
!:
::::
::
|_ [hide ~]
++ lima |*(a=(pole) ?~(a ~ [i t]=a(+ (..$ +.a))))
++ poke--args
|* [ost=bone @ a=[* (pole)]]
=> .(a ^.(lima a))
:_(+> (turn a |*(b=_i.a [ost %give b])))
::
++ pour
%- add-exit
|= [@ * sih=*]
~& gnab-resp/(,[term term] [&1 &2]:sih)
`+>.$
--

66
base/app/grep/core.hook
View File

@ -1,66 +0,0 @@
|%
++ sign
$% $: %g
$% [%nice ~]
$: %rush
$% [%txt p=cord]
[%tang p=(list tank)]
== == ==
== ==
--
::
!:
::::
::
|_ [hid=hide arg=cord]
++ poke-grep-args
|= [ost=bone you=ship arg=cord ~]
=. ^arg arg
:_ +>.$
~& [%grep-subscribing-to /in/[-.imp.hid]]
:~ [ost %pass / %g %show [our.hid +.imp.hid] you /in/[-.imp.hid]]
==
++ peer |=(* `+>)
++ pour
|= [ost=bone pax=path sih=*]
=+ sih=;;(sign sih)
::~& grep-por/[pax sih]
?^ pax `+>.$
:_ +>.$
?- &2.sih
%nice
[ost %give %nice ~]~
%rush
%+ weld (spam %rush %prompt 'searching for {<arg>}...' %text ~)
%- spam
?- &3.sih
%txt
?. (match (trip p.sih)) [%rush %tang ~]
+.sih
%tang
=< [%rush %tang .]
%+ murn p.sih
|= a=tank
^- (unit tank)
?- -.a
%leaf
?.((match p.a) ~ `a)
?(%palm %rose)
=. q.a (murn q.a ..$)
?~ q.a ~
(some a)
==
== ==
++ match
|= a=tape
=+ tag=(trip arg)
?: =(tag (scag (lent tag) a))
&
?~ a |
$(a t.a)
++ spam
|* git=*
%+ turn
(~(tap in (~(get ju pus.hid) /out)))
|=(a=bone [a %give git])
--

505
base/app/helm/core.hook
View File

@ -1,505 +0,0 @@
:: :: ::
:::: /hook/core/helm/app :: ::
:: :: ::
/? 314 :: zuse version
/- *sole, *talk :: structures
/+ sole, talk :: libraries
:: :: ::
:::: :: ::
!: :: ::
=> |% :: principal structures
++ helm-house :: all state
$: %0 :: state version
bur=(unit (pair ship mace)) :: requesting ticket
hoc=(map bone helm-session) :: consoles
rem=(map desk merge-state) :: active merges
== ::
++ helm-session ::
$: say=sole-share ::
mud=(unit (sole-dialog ,@ud)) ::
== ::
++ merge-state :: merge data
$: auto=? :: escalate on failure
gem=germ :: strategy
her=@p :: from ship
sud=@tas :: from desk
cas=case :: at case
== ::
++ funk (pair ,@ ,@) ::
++ begs ,[his=@p tic=@p eny=@t ges=gens] :: begin data
++ helm-wish ::
$| $? %reset :: reset kernel
%verb :: verbose mode
== ::
$% [%reload p=(list term)] :: reload vanes
[%sync p=@tas q=@p r=@tas ~] ::
== ::
++ dill-flog :: sent to %dill
$% [%crud p=%hax-init [%leaf p=tape] ~] :: initialize ship
[%heft ~] :: weigh memory
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
:: ::
++ gift :: out result <-$
$% [%mean p=ares] :: error
[%nice ~] :: acknowledge
[%rush %sole-effect sole-effect] :: effect
== ::
++ hapt ,[p=ship q=path] ::
++ milk (trel ship desk silk) ::
++ silk ::
$& [p=silk q=silk] :: cons
$% [%diff p=silk q=silk] :: diff
[%done p=(set beam) q=gage] :: literal
[%file p=beam] :: from clay
[%mash p=mark q=milk r=milk] :: merge
[%tabl p=(list (pair silk silk))] :: list
== ::
++ tage :: %tabl gage
,[[%tabl p=(list (pair marc marc))] q=vase] ::
++ move ,[p=bone q=(mold note gift)] ::
++ note-clay :: filesystem command
$% [%font p=@p q=@tas r=@p s=@tas] ::
[%info p=@p q=@tas r=nori] ::
[%lynx p=@p q=@tas r=(unit ,?)] ::
[%merg p=@p q=@tas r=@p s=@tas t=germ] ::
== ::
++ note-dill :: system command
$% [%flog p=dill-flog] ::
== ::
++ note-ford ::
$% [%exec p=@p q=beak r=(unit silk)] ::
== ::
++ note-gall :: note to %gall
$% [%mess p=[p=ship q=path] q=ship r=cage] ::
[%show p=[p=ship q=path] q=ship r=path] ::
[%took p=[p=ship q=path] q=ship] ::
== ::
++ note :: out request $->
$% [%c note-clay] ::
[%d note-dill] ::
[%f note-ford] ::
[%g note-gall] ::
== ::
++ sign-clay ::
$% [%mere are=(each (set path) (pair term tang))]::
== ::
++ sign-ford ::
$% [%made p=@uvH q=(each gage tang)] ::
== ::
++ sign-gall ::
$% [%mean p=ares] ::
[%nice ~] ::
== ::
++ sign ::
$% [%c sign-clay] ::
[%f sign-ford] ::
[%g sign-gall] ::
== ::
-- ::
:: ::
:::: ::
:: ::
|_ $: hid=hide :: system state
helm-house :: program state
== ::
++ he :: per session
|_ [[ost=bone moz=(list move)] helm-session] ::
++ he-abet :: resolve
[(flop moz) %_(+> hoc (~(put by hoc) ost +<+))] ::
:: ::
++ he-give :: emit gift
|= git=gift
%_(+> moz [[ost %give git] moz])
::
++ he-wish-reset
^+ .
=- %_(+ moz (weld (flop zum) moz))
^- zum=(list move)
=+ top=`path`/(scot %p our.hid)/home/(scot %da lat.hid)/arvo
:- [ost %pass /reset %d %flog %vega (weld top `path`/hoon)]
%+ turn
^- (list ,[p=@tas q=@tas])
:~ [%$ %zuse]
[%a %ames]
[%c %clay]
[%d %dill]
[%e %eyre]
[%f %ford]
[%g %gall]
[%t %time]
==
|= [p=@tas q=@tas]
=+ pax=`path`(welp top /[q])
=+ txt=((hard ,@) .^(%cx (welp pax /hoon)))
[ost %pass /reset %d %flog %veer p pax txt]
::
++ he-wish-reload
|= all=(list term)
=- %_(+ moz (weld (flop zum) moz))
^- zum=(list move)
=+ top=`path`/(scot %p our.hid)/home/(scot %da lat.hid)/arvo
%+ turn all
=+ ark=(arch .^(%cy /(scot %p our.hid)/home/(scot %da lat.hid)/arvo))
=+ van=(~(tap by r.ark))
|= nam=@tas
=. nam
?. =(1 (met 3 nam))
nam
=+ ^- zaz=(list ,[p=span ~])
(skim van |=([a=term ~] =(nam (end 3 1 a))))
?> ?=([[@ ~] ~] zaz)
`term`p.i.zaz
=+ tip=(end 3 1 nam)
=. tip ?:(=('z' tip) %$ tip)
=+ pax=`path`(welp top /[nam])
=+ txt=((hard ,@) .^(%cx (welp pax /hoon)))
[ost %pass /reload %d %flog %veer tip pax txt]
::
++ he-wish-sync
|= [syd=desk her=ship sud=desk ~]
%_ .
moz
:_ moz
[ost %pass /sync %c %font our.hid syd her sud]
==
::
++ he-wish-unix
|= [syd=desk syn=(unit ,?)]
%_ .
moz
:_ moz
[ost %pass /unix %c %lynx our.hid syd syn]
==
::
++ he-wish-verb
%_ .
moz
:_ moz
[ost %pass /verb %d %flog %verb ~]
==
::
++ he-wish-mass
%_ .
moz
:_ moz
[ost %pass /heft %d %flog %heft ~]
==
::
++ he-wish-init
|= him=ship
%_ +>.$
moz
:_ moz
[ost %pass /init %d %flog %crud %hax-init leaf/(scow %p him) ~]
==
::
++ he-wish-merge
|= syd=desk
=+ ^- merge-state
%+ fall (~(get by rem) syd)
=+ *merge-state
%_(- cas [%da lat.hid])
|%
++ merge-abet
..he-wish-merge(rem (~(put by rem) syd auto gem her sud cas))
::
++ blab
|= new=(list move)
^+ +>
+>.$(moz (welp new moz))
::
++ win (blab [ost %give %nice ~] ~)
++ lose (blab [ost %give %mean ~] ~)
::
++ gage-to-tage
|= res=gage
^- tage
?@ p.res
~|(%bad-marc !!)
res
::
++ tage-to-cages
|= tab=tage
^- (list (pair cage cage))
?~ p.tab
~
:_ $(p.tab t.p.tab, q.tab (slot 3 q.tab))
~| %strange-gage
:- [?^(p.i.p.tab !! p.i.p.tab) (slot 4 q.tab)]
[?^(q.i.p.tab !! q.i.p.tab) (slot 5 q.tab)]
::
++ merge
^+ .
(blab [ost %pass /merge/[syd]/merge %c %merg our.hid syd her sud gem] ~)
::
++ fancy-merge :: recurse
|= [syd=desk her=@p sud=desk gem=?(%auto germ)]
^+ +>
%- blab :_ ~
:* ost %pass /merge/[^syd]/fancy %g %mess [our.hid imp.hid]
our.hid %helm-merge !>([syd her sud gem])
==
::
++ spam
|= mes=(list tank)
%- blab :_ ~
:* ost %pass /merge/[syd]/spam %g %mess
[our.hid /talk] our.hid %talk-command -:!>(*command)
%publish
%- flop
=< acc
%+ roll mes
=< .(eny eny.hid)
|= [tan=tank acc=(list thought) eny=@uvI]
^- [acc=(list thought) eny=@uvI]
=+ (sham eny mes)
:_ -
:_ acc
^- thought
:+ -
[[[%& our.hid (main our.hid)] [*envelope %pending]] ~ ~]
[lat.hid *bouquet [%app (crip ~(ram re tan))]]
==
++ start
|= [her=@p sud=@tas gim=?(%auto germ)]
^+ +>
=. cas [%da lat.hid]
?. ?=(%auto gim)
merge(auto |, gem gim, her her, sud sud)
?: =(0 .^(%cw /(scot %p our.hid)/[syd]/(scot %da lat.hid)))
=> $(gim %init)
.(auto &)
=> $(gim %fine)
.(auto &)
::
++ work
|= sih=sign
^+ +>
~| [%working auto=auto gem=gem syd=syd her=her sud=sud]
?: ?=(%meld gem)
?- -.sih
%g
?: ?=(%nice +<.sih)
=> (spam leaf/"%melding %{(trip sud)} into scratch space" ~)
%- blab :_ ~
:* ost %pass /merge/[syd]/scratch %c %merg our.hid
(cat 3 syd '-scratch') her sud gem
==
=+ :- "failed to set up conflict resolution scratch space"
"I'm out of ideas"
lose:(spam leaf/-< leaf/-> ~)
::
%c
?: ?=(%& -.are.sih)
?. auto
=+ "successfully merged with strategy {<gem>}"
win:(spam leaf/- ?~(p.are.sih ~ [>`(set path)`p.are.sih< ~]))
=+ "mashing conflicts"
=> .(+>.$ (spam leaf/- ~))
=+ tic=(cat 3 syd '-scratch')
%- blab :_ ~
:* ost %pass /merge/[syd]/mash
%f %exec our.hid [our.hid tic %da lat.hid] ~ %tabl
^- (list (pair silk silk))
%+ turn (~(tap in p.are.sih))
|= pax=path
^- (pair silk silk)
:- [%done ~ %path -:!>(*path) pax]
=+ base=[%file [our.hid tic %da lat.hid] (flop pax)]
=+ alis=[%file [her sud cas] (flop pax)]
=+ bobs=[%file [our.hid syd %da lat.hid] (flop pax)]
=+ dali=[%diff base alis]
=+ dbob=[%diff base bobs]
=+ ^- for=mark
=+ (slag (dec (lent pax)) pax)
?~(- %$ i.-)
[%mash for [her sud dali] [our.hid syd dbob]]
==
=+ "failed to merge with strategy {<p.p.are.sih>}"
lose:(spam leaf/- q.p.are.sih)
::
%f
?: ?=(%| -.q.sih)
=+ "failed to mash"
lose:(spam leaf/- p.q.sih)
=+ ^- can=(list (pair path (unit miso)))
%+ turn (tage-to-cages (gage-to-tage p.q.sih))
|= [pax=cage dif=cage]
^- (pair path (unit miso))
?. ?=(%path p.pax)
~| "strange path mark: {<p.pax>}"
!!
[((hard path) q.q.pax) ?:(?=(%null p.dif) ~ `[%dif dif])]
=+ notated=(skid can |=([path a=(unit miso)] ?=(^ a)))
=+ annotated=(turn `(list (pair path ,*))`-.notated head)
=+ unnotated=(turn `(list (pair path ,*))`+.notated head)
=+ (trip (cat 3 syd '-scratch'))
=+ ^- tan=(list tank)
%- zing
^- (list (list tank))
:~ :~ leaf/""
leaf/"done setting up scratch space in %{-}"
leaf/"please resolve the following conflicts and run"
leaf/":helm+merge %{(trip syd)} {<our.hid>} %{-}"
==
?~ annotated
~
:~ leaf/""
leaf/"annotated conflicts in:"
>`(list path)`annotated<
==
?~ unnotated
~
:~ leaf/""
leaf/"some conflicts could not be annotated."
leaf/"for these, the scratch space contains"
leaf/"the most recent common ancestor of the"
leaf/"conflicting content."
leaf/""
leaf/"unannotated conflicts in:"
>`(list path)`unnotated<
==
==
=< win
%- blab:(spam tan)
:_ ~
:* ost %pass /merge/[syd]/dash %c %info
our.hid (cat 3 syd '-scratch')
%& *cart
%+ murn can
|= [p=path q=(unit miso)]
`(unit (pair path miso))`?~(q ~ `[p u.q])
==
==
?> ?=(%c -.sih)
?: ?=(%& -.are.sih)
=+ "successfully merged with strategy {<gem>}"
win:(spam leaf/- ?~(p.are.sih ~ [>`(set path)`p.are.sih< ~]))
?. auto
=+ "failed to merge with strategy {<p.p.are.sih>}"
lose:(spam leaf/- q.p.are.sih)
?+ gem
(spam leaf/"strange auto" >gem< ~)
::
%init
=+ :- "auto merge failed on strategy %init"
"I'm out of ideas"
lose:(spam leaf/-< leaf/-> [>p.p.are.sih< q.p.are.sih])
::
%fine
?. ?=(%bad-fine-merge p.p.are.sih)
=+ "auto merge failed on strategy %fine"
lose:(spam leaf/- >p.p.are.sih< q.p.are.sih)
=> (spam leaf/"%fine merge failed, trying %meet" ~)
merge(gem %meet)
::
%meet
?. ?=(%meet-conflict p.p.are.sih)
=+ "auto merge failed on strategy %meet"
lose:(spam leaf/- >p.p.are.sih< q.p.are.sih)
=> (spam leaf/"%meet merge failed, trying %mate" ~)
merge(gem %mate)
::
%mate
?. ?=(%mate-conflict p.p.are.sih)
=+ "auto merge failed on strategy %mate"
lose:(spam leaf/- >p.p.are.sih< q.p.are.sih)
=> .(gem %meld)
=+ tic=(cat 3 syd '-scratch')
=> =+ :- "%mate merge failed with conflicts,"
"setting up scratch space at %{(trip tic)}"
[tic=tic (spam leaf/-< leaf/-> ~)]
(fancy-merge tic our.hid syd %auto)
==
--
--
::
++ hake :: poke core
|= [ost=bone her=ship]
?> =(her our.hid)
~(. he [ost [ost %give %nice ~]~] (fall (~(get by hoc) ost) *helm-session))
::
++ hoke :: poke sans ack
|= [ost=bone her=ship]
?> =(her our.hid)
~(. he [ost ~] (fall (~(get by hoc) ost) *helm-session))
::
++ poke-helm-reset
|= [ost=bone her=ship ~]
~& %poke-helm-reset
he-abet:he-wish-reset:(hake ost her)
::
++ poke-helm-verb
|= [ost=bone her=ship ~]
~& %poke-helm-verb
he-abet:he-wish-verb:(hake ost her)
::
++ poke-helm-mass
|= [ost=bone her=ship ~]
~& %poke-helm-mass
he-abet:he-wish-mass:(hake ost her)
::
++ poke-helm-init
|= [ost=bone her=ship him=ship]
~& %poke-helm-init
he-abet:(he-wish-init:(hake ost her) him)
::
++ poke-helm-reload
|= [ost=bone her=ship all=(list term)]
~& %poke-helm-reload
he-abet:(he-wish-reload:(hake ost her) all)
::
++ poke-helm-merge
|= [ost=bone her=ship syd=@tas ali=@p sud=@tas gem=?(%auto germ)]
~& %poke-helm-merge
he-abet:merge-abet:(start:(he-wish-merge:(hoke ost her) syd) ali sud gem)
::
++ poke-helm-sync
|= [ost=bone her=ship all=[desk ship desk ~]]
~& %poke-helm-sync
he-abet:(he-wish-sync:(hake ost her) all)
::
++ poke-helm-unix
|= [ost=bone her=ship all=[desk (unit ,?)]]
~& %poke-helm-unix
he-abet:(he-wish-unix:(hake ost her) all)
::
++ poke-helm-begin
|= [ost=bone you=ship begs]
~& %poke-helm-begin
?> ?=(~ bur)
=+ buz=(shax :(mix (jam ges) eny))
=+ loy=(bruw 2.048 buz)
:_ +>.$(bur `[his [0 sec:ex:loy]~])
:~ :* ost %pass /ticketing %a %want [our.hid (sein his)] /q/ta
his tic ges pub:ex:loy
==
[ost %give %nice ~]
==
::
++ poke-will
|= [ost=bone you=ship wil=(unit will)]
?> ?=(^ bur)
:_ +>.$(bur ~)
?~ wil
[ost %give %mean ~ %rejected ~]~
:~ [ost %pass / %a %cash p.u.bur q.u.bur u.wil]
[ost %pass / %c %plug our.hid %home (sein our.hid) %kids]
[ost %give %nice ~]
==
::
++ pour
|= [ost=bone pax=path sih=*]
^- [(list move) _+>]
=+ sih=((soft sign) sih)
?~ sih [~ +>.$]
?+ pax [~ +>.$]
[%merge @tas @ ~]
?: ?=(%spam i.t.t.pax)
[~ +>.$]
he-abet:merge-abet:(work:(he-wish-merge:(hoke ost our.hid) i.t.pax) u.sih)
==
--

50
base/app/hi/core.hook
View File

@ -1,50 +0,0 @@
:: Hi, send optional message to a ship
::
:::: /hook/core/hi/bin
::
/+ sh-utils
::
::::
::
|%
++ sign ::
$% $: %g ::
$% [%nice ~] ::
[%mean p=ares] ::
== == ==
++ flog :: sent to %dill
$% [%crud p=@tas q=(list tank)] ::
[%text p=tape] ::
== ::
--
!:
::::
::
|_ [hid=hide ~]
++ peer
|= [ost=bone ^]
~& per=ost
`+>
++ poke--args
|= [bone you=ship her=ship mes=?(~ [tex=tape ~])]
%. +<
%+ add-resp
=+ mez=[%txt !>(?~(mes '' (crip tex.mes)))]
[%pass /hi/(scot %p her) %g %mess [her /hi] you mez]
(add-nice ,_`+>.$)
::
++ poke-txt
%- add-nice
|= [ost=bone him=ship cor=@t]
~& from=ost
:_ +>.$
[ost %pass /di %d %flog %text "< {<him>}: {(trip cor)}"]~
::
++ pour
|= [ost=bone pax=path sih=sign]
?> ?=([%hi @t ~] pax)
%. +<
=+ ack=?+(+<.sih "unsuccesful" %nice "succesful")
(add-exit (print +>.$ "hi {(trip i.t.pax)} {ack}"))
::
--

19
base/app/into/core.hook
View File

@ -1,19 +0,0 @@
:: Over/write to location, usage :into %/foo/txt 'Contents'
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke-into-args
|= [ost=bone you=ship pax=path dat=cage ~]
:_ +>.$
:* [ost %pass /into %c %info our.hid (foal pax dat)]
[ost %pass / %g %cide %$]
[ost %give %nice ~]
%+ turn (~(tap by sup.hid))
|= [ost=bone *]
:^ ost %give %rush
:- %tang :_ ~
leaf/"written"
==
--

13
base/app/label/core.hook
View File

@ -1,13 +0,0 @@
!:
::::
::
|_ [hid=hide ~]
++ poke-label-args
|= [ost=bone you=ship syd=@tas lab=@tas ~]
:_ +>.$
:~ [ost %pass /label %c %info our.hid syd %| lab]
[ost %pass / %g %cide %$]
[ost %give %nice ~]
==
++ peer |=(* `+>)
--

17
base/app/ls/core.hook
View File

@ -1,17 +0,0 @@
:: LiSt directory subnodes
::
::::
::
/+ sh-utils
// /%%/subdir
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke-ls-args
%+ args-into-gate .
|= [arg=path ~]
=+ lon=((hard arch) .^(%cy arg))
tang/[?~(r.lon leaf/"~" (subdir arg r.lon))]~
--

20
base/app/ls/subdir.hoon
View File

@ -1,20 +0,0 @@
|%
++ subdir
|= [pax=path des=(map ,@t ,~)]
^- tank
:+ %rose [" " `~]
%+ turn (sort (~(tap by des)) aor)
|= [kid=@ta ~]
=+ paf=`path`/[kid]
=- :+ %rose ["/" ~ ?:(dir "/" ~)]
(turn paf |=(a=span leaf/(trip a)))
|- ^- [dir=? paf=path]
=+ arf=;;(arch .^(%cy (weld pax paf)))
?^ q.arf
[| paf]
?~ r.arf
[& paf] :: !!
?. ?=([^ ~ ~] r.arf)
[& paf]
$(paf (welp paf /[p.n.r.arf]))
--

165
base/app/matrix/hymn.hook
View File

@ -1,165 +0,0 @@
:: Matrix GUI
::
:::: /hook/hymn/matr/app
::
/? 310
|%
++ cdnj |=(a=tape ;script(src "//cdnjs.cloudflare.com/ajax/libs/{a}");)
--
::
::::
::
^- manx
;html
;head
;title: Matrix
;* %- turn :_ cdnj ^- wall
:~ "jquery/2.1.1/jquery.min.js"
"mousetrap/1.4.6/mousetrap.js"
"react/0.11.0/react.js"
==
;script(src "/~/at/home/lib/urb.js");
;script: urb.appl = 'sole'
;style:'''
#term {
width: 100%;
}
#term * {
margin: 0px;
}
'''
==
;body
;div#err;
;div#term:""
;script(type "text/coffeescript") ;- %- trip
'''
[DOM,recl,rend] = [React.DOM, React.createClass, React.renderComponent]
[div, pre] = [DOM.div, DOM.pre]
Matr = recl render: ->
[pro,cur] = [@props.prompt + " ", @props.cursor + 1]
prompt = "#{pro.slice(0,cur)}\u0332#{pro.slice(cur)}"
lines = [prompt, @props.rows...]
div {}, lines.slice().reverse().map (lin)->
pre {}, lin
$ ->
termRev = 0
pressed = []
deltim = null
met = $('<pre>').text('m').css(display: 'none').appendTo(term).width()
subs = ""
# $(window).resize ->
# window.termWif = ($(term).width() / met).toFixed()
# path = "/new/#{termWif}"
# if path is subs
# return
# if subs
# urb.unsubscribe {path:subs}
# subs = path
# urb.subscribe {path}, (err,dat)->
# if err or dat.data.ok
# return;
# syncRev = dat.data.rev
# unless termRev > syncRev
# termRev = syncRev
# matr.setProps rows: dat.data.stak
# document.title = "Matrix" # XX debug
# $(window).resize()
matr = rend (Matr rows:[], prompt:"", cursor:1), term
flash = ($el, background)->
$el.css {background}
if background
setTimeout (()-> flash $el,''), 50
peer = (ruh) ->
switch false
when !ruh.map then ruh.map peer
when !ruh.pro then matr.setProps prompt: ruh.pro
when !ruh.hop then matr.setProps cursor: ruh.hop
when !ruh.out
matr.setProps rows: [ruh.out, matr.props.rows...]
when !ruh.act then switch ruh.act
when 'clr' then matr.setProps rows:[]
when 'bel' then flash ($ 'body'), 'black'
else throw "Unknown "+(JSON.stringify ruh)
else console.log ruh
urb.bind "", (err,d)->
if d.data then peer d.data
#later = (data)->
# if data
# pressed.push data
# clearTimeout deltim
# setTimeout (->
# if urb.reqq.length > 0
# return deltim = later()
# urb.send data: pressed
# pressed = []
# ), 500
Mousetrap.handleKey = (char, mod, e)->
norm = {
capslock: 'caps'
pageup: 'pgup'
pagedown: 'pgdn'
backspace: 'baxp'
enter: 'entr'
}
key =
if char.length is 1
if e.type is 'keypress'
str: char
else if e.type is 'keydown'
if char isnt 'space'
act: norm[char] ? char
else if e.type is 'keyup' and norm[key] is 'caps'
act: 'uncap'
if key
e.preventDefault()
urb.send mark: 'dill-belt', data: {mod,key}
# amod = (arr)->
# for i in arr
# unless mod.indexOf(i) < 0
# return yes
# no
# if key.str or key.act is 'baxp' or key.act is 'entr'
# termRev++
# [bot, rest...] = old = matr.props.rows
# matr.setProps rows:(
# switch key.act
# when 'baxp'
# if amod ['ctrl', 'meta']
# ['', rest...]
# else if amod ['alt']
# [(bot.replace /\ *[^ ]*$/, ''), rest...]
# else if bot and bot.length
# [bot.slice(0, -1), rest...]
# else if rest[0] and rest[0].length
# res = rest.slice()
# res[0] = res[0].slice(0, -1)
# res
# else rest
# when 'entr'
# ['', old...]
# when undefined
# if mod.length > 1 or (mod.length and !amod ['shift'])
# old
# else unless old and bot isnt null
# [key.str]
# #else if bot.length is termWif
# # [key.str, old...]
# else [bot + key.str, rest...]
# )
# document.title = "Matri" # XX debug
# later {mod, key}
'''
==
;+ (cdnj "coffee-script/1.7.1/coffee-script.min.js")
== ==

17
base/app/mv/core.hook
View File

@ -1,17 +0,0 @@
:: MoVe file from one location to another
::
:::: /hook/core/mv/app
::
/+ sh-utils
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke--args
%+ gate-bang
|= [input=path output=path ~]
:^ %c %info our.hid
(furl (foal output .^(%cx input)) (fray input))
(args-into-gate . ,_[%txt 'moved'])
--

1
base/app/nop/core.hook
View File

@ -1 +0,0 @@
|_ ^ ++ poke-nop-args ,_`. --

34
base/app/peek/core.hook
View File

@ -1,34 +0,0 @@
:: Peek imp path || Poke ship imp path. Subscribe to an app.
!:
::::
::
|_ [hide ~]
++ ptah ,[p=path q=path ~]
++ poke-peek-args
|= [ost=bone @ a=?(ptah [her=ship ptah])]
=- :_(+>.$ ~[[ost %give %nice ~] [ost %pass / %g %show -]])
^- [p=[ship path] q=ship r=path]
?^ |2.a [[her p]:a our q.a]
[[our p.a] our q.a]
::
++ posh
|* [@ * git=[@tas *]]
~& peek-posh/git
`+>
++ pour
|= [ost=bone * sih=*]
~& =+ cod=(,[term term] [&1 &2]:sih)
?+ +.cod peek-resp/cod
%nice %peek-nice
%mean
=+ are=((soft ares) |2.sih)
?~ are %peek-mean
?~ u.are %peek-done
~& > p.u.u.are
|-
?~ q.u.u.are %peek-mean
~> %slog.`rose/[~ "! " ~]^[i.q.u.u.are]~
$(q.u.u.are t.q.u.u.are)
==
:_(+> ?+(&2.sih ~ %mean [ost %pass / %g %cide %$]~))
--

30
base/app/poke/core.hook
View File

@ -1,30 +0,0 @@
:: Poke path [mark *] || Poke ship path [mark *]. Send message to an app.
!:
::::
::
|_ [hide ~]
++ mess ,[p=path q=[@ *] ~]
++ pock-poke-args
|= [ost=bone @ a=type b=?(mess [her=ship mess])]
=- :_(+>.$ [ost %pass / %g %mess -]~)
^- [p=[ship path] q=ship r=cage]
?^ |2.b [[her p]:b our -.q.b (slot 29 [a b])] :: +.&3
[[our p.b] our -.q.b (slot 13 [a b])] :: +.&2
::
++ pour
|= [ost=bone * sih=*]
~& =+ cod=(,[term term] [&1 &2]:sih)
?+ +.cod poke-resp/cod
%nice %poke-nice
%mean
=+ are=((soft ares) |2.sih)
?~ are %poke-mean
?~ u.are %poke-nil-mean
~& > p.u.u.are
|-
?~ q.u.u.are %poke-mean
~> %slog.`rose/[~ "! " ~]^[i.q.u.u.are]~
$(q.u.u.are t.q.u.u.are)
==
:_(+> [ost %pass / %g %cide %$]~)
--

47
base/app/pope/core.hook
View File

@ -1,47 +0,0 @@
:: Pope, generate key for carrier
::
:::: /hook/core/pope/app
::
/+ sh-utils
!:
::::
::
|%
++ gilt $%([%tang (list tank)] [%prompt @t prom @t])
++ sign
$% [%t %wake ~]
[%g $%([%nice ~] [%rush %txt p=cord])]
==
--
!:
::::
::
=+ cryp=bruw :: XX change to ec2 ++brew eventually
|_ [hide who=@p fra=@t]
++ peer ,_`.
++ poke--args
|= [@ @ who=ship ~]
?> ?=(%czar (clan who))
=. ^who who
=- %.(+<.$ (add-nice (gate-bang ,_noe (return git))))
:- noe=[%g %show our^+.imp our /in/[-.imp]] :: request input
git=prompt/['passphrase: ' %pass '']
::
++ return |=(a=gilt (add-output +> rush/a ,_`+>))
++ pour
|= [@ * sih=*]
=+ sih=;;(sign sih)
?- -.sih
%g ?. ?=(%rush +<.sih) `+>.$
=. fra p.sih
=- %.(+<.$ (gate-bang ,_noe (return tang/~[leaf/msg])))
:- noe=[%t %wait (add ~s1 lat)] :: set print timeout
msg="generating carrier {(scow %p who)} (#{(scow %ud who)})"
::
%t =- %.(+<.$ (add-exit (return tang/-)))
=+ bur=(shax (add who (shax fra)))
=+ arc=(cryp 2.048 bur)
:~ leaf/"generator: {(scow %uw bur)}"
leaf/"fingerprint: {(scow %uw fig:ex:arc)}"
== ==
--

37
base/app/reboot/core.hook
View File

@ -1,37 +0,0 @@
:: Reboot %zuse and all kernel vanes
::
:::: /hook/core/reboot/app
::
/+ sh-utils
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke--args
%^ add-output .
rush/tang/[leaf/"done"]~
%+ args-into-resp .
|= arg=~
%- turn
:_ |= [tip=@tasD nam=@tas]
=+ pax=[(scot %p our.hid) %arvo (scot %da lat.hid) nam %hoon ~]
[%veer tip pax (,@ +:.^(%cx pax))]
^- (list ,[p=@tas q=@tas])
:~ [%$ %zuse]
[%a %ames]
[%c %clay]
[%d %dill]
[%e %eyre]
[%f %ford]
[%g %gall]
[%t %time]
==
++ pour
%+ gate-bang
=+ pax=/(scot %p our.hid)/=/(scot %da lat.hid)/==count/txt
=+ nuf=(file pax)
=+ num=?~(nuf 0 +((fall (slaw %ud (,@t u.nuf)) 0)))
,_[%c %info our.hid (foal pax num)] :: touch clay to reload apps
,_`.
--

30
base/app/reload/core.hook
View File

@ -1,30 +0,0 @@
:: Reload kernel vanes, specified by name or letter
::
:::: /hook/core/reload/app
::
/+ sh-utils
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke--args
%^ add-output .
rush/tang/[leaf/"done"]~
%+ args-into-resp .
|= all=(list ,@tas)
%+ turn all
=+ ark=(arch .^(%cy /(scot %p our.hid)/main/(scot %da lat.hid)/arvo))
=+ van=(~(tap by r.ark))
|= nam=@tas
=. nam
?. =(1 (met 3 nam))
nam
=+ ^- zaz=(list ,[p=span ~])
(skim van |=([a=term ~] =(nam (end 3 1 a))))
?> ?=([[@ ~] ~] zaz)
`term`p.i.zaz
=+ tip=(end 3 1 nam)
=+ pax=[(scot %p our.hid) %main (scot %da lat.hid) %arvo nam ~]
[%veer ?:(=('z' tip) %$ tip) pax (,@ .^(%cx (welp pax /hoon)))]
--

38
base/app/reset/core.hook
View File

@ -1,38 +0,0 @@
:: Reset: recompile arvo, from hoon/hoon up
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke-reset-args
|= [ost=bone you=ship arg=$|(~ [_| ~])]
:_ +>.$
=+ top=`path`/(scot %p our.hid)/arvo/(scot %da lat.hid)
:^ [ost %give %nice ~]
[ost %pass ?~(arg /refresh /) %t %wait lat.hid]
[ost %give %vega (weld top `path`/hoon)]
%+ turn
^- (list ,[p=@tas q=@tas])
:~ [%$ %zuse]
[%a %ames]
[%c %clay]
[%d %dill]
[%e %eyre]
[%f %ford]
[%g %gall]
[%t %time]
==
|= [p=@tas q=@tas]
=+ pax=`path`(welp top /[q])
=+ txt=((hard ,@) .^(%cx (welp pax /hoon)))
[ost %give %veer p pax txt]
++ pour
|= [ost=bone pax=path *]
:_ +>.$
?~ pax ~
:_ ~
=+ paf=/(scot %p our.hid)/=/(scot %da lat.hid)/==count/txt
=+ nuf=(file paf)
=+ num=?~(nuf 0 +((fall (slaw %ud (,@t u.nuf)) 0)))
[ost %pass /touch %c %info our.hid (foal paf num)]
--

18
base/app/rm/core.hook
View File

@ -1,18 +0,0 @@
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke-rm-args
|= [ost=bone you=ship pax=path ~]
:_ +>.$
:* [ost %pass /rm %c %info our.hid (fray pax)]
[ost %pass / %g %cide %$]
[ost %give %nice ~]
%+ turn (~(tap by sup.hid))
|= [ost=bone *]
:^ ost %give %rush
:- %tang :_ ~
leaf/"removed"
==
--

569
base/app/shell/core.hook
View File

@ -1,569 +0,0 @@
:: Shell
::
:::: /hook/core/shell/app
::
/? 314
/- term-line, kyev
/= pit /~ !>(+) :: kernel vase
::
:::: structures
!:
|% ::
++ axle ::
$: %1 :: version
tiv=? :: typing?
wit=[p=@u q=(map ,@u coma)] :: waiting commands
pid=@u :: next process id
pax=_`path`/=base=/try :: working directory
act=(unit span) :: active child
pip=(jar span span) :: pipe out->in
pop=(jar span span) :: pipe in->out
pot=(map span ,[cord prom cord]) :: prompts
var=(map term vase) :: variables
== ::
++ gift ::
$% [%rush p=gilt] ::
[%init p=@p] ::
[%logo p=@] ::
[%mean p=ares] ::
[%nice ~] ::
[%meta p=vase] ::
[%sage p=path q=*] ::
[%verb ~] ::
[%veer p=@ta q=path r=@t] ::
[%vega p=path] ::
== ::
++ gilt ::
$% [%term-line p=term-line] ::
[%txt p=cord] ::
[%type p=?] ::
== ::
++ glas ?(%out [%in p=cord] [%active p=cord]) ::
++ hapt ,[p=ship q=path] ::
++ move ,[p=bone q=(mold note gift)] ::
++ note ::
$% $: %c ::
$% [%info p=@p q=toro] ::
== == ::
$: %g ::
$% [%cide p=span] ::
[%show p=hapt q=ship r=path] ::
[%sire p=term q=span] ::
[%mess p=hapt q=ship r=cage] ::
[%meta p=vase] ::
[%nuke p=hapt q=ship] ::
[%took p=hapt q=ship] ::
== == == ::
++ mand ,[p=term q=(list twig)] :: name and arguments
++ coma ::
$% [%run p=(list mand) q=mand] :: pipe into
[%end p=(each ,@u cord)] :: kill pid/name
[%path p=path] :: chdir
[%del p=path] :: rm file
[%ins p=path q=(unit twig)] :: add file
[%mut p=path q=(unit twig)] :: change file
[%hoon p=twig] :: eval expression
[%comt ~] :: comment
[%var p=term q=twig] :: set variable
[%rvar p=term] :: unset variable
[%help p=term] :: info about command
== ::
++ sign ::
$% $: %g ::
$% [%gone p=hapt] ::
[%init p=@p] ::
[%dumb ~] ::
[%mean p=ares] ::
[%nice ~] ::
[%rush p=mark q=*] ::
[%rust p=mark q=*] ::
[%sage p=path q=*] ::
[%verb ~] ::
[%veer p=@ta q=path r=@t] ::
[%vega p=path] ::
== == == ::
--
::
:::: parsers
!:
|%
++ maybe |*(fel=_rule (cook |*(a=(unit) (fall a ~)) (opts fel)))
++ opts :: parse unit
|* fel=_rule
;~ pose
(cook some fel)
(easy ~)
==
::
++ from :: parse door
=+ tol=`?(0 1 2)`%2 :: wide, tallish, tall
|_ [pax=path lat=time]
++ rail :: build from wide/tall
|* [wid=_rule wif=_rule tal=_rule]
?~ tol wid
=- ;~(pose wif wid)
^= wif
?: ?=(1 tol) wif
;~(pose tal wif)
::
++ rais |*([wid=_rule tal=_rule] (rail wid wid tal))
::
++ parse :: top level
^- $+(nail (like coma))
=+ paf=pax
=. pax ?.(&(?=([@ @ @ *] pax) =('0' &3.pax)) pax pax(&3 (scot da/lat)))
%+ ifix [(star ace) gaw]
;~ pose
(stag %run ;~(plug (star ;~(sfix (task(tol %0) bar) ace)) (task col)))
(stag %end ;~(pfix col sem ;~(pose (stag %& dem) (stag %| sym))))
(stag %del ;~(pfix hep (plus ace) loca))
(stag %mut ;~(pfix col (plus ace) ;~(plug loca (opts expg))))
(stag %ins ;~(pfix lus (plus ace) ;~(plug loca (opts expg))))
(stag %help ;~(pfix wut ace ;~(pfix col sym)))
(stag %path (full ;~(sfix loca(pax paf) (star ace))))
(stag %var ;~(plug ;~(pfix tis sym) expg))
(stag %rvar ;~(pfix ;~(plug tis tis) sym))
(stag %hoon expr)
(stag %comt ;~(pfix col col (cold ~ (star prn))))
(stag %comt (easy ~))
==
::
++ expg (rais ;~(pfix ace expr(tol %1)) ;~(pfix gap expr))
++ expr (rais [wide tall]:(vang | pax))
++ loca %+ sear ;~(biff plex:(vang | pax) vabe) :: path in %clay
[;~(pose rood ;~(simu cen scat))]:(vang | pax)
++ vabe |=(a=path ?~((tome a) ~ (some a))) :: check valid beam
++ args :: task arguments
%^ rail
(ifix sel^ser (most ace expr))
(plus ;~(pfix ace expr))
;~(sfix (plus ;~(pfix gap expr)) ;~(plug gap duz))
::
++ task |*(fel=_rule ;~(pfix fel ;~(plug sym (maybe args))))
::
--
--
::
:::: per event
!:
|%
++ ve
|= [hid=hide ost=bone axle]
=* vat +<+>
=| mow=(list move)
|%
++ abet
^- [(list move) axle]
[(flop mow) vat]
::
++ blab
|= mof=(list move)
+>.$(mow (welp (flop mof) mow))
::
++ chew-file
|= [paf=path mor=$|(cord toro)]
%- blab
^- (list move)
?@ mor
(print palm/[" " ~ ~ ~]^~[leaf/(trip mor) (dank:ut paf)])
[ost %pass writ/paf %c %info our.hid mor]~
::
++ cubs :: tasks with open /in
%- sort :_ |=([a=span b=span] (lth (slav %ud a) (slav %ud b)))
^- (list span)
%+ murn (~(tap by cub.hid))
|= [a=span @]
?.(=([~ ~] (~(get by pop) a)) ~ (some a))
::
++ eat
|= [you=ship com=coma]
?- -.com
%comt +>.$
%del (eat-del +.com)
%end (eat-end +.com)
%hoon (eat-hoon +.com)
%ins (eat-ins +.com)
%mut (eat-mut +.com)
%help (eat-help +.com)
%path (eat-path +.com)
%run (eat-run you +.com)
%rvar (eat-rvar +.com)
%var (eat-var +.com)
==
::
++ eat-del
|= paf=path
^+ +>
%+ chew-file paf
?~ (file paf) '! none'
(fray paf)
::
++ eat-end :: XX clean up state
|= poc=(each ,@u cord)
^+ +>
?- -.poc
%&
=+ cil=(scot %ud p.poc)
=+ cin=(trip (~(got by cub.hid) cil))
%- blab
%+ welp
(kill cil)
(print leaf/"- :{cin}({(trip cil)})")
::
%|
=+ ^- moz=(list move)
%- zing
%+ turn (~(tap by cub.hid))
|= [a=span b=term]
?. =(b p.poc) ~
(kill a)
%- blab %+ welp moz
(print leaf/"-{<(lent moz)>} :{(trip p.poc)}")
==
::
++ eat-hoon
|= gen=twig
^+ +>
%+ with gen |= rez=vase
(blab (print (sell rez)))
::
++ eat-ins
|= [paf=path gen=(unit twig)]
^+ +>
?^ (file paf) (chew-file paf '! exists')
%+ with (fall gen [%bczp atom/%t])
|= new=vase
=+ for=((hard mark) -:(flop paf))
(chew-file paf (foal paf for new))
::
++ eat-mut
|= [paf=path gen=(unit twig)]
^+ +>
=+ fel=(file paf)
?^ fel
?~ gen
(blab (stray (crip ": {(spud paf)} {<(,@t u.fel)>}")))
%+ with u.gen |= new=vase
=+ for=((hard mark) -:(flop paf))
(chew-file paf (foal paf for new))
=+ ark=;;(arch .^(%cy paf))
?- r.ark
~ (chew-file paf '! none')
[^ ~ ~] $(paf (welp paf /[p.n.r.ark]))
* (chew-file paf '! many')
==
::
++ eat-help
|= app=term
^+ +>
%- blab %- print
^- tank
=+ rup=/(scot %p our.hid)/main/(scot %da lat.hid)
=+ paf=`path`(welp rup /app/[app]/core/hook)
=+ src=(file paf)
?. ?=([~ @t] src)
leaf/"app {<app>} does not exist"
=+ cot=;~(pfix col col (plus ace) (star prn))
=+ led=(cot 1^1 (trip u.src))
?^ q.led
leaf/":: {(wonk led)}"
palm/[" " ``~]^~[leaf/"no leading comment in" >paf<]
::
++ eat-path
|= paf=path
^+ +>
=. pax paf
(blab (print leaf/"=% {(spud paf)}"))
::
++ eat-run
|= [you=ship mud=(list mand) mad=mand]
^+ +>
:: =. +>.$ (blab (print leaf/"+ :{(trip p.mad)}"))
?. =- (~(has by r:(arch -)) %core)
.^(%cy /(scot %p our.hid)/main/(scot %da lat.hid)/app/[p.mad])
(blab (print leaf/"app {<p.mad>} does not exist"))
=+ liz=`(list mand)`(welp mud mad ~)
%+ with [%clsg (turn liz |=(mand [%clsg q]))]
|= arg=vase
=| inp=(unit span)
|-
?~ liz ..eat-run
=+ cil=(scot %ud pid)
%_ $
liz t.liz
arg (slot 3 arg)
pid +(pid)
pip ?~ inp pip (~(add ja pip) cil u.inp)
pop ?~ inp pop (~(add ja pop) u.inp cil)
inp `cil
mow
=< mow :: XX side effects?
%- blab
=+ yon=[our.hid cil imp.hid]
=+ mez=[(cat 3 p.i.liz '-args') (slot 2 arg)]
^- (list move)
:~ [ost %pass /child/[cil]/fork %g %sire p.i.liz cil]
[ost %pass /child/[cil]/out %g %show yon you /out]
[ost %pass /child/[cil]/main %g %meta !>([%mess yon you mez])]
==
==
::
++ eat-rvar
|= vor=term
^+ +>
=+ mod=(~(has by var) vor)
=. var (~(del by var) vor)
(blab (print leaf/"{?:(mod "var gone" "no var")} {<vor>}"))
::
++ eat-var
|= [vor=term gen=twig]
^+ +>
%+ with gen |= new=vase
=+ old=(~(get by var) vor)
=+ mod=?~(old "new var" ?:(=(new u.old) "same var" "changed"))
=. var (~(put by var) vor new)
(blab (print leaf/"{mod} {<vor>}"))
::
++ with
|= [gen=twig coz=$+(vase _..with)]
%- coz
%- slap :_ gen
%+ slop
%+ slop [[%face %our p] q]:!>(our.hid)
%+ slop [[%face %tym p] q]:!>(lat.hid)
[[%face %eny p] q]:!>(eny.hid)
%+ roll (~(tap by var))
=< .(q pit)
|= [[n=term v=vase] q=vase]
(slop [[%face n p.v] q.v] q)
::
++ kill
|= cil=span
^- (list move)
:~ [ost %pass /child/[cil]/fork %g %cide cil]
::[ost %pass /child/[cil]/out %g %nuke [our.hid cil imp.hid] our.hid]
==
::
++ next-act :: rotate active task
=+ ^- nex=(unit span)
=+ opt=[i=`(unit span)`~ t=(turn cubs |=(a=span `(unit span)`[~ a]))]
|-
?~ t.opt ~
?: =(act i.opt)
i.t.opt
$(opt t.opt)
?. tiv +(act nex)
%- blab(act nex)
%+ weld
?~ nex ~
(spam /active/[u.nex] %rush %type %&)
?~ act ~
(spam /active/[u.act] %rush %type %|)
::
++ peer
|= [you=ship gal=glas]
^+ +>
?@ gal
%_ +>.$
mow :_(mow [ost %give %rush %term-line prompt ~ ~])
==
?: ?=(%active -.gal)
(blab [ost %give %rush %type %|] ~)
?. (~(has by cub.hid) p.gal) +>.$
?: (~(has by pop) p.gal) +>.$
=: act `p.gal
pop (~(put by pop) p.gal ~) :: .=(~ standard-in)
==
(blab ping)
::
++ ping (print-vase !>(*tang))
++ poke-kyev
|= [you=ship key=kyev]
^+ +>
?: ?=([~ @] key) (poke-txt you q.key) :: simple keypress ?
?> ?=([[%ctrl ~ ~] @t] key)
?+ q.key
%+ blab
[ost %give %nice ~]
(print leaf/"no command \\{(trip q.key)}")
%d ?~ act
%^ blab
[ost %give %nice ~]
[ost %give %logo ~]
~
(eat-end:next-act %& (slav %ud u.act))
%g =+ =- tak=rose/[" " "[" "]"]^(turn (~(tap by cub.hid)) -)
=+ c=(sa cubs)
|= [a=span b=term]
:- %leaf
=+ (trip (rap 3 b '(' a ')' ~))
?.((~(has in c) a) - ?.(=([~ a] act) ['+' -] ['*' -]))
(blab [ost %give %nice ~] (print tak))
%x =. +>.$ next-act
(blab [ost %give %nice ~] ping)
==
::
++ poke-txt :: handle command
|= [you=ship txt=cord]
^+ +>
?^ act :: pipe to child
%+ blab
[ost %give %nice ~]
(spam /in/[u.act] %rush %txt txt)
=+ pas=((full ~(parse from pax lat.hid)) [1 1] (trip txt))
?~ q.pas
=- (blab (weld (stray txt) (print leaf/-)))
"<syntax error at {<`[@ @]`p.pas>}>"
=+ com=(wonk pas)
=> .(+>.$ (eat you com))
=. +>.$ (blab (stash txt))
+>.$(mow :_(mow [ost %give %nice ~]))
::
++ poke-type
|= [you=ship tiv=?]
^+ +>
=. tiv tiv
?^ act
%+ blab
[ost %give %nice ~]
(spam /active/[u.act] %rush %type tiv)
(blab [ost %give %nice ~] ~)
::
++ print |=(a=tank (print-vase !>(`tang`[a ~])))
++ print-vase
|= tan=vase :: [p=p:!>(*tang) q=*]
^- (list move)
%^ spam /out %meta
:(slop !>(%rush) !>(%term-line) !>(prompt) !>(~) tan)
::
++ prompt
^- [p=cord q=prom r=cord]
?^ act
=+ por=(~(get by pot) u.act)
?^ por u.por
[(rap 3 (~(got by cub.hid) u.act) '(' u.act ') ' ~) %text '']
:_ [%text '']
?. &(?=([@ @ @ *] pax) =('0' &3.pax))
(rsh 3 1 (cat 3 (spat pax) '> '))
(rap 3 &1.pax '/' &2.pax '=' ?~(|3.pax ~['> '] ~[(spat |3.pax) '> ']))
::
++ purr
|= [cil=span fom=?(%fork %out %main) typ=type sih=sign]
^+ +>
?< ?=(?(%init %sage %verb %veer %vega) +<.sih)
?- fom
%fork
?> ?=(%gone +<.sih)
=. mow :_(mow [ost %give %nice ~])
?. =(act [~ cil]) +>.$
=. act ~
(blab ping)
::
%main
?> ?=(?(%nice %mean) +<.sih)
%+ blab
[ost %give +.sih]
?. ?=(%mean +<.sih)
ping
(welp ping (kill cil))
::
%out
?. ?=(?(%rust %rush) +<.sih) +>.$
=> .(+<.sih %rush)
?: ?=(%prompt p.sih)
?^ (~(get ja pip) cil) +>.$
=. pot (~(put by pot) cil (,[cord prom cord] q.sih))
(blab ping)
%- blab
?: (~(has by pip) cil)
=+ inp=(~(get ja pip) cil)
|-
?~ inp ~
%+ weld $(inp t.inp)
(spam /in/[i.inp] %meta (slot 3 typ sih))
%- print-vase
?+ p.sih
!>([(sell (slot 15 [typ sih]))]~)
%tang (slam !>(flop) p:!>(*tang) q.sih)
%txt
?^ q.sih !! :: move to vase space?
!>([leaf/(trip q.sih)]~)
==
==
::
++ spam
|= [pax=path gip=gift]
^- (list move)
%+ turn
(~(tap in (~(get ju pus.hid) pax)))
|=(a=bone [a %give gip])
::
++ stash
|= a=cord
%^ spam /out %meta
!>([%rush %term-line `term-line`[prompt [a]~ ~]])
::
++ stray
|= a=cord
%^ spam /out %meta
=+ pro=prompt
!>([%rush %term-line `term-line`[pro(r a) ~ ~]])
--
--
::
:::: formal interface
!:
|_ [hid=hide vat=axle]
::
++ peer :: handle subscription
|= [ost=bone you=ship pax=path]
^- [(list move) _+>]
?~ pax `+>.$
?. ?=(?(%in %out %active) i.pax) `+>.$
=+ ^= gal
?: ?=(%out i.pax) %out
?: ?=(%in i.pax) [%in ?<(?=(~ t.pax) i.t.pax)]
[%active ?<(?=(~ t.pax) i.t.pax)]
=+ abet:(peer:(ve hid ost vat) you gal)
[-< +>.$(vat ->)]
::
++ poke-kyev :: handle key event
|= [ost=bone you=ship key=kyev]
^- [(list move) _+>]
=+ abet:(poke-kyev:(ve hid ost vat) you key)
[-< +>.$(vat ->)]
::
++ poke-txt :: handle command
|= [ost=bone you=ship txt=cord]
^- [(list move) _+>]
=+ abet:(poke-txt:(ve hid ost vat) you txt)
[-< +>.$(vat ->)]
::
++ poke-type :: handle command
|= [ost=bone you=ship tiv=?]
^- [(list move) _+>]
=+ abet:(poke-type:(ve hid ost vat) you tiv)
[-< +>.$(vat ->)]
::
++ purr
|= [ost=bone pax=path typ=type sih=sign]
^- [(list move) _+>]
?: ?=(%init +<.sih) :: vomit
[[ost %give +.sih]~ +>.$]
?: ?=(%dumb +<.sih) :: sleep
[~ +>.$]
?: ?=(%sage +<.sih) :: vomit
[[ost %give +.sih]~ +>.$]
?: ?=(%verb +<.sih) :: vomit
[[ost %give +.sih]~ +>.$]
?: ?=(%veer +<.sih) :: vomit
[[ost %give +.sih]~ +>.$]
?: ?=(%vega +<.sih) :: vomit
[[ost %give +.sih]~ +>.$]
?~ pax ~& %no-path !!
?> ?=([%child span ?(%fork %out %main) ~] pax)
=^ moz vat abet:(purr:(ve hid ost vat) i.t.pax i.t.t.pax typ sih)
:_ +>.$
?. ?=(%rush +<.sih) moz
[[ost %pass pax %g %took [our.hid i.t.pax imp.hid] our.hid] moz]
--

643
base/app/sole/core.hook
View File

@ -1,643 +0,0 @@
:: :: ::
:::: /hook/core/sole/app :: ::
:: :: ::
/? 314 :: zuse version
/- *sole :: console structures
/+ sole :: console library
:: :: ::
:::: :: ::
!: :: ::
=> |% :: data structures
++ house :: all state
$: bin=(map bone source) :: input devices
== ::
++ source :: input device
$: edg=_79 :: terminal columns
off=@ud :: window offset
kil=(unit (list ,@c)) :: kill buffer
apt=(list gill) :: application ring
maz=master :: master window
feg=(map gill target) :: live applications
mir=(pair ,@ud (list ,@c)) :: mirrored terminal
== ::
++ master :: master buffer
$: liv=? :: master is live
tar=target :: master target
== ::
++ history :: past input
$: pos=@ud :: input position
num=@ud :: number of entries
lay=(map ,@ud (list ,@c)) :: editing overlay
old=(list (list ,@c)) :: entries proper
== ::
++ search :: reverse-i-search
$: pos=@ud :: search position
str=(list ,@c) :: search string
== ::
++ target :: application target
$: ris=(unit search) :: reverse-i-search
hit=history :: all past input
pom=sole-prompt :: static prompt
inp=sole-command :: input state
== ::
++ ukase :: master command
$% [%add p=(list gill)] :: add agents
[%del p=(list gill)] :: delete agents
== ::
++ gift :: out result <-$
$% [%mean p=ares] ::
[%nice ~] ::
[%rush %dill-blit dill-blit] ::
== ::
++ sign-gall :: sign from %gall
$% [%mean p=ares] ::
[%nice ~] ::
[%rush %sole-effect sole-effect] ::
== ::
++ sign :: in result $<-
$% [%g sign-gall] ::
== ::
++ move ,[p=bone q=(mold note gift)] ::
++ note-gall :: note to %gall
$% [%mess p=[p=ship q=path] q=ship r=cage] ::
[%nuke p=[p=ship q=path] q=ship] ::
[%show p=[p=ship q=path] q=ship r=path] ::
[%took p=[p=ship q=path] q=ship] ::
== ::
++ note :: out request $->
$% [%g note-gall] ::
== ::
-- ::
|_ $: hid=hide :: system state
house :: program state
== ::
++ sp
|% ++ sp-ukase
%+ knee *ukase |. ~+
;~ pose
(stag %add ;~(pfix lus sp-gills))
(stag %del ;~(pfix hep sp-gills))
==
::
++ sp-gills
;~ pose
(most ;~(plug com ace) sp-gill)
%+ cook
|= a=ship
[[a %dojo] [a %talk] ~]
;~(pfix sig fed:ag)
==
::
++ sp-gill
;~ pose
(stag our.hid sym)
;~ plug
;~(pfix sig fed:ag)
;~(pfix fas sym)
==
==
--
++ se :: per source
|_ $: [moz=(list move) biz=(list dill-blit)]
[her=ship ost=bone]
source
==
++ se-abet :: resolve
:_ %_(+> bin (~(put by bin) ost +<+>))
%+ welp (flop moz)
^- (list move)
?~ biz ~
[ost %give %rush %dill-blit ?~(t.biz i.biz [%mor (flop biz)])]~
::
++ se-belt :: handle input
|= bet=dill-belt
^+ +>
?: ?=(%rez -.bet)
+>(edg (dec p.bet))
?: ?=(%yow -.bet)
(se-link p.bet)
=+ gyl=?^(apt i.apt [~zod %$])
=+ taz=~(. ta [& liv.maz gyl] ?:(liv.maz tar.maz (~(got by feg) gyl)))
=< ta-abet
?- -.bet
%aro (ta-aro:taz p.bet)
%bac ta-bac:taz
%cru (ta-cru:taz p.bet q.bet)
%ctl (ta-ctl:taz p.bet)
%del ta-del:taz
%met (ta-met:taz p.bet)
%ret ta-ret:taz
%txt (ta-txt:taz p.bet)
==
::
++ se-drop :: passive drop
|= gyl=gill
^+ +>
=< se-prom
?> (~(has by feg) gyl)
%_ +>
feg (~(del by feg) gyl)
apt (skip apt |=(a=gill =(gyl a)))
liv.maz ?~(apt & liv.maz)
==
::
++ se-join :: add connection
|= gyl=gill
^+ +>
=< se-prom
?: (~(has by feg) gyl)
(se-blit %bel ~)
+>(liv.maz |, apt [gyl apt], feg (~(put by feg) gyl *target))
::
++ se-nuke :: active drop
|= gyl=gill
^+ +>
(se-drop:(se-send(liv.maz |) gyl %nuke [p.gyl ~[q.gyl]] her) gyl)
::
++ se-like :: act in master
|= kus=ukase
?- -.kus
%add
|- ^+ +>.^$
?~ p.kus +>.^$
$(p.kus t.p.kus, +>.^$ (se-link i.p.kus))
::
%del
|- ^+ +>.^$
?~ p.kus +>.^$
$(p.kus t.p.kus, +>.^$ (se-nuke i.p.kus))
==
::
++ se-prom :: set master prompt
^+ .
%_ .
cad.pom.tar.maz
^- tape
%+ welp
(scow %p our.hid)
=+ ^= mux
|- ^- tape
?~ apt ~
=+ ^= mor ^- tape
?~ t.apt ~
[',' ' ' $(apt t.apt)]
%+ welp
^- tape
=+ txt=(trip q.i.apt)
?: =(our.hid p.i.apt)
txt
:(welp "~" (scow %p p.i.apt) "/" txt)
mor
?~ mux
"# "
:(welp ":" mux "# ")
==
::
++ se-link :: connect to app
|= gyl=gill
^+ +>
%. gyl
=< se-join
(se-send gyl %show [p.gyl ~[q.gyl]] her /sole)
::
++ se-blit :: give output
|= bil=dill-blit
+>(biz [bil biz])
::
++ se-show :: show buffer, raw
|= lin=(pair ,@ud (list ,@c))
^+ +>
?: =(mir lin) +>
=. +> ?:(=(q.mir q.lin) +> (se-blit %pro q.lin))
=. +> ?:(=(p.mir p.lin) +> (se-blit %hop p.lin))
+>(mir lin)
::
++ se-just :: adjusted buffer
|= lin=(pair ,@ud (list ,@c))
^+ +>
=. off ?:((lth p.lin edg) 0 (sub p.lin edg))
(se-show (sub p.lin off) (scag edg (slag off q.lin)))
::
++ se-view :: flush buffer
?: liv.maz
(se-just ~(ta-vew ta [& & ~zod %$] tar.maz))
?~ apt
se-view(liv.maz &)
%- se-just
~(ta-vew ta [& | i.apt] (~(got by feg) i.apt))
::
++ se-kill :: kill a source
=+ tup=apt
|- ^+ +>
?~ tup +>(apt ~)
$(tup +.tup, +> (se-nuke i.tup))
::
++ se-emit :: emit move
|= mov=move
%_(+> moz [mov moz])
::
++ se-send :: send a message
|= [gyl=gill nog=note-gall]
(se-emit ost %pass [(scot %p her) (scot %p p.gyl) q.gyl ~] %g nog)
::
++ se-tame
|= gyl=gill
^+ ta
~(. ta [& %| gyl] (~(got by feg) gyl))
::
++ se-pour :: receive results
|= [gyl=gill sil=sign-gall]
^+ +>
?- -.sil
%mean
+>.$
::
%nice
+>.$
::
%rush
ta-abet:ta-rap:(ta-fec:(se-tame gyl) +>.sil)
==
::
++ ta :: per target
|_ $: $: liv=? :: don't delete
mav=? :: showing master
gyl=gill :: target app
== ::
target :: target state
== ::
++ ta-abet :: resolve
^+ ..ta
=. liv.maz mav
?: mav
?. liv
(se-blit `dill-blit`[%qit ~])
+>(tar.maz +<+)
?. liv
=. ..ta (se-nuke gyl)
..ta(liv.maz =(~ apt))
%_(+> feg (~(put by feg) gyl +<+))
::
++ ta-ant :: toggle master
^+ .
?: mav
?~ apt ta-bel
%_ .
mav |
+<+ (~(got by feg) gyl)
tar.maz +<+
==
%_ .
mav &
+<+ tar.maz
feg (~(put by feg) gyl +<+)
==
::
++ ta-act :: send action
|= act=sole-action
^+ +>
?: mav
+>.$
%_ +>
+>
(se-send gyl %mess [p.gyl ~[q.gyl]] her %sole-action !>(act))
==
::
++ ta-aro :: hear arrow
|= key=?(%d %l %r %u)
^+ +>
?- key
%d =. ris ~
?. =(num.hit pos.hit)
(ta-mov +(pos.hit))
?: =(0 (lent buf.say.inp))
ta-bel
(ta-hom:ta-nex %set ~)
%l ?^ ris ta-bel
?: =(0 pos.inp) ta-bel
+>(pos.inp (dec pos.inp))
%r ?^ ris ta-bel
?: =((lent buf.say.inp) pos.inp)
ta-bel
+>(pos.inp +(pos.inp))
%u =. ris ~
?:(=(0 pos.hit) ta-bel (ta-mov (dec pos.hit)))
==
::
++ ta-bel .(+> (se-blit %bel ~)) :: beep
++ ta-cat :: mass insert
|= [pos=@ud txt=(list ,@c)]
^- sole-edit
:- %mor
|- ^- (list sole-edit)
?~ txt ~
[[%ins pos i.txt] $(pos +(pos), txt t.txt)]
::
++ ta-cut :: mass delete
|= [pos=@ud num=@ud]
^- sole-edit
:- %mor
|-(?:(=(0 num) ~ [[%del pos] $(num (dec num))]))
::
++ ta-det :: send edit
|= ted=sole-edit
^+ +>
(ta-act %det [[his.ven.say.inp own.ven.say.inp] (sham buf.say.inp) ted])
::
++ ta-bac :: hear backspace
^+ .
?^ ris
?: =(~ str.u.ris)
ta-bel
.(str.u.ris (scag (dec (lent str.u.ris)) str.u.ris))
?: =(0 pos.inp)
.(+> (se-blit %bel ~))
=+ pre=(dec pos.inp)
(ta-hom(pos.inp pre) %del pre)
::
++ ta-ctl :: hear control
|= key=@c
^+ +>
?+ key ta-bel
%a +>(pos.inp 0)
%b (ta-aro %l)
%c ta-bel(ris ~)
%d ?: &(=(0 pos.inp) =(0 (lent buf.say.inp)))
+>(liv |)
ta-del
%e +>(pos.inp (lent buf.say.inp))
%f (ta-aro %r)
%g ta-bel(ris ~)
%k =+ len=(lent buf.say.inp)
?: =(pos.inp len)
ta-bel
%- ta-hom(kil `(slag pos.inp buf.say.inp))
(ta-cut pos.inp (sub len pos.inp))
%l +>(+> (se-blit %clr ~))
%n (ta-aro %d)
%p (ta-aro %u)
%r ?~ ris
+>(ris `[pos.hit ~])
?: =(0 pos.u.ris)
ta-bel
(ta-ser ~)
%t =+ len=(lent buf.say.inp)
?: |(=(0 pos.inp) (lth len 2))
ta-bel
=+ sop=?:(=(len pos.inp) (dec pos.inp) pos.inp)
=. pos.inp +(sop)
%- ta-hom
:~ %mor
[%del sop]
[%ins (dec sop) (snag sop buf.say.inp)]
==
%u ?: =(0 pos.inp)
ta-bel
%- ta-hom(pos.inp 0, kil `(scag pos.inp buf.say.inp))
(ta-cut 0 pos.inp)
%v ta-ant
%x ?: =(~ apt) ta-bel
?: mav ta-bel
+>(apt (welp (slag 1 apt) [(snag 0 apt) ~]))
%y ?~ kil ta-bel
%- ta-hom(pos.inp (add pos.inp (lent u.kil)))
(ta-cat pos.inp u.kil)
==
::
++ ta-cru :: hear crud
|= [lab=@tas tac=(list tank)]
=. +>+> (se-blit %out (tuba (trip lab)))
(ta-tan tac)
::
++ ta-del :: hear delete
^+ .
?: =((lent buf.say.inp) pos.inp)
.(+> (se-blit %bel ~))
(ta-hom %del pos.inp)
::
++ ta-erl :: hear local error
|= pos=@ud
ta-bel(pos.inp (min pos (lent buf.say.inp)))
::
++ ta-err :: hear remote error
|= pos=@ud
(ta-erl (~(transpose cs say.inp) pos))
::
++ ta-fec :: apply effect
|= fec=sole-effect
^+ +>
?- -.fec
%bel ta-bel
%blk +>
%clr +>(+> (se-blit fec))
%det (ta-got +.fec)
%err (ta-err +.fec)
%mor |- ^+ +>.^$
?~ p.fec +>.^$
$(p.fec t.p.fec, +>.^$ ^$(fec i.p.fec))
%nex ta-nex
%pro (ta-pro +.fec)
%tan (ta-tan p.fec)
%sag +>(+> (se-blit fec))
%sav +>(+> (se-blit fec))
%txt $(fec [%tan [%leaf p.fec]~])
==
::
++ ta-rap :: send %took
.(+> (se-send gyl %took [p.gyl ~[q.gyl]] her))
::
++ ta-dog :: change cursor
|= ted=sole-edit
%_ +>
pos.inp
=+ len=(lent buf.say.inp)
%+ min len
|- ^- @ud
?- -.ted
%del ?:((gth pos.inp p.ted) (dec pos.inp) pos.inp)
%ins ?:((lte pos.inp p.ted) +(pos.inp) pos.inp)
%mor |- ^- @ud
?~ p.ted pos.inp
$(p.ted t.p.ted, pos.inp ^$(ted i.p.ted))
%nop pos.inp
%set len
==
==
::
++ ta-got :: apply change
|= cal=sole-change
=^ ted say.inp (~(receive cs say.inp) cal)
(ta-dog ted)
::
++ ta-hom :: local edit
|= ted=sole-edit
^+ +>
=. +> (ta-det ted)
=. +> (ta-dog(say.inp (~(commit cs say.inp) ted)) ted)
+>
::
++ ta-met :: meta key
|= key=@c
~& [%ta-met key]
+>
::
++ ta-mov :: move in history
|= sop=@ud
^+ +>
?: =(sop pos.hit) +>
%+ %= ta-hom
pos.hit sop
lay.hit %+ ~(put by lay.hit)
pos.hit
buf.say.inp
==
%set
%- (bond |.((snag (sub num.hit +(sop)) old.hit)))
(~(get by lay.hit) sop)
::
++ ta-nex :: advance history
%_ .
num.hit +(num.hit)
pos.hit +(num.hit)
ris ~
lay.hit ~
old.hit [buf.say.inp old.hit]
==
::
++ ta-pro :: set prompt
|= pom=sole-prompt
+>(pom pom(cad :(welp (scow %p p.gyl) ":" (trip q.gyl) cad.pom)))
::
++ ta-ret :: hear return
?. mav
(ta-act %ret ~)
=+ txt=(tufa buf.say.inp)
=+ fey=(rose txt sp-ukase:sp)
?- -.fey
%| (ta-erl (lent (tuba (scag p.fey txt))))
%& ?~ p.fey
(ta-erl (lent buf.say.inp))
=. +>+> (se-like u.p.fey)
=. pom pom.tar.maz
(ta-hom:ta-nex %set ~)
==
::
++ ta-ser :: reverse search
|= ext=(list ,@c)
^+ +>
?: |(?=(~ ris) =(0 pos.u.ris)) ta-bel
=+ tot=(weld str.u.ris ext)
=+ dol=(slag (sub num.hit pos.u.ris) old.hit)
=+ sop=pos.u.ris
=+ ^= ser
=+ ^= beg
|= [a=(list ,@c) b=(list ,@c)] ^- ?
?~(a & ?~(b | &(=(i.a i.b) $(a t.a, b t.b))))
|= [a=(list ,@c) b=(list ,@c)] ^- ?
?~(a & ?~(b | |((beg a b) $(b t.b))))
=+ ^= sup
|- ^- (unit ,@ud)
?~ dol ~
?: (ser tot i.dol)
`sop
$(sop (dec sop), dol t.dol)
?~ sup ta-bel
(ta-mov(str.u.ris tot, pos.u.ris (dec u.sup)) (dec u.sup))
::
++ ta-tan :: print tanks
|= tac=(list tank)
=+ wol=`wall`(zing (turn tac |=(a=tank (~(win re a) [0 edg]))))
|- ^+ +>.^$
?~ wol +>.^$
$(wol t.wol, +>+>.^$ (se-blit %out (tuba i.wol)))
::
++ ta-txt :: hear text
|= txt=(list ,@c)
^+ +>
?^ ris
(ta-ser txt)
:: ~& ven.say.inp
%- ta-hom(pos.inp (add (lent txt) pos.inp))
:- %mor
|- ^- (list sole-edit)
?~ txt ~
[[%ins pos.inp i.txt] $(pos.inp +(pos.inp), txt t.txt)]
::
++ ta-vew :: computed prompt
|- ^- (pair ,@ud (list ,@c))
?^ ris
%= $
ris ~
cad.pom
:(welp "(reverse-i-search)'" (tufa str.u.ris) "': ")
==
=- [(add pos.inp (lent p.vew)) (weld (tuba p.vew) q.vew)]
^= vew ^- (pair tape (list ,@c))
?: vis.pom [cad.pom buf.say.inp]
:- %+ welp cad.pom
?~ buf.say.inp ~
"<{(scow %p (end 4 1 (sham buf.say.inp)))}> "
(turn buf.say.inp ,_`@c`'*')
--
--
++ peer
|= [ost=bone her=ship pax=path]
^- [(list move) _+>]
:: ~& [%sole-peer ost her pax]
?< (~(has by bin) ost)
:- [ost %give %rush %dill-blit %pro [`@c`0x23 `@c`0x20 ~]]~
%= +>
bin
%+ ~(put by bin) ost
^- source
:* 80
0
~
~
:* %&
*(unit search)
*history
`sole-prompt`[%& %sole "{(scow %p our.hid)}# "]
*sole-command
==
~
[0 ~]
==
==
::
++ poke-dill-belt
|= [ost=bone her=ship bet=dill-belt]
^- [(list move) _+>]
:: ~& [%sole-poke ost her bet]
=+ yog=(~(get by bin) ost)
?~ yog
~& [%sole-poke-stale ost]
[~ +>.$]
=< se-abet
=< se-view
(~(se-belt se [[ost %give %nice ~]~ ~] [her ost] u.yog) bet)
::
++ pour
|= [ost=bone pax=path sih=*]
^- [(list move) _+>]
=+ yog=(~(get by bin) ost)
?~ yog
~& [%sole-pour-stale ost pax]
[~ +>.$]
=+ sih=((hard sign) sih)
?> ?=([@ @ @ ~] pax)
=< se-abet
=< se-view
=+ gyl=[(slav %p i.t.pax) i.t.t.pax]
(~(se-pour se [~ ~] [(slav %p i.pax) ost] u.yog) gyl +.sih)
::
++ pull
|= ost=bone
^- [(list move) _+>]
:: ~& [%sole-pull ost]
=^ moz +>
=< se-abet
=< se-view
~(se-kill se [~ ~] [our.hid ost] (~(got by bin) ost))
[moz +>.$(bin (~(del by bin) ost))]
--

41
base/app/solid/core.hook
View File

@ -1,41 +0,0 @@
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke-solid-args
|= [ost=bone you=ship ~]
:_ +>.$
=+ top=`path`/(scot %p our.hid)/main/(scot %da lat.hid)/arvo
=+ pax=`path`(weld top `path`[%hoon ~])
~& %solid-start
=+ gen=(reck pax)
~& %solid-parsed
=+ ken=q:(~(mint ut %noun) %noun gen)
~& %solid-compiled
=+ ^= all
=+ all=.*(0 ken)
=+ ^= vay ^- (list ,[p=@tas q=@tas])
:~ [%$ %zuse]
[%g %gall]
[%f %ford]
[%a %ames]
[%c %clay]
[%d %dill]
[%e %eyre]
[%t %time]
==
|- ^+ all
?~ vay all
=+ pax=(weld top `path`[q.i.vay ~])
=+ txt=((hard ,@) .^(%cx (weld pax `path`[%hoon ~])))
=+ sam=[lat.hid `ovum`[[%gold ~] [%veer p.i.vay pax txt]]]
~& [%solid-veer i.vay]
=+ gat=.*(all .*(all [0 42]))
=+ nex=+:.*([-.gat [sam +>.gat]] -.gat)
$(vay t.vay, all nex)
:~ [ost %give %sage [%urbit %pill ~] [ken all]]
[ost %pass / %g %cide %$]
[ost %give %nice ~]
==
--

16
base/app/sync/core.hook
View File

@ -1,16 +0,0 @@
:: Desk sync
::
:::: /hook/core/sync/app
::
/+ sh-utils
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke--args
%+ gate-bang
|= [syd=@tas her=@p sud=@tas ~]
[%c %font our.hid syd her sud]
(print . "synced")
--

1897
base/app/talk/core.hook
View File

File diff suppressed because it is too large Load Diff

28
base/app/tease/core.hook
View File

@ -1,28 +0,0 @@
:: :: ::
:::: /hook/core/tease/app :: ::
:: :: ::
/? 314 :: zuse version
/- *console :: console structures
/+ console :: console library
!: :: ::
:::: :: ::
:: :: ::
|_ [hid=hide ~]
++ peer ,_`.
++ poke--args
|= [ost=bone you=ship ~]
~& %tease
:_ +>.$
:~ :* 0 %pass ~
%g %show
[our.hid /seat] our.hid
/
==
:* 0 %pass ~
%g %mess
[our.hid /seat] our.hid
%dill-belt
!>(`dill-belt`[%yow %helm])
==
==
--

306
base/app/terminal/core.hook
View File

@ -1,306 +0,0 @@
:: Terminal
::
:::: /hook/core/terminal/app
::
/? 314 :: need urbit 314
/- term-line, term-in, term-ctrl, kyev
::/= stat /:/%%/:/hymn/
::
:::: structures
::
|% ::
++ axle $: %1 ::
hiz=(map path term-line) ::
== ::
++ gilt ::
$% [%term-line p=term-line] ::
[%hymn p=manx] ::
== ::
++ gift ::
$% [%rush gilt] ::
[%init p=@p] ::
[%logo @] ::
[%mean p=ares] ::
[%nice ~] ::
[%sage p=path q=*] ::
[%verb ~] ::
[%veer p=@ta q=path r=@t] ::
[%vega p=path] ::
== ::
++ glas ?(%term %lines) ::
++ hapt ,[p=ship q=path] ::
++ mess ::
$% [%txt p=(hypo cord)] ::
[%kyev p=(hypo kyev)] ::
[%type p=(hypo ,?)] ::
== ::
++ move ,[p=bone q=(mold note gift)] ::
++ note ::
$% $: %g ::
$% [%cide p=span] ::
[%show p=hapt q=ship r=path] ::
[%sire p=term q=span] ::
[%mess p=hapt q=ship r=mess] ::
[%took p=hapt q=ship] ::
== == == ::
++ sign ::
$% $: %g ::
$% [%gone p=hapt] ::
[%init p=@p] ::
[%logo @] ::
[%mean p=ares] ::
[%nice ~] ::
[%rush p=%term-line q=term-line] ::
[%sage p=path q=*] ::
[%verb ~] ::
[%veer p=@ta q=path r=@t] ::
[%vega p=path] ::
== == ==
--
::
:::: from future import wick, pack, pick XX remove on breach or kelvin bump
::
|%
++ wick :: span format
|= a=@
^- (unit ,@ta)
=+ b=(rip 3 a)
=- ?^(b ~ (some (rap 3 (flop c))))
=| c=tape
|- ^- [b=tape c=tape]
?~ b [~ c]
?. =('~' i.b)
$(b t.b, c [i.b c])
?~ t.b [b ~]
?- i.t.b
%'~' $(b t.t.b, c ['~' c])
%'-' $(b t.t.b, c ['_' c])
@ [b ~]
==
::
++ pack :: light path encoding
|= [a=term b=path] ^- span
%+ rap 3 :- (wack a)
(turn b |=(c=span (cat 3 '_' (wack c))))
::
++ pick :: light path decoding
|= a=span ^- (unit ,[p=term q=path])
(rush a (most cab (sear wick urt:ab)))
--
!:
:::: helpers
::
|%
++ aut %shell
++ inject
|= [a=[i=mane t=(list mane)] b=marl]
|= man=manx
?. =(i.a n.g.man)
man
?~ t.a
man(c (weld c.man b))
man(c (turn c.man ^$(a t.a)))
::
++ start-shell
|= [our=ship imp=path ost=bone you=ship pax=path]
%- flop
^- (list move)
=+ auc=(pack aut pax)
:- [ost %pass [%fork pax] %g %sire [aut auc]]
[ost %pass [%resp pax] %g %show [our [auc imp]] you /out]~
--
!:
:::: per shell
::
|%
++ se
|= [hid=hide ost=bone you=ship hiz=(map path term-line) pax=path]
=+ tel=(fall (~(get by hiz) pax) *term-line)
=+ auc=(pack aut pax)
=^ mow tel
?: (~(has by cub.hid) auc)
[~ tel]
:- (start-shell our.hid imp.hid ost you pax)
tel(r :_(r.tel leaf/"+ {(trip aut)}"))
|%
++ abet
^- [(list move) (map path term-line)]
[(flop mow) (~(put by hiz) pax tel)]
::
++ page
;html
;head
;title: Not yet
==
;body;
==
:: %. stat
:: %+ inject
:: ~[%html %head]
:: ;= ;script: urb.appl = "{(trip app.hid)}"
:: ;script: urb.term = \{pax: "{(spud pax)}"}
:: ==
::
++ peer
|= gal=glas
%_ +>.$
mow
:_ mow
?- gal
%term [ost %give %rust %hymn page] :: hymn front end
%lines [ost %give %rust %term-line tel] :: term-line output
==
==
::
++ poke
|= jof=$%([%line p=cord] [%res p=span] [%cmd p=char] [%type p=?])
^+ +>
?- -.jof
%res :: restart shell
=. +>.$
?. (~(has by cub.hid) auc) +>.$
%_ +>.$
mow :_(mow [ost %pass [%fork pax] %g %cide auc])
r.tel :_(r.tel leaf/"- {(trip aut)}")
==
%_ +>.$
r.tel :_(r.tel leaf/"+ {(trip auc)}")
mow
;: welp
(start-shell our.hid imp.hid ost you pax)
[ost %give %nice ~]~
(spam tel)
mow
==
==
::
%line :: command entered
=+ new=stem/[lat.hid leaf/(trip p.p.tel) leaf/(trip p.jof)]
=. r.tel
:_ r.tel
stem/[lat.hid leaf/(trip p.p.tel) leaf/(trip p.jof)]
=. +>.$ (send %txt -:!>(*cord) p.jof)
+>.$(mow (welp (spam p.tel q.tel new ~) mow))
::
%cmd :: key command
?+ p.jof
(send %kyev -:!>(*kyev) [[%ctrl ~ ~] p.jof])
%r $(jof [%res 'shell'])
==
::
%type
(send %type -:!>(*?) p.jof)
==
::
++ poke-ctrl
.(mow :_(mow [ost %give %rush %term-line [p q ~]:tel]))
::
++ pour
|= [dis=?(%fork %resp %txt %kyev %type) sih=sign]
^+ +>
?- dis
%fork ?>(?=(%gone +<.sih) +>.$) :: XX maybe mean?
%resp
?+ +<.sih !!
%nice +>.$
%rush
:: ~? !=(p.tel p.q.sih) prompt/[p.q.sih ?=(~ q.q.sih)]
=. p.q.sih ?^(q.q.sih p.tel p.q.sih) :: XX prompt hack
%_ +>.$
mow :- [ost %pass [%resp pax] %g %took [our.hid [auc imp.hid]] you]
(welp (spam q.sih) mow)
tel [p.q.sih (weld q.q.sih q.tel) (weld r.q.sih r.tel)]
==
==
::
?(%txt %kyev %type)
?+ +<.sih !!
%nice +>.$(mow :_(mow [ost %give +.sih]))
%mean
=+ ^= new
=- (turn - |=(a=tank rose/[~ "! " ~]^[a]~))
%- flop ^- tang
?~ p.sih ~
[leaf/(trip p.u.p.sih) q.u.p.sih]
%_ +>.$
r.tel (welp new r.tel)
mow
%- welp :_ mow
[[ost %give +.sih] (spam [p.tel q.tel new])]
==
==
==
::
++ send
|= mez=mess
%_ +>.$
mow
%- welp :_ mow
^- (list move)
%+ murn (~(tap by cub.hid))
|= [p=span q=term]
?. =(p auc) ~
%- some ^- move
:^ ost %pass [-.mez pax]
[%g %mess [our.hid p imp.hid] you mez]
==
::
++ spam
|= tol=term-line
^- (list move)
%+ murn
(~(tap by sup.hid))
|= [ost=bone @ paf=path]
?: =([%lines pax] paf)
(some ost %give %rush %term-line tol)
~
--
--
!:
:::: formal interface
::
|_ [hid=hide axle]
++ peer
|= [ost=bone you=ship pax=path]
^- [(list move) _+>]
?~ pax
$(pax /term)
?. ?=(glas i.pax)
[[ost %give %mean ~ %bad-path ~]~ +>.$]
=+ abet:(peer:(se hid ost you hiz t.pax) i.pax)
[-< +>.$(hiz ->)]
::
++ poke-term-in
|= [ost=bone you=ship term-in]
^- [(list move) _+>]
=+ abet:(poke:(se hid ost you hiz pax) jof)
[-< +>.$(hiz ->)]
::
++ poke-term-ctrl
|= [ost=bone you=ship col=term-ctrl]
^- [(list move) _+>]
=+ abet:poke-ctrl:(se hid ost you hiz /)
[-< +>.$(hiz ->)]
::
++ pour
|= [ost=bone pax=path sih=*]
^- [(list move) _+>]
=+ sih=~|([%term-pour (,[term term ~] sih)] ((hard sign) sih))
?: ?=(?(%sage %init %logo %verb %veer %vega) &2.sih) :: vomit
[[ost %give +.sih]~ +>.$]
?~ pax !!
?. ?=(?(%fork %resp %txt %kyev %type) i.pax) !!
=+ abet:(pour:(se hid ost our.hid hiz t.pax) i.pax sih)
[-< +>.$(hiz ->)]
::
++ prep
|= old=(unit (unit axle))
^- [(list move) _+>]
:- ~
%_ +>.$
hiz
?. ?=([~ ~ *] old) hiz
%- ~(run by hiz.u.u.old)
|=(term-line [p q ~])
==
--

33
base/app/terminal/hymn.hook
View File

@ -1,33 +0,0 @@
:: Terminal page
::
::::
::
/? 314
/= styl /:/%/style:/psal/
/= jass /:/%/script:/psal/
::
:::: ~talsur-todres
::
^- manx
;html
;head
;title: Hi
;script: window.urb = window.urb || \{};
;script@"/~/at/base/lib/urb.js";
;script@"//cdnjs.cloudflare.com/ajax/libs/jquery/2.1.1/jquery.min.js";
;script@"//cdnjs.cloudflare.com/ajax/libs/mousetrap/1.4.6/mousetrap.js";
;script@"//use.typekit.net/fkv0sjk.js";
;script:'try{Typekit.load();}catch(e){}'
:: ;script: urb.appl = "terminal"; urb.term = \{pax: "/"}
;+ styl
==
;body
;pre#cont;
;span#prem:">"
;div#prom-cont
;textarea.mousetrap#prom(wrap "off");
;div#prom-size;
==
;+ jass
==
==

104
base/app/terminal/hymn/script.js
View File

@ -1,104 +0,0 @@
urb.appl = urb.appl ||
window.location.pathname.match(/.*?app\/([a-z0-9-]+)/)[1]
urb.term = urb.term ||
{pax: location.pathname.replace(new RegExp(".*?app/"+urb.appl),'') || '/'}
function jpok(a,b){
var dat = {pax:urb.term.pax, act:{}}
dat.act[a] = b
urb.send({data:dat,mark:"term-in"}, function(e,dat){
if(a === 'line' && dat.data.err){
hist.unshift(prom.val())
prom.val(b)
hind = 0
}
})
}
var prom, prom_size, hist, hind, size, focus, pos, pax
$(function() {
prom = $("#prom")
prom_size = $("#prom-size")
hist = []
hind = 0
var keys = ['l', 'x', 'r']
var mod = /Mac|iPod|iPhone|iPad/.test(navigator.platform) ? 'ctrl' : 'alt'
for (i in keys) (function(k){
Mousetrap.bind(mod + '+' + k, function(){
jpok('cmd', k)
})
})(keys[i])
prom.keydown(function(e){
switch(e.which){
default: return true
break;
case 13: // %retn
if(e.shiftKey) return true
v = prom.val().replace(/\xa0/g, ' ')
$(cont).append($('<b>').html(prem.innerHTML),
$('<div class="prom">').text(v))
jpok('line', v)
hist.unshift(v)
prom.val('')
return false
break;
case 38: // %up
if(hind == hist.length) return true
if(pos().top === false) return true
prom.val([hist[hind], hist[hind] = prom.val()][0]) // swap
size()
hind++
return false
break;
case 40: // %down
if(hind == 0) return true
if(pos().bot === false) return true
size()
hind--
prom.val([hist[hind], hist[hind] = prom.val()][0]) // swap
return false
}
})
focus = function() { $(prom).focus(); }
$('body').on('click', focus)
focus()
size = function() {
prom_size.html(prom.val()+"<br />")
}
size()
prom.on('input propertychange', size)
pos = function() {
v = prom.val()
_top = v.slice(0,prom[0].selectionStart).indexOf("\n") === -1
_bot = v.slice(prom[0].selectionStart).indexOf("\n") === -1
return {top:_top,bot:_bot}
}
pax = '/lines'
if(urb.term.pax != "/") pax += urb.term.pax
urb.subscribe({path: pax}, function(e, dat){
if(dat.data.ok) return;
hist = dat.data.history.concat(hist)
hind = 0
// cont.innerHTML = ''
for(var i in dat.data.lines){
var lom = dat.data.lines[i]
if(typeof lom == 'string')
$(cont).append($('<div>').text(lom))
else {
$(cont).append($('<b>').text(lom.prompt),
$('<div class="prom">').text(lom.task))
}
}
window.scrollTo(0,document.body.scrollHeight)
prem.textContent = dat.data.prompt
})
});

54
base/app/terminal/hymn/style.css
View File

@ -1,54 +0,0 @@
html {
font-size: 14px;
}
body {
margin: 2rem;
line-height: 1.4rem;
}
body,
span,
pre,
textarea,
input {
font-family: 'source-code-pro', monospace;
font-size: 1rem;
background-color: #000;
color: #fff;
}
button {
border: none;
font-family: "Helvetica Neue", Helvetica, Arial, sans-serif;
font-weight: 600;
font-size: .8rem;
text-transform: uppercase;
letter-spacing: 1px;
color: #000;
background-color: #fff;
padding: 1rem;
}
#prom-cont,
.prom {
display: block;
position:relative;
left: 1rem;
}
textarea,
#prom-size {
min-height: 24px;
box-sizing: border-box;
overflow: hidden;
width: 100%;
}
textarea {
height: 100%;
border: 0;
outline: none;
position: absolute;
resize: none;
}
#prom-size {
visibility: hidden;
white-space: pre-wrap;
word-wrap: break-word;
overflow-wrap: break-word;
}

73
base/app/test/app.js
View File

@ -1,73 +0,0 @@
$(function() {
$tests = $("#tests")
runtest = function(name) {
test = $(name)
test.attr('disabled', true)
test.addClass('disabled')
window.urb.send({
appl:"test",
data:{test:name}
}, function(err,res) {
test.attr('disabled', false)
test.removeClass('disabled')
_test = {
name: name,
result: res.data
}
console.log('set it')
console.log(_test)
$tests.prepend(renderTest(_test))
})
}
renderTest = function(test) {
css = "test"
if(test.pending == true)
css += " pending"
$_test = $("<div class='"+css+"' id="+test.name+" onclick='runtest(\""+test.name+"\")'></div>")
$_test.append("<div class='name'>"+test.name+"</div>")
$_test.append("<div class='result'>"+JSON.stringify(test.result)+"</div>")
return $_test
}
renderTests = function(testlist) {
console.log("renderTests: "+testlist)
$tests.html("")
for(i in testlist) {
$tests.append(renderTest(testlist[i]))
}
}
renderError = function(error) {
$tests.html("<div class='error'>Sorry! There was an error fetching from Test: "+error+"</div>")
}
window.urb.subscribe({
appl:"test",
path:"/tests"
}, function(err,res) {
console.log('subscr')
console.log(arguments)
if (res.data.ok)
return
if(err)
renderTests(err)
else
{
if(res.data) {
if(res.data) {
renderTests(res.data)
}
else
{
renderTests("unknown error")
}
}
}
})
})

334
base/app/test/core.hook
View File

@ -1,334 +0,0 @@
:: Test suite
::
:: runnable from unix with command:
:: curl http://localhost:8080/gog/test/all-tests
::
:::: /hook/core/test/app
::
/? 314 :: need urbit 314
:: /= front /:/%%/front:/hymn/ :: load front page
::
:::: structures
::
|% :: structures
++ axle ,[%0 tests=(map term test)] :: application state
++ gilt :: subscription frame
$% [%json p=json] :: json data
[%html p=@t] :: html text
[%hymn p=manx] :: html tree
[%mime p=mite q=octs] :: mime data
== ::
++ gift :: output action
$% [%rust gilt] :: total update
[%mean p=ares] :: message failure
[%nice ~] :: succeed
== ::
++ hapt ,[p=ship q=path] :: see %gall
++ move ,[p=bone q=(mold note gift)] :: output operation
++ result :: test result
$% [%mean p=ares] :: failure
[%nice ~] :: success
== ::
++ note :: system request
$% $: %g :: to %gall
$% [%mess p=hapt q=ship r=cage] ::
[%cide p=span] ::
[%show p=hapt q=ship r=path] ::
[%sire p=term q=span] ::
== == == ::
++ test :: test template
$_ ^? |% ::
++ poke |+([bone ship] [*(list move) +>]) :: start test
++ pour |+([bone path *] [*(list move) +>]) :: system response
-- ::
-- ::
!:
:::: program
::
|_ $: hid=hide :: system state
axle :: custom state
==
++ et :: tests
|%
++ tests-json
%- jobe
%+ turn (~(tap by tests))
|= [nam=@t tes=test]
:- nam
%- jobe
^- (list ,[@t json])
~[[%name %s nam] [%result %s %untested]]
++ succeed
^- test
|%
++ poke
|+ [ost=bone you=ship]
^- [(list move) _+>]
[[ost %give %nice ~]~ +>.$]
++ pour
|+ [ost=bone pax=path sih=*]
^- [(list move) _+>]
!!
--
++ cede
^- test
=> |%
++ sign
$% $: %g
$% [%nice ~]
[%gone p=hapt]
== == ==
--
=| cnt=?
|%
++ poke
|+ [ost=bone you=ship]
^- [(list move) _+>]
~& [%cede-poke cub.hid sup.hid our.hid]
:_ +>.$(cnt !cnt)
?: cnt
:~
[ost %pass /cede/sire %g %sire %test-cede %babe]
:* ost %pass /cede/poke %g
%mess [our.hid babe/imp.hid] you
%json !>(~)
==
==
[ost %give %nice ~]~
++ pour
|+ [ost=bone pax=path sih=*]
^- [(list move) _+>]
~& [%cede-pour pax]
?+ -.pax `+>
%sire
~& %child-dead
:_ +>.$ :_ ~
[ost %give %nice ~]
==
--
++ cide
^- test
=> |%
++ sign
$% $: %g
$% [%nice ~]
[%rust %hymn p=manx]
== == ==
--
|%
++ poke
|+ [ost=bone you=ship]
^- [(list move) _+>]
~& [%cide-poke cub.hid sup.hid our.hid]
:_ +>.$
:~
[ost %pass /cide/hi %g %cide %baby]
[ost %give %nice ~]
==
++ pour
|+ [ost=bone pax=path sih=*]
^- [(list move) _+>]
!!
--
++ sire
^- test
=> |%
++ sign
$% $: %g
$% [%nice ~]
[%rust %hymn p=manx]
[%gone p=hapt]
== == ==
--
|%
++ poke
|+ [ost=bone you=ship]
^- [(list move) _+>]
:_ +>.$
:~
[ost %pass /sire/hi %g %sire %test-cede %baby]
[ost %give %nice ~]
:: [ost %pass /sire/ho %g %mess our.hid^baby/imp.hid you %json !>(*json)]
:: [ost %pass /sire/ho %g %show our.hid^baby/imp.hid you /]
==
++ pour
|+ [ost=bone pax=path sih=*]
^- [(list move) _+>]
=+ sih=((hard sign) sih)
:_ +>.$
[ost %give %nice ~]~
--
++ poke-local
^- test
=> |%
++ sign ,[%g result]
--
|%
++ poke
|+ [ost=bone you=ship]
^- [(list move) _+>]
:_ +>.$ :_ ~
:* ost %pass /poke-local %g
%mess [our.hid %test ~] you %json
!> (joba %test %s %bad-test-name)
==
++ pour
|+ [ost=bone pax=path sih=*]
^- [(list move) _+>]
:_ +>.$
=+ sih=((soft sign) sih)
:_ ~ :+ ost %give
?~ sih [%mean ~ %poke-local-pour-bad-sign ~]
?- +<.u.sih
%nice [%mean ~ %poke-local-pour-unexpected-nice ~]
%mean
?: ?=([~ %bad-test ~] p.u.sih)
[%nice ~]
[%mean ~ %poke-local-pour-unexpected-mean ~]
==
--
++ ze
^- test
|%
++ poke
|+ [ost=bone you=ship]
^- [(list move) _+>]
:_ +>.$ :_ ~
=+ ^= zez
%+ ~(edit ^ze lat.hid *dome *rang)
lat.hid
[%& [0v0 0v0] [/hello %ins 'hello, world']~]
=+ `[l=@da d=dome r=rang]`+<.zez
?: .= lat.r
:_ [~ ~]
[p=1.292.805.149 q=[%direct p=1.292.805.149 q='hello, world' r=%c]]
[ost %give %nice ~]
[ost %give %mean ~ %bad-rang ~[leaf/<d> leaf/<r>]]
++ pour
|+ [ost=bone pax=path sih=*]
^- [(list move) _+>]
!!
--
++ all-tests
^- test
=> |%
++ sign ,[%g result]
++ sult
$? result
[%pending ~]
==
--
=| results=(map ,@t sult)
|%
++ poke
|+ [ost=bone you=ship]
^- [(list move) _+>]
=. results
%- mo
%+ turn (~(tap by tests))
|= [nam=@t tes=test]
[nam %pending ~]
:_ +>.$
%+ turn (~(tap by tests))
|= [nam=@t tes=test]
:* ost %pass /all-tests/[nam] %g
%mess [our.hid %test ~] you %json
!> (joba %test %s nam)
==
++ pour
|+ [ost=bone pax=path sih=*]
^- [(list move) _+>]
=+ sih=((hard sign) sih)
?. ?=([@ ~] pax) ~& [%all-tests-strange-path pax] [~ +>.$]
=. results (~(put by results) -.pax +.sih)
:_ +>.$
?: (~(any by results) |=([res=sult] ?=(%pending -.res)))
~
:_ ~
?: (~(all by results) |=([res=sult] ?=(%nice -.res)))
[ost %give %nice ~]
:^ ost %give %mean
:+ ~ %failed-tests
%- zing
%+ turn
(skim (~(tap by results)) |=([nam=@t res=sult] ?=(%mean -.res)))
|= [nam=@t res=sult]
?> ?=(%mean -.res)
^- (list tank)
:_ ?~ p.res ~ q.u.p.res
:- %leaf
%+ weld "test %{(trip nam)} failed with "
?~ p.res "no error message"
%+ weld "error code %{(trip p.u.p.res)} and "
?~ q.u.p.res "no error info"
"the following error info:"
--
--
++ spec-pour
|= [ost=bone pax=path sih=*]
^- [(list move) _+>]
=+ sih=((hard ,[%g result]) sih)
:_ +>.$ :_ ~
[ost %give %rust %mime /text/plain (taco (cat 3 (crip <sih>) 10))]
++ prep
|= old=(unit (unit axle))
^- [(list move) _+>]
:- ~
%= +>.$
tests
?~ old
~& %prep-sig tests
?^ u.old
~& %prep-no-sig tests.u.u.old
=. tests
%- mo
^- (list ,[@t test])
=> et
:~ [%succeed succeed]
[%sire sire]
[%cide cide]
[%cede cede]
[%ze ze]
[%poke-local poke-local]
==
(~(put by tests) %all-tests all-tests:et)
==
++ peer :: accept subscriber
|= [ost=bone you=ship pax=path]
^- [(list move) _+>]
~& [%test-peer hid]
?~ pax !! ::[[ost %give %rust %hymn front]~ +>.$]
?: ?=(%tests -.pax)
[[ost %give %rust %json tests-json:et]~ +>.$]
:_ +>.$ :_ ~
:* ost %pass /automagic %g
%mess [our.hid %test ~] you %json
!> (joba %test %s -.pax)
==
++ poke-json :: browser message
|= [ost=bone you=ship jon=json]
^- [(list move) _+>]
~& [%test-poke hid you]
=+ tes=((of [%test so] ~):jo jon)
?~ tes [[ost %give %mean ~ %strange-json ~]~ +>.$]
=+ tst=(~(get by tests) +.u.tes)
?~ tst
[[ost %give %mean ~ %bad-test leaf/<+.u.tes> ~]~ +>.$]
~& [%running-test +.u.tes]
=+ res=(poke:u.tst ost you)
:- -.res
+>.$(tests (~(put by tests) +.u.tes +.res))
++ pour :: response
|= [ost=bone pax=path sih=*]
^- [(list move) _+>]
~& [%test-pour ost pax -.sih +<.sih]
?~ pax ~& %test-strange-path [~ +>.$]
?: ?=(%automagic -.pax)
(spec-pour ost pax sih)
=+ tst=(~(get by tests) -.pax)
?~ tst
~& [%test-bad-path pax] [~ +>.$]
=+ res=(pour:u.tst ost +.pax sih)
:- -.res
+>.$(tests (~(put by tests) -.pax +.res))
--

31
base/app/test/front/hymn.hook
View File

@ -1,31 +0,0 @@
:: Front page of the twitter app.
::
:::: /hook/hymn/front/twit/app
::
/? 314 :: need urbit 314
/= urbit /:/===lib/urb:/hymn/ :: urbit library (js)
/= style /:/%%%/style:/hymn/ :: stylesheet (css)
/= application /:/%%%/app:/hymn/ :: application (js)
!:
:::: content
::
^- manx
=- ~! - -
;html
;head
;title: Tests
;+ style
;script
=type "text/javascript"
=src "//cdnjs.cloudflare.com/ajax/libs/jquery/2.1.1/jquery.min.js"
;
==
==
;body
;div#tests
;p: Fetching tests...
==
;+ urbit
;+ application
==
==

82
base/app/test/style.css
View File

@ -1,82 +0,0 @@
body,
textarea,
input {
font-family: "Helvetica Neue", Helvetica, Arial, sans-serif;
font-weight: 400;
}
body {
margin-top: 4rem;
font-size: 18px;
}
.test,
.name,
.result {
width: 32rem;
}
textarea {
border: 0;
height: 8rem;
line-height: 1.5rem;
margin-bottom: .3rem;
resize: none;
padding: 1rem 1px;
background-color: #f7f7f7;
}
.name {
border: 0;
color: #333;
letter-spacing: 0.01rem;
}
.name {
background-color: transparent;
border: 2px solid #5DE668;
color: #5DE668;
padding: .3rem 1rem;
font-weight: 500;
cursor: pointer;
}
.name {
background-color: #5DE668;
color: #fff;
}
.disabled {
opacity: .6;
}
.text {
word-wrap:break-word;
margin-bottom: .3rem;
line-height: 1.6rem;
}
#twet {
margin-bottom: 3rem;
border-bottom: 2px solid #464646;
padding-bottom: 2rem;
}
#twet,
.tweet {
border-bottom: 1px solid #eee;
}
.tweet {
margin-bottom: 2rem;
padding-bottom: 1rem;
}
.pending {
opacity: .3;
}
.error {
color: #FF5F5F;
letter-spacing: .06rem;
}

24
base/app/ticket/core.hook
View File

@ -1,24 +0,0 @@
/+ sh-utils
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke-ticket-args
%+ args-into-gate .
|= [her=@p num=?(~ [p=@ud ~])]
=+ n=?~(num 1 p.num)
=+ ^= sep ^- @
=+ mir=(clan her)
?+ mir ~|(%ticket-clan !!)
%king (bex 8)
%duke (bex 16)
%earl (bex 32)
==
:- %tang
|- ^- tang
?: ?=(0 n) ~
=+ tic=/(scot %p our.hid)/tick/(scot %da lat.hid)/(scot %p her)
:- leaf/"{<her>}: {<(,@p .^(%a tic))>}"
$(her (add sep her), n (dec n))
--

11
base/app/time/core.hook
View File

@ -1,11 +0,0 @@
:: Time an operation, usage :time foo, |time :foo
::
:::: /hook/core/time/app
::
/+ sh-utils
|_ [hide ~]
++ peer ,_`.
++ poke--args (add-resp [%pass /(scot %da lat) %t %wait lat] ,_`.)
++ pour |=([@ a=path *] %.(+< (args-into-gate +> ,_(resu a))))
++ resu |=(a=path tang/[>`@dr`(sub lat (slav %da -.a))<]~)
--

26
base/app/tree/core.hook
View File

@ -1,26 +0,0 @@
:: Tree view recursive directory contents
::
:::: /hook/core/tree/app
::
/+ sh-utils
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke--args
%+ args-into-gate .
|= [pax=path fla=$|(~ [%full ~])]
=+ len=(lent pax)
=+ rend=?^(fla dank:ut |=(a=path (dank:ut (slag len a))))
:- %tang
|- ^- tang
=+ ark=;;(arch .^(cy/pax))
=- ?~ q.ark -
[(rend pax) -]
%- zing
%+ turn
(sort (~(tap by r.ark)) aor)
|= [a=@t ~]
^$(pax (welp pax /[a]))
--

13
base/app/tweet/core.hook
View File

@ -1,13 +0,0 @@
/+ sh-utils
!:
|_ [hide ~]
++ peer ,_`.
++ poke--args
%+ add-subs [[our /twit] our /post/(scot %uv eny)]
%^ gate-mess .
|=([a=span b=cord ~] [/twit %twit-do !>([a %post eny b])])
,_`.
++ posh-twit-stat
(args-into-gate . |=([@ @ a=@da @] tang/~[leaf/"Tweet recieved {<a>}"]))
++ pour |*([ost=@ * sih=[@ ^]] :_(+>.$ [ost %give +.sih]~))
--

217
base/app/twit/core.hook
View File

@ -1,217 +0,0 @@
:: Twitter daemon
::
:::: /hook/core/twit/app
::
/- *twitter
/+ twitter
::
:::: ~fyr
::
|%
++ twit-path :: valid peer path
$% :: [%home ~] :: home timeline
[%user p=@t ~] :: user's tweets
[%post p=@ta ~] :: status of status
==
::
++ axle :: app state
$: %0
kes=(map span keys:twit-do) :: auth
out=(map ,@uvI (each ,[span cord] stat)) :: sent tweets
ran=(map path ,[p=@ud q=@da]) :: polls active
fed=(jar path stat) :: feed cache
==
::
++ gift :: app response
$% [%nice ~] :: acknowledgement
[%mean p=ares] :: error/termination
[%rush p=gilt] :: subscription data
==
::
++ gilt
$% [%twit-feed p=(list stat)] :: posts in feed
[%twit-stat p=stat] :: tweet accepted
==
::
++ move ,[bone (mold note gift)]
++ note :: arvo request
$% [%e %them ~ u=hiss] :: HTTP request
[%t %wait p=@da] :: timeout
==
::
++ sign :: arvo response
$% [%e %thou p=httr] :: HTTP result
[%t %wake ~] :: timeout ping
==
::
++ stat twit-stat :: recieved tweet
--
!:
::::
::
|_ [hide axle]
++ any-auth ?~(kes (auth) (auth p.n.kes)) :: use any keys
++ auth :: build API door
|= a=span
~| [%no-auth a]
~(. twit (~(got by kes) a) lat `@`eny)
::
++ cull :: remove seen tweets
|= [pax=path rep=(list stat)] ^+ rep
=+ pev=(sa (turn (~(get ja fed) pax) |=(stat id)))
(skip rep |=(stat (~(has in pev) id)))
::
++ dely :: next polling timeout
|= pax=path
^- [(unit time) _ran]
=+ cur=(~(get by ran) pax)
=+ tym=(add lat (mul ~s8 (bex ?~(cur 0 p.u.cur))))
:: ~& dely/`@dr`(sub tym lat)
?: &(?=(^ cur) (gte tym q.u.cur) (gth q.u.cur lat))
[~ ran]
[`tym (~(put by ran) pax ?~(cur 0 (min 5 +(p.u.cur))) tym)]
::
++ wait :: ensure poll by path
|= [ost=bone pax=path mof=(list move)]
=^ tym ran (dely pax)
:_ +>.$
?~ tym
:: ~& no-wait/ran
mof
:: ~& will-wait/u.tym
:- [ost %pass pax %t %wait u.tym]
mof
::
++ poke-twit-do :: recieve request
|= [ost=bone @ act=twit-do]
^+ [*(list move) +>]
?- -.q.act
%auth
:: ~& twit-auth/p.act
=. kes (~(put by kes) p.act p.q.act)
:_(+>.$ [ost %give %nice ~]~) :: XX verify key
%post
=: out (~(put by out) p.q.act %& p.act q.q.act)
ran (~(del by ran) /peer/home)
==
%^ wait ost /peer/home
:- [ost %give %nice ~]
=+ mez=(stat-upda:(auth p.act) [%status q.q.act]~ ~)
[ost %pass /post/(scot %uv p.q.act) %e %them ~ mez]~
==
::
++ pour :: recieve response
|= [ost=bone pax=path sig=sign]
^+ [*(list move) +>]
?- &2.sig
%wake
~& wake/[pax sig]
:_ +>.$
?. (~(has by ran) pax) :: ignore if retracted
~
?+ pax ~|([%wake-missed pax] !!)
[%peer *]
?~ (~(get ju pus) t.pax)
~
~& peer-again/[t.pax ran]
(pear | ost our t.pax)
==
%thou
?+ p.p.sig ~|([%unknown-code p.p.sig] !!)
429 :: Rate-limit
=. ran (~(put by ran) pax 6 lat)
=+ lim=%.(%x-rate-limit-reset ;~(biff ~(get by (mo q.p.sig)) poja ni:jo))
=+ tym=?~(lim (add ~m7.s30 lat) (add ~1970.1.1 (mul ~s1 u.lim)))
~& retrying-in/`@dr`(sub tym lat)
:_(+>.$ [ost %pass pax %t %wait tym]~)
200 :: OK
=+ jon=(need (poja q:(need r.p.sig)))
:: ~& twit-resp/%.(jon ?+(-.jon !! %o stat:twir, %a (ar:jo stat:twir)))
?+ pax ~|([%http-missed pax] !!)
[%post @ ~] :: post acknowledged
=+ ^= rep
~| [%bad-post jon]
(need %.(jon stat:twir))
=. out (~(put by out) (slav %uv i.t.pax) %| rep)
:_ +>.$
(weld (spam pax %rush %twit-stat rep) (spam pax %mean ~))
[%peer *] :: feed data
=+ ^= rep
~| [%bad-feed jon]
(need %.(jon (ar:jo stat:twir)))
:: ~& got-feed/[(scag 5 (turn rep |=(stat id))) fed]
=+ ren=(cull t.pax rep) :: new messages
?~ ren
(wait ost pax ~) :: pump polling
~& spam-feed/ren
=: ran (~(del by ran) pax) :: clear poll delay
fed (~(put by fed) t.pax rep) :: saw last message
==
(wait ost pax (spam t.pax %rush twit-feed/(flop ren)))
==
?(400 401 403 404) :: Err
=+ ^- git=gift
=+ err=%.(q:(need r.p.sig) ;~(biff poja mean:twir))
:^ %mean ~ %bad-http
[leaf/"HTTP Code {<p.p.sig>}" (turn (need err) mean:twip)]
?+ pax [[ost %give git]~ +>.$]
[%post @ ~]
[(spam pax git) +>.$]
== ==
==
::
++ peer :: accept subscription
|= [ost=bone ship path]
^+ [*(list move) +>]
:_(+> [[ost %give %nice ~] (pear & +<)])
::
++ pear :: poll, possibly returning current data
|= [ver=? ost=bone @ pax=path]
^- (list move)
?. ?=(twit-path pax)
~|([%missed-path pax] !!)
=> .(pax `twit-path`pax)
?: ?=(%post -.pax)
?. ver ~
=+ sta=(~(get by out) (slav %uv p.pax))
?. ?=([~ %| ^] sta) :: post not received
~
:- [ost %give %rush %twit-stat p.u.sta]
[ost %give %mean ~]~ :: subscription end
=+ ole=(~(get ja fed) pax)
:_ ?. ver ~
?~ ole ~
[ost %give %rush %twit-feed (flop ole)]~
=- [ost %pass [%peer pax] %e %them ~ `hiss`-]
=+ opt=?~(ole ~ ['since_id' (lutt:twit id.i.ole)]~)
=+ aut=any-auth
?- -.pax
%user (stat-user:aut [(to-sd p.pax)]~ opt)
:: %home (stat-home:auth ~ opt)
==
::
++ to-sd :: parse user name/numb
|= a=span ^- sd:twit
~| [%not-user a]
%+ rash a
;~(pose (stag %user-id dem) (stag %screen-name user:twir))
::
++ pull :: release subscription
|= ost=bone
?. (~(has by sup) ost) `+>.$ :: XX should not occur
=+ [his pax]=(~(got by sup) ost)
?: (lth 1 ~(wyt in (~(get ju pus) pax)))
`+>.$
=: ran (~(del by ran) [%peer pax])
fed (~(del by fed) pax)
==
`+>.$
::
++ spam :: send by path
|= [a=path b=gift] ^- (list move)
%+ murn (~(tap by sup))
|= [ost=bone @ pax=path]
^- (unit move)
?. =(pax a) ~
[~ [ost %give b]]
--

4
base/app/twit/hoontap-keys.hoon
View File

@ -1,4 +0,0 @@
:- :- 'AP3G1t8ki6rPzeeAqdWCTw03F'
'VV784LPwZSaAxtF16RWWTnST4F85BHN8VqQKNyv7MprCkA0xZD'
:- '2821727326-RZGXSeTn7hCFQfJqR0ViivM3YYpu2O1M71gelBl'
'jW9VygFPOTsEK0WmrJDHYSoEnofOPdCE1oQRzueemVTl8'

34
base/app/twitter-auth/core.hook
View File

@ -1,34 +0,0 @@
:: Input twitter keys
/+ sh-utils
!:
|_ [hide vat=wain]
++ prompts
^- wain
:~ 'User: '
'App token: '
'App secret: '
'User token: '
'User secret: '
''
==
++ peek ,_prompt/[(snag (lent vat) prompts) %text '']
++ posh-txt
|= [@ * p=cord]
=. vat [p vat]
?. =(5 (lent vat)) `+>.$
%.(+< (add-exit ,_`+>.$))
::
++ part
=. vat (flop vat) :: put into order of entry
?. ?=([@ @ @ @ @ ~] vat)
~|([%keys-missing vat] !!)
=+ =< aut=[acc %auth [ctok csec] atok asec]
`[acc=span ctok=cord csec=cord atok=cord asec=cord ~]`vat
|= ost=bone
:_ ~
:^ ost %pass /out
[%g %mess serv our %twit-do !>(aut)]
::
++ poke--args (listen-in . (add-nice ,_`.))
++ serv [our /twit]
--

5
base/app/twitter-auth/hoontap-keys.txt
View File

@ -1,5 +0,0 @@
hoontap
AP3G1t8ki6rPzeeAqdWCTw03F
VV784LPwZSaAxtF16RWWTnST4F85BHN8VqQKNyv7MprCkA0xZD
2821727326-RZGXSeTn7hCFQfJqR0ViivM3YYpu2O1M71gelBl
jW9VygFPOTsEK0WmrJDHYSoEnofOPdCE1oQRzueemVTl8

22
base/app/twitter-feed/core.hook
View File

@ -1,22 +0,0 @@
:: Display twitter feed
::
:::: /hook/core/twitter-feed/app
::
/+ sh-utils
!:
::
:::: ~fyr
::
|_ [hide ~]
++ stat ,[id=@u who=@ta now=@da txt=@t]
++ rens
|=(stat rose/[": " `~]^~[leaf/"{<now>} @{(trip who)}" leaf/(trip txt)])
++ peer ,_`.
++ poke--args
|= [ost=bone his=ship who=span ~]
%.(+< (add-subs [[our /twit] our /user/[who]] ,_`+>.$))
::
++ posh-twit-feed
(args-into-gate . |=(a=(list stat) tang/(turn a rens)))
:: ++ pour |*([ost=@ * sih=[@ ^]] :_(+>.$ [ost %give +.sih]~))
--

19
base/app/type/core.hook
View File

@ -1,19 +0,0 @@
:: Type, render tpyes of arguments
::
:::: /hook/core/type/app
::
/+ sh-utils
!:
::::
::
|_ [hide ~]
++ peer ,_`.
++ pock--args
%+ args-into-gate .
|= a=vase
:- %tang
|- ^- tang
=+ nex=(slew 3 a)
?~ nex ~
[(skol p:(slot 2 a)) $(a u.nex)]
--

16
base/app/unsync/core.hook
View File

@ -1,16 +0,0 @@
:: Desk unsync
::
:::: /hook/core/unsync/app
::
/+ sh-utils
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke--args
%+ gate-bang
|= [syd=@tas her=@p sud=@tas ~]
[%c %plug our.hid syd her sud]
(print . "unsynced")
--

12
base/app/verb/core.hook
View File

@ -1,12 +0,0 @@
:: Verb: toggle verbose mode
::
:::: /hook/core/verb/app
::
/+ sh-utils
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke--args (add-resp [%give %verb ~] (args-done ,_`.))
--

13
base/app/wipe/core.hook
View File

@ -1,13 +0,0 @@
:: Wipe path, retcon app existence
::
::::
::
/+ sh-utils
!:
::::
::
|_ [hide ~]
++ poke--args
%+ gate-bang |=([a=path ~] [%g %wipe our a])
(args-done ,_`.)
--

42
base/app/ye/core.hook
View File

@ -1,42 +0,0 @@
:: Ye broadcast
::
:::: /hook/gate/ye/bin
::
/+ sh-utils
::
::::
::
|%
++ sign ::
$% $: %a ::
$% [%went p=ship q=cape] ::
== == == ::
++ flog :: sent to %dill
$% [%crud p=@tas q=(list tank)] ::
[%text p=tape] ::
== ::
--
!:
::::
::
|_ [hid=hide ~]
++ peer ,_`.
++ poke--args
%+ gate-bang
|= [tex=tape ~]
=+ mez=(crip "{<our.hid>}: {tex}")
[%a %want [our.hid (sein our.hid)] /q/ye mez]
(add-nice ,_`.)
::
++ poke-txt
%+ gate-bang |=(cor=@t [%d %flog `flog`[%text "> {(trip cor)}"]])
(add-nice ,_`.)
::
++ pour
|= [ost=bone pax=path sih=sign]
?> ?=([%bang ~] pax)
%. +<
=+ ack=?+(q.sih "failed" %good "recieved")
(add-exit (print +>.$ "ye {ack}"))
::
--

104
base/arvo/ames.hoon
View File

@ -4,59 +4,17 @@
=> =~
:: structures
|%
++ flog :: error wrapper
$% [%crud p=@tas q=(list tank)] ::
[%text p=tape] ::
== ::
++ cuft :: internal gift
$% [%coup p=(unit tang)] :: poke result
[%diff p=cage] :: subscription output
[%quit ~] :: close subscription
[%reap p=(unit tang)] :: peer result
== ::
++ gift :: out result <-$
$% [%hear p=lane q=@] :: receive packet
[%init p=@p] :: report install
[%mass p=mass] :: memory usage
[%send p=lane q=@] :: transmit packet
[%waft p=sock q=*] :: response message
[%wart p=sock q=@tas r=path s=*] :: network request
[%went p=ship q=cape] :: reaction message
[%woot p=ship q=coop] :: e2e reaction message
== ::
++ hasp ,[p=ship q=term] :: see %gall
++ kiss :: in request ->$
$% [%barn ~] :: new unix process
[%crud p=@tas q=(list tank)] :: error with trace
[%cash p=@p q=buck] :: civil license
[%hear p=lane q=@] :: receive packet
[%hole p=lane q=@] :: packet failed
[%junk p=@] :: entropy
[%kick p=@da] :: wake up
[%make p=(unit ,@t) q=@ud r=@ s=?] :: wild license
[%sith p=@p q=@uw r=?] :: imperial generator
[%wake ~] :: timer activate
[%want p=sock q=path r=*] :: send message
[%wegh ~] :: report memory
[%wont p=sock q=path r=*] :: e2e send message
== ::
++ move ,[p=duct q=(mold note gift)] :: local move
++ move ,[p=duct q=(mold note gift-ames)] :: local move
++ note :: out request $->
$? $: %d :: to %dill
$% [%flog p=flog] ::
== == ::
$: %a :: to %ames
$% [%kick p=@da] ::
== == ::
$: %b :: to %behn
$% [%rote p=sack q=path r=*] ::
[%roth p=sack q=path r=*] ::
[%mess p=[@p %ye ~] q=@p r=cage] ::
== == ::
$: %g :: to %gall
$% [%rote p=sack q=path r=*] ::
[%roth p=sack q=path r=*] ::
[%mess p=[@p %ye ~] q=@p r=cage] ::
== == ::
$: @tas :: to any
$% [%init p=@p] ::
@ -67,12 +25,10 @@
$? $: %a :: from %ames
$% [%went p=ship q=cape] ::
== == ::
$: %b :: from %gall
$: %g :: from %gall
$% [%unto p=cuft] ::
[%mack p=(unit tang)] :: message ack
== == ::
$: %g :: from %gall
$% [%mean p=ares] ::
[%mean p=ares] :: XX old, clean up
[%nice ~] ::
== == ::
$: @tas ::
@ -457,7 +413,7 @@
vix=(bex +((cut 0 [25 2] mag))) :: width of sender
tay=(cut 0 [27 5] mag) :: message type
==
?> =(6 vez)
?> =(7 vez)
?> =(chk (end 0 20 (mug bod)))
:+ [(end 3 wix bod) (cut 3 [wix vix] bod)]
(kins tay)
@ -477,7 +433,7 @@
=+ tay=(ksin q.kec)
%+ mix
%+ can 0
:~ [3 6]
:~ [3 7]
[20 (mug bod)]
[2 yax]
[2 qax]
@ -498,7 +454,9 @@
^- [(unit will) _+>]
?. =(our (sein her)) [~ +>.$]
=+ nes=sen
?. =(tic (end 6 1 (shaf %tick (mix her (shax sec:ex:q.nes)))))
=+ ryt=(end 6 1 (shaf %tick (mix her (shax sec:ex:q.nes))))
?. =(tic ryt)
~& [%ames-wrong-ticket `@p`ryt]
[~ +>.$]
=+ rad=(~(get by hoc.saf) her)
?^ rad
@ -1060,7 +1018,7 @@
++ gnaw :: gnaw:am
|= [kay=cape ryn=lane pac=rock] :: process packet
^- [p=(list boon) q=fort]
?. =(6 (end 0 3 pac)) [~ fox]
?. =(7 (end 0 3 pac)) [~ fox]
=+ kec=(bite pac)
?: (goop p.p.kec) [~ fox]
?. (~(has by urb.ton.fox) q.p.kec)
@ -1604,16 +1562,16 @@
|% :: vane interface
++ call :: handle request
|= $: hen=duct
hic=(hypo (hobo kiss))
hic=(hypo (hobo kiss-ames))
==
=> %= . :: XX temporary
q.hic
^- kiss
^- kiss-ames
?: ?=(%soft -.q.hic)
((hard kiss) p.q.hic)
?: (~(nest ut -:!>(*kiss)) | p.hic) q.hic
((hard kiss-ames) p.q.hic)
?: (~(nest ut -:!>(*kiss-ames)) | p.hic) q.hic
~& [%ames-call-flub (,@tas `*`-.q.hic)]
((hard kiss) q.hic)
((hard kiss-ames) q.hic)
==
^- [p=(list move) q=_..^$]
=^ duy ..knob
@ -1685,13 +1643,11 @@
[hen [%slip %a %kick now]]
[hen [%slip %e %init p.bon]]
[hen [%slip %g %init p.bon]]
[hen [%slip %b %init p.bon]] :: temporary %behn
[hen [%slip %d %init p.bon]] :: must be after gall
~
==
::
%cake
:: ~& [%cake p.bon q.bon r.bon]
:_ fox
:~ [s.bon %give %woot q.p.bon r.bon]
==
@ -1716,7 +1672,7 @@
:+ (scot %p p.p.bon)
(scot %p q.p.bon)
q.q.bon
[hen %pass pax %g %rote p.bon /helm 0 %m %will wil]~
[hen %pass pax %g %rote p.bon /hood 0 %m %will wil]~
?> ?=([@ @ *] t.q.q.bon)
:_ fox
=+ [cak=i.t.q.q.bon ven=i.t.t.q.q.bon]
@ -1778,7 +1734,7 @@
%+ turn paz
|= him=ship
:- hen
[%pass /ye %g %mess [him ye/~] p.p.bon [%txt !>(((hard ,@t) r.bon))]]
[%pass /ye %g %rote `sack`p.bon /ye 0 %m %helm-ye ((hard ,@t) r.bon)]
==
::
%mulk
@ -1791,26 +1747,6 @@
:~ :- (claw p.p.bon)
[%sick %wart p.bon i.t.q.q.bon t.t.q.q.bon r.bon]
==
::
%be :: %behn request
=* imp t.t.q.q.bon
?> (levy imp (sane %ta))
=+ ^= pax
:+ (scot %p p.p.bon)
(scot %p q.p.bon)
q.q.bon
:: ~& [%ames-behn-request p.bon imp pax]
:_ fox [hen %pass pax %b %rote p.bon imp r.bon]~
::
%bh :: %behn response
=* imp t.t.q.q.bon
?> (levy imp (sane %ta))
=+ ^= pax
:+ (scot %p p.p.bon)
(scot %p q.p.bon)
q.q.bon
:: ~& [%ames-behn-response p.bon imp pax]
:_ fox [hen %pass pax %b %roth p.bon imp r.bon]~
::
%ge :: %gall request
=* imp t.t.q.q.bon
@ -1819,6 +1755,7 @@
:+ (scot %p p.p.bon)
(scot %p q.p.bon)
q.q.bon
:: ~& [%ames-gall-request p.bon imp pax]
:_ fox [hen %pass pax %g %rote p.bon imp r.bon]~
::
%gh :: %gall response
@ -1828,6 +1765,7 @@
:+ (scot %p p.p.bon)
(scot %p q.p.bon)
q.q.bon
:: ~& [%ames-gall-response p.bon imp pax]
:_ fox [hen %pass pax %g %roth p.bon imp r.bon]~
==
::
@ -1858,10 +1796,10 @@
?- +<.sih
%crud [[[hen [%slip %d %flog +.sih]] ~] +>]
%went [~ +>]
%mack ?~ +>.sih $(sih [%g %nice ~])
%mack ?~ +>.sih $(sih [%g %nice ~]) :: XX using old code
$(sih [%g %mean `[%mack +>+.sih]])
%unto ~|([%ames-unto tea hen +>-.sih] !!)
?(%mean %nice)
?(%mean %nice) :: XX obsolete
?: ?=([%ye ~] tea)
[~ +>.$]
?> ?=([@ @ @ *] tea)
@ -1882,7 +1820,7 @@
==
::
++ knob
|= [hen=duct kyz=kiss]
|= [hen=duct kyz=kiss-ames]
^- [(list move) _+>]
?: ?=(%crud -.kyz)
[[[hen [%slip %d %flog kyz]] ~] +>]

1145
base/arvo/behn.hoon
View File

File diff suppressed because it is too large Load Diff

134
base/arvo/clay.hoon
View File

@ -17,30 +17,8 @@
mer=(map (pair ship desk) mery) :: outstanding merges
syn=? :: sync to unix
== ::
++ gift :: out result <-$
$% [%ergo p=@p q=@tas r=@ud s=(list ,[path (unit mime)])]
:: version update
[%mass p=mass] :: memory usage
[%mere p=(each (set path) (pair term tang))] :: merge result
[%note p=@tD q=tank] :: debug message
[%writ p=riot] :: response
== ::
++ khan ::
$: fil=(unit (unit cage)) :: XX see khan-to-soba
dir=(map ,@ta khan) ::
== ::
++ kiss :: in request ->$
$% [%font p=@p q=@tas r=@p s=@tas] :: set upstream
[%info p=@p q=@tas r=nori] :: internal edit
[%init p=@p] :: report install
[%into p=@p q=@tas r=khan] :: external edit
[%lynx p=@p q=@tas r=(unit ,?)] :: sync to unix
[%merg p=@p q=@tas r=@p s=@tas t=germ] :: merge desks
[%plug p=@p q=@tas r=@p s=@tas] :: unset upstream
[%wart p=sock q=@tas r=path s=*] :: network request
[%warp p=sock q=riff] :: file request
[%wegh ~] :: report memory
== ::
++ gift gift-clay :: out result <-$
++ kiss kiss-clay :: in request ->$
++ mery ::
$: gem=germ :: strategy
cas=case :: ali's case
@ -102,26 +80,6 @@
$: @tas :: by any
$% [%crud p=@tas q=(list tank)] ::
== == == ::
++ silk :: construction layer
$& [p=silk q=silk] :: cons
$% [%bake p=mark q=beam r=path] :: local synthesis
[%boil p=mark q=beam r=path] :: general synthesis
[%bunt p=mark] :: example of mark
[%call p=silk q=silk] :: slam
[%cast p=mark q=silk] :: translate
[%diff p=silk q=silk] :: diff
[%done p=(set beam) q=gage] :: literal
[%dude p=tank q=silk] :: error wrap
[%dune p=(set beam) q=(unit gage)] :: unit literal
[%join p=mark q=silk r=silk] :: merge
[%mute p=silk q=(list (pair wing silk))] :: mutant
[%pact p=silk q=silk] :: patch
[%reef ~] :: kernel reef
[%ride p=twig q=silk] :: silk thru twig
[%tabl p=(list (pair silk silk))] :: list
[%vale p=mark q=ship r=*] :: validate [our his]
[%volt p=(set beam) q=(cask ,*)] :: unsafe add type
== ::
++ raft :: filesystem
$: fat=(map ship room) :: domestic
hoy=(map ship rung) :: foreign
@ -138,7 +96,6 @@
mer=(map (pair ship desk) mery) :: outstanding merges
syn=? :: sync to unix
== ::
++ riff ,[p=desk q=(unit rave)] :: request/desist
++ rind :: request manager
$: nix=@ud :: request index
bom=(map ,@ud ,[p=duct q=rave]) :: outstanding
@ -290,8 +247,6 @@
?. ?=([%sing %v *] rav) rav
[%many %| [%ud let.dom] `case`q.p.rav r.p.rav]
=+ inx=nix.u.ref
~? ?=([%sing %x *] vaw)
[%remote-x-ing vaw hen]
%= +>+.$
say [[hen [(scot %ud inx) ~] for [inx syd ~ vaw]] say]
nix.u.ref +(nix.u.ref)
@ -711,7 +666,7 @@
^- (list (pair path misu))
(turn u.mut.u.dok |=([pax=path cal=[lobe cage]] [pax %dif cal]))
==
=^ hat +>.$ (edit:ze now %& *cart sim) :: XX we do same thing in ++apply-edit
=^ hat +>.$ (edit:ze now %& *cart sim) :: XX do same in ++apply-edit
?~ dok ~& %no-dok +>.$
=>
%= .
@ -770,8 +725,11 @@
[%done ~ %null !>(~)]
=+ (~(get by mim.u.dok) a)
?^ - [%done ~ %mime !>(u.-)]
:^ %cast %mime %done :- ~
(need (read:ze %x [%ud let.dom] a))
:+ %cast %mime
=+ (need (need (read-x:ze let.dom a)))
?: ?=(%& -<)
[%done ~ p.-]
(lobe-to-silk:ze a p.-)
==
==
::
@ -905,8 +863,8 @@
!!
::
%x
=< ?> ?=(^ ref) .
(rand-to-rant u.rut)
=< ?>(?=(^ ref) .)
(validate-x p.p.u.rut q.p.u.rut q.u.rut r.u.rut)
::
%w
=. haw.u.ref
@ -973,6 +931,27 @@
:: ==
:: ==
::
++ validate-x
|= [car=care cas=case pax=path peg=page]
^+ +>
=- %_(+>.$ tag [- tag])
:* hen %pass
[%foreign-x (scot %p who) (scot %p for) syd car (scot cas) pax]
%f %exec who [for syd cas] ~
%vale p.peg for q.peg
==
::
++ take-foreign-x
|= [car=care cas=case pax=path res=(each gage tang)]
^+ +>
?> ?=(^ ref)
?: ?=(%| -.res)
~| "validate foreign plops failed"
~| [%plop-fail (turn p.res |=(tank ~(ram re +<)))]
!!
?> ?=(@ p.p.res)
wake(haw.u.ref (~(put by haw.u.ref) [car cas pax] `p.res))
::
++ validate-plops
|= [cas=case pop=(set plop)]
^+ +>
@ -1720,8 +1699,6 @@
%that
?: =(r.ali.dat r.bob.dat)
(done:he ~)
?: (~(has in (reachable-takos r.bob.dat)) r.ali.dat)
(done:he ~)
=. new.dat (make-yaki [r.ali.dat r.bob.dat ~] q.ali.dat now)
=. hut.ran (~(put by hut.ran) r.new.dat new.dat)
=. erg.dat
@ -2137,7 +2114,7 @@
?~ cay
~
`[pax u.cay]
=^ hat lat.ran :: new content
=^ hot lat.ran :: new content
^- [(map path lobe) (map lobe blob)]
%+ roll (~(tap by can))
=< .(lat lat.ran)
@ -2152,13 +2129,13 @@
[(lobe-to-mark u.-) u.-]
[p q.q]:cay
[(~(put by hat) pax p.bol) (~(put by lat) p.bol bol)]
=. hat :: all the content
=+ ^- hat=(map path lobe) :: all the content
%- ~(uni by old)
%- ~(uni by new.dal.dat)
%- ~(uni by new.dob.dat)
%- ~(uni by cal.dal.dat)
%- ~(uni by cal.dob.dat)
%- ~(uni by hat)
%- ~(uni by hot)
cas
=+ ^- del=(map path ,?)
(~(run by (~(uni by old.dal.dat) old.dob.dat)) |=(~ %|))
@ -2167,7 +2144,13 @@
(make-yaki [r.ali.dat r.bob.dat ~] hat now)
=. hut.ran (~(put by hut.ran) r.new.dat new.dat)
=. erg.dat %- ~(uni by del)
`(map path ,?)`(~(run by hat) |=(lobe %&))
^- (map path ,?)
%. |=(lobe %&)
%~ run by
%- ~(uni by new.dal.dat)
%- ~(uni by cal.dal.dat)
%- ~(uni by cas)
hot
checkout
::
++ checkout
@ -2454,10 +2437,16 @@
::
%init
:_ ..^$(fat.ruf (~(put by fat.ruf) p.q.hic [hen ~ ~]))
=+ bos=(sein p.q.hic)
~& [%bos bos p.q.hic]
=+ [bos=(sein p.q.hic) can=(clan p.q.hic)]
%- zing ^- (list (list move))
:~ ~& [%bos bos p.q.hic]
?: =(bos p.q.hic) ~
[hen %pass / %c %font p.q.hic %base bos %kids]~
::
~
:: ?. ?=(?(%king %czar) can) ~
:: [hen %pass / %c %font p.q.hic %kids p.q.hic %base]~
==
::
%info
?: =(%$ q.q.hic)
@ -2640,7 +2629,7 @@
=* sud i.t.t.t.t.tea
=* sat i.t.t.t.t.t.tea
=+ une=(un our now hen ruf)
=+ wak=wake:une
=+ wak=une
=+ wex=(di:wak syd)
=+ dat=?-(+<.q.hin %writ [%& p.q.hin], %made [%| q.q.hin])
=+ ^- kan=(unit ankh)
@ -2651,7 +2640,8 @@
ank.dom
=+ wao=abet:(route:(me:ze:wex [her sud] kan) sat dat)
=+ woo=abet:wao
[(weld -.wak -.woo) ..^$(ruf abet:(pish:une syd +.woo ran.wao))]
=+ sip=wake:(pish:une syd +.woo ran.wao)
[(weld -.sip -.woo) ..^$(ruf abet:[+.sip])]
?: ?=([%auto @ @ @ @ ~] tea)
=+ our=(slav %p i.t.tea)
=* syd i.t.t.tea
@ -2663,7 +2653,7 @@
=. sor.ruf (~(put by sor.ruf) [our syd her sud] [nex hen])
=+ `move`[hen %pass tea %c %warp [our her] sud ~ %sing %y [%ud nex] /]
?: ?=(%& -.p.+.q.hin)
~& ['merge succeeded' p.p.+.q.hin]
:: ~& ['merge succeeded' p.p.+.q.hin]
[[- ~] ..^$]
~& :^ "merge failed"
"please manually merge the desks with"
@ -2810,6 +2800,24 @@
=+ zot=abet.zat
[-.zot (posh her syd +.zot ruf)]
[mos ..^$(ran.ruf ran.zat)]
::
%foreign-x
?> ?=([@ @ @ @ @ *] t.tea)
=+ our=(slav %p i.t.tea)
=+ her=(slav %p i.t.t.tea)
=+ syd=(slav %tas i.t.t.t.tea)
=+ car=((hard care) i.t.t.t.t.tea)
=+ ^- cas=case
=+ (slay i.t.t.t.t.t.tea)
?> ?=([~ %$ case] -)
->+
=* pax t.t.t.t.t.t.tea
=+ zax=(do now hen [our her] syd ruf)
=+ zat=(take-foreign-x:zax car cas pax q.q.hin)
=^ mos ruf
=+ zot=abet.zat
[-.zot (posh her syd +.zot ruf)]
[mos ..^$(ran.ruf ran.zat)]
==
::
%mere !!

319
base/arvo/dill.hoon
View File

@ -3,63 +3,17 @@
::
|= pit=vase
=> |% :: interface tiles
++ console-action :: console to app
$% [%det console-change] :: edit prompt line
[%inn ~] :: enter session
[%out ~] :: exit session
[%ret ~] :: submit and clear
== ::
++ console-buffer (list ,@c) :: command state
++ console-change :: network change
$: ler=console-clock :: destination clock
haw=@uvH :: source hash
ted=console-edit :: state change
== ::
++ console-clock ,[own=@ud his=@ud] :: vector clock
++ console-edit :: shared state change
$% [%del p=@ud] :: delete one at
[%ins p=@ud q=@c] :: insert at
[%mor p=(list console-edit)] :: combination
[%nop ~] :: no-op
[%set p=console-buffer] :: discontinuity
== ::
++ console-effect :: app to console
$% [%bel ~] :: beep
[%blk p=@ud q=@c] :: blink/match char at
[%clr ~] :: clear screen
[%det console-change] :: edit input
[%nex ~] :: save and clear input
[%tan p=(list tank)] :: classic tank
:: [%taq p=tanq] :: modern tank
[%txt p=tape] :: text line
== ::
++ dill-belt :: console input
$% [%aro p=?(%d %l %r %u)] :: arrow key
[%bac ~] :: true backspace
[%cru p=@tas q=(list tank)] :: echo error
[%ctl p=@c] :: control-key
[%del ~] :: true delete
[%met p=@c] :: meta-key
[%ret ~] :: return
[%rez p=@ud q=@ud] :: resize, cols, rows
[%txt p=(list ,@c)] :: utf32 text
[%yow p=gill] :: connect to app
== ::
++ dill-blit :: console output
$% [%bel ~] :: make a noise
[%clr ~] :: clear the screen
[%hop p=@ud] :: set cursor position
[%mor p=(list dill-blit)] :: multiple blits
[%pro p=(list ,@c)] :: show as cursor/line
[%qit ~] :: close console
[%out p=(list ,@c)] :: send output line
[%sag p=path q=*] :: save to jamfile
[%sav p=path q=@] :: save to file
== ::
++ gill (pair ship term) :: general contact
-- ::
=> |% :: console protocol
++ axle :: all dill state
++ all-axle ?(old-axle axle) ::
++ old-axle :: all dill state
$: %2 ::
ore=(unit ship) :: identity once set
hey=(unit duct) :: default duct
dug=(map duct axon) :: conversations
== ::
++ axle ::
$: %3 ::
ore=(unit ship) :: identity once set
hey=(unit duct) :: default duct
@ -82,67 +36,20 @@
== ::
-- => ::
|% :: protocol below
++ blew ,[p=@ud q=@ud] :: columns rows
++ belt :: raw console input
$% [%aro p=?(%d %l %r %u)] :: arrow key
[%bac ~] :: true backspace
[%ctl p=@c] :: control-key
[%del ~] :: true delete
[%met p=@c] :: meta-key
[%ret ~] :: return
[%txt p=(list ,@c)] :: utf32 text
== ::
++ blit :: raw console output
$% [%bel ~] :: make a noise
[%clr ~] :: clear the screen
[%hop p=@ud] :: set cursor position
[%lin p=(list ,@c)] :: set current line
[%mor ~] :: newline
[%sag p=path q=*] :: save to jamfile
[%sav p=path q=@] :: save to file
== ::
++ flog :: sent to %dill
$% [%crud p=@tas q=(list tank)] :: error with trace
[%heft ~] :: system memory
[%text p=tape] :: print text
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ gift :: out result <-$
$% [%bbye ~] :: reset prompt
[%blit p=(list blit)] :: terminal output
[%init p=@p] :: set owner
[%logo ~] :: logout
[%mass p=mass] :: memory usage
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ kiss :: in request ->$
$% [%belt p=belt] :: terminal input
[%blew p=blew] :: terminal config
[%boot p=*] :: weird %dill boot
[%crud p=@tas q=(list tank)] :: error with trace
[%flog p=flog] :: wrapped error
[%flow p=@tas q=(list gill)] :: terminal config
[%hail ~] :: terminal refresh
[%heft ~] :: system memory
[%hook ~] :: this term hung up
[%harm ~] :: all terms hung up
[%init p=ship] :: after gall ready
[%noop ~] :: no operation
[%talk p=tank] ::
[%text p=tape] ::
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ gift gift-dill :: out result <-$
++ kiss kiss-dill :: in request ->$
-- => ::
|% :: protocol outward
++ mess ::
$% [%dill-belt p=(hypo dill-belt)] ::
== ::
++ cuft :: internal gift
$% [%coup p=(unit tang)] :: poke result
[%quit ~] :: close subscription
[%reap p=(unit tang)] :: peer result
[%diff p=cage] :: subscription output
== ::
++ suss (trel term ,@tas ,@da) :: config report
++ move ,[p=duct q=(mold note gift)] :: local move
++ note-ames :: weird ames move
$% [%make p=(unit ,@t) q=@ud r=@ s=?] ::
@ -161,15 +68,13 @@
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ note-gall :: outbound message
$% [%mess p=[ship q=path] q=ship r=mess] ::
[%nuke p=[p=ship q=path] q=ship] ::
[%show p=[p=ship q=path] q=ship r=path] ::
[%took p=[p=ship q=path] q=ship] ::
++ note-gall ::
$% [%conf dock %load ship desk] ::
[%deal p=sock q=cush] ::
== ::
++ note ::
++ note :: out request $->
$? [?(%a %c %e %f %g %t) %wegh ~] ::
$% [%a note-ames] :: out request $->
$% [%a note-ames] ::
[%c note-clay] ::
[%d note-dill] ::
[%g note-gall] ::
@ -179,6 +84,9 @@
$% [%nice ~] ::
[%init p=ship] ::
== ::
++ sign-gall :: see %gall
$% [%onto p=(unit tang)] ::
== ::
++ sign-clay ::
$% [%mere p=(each (set path) (pair term tang))] ::
[%note p=@tD q=tank] ::
@ -188,10 +96,8 @@
$% [%blit p=(list blit)] ::
== ::
++ sign-gall ::
$% [%crud p=@tas q=(list tank)] ::
[%mean p=ares] ::
[%nice ~] ::
[%rush %dill-blit dill-blit] ::
$% [%onto p=(each suss tang)] ::
[%unto p=cuft] ::
== ::
++ sign-time ::
$% [%wake ~] ::
@ -230,6 +136,28 @@
(crud p.kyz q.kyz)
%blew (send %rez p.p.kyz q.p.kyz)
%heft heft
%tick =+ ^= ges ^- gens
^- gens
:- %en
=+ can=(clan p.kyz)
?- can
%czar [%czar ~]
%duke [%duke %anon ~]
%earl [%earl (scot %p p.kyz)]
%king :- %king
?: =(~doznec p.kyz) :: so old tickets work
'Urban Republic'
(scot %p p.kyz)
%pawn [%pawn ~]
==
=+ yen=(scot %p (shax :(mix %ticket eny now)))
=+ ^= beg ^- [his=@p tic=@p yen=@t ges=gens]
[p.kyz q.kyz yen ges]
=+ cag=`cage`[%hood-begin !>(beg)]
%= +>.$
moz
:_(moz [hen %pass ~ %g %deal [our our] %hood %poke cag])
==
%veer (dump kyz)
%vega (dump kyz)
%verb (dump kyz)
@ -289,14 +217,18 @@
==
::
++ init :: initialize
~& [%dill-init our]
~& [%dill-init our ram]
=+ myt=(flop (need tem))
=+ can=(clan our)
=. tem ~
=. moz :_(moz [hen %pass / %c %font our %home our %base])
=. moz :_(moz [hen %pass / %g %show [our [ram ~]] our ~])
|- ^+ +>
?~ myt +>
$(myt t.myt, +> (send i.myt))
=. moz ?. ?=(?(%king %czar) can) moz
:_(moz [hen %pass / %c %font our %kids our %base])
=. moz :_(moz [hen %pass ~ %g %conf [[our ram] %load our %home]])
=. moz :_(moz [hen %pass ~ %g %deal [our our] ram %peer /drum])
|- ^+ +>+
?~ myt +>+
$(myt t.myt, +>+ (send i.myt))
::
++ into :: preinitialize
|= gyl=(list gill)
@ -319,13 +251,68 @@
%_ +>
moz
:_ moz
[hen %pass ~ %g %mess [our [ram ~]] our [%dill-belt -:!>(bet) bet]]
[hen %pass ~ %g %deal [our our] ram %poke [%dill-belt -:!>(bet) bet]]
==
::
++ took :: send rush ack
++ pump :: send diff ack
%_ .
moz
:_(moz [hen %pass ~ %g %took [our [ram ~]] our])
:_(moz [hen %pass ~ %g %deal [our our] ram %pump ~])
==
::
++ take :: receive
|= sih=sign
^+ +>
?- sih
[?(%a %c %e %f %g %t) %mass *]
(wegt -.sih p.sih)
::
[%a %nice *]
:: ~& [%take-nice-ames sih]
+>
::
[%a %init *]
+>(moz :_(moz [hen %give +.sih]))
::
[%c %mere *]
?: ?=(%& -.p.sih)
+>.$
~| %dill-mere-fail
~| p.p.p.sih
|-
?~ q.p.p.sih !!
~> %mean.|.(i.q.p.p.sih) :: pull ford fail into stack trace
$(q.p.p.sih t.q.p.p.sih)
::
[%g %onto *]
:: ~& [%take-gall-onto +>.sih]
?- -.+>.sih
%| (crud %onto p.p.+>.sih)
%& (done %blit [%lin (tuba "{<p.p.sih>}")]~)
==
::
[%g %unto *]
:: ~& [%take-gall-unto +>.sih]
?- -.+>.sih
%coup ?~(p.p.+>.sih +>.$ (crud %coup u.p.p.+>.sih))
%quit ~& %dill-console-quit
(dump %logo ~)
%reap ?~(p.p.+>.sih +>.$ (crud %reap u.p.p.+>.sih))
%diff pump:(from ((hard dill-blit) q:`vase`+>+>.sih))
==
::
[%c %note *]
(from %out (tuba p.sih ' ' ~(ram re q.sih)))
::
[%c %writ *]
init
::
[%d %blit *]
(done +.sih)
::
[%t %wake *]
:: ~& %dill-wake
+>
==
::
++ wegh
@ -359,59 +346,6 @@
%mass
=> [hef.all d=wegh]
[%vanes %| ~[u.a u.c d u.e u.f u.g u.t]]
::
++ take :: receive
|= [tea=wire sih=sign]
^+ +>
?- sih
[?(%a %c %e %f %g %t) %mass *]
(wegt -.sih p.sih)
::
[%a %nice *]
:: ~& [%take-nice-ames sih]
+>
::
[%a %init *]
+>(moz :_(moz [hen %give +.sih]))
::
[%c %mere *] :: i don't think we get these anymore
?: ?=(%& -.p.sih)
+>.$
~| %dill-mere-fail
~| p.p.p.sih
|-
?~ q.p.p.sih !!
~> %mean.|.(i.q.p.p.sih) :: interpolate ford fail into stack trace
$(q.p.p.sih t.q.p.p.sih)
::
[%c %note *]
(from %out (tuba p.sih ' ' ~(ram re q.sih)))
::
[%c %writ *]
init
::
[%d %blit *]
(done +.sih)
::
[%g %crud *]
(crud p.+.sih q.+.sih)
:: (send %cru p.+.sih q.+.sih)
::
[%g %mean *]
~& %dill-take-mean
+>
::
[%g %nice *]
:: ~& [%take-nice sih]
+>
::
[%g %rush %dill-blit *]
took:(from +>+.sih)
::
[%t %wake *]
:: ~& %dill-wake
+>
==
--
::
++ ax :: make ++as
@ -429,7 +363,7 @@
[~ ~]
80
0
(tuba "<{(trip p.kyz)}>")
(tuba "<awaiting {(trip p.kyz)}>")
==
--
|% :: poke/peek pattern
@ -455,6 +389,8 @@
?: ?=([%crud %hax-init [%leaf *] ~] p.q.hic)
=+ him=(slav %p (crip p.i.q.p.q.hic))
:_(..^$ ?~(hey.all ~ [u.hey.all %give %init him]~))
?: ?=([%crud %hax-heft ~] p.q.hic)
:_(..^$ ?~(hey.all ~ [u.hey.all %slip %d %heft ~]~))
:_(..^$ ?~(hey.all ~ [u.hey.all %slip %d p.q.hic]~))
=. hey.all ?^(hey.all hey.all `hen)
?: ?=(%init -.q.hic)
@ -464,15 +400,7 @@
=: ore.all `p.q.hic
dug.all ~
==
=+ ^= flo ^- (list (pair ship term))
=+ myr=(clan p.q.hic)
?: =(%pawn myr)
[[p.q.hic %dojo] ~]
?: =(%earl myr)
=+ fap=(sein p.q.hic)
[[fap %dojo] [fap %talk] ~]
[[p.q.hic %dojo] [p.q.hic %talk] ~]
=^ moz all abet:(need (ax (need hey.all) [%flow %sole flo]))
=^ moz all abet:(need (ax (need hey.all) [%flow %hood ~]))
?: |((lth p.q.hic 256) (gte p.q.hic (bex 64))) [moz ..^$] :: XX HORRIBLE
[:_(moz [(need hey.all) %give %init p.q.hic]) ..^$]
=+ nus=(ax hen q.hic)
@ -488,7 +416,9 @@
~
::
++ load :: trivial
|= old=axle
|= old=all-axle
?: ?=(%2 -.old)
$(old [%3 ore hey dug ~ ~ ~ ~ ~ ~]:old)
..^$(all old)
:: |= old=* :: diable
:: ..^$(ore.all `~zod)
@ -517,6 +447,7 @@
[~ ..^$]
=+ our=?>(?=(^ ore.all) u.ore.all)
=^ moz all
abet:(~(take as [~ hen our] (~(got by dug.all) hen)) tea q.hin)
abet:(~(take as [~ hen our] (~(got by dug.all) hen)) q.hin)
[moz ..^$]
--

480
base/arvo/doll.hoon
View File

@ -1,480 +0,0 @@
!:
:: dill (4d), terminal handling
::
|= pit=vase
=> |% :: interface tiles
++ console-action :: console to app
$% [%det console-change] :: edit prompt line
[%inn ~] :: enter session
[%out ~] :: exit session
[%ret ~] :: submit and clear
== ::
++ console-buffer (list ,@c) :: command state
++ console-change :: network change
$: ler=console-clock :: destination clock
haw=@uvH :: source hash
ted=console-edit :: state change
== ::
++ console-clock ,[own=@ud his=@ud] :: vector clock
++ console-edit :: shared state change
$% [%del p=@ud] :: delete one at
[%ins p=@ud q=@c] :: insert at
[%mor p=(list console-edit)] :: combination
[%nop ~] :: no-op
[%set p=console-buffer] :: discontinuity
== ::
++ console-effect :: app to console
$% [%bel ~] :: beep
[%blk p=@ud q=@c] :: blink/match char at
[%clr ~] :: clear screen
[%det console-change] :: edit input
[%nex ~] :: save and clear input
[%tan p=(list tank)] :: classic tank
:: [%taq p=tanq] :: modern tank
[%txt p=tape] :: text line
== ::
++ dill-belt :: console input
$% [%aro p=?(%d %l %r %u)] :: arrow key
[%bac ~] :: true backspace
[%cru p=@tas q=(list tank)] :: echo error
[%ctl p=@c] :: control-key
[%del ~] :: true delete
[%met p=@c] :: meta-key
[%ret ~] :: return
[%rez p=@ud q=@ud] :: resize, cols, rows
[%txt p=(list ,@c)] :: utf32 text
[%yow p=gill] :: connect to app
== ::
++ dill-blit :: console output
$% [%bel ~] :: make a noise
[%clr ~] :: clear the screen
[%hop p=@ud] :: set cursor position
[%mor p=(list dill-blit)] :: multiple blits
[%pro p=(list ,@c)] :: show as cursor/line
[%qit ~] :: close console
[%out p=(list ,@c)] :: send output line
[%sag p=path q=*] :: save to jamfile
[%sav p=path q=@] :: save to file
== ::
++ gill (pair ship term) :: general contact
-- ::
=> |% :: console protocol
++ axle :: all dill state
$: %2 ::
ore=(unit ship) :: identity once set
hey=(unit duct) :: default duct
dug=(map duct axon) :: conversations
== ::
++ axon :: dill per duct
$: ram=term :: console program
tem=(unit (list dill-belt)) :: pending, reverse
wid=_80 :: terminal width
pos=@ud :: cursor position
see=(list ,@c) :: current line
== ::
-- => ::
|% :: protocol below
++ blew ,[p=@ud q=@ud] :: columns rows
++ belt :: raw console input
$% [%aro p=?(%d %l %r %u)] :: arrow key
[%bac ~] :: true backspace
[%ctl p=@c] :: control-key
[%del ~] :: true delete
[%met p=@c] :: meta-key
[%ret ~] :: return
[%txt p=(list ,@c)] :: utf32 text
== ::
++ blit :: raw console output
$% [%bel ~] :: make a noise
[%clr ~] :: clear the screen
[%hop p=@ud] :: set cursor position
[%lin p=(list ,@c)] :: set current line
[%mor ~] :: newline
[%sag p=path q=*] :: save to jamfile
[%sav p=path q=@] :: save to file
== ::
++ flog :: sent to %dill
$% [%crud p=@tas q=(list tank)] ::
[%text p=tape] ::
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ gift :: out result <-$
$% [%bbye ~] :: reset prompt
[%blit p=(list blit)] :: terminal output
[%init p=@p] :: set owner
[%logo ~] :: logout
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ kiss :: in request ->$
$% [%belt p=belt] :: terminal input
[%blew p=blew] :: terminal config
[%boot p=*] :: weird %dill boot
[%crud p=@tas q=(list tank)] :: error with trace
[%flog p=flog] :: wrapped error
[%flow p=@tas q=(list gill)] :: terminal config
[%hail ~] :: terminal refresh
[%hook ~] :: this term hung up
[%harm ~] :: all terms hung up
[%init p=ship] :: after gall ready
[%noop ~] :: no operation
[%talk p=tank] ::
[%text p=tape] ::
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
-- => ::
|% :: protocol outward
++ mess ::
$% [%dill-belt p=(hypo dill-belt)] ::
== ::
++ club :: agent action
$% [%peer p=path] :: subscribe
[%poke p=cage] :: apply
[%pull ~] :: unsubscribe
[%pump ~] :: pump yes/no
== ::
++ cuft :: internal gift
$% [%coup p=(unit tang)] :: poke result
[%quit ~] :: close subscription
[%reap p=(unit tang)] :: peer result
[%diff p=cage] :: subscription output
== ::
++ cuss (pair term club) :: internal kiss
++ suss (trel term ,@tas ,@da) :: config report
++ move ,[p=duct q=(mold note gift)] :: local move
++ note-ames :: weird ames move
$% [%make p=(unit ,@t) q=@ud r=@ s=?] ::
[%sith p=@p q=@uw r=?] ::
== ::
++ note-clay ::
$% [%font p=@p q=@tas r=@p s=@tas] ::
[%warp p=sock q=riff] :: wait for clay, hack
== ::
++ note-dill :: note to self, odd
$% [%crud p=@tas q=(list tank)] ::
[%init p=ship] ::
[%text p=tape] ::
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ note-behn ::
$% [%conf dock %load ship desk] ::
[%deal p=sock q=cuss] ::
== ::
++ note :: out request $->
$% [%a note-ames] ::
[%b note-behn] ::
[%c note-clay] ::
[%d note-dill] ::
== ::
++ riff ,[p=desk q=(unit rave)] :: see %clay
++ sign-ames ::
$% [%nice ~] ::
[%init p=ship] ::
== ::
++ sign-behn :: see %behn
$% [%onto p=(unit tang)] ::
== ::
++ sign-clay ::
$% [%mere p=(each (set path) (pair term tang))] ::
[%note p=@tD q=tank] ::
[%writ p=riot] ::
== ::
++ sign-dill ::
$% [%blit p=(list blit)] ::
== ::
++ sign-behn ::
$% [%onto p=(each suss tang)] ::
[%unto p=cuft] ::
== ::
++ sign-time ::
$% [%wake ~] ::
== ::
++ sign :: in result $<-
$% [%a sign-ames] ::
[%b sign-behn] ::
[%c sign-clay] ::
[%d sign-dill] ::
[%t sign-time] ::
== ::
:::::::: :: dill tiles
--
=| all=axle
|= [now=@da eny=@ ski=sled] :: current invocation
=> |%
++ as :: per cause
|_ $: [moz=(list move) hen=duct our=ship]
axon
==
++ abet :: resolve
^- [(list move) axle]
[(flop moz) all(dug (~(put by dug.all) hen +<+))]
::
++ call :: receive input
|= kyz=kiss
^+ +>
?+ -.kyz ~& [%strange-kiss -.kyz] +>
%flow +>
%harm +>
%hail +>
%belt (send `dill-belt`p.kyz)
%text (from %out (tuba p.kyz))
%crud :: (send `dill-belt`[%cru p.kyz q.kyz])
(crud p.kyz q.kyz)
%blew (send %rez p.p.kyz q.p.kyz)
%veer (dump kyz)
%vega (dump kyz)
%verb (dump kyz)
==
::
++ crud
|= [err=@tas tac=(list tank)]
=+ ^= wol ^- wall
:- (trip err)
(zing (turn tac |=(a=tank (~(win re a) [0 wid]))))
|- ^+ +>.^$
?~ wol +>.^$
$(wol t.wol, +>.^$ (from %out (tuba i.wol)))
::
++ dump :: pass down to hey
|= git=gift
?> ?=(^ hey.all)
+>(moz [[u.hey.all %give git] moz])
::
++ done :: return gift
|= git=gift
+>(moz :_(moz [hen %give git]))
::
++ from :: receive belt
|= bit=dill-blit
^+ +>
?: ?=(%mor -.bit)
|- ^+ +>.^$
?~ p.bit +>.^$
$(p.bit t.p.bit, +>.^$ ^$(bit i.p.bit))
?: ?=(%out -.bit)
%+ done %blit
:~ [%lin p.bit]
[%mor ~]
[%lin see]
[%hop pos]
==
?: ?=(%pro -.bit)
(done(see p.bit) %blit [[%lin p.bit] [%hop pos] ~])
?: ?=(%hop -.bit)
(done(pos p.bit) %blit [bit ~])
?: ?=(%qit -.bit)
(dump %logo ~)
(done %blit [bit ~])
::
++ init :: initialize
~& [%dill-init our]
=+ myt=(flop (need tem))
=. tem ~
<<<<<<< HEAD:urb/zod/base/arvo/dill.hoon
=. moz :_(moz [hen %pass / %c %font our %home our %base])
=. moz :_(moz [hen %pass / %g %show [our [ram ~]] our ~])
=======
=. moz :_(moz [hen %pass ~ %b %conf [[our ram] %load our %main]])
=. moz :_(moz [hen %pass ~ %b %deal [our our] ram %peer ~])
>>>>>>> newgall^:urb/zod/arvo/dill.hoon
|- ^+ +>
?~ myt +>
$(myt t.myt, +> (send i.myt))
::
++ into :: preinitialize
|= gyl=(list gill)
%_ +>
tem `(turn gyl |=(a=gill [%yow a]))
moz
:_ moz
:* hen
%pass
/
%c
[%warp [our our] %base `[%sing %y [%ud 1] /]]
==
==
::
++ send :: send action
|= bet=dill-belt
?^ tem
+>(tem `[bet u.tem])
%_ +>
moz
:_ moz
[hen %pass ~ %b %deal [our our] ram %poke [%dill-belt -:!>(bet) bet]]
==
::
++ pump :: send diff ack
%_ .
moz
:_(moz [hen %pass ~ %b %deal [our our] ram %pump ~])
==
::
++ take :: receive
|= sih=sign
^+ +>
?- sih
[%a %nice *]
:: ~& [%take-nice-ames sih]
+>
::
[%a %init *]
+>(moz :_(moz [hen %give +.sih]))
::
[%c %mere *]
?: ?=(%& -.p.sih)
+>.$
~| %dill-mere-fail
~| p.p.p.sih
|-
?~ q.p.p.sih !!
~> %mean.|.(i.q.p.p.sih) :: interpolate ford fail into stack trace
$(q.p.p.sih t.q.p.p.sih)
::
[%b %onto *]
:: ~& [%take-behn-onto +>.sih]
?- -.+>.sih
%| (crud %onto p.p.+>.sih)
%& (done %blit [%lin (tuba "{<p.p.sih>}")]~)
==
::
[%b %unto *]
:: ~& [%take-behn-unto +>.sih]
?- -.+>.sih
%coup ?~(p.p.+>.sih +>.$ (crud %coup u.p.p.+>.sih))
%quit !! :: ??
%reap ?~(p.p.+>.sih +>.$ (crud %reap u.p.p.+>.sih))
%diff pump:(from ((hard dill-blit) q:`vase`+>+>.sih))
==
::
[%c %note *]
(from %out (tuba p.sih ' ' ~(ram re q.sih)))
::
[%c %writ *]
init
::
[%d %blit *]
(done +.sih)
::
[%t %wake *]
:: ~& %dill-wake
+>
==
--
::
++ ax :: make ++as
|= [hen=duct kyz=kiss] ::
?~ ore.all ~
=+ nux=(~(get by dug.all) hen)
?^ nux
(some ~(. as [~ hen u.ore.all] u.nux))
?. ?=(%flow -.kyz) ~
%- some
%. q.kyz
%~ into as
:- [~ hen u.ore.all]
:* p.kyz
[~ ~]
80
0
(tuba "<{(trip p.kyz)}>")
==
--
|% :: poke/peek pattern
++ call :: handle request
|= $: hen=duct
hic=(hypo (hobo kiss))
==
^- [p=(list move) q=_..^$]
=> %= . :: XX temporary
q.hic
^- kiss
?: ?=(%soft -.q.hic)
:: ~& [%dill-call-soft (,@tas `*`-.p.q.hic)]
((hard kiss) p.q.hic)
?: (~(nest ut -:!>(*kiss)) | p.hic) q.hic
~& [%dill-call-flub (,@tas `*`-.q.hic)]
((hard kiss) q.hic)
==
?: ?=(%boot -.q.hic)
:_(..^$ [hen %pass ~ (note %a p.q.hic)]~)
?: ?=(%flog -.q.hic)
:: ~& [%dill-flog +.q.hic]
?: ?=([%crud %hax-init [%leaf *] ~] p.q.hic)
=+ him=(slav %p (crip p.i.q.p.q.hic))
:_(..^$ ?~(hey.all ~ [u.hey.all %give %init him]~))
:_(..^$ ?~(hey.all ~ [u.hey.all %slip %d p.q.hic]~))
=. hey.all ?^(hey.all hey.all `hen)
?: ?=(%init -.q.hic)
:: ~& [%call-init hen]
?: =(ore.all `p.q.hic)
[[hen %give q.hic]~ ..^$]
=: ore.all `p.q.hic
dug.all ~
==
=+ ^= flo ^- (list (pair ship term))
=+ myr=(clan p.q.hic)
?: =(%pawn myr)
[[p.q.hic %dojo] ~]
?: =(%earl myr)
=+ fap=(sein p.q.hic)
[[fap %dojo] [fap %talk] [fap %helm] ~]
[[p.q.hic %dojo] [p.q.hic %talk] [p.q.hic %helm] ~]
=^ moz all abet:(need (ax (need hey.all) [%flow %sole flo]))
?: |((lth p.q.hic 256) (gte p.q.hic (bex 64))) [moz ..^$] :: XX HORRIBLE
[:_(moz [(need hey.all) %give %init p.q.hic]) ..^$]
=+ nus=(ax hen q.hic)
?~ nus
~& [%dill-no-flow q.hic]
[~ ..^$]
=^ moz all abet:(call:u.nus q.hic)
[moz ..^$]
::
++ doze
|= [now=@da hen=duct]
^- (unit ,@da)
~
::
++ load :: trivial
|= old=axle
..^$(all old)
:: |= old=* :: diable
:: ..^$(ore.all `~zod)
::
++ scry
|= [fur=(unit (set monk)) ren=@tas his=ship syd=desk lot=coin tyl=path]
^- (unit (unit cage))
[~ ~]
::
++ stay all
::
++ take :: process move
|= [tea=wire hen=duct hin=(hypo sign)]
^- [p=(list move) q=_..^$]
?: =(~ ore.all)
?: ?=([%a %init *] q.hin)
:: ~& [%take-init hen]
=. hey.all ?^(hey.all hey.all `hen)
[[[hen %give +.q.hin] ~] ..^$]
:: [~ ..^$]
~& [%take-back q.hin]
[~ ..^$]
?. (~(has by dug.all) hen)
~& [%take-weird-sign q.hin]
~& [%take-weird-hen hen]
[~ ..^$]
=+ our=?>(?=(^ ore.all) u.ore.all)
=^ moz all
abet:(~(take as [~ hen our] (~(got by dug.all) hen)) q.hin)
[moz ..^$]
--
:: good test

408
base/arvo/eyre.hoon
View File

@ -4,33 +4,8 @@
|= pit=vase
=> =~
|% :: interfaces
++ gift :: out result <-$
$% [%mass p=mass] :: memory usage
[%thou p=httr] :: raw http response
[%thus p=@ud q=(unit hiss)] :: http request/cancel
[%veer p=@ta q=path r=@t] :: drop-through
[%vega p=path] :: drop-through
== ::
++ gram :: inter-ship message
$? [[%lon ~] p=hole] :: login request
[[%aut ~] p=hole] :: login reply
[[%hat ~] p=hole q=hart] :: login redirect
[[%get ~] p=@uvH q=[? clip httq]] :: remote request
[[%got ~] p=@uvH q=httr] :: remote response
== ::
++ hasp ,[p=ship q=term] :: don't see %gall
++ hapt ,[p=ship q=path] :: do see %gall
++ kiss :: in request ->$
$% [%born ~] :: new unix process
[%crud p=@tas q=(list tank)] :: XX rethink
[%init p=@p] :: report install
[%them p=(unit hiss)] :: outbound request
[%they p=@ud q=httr] :: inbound response
[%this p=? q=clip r=httq] :: inbound request
[%thud ~] :: inbound cancel
[%wart p=sack q=@tas r=_`[path *]`*gram] :: urbit message
[%wegh ~] :: report memory
== ::
++ gift gift-eyre :: out result <-$
++ kiss kiss-eyre :: in request ->$
++ move ,[p=duct q=(mold note gift)] :: local move
++ note :: out request $->
$% $: %a :: to %ames
@ -47,30 +22,18 @@
[%wasp p=@p q=@uvH] ::
== == ::
$: %g :: to %gall
$% [%mess p=hapt q=ship r=cage] ::
[%nuke p=hapt q=ship] ::
[%show p=hapt q=ship r=path] ::
[%took p=hapt q=ship] ::
$% [%deal p=sock q=cush] :: full transmission
== == ::
$: %t :: to %temp
$% [%wait p=@da] ::
[%rest p=@da] ::
== == == ::
++ silk :: see %ford
$& [p=silk q=silk] ::
$% [%boil p=mark q=beam r=path] ::
[%cast p=mark q=silk] ::
[%done p=(set beam) q=cage] ::
== ::
++ sine ::
$? sign ::
$: %g ::
$% [%veer p=@ta q=path r=@t] ::
[%vega p=path] ::
== == == ::
++ sign :: in result $<-
$? $: %a :: by %ames
$% [%went p=ship q=cape] ::
== == ::
$: %g :: by %gall
$% [%unto p=cuft] :: within agent
== == ::
$: %e :: by self
$% [%thou p=httr] :: response for proxy
@ -78,13 +41,6 @@
$: %f :: by %ford
$% [%made p=@uvH q=(each gage tang)] ::
[%news ~] ::
== == ::
$: %g :: by %gall
$% [%dumb ~] ::
[%mean p=ares] ::
[%nice ~] ::
[%rush p=mark q=*] ::
[%rust p=mark q=*] ::
== == ::
$: %t :: by %time
$% [%wake ~] :: timer activate
@ -101,7 +57,7 @@
[%on p=span:,@uvH ~] :: dependency
[%to p=ixor q=span:ship r=term s=wire] :: associated app
== ::
++ whir-of ,[p=span:ship q=term r=wire] :: path in hasp
++ whir-of ,[p=span:ship q=term r=wire] :: path in dock
-- ::
|% :: models
++ bolo :: eyre state
@ -117,7 +73,7 @@
dop=(map host ship) :: host aliasing
liz=(jug ,@uvH (each duct ixor)) :: ford depsets
wup=(map hole cyst) :: secure sessions
sop=(map hole ,[ship ?]) :: foreign session names
sop=(map hole ,[ship ?]) :: foreign sess names
wix=(map ixor stem) :: open views
== ::
::
@ -137,11 +93,11 @@
eve=[p=@u q=(map ,@u even)] :: queued events
med=(qeu duct) :: waiting /~/to/
==
::
++ honk $%([%nice ~] [%mean p=ares]) :: old gall result
++ even :: client event
$% [%mean p=[hasp path] q=ares]
$% [%mean p=[dock path] q=ares]
[%news p=@uv]
[%rush p=[hasp path] q=json]
[%rush p=[dock path] q=json]
==
::
++ perk :: parsed request
@ -150,20 +106,20 @@
[%bugs p=?(%as %to) ~]
[%beam p=beam]
[%deps p=?(%put %delt) q=@uvH]
[%mess p=hasp q=mark r=wire s=json]
[%mess p=dock q=mark r=wire s=json]
[%poll p=[i=@uvH t=(list ,@uvH)]]
[%spur p=spur]
[%subs p=?(%put %delt) q=[hasp %json wire path]]
[%subs p=?(%put %delt) q=[dock %json wire path]]
[%view p=ixor q=[~ u=@ud]]
==
::
++ perk-auth :: parsed auth
$% [%at p=pork] :: inject auth
[%del p=(unit ship)]
[%get him=ship rem=pork]
[%get him=(unit ship) rem=pork]
[%js ~]
[%json ~]
[%try him=ship cod=cord]
[%try him=ship paz=(unit cord)]
[%xen ses=hole rem=pork]
==
::
@ -176,7 +132,7 @@
[%js p=@t] :: script
[%json p=json] :: data
[%html p=manx] :: successful page
[%htme p=manx] :: authentication failure
[%htme p=manx] :: authentication fail
==
-- ::
|%
@ -197,22 +153,23 @@
[[%$ %t p.i.quy] [%$ %t q.i.quy] $(quy t.quy)]
==
::
++ gsig |=([a=hasp b=path] [(scot %p p.a) q.a b])
++ gsig |=([a=dock b=path] [(scot %p p.a) q.a b])
++ session-from-cookies
|= [nam=@t maf=math]
^- (unit hole)
=+ ^= cok ^- (list ,@t)
=+ cok=(~(get by maf) 'cookie')
?~(cok ~ u.cok)
|- ^- (unit hole)
(from-cookies maf |=([k=@t v=@] &(=(nam k) !=('~' v))))
::
++ ship-from-cookies
|= maf=math ^- (unit ship)
(biff (from-cookies maf |=([k=@ @] =(%ship k))) (slat %p))
::
++ from-cookies
|= [maf=math fil=$+([@t @t] ?)]
=+ `cot=(list ,@t)`(~(get ju maf) 'cookie')
=+ `cok=quay`(zing `(list quay)`(murn cot (curr rush cock:epur)))
|- ^- (unit cord)
?~ cok ~
=+ mar=`(unit (list ,[p=@t q=@t]))`(rush i.cok cock:epur)
?~ mar $(cok t.cok)
|- ^- (unit hole)
?~ u.mar ^$(cok t.cok)
?: &(=(nam p.i.u.mar) !=('~' q.i.u.mar))
[~ q.i.u.mar]
$(u.mar t.u.mar)
?:((fil i.cok) [~ q.i.cok] $(cok t.cok))
::
++ wush
|= [wid=@u tan=tang]
@ -228,9 +185,11 @@
hit(q (weld cuh q.hit))
::
++ add-poll :: inject dependency
|= [dep=@uvH max=[[%html ~] [[%head ~] hed=marl] [[%body ~] manx marl] ~]]
|= [dep=@uvH max=[[%html ~] [[%head ~] hed=marl] [[%body ~] tal=marl] ~]]
^- manx
=. hed.max :_(hed.max ;meta(charset "utf-8", urb_injected "");)
=: hed.max :_(hed.max ;meta(charset "utf-8", urb_injected "");)
tal.max (welp tal.max ;script(urb_injected ""):"{(trip etag:js)}" ~)
==
?~ dep max
max(hed :_(hed.max ;script@"/~/on/{<dep>}.js"(urb_injected "");))
::
@ -318,19 +277,28 @@
})
}
if(window.ship) ship.innerText = urb.ship
urb.foreign = /^\/~\/am/.test(window.location.pathname)
urb.submit = function(){
req(
"/~/auth.json?PUT",
{ship: ship.innerText, code: pass.value},
function(){
if(urb.foreign) document.location =
urb.redir = function(ship){
if(ship) document.location.pathname =
document.location.pathname.replace(/^\/_|\/~\/as\/any/,'/~/as/~'+ship)
else document.location =
document.location.hash.match(/#[^?]+/)[0].slice(1) +
document.location.pathname.replace(
/^\/~\/am\/[^/]+/,
'/~/as/~' + urb.ship) +
document.location.search
}
if(urb.foreign && urb.auth.indexOf(urb.ship) !== -1){
req("/~/auth.json?PUT",
{ship:urb.ship,code:null},
function(){urb.redir()})
}
urb.submit = function(){
req(
"/~/auth.json?PUT",
{ship:ship.innerText.toLowerCase(), code:pass.value},
function(){
if(urb.foreign) urb.redir()
else document.location.reload()
})
}
@ -338,32 +306,85 @@
function(){document.getElementById("c").innerHTML = "<p>Goodbye.</p>" }
)}
'''
++ etag
'''
if(!window.urb) window.urb = {}
urb.fetchTag = function(){
var tag = JSON.parse(this.getResponseHeader("etag"))
if(tag) urb.wasp(tag)
}
urb.headReq = function(url){
var xhr = new XMLHttpRequest()
xhr.open("HEAD", url)
xhr.onload = urb.fetchTag
xhr.send()
}
Array.prototype.map.call(document.querySelectorAll('script'), function(ele){
if((new URL(ele.src)).host == document.location.host)
urb.headReq(ele.src)
})
Array.prototype.map.call(document.querySelectorAll('link'), function(ele){
if((new URL(ele.href)).host == document.location.host)
urb.headReq(ele.href)
})
'''
--
++ xml
|%
++ login-page
%+ titl 'Log in'
;= ;div#c
;p: Please log in.
;p.mono: ~;{span#ship(contenteditable "")}
;input#pass(onchange "urb.submit()");
%+ titl 'Log in :urbit'
;= ;h1: Please log in
;p.ship
;div.sig: ~
;span#ship;
==
;input#pass(type "password");
;script:'''
$(function() {
$ship = $('#ship')
$pass = $('#pass')
$ship.on('keydown', function(e) {
if(e.keyCode === 13 || e.keyCode === 9) {
$pass.show()
$pass.focus()
e.preventDefault()
}
})
$ship.on('focus', function(e) {
$pass.hide()
})
$pass.on('keydown', function(e) {
if(e.keyCode === 13) {
urb.submit()
}
})
if(window.ship) {
$ship.text(urb.ship)
$pass.focus()
} else {
$pass.hide()
}
})
'''
;pre:code#err;
;script@"/~/at/~/auth.js";
==
;link(rel "stylesheet", href "/home/lib/base.css");
==
::
++ logout-page
%+ titl 'Log out'
;= ;div#c
;p: Goodbye ~;{span#ship}.
;= ;h1: Goodbye ~;{span#ship}.
;button#act(onclick "urb.away()"): Log out
;pre:code#err;
;script@"/~/at/~/auth.js";
==
;link(rel "stylesheet", href "/home/lib/base.css");
==
::
++ logside-page
%+ titl 'Verify identify'
;= ;h1: You are ~;{span#ship(contenteditable "")}
;button#act(onclick "urb.redir(ship.innerHTML)"): Go
;pre:code#err;
;script@"/~/at/~/auth.js";
==
++ poke-test
%+ titl 'Poke'
;= ;button(onclick "urb.testPoke('/~/to/hi/txt.json')"): Hi anonymous
@ -377,7 +398,18 @@
}
'''
==
++ titl |=([a=cord b=marl] ;html:(head:title:"{(trip a)}" body:"*{b}"))
++ titl
|= [a=cord b=marl]
;html
;head
;meta(charset "utf-8");
;title:"{(trip a)}"
;script(type "text/javascript", src "//cdnjs.cloudflare.com/ajax/".
"libs/jquery/2.1.1/jquery.min.js");
;link(rel "stylesheet", href "/home/lib/base.css");
==
;body:div#c:"*{b}"
==
--
--
|% :: functions
@ -429,7 +461,7 @@
=. p.p.pul |(p.p.pul ?=(hoke r.p.pul))
=+ her=(host-to-ship r.p.pul)
?: |(?=(~ her) =(our u.her))
(handle pul [q.+.kyz anon] [p.heq maf s.heq])
(handle pul [q.+.kyz |] [p.heq maf s.heq])
=+ han=(sham hen)
=. pox (~(put by pox) han hen)
(ames-gram u.her [%get ~] han +.kyz)
@ -472,6 +504,9 @@
%hat (foreign-hat:(ses-ya p.u.mez) q.p.kyz q.u.mez)
%get (pass-note ay/(dray p/uv/~ q.p.kyz p.u.mez) [%e %this q.u.mez])
%got
?. (~(has by pox) p.u.mez)
~& lost-gram-thou/p.u.mez
+>.$
=: hen (~(got by pox) p.u.mez)
pox (~(del by pox) p.u.mez)
==
@ -488,36 +523,42 @@
%wegh !!
==
::
++ axom :: old response
|= [tee=whir hon=honk]
^+ +>
?+ tee !!
~ ?-(-.hon %nice (nice-json), %mean (mean-json 500 p.hon))
[%of @ ^] (get-ack:(ire-ix p.tee) q.tee hon)
==
++ axon :: accept response
|= [tee=whir typ=type sih=sign]
^+ +>
:: %- emule |. ^+ ..axon
=. our ?~(hov our u.hov) :: XX
?- &2.sih
%crud +>.$(mow [[hen %slip %d %flog +.sih] mow])
%dumb
=. +> ?+(tee +> [%of ^] pop-duct:(ire-ix p.tee))
(emule |.(~|(gall-dumb/tee !!)))
:: %dumb
:: =. +> ?+(tee +> [%of ^] pop-duct:(ire-ix p.tee))
:: (emule |.(~|(gall-dumb/tee !!)))
::
%went +>.$
%thou
?> ?=([%ay ^] tee)
(ames-gram (slav %p p.tee) got/~ (slav %uv q.tee) |2.sih)
::
?(%rush %rust)
?> ?=([%of @ ^] tee)
?. ?=(%json p.sih)
=- (back tee 0v0 %json -)
`cage`[p.sih (slot 3 (spec (slot 3 [typ +.sih])))]
~! [q.tee *whir-of]
(get-rush:(ire-ix p.tee) q.tee ((hard json) q.sih))
%unto :: XX horrible
=+ cuf=`cuft`+>.sih
?- -.cuf
?(%coup %reap)
(axom tee ?~(p.cuf [%nice ~] [%mean `[-.cuf u.p.cuf]]))
::
?(%nice %mean)
:: ~& [tee `@tas`&2.sih]
?+ tee !!
~ ~& empty-ack/&2.sih
?-(&2.sih %nice (nice-json), %mean (mean-json 500 p.sih))
[%of @ ^] (get-ack:(ire-ix p.tee) q.tee +.sih)
%diff
?> ?=([%of @ ^] tee)
?. ?=(%json p.p.cuf)
::~> %slog.`rose/[" " "[" "]"]^~[>%backing< >p.p.cuf< (sell q.p.cuf)]
(back tee 0v0 %json p.cuf)
(get-rush:(ire-ix p.tee) q.tee ((hard json) q.q.p.cuf))
::
%quit (axom tee [%mean ~])
==
::
%wake
@ -620,7 +661,7 @@
(~(has in aut.u.cyz) our)
::
++ ses-ya |=(ses=hole ~(. ya ses (~(got by wup) ses)))
++ our-host `hart`[& ~ `/com/urbit/(rsh 3 1 (scot %p our))]
++ our-host `hart`[& ~ `/org/urbit/(rsh 3 1 (scot %p our))]
:: [| [~ 8.445] `/localhost] :: XX testing
::
++ ames-gram
@ -628,7 +669,8 @@
::
++ back :: %ford bounce
|= [tea=whir dep=@uvH mar=mark cay=cage]
(pass-note tea (ford-req root-beak [%cast mar %done ~ cay])) :: XX deps
=+ sil=`silk`[%cast mar %flag dep %done ~ cay]
(pass-note tea (ford-req root-beak sil))
::
++ ford-kill (pass-note ~ %f [%exec our *beak ~]) :: XX unused
++ ford-req |=([bek=beak kas=silk] [%f [%exec our bek `kas]])
@ -664,8 +706,8 @@
++ host-to-ship :: host to ship
|= hot=host
^- (unit ship)
=+ gow=(~(get by dop) hot)
?^ gow gow
:: =+ gow=(~(get by dop) hot) :: XX trust
:: ?^ gow gow
?. ?=(& -.hot) ~
=+ dom=(flop p.hot) :: domain name
?~ dom ~
@ -680,7 +722,7 @@
::
++ handle
|= $: [hat=hart pok=pork quy=quay] :: purl, parsed url
[cip=clip him=ship] :: client ip, ship
[cip=clip aut=?] :: client ip, nonymous?
[mef=meth maf=math bod=(unit octs)] :: method/headers/body
==
=< apex
@ -696,7 +738,9 @@
::
++ ford-get-beam
|= [bem=beam ext=term]
=: s.bem [%web ~(rent co (fcgi quy fcgi-cred:for-client)) s.bem]
=+ yac=for-client
=. him.yac ?.(aut anon him.yac)
=: s.bem [%web ~(rent co (fcgi quy fcgi-cred.yac)) s.bem]
r.bem ?+(r.bem r.bem [%ud %0] da/now)
==
(ford-req -.bem [%boil ext bem ~])
@ -816,8 +860,10 @@
[[%'PUT' ~] ~] %put
==
|-
?: ?=([%'~~' *] q.pok) :: auth shortcut
?: ?=([%'~~' *] q.pok) :: auth shortcuts
$(q.pok ['~' %as %own t.q.pok])
?: ?=([%'_' *] q.pok)
$(q.pok ['~' %as %any t.q.pok])
?. ?=([%'~' @ *] q.pok) ~
:- ~ ^- perk
=* pef i.t.q.pok
@ -832,9 +878,10 @@
~| bad-ship/?~(but ~ i.but)
?~ but !!
:_ pok(q t.but)
?+ i.but (slav %p i.but)
%anon anon
%own our
?+ i.but `(slav %p i.but)
%anon `anon
%own `our
%any ~
==
::
%on
@ -891,7 +938,7 @@
%get [%json ~]
%put
~| parsing/bod
[%try (need-body (ot ship/(su fed:ag) code/so ~):jo)]
[%try (need-body (ot ship/(su fed:ag) code/(mu so) ~):jo)]
::
%delt
~| parsing/bod
@ -919,7 +966,8 @@
=+ ext=(fall p.pok %urb)
=+ bem=?-(-.hem %beam p.hem, %spur [root-beak p.hem])
=+ wir=?+(mef !! %get ~, %head [%he ~])
[%& %| wir (ford-get-beam bem ext)]
=- ?.(aut [%& %| -] [%| (pass-note -)]) :: XX properly
[wir (ford-get-beam bem ext)]
::
%bugs
?- p.hem
@ -975,7 +1023,7 @@
::
%at
=. ..ya abet.yac
=+ pez=process(pok p.ham)
=+ pez=process(pok p.ham, aut |)
?. ?=(%& -.pez) ~|(no-inject/p.ham !!)
?~ p.pez pez
?+ -.p.pez ~&(bad-inject/p.pez !!)
@ -991,24 +1039,36 @@
::
%del
=. ..ya (logoff:yac p.ham)
=+ cug=[(cat 3 cookie-prefix '=~; Path=/')]~
=+ cug=[(set-cookie cookie-prefix '~')]~
[%| (give-json 200 cug (joba %ok %b &))]
::
%get
|-
~| aute/ham
?: |(=(anon him.ham) (~(has in aut.yac) him.ham))
process(him him.ham, pok rem.ham)
?. =(our him.ham)
[%| ((teba foreign-auth.yac) him.ham hat rem.ham quy)]
?~ him.ham
=+ him=(ship-from-cookies maf)
?^ him $(him.ham him)
(show-ship-selection)
=* him u.him.ham
?: |(=(anon him) (~(has in aut.yac) him))
=. ..ya abet.yac(him him)
=+ pez=process(pok rem.ham, aut &)
?: ?=(%| -.pez) pez
[%| (resolve ~ p.pez)]
?. =(our him)
[%| ((teba foreign-auth.yac) him hat rem.ham quy)]
(show-login-page ~)
::
%try
:- %|
?. =(our him.ham)
~|(stub-foreign/him.ham !!)
?. =(load-secret cod.ham)
?. ?| (~(has in aut.yac) him.ham)
?~(paz.ham | =(u.paz.ham load-secret))
==
~|(try/`@t`load-secret !!) :: XX security
=^ jon ..ya stat-json:(logon:yac him.ham)
=. cug.yac :_(cug.yac (set-cookie %ship (scot %p him.ham)))
(give-json 200 cug.yac jon)
==
::
@ -1021,10 +1081,36 @@
?: (~(has by wup) u.ses)
[%& %htme login-page:xml]
=+ yac=(new-ya u.ses)
=. ..ya abet.yac
[%| (give-html 401 cug.yac login-page:xml)]
=+ =- lon=(~(has in aut:(fall - *cyst)) our)
(biff (session-from-cookies cookie-prefix maf) ~(get by wup))
=. yac ?.(lon yac (logon.yac our))
[%| (give-html(..ya abet.yac) 401 cug.yac login-page:xml)]
::
++ show-ship-selection
|= ~
~| %ship-selection-unimplemented
[%& %htme logside-page:xml]
::
++ cookie-prefix (rsh 3 1 (scot %p our))
++ cookie-domain
^- cord
?- r.hat
[%| @] (cat 3 '; Domain=' (rsh 3 1 (scot %if p.r.hat)))
[%& %org %urbit *] '; Domain=.urbit.org'
[%& @ @ *] =+ dom=p.r.hat
=- (rap 3 i.dom '.' i.t.dom -)
|-(?~(t.t.dom ~ ['.' i.t.t.dom $(dom t.dom)]))
[%& *] '' :: XX security?
==
::
++ set-cookie
|= [key=@t val=@t]
%+ rap 3 :~
key '=' val
:: '; HttpOnly' ?.(sec '' '; Secure') :: XX security
cookie-domain
'; Path=/; HttpOnly'
==
++ need-ixor (oryx-to-ixor (need grab-oryx))
++ for-view ^+(ix (ire-ix need-ixor))
::
@ -1034,20 +1120,22 @@
=+ lig=(session-from-cookies pef maf)
?~ lig
(new-ya (rsh 3 1 (scot %p (end 6 1 ney))))
~| bad-cookie/u.lig
=+ cyz=(~(got by wup) u.lig)
~(. ya u.lig cyz(him him, cug ~))
=+ cyz=(~(get by wup) u.lig)
?~ cyz
~& bad-cookie/u.lig
(new-ya (rsh 3 1 (scot %p (end 6 1 ney))))
~(. ya u.lig u.cyz(cug ~))
::
++ new-ya |=(ses=hole ~(. ya ses (new-cyst ses)))
++ new-cyst
|= ses=hole
=* sec p.hat
=+ pef=cookie-prefix
^- cyst
:* ^- cred
:* hat(p sec)
~
'not-yet-implemented' ::(rsh 3 1 (scot %p (end 6 1 (shaf %oryx ses))))
'not-yet-implemented'
::(rsh 3 1 (scot %p (end 6 1 (shaf %oryx ses))))
::
=+ lag=(~(get by maf) %accept-language)
?~(lag ~ ?~(u.lag ~ [~ i.u.lag]))
@ -1057,11 +1145,7 @@
==
[anon ~]
::
:_ ~
%^ cat 3
(cat 3 (cat 3 pef '=') ses)
:: (cat 3 '; HttpOnly' ?.(sec '' '; Secure'))
'; Path=/; HttpOnly'
[(set-cookie cookie-prefix ses)]~
::
now
~
@ -1148,7 +1232,7 @@
++ teba |*(a=$+(* ..ix) |*(b=* %_(done ..ix (a b))))
++ give-json (teba ^give-json)
++ hurl-note
|= [a=[hasp path] b=note] ^+ ..ix
|= [a=[dock path] b=note] ^+ ..ix
=: med (~(put to med) hen)
hen `~
==
@ -1160,23 +1244,24 @@
[+(p.eve) (~(put by q.eve) p.eve a)]
::
++ new-mess
|= [a=hasp b=wire c=cage] ^+ ..ix
(hurl-note [a b] [%g %mess [- + ~]:a him c])
|= [a=dock b=wire c=cage] ^+ ..ix
(hurl-note [a b] [%g %deal [him -.a] +.a %poke c])
::
++ add-subs
|= [a=hasp %json b=wire c=path] ^+ ..ix
(hurl-note [a b] [%g %show [- + ~]:a him c])
|= [a=dock %json b=wire c=path] ^+ ..ix
(hurl-note [a b] [%g %deal [him -.a] +.a %peer c])
::
++ del-subs :: XX per path?
|= [a=hasp %json b=wire c=path] ^+ ..ix
(hurl-note [a b] [%g %nuke [- + ~]:a him])
|= [a=dock %json b=wire c=path] ^+ ..ix
=. ..ix (hurl-note [a b] [%g %deal [him -.a] +.a %pull ~])
(nice-json:pop-duct:(ire-ix ire)) :: XX gall ack
::
++ get-rush
|= [a=whir-of b=json] ^+ ..ix
(get-even [%rush [[(slav %p p.a) q.a] r.a] (joba %json b)])
::
++ get-ack
|= [a=whir-of b=$&([%nice ~] [%mean p=ares])] ^+ ..ix
|= [a=whir-of b=honk] ^+ ..ix
?- -.b
%mean
?~ p.b :: XX actually a yawn-told-full
@ -1213,8 +1298,10 @@
==
::
++ pass-took
|= a=[p=hasp wire]
(pass-note(hen `~) [%of ire (gsig a)] [%g %took [- + ~]:p.a him])
|= a=[p=dock wire]
%+ pass-note(hen `~)
[%of ire (gsig a)]
[%g %deal [him -.p.a] +.p.a %pump ~]
::
++ pop-duct =^(ned med ~(get to med) abet(hen ned))
++ poll
@ -1228,7 +1315,7 @@
abet:(give-even & a ven)
::
++ subs-to-json
|= [a=hasp b=path]
|= [a=dock b=path]
%- jobe :~
ship/[%s (rsh 3 1 (scot %p p.a))]
appl/[%s q.a]
@ -1236,7 +1323,7 @@
==
++ wake ^+(..ix abet(ude ~)) :: XX other effects?
:: XX unused
++ print-subs |=([a=hasp b=path] "{<p.a>}/{(trip q.a)}{(spud b)}")
++ print-subs |=([a=dock b=path] "{<p.a>}/{(trip q.a)}{(spud b)}")
-- --
--
. ==
@ -1285,9 +1372,10 @@
|= old=bolo
^+ ..^$
=+ mej=|=(a=* (met 3 (jam a)))
~& :* gub=(mej gub.old) hov=(mej hov.old) ged=(mej ged.old) ded=(mej ded.old)
pox=(mej pox.old) ask=(mej ask.old) kes=(mej kes.old) ney=(mej ney.old)
dop=(mej dop.old) liz=(mej liz.old) wup=(mej wup.old) sop=(mej sop.old)
~& :* gub=(mej gub.old) hov=(mej hov.old) ged=(mej ged.old)
ded=(mej ded.old) pox=(mej pox.old) ask=(mej ask.old)
kes=(mej kes.old) ney=(mej ney.old) dop=(mej dop.old)
liz=(mej liz.old) wup=(mej wup.old) sop=(mej sop.old)
wix=(mej wix.old)
==
..^$(+>- old)
@ -1299,12 +1387,8 @@
::
++ stay `bolo`+>-.$
++ take :: accept response
|= [tea=wire hen=duct hin=(hypo sine)]
|= [tea=wire hen=duct hin=(hypo sign)]
^- [p=(list move) q=_..^$]
?: ?=(%veer +<.q.hin) :: vomit
[[hen %give +.q.hin]~ ..^$]
?: ?=(%vega +<.q.hin) :: vomit
[[hen %give +.q.hin]~ ..^$]
=+ our=`@p`0x100 :: XX sentinel
=+ ska=(slod ski)
=+ sky=|=(* `(unit)`=+(a=(ska +<) ?~(a ~ ?~(u.a ~ [~ u.u.a]))))

89
base/arvo/ford.hoon
View File

@ -7,87 +7,18 @@
:: structures
|%
::
++ bead ,[p=(set beam) q=gage] :: computed result
++ gift :: out result <-$
$% [%made p=@uvH q=(each gage tang)] :: computed result
[%mass p=mass] :: memory usage
[%news ~] :: fresh depends
== ::
++ gift gift-ford :: out result <-$
++ heel path :: functional ending
++ hock :: standard label
$: [%c p=@ud] :: celsius version
[%k p=@ud] :: kelvin version
[%s p=@ud q=@ud r=@ud] :: semantic version
== ::
++ hood :: assembly plan
$: zus=@ud :: zuse kelvin
sur=(list hoot) :: structures
lib=(list hoof) :: libraries
fan=(list horn) :: resources
src=(list hoop) :: program
== ::
++ hoof (pair term (unit (pair case ship))) :: resource reference
++ hoot (pair bean hoof) :: structure gate/core
++ hoop :: source in hood
$% [%& p=twig] :: direct twig
[%| p=beam] :: resource location
== ::
++ horn :: resource tree
$% [%ape p=twig] :: /~ twig by hand
[%arg p=twig] :: /$ argument
[%day p=horn] :: /| list by @dr
[%dub p=term q=horn] :: /= apply face
[%fan p=(list horn)] :: /. list
[%for p=path q=horn] :: /, descend
[%hel p=@ud q=horn] :: /% propagate heel
[%hub p=horn] :: /@ list by @ud
[%man p=(map span horn)] :: /* hetero map
[%nap p=horn] :: /_ homo map
[%now p=horn] :: /& list by @da
[%saw p=twig q=horn] :: /; operate on
[%see p=beam q=horn] :: /: relative to
[%sic p=tile q=horn] :: /^ cast
[%toy p=mark] :: /mark/ static
== ::
++ kiss :: in request ->$
$% [%exec p=@p q=beak r=(unit silk)] :: make / kill
[%wasp p=@p q=@uvH] :: depends query
[%wegh ~] :: report memory
== ::
++ milk (trel ship desk silk) :: sourced silk
++ kiss kiss-ford :: in request ->$
++ move ,[p=duct q=(mold note gift)] :: local move
++ note :: out request $->
$% $: %c :: to %clay
$% [%warp p=sock q=riff] ::
== == == ::
++ riff ,[p=desk q=(unit rave)] :: see %clay
++ sign :: in result $<-
$% $: %c :: by %clay
$% [%writ p=riot] ::
== == == ::
++ silk :: construction layer
$& [p=silk q=silk] :: cons
$% [%bake p=mark q=beam r=path] :: local synthesis
[%boil p=mark q=beam r=path] :: general synthesis
[%bunt p=mark] :: example of mark
[%call p=silk q=silk] :: slam
[%cast p=mark q=silk] :: translate
[%diff p=silk q=silk] :: diff
[%done p=(set beam) q=gage] :: literal
[%dude p=tank q=silk] :: error wrap
[%dune p=(set beam) q=(unit gage)] :: unit literal
[%file p=beam] :: from clay
[%join p=mark q=silk r=silk] :: merge
[%mash p=mark q=milk r=milk] :: annotate
[%mute p=silk q=(list (pair wing silk))] :: mutant
[%pact p=silk q=silk] :: patch
[%plan p=beam q=spur r=hood] :: structured assembly
[%reef ~] :: kernel reef
[%ride p=twig q=silk] :: silk thru twig
[%tabl p=(list (pair silk silk))] :: list
[%vale p=mark q=ship r=*] :: validate [our his]
[%volt p=(set beam) q=(cask ,*)] :: unsafe add type
== ::
-- ::
|% :: structures
++ axle :: all %ford state
@ -299,8 +230,11 @@
|= dep=@uvH
?~ dep
~&(dep-empty/hen +>.$)
?: =(dep 0vtest) :: upstream testing
+>.$(mow :_(mow [hen %give %news ~]))
=+ dap=(~(get by deh.bay) dep)
?~ dap ~&(dep-missed/dep +>.$) :: XX ~| !!
:: ~& awap/[dep u.dap]
?- -.u.dap
%done +>.$(mow :_(mow [hen %give %news ~]))
%sent
@ -379,7 +313,7 @@
%0
=^ cux p.hoc ((calk p.hoc) sem q.q.hoc)
?^ cux
[p=p.hoc q=[%0 p=p.q.hoc q=((calf sem) u.cux)]]
[p=p.hoc q=[%0 p=dep.p.u.cux q=((calf sem) u.cux)]]
=+ nuf=(cope hoc fun)
?- -.q.nuf
%2 nuf
@ -1124,6 +1058,7 @@
(fine cof [p.kas u.vux])
::
%boil
^- (bolt gage)
%+ cool |.(leaf/"ford: boil {<p.kas>} {<(tope q.kas)>} {<r.kas>}")
%+ cope (lamp cof q.kas)
|= [cof=cafe bem=beam]
@ -1178,9 +1113,17 @@
$(kas [%done p.kas u.q.kas])
::
%file
%+ cool |.(leaf/"ford: file {<p.kas>}")
(lear cof p.kas)
::
%flag
?~ p.kas $(kas q.kas)
=+ dap=(~(get by deh.bay) p.kas)
?~ dap ~&(flag-missed/p.kas $(kas q.kas))
=+ dep=?-(-.u.dap %init p.u.dap, %sent q.u.dap, %done [[bek ~] ~ ~])
=+ rez=$(kas q.kas) :: XX revisit ^ during dependency review
?: ?=(%1 -.q.rez) rez
rez(p.q (~(uni in p.q.rez) `(set beam)`dep))
::
%join
%+ cool

2264
base/arvo/gall.hoon
View File

File diff suppressed because it is too large Load Diff

23
base/arvo/hoon.hoon
View File

@ -2733,6 +2733,10 @@
=|([p=@ q=@] |.((add p (mul wuc q))))
tyd
::
++ flag
|= [sic=@t non=@t]
;~(pose (cold %& (jest sic)) (cold %| (jest non)))
::
++ ifix
|* [fel=[p=_rule q=_rule] hof=_rule]
;~(pfix p.fel ;~(sfix hof q.fel))
@ -2745,7 +2749,15 @@
|* [bus=_rule fel=_rule]
;~(plug fel (star ;~(pfix bus fel)))
::
++ pick
|* [a=_rule b=_rule]
;~ pose
(stag %& a)
(stag %| b)
==
::
++ plus |*(fel=_rule ;~(plug fel (star fel)))
++ punt |*([a=_rule] ;~(pose (stag ~ a) (easy ~)))
++ slug
|* raq=_|*([a=* b=*] [a b])
|* [bus=_rule fel=_rule]
@ -9623,7 +9635,6 @@
a ::
== ::
++ kirk (unit (set monk)) :: audience
++ khan ,[p=@tas q=@ta] :: foreign identity
++ lens :: observation core
$_ ^? ::
|% ++ u *(unit (unit ,~)) :: existence
@ -9641,7 +9652,7 @@
++ mass (pair cord (each noun (list ,mass))) :: memory usage
++ mill (each vase milt) :: vase/metavase
++ milt ,[p=* q=*] :: metavase
++ monk (each ship khan) :: general identity
++ monk (each ship ,[p=@tas q=@ta]) :: general identity
++ mold :: new kernel action
|* [a=$+(* *) b=$+(* *)] :: forward/reverse
$% [%pass p=path q=a] :: advance
@ -9655,6 +9666,7 @@
++ pane (list ,[p=@tas q=vase]) :: kernel modules
++ pone (list ,[p=@tas q=vise]) :: kernel modules, old
++ ship ,@p :: network identity
++ sink (trel bone ship path) :: subscription
++ sled $+ [(unit (set monk)) term beam] :: namespace function
(unit (unit cage)) ::
++ slad $+ [(unit (set monk)) term beam] :: undertyped
@ -9668,7 +9680,12 @@
mev=type :: -:!>([%meta *vase])
== ::
++ wire path :: event pretext
::::: hacks
::::: hacks and tools
++ pale |= [hid=hide fun=$+(sink ?)] :: filter peers
(skim (~(tap by sup.hid)) fun)
++ prix |= pax=path |= sink ^- ? :: filter gate
?~ pax & ?~ r.+< | ::
&(=(i.pax i.r.+<) $(pax t.pax, r.+< t.r.+<)) ::
++ slod
|= sed=slad
^- slut

7
base/arvo/time.hoon
View File

@ -12,12 +12,7 @@
== ::
++ broq |* [a=_,* b=_,*] :: brodal skew qeu
(list (sqeu a b)) ::
++ weight
(each noun (list (pair tape weight)))
++ gift :: out result <-$
$% [%mass p=mass] :: memory usage
[%wake ~] :: wakey-wakey
== ::
++ gift gift-time :: out result <-$
++ kiss :: in request ->$
$% [%rest p=@da] :: cancel alarm
[%wait p=@da] :: set alarm

341
base/arvo/zuse.hoon
View File

@ -1746,7 +1746,7 @@
%+ rap 3 :- (wack a)
(turn b |=(c=span (cat 3 '_' (wack c))))
::
++ pick :: light path decoding
++ puck :: light path decoding
=+ fel=(most cab (sear wick urt:ab))
|=(a=span `(unit ,[p=term q=path])`(rush a fel))
::
@ -1767,7 +1767,7 @@
%pawn `@p`0
==
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 3bI, Arvo models ::
:: section 3bI, Arvo structures ::
::
++ acru :: asym cryptosuite
$_ ^? |% :: opaque object
@ -1887,7 +1887,7 @@
wab=(map ship bath) :: relationship
== ::
++ cred :: credential
$: hut=hoot :: client host
$: hut=hart :: client host
aut=(jug ,@tas ,@t) :: client identities
orx=oryx :: CSRF secret
acl=(unit ,@t) :: accept-language
@ -2001,7 +2001,6 @@
++ hiss ,[p=purl q=moth] :: outbound request
++ hist ,[p=@ud q=(list ,@t)] :: depth texts
++ hole ,@t :: session identity
++ hoot ,[p=? q=(unit ,@ud) r=host] :: secure/port/host
++ hort ,[p=(unit ,@ud) q=host] :: http port/host
++ host $%([& p=(list ,@t)] [| p=@if]) :: http host
++ hoke %+ each ,[%localhost ~] :: local host
@ -2263,4 +2262,338 @@
++ wund (list ,[p=life q=ring r=acru]) :: mace in action
++ will (list deed) :: certificate
++ zuse %310 :: hoon/zuse kelvin
:: ::
:::: :::: this will become `%york`, vane structures.
:: ::
++ gift-ames :: out result <-$
$% [%hear p=lane q=@] :: receive packet
[%init p=@p] :: report install
[%mass p=mass] :: memory usage
[%send p=lane q=@] :: transmit packet
[%waft p=sock q=*] :: response message
[%wart p=sock q=@tas r=path s=*] :: network request
[%went p=ship q=cape] :: reaction message
[%woot p=ship q=coop] :: e2e reaction message
== ::
++ kiss-ames :: in request ->$
$% [%barn ~] :: new unix process
[%crud p=@tas q=(list tank)] :: error with trace
[%cash p=@p q=buck] :: civil license
[%hear p=lane q=@] :: receive packet
[%hole p=lane q=@] :: packet failed
[%junk p=@] :: entropy
[%kick p=@da] :: wake up
[%make p=(unit ,@t) q=@ud r=@ s=?] :: wild license
[%sith p=@p q=@uw r=?] :: imperial generator
[%wake ~] :: timer activate
[%want p=sock q=path r=*] :: send message
[%wegh ~] :: report memory
[%wont p=sock q=path r=*] :: e2e send message
== ::
::
:::: %clay
::
++ khan ::
$: fil=(unit (unit cage)) :: XX see khan-to-soba
dir=(map ,@ta khan) ::
== ::
++ mick (list ,[path (unit mime)])
++ riff ,[p=desk q=(unit rave)] :: request/desist
:::: ::
++ gift-clay :: out result <-$
$% [%ergo p=@p q=@tas r=@ud s=mick] :: version update
[%mass p=mass] :: memory usage
[%mere p=(each (set path) (pair term tang))] :: merge result
[%note p=@tD q=tank] :: debug message
[%writ p=riot] :: response
== ::
++ kiss-clay :: in request ->$
$% [%font p=@p q=@tas r=@p s=@tas] :: set upstream
[%info p=@p q=@tas r=nori] :: internal edit
[%init p=@p] :: report install
[%into p=@p q=@tas r=khan] :: external edit
[%lynx p=@p q=@tas r=(unit ,?)] :: sync to unix
[%merg p=@p q=@tas r=@p s=@tas t=germ] :: merge desks
[%plug p=@p q=@tas r=@p s=@tas] :: unset upstream
[%wart p=sock q=@tas r=path s=*] :: network request
[%warp p=sock q=riff] :: file request
[%wegh ~] :: report memory
== ::
::
::::
::
++ blew ,[p=@ud q=@ud] :: columns rows
++ belt :: old belt
$% [%aro p=?(%d %l %r %u)] :: arrow key
[%bac ~] :: true backspace
[%ctl p=@c] :: control-key
[%del ~] :: true delete
[%met p=@c] :: meta-key
[%ret ~] :: return
[%txt p=(list ,@c)] :: utf32 text
== ::
++ blit :: old blit
$% [%bel ~] :: make a noise
[%clr ~] :: clear the screen
[%hop p=@ud] :: set cursor position
[%lin p=(list ,@c)] :: set current line
[%mor ~] :: newline
[%sag p=path q=*] :: save to jamfile
[%sav p=path q=@] :: save to file
== ::
++ dill-belt :: new belt
$% [%aro p=?(%d %l %r %u)] :: arrow key
[%bac ~] :: true backspace
[%cru p=@tas q=(list tank)] :: echo error
[%ctl p=@] :: control-key
[%del ~] :: true delete
[%met p=@] :: meta-key
[%ret ~] :: return
[%rez p=@ud q=@ud] :: resize, cols, rows
[%txt p=(list ,@c)] :: utf32 text
[%yow p=gill] :: connect to app
== ::
++ dill-blit :: new blit
$% [%bel ~] :: make a noise
[%clr ~] :: clear the screen
[%hop p=@ud] :: set cursor position
[%mor p=(list dill-blit)] :: multiple blits
[%pro p=(list ,@c)] :: show as cursor/line
[%qit ~] :: close console
[%out p=(list ,@c)] :: send output line
[%sag p=path q=*] :: save to jamfile
[%sav p=path q=@] :: save to file
== ::
++ flog :: sent to %dill
$% [%crud p=@tas q=(list tank)] ::
[%heft ~] ::
[%text p=tape] ::
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ gill (pair ship term) :: general contact
::::
++ gift-dill :: out result <-$
$% [%bbye ~] :: reset prompt
[%blit p=(list blit)] :: terminal output
[%init p=@p] :: set owner
[%logo ~] :: logout
[%mass p=mass] :: memory usage
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ kiss-dill :: in request ->$
$% [%belt p=belt] :: terminal input
[%blew p=blew] :: terminal config
[%boot p=*] :: weird %dill boot
[%crud p=@tas q=(list tank)] :: error with trace
[%flog p=flog] :: wrapped error
[%flow p=@tas q=(list gill)] :: terminal config
[%hail ~] :: terminal refresh
[%heft ~] :: memory report
[%hook ~] :: this term hung up
[%harm ~] :: all terms hung up
[%init p=ship] :: after gall ready
[%tick p=@p q=@p] :: initial ticket
[%noop ~] :: no operation
[%talk p=tank] ::
[%text p=tape] ::
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
::
:::: %eyre
::
++ gram :: inter-ship message
$? [[%lon ~] p=hole] :: login request
[[%aut ~] p=hole] :: login reply
[[%hat ~] p=hole q=hart] :: login redirect
[[%get ~] p=@uvH q=[? clip httq]] :: remote request
[[%got ~] p=@uvH q=httr] :: remote response
== ::
:::: ::
++ kiss-eyre :: in request ->$
$% [%born ~] :: new unix process
[%crud p=@tas q=(list tank)] :: XX rethink
[%init p=@p] :: report install
[%them p=(unit hiss)] :: outbound request
[%they p=@ud q=httr] :: inbound response
[%this p=? q=clip r=httq] :: inbound request
[%thud ~] :: inbound cancel
[%wart p=sack q=@tas r=_`[path *]`*gram] :: urbit message
[%wegh ~] :: report memory
== ::
++ gift-eyre :: out result <-$
$% [%mass p=mass] :: memory usage
[%thou p=httr] :: raw http response
[%thus p=@ud q=(unit hiss)] :: http request/cancel
[%veer p=@ta q=path r=@t] :: drop-through
[%vega p=path] :: drop-through
== ::
::
:::: %ford
::
++ hood :: assembly plan
$: zus=@ud :: zuse kelvin
sur=(list hoot) :: structures
lib=(list hoof) :: libraries
fan=(list horn) :: resources
src=(list hoop) :: program
== ::
++ hoof (pair term (unit (pair case ship))) :: resource reference
++ hoot (pair bean hoof) :: structure gate/core
++ hoop :: source in hood
$% [%& p=twig] :: direct twig
[%| p=beam] :: resource location
== ::
++ horn :: resource tree
$% [%ape p=twig] :: /~ twig by hand
[%arg p=twig] :: /$ argument
[%day p=horn] :: /| list by @dr
[%dub p=term q=horn] :: /= apply face
[%fan p=(list horn)] :: /. list
[%for p=path q=horn] :: /, descend
[%hel p=@ud q=horn] :: /% propagate heel
[%hub p=horn] :: /@ list by @ud
[%man p=(map span horn)] :: /* hetero map
[%nap p=horn] :: /_ homo map
[%now p=horn] :: /& list by @da
[%saw p=twig q=horn] :: /; operate on
[%see p=beam q=horn] :: /: relative to
[%sic p=tile q=horn] :: /^ cast
[%toy p=mark] :: /mark/ static
== ::
++ milk (trel ship desk silk) :: sourced silk
++ silk :: construction layer
$& [p=silk q=silk] :: cons
$% [%bake p=mark q=beam r=path] :: local synthesis
[%boil p=mark q=beam r=path] :: general synthesis
[%bunt p=mark] :: example of mark
[%call p=silk q=silk] :: slam
[%cast p=mark q=silk] :: translate
[%diff p=silk q=silk] :: diff
[%done p=(set beam) q=gage] :: literal
[%dude p=tank q=silk] :: error wrap
[%dune p=(set beam) q=(unit gage)] :: unit literal
[%file p=beam] :: from clay
[%flag p=@uvH q=silk] :: re-apply user deps
[%join p=mark q=silk r=silk] :: merge
[%mash p=mark q=milk r=milk] :: annotate
[%mute p=silk q=(list (pair wing silk))] :: mutant
[%pact p=silk q=silk] :: patch
[%plan p=beam q=spur r=hood] :: structured assembly
[%reef ~] :: kernel reef
[%ride p=twig q=silk] :: silk thru twig
[%tabl p=(list (pair silk silk))] :: list
[%vale p=mark q=ship r=*] :: validate [our his]
[%volt p=(set beam) q=(cask ,*)] :: unsafe add type
== ::
::::
++ gift-ford :: out result <-$
$% [%made p=@uvH q=(each gage tang)] :: computed result
[%mass p=mass] :: memory usage
[%news ~] :: fresh depends
== ::
++ kiss-ford :: in request ->$
$% [%exec p=@p q=beak r=(unit silk)] :: make / kill
[%wasp p=@p q=@uvH] :: depends query
[%wegh ~] :: report memory
== ::
::
:::: %gall
::
++ club :: agent action
$% [%peer p=path] :: subscribe
[%poke p=cage] :: apply
[%pull ~] :: unsubscribe
[%pump ~] :: pump yes/no
== ::
++ cuft :: internal gift
$% [%coup p=(unit tang)] :: poke result
[%diff p=cage] :: subscription output
[%quit ~] :: close subscription
[%reap p=(unit tang)] :: peer result
== ::
++ culm :: config action
$% [%load p=scup] :: load/reload
:: [%kick ~] :: restart everything
:: [%stop ~] :: toggle suspend
:: [%wipe ~] :: destroy all state
== ::
++ cush (pair term club) :: internal kiss
++ dude term :: server identity
++ scup (pair ship desk) :: autoupdate
++ well (pair desk term) ::
++ suss (trel dude ,@tas ,@da) :: config report
:::: ::
++ kiss-gall :: incoming request
$% [%conf p=dock q=culm] :: configure app
[%init p=ship] :: set owner
[%deal p=sock q=cush] :: full transmission
[%rote p=sack q=path r=*] :: remote request
[%roth p=sack q=path r=*] :: remote response
[%wegh ~] :: report memory
== ::
++ gift-gall :: outgoing result
$% [%mass p=mass] :: memory usage
[%onto p=(each suss tang)] :: about agent
[%unto p=cuft] :: within agent
[%mack p=(unit tang)] :: message ack
== ::
::
:::: %time
::
++ gift-time :: out result <-$
$% [%mass p=mass] :: memory usage
[%wake ~] :: wakey-wakey
== ::
++ kiss-time :: in request ->$
$% [%rest p=@da] :: cancel alarm
[%wait p=@da] :: set alarm
[%wake ~] :: timer activate
[%wegh ~] :: report memory
== ::
::
:::: %arvo
::
++ gift-arvo :: out result <-$
$? gift-ames
gift-clay
gift-dill
gift-eyre
gift-ford
gift-gall
gift-time
==
++ kiss-arvo :: in request ->$
$? kiss-ames
kiss-clay
kiss-dill
kiss-eyre
kiss-ford
kiss-gall
kiss-time
==
++ note-arvo :: out request $->
$? [@tas %meta vase]
$% [%a kiss-ames]
[%c kiss-clay]
[%d kiss-dill]
[%e kiss-eyre]
[%f kiss-ford]
[%g kiss-gall]
[%t kiss-time]
== ==
++ sign-arvo :: in result $<-
$% [%a gift-ames]
[%c gift-clay]
[%d gift-dill]
[%e gift-eyre]
[%f gift-ford]
[%g gift-gall]
[%t gift-time]
==
--

11
base/cat/helm/start/gate.hook Normal file
View File

@ -0,0 +1,11 @@
::
:::: /hook/gate/start/helm/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[[who=@p dap=term ~] ~]
==
[%helm-start who dap]

12
base/cat/hood/init/gate.hook Normal file
View File

@ -0,0 +1,12 @@
::
:::: /hook/gate/reload/hood/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[~ ~]
==
:- %hood-init
p.bec

11
base/cat/hood/mass/gate.hook Normal file
View File

@ -0,0 +1,11 @@
::
:::: /hook/gate/mass/hood/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[arg=~ ~]
==
[%hood-mass ~]

12
base/cat/hood/merge/gate.hook Normal file
View File

@ -0,0 +1,12 @@
::
:::: /hook/gate/merge/hood/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[[syd=@tas her=@p sud=@tas gem=?([?(%auto germ) ~] ~)] ~]
==
:- %hood-merge
[syd her sud ?~(gem %auto -.gem)]

12
base/cat/hood/reload/gate.hook Normal file
View File

@ -0,0 +1,12 @@
::
:::: /hook/gate/reload/hood/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[arg=(list term) ~]
==
:- %hood-reload
arg

11
base/cat/hood/start/gate.hook Normal file
View File

@ -0,0 +1,11 @@
::
:::: /hook/gate/start/hood/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[[who=@p dap=term ~] ~]
==
[%hood-start who dap]

12
base/cat/hood/sync/gate.hook Normal file
View File

@ -0,0 +1,12 @@
::
:::: /hook/gate/sync/hood/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[arg=[syd=@tas her=@p sud=@tas ~] ~]
==
:- %hood-sync
arg

15
base/cat/hood/unix/gate.hook Normal file
View File

@ -0,0 +1,15 @@
::
:::: /hook/gate/unix/hood/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[[syd=@tas syn=?(~ [? ~])] ~]
==
:+ %hood-unix
syd
?~ syn
~
`-.syn

45
base/dog/hood/begin/gate.hook Normal file
View File

@ -0,0 +1,45 @@
::
:::: /hook/gate/begin/hood/gun
::
/? 314
/- *sole
::
::::
!:
=> |%
++ begs ,[his=@p tic=@p yen=@t ges=gens]
--
|= $: [now=@da eny=@uvI bec=beak]
[~ ~]
==
^- (sole-result (cask begs))
%+ sole-lo
[%& %hood-begin "your ship: ~"]
%+ sole-go fed:ag
|= his=@p
%+ sole-lo
[%& %hood-ticket "your ticket: ~"]
%+ sole-go fed:ag
|= tic=@p
%+ sole-lo
[%& %hood-entropy "some entropy: "]
%+ sole-go (boss 256 (more gon qit))
|= yen=@t
=+ ney=(shax yen)
%+ sole-yo `tank`[%leaf "entropy check: {(scow %p `@p`(mug ney))}"]
%+ sole-so %hood-begin
:* his
tic
ney
::
^- gens
:- %en
=+ can=(clan his)
?- can
%czar [%czar ~]
%duke [%duke %anon ~]
%earl [%earl (scot %p his)]
%king [%king ?:(=(~doznec his) 'Urban Republic' (scot %p his))]
%pawn [%pawn ~]
==
==

12
base/dog/hood/reload/gate.hook Normal file
View File

@ -0,0 +1,12 @@
::
:::: /hook/gate/reload/hood/gun
::
/? 314
/- *sole
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[arg=(list term) ~]
==
(sole-so %hood-reload arg)

12
base/dog/hood/reset/gate.hook Normal file
View File

@ -0,0 +1,12 @@
::
:::: /hook/gate/reset/hood/gun
::
/? 314
/- *sole
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[~ ~]
==
(sole-so %hood-reset ~)

13
base/dog/hood/verb/gate.hook Normal file
View File

@ -0,0 +1,13 @@
::
:::: /hook/gate/verb/hood/gun
::
/? 314
/- *sole
::
::::
!:
|= $: [now=@da eny=@ bec=beak]
[~ ~]
==
~& %hood-verb
(sole-so %hood-verb ~)

1
base/dog/solid/gate.hook
View File

@ -21,7 +21,6 @@
=+ all=.*(0 ken)
=+ ^= vay ^- (list ,[p=@tas q=@tas])
:~ [%$ %zuse]
[%b %behn]
[%g %gall]
[%f %ford]
[%a %ames]

57
base/lib/base.css
View File

@ -104,23 +104,29 @@ code,
}
#c {
width: 24rem;
width: 32rem;
margin-left: -16rem;
position: absolute;
left: 50%;
margin-left: -12rem;
}
h1 {
font-size: 1.6rem;
font-weight: 500;
}
h1:after {
content: "\2014";
margin-left: 1rem;
}
#c pre {
font-size: .6rem;
}
#c.err {
width: 32rem;
margin-left: -16rem;
margin-top: 2rem;
}
#pass {
width: 24rem;
width: 32rem;
}
button {
@ -131,17 +137,32 @@ button {
font-weight: 500;
}
#ship,
input {
font-family: "scp";
.sig {
font-weight: 400;
font-size: 2rem;
display: inline;
border: none;
background-color: #f5f5f5;
padding: .3rem;
outline: none;
vertical-align: middle;
}
#ship:focus,
input:focus {
background-color: #eee;
span#ship {
font-family: 'bau';
font-weight: 400;
font-size: 1.2rem;
text-transform: uppercase;
letter-spacing: .1rem;
display: inline-block;
min-width: 1rem;
}
input {
font-family: 'scp';
display: inline;
}
span#ship,
input {
border: none;
padding: .3rem;
outline: none;
border-bottom: 3px solid #555;
}

815
base/lib/drum/core.hook Normal file
View File

@ -0,0 +1,815 @@
:: :: ::
:::: /hook/core/drum/lib :: ::
:: :: ::
/? 310 :: version
!: :: ::
:::: :: ::
:: :: ::
|% :: ::
++ drum-part ,[%drum %0 drum-pith] ::
++ drum-pith ::
$: eel=(set gill) :: connect to
ray=(set well) ::
fur=(map dude (unit server)) :: servers
bin=(map bone source) :: terminals
== ::
++ drum-start well :: start (local) server
:: :: ::
:::: :: ::
:: :: ::
++ server :: running server
$: syd=desk :: app identity
cas=case :: boot case
== ::
++ source :: input device
$: edg=_80 :: terminal columns
off=@ud :: window offset
kil=(unit (list ,@c)) :: kill buffer
maz=master :: master window
inx=@ud :: ring index
fug=(map gill (unit target)) :: connections
mir=(pair ,@ud (list ,@c)) :: mirrored terminal
== ::
++ master :: master buffer
$: liv=? :: master is live
tar=target :: master target
== ::
++ history :: past input
$: pos=@ud :: input position
num=@ud :: number of entries
lay=(map ,@ud (list ,@c)) :: editing overlay
old=(list (list ,@c)) :: entries proper
== ::
++ search :: reverse-i-search
$: pos=@ud :: search position
str=(list ,@c) :: search string
== ::
++ target :: application target
$: ris=(unit search) :: reverse-i-search
hit=history :: all past input
pom=sole-prompt :: static prompt
inp=sole-command :: input state
== ::
++ ukase :: master command
$% [%add p=(list gill)] :: attach to
[%del p=(list gill)] :: detach from
[%new p=(list well)] :: create
== ::
:: :: ::
:::: :: ::
:: :: ::
++ deft-apes :: default servers
|= our=ship
%- ~(gas in *(set well))
=+ myr=(clan our)
?: =(%pawn myr)
[[%base %dojo] ~]
?: =(%earl myr) ~
[[%home %dojo] [%home %talk] ~]
::
++ deft-fish :: default connects
|= our=ship
%- ~(gas in *(set gill))
^- (list gill)
=+ myr=(clan our)
?: =(%pawn myr)
[[our %dojo] ~]
?: =(%earl myr)
=+ dad=(sein our)
[[dad %dojo] [dad %talk] ~]
[[our %dojo] [our %talk] ~]
::
++ deft-mast :: default master
|= our=ship
^- master
:* %&
*(unit search)
*history
[%& %sole "{(scow %p our)}# "]
*sole-command
==
::
++ deft-pipe :: default source
|= our=ship ::
^- source ::
:* 80 :: edg
0 :: off
~ :: kil
(deft-mast our) :: maz
0 :: inx
~ :: fug
[0 ~] :: mir
==
::
++ deft-tart *target :: default target
++ drum-port :: initial part
|= our=ship
^- drum-part
:* %drum
%0
(deft-fish our) :: eel
(deft-apes our) :: ray
~ :: fur
~ :: bin
== ::
::
++ drum-path :: encode path
|= gyl=gill
[%drum (scot %p p.gyl) q.gyl ~]
::
++ drum-phat :: decode path
|= way=wire ^- gill
?>(?=([@ @ ~] way) [(slav %p i.way) i.t.way])
::
++ drum-work :: work in drum
|= [[hide from] drum-part]
=+ (fall (~(get by bin) ost) (deft-pipe our))
=> |% :: arvo structures
++ pear :: request
$% [%sole-action p=sole-action] ::
== ::
++ lime :: update
$% [%dill-blit dill-blit] ::
== ::
++ card :: general card
$% [%conf wire dock %load ship term] ::
[%diff lime] ::
[%peer wire dock path] ::
[%poke wire dock pear] ::
[%pull wire dock ~] ::
[%pass wire note] ::
== ::
++ move (pair bone card) :: user-level move
++ sp :: command parser
|% ++ sp-ukase
%+ knee *ukase |. ~+
;~ pose
(stag %add ;~(pfix lus sp-gills))
(stag %del ;~(pfix hep sp-gills))
(stag %new ;~(pfix tar sp-wells))
==
::
++ sp-gills
;~ pose
(most ;~(plug com ace) sp-gill)
%+ cook
|= a=ship
[[a %dojo] [a %talk] ~]
;~(pfix sig fed:ag)
==
::
++ sp-gill
;~ pose
(stag our sym)
;~ plug
;~(pfix sig fed:ag)
;~(pfix fas sym)
==
==
++ sp-well
;~ pose
(stag %home sym)
;~(plug sym ;~(pfix fas sym))
==
++ sp-wells (most ;~(plug com ace) sp-well)
--
--
|_ [moz=(list move) biz=(list dill-blit)]
++ diff-sole-effect ::
|= [way=wire fec=sole-effect] =< se-abet
=+ gyl=(drum-phat way)
?: (se-aint gyl) +>.$
(se-diff gyl fec)
::
++ peer ::
|= pax=path =< se-abet
^+ +>
?. ?| =(our src) :: ourself
&(=(%duke (clan our)) =(our (sein src))) :: or our own yacht
== ::
~| [%drum-unauthorized our/our src/src] :: very simplistic
!!
se-view:(se-text "[{<src>}, driving {<our>}]")
::
++ poke-dill-belt ::
|= bet=dill-belt
=< se-abet =< se-view
(se-belt bet)
::
++ poke-start ::
|= wel=well
=< se-abet =< se-view
(se-born wel)
::
++ reap ::
|= [way=wire saw=(unit tang)]
=< se-abet =< se-view
=+ gyl=(drum-phat way)
?~ saw
(se-join gyl)
(se-dump:(se-drop & gyl) u.saw)
::
++ take-coup ::
|= [way=wire saw=(unit tang)]
=< se-abet =< se-view
?~ saw +>
=+ gyl=(drum-phat way)
?: (se-aint gyl) +>.$
~& [%drum-coup-fail src ost gyl u.saw]
(se-dump:(se-drop & gyl) u.saw)
::
++ take-onto ::
|= [way=wire saw=(each suss tang)]
=< se-abet =< se-view
?> ?=([@ @ ~] way)
?> (~(has by fur) i.t.way)
=+ wel=`well`[i.way i.t.way]
?- -.saw
%| (se-dump p.saw)
%& ?> =(q.wel p.p.saw)
=. +>.$ (se-text "[{<p.saw>}]")
+>.$(fur (~(put by fur) q.wel `[p.wel %da r.p.saw]))
==
::
++ quit
|= way=wire
=< se-abet =< se-view
=+ gyl=(drum-phat way)
~& [%drum-quit src ost gyl]
(se-drop %| gyl)
:: :: ::
:::: :: ::
:: :: ::
++ se-abet :: resolve
^- (quip move *drum-part)
=. . se-adze:se-adit
:_ %_(+>+>+<+ bin (~(put by bin) ost `source`+>+<))
^- (list move)
%+ welp (flop moz)
^- (list move)
?~ biz ~
[ost %diff %dill-blit ?~(t.biz i.biz [%mor (flop biz)])]~
::
++ se-adit :: update servers
=+ yar=(~(tap by ray))
|- ^+ +>
?~ yar +>
=+ hig=(~(get by fur) q.i.yar)
?: &(?=(^ hig) |(?=(~ u.hig) =(p.i.yar syd.u.u.hig))) $(yar t.yar)
%= $
yar t.yar
+>
%- se-emit(fur (~(put by fur) q.i.yar ~))
[ost %conf [%drum p.i.yar q.i.yar ~] [our q.i.yar] %load our p.i.yar]
==
::
++ se-adze :: update connections
=+ lee=(~(tap by eel))
|- ^+ +>
?~ lee +>
?: (~(has by fug) i.lee) $(lee t.lee)
$(lee t.lee, +> (se-peer i.lee))
::
++ se-aint :: ignore result
|= gyl=gill
^- ?
?. (~(has by bin) ost) &
=+ gyr=(~(get by fug) gyl)
|(?=(~ gyr) ?=([~ ~] gyr))
::
++ se-alas :: recalculate index
|= gyl=gill
^+ +>
=+ [xin=0 wag=se-amor]
?: =(~ wag) +>.$(inx 0)
|- ^+ +>.^$
?~ wag +>.^$(inx 0)
?: =(i.wag gyl) +>.^$(inx xin)
$(wag t.wag, xin +(xin))
::
++ se-amor :: live targets
^- (list gill)
(skim (~(tap in eel)) |=(gill ?=([~ ~ *] (~(get by fug) +<))))
::
++ se-anon :: rotate index
=+ wag=se-amor
?~ wag +
:: ~& [%se-anon inx/inx wag/wag nex/(mod +(inx) (lent se-amor))]
+(inx (mod +(inx) (lent se-amor)))
::
++ se-agon :: current gill
^- (unit gill)
=+ wag=se-amor
?~ wag ~
`(snag inx se-amor)
::
++ se-belt :: handle input
|= bet=dill-belt
^+ +>
?: ?=(%rez -.bet)
+>(edg (dec p.bet))
?: ?=(%yow -.bet)
~& [%no-yow -.bet]
+>
=+ gul=se-agon
=+ tur=`(unit (unit target))`?~(gul ~ (~(get by fug) u.gul))
?: &(!liv.maz |(=(~ gul) =(~ tur) =([~ ~] tur))) (se-blit %bel ~)
=+ ^= taz
?: liv.maz
~(. ta [& %& `gill`(fall gul [our %none])] `target`tar.maz)
~(. ta [& %| (need gul)] `target`(need (need tur)))
=< ta-abet
?- -.bet
%aro (ta-aro:taz p.bet)
%bac ta-bac:taz
%cru (ta-cru:taz p.bet q.bet)
%ctl (ta-ctl:taz p.bet)
%del ta-del:taz
%met (ta-met:taz p.bet)
%ret ta-ret:taz
%txt (ta-txt:taz p.bet)
==
::
++ se-born :: new server
|= wel=well
^+ +>
?: (~(has in ray) wel)
(se-text "[already running {<p.wel>}/{<q.wel>}]")
+>(ray (~(put in ray) wel), eel (~(put in eel) [our q.wel]))
::
++ se-dump :: print tanks
|= tac=(list tank)
^+ +>
=+ wol=`wall`(zing (turn tac |=(a=tank (~(win re a) [0 edg]))))
|- ^+ +>.^$
?~ wol +>.^$
$(wol t.wol, +>.^$ (se-blit %out (tuba i.wol)))
::
++ se-drop :: disconnect
|= [pej=? gyl=gill]
^+ +>
=+ lag=se-agon
?. (~(has by fug) gyl) +>.$
=. fug (~(del by fug) gyl)
=. eel ?.(pej eel (~(del in eel) gyl))
=. +>.$ ?. &(?=(^ lag) !=(gyl u.lag))
+>.$(inx 0)
(se-alas u.lag)
=. +>.$ (se-text "[detached from {<gyl>}]")
se-prom(liv.maz ?~(fug & liv.maz))
::
++ se-joke :: prepare connection
|= gyl=gill
^+ +>
=+ lag=se-agon
?~ lag +>.$
?: =(~ fug) +>.$
(se-alas(fug (~(put by fug) gyl ~)) u.lag)
::
++ se-join :: confirm connection
|= gyl=gill
^+ +>
=. +> (se-text "[connected to {<gyl>}]")
?> =(~ (~(got by fug) gyl))
(se-alas:se-prom(liv.maz |, fug (~(put by fug) gyl `*target)) gyl)
::
++ se-nuke :: teardown
|= gyl=gill
^+ +>
(se-drop:(se-pull(liv.maz |) gyl) & gyl)
::
++ se-like :: act in master
|= kus=ukase
?- -.kus
%add
|- ^+ +>.^$
?~ p.kus +>.^$
$(p.kus t.p.kus, +>.^$ (se-link i.p.kus))
::
%del
|- ^+ +>.^$
?~ p.kus +>.^$
$(p.kus t.p.kus, +>.^$ (se-nuke i.p.kus))
::
%new
|- ^+ +>.^$
?~ p.kus +>.^$
$(p.kus t.p.kus, +>.^$ (se-born i.p.kus))
==
::
++ se-plot :: status line
^- tape
=+ lag=se-agon
=+ ^= pry
|= gill ^- tape
=+((trip q.+<) ?:(=(our p.+>-) - :(welp (scow %p p.+>-) "/" -)))
=+ ^= yey
|= gill ^- tape
=+((pry +<) ?:(=(lag `+>-) ['*' -] -))
=+ ^= yal ^- (list tape)
%+ weld
^- (list tape)
%+ turn (~(tap by fug))
|= [a=gill b=(unit target)]
=+ c=(yey a)
?~(b ['?' c] c)
^- (list tape)
%+ turn (skip (~(tap by fur)) |=([term *] (~(has by fug) [our +<-])))
|=([term *] ['-' (pry our +<-)])
|- ^- tape
?~ yal ~
?~ t.yal i.yal
:(welp i.yal ", " $(yal t.yal))
::
++ se-prom :: update drum prompt
^+ .
=+ mux=se-plot
%_ +
cad.pom.tar.maz
(welp (scow %p our) ?~(mux "# " :(welp ":" mux "# ")))
==
::
++ se-link :: connect to app
|= gyl=gill
+>(eel (~(put in eel) gyl))
::
++ se-blit :: give output
|= bil=dill-blit
+>(biz [bil biz])
::
++ se-show :: show buffer, raw
|= lin=(pair ,@ud (list ,@c))
^+ +>
?: =(mir lin) +>
=. +> ?:(=(q.mir q.lin) +> (se-blit %pro q.lin))
=. +> ?:(=(p.mir p.lin) +> (se-blit %hop p.lin))
+>(mir lin)
::
++ se-just :: adjusted buffer
|= lin=(pair ,@ud (list ,@c))
^+ +>
=. off ?:((lth p.lin edg) 0 (sub p.lin edg))
(se-show (sub p.lin off) (scag edg (slag off q.lin)))
::
++ se-view :: flush buffer
?: liv.maz
(se-just ~(ta-vew ta [& & ~zod %$] tar.maz))
=+ gul=se-agon
?~ gul se-view(liv.maz &)
=+ gyr=(~(get by fug) u.gul)
?~ gyr se-view(liv.maz &)
?~ u.gyr se-view(liv.maz &)
%- se-just
~(ta-vew ta [& | u.gul] u.u.gyr)
::
++ se-emit :: emit move
|= mov=move
%_(+> moz [mov moz])
::
++ se-text :: return text
|= txt=tape
(se-blit %out (tuba txt))
::
++ se-poke :: send a poke
|= [gyl=gill par=pear]
(se-emit ost %poke (drum-path gyl) gyl par)
::
++ se-peer :: send a peer
|= gyl=gill
(se-emit(fug (~(put by fug) gyl ~)) ost %peer (drum-path gyl) gyl /sole)
::
++ se-pull :: cancel subscription
|= gyl=gill
(se-emit ost %pull (drum-path gyl) gyl ~)
::
++ se-tame :: switch connection
|= gyl=gill
^+ ta
~(. ta [& %| gyl] (need (~(got by fug) gyl)))
::
++ se-diff :: receive results
|= [gyl=gill fec=sole-effect]
^+ +>
ta-abet:(ta-fec:(se-tame gyl) fec)
::
++ ta :: per target
|_ $: $: liv=? :: don't delete
mav=? :: showing master
gyl=gill :: target app
== ::
target :: target state
== ::
++ ta-abet :: resolve
^+ ..ta
=. liv.maz mav
?: mav
?. liv
(se-blit `dill-blit`[%qit ~])
se-prom:+>(tar.maz +<+)
?. liv
=. ..ta (se-nuke gyl)
..ta(liv.maz =(~ fug))
..ta(fug (~(put by fug) gyl ``target`+<+))
::
++ ta-ant :: toggle master
^+ .
?: mav
?: =(~ fug) ta-bel
%_ .
mav |
+<+ (need (~(got by fug) gyl))
tar.maz +<+
==
%_ .
mav &
+<+ tar.maz
fug (~(put by fug) gyl `+<+)
==
::
++ ta-act :: send action
|= act=sole-action
^+ +>
?: mav
+>.$
+>.$(+> (se-poke gyl %sole-action act))
::
++ ta-aro :: hear arrow
|= key=?(%d %l %r %u)
^+ +>
?- key
%d =. ris ~
?. =(num.hit pos.hit)
(ta-mov +(pos.hit))
?: =(0 (lent buf.say.inp))
ta-bel
(ta-hom:ta-nex %set ~)
%l ?^ ris ta-bel
?: =(0 pos.inp) ta-bel
+>(pos.inp (dec pos.inp))
%r ?^ ris ta-bel
?: =((lent buf.say.inp) pos.inp)
ta-bel
+>(pos.inp +(pos.inp))
%u =. ris ~
?:(=(0 pos.hit) ta-bel (ta-mov (dec pos.hit)))
==
::
++ ta-bel .(+> (se-blit %bel ~)) :: beep
++ ta-cat :: mass insert
|= [pos=@ud txt=(list ,@c)]
^- sole-edit
:- %mor
|- ^- (list sole-edit)
?~ txt ~
[[%ins pos i.txt] $(pos +(pos), txt t.txt)]
::
++ ta-cut :: mass delete
|= [pos=@ud num=@ud]
^- sole-edit
:- %mor
|-(?:(=(0 num) ~ [[%del pos] $(num (dec num))]))
::
++ ta-det :: send edit
|= ted=sole-edit
^+ +>
(ta-act %det [[his.ven.say.inp own.ven.say.inp] (sham buf.say.inp) ted])
::
++ ta-bac :: hear backspace
^+ .
?^ ris
?: =(~ str.u.ris)
ta-bel
.(str.u.ris (scag (dec (lent str.u.ris)) str.u.ris))
?: =(0 pos.inp)
.(+> (se-blit %bel ~))
=+ pre=(dec pos.inp)
(ta-hom(pos.inp pre) %del pre)
::
++ ta-ctl :: hear control
|= key=@ud
^+ +>
?+ key ta-bel
%a +>(pos.inp 0)
%b (ta-aro %l)
%c ta-bel(ris ~)
%d ?: &(=(0 pos.inp) =(0 (lent buf.say.inp)))
+>(liv |)
ta-del
%e +>(pos.inp (lent buf.say.inp))
%f (ta-aro %r)
%g ta-bel(ris ~)
%k =+ len=(lent buf.say.inp)
?: =(pos.inp len)
ta-bel
%- ta-hom(kil `(slag pos.inp buf.say.inp))
(ta-cut pos.inp (sub len pos.inp))
%l +>(+> (se-blit %clr ~))
%n (ta-aro %d)
%p (ta-aro %u)
%r ?~ ris
+>(ris `[pos.hit ~])
?: =(0 pos.u.ris)
ta-bel
(ta-ser ~)
%t =+ len=(lent buf.say.inp)
?: |(=(0 pos.inp) (lth len 2))
ta-bel
=+ sop=?:(=(len pos.inp) (dec pos.inp) pos.inp)
=. pos.inp +(sop)
%- ta-hom
:~ %mor
[%del sop]
[%ins (dec sop) (snag sop buf.say.inp)]
==
%u ?: =(0 pos.inp)
ta-bel
%- ta-hom(pos.inp 0, kil `(scag pos.inp buf.say.inp))
(ta-cut 0 pos.inp)
%v ta-ant
%x +>(+> se-anon)
%y ?~ kil ta-bel
%- ta-hom(pos.inp (add pos.inp (lent u.kil)))
(ta-cat pos.inp u.kil)
==
::
++ ta-cru :: hear crud
|= [lab=@tas tac=(list tank)]
=. +>+> (se-text (trip lab))
(ta-tan tac)
::
++ ta-del :: hear delete
^+ .
?: =((lent buf.say.inp) pos.inp)
.(+> (se-blit %bel ~))
(ta-hom %del pos.inp)
::
++ ta-erl :: hear local error
|= pos=@ud
ta-bel(pos.inp (min pos (lent buf.say.inp)))
::
++ ta-err :: hear remote error
|= pos=@ud
(ta-erl (~(transpose cs say.inp) pos))
::
++ ta-fec :: apply effect
|= fec=sole-effect
^+ +>
?- -.fec
%bel ta-bel
%blk +>
%clr +>(+> (se-blit fec))
%det (ta-got +.fec)
%err (ta-err +.fec)
%mor |- ^+ +>.^$
?~ p.fec +>.^$
$(p.fec t.p.fec, +>.^$ ^$(fec i.p.fec))
%nex ta-nex
%pro (ta-pro +.fec)
%tan (ta-tan p.fec)
%sag +>(+> (se-blit fec))
%sav +>(+> (se-blit fec))
%txt $(fec [%tan [%leaf p.fec]~])
==
::
++ ta-dog :: change cursor
|= ted=sole-edit
%_ +>
pos.inp
=+ len=(lent buf.say.inp)
%+ min len
|- ^- @ud
?- -.ted
%del ?:((gth pos.inp p.ted) (dec pos.inp) pos.inp)
%ins ?:((lte pos.inp p.ted) +(pos.inp) pos.inp)
%mor |- ^- @ud
?~ p.ted pos.inp
$(p.ted t.p.ted, pos.inp ^$(ted i.p.ted))
%nop pos.inp
%set len
==
==
::
++ ta-got :: apply change
|= cal=sole-change
=^ ted say.inp (~(receive cs say.inp) cal)
(ta-dog ted)
::
++ ta-hom :: local edit
|= ted=sole-edit
^+ +>
=. +> (ta-det ted)
=. +> (ta-dog(say.inp (~(commit cs say.inp) ted)) ted)
+>
::
++ ta-met :: meta key
|= key=@ud
~& [%ta-met key]
+>
::
++ ta-mov :: move in history
|= sop=@ud
^+ +>
?: =(sop pos.hit) +>
%+ %= ta-hom
pos.hit sop
lay.hit %+ ~(put by lay.hit)
pos.hit
buf.say.inp
==
%set
%- (bond |.((snag (sub num.hit +(sop)) old.hit)))
(~(get by lay.hit) sop)
::
++ ta-nex :: advance history
%_ .
num.hit +(num.hit)
pos.hit +(num.hit)
ris ~
lay.hit ~
old.hit [buf.say.inp old.hit]
==
::
++ ta-pro :: set prompt
|= pom=sole-prompt
+>(pom pom(cad :(welp (scow %p p.gyl) ":" (trip q.gyl) cad.pom)))
::
++ ta-ret :: hear return
?. mav
(ta-act %ret ~)
=+ txt=(tufa buf.say.inp)
=+ fey=(rose txt sp-ukase:sp)
?- -.fey
%| (ta-erl (lent (tuba (scag p.fey txt))))
%& ?~ p.fey
(ta-erl (lent buf.say.inp))
=. +>+> (se-like u.p.fey)
=. pom pom.tar.maz
(ta-hom:ta-nex %set ~)
==
::
++ ta-ser :: reverse search
|= ext=(list ,@c)
^+ +>
?: |(?=(~ ris) =(0 pos.u.ris)) ta-bel
=+ tot=(weld str.u.ris ext)
=+ dol=(slag (sub num.hit pos.u.ris) old.hit)
=+ sop=pos.u.ris
=+ ^= ser
=+ ^= beg
|= [a=(list ,@c) b=(list ,@c)] ^- ?
?~(a & ?~(b | &(=(i.a i.b) $(a t.a, b t.b))))
|= [a=(list ,@c) b=(list ,@c)] ^- ?
?~(a & ?~(b | |((beg a b) $(b t.b))))
=+ ^= sup
|- ^- (unit ,@ud)
?~ dol ~
?: (ser tot i.dol)
`sop
$(sop (dec sop), dol t.dol)
?~ sup ta-bel
(ta-mov(str.u.ris tot, pos.u.ris (dec u.sup)) (dec u.sup))
::
++ ta-tan :: print tanks
|= tac=(list tank)
=+ wol=`wall`(zing (turn tac |=(a=tank (~(win re a) [0 edg]))))
|- ^+ +>.^$
?~ wol +>.^$
$(wol t.wol, +>+>.^$ (se-text i.wol))
::
++ ta-txt :: hear text
|= txt=(list ,@c)
^+ +>
?^ ris
(ta-ser txt)
%- ta-hom(pos.inp (add (lent txt) pos.inp))
:- %mor
|- ^- (list sole-edit)
?~ txt ~
[[%ins pos.inp i.txt] $(pos.inp +(pos.inp), txt t.txt)]
::
++ ta-vew :: computed prompt
|- ^- (pair ,@ud (list ,@c))
?^ ris
%= $
ris ~
cad.pom
:(welp "(reverse-i-search)'" (tufa str.u.ris) "': ")
==
=- [(add pos.inp (lent p.vew)) (weld (tuba p.vew) q.vew)]
^= vew ^- (pair tape (list ,@c))
?: vis.pom [cad.pom buf.say.inp]
:- ;: welp
cad.pom
?~ buf.say.inp ~
;: welp
"<"
(scow %p (end 4 1 (sham buf.say.inp)))
"> "
==
==
=+ len=(lent buf.say.inp)
|- ^- (list ,@c)
?:(=(0 len) ~ [`@c`'*' $(len (dec len))])
--
--
--

163
base/lib/helm/core.hook Normal file
View File

@ -0,0 +1,163 @@
:: :: ::
:::: /hook/core/helm/lib :: ::
:: :: ::
/? 310 :: version
:: :: ::
:::: :: ::
:: :: ::
|% :: ::
++ helm-part ,[%helm %0 helm-pith] :: helm state
++ helm-pith :: helm content
$: bur=(unit (pair ship mace)) :: requesting ticket
hoc=(map bone helm-session) :: consoles
== ::
++ helm-session ::
$: say=sole-share :: console state
mud=(unit (sole-dialog ,@ud)) :: console dialog
== ::
:: :: ::
:::: :: ::
:: :: ::
++ hood-begin :: begin command
$: his=@p :: identity
tic=@p :: ticket
eny=@t :: entropy
ges=gens :: description
== ::
++ hood-init :: report init
$: him=ship ::
== ::
++ hood-start :: start (local) server
$: syd=desk :: desk
dap=term :: program
== ::
++ hood-reset :: reset command
,~ ::
++ helm-verb :: reset command
,~ ::
++ hood-reload :: reload command
(list term) ::
-- ::
:: :: ::
:::: :: ::
!: :: ::
|% :: helm library
++ helm-work :: work in helm
|= [[hide from] helm-part]
=+ sez=(fall (~(get by hoc) ost) *helm-session)
=> |% :: arvo structures
++ card ::
$% [%cash wire p=@p q=buck] ::
[%conf wire dock %load ship term] ::
[%flog wire flog] ::
[%plug wire @p @tas @p @tas] ::
[%want wire sock path *] :: send message
== ::
++ move (pair bone card) :: user-level move
--
|_ moz=(list move)
++ abet :: resolve
[(flop moz) %_(+>+>+<+ hoc (~(put by hoc) ost sez))]
::
++ emit |=(card %_(+> moz [[ost +<] moz])) :: return card
++ emil :: return cards
|= (list card)
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
++ poke-begin :: make/send keypair
|= hood-begin =< abet
?> ?=(~ bur)
=+ buz=(shax :(mix (jam ges) eny))
=+ loy=(bruw 2.048 buz)
%- emit(bur `[his [0 sec:ex:loy]~])
[%want /helm/ticket [our (sein his)] /q/ta his tic ges pub:ex:loy]
::
++ poke-init :: initialize
|= him=ship =< abet
(emit %flog /helm %crud %hax-init leaf/(scow %p him) ~)
::
++ poke-mass
=< abet
(emit %flog /heft %crud %hax-heft ~)
::
++ poke-start :: start a server
|= hood-start =< abet
(emit %conf /helm [our dap] %load our syd)
::
++ poke-reload :: reload vanes
|= all=(list term) =< abet
%- emil
%- flop
%+ turn all
=+ ark=(arch .^(%cy /(scot %p our)/base/(scot %da lat)/arvo))
=+ van=(~(tap by r.ark))
|= nam=@tas
=. nam
?. =(1 (met 3 nam))
nam
=+ ^- zaz=(list ,[p=span ~])
(skim van |=([a=term ~] =(nam (end 3 1 a))))
?> ?=([[@ ~] ~] zaz)
`term`p.i.zaz
=+ tip=(end 3 1 nam)
=+ way=[(scot %p our) %home (scot %da lat) %arvo nam %hoon ~]
=+ fil=(,@ .^(%cx way))
:* %flog
/reload
[%veer ?:(=('z' tip) %$ tip) way (,@ .^(%cx way))]
==
::
++ poke-reset :: reset system
|= hood-reset =< abet
%- emil
=+ top=`path`/(scot %p our)/base/arvo/(scot %da lat)
:- [%flog /reset %vega (weld top `path`/hoon)]
%+ turn
^- (list ,[p=@tas q=@tas])
:~ [%$ %zuse]
[%a %ames]
[%c %clay]
[%d %dill]
[%e %eyre]
[%f %ford]
[%g %gall]
[%t %time]
==
|= [p=@tas q=@tas]
=+ way=`path`(welp top /[q])
=+ txt=((hard ,@) .^(%cx (welp way /hoon)))
[%flog /reset %veer p way txt]
::
++ poke-will :: hear certificate
|= wil=(unit will)
?> ?=(^ bur)
?> ?=(^ wil)
=< abet
%- emil(bur ~)
:~ [%cash /helm p.u.bur q.u.bur u.wil]
[%plug /helm our %home (sein our) %kids]
==
::
++ poke-verb :: toggle verbose
|= ~ =< abet
(emit %flog /helm %verb ~)
::
++ take-onto :: result of %conf
|= saw=(each suss tang) =< abet
~& [%take-onto saw]
%- emit
?- -.saw
%| [%flog ~ %crud %onto `tang`p.saw]
%& [%flog ~ %text "<{<p.saw>}>"]
==
::
++ take-note :: result of %init
|= [way=wire chr=@tD tan=tank] =< abet
(emit %flog ~ %text chr ' ' ~(ram re tan))
::
++ take-went :: result of %want
|= [way=path her=ship kay=cape] =< abet
(emit %flog ~ %text "went: {<[way kay]>}")
--
--

318
base/lib/kiln/core.hook Normal file
View File

@ -0,0 +1,318 @@
:: :: ::
:::: /hook/core/kiln/lib :: ::
:: :: ::
/? 310 :: version
:: :: ::
:::: :: ::
:: :: ::
|% :: ::
++ kiln-part ,[%kiln %0 kiln-pith] :: kiln state
++ kiln-pith ::
$: rem=(map desk kiln-desk) ::
==
++ kiln-desk :: per-desk state
$: auto=? :: escalate on failure
gem=germ :: strategy
her=@p :: from ship
sud=@tas :: from desk
cas=case :: at case
== ::
:: :: ::
:::: :: ::
:: :: ::
++ hood-unix ::
$: syd=desk ::
syn=(unit bean) ::
== ::
++ hood-sync ::
$: syd=desk ::
her=ship ::
sud=desk ::
== ::
++ hood-merge ::
$: syd=desk ::
ali=ship ::
sud=desk ::
gim=?(%auto germ) ::
== ::
-- ::
:: :: ::
:::: :: ::
!: :: ::
|% :: kiln library
++ kiln-work :: work in kiln
|= [[hide from] kiln-part]
?> =(src our)
=> |% :: arvo structures
++ card ::
$% [%exec wire @p beak (unit silk)] ::
[%font wire @p @tas @p @tas] ::
[%info wire @p @tas nori] ::
[%lynx wire @p @tas (unit ,?)] ::
[%merg wire @p @tas @p @tas germ] ::
[%plug wire @p @tas @p @tas] ::
[%poke wire dock pear] ::
== ::
++ pear :: poke fruit
$% [%talk-command command:talk] ::
[%hood-merge hood-merge] ::
== ::
++ tage :: %tabl gage
,[[%tabl p=(list (pair marc marc))] q=vase] ::
++ move (pair bone card) :: user-level move
--
|_ moz=(list move)
++ abet :: resolve
[(flop moz) `kiln-part`+>+>->]
::
++ emit |=(card %_(+> moz [[ost +<] moz])) :: return card
++ emil :: return cards
|= (list card)
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
++ poke-unix ::
|= hood-unix
abet:(emit %lynx /kiln our syd syn)
::
++ poke-sync ::
|= hood-sync
abet:(emit %font /kiln our syd her sud)
::
++ poke-merge ::
|= hood-merge
abet:abet:(merge:(work syd) ali sud gim)
::
++ take |=(way=wire ?>(?=([@ ~] way) (work i.way))) :: general handler
++ take-mere ::
|= [way=wire are=(each (set path) (pair term tang))]
abet:abet:(mere:(take way) are)
::
++ take-made ::
|= [way=wire dep=@uvH reg=(each gage tang)]
abet:abet:(made:(take way) dep reg)
::
++ take-coup-fancy ::
|= [way=wire saw=(unit tang)]
abet:abet:(coup-fancy:(take way) saw)
::
++ work :: state machine
|= syd=desk
=+ ^- kiln-desk
%+ fall (~(get by rem) syd)
=+ *kiln-desk
%_(- cas [%da lat])
|%
++ abet :: resolve
..work(rem (~(put by rem) syd auto gem her sud cas))
::
++ blab :: emit, XX remove
|= new=(list move)
^+ +>
+>.$(moz (welp new moz))
::
++ win . :: successful poke
++ lose
^+ .
~| %kiln-work-fail
!!
::
++ gage-to-tage ::
|= res=gage
^- tage
?@ p.res
~|(%bad-marc !!)
res
::
++ tage-to-cages ::
|= tab=tage
^- (list (pair cage cage))
?~ p.tab
~
:_ $(p.tab t.p.tab, q.tab (slot 3 q.tab))
~| %strange-gage
:- [?^(p.i.p.tab !! p.i.p.tab) (slot 4 q.tab)]
[?^(q.i.p.tab !! q.i.p.tab) (slot 5 q.tab)]
::
++ perform ::
^+ .
(blab [ost %merg /kiln/[syd] our syd her sud gem] ~)
::
++ fancy-merge :: send to self
|= [syd=desk her=@p sud=desk gem=?(%auto germ)]
^+ +>
%- 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]] ~ ~]
[lat *bouquet:talk [%app (crip ~(ram re tan))]]
==
::
++ merge
|= [her=@p sud=@tas gim=?(%auto germ)]
^+ +>
=. cas [%da lat]
?. ?=(%auto gim)
perform(auto |, gem gim, her her, sud sud)
?: =(0 .^(%cw /(scot %p our)/[syd]/(scot %da lat)))
=> $(gim %init)
.(auto &)
=> $(gim %fine)
.(auto &)
::
++ coup-fancy
|= saw=(unit tang)
?~ saw
=> (spam leaf/"%melding %{(trip sud)} into scratch space" ~)
%- blab :_ ~
[ost %merg /kiln/[syd] our (cat 3 syd '-scratch') her sud gem]
=+ :- "failed to set up conflict resolution scratch space"
"I'm out of ideas"
lose:(spam leaf/-< leaf/-> ~)
::
++ mere
|= are=(each (set path) (pair term tang))
^+ +>
?: =(%meld gem)
?: ?=(%& -.are)
?. auto
=+ "successfully merged with strategy {<gem>}"
win:(spam leaf/- ?~(p.are ~ [>`(set path)`p.are< ~]))
=+ "mashing conflicts"
=> .(+>.$ (spam leaf/- ~))
=+ tic=(cat 3 syd '-scratch')
%- blab :_ ~
:* ost %exec /kiln/[syd]
our [our tic %da lat] ~ %tabl
^- (list (pair silk silk))
%+ turn (~(tap in p.are))
|= pax=path
^- (pair silk silk)
:- [%done ~ %path -:!>(*path) pax]
=+ base=[%file [our tic %da lat] (flop pax)]
=+ alis=[%file [her sud cas] (flop pax)]
=+ bobs=[%file [our syd %da lat] (flop pax)]
=+ dali=[%diff base alis]
=+ dbob=[%diff base bobs]
=+ ^- for=mark
=+ (slag (dec (lent pax)) pax)
?~(- %$ i.-)
[%mash for [her sud dali] [our syd dbob]]
==
=+ "failed to merge with strategy {<p.p.are>}"
lose:(spam leaf/- q.p.are)
?: ?=(%& -.are)
=+ "successfully merged with strategy {<gem>}"
win:(spam leaf/- ?~(p.are ~ [>`(set path)`p.are< ~]))
?. auto
=+ "failed to merge with strategy {<p.p.are>}"
lose:(spam leaf/- q.p.are)
?+ gem
(spam leaf/"strange auto" >gem< ~)
::
%init
=+ :- "auto merge failed on strategy %init"
"I'm out of ideas"
lose:(spam leaf/-< leaf/-> [>p.p.are< q.p.are])
::
%fine
?. ?=(%bad-fine-merge p.p.are)
=+ "auto merge failed on strategy %fine"
lose:(spam leaf/- >p.p.are< q.p.are)
=> (spam leaf/"%fine merge failed, trying %meet" ~)
perform(gem %meet)
::
%meet
?. ?=(%meet-conflict p.p.are)
=+ "auto merge failed on strategy %meet"
lose:(spam leaf/- >p.p.are< q.p.are)
=> (spam leaf/"%meet merge failed, trying %mate" ~)
perform(gem %mate)
::
%mate
?. ?=(%mate-conflict p.p.are)
=+ "auto merge failed on strategy %mate"
lose:(spam leaf/- >p.p.are< q.p.are)
=> .(gem %meld)
=+ tic=(cat 3 syd '-scratch')
=> =+ :- "%mate merge failed with conflicts,"
"setting up scratch space at %{(trip tic)}"
[tic=tic (spam leaf/-< leaf/-> ~)]
(fancy-merge tic our syd %auto)
==
::
++ made
|= [dep=@uvH reg=(each gage tang)]
^+ +>
?: ?=(%| -.reg)
=+ "failed to mash"
lose:(spam leaf/- p.reg)
=+ ^- can=(list (pair path (unit miso)))
%+ turn (tage-to-cages (gage-to-tage p.reg))
|= [pax=cage dif=cage]
^- (pair path (unit miso))
?. ?=(%path p.pax)
~| "strange path mark: {<p.pax>}"
!!
[((hard path) q.q.pax) ?:(?=(%null p.dif) ~ `[%dif dif])]
=+ notated=(skid can |=([path a=(unit miso)] ?=(^ a)))
=+ annotated=(turn `(list (pair path ,*))`-.notated head)
=+ unnotated=(turn `(list (pair path ,*))`+.notated head)
=+ (trip (cat 3 syd '-scratch'))
=+ ^- tan=(list tank)
%- zing
^- (list (list tank))
:~ :~ leaf/""
leaf/"done setting up scratch space in %{-}"
leaf/"please resolve the following conflicts and run"
leaf/":+merge %{(trip syd)} {<our>} %{-}"
==
?~ annotated
~
:~ leaf/""
leaf/"annotated conflicts in:"
>`(list path)`annotated<
==
?~ unnotated
~
:~ leaf/""
leaf/"some conflicts could not be annotated."
leaf/"for these, the scratch space contains"
leaf/"the most recent common ancestor of the"
leaf/"conflicting content."
leaf/""
leaf/"unannotated conflicts in:"
>`(list path)`unnotated<
==
==
=< win
%- blab:(spam tan)
:_ ~
:* ost %info /kiln/[syd]/dash
our (cat 3 syd '-scratch')
%& *cart
%+ murn can
|= [p=path q=(unit miso)]
`(unit (pair path miso))`?~(q ~ `[p u.q])
==
--
--
--

11
base/lib/sole/core.hook
View File

@ -1,8 +1,6 @@
::
:::: /hook/core/sole/lib
::
:: This file is in the public domain.
::
/? 310
/- *sole
!:
@ -37,6 +35,7 @@
::
++ transmute :: dex as after sin
|= [sin=sole-edit dex=sole-edit]
~| [%transmute sin dex]
^- sole-edit
?: ?=(%mor -.sin)
|- ^- sole-edit
@ -58,14 +57,14 @@
?- -.dex
%del ?: =(p.sin p.dex) [%nop ~]
?:((lth p.sin p.dex) dex(p (dec p.dex)) dex)
%ins ?:((lte p.sin p.dex) dex(p (dec p.dex)) dex)
%ins ?:((lth p.sin p.dex) dex(p (dec p.dex)) dex)
==
::
%ins
?- -.dex
%del ?:((lte p.sin p.dex) dex(p +(p.dex)) dex)
%ins ?: =(p.sin p.dex)
?:((gth q.sin q.dex) dex dex(p +(p.dex)))
?:((lth q.sin q.dex) dex dex(p +(p.dex)))
?:((lte p.sin p.dex) dex(p +(p.dex)) dex)
==
==
@ -102,7 +101,9 @@
++ receive :: naturalize event
|= sole-change
^- [sole-edit sole-share]
?> &(=(his.ler his.ven) (lte own.ler own.ven))
?. &(=(his.ler his.ven) (lte own.ler own.ven))
~& [%receive-sync his/[his.ler his.ven] own/[own.ler own.ven]]
!!
?> &(=(his.ler his.ven) (lte own.ler own.ven))
?> |(!=(own.ler own.ven) =(0 haw) =(haw (sham buf)))
=. leg (scag (sub own.ven own.ler) leg)

1
base/lib/talk/core.hook
View File

@ -10,7 +10,6 @@
::
|%
++ main :: main story
|= our=ship ^- cord
=+ can=(clan our)
?+ can %porch

14
base/lib/urb.js
View File

@ -52,6 +52,17 @@ window.urb.req = function(method,url,params,json,cb) {
xhr.send(JSON.stringify(_data))
}
// window.urb.getJSON = function(url,cb){ window.urb.reqJSON("GET",url, null, cb)}
// window.urb.reqJSON = function(method, url, data, cb){
// var xhr = new XMLHttpRequest()
// xhr.open(method, url)
// xhr.onload = function(){
// urb.fetchTag.call(xhr)
// if(cb) cb(JSON.parse(xhr.responseText))
// }
// xhr.send(data === null ? null : JSON.stringify(data))
// }
window.urb.reqq = []
window.urb.qreq = function(method,url,params,json,cb) {
walk = function() {
@ -244,12 +255,11 @@ window.urb.unsubscribe = function(params,cb) {
if(!params.path) throw new Error("You must specify a path for urb.unsubscribe.")
if(!params.appl) throw new Error("You must specify an appl for urb.unsubscribe.")
if(!cb) throw new Error("You must supply a callback to urb.unsubscribe.")
url = "/~/is/"+this.gsig(params)+".json"
method = "delete"
this.req("delete",url,params,true,function(err,res) {
cb(err,res)
if(cb) cb(err,res)
})
}

12
base/mar/acto-game/door.hook Normal file
View File

@ -0,0 +1,12 @@
::
:::: /hook/door/octo-game/mar
::
/? 310
!:
|_ cod=[who=? box=@ boo=@] :: game state
::
++ grab :: convert from
|%
++ noun ,[who=? box=@ boo=@] :: clam from %noun
--
--

11
base/mar/cat-args/door.hook
View File

@ -1,11 +0,0 @@
::
:::: /hoon/core/cat-args/mar
::
/? 314
|_ pax=(list path)
::
++ grab :: convert from
|%
++ noun (list path) :: clam from %noun
--
--

12
base/mar/cp-args/door.hook
View File

@ -1,12 +0,0 @@
::
:::: /hoon/core/cp-args/mar
::
/? 314
/- cp-args
|_ arg=cp-args
::
++ grab :: convert from
|%
++ noun cp-args :: clam from %noun
--
--

12
base/mar/demo-args/door.hook
View File

@ -1,12 +0,0 @@
::
:::: /hoon/core/zing/mar
::
/? 314
/- demo-args
|_ arg=demo-args
::
++ grab :: convert from
|%
++ noun demo-args :: clam from %noun
--
--

11
base/mar/grep-args/door.hook
View File

@ -1,11 +0,0 @@
::
:::: /hoon/core/grep-args/mar
::
/? 314
|_ arg=[cord ~]
::
++ grab :: convert from
|%
++ noun ,[cord ~] :: clam from %noun
--
--

12
base/mar/hi-args/door.hook
View File

@ -1,12 +0,0 @@
::
:::: /hoon/core/zing/pro
::
/? 314
/- hi-args
|_ arg=hi-args
::
++ grab :: convert from
|%
++ noun hi-args :: clam from %noun
--
--

Some files were not shown because too many files have changed in this diff Show More