shrub/main/lib/console/core.hook

::
::::  /hook/core/console/lib
  ::  
  ::  This file is in the public domain.
  ::
/?    310
/-    *console
!:
::::
  ::
|%
++  cs                                                  ::  shared-state engine
  |_  console-share
  ++  abet  +<
  ++  apex                                              ::  engine by rule
    |*  sef=_rule
    |=  act=console-action
    ^+  [[p=*(list console-effect) q=(rust ~ sef)] *console-share]
    ?-    -.act
        %det
      =^  dut  +<.apex
          %+  remit  +.act
          |=  buf=(list ,@c)
          =+  txt=(tufa buf)
          =((lent txt) q.p:(sef [0 0] txt))
      [[?~(dut ~ [[%det u.dut] [%bel ~] ~]) ~] +<.apex]
    ::
        %ret
      =+  dod=(rust (tufa buf) sef)
      ?~  dod
        [[[%bel ~]~ ~] +<.apex]
      =^  cal  +<.apex  (transmit [%set ~])
      :_  +<.apex
      :_  dod
      :~  [%det cal]
          [%nex ~]
      ==
    ==
  ++  apse                                              ::  dialog engine
    |*  dog=(console-dialog)
    |=  act=(unit console-action)
    =<  abet  |%
    ++  abet
      ?~  act  (ajar ~)
      ?-  -.u.act
          %det
        =^  dut  +<.apse
            %+  remit  +.u.act
            |=  buf=(list ,@c)
            !=(~ (dog `(tufa buf)))
        :_  +<.apse
        :_  dog
        :_  q=[~ u=~]
        ^=  p   ^-  (list console-effect)
        ?~(dut ~ [[%det u.dut] [%bel ~] ~])
      ::
          %ret  (ajar `(tufa buf))
      ==
    ++  ajar
      |=  unp=(unit console-input)
      =+  god=(dog unp)
      ?:  |(?=(~ god) ?=(~ u.god))
        :_  +<.apse
        :_  dog
        :-  p=`(list console-effect)`[%bel ~]~
        q=[~ u=~]
      =+  fex=`(list console-effect)`[%tan p.u.u.god]~
      ?-    -.q.u.u.god
          %&
        :_  +<.apse
        :_  dog
        :-  p=fex
        q=?~(p.q.u.u.god ~ [~ u=p.q.u.u.god])
      ::
          %|
        =^  cal  +<.apse  (transmit [%set ~])
        :_  +<.apse
        :_  q.p.q.u.u.god
        :_  q=[~ u=~]
        ^=  p  ^+  fex
        :*  [%det cal]
            [%nex ~]
            [%pro p.p.q.u.u.god]
            fex
        ==
      == 
    --
  ::
  ++  apply
    |=  ted=console-edit 
    ^+  +>
    ?-    -.ted
      %del  +>.$(buf (weld (scag p.ted buf) (slag +(p.ted) buf)))
      %ins  +>.$(buf (weld (scag p.ted buf) `_buf`[q.ted (slag p.ted buf)]))
      %mor  |-  ^+  +>.^$
            ?~  p.ted 
              +>.^$ 
            $(p.ted t.p.ted, +>.^$ ^$(ted i.p.ted))
      %nop  +>.$
      %set  +>.$(buf p.ted)
    ==
  ::
  ::::
  ::  ++transmute: symmetric operational transformation.  
  ::
  ::  for any console state +>, obeys
  ::
  ::      =+  [x=(transmute a b) y=(transmute b a)]
  ::      .=  (apply:(apply b) x) 
  ::          (apply:(apply a) y)
  ::
  ++  transmute                                         ::  dex as after sin
    |=  [sin=console-edit dex=console-edit]
    ^-  console-edit
    ?:  ?=(%mor -.sin)
      |-  ^-  console-edit
      ?~  p.sin  dex
      $(p.sin t.p.sin, dex ^$(sin i.p.sin))
    ::
    ?:  ?=(%mor -.dex)
      :-  %mor
      |-  ^-  (list console-edit)
      ?~  p.dex  ~
      [^$(dex i.p.dex) $(p.dex t.p.dex)]
    ::
    ?:  |(?=(%nop -.sin) ?=(%nop -.dex))  dex
    ?:  ?=(%set -.sin)                    [%nop ~]
    ?:  ?=(%set -.dex)                    dex
    ::
    ?-    -.sin
        %del
      ?-  -.dex
        %del  ?:  =(p.sin p.dex)  [%nop ~]
              ?:((lth p.sin p.dex) dex(p (dec p.dex)) dex)
        %ins  ?:((lte p.sin p.dex) dex(p (dec p.dex)) dex)
      ==
    ::  
        %ins
      ?-  -.dex
        %del  ?:((lte p.sin p.dex) dex(p +(p.dex)) dex)
        %ins  ?:  =(p.sin p.dex)     
                ?:((gth q.sin q.dex) dex dex(p +(p.dex)))
              ?:((lte p.sin p.dex) dex(p +(p.dex)) dex)
      ==
    ==   
  ::
  ++  commit                                            ::  local change
    |=  ted=console-edit
    ^-  console-share
    abet:(apply(own.ven +(own.ven)) ted)
  ::
  ::::
  ::  ++inverse: inverse of change in context.
  ::
  ::  for any console state +>, obeys
  ::      
  ::      =(+> (apply:(apply a) (inverse a)))
  ::
  ++  inverse                                           ::  relative inverse
    |=  ted=console-edit
    ^-  console-edit
    ?-  -.ted
      %del  [%ins p.ted (snag p.ted buf)]
      %ins  [%del p.ted]
      %mor  :-  %mor
            %-  flop
            |-  ^-  (list console-edit)
            ?~  p.ted  ~
            :-  ^$(ted i.p.ted)
            $(p.ted t.p.ted, +>.^$ (apply i.p.ted))
      %nop  [%nop ~]
      %set  [%set buf]
    ==
  ::
  ++  transmit                                          ::  outgoing change
    |=  ted=console-edit
    ^-  [console-change console-share]
    [[[his.ven own.ven] (sham buf) ted] (commit ted)]
  ::
  ++  receive                                           ::  naturalize event
    |=  console-change
    ^-  [console-edit console-share]
    ?>  &(=(his.ler his.ven) (lte own.ler own.ven))
    ?>  &(=(his.ler his.ven) (lte own.ler own.ven))
    ?>  |(!=(own.ler own.ven) =(haw (sham buf)))
    =.  leg  (scag (sub own.ven own.ler) leg)
    =+  dat=(transmute [%mor leg] ted)
    [dat abet:(apply(his.ven +(his.ven)) dat)]
  ::
  ++  remit                                             ::  conditional accept
    |=  [cal=console-change ask=$+((list ,@c) ?)]
    ^-  [(unit console-change) console-share]
    =^  dat  +>+<.$  (receive cal)
    ?:  (ask buf)
      [~ +>+<.$]
    =^  lic  +>+<.$  (transmit (inverse dat))
    [`lic +>+<.$]
  --
--