mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-18 12:22:10 +03:00
525 lines
18 KiB
Plaintext
525 lines
18 KiB
Plaintext
:: :: ::
|
|
:::: /hook/core/seat/app :: ::
|
|
:: :: ::
|
|
/? 314 :: zuse version
|
|
/- *console :: console structures
|
|
/+ console :: 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 term) :: application ring
|
|
maz=(unit (list ,@c)) :: master window
|
|
feg=(map term target) :: live applications
|
|
mir=(pair ,@ud (list ,@c)) :: mirrored state
|
|
== ::
|
|
++ master :: master buffer
|
|
$: pos=@ud :: cursor position
|
|
buf=(list ,@c) :: text entry
|
|
== ::
|
|
++ 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=console-prompt :: static prompt
|
|
inp=console-command :: input state
|
|
== ::
|
|
++ gift :: out result <-$
|
|
$% [%mean p=ares] ::
|
|
[%nice ~] ::
|
|
[%rush %dill-blit dill-blit] ::
|
|
== ::
|
|
++ sign-gall :: sign from %gall
|
|
$% [%mean p=ares] ::
|
|
[%nice ~] ::
|
|
[%rush %console-effect console-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
|
|
== ::
|
|
++ se :: per source
|
|
|_ [moz=(list move) [her=ship ost=bone] source]
|
|
++ se-abet :: resolve
|
|
[(flop moz) %_(+> bin (~(put by bin) ost +<+>))]
|
|
::
|
|
++ se-belt :: handle input
|
|
|= bet=dill-belt
|
|
^+ +>
|
|
?: ?=(%rez -.bet)
|
|
+>(edg (dec p.bet))
|
|
?: ?=(%yow -.bet)
|
|
(se-link p.bet)
|
|
?^ maz
|
|
?+ -.bet (se-blit %bel ~)
|
|
::
|
|
%bac
|
|
?: =(0 (lent u.maz))
|
|
(se-blit %bel ~)
|
|
+>(u.maz (scag (dec (lent u.maz)) u.maz))
|
|
::
|
|
%ctl
|
|
?+ p.bet (se-blit %bel ~)
|
|
%d (se-emit ost %give %mean ~)
|
|
%v +>.$(maz ~)
|
|
%x $(maz ~)
|
|
==
|
|
::
|
|
%ret (se-like(maz ~) u.maz)
|
|
%txt +>(u.maz (weld u.maz p.bet))
|
|
==
|
|
?~ apt
|
|
~& %console-no-terminal
|
|
(se-blit %bel ~)
|
|
=+ nam=i.apt
|
|
=+ taz=~(. ta [& nam] (~(got by feg) nam))
|
|
=< 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
|
|
|= nam=term
|
|
^+ +>
|
|
?> (~(has by feg) nam)
|
|
=: feg (~(del by feg) nam)
|
|
apt (skip apt |=(a=term =(nam a)))
|
|
==
|
|
?^ apt +>
|
|
?^ maz +>
|
|
+>(maz `~)
|
|
::
|
|
++ se-join :: add connection
|
|
|= nam=term
|
|
^+ +>
|
|
?< (~(has by feg) nam)
|
|
+>(maz ~, apt [nam apt], feg (~(put by feg) nam *target))
|
|
::
|
|
++ se-nuke :: active drop
|
|
|= nam=term
|
|
^+ +>
|
|
(se-drop:(se-send nam %nuke [her ~[nam]] her) nam)
|
|
::
|
|
++ se-like :: act in master
|
|
|= buf=(list ,@c)
|
|
(se-link (crip (tufa buf)))
|
|
::
|
|
++ se-link :: connect to app
|
|
|= nam=term
|
|
^+ +>
|
|
%. nam
|
|
=< se-join
|
|
(se-send nam %show [her ~[nam]] her /console)
|
|
::
|
|
++ se-blit :: give output
|
|
|= bil=dill-blit
|
|
(se-emit ost %give %rush %dill-blit bil)
|
|
::
|
|
++ 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
|
|
%- se-just
|
|
?^ maz
|
|
=- [(lent zil) zil]
|
|
^= zil ^- (list ,@c)
|
|
%- welp
|
|
:_ u.maz
|
|
|- ^- (list ,@c)
|
|
?~ apt [`@c`0x23 `@c`0x20 ~]
|
|
=+ nex=$(apt t.apt)
|
|
%+ welp (tuba (trip i.apt))
|
|
?~(t.apt nex `_nex`[`@c`0x2c `@c`0x20 nex])
|
|
?~ apt
|
|
~&(%se-no-view [0 ~])
|
|
~(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
|
|
|= [nam=term nog=note-gall]
|
|
(se-emit ost %pass [(scot %p her) nam ~] %g nog)
|
|
::
|
|
++ se-tame
|
|
|= nam=term
|
|
~(. ta [& nam] (~(got by feg) nam))
|
|
::
|
|
++ se-pour :: receive results
|
|
|= [nam=term sil=sign-gall]
|
|
^+ +>
|
|
?- -.sil
|
|
%mean
|
|
~& [%seat-mean sil]
|
|
+>.$
|
|
::
|
|
%nice
|
|
+>.$
|
|
::
|
|
%rush
|
|
ta-abet:(ta-fec:(se-tame nam) +>.sil)
|
|
==
|
|
::
|
|
++ ta :: per target
|
|
|_ $: $: liv=? :: don't delete
|
|
nam=term :: target app
|
|
== ::
|
|
target :: target state
|
|
== ::
|
|
++ ta-abet :: resolve
|
|
^+ ..ta
|
|
?. liv (se-nuke nam)
|
|
%_(+> feg (~(put by feg) nam +<+))
|
|
::
|
|
++ ta-act :: send action
|
|
|= act=console-action
|
|
^+ +>
|
|
%_(+> +> (se-send nam %mess [her ~[nam]] her %console-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)]
|
|
^- console-edit
|
|
:- %mor
|
|
|- ^- (list console-edit)
|
|
?~ txt ~
|
|
[[%ins pos i.txt] $(pos +(pos), txt t.txt)]
|
|
::
|
|
++ ta-cut :: mass delete
|
|
|= [pos=@ud num=@ud]
|
|
^- console-edit
|
|
:- %mor
|
|
|-(?:(=(0 num) ~ [[%del pos] $(num (dec num))]))
|
|
::
|
|
++ ta-det :: send edit
|
|
|= ted=console-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 +>(maz `~)
|
|
%x ?: =(~ apt) ta-bel
|
|
?^ maz 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-fec :: apply effect
|
|
|= fec=console-effect
|
|
^+ +>
|
|
?- -.fec
|
|
%bel ta-bel
|
|
%blk +>
|
|
%clr +>(+> (se-blit fec))
|
|
%det (ta-got +.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 :: correct position
|
|
|= ted=console-edit
|
|
?. ?=(%set -.ted) +>
|
|
+>(pos.inp (lent buf.say.inp))
|
|
::
|
|
++ ta-got :: apply change
|
|
|= cal=console-change
|
|
=. +> (ta-dog:+>(say.inp abet:(~(receive cs say.inp) cal)) ted.cal)
|
|
+>
|
|
::
|
|
++ ta-hom :: local edit
|
|
|= ted=console-edit
|
|
^+ +>
|
|
=. +> (ta-det ted)
|
|
=. +> (ta-dog:+>(say.inp abet:(~(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=console-prompt
|
|
+>(pom pom)
|
|
::
|
|
++ ta-ret (ta-act %ret ~) :: hear return
|
|
++ 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 console-edit)
|
|
?~ txt ~
|
|
[[%ins pos.inp i.txt] $(pos.inp +(pos.inp), txt t.txt)]
|
|
::
|
|
++ ta-vew :: computed prompt
|
|
|- ^- (pair ,@ud (list ,@c))
|
|
?^ ris
|
|
%= $
|
|
ris ~
|
|
cap.pom
|
|
`(list ,@)`:(welp "(reverse-i-search)'" str.u.ris "': ")
|
|
==
|
|
=- =. pos.inp (max pos.inp (lent q.vew))
|
|
[(add pos.inp (lent p.vew)) (weld p.vew q.vew)]
|
|
^= vew ^- (pair (list ,@c) (list ,@c))
|
|
?: vis.pom [cap.pom buf.say.inp]
|
|
:- ;: welp
|
|
cap.pom
|
|
?~ buf.say.inp ~
|
|
%- tuba
|
|
;: welp
|
|
"<"
|
|
(scow %p (end 4 1 (sham buf.say.inp)))
|
|
"> "
|
|
==
|
|
==
|
|
=+ len=(lent buf.say.inp)
|
|
|- ^- (list ,@c)
|
|
?:(=(0 len) ~ [`@c`'*' $(len (dec len))])
|
|
--
|
|
--
|
|
++ peer
|
|
|= [ost=bone her=ship pax=path]
|
|
^- [(list move) _+>]
|
|
?< (~(has by bin) ost)
|
|
:- [ost %give %rush %dill-blit %pro [`@c`0x23 `@c`0x20 ~]]~
|
|
%= +>
|
|
bin
|
|
%+ ~(put by bin) ost
|
|
^- source
|
|
:* 80
|
|
0
|
|
~
|
|
~
|
|
`~
|
|
~
|
|
[0 ~]
|
|
==
|
|
==
|
|
::
|
|
++ poke-dill-belt
|
|
|= [ost=bone her=ship bet=dill-belt]
|
|
^- [(list move) _+>]
|
|
=< se-abet
|
|
=< se-view
|
|
(~(se-belt se [ost %give %nice ~]~ [her ost] (~(got by bin) ost)) bet)
|
|
::
|
|
++ pour
|
|
|= [ost=bone pax=path sih=*]
|
|
^- [(list move) _+>]
|
|
=+ sih=((hard sign) sih)
|
|
?> ?=([@ @ ~] pax)
|
|
=< se-abet
|
|
=< se-view
|
|
(~(se-pour se ~ [(slav %p i.pax) ost] (~(got by bin) ost)) i.t.pax +.sih)
|
|
::
|
|
++ pull
|
|
|= ost=bone
|
|
^- [(list move) _+>]
|
|
=^ moz +>
|
|
=< se-abet
|
|
=< se-view
|
|
~(se-kill se ~ [our.hid ost] (~(got by bin) ost))
|
|
[moz +>.$(bin (~(del by bin) ost))]
|
|
--
|