Author Topic: Soft Arrays grand tour (with video!) (Read 2778 times)

STxAxTIC · « **on:** December 22, 2020, 03:09:12 pm »

I felt bad for not really explaining the linked lists thing in another post, so I'm making it all up to you you here.

(1) A video ~ 15 mins:

(2) Full code, no attachments, just paste and F5. You can follow with the video.

Code: QB64: [Select]

' Version 2020-12-22
 
OPTION _EXPLICIT
 
 
 
 
 
 
 
 
 
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Begin BI-component.
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Hard arrays to store actual data:
'
REDIM SHARED IntegerData(0) AS INTEGER
REDIM SHARED TextData(0) AS STRING
REDIM SHARED DoubleData(0) AS DOUBLE
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Temp variable(s):
'
 
DIM ktmpsa AS INTEGER
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Nodes:
'
 
' Node structure
TYPE Node
    Identity AS LONG '   Address in identity register
    Species AS STRING '  Data type
    Reference AS LONG '  Pointer to hard array index
    North AS LONG '
    South AS LONG '
    East AS LONG '
    West AS LONG '       Orientation
END TYPE
 
DIM MaxNodes AS INTEGER
MaxNodes = 10000
 
' Node identity register
DIM SHARED IdentityRegister(MaxNodes) AS LONG
FOR ktmpsa = 1 TO UBOUND(IdentityRegister)
    IdentityRegister(ktmpsa) = -1
NEXT
 
' Node storage
DIM SHARED Nodes(MaxNodes) AS Node
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Soft arrays:
'
 
' Soft array structure
TYPE SoftArrayStructure
    Label AS STRING
    HeadNode AS LONG
END TYPE
 
DIM MaxSoftArrays AS INTEGER
MaxSoftArrays = MaxNodes / 2
 
' Soft array register
DIM SHARED SoftArrayRegister(MaxSoftArrays) AS INTEGER
FOR ktmpsa = 1 TO UBOUND(SoftArrayRegister)
    SoftArrayRegister(ktmpsa) = -1
NEXT
 
' Soft array storage
DIM SHARED SoftArray(MaxSoftArrays) AS SoftArrayStructure
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Processing
'
DIM SHARED LambdaMatrix(99, 9) AS LONG
DIM SHARED LambdaIndex AS INTEGER
DIM SHARED LambdaArgCount(9) AS LONG
LambdaIndex = 0
 
DIM SHARED IdentityStack(MaxNodes, 5) AS LONG
DIM SHARED IdentityStackSize AS INTEGER
 
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' End BI-component.
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
 
 
 
 
 
 
 
 
 
'REM $Include: 'SoftArrays.bi'
 
DO UNTIL _SCREENEXISTS: LOOP
_TITLE "Soft Array Editor"
$RESIZE:ON
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Meta:
'
RANDOMIZE TIMER
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Visual Nodes (optional)
'
 
TYPE Vector
    x AS DOUBLE
    y AS DOUBLE
END TYPE
 
' Visual node structure
TYPE VisualNodesStructure
    Reference AS LONG '    Points to a node.
    BoxCenter AS Vector
    BoxHeight AS DOUBLE
    BoxWidth AS DOUBLE
    CornerNE AS Vector
    CornerNW AS Vector
    CornerSE AS Vector
    CornerSW AS Vector
    AntennaN AS Vector
    AntennaS AS Vector
    AntennaE AS Vector
    AntennaW AS Vector
    Visible AS INTEGER
END TYPE
 
DIM MaxVisualNodess AS INTEGER
DIM SHARED VisualNodesCount AS INTEGER
MaxVisualNodess = 512
VisualNodesCount = 0
 
' Visual node storage
DIM SHARED VisualNodes(MaxVisualNodess) AS VisualNodesStructure
 
' Visual node extras
DIM SHARED SelectionIndex(5) AS INTEGER
 
DIM SHARED ScrollPosition AS Vector
DIM SHARED Origin AS Vector
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Pre-Main
'
 
DIM SHARED ScreenHandle AS LONG
DIM SHARED ScreenHandleTemp AS LONG
'ScreenHandle = _NEWIMAGE(800, 600, 32)
ScreenHandle = _NEWIMAGE(1024, 768, 32)
SCREEN ScreenHandle
_DELAY .1
_SCREENMOVE _MIDDLE
COLOR _RGBA(255, 255, 255, 255)
 
Origin.x = -.33 * _WIDTH / 2
Origin.y = .9 * _HEIGHT / 2
ScrollPosition.x = 0
ScrollPosition.y = 0
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Main
'
 
'SLEEP
CALL UserMain(0, 1, 1)
CALL DemoTree
CALL DemoArray3D
CALL DemoTreeEdit
CALL DemoArithmetic
CALL DemoList
CALL DemoLambda
CALL DemoMerge
CALL DemoJSON
 
END
 
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Demo cases:
'
 
