TreeRecurseV.vbs

TreeRecurseV.vbs

' TreeRecurseV.vbs
' Copyright (C) 2018 Katayama Hirofumi MZ <katayama.hirofumi.mz@gmail.com>
' This file is public domain software.
' Usage: cscript TreeRecurseV.vbs > Output.txt

Option Explicit

Function Slice(ary, start, ending)
    Dim I, ret()
    If Right(TypeName(ary), 2) <> "()" Then
        Err.Raise 0
    End If
    If IsEmpty(ending) Then
        ending = UBound(ary)
    End If
    ReDim ret(ending - start)
    For I = start To ending
        ret(I - start) = ary(I)
    Next
    Slice = ret
End Function

Class TextArea
    Public Texts(), NumLines, NumColumns

    Public Sub Reset(cx, cy)
        NumColumns = cx
        NumLines = cy
        ReDim Texts(NumLines - 1)
        Dim I
        For I = 0 To NumLines - 1
            Texts(I) = String(NumColumns, "・")
        Next
    End Sub

    Public Function GetText()
        Dim I
        GetText = ""
        For I = 0 To NumLines - 1
            GetText = GetText & Texts(I) & vbCrLf
        Next
    End Function
    
    Public Sub Output
        WScript.Echo GetText()
    End Sub

    Public Sub SetChar(x, y, ch)
        Dim Row
        If x <= 0 Or NumColumns < x Or y <= 0 Or NumLines < y Then
            Exit Sub
        End If
        Row = Texts(y - 1)
        Row = Mid(Row, 1, x - 1) & ch & Mid(Row, x + 1)
        Texts(y - 1) = Row
    End Sub

    Public Sub PasteTextH(x, y, Text)
        Dim I
        For I = 0 To Len(Text) - 1
            Call SetChar(x + I, y, Mid(Text, I + 1, 1))
        Next
    End Sub

    Public Sub PasteTextV(x, y, Text)
        Dim I
        For I = 0 To Len(Text) - 1
            Call SetChar(x, y + I, Mid(Text, I + 1, 1))
        Next
    End Sub

    Public Sub PasteTA(x, y, TA)
        Dim I, J
        For J = 0 To TA.NumLines - 1
            For I = 0 To TA.NumColumns - 1
                Call SetChar(x + I, y + J, Mid(TA.Texts(J), I + 1, 1))
            Next
        Next
    End Sub
End Class

Sub PrintArray(Ary)
    Dim I, S
    S = ""
    For I = 0 To UBound(Ary)
        S = S & Ary(I) & ", "
    Next
    WScript.Echo S
End Sub

Function Max(A, B)
    If A < B Then
        Max = B
    Else
        Max = A
    End If
End Function

Function MakeTree(Ary, ByRef RootPos)
    Dim TA, I, Ary1, Ary2
    If UBound(Ary) = 0 Then
        Set TA = New TextArea
        Call TA.Reset(1, 1)
        Call TA.SetChar(1, 1, Ary(0))
        Set MakeTree = TA
        RootPos = 1
    Else
        I = UBound(Ary) \ 2
        Ary1 = Slice(Ary, 0, I)
        Ary2 = Slice(Ary, I + 1, Empty)

        Dim TA1, TA2, RootPos1, RootPos2
        Set TA1 = MakeTree(Ary1, RootPos1)
        Set TA2 = MakeTree(Ary2, RootPos2)

        RootPos = TA1.NumLines + 1

        Dim Text
        Text = "┌" & String(RootPos - RootPos1 - 1, "│") & "┤" & String(RootPos2 - 1, "│") & "└"

        Dim CX
        CX = Max(TA1.NumColumns, TA2.NumColumns)

        Set TA = New TextArea
        Call TA.Reset(CX + 1, TA1.NumLines + 1 + TA2.NumLines)
        Call TA.PasteTextV(1, RootPos1, Text)
        Call TA.PasteTA(2, 1, TA1)
        Call TA.PasteTA(2, RootPos + 1, TA2)
        Set MakeTree = TA
    End If
End Function

Sub Main
    Dim ary
    ary = Array("Ａ","Ｂ","Ｃ","Ｄ","Ｅ","Ｆ","Ｇ","Ｈ","Ｉ","Ｊ")

    Dim TA, RootPos
    Set TA = MakeTree(ary, RootPos)
    TA.Output()
End Sub

Main