Doubly Linked String/WString List (Parser?)

[Stanley Durham]

Code:

''StrList.bas

#Option LargeMem32
#Dim All
#Compile Exe
#Include Once "WIN32API.INC"

%HaltOnError = 1

#Include Once "..\StrList.inc"

%TextBox = 101
%BtnID = 102
Global gDlg As Long
Global gBuild As IStringBuilderW
Sub SS(ByVal value As WString)
    gBuild.Add(value + $CrLf)
End Sub

Sub SampleCode()
    Register i As Long
    Local list As StrListT Ptr
    Local more As Long
    Local stored As String
    Local a() As String
    Local d As Double
    Local testcount As Long : testcount = 1000000

    Randomize
    MousePtr 11
    Control Set Text gDlg, %TextBox, ""

    SS ""
    SS "Function StrListNew() As Long "
    list = StrListNew()

    SS ""
    SS "Sub StrListAdd(ByVal p As StrListT Ptr, ByRef value As String)"
    SS "add  values"
    StrListClear list
    For i = 65 To 69
        StrListAdd list, Chr$(i)
    Next i
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend

    SS ""
    SS "Function StrListDeleteForward(ByVal p As StrListT Ptr) As Long"
    StrListClear list
    For i = 65 To 69
        StrListAdd list, Chr$(i)
    Next i
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend
    SS "move to C"
    StrListFirst(list)
    StrListNext(list)
    StrListNext(list)
    SS "delete moving forward 2 times"
    StrListDeleteForward(list)
    StrListDeleteForward(list)
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend

    SS ""
    SS "Function StrListDeleteBackward(ByVal p As StrListT Ptr) As Long"
    StrListClear list
    For i = 65 To 69
        StrListAdd list, Chr$(i)
    Next i
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend
    SS "move to C"
    StrListFirst(list)
    StrListNext(list)
    StrListNext(list)
    SS "delete moving backwards 2 times"
    StrListDeleteBackward(list)
    StrListDeleteBackward(list)
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend

    SS ""
    SS "Function StrListDeleteBefore(ByVal p As StrListT Ptr) As Long"
    SS "Function StrListDeleteAfter(ByVal p As StrListT Ptr) As Long"
    StrListClear list
    For i = 65 To 69
        StrListAdd list, Chr$(i)
    Next i
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend
    SS "move to C"
    StrListFirst(list)
    StrListNext(list)
    StrListNext(list)
    SS "delete before position"
    StrListDeleteBefore(list)
    SS "delete after position"
    StrListDeleteAfter(list)
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend

    SS ""
    SS "Function StrListPushBefore(ByVal p As StrListT Ptr, ByRef value As String) As Long"
    SS "Function StrListPushAfter(ByVal p As StrListT Ptr, ByRef value As String) As Long"
    StrListClear list
    For i = 65 To 69
        StrListAdd list, Chr$(i)
    Next i
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend
    SS "move to C"
    StrListFirst(list)
    StrListNext(list)
    StrListNext(list)
    SS "insert value before position"
    StrListPushBefore(list, "BEFORE")
    SS "insert value after position"
    StrListPushAfter(list, "AFTER")
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend

    SS ""
    SS "Function StrListPeekBefore(ByVal p As StrListT Ptr) As String"
    SS "Function StrListPeekAfter(ByVal p As StrListT Ptr) As String"
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend
    SS "move to C"
    StrListFirst(list)
    While StrListGet(list) <> "C"
        StrListNext(list)
    Wend
    SS "peek before = " + $Dq + StrListPeekBefore(list) + $Dq
    SS "peek after = " + $Dq + StrListPeekAfter(list) + $Dq

    SS ""
    SS "Function StrListPopBefore(ByVal p As StrListT Ptr) As String"
    SS "Function StrListPopAfter(ByVal p As StrListT Ptr) As String"
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend
    SS "move to C"
    StrListFirst(list)
    While StrListGet(list) <> "C"
        StrListNext(list)
    Wend
    SS "pop before = " + $Dq + StrListPopBefore(list) + $Dq
    SS "pop after = " + $Dq + StrListPopAfter(list) + $Dq
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend


    SS ""
    SS "Sub StrListPushFirst(ByVal p As StrListT Ptr, ByRef value As String)"
    SS "Sub StrListPushLast(ByVal p As StrListT Ptr, ByRef value As String)"
    SS "Function StrListPeekFirst(ByVal p As StrListT Ptr) As String"
    SS "Function StrListPeekLast(ByVal p As StrListT Ptr) As String"
    SS "Function StrListPopFirst(ByVal p As StrListT Ptr) As String"
    SS "Function StrListPopLast(ByVal p As StrListT Ptr) As String"

    SS ""
    SS "add A, B, C to queue"
    StrListClear list
    StrListPushLast(list, "A")
    StrListPushLast(list, "B")
    StrListPushLast(list, "C")
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend
    SS "peek and pop queue"
    While StrListCount(list)
        SS "peek = " + $Dq + StrListPeekFirst(list) + $Dq
        SS "pop  = " + $Dq + StrListPopFirst(list) + $Dq
    Wend

    SS ""
    SS "push A, B, C on stack"
    StrListClear list
    StrListPushLast(list, "A")
    StrListPushLast(list, "B")
    StrListPushLast(list, "C")
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend
    SS "peek and pop stack"
    While StrListCount(list)
        SS "peek = " + $Dq + StrListPeekLast(list) + $Dq
        SS "pop  = " + $Dq + StrListPopLast(list) + $Dq
    Wend

    ReDim a(1 To 3)
    a(1) = "aaa"
    a(2) = "bbb"
    a(3) = "ccc"

    SS ""
    SS "Sub StrListImport(ByVal p As StrListT Ptr, a() As String)"
    StrListImport list, a()
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend

    SS ""
    SS "Sub StrListExport(ByVal p As StrListT Ptr, a() As String)"
    Erase a()
    StrListExport list, a()
    For i = LBound(a) To UBound(a)
        SS $Dq + a(i) + $Dq
    Next i

    SS ""
    SS "Sub StrListSplit(ByVal p As StrListT Ptr, ByVal delimited As String, ByVal delimiter As String)"
    SS "split on 'a,b,c,d,e' "
    StrListSplit list, "a,b,c,d,e", ","
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend

    SS ""
    SS "Function StrListJoin(ByVal p As StrListT Ptr, ByVal delimiter As String) As String"
    SS "join = " + $Dq + StrListJoin(list, ",") + $Dq

    SS ""
    SS "Sub StrListToText(ByVal p As StrListT Ptr, ByVal file As WString)"
    SS "add text lines and store as text file"
    StrListClear list
    StrListAdd list, "This is the first line of text."
    StrListAdd list, "This is the second line of text."
    StrListAdd list, "Tins is the last line of text."
    StrListToText list, "List.txt"

    SS ""
    SS "Sub StrListFromText(ByVal p As StrListT Ptr, ByVal file As WString)"
    StrListFromText list, "List.txt"
    Kill "List.txt"
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend

    SS ""
    SS "Sub StrListFolders(ByVal p As StrListT Ptr, ByVal rootFolder As String)"
