From 79af294f51d0e66974836d3f87ca055f0ae0d1d6 Mon Sep 17 00:00:00 2001 From: cqc Date: Mon, 13 Sep 2021 16:02:14 -0500 Subject: [PATCH] store editor tree navigation works???? --- irc.ml | 14 +++-- main.ml | 175 ++++++++++++++++++++++++++++++++++---------------------- 2 files changed, 118 insertions(+), 71 deletions(-) diff --git a/irc.ml b/irc.ml index 5ab8e37..dccad5c 100644 --- a/irc.ml +++ b/irc.ml @@ -5,6 +5,10 @@ we need to design this somehow before implementing it really the graphical drawing / window management funcitons i think at this point. +features: + - message drafts? more like, if you send too many messages to someone all at once it will hold them so you can respond later and not flood people....... + - i mean really what you want is an editable stream, so you can stage messages for later + - because i mean, if this is a bicycle, and you can make it however you want, you can just fuck with the conversation thread with computer assistance instaed of just relying on your memory. *) @@ -34,7 +38,8 @@ let callback connection result = >>= fun () -> Lwt_io.flush Lwt_io.stdout >>= fun () -> - C.send_privmsg ~connection ~target:"cqc" ~message:("ack: " ^ data) + C.send_privmsg ~connection ~target:"cqc" + ~message:("ack: " ^ data) | Result.Ok msg -> Lwt_io.printf "Got message: %s\n" (M.to_string msg) >>= fun () -> Lwt_io.flush Lwt_io.stdout @@ -44,15 +49,16 @@ let lwt_main () = C.reconnect_loop ~after:30 ~connect:(fun () -> Lwt_io.printl "Connecting..." - >>= fun () -> C.connect_by_name ~server:!host ~port:!port ~nick:!nick () - ) + >>= fun () -> + C.connect_by_name ~server:!host ~port:!port ~nick:!nick () ) ~f:(fun connection -> Lwt_io.printl "Connected" >>= fun () -> Lwt_io.printl "send join msg" >>= fun () -> C.send_join ~connection ~channel:!channel - >>= fun () -> C.send_privmsg ~connection ~target:!channel ~message ) + >>= fun () -> + C.send_privmsg ~connection ~target:!channel ~message ) ~callback () let _ = diff --git a/main.ml b/main.ml index 19f7bf3..88ddeb5 100644 --- a/main.ml +++ b/main.ml @@ -346,7 +346,7 @@ module Event = struct | `Window_event -> `Unknown "`Window_event " | `Display_event -> `Unknown "`Display_event " | `Sensor_update -> `Unknown "`Sensor_update " in - (* F.epr "event_of_sdlevent: %s@." (to_string r) ;*) + (*F.epr "event_of_sdlevent: %s@." (to_string r) ;*) r let key_up : Sdl.keycode = 0x40000052 @@ -357,27 +357,30 @@ module Event = struct let actions_of_events (state : Input.Bind.state) (events : events) = let open Input.Bind in - List.iter - (function - | `Key_down (k : Input.keystate) -> - ( match state.state with - | Continue _ -> () - | _ -> state.last_keyseq <- [] ) ; - state.state <- - resolve k - (get_resolver state.state - (default_resolver state.bindings) ) ; - state.last_keyseq <- k :: state.last_keyseq - | _ -> () ) - events ; - match state.state with - | Accepted a -> - state.last_actions <- a ; - a - | Rejected -> - state.last_actions <- [] ; - [] - | _ -> [] + List.flatten + (List.filter_map + (fun e -> + (*F.epr "action_of_events: %s@." (to_string e) ;*) + match e with + | `Key_down (k : Input.keystate) -> ( + ( match state.state with + | Continue _ -> () + | _ -> state.last_keyseq <- [] ) ; + state.state <- + resolve k + (get_resolver state.state + (default_resolver state.bindings) ) ; + state.last_keyseq <- k :: state.last_keyseq ; + match state.state with + | Accepted a -> + state.last_actions <- a ; + Some a + | Rejected -> + state.last_actions <- [] ; + None + | _ -> None ) + | _ -> None ) + events ) end module Display = struct @@ -793,7 +796,7 @@ module Panel = struct , ( Box2.of_pts (Box2.o s.box) (P2.v !max_x (Box2.maxy !box)) , !node ) ) - let default_bindings = + let textedit_bindings = let open Input.Bind in add [([], Code Left)] [Zed Prev_char] @@ add [([], Code Right)] [Zed Next_char] @@ -837,7 +840,7 @@ module Panel = struct type textedit = {ze: unit Zed_edit.t; zc: Zed_cursor.t; keybind: Input.Bind.state} - let make_textedit ?(keybinds = default_bindings) () = + let make_textedit ?(keybinds = textedit_bindings) () = let z = Zed_edit.create () in { ze= z ; zc= Zed_edit.new_cursor z @@ -958,6 +961,8 @@ module Text = Wall_text module Store = struct module Istore = Irmin_unix.Git.FS.KV (Irmin.Contents.String) + (* storeview shows items of the selected level *) + type storeview = { store: Istore.t ; mutable view: string list @@ -973,50 +978,56 @@ module Store = struct (Istore.Repo.v (Irmin_git.config storepath)) ) branch ) ; view= path - ; selected= [2] + ; selected= [1] ; edit= false } - let draw_storeview tree selected pp = - let indent = ref 0 in - let rec draw_levels ttree sel = - indent := !indent + 1 ; - List.iteri - (fun i (step, node) -> - Format.pp_open_vbox pp 0 ; - Format.pp_open_hbox pp () ; - for _ = 0 to !indent do - Format.pp_print_space pp () - done ; - if sel = [i] then - Format.pp_open_stag pp - Display.( - Panel.Color_bg (Wall.Color.v 0.99 0.99 0.125 0.3)) ; - Format.fprintf pp "%d-%s@." !indent step ; - if sel = [i] then Format.pp_close_stag pp () ; - Format.pp_close_box pp () ; - let subtree = Lwt_main.run (Istore.Tree.list node []) in - let subsel = - if List.length sel > 0 && List.hd sel = i then List.tl sel - else [] in - draw_levels subtree subsel ; - Format.pp_close_box pp () ) - ttree ; - indent := !indent - 1 in - draw_levels tree selected - let navigate sv action = - let _root = + let rec nodecount (ipath : int list) tree = + match ipath with + | [] -> + Istore.Tree.list tree [] + >>= fun l -> Lwt.return (List.length l) + | a :: b -> + Istore.Tree.list tree [] + >>= fun l -> nodecount b (snd (List.nth l a)) in + let removelast l = List.rev (List.tl (List.rev l)) in + let last l = List.nth l (List.length l - 1) in + fun () -> Lwt_main.run ( Istore.get_tree sv.store sv.view - >>= fun n -> Istore.Tree.list n [] ) in - let rec listlast f = function - | [] -> [] - | [x] -> F.epr "%d@." x ; [f x] - | _ :: x -> listlast f x in - fun () -> - match action with - | `Next -> sv.selected <- listlast succ sv.selected - | `Prev -> sv.selected <- listlast pred sv.selected + >>= fun top -> + nodecount (removelast sv.selected) top + >>= fun seln -> + nodecount sv.selected top + >>= fun subn -> + Lwt.return + ( ( match action with + | `Next -> + F.epr + "navigate `Next: (last sv.selected)=%d seln=%d@." + (last sv.selected) seln ; + if last sv.selected < seln - 1 then + sv.selected <- + List.mapi + (fun i a -> + if i >= List.length sv.selected - 1 then a + 1 + else a ) + sv.selected + | `Prev -> + if last sv.selected > 0 then + sv.selected <- + List.mapi + (fun i a -> + if i >= List.length sv.selected - 1 then a - 1 + else a ) + sv.selected + | `Sub -> if subn > 0 then sv.selected <- sv.selected @ [0] + | `Sup -> + if List.length sv.selected > 1 then + sv.selected <- removelast sv.selected ) ; + F.epr "Store.editor selected: %d@." + (List.nth sv.selected (List.length sv.selected - 1)) ) + ) let editor ?(branch = "current") storepath : Panel.t = let sv = make_storeview storepath branch in @@ -1024,7 +1035,9 @@ module Store = struct let open CamomileLibrary in let open Input.Bind in add [([], Char 'n')] [Custom (navigate sv `Next)] - @@ add [([], Char 'p')] [Custom (navigate sv `Prev)] empty in + @@ add [([], Char 'p')] [Custom (navigate sv `Prev)] + @@ add [([], Char 'd')] [Custom (navigate sv `Sub)] + @@ add [([], Char 'u')] [Custom (navigate sv `Sup)] empty in let bindstate = Input.Bind.init keybinds in { act= (fun panel events -> @@ -1034,11 +1047,39 @@ module Store = struct (Panel.vbox panel.subpanels).act panel events ) ; subpanels= [ Panel.prettyprint (fun pp -> + let indent = ref 0 in + let rec draw_levels tree sel = + indent := !indent + 1 ; + List.iteri + (fun i (step, node) -> + Format.pp_open_vbox pp 0 ; + Format.pp_open_hbox pp () ; + for _ = 0 to !indent do + Format.pp_print_space pp () + done ; + if sel = [i] then + Format.pp_open_stag pp + Display.( + Panel.Color_bg + (Wall.Color.v 0.99 0.99 0.125 0.3)) ; + Format.fprintf pp "%d-%s@." !indent step ; + if sel = [i] then Format.pp_close_stag pp () ; + Format.pp_close_box pp () ; + let subtree = + Lwt_main.run (Istore.Tree.list node []) in + let subsel = + if List.length sel > 0 && List.hd sel = i then + List.tl sel + else [] in + draw_levels subtree subsel ; + Format.pp_close_box pp () ) + tree ; + indent := !indent - 1 in let root = Lwt_main.run ( Istore.get_tree sv.store sv.view >>= fun n -> Istore.Tree.list n [] ) in - draw_storeview root sv.selected pp ) + draw_levels root sv.selected ) ; Panel.bindingstate bindstate ] ; tag= "store-editor" } end @@ -1144,8 +1185,8 @@ let top_panel (t : top) = F.epr "Exception in pane_top//eval@." in t.te.keybind.bindings <- Input.( - Bind.S.add - [{mods= Keymod.of_list [Ctrl]; code= Enter}] + Bind.add + [([Ctrl], Code Enter)] Bind.[Custom eval] t.te.keybind.bindings) ; Panel.(