415 lines
20 KiB
Forth
415 lines
20 KiB
Forth
namespace HtmlStruct
|
|
|
|
open AstAccess
|
|
open System.Xml
|
|
open System
|
|
/// 展现节点 =========================================================================================
|
|
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
|
|
|
|
/// 容器节点：分卷、章节、故事线、情节
|
|
type IContainer =
|
|
interface
|
|
abstract member append:IDomUnit list -> IContainer
|
|
abstract member children:unit -> IDomUnit list
|
|
end
|
|
|
|
/// 内容定义元素 =================================================================================
|
|
type Forwards(item: AstImport.AstObject) =
|
|
class
|
|
let mutable assemble_page_url: string = ""
|
|
|
|
member this.elementID(): string =
|
|
item.address()
|
|
member this.setAssembleURL(url: string) =
|
|
assemble_page_url <- url
|
|
member this.assembleURL():string =
|
|
assemble_page_url
|
|
end
|
|
|
|
/// 回访定义元素 =================================================================================
|
|
type Backwards(bind_item: Forwards, bind_page: PageAccess) =
|
|
class
|
|
member this.elementID(): string =
|
|
bind_item.elementID()
|
|
member this.backwardsLink(): string =
|
|
$"{bind_page.accessLink()}#{bind_item.elementID()}"
|
|
end
|
|
|
|
|
|
/// 访问页面：概括页面、卷宗页面、故事线页面、节点汇总 =================================================
|
|
type VolumePage(page_hrefs: string, volume: IDomUnit, childs: IDomUnit list) =
|
|
class
|
|
inherit PageAccess(page_hrefs)
|
|
new(page_hrefs, volume) = VolumePage(page_hrefs, volume, [])
|
|
|
|
interface IDomUnit with
|
|
member this.name():string =
|
|
volume.name()
|
|
member this.object() =
|
|
volume.object()
|
|
member this.getHtmlWith(p: XmlElement): XmlElement =
|
|
raise (System.NotImplementedException())
|
|
|
|
interface IContainer with
|
|
member this.children(): IDomUnit list = childs
|
|
member this.append(childs: IDomUnit list): IContainer =
|
|
raise (System.NotImplementedException())
|
|
end
|
|
|
|
type StoryPage(page_hrefs: string, story: IDomUnit, childs: IDomUnit list) =
|
|
class
|
|
inherit PageAccess(page_hrefs)
|
|
new(page_hrefs, story) = StoryPage(page_hrefs, story, [])
|
|
|
|
interface IDomUnit with
|
|
member this.name():string =
|
|
story.name()
|
|
member this.object() =
|
|
story.object()
|
|
member this.getHtmlWith(p: XmlElement): XmlElement =
|
|
raise (System.NotImplementedException())
|
|
|
|
interface IContainer with
|
|
member this.children(): IDomUnit list = childs
|
|
member this.append(childs: IDomUnit list): IContainer =
|
|
raise (System.NotImplementedException())
|
|
end
|
|
|
|
type PointPage(page_hrefs: string, point: IDomUnit, refer_list: IDomUnit list) =
|
|
class
|
|
inherit PageAccess(page_hrefs)
|
|
new(page_hrefs, point) = PointPage(page_hrefs, point, [])
|
|
|
|
interface IDomUnit with
|
|
member this.name():string =
|
|
point.name()
|
|
member this.object() =
|
|
point.object()
|
|
member this.getHtmlWith(p: XmlElement): XmlElement =
|
|
raise (System.NotImplementedException())
|
|
|
|
interface IContainer with
|
|
member this.children(): IDomUnit list = refer_list
|
|
member this.append(childs: IDomUnit list): IContainer =
|
|
raise (System.NotImplementedException())
|
|
end
|
|
|
|
|
|
/// 内容节点 =========================================================================================
|
|
module Content =
|
|
type TextContent(word: AstImport.TextItem) =
|
|
class
|
|
interface Present.IDomUnit with
|
|
member this.name(): string = ""
|
|
member this.object() = word
|
|
member this.getHtmlWith(pnode: XmlElement): XmlElement =
|
|
raise (System.NotImplementedException())
|
|
end
|
|
|
|
|
|
type PointRefer(refs: AstImport.PointRef, items: Present.IDomUnit list) =
|
|
class
|
|
inherit Present.Forwards(refs)
|
|
|
|
let ref_signature = $"@{refs.storyRef()}&{refs.sliceRef()}&{refs.pointRef()}"
|
|
let lines = refs.children() |> List.map (fun x->x.content())
|
|
|
|
interface Present.IDomUnit with
|
|
member this.name(): string =
|
|
ref_signature
|
|
member this.object() = refs
|
|
member this.getHtmlWith(pnode: XmlElement): XmlElement =
|
|
raise (System.NotImplementedException())
|
|
|
|
interface Present.IContainer with
|
|
member this.children(): Present.IDomUnit list = items
|
|
member this.append(childs: Present.IDomUnit list): Present.IContainer =
|
|
raise (System.NotImplementedException())
|
|
end
|
|
let refer_assemble (refn: AstImport.PointRef) : PointRefer =
|
|
let texts = refn.children() |> List.map (fun dom -> TextContent(dom) :> Present.IDomUnit)
|
|
PointRefer(refn, texts)
|
|
|
|
|
|
type PointDefine(defs: AstImport.PointDef, items: Present.IDomUnit list) =
|
|
class
|
|
inherit Present.Forwards(defs)
|
|
|
|
let lines = defs.children() |> List.map (fun x->x.content())
|
|
|
|
interface Present.IDomUnit with
|
|
member this.name(): string =
|
|
defs.name()
|
|
member this.object() = defs
|
|
member this.getHtmlWith(pnode: XmlElement): XmlElement =
|
|
raise (System.NotImplementedException())
|
|
|
|
interface Present.IContainer with
|
|
member this.children(): Present.IDomUnit list = items
|
|
member this.append(childs: Present.IDomUnit list): Present.IContainer =
|
|
raise (System.NotImplementedException())
|
|
end
|
|
let point_assemble (defs: AstImport.PointDef) : PointDefine =
|
|
let texts = defs.children() |> List.map (fun dom -> TextContent(dom) :> Present.IDomUnit)
|
|
PointDefine(defs, texts)
|
|
|
|
|
|
/// 具有回退功能的元素
|
|
type AssemblePoint<'T when 'T :> Present.Forwards and 'T :> Present.IDomUnit and 'T:> Present.IContainer>(item: 'T, page: Present.PageAccess) =
|
|
class
|
|
inherit Present.Backwards(item, page)
|
|
|
|
interface Present.IDomUnit with
|
|
member this.name(): string =
|
|
item.name()
|
|
member this.object() = item.object()
|
|
member this.getHtmlWith(pnode: XmlElement): XmlElement =
|
|
raise (System.NotImplementedException())
|
|
|
|
interface Present.IContainer with
|
|
member this.children(): Present.IDomUnit list =
|
|
item.children()
|
|
member this.append(childs: Present.IDomUnit list): Present.IContainer =
|
|
raise (System.NotImplementedException())
|
|
end
|
|
|
|
|
|
type SliceDefine(defs: AstImport.SliceDef, items: Present.IDomUnit list) =
|
|
class
|
|
interface Present.IDomUnit with
|
|
member this.name(): string =
|
|
defs.name()
|
|
member this.object() = defs
|
|
member this.getHtmlWith(pnode: XmlElement): XmlElement =
|
|
raise (System.NotImplementedException())
|
|
|
|
interface Present.IContainer with
|
|
member this.children(): Present.IDomUnit list = items
|
|
member this.append(childs: Present.IDomUnit list): Present.IContainer =
|
|
raise (System.NotImplementedException())
|
|
end
|
|
let slice_assemble (defs: AstImport.SliceDef) : SliceDefine =
|
|
let childs = defs.children()
|
|
|> List.map<AstImport.AstObject,Present.IDomUnit>(fun data ->
|
|
match data with
|
|
| :? AstImport.PointRef as refs -> refer_assemble(refs)
|
|
| :? AstImport.PointDef as defs -> point_assemble(defs)
|
|
| :? AstImport.TextItem as text -> TextContent(text)
|
|
| _ -> raise (System.NotImplementedException())
|
|
)
|
|
SliceDefine(defs, childs)
|
|
|
|
|
|
type StoryDefine(defs: AstImport.StoryDef, childs: Present.IDomUnit list) =
|
|
class
|
|
interface Present.IDomUnit with
|
|
member this.name(): string =
|
|
defs.name()
|
|
member this.object() = defs
|
|
member this.getHtmlWith(pnode: XmlElement): XmlElement =
|
|
raise (System.NotImplementedException())
|
|
|
|
interface Present.IContainer with
|
|
member this.children(): Present.IDomUnit list = childs
|
|
member this.append(childs: Present.IDomUnit list): Present.IContainer =
|
|
raise (System.NotImplementedException())
|
|
end
|
|
let story_assemble (defs: AstImport.StoryDef): StoryDefine =
|
|
let childs = defs.children()
|
|
|> List.map<AstImport.AstObject, Present.IDomUnit>(fun data ->
|
|
match data with
|
|
| :? AstImport.SliceDef as defs -> slice_assemble(defs)
|
|
| :? AstImport.TextItem as text -> TextContent(text)
|
|
| _ -> raise (System.NotImplementedException())
|
|
)
|
|
StoryDefine(defs, childs)
|
|
|
|
|
|
type ArticleDefine(defs: AstImport.ArticleDef, childs: Present.IDomUnit list) =
|
|
class
|
|
interface Present.IDomUnit with
|
|
member this.name(): string =
|
|
defs.name()
|
|
member this.object() = defs
|
|
member this.getHtmlWith(pnode: XmlElement): XmlElement =
|
|
raise (System.NotImplementedException())
|
|
|
|
interface Present.IContainer with
|
|
member this.children(): Present.IDomUnit list = childs
|
|
member this.append(childs: Present.IDomUnit list): Present.IContainer =
|
|
raise (System.NotImplementedException())
|
|
end
|
|
let article_assemble (defs: AstImport.ArticleDef) : ArticleDefine =
|
|
let childs = defs.children()
|
|
|> List.map<AstImport.AstObject, Present.IDomUnit>(fun data ->
|
|
match data with
|
|
| :? AstImport.TextItem as text -> TextContent(text)
|
|
| :? AstImport.PointRef as refs -> refer_assemble(refs)
|
|
| _ -> raise (System.NotImplementedException())
|
|
)
|
|
ArticleDefine(defs, childs)
|
|
|
|
|
|
type VolumeDefine(defs: AstImport.VolumeDef, childs: Present.IDomUnit list) =
|
|
class
|
|
interface Present.IDomUnit with
|
|
member this.name(): string =
|
|
defs.name()
|
|
member this.object() = defs
|
|
member this.getHtmlWith(pnode: XmlElement): XmlElement =
|
|
raise (System.NotImplementedException())
|
|
|
|
interface Present.IContainer with
|
|
member this.children(): Present.IDomUnit list = childs
|
|
member this.append(news: Present.IDomUnit list): Present.IContainer =
|
|
VolumeDefine(defs, childs@news)
|
|
end
|
|
let volume_assemble (defs: AstImport.VolumeDef): VolumeDefine =
|
|
let childs = defs.children()
|
|
|> List.map<AstImport.AstObject, Present.IDomUnit>(fun data ->
|
|
match data with
|
|
| :? AstImport.TextItem as text -> TextContent(text)
|
|
| :? AstImport.ArticleDef as defs -> article_assemble(defs)
|
|
| _ -> raise (System.NotImplementedException())
|
|
)
|
|
VolumeDefine(defs, childs)
|
|
|
|
|
|
type UnitGenerate(root: AstImport.AstObject) =
|
|
class
|
|
// ast 节点序列
|
|
let forwards_map = AstImport.branch_map_conv(root, root.members())
|
|
// 累积结果
|
|
let mutable result_nodes: (int*Present.IDomUnit) list = []
|
|
|
|
interface AstImport.AstVisitor with
|
|
member this.visit(obj: AstImport.AstObject): bool =
|
|
let refs_depth = AstImport.depth_seek(forwards_map, obj)
|
|
let childs = result_nodes |> List.filter (fun (depth, _) -> depth > refs_depth)
|
|
|> List.map(fun (_, object) -> object)
|
|
|
|
let datas = match obj with
|
|
| :? AstImport.TextItem as text ->
|
|
(refs_depth, TextContent(text) :> Present.IDomUnit)::result_nodes
|
|
| :? AstImport.PointRef as refs ->
|
|
(refs_depth, PointRefer(refs, childs))::result_nodes
|
|
| :? AstImport.PointDef as defs ->
|
|
(refs_depth, PointDefine(defs, childs))::result_nodes
|
|
| :? AstImport.SliceDef as defs ->
|
|
(refs_depth, SliceDefine(defs, childs))::result_nodes
|
|
| :? AstImport.StoryDef as defs ->
|
|
(refs_depth, StoryDefine(defs, childs))::result_nodes
|
|
| :? AstImport.ArticleDef as defs ->
|
|
(refs_depth, ArticleDefine(defs, childs))::result_nodes
|
|
| :? AstImport.VolumeDef as defs ->
|
|
(refs_depth, VolumeDefine(defs, childs))::result_nodes
|
|
| :? AstImport.Program -> result_nodes
|
|
| _ -> raise (System.NotImplementedException())
|
|
|
|
result_nodes <- datas
|
|
if refs_depth > 0 then
|
|
result_nodes <- result_nodes |> List.filter(fun (depth, _) -> depth <= refs_depth)
|
|
true
|
|
|
|
member this.contents() =
|
|
result_nodes |> List.map(fun (_, obj) -> obj)
|
|
end
|
|
|
|
|
|
/// 内容组装 =========================================================================================
|
|
module Assemble =
|
|
/// 构建页面名称
|
|
let page_address_make(node: Present.IDomUnit): string =
|
|
let name_seqs = node.name().ToCharArray() |> Array.map(fun c-> string(uint16(c)))
|
|
name_seqs |> Array.reduce(fun a b-> a+b)
|
|
|
|
/// 构建所有卷宗页面
|
|
let rec volume_page_build (nodes: Present.IDomUnit list): Present.VolumePage list =
|
|
match nodes with
|
|
| [] -> []
|
|
| _ ->
|
|
match nodes.Head with
|
|
| :? Content.VolumeDefine as vole ->
|
|
let con: Present.IContainer = vole
|
|
Present.VolumePage(page_address_make(vole), vole, con.children())::volume_page_build(nodes.Tail)
|
|
| _ -> volume_page_build(nodes.Tail)
|
|
|
|
/// 构建所有故事线页面
|
|
let rec story_page_build (nodes: Present.IDomUnit list): Present.StoryPage list =
|
|
match nodes with
|
|
| [] -> []
|
|
| _ ->
|
|
match nodes.Head with
|
|
| :? Content.StoryDefine as storye ->
|
|
let con: Present.IContainer = storye
|
|
Present.StoryPage(page_address_make(storye), storye, con.children())::story_page_build(nodes.Tail)
|
|
| _ -> story_page_build(nodes.Tail)
|
|
|
|
/// 提取point-define和point-refer
|
|
let rec point_peers_extract(nodes: Present.IDomUnit list):(Present.IDomUnit option*Present.IDomUnit option)list =
|
|
match nodes with
|
|
| [] -> []
|
|
| _ ->
|
|
let head_data = nodes.Head
|
|
match head_data with
|
|
| :? Content.StoryDefine as story_e ->
|
|
let con = story_e :> Present.IContainer
|
|
let items = point_peers_extract(con.children())@point_peers_extract(nodes.Tail)
|
|
items |> List.map(
|
|
fun (x,y)->
|
|
match x with
|
|
| None -> (Some(story_e :> Present.IDomUnit), y)
|
|
| _ -> (x, y)
|
|
)
|
|
| :? Present.StoryPage as story_e ->
|
|
let con = story_e :> Present.IContainer
|
|
let items = point_peers_extract(con.children())@point_peers_extract(nodes.Tail)
|
|
items |> List.map(
|
|
fun (x,y)->
|
|
match x with
|
|
| None -> (Some(story_e :> Present.IDomUnit), y)
|
|
| _ -> (x, y)
|
|
)
|
|
| :? Content.VolumeDefine as volume_e ->
|
|
let con = volume_e :> Present.IContainer
|
|
let items = point_peers_extract(con.children())@point_peers_extract(nodes.Tail)
|
|
items |> List.map (
|
|
fun (x,y) ->
|
|
match x with
|
|
| None -> (Some(volume_e), y)
|
|
| _ -> (x, y)
|
|
)
|
|
| :? Present.VolumePage as volume_e ->
|
|
let con = volume_e :> Present.IContainer
|
|
let items = point_peers_extract(con.children())@point_peers_extract(nodes.Tail)
|
|
items |> List.map (
|
|
fun (x,y) ->
|
|
match x with
|
|
| None -> (Some(volume_e), y)
|
|
| _ -> (x, y)
|
|
)
|
|
| :? Content.SliceDefine as slice_e ->
|
|
let con = slice_e :> Present.IContainer
|
|
point_peers_extract(con.children())@point_peers_extract(nodes.Tail)
|
|
| :? Content.ArticleDefine as article_e ->
|
|
let con = article_e :> Present.IContainer
|
|
point_peers_extract(con.children())@point_peers_extract(nodes.Tail)
|
|
| :? Content.PointRefer as refer_e ->
|
|
(None, Some(refer_e :> Present.IDomUnit))::point_peers_extract(nodes.Tail)
|
|
| :? Content.PointDefine as define_e ->
|
|
(None, Some(define_e))::point_peers_extract(nodes.Tail)
|
|
| _ -> point_peers_extract(nodes.Tail)
|