本业跳转

This commit is contained in:
codeboss 2025-02-22 01:22:52 +08:00
parent c423acfb43
commit a9f8ec9a6b
2 changed files with 375 additions and 71 deletions

View File

@ -3,20 +3,17 @@
open AstAccess open AstAccess
open System.Xml open System.Xml
open System open System
open System.Xml.Linq
open System.IO
/// 展现节点 ========================================================================================= /// 展现节点 =========================================================================================
module Present = module Present =
/// 访
type PageAccess(hrefs: string) =
class
member this.accessLink(): string = hrefs
end
/// 线 /// 线
type IDomUnit = type IDomUnit =
interface interface
abstract member name:unit -> string abstract member name:unit -> string
abstract member object:unit -> AstImport.AstObject abstract member object:unit -> AstImport.AstObject
abstract member getHtmlWith: pnode:XmlElement -> XmlElement
end end
/// 线 /// 线
@ -26,25 +23,46 @@ open System
abstract member children:unit -> IDomUnit list abstract member children:unit -> IDomUnit list
end end
/// 访
type PageAccess(hrefs: string) =
class
member this.pageURL(): string = hrefs
end
/// 内容定义元素 ================================================================================= /// 内容定义元素 =================================================================================
type Forwards(item: AstImport.AstObject) = type Forwards(item: AstImport.AstObject) =
class class
let mutable assemble_page_url: string = "" let mutable defines_page: Option<PageAccess> = None
let mutable assemble_page: Option<PageAccess> = None
member this.elementID(): string = item.address() member this.elementID(): string = item.address()
member this.setAssembleURL(url: string) = /// URL
assemble_page_url <- 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 = member this.assembleURL():string =
assemble_page_url match assemble_page with
| Some v -> $"{v.pageURL()}#{this.elementID()}"
| None -> failwith ""
member this.setAssemble(page: PageAccess) =
assemble_page <- Some(page)
end end
/// 回访定义元素 ================================================================================= /// 回访定义元素 =================================================================================
type Backwards(bind_item: Forwards, bind_page: PageAccess) = type Backwards(bind_item: Forwards, refer_anchor: string) =
class class
member this.defsElement() =
bind_item
member this.elementID(): string = member this.elementID(): string =
bind_item.elementID() bind_item.elementID()
member this.backwardsLink(): string = member this.backwardsLink(): string =
$"{bind_page.accessLink()}#{bind_item.elementID()}" bind_item.definedURL()
member this.referAnchor(): string = refer_anchor
end end
@ -58,8 +76,6 @@ open System
member this.name():string = volume.name() member this.name():string = volume.name()
member this.object() = member this.object() =
volume.object() volume.object()
member this.getHtmlWith(p: XmlElement): XmlElement =
failwith "getHtmlWith"
interface IContainer with interface IContainer with
member this.children(): IDomUnit list = childs member this.children(): IDomUnit list = childs
@ -76,8 +92,6 @@ open System
member this.name():string = story.name() member this.name():string = story.name()
member this.object() = member this.object() =
story.object() story.object()
member this.getHtmlWith(p: XmlElement): XmlElement =
failwith "getHtmlWith"
interface IContainer with interface IContainer with
member this.children(): IDomUnit list = childs member this.children(): IDomUnit list = childs
@ -90,11 +104,12 @@ open System
inherit PageAccess(page_hrefs) inherit PageAccess(page_hrefs)
new(page_hrefs, point) = PointPage(page_hrefs, point, []) new(page_hrefs, point) = PointPage(page_hrefs, point, [])
member this.defines() =
point
interface IDomUnit with interface IDomUnit with
member this.name():string = point.name() member this.name():string = point.name()
member this.object() = point.object() member this.object() = point.object()
member this.getHtmlWith(p: XmlElement): XmlElement =
failwith "getHtmlWith"
interface IContainer with interface IContainer with
member this.children(): IDomUnit list = refer_list member this.children(): IDomUnit list = refer_list
@ -110,8 +125,6 @@ open System
interface Present.IDomUnit with interface Present.IDomUnit with
member this.name(): string = "" member this.name(): string = ""
member this.object() = word member this.object() = word
member this.getHtmlWith(pnode: XmlElement): XmlElement =
failwith "getHtmlWith"
end end
@ -125,8 +138,6 @@ open System
interface Present.IDomUnit with interface Present.IDomUnit with
member this.name(): string = ref_signature member this.name(): string = ref_signature
member this.object() = refs member this.object() = refs
member this.getHtmlWith(pnode: XmlElement): XmlElement =
failwith "getHtmlWith"
interface Present.IContainer with interface Present.IContainer with
member this.children(): Present.IDomUnit list = items member this.children(): Present.IDomUnit list = items
@ -147,8 +158,6 @@ open System
interface Present.IDomUnit with interface Present.IDomUnit with
member this.name(): string = defs.name() member this.name(): string = defs.name()
member this.object() = defs member this.object() = defs
member this.getHtmlWith(pnode: XmlElement): XmlElement =
failwith "getHtmlWith"
interface Present.IContainer with interface Present.IContainer with
member this.children(): Present.IDomUnit list = items 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 class
inherit Present.Backwards(item, page) inherit Present.Backwards(item, refer_anchor)
interface Present.IDomUnit with interface Present.IDomUnit with
member this.name() = from member this.name() = refer_anchor
member this.object() = item.object() member this.object() = item.object()
member this.getHtmlWith(pnode: XmlElement): XmlElement =
failwith "getHtmlWith"
interface Present.IContainer with interface Present.IContainer with
member this.children(): Present.IDomUnit list = item.children() member this.children(): Present.IDomUnit list = item.children()
@ -183,8 +193,6 @@ open System
interface Present.IDomUnit with interface Present.IDomUnit with
member this.name(): string = defs.name() member this.name(): string = defs.name()
member this.object() = defs member this.object() = defs
member this.getHtmlWith(pnode: XmlElement): XmlElement =
failwith "getHtmlWith"
interface Present.IContainer with interface Present.IContainer with
member this.children(): Present.IDomUnit list = items member this.children(): Present.IDomUnit list = items
@ -209,8 +217,6 @@ open System
member this.name(): string = member this.name(): string =
defs.name() defs.name()
member this.object() = defs member this.object() = defs
member this.getHtmlWith(pnode: XmlElement): XmlElement =
failwith "getHtmlWith"
interface Present.IContainer with interface Present.IContainer with
member this.children(): Present.IDomUnit list = childs member this.children(): Present.IDomUnit list = childs
@ -234,8 +240,6 @@ open System
member this.name(): string = member this.name(): string =
defs.name() defs.name()
member this.object() = defs member this.object() = defs
member this.getHtmlWith(pnode: XmlElement): XmlElement =
failwith "getHtmlWith"
interface Present.IContainer with interface Present.IContainer with
member this.children(): Present.IDomUnit list = childs member this.children(): Present.IDomUnit list = childs
@ -259,8 +263,6 @@ open System
member this.name(): string = member this.name(): string =
defs.name() defs.name()
member this.object() = defs member this.object() = defs
member this.getHtmlWith(pnode: XmlElement): XmlElement =
failwith "getHtmlWith"
interface Present.IContainer with interface Present.IContainer with
member this.children(): Present.IDomUnit list = childs member this.children(): Present.IDomUnit list = childs
@ -293,19 +295,19 @@ open System
let datas = match obj with let datas = match obj with
| :? AstImport.TextItem as text -> | :? AstImport.TextItem as text ->
(refs_depth, TextContent(text) :> Present.IDomUnit)::result_nodes result_nodes@[(refs_depth, TextContent(text) :> Present.IDomUnit)]
| :? AstImport.PointRef as refs -> | :? AstImport.PointRef as refs ->
(refs_depth, PointRefer(refs, childs))::result_nodes result_nodes@[(refs_depth, PointRefer(refs, childs))]
| :? AstImport.PointDef as defs -> | :? AstImport.PointDef as defs ->
(refs_depth, PointDefine(defs, childs))::result_nodes result_nodes@[(refs_depth, PointDefine(defs, childs))]
| :? AstImport.SliceDef as defs -> | :? AstImport.SliceDef as defs ->
(refs_depth, SliceDefine(defs, childs))::result_nodes result_nodes@[(refs_depth, SliceDefine(defs, childs))]
| :? AstImport.StoryDef as defs -> | :? AstImport.StoryDef as defs ->
(refs_depth, StoryDefine(defs, childs))::result_nodes result_nodes@[(refs_depth, StoryDefine(defs, childs))]
| :? AstImport.ArticleDef as defs -> | :? AstImport.ArticleDef as defs ->
(refs_depth, ArticleDefine(defs, childs))::result_nodes result_nodes@[(refs_depth, ArticleDefine(defs, childs))]
| :? AstImport.VolumeDef as defs -> | :? AstImport.VolumeDef as defs ->
(refs_depth, VolumeDefine(defs, childs))::result_nodes result_nodes@[(refs_depth, VolumeDefine(defs, childs))]
| :? AstImport.Program -> result_nodes | :? AstImport.Program -> result_nodes
| _ -> failwith "match error" | _ -> failwith "match error"
@ -424,40 +426,327 @@ open System
/// ///
/// param nodes volume-pages@story-pages /// param nodes volume-pages@story-pages
let rec point_page_assemble(nodes: Present.IDomUnit list) = let rec point_page_assemble(pages: Present.IDomUnit list) =
let refers_about = point_peers_extract(nodes) let checked_list = pages |> List.filter(
let pages = refers_about |> List.map ( fun it ->
fun (page_defs, slice_defs, point_defs) -> match it with
match point_defs.Value with | :? Present.PageAccess -> true
| :? Content.PointDefine as defs -> | _ -> false
let name_seqs = $"{page_defs.Value.name()}&{slice_defs.Value.name()}&{point_defs.Value.name()}"
let refer_point = Content.AssembleRefer<Content.PointDefine>(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
) )
|> List.filter (fun d -> d <> None) if checked_list.Length <> pages.Length then
failwith "pagesPageAccess"
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) -> fun (_, _, n) ->
match n.Value with match n.Value with
| :? Content.PointRefer -> true | :? Content.PointRefer -> true
| _ -> false | _ -> false
) )
|> List.map( |> List.map(
fun (page_defs, _, point_refs) -> fun (page_defs, mid_defs, point_refs) ->
let refer_object = point_refs.Value.object() :?> AstImport.PointRef let refn = point_refs.Value.object() :?> AstImport.PointRef
let refer_name = $"{refer_object.storyRef()}&{refer_object.sliceRef()}&{refer_object.pointRef()}" let refer_name = $"{page_defs.Value.name()}&{mid_defs.Value.name()}@<this>"
let refs = point_refs.Value :?> Content.PointRefer let refs = point_refs.Value :?> Content.PointRefer
Content.AssembleRefer<Content.PointRefer>(refer_name, refs, page_defs.Value :?> Present.PageAccess) $"{refn.storyRef()}&{refn.sliceRef()}&{refn.pointRef()}", Content.AssembleRefer<Content.PointRefer>(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<Content.PointDefine>(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( pages |> List.map(
fun page_one -> fun (key, page_one) ->
let page_old = page_one.Value :> Present.IContainer let page_old = page_one :> Present.IContainer
let page_dom = page_one.Value :> Present.IDomUnit let page_dom = page_one :> Present.IDomUnit
let nodes = refer_nodes |> List.filter(fun d -> (d:>Present.IDomUnit).name() = page_dom.name()) let nodes = refer_nodes |> List.filter(fun (k, _) -> k = key)
page_old.append(nodes |> List.map<Content.AssembleRefer<Content.PointRefer>, Present.IDomUnit> (fun x->x)) 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<Content.PointDefine>
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

View File

@ -19,5 +19,20 @@ 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)
let maker = volume_pages @ story_pages @ point_pages
|> List.map(fun page_unit ->
match page_unit with
| :? PointPage as point ->
PageMaker<PointPage>(point) :> PageText
| :? VolumePage as vol ->
PageMaker<VolumePage>(vol)
| :? StoryPage as story ->
PageMaker<StoryPage>(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 for refs in point_pages do
System.Console.WriteLine(refs.ToString()) System.Console.WriteLine(refs.ToString())