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  +>+>.$
          %+  remit  +.act
          |=  buf=(list ,@c)
          =+  txt=(tufa buf)
          =((lent txt) q.p:(sef [0 0] txt))
      [[?~(dut ~ [[%det u.dut] ~]) ~] +>+>+<.$]
    ::
        %ret
      =+  dod=(rust (tufa buf) sef)
      ?~  dod
        [[[%bel ~]~ ~] +>+>+<.$]
      =^  cal  +>+>.$  (transmit [%set ~])
      :_  +>+>+<.$
      :_  dod
      :~  [%det cal]
          [%nex ~]
      ==
    ==
  ++  apse                                              ::  dialog engine
    |*  dog=(console-dialog)
    |%  ++  abet  `console-share`+>+>-                  ::  resolve
        ++  dole                                        ::  
          =+  fov=^+(init:dog [[~ ~] [%& ~]])
          |-
          =+  fex=[%tan p.fov]
          ?-  -.q.fov
            %&  [[p=fex q=[~ u=p.q.fov]] +>.$]
            %|  :-  [p=[i=[%pro `console-prompt`p.p.q.fov] t=fex] q=~]
                +>.$(dog q.p.q.fov)
          ==
        ::
        ++  init  (dole init:dog)                       ::  initialize
        ++  work
          |=  act=console-action
          ^+  init
          ?-    -.act
              %det
            =^  dut  +>+>.$
                %+  remit  +.act
                |=  buf=(list ,@c)
                !=(~ (nice:dog (tufa buf)))
            [[?~(dut ~ [[%det u.dut] ~]) ~] +>+>+<.$]
          ::
              %ret
            =+  txt=(tufa buf)
            ?.  =(`& (nice:dog txt))
              [[[%bel ~]~ ~] +>+>+<.$]
            (dole (kick:dog txt))
          ==
    --
  ::
  ++  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
    ^+  +>
    (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 _+>]
    [[[his.ven own.ven] (sham buf) ted] (commit ted)]
  ::
  ++  realize                                           ::  naturalize event
    |=  console-change
    ^-  [console-edit _+>]
    ?>  &(=(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)
    [(transmute [%mor leg] ted) +>]
  ::
  ++  remit                                             ::  conditional accept
    |=  [cal=console-change ask=$+((list ,@c) ?)]
    ^-  [(unit console-change) _+>]
    =+  old=+>
    =^  dat  +>.$  (realize cal)
    =.  +>.$  (apply(his.ven +(his.ven)) dat)
    ?:  (ask buf)
      [~ +>.$]
    =+  wad=(inverse dat)
    ::  ~&  [%remit-old buf.old]
    ::  ~&  [%remit-new buf]
    ::  ~&  [%remit ted/ted.cal]
    ::  ~&  [%remit dat/dat]
    ::  ~&  [%remit wad/wad]
    =^  lic  +>.$  (transmit wad)
    ::  ~&  [%remit-end [lic buf]]
    [`lic +>.$]
  ::
  ++  receive                                           ::  accept change
    |=  cal=console-change
    ^+  +>
    =^  dat  +>  (realize cal)
    (apply(his.ven +(his.ven)) dat)
  --
--