diff --git a/AstConv/HtmlStruct.fs b/AstConv/HtmlStruct.fs
index 3fdc899..32045c9 100644
--- a/AstConv/HtmlStruct.fs
+++ b/AstConv/HtmlStruct.fs
@@ -3,20 +3,17 @@
open AstAccess
open System.Xml
open System
+open System.Xml.Linq
+open System.IO
+
/// 展现节点 =========================================================================================
module Present =
- /// 可访问页面
- type PageAccess(hrefs: string) =
- class
- member this.accessLink(): string = hrefs
- end
/// 内容元素：分卷、章节、引用节点、故事线、情节、定义节点、引用节点
type IDomUnit =
interface
abstract member name:unit -> string
abstract member object:unit -> AstImport.AstObject
- abstract member getHtmlWith: pnode:XmlElement -> XmlElement
end
/// 容器节点：分卷、章节、故事线、情节
@@ -26,25 +23,46 @@ open System
abstract member children:unit -> IDomUnit list
end
+ /// 可访问页面
+ type PageAccess(hrefs: string) =
+ class
+ member this.pageURL(): string = hrefs
+ end
+
/// 内容定义元素 =================================================================================
type Forwards(item: AstImport.AstObject) =
class
- let mutable assemble_page_url: string = ""
+ let mutable defines_page: Option = None
+ let mutable assemble_page: Option = None
member this.elementID(): string = item.address()
- member this.setAssembleURL(url: string) =
- assemble_page_url <- url
- member this.assembleURL():string =
- assemble_page_url
- end
+ /// 节点定义页面，本元素完整URL
+ member this.definedURL(): string =
+ match defines_page with
+ | Some v -> $"{v.pageURL()}#{this.elementID()}"
+ | None -> failwith "节点元素定义页面配置错误"
+ member this.setDefines(page: PageAccess) =
+ defines_page <- Some(page)
+ /// 节点汇集页面，本元素完整URL
+ member this.assembleURL():string =
+ match assemble_page with
+ | Some v -> $"{v.pageURL()}#{this.elementID()}"
+ | None -> failwith "节点元素汇集页面配置错误"
+ member this.setAssemble(page: PageAccess) =
+ assemble_page <- Some(page)
+ end
+
/// 回访定义元素 =================================================================================
- type Backwards(bind_item: Forwards, bind_page: PageAccess) =
+ type Backwards(bind_item: Forwards, refer_anchor: string) =
class
+ member this.defsElement() =
+ bind_item
member this.elementID(): string =
bind_item.elementID()
member this.backwardsLink(): string =
- $"{bind_page.accessLink()}#{bind_item.elementID()}"
+ bind_item.definedURL()
+ member this.referAnchor(): string = refer_anchor
end
@@ -58,8 +76,6 @@ open System
member this.name():string = volume.name()
member this.object() =
volume.object()
- member this.getHtmlWith(p: XmlElement): XmlElement =
- failwith "getHtmlWith"
interface IContainer with
member this.children(): IDomUnit list = childs
@@ -76,8 +92,6 @@ open System
member this.name():string = story.name()
member this.object() =
story.object()
- member this.getHtmlWith(p: XmlElement): XmlElement =
- failwith "getHtmlWith"
interface IContainer with
member this.children(): IDomUnit list = childs
@@ -89,12 +103,13 @@ open System
class
inherit PageAccess(page_hrefs)
new(page_hrefs, point) = PointPage(page_hrefs, point, [])
+
+ member this.defines() =
+ point
interface IDomUnit with
member this.name():string = point.name()
member this.object() = point.object()
- member this.getHtmlWith(p: XmlElement): XmlElement =
- failwith "getHtmlWith"
interface IContainer with
member this.children(): IDomUnit list = refer_list
@@ -110,8 +125,6 @@ open System
interface Present.IDomUnit with
member this.name(): string = ""
member this.object() = word
- member this.getHtmlWith(pnode: XmlElement): XmlElement =
- failwith "getHtmlWith"
end
@@ -125,8 +138,6 @@ open System
interface Present.IDomUnit with
member this.name(): string = ref_signature
member this.object() = refs
- member this.getHtmlWith(pnode: XmlElement): XmlElement =
- failwith "getHtmlWith"
interface Present.IContainer with
member this.children(): Present.IDomUnit list = items
@@ -147,8 +158,6 @@ open System
interface Present.IDomUnit with
member this.name(): string = defs.name()
member this.object() = defs
- member this.getHtmlWith(pnode: XmlElement): XmlElement =
- failwith "getHtmlWith"
interface Present.IContainer with
member this.children(): Present.IDomUnit list = items
@@ -161,15 +170,16 @@ open System
/// 具有回退功能的元素
- type AssembleRefer<'T when 'T :> Present.Forwards and 'T :> Present.IDomUnit and 'T:> Present.IContainer>(from: string,item: 'T, page: Present.PageAccess) =
+ type AssembleRefer<'T when
+ 'T :> Present.Forwards and
+ 'T :> Present.IDomUnit and
+ 'T:> Present.IContainer>(item: 'T, refer_anchor: string) =
class
- inherit Present.Backwards(item, page)
+ inherit Present.Backwards(item, refer_anchor)
interface Present.IDomUnit with
- member this.name() = from
+ member this.name() = refer_anchor
member this.object() = item.object()
- member this.getHtmlWith(pnode: XmlElement): XmlElement =
- failwith "getHtmlWith"
interface Present.IContainer with
member this.children(): Present.IDomUnit list = item.children()
@@ -183,8 +193,6 @@ open System
interface Present.IDomUnit with
member this.name(): string = defs.name()
member this.object() = defs
- member this.getHtmlWith(pnode: XmlElement): XmlElement =
- failwith "getHtmlWith"
interface Present.IContainer with
member this.children(): Present.IDomUnit list = items
@@ -209,8 +217,6 @@ open System
member this.name(): string =
defs.name()
member this.object() = defs
- member this.getHtmlWith(pnode: XmlElement): XmlElement =
- failwith "getHtmlWith"
interface Present.IContainer with
member this.children(): Present.IDomUnit list = childs
@@ -234,8 +240,6 @@ open System
member this.name(): string =
defs.name()
member this.object() = defs
- member this.getHtmlWith(pnode: XmlElement): XmlElement =
- failwith "getHtmlWith"
interface Present.IContainer with
member this.children(): Present.IDomUnit list = childs
@@ -259,8 +263,6 @@ open System
member this.name(): string =
defs.name()
member this.object() = defs
- member this.getHtmlWith(pnode: XmlElement): XmlElement =
- failwith "getHtmlWith"
interface Present.IContainer with
member this.children(): Present.IDomUnit list = childs
@@ -293,19 +295,19 @@ open System
let datas = match obj with
| :? AstImport.TextItem as text ->
- (refs_depth, TextContent(text) :> Present.IDomUnit)::result_nodes
+ result_nodes@[(refs_depth, TextContent(text) :> Present.IDomUnit)]
| :? AstImport.PointRef as refs ->
- (refs_depth, PointRefer(refs, childs))::result_nodes
+ result_nodes@[(refs_depth, PointRefer(refs, childs))]
| :? AstImport.PointDef as defs ->
- (refs_depth, PointDefine(defs, childs))::result_nodes
+ result_nodes@[(refs_depth, PointDefine(defs, childs))]
| :? AstImport.SliceDef as defs ->
- (refs_depth, SliceDefine(defs, childs))::result_nodes
+ result_nodes@[(refs_depth, SliceDefine(defs, childs))]
| :? AstImport.StoryDef as defs ->
- (refs_depth, StoryDefine(defs, childs))::result_nodes
+ result_nodes@[(refs_depth, StoryDefine(defs, childs))]
| :? AstImport.ArticleDef as defs ->
- (refs_depth, ArticleDefine(defs, childs))::result_nodes
+ result_nodes@[(refs_depth, ArticleDefine(defs, childs))]
| :? AstImport.VolumeDef as defs ->
- (refs_depth, VolumeDefine(defs, childs))::result_nodes
+ result_nodes@[(refs_depth, VolumeDefine(defs, childs))]
| :? AstImport.Program -> result_nodes
| _ -> failwith "match error"
@@ -424,40 +426,327 @@ open System
/// 构建节点汇总页面
/// param nodes volume-pages@story-pages
- let rec point_page_assemble(nodes: Present.IDomUnit list) =
- let refers_about = point_peers_extract(nodes)
- let pages = refers_about |> List.map (
- fun (page_defs, slice_defs, point_defs) ->
- match point_defs.Value with
- | :? Content.PointDefine as defs ->
- let name_seqs = $"{page_defs.Value.name()}&{slice_defs.Value.name()}&{point_defs.Value.name()}"
- let refer_point = Content.AssembleRefer(name_seqs, defs, page_defs.Value :?> Present.StoryPage)
- let page_assemble = Present.PointPage(page_address_make(defs), refer_point)
- defs.setAssembleURL(page_assemble.accessLink())
- Some(page_assemble)
- | _ -> None
+ let rec point_page_assemble(pages: Present.IDomUnit list) =
+ let checked_list = pages |> List.filter(
+ fun it ->
+ match it with
+ | :? Present.PageAccess -> true
+ | _ -> false
)
- |> List.filter (fun d -> d <> None)
+ if checked_list.Length <> pages.Length then
+ failwith "传入的参数pages必须是PageAccess的子类集合"
- let refer_nodes = refers_about |> List.filter(
+
+ let points_about= point_peers_extract(pages)
+ // 所有的节点关联定义页面
+ points_about |> List.iter (
+ fun (page, midx, deref) ->
+ match deref.Value with
+ | :? Present.Forwards as forwards_elm ->
+ let page_def = page.Value :?> Present.PageAccess
+ forwards_elm.setDefines(page_def)
+ | _ -> failwith "point_peers_extract结果类型错误"
+ )
+ let refer_nodes = points_about |> List.filter(
fun (_, _, n) ->
match n.Value with
| :? Content.PointRefer -> true
| _ -> false
)
|> List.map(
- fun (page_defs, _, point_refs) ->
- let refer_object = point_refs.Value.object() :?> AstImport.PointRef
- let refer_name = $"{refer_object.storyRef()}&{refer_object.sliceRef()}&{refer_object.pointRef()}"
+ fun (page_defs, mid_defs, point_refs) ->
+ let refn = point_refs.Value.object() :?> AstImport.PointRef
+ let refer_name = $"{page_defs.Value.name()}&{mid_defs.Value.name()}@"
let refs = point_refs.Value :?> Content.PointRefer
- Content.AssembleRefer(refer_name, refs, page_defs.Value :?> Present.PageAccess)
+ $"{refn.storyRef()}&{refn.sliceRef()}&{refn.pointRef()}", Content.AssembleRefer(refs, refer_name)
)
+ // 构建节点汇集页面
+ let pages = points_about |> List.filter(
+ fun (_, _, n) ->
+ match n.Value with
+ | :? Content.PointDefine -> true
+ | _ -> false
+ )
+ |> List.map (
+ fun (page_defs, slice_defs, point_defs) ->
+ let defs = point_defs.Value :?> Content.PointDefine
+ let name_seqs = $"{page_defs.Value.name()}&{slice_defs.Value.name()}&{point_defs.Value.name()}"
+ let refer_point = Content.AssembleRefer(defs, name_seqs)
+ let page_assemble = Present.PointPage(page_address_make(defs), refer_point)
+ defs.setAssemble(page_assemble)
+ name_seqs,page_assemble
+ )
- pages |> List.map(
- fun page_one ->
- let page_old = page_one.Value :> Present.IContainer
- let page_dom = page_one.Value :> Present.IDomUnit
- let nodes = refer_nodes |> List.filter(fun d -> (d:>Present.IDomUnit).name() = page_dom.name())
- page_old.append(nodes |> List.map, Present.IDomUnit> (fun x->x))
- )
\ No newline at end of file
+ pages |> List.map(
+ fun (key, page_one) ->
+ let page_old = page_one :> Present.IContainer
+ let page_dom = page_one :> Present.IDomUnit
+ let nodes = refer_nodes |> List.filter(fun (k, _) -> k = key)
+ nodes |> List.iter (fun (_, data) -> data.defsElement().setAssemble(page_one))
+ let p = page_old.append(page_dom::(nodes |> List.map(fun (_, x)->x :> Present.IDomUnit)))
+ p :?> Present.IDomUnit
+ )
+
+ type PageText =
+ interface
+ abstract member getHtmlText:unit -> string
+ end
+
+ type PageMaker<'T when
+ 'T :> Present.PageAccess and
+ 'T :> Present.IDomUnit and
+ 'T :> Present.IContainer>(page: 'T) =
+ class
+ member this.getHtmlDocument(): XmlDocument =
+ 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(page.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(page.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, page.children())
+
+ doc
+
+ member this.initNavigate(nav: XmlElement):XmlElement =
+ let rec nav_items_expand(nav: XmlElement, items: (Present.IDomUnit option*Present.IDomUnit option*Present.IDomUnit option) list) =
+ match items with
+ | [] -> ()
+ | _ ->
+ let doc_o = nav.OwnerDocument
+ let (_, _, head) = items.Head
+ match head.Value with
+ | :? Present.Forwards as fx ->
+ let p = doc_o.CreateElement("p")
+ let a = doc_o.CreateElement("a")
+ a.SetAttribute("href", $"#{fx.elementID()}")
+ a.AppendChild(doc_o.CreateTextNode(head.Value.name())) |> ignore
+ p.AppendChild(a) |> ignore
+ nav.AppendChild(p) |> ignore
+ | :? Present.Backwards as bx ->
+ let p = doc_o.CreateElement("p")
+ let a = doc_o.CreateElement("a")
+ a.SetAttribute("href", $"#{bx.elementID()}")
+ a.AppendChild(doc_o.CreateTextNode(head.Value.name())) |> ignore
+ p.AppendChild(a) |> ignore
+ nav.AppendChild(p) |> ignore
+ | _ -> ()
+
+ nav_items_expand(nav, items.Tail)
+
+ let objp = page :> obj
+ let point_peers = if (objp :? Present.PointPage) then
+ (objp :?>Present.PointPage).defines()::page.children() |> List.map(fun x-> None, None, Some(x))
+ else
+ point_peers_extract(page.children())
+
+ match point_peers with
+ | [] ->
+ let empty = nav.OwnerDocument.CreateElement("p")
+ empty.AppendChild(nav.OwnerDocument.CreateTextNode("当前文档无索引")) |> ignore
+ nav.AppendChild(empty) |> ignore
+ | _ ->
+ nav_items_expand(nav, point_peers)
+
+ nav
+
+ member this.contentAppend(pnode: XmlElement, contents: Present.IDomUnit list) =
+ let vdoc = pnode.OwnerDocument
+ match contents with
+ | [] -> ()
+ | _ ->
+ match contents.Head with
+ | :? Content.TextContent ->
+ let text_ast = contents.Head.object() :?> AstImport.TextItem
+ let text_line = contents.Tail |> List.filter(
+ fun content_item->
+ match content_item with
+ | :? Content.TextContent ->
+ let curr_ast = content_item.object() :?> AstImport.TextItem
+ curr_ast.row() = text_ast.row()
+ | _ -> false
+ )
+ let one_line = contents.Head::text_line
+ let p = vdoc.CreateElement("p")
+ for t in one_line do
+ let text_content = t.object() :?> AstImport.TextItem
+ let content = text_content.content()
+ p.AppendChild(vdoc.CreateTextNode(content)) |> ignore
+ pnode.AppendChild(p) |> ignore
+ this.contentAppend(pnode, List.skip one_line.Length contents)
+
+ | :? Content.SliceDefine as slice_defs->
+ let div_slice = vdoc.CreateElement("div")
+ div_slice.SetAttribute("data-type", "slice")
+ div_slice.SetAttribute("class", "content")
+ let slice_title = vdoc.CreateElement("h3")
+ slice_title.AppendChild(vdoc.CreateTextNode(contents.Head.name())) |> ignore
+ div_slice.AppendChild(slice_title) |> ignore
+ pnode.AppendChild(div_slice) |> ignore
+ let slice_con = slice_defs :> Present.IContainer
+ this.contentAppend(div_slice, slice_con.children())
+ this.contentAppend(pnode, contents.Tail)
+
+ | :? Content.ArticleDefine as article_defs ->
+ let div_article = vdoc.CreateElement("div")
+ div_article.SetAttribute("data-type", "article")
+ div_article.SetAttribute("class", "content")
+ let article_title = vdoc.CreateElement("h3")
+ article_title.AppendChild(vdoc.CreateTextNode(contents.Head.name())) |> ignore
+ div_article.AppendChild(article_title) |> ignore
+ pnode.AppendChild(div_article) |> ignore
+ let article_con = article_defs :> Present.IContainer
+ this.contentAppend(div_article, article_con.children())
+ this.contentAppend(pnode, contents.Tail)
+
+ | :? Present.PointPage as page_point ->
+ let page_defs = page_point.defines() :?> Content.AssembleRefer
+ this.contentAppend(pnode, [page_defs])
+ this.contentAppend(pnode, contents.Tail)
+
+
+ | :? Present.Forwards as object_defs ->
+ let type_name = match object_defs with
+ | :? Content.PointDefine -> "point"
+ | :? Content.PointRefer -> "refer"
+ | _ -> failwith "type mismatch"
+
+ let div_forwards = vdoc.CreateElement("div")
+ div_forwards.SetAttribute("data-type", type_name)
+ div_forwards.SetAttribute("class", "content")
+
+ let define_title = vdoc.CreateElement("h3")
+ define_title.AppendChild(vdoc.CreateTextNode(contents.Head.name())) |> ignore
+ div_forwards.AppendChild(define_title) |> ignore
+ let define_a = vdoc.CreateElement("a")
+ define_a.SetAttribute("id", object_defs.elementID())
+ define_a.SetAttribute("href", object_defs.assembleURL())
+ define_a.AppendChild(define_title) |> ignore
+ div_forwards.AppendChild(define_a) |> ignore
+
+ pnode.AppendChild(div_forwards) |> ignore
+ let point_con = contents.Head :?> Present.IContainer
+ this.contentAppend(div_forwards, point_con.children())
+ this.contentAppend(pnode, contents.Tail)
+
+ | :? Present.Backwards as object_backs ->
+ let div_backwards = vdoc.CreateElement("div")
+ div_backwards.SetAttribute("data-type", "assemble")
+ div_backwards.SetAttribute("class", "content")
+
+ let define_title = vdoc.CreateElement("h3")
+ define_title.AppendChild(vdoc.CreateTextNode(contents.Head.name())) |> ignore
+ div_backwards.AppendChild(define_title) |> ignore
+ let define_a = vdoc.CreateElement("a")
+ define_a.SetAttribute("id", object_backs.elementID())
+ define_a.SetAttribute("href", object_backs.backwardsLink())
+ define_a.AppendChild(define_title) |> ignore
+ div_backwards.AppendChild(define_a) |> ignore
+
+ pnode.AppendChild(div_backwards) |> ignore
+ let point_con = contents.Head :?> Present.IContainer
+ this.contentAppend(div_backwards, point_con.children())
+ this.contentAppend(pnode, contents.Tail)
+
+ | _ -> ()
+
+ interface PageText with
+ member this.getHtmlText(): string =
+ let doc = this.getHtmlDocument()
+
+ let out = new StringWriter()
+ let writer = new XmlTextWriter(out)
+ writer.Formatting = Formatting.Indented |> ignore
+ doc.WriteTo(writer)
+ writer.Flush()
+ out.ToString()
+ end
\ No newline at end of file
diff --git a/AstConv/Program.fs b/AstConv/Program.fs
index e6ac7f9..79abfe7 100644
--- a/AstConv/Program.fs
+++ b/AstConv/Program.fs
@@ -19,5 +19,20 @@ let volume_pages = volume_page_assemble(visitor.contents()) |> List.map List.map (fun x->x)
let point_pages = point_page_assemble(volume_pages @ story_pages)
+let maker = volume_pages @ story_pages @ point_pages
+ |> List.map(fun page_unit ->
+ match page_unit with
+ | :? PointPage as point ->
+ PageMaker(point) :> PageText
+ | :? VolumePage as vol ->
+ PageMaker(vol)
+ | :? StoryPage as story ->
+ PageMaker(story)
+ | _ -> failwith ""
+ )
+let docx0 = maker.Item(5).getHtmlText()
+let docx1 = maker.Item(18).getHtmlText()
+let docx2 = maker.Item(22).getHtmlText()
+
for refs in point_pages do
System.Console.WriteLine(refs.ToString())
\ No newline at end of file