From 1167090fb520544bb0725328922fe6253be579a9 Mon Sep 17 00:00:00 2001 From: codeboss <2422523675@qq.com> Date: Sat, 29 Mar 2025 19:49:02 +0800 Subject: [PATCH] =?UTF-8?q?=E6=94=B9=E8=BF=9B=E6=95=85=E4=BA=8B=E7=BA=BF?= =?UTF-8?q?=E5=9B=BE=E7=A4=BA?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- AstConv/AstImport.fs | 2 +- AstConv/HtmlStruct.fs | 147 +++++++++++++++--------------------------- AstConv/Program.fs | 12 ++-- 3 files changed, 59 insertions(+), 102 deletions(-) diff --git a/AstConv/AstImport.fs b/AstConv/AstImport.fs index 0757705..4fd3e08 100644 --- a/AstConv/AstImport.fs +++ b/AstConv/AstImport.fs @@ -8,7 +8,7 @@ open System.Linq type AstObject() = class abstract member address:unit -> string - default this.address():string = string(this.GetHashCode ()) + default this.address():string = "mem_" + string(this.GetHashCode ()) abstract member members:unit -> AstObject list default this.members(): AstObject list = [] diff --git a/AstConv/HtmlStruct.fs b/AstConv/HtmlStruct.fs index b82ffa7..e5ad8e4 100644 --- a/AstConv/HtmlStruct.fs +++ b/AstConv/HtmlStruct.fs @@ -920,7 +920,7 @@ open System.IO type StorylineGraphMake(gname:string, items: Present.PageAccess list) = class - let lines = items |> List.filter(fun v-> v :? Present.StoryPage) + let story_lines = items |> List.filter(fun v-> v :? Present.StoryPage) |> List.map(fun v->v:?>Present.StoryPage) |> List.map(fun s->s :> Present.IDomUnit) |> List.map(fun s->s.object() :?> AstImport.StoryDef) @@ -937,105 +937,62 @@ open System.IO (None, slice)::this.nodedefs_collect(objs.Tail) | _ -> this.nodedefs_collect(objs.Tail) - member this.getGraphCode(): string = "" - //let slice_refers = this.node_collect(lines|> List.map(fun d -> d :> AstImport.AstObject)) + member this.getGraphCode(): string = + let fragment_defs = this.nodedefs_collect(story_lines|> List.map(fun d -> d:>AstImport.AstObject)) - // // 获取节点字典 - // let node_map = node_about|> List.filter(fun (_, _, c) -> c :? AstImport.PointDef) - // |> List.map( - // fun (a, b, c) -> - // $"{a.Value.name()}&{b.Value.name()}&{(c:?>AstImport.PointDef).name()}", c.address() - // ) + // 故事线声明 + let story_decl = story_lines|> List.map(fun story -> + $"""node_{story.address()}[label="{story.name()}" shape="cds"] + """)|> List.reduce(fun a b -> a + b) + // 情节节点声明 + let points_decl = fragment_defs |> List.map(fun (_, node_def) -> + $"""node_{node_def.address()}[label="{node_def.name()}" shape="rect"] + """)|> List.reduce(fun a b -> a + b) + // 所有的节点声明 + let nodes_decl = story_decl + points_decl + // 故事线内节点连线 + let rec node_chains(story_nm: string)(node_curr:AstImport.AstObject)(nexts:AstImport.AstObject list): string list = + match nexts with + | [] -> [] + | _ -> + let vhead = nexts.Head + match vhead with + | :? AstImport.FragmentSlice as slice -> + $"""node_{node_curr.address()}->node_{vhead.address()}[label="{story_nm}"] + """::node_chains story_nm slice nexts.Tail + | _ -> node_chains story_nm node_curr nexts.Tail + let arrows_decl = story_lines|> List.map(fun story -> node_chains (story.name()) story (story.children())) + |> List.reduce (fun al bl -> al @ bl) + |> List.reduce (fun a b -> a + b) - // // 节点声明 - // let story_decl = lines |> List.map(fun story -> - // $"""node_{story.address()}[label="{story.name()}" shape="cds"]""") - // |> List.reduce(fun a b -> a + "\n" + b) - // let points_decl = node_about |> List.map(fun (_, _, point) -> - // match point with - // | :? AstImport.PointDef as def-> - // $"""node_{point.address()}[label="{def.name()}" shape="rect"]""" - // | :? AstImport.PointRef as ref -> - // $"""node_{point.address()}[label="{ref.pointRef()}" style="dotted"]""" - // | _ -> failwith "mismatch" - // ) - // |> List.reduce(fun a b -> a + "\n" + b) - // let nodes_decl = story_decl + points_decl + // 获取节点字典 + let node_map = fragment_defs |> List.map(fun (a, b) -> + $"{a.Value.name()}&{b.name()}", b.address()) + + // 故事线之间的节点连线 + let towards_arrs = fragment_defs|> List.map(fun (_, defn) -> + let node_refs = defn.children() |> List.filter(fun v -> v:? AstImport.FragmentRef) + |> List.map(fun v -> v:?> AstImport.FragmentRef) + node_refs|> List.map(fun nref -> + let node_name = $"""{nref.storyRef()}&{nref.sliceRef()}""" + let _, address_target = node_map|> List.filter(fun (a,_)-> a = node_name)|> List.item 0 + $"""node_{defn.address()}->node_{address_target}[style="dotted"] + """ + ) + ) + |> List.reduce(fun al bl-> al @ bl) + |> List.reduce(fun a b -> a + b) + let all_arrows = arrows_decl + towards_arrs - // // 提取所有情节声明 - // let slice_nodes = node_about|> List.map(fun (a, b, _)->a.Value,b.Value)|> List.distinctBy(fun (_, b) -> b.address()) - // let rec get_slice_decl = fun (slices_t: (AstImport.StoryDef*AstImport.SliceDef) list)-> - // match slices_t with - // | [] -> [] - // | _ -> - // let story, slice = slices_t.Head - // let slice_childs = node_about - // |> List.filter( - // fun (_, b, _) -> - // slice.address() = b.Value.address() - // ) - // |> List.map(fun (_, _, n) -> $"node_{n.address()}") - // |> List.reduce(fun a b -> $"{a}->{b}") - - // let slice_def = $"""subgraph cluster_{slice.address()}{{ label="{story.name()}::{slice.name()}" {slice_childs} }}""" - // slice_def::get_slice_decl(slices_t.Tail) - // let slice_relates = get_slice_decl(slice_nodes)|> List.reduce(fun a b -> a + "\n" + b) - - - // // 构建引用指向 - // let refer_nodes = node_about|> List.filter(fun (_, _, n) -> n:? AstImport.PointRef) - // |> List.map(fun (_, _, n) -> n :?> AstImport.PointRef) - // let rec get_refer_decl = fun(list_def: (string*string)list) -> - // match list_def with - // | [] -> [] - // | _ -> - // let node_name,node_addr = list_def.Head - // let refers_about = refer_nodes|> List.filter(fun d -> node_name = $"{d.storyRef()}&{d.sliceRef()}&{d.pointRef()}") - // match refers_about with - // | [] -> get_refer_decl(list_def.Tail) - // | _ -> - // let refer_arrows = refers_about|> List.map(fun d -> $"node_{d.address()}->node_{node_addr}") - // |> List.reduce(fun a b -> a + "\n" + b) - // refer_arrows::get_refer_decl(list_def.Tail) - // let refer_arrows = get_refer_decl(node_map)|> List.reduce(fun a b -> a + "\n" + b) - - - // // 串联情节 - // let rec slice_combine = fun(items: AstImport.AstObject list) -> - // match items with - // | [] -> [] - // | _ -> - // match items.Head with - // | :? AstImport.SliceDef as defs -> - // let points = defs.children()|> List.filter(fun d -> not(d :? AstImport.TextItem)) - // match points with - // | [] -> slice_combine(items.Tail) - // | _ -> - // (points.Head, points.Item(points.Length-1))::slice_combine(items.Tail) - // | :? AstImport.StoryDef as defs -> - // slice_combine(defs.children()) - // | _ -> slice_combine(items.Tail) - // let story_arrows = lines |> List.map(fun story -> - // let slice_ends = slice_combine([story]) - // match slice_ends with - // | [] -> "" - // | _ -> - // let arrow_link = slice_ends |> List.map(fun (a,b) -> $"node_{a.address()} node_{b.address()}") - // |> List.reduce(fun a b -> $"{a}->{b}") - // $"""node_{story.address()}->{arrow_link}""" - // ) - // |> List.reduce(fun a b -> a + "\n" + b) - - // $"""digraph node_relates{{ - // rankdir=LR - // label="{gname}" - // {nodes_decl} - // {slice_relates} - // {refer_arrows} - // {story_arrows} - // }}""" + + $"""digraph node_relates{{ + rankdir=LR + label="{gname}" + {nodes_decl} + {all_arrows} + }}""" end //type VolumeGraphMake(gname: string, story_volume_set: Present.PageAccess list) = diff --git a/AstConv/Program.fs b/AstConv/Program.fs index 93f9ff9..d39c293 100644 --- a/AstConv/Program.fs +++ b/AstConv/Program.fs @@ -63,13 +63,13 @@ for refs in makers do let file_path = (refs.bindPage() :?> PageAccess).pageURL() File.WriteAllLines(file_path, [refs.getHtmlText()]) -//let graph = StorylineGraphMake("故事线网络", story_pages|> List.map(fun x -> x :?> PageAccess)) -//let graph_code = graph.getGraphCode() +let graph = StorylineGraphMake("故事线网络", story_pages|> List.map(fun x -> x :?> PageAccess)) +let graph_code = graph.getGraphCode() -//let stream = new StreamWriter(Path.Combine(dir_o.FullName, "storys_display.dot"), false) -//stream.Write(graph_code) -//stream.Flush() -//Process.Start("dot", $"""-Tsvg -o{Path.Combine(dir_o.FullName, "storys_display.svg")} {Path.Combine(dir_o.FullName, "storys_display.dot")}""") |> ignore +let stream = new StreamWriter(Path.Combine(dir_o.FullName, "storys_display.dot"), false) +stream.Write(graph_code) +stream.Flush() +Process.Start("dot", $"""-Tsvg -o{Path.Combine(dir_o.FullName, "storys_display.svg")} {Path.Combine(dir_o.FullName, "storys_display.dot")}""") |> ignore //let graph2 = VolumeGraphMake("卷章引用网络", (volume_pages@story_pages)|> List.map(fun d -> d :?> PageAccess)) //let graph2_code = graph2.getGraphCode()