what have i done

human.ml

@@ -1260,7 +1260,7 @@ module Panel = struct
     and atom =
       [ `Image of image
       | `Uchar of Uchar.t
-      | `Boundary of [`Word | `Line | `Sentance]
+      | `Boundary of boundary
       | `Hint of [`Line | `Other]
       | `Empty ]
 
@@ -1273,6 +1273,7 @@ module Panel = struct
     and dir = [`X | `Y | `Z]
     and dim = Size2.t
     and image = Wall.image * dim
+    and boundary = [`Char | `Word | `Phrase | `Line | `Page | `Text]
     and style = Style.t
     and handler = node -> Event.t -> Event.t option Lwt.t
 
@@ -1298,6 +1299,109 @@ module Panel = struct
     let empty_node () = node (`Atom `Empty)
     let style (s : Style.t) (n : node) = node (`Attr (`Style s, n))
 
+    module Pp = struct
+      let pp_uchar ppf v =
+        if Uchar.is_char v then Fmt.pf ppf "'%c'" (Uchar.to_char v)
+        else Fmt.Dump.uchar ppf v
+
+      let pp_boundary ppf v =
+        F.any
+          ( match v with
+          | `Char -> "`Char"
+          | `Word -> "`Word"
+          | `Phrase -> "`Phrase"
+          | `Line -> "`Line"
+          | `Page -> "`Page"
+          | `Text ->
+              "`Text"
+              (* text is like a file (unicode calls it End Of Text) *)
+          )
+          ppf ()
+
+      let pp_atom ppf v =
+        let open Fmt in
+        ( match v with
+        | `Image _ -> any "`Image"
+        | `Uchar c -> any "`Uchar " ++ const pp_uchar c
+        | `Boundary b -> any "`Boundary " ++ const pp_boundary b
+        | `Hint h ->
+            any "`Hint "
+            ++ any
+                 (match h with `Line -> "`Line" | `Other -> "`Other")
+        | `Empty -> any "`Empty" )
+          ppf ()
+
+      let pp_attr ppf v =
+        let open Fmt in
+        (any
+           ( match v with
+           | `Style _ -> "`Style ..."
+           | `Pad _ -> "`Pad ..."
+           | `Shift _ -> "`Shift ..."
+           | `Cursor -> "`Cursor"
+           | `Handler _ -> "`Handler ..." ) )
+          ppf ()
+
+      let pp_dir ppf v =
+        F.pf ppf "%s"
+          (match v with `X -> "`X" | `Y -> "`Y" | `Z -> "`Z")
+
+      let pp_node_n ppf v = F.(pf ppf "%a" int v.n)
+
+      let rec _pp_t child ppf v =
+        let open Fmt in
+        match v with
+        | `Atom x -> pf ppf "`Atom %a" pp_atom x
+        | `Attr (a, n) ->
+            pf ppf "`Attr %a"
+              (parens (const pp_attr a ++ comma ++ const child n))
+              ()
+        | `Join (d, a, b) ->
+            pf ppf "`Join %a"
+              (parens
+                 ( const pp_dir d ++ comma ++ const child a ++ comma
+                 ++ const child b ) )
+              ()
+
+      and _pp_node child ppf v =
+        let open Fmt in
+        pf ppf "@[<hov>%a@]"
+          (braces
+             (record
+                [ field "n" (fun v -> v.n) int
+                ; field "t" (fun v -> v.t) (_pp_t child)
+                ; field "parent"
+                    (fun v -> v.parent)
+                    (option pp_node_n) ] ) )
+          v
+
+      and pp_node_n_record =
+        F.(
+          braces
+            (record ~sep:semi [field "n" Fun.id pp_node_n; any "..."]))
+
+      and pp_node ppf = _pp_node pp_node_n_record ppf
+      and pp_dump_node ppf = _pp_node pp_dump_node ppf
+
+      let pp_t = _pp_t pp_node_n_record
+
+      let rec pp_node_structure ppf v =
+        F.(
+          const int v.n
+          ++ parens
+               (concat ~sep:comma
+                  ( match v.t with
+                  | `Atom a -> [const pp_atom a]
+                  | `Attr (a, n) ->
+                      [const pp_attr a; const pp_node_structure n]
+                  | `Join (d, l, r) ->
+                      [ const pp_dir d; const pp_node_structure l
+                      ; const pp_node_structure r ] ) ))
+          ppf ()
+    end
+
+    open Pp
+
     let rec traverse_nodes ~(f : node -> node option) (n : node) :
         unit =
       match f n with
@@ -1359,87 +1463,14 @@ module Panel = struct
     let ( ^*^ ) = join_z
 
     let append_ d (l : node -> node) (a : node) : node -> node =
-     fun n -> l (join_ d a n)
+      F.epr "append_%a@." pp_dir d ;
+      fun n -> l (join_ d a n)
 
+    let empty_append = Fun.id
     let append_x = append_ `X
     let append_y = append_ `Y
     let append_z = append_ `Z
 
-    let pp_uchar ppf v =
-      if Uchar.is_char v then Fmt.pf ppf "'%c'" (Uchar.to_char v)
-      else Fmt.Dump.uchar ppf v
-
-    let pp_atom ppf v =
-      let open Fmt in
-      ( match v with
-      | `Image _ -> any "`Image"
-      | `Uchar c -> any "`Uchar " ++ const pp_uchar c
-      | `Boundary b -> (
-          any "`Boundary "
-          ++
-          match b with
-          | `Word -> any "`Word"
-          | `Line -> any "`Line"
-          | `Sentance -> any "`Sentance" )
-      | `Hint h ->
-          any "`Hint "
-          ++ any (match h with `Line -> "`Line" | `Other -> "`Other")
-      | `Empty -> any "`Empty" )
-        ppf ()
-
-    let pp_attr ppf v =
-      let open Fmt in
-      (any
-         ( match v with
-         | `Style _ -> "`Style ..."
-         | `Pad _ -> "`Pad ..."
-         | `Shift _ -> "`Shift ..."
-         | `Cursor -> "`Cursor"
-         | `Handler _ -> "`Handler ..." ) )
-        ppf ()
-
-    let pp_dir ppf v =
-      F.pf ppf "%s"
-        (match v with `X -> "`X" | `Y -> "`Y" | `Z -> "`Z")
-
-    let pp_node_n ppf v =
-      F.(
-        pf ppf "%a"
-          (record [field "n" (fun v -> v.n) int; any "..."])
-          v)
-
-    let rec _pp_t child ppf v =
-      let open Fmt in
-      match v with
-      | `Atom x -> pf ppf "`Atom %a" pp_atom x
-      | `Attr (a, n) ->
-          pf ppf "`Attr %a"
-            (parens (const pp_attr a ++ comma ++ const child n))
-            ()
-      | `Join (d, a, b) ->
-          pf ppf "`Join %a"
-            (parens
-               ( const pp_dir d ++ comma ++ const child a ++ comma
-               ++ const child b ) )
-            ()
-
-    and _pp_node child ppf v =
-      let open Fmt in
-      pf ppf "@[<hov>%a@]"
-        (braces
-           (record
-              [ field "n" (fun v -> v.n) int
-              ; field "t" (fun v -> v.t) (_pp_t child)
-              ; field "parent"
-                  (fun v -> v.parent)
-                  (option (fun ppf v -> pf ppf "%a" int v.n)) ] ) )
-        v
-
-    and pp_node ppf v = _pp_node pp_node_n ppf v
-    and pp_dump_node ppf v = _pp_node pp_dump_node ppf v
-
-    let pp_t = _pp_t pp_node_n
-
     (* there's no difference between a node element and a node list what, tho an element is kinda like a node.t,
        so i guess we'll use that to kinda emulate append (vs. concat which is what join is)
        ugh maybe using types to build this double-linked binary-tree data structure is not a good idea.
@@ -1449,71 +1480,85 @@ module Panel = struct
     *)
 
     module Text = struct
-      let rec of_string (str : string) : node =
+      let rec _of_string
-        let uudec = Uutf.decoder (`String str) in
+          (segmenter :
-        let rec dec (lx : node -> node) : 'a * (node -> node) =
+               'a
-          match Uutf.decode uudec with
+            -> [`Uchar of Uchar.t | `Await | `End]
-          | `Malformed b ->
+            -> 'a * [`Uchar of Uchar.t | `Await | `End] ) dec (ly, lx)
-              dec (append_x lx (of_string (String.escaped b)))
+          =
-          | (`Await | `Uchar _ | `End) as x -> (x, lx) in
+        F.epr "_of_string@." ;
-        let uuline = Uuseg.create `Line_break in
+        let rec segment aa ll =
-        let rec char (x, (l : node -> node)) =
+          F.epr "segment %s -> "
-          match Uuseg.add uuline x with
+            ( match aa with
-          | `End as x -> (l, x)
+            | `Await -> "`Await"
-          | `Await -> char (dec l)
+            | `End -> "`End"
-          | `Boundary as x when Uuseg.mandatory uuline -> (l, x)
+            | `Uchar c -> F.str "`Uchar U+%x" (Uchar.to_int c) ) ;
-          | `Boundary ->
+          match segmenter ll aa with
-              char (`Await, append_x l (node (`Atom (`Hint `Line))))
+          | (ly', lx'), `Await -> (
-          | `Uchar c ->
+              F.epr "`Await -> decode@." ;
-              char (`Await, append_x l (node (`Atom (`Uchar c))))
+              match Uutf.decode dec with
+              | `Malformed b ->
+                  F.epr
+                    "Text.dec (Uutf.decode uudec)=`Malformed \"%s\"@."
+                    (String.escaped b) ;
+                  _of_string segmenter dec
+                    (ly', append_x lx' (of_string (String.escaped b)))
+              | (`End | `Await | `Uchar _) as a -> segment a (lx', ly')
+              )
+          | (ly', lx'), `Uchar c ->
+              F.epr "`Uchar U+%04x -> `Await@." (Uchar.to_int c) ;
+              segment `Await
+                (ly', append_x lx' (node (`Atom (`Uchar c))))
+          | (ly', lx'), `End ->
+              F.epr "`End ;@." ;
+              append_y ly' (lx' (node (`Atom (`Boundary `Text))))
         in
-        let rec new_line la : node -> node =
+        let r = segment `Await (ly, lx) in
-          match char (`Await, la) with
+        F.epr "@." ; r
-          | l, `Boundary ->
-              new_line
-                (append_y la (l (node (`Atom (`Boundary `Line)))))
-          | l, `End -> l in
-        (new_line (fun n -> n)) (empty_node ())
 
-      (* let segment ?(boundary = `Word) ?(label = `Word) (node : node) :
+      and of_string str =
-             node =
+        (_of_string
-           let uuseg = Uuseg.create boundary in
+           (fun l s ->
-           traverse_regions
+             F.epr "segmenter[of_string] %s -> "
-             ~node:(fun node -> node)
+               ( match s with
-             ~region:(fun ~parent (r, c) ~child ->
+               | `Await -> "`Await"
-               match child.child with
+               | `End -> "`End"
-               | `Atom (`Uchar uc) ->
+               | `Uchar c -> F.str "`Uchar U+%x" (Uchar.to_int c) ) ;
-                   let rec seg ((t : node Trope.t), (c : Region.cursor))
+             (l, s) )
-                       e' =
+           (Uutf.decoder
-                     match Uuseg.add uuseg e' with
+              ~nln:(`Readline (Uchar.of_int 0x000A))
-                     | `Boundary ->
+              (`String str) )
-                         seg
+           (empty_append, empty_append) )
-                           ( Trope.put_right t c
+          (node (`Atom (`Boundary `Text)))
-                               {parent; child= `Atom (`Boundary label)}
-                           , Trope.cursor_after c )
-                           `Await
-                     | `End | `Await -> (t, c)
-                     | `Uchar ch ->
-                         seg
-                           ( Trope.put_right t c
-                               {parent; child= `Atom (`Uchar ch)}
-                           , c )
-                           `Await in
-                   let r', c' = seg (r.t, c) (`Uchar uc) in
-                   ({r with t= r'}, c')
-               | _ -> (r, c) )
-             node
 
-          let words node : node =
+      and lines str =
-           segment ~boundary:`Word ~label:`Word node
+        let rec line_seg u (ly, lx) s =
-
+          F.epr "line_seg %s -> "
-         let sentances node : node =
+            ( match s with
-           segment ~boundary:`Sentence ~label:`Sentance node
+            | `Await -> "`Await"
-
+            | `End -> "`End"
-         let text str : node = insert_string str |> sentances |> words *)
+            | `Uchar c -> F.str "`Uchar U+%x" (Uchar.to_int c) ) ;
+          match Uuseg.add u s with
+          | (`End | `Await | `Uchar _) as s' -> ((lx, ly), s')
+          | `Boundary when Uuseg.mandatory u ->
+              line_seg u
+                ( append_y ly (lx (node (`Atom (`Boundary `Line))))
+                , empty_append )
+                `Await
+          | `Boundary ->
+              line_seg u
+                (ly, append_x lx (node (`Atom (`Hint `Line))))
+                `Await in
+        (_of_string
+           (line_seg (Uuseg.create `Line_break))
+           (Uutf.decoder
+              ~nln:(`Readline (Uchar.of_int 0x000A))
+              (`String str) )
+           (empty_append, empty_append) )
+          (node (`Atom (`Boundary `Text)))
     end
 
-    let text = Text.of_string
+    let text = Text.lines
 
     module Draw = struct
       type d = [`X | `Y | `Z]
@@ -1609,14 +1654,11 @@ module Panel = struct
     end
 
     module Action = struct
-      type segment_type =
+      type segment =
-        [`Char | `Word | `Phrase | `Line | `Page | `Region]
+        [ `Beginning of boundary
-
+        | `Forward of boundary
-      and segment =
+        | `Backward of boundary
-        [ `Beginning of segment_type
+        | `End of boundary ]
-        | `Forward of segment_type
-        | `Backward of segment_type
-        | `End of segment_type ]
 
       and t =
         [ `Move of segment
@@ -1655,23 +1697,12 @@ module Panel = struct
           | `Out -> "`Out" )
           ppf ()
 
-      let pp_segment_type ppf v =
-        any
-          ( match v with
-          | `Char -> "`Char"
-          | `Word -> "`Word"
-          | `Phrase -> "`Phrase"
-          | `Line -> "`Line"
-          | `Page -> "`Page"
-          | `Region -> "`Region" )
-          ppf ()
-
       let pp_segment ppf v =
         ( match v with
-        | `Beginning s -> any "`Beginning " ++ const pp_segment_type s
+        | `Beginning s -> any "`Beginning " ++ const pp_boundary s
-        | `Forward s -> any "`Forward " ++ const pp_segment_type s
+        | `Forward s -> any "`Forward " ++ const pp_boundary s
-        | `Backward s -> any "`Backward " ++ const pp_segment_type s
+        | `Backward s -> any "`Backward " ++ const pp_boundary s
-        | `End s -> any "`End " ++ const pp_segment_type s )
+        | `End s -> any "`End " ++ const pp_boundary s )
           ppf ()
 
       let pp_t ppf v =
@@ -1816,14 +1847,8 @@ module Panel = struct
               | Some n -> n
               | None -> n ) } in
       Format.pp_set_max_boxes F.stderr 64 ;
-      Format.pp_set_margin F.stderr 120 ;
+      (*full screen fynn  *)
-      Format.(
+      Format.pp_safe_set_geometry F.stderr ~max_indent:150 ~margin:230 ;
-        F.epr
-          "@[<hv>F.stderr margin: %d, max_indent: %d, max_boxes: %d \
-           @]@."
-          (pp_get_margin F.stderr ())
-          (pp_get_max_indent F.stderr ())
-          (pp_get_max_boxes F.stderr ())) ;
       node
         (`Attr
           ( `Handler
@@ -1833,7 +1858,7 @@ module Panel = struct
                     c.sel <- remove_attr c.sel ;
                     F.epr
                       "textedit_handler c.root=@.@[%a@]@.c.sel=%a@."
-                      pp_dump_node c.root pp_node c.sel ;
+                      pp_node_structure c.root pp_node c.sel ;
                     ( match perform_action x c with
                     | Some _ ->
                         F.epr
@@ -1888,15 +1913,17 @@ module Panel = struct
         (Lwd.pure
            (textedit_handler
               (style Style.dark
-                 (join_y
+                 (* (join_y
-                    (* (join_y
+                     (join_y
-                       (Text.of_string
+                        (Text.of_string
-                          "-- welcome to my land of idiocy ---" )
+                           "-- welcome to my land of idiocy ---" )
-                                          (join_x *)
+                        ( ( Text.of_string "hello bitch"
-                    (Text.of_string "hello bitch")
+                          ^^ Text.of_string "!\n sup daddy" )
-                    (*
+                        ^/^ (text "hello bitch" ^^ text "!\n sup daddy")
-                          (Text.of_string "!\n sup daddy") ) ) *)
+                        ^/^ text "hello bitch" ^/^ text "!\n sup daddy"
-                    (Text.of_string "123") ) ) ) )
+                        ) ) *)
+                 (Text.of_string "123")
+                 (* )p *) ) ) )
   end
 end