diff --git a/.console b/.console new file mode 100644 index 0000000..453a8dc --- /dev/null +++ b/.console @@ -0,0 +1 @@ +it consoles you diff --git a/human.ml b/human.ml index c8a66d3..2e6a997 100644 --- a/human.ml +++ b/human.ml @@ -1,5 +1,7 @@ (* +ALWAYS BREAK UP THE PROBLEM INTO SMALLER CHUNKS BITCH!! + a computation console - irmin store provides a tree of data objects @@ -1254,7 +1256,9 @@ module Panel = struct and atom = [ `Image of image | `Uchar of Uchar.t - | `Boundary of [`Word | `Line | `Sentance | `Hint] ] + | `Boundary of [`Word | `Line | `Sentance] + | `Hint of [`Line | `Other] + | `Empty ] and attr = [ `Style of style @@ -1280,7 +1284,7 @@ module Panel = struct let node (t : t) = set_parent_on_children {parent= None; t} let empty_image = (Image.empty, V2.zero) - let empty_node = node (`Atom (`Image empty_image)) + let empty_node = node (`Atom `Empty) let style (s : Style.t) (n : node) = node (`Attr (`Style s, n)) let rec traverse_nodes ~(f : node -> node option) (n : node) : @@ -1341,70 +1345,110 @@ module Panel = struct let ( ^^ ) = join_x let ( ^/^ ) = join_y - let rec pp_ui : node F.t = - fun ppf v -> - let atom a = - F.pf ppf "`Atom " ; - match a with - | `Image _ -> F.pf ppf "`Image" - | `Uchar c -> - F.pf ppf "`Uchar " ; - if Uchar.is_char c then F.pf ppf "%c" (Uchar.to_char c) - else F.pf ppf "0x%x" (Uchar.to_int c) - | `Boundary b -> - F.pf ppf "`Boundary " ; - F.pf ppf - ( match b with - | `Word -> "`Word" - | `Line -> "`Line" - | `Sentance -> "`Sentance" - | `Hint -> "`Hint" ) in - let attr a = - F.pf ppf "`Attr " ; - F.pf ppf - ( match a with - | `Style _ -> "`Style ..., " - | `Pad _ -> "`Pad ..., " - | `Shift _ -> "`Shift ..., " - | `Cursor -> "`Cursor " - | `Handler _ -> "`Handler ..., " ) in - let join (d, a, b) = - F.pf ppf "`Join " ; - ( match d with - | `X -> F.pf ppf "`X " - | `Y -> F.pf ppf "`Y " - | `Z -> F.pf ppf "`Z " ) ; - F.parens pp_ui ppf b ; F.parens pp_ui ppf a in - match v.t with - | `Join x -> join x - | `Attr (x, n) -> attr x ; F.parens pp_ui ppf n - | `Atom x -> atom x + 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 tess v = F.epr "%a" pp_atom v + + 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 rec pp_node ppf v = + let open Fmt in + pf ppf "@[%a@]" pp_t v.t + + and pp_t ppf v = + let open Fmt in + match v with + | `Join (d, a, b) -> + pf ppf "`Join %a" + (parens + ( const pp_dir d ++ comma ++ const pp_node a ++ comma + ++ const pp_node b ) ) + () + | `Attr (a, n) -> + pf ppf "`Attr %a" + (parens (const pp_attr a ++ comma ++ const pp_node n)) + () + | `Atom x -> pf ppf "`Atom %a" pp_atom x + + (* 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. + I'm STONED, so i'm not making sense, but i'm gonna carry on anyway and see what happens. + So i think what is really happening is that i'm defining the `list` for this node type that allows `append`. + The main problem with this thought is that you can't do anything but append with the datastructure. + *) + let new_append () = empty_node + + let append (d : dir) (l : unit -> node) (n : node) : unit -> node + = + fun () -> + set_parent_on_children {parent= None; t= `Join (d, l (), n)} module Text = struct - let rec insert_string (n : node) (str : string) : node = + let rec _of_string (la : unit -> node) (str : string) : + unit -> node = let uudec = Uutf.decoder (`String str) in - let rec dec (n' : node) : 'a * node = + let rec dec (lx : unit -> node) : 'a * (unit -> node) = match Uutf.decode uudec with - | `Malformed b -> dec (insert_string n' (String.escaped b)) - | (`Await | `Uchar _ | `End) as x -> (x, n') in + | `Malformed b -> dec (_of_string lx (String.escaped b)) + | (`Await | `Uchar _ | `End) as x -> (x, lx) in let uuline = Uuseg.create `Line_break in - let rec line (n' : node) : node = - let rec char (x, t) (line : node) = + let rec new_line la' : unit -> node = + let rec char (x, lx) (ly : unit -> node) = match Uuseg.add uuline x with - | `End as x -> (line, x) - | `Boundary as x when Uuseg.mandatory uuline -> (line, x) - | `Await -> char (dec t) line + | `End as x -> (ly, x) + | `Boundary as x when Uuseg.mandatory uuline -> (ly, x) + | `Await -> char (dec lx) ly | `Boundary -> char - (`Await, t) - (line ^^ node (`Atom (`Boundary `Hint))) + (`Await, append `X lx (node (`Atom (`Hint `Line)))) + ly | `Uchar c -> - char (`Await, t) (line ^^ node (`Atom (`Uchar c))) - in - match char (`Await, n') n' with - | l, `Boundary -> line (l ^/^ node (`Atom (`Boundary `Line))) + char + (`Await, append `X lx (node (`Atom (`Uchar c)))) + ly in + match char (`Await, la') la' with + | l, `Boundary -> + new_line + (append `Y la' + ((append `X l (node (`Atom (`Boundary `Line)))) ()) ) | l, `End -> l in - line n + new_line la + + let of_string str = _of_string new_append str () (* let segment ?(boundary = `Word) ?(label = `Word) (node : node) : node = @@ -1444,7 +1488,7 @@ module Panel = struct let text str : node = insert_string str |> sentances |> words *) end - let text = Text.insert_string + let text = Text.of_string module Draw = struct type d = [`X | `Y | `Z] @@ -1519,6 +1563,8 @@ module Panel = struct | `Image i -> i | `Uchar uc -> uchar style uc | `Boundary _ -> empty_image + | `Hint _ -> empty_image + | `Empty -> empty_image and attr ?(style = Style.empty) (attr, node) : image = match attr with @@ -1639,7 +1685,14 @@ module Panel = struct let bind = Key.Bind.init bindings in let n' = insert_attr `Cursor n in let c = ref n in - F.epr "%a@." pp_ui n' ; + Format.( + F.epr + "@[ 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 ())) ; + F.epr "@[%a@]@." pp_node n' ; node (`Attr ( `Handler @@ -1649,7 +1702,7 @@ module Panel = struct c := insert_attr `Cursor (perform_action x (remove_attr !c)) ; - F.epr "%a@." pp_ui !c ; + F.epr "%a@." pp_node !c ; Lwt.return_none | [] -> Lwt.return_some e ) , n ) ) @@ -1700,7 +1753,7 @@ module Panel = struct (Text.insert_string empty_node "hello bitch") (Text.insert_string empty_node "!\n sup daddy" ) ) )*) - (Text.insert_string empty_node "test 1 2 3") ) ) ) + (Text.of_string "test 1 2 3") ) ) ) (* ) *) end end diff --git a/opam-switch b/opam-switch new file mode 100644 index 0000000..6523fb5 --- /dev/null +++ b/opam-switch @@ -0,0 +1,361 @@ +opam-version: "2.0" +compiler: ["ocaml-system.4.13.1"] +roots: [ + "bogue.20210917" + "findlib_top.v0.11.0" + "glfw-ocaml.3.3.1-1" + "huffman.0.1.2" + "inuit.0.4.1" + "irc-client.0.7.0" + "irc-client-lwt.0.7.0" + "irc-client-tls.0.7.0" + "irc-client-unix.0.7.0" + "irmin.2.9.0" + "irmin-unix.2.9.0" + "lambda-term.3.1.0" + "lwd.0.1" + "lwt_ppx.2.0.3" + "merlin.4.4-413" + "note.0.0.1" + "nottui.0.1" + "nottui-lwt.0.1" + "nottui-pretty.0.1" + "ocaml-manual.4.13.0" + "ocaml-system.4.13.1" + "ocamlformat.0.20.1" + "odig.0.0.7" + "odoc.2.0.2" + "pp.1.1.2" + "pprint.20211129" + "tgls.0.8.5" + "tsdl.0.9.8" + "user-setup.0.7" + "wall.0.4.1" + "zed.3.1.0" +] +installed: [ + "angstrom.0.15.0" + "arp.3.0.0" + "asn1-combinators.0.2.6" + "astring.0.8.5" + "awa.0.0.4" + "awa-mirage.0.0.4" + "b0.0.0.3" + "base.v0.14.2" + "base-bigarray.base" + "base-bytes.base" + "base-threads.base" + "base-unix.base" + "base64.3.5.0" + "bheap.2.0.0" + "bigarray-compat.1.0.0" + "bigstringaf.0.8.0" + "biniou.1.2.1" + "bogue.20210917" + "bos.0.2.0" + "ca-certs.0.2.2" + "ca-certs-nss.3.71" + "camomile.1.0.2" + "carton.0.4.3" + "carton-git.0.4.3" + "carton-lwt.0.4.3" + "cf.0.4" + "cf-lwt.0.4" + "charInfo_width.1.1.0" + "checkseum.0.3.2" + "cmdliner.1.0.4" + "cohttp.4.0.0" + "cohttp-lwt.4.0.0" + "cohttp-lwt-unix.4.0.0" + "conduit.4.0.2" + "conduit-lwt.4.0.2" + "conduit-lwt-unix.4.0.2" + "conf-cairo.1" + "conf-gles2.1" + "conf-glfw3.2" + "conf-gmp.3" + "conf-gmp-powm-sec.3" + "conf-libffi.2.0.0" + "conf-libX11.1" + "conf-m4.1" + "conf-pkg-config.2" + "conf-sdl2.1" + "conf-sdl2-image.1" + "conf-sdl2-ttf.1" + "cppo.1.6.8" + "crunch.3.2.0" + "csexp.1.5.1" + "cstruct.6.0.1" + "cstruct-lwt.6.0.1" + "cstruct-sexp.6.0.1" + "cstruct-unix.6.0.1" + "ctypes.0.20.0" + "ctypes-foreign.0.18.0" + "decompress.1.4.2" + "digestif.1.1.0" + "dispatch.0.5.0" + "domain-name.0.3.1" + "dot-merlin-reader.4.1" + "duff.0.4" + "dune.2.9.1" + "dune-build-info.2.9.1" + "dune-configurator.2.9.1" + "duration.0.2.0" + "easy-format.1.3.2" + "either.1.0.0" + "emile.1.1" + "encore.0.8" + "eqaf.0.8" + "ethernet.3.0.0" + "findlib_top.v0.11.0" + "fix.20211125" + "fmt.0.9.0" + "fpath.0.7.3" + "fsevents.0.3.0" + "fsevents-lwt.0.3.0" + "gg.0.9.3" + "git.3.6.0" + "git-cohttp.3.6.0" + "git-cohttp-unix.3.6.0" + "git-unix.3.6.0" + "glfw-ocaml.3.3.1-1" + "gmap.0.3.0" + "graphql.0.13.0" + "graphql-cohttp.0.13.0" + "graphql-lwt.0.13.0" + "graphql_parser.0.13.0" + "graphv_core.0.1.1" + "graphv_core_lib.0.1.1" + "graphv_font.0.1.1" + "graphv_font_js.0.1.1" + "graphv_gles2.0.1.1" + "graphv_gles2_native_impl.0.1.1" + "graphv_webgl.0.1.1" + "graphv_webgl_impl.0.1.1" + "grenier.0.13" + "hex.1.4.0" + "hkdf.1.0.4" + "huffman.0.1.2" + "hxd.0.3.1" + "index.1.5.0" + "inotify.2.3" + "integers.0.5.1" + "inuit.0.4.1" + "ipaddr.5.2.0" + "ipaddr-sexp.5.2.0" + "irc-client.0.7.0" + "irc-client-lwt.0.7.0" + "irc-client-tls.0.7.0" + "irc-client-unix.0.7.0" + "irmin.2.9.0" + "irmin-fs.2.9.0" + "irmin-git.2.9.0" + "irmin-graphql.2.9.0" + "irmin-http.2.9.0" + "irmin-layers.2.9.0" + "irmin-pack.2.9.0" + "irmin-unix.2.9.0" + "irmin-watcher.0.5.0" + "jbuilder.1.0+beta20.2" + "js_of_ocaml.3.11.0" + "js_of_ocaml-compiler.3.11.0" + "js_of_ocaml-ppx.3.11.0" + "jsonm.1.0.1" + "ke.0.4" + "lambda-term.3.1.0" + "logs.0.7.0" + "lru.0.3.0" + "lwd.0.1" + "lwt.5.5.0" + "lwt-dllist.1.0.1" + "lwt_log.1.1.1" + "lwt_ppx.2.0.3" + "lwt_react.1.1.5" + "macaddr.5.2.0" + "macaddr-cstruct.5.2.0" + "magic-mime.1.2.0" + "menhir.20211128" + "menhirLib.20211128" + "menhirSdk.20211128" + "merlin.4.4-413" + "metrics.0.3.0" + "mew.0.1.0" + "mew_vi.0.5.0" + "mimic.0.0.4" + "mirage-clock.4.0.0" + "mirage-clock-unix.4.0.0" + "mirage-crypto.0.10.5" + "mirage-crypto-ec.0.10.5" + "mirage-crypto-pk.0.10.5" + "mirage-crypto-rng.0.10.5" + "mirage-device.2.0.0" + "mirage-flow.3.0.0" + "mirage-kv.4.0.0" + "mirage-net.4.0.0" + "mirage-no-solo5.1" + "mirage-no-xen.1" + "mirage-profile.0.9.1" + "mirage-protocols.8.0.0" + "mirage-random.3.0.0" + "mirage-stack.4.0.0" + "mirage-time.3.0.0" + "mmap.1.1.0" + "mtime.1.3.0" + "note.0.0.1" + "nottui.0.1" + "nottui-lwt.0.1" + "nottui-pretty.0.1" + "notty.0.2.2" + "num.1.4" + "oasis.0.4.11" + "ocaml.4.13.1" + "ocaml-compiler-libs.v0.12.4" + "ocaml-config.2" + "ocaml-manual.4.13.0" + "ocaml-migrate-parsetree.2.3.0" + "ocaml-options-vanilla.1" + "ocaml-syntax-shims.1.0.0" + "ocaml-system.4.13.1" + "ocaml-version.3.4.0" + "ocamlbuild.0.14.0" + "ocamlfind.1.9.1" + "ocamlformat.0.20.1" + "ocamlgraph.2.0.0" + "ocamlify.0.0.1" + "ocamlmod.0.0.9" + "ocb-stubblr.0.1.1-1" + "ocp-indent.1.8.1" + "ocplib-endian.1.2" + "odig.0.0.7" + "odoc.2.0.2" + "odoc-parser.1.0.0" + "optint.0.1.0" + "parsexp.v0.14.1" + "pbkdf.1.2.0" + "pecu.0.6" + "pp.1.1.2" + "pprint.20211129" + "ppx_cstruct.6.0.1" + "ppx_derivers.1.2.1" + "ppx_deriving.5.2.1" + "ppx_irmin.2.9.0" + "ppx_repr.0.5.0" + "ppx_sexp_conv.v0.14.3" + "ppxlib.0.24.0" + "progress.0.2.1" + "psq.0.2.0" + "ptime.0.8.6" + "randomconv.0.1.3" + "re.1.10.3" + "react.1.2.1" + "repr.0.5.0" + "result.1.5" + "rresult.0.6.0" + "semaphore-compat.1.0.1" + "seq.base" + "sexplib.v0.14.0" + "sexplib0.v0.14.0" + "stb_image.0.5" + "stb_truetype.0.6" + "stdio.v0.14.0" + "stdlib-shims.0.3.0" + "stringext.1.6.0" + "tcpip.7.0.0" + "terminal.0.2.1" + "terminal_size.0.1.4" + "tgls.0.8.5" + "tls.0.14.1" + "tls-mirage.0.14.1" + "topkg.1.0.4" + "trie.1.0.0" + "tsdl.0.9.8" + "tsdl-image.0.3.2" + "tsdl-ttf.0.3.2" + "tyxml.4.5.0" + "uchar.0.0.2" + "uri.4.2.0" + "uri-sexp.4.2.0" + "user-setup.0.7" + "uucp.14.0.0" + "uuseg.14.0.0" + "uutf.1.0.2" + "vector.1.0.0" + "wall.0.4.1" + "webmachine.0.7.0" + "x509.0.14.1" + "yaml.3.0.0" + "yojson.1.7.0" + "zarith.1.12" + "zed.3.1.0" +] +pinned: ["lwd.0.1" "nottui.0.1"] +package "lwd" { + opam-version: "2.0" + version: "0.1" + synopsis: "Lightweight reactive documents" + maintainer: "fred@tarides.com" + authors: "Frédéric Bour" + license: "MIT" + homepage: "https://github.com/let-def/lwd" + doc: "https://let-def.github.io/lwd/doc" + bug-reports: "https://github.com/let-def/lwd/issues" + depends: [ + "dune" {>= "2.0"} + "seq" + "ocaml" {>= "4.03"} + "qtest" {with-test} + "qcheck" {with-test} + ] + build: [ + ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ] + dev-repo: "git+https://github.com/let-def/lwd.git" + url { + src: "git+file:///home/cqc/p/console/ref/lwd#master" + } +} +package "nottui" { + opam-version: "2.0" + version: "0.1" + synopsis: "UI toolkit for the terminal built on top of Notty and Lwd" + maintainer: "fred@tarides.com" + authors: "Frédéric Bour" + license: "MIT" + homepage: "https://github.com/let-def/lwd" + doc: "https://let-def.github.io/lwd/doc" + bug-reports: "https://github.com/let-def/lwd/issues" + depends: [ + "dune" {>= "2.0"} + "lwd" + "notty" + ] + build: [ + ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ] + dev-repo: "git+https://github.com/let-def/lwd.git" + url { + src: "git+file:///home/cqc/p/console/ref/lwd#master" + } +}