SUB DemoJSON
    DIM TheName AS STRING
    TheName = "myObj"
 
    DIM a AS LONG
    DIM b AS LONG
    DIM c AS LONG
    DIM d AS LONG
    DIM e AS LONG
    a = NewSoftArray(TheName)
    b = LinkEast(a, NewTextNode("name"))
    c = LinkEast(b, NewTextNode("John"))
    b = LinkSouth(b, NewTextNode("age"))
    c = LinkEast(b, NewIntegerNode(30))
    b = LinkSouth(b, NewTextNode("cars"))
    c = LinkEast(b, NewTextNode("[]"))
    c = LinkSouth(c, NewTextNode("{}"))
    d = LinkEast(c, NewTextNode("name"))
    e = LinkEast(d, NewTextNode("Ford"))
    d = LinkSouth(d, NewTextNode("models"))
    e = LinkEast(d, NewTextNode("[]"))
    e = LinkSouth(e, NewTextNode("Fiesta"))
    e = LinkSouth(e, NewTextNode("Focus"))
    e = LinkSouth(e, NewTextNode("Mustang"))
    c = LinkSouth(c, NewTextNode("{}"))
    d = LinkEast(c, NewTextNode("name"))
    e = LinkEast(d, NewTextNode("BMW"))
    d = LinkSouth(d, NewTextNode("models"))
    e = LinkEast(d, NewTextNode("[]"))
    e = LinkSouth(e, NewTextNode("320"))
    e = LinkSouth(e, NewTextNode("X3"))
    e = LinkSouth(e, NewTextNode("X5"))
    c = LinkSouth(c, NewTextNode("{}"))
    d = LinkEast(c, NewTextNode("name"))
    e = LinkEast(d, NewTextNode("Fiat"))
    d = LinkSouth(d, NewTextNode("models"))
    e = LinkEast(d, NewTextNode("[]"))
    e = LinkSouth(e, NewTextNode("500"))
    e = LinkSouth(e, NewTextNode("Panda"))
 
    CALL UserMain(0, 1, 1)
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoTree
    DIM TheName AS STRING
    TheName = "Tree of Friends"
 
    DIM a AS LONG
    DIM b AS LONG
    DIM c AS LONG
    DIM d AS LONG
    DIM e AS LONG
    DIM f AS LONG
    DIM g AS LONG
 
    a = NewSoftArray(TheName)
    b = LinkEast(a, NewTextNode("QB64 Buddy"))
    c = LinkEast(b, NewTextNode("Handle"))
    d = LinkEast(c, NewTextNode("SMcNeill"))
    c = LinkSouth(c, NewTextNode("Name"))
    d = LinkEast(c, NewTextNode("Steve SMcNeill"))
    c = LinkSouth(c, NewTextNode("Country"))
    d = LinkEast(c, NewTextNode("USA"))
    e = LinkEast(d, NewTextNode("Locality"))
    f = LinkEast(e, NewTextNode("Virginia"))
    c = LinkSouth(c, NewTextNode("Birthyear"))
    d = LinkEast(c, NewIntegerNode(1973))
    d = LinkSouth(d, NewTextNode("May?"))
    b = LinkSouth(b, NewTextNode("QB64 Buddy"))
    c = LinkEast(b, NewTextNode("Handle"))
    d = LinkEast(c, NewTextNode("FellippeHeitor"))
    c = LinkSouth(c, NewTextNode("Name"))
    d = LinkEast(c, NewTextNode("Fellippe Heitor"))
    c = LinkSouth(c, NewTextNode("Country"))
    d = LinkEast(c, NewTextNode("Brazil"))
    e = LinkEast(d, NewTextNode("Locality"))
    f = LinkEast(e, NewTextNode("My <3"))
    g = LinkEast(f, NewTextNode("JK, it's ___."))
    c = LinkSouth(c, NewTextNode("Birthyear"))
    d = LinkEast(c, NewIntegerNode(1983))
    d = LinkSouth(d, NewTextNode("Sep?"))
    d = LinkSouth(d, NewTextNode("... or was it May?"))
    b = LinkSouth(b, NewTextNode("QB64 Buddy"))
    c = LinkEast(b, NewTextNode("Handle"))
    d = LinkEast(c, NewTextNode("Ashish"))
 
    ' Query tests
    CLS
    PRINT PrintSoftArray$(a)
    PRINT
    PRINT "Steve's locality: ";
    PRINT Literal$(StepFromUsing(a, "eesseee"))
    PRINT "Fellippe's locality: ";
    PRINT Literal$(StepFromUsing(a, "esesseee"))
    PRINT "Fellippe's birth month: ";
    PRINT Literal$(StepFromUsing(JumpFrom(StepFromUsing(a, "ese"), "s", 3), "es"))
    PRINT "Width of Fellippe's Country branch:";
    PRINT Measure(SeekText("Country", a, 2), "e")
    PRINT "Height under Fellippe's Birthyear branch:";
    PRINT Measure(Nodes(SeekText("Birthyear", a, 2)).East, "s")
    PRINT
    PRINT "Press any key..."
    _DISPLAY
    SLEEP
 
    CALL UserMain(0, 1, 1)
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoArray3D
    DIM TheName AS STRING
    TheName = "Three-Dimensional Array"
 
    DIM i AS INTEGER
    DIM j AS INTEGER
    DIM k AS INTEGER
    DIM a AS LONG
    DIM b AS LONG
 
    ' Create a 3D array manually
    DIM TestArray3D(3, 2, 3) AS STRING
    TestArray3D(1, 1, 1) = "one.one.one"
    TestArray3D(1, 1, 2) = "one.one.two"
    TestArray3D(1, 1, 3) = "one.one.three"
    TestArray3D(1, 2, 1) = "one.two.one"
    TestArray3D(1, 2, 2) = "one.two.two"
    TestArray3D(1, 2, 3) = "one.two.three"
    TestArray3D(2, 1, 1) = "two.one.one"
    TestArray3D(2, 1, 2) = "two.one.two"
    TestArray3D(2, 1, 3) = "two.one.three"
    TestArray3D(2, 2, 1) = "two.two.one"
    TestArray3D(2, 2, 2) = "two.two.two"
    TestArray3D(2, 2, 3) = "two.two.three"
    TestArray3D(3, 1, 1) = "three.one.one"
    TestArray3D(3, 1, 2) = "three.one.two"
    TestArray3D(3, 1, 3) = "three.one.three"
    TestArray3D(3, 2, 1) = "three.two.one"
    TestArray3D(3, 2, 2) = "three.two.two"
    TestArray3D(3, 2, 3) = "three.two.three"
 
    ' Load 3D array as Soft array
    a = NewSoftArray(TheName)
    FOR i = 1 TO UBOUND(TestArray3D, 1)
        FOR j = 1 TO UBOUND(TestArray3D, 2)
            FOR k = 1 TO UBOUND(TestArray3D, 3)
                IF ((i = 1) AND (j = 1) AND (k = 1)) THEN
                    a = LinkEast(a, NewTextNode(TestArray3D(i, j, k)))
                    b = a
                ELSE
                    IF (k = 1) THEN
                        a = LinkSouth(a, NewTextNode(TestArray3D(i, j, k)))
                        b = a
                    ELSE
                        b = LinkEast(b, NewTextNode(TestArray3D(i, j, k)))
                    END IF
                END IF
            NEXT
        NEXT
    NEXT
 
    CLS
 
    ' Store the identity of the array name (even though we already have it, pretend we just received the label.)
    DIM a0 AS LONG
    a0 = SoftArrayID(TheName)
    PRINT PrintSoftArray$(a0)
    PRINT
 
    ' Store the address of he head node and print its content. This initializes the loop below.
    k = SoftArray(a0).HeadNode
 
    PRINT "Typical FOR-like loop:"
    PRINT Literal$(k)
    PRINT "(Listing one layer deep only.)"
    ' Set the address variable to the first entry in the "array".
    k = Nodes(k).East
    DO
        PRINT Literal$(k)
        k = Nodes(k).South
        IF (k = -1) THEN EXIT DO
        ' Exit the loop when there is no south link.
    LOOP
    _DISPLAY
    SLEEP
 
    CALL UserMain(0, 1, 1)
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoMerge
    DIM TheName1 AS STRING
    DIM TheName2 AS STRING
    TheName1 = "top part"
    TheName2 = "bottom part"
 
    DIM a AS LONG
    DIM a0 AS LONG
    DIM b AS LONG
 
    a = NewUnitArray("cow", NewIntegerNode(5))
    a0 = a
    a = NewSoftArray(TheName1)
    a = LinkEast(a, NewTextNode("lambda"))
    b = LinkEast(a, NewIntegerNode(4))
    b = LinkSouth(b, NewIntegerNode(6))
    a = NewSoftArray(TheName2)
    a = LinkEast(a, NewTextNode("cos"))
    b = LinkEast(a, NewTextNode("*"))
    b = LinkEast(b, NewIntegerNode(3))
    b = LinkSouth(b, NewTextNode("[1]"))
    b = LinkSouth(b, CopyIntegerNode(Nodes(a0).East))
    b = LinkSouth(b, NewTextNode("[2]"))
 
    CALL UserMain(1, 0, 0)
 
    a = SoftArrayID(TheName2)
    b = SoftArray(a).HeadNode
    SoftArrayRegister(a) = -1
    IdentityRegister(b) = -1
 
    a = Nodes(SoftArray(SoftArrayID(TheName1)).HeadNode).East
    b = Nodes(b).East
    Nodes(b).West = -1
    Nodes(b).North = a
    Nodes(a).South = b
 
    CALL UserMain(1, 1, 0)
    a = EvalMultiSoftArrays(1)
    CALL UserMain(1, 0, 1)
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoLambda
    DIM TheName AS STRING
    TheName = "Lambda Test"
 
    DIM a AS LONG
    DIM a0 AS LONG
    DIM b AS LONG
    a = NewUnitArray("cow", NewIntegerNode(7))
    a0 = a
    a = NewSoftArray(TheName)
    a = LinkEast(a, NewTextNode("lambda"))
    b = LinkEast(a, NewIntegerNode(4))
    b = LinkSouth(b, NewIntegerNode(6))
    a = LinkSouth(a, NewTextNode("cos"))
    b = LinkEast(a, NewTextNode("*"))
    b = LinkEast(b, NewIntegerNode(3))
    b = LinkSouth(b, NewTextNode("[1]"))
    b = LinkSouth(b, CopyIntegerNode(Nodes(a0).East))
    b = LinkSouth(b, NewTextNode("[2]"))
 
    CALL UserMain(0, 1, 0)
    a = EvalMultiSoftArrays(1)
    CALL UserMain(1, 0, 1)
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoList
    DIM TheName AS STRING
    TheName = "List Test"
 
    DIM a AS LONG
    DIM b AS LONG
    a = NewSoftArray(TheName)
    a = LinkEast(a, NewTextNode("cos"))
    b = LinkEast(a, NewTextNode("three"))
    b = LinkSouth(b, NewTextNode("four"))
    b = LinkSouth(b, NewTextNode("five"))
    b = LinkSouth(b, NewTextNode("six"))
    b = LinkSouth(b, NewTextNode("seven"))
    a = LinkSouth(a, NewTextNode("cos"))
    b = LinkEast(a, NewIntegerNode(3))
    b = LinkSouth(b, NewIntegerNode(4))
    b = LinkSouth(b, NewIntegerNode(5))
    b = LinkSouth(b, NewIntegerNode(6))
    b = LinkSouth(b, NewIntegerNode(7))
 
    CALL UserMain(0, 1, 0)
    a = EvalMultiSoftArrays(1)
    CALL UserMain(1, 0, 1)
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoArithmetic
    DIM a AS LONG
    DIM a0 AS LONG
    DIM b AS LONG
 
    a = NewSoftArray("Arithmetic Test1")
    a0 = a
    a = LinkEast(a, NewTextNode("*"))
    b = LinkEast(a, NewIntegerNode(3))
    b = LinkSouth(b, NewIntegerNode(4))
    a = LinkSouth(b, NewTextNode("cos"))
    b = LinkEast(a, NewTextNode("+"))
    b = LinkEast(b, NewIntegerNode(4))
    b = LinkSouth(b, NewIntegerNode(7))
    b = LinkSouth(a, NewIntegerNode(2))
 
    CALL UserMain(0, 1, 0)
    a = EvalMultiSoftArrays(1)
    CALL UserMain(1, 0, 0)
 
    a = NewSoftArray("Arithmetic Test2")
    a = LinkEast(a, NewTextNode("/"))
    b = LinkEast(a, NewIntegerNode(3))
    a = LinkSouth(b, NewTextNode("cos"))
    b = LinkEast(a, NewTextNode("+"))
    b = LinkEast(b, NewIntegerNode(4))
    b = LinkSouth(b, NewDoubleNode(DoubleData(Nodes(Nodes(a0).East).Reference)))
 
    CALL UserMain(0, 1, 0)
    a = EvalMultiSoftArrays(1)
    CALL UserMain(1, 0, 1)
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoTreeEdit
    DIM TheName AS STRING
    TheName = "Tree Edit Test"
 
    DIM a AS LONG
    DIM a0 AS LONG
    DIM b AS LONG
    DIM c AS LONG
    a = NewSoftArray(TheName)
    a0 = a
    a = LinkEast(a, NewTextNode("QB64 Buddy"))
    a = LinkEast(a, NewTextNode("Handle"))
    b = LinkEast(a, NewTextNode("flukiluke"))
    a = LinkSouth(a, NewTextNode("Name"))
    b = LinkEast(a, NewTextNode("Luke C."))
    a = LinkSouth(a, NewTextNode("Country"))
    b = LinkEast(a, NewTextNode("Australia"))
    c = LinkEast(b, NewTextNode("Locality"))
    b = LinkEast(c, NewTextNode("Down Under"))
    a = LinkSouth(a, NewTextNode("Birthyear"))
    b = LinkEast(a, NewIntegerNode(1523))
    c = LinkSouth(b, NewTextNode("December"))
 
    CALL UserMain(1, 0, 0)
 
    a = InsertEast(SeekText("Down Under", a0, 1), NewTextNode("Get it?"))
    a = InsertSouth(SeekText("QB64 Buddy", a0, 1), NewTextNode("QB64 Enemy"))
    a = EditIntegerReference(StepFromUsing(SeekText("Birthyear", a0, 1), "e"), 1855)
    a = DeleteNodes(SeekText("Name", a0, 1))
 
    'CLS
    '' Query tests
    'PRINT "Inserting `Get it?' into list..."
    'PRINT "Adding new entry to bottom of list..."
    'PRINT "Editing Birthyear..."
    'PRINT "Deleting Name..."
    'PRINT
    '_DISPLAY
    'SLEEP
 
    CALL UserMain(0, 1, 1)
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Begin GUI/Graphical component (optional)
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB UserMain (q AS INTEGER, r AS INTEGER, s AS INTEGER)
    DIM a AS LONG
    DIM k AS INTEGER
    DIM t AS STRING
 
    IF (q = 1) THEN
        CLS
        PRINT PrintMultiSoftArrays$(1)
        CALL Halt
    END IF
 
    IF (q = 2) THEN
        CLS
        PRINT PrintJSON$(1)
        CALL Halt
    END IF
 
    IF (r = 1) THEN
        k = ClearSelections(1)
        CALL BuildAllVisualArrays
        CALL UserLoop
    END IF
 
    IF (s = 1) THEN
        a = DeleteAllSoftArrays(1)
        k = ClearSelections(1)
        ScrollPosition.x = 0
        ScrollPosition.y = 0
        t = MemoryProbe$("")
    END IF
END SUB
 
