console/boot
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Irmin_git.KV (Irmin_git.Mem) (Git.Mem.Sync (Irmin_git.Mem)) results in a.caml_thread_initialize is not a function

Browse Source
This commit is contained in:
cqc
2022-10-06 12:18:32 -05:00
parent fec4249d9f
commit 281351371d
4 changed files with 469 additions and 365 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
.ocamlformat
View File

@ -1 +0,0 @@
profile = compact

46
boot_js.ml
View File

@ -1,4 +1,5 @@
open Js_of_ocaml open Js_of_ocaml
open Lwt.Infix
module NVG = Graphv_webgl module NVG = Graphv_webgl
(* This scales the canvas to match the DPI of the window, (* This scales the canvas to match the DPI of the window,
@ -11,15 +12,18 @@ let scale_canvas (canvas : Dom_html.canvasElement Js.t) =
canvas##.width := width *. dpr |> int_of_float; canvas##.width := width *. dpr |> int_of_float;
canvas##.height := height *. dpr |> int_of_float; canvas##.height := height *. dpr |> int_of_float;
let width = let width =
Printf.sprintf "%dpx" (int_of_float width) |> Js.string in Printf.sprintf "%dpx" (int_of_float width) |> Js.string
in
let height = let height =
Printf.sprintf "%dpx" (int_of_float height) |> Js.string in Printf.sprintf "%dpx" (int_of_float height) |> Js.string
in
canvas##.style##.width := width; canvas##.style##.width := width;
canvas##.style##.height := height canvas##.style##.height := height
let _ = let _ =
let canvas = let canvas =
Js.Unsafe.coerce (Dom_html.getElementById_exn "canvas") in Js.Unsafe.coerce (Dom_html.getElementById_exn "canvas")
in
scale_canvas canvas; scale_canvas canvas;
let webgl_ctx = let webgl_ctx =
(* Graphv requires a stencil buffer to work properly *) (* Graphv requires a stencil buffer to work properly *)
@ -31,15 +35,19 @@ let _ =
| None -> | None ->
print_endline "Sorry your browser does not support WebGL"; print_endline "Sorry your browser does not support WebGL";
raise Exit raise Exit
| Some ctx -> ctx in | Some ctx -> ctx
in
let open NVG in let open NVG in
let vg = let vg =
create create
~flags:CreateFlags.(antialias lor stencil_strokes) ~flags:CreateFlags.(antialias lor stencil_strokes)
webgl_ctx in webgl_ctx
in
(* File in this case is actually the CSS font name *) (* File in this case is actually the CSS font name *)
Text.create vg ~name:"sans" ~file:"sans" |> ignore; Text.create vg ~name:"sans" ~file:"sans" |> ignore;
webgl_ctx##clearColor 0.3 0.3 0.32 1.; webgl_ctx##clearColor 0.3 0.3 0.32 1.;
(*
let render ev = let render ev =
webgl_ctx##clear webgl_ctx##clear
(webgl_ctx##._COLOR_BUFFER_BIT_ (webgl_ctx##._COLOR_BUFFER_BIT_
@ -62,11 +70,31 @@ let _ =
Text.set_align vg ~align:Align.(center lor middle) ; Text.set_align vg ~align:Align.(center lor middle) ;
set_fill_color vg ~color:Color.white ; set_fill_color vg ~color:Color.white ;
Text.text vg ~x:0. ~y:0. "Hello World!" ; *) Text.text vg ~x:0. ~y:0. "Hello World!" ; *)
NVG.end_frame vg in NVG.end_frame vg
in
Dom_html.window##requestAnimationFrame Dom_html.window##requestAnimationFrame
(Js.wrap_callback (fun _ -> render Human.Event.empty)) (Js.wrap_callback (fun _ -> render Human.Event.empty))
|> ignore ; |> ignore;*)
Dom_html.document##.onkeydown let open Js_of_ocaml_lwt.Lwt_js_events in
async (fun () ->
buffered_loop (make_event Dom_html.Event.keydown)
Dom_html.document (fun ev _ ->
webgl_ctx##clear
(webgl_ctx##._COLOR_BUFFER_BIT_
lor webgl_ctx##._DEPTH_BUFFER_BIT_
lor webgl_ctx##._STENCIL_BUFFER_BIT_);
let device_ratio = Dom_html.window##.devicePixelRatio in
begin_frame vg ~width:canvas##.width ~height:canvas##.height
~device_ratio;
Transform.scale vg ~x:device_ratio ~y:device_ratio;
Human.Panel.Ui.(
render_lwt vg Gg.P2.o
(Human.Event_js.evt_of_jskey `Press ev))
>>= fun () ->
NVG.end_frame vg;
Lwt.return_unit))
(* Dom_html.document##.onkeydown
:= Dom.handler (fun (evt : Dom_html.keyboardEvent Js.t) -> := Dom.handler (fun (evt : Dom_html.keyboardEvent Js.t) ->
render (Human.Event_js.evt_of_jskey `Press evt) ; render (Human.Event_js.evt_of_jskey `Press evt) ;
Js._false ) Js._false ) *)

8
dune
View File

@ -11,10 +11,10 @@
(libraries (libraries
fmt fmt
graphv_webgl graphv_webgl
js_of_ocaml js_of_ocaml-lwt
lwt digestif.ocaml
irmin irmin.mem
irmin-git irmin-git.unix
zed zed
gg gg

295
human.ml
View File

@ -35,19 +35,27 @@ module NVG = Graphv_webgl
module Nav = struct module Nav = struct
open Lwt.Infix open Lwt.Infix
module S = Irmin_mem.KV.Make(Irmin.Contents.String) module Maker =
Irmin_git.KV (Irmin_git.Mem) (Git.Mem.Sync (Irmin_git.Mem))
module S = Maker.Make (Irmin.Contents.String)
module Sync = Irmin.Sync.Make (S)
type t = S.tree type t = S.tree
let init () : t Lwt.t = let init () = S.Repo.v (Irmin_mem.config ()) >>= S.main >>= S.tree
S.Repo.v (Irmin_mem.config ()) >>= S.main >>= S.tree
let test_populate () : t Lwt.t = let test_populate () : t Lwt.t =
let add p s t = S.Tree.add t p s in let add p s t = S.Tree.add t p s in
add ["hello"] "world" (S.Tree.empty ()) >>= add [ "hello" ] "world" (S.Tree.empty ())
add ["hello";"daddy"] "ily" >>= >>= add [ "hello"; "daddy" ] "ily"
add ["beep";"beep"] "motherfucker" >>= add [ "beep"; "beep" ] "motherfucker"
let test_pull () : t Lwt.t = test_populate ()
(* S.Repo.v (Irmin_git.config "") >>= fun repo ->
S.of_branch repo "master" >>= fun t ->
let upstream = Irmin.Sync.remote_store (module S) t in
Sync.pull_exn t upstream `Set >>= fun _ -> S.tree t *)
end end
module Key = struct module Key = struct
@ -66,11 +74,18 @@ module Key = struct
| `Unknown of string ] | `Unknown of string ]
(* Type of key code. *) (* Type of key code. *)
type code = [`Uchar of Uchar.t (* A unicode character. *) | special] type code =
[ `Uchar of Uchar.t (* A unicode character. *) | special ]
type keyaction = [ `Press | `Release | `Repeat ] type keyaction = [ `Press | `Release | `Repeat ]
type keystate = type keystate = {
{ctrl: bool; meta: bool; shift: bool; super: bool; code: code} ctrl : bool;
meta : bool;
shift : bool;
super : bool;
code : code;
}
module KeyS = struct module KeyS = struct
type t = keystate type t = keystate
@ -86,11 +101,12 @@ module Key = struct
type 'a resolver = 'a list S.resolver type 'a resolver = 'a list S.resolver
type 'a result = 'a list S.result type 'a result = 'a list S.result
type 'a state = type 'a state = {
{ mutable bindings: 'a t mutable bindings : 'a t;
; mutable state: 'a result mutable state : 'a result;
; mutable last_keyseq: keystate list mutable last_keyseq : keystate list;
; mutable last_actions: 'a list } mutable last_actions : 'a list;
}
type mods = Ctrl | Meta | Super | Shift type mods = Ctrl | Meta | Super | Shift
type key = C of char | U of code type key = C of char | U of code
@ -110,16 +126,19 @@ module Key = struct
List.map List.map
(fun (m, k) -> (fun (m, k) ->
keystate_of_mods keystate_of_mods
{ meta= false {
; ctrl= false meta = false;
; super= false ctrl = false;
; shift= false super = false;
; code= shift = false;
code =
(match k with (match k with
| C c -> `Uchar (Uchar.of_char c) | C c -> `Uchar (Uchar.of_char c)
| U c -> c ) } | U c -> c);
}
m) m)
events in events
in
S.add events action bindings S.add events action bindings
let default_resolver b = S.resolver [ S.pack (fun x -> x) b ] let default_resolver b = S.resolver [ S.pack (fun x -> x) b ]
@ -128,7 +147,12 @@ module Key = struct
match result with S.Continue r -> r | _ -> default match result with S.Continue r -> r | _ -> default
let init bindings = let init bindings =
{bindings; state= S.Rejected; last_keyseq= []; last_actions= []} {
bindings;
state = S.Rejected;
last_keyseq = [];
last_actions = [];
}
let resolve = S.resolve let resolve = S.resolve
let empty = S.empty let empty = S.empty
@ -300,7 +324,8 @@ module Event_js = struct
| `Await -> decode dec d | `Await -> decode dec d
| `End -> d | `End -> d
| `Uchar u -> | `Uchar u ->
if Option.is_none d then decode dec (Some u) else None in if Option.is_none d then decode dec (Some u) else None
in
decode decode
(Uutf.decoder (Uutf.decoder
~nln:(`Readline (Uchar.of_int 0x000A)) ~nln:(`Readline (Uchar.of_int 0x000A))
@ -332,13 +357,15 @@ module Event_js = struct
match Js.Optdef.to_option evt##.key with match Js.Optdef.to_option evt##.key with
| Some s -> | Some s ->
`Key `Key
( p ( p,
, Key. Key.
{ meta= Js.to_bool evt##.altKey {
; shift= Js.to_bool evt##.shiftKey meta = Js.to_bool evt##.altKey;
; ctrl= Js.to_bool evt##.ctrlKey shift = Js.to_bool evt##.shiftKey;
; super= Js.to_bool evt##.metaKey ctrl = Js.to_bool evt##.ctrlKey;
; code= of_jskey (Js.to_string s) } ) super = Js.to_bool evt##.metaKey;
code = of_jskey (Js.to_string s);
} )
| None -> `Unknown "keypress .key is None?" | None -> `Unknown "keypress .key is None?"
end end
@ -347,10 +374,11 @@ module Panel = struct
open NVG open NVG
(* current window state to be passed to window renderer *) (* current window state to be passed to window renderer *)
type state = type state = {
{ box: box2 box : box2;
(* This is cannonically box within which the next element should draw *) (* This is cannonically box within which the next element should draw *)
; renderer: NVG.t } renderer : NVG.t;
}
(* the box2 here is cannonically the place the returner drew (* the box2 here is cannonically the place the returner drew
(the Wall.image extents) *) (the Wall.image extents) *)
@ -365,7 +393,11 @@ module Panel = struct
let draw_pane vg pane width height = let draw_pane vg pane width height =
let _, _ = let _, _ =
pane {box= Box2.v (P2.v 0. 0.) (P2.v width height); renderer= vg} pane
{
box = Box2.v (P2.v 0. 0.) (P2.v width height);
renderer = vg;
}
in in
Ok () Ok ()
@ -397,27 +429,32 @@ module Panel = struct
module Style = struct module Style = struct
module Font = struct module Font = struct
type t = type t = {
{ size: float option size : float option;
; font: [`Sans | `Serif | `Mono | `None] font : [ `Sans | `Serif | `Mono | `None ];
; weight: [`Bold | `Regular | `Light | `None] weight : [ `Bold | `Regular | `Light | `None ];
; italic: [`Italic | `None] italic : [ `Italic | `None ];
; underline: [`Underline | `None] } underline : [ `Underline | `None ];
}
let empty = let empty =
{ size= None {
; font= `None size = None;
; weight= `None font = `None;
; italic= `None weight = `None;
; underline= `None } italic = `None;
underline = `None;
}
let default = let default =
ref ref
{ size= Some 20. {
; font= `Sans size = Some 20.;
; weight= `Regular font = `Sans;
; italic= `None weight = `Regular;
; underline= `None } italic = `None;
underline = `None;
}
let size { size; _ } = let size { size; _ } =
match (size, !default.size) with match (size, !default.size) with
@ -425,35 +462,37 @@ module Panel = struct
| None, Some s | Some s, _ -> s | None, Some s | Some s, _ -> s
let merge a b = let merge a b =
{ size= {
size =
(match (a.size, b.size) with (match (a.size, b.size) with
| None, None -> None | None, None -> None
| Some s, None | None, Some s -> Some s | Some s, None | None, Some s -> Some s
| Some s1, Some s2 -> Some (Float.max_num s1 s2) ) | Some s1, Some s2 -> Some (Float.max_num s1 s2));
; font= font =
(match (a.font, b.font) with (match (a.font, b.font) with
| `Sans, _ | _, `Sans -> `Sans | `Sans, _ | _, `Sans -> `Sans
| `Serif, (`Serif | `Mono | `None) | `Serif, (`Serif | `Mono | `None)
| (`Mono | `None), `Serif -> | (`Mono | `None), `Serif ->
`Serif `Serif
| `Mono, (`Mono | `None) | `None, `Mono -> `Mono | `Mono, (`Mono | `None) | `None, `Mono -> `Mono
| `None, `None -> `None ) | `None, `None -> `None);
; weight= weight =
(match (a.weight, b.weight) with (match (a.weight, b.weight) with
| `Bold, _ | _, `Bold -> `Bold | `Bold, _ | _, `Bold -> `Bold
| `Regular, (`Regular | `Light | `None) | `Regular, (`Regular | `Light | `None)
| (`Light | `None), `Regular -> | (`Light | `None), `Regular ->
`Regular `Regular
| `Light, (`Light | `None) | `None, `Light -> `Light | `Light, (`Light | `None) | `None, `Light -> `Light
| `None, `None -> `None ) | `None, `None -> `None);
; italic= italic =
(match (a.italic, b.italic) with (match (a.italic, b.italic) with
| `Italic, _ | _, `Italic -> `Italic | `Italic, _ | _, `Italic -> `Italic
| _ -> `None ) | _ -> `None);
; underline= underline =
(match (a.underline, b.underline) with (match (a.underline, b.underline) with
| `Underline, _ | _, `Underline -> `Underline | `Underline, _ | _, `Underline -> `Underline
| _ -> `None ) } | _ -> `None);
}
let set vg t = let set vg t =
(match t.size with (match t.size with
@ -470,7 +509,11 @@ module Panel = struct
let gray a = Color.rgbf ~r:a ~g:a ~b:a let gray a = Color.rgbf ~r:a ~g:a ~b:a
let empty = let empty =
{fg= Color.transparent; bg= Color.transparent; font= Font.empty} {
fg = Color.transparent;
bg = Color.transparent;
font = Font.empty;
}
let light = { empty with fg = gray 0.2 } let light = { empty with fg = gray 0.2 }
let dark = { empty with fg = gray 0.8 } let dark = { empty with fg = gray 0.8 }
@ -480,17 +523,21 @@ module Panel = struct
if a1 == empty then a2 if a1 == empty then a2
else if a2 == empty then a1 else if a2 == empty then a1
else else
{ a1 with {
fg= Color.lerp a1.fg a2.fg ~a:0.5 a1 with
; bg= Color.lerp a1.bg a2.bg ~a:0.5 } fg = Color.lerp a1.fg a2.fg ~a:0.5;
bg = Color.lerp a1.bg a2.bg ~a:0.5;
}
let fg fg = { empty with fg } let fg fg = { empty with fg }
let bg bg = { empty with bg } let bg bg = { empty with bg }
let merge a b = let merge a b =
{ fg= Color.lerp a.fg b.fg ~a:0.5 {
; bg= Color.lerp a.bg b.bg ~a:0.5 fg = Color.lerp a.fg b.fg ~a:0.5;
; font= Font.merge a.font b.font } bg = Color.lerp a.bg b.bg ~a:0.5;
font = Font.merge a.font b.font;
}
let set vg s = let set vg s =
F.epr "Style.set @."; F.epr "Style.set @.";
@ -500,13 +547,20 @@ module Panel = struct
end end
module Pad = struct module Pad = struct
type t = {t: Gg.size1; b: Gg.size1; l: Gg.size1; r: Gg.size1} type t = {
t : Gg.size1;
b : Gg.size1;
l : Gg.size1;
r : Gg.size1;
}
let empty = let empty =
{ t= Gg.Size1.zero {
; b= Gg.Size1.zero t = Gg.Size1.zero;
; l= Gg.Size1.zero b = Gg.Size1.zero;
; r= Gg.Size1.zero } l = Gg.Size1.zero;
r = Gg.Size1.zero;
}
let all v = { t = v; b = v; l = v; r = v } let all v = { t = v; b = v; l = v; r = v }
end end
@ -605,8 +659,8 @@ module Panel = struct
let rec node_up_ (d : [ `Left | `Right ]) n' = let rec node_up_ (d : [ `Left | `Right ]) n' =
match (d, n'.parent) with match (d, n'.parent) with
| _, `None -> None | _, `None -> None
| ( _ | ( _,
, ( `Left ({t= `Attr _; _} as p) ( `Left ({ t = `Attr _; _ } as p)
| `Right ({ t = `Attr _; _ } as p) ) ) -> | `Right ({ t = `Attr _; _ } as p) ) ) ->
node_up_ d p node_up_ d p
| `Right, `Right ({ t = `Join _; _ } as p) | `Right, `Right ({ t = `Join _; _ } as p)
@ -693,7 +747,8 @@ module Panel = struct
| Some { t = `Atom _; _ } -> () | Some { t = `Atom _; _ } -> ()
| Some { t = `Attr (_, n'); _ } -> traverse_nodes ~f n' | Some { t = `Attr (_, n'); _ } -> traverse_nodes ~f n'
| Some { t = `Join (_, a, b); _ } -> | Some { t = `Join (_, a, b); _ } ->
traverse_nodes ~f a ; traverse_nodes ~f b traverse_nodes ~f a;
traverse_nodes ~f b
| None -> () | None -> ()
let insert_join_l (d : dir) (n : node) (n' : node) : node = let insert_join_l (d : dir) (n : node) (n' : node) : node =
@ -769,8 +824,7 @@ module Panel = struct
| `Page -> "`Page" | `Page -> "`Page"
| `Text -> | `Text ->
"`Text" "`Text"
(* text is like a file (unicode calls it End Of Text) *) (* text is like a file (unicode calls it End Of Text) *))
)
ppf () ppf ()
let pp_atom ppf v = let pp_atom ppf v =
@ -782,7 +836,9 @@ module Panel = struct
| `Hint h -> | `Hint h ->
any "`Hint " any "`Hint "
++ any ++ any
(match h with `Line -> "`Line" | `Other -> "`Other") (match h with
| `Line -> "`Line"
| `Other -> "`Other")
| `Empty -> any "`Empty") | `Empty -> any "`Empty")
ppf () ppf ()
@ -831,15 +887,18 @@ module Panel = struct
pf ppf "@[<hov>%a@]" pf ppf "@[<hov>%a@]"
(braces (braces
(record (record
[ field "n" (fun v -> v.n) int [
; field "t" (fun v -> v.t) (_pp_t child) field "n" (fun v -> v.n) int;
; field "parent" (fun v -> v.parent) _pp_parent ] ) ) field "t" (fun v -> v.t) (_pp_t child);
field "parent" (fun v -> v.parent) _pp_parent;
]))
v v
and pp_node_n_record = and pp_node_n_record =
F.( F.(
braces braces
(record ~sep:semi [field "n" Fun.id pp_node_n; any "..."])) (record ~sep:semi
[ field "n" Fun.id pp_node_n; any "..." ]))
and pp_node ppf = _pp_node pp_node_n ppf and pp_node ppf = _pp_node pp_node_n ppf
and pp_dump_node ppf = _pp_node pp_dump_node ppf and pp_dump_node ppf = _pp_node pp_dump_node ppf
@ -859,8 +918,11 @@ module Panel = struct
| `Attr (a, n) -> | `Attr (a, n) ->
[ const pp_attr a; const pp_node_structure n ] [ const pp_attr a; const pp_node_structure n ]
| `Join (d, l, r) -> | `Join (d, l, r) ->
[ const pp_dir d; const pp_node_structure l [
; const pp_node_structure r ] ) )) const pp_dir d;
const pp_node_structure l;
const pp_node_structure r;
])))
ppf () ppf ()
end end
@ -908,8 +970,7 @@ module Panel = struct
(Uutf.decoder (Uutf.decoder
~nln:(`Readline (Uchar.of_int 0x000A)) ~nln:(`Readline (Uchar.of_int 0x000A))
(`String str)) (`String str))
empty_append empty_append (empty_append, `Await)
(empty_append, `Await)
let text = of_string let text = of_string
let nl = atom (`Boundary `Line) let nl = atom (`Boundary `Line)
@ -939,7 +1000,8 @@ module Panel = struct
let rec encode c = let rec encode c =
match Uutf.encode enc c with match Uutf.encode enc c with
| `Ok -> () | `Ok -> ()
| `Partial -> encode `Await in | `Partial -> encode `Await
in
encode (`Uchar uc); encode (`Uchar uc);
encode `End; encode `End;
let text = Bytes.to_string (Buffer.to_bytes b) in let text = Bytes.to_string (Buffer.to_bytes b) in
@ -963,7 +1025,8 @@ module Panel = struct
Path.rect vg ~x:(P2.x b) ~y:(P2.y b) ~w ~h; Path.rect vg ~x:(P2.x b) ~y:(P2.y b) ~w ~h;
let img_paint = let img_paint =
Paint.image_pattern vg ~cx:(P2.x b) ~cy:(P2.y b) ~w ~h Paint.image_pattern vg ~cx:(P2.x b) ~cy:(P2.y b) ~w ~h
~angle:0.0 ~image ~alpha:0. in ~angle:0.0 ~image ~alpha:0.
in
set_fill_paint vg ~paint:img_paint; set_fill_paint vg ~paint:img_paint;
fill vg; fill vg;
P2.v (P2.x b +. w) (P2.y b +. h) P2.v (P2.x b +. w) (P2.y b +. h)
@ -994,7 +1057,8 @@ module Panel = struct
| `X -> P2.v (P2.x av) (P2.y t) | `X -> P2.v (P2.x av) (P2.y t)
| `Y -> P2.v (P2.x t) (P2.y av) | `Y -> P2.v (P2.x t) (P2.y av)
| `Z -> t) | `Z -> t)
b in b
in
match d with match d with
| `X -> V2.v (V2.x bv) (Float.max_num (V2.y av) (V2.y bv)) | `X -> V2.v (V2.x bv) (Float.max_num (V2.y av) (V2.y bv))
| `Y -> V2.v (Float.max_num (V2.x av) (V2.x bv)) (V2.y bv) | `Y -> V2.v (Float.max_num (V2.x av) (V2.x bv)) (V2.y bv)
@ -1008,7 +1072,8 @@ module Panel = struct
match n.t with match n.t with
| `Atom a -> atom t b a | `Atom a -> atom t b a
| `Attr a -> attr t b a | `Attr a -> attr t b a
| `Join a -> join t b a in | `Join a -> join t b a
in
(*ignore (*ignore
(Display.path_box t.vg (Display.path_box t.vg
(Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2) (Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2)
@ -1092,7 +1157,9 @@ module Panel = struct
(search_backward (search_backward
(function (function
| { t = `Atom (`Boundary `Line); _ } -> Some () | { t = `Atom (`Boundary `Line); _ } -> Some ()
| {t= `Atom (`Uchar _); _} -> incr i ; None | { t = `Atom (`Uchar _); _ } ->
incr i;
None
| _ -> None) | _ -> None)
c.sel); c.sel);
match search_forward (is_boundary `Line) c.sel with match search_forward (is_boundary `Line) c.sel with
@ -1111,7 +1178,9 @@ module Panel = struct
search_backward search_backward
(function (function
| { t = `Atom (`Boundary `Line); _ } as n' -> Some n' | { t = `Atom (`Boundary `Line); _ } as n' -> Some n'
| {t= `Atom (`Uchar _); _} -> incr i ; None | { t = `Atom (`Uchar _); _ } ->
incr i;
None
| _ -> None) | _ -> None)
c.sel c.sel
with with
@ -1189,8 +1258,7 @@ module Panel = struct
(`Draw (`Draw
(fun (t : draw_context) (b : P2.t) -> (fun (t : draw_context) (b : P2.t) ->
Draw.node t b Draw.node t b
(Text.lines (Fmt.to_to_string pp_node_structure c.root)) (Text.lines (Fmt.to_to_string pp_node_structure c.root))))
) )
(atom `Empty) (atom `Empty)
let draw_cursor_sel (c : cursor) : node = let draw_cursor_sel (c : cursor) : node =
@ -1220,9 +1288,11 @@ module Panel = struct
match e with match e with
| `Key (`Press, (k : Key.keystate)) -> ( | `Key (`Press, (k : Key.keystate)) -> (
match k.code with match k.code with
| `Uchar c -> Some (`Insert (atom (`Uchar c))) | `Uchar c ->
Some (`Insert (atom (`Uchar c)))
| _ -> None) | _ -> None)
| _ -> None ) in | _ -> None)
in
let r = let r =
match a with match a with
| Some x -> | Some x ->
@ -1237,9 +1307,10 @@ module Panel = struct
Action.pp_t x); Action.pp_t x);
c.sel <- insert_attr cursor_attr c.sel; c.sel <- insert_attr cursor_attr c.sel;
None None
| None -> None in | None -> None
r ) in
, n ) ; r),
n );
join_y (pad 5. c.root) join_y (pad 5. c.root)
(join_y (join_y
(pad 5. (draw_cursor_sel c)) (pad 5. (draw_cursor_sel c))
@ -1265,16 +1336,22 @@ module Panel = struct
F.epr "Unhandled event: %s@." (Event.to_string _e)); F.epr "Unhandled event: %s@." (Event.to_string _e));
Draw.node { vg; style = Style.dark } p t Draw.node { vg; style = Style.dark } p t
let test = let storetree = ref (Nav.test_pull ())
style Style.dark let storecursor = ref []
(pad 20.
(textedit open Lwt.Infix
Text.(
(* text "--- welcome to my land of idiocy ---" let render_lwt (vg : NVG.t) (p : P2.t) (_ev : Event.t) :
^/^ *) unit Lwt.t =
text "hello bitch" !storetree >>= fun tree ->
(*^^ text "! sup daddy" ^^ nl) Nav.S.Tree.list tree !storecursor >>= fun l ->
^/^ lines "123")*)) ) ) let contents =
String.concat "\n" (List.map (fun (step, _t') -> step) l)
in
Draw.node { vg; style = Style.dark } p (Text.lines contents)
|> ignore;
Lwt.return_unit
end end
end end