'    StrListFolders list, "C:\PBCode\PLib25A"
'    more = StrListFirst(list)
'    While more
'        SS $Dq + StrListGet(list) + $Dq
'        more = StrListNext(list)
'    Wend

    SS ""
    SS "Sub StrListFiles(ByVal p As StrListT Ptr, ByVal folder As String, ByVal mask As String)"
'    StrListFiles list, "C:\PBCode\PLib25A\Array", "*.inc"
'    more = StrListFirst(list)
'    While more
'        SS $Dq + StrListGet(list) + $Dq
'        more = StrListNext(list)
'    Wend

    SS ""
    SS "Sub StrListAllFolders(ByVal p As StrListT Ptr, ByVal rootFolder As String)"
'    StrListAllFolders list, "C:\PBCode\PLib25A"
'    more = StrListFirst(list)
'    While more
'        SS $Dq + StrListGet(list) + $Dq
'        more = StrListNext(list)
'    Wend

    SS ""
    SS "Sub StrListAllFiles(ByVal p As StrListT Ptr, ByVal rootFolder As String, ByVal mask As String)"
'    StrListAllFiles list, "C:\PBCode\PLib25A", "*.inc"
'    more = StrListFirst(list)
'    While more
'        SS $Dq + StrListGet(list) + $Dq
'        more = StrListNext(list)
'    Wend

    SS ""
    SS "add  values"
    StrListClear list
    For i = 65 To 69
        StrListAdd list, Chr$(i)
    Next i
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend

    SS ""
    SS "Function StrListStore(ByVal p As StrListT Ptr) As String"
    stored = StrListStore(list)
    SS "Sub StrListRestore(ByVal p As StrListT Ptr, ByRef stored As String)"
    StrListRestore list, stored
    SS "Sub StrListFileStore(ByVal p As StrListT Ptr, ByVal file As WString)"
    StrListFileStore list, "Stored.list"
    SS "Sub StrListFileRestore(ByVal p As StrListT Ptr, ByVal file As WString)"
    StrListFileRestore list, "Stored.list"
    Kill "Stored.list"
    more = StrListFirst(list)
    While more
        SS $Dq + StrListGet(list) + $Dq
        more = StrListNext(list)
    Wend

    SS ""
    SS ""
    SS "add "+Format$(testcount,"#,")+" values"
    StrListClear list
    d = Timer
    For i = 1 To testcount
        StrListAdd list, "X"
    Next i
    SS "Time = " + Format$(Timer - d, "000.000")

    SS ""
    SS "get "+Format$(testcount,"#,")+" values"
    d = Timer
    more = StrListFirst(list)
    While more
        StrListGet(list)
        more = StrListNext(list)
    Wend
    SS "Time = " + Format$(Timer - d, "000.000")

    SS ""
    SS ""
    SS "Function PtrFree(ByVal p As PtrT Ptr) As Long"
    list = PtrFree(list)

    SS ""
    SS ""
    Control Set Text gDlg, %TextBox, gBuild.String
    gBuild.Clear
    MousePtr 1
