urbit/main/app/seat/core.hook

::                                                      ::  ::
::::  /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-input                             ::  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 %clr ~))
        %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)
        %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))]
--