::                                                      ::  ::
::::  /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=_80                                       ::  terminal columns
          apt=(list term)                               ::  application ring
          feg=(map term target)                         ::  live applications
          mir=(pair ,@ud (list ,@c))                    ::  mirrored state
      ==                                                ::
    ++  target                                          ::  application target
      $:  pom=console-prompt                            ::  static prompt
          inp=console-input                             ::  input state
      ==                                                ::
    ++  message                                         ::  message to app
      $%  [%console-action console-action]              ::
      ==                                                ::
    ++  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=message]    ::
          [%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
    ^+  +>
    ~&  [%se-belt bet]
    ?:  ?=(%rez -.bet)
      +>(edg q.bet)
    ?:  ?=(%yow -.bet)
      (se-link 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)))
    ==
  ::
  ++  se-join                                           ::  add connection
    |=  nam=term
    ^+  +>
    ?<  (~(has by feg) nam)
    +>(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-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-view                                           ::  flush buffer
    ^+  .
    =+  ^=  lin  ^-  (pair ,@ud (list ,@c))
        ?~  apt  [0 ~]
        ~(ta-vew ta [& i.apt] (~(got by feg) i.apt))
    ?:  =(mir lin)  +
    =.  +  ?:(=(q.mir q.lin) + (se-blit %pro q.lin))
    =.  +  ?:(=(p.mir p.lin) + (se-blit %hop p.lin))
    +(mir lin)
  ::
  ++  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  
      ~&  [%se-pour-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-bel  .(+> (se-blit %bel ~))                  ::  beep
    ++  ta-det                                          ::  send edit
      |=  ted=console-edit
      ^+  +>
      (ta-act %det [[his.ven.say.inp own.ven.say.inp] (sham buf.say.inp) ted])
    ::
    ++  ta-aro                                          ::  hear arrow
      |=  key=?(%d %l %r %u)
      ^+  +>
      ?-  key
        %d  ta-bel
        %l  ?:  =(0 pos.inp)  
              ta-bel 
            +>(pos.inp (dec pos.inp))
        %r  ?:  =((lent buf.say.inp) pos.inp) 
              ta-bel
            +>(pos.inp +(pos.inp))
        %u  ta-bel
      ==
    ::
    ++  ta-bac                                          ::  hear backspace
      ^+  .
      ?:  =(0 pos.inp)
        .(+> (se-blit %bel ~))
      (ta-hom %del (dec pos.inp))
    ::
    ++  ta-ctl                                          ::  hear control
      |=  key=@ud
      ~&  [%ta-ctl key]
      +>
    ::
    ++  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
      |=  fec=console-effect
      ^+  +>
      ?-    -.fec
        %bel  ta-bel
        %blk  +>
        %clr  +>(+> (se-blit %clr ~))
        %det  (ta-got +.fec)
        %pro  (ta-pro +.fec)
        %tan  (ta-tan p.fec)
        %txt  $(fec [%tan [%leaf p.fec]~])
      ==
    ::
    ++  ta-got
      |=  [ler=console-clock haw=@uvH ted=console-edit]
      +>(inp abet:(~(receive cs inp) ler haw ted))
    ::
    ++  ta-hom                                          ::  local edit
      |=  ted=console-edit
      ^+  +>
      =.  +>  (ta-det ted)
      %_(+> inp abet:(~(commit cs inp) ted))
    ::
    ++  ta-met                                          ::  meta key
      |=  key=@ud
      ~&  [%ta-met key]
      +>
    ::
    ++  ta-pro                                          ::  set prompt
      |=  pom=console-prompt
      +>(pom pom)
    ::
    ++  ta-ret  (ta-act %ret ~)                         ::  hear return
    ++  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)
      %-  ta-hom
      :-  %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))
      =-  [(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) _+>]
  ~&  [%seat-peer ost her pax]
  ?<  (~(has by bin) ost)
  [~ +>(bin (~(put by bin) ost *source))]
::
++  poke-dill-belt
  |=  [ost=bone her=ship bet=dill-belt]
  ^-  [(list move) _+>]
  ~&  [%dill-belt bet]
  =<  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)
  ~&  [%seat-pour 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))]
--