End Sub

Function PBMain()
    gBuild = Class "StringBuilderW"
    Dialog Default Font "consolas", 12, 0, 0
    Dialog New 0, "Sample Code", 0, 0, 0, 0, %WS_Caption Or %WS_ClipSiblings Or %WS_MinimizeBox Or %WS_SysMenu Or %WS_ThickFrame, %WS_Ex_AppWindow To gDlg
    Control Add TextBox, gDlg, %TextBox, "", 0, 0, 0, 0, %ES_AutoHScroll Or %ES_AutoVScroll Or %ES_MultiLine Or %ES_NoHideSel Or %ES_WantReturn Or %WS_HScroll Or %WS_VScroll Or %WS_Border, 0
    Control Add Button,  gDlg, %BtnID, "Run", 275, 220, 60, 15, %BS_Flat, 0
    SendMessageW(GetDlgItem(gDlg, %TextBox), %EM_SETLIMITTEXT, 4000000, 0)
    Dialog Show Modeless gDlg, Call DlgCB
    While IsWin(gDlg)
        Dialog DoEvents
    Wend
End Function

CallBack Function DlgCB()
    Select Case As Long Cb.Msg
        Case %WM_InitDialog
            WM_InitDialog()
        Case %WM_Size
            WM_Size()
        Case %WM_Command
            Select Case As Long Cb.Ctl
                Case %BtnID : If Cb.CtlMsg = %BN_Clicked Then SampleCode()
            End Select
    End Select
End Function

Sub WM_InitDialog()
    Local clientW, clientH As Long
    Desktop Get Client To clientW, clientH
    clientW /= 7
    clientH /= 4
    Dialog Set Loc gDlg, clientW / 2, clientH / 7
    Dialog Set Size gDlg, clientW, clientH
End Sub

Sub WM_Size()
    Local clientW, clientH As Long
    Local marg As Long
    Local buttonW, buttonH As Long
    Local txtWidth, txtHeight As Long
    Local fromLeft, fromBottom As Long
    Dialog Get Client gDlg To clientW, clientH
    marg = 1 : buttonW = 30 : buttonH = 10
    fromLeft = clientW - marg - marg - buttonW
    fromBottom = clientH - marg - marg - buttonH
    Control Set Size gDlg, %BtnID, buttonW, buttonH
    Control Set Loc gDlg, %BtnID, fromLeft, fromBottom
    txtWidth = clientW - marg - marg
    txtHeight = clientH - marg - buttonH - marg - marg
    Control Set Size gDlg, %TextBox, txtWidth, txtHeight
    Control Set Loc gDlg, %TextBox, marg, marg
End Sub