:: :: :: :::: /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 == :: ++ suss ,[term @tas @da] :: config report ++ dill :: *forward* 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 == :: ++ pear :: request $% [%sole-action p=sole-action] :: == :: ++ lime :: update $% [%dill-blit dill-blit] :: == :: ++ card :: general card $% [%conf wire dock %load ship term] :: [%diff lime] :: [%flog wire dill] :: [%peer wire dock path] :: [%poke wire dock pear] :: [%pull wire dock ~] :: == :: ++ move (pair bone card) :: user-level move -- :: |_ $: 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)] [src=ship ost=bone] source == ++ se-abet :: resolve :_ %_(+> bin (~(put by bin) ost +<+>)) %+ welp (flop moz) ^- (list move) ?~ biz ~ [ost %diff %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 ^+ +> ?. (~(has by feg) gyl) +> =. +> (se-blit %out (tuba "[disconnected from {<gyl>}]")) =< se-prom %_ +> 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-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)) == :: ++ 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 ^+ +> =. +> ?. =(p.gyl src) +> (se-emit ost %conf (se-path gyl) gyl %load src %home) (se-join:(se-peer gyl /sole) 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)) ?~ 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-path :: standard path |= gyl=gill [(scot %p src) (scot %p p.gyl) q.gyl ~] :: ++ se-poke :: send a poke |= [gyl=gill par=pear] (se-emit ost %poke (se-path gyl) gyl par) :: ++ se-peer |= [gyl=gill pax=path] (se-emit ost %peer (se-path gyl) gyl pax) :: ++ se-pull |= gyl=gill (se-emit ost %pull (se-path gyl) gyl ~) :: ++ se-tame |= gyl=gill ^+ ta ~(. ta [& %| gyl] (~(got by feg) 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 ~]) +>(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-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 ?: =(~ 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-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-blit %out (tuba 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))]) -- -- ++ peer |= [from pax=path] ^- (quip move +>) :: ~& [%sole-peer ost src pax] ?< (~(has by bin) ost) :- [ost %diff %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 ~] == == :: ++ 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 +>) :: ~& [%sole-poke ost src bet] =+ yog=(~(get by bin) ost) ?~ yog ~& [%sole-poke-stale ost] [~ +>.$] =< se-abet =< se-view (~(se-belt se [~ ~] [src ost] u.yog) bet) :: ++ diff-sole-effect |= [then fec=sole-effect] ^- (quip move +>) :: ~& [%diff-sole-effect way] =+ yog=(~(get by bin) ost) ?~ yog ~& [%sole-diff-stale ost way] [~ +>.$] =< se-abet =< se-view =+ yaw=(gull way) (~(se-diff se [~ ~] [p.yaw ost] u.yog) q.yaw fec) :: ++ coup |= [then saw=(unit tang)] ^- (quip move +>) ?~ 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)] ^- (quip move +>) ?~ saw [~ +>] :_ +> :_ ~ `move`[ost %flog ~ %crud %reap u.saw] :: ++ 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>}>"] ~ == :: ++ pull |= [from pax=path] ^- (quip 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))] --