shrub/arvo/dill.hoon

451 lines
17 KiB
Plaintext
Raw Normal View History

::
2015-05-08 22:43:11 +03:00
:: dill (4d), terminal handling
2013-09-29 00:21:18 +04:00
::
2013-12-15 09:42:27 +04:00
|= pit=vase
2014-06-09 01:27:04 +04:00
=> |% :: interface tiles
2015-03-23 01:46:42 +03:00
++ gill (pair ship term) :: general contact
2015-03-18 19:40:40 +03:00
-- ::
=> |% :: console protocol
2015-05-19 04:16:32 +03:00
++ all-axle ?(old-axle axle) ::
++ old-axle :: all dill state
2015-05-08 22:43:11 +03:00
$: %2 ::
2015-05-06 22:55:47 +03:00
ore=(unit ship) :: identity once set
hey=(unit duct) :: default duct
dug=(map duct axon) :: conversations
2015-05-19 04:16:32 +03:00
== ::
++ axle ::
$: %3 ::
ore=(unit ship) :: identity once set
hey=(unit duct) :: default duct
dug=(map duct axon) :: conversations
$= hef :: other weights
$: a=(unit mass) ::
2015-07-02 00:28:09 +03:00
b=(unit mass) ::
2015-05-19 04:16:32 +03:00
c=(unit mass) ::
e=(unit mass) ::
f=(unit mass) ::
g=(unit mass) ::
== ::
2015-05-06 22:55:47 +03:00
== ::
2015-03-18 19:40:40 +03:00
++ 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
2015-05-12 23:10:22 +03:00
++ gift gift-dill :: out result <-$
2015-05-19 04:16:32 +03:00
++ kiss kiss-dill :: in request ->$
2015-03-18 19:40:40 +03:00
-- => ::
|% :: protocol outward
++ mess ::
$% [%dill-belt p=(hypo dill-belt)] ::
== ::
2014-06-22 09:49:10 +04:00
++ move ,[p=duct q=(mold note gift)] :: local move
2015-03-18 19:40:40 +03:00
++ note-ames :: weird ames move
$% [%make p=(unit ,@t) q=@ud r=@ s=?] ::
[%sith p=@p q=@uw r=?] ::
== ::
2015-04-30 01:48:45 +03:00
++ note-clay ::
2015-06-04 00:18:13 +03:00
$% [%merg p=@p q=@tas r=@p s=@tas t=germ] :: merge desks
2015-04-30 01:48:45 +03:00
[%warp p=sock q=riff] :: wait for clay, hack
2015-03-18 19:40:40 +03:00
== ::
++ note-dill :: note to self, odd
$% [%crud p=@tas q=(list tank)] ::
2015-05-19 04:16:32 +03:00
[%heft ~] ::
2015-04-08 21:27:51 +03:00
[%init p=ship] ::
2015-03-18 19:40:40 +03:00
[%text p=tape] ::
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
2015-05-10 01:55:05 +03:00
++ note-gall ::
2015-05-08 22:43:11 +03:00
$% [%conf dock %load ship desk] ::
2015-05-12 23:10:22 +03:00
[%deal p=sock q=cush] ::
2015-03-18 19:40:40 +03:00
== ::
2015-05-08 22:43:11 +03:00
++ note :: out request $->
2015-07-02 00:28:09 +03:00
$? [?(%a %b %c %e %f %g) %wegh ~] ::
2015-05-08 22:43:11 +03:00
$% [%a note-ames] ::
2015-04-08 21:27:51 +03:00
[%c note-clay] ::
2015-03-18 19:40:40 +03:00
[%d note-dill] ::
[%g note-gall] ::
2015-05-19 04:16:32 +03:00
== == ::
2015-03-18 19:40:40 +03:00
++ sign-ames ::
$% [%nice ~] ::
[%init p=ship] ::
== ::
2015-05-10 01:55:05 +03:00
++ sign-gall :: see %gall
2015-05-08 22:43:11 +03:00
$% [%onto p=(unit tang)] ::
== ::
2015-03-18 19:40:40 +03:00
++ sign-clay ::
2015-04-30 01:48:45 +03:00
$% [%mere p=(each (set path) (pair term tang))] ::
[%note p=@tD q=tank] ::
2015-03-18 19:40:40 +03:00
[%writ p=riot] ::
== ::
2015-03-19 01:01:47 +03:00
++ sign-dill ::
$% [%blit p=(list blit)] ::
== ::
2015-03-18 19:40:40 +03:00
++ sign-gall ::
2015-05-08 22:43:11 +03:00
$% [%onto p=(each suss tang)] ::
[%unto p=cuft] ::
2015-03-18 19:40:40 +03:00
== ::
2014-06-22 09:49:10 +04:00
++ sign :: in result $<-
2015-07-02 00:28:09 +03:00
$? [?(%a %b %c %e %f %g) %mass p=mass] ::
2015-03-18 19:40:40 +03:00
$% [%a sign-ames] ::
[%c sign-clay] ::
2015-03-19 01:01:47 +03:00
[%d sign-dill] ::
2015-03-18 19:40:40 +03:00
[%g sign-gall] ::
2015-05-19 04:16:32 +03:00
== == ::
2014-06-09 01:27:04 +04:00
:::::::: :: dill tiles
2015-03-18 19:40:40 +03:00
--
=| all=axle
|= [now=@da eny=@ ski=sled] :: current invocation
=> |%
++ as :: per cause
|_ $: [moz=(list move) hen=duct our=ship]
axon
==
2015-03-18 19:40:40 +03:00
++ abet :: resolve
^- [(list move) axle]
[(flop moz) all(dug (~(put by dug.all) hen +<+))]
2013-09-29 00:21:18 +04:00
::
2015-03-18 19:40:40 +03:00
++ call :: receive input
|= kyz=kiss
^+ +>
?+ -.kyz ~& [%strange-kiss -.kyz] +>
%flow +>
%harm +>
%hail +>
%belt (send `dill-belt`p.kyz)
2015-03-19 01:01:47 +03:00
%text (from %out (tuba p.kyz))
%crud :: (send `dill-belt`[%cru p.kyz q.kyz])
(crud p.kyz q.kyz)
2015-03-18 19:40:40 +03:00
%blew (send %rez p.p.kyz q.p.kyz)
2015-05-19 04:16:32 +03:00
%heft heft
2015-05-19 21:38:23 +03:00
%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])
==
2015-03-18 19:40:40 +03:00
%veer (dump kyz)
%vega (dump kyz)
%verb (dump kyz)
2013-09-29 00:21:18 +04:00
==
::
2015-03-19 01:01:47 +03:00
++ crud
|= [err=@tas tac=(list tank)]
=+ ^= wol ^- wall
:- (trip err)
2015-06-17 00:01:07 +03:00
(zing (turn (flop tac) |=(a=tank (~(win re a) [0 wid]))))
2015-03-19 01:01:47 +03:00
|- ^+ +>.^$
?~ wol +>.^$
$(wol t.wol, +>.^$ (from %out (tuba i.wol)))
2013-09-29 00:21:18 +04:00
::
2015-03-18 19:40:40 +03:00
++ dump :: pass down to hey
|= git=gift
?> ?=(^ hey.all)
+>(moz [[u.hey.all %give git] moz])
2013-09-29 00:21:18 +04:00
::
2015-03-18 19:40:40 +03:00
++ done :: return gift
|= git=gift
+>(moz :_(moz [hen %give git]))
2015-02-09 00:22:33 +03:00
::
2015-03-18 19:40:40 +03:00
++ from :: receive belt
|= bit=dill-blit
^+ +>
2015-03-25 01:56:11 +03:00
?: ?=(%mor -.bit)
|- ^+ +>.^$
?~ p.bit +>.^$
$(p.bit t.p.bit, +>.^$ ^$(bit i.p.bit))
2015-03-18 19:40:40 +03:00
?: ?=(%out -.bit)
%+ done %blit
:~ [%lin p.bit]
[%mor ~]
[%lin see]
[%hop pos]
2013-09-29 00:21:18 +04:00
==
2015-03-18 19:40:40 +03:00
?: ?=(%pro -.bit)
(done(see p.bit) %blit [[%lin p.bit] [%hop pos] ~])
?: ?=(%hop -.bit)
(done(pos p.bit) %blit [bit ~])
2015-04-01 23:56:43 +03:00
?: ?=(%qit -.bit)
(dump %logo ~)
2015-03-18 19:40:40 +03:00
(done %blit [bit ~])
2013-09-29 00:21:18 +04:00
::
2015-05-19 04:16:32 +03:00
++ heft
%_ .
moz
:* [hen %pass /heft/ames %a %wegh ~]
2015-07-02 00:28:09 +03:00
[hen %pass /heft/behn %b %wegh ~]
2015-05-19 04:16:32 +03:00
[hen %pass /heft/clay %c %wegh ~]
[hen %pass /heft/eyre %e %wegh ~]
[hen %pass /heft/ford %f %wegh ~]
[hen %pass /heft/gall %g %wegh ~]
moz
==
==
::
2015-03-18 19:40:40 +03:00
++ init :: initialize
2015-05-17 05:37:36 +03:00
~& [%dill-init our ram]
2015-03-18 19:40:40 +03:00
=+ myt=(flop (need tem))
=+ can=(clan our)
2015-03-18 19:40:40 +03:00
=. tem ~
2015-06-03 21:06:44 +03:00
=. moz :_(moz [hen %pass / %c %merg our %home our %base %init])
2015-05-14 04:13:13 +03:00
=. moz :_(moz [hen %pass ~ %g %conf [[our ram] %load our %home]])
2015-06-03 21:06:44 +03:00
=. +> ?: ?=(%czar can) +>
(sync %base (sein our) %kids)
=. +> (sync %home our %base)
=. +> ?. ?=(?(%king %czar) can) +>
(sync %kids our %base)
2015-05-20 02:09:37 +03:00
=. +> peer
|- ^+ +>+
?~ myt +>+
$(myt t.myt, +>+ (send i.myt))
2015-03-18 19:40:40 +03:00
::
++ into :: preinitialize
|= gyl=(list gill)
%_ +>
tem `(turn gyl |=(a=gill [%yow a]))
moz
:_ moz
:* hen
2015-04-30 01:48:45 +03:00
%pass
/
%c
[%warp [our our] %base `[%sing %y [%ud 1] /]]
2013-09-29 00:21:18 +04:00
==
==
::
2015-03-18 19:40:40 +03:00
++ send :: send action
|= bet=dill-belt
?^ tem
+>(tem `[bet u.tem])
%_ +>
moz
:_ moz
2015-05-10 01:55:05 +03:00
[hen %pass ~ %g %deal [our our] ram %poke [%dill-belt -:!>(bet) bet]]
2013-09-29 00:21:18 +04:00
==
2015-05-20 02:08:35 +03:00
++ peer
%_ .
moz
:_(moz [hen %pass ~ %g %deal [our our] ram %peer /drum])
==
2015-03-18 19:40:40 +03:00
::
2015-06-03 21:06:44 +03:00
++ sync
|= syn=[desk ship desk]
%_ +>.$
moz
:_ moz
[hen %pass ~ %g %deal [our our] ram %poke %hood-sync -:!>(syn) syn]
==
::
2015-05-08 22:43:11 +03:00
++ pump :: send diff ack
%_ .
moz
2015-05-10 01:55:05 +03:00
:_(moz [hen %pass ~ %g %deal [our our] ram %pump ~])
2015-05-06 22:55:47 +03:00
==
::
2015-03-18 19:40:40 +03:00
++ take :: receive
2015-05-08 22:43:11 +03:00
|= sih=sign
2015-03-18 19:40:40 +03:00
^+ +>
?- sih
2015-07-02 00:28:09 +03:00
[?(%a %b %c %e %f %g) %mass *]
2015-05-19 04:16:32 +03:00
(wegt -.sih p.sih)
::
2015-03-18 19:40:40 +03:00
[%a %nice *]
:: ~& [%take-nice-ames sih]
+>
::
[%a %init *]
+>(moz :_(moz [hen %give +.sih]))
2015-04-30 01:48:45 +03:00
::
2015-05-08 22:43:11 +03:00
[%c %mere *]
2015-04-30 01:48:45 +03:00
?: ?=(%& -.p.sih)
+>.$
2015-06-17 00:01:07 +03:00
(mean >%dill-mere-fail< >p.p.p.sih< q.p.p.sih)
2015-05-08 22:43:11 +03:00
::
2015-05-10 01:55:05 +03:00
[%g %onto *]
:: ~& [%take-gall-onto +>.sih]
2015-05-08 22:43:11 +03:00
?- -.+>.sih
%| (crud %onto p.p.+>.sih)
%& (done %blit [%lin (tuba "{<p.p.sih>}")]~)
==
::
2015-05-10 01:55:05 +03:00
[%g %unto *]
:: ~& [%take-gall-unto +>.sih]
2015-05-08 22:43:11 +03:00
?- -.+>.sih
%coup ?~(p.p.+>.sih +>.$ (crud %coup u.p.p.+>.sih))
2015-05-20 02:08:35 +03:00
%quit peer
%reap ?~ p.p.+>.sih
+>.$
(dump:(crud %reap u.p.p.+>.sih) %logo ~)
2015-05-08 22:43:11 +03:00
%diff pump:(from ((hard dill-blit) q:`vase`+>+>.sih))
2015-06-05 07:14:07 +03:00
%doff !!
2015-05-08 22:43:11 +03:00
==
2015-03-18 19:40:40 +03:00
::
[%c %note *]
2015-05-01 03:21:31 +03:00
(from %out (tuba p.sih ' ' ~(ram re q.sih)))
2015-03-18 19:40:40 +03:00
::
[%c %writ *]
init
2015-03-19 01:01:47 +03:00
::
[%d %blit *]
(done +.sih)
2015-03-18 19:40:40 +03:00
==
2015-05-19 04:16:32 +03:00
::
++ wegh
^- mass
:- %dill
:- %|
:~ all/`[ore hey dug]:all
==
::
++ wegt
2015-07-02 00:28:09 +03:00
|= [lal=?(%a %b %c %e %f %g) mas=mass]
2015-05-19 04:16:32 +03:00
^+ +>
=. hef.all
?- lal
%a ~?(?=(^ a.hef.all) %double-mass-a hef.all(a `mas))
2015-07-02 00:28:09 +03:00
%b ~?(?=(^ b.hef.all) %double-mass-b hef.all(b `mas))
2015-05-19 04:16:32 +03:00
%c ~?(?=(^ c.hef.all) %double-mass-c hef.all(c `mas))
%e ~?(?=(^ e.hef.all) %double-mass-e hef.all(e `mas))
%f ~?(?=(^ f.hef.all) %double-mass-f hef.all(f `mas))
%g ~?(?=(^ g.hef.all) %double-mass-g hef.all(g `mas))
==
?. ?& ?=(^ a.hef.all)
2015-07-02 00:28:09 +03:00
?=(^ b.hef.all)
2015-05-19 04:16:32 +03:00
?=(^ c.hef.all)
?=(^ e.hef.all)
?=(^ f.hef.all)
?=(^ g.hef.all)
==
+>.$
%+ done(hef.all [~ ~ ~ ~ ~ ~])
%mass
=> [hef.all d=wegh]
2015-07-02 00:28:09 +03:00
[%vanes %| ~[u.a u.c d u.e u.f u.g u.b]]
2015-03-18 19:40:40 +03:00
--
2014-10-22 06:59:05 +04:00
::
2015-03-18 19:40:40 +03:00
++ 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
2015-05-17 05:37:36 +03:00
(tuba "<awaiting {(trip p.kyz)}>")
2014-10-22 06:59:05 +04:00
==
2015-03-18 19:40:40 +03:00
--
2014-06-06 02:14:49 +04:00
|% :: 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)
==
2015-03-18 19:40:40 +03:00
?: ?=(%boot -.q.hic)
:_(..^$ [hen %pass ~ (note %a p.q.hic)]~)
2014-06-06 02:14:49 +04:00
?: ?=(%flog -.q.hic)
2015-03-19 01:01:47 +03:00
:: ~& [%dill-flog +.q.hic]
2015-04-08 21:27:51 +03:00
?: ?=([%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]~))
2015-05-19 04:16:32 +03:00
?: ?=([%crud %hax-heft ~] p.q.hic)
:_(..^$ ?~(hey.all ~ [u.hey.all %slip %d %heft ~]~))
2015-03-18 19:40:40 +03:00
:_(..^$ ?~(hey.all ~ [u.hey.all %slip %d p.q.hic]~))
=. hey.all ?^(hey.all hey.all `hen)
2015-03-19 01:01:47 +03:00
?: ?=(%init -.q.hic)
2015-04-08 05:19:31 +03:00
:: ~& [%call-init hen]
2015-03-19 01:01:47 +03:00
?: =(ore.all `p.q.hic)
2015-04-08 21:27:51 +03:00
[[hen %give q.hic]~ ..^$]
2015-03-19 01:01:47 +03:00
=: ore.all `p.q.hic
dug.all ~
==
2015-05-17 05:37:36 +03:00
=^ moz all abet:(need (ax (need hey.all) [%flow %hood ~]))
2015-04-08 05:19:31 +03:00
?: |((lth p.q.hic 256) (gte p.q.hic (bex 64))) [moz ..^$] :: XX HORRIBLE
[:_(moz [(need hey.all) %give %init p.q.hic]) ..^$]
2015-03-18 19:40:40 +03:00
=+ nus=(ax hen q.hic)
?~ nus
~& [%dill-no-flow q.hic]
[~ ..^$]
=^ moz all abet:(call:u.nus q.hic)
[moz ..^$]
2014-05-22 21:39:51 +04:00
::
2013-09-29 00:21:18 +04:00
++ doze
2013-12-15 09:42:27 +04:00
|= [now=@da hen=duct]
2013-09-29 00:21:18 +04:00
^- (unit ,@da)
~
::
2015-03-19 01:01:47 +03:00
++ load :: trivial
2015-05-19 04:16:32 +03:00
|= old=all-axle
?: ?=(%2 -.old)
$(old [%3 ore hey dug ~ ~ ~ ~ ~ ~]:old)
2015-03-19 01:01:47 +03:00
..^$(all old)
:: |= old=* :: diable
:: ..^$(ore.all `~zod)
2013-09-29 00:21:18 +04:00
::
++ scry
2014-05-27 00:43:40 +04:00
|= [fur=(unit (set monk)) ren=@tas his=ship syd=desk lot=coin tyl=path]
2015-02-27 09:35:41 +03:00
^- (unit (unit cage))
2015-03-18 19:40:40 +03:00
[~ ~]
::
++ stay all
2013-09-29 00:21:18 +04:00
::
2014-06-06 02:14:49 +04:00
++ take :: process move
2014-06-22 09:49:10 +04:00
|= [tea=wire hen=duct hin=(hypo sign)]
2014-06-06 02:14:49 +04:00
^- [p=(list move) q=_..^$]
2015-03-18 19:40:40 +03:00
?: =(~ ore.all)
?: ?=([%a %init *] q.hin)
2015-04-08 05:19:31 +03:00
:: ~& [%take-init hen]
2015-03-19 01:01:47 +03:00
=. hey.all ?^(hey.all hey.all `hen)
2015-03-18 19:40:40 +03:00
[[[hen %give +.q.hin] ~] ..^$]
2015-04-08 05:19:31 +03:00
:: [~ ..^$]
2015-03-18 19:40:40 +03:00
~& [%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
2015-05-08 22:43:11 +03:00
abet:(~(take as [~ hen our] (~(got by dug.all) hen)) q.hin)
2015-03-18 19:40:40 +03:00
[moz ..^$]
2013-09-29 00:21:18 +04:00
--
2015-05-08 22:43:11 +03:00