SUB UserLoop
    DIM x0 AS DOUBLE
    DIM y0 AS DOUBLE
    DIM xx AS DOUBLE
    DIM yy AS DOUBLE
    DIM a AS LONG
    DIM b AS LONG
    DIM c AS LONG
    DIM k AS INTEGER
    DIM i AS INTEGER
    DIM j AS INTEGER
    DIM kh AS INTEGER
    DIM AltWires AS INTEGER
    DIM CtrlKey AS INTEGER
    DIM MW AS INTEGER
    DIM MB1 AS INTEGER
    DIM t AS STRING
    DIM KeyIn AS STRING
 
    KeyIn = INKEY$
 
    DO WHILE _MOUSEINPUT: LOOP ' Clear mouse buffer.
 
    DO
 
        x0 = _MOUSEX
        y0 = _MOUSEY
        x0 = (x0 - _WIDTH / 2)
        y0 = (-y0 + _HEIGHT / 2)
        i = MouseOver(x0, y0)
 
        MB1 = 0
 
        DO WHILE _MOUSEINPUT
            xx = _MOUSEX
            yy = _MOUSEY
 
            xx = (xx - _WIDTH / 2)
            yy = (-yy + _HEIGHT / 2)
 
            IF ((_MOUSEBUTTON(1) = 0) AND (MB1 = 0)) THEN
                i = MouseOver(xx, yy)
                j = i
            END IF
 
            IF ((_MOUSEBUTTON(1) = -1) AND (MB1 = 0)) THEN
                i = MouseOver(xx, yy)
                j = i
                MB1 = -1
            END IF
 
            IF (MB1 = -1) THEN
                i = j
                IF (i <> -1) THEN
                    'ScrollPosition.x = ScrollPosition.x + (xx - VisualNodes(i).BoxCenter.x)
                    'ScrollPosition.y = ScrollPosition.y + (yy - VisualNodes(i).BoxCenter.y)
                    'CALL MoveVisualNodesRecur(i, VisualNodes(i).Reference, xx - VisualNodes(i).BoxCenter.x, yy - VisualNodes(i).BoxCenter.y)
                    CALL NewSelection(i)
                END IF
            END IF
 
            '''
 
            IF (_MOUSEBUTTON(2) = -1) THEN
                ScrollPosition.x = ScrollPosition.x + (xx - x0)
                ScrollPosition.y = ScrollPosition.y + (yy - y0)
                CALL MoveAllVisualNodes(xx - x0, yy - y0)
                x0 = xx
                y0 = yy
            END IF
 
            MW = _MOUSEWHEEL
            IF (MW <> 0) THEN
                CALL MoveAllVisualNodes(0, 30 * MW)
                ScrollPosition.y = ScrollPosition.y + 30 * MW
            END IF
 
        LOOP
 
        'IF ((_MOUSEBUTTON(1) = 0) AND (MB1 = -1)) THEN
        IF (MB1 = -1) THEN
            i = -1
            j = i
            MB1 = 0
            CALL BuildAllVisualArrays
        END IF
 
        IF (i <> -1) THEN
            IF (xx > VisualNodes(i).BoxCenter.x - VisualNodes(i).BoxWidth / 2) AND (xx < VisualNodes(i).BoxCenter.x + VisualNodes(i).BoxWidth / 2) THEN
                IF (yy > VisualNodes(i).BoxCenter.y - VisualNodes(i).BoxHeight / 2) AND (yy < VisualNodes(i).BoxCenter.y + VisualNodes(i).BoxHeight / 2) THEN
                    'CALL NewSelection(i)
                END IF
            END IF
        END IF
 
        kh = _KEYHIT
 
        ' Press-and-hold keys
        IF (_KEYDOWN(100305)) OR (_KEYDOWN(100306)) THEN
            CtrlKey = 1
        ELSE
            CtrlKey = 0
        END IF
 
        IF (_KEYDOWN(ASC("w"))) OR (_KEYDOWN(ASC("W"))) THEN
            AltWires = 1
        ELSE
            AltWires = 0
        END IF
 
        ' State-changing.
        SELECT CASE kh
            CASE 13 ' enter
                IF (SelectionIndex(1) <> -1) THEN
                    a = Evaluate(VisualNodes(SelectionIndex(1)).Reference)
                    CALL BuildAllVisualArrays
                    i = ClearSelections(1)
                END IF
            CASE 27 ' esc
                EXIT SUB
            CASE 21248 ' delete
                IF (SelectionIndex(1) <> -1) THEN
                    a = DeleteNodes(VisualNodes(SelectionIndex(1)).Reference)
                    CALL BuildAllVisualArrays
                    i = ClearSelections(1)
                END IF
            CASE ASC("v"), ASC("V")
                IF (SelectionIndex(1) <> -1) THEN
                    a = SeverSoftArray(VisualNodes(SelectionIndex(1)).Reference)
                    CALL BuildAllVisualArrays
                END IF
            CASE ASC("c"), ASC("C")
                IF (SelectionIndex(1) <> -1) THEN
                    a = CopyNodes(VisualNodes(SelectionIndex(1)).Reference)
                    CALL BuildAllVisualArrays
                END IF
            CASE ASC("i"), ASC("I")
                IF (CtrlKey = 1) THEN
                    IF (SelectionIndex(1) <> -1) THEN
                        a = ConvertToInteger(VisualNodes(SelectionIndex(1)).Reference, 0)
                        CALL DefineVisualNode(SelectionIndex(1), VisualNodes(SelectionIndex(1)).Reference, VisualNodes(SelectionIndex(1)).BoxCenter.x, VisualNodes(SelectionIndex(1)).BoxCenter.y)
                    END IF
                ELSE
                    a = NewUnitArray("integer" + LTRIM$(RTRIM$(STR$(INT(TIMER * 10)))), NewIntegerNode(0))
                    CALL BuildAllVisualArrays
                END IF
            CASE ASC("d"), ASC("D")
                IF (CtrlKey = 1) THEN
                    IF (SelectionIndex(1) <> -1) THEN
                        a = ConvertToDouble(VisualNodes(SelectionIndex(1)).Reference, 0)
                        CALL DefineVisualNode(SelectionIndex(1), VisualNodes(SelectionIndex(1)).Reference, VisualNodes(SelectionIndex(1)).BoxCenter.x, VisualNodes(SelectionIndex(1)).BoxCenter.y)
                    END IF
                ELSE
                    a = NewUnitArray("double" + LTRIM$(RTRIM$(STR$(INT(TIMER * 10)))), NewDoubleNode(0))
                    CALL BuildAllVisualArrays
                END IF
            CASE ASC("t"), ASC("T")
                IF (CtrlKey = 1) THEN
                    IF (SelectionIndex(1) <> -1) THEN
                        a = ConvertToText(VisualNodes(SelectionIndex(1)).Reference, "text")
                        CALL DefineVisualNode(SelectionIndex(1), VisualNodes(SelectionIndex(1)).Reference, VisualNodes(SelectionIndex(1)).BoxCenter.x, VisualNodes(SelectionIndex(1)).BoxCenter.y)
                    END IF
                ELSE
                    a = NewUnitArray("text" + LTRIM$(RTRIM$(STR$(INT(TIMER * 10)))), NewTextNode("."))
                    CALL BuildAllVisualArrays
                END IF
            CASE ASC("e"), ASC("E")
                IF (CtrlKey = 1) THEN
                    FOR k = 1 TO UBOUND(SoftArrayRegister)
                        IF (SoftArrayRegister(k) <> -1) THEN
                            IF (SoftArray(k).Label = Literal$(VisualNodes(SelectionIndex(1)).Reference)) THEN
                                a = SoftArray(k).HeadNode
                                b = Nodes(a).East
                                Nodes(b).West = -1
                                SoftArrayRegister(k) = -1
                                IdentityRegister(a) = -1
                                a = VisualNodes(SelectionIndex(2)).Reference
                                c = Nodes(a).East
                                IF (c <> -1) THEN
                                    c = DeleteNodes(c)
                                END IF
                                Nodes(a).East = b
                                Nodes(b).West = a
                                EXIT FOR
                            END IF
                        END IF
                    NEXT
                ELSE
                    IF (SelectionIndex(1) <> -1) THEN
                        SELECT CASE Nodes(VisualNodes(SelectionIndex(1)).Reference).Species
                            CASE "integer"
                                a = InsertEast(VisualNodes(SelectionIndex(1)).Reference, NewIntegerNode(0))
                            CASE "text"
                                a = InsertEast(VisualNodes(SelectionIndex(1)).Reference, NewTextNode("e"))
                            CASE "double"
                                a = InsertEast(VisualNodes(SelectionIndex(1)).Reference, NewDoubleNode(0))
                        END SELECT
                    END IF
                END IF
                CALL BuildAllVisualArrays
            CASE ASC("s"), ASC("S")
                IF (CtrlKey = 1) THEN
                    FOR k = 1 TO UBOUND(SoftArrayRegister)
                        IF (SoftArrayRegister(k) <> -1) THEN
                            IF (SoftArray(k).Label = Literal$(VisualNodes(SelectionIndex(1)).Reference)) THEN
                                a = SoftArray(k).HeadNode
                                b = Nodes(a).East
                                Nodes(b).West = -1
                                SoftArrayRegister(k) = -1
                                IdentityRegister(a) = -1
                                a = VisualNodes(SelectionIndex(2)).Reference
                                c = Nodes(a).South
                                IF (c <> -1) THEN
                                    c = DeleteNodesRecur(c)
                                END IF
                                Nodes(a).South = b
                                Nodes(b).North = a
                                EXIT FOR
                            END IF
                        END IF
                    NEXT
                ELSE
                    IF (SelectionIndex(1) <> -1) THEN
                        SELECT CASE Nodes(VisualNodes(SelectionIndex(1)).Reference).Species
                            CASE "integer"
                                a = InsertSouth(VisualNodes(SelectionIndex(1)).Reference, NewIntegerNode(0))
                            CASE "text"
                                a = InsertSouth(VisualNodes(SelectionIndex(1)).Reference, NewTextNode("s"))
                            CASE "double"
                                a = InsertSouth(VisualNodes(SelectionIndex(1)).Reference, NewDoubleNode(0))
                        END SELECT
                    END IF
                END IF
                CALL BuildAllVisualArrays
            CASE ASC("x"), ASC("X")
                IF (SelectionIndex(1) <> -1) THEN
                    _KEYCLEAR
                    LOCATE (_HEIGHT / 16) / 2, (_WIDTH / 8) / 2 - 8
                    PRINT "Enter new value:" '+ CHR$(10) + SPACE$(20);
                    LOCATE (_HEIGHT / 16) / 2 + 1, (_WIDTH / 8) / 2 - 8
                    LINE INPUT t
                    SELECT CASE Nodes(VisualNodes(SelectionIndex(1)).Reference).Species
                        CASE "integer"
                            Nodes(VisualNodes(SelectionIndex(1)).Reference).Reference = NewIntegerData(INT(VAL(t)))
                        CASE "text"
                            a = VisualNodes(SelectionIndex(1)).Reference
                            Nodes(a).Reference = NewTextData(t)
                            FOR k = 1 TO UBOUND(SoftArrayRegister)
                                IF (SoftArrayRegister(k) <> -1) THEN
                                    IF (SoftArray(k).HeadNode = a) THEN
                                        SoftArray(k).Label = t
                                    END IF
                                END IF
                            NEXT
                        CASE "double"
                            Nodes(VisualNodes(SelectionIndex(1)).Reference).Reference = NewDoubleData(VAL(t))
                    END SELECT
                    CALL DefineVisualNode(SelectionIndex(1), VisualNodes(SelectionIndex(1)).Reference, VisualNodes(SelectionIndex(1)).BoxCenter.x, VisualNodes(SelectionIndex(1)).BoxCenter.y)
                    CALL BuildAllVisualArrays
                END IF
        END SELECT
 
        ' Display-changing.
 
        KeyIn = INKEY$
 
        SELECT CASE LCASE$(KeyIn)
            CASE CHR$(10) ' Ctrl+J
                OPEN "SoftArrays-" + LTRIM$(RTRIM$(STR$(INT(10 * TIMER)))) + ".txt" FOR OUTPUT AS #1
                PRINT #1, PrintJSON$(1)
                CLOSE #1
                CALL UserMain(2, 0, 0)
        END SELECT
 
        SELECT CASE kh
            CASE 18688 ' pgup
                CALL MoveAllVisualNodes(0, -.9 * _HEIGHT / 2)
                ScrollPosition.y = ScrollPosition.y - .9 * _HEIGHT / 2
            CASE 20736 ' pgdn
                CALL MoveAllVisualNodes(0, .9 * _HEIGHT / 2)
                ScrollPosition.y = ScrollPosition.y + .9 * _HEIGHT / 2
            CASE ASC("m"), ASC("M")
                CLS
                PRINT MemoryProbe$("")
                CALL Halt
            CASE ASC("l"), ASC("L")
                IF (CtrlKey = 1) THEN
                    OPEN "SoftArrays-" + LTRIM$(RTRIM$(STR$(INT(10 * TIMER)))) + ".txt" FOR OUTPUT AS #1
                    PRINT #1, PrintMultiSoftArrays$(1)
                    CLOSE #1
                END IF
                CALL UserMain(1, 0, 0)
            CASE ASC("j"), ASC("J")
                CALL UserMain(2, 0, 0)
            CASE ELSE
        END SELECT
 
        _KEYCLEAR
 
        IF (_RESIZE = -1) THEN
            IF ((_RESIZEWIDTH > 320) AND (_RESIZEHEIGHT > 240)) THEN
                _DELAY .01
                ScreenHandleTemp = ScreenHandle
                ScreenHandle = _NEWIMAGE(_RESIZEWIDTH, _RESIZEHEIGHT, 32)
                SCREEN ScreenHandle
                _FREEIMAGE ScreenHandleTemp
            END IF
        END IF
 
        CLS
 
        CALL DrawAllVisualNodes(AltWires)
 
        IF (i <> -1) THEN
            IF (VisualNodes(i).Reference <> -1) THEN
                CALL DrawSingleNode(i, _RGBA(255, 25, 50, 255), _RGBA(255, 255, 0, 255))
            END IF
        END IF
 
        COLOR _RGBA(200, 200, 200, 255)
        CALL lprintstring(1, 3, "Selection history:")
        FOR k = 1 TO UBOUND(SelectionIndex)
            IF (SelectionIndex(k) <> -1) THEN
                IF (VisualNodes(SelectionIndex(k)).Reference <> -1) THEN
                    CALL lprintstring(1, 3 + k, LTRIM$(RTRIM$(STR$(k))) + ") " + Literal$(VisualNodes(SelectionIndex(k)).Reference) + " (@ " + LTRIM$(RTRIM$(STR$(VisualNodes(SelectionIndex(k)).Reference))) + ")")
                END IF
            END IF
        NEXT
 
        COLOR _RGBA(200, 200, 200, 255)
        i = UBOUND(SelectionIndex) + 4
        i = i + 1: CALL lprintstring(1, i, "Mouse:")
        i = i + 1: CALL lprintstring(1, i, "  Point  = highlight")
        i = i + 1: CALL lprintstring(1, i, "  MB1    = select")
        i = i + 1: CALL lprintstring(1, i, "  MB2    = drag")
        i = i + 1: CALL lprintstring(1, i, "Soft arrays:")
        i = i + 1: CALL lprintstring(1, i, "  I      = new integer")
        i = i + 1: CALL lprintstring(1, i, "  T      = new text")
        i = i + 1: CALL lprintstring(1, i, "  D      = new double")
        i = i + 1: CALL lprintstring(1, i, "  C      = copy recur")
        i = i + 1: CALL lprintstring(1, i, "  Delete = delete")
        i = i + 1: CALL lprintstring(1, i, "  V      = sever")
        i = i + 1: CALL lprintstring(1, i, "  Ctrl+S = mov (1)s(2)")
        i = i + 1: CALL lprintstring(1, i, "  Ctrl+E = mov (1)e(2)")
        i = i + 1: CALL lprintstring(1, i, "  Enter  = evaluate")
        i = i + 1: CALL lprintstring(1, i, "Nodes:")
        i = i + 1: CALL lprintstring(1, i, "  E      = append east")
        i = i + 1: CALL lprintstring(1, i, "  S      = append south")
        i = i + 1: CALL lprintstring(1, i, "  X      = edit content")
        i = i + 1: CALL lprintstring(1, i, "  Ctrl+I = to integer")
        i = i + 1: CALL lprintstring(1, i, "  Ctrl+T = to text")
        i = i + 1: CALL lprintstring(1, i, "  Ctrl+D = to double")
        i = i + 1: CALL lprintstring(1, i, "Report:")
        i = i + 1: CALL lprintstring(1, i, "  L      = print all")
        i = i + 1: CALL lprintstring(1, i, "  J      = print JSON")
        i = i + 1: CALL lprintstring(1, i, "  Ctrl+L = write file")
        COLOR _RGBA(255, 100, 155, 255)
        i = i + 1: CALL lprintstring(1, i, "  Ctrl+J = write JSON")
        COLOR _RGBA(200, 200, 200, 255)
        i = i + 1: CALL lprintstring(1, i, "  M      = mem probe")
        i = i + 1: CALL lprintstring(1, i, "  W      = all wires")
 
 
        CALL rprintstring(3, "Scroll position:")
        CALL rprintstring(4, "(" + LTRIM$(RTRIM$(STR$(INT(ScrollPosition.x)))) + "," + LTRIM$(RTRIM$(STR$(INT(ScrollPosition.y)))) + ")")
 
        COLOR _RGBA(255, 100, 255, 255)
        CALL cprintstring(_HEIGHT / 2, "--Soft Array Editor--")
        CALL cprintstring(-_HEIGHT / 2 + 16, "Press ESC to continue.")
        COLOR _RGBA(255, 255, 255, 255)
 
        _DISPLAY
 
        _LIMIT 30
    LOOP
 
END SUB
 
SUB Halt
    _DELAY .01
    _KEYCLEAR
    DO: LOOP WHILE _MOUSEINPUT
    COLOR _RGBA(255, 255, 100, 255)
    PRINT "Press any key..."
    COLOR _RGBA(255, 255, 255, 255)
    _DISPLAY
    DO: LOOP UNTIL INKEY$ <> ""
    CLS
    _DISPLAY
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Visual Nodes
'
 
SUB DefineVisualNode (i AS INTEGER, x AS LONG, cx AS DOUBLE, cy AS DOUBLE)
    DIM h AS DOUBLE
    DIM w AS DOUBLE
    h = 22
    w = 12 + 8 * LEN(Literal$(x))
    VisualNodes(i).Reference = x
    VisualNodes(i).BoxCenter.x = cx
    VisualNodes(i).BoxCenter.y = cy
    VisualNodes(i).BoxHeight = h
    VisualNodes(i).BoxWidth = w
    VisualNodes(i).CornerNE.x = cx + .5 * w
    VisualNodes(i).CornerNE.y = cy + .5 * h
    VisualNodes(i).CornerNW.x = cx - .5 * w
    VisualNodes(i).CornerNW.y = cy + .5 * h
    VisualNodes(i).CornerSE.x = cx + .5 * w
    VisualNodes(i).CornerSE.y = cy - .5 * h
    VisualNodes(i).CornerSW.x = cx - .5 * w
    VisualNodes(i).CornerSW.y = cy - .5 * h
    VisualNodes(i).AntennaN.x = cx
    VisualNodes(i).AntennaN.y = cy + .5 * h + 3
    VisualNodes(i).AntennaS.x = cx
    VisualNodes(i).AntennaS.y = cy - .5 * h - 3
    VisualNodes(i).AntennaE.x = cx + .5 * w + 3
    VisualNodes(i).AntennaE.y = cy
    VisualNodes(i).AntennaW.x = cx - .5 * w - 3
    VisualNodes(i).AntennaW.y = cy
END SUB
 
FUNCTION VisualNodeIndexFromReference (x AS LONG)
    DIM TheReturn AS INTEGER
    DIM j AS INTEGER
    TheReturn = -1
    FOR j = 1 TO VisualNodesCount
        IF (VisualNodes(j).Reference = x) THEN
            TheReturn = j
            EXIT FOR
        END IF
    NEXT
    VisualNodeIndexFromReference = TheReturn
END FUNCTION
 
SUB BuildAllVisualArrays
    DIM k AS LONG
    DIM y0 AS DOUBLE
    VisualNodesCount = 0
    y0 = Origin.y + ScrollPosition.y
    FOR k = UBOUND(SoftArrayRegister) TO 1 STEP -1
        IF (SoftArrayRegister(k) <> -1) THEN
            CALL BuildVisualArray(SoftArray(k).HeadNode, Origin.x + ScrollPosition.x, y0)
            y0 = y0 - 30
        END IF
    NEXT
END SUB
 
SUB BuildVisualArray (x AS LONG, x0 AS DOUBLE, y0 AS DOUBLE)
    DIM s AS LONG
    DIM e AS LONG
    DIM dxtmp AS DOUBLE
    s = Nodes(x).South
    e = Nodes(x).East
    VisualNodesCount = VisualNodesCount + 1
    CALL DefineVisualNode(VisualNodesCount, x, x0, y0)
    y0 = y0 - 30
    IF (e <> -1) THEN
        dxtmp = 8 * .5 * (LEN(Literal$(x)) + LEN(Literal$(e)))
        IF (dxtmp < 30) THEN dxtmp = 30
        CALL BuildVisualArray(e, x0 + dxtmp, y0)
    END IF
    IF (s <> -1) THEN
        CALL BuildVisualArray(s, x0, y0)
    END IF
END SUB
 
SUB MoveAllVisualNodes (dx AS DOUBLE, dy AS DOUBLE)
    DIM k AS INTEGER
    FOR k = 1 TO VisualNodesCount
        CALL MoveSingleVisualNode(k, dx, dy)
    NEXT
END SUB
 
SUB MoveVisualNodesRecur (i AS INTEGER, x AS LONG, dx AS DOUBLE, dy AS DOUBLE)
    DIM s AS LONG
    DIM e AS LONG
    DIM k AS INTEGER
    DIM f AS INTEGER
    s = Nodes(x).South
    e = Nodes(x).East
    IF (e <> -1) THEN
        f = 0
        FOR k = 1 TO VisualNodesCount
            IF (VisualNodes(k).Reference = e) THEN
                f = 1
                EXIT FOR
            END IF
        NEXT
        IF (f = 1) THEN
            CALL MoveVisualNodesRecur(k, e, dx, dy)
        END IF
    END IF
    IF (s <> -1) THEN
        f = 0
        FOR k = 1 TO VisualNodesCount
            IF (VisualNodes(k).Reference = s) THEN
                f = 1
                EXIT FOR
            END IF
        NEXT
        IF (f = 1) THEN
            CALL MoveVisualNodesRecur(k, s, dx, dy)
        END IF
    END IF
    CALL MoveSingleVisualNode(i, dx, dy)
END SUB
 
SUB MoveSingleVisualNode (i AS INTEGER, dx AS DOUBLE, dy AS DOUBLE)
    CALL DefineVisualNode(i, VisualNodes(i).Reference, VisualNodes(i).BoxCenter.x + dx, VisualNodes(i).BoxCenter.y + dy)
END SUB
 
SUB DrawAllVisualNodes (i AS INTEGER)
    DIM k AS INTEGER
    FOR k = 1 TO VisualNodesCount
        CALL DrawWiresSE(k)
        IF (i = 1) THEN
            CALL DrawWiresNW(k)
        END IF
        SELECT CASE Nodes(VisualNodes(k).Reference).Species
            CASE "integer"
                CALL DrawSingleNode(k, _RGBA(255, 255, 255, 255), _RGBA(155, 55, 55, 255))
            CASE "text"
                CALL DrawSingleNode(k, _RGBA(255, 255, 255, 255), _RGBA(55, 155, 55, 255))
            CASE "double"
                CALL DrawSingleNode(k, _RGBA(255, 255, 255, 255), _RGBA(55, 55, 155, 255))
            CASE ELSE
                CALL DrawSingleNode(k, _RGBA(255, 255, 255, 255), _RGBA(55, 55, 55, 255))
        END SELECT
    NEXT
END SUB
 
SUB DrawSingleNode (x AS LONG, c1 AS _UNSIGNED LONG, c2 AS _UNSIGNED LONG)
    CALL clinebf(VisualNodes(x).CornerNE.x, VisualNodes(x).CornerNE.y, VisualNodes(x).CornerSW.x, VisualNodes(x).CornerSW.y, c2)
    COLOR c1, c2
    CALL bprintstring(VisualNodes(x).CornerNW.x + 6, VisualNodes(x).CornerNW.y - 4, Literal$(VisualNodes(x).Reference))
    CALL clineb(VisualNodes(x).CornerNE.x + 0, VisualNodes(x).CornerNE.y + 0, VisualNodes(x).CornerSW.x - 0, VisualNodes(x).CornerSW.y - 0, _RGB32(155, 155, 155, 255))
    COLOR _RGBA(255, 255, 255, 255), 0
END SUB
 
SUB DrawWiresSE (x AS INTEGER)
    DIM i AS LONG
    DIM k AS INTEGER
    DIM s AS LONG
    DIM e AS LONG
    i = VisualNodes(x).Reference
    s = Nodes(i).South
    e = Nodes(i).East
    IF (s <> -1) THEN
        k = VisualNodeIndexFromReference(s)
        CALL cline(VisualNodes(x).AntennaS.x, VisualNodes(x).AntennaS.y, VisualNodes(k).BoxCenter.x, VisualNodes(k).BoxCenter.y, _RGBA(155, 155, 155, 255))
        CALL ccircle(VisualNodes(x).AntennaS.x, VisualNodes(x).AntennaS.y, 3, _RGBA(155, 155, 155, 255))
    END IF
    IF (e <> -1) THEN
        k = VisualNodeIndexFromReference(e)
        CALL cline(VisualNodes(x).AntennaE.x, VisualNodes(x).AntennaE.y, VisualNodes(k).BoxCenter.x, VisualNodes(k).BoxCenter.y, _RGBA(155, 155, 155, 255))
        CALL ccircle(VisualNodes(x).AntennaE.x, VisualNodes(x).AntennaE.y, 3, _RGBA(155, 155, 155, 255))
    END IF
END SUB
 
SUB DrawWiresNW (x AS INTEGER)
    DIM i AS LONG
    DIM k AS INTEGER
    DIM n AS LONG
    DIM w AS LONG
    i = VisualNodes(x).Reference
    n = Nodes(i).North
    w = Nodes(i).West
    IF (n <> -1) THEN
        k = VisualNodeIndexFromReference(n)
        CALL cline(VisualNodes(x).AntennaN.x, VisualNodes(x).AntennaN.y, VisualNodes(k).BoxCenter.x, VisualNodes(k).BoxCenter.y, _RGBA(255, 55, 55, 255))
        CALL ccircle(VisualNodes(x).AntennaN.x, VisualNodes(x).AntennaN.y, 3, _RGBA(255, 55, 55, 255))
    END IF
    IF (w <> -1) THEN
        k = VisualNodeIndexFromReference(w)
        CALL cline(VisualNodes(x).AntennaW.x, VisualNodes(x).AntennaW.y, VisualNodes(k).BoxCenter.x, VisualNodes(k).BoxCenter.y, _RGBA(255, 55, 55, 255))
        CALL ccircle(VisualNodes(x).AntennaW.x, VisualNodes(x).AntennaW.y, 3, _RGBA(255, 55, 55, 255))
    END IF
END SUB
 
FUNCTION MouseOver (x0 AS DOUBLE, y0 AS DOUBLE)
    DIM TheReturn AS INTEGER
    DIM k AS INTEGER
    TheReturn = -1
    FOR k = 1 TO VisualNodesCount
        IF (x0 > VisualNodes(k).BoxCenter.x - VisualNodes(k).BoxWidth / 2) AND (x0 < VisualNodes(k).BoxCenter.x + VisualNodes(k).BoxWidth / 2) THEN
            IF (y0 > VisualNodes(k).BoxCenter.y - VisualNodes(k).BoxHeight / 2) AND (y0 < VisualNodes(k).BoxCenter.y + VisualNodes(k).BoxHeight / 2) THEN
                TheReturn = k
                EXIT FOR
            END IF
        END IF
    NEXT
    MouseOver = TheReturn
END FUNCTION
 
SUB NewSelection (x AS INTEGER)
    DIM k AS INTEGER
    IF (SelectionIndex(1) <> x) THEN
        FOR k = UBOUND(SelectionIndex) TO 2 STEP -1
            SelectionIndex(k) = SelectionIndex(k - 1)
        NEXT
        SelectionIndex(1) = x
    END IF
END SUB
 
FUNCTION ClearSelections (x AS INTEGER)
    DIM TheReturn AS INTEGER
    DIM k AS INTEGER
    FOR k = x TO UBOUND(SelectionIndex)
        SelectionIndex(k) = -1
    NEXT
    TheReturn = -1
    ClearSelections = TheReturn
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Cartesian graphics
'
 
SUB cline (x1 AS DOUBLE, y1 AS DOUBLE, x2 AS DOUBLE, y2 AS DOUBLE, col AS _UNSIGNED LONG)
    LINE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)-(_WIDTH / 2 + x2, -y2 + _HEIGHT / 2), col
END SUB
 
SUB clineb (x1 AS DOUBLE, y1 AS DOUBLE, x2 AS DOUBLE, y2 AS DOUBLE, col AS _UNSIGNED LONG)
    LINE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)-(_WIDTH / 2 + x2, -y2 + _HEIGHT / 2), col, B
END SUB
 
SUB clinebf (x1 AS DOUBLE, y1 AS DOUBLE, x2 AS DOUBLE, y2 AS DOUBLE, col AS _UNSIGNED LONG)
    LINE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)-(_WIDTH / 2 + x2, -y2 + _HEIGHT / 2), col, BF
END SUB
 
SUB ccircle (x1 AS DOUBLE, y1 AS DOUBLE, rad AS DOUBLE, col AS _UNSIGNED LONG)
    CIRCLE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), rad, col
END SUB
 
SUB cpset (x1 AS DOUBLE, y1 AS DOUBLE, col AS _UNSIGNED LONG)
    PSET (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), col
END SUB
 
SUB cpaint (x1 AS DOUBLE, y1 AS DOUBLE, col1 AS _UNSIGNED LONG, col2 AS _UNSIGNED LONG)
    PAINT (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), col1, col2
END SUB
 
SUB bprintstring (x1 AS DOUBLE, y1 AS DOUBLE, a AS STRING)
    _PRINTSTRING (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), a
END SUB
 
SUB cprintstring (y1 AS DOUBLE, a AS STRING)
    _PRINTSTRING (_WIDTH / 2 - (LEN(a) * 8) / 2, -y1 + _HEIGHT / 2), a
END SUB
 
SUB lprintstring (x1 AS DOUBLE, y1 AS DOUBLE, a AS STRING)
    'LOCATE y1, x1: PRINT a
    _PRINTSTRING ((x1 - 1) * 8, (y1 - 1) * 16), a
END SUB
 
SUB rprintstring (y1 AS DOUBLE, a AS STRING)
    _PRINTSTRING (_WIDTH - (LEN(a) * 8), (y1 - 1) * 16), a
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' End GUI/Graphical component (optional)
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'REM $Include: 'SoftArrays.bm'
 
 
 
 
 
 
 
 
 
 
'REM $Include: 'SoftArrays.bi'
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Begin BM-component.
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Processing
'
 
FUNCTION EvalMultiSoftArrays (x AS INTEGER)
    DIM TheReturn AS LONG
    DIM k AS INTEGER
    FOR k = x TO UBOUND(SoftArrayRegister)
        IF (SoftArrayRegister(k) <> -1) THEN
            TheReturn = Evaluate(SoftArray(k).HeadNode)
        END IF
    NEXT
    EvalMultiSoftArrays = TheReturn
END FUNCTION
 
FUNCTION Evaluate (x AS LONG)
    DIM TheReturn AS LONG
    DIM a AS LONG
    DIM b AS LONG
    a = x
    b = -1
    DO
        a = EvalStep(FirstEmbedded(a))
        IF (a = x) THEN EXIT DO
        IF (a = b) THEN
            IF (a = -1) THEN EXIT DO
            a = Nodes(a).South
            IF (a = -1) THEN EXIT DO
        ELSE
            b = a
        END IF
    LOOP
    TheReturn = a
    Evaluate = TheReturn
END SUB
 
FUNCTION EvalStep (x AS LONG)
    DIM TheReturn AS LONG
    DIM SouthernId AS LONG
    DIM NorthernId AS LONG
    DIM FunctionId AS LONG
    DIM i AS LONG
    DIM j AS LONG
    DIM k AS INTEGER
    DIM n AS LONG
    DIM s AS LONG
    DIM RefSpecies AS STRING
    DIM ReturnSpecies AS STRING
    DIM ReturnInteger AS INTEGER
    DIM ReturnText AS STRING
    DIM ReturnDouble AS DOUBLE
    DIM MultiPass AS INTEGER
 
    RefSpecies = ""
    FunctionId = x
    ReturnSpecies = ""
    ReturnInteger = 0
    ReturnText = ""
    ReturnDouble = 0
 
    ' Pre-evaluation
    IF (x <> -1) THEN
        SouthernId = x
        i = x
        DO
            n = Nodes(i).North
            IF (n <> -1) THEN
                i = n
            ELSE
                NorthernId = i
                EXIT DO
            END IF
        LOOP
        FunctionId = Nodes(NorthernId).West
        IF (FunctionId <> -1) THEN
            ReturnSpecies = Nodes(FunctionId).Species
            SELECT CASE ReturnSpecies
                CASE "integer"
                    ReturnInteger = IntegerData(Nodes(FunctionId).Reference)
                CASE "text"
                    ReturnText = TextData(Nodes(FunctionId).Reference)
                CASE "double"
                    ReturnDouble = DoubleData(Nodes(FunctionId).Reference)
            END SELECT
        END IF
    END IF
 
    ' Lambda substitution
    i = NorthernId
    DIM lf AS INTEGER
    lf = 0
    DO
        IF (Nodes(i).Species = "text") THEN
            IF (TextData(Nodes(i).Reference) = "[1]") THEN
                j = LambdaMatrix(LambdaIndex, 1)
                Nodes(i).Species = Nodes(j).Species
                Nodes(i).Reference = Nodes(j).Reference
                lf = 1
            END IF
            IF (TextData(Nodes(i).Reference) = "[2]") THEN
                j = LambdaMatrix(LambdaIndex, 2)
                Nodes(i).Species = Nodes(j).Species
                Nodes(i).Reference = Nodes(j).Reference
                lf = 1
            END IF
        END IF
        IF (i = SouthernId) THEN
            EXIT DO
        ELSE
            s = Nodes(i).South
            i = s
        END IF
    LOOP
    IF (lf = 1) THEN
        FOR k = 1 TO LambdaArgCount(LambdaIndex)
            j = Unlink(LambdaMatrix(LambdaIndex, k))
        NEXT
        LambdaArgCount(LambdaIndex) = 0
        LambdaIndex = LambdaIndex - 1
    END IF
 
    ' Determine return species
    i = NorthernId
    DO
        IF (i = -1) THEN EXIT DO
        IF (Nodes(i).Species = "text") THEN RefSpecies = "text"
        IF ((Nodes(i).Species = "double") AND (RefSpecies <> "text")) THEN RefSpecies = "double"
        IF ((Nodes(i).Species = "integer") AND (RefSpecies <> "text") AND (RefSpecies <> "double")) THEN RefSpecies = "integer"
        i = Nodes(i).South
    LOOP
 
    ' Single-pass evaluation
    MultiPass = 0
    SELECT CASE Literal$(FunctionId)
        CASE "*"
            MultiPass = 1
            ReturnSpecies = RefSpecies
            ReturnInteger = 1
            ReturnDouble = 1
        CASE "+"
            MultiPass = 1
            ReturnSpecies = RefSpecies
            ReturnInteger = 0
            ReturnDouble = 0
        CASE "/"
            MultiPass = 0
            SELECT CASE Nodes(NorthernId).Species
                CASE "integer"
                    ReturnSpecies = "double"
                    SELECT CASE Nodes(SouthernId).Species
                        CASE "integer"
                            ReturnDouble = IntegerData(Nodes(NorthernId).Reference) / IntegerData(Nodes(SouthernId).Reference)
                        CASE "double"
                            ReturnDouble = IntegerData(Nodes(NorthernId).Reference) / DoubleData(Nodes(SouthernId).Reference)
                    END SELECT
                CASE "text"
                    ReturnSpecies = "text"
                    ReturnText = Literal$(NorthernId) + "/" + Literal$(SouthernId)
                CASE "double"
                    ReturnSpecies = "double"
                    SELECT CASE Nodes(SouthernId).Species
                        CASE "integer"
                            ReturnDouble = DoubleData(Nodes(NorthernId).Reference) / IntegerData(Nodes(SouthernId).Reference)
                        CASE "double"
                            ReturnDouble = DoubleData(Nodes(NorthernId).Reference) / DoubleData(Nodes(SouthernId).Reference)
                    END SELECT
            END SELECT
            i = Unlink(NorthernId)
            i = Unlink(SouthernId)
        CASE "cos"
            IF (NorthernId = SouthernId) THEN
                MultiPass = 0
                i = NorthernId
                SELECT CASE Nodes(i).Species
                    CASE "integer"
                        ReturnSpecies = "double"
                        ReturnDouble = COS(IntegerData(Nodes(i).Reference))
                    CASE "text"
                        ReturnSpecies = "text"
                        ReturnText = "cos" + "(" + Literal$(i) + ")"
                    CASE "double"
                        ReturnSpecies = "double"
                        ReturnDouble = COS(DoubleData(Nodes(i).Reference))
                END SELECT
                i = Unlink(i)
            ELSE
                MultiPass = 1
                ReturnSpecies = "text"
                ReturnText = "(" + "cos" + ")"
            END IF
        CASE "lambda"
            MultiPass = 1
            LambdaIndex = LambdaIndex + 1
            ReturnSpecies = "text"
            ReturnText = "(" + "lambda" + ")"
        CASE "(" + "lambda" + ")"
            '
    END SELECT
 
    ' Multi-pass evaluation
    IF (MultiPass = 1) THEN
        i = NorthernId
        DO
            SELECT CASE Literal$(FunctionId)
                CASE "*"
                    SELECT CASE ReturnSpecies
                        CASE "integer"
                            SELECT CASE Nodes(i).Species
                                CASE "integer"
                                    ReturnInteger = ReturnInteger * IntegerData(Nodes(i).Reference)
                                CASE "double"
                                    ReturnInteger = ReturnInteger * DoubleData(Nodes(i).Reference)
                            END SELECT
                        CASE "text"
                            ReturnText = ReturnText + Literal$(i)
                        CASE "double"
                            SELECT CASE Nodes(i).Species
                                CASE "integer"
                                    ReturnDouble = ReturnDouble * IntegerData(Nodes(i).Reference)
                                CASE "double"
                                    ReturnDouble = ReturnDouble * DoubleData(Nodes(i).Reference)
                            END SELECT
                    END SELECT
                    IF (i = SouthernId) THEN
                        i = Unlink(i)
                        EXIT DO
                    ELSE
                        s = Nodes(i).South
                        i = Unlink(i)
                        i = s
                    END IF
                CASE "+"
                    SELECT CASE ReturnSpecies
                        CASE "integer"
                            SELECT CASE Nodes(i).Species
                                CASE "integer"
                                    ReturnInteger = ReturnInteger + IntegerData(Nodes(i).Reference)
                                CASE "double"
                                    ReturnInteger = ReturnInteger + DoubleData(Nodes(i).Reference)
                            END SELECT
                        CASE "text"
                            ReturnText = ReturnText + Literal$(i)
                        CASE "double"
                            SELECT CASE Nodes(i).Species
                                CASE "integer"
                                    ReturnDouble = ReturnDouble + IntegerData(Nodes(i).Reference)
                                CASE "double"
                                    ReturnDouble = ReturnDouble + DoubleData(Nodes(i).Reference)
                            END SELECT
                    END SELECT
                    IF (i = SouthernId) THEN
                        i = Unlink(i)
                        EXIT DO
                    ELSE
                        s = Nodes(i).South
                        i = Unlink(i)
                        i = s
                    END IF
                CASE "cos"
                    SELECT CASE Nodes(i).Species
                        CASE "integer"
                            Nodes(i).Species = "double"
                            Nodes(i).Reference = NewDoubleData(COS(IntegerData(Nodes(i).Reference)))
                        CASE "text"
                            Nodes(i).Reference = NewTextData("cos" + "(" + Literal$(i) + ")")
                        CASE "double"
                            Nodes(i).Species = "double"
                            Nodes(i).Reference = NewDoubleData(COS(DoubleData(Nodes(i).Reference)))
                    END SELECT
                    IF (i = SouthernId) THEN
                        EXIT DO
                    ELSE
                        s = Nodes(i).South
                        i = s
                    END IF
                CASE "lambda"
                    LambdaArgCount(LambdaIndex) = LambdaArgCount(LambdaIndex) + 1
                    LambdaMatrix(LambdaIndex, LambdaArgCount(LambdaIndex)) = i
                    IF (i = SouthernId) THEN
                        EXIT DO
                    ELSE
                        s = Nodes(i).South
                        i = s
                    END IF
            END SELECT
        LOOP
    END IF
 
    SELECT CASE ReturnSpecies
        CASE "integer"
            Nodes(FunctionId).Species = ReturnSpecies
            Nodes(FunctionId).Reference = NewIntegerData(ReturnInteger)
        CASE "text"
            Nodes(FunctionId).Species = ReturnSpecies
            Nodes(FunctionId).Reference = NewTextData(ReturnText)
        CASE "double"
            Nodes(FunctionId).Species = ReturnSpecies
            Nodes(FunctionId).Reference = NewDoubleData(ReturnDouble)
    END SELECT
 
    TheReturn = FunctionId
    EvalStep = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Eval helper functions
'
 
FUNCTION FirstEmbedded (x AS LONG)
    DIM TheReturn AS LONG
    TheReturn = MostEmbeddedRecur(x, -1)
    FirstEmbedded = TheReturn
END FUNCTION
 
FUNCTION MostEmbeddedRecur (x AS LONG, y AS LONG)
    DIM TheReturn AS LONG
    DIM s AS LONG
    DIM e AS LONG
    s = Nodes(x).South
    e = Nodes(x).East
    IF (e <> -1) THEN
        TheReturn = MostEmbeddedRecur(e, y)
    END IF
    IF (s <> -1) THEN
        TheReturn = MostEmbeddedRecur(s, y)
    END IF
    IF ((e = -1) AND (s = -1) AND (y = -1)) THEN
        y = x
    END IF
    TheReturn = y
    MostEmbeddedRecur = TheReturn
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Programmer-friendly functions
'
 
FUNCTION SoftArrayID (t AS STRING)
    '
    ' Inputs a soft array label and returns the node address.
    '
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = 1 TO UBOUND(SoftArray)
        IF (SoftArray(k).Label = t) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    SoftArrayID = TheReturn
END FUNCTION
 
FUNCTION SeekText (t AS STRING, x AS LONG, r AS INTEGER)
    DIM TheReturn AS LONG
    DIM s AS LONG
    DIM e AS LONG
    TheReturn = -1
    s = Nodes(x).South
    e = Nodes(x).East
    IF (TextData(Nodes(x).Reference) = t) THEN
        TheReturn = x
        r = r - 1
    ELSE
        IF ((e <> -1) AND (r > 0)) THEN
            TheReturn = SeekText(t, e, r)
        END IF
        IF ((s <> -1) AND (r > 0)) THEN
            TheReturn = SeekText(t, s, r)
        END IF
    END IF
    SeekText = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Navigation
'
FUNCTION JumpFrom (x AS LONG, t AS STRING, r AS INTEGER)
    DIM TheReturn AS LONG
    TheReturn = x
    IF (r > 0) THEN
        SELECT CASE t
            CASE "n"
                TheReturn = JumpFrom(Nodes(x).North, "n", r - 1)
            CASE "s"
                TheReturn = JumpFrom(Nodes(x).South, "s", r - 1)
            CASE "e"
                TheReturn = JumpFrom(Nodes(x).East, "e", r - 1)
            CASE "w"
                TheReturn = JumpFrom(Nodes(x).West, "w", r - 1)
        END SELECT
    END IF
    JumpFrom = TheReturn
END FUNCTION
 
FUNCTION StepFromUsing (x AS LONG, t AS STRING)
    DIM TheReturn AS LONG
    DIM i AS LONG
    DIM j AS LONG
    DIM k AS INTEGER
    i = x
    FOR k = 1 TO LEN(t)
        SELECT CASE MID$(t, k, 1)
            CASE "n"
                j = Nodes(i).North
                IF (j <> -1) THEN i = j
            CASE "s"
                j = Nodes(i).South
                IF (j <> -1) THEN i = j
            CASE "e"
                j = Nodes(i).East
                IF (j <> -1) THEN i = j
            CASE "w"
                j = Nodes(i).West
                IF (j <> -1) THEN i = j
        END SELECT
    NEXT
    TheReturn = i
    StepFromUsing = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Internal metrics
'
FUNCTION Measure (x AS LONG, t AS STRING)
    '
    ' A simpler version of CountSteps that looks for -1.
    '
    DIM TheReturn AS INTEGER
    TheReturn = CountSteps(x, -1, t)
    Measure = TheReturn
END FUNCTION
 
FUNCTION CountSteps (x AS LONG, y AS LONG, t AS STRING)
    DIM TheReturn AS INTEGER
    DIM k AS LONG
    TheReturn = 0
    SELECT CASE t
        CASE "n"
            k = Nodes(x).North
        CASE "s"
            k = Nodes(x).South
        CASE "e"
            k = Nodes(x).East
        CASE "w"
            k = Nodes(x).West
    END SELECT
    IF (k = y) THEN
        TheReturn = TheReturn + 1
    ELSE
        IF (k <> -1) THEN
            TheReturn = TheReturn + 1 + CountSteps(k, y, t)
        END IF
    END IF
    CountSteps = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Printing and Reporting
'
 
FUNCTION PrintJSON$ (x AS LONG)
    DIM TheReturn AS STRING
    DIM t AS STRING
    't = Literal$(x) + " = {" + CHR$(10) + WriteJSONRecur$(1, Nodes(x).East) + "}"
    t = "{" + CHR$(10) + WriteJSONRecur$(0, Nodes(x).East) + "}"
    TheReturn = t
    PrintJSON$ = TheReturn
END SUB
 
FUNCTION WriteJSONRecur$ (i AS INTEGER, x AS LONG)
    DIM TheReturn AS STRING
    DIM ThisLiteral AS STRING
    DIM n AS LONG
    DIM s AS LONG
    DIM e AS LONG
    DIM w AS LONG
    DIM lb AS STRING
    DIM rb AS STRING
    DIM lq AS STRING
    DIM rq AS STRING
 
    ThisLiteral = LiteralJSON$(x)
    n = Nodes(x).North
    s = Nodes(x).South
    e = Nodes(x).East
    w = Nodes(x).West
    lb = ""
    rb = ""
    lq = ""
    rq = ""
 
    IF (Literal$(x) = "[]") THEN
        lb = "["
        rb = Filler$(i, "  ") + "]" + CHR$(10)
        ThisLiteral = lb
    END IF
 
    IF (Literal$(x) = "{}") THEN
        lq = "{"
        rq = Filler$(i, "  ") + "}"
        ThisLiteral = lq
        IF (s <> -1) THEN rq = rq + ","
        rq = rq + CHR$(10)
    END IF
 
    ThisLiteral = Filler$(i, "  ") + ThisLiteral
 
    IF (e <> -1) THEN
        IF (Nodes(e).East = -1) THEN ThisLiteral = ThisLiteral + ":"
    END IF
    IF (n <> -1) AND (s <> -1) AND (e = -1) AND (w = -1) THEN ThisLiteral = ThisLiteral + ","
    IF (n = -1) AND (s = -1) AND (e = -1) AND (w <> -1) THEN ThisLiteral = ThisLiteral + ","
 
    TheReturn = TheReturn + ThisLiteral + CHR$(10)
 
    IF (e <> -1) THEN
        TheReturn = TheReturn + WriteJSONRecur$(i + 1, e) + rq
    END IF
    IF (s <> -1) THEN
        TheReturn = TheReturn + WriteJSONRecur$(i, s) + rb
    END IF
 
    WriteJSONRecur$ = TheReturn
END FUNCTION
 
FUNCTION MemoryProbe$ (t AS STRING)
    DIM TheReturn AS STRING
    DIM a AS LONG
    DIM k AS INTEGER
    TheReturn = t
    TheReturn = TheReturn + "Begin memory probe..." + CHR$(10)
    TheReturn = TheReturn + "Soft arrays:" + CHR$(10)
    FOR k = 1 TO UBOUND(SoftArrayRegister)
        IF (SoftArrayRegister(k) <> -1) THEN
            TheReturn = TheReturn + "  " + SoftArray(k).Label + " (@@" + STR$(SoftArrayRegister(k)) + ") (@" + STR$(SoftArray(k).HeadNode) + ")" + CHR$(10)
        END IF
    NEXT
    TheReturn = TheReturn + "Nodes:" + CHR$(10)
    FOR k = 1 TO UBOUND(IdentityRegister)
        IF (IdentityRegister(k) <> -1) THEN
            a = IdentityRegister(k)
            TheReturn = TheReturn + "  " + Literal$(a)
            TheReturn = TheReturn + " (@" + STR$(IdentityRegister(k)) + ")"
            TheReturn = TheReturn + " (" + LTRIM$(RTRIM$(STR$(Nodes(a).North))) + "," + LTRIM$(RTRIM$(STR$(Nodes(a).South))) + "," + LTRIM$(RTRIM$(STR$(Nodes(a).East))) + "," + LTRIM$(RTRIM$(STR$(Nodes(a).West))) + ")"
            TheReturn = TheReturn + CHR$(10)
        END IF
    NEXT
    TheReturn = TheReturn + "End memory probe..." + CHR$(10)
    MemoryProbe$ = TheReturn
END FUNCTION
 
FUNCTION PrintMultiSoftArrays$ (x AS INTEGER)
    DIM TheReturn AS STRING
    DIM k AS INTEGER
    TheReturn = ""
    FOR k = x TO UBOUND(SoftArrayRegister)
        IF (SoftArrayRegister(k) <> -1) THEN
            TheReturn = TheReturn + PrintSoftArray$(SoftArray(k).HeadNode)
            IF (x < UBOUND(SoftArrayRegister)) THEN
                TheReturn = TheReturn + CHR$(10)
            END IF
        END IF
    NEXT
    PrintMultiSoftArrays$ = TheReturn
END FUNCTION
 
FUNCTION PrintSoftArray$ (x AS LONG)
    DIM TheReturn AS STRING
    DIM t AS STRING
    t = ListNodesRecur$(0, x)
    TheReturn = LEFT$(t, LEN(t) - 1)
    PrintSoftArray$ = TheReturn
END SUB
 
FUNCTION ListNodesRecur$ (i AS INTEGER, x AS LONG)
    DIM TheReturn AS STRING
    DIM s AS LONG
    DIM e AS LONG
    s = Nodes(x).South
    e = Nodes(x).East
    TheReturn = TheReturn + Filler$(i, "  ") + Literal$(x) 'CHR$(9)
    'TheReturn = TheReturn  + " (" + STR$(Nodes(x).North) + "," + STR$(Nodes(x).South) + "," + STR$(Nodes(x).East) + "," + STR$(Nodes(x).West) + ")"
    TheReturn = TheReturn + CHR$(10)
    IF (e <> -1) THEN
        TheReturn = TheReturn + ListNodesRecur$(i + 1, e)
    END IF
    IF (s <> -1) THEN
        TheReturn = TheReturn + ListNodesRecur$(i, s)
    END IF
    ListNodesRecur$ = TheReturn
END FUNCTION
 
FUNCTION IdentityStackBuildRecur (x AS LONG, r AS INTEGER)
    DIM TheReturn AS LONG
    DIM n AS LONG
    DIM s AS LONG
    DIM e AS LONG
    DIM w AS LONG
    n = Nodes(x).North
    s = Nodes(x).South
    e = Nodes(x).East
    w = Nodes(x).West
    IdentityStackSize = IdentityStackSize + 1
    IdentityStack(IdentityStackSize, 1) = x
    IdentityStack(IdentityStackSize, 2) = n
    IdentityStack(IdentityStackSize, 3) = s
    IdentityStack(IdentityStackSize, 4) = e
    IdentityStack(IdentityStackSize, 5) = w
    IF (r <> -1) THEN
        IF (e <> -1) THEN
            TheReturn = IdentityStackBuildRecur(e, 1)
        END IF
        IF (r <> 0) THEN
            IF (s <> -1) THEN
                TheReturn = IdentityStackBuildRecur(s, 1)
            END IF
        END IF
    ELSE
        TheReturn = -1
    END IF
    IdentityStackBuildRecur = TheReturn
END FUNCTION
 
FUNCTION Literal$ (x AS LONG)
    DIM TheReturn AS STRING
    TheReturn = ""
    IF (x <> -1) THEN
        SELECT CASE Nodes(x).Species
            CASE "integer"
                TheReturn = LTRIM$(RTRIM$(STR$(IntegerData(Nodes(x).Reference))))
            CASE "text"
                TheReturn = TextData(Nodes(x).Reference)
            CASE "double"
                TheReturn = LTRIM$(RTRIM$(STR$(DoubleData(Nodes(x).Reference))))
        END SELECT
    END IF
    Literal$ = TheReturn
END FUNCTION
 
FUNCTION LiteralJSON$ (x AS LONG)
    DIM TheReturn AS STRING
    TheReturn = ""
    IF (x <> -1) THEN
        SELECT CASE Nodes(x).Species
            CASE "integer"
                TheReturn = LTRIM$(RTRIM$(STR$(IntegerData(Nodes(x).Reference))))
            CASE "text"
                TheReturn = CHR$(34) + TextData(Nodes(x).Reference) + CHR$(34)
            CASE "double"
                TheReturn = LTRIM$(RTRIM$(STR$(DoubleData(Nodes(x).Reference))))
        END SELECT
    END IF
    LiteralJSON$ = TheReturn
END FUNCTION
 
 
FUNCTION Filler$ (x AS INTEGER, t AS STRING)
    DIM TheReturn AS STRING
    DIM k AS INTEGER
    IF (x > 0) THEN
        FOR k = 1 TO x
            TheReturn = TheReturn + t
        NEXT
    ELSE
        TheReturn = ""
    END IF
    Filler$ = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Soft array construction
'
 
FUNCTION NewUnitArray (t AS STRING, x AS LONG)
    DIM TheReturn AS LONG
    DIM k AS LONG
    DIM r AS LONG
    r = NewSoftArray(t)
    TheReturn = r
    k = LinkEast(TheReturn, x)
    NewUnitArray = TheReturn
END FUNCTION
 
FUNCTION NewSoftArray (t AS STRING)
    DIM TheReturn AS LONG
    DIM i AS LONG
    TheReturn = NewTextNode(t)
    i = NextOpenSoftArray(1)
    SoftArrayRegister(i) = i
    SoftArray(i).Label = TextData(Nodes(TheReturn).Reference)
    SoftArray(i).HeadNode = TheReturn
    NewSoftArray = TheReturn
END FUNCTION
 
FUNCTION NextOpenSoftArray (x AS LONG)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = x TO UBOUND(SoftArrayRegister)
        IF (SoftArrayRegister(k) = -1) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    NextOpenSoftArray = TheReturn
END FUNCTION
 
FUNCTION LinkSouth (n AS LONG, s AS LONG)
    DIM TheReturn AS LONG
    Nodes(s).North = n
    Nodes(n).South = s
    TheReturn = s
    LinkSouth = TheReturn
END FUNCTION
 
FUNCTION LinkEast (w AS LONG, e AS LONG)
    DIM TheReturn AS LONG
    Nodes(w).East = e
    Nodes(e).West = w
    TheReturn = e
    LinkEast = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Soft array editing
'
 
FUNCTION InsertSouth (n AS LONG, x AS LONG)
    DIM s AS LONG
    s = Nodes(n).South
    Nodes(n).South = x
    Nodes(x).North = n
    Nodes(x).South = s
    IF (s <> -1) THEN
        Nodes(s).North = x
    END IF
    InsertSouth = x
END FUNCTION
 
FUNCTION InsertEast (w AS LONG, x AS LONG)
    DIM e AS LONG
    e = Nodes(w).East
    Nodes(w).East = x
    Nodes(x).West = w
    Nodes(x).East = e
    IF (e <> -1) THEN
        Nodes(e).West = x
    END IF
    InsertEast = x
END FUNCTION
 
FUNCTION Unlink (x AS LONG)
    DIM n AS LONG
    DIM s AS LONG
    DIM e AS LONG
    DIM w AS LONG
    DIM k AS INTEGER
    n = Nodes(x).North
    s = Nodes(x).South
    e = Nodes(x).East
    w = Nodes(x).West
    IF (n = -1) AND (s = -1) AND (w = -1) THEN ' head node
        FOR k = 1 TO UBOUND(SoftArrayRegister)
            IF (SoftArray(k).HeadNode = x) THEN
                SoftArrayRegister(k) = -1
            END IF
        NEXT
    END IF
    IF (n <> -1) THEN Nodes(n).South = s
    IF (s <> -1) THEN Nodes(s).North = n
    IF (e <> -1) THEN Nodes(e).West = w
    IF (w <> -1) THEN Nodes(w).East = e
    IF ((n = -1) AND (w <> -1)) THEN ' content node
        IF (s <> -1) THEN
            Nodes(s).West = w
            Nodes(s).North = -1
            Nodes(w).East = s
        END IF
    END IF
    IdentityRegister(x) = -1
    Unlink = x
END FUNCTION
 
FUNCTION DeleteNodes (x AS LONG)
    DIM TheReturn AS LONG
    DIM e AS LONG
    e = Nodes(x).East
    IF (e <> -1) THEN
        TheReturn = DeleteNodesRecur(e)
    END IF
    TheReturn = Unlink(x)
    DeleteNodes = TheReturn
END SUB
 
FUNCTION DeleteNodesRecur (x AS LONG)
    DIM TheReturn AS LONG
    DIM s AS LONG
    DIM e AS LONG
    s = Nodes(x).South
    e = Nodes(x).East
    IF (e <> -1) THEN
        TheReturn = DeleteNodesRecur(e)
    END IF
    IF (s <> -1) THEN
        TheReturn = DeleteNodesRecur(s)
    END IF
    TheReturn = Unlink(x)
    DeleteNodesRecur = TheReturn
END FUNCTION
 
FUNCTION CopyNodes (x AS LONG)
    DIM TheReturn AS LONG
    DIM k AS INTEGER
    DIM j AS INTEGER
    DIM n AS INTEGER
    DIM i AS INTEGER
    DIM m AS INTEGER
    DIM a AS LONG
    DIM b AS LONG
    a = IdentityStackBuildRecur(x, 0)
    FOR k = 1 TO IdentityStackSize
        i = k + IdentityStackSize
        a = NewNode(NextOpenIdentity(IdentityStack(k, 1)), Nodes(IdentityStack(k, 1)).Species, Nodes(IdentityStack(k, 1)).Reference)
        IdentityStack(i, 1) = a
    NEXT
    FOR k = 1 TO IdentityStackSize
        i = k + IdentityStackSize
        FOR j = 2 TO 5
            a = IdentityStack(k, j)
            FOR n = 1 TO IdentityStackSize
                m = n + IdentityStackSize
                b = IdentityStack(n, 1)
                IF (b = a) THEN
                    SELECT CASE j
                        CASE 2
                            Nodes(IdentityStack(i, 1)).North = IdentityStack(m, 1)
                        CASE 3
                            Nodes(IdentityStack(i, 1)).South = IdentityStack(m, 1)
                        CASE 4
                            Nodes(IdentityStack(i, 1)).East = IdentityStack(m, 1)
                        CASE 5
                            Nodes(IdentityStack(i, 1)).West = IdentityStack(m, 1)
                    END SELECT
                END IF
            NEXT
        NEXT
    NEXT
    a = IdentityStack(1 + IdentityStackSize, 1)
    FOR k = 1 TO UBOUND(SoftArrayRegister)
        IF (SoftArray(k).HeadNode) = x THEN
            a = Nodes(a).East
            EXIT FOR
        END IF
    NEXT
    IdentityStackSize = 0
    TheReturn = NewSoftArray("copy" + LTRIM$(RTRIM$(STR$(INT(TIMER * 10)))))
    b = LinkEast(TheReturn, a)
    CopyNodes = TheReturn
END FUNCTION
 
FUNCTION DeleteSoftArray (x AS INTEGER)
    DIM TheReturn AS LONG
    SoftArrayRegister(x) = -1
    TheReturn = DeleteNodesRecur(SoftArray(x).HeadNode)
    DeleteSoftArray = TheReturn
END FUNCTION
 
FUNCTION DeleteAllSoftArrays (x AS INTEGER)
    DIM TheReturn AS LONG
    DIM k AS INTEGER
    FOR k = x TO UBOUND(SoftArrayRegister)
        IF (SoftArrayRegister(k) <> -1) THEN
            TheReturn = DeleteSoftArray(k)
        END IF
    NEXT
    DeleteAllSoftArrays = TheReturn
END FUNCTION
 
FUNCTION SeverSoftArray (x AS INTEGER)
    ' Need to filter out case when node being severed is a head node. It makes no sense.
    DIM TheReturn AS LONG
    IF (Nodes(x).North <> -1) THEN
        Nodes(Nodes(x).North).South = -1
        Nodes(x).North = -1
    END IF
    IF (Nodes(x).West <> -1) THEN
        Nodes(Nodes(x).West).East = -1
    END IF
    TheReturn = NewSoftArray("sever" + LTRIM$(RTRIM$(STR$(INT(TIMER * 10)))))
    TheReturn = LinkEast(TheReturn, x)
    SeverSoftArray = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Node creation
'
 
FUNCTION NextOpenIdentity (x AS LONG)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = x TO UBOUND(IdentityRegister)
        IF (IdentityRegister(k) = -1) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    NextOpenIdentity = TheReturn
END FUNCTION
 
FUNCTION NewNode (x AS LONG, t AS STRING, r AS LONG)
    DIM i AS LONG
    i = NextOpenIdentity(x)
    IdentityRegister(i) = i
    Nodes(i).Identity = i
    Nodes(i).Species = t
    Nodes(i).Reference = r
    Nodes(i).North = -1
    Nodes(i).South = -1
    Nodes(i).East = -1
    Nodes(i).West = -1
    NewNode = i
END FUNCTION
 
FUNCTION CopyIntegerNode (x AS LONG)
    CopyIntegerNode = NewIntegerNode(IntegerData(Nodes(x).Reference))
END FUNCTION
 
FUNCTION ConvertToInteger (i AS LONG, x AS INTEGER)
    DIM TheReturn AS LONG
    Nodes(i).Species = "integer"
    Nodes(i).Reference = NewIntegerData(x)
    TheReturn = i
    ConvertToInteger = TheReturn
END FUNCTION
 
FUNCTION ConvertToText (i AS LONG, x AS STRING)
    DIM TheReturn AS LONG
    Nodes(i).Species = "text"
    Nodes(i).Reference = NewTextData(x)
    TheReturn = i
    ConvertToText = TheReturn
END FUNCTION
 
FUNCTION ConvertToDouble (i AS LONG, x AS DOUBLE)
    DIM TheReturn AS LONG
    Nodes(i).Species = "double"
    Nodes(i).Reference = NewDoubleData(x)
    TheReturn = i
    ConvertToDouble = TheReturn
END FUNCTION
 
FUNCTION NewIntegerNode (x AS INTEGER)
    NewIntegerNode = NewNode(1, "integer", NewIntegerData(x))
END FUNCTION
 
FUNCTION NewTextNode (x AS STRING)
    NewTextNode = NewNode(1, "text", NewTextData(x))
END FUNCTION
 
FUNCTION NewDoubleNode (x AS DOUBLE)
    NewDoubleNode = NewNode(1, "double", NewDoubleData(x))
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Node editing
'
 
FUNCTION EditIntegerReference (x AS LONG, i AS INTEGER)
    DIM z AS LONG
    z = NewIntegerData(i)
    Nodes(x).Reference = z
    EditIntegerReference = z
END FUNCTION
 
FUNCTION EditTextReference (x AS LONG, t AS STRING)
    DIM z AS LONG
    z = NewTextData(t)
    Nodes(x).Reference = z
    EditTextReference = z
END FUNCTION
 
FUNCTION EditDoubleReference (x AS LONG, d AS DOUBLE)
    DIM z AS LONG
    z = NewDoubleData(d)
    Nodes(x).Reference = z
    EditDoubleReference = z
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Data assimilation (prevents redundancy but can be disabled for more speed)
'
 
FUNCTION NewIntegerData (x AS INTEGER)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = 1 TO UBOUND(IntegerData)
        IF (IntegerData(k) = x) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    IF (TheReturn = -1) THEN
        REDIM _PRESERVE IntegerData(UBOUND(IntegerData) + 1)
        IntegerData(UBOUND(IntegerData)) = x
        TheReturn = UBOUND(IntegerData)
    END IF
    NewIntegerData = TheReturn
END SUB
 
FUNCTION NewTextData (x AS STRING)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = 1 TO UBOUND(TextData)
        IF (TextData(k) = x) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    IF (TheReturn = -1) THEN
        REDIM _PRESERVE TextData(UBOUND(TextData) + 1)
        TextData(UBOUND(Textdata)) = x
        TheReturn = UBOUND(TextData)
    END IF
    NewTextData = TheReturn
END SUB
 
FUNCTION NewDoubleData (x AS DOUBLE)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = 1 TO UBOUND(DoubleData)
        IF (DoubleData(k) = x) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    IF (TheReturn = -1) THEN
        REDIM _PRESERVE DoubleData(UBOUND(DoubleData) + 1)
        DoubleData(UBOUND(DoubleData)) = x
        TheReturn = UBOUND(DoubleData)
    END IF
    NewDoubleData = TheReturn
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' End BM-component.
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 

News:

Author Topic: Soft Arrays grand tour (with video!) (Read 2778 times)

STxAxTIC

Soft Arrays grand tour (with video!)