codeboss
/
WsParser_VS
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

update

This commit is contained in:
codeboss 2025-02-23 22:56:48 +08:00
parent d66e481b6c
commit a1f651ca61
3 changed files with 497 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

453
AstConv/HtmlStruct.fs
View File

@ -28,11 +28,11 @@ open System.IO
class class
let mutable root: string = "" let mutable root: string = ""
member this.pageURL(): string = $"{root}{name}.html" member this.pageURL(): string = $"{root}{name}.html"
member this.setPageRoot(path: string) = member this.setPageRoot(path: Uri) =
if path.EndsWith "/" then if path.AbsolutePath.EndsWith "/" then
root <- path root <- path.AbsolutePath
else else
root <- path+"/" root <- path.AbsolutePath + "/"
end end
/// 内容定义元素 ================================================================================= /// 内容定义元素 =================================================================================
@ -760,3 +760,448 @@ open System.IO
writer.Flush() writer.Flush()
out.ToString() out.ToString()
end end
type IndexPage(name: string, childs: Present.IDomUnit list) =
class
inherit Present.PageAccess("index")
new(name) = IndexPage(name, [])
member this.append(arg: Present.IDomUnit list) =
IndexPage(name, childs @ arg)
interface Present.IDomUnit with
member this.name(): string = name
member this.object(): AstImport.AstObject =
raise (System.NotImplementedException())
interface PageText with
member this.bindPage(): obj = this
member this.getHtmlText(): string =
let doc = XmlDocument()
let doc_type = doc.CreateDocumentType("html", null, null, null)
doc.AppendChild(doc_type) |> ignore
let html = doc.CreateElement("html")
let head = doc.CreateElement("head")
let charset = doc.CreateElement("meta")
charset.SetAttribute("charset", "UTF-8")
head.AppendChild(charset) |> ignore
let refresh = doc.CreateElement("meta")
refresh.SetAttribute("http-equiv", "refresh")
refresh.SetAttribute("content", "5")
head.AppendChild(refresh) |> ignore
let title = doc.CreateElement("title")
title.AppendChild(doc.CreateTextNode(name)) |> ignore
head.AppendChild(title) |> ignore
let style = doc.CreateElement("style")
style.AppendChild(doc.CreateTextNode("""body{
background-color:lightgray;
}
h1 {
margin-left:300px;
margin-top: 50px;
margin-bottom: 30px;
}
div.outline {
max-width:90%;
#outline:green dotted thick;
margin:auto;
display:flex;
background-color:#f0f0f0;
}
div#left-nav{
min-width:30%;
max-width:30%;
# border:1px solid red;
# outline:green dotted thick;
overflow:clip;
padding:20px;
background-image: linear-gradient(
to right,
#e0e0e0 0%,
#ffffff 100%
);
}
div#left-nav p {
word-wrap:break-word;
text-align:right;
}
div.content {
padding: 5px;
padding-left: 20px;
max-width: 90%;
outline: #e0e0e0 solid 1px;
box-shadow: 2px 2px 2px gray;
}
.content p {
word-wrap:break-word;
}
""")) |> ignore
head.AppendChild(style) |> ignore
html.AppendChild(head) |> ignore
doc.AppendChild(html) |> ignore
let body = doc.CreateElement("body")
html.AppendChild(body) |> ignore
let h1 = doc.CreateElement("h1")
h1.AppendChild(doc.CreateTextNode(name)) |> ignore
body.AppendChild(h1) |> ignore
let div_outline = doc.CreateElement("div")
div_outline.SetAttribute("class", "outline")
body.AppendChild(div_outline) |> ignore
let div_nav = doc.CreateElement("div")
div_nav.SetAttribute("id", "left-nav")
div_outline.AppendChild(div_nav) |> ignore
this.initNavigate(div_nav) |> ignore
let div_content = doc.CreateElement("div")
div_content.SetAttribute("id", "content")
div_content.SetAttribute("class", "content")
div_outline.AppendChild(div_content) |> ignore
this.contentAppend(div_content, childs)
let out = new StringWriter()
let writer = new XmlTextWriter(out)
writer.Formatting = Formatting.Indented |> ignore
doc.WriteTo(writer)
writer.Flush()
out.ToString()
member this.initNavigate(nav: XmlElement): unit =
let vdoc = nav.OwnerDocument
let p1 = vdoc.CreateElement("p")
let a1 = vdoc.CreateElement("a")
a1.SetAttribute("href", "#volume");
a1.AppendChild(vdoc.CreateTextNode("卷宗组织")) |> ignore
p1.AppendChild(a1) |> ignore
nav.AppendChild(p1) |> ignore
let p2 = vdoc.CreateElement("p")
let a2 = vdoc.CreateElement("a")
a2.SetAttribute("href", "#story");
a2.AppendChild(vdoc.CreateTextNode("故事脉络")) |> ignore
p2.AppendChild(a2) |> ignore
nav.AppendChild(p2) |> ignore
let p4 = vdoc.CreateElement("p")
let a4 = vdoc.CreateElement("a")
a4.SetAttribute("href", "#story-graph");
a4.AppendChild(vdoc.CreateTextNode("脉络图示")) |> ignore
p4.AppendChild(a4) |> ignore
nav.AppendChild(p4) |> ignore
let p3 = vdoc.CreateElement("p")
let a3 = vdoc.CreateElement("a")
a3.SetAttribute("href", "#volume-graph");
a3.AppendChild(vdoc.CreateTextNode("卷宗图示")) |> ignore
p3.AppendChild(a3) |> ignore
nav.AppendChild(p3) |> ignore
member this.contentAppend(content: XmlElement, childs: Present.IDomUnit list): unit =
let vdoc = content.OwnerDocument
// volume汇总
let div_volume = vdoc.CreateElement("div")
div_volume.SetAttribute("data-type", "volume")
div_volume.SetAttribute("class", "content")
let volume_title = vdoc.CreateElement("h3")
volume_title.SetAttribute("id", "volume")
volume_title.AppendChild(vdoc.CreateTextNode("卷宗组织")) |> ignore
div_volume.AppendChild(volume_title) |> ignore
content.AppendChild(div_volume) |> ignore
for p in childs do
match p with
| :? Present.VolumePage ->
let div_page = vdoc.CreateElement("div")
let page_a = vdoc.CreateElement("a")
let page_bind = p :?> Present.PageAccess
page_a.SetAttribute("href", page_bind.pageURL())
page_a.AppendChild(vdoc.CreateTextNode(p.name())) |> ignore
div_page.AppendChild(page_a) |> ignore
div_volume.AppendChild(div_page) |> ignore
| _ -> ()
// story汇总
let div_story = vdoc.CreateElement("div")
div_story.SetAttribute("data-type", "story")
div_story.SetAttribute("class", "content")
let story_title = vdoc.CreateElement("h3")
story_title.SetAttribute("id", "story")
story_title.AppendChild(vdoc.CreateTextNode("故事脉络")) |> ignore
div_story.AppendChild(story_title) |> ignore
content.AppendChild(div_story) |> ignore
for p in childs do
match p with
| :? Present.StoryPage ->
let div_page = vdoc.CreateElement("div")
let page_a = vdoc.CreateElement("a")
let page_bind = p :?> Present.PageAccess
page_a.SetAttribute("href", page_bind.pageURL())
page_a.AppendChild(vdoc.CreateTextNode(p.name())) |> ignore
div_page.AppendChild(page_a) |> ignore
div_story.AppendChild(div_page) |> ignore
| _ -> ()
// storylines 网络图
let div_story_svg = vdoc.CreateElement("div")
div_story_svg.SetAttribute("data-type", "story_svg")
div_story_svg.SetAttribute("id", "story-graph")
let story_h3 = vdoc.CreateElement("h3")
story_h3.AppendChild(vdoc.CreateTextNode("脉络图示")) |> ignore
div_story_svg.AppendChild(story_h3) |> ignore
let image = vdoc.CreateElement("img")
image.SetAttribute("src", "./storys_display.svg")
div_story_svg.AppendChild(image) |> ignore
content.AppendChild(div_story_svg) |> ignore
// volumes 引用图
let div_volume_svg = vdoc.CreateElement("div")
div_volume_svg.SetAttribute("data-type", "volume_svg")
div_volume_svg.SetAttribute("id", "volume-graph")
let volume_h3 = vdoc.CreateElement("h3")
volume_h3.AppendChild(vdoc.CreateTextNode("卷宗图示")) |> ignore
div_volume_svg.AppendChild(volume_h3) |> ignore
let image2 = vdoc.CreateElement("img")
image2.SetAttribute("src", "./volume_display.svg")
div_volume_svg.AppendChild(image2) |> ignore
content.AppendChild(div_volume_svg) |> ignore
end
type StorylineGraphMake(gname:string, items: Present.PageAccess list) =
class
let 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)
member private this.node_collect(objs: AstImport.AstObject list) =
match objs with
| [] -> []
| _ ->
match objs.Head with
| :? AstImport.StoryDef as story ->
let list_a = this.node_collect(story.children())
(list_a|> List.map(fun (_, b, c) -> Some(story), b, c))@this.node_collect(objs.Tail)
| :? AstImport.SliceDef as slice ->
let list_a = this.node_collect(slice.children())
(list_a|> List.map(fun (_, _, c) -> None, Some(slice), c))@this.node_collect(objs.Tail)
| :? AstImport.PointDef as point ->
(None, None, point :> AstImport.AstObject)::this.node_collect(objs.Tail)
| :? AstImport.PointRef as refer ->
(None, None, refer)::this.node_collect(objs.Tail)
| _ -> this.node_collect(objs.Tail)
member this.getGraphCode(): string =
let node_about = this.node_collect(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 = 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 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
| [] -> []
| _ ->
(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.Replace("&&&&", "\n")}"""
)
|> List.reduce(fun a b -> a + "\n" + b)
$"""digraph node_relates{{
rankdir=LR
label="{gname}"
{nodes_decl}
{slice_relates}
{refer_arrows}
{story_arrows}
}}"""
end
type VolumeGraphMake(gname: string, story_volume_set: Present.PageAccess list) =
class
member private this.node_collect(objs: AstImport.AstObject list) =
match objs with
| [] -> []
| _ ->
match objs.Head with
| :? AstImport.StoryDef as story ->
let list = this.node_collect(story.children())
(list|> List.map(fun (_, b, c) -> Some(story :> AstImport.AstObject), b, c))@this.node_collect(objs.Tail)
| :? AstImport.SliceDef as slice ->
let list = this.node_collect(slice.children())
(list|> List.map(fun (_, _, c) -> None, Some(slice :> AstImport.AstObject), c))@this.node_collect(objs.Tail)
| :? AstImport.VolumeDef as volume ->
let list = this.node_collect(volume.children())
(list|> List.map(fun (_, b, c) -> Some(volume), b, c))@this.node_collect(objs.Tail)
| :? AstImport.ArticleDef as article ->
let list = this.node_collect(article.children())
(list|> List.map(fun (_, _, c) -> None, Some(article), c))@this.node_collect(objs.Tail)
| :? AstImport.PointDef as point ->
(None, None, point :> AstImport.AstObject)::this.node_collect(objs.Tail)
| :? AstImport.PointRef as refer ->
(None, None, refer)::this.node_collect(objs.Tail)
| _ -> this.node_collect(objs.Tail)
member this.getGraphCode(): string =
let storys = story_volume_set
|> List.filter(fun dt -> dt :? Present.StoryPage)
|> List.map(fun d -> d :?> Present.StoryPage)
|> List.map(fun d -> d :> Present.IDomUnit)
|> List.map(fun d -> d.object())
let volumes= story_volume_set
|> List.filter(fun dt -> dt :? Present.VolumePage)
|> List.map(fun dt -> dt :?> Present.VolumePage)
|> List.map(fun d -> d :> Present.IDomUnit)
|> List.map(fun d -> d.object())
let rec point_code_generate(list: AstImport.AstObject list) =
match list with
| [] -> []
| _ ->
let item_current = list.Head
match item_current with
| :? AstImport.StoryDef as story ->
let subcluster = point_code_generate(story.children())
let clusters_desc = if subcluster.Length > 0 then subcluster|> List.reduce(fun a b -> a + "\n" + b) else ""
let story_desc = $""" subgraph cluster_{story.address()} {{ label="{story.name()}" {clusters_desc} }} """
story_desc::point_code_generate(list.Tail)
| :? AstImport.SliceDef as slice ->
let node_exists = point_code_generate(slice.children())
let nodes_desc = if node_exists.Length > 0 then node_exists|> List.reduce(fun a b -> a+"\n"+b) else ""
let slice_desc = $""" subgraph cluster_{slice.address()} {{ label="{slice.name()}" {nodes_desc} }} """
slice_desc::point_code_generate(list.Tail)
| :? AstImport.PointDef as point ->
let node_desc = $""" node_{point.address()}[label="{point.name()}" shape="rect" style="diagonals"] """
node_desc::point_code_generate(list.Tail)
| :? AstImport.PointRef as refer ->
let refer_desc = $""" node_{refer.address()}[label="{refer.pointRef()}" style="dotted"] """
refer_desc::point_code_generate(list.Tail)
| :? AstImport.ArticleDef as article ->
let refer_descx = point_code_generate(article.children())
let nodes_desc = if refer_descx.Length > 0 then refer_descx|> List.reduce(fun a b -> a+"\n"+b) else ""
let article_desc = $""" subgraph cluster_{article.address()} {{ label="{article.name()}" {nodes_desc} }} """
article_desc::point_code_generate(list.Tail)
| :? AstImport.VolumeDef as volume ->
let subclusters = point_code_generate(volume.children())
let clusters_desc = if subclusters.Length > 0 then subclusters|> List.reduce(fun a b -> a + "\n" + b) else ""
let volume_desc = $""" subgraph cluster_{volume.address()} {{ label="{volume.name()}" {clusters_desc} }} """
volume_desc::point_code_generate(list.Tail)
| _ -> point_code_generate(list.Tail)
let clusters_desc = (point_code_generate(storys)@point_code_generate(volumes))|> List.reduce(fun a b -> a + "\n" + b)
let points_about = this.node_collect(storys @ volumes)
let point_map = points_about|> List.filter(fun (_, _, d) -> d :? AstImport.PointDef)
|> List.map(fun (a, b, c) ->
let story_def = a.Value :?> AstImport.StoryDef
let slice_def = b.Value :?> AstImport.SliceDef
$"{story_def.name()}&{slice_def.name()}&{(c :?> AstImport.PointDef).name()}", c.address()
)
let rec refers_link_assemble(nodes: (string*string)list) =
match nodes with
| [] -> []
| _ ->
let node_sig, address = nodes.Head
let referx = points_about|> List.filter(fun (_, _, n) -> n :? AstImport.PointRef)
|> List.map(fun (_, _, c) -> c :?> AstImport.PointRef)
|> List.filter(fun n ->
let sig_ref = $"{n.storyRef()}&{n.sliceRef()}&{n.pointRef()}"
sig_ref = node_sig
)
let code_curr = referx |> List.map(fun x-> $"node_{x.address()}--node_{address}")
code_curr@refers_link_assemble(nodes.Tail)
let temps = refers_link_assemble(point_map)
let refer_arrows = refers_link_assemble(point_map)|> List.reduce(fun a b -> a + "\n" + b)
$"""graph{{ label="{gname}" {clusters_desc} {refer_arrows} }}"""
end

42
AstConv/Program.fs
View File

@ -5,13 +5,29 @@ open HtmlStruct.Assemble
open HtmlStruct.Content open HtmlStruct.Content
open HtmlStruct.Present open HtmlStruct.Present
open System.IO open System.IO
open System.Text
open System
open System.Diagnostics
let args = System.Environment.GetCommandLineArgs()|> Array.toList
if args.Length <> 5 then
failwith "程序调用参数错误：AstConv.exe -file xast文件路径 -odir 输出文件夹路径"
let file_in, dir_o = match args.Item(1), args.Item(3) with
| "-file","-odir" ->
if not(FileInfo(args.Item 2).Exists) then
failwith "指定xast文件不存在"
if not(DirectoryInfo(args.Item 4).Exists) then
failwith "指定输出文件夹不存在"
FileInfo(args.Item 2), DirectoryInfo(args.Item 4)
| _ -> failwith "程序调用参数错误：AstConv.exe -file xast文件路径 -odir 输出文件夹路径"
let out_dir = Uri(dir_o.FullName)
let doc = XmlDocument() let doc = XmlDocument()
doc.Load("E:/storyline.xast") doc.Load(file_in.FullName)
let prog = Program.GenerateFrom(doc) let prog = Program.GenerateFrom(doc)
let entry = AstVisitEntry(prog) let entry = AstVisitEntry(prog)
let visitor = UnitGenerate(prog) let visitor = UnitGenerate(prog)
entry.visitWith(visitor) |> ignore entry.visitWith(visitor) |> ignore
@ -20,7 +36,7 @@ let volume_pages = volume_page_assemble(visitor.contents()) |> List.map<VolumePa
let story_pages = story_page_assemble(visitor.contents()) |> List.map<StoryPage, IDomUnit> (fun x->x) let story_pages = story_page_assemble(visitor.contents()) |> List.map<StoryPage, IDomUnit> (fun x->x)
let point_pages = point_page_assemble(volume_pages @ story_pages) let point_pages = point_page_assemble(volume_pages @ story_pages)
volume_pages @ story_pages @ point_pages |> List.iter (fun it -> (it:?>PageAccess).setPageRoot("E:")) volume_pages @ story_pages @ point_pages |> List.iter (fun it -> (it:?>PageAccess).setPageRoot(out_dir))
let makers = volume_pages @ story_pages @ point_pages let makers = volume_pages @ story_pages @ point_pages
|> List.map(fun page_unit -> |> List.map(fun page_unit ->
match page_unit with match page_unit with
@ -33,6 +49,26 @@ let makers = volume_pages @ story_pages @ point_pages
| _ -> failwith "" | _ -> failwith ""
) )
let index_page = IndexPage("汇总页面", volume_pages @ story_pages @ point_pages)
index_page.setPageRoot(out_dir)
let content = (index_page :> PageText).getHtmlText()
let href = index_page.pageURL()
File.WriteAllLines(href, [content])
for refs in makers do for refs in makers do
let file_path = (refs.bindPage() :?> PageAccess).pageURL() let file_path = (refs.bindPage() :?> PageAccess).pageURL()
File.WriteAllLines(file_path, [refs.getHtmlText()]) File.WriteAllLines(file_path, [refs.getHtmlText()])
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 graph2 = VolumeGraphMake("卷章引用网络", (volume_pages@story_pages)|> List.map(fun d -> d :?> PageAccess))
let graph2_code = graph2.getGraphCode()
let stream2 = new StreamWriter(Path.Combine(dir_o.FullName, "volume_display.dot"), false)
stream2.Write(graph2_code)
stream2.Flush()
Process.Start("dot", $"""-Tsvg -o{Path.Combine(dir_o.FullName, "volume_display.svg")} {Path.Combine(dir_o.FullName, "volume_display.dot")}""") |> ignore

8
AstConv/Properties/launchSettings.json Normal file
View File

@ -0,0 +1,8 @@
{
"profiles": {
"AstConv": {
"commandName": "Project",
"commandLineArgs": "-file \"E:/storyline.xast\" -odir \"E:/diro\""
}
}
}