This commit is contained in:
codeboss 2025-02-19 21:19:18 +08:00
parent 779c822741
commit d977a765e2
2 changed files with 145 additions and 25 deletions

View File

@ -3,25 +3,20 @@
open AstAccess
open System.Xml
open System
/// 展现节点 =========================================================================================
module Present =
/// 访
type Access(hrefs: string) =
type PageAccess(hrefs: string) =
class
member this.accessLink(): string = hrefs
end
/// 退访
type Backward(hrefs: string) =
class
member this.backwardLink(): string = hrefs
end
/// 线
type IDomUnit =
interface
abstract member name:unit -> string
abstract member getHtml:XmlElement -> XmlElement
abstract member object:unit -> AstImport.AstObject
abstract member getHtmlWith: pnode:XmlElement -> XmlElement
end
/// 线
@ -31,16 +26,41 @@ open System
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 Access(page_hrefs)
inherit PageAccess(page_hrefs)
new(page_hrefs, volume) = VolumePage(page_hrefs, volume, [])
interface IDomUnit with
member this.name():string =
volume.name()
member this.getHtml(p: XmlElement): XmlElement =
member this.object() =
volume.object()
member this.getHtmlWith(p: XmlElement): XmlElement =
raise (System.NotImplementedException())
interface IContainer with
@ -51,13 +71,15 @@ open System
type StoryPage(page_hrefs: string, story: IDomUnit, childs: IDomUnit list) =
class
inherit Access(page_hrefs)
inherit PageAccess(page_hrefs)
new(page_hrefs, story) = StoryPage(page_hrefs, story, [])
interface IDomUnit with
member this.name():string =
story.name()
member this.getHtml(p: XmlElement): XmlElement =
member this.object() =
story.object()
member this.getHtmlWith(p: XmlElement): XmlElement =
raise (System.NotImplementedException())
interface IContainer with
@ -68,13 +90,15 @@ open System
type PointPage(page_hrefs: string, point: IDomUnit, refer_list: IDomUnit list) =
class
inherit Access(page_hrefs)
inherit PageAccess(page_hrefs)
new(page_hrefs, point) = PointPage(page_hrefs, point, [])
interface IDomUnit with
member this.name():string =
point.name()
member this.getHtml(p: XmlElement): XmlElement =
member this.object() =
point.object()
member this.getHtmlWith(p: XmlElement): XmlElement =
raise (System.NotImplementedException())
interface IContainer with
@ -90,20 +114,24 @@ open System
class
interface Present.IDomUnit with
member this.name(): string = ""
member this.getHtml(pnode: XmlElement): XmlElement =
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.getHtml(pnode: XmlElement): XmlElement =
member this.object() = refs
member this.getHtmlWith(pnode: XmlElement): XmlElement =
raise (System.NotImplementedException())
interface Present.IContainer with
@ -118,12 +146,15 @@ open System
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.getHtml(pnode: XmlElement): XmlElement =
member this.object() = defs
member this.getHtmlWith(pnode: XmlElement): XmlElement =
raise (System.NotImplementedException())
interface Present.IContainer with
@ -136,12 +167,33 @@ open System
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.getHtml(pnode: XmlElement): XmlElement =
member this.object() = defs
member this.getHtmlWith(pnode: XmlElement): XmlElement =
raise (System.NotImplementedException())
interface Present.IContainer with
@ -166,7 +218,8 @@ open System
interface Present.IDomUnit with
member this.name(): string =
defs.name()
member this.getHtml(pnode: XmlElement): XmlElement =
member this.object() = defs
member this.getHtmlWith(pnode: XmlElement): XmlElement =
raise (System.NotImplementedException())
interface Present.IContainer with
@ -190,7 +243,8 @@ open System
interface Present.IDomUnit with
member this.name(): string =
defs.name()
member this.getHtml(pnode: XmlElement): XmlElement =
member this.object() = defs
member this.getHtmlWith(pnode: XmlElement): XmlElement =
raise (System.NotImplementedException())
interface Present.IContainer with
@ -214,7 +268,8 @@ open System
interface Present.IDomUnit with
member this.name(): string =
defs.name()
member this.getHtml(pnode: XmlElement): XmlElement =
member this.object() = defs
member this.getHtmlWith(pnode: XmlElement): XmlElement =
raise (System.NotImplementedException())
interface Present.IContainer with
@ -274,6 +329,7 @@ open System
end
/// 内容组装 =========================================================================================
module Assemble =
///
let page_address_make(node: Present.IDomUnit): string =
@ -300,4 +356,59 @@ open System
| :? 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)
| _ -> story_page_build(nodes.Tail)
/// point-definepoint-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)

View File

@ -1,6 +1,10 @@
open AstAccess.AstImport
open HtmlStruct.Content
open System.Xml
open HtmlStruct.Assemble
open HtmlStruct.Content
open HtmlStruct.Present
let doc = XmlDocument()
doc.Load("E:/storyline.xast")
@ -11,5 +15,10 @@ let entry = AstVisitEntry(prog)
let visitor = UnitGenerate(prog)
entry.visitWith(visitor) |> ignore
for it in visitor.contents() do
printfn $"Name:{it.name()}"
let volume_pages = volume_page_build(visitor.contents()) |> List.map<VolumePage, IDomUnit> (fun x->x)
let story_pages = story_page_build(visitor.contents()) |> List.map<StoryPage, IDomUnit> (fun x->x)
let refers = point_peers_extract(volume_pages @ story_pages)
for it in refers do
let (x,y)= it
printfn $"{x.Value.name()}&{y.Value.name()}"