Author Topic: A new take on arrays and data (Read 3977 times)

STxAxTIC · « **Reply #15 on:** April 10, 2020, 01:11:25 am »

Alright, here is an important update in my opinion.

They say big projects should be designed to be tested early. As a worthwhile target that is more involved than just shoveling fake data around, I decided to write an expression evaluator that works by recursive tree traversal. I'm happy to report that it works.

In the screenshot below, you can see I set up the math problem 3 * 4 * cos (4 + 7) * 2 in a tree-like notation, namely:

Code: [Select]

Then, the code executes just one new function I called EvalStep to reduce that blob into an answer:

Code: [Select]

0.1062...
At no point do I swap numbers to a string representation and then switch back - this stays true to type.

Attachment at the bottom, newest and latest code here:

Code: QB64: [Select]

OPTION _EXPLICIT
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Hard arrays to store actual data:
'
REDIM SHARED IntegerData(0) AS INTEGER
REDIM SHARED StringData(0) AS STRING
REDIM SHARED DoubleData(0) AS DOUBLE
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Elements:
'
 
' Elemental structure
TYPE Element
    Identity AS LONG '   Address
    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 MaxElements AS INTEGER
MaxElements = 9999
 
' Element visibility toggle
DIM SHARED IdentityRegister(MaxElements) AS LONG
DIM k AS LONG
FOR k = 1 TO UBOUND(IdentityRegister)
    IdentityRegister(k) = 0
NEXT
 
' Element storage
DIM SHARED Elements(MaxElements) AS Element
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Soft Arrays:
'
 
' Soft array structure
TYPE SoftArrayMeta
    Label AS STRING
    FirstElement AS LONG
END TYPE
 
DIM MaxSoftArrays AS INTEGER
MaxSoftArrays = 99
 
' Soft array visibility toggle
DIM SHARED SoftArrayRegister(MaxSoftArrays) AS INTEGER
FOR k = 1 TO UBOUND(SoftArrayRegister)
    SoftArrayRegister(k) = 0
NEXT
 
' Soft array storage
DIM SHARED SoftArray(MaxSoftArrays) AS SoftArrayMeta
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Setup
'
 
SCREEN _NEWIMAGE(80, 42)
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Main
'
 
CALL DemoArray3D
PRINT
PRINT "Press any key..."
SLEEP
CLS
CALL DemoTree
PRINT
PRINT "Press any key..."
SLEEP
CLS
CALL DemoTreeEdit
PRINT
PRINT "Press any key..."
SLEEP
CLS
CALL DemoArithmetic
 
END
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Example cases:
'
 
SUB DemoArithmetic
    DIM a AS LONG
    DIM b AS LONG
 
    a = NewSoftArray(0, "Arithmetic Test")
    a = LinkEast(a, NewStringElement("*"))
    b = LinkEast(a, NewIntegerElement(3))
    b = LinkSouth(b, NewIntegerElement(4))
    a = LinkSouth(b, NewStringElement("cos"))
    b = LinkEast(a, NewStringElement("+"))
    b = LinkEast(b, NewIntegerElement(4))
    b = LinkSouth(b, NewIntegerElement(7))
    'b = LinkSouth(b, NewStringElement("seventeen"))
    b = LinkSouth(a, NewIntegerElement(2))
 
    ' Display and query tests
    CALL PrintSoftArray(ArrayId("Arithmetic Test"))
    PRINT
    PRINT "..."
    CALL EvalStep(FirstEmbedded(SoftArray(ArrayId("Arithmetic Test")).FirstElement))
    CALL PrintSoftArray(ArrayId("Arithmetic Test"))
    PRINT
    PRINT "..."
    CALL EvalStep(FirstEmbedded(SoftArray(ArrayId("Arithmetic Test")).FirstElement))
    CALL PrintSoftArray(ArrayId("Arithmetic Test"))
    PRINT
    PRINT "..."
    CALL EvalStep(FirstEmbedded(SoftArray(ArrayId("Arithmetic Test")).FirstElement))
    CALL PrintSoftArray(ArrayId("Arithmetic Test"))
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoTreeEdit
    DIM a AS LONG
    DIM b AS LONG
    DIM c AS LONG
 
    a = NewSoftArray(0, "Tree Edit Test")
    a = LinkEast(a, NewStringElement("QB64 Buddy"))
    a = LinkEast(a, NewStringElement("Handle"))
    b = LinkEast(a, NewStringElement("flukiluke"))
    a = LinkSouth(a, NewStringElement("Name"))
    b = LinkEast(a, NewStringElement("Luke C."))
    a = LinkSouth(a, NewStringElement("Country"))
    b = LinkEast(a, NewStringElement("Australia"))
    c = LinkEast(b, NewStringElement("Locality"))
    b = LinkEast(c, NewStringElement("Down Under"))
    a = LinkSouth(a, NewStringElement("Birthyear"))
    b = LinkEast(a, NewIntegerElement(1523))
    c = LinkSouth(b, NewStringElement("May?"))
 
    ' Display and query tests
    CALL PrintSoftArray(ArrayId("Tree Edit Test"))
    PRINT
 
    PRINT "Inserting `Get it?' into list..."
    a = InsertEast(SeekString("Down Under", FromLabel("Tree Edit Test"), 1), NewStringElement("Get it?"))
    PRINT "Adding new entry to bottom of list..."
    a = InsertSouth(SeekString("QB64 Buddy", FromLabel("Tree Edit Test"), 1), NewStringElement("QB64 Enemy"))
    PRINT "Editing Birthyear..."
    a = EditIntegerReference(StepUsing(SeekString("Birthyear", FromLabel("Tree Edit Test"), 1), "e"), 1855)
    PRINT "Deleting a few entries under Country..."
    a = LinkEast(SeekString("Country", FromLabel("Tree Edit Test"), 1), SeekString("Down Under", FromLabel("Tree Edit Test"), 1))
    PRINT "Unlinking Name (and child elements)..."
    a = Unlink(SeekString("Name", FromLabel("Tree Edit Test"), 1))
 
    PRINT
    CALL PrintSoftArray(ArrayId("Tree Edit Test"))
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoTree
    DIM a AS LONG
    DIM b AS LONG
    DIM c AS LONG
    DIM d AS LONG
 
    a = NewSoftArray(0, "Tree of Friends")
    a = LinkEast(a, NewStringElement("QB64 Buddy")): d = a
    a = LinkEast(a, NewStringElement("Handle"))
    b = LinkEast(a, NewStringElement("SMcNeill"))
    a = LinkSouth(a, NewStringElement("Name"))
    b = LinkEast(a, NewStringElement("Steve SMcNeill"))
    a = LinkSouth(a, NewStringElement("Country"))
    b = LinkEast(a, NewStringElement("USA"))
    c = LinkEast(b, NewStringElement("Locality"))
    b = LinkEast(c, NewStringElement("Virginia"))
    a = LinkSouth(a, NewStringElement("Birthyear"))
    b = LinkEast(a, NewIntegerElement(1973))
    c = LinkSouth(b, NewStringElement("May?"))
    a = LinkSouth(d, NewStringElement("QB64 Buddy")): d = a
    a = LinkEast(a, NewStringElement("Handle"))
    b = LinkEast(a, NewStringElement("FellippeHeitor"))
    a = LinkSouth(a, NewStringElement("Name"))
    b = LinkEast(a, NewStringElement("Fellippe Heitor"))
    a = LinkSouth(a, NewStringElement("Country"))
    b = LinkEast(a, NewStringElement("Brazil"))
    c = LinkEast(b, NewStringElement("Locality"))
    b = LinkEast(c, NewStringElement("My <3"))
    c = LinkEast(b, NewStringElement("JK, it's ___."))
    a = LinkSouth(a, NewStringElement("Birthyear"))
    b = LinkEast(a, NewIntegerElement(1983))
    c = LinkSouth(b, NewStringElement("Sep?"))
    b = LinkSouth(c, NewStringElement("... or was it May?"))
    a = LinkSouth(d, NewStringElement("QB64 Buddy")): d = a
    a = LinkEast(a, NewStringElement("Handle"))
    b = LinkEast(a, NewStringElement("DanTurtle"))
 
    ' Display array
    CALL PrintSoftArray(ArrayId("Tree of Friends"))
    PRINT
 
    ' Query tests
    PRINT "Height:"; SoftArrayHeight(ArrayId("Tree of Friends"))
    PRINT "Steve's locality: "; Literal$(StepFromLabel("Tree of Friends", "eesseee"))
    PRINT "Fellippe's locality: "; Literal$(StepFromLabel("Tree of Friends", "esesseee"))
    PRINT "Fellippe's birth month: "; Literal$(StepUsing(JumpFrom(StepFromLabel("Tree of Friends", "ese"), "s", 3), "es"))
    PRINT "Width of Fellippe's Country branch:"; Measure(SeekString("Country", FromLabel("Tree of Friends"), 2), "e")
    PRINT "Height under Fellippe's Birthyear branch:"; Measure(Elements(SeekString("Birthyear", FromLabel("Tree of Friends"), 2)).East, "s")
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoArray3D
    DIM TestArray3D(4, 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"
    TestArray3D(4, 1, 1) = "four.one.one"
    TestArray3D(4, 1, 2) = "four.one.two"
    TestArray3D(4, 1, 3) = "four.one.three"
    TestArray3D(4, 2, 1) = "four.two.one"
    TestArray3D(4, 2, 2) = "four.two.two"
    TestArray3D(4, 2, 3) = "four.two.three"
    DIM i AS INTEGER
    DIM j AS INTEGER
    DIM k AS INTEGER
    DIM a AS LONG
    DIM b AS LONG
    a = NewSoftArray(0, "Three-Dimensional Array")
    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, NewStringElement(TestArray3D(i, j, k)))
                    b = a
                ELSE
                    IF (k = 1) THEN
                        a = LinkSouth(a, NewStringElement(TestArray3D(i, j, k)))
                        b = a
                    ELSE
                        b = LinkEast(b, NewStringElement(TestArray3D(i, j, k)))
                    END IF
                END IF
            NEXT
        NEXT
    NEXT
 
    ' Display array
    CALL PrintSoftArray(ArrayId("Three-Dimensional Array"))
    PRINT
 
    ' Query tests
    PRINT "Height:"; SoftArrayHeight(ArrayId("Three-Dimensional Array"))
    PRINT "Width:"; SoftArrayWidth(ArrayId("Three-Dimensional Array"))
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Processing
'
 
SUB EvalStep (x AS LONG)
    DIM SouthernId AS LONG
    DIM NorthernId AS LONG
    DIM FunctionId AS LONG
    DIM i AS LONG
    DIM n AS LONG
    DIM s AS LONG
    DIM RefSpecies AS STRING
    DIM ReturnSpecies AS STRING
    DIM ReturnInteger AS INTEGER
    DIM ReturnString AS STRING
    DIM ReturnDouble AS DOUBLE
    RefSpecies = "integer"
    ReturnSpecies = ""
    ReturnInteger = 0
    ReturnString = ""
    ReturnDouble = 0
 
    IF (x <> -1) THEN
        SouthernId = x
        i = x
        DO
            IF (Elements(i).Species = "string") THEN RefSpecies = "string"
            IF (Elements(i).Species = "double") THEN RefSpecies = "double"
            n = Elements(i).North
            IF (n <> -1) THEN
                i = n
            ELSE
                NorthernId = i
                EXIT DO
            END IF
        LOOP
        FunctionId = Elements(NorthernId).West
    END IF
 
    SELECT CASE Literal$(FunctionId)
        CASE "*"
            ReturnSpecies = RefSpecies
            ReturnInteger = 1
            ReturnDouble = 1
        CASE "+"
            ReturnSpecies = RefSpecies
            ReturnInteger = 0
            ReturnDouble = 0
    END SELECT
 
    i = NorthernId
    DO
        SELECT CASE Literal$(FunctionId)
            CASE "*"
                SELECT CASE ReturnSpecies
                    CASE "integer"
                        SELECT CASE Elements(i).Species
                            CASE "integer"
                                ReturnInteger = ReturnInteger * IntegerData(Elements(i).Reference)
                            CASE "double"
                                ReturnInteger = ReturnInteger * DoubleData(Elements(i).Reference)
                        END SELECT
                    CASE "string"
                        ReturnString = ReturnString + Literal$(i)
                    CASE "double"
                        SELECT CASE Elements(i).Species
                            CASE "integer"
                                ReturnDouble = ReturnDouble * IntegerData(Elements(i).Reference)
                            CASE "double"
                                ReturnDouble = ReturnDouble * DoubleData(Elements(i).Reference)
                        END SELECT
                END SELECT
 
            CASE "+"
                SELECT CASE ReturnSpecies
                    CASE "integer"
                        SELECT CASE Elements(i).Species
                            CASE "integer"
                                ReturnInteger = ReturnInteger + IntegerData(Elements(i).Reference)
                            CASE "double"
                                ReturnInteger = ReturnInteger + DoubleData(Elements(i).Reference)
                        END SELECT
                    CASE "string"
                        ReturnString = ReturnString + Literal$(i)
                    CASE "double"
                        SELECT CASE Elements(i).Species
                            CASE "integer"
                                ReturnDouble = ReturnDouble + IntegerData(Elements(i).Reference)
                            CASE "double"
                                ReturnDouble = ReturnDouble + DoubleData(Elements(i).Reference)
                        END SELECT
                END SELECT
            CASE "cos"
 
                SELECT CASE Elements(i).Species
                    CASE "integer"
                        ReturnSpecies = "double"
                        ReturnDouble = COS(IntegerData(Elements(i).Reference))
                    CASE "string"
                        ReturnSpecies = "string"
                        ReturnString = "cos(" + Literal$(i) + ")"
                    CASE "double"
                        ReturnSpecies = "double"
                        ReturnDouble = COS(DoubleData(Elements(i).Reference))
                END SELECT
        END SELECT
 
        IF (i = SouthernId) THEN
            i = Unlink(i)
            EXIT DO
        ELSE
            s = Elements(i).South
            i = Unlink(i)
            i = s
        END IF
    LOOP
 
    Elements(FunctionId).Species = ReturnSpecies
    SELECT CASE ReturnSpecies
        CASE "integer"
            Elements(FunctionId).Reference = NewIntegerData(ReturnInteger)
        CASE "string"
            Elements(FunctionId).Reference = NewStringData(ReturnString)
        CASE "double"
            Elements(FunctionId).Reference = NewDoubleData(ReturnDouble)
    END SELECT
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Seek and recall
'
 
FUNCTION ArrayId (x AS STRING)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = 1 TO UBOUND(SoftArray)
        IF (SoftArray(k).Label = x) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    ArrayId = TheReturn
END FUNCTION
 
FUNCTION SeekString (t AS STRING, x AS LONG, r AS INTEGER)
    DIM TheReturn AS LONG
    DIM s AS LONG
    DIM e AS LONG
    TheReturn = -1
    s = Elements(x).South
    e = Elements(x).East
    IF (StringData(Elements(x).Reference) = t) THEN
        TheReturn = x
        r = r - 1
    ELSE
        IF (e <> -1) AND (r > 0) THEN
            TheReturn = SeekString(t, e, r)
        END IF
        IF (s <> -1) AND (r > 0) THEN
            TheReturn = SeekString(t, s, r)
        END IF
    END IF
    SeekString = TheReturn
END FUNCTION
 
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 = Elements(x).South
    e = Elements(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
    MostEmbeddedRecur = y
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Navigation
'
 
FUNCTION FromLabel (x AS STRING)
    DIM TheReturn AS LONG
    TheReturn = SoftArray(ArrayId(x)).FirstElement
    FromLabel = TheReturn
END FUNCTION
 
FUNCTION StepFromLabel (x AS STRING, t AS STRING)
    DIM TheReturn AS LONG
    TheReturn = StepUsing(FromLabel(x), t)
    StepFromLabel = TheReturn
END FUNCTION
 
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(Elements(x).North, "n", r - 1)
            CASE "s"
                TheReturn = JumpFrom(Elements(x).South, "s", r - 1)
            CASE "e"
                TheReturn = JumpFrom(Elements(x).East, "e", r - 1)
            CASE "w"
                TheReturn = JumpFrom(Elements(x).West, "w", r - 1)
        END SELECT
    END IF
    JumpFrom = TheReturn
END FUNCTION
 
FUNCTION StepUsing (x AS LONG, t AS STRING)
    DIM TheReturn AS LONG
    DIM k AS INTEGER
    DIM i AS LONG
    DIM j AS LONG
    i = x
    FOR k = 1 TO LEN(t)
        SELECT CASE MID$(t, k, 1)
            CASE "n"
                j = Elements(i).North
                IF (j <> -1) THEN i = j
            CASE "s"
                j = Elements(i).South
                IF (j <> -1) THEN i = j
            CASE "e"
                j = Elements(i).East
                IF (j <> -1) THEN i = j
            CASE "w"
                j = Elements(i).West
                IF (j <> -1) THEN i = j
        END SELECT
    NEXT
    TheReturn = i
    StepUsing = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Internal metrics
'
 
FUNCTION SoftArrayHeight (x AS INTEGER)
    DIM TheReturn AS INTEGER
    TheReturn = Measure(Elements(SoftArray(x).FirstElement).East, "s")
    SoftArrayHeight = TheReturn
END FUNCTION
 
FUNCTION SoftArrayWidth (x AS INTEGER)
    DIM TheReturn AS INTEGER
    TheReturn = Measure(Elements(SoftArray(x).FirstElement).East, "e")
    SoftArrayWidth = TheReturn
END FUNCTION
 
FUNCTION Measure (x AS LONG, t AS STRING)
    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 = Elements(x).North
        CASE "s"
            k = Elements(x).South
        CASE "e"
            k = Elements(x).East
        CASE "w"
            k = Elements(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
'
 
SUB PrintSoftArray (x AS LONG)
    DIM t AS STRING
    IF (x <> -1) THEN
        t = ListElementsRecur$(0, SoftArray(x).FirstElement)
    END IF
    t = LEFT$(t, LEN(t) - 1)
    PRINT t
END SUB
 
FUNCTION ListElementsRecur$ (i AS INTEGER, x AS LONG)
    DIM TheReturn AS STRING
    DIM s AS LONG
    DIM e AS LONG
    s = Elements(x).South
    e = Elements(x).East
    TheReturn = TheReturn + SPACE$(i) + Literal$(x) + CHR$(10)
    IF (e <> -1) THEN
        TheReturn = TheReturn + ListElementsRecur$(i + 2, e)
    END IF
    IF (s <> -1) THEN
        TheReturn = TheReturn + ListElementsRecur$(i, s)
    END IF
    ListElementsRecur$ = TheReturn
END SUB
 
FUNCTION Literal$ (x AS LONG)
    DIM TheReturn AS STRING
    TheReturn = ""
    SELECT CASE Elements(x).Species
        CASE "integer"
            TheReturn = LTRIM$(RTRIM$(STR$(IntegerData(Elements(x).Reference))))
        CASE "string"
            TheReturn = StringData(Elements(x).Reference)
        CASE "double"
            TheReturn = LTRIM$(RTRIM$(STR$(DoubleData(Elements(x).Reference))))
    END SELECT
    Literal$ = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Soft array construction
'
 
FUNCTION NextOpenSoftArray (x AS LONG)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = x TO UBOUND(SoftArrayRegister)
        IF (SoftArrayRegister(k) = 0) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    NextOpenSoftArray = TheReturn
END FUNCTION
 
FUNCTION NewSoftArray (i AS INTEGER, t AS STRING)
    DIM k AS LONG
    k = NewStringElement(t)
    IF (i < 1) THEN
        i = NextOpenSoftArray(1)
        SoftArrayRegister(i) = i
    END IF
    SoftArray(i).Label = StringData(Elements(k).Reference)
    SoftArray(i).FirstElement = k
    NewSoftArray = k
END FUNCTION
 
FUNCTION LinkSouth (n AS LONG, s AS LONG)
    DIM TheReturn AS LONG
    Elements(s).North = n
    Elements(n).South = s
    TheReturn = s
    LinkSouth = TheReturn
END FUNCTION
 
FUNCTION LinkEast (w AS LONG, e AS LONG)
    DIM TheReturn AS LONG
    Elements(w).East = e
    Elements(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 = Elements(n).South
    Elements(n).South = x
    Elements(x).North = n
    Elements(x).South = s
    IF (s <> -1) THEN
        Elements(s).North = x
    END IF
    InsertSouth = x
END FUNCTION
 
FUNCTION InsertEast (w AS LONG, x AS LONG)
    DIM e AS LONG
    e = Elements(w).East
    Elements(w).East = x
    Elements(x).West = w
    Elements(x).East = e
    IF (e <> -1) THEN
        Elements(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
    n = Elements(x).North
    s = Elements(x).South
    e = Elements(x).East
    w = Elements(x).West
    IF (n <> -1) THEN Elements(n).South = s
    IF (s <> -1) THEN Elements(s).North = n
    IF (e <> -1) THEN Elements(e).West = w
    IF (w <> -1) THEN Elements(w).East = e
    IdentityRegister(x) = 0
    Unlink = x
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Element 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) = 0) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    NextOpenIdentity = TheReturn
END FUNCTION
 
FUNCTION NewElement (x AS LONG, t AS STRING, r AS LONG)
    DIM i AS LONG
    i = NextOpenIdentity(x)
    IdentityRegister(i) = i
    Elements(i).Identity = i
    Elements(i).Species = t
    Elements(i).Reference = r
    Elements(i).North = -1
    Elements(i).South = -1
    Elements(i).East = -1
    Elements(i).West = -1
    NewElement = i
END FUNCTION
 
FUNCTION NewIntegerElement (x AS INTEGER)
    NewIntegerElement = NewElement(1, "integer", NewIntegerData(x))
END FUNCTION
 
FUNCTION NewStringElement (x AS STRING)
    NewStringElement = NewElement(1, "string", NewStringData(x))
END FUNCTION
 
FUNCTION NewDoubleElement (x AS DOUBLE)
    NewDoubleElement = NewElement(1, "double", NewDoubleData(x))
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Element editing
'
 
FUNCTION EditIntegerReference (i AS LONG, x AS INTEGER)
    DIM z AS LONG
    z = NewIntegerData(x)
    Elements(i).Reference = z
    EditIntegerReference = z
END FUNCTION
 
FUNCTION EditStringReference (i AS LONG, x AS STRING)
    DIM z AS LONG
    z = NewStringData(x)
    Elements(i).Reference = z
    EditStringReference = z
END FUNCTION
 
FUNCTION EditDoubleReference (i AS LONG, x AS DOUBLE)
    DIM z AS LONG
    z = NewDoubleData(x)
    Elements(i).Reference = z
    EditDoubleReference = z
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Data assimilation
'
 
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 NewStringData (x AS STRING)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = 1 TO UBOUND(StringData)
        IF (StringData(k) = x) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    IF (TheReturn = -1) THEN
        REDIM _PRESERVE StringData(UBOUND(StringData) + 1)
        StringData(UBOUND(Stringdata)) = x
        TheReturn = UBOUND(StringData)
    END IF
    NewStringData = 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
 
'SUB ResetStack
'    REDIM _PRESERVE IdentityStack(0)
'END SUB
 
'FUNCTION NewStackId (x AS LONG)
'    REDIM _PRESERVE IdentityStack(UBOUND(IdentityStack) + 1)
'    IdentityStack(UBOUND(IdentityStack)) = x
'    NewStackId = x
'END SUB
 

STxAxTIC · « **Reply #16 on:** April 12, 2020, 08:59:14 am »

I'm calling this the Anonymous Function update.

How to explain this... okay... so QB64 doesn't natively support lambda expressions, anonymous functions, combinators - none of the high-level egghead stuff. I began thinking about why most of us haven't heard of these things, and I conclude it's because QB64 is a high-level language that uses low-level semantics. If QB64 had a keyword for it, you would all be experts on it. But when there isn't, it's great pain for everyone, am I wrong? Anyway, if we want QB64 to behave more abstractly, we have to roll our own and not wait for version 1.9 or whatever. This sentiment transitions right into a nice quote summarizing why there is a drive for math evaluators, sub-languages, etc. - basically anything in our Interpreters section in the Library:

Quote

Any sufficiently complicated C or Fortran program contains an ad hoc, informally-specified, bug-ridden, slow implementation of half of Common Lisp. - Greenspun's tenth rule of programming

Fast Review of Functions

Consider the QB64 function of three arguments that returns a number:

Code: QB64: [Select]

FUNCTION DoMath (x, y, z)
    DoMath = 3 * x + 4 * y - 2 * z
END FUNCTION

To call the function, you need to type the name and the correct number of arguments, as in

Code: QB64: [Select]

PRINT DoMath(4, 5, 6)

... which gives a result of 20.

Anonymous Function

Functional languages allow the coder to (i) define, (ii) send arguments, and (iii) use a function all in one step, without ever naming the function. This is why it's called anonymous. Wouldn't be interesting then, if QB64 had the same thing, where we might type something like

Code: QB64: [Select]

PRINT {3*x + 4*y - 5*z} (3,4,5)

... to produce the same 20. Now, this still may seem trivial, or equivalent to the old DEF FN if we want to use this idea all alone, surrounded by the pithy matrix of QB64-ness. Alas, this stuff has much more power when your surrounding paradigm leans functional, meaning functions and code are passed around as data. I know that sounds weird, and I'm afraid I won't try to justify it in this paragraph.

So what's new with this code?

The Soft Arrays codebase now evaluates anonymous functions (triggered by the lambda keyword). To explain, consider the QB64 code

Code: QB64: [Select]

PRINT DoMath(4, 6)
 
FUNCTION DoMath (x, y)
    DoMath = COS(3 * x * 5 * y)
END FUNCTION

... which prints something like -.284. Of course, in a tighter pseudo-anonymous notation, we may write

Code: QB64: [Select]

PRINT {COS(3*x*5*y)} (4,6)

Now, forgive how expanded the syntax is for now (this will tighten up later)... but the EXACT same calculation, as expressed via a linked list, looks like:

Code: QB64: [Select]

    a = NewSoftArray(0, "Lambda Test")
    a = LinkEast(a, NewStringElement("lambda"))
    b = LinkEast(a, NewIntegerElement(4))
    b = LinkSouth(b, NewIntegerElement(6))
    a = LinkSouth(a, NewStringElement("cos"))
    b = LinkEast(a, NewStringElement("*"))
    b = LinkEast(b, NewIntegerElement(3))
    b = LinkSouth(b, NewStringElement("[1]"))
    b = LinkSouth(b, NewIntegerElement(5))
    b = LinkSouth(b, NewStringElement("[2]"))

... which, when I run my new magic Evaluate function, gives the correct answer as shown in the screenshot.

Full code below:

Code: QB64: [Select]

OPTION _EXPLICIT
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Hard arrays to store actual data:
'
REDIM SHARED IntegerData(0) AS INTEGER
REDIM SHARED StringData(0) AS STRING
REDIM SHARED DoubleData(0) AS DOUBLE
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Elements:
'
 
' Elemental structure
TYPE Element
    Identity AS LONG '   Address
    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 MaxElements AS INTEGER
MaxElements = 9999
 
' Element visibility toggle
DIM SHARED IdentityRegister(MaxElements) AS LONG
DIM k AS LONG
FOR k = 1 TO UBOUND(IdentityRegister)
    IdentityRegister(k) = 0
NEXT
 
' Element storage
DIM SHARED Elements(MaxElements) AS Element
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Soft Arrays:
'
 
' Soft array structure
TYPE SoftArrayMeta
    Label AS STRING
    FirstElement AS LONG
END TYPE
 
DIM MaxSoftArrays AS INTEGER
MaxSoftArrays = 99
 
' Soft array visibility toggle
DIM SHARED SoftArrayRegister(MaxSoftArrays) AS INTEGER
FOR k = 1 TO UBOUND(SoftArrayRegister)
    SoftArrayRegister(k) = 0
NEXT
 
' Soft array storage
DIM SHARED SoftArray(MaxSoftArrays) AS SoftArrayMeta
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Processing
'
DIM SHARED LambdaMatrix(99, 9) AS LONG
DIM SHARED LambdaIndex AS INTEGER
DIM SHARED LambdaArg AS LONG
LambdaIndex = 0
LambdaArg = 0
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Setup
'
 
SCREEN _NEWIMAGE(80, 42)
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Main
'
 
CALL DemoArray3D
PRINT
PRINT "Press any key..."
SLEEP
CLS
CALL DemoTree
PRINT
PRINT "Press any key..."
SLEEP
CLS
CALL DemoTreeEdit
PRINT
PRINT "Press any key..."
SLEEP
CLS
CALL DemoArithmetic
PRINT
PRINT "Press any key..."
SLEEP
CLS
CALL DemoList
PRINT
PRINT "Press any key..."
SLEEP
CLS
CALL DemoLambda
 
END
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Example cases:
'
 
SUB DemoLambda
    DIM a AS LONG
    DIM b AS LONG
 
    a = NewSoftArray(0, "Lambda Test")
    a = LinkEast(a, NewStringElement("lambda"))
    b = LinkEast(a, NewIntegerElement(4))
    b = LinkSouth(b, NewIntegerElement(6))
    a = LinkSouth(a, NewStringElement("cos"))
    b = LinkEast(a, NewStringElement("*"))
    b = LinkEast(b, NewIntegerElement(3))
    b = LinkSouth(b, NewStringElement("[1]"))
    b = LinkSouth(b, NewIntegerElement(5))
    b = LinkSouth(b, NewStringElement("[2]"))
 
    PRINT PrintSoftArray(ArrayId("Lambda Test"))
    PRINT "..."
    a = Evaluate(FromLabel("Lambda Test"))
    PRINT PrintSoftArray(ArrayId("Lambda Test"))
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoList
    DIM a AS LONG
    DIM b AS LONG
 
    a = NewSoftArray(0, "List Test")
    a = LinkEast(a, NewStringElement("cos"))
    b = LinkEast(a, NewStringElement("three"))
    b = LinkSouth(b, NewStringElement("four"))
    b = LinkSouth(b, NewStringElement("five"))
    b = LinkSouth(b, NewStringElement("six"))
    b = LinkSouth(b, NewStringElement("seven"))
 
    a = LinkSouth(a, NewStringElement("cos"))
    b = LinkEast(a, NewIntegerElement(3))
    b = LinkSouth(b, NewIntegerElement(4))
    b = LinkSouth(b, NewIntegerElement(5))
    b = LinkSouth(b, NewIntegerElement(6))
    b = LinkSouth(b, NewIntegerElement(7))
 
    PRINT PrintSoftArray(ArrayId("List Test"))
    PRINT
    a = Evaluate(FromLabel("List Test"))
    PRINT PrintSoftArray(ArrayId("List Test"))
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoArithmetic
    DIM a AS LONG
    DIM b AS LONG
 
    a = NewSoftArray(0, "Arithmetic Test")
    a = LinkEast(a, NewStringElement("*"))
    b = LinkEast(a, NewIntegerElement(3))
    b = LinkSouth(b, NewIntegerElement(4))
    a = LinkSouth(b, NewStringElement("cos"))
    b = LinkEast(a, NewStringElement("+"))
    b = LinkEast(b, NewIntegerElement(4))
    b = LinkSouth(b, NewIntegerElement(7))
    b = LinkSouth(a, NewIntegerElement(2))
 
    PRINT PrintSoftArray(ArrayId("Arithmetic Test"))
    PRINT
    a = Evaluate(FromLabel("Arithmetic Test"))
    PRINT PrintSoftArray(ArrayId("Arithmetic Test"))
    PRINT
 
    a = NewSoftArray(0, "Arithmetic Test2")
    a = LinkEast(a, NewStringElement("/"))
    b = LinkEast(a, NewIntegerElement(3))
    a = LinkSouth(b, NewStringElement("cos"))
    b = LinkEast(a, NewStringElement("+"))
    b = LinkEast(b, NewIntegerElement(4))
    b = LinkSouth(b, Elements(FromLabel("Arithmetic Test")).East)
 
    PRINT PrintSoftArray(ArrayId("Arithmetic Test2"))
    PRINT
    a = Evaluate(FromLabel("Arithmetic Test2"))
    PRINT PrintSoftArray(ArrayId("Arithmetic Test2"))
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoTreeEdit
    DIM a AS LONG
    DIM b AS LONG
    DIM c AS LONG
 
    a = NewSoftArray(0, "Tree Edit Test")
    a = LinkEast(a, NewStringElement("QB64 Buddy"))
    a = LinkEast(a, NewStringElement("Handle"))
    b = LinkEast(a, NewStringElement("flukiluke"))
    a = LinkSouth(a, NewStringElement("Name"))
    b = LinkEast(a, NewStringElement("Luke C."))
    a = LinkSouth(a, NewStringElement("Country"))
    b = LinkEast(a, NewStringElement("Australia"))
    c = LinkEast(b, NewStringElement("Locality"))
    b = LinkEast(c, NewStringElement("Down Under"))
    a = LinkSouth(a, NewStringElement("Birthyear"))
    b = LinkEast(a, NewIntegerElement(1523))
    c = LinkSouth(b, NewStringElement("May?"))
 
    ' Display and query tests
    PRINT PrintSoftArray(ArrayId("Tree Edit Test"))
    PRINT
 
    PRINT "Inserting `Get it?' into list..."
    a = InsertEast(SeekString("Down Under", FromLabel("Tree Edit Test"), 1), NewStringElement("Get it?"))
    PRINT "Adding new entry to bottom of list..."
    a = InsertSouth(SeekString("QB64 Buddy", FromLabel("Tree Edit Test"), 1), NewStringElement("QB64 Enemy"))
    PRINT "Editing Birthyear..."
    a = EditIntegerReference(StepUsing(SeekString("Birthyear", FromLabel("Tree Edit Test"), 1), "e"), 1855)
    PRINT "Deleting a few entries under Country..."
    a = LinkEast(SeekString("Country", FromLabel("Tree Edit Test"), 1), SeekString("Down Under", FromLabel("Tree Edit Test"), 1))
    PRINT "Unlinking Name..."
    a = Unlink(SeekString("Name", FromLabel("Tree Edit Test"), 1))
 
    PRINT
    PRINT PrintSoftArray(ArrayId("Tree Edit Test"))
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoTree
    DIM a AS LONG
    DIM b AS LONG
    DIM c AS LONG
    DIM d AS LONG
 
    a = NewSoftArray(0, "Tree of Friends")
    a = LinkEast(a, NewStringElement("QB64 Buddy")): d = a
    a = LinkEast(a, NewStringElement("Handle"))
    b = LinkEast(a, NewStringElement("SMcNeill"))
    a = LinkSouth(a, NewStringElement("Name"))
    b = LinkEast(a, NewStringElement("Steve SMcNeill"))
    a = LinkSouth(a, NewStringElement("Country"))
    b = LinkEast(a, NewStringElement("USA"))
    c = LinkEast(b, NewStringElement("Locality"))
    b = LinkEast(c, NewStringElement("Virginia"))
    a = LinkSouth(a, NewStringElement("Birthyear"))
    b = LinkEast(a, NewIntegerElement(1973))
    c = LinkSouth(b, NewStringElement("May?"))
    a = LinkSouth(d, NewStringElement("QB64 Buddy")): d = a
    a = LinkEast(a, NewStringElement("Handle"))
    b = LinkEast(a, NewStringElement("FellippeHeitor"))
    a = LinkSouth(a, NewStringElement("Name"))
    b = LinkEast(a, NewStringElement("Fellippe Heitor"))
    a = LinkSouth(a, NewStringElement("Country"))
    b = LinkEast(a, NewStringElement("Brazil"))
    c = LinkEast(b, NewStringElement("Locality"))
    b = LinkEast(c, NewStringElement("My <3"))
    c = LinkEast(b, NewStringElement("JK, it's ___."))
    a = LinkSouth(a, NewStringElement("Birthyear"))
    b = LinkEast(a, NewIntegerElement(1983))
    c = LinkSouth(b, NewStringElement("Sep?"))
    b = LinkSouth(c, NewStringElement("... or was it May?"))
    a = LinkSouth(d, NewStringElement("QB64 Buddy")): d = a
    a = LinkEast(a, NewStringElement("Handle"))
    b = LinkEast(a, NewStringElement("DanTurtle"))
 
    ' Display array
    PRINT PrintSoftArray(ArrayId("Tree of Friends"))
    PRINT
 
    ' Query tests
    PRINT "Height:"; SquareArrayHeight(ArrayId("Tree of Friends"))
    PRINT "Steve's locality: "; Literal$(StepFromLabel("Tree of Friends", "eesseee"))
    PRINT "Fellippe's locality: "; Literal$(StepFromLabel("Tree of Friends", "esesseee"))
    PRINT "Fellippe's birth month: "; Literal$(StepUsing(JumpFrom(StepFromLabel("Tree of Friends", "ese"), "s", 3), "es"))
    PRINT "Width of Fellippe's Country branch:"; Measure(SeekString("Country", FromLabel("Tree of Friends"), 2), "e")
    PRINT "Height under Fellippe's Birthyear branch:"; Measure(Elements(SeekString("Birthyear", FromLabel("Tree of Friends"), 2)).East, "s")
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoArray3D
    DIM TestArray3D(4, 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"
    TestArray3D(4, 1, 1) = "four.one.one"
    TestArray3D(4, 1, 2) = "four.one.two"
    TestArray3D(4, 1, 3) = "four.one.three"
    TestArray3D(4, 2, 1) = "four.two.one"
    TestArray3D(4, 2, 2) = "four.two.two"
    TestArray3D(4, 2, 3) = "four.two.three"
    DIM i AS INTEGER
    DIM j AS INTEGER
    DIM k AS INTEGER
    DIM a AS LONG
    DIM b AS LONG
    a = NewSoftArray(0, "Three-Dimensional Array")
    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, NewStringElement(TestArray3D(i, j, k)))
                    b = a
                ELSE
                    IF (k = 1) THEN
                        a = LinkSouth(a, NewStringElement(TestArray3D(i, j, k)))
                        b = a
                    ELSE
                        b = LinkEast(b, NewStringElement(TestArray3D(i, j, k)))
                    END IF
                END IF
            NEXT
        NEXT
    NEXT
 
    ' Display array
    PRINT PrintSoftArray(ArrayId("Three-Dimensional Array"))
    PRINT
 
    ' Query tests
    PRINT "Height:"; SquareArrayHeight(ArrayId("Three-Dimensional Array"))
    PRINT "Width:"; SquareArrayWidth(ArrayId("Three-Dimensional Array"))
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Processing
'
 
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 (b = a) THEN
            a = Elements(a).South
            IF (a = -1) THEN
                EXIT DO
            END IF
        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 ReturnString AS STRING
    DIM ReturnDouble AS DOUBLE
    DIM MultiPass AS INTEGER
    RefSpecies = ""
    FunctionId = x
    ReturnSpecies = ""
    ReturnInteger = 0
    ReturnString = ""
    ReturnDouble = 0
 
    ' Pre-evaluation
    IF (x <> -1) THEN
        SouthernId = x
        i = x
        DO
            n = Elements(i).North
            IF (n <> -1) THEN
                i = n
            ELSE
                NorthernId = i
                EXIT DO
            END IF
        LOOP
        FunctionId = Elements(NorthernId).West
        ReturnSpecies = Elements(FunctionId).Species
        SELECT CASE ReturnSpecies
            CASE "integer"
                ReturnInteger = IntegerData(Elements(FunctionId).Reference)
            CASE "string"
                ReturnString = StringData(Elements(FunctionId).Reference)
            CASE "double"
                ReturnDouble = DoubleData(Elements(FunctionId).Reference)
        END SELECT
    END IF
 
    ' Lambda substitution
    i = NorthernId
    DIM lf AS INTEGER
    lf = 0
    DO
        IF (Elements(i).Species = "string") THEN
            IF (StringData(Elements(i).Reference) = "[1]") THEN
                j = LambdaMatrix(LambdaIndex, 1)
                Elements(i).Species = Elements(j).Species
                Elements(i).Reference = Elements(j).Reference
                lf = 1
            END IF
            IF (StringData(Elements(i).Reference) = "[2]") THEN
                j = LambdaMatrix(LambdaIndex, 2)
                Elements(i).Species = Elements(j).Species
                Elements(i).Reference = Elements(j).Reference
                lf = 1
            END IF
        END IF
        IF (i = SouthernId) THEN
            EXIT DO
        ELSE
            s = Elements(i).South
            i = s
        END IF
    LOOP
    IF (lf = 1) THEN
        FOR k = 1 TO LambdaArg
            j = Unlink(LambdaMatrix(LambdaIndex, k))
        NEXT
        LambdaIndex = LambdaIndex - 1
    END IF
 
    ' Determine return species
    i = NorthernId
    DO
        IF (i = -1) THEN EXIT DO
        IF (Elements(i).Species = "string") THEN RefSpecies = "string"
        IF ((Elements(i).Species = "double") AND (RefSpecies <> "string")) THEN RefSpecies = "double"
        IF ((Elements(i).Species = "integer") AND (RefSpecies <> "string") AND (RefSpecies <> "double")) THEN RefSpecies = "integer"
        i = Elements(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 Elements(NorthernId).Species
                CASE "integer"
                    ReturnSpecies = "double"
                    SELECT CASE Elements(SouthernId).Species
                        CASE "integer"
                            ReturnDouble = IntegerData(Elements(NorthernId).Reference) / IntegerData(Elements(SouthernId).Reference)
                        CASE "double"
                            ReturnDouble = IntegerData(Elements(NorthernId).Reference) / DoubleData(Elements(SouthernId).Reference)
                    END SELECT
                CASE "string"
                    ReturnSpecies = "string"
                    ReturnString = Literal$(NorthernId) + "/" + Literal$(SouthernId)
                CASE "double"
                    ReturnSpecies = "double"
                    SELECT CASE Elements(SouthernId).Species
                        CASE "integer"
                            ReturnDouble = DoubleData(Elements(NorthernId).Reference) / IntegerData(Elements(SouthernId).Reference)
                        CASE "double"
                            ReturnDouble = DoubleData(Elements(NorthernId).Reference) / DoubleData(Elements(SouthernId).Reference)
                    END SELECT
            END SELECT
            i = Unlink(NorthernId)
            i = Unlink(SouthernId)
        CASE "cos"
            IF (NorthernId = SouthernId) THEN
                MultiPass = 0
                i = NorthernId
                SELECT CASE Elements(i).Species
                    CASE "integer"
                        ReturnSpecies = "double"
                        ReturnDouble = COS(IntegerData(Elements(i).Reference))
                    CASE "string"
                        ReturnSpecies = "string"
                        ReturnString = "cos" + "(" + Literal$(i) + ")"
                    CASE "double"
                        ReturnSpecies = "double"
                        ReturnDouble = COS(DoubleData(Elements(i).Reference))
                END SELECT
                i = Unlink(i)
            ELSE
                MultiPass = 1
                ReturnSpecies = "string"
                ReturnString = "(" + "cos" + ")"
            END IF
        CASE "lambda"
            MultiPass = 1
            LambdaIndex = LambdaIndex + 1
            ReturnSpecies = "string"
            ReturnString = "(" + "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 Elements(i).Species
                                CASE "integer"
                                    ReturnInteger = ReturnInteger * IntegerData(Elements(i).Reference)
                                CASE "double"
                                    ReturnInteger = ReturnInteger * DoubleData(Elements(i).Reference)
                            END SELECT
                        CASE "string"
                            ReturnString = ReturnString + Literal$(i)
                        CASE "double"
                            SELECT CASE Elements(i).Species
                                CASE "integer"
                                    ReturnDouble = ReturnDouble * IntegerData(Elements(i).Reference)
                                CASE "double"
                                    ReturnDouble = ReturnDouble * DoubleData(Elements(i).Reference)
                            END SELECT
                    END SELECT
                    IF (i = SouthernId) THEN
                        i = Unlink(i)
                        EXIT DO
                    ELSE
                        s = Elements(i).South
                        i = Unlink(i)
                        i = s
                    END IF
                CASE "+"
                    SELECT CASE ReturnSpecies
                        CASE "integer"
                            SELECT CASE Elements(i).Species
                                CASE "integer"
                                    ReturnInteger = ReturnInteger + IntegerData(Elements(i).Reference)
                                CASE "double"
                                    ReturnInteger = ReturnInteger + DoubleData(Elements(i).Reference)
                            END SELECT
                        CASE "string"
                            ReturnString = ReturnString + Literal$(i)
                        CASE "double"
                            SELECT CASE Elements(i).Species
                                CASE "integer"
                                    ReturnDouble = ReturnDouble + IntegerData(Elements(i).Reference)
                                CASE "double"
                                    ReturnDouble = ReturnDouble + DoubleData(Elements(i).Reference)
                            END SELECT
                    END SELECT
                    IF (i = SouthernId) THEN
                        i = Unlink(i)
                        EXIT DO
                    ELSE
                        s = Elements(i).South
                        i = Unlink(i)
                        i = s
                    END IF
                CASE "cos"
                    SELECT CASE Elements(i).Species
                        CASE "integer"
                            Elements(i).Species = "double"
                            Elements(i).Reference = NewDoubleData(COS(IntegerData(Elements(i).Reference)))
                        CASE "string"
                            Elements(i).Reference = NewStringData("cos" + "(" + Literal$(i) + ")")
                        CASE "double"
                            Elements(i).Species = "double"
                            Elements(i).Reference = NewDoubleData(COS(DoubleData(Elements(i).Reference)))
                    END SELECT
                    IF (i = SouthernId) THEN
                        EXIT DO
                    ELSE
                        s = Elements(i).South
                        i = s
                    END IF
                CASE "lambda"
                    LambdaArg = LambdaArg + 1
                    LambdaMatrix(LambdaIndex, LambdaArg) = i
                    IF (i = SouthernId) THEN
                        EXIT DO
                    ELSE
                        s = Elements(i).South
                        i = s
                    END IF
            END SELECT
        LOOP
    END IF
 
    Elements(FunctionId).Species = ReturnSpecies
    SELECT CASE ReturnSpecies
        CASE "integer"
            Elements(FunctionId).Reference = NewIntegerData(ReturnInteger)
        CASE "string"
            Elements(FunctionId).Reference = NewStringData(ReturnString)
        CASE "double"
            Elements(FunctionId).Reference = NewDoubleData(ReturnDouble)
    END SELECT
 
    TheReturn = FunctionId
    EvalStep = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Seek and recall
'
 
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 = Elements(x).South
    e = Elements(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
    MostEmbeddedRecur = y
END SUB
 
FUNCTION ArrayId (x AS STRING)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = 1 TO UBOUND(SoftArray)
        IF (SoftArray(k).Label = x) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    ArrayId = TheReturn
END FUNCTION
 
FUNCTION SeekString (t AS STRING, x AS LONG, r AS INTEGER)
    DIM TheReturn AS LONG
    DIM s AS LONG
    DIM e AS LONG
    TheReturn = -1
    s = Elements(x).South
    e = Elements(x).East
    IF (StringData(Elements(x).Reference) = t) THEN
        TheReturn = x
        r = r - 1
    ELSE
        IF (e <> -1) AND (r > 0) THEN
            TheReturn = SeekString(t, e, r)
        END IF
        IF (s <> -1) AND (r > 0) THEN
            TheReturn = SeekString(t, s, r)
        END IF
    END IF
    SeekString = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Navigation
'
 
FUNCTION FromLabel (x AS STRING)
    DIM TheReturn AS LONG
    TheReturn = SoftArray(ArrayId(x)).FirstElement
    FromLabel = TheReturn
END FUNCTION
 
FUNCTION StepFromLabel (x AS STRING, t AS STRING)
    DIM TheReturn AS LONG
    TheReturn = StepUsing(FromLabel(x), t)
    StepFromLabel = TheReturn
END FUNCTION
 
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(Elements(x).North, "n", r - 1)
            CASE "s"
                TheReturn = JumpFrom(Elements(x).South, "s", r - 1)
            CASE "e"
                TheReturn = JumpFrom(Elements(x).East, "e", r - 1)
            CASE "w"
                TheReturn = JumpFrom(Elements(x).West, "w", r - 1)
        END SELECT
    END IF
    JumpFrom = TheReturn
END FUNCTION
 
FUNCTION StepUsing (x AS LONG, t AS STRING)
    DIM TheReturn AS LONG
    DIM k AS INTEGER
    DIM i AS LONG
    DIM j AS LONG
    i = x
    FOR k = 1 TO LEN(t)
        SELECT CASE MID$(t, k, 1)
            CASE "n"
                j = Elements(i).North
                IF (j <> -1) THEN i = j
            CASE "s"
                j = Elements(i).South
                IF (j <> -1) THEN i = j
            CASE "e"
                j = Elements(i).East
                IF (j <> -1) THEN i = j
            CASE "w"
                j = Elements(i).West
                IF (j <> -1) THEN i = j
        END SELECT
    NEXT
    TheReturn = i
    StepUsing = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Internal metrics
'
 
FUNCTION SquareArrayHeight (x AS INTEGER)
    DIM TheReturn AS INTEGER
    TheReturn = Measure(Elements(SoftArray(x).FirstElement).East, "s")
    SquareArrayHeight = TheReturn
END FUNCTION
 
FUNCTION SquareArrayWidth (x AS INTEGER)
    DIM TheReturn AS INTEGER
    TheReturn = Measure(Elements(SoftArray(x).FirstElement).East, "e")
    SquareArrayWidth = TheReturn
END FUNCTION
 
FUNCTION Measure (x AS LONG, t AS STRING)
    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 = Elements(x).North
        CASE "s"
            k = Elements(x).South
        CASE "e"
            k = Elements(x).East
        CASE "w"
            k = Elements(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 PrintSoftArray$ (x AS LONG)
    DIM TheReturn AS STRING
    DIM t AS STRING
    IF (x <> -1) THEN
        t = ListElementsRecur$(0, SoftArray(x).FirstElement)
    END IF
    TheReturn = LEFT$(t, LEN(t) - 1)
    PrintSoftArray = TheReturn
END SUB
 
FUNCTION ListElementsRecur$ (i AS INTEGER, x AS LONG)
    DIM TheReturn AS STRING
    DIM s AS LONG
    DIM e AS LONG
    s = Elements(x).South
    e = Elements(x).East
    TheReturn = TheReturn + SPACE$(i) + Literal$(x) + CHR$(10)
    IF (e <> -1) THEN
        TheReturn = TheReturn + ListElementsRecur$(i + 2, e)
    END IF
    IF (s <> -1) THEN
        TheReturn = TheReturn + ListElementsRecur$(i, s)
    END IF
    ListElementsRecur$ = TheReturn
END SUB
 
FUNCTION Literal$ (x AS LONG)
    DIM TheReturn AS STRING
    TheReturn = ""
    IF (x <> -1) THEN
        SELECT CASE Elements(x).Species
            CASE "integer"
                TheReturn = LTRIM$(RTRIM$(STR$(IntegerData(Elements(x).Reference))))
            CASE "string"
                TheReturn = StringData(Elements(x).Reference)
            CASE "double"
                TheReturn = LTRIM$(RTRIM$(STR$(DoubleData(Elements(x).Reference))))
        END SELECT
    END IF
    Literal$ = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Soft array construction
'
 
FUNCTION NextOpenSoftArray (x AS LONG)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = x TO UBOUND(SoftArrayRegister)
        IF (SoftArrayRegister(k) = 0) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    NextOpenSoftArray = TheReturn
END FUNCTION
 
FUNCTION NewSoftArray (i AS INTEGER, t AS STRING)
    DIM k AS LONG
    k = NewStringElement(t)
    IF (i < 1) THEN
        i = NextOpenSoftArray(1)
        SoftArrayRegister(i) = i
    END IF
    SoftArray(i).Label = StringData(Elements(k).Reference)
    SoftArray(i).FirstElement = k
    NewSoftArray = k
END FUNCTION
 
FUNCTION LinkSouth (n AS LONG, s AS LONG)
    DIM TheReturn AS LONG
    Elements(s).North = n
    Elements(n).South = s
    TheReturn = s
    LinkSouth = TheReturn
END FUNCTION
 
FUNCTION LinkEast (w AS LONG, e AS LONG)
    DIM TheReturn AS LONG
    Elements(w).East = e
    Elements(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 = Elements(n).South
    Elements(n).South = x
    Elements(x).North = n
    Elements(x).South = s
    IF (s <> -1) THEN
        Elements(s).North = x
    END IF
    InsertSouth = x
END FUNCTION
 
FUNCTION InsertEast (w AS LONG, x AS LONG)
    DIM e AS LONG
    e = Elements(w).East
    Elements(w).East = x
    Elements(x).West = w
    Elements(x).East = e
    IF (e <> -1) THEN
        Elements(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
    n = Elements(x).North
    s = Elements(x).South
    e = Elements(x).East
    w = Elements(x).West
    IF (n <> -1) THEN Elements(n).South = s
    IF (s <> -1) THEN Elements(s).North = n
    IF (e <> -1) THEN Elements(e).West = w
    IF (w <> -1) THEN Elements(w).East = e
    IdentityRegister(x) = 0
    Unlink = x
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Element 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) = 0) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    NextOpenIdentity = TheReturn
END FUNCTION
 
FUNCTION NewElement (x AS LONG, t AS STRING, r AS LONG)
    DIM i AS LONG
    i = NextOpenIdentity(x)
    IdentityRegister(i) = i
    Elements(i).Identity = i
    Elements(i).Species = t
    Elements(i).Reference = r
    Elements(i).North = -1
    Elements(i).South = -1
    Elements(i).East = -1
    Elements(i).West = -1
    NewElement = i
END FUNCTION
 
FUNCTION NewIntegerElement (x AS INTEGER)
    NewIntegerElement = NewElement(1, "integer", NewIntegerData(x))
END FUNCTION
 
FUNCTION NewStringElement (x AS STRING)
    NewStringElement = NewElement(1, "string", NewStringData(x))
END FUNCTION
 
FUNCTION NewDoubleElement (x AS DOUBLE)
    NewDoubleElement = NewElement(1, "double", NewDoubleData(x))
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Element editing
'
 
FUNCTION EditIntegerReference (i AS LONG, x AS INTEGER)
    DIM z AS LONG
    z = NewIntegerData(x)
    Elements(i).Reference = z
    EditIntegerReference = z
END FUNCTION
 
FUNCTION EditStringReference (i AS LONG, x AS STRING)
    DIM z AS LONG
    z = NewStringData(x)
    Elements(i).Reference = z
    EditStringReference = z
END FUNCTION
 
FUNCTION EditDoubleReference (i AS LONG, x AS DOUBLE)
    DIM z AS LONG
    z = NewDoubleData(x)
    Elements(i).Reference = z
    EditDoubleReference = z
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Data assimilation
'
 
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 NewStringData (x AS STRING)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = 1 TO UBOUND(StringData)
        IF (StringData(k) = x) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    IF (TheReturn = -1) THEN
        REDIM _PRESERVE StringData(UBOUND(StringData) + 1)
        StringData(UBOUND(Stringdata)) = x
        TheReturn = UBOUND(StringData)
    END IF
    NewStringData = 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
 

FellippeHeitor · « **Reply #17 on:** April 12, 2020, 09:20:19 am »

Allow me to pour some stupidity into this otherwise math superior thread. You know how much I respect you and how aware I am of your love for the topic, but this has now popped in my head:

For languages that do allow lambda/anonymous functions: what'd be the use of:

Code: QB64: [Select]

 PRINT {COS(3*x*5*y)} (4,6)

...if it'll never be reused? My QBrain wants to simply:

Code: QB64: [Select]

 PRINT COS(3*4*5*6)

This is an honest question.

STxAxTIC · « **Reply #18 on:** April 12, 2020, 09:30:18 am »

Damn I can answer this in spades if it werent for me heading to a nursing home to solve a drain problem.

For now, and this is kind of occult knowledge, but try to imagine when I've used the dollar sign in sxript- it's the same thing used there

STxAxTIC · « **Reply #19 on:** April 12, 2020, 10:53:31 pm »

Alrighty, so Fellippe's question was more-or-less handled on Discord, but a public question still deserves some kind of public answer.

As I mentioned earlier,

Quote

...this stuff has much more power when your surrounding paradigm leans functional, meaning functions and code are passed around as data. I know that sounds weird, and I'm afraid I won't try to justify it in this paragraph.

I guess I need to justify it in *this* paragraph. The real problem is these concepts can't be taken in isolation - so here comes yet another mouthful. The example language I'm using is Sxript for non-self-serving reasons... It turns out QB64 has no analog for the stuff that follows...

High Order Function

So first we need a high-order function. These can be thought of as functions that have no distinct job until called with special arguments. The arguments need to somehow contain *code*, which sounds weird as hell a QB64 coder. The high-order function we'll use is extremely simple:

Code: [Select]

func(DoSomething,{[x]([y])})
Inside the curly braces, you see the very simple form x(y). This means the DoSomething function can take *any* two arguments x, y as long as the resulting statement makes sense. For example, these lines

Code: [Select]

DoSomething(cos,3)

DoSomething(sin,3)

... are immediately translated to cos(3) and sin(3). Everyone with me?

Anonymous Function

Now we may ask, "what if the x-argument I send to DoSomething isn't a named function"? That is, suppose we want to calculate cos(3)+sin(3). Of course, you're totally allowed to write

Code: [Select]

func(cosplussin,{cos([x])+sin([x])})

DoSomething(cosplussin,3)

... which is totally fine... but the new argument is: why name the function if we're only using it once? Or - can the above be done in one line? Yes, that's where the anonymous function steps in:

Code: [Select]

DoSomething($({sin([x])+cos([x])}),3)
There you can see the guts of the function, even contained in curly braces, but we never named the function. This is what's going on in the latest update to the Soft Arrays code.

Code as Data

I can still hear it though: that question "why not just hardcode the one-liner, with or without a function?"... This question is brilliantly met with the idea of code as data. Consider the following Sxript line:

Code: [Select]

let(a, {[x]+tan([x])} )
Here we have a variable, not a function, that contains the instruction x+tan(x). Note now that the content of the curly braces could be made by ANY process - ask the user to type a function, piece one together from other snippets, etc. - point is, you can do anything you want to build the contents of let(a, {...} ). This is the idea behind code as data. The advantage? Send it right to your high-order function as an anonymous function:

Code: [Select]

DoSomething($([a]),3)
Conclusion

Forgive my sloppy introduction to functional programming concepts if you've already heard of this stuff. If not though, consider yourself led to water!

The full code I was working with is right here:

Code: [Select]

func(DoSomething,{[x]([y])})                      :
print_DoSomething(cos,3)                         ,:
print_DoSomething(sin,3)                         ,:
print_DoSomething($({sin([x])+cos([x])}),3)      ,:
let(a, {[x]+tan([x])} )                           :
print_DoSomething($([a]),3)                      ,:

... which can be pasted into the console at http://barnes.x10host.com/sxript/docs/console/console.html to see it work.

FellippeHeitor · « **Reply #20 on:** April 12, 2020, 11:09:04 pm »

Thanks, man. Nicely put.

STxAxTIC · « **Reply #21 on:** April 19, 2020, 10:45:48 am »

Alright, this update was far harder to churn out, namely from getting lost in my own notation because I still work in the trenches 60 hours a week. Lockdown? What lockdown...?

I should also apologize for not responding to data-related discussions on adjacent threads, which transitions into today's update. Rather than wax poetic about the recent streamlining, I decided to code a visual component to this code base. Don't worry - it's still layered properly and the graphics are in no way essential to anything - it's pure sugar.

This can be taken in any number of directions, which is why it's the perfect place to stop. From the demos below, I hope you can see this code going in the direction of databases, list processing, (god willing) a LISP-like scripting language, etc. etc. etc. Rather than pursue any of those, I think it'll be best to package this code as a plug-n-play library that can stand in for regular arrays when your data becomes less linear.

For now though, just press enter to sail through each demo - there's nothing else to do.

Code: QB64: [Select]

' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Meta:
'
 
OPTION _EXPLICIT
RANDOMIZE TIMER
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Begin BI-component.
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Hard arrays to store actual data:
'
REDIM SHARED IntegerData(0) AS INTEGER
REDIM SHARED StringData(0) AS STRING
REDIM SHARED DoubleData(0) AS DOUBLE
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Temp variable(s):
'
 
DIM k AS LONG
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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 = 9999
 
' Node visibility toggle
DIM SHARED IdentityRegister(MaxNodes) AS LONG
FOR k = 1 TO UBOUND(IdentityRegister)
    IdentityRegister(k) = 0
NEXT
 
' Node storage
DIM SHARED Nodes(MaxNodes) AS Node
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Linked lists:
'
 
' Linked list structure
TYPE LinkedListStructure
    Label AS STRING
    FirstNode AS LONG
END TYPE
 
DIM MaxLinkedLists AS INTEGER
MaxLinkedLists = 99
 
' Linked list visibility toggle
DIM SHARED LinkedListRegister(MaxLinkedLists) AS INTEGER
FOR k = 1 TO UBOUND(LinkedListRegister)
    LinkedListRegister(k) = 0
NEXT
 
' Linked list storage
DIM SHARED LinkedList(MaxLinkedLists) AS LinkedListStructure
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Processing
'
DIM SHARED LambdaMatrix(99, 9) AS LONG
DIM SHARED LambdaIndex AS INTEGER
DIM SHARED LambdaArgCount(9) AS LONG
LambdaIndex = 0
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' End BI-component.
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Pre-Main
'
 
SCREEN _NEWIMAGE(800, 600, 32)
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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
END TYPE
 
DIM MaxVisualNodess AS INTEGER
DIM SHARED VisualNodesCount AS INTEGER
MaxVisualNodess = 256
VisualNodesCount = 0
 
' Visual node storage
DIM SHARED VisualNodes(MaxVisualNodess) AS VisualNodesStructure
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Main
'
 
'
CALL DemoArray3D
'
CALL DemoTree
'
CALL DemoTreeEdit
'
CALL DemoArithmetic
'
CALL DemoList
'
CALL DemoLambda
'
CALL DemoMerge
'
 
 
END
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Visual Node graphics (OPTIONAL)
'
 
SUB ReportVisualNodes (x AS LONG, x0 AS DOUBLE, y0 AS DOUBLE)
    DIM k AS INTEGER
    PRINT PrintLinkedList$(Literal$(x))
    VisualNodesCount = 0
    CALL VisualListRecur(x, x0, y0)
    FOR k = 1 TO VisualNodesCount
        CALL DrawWires(k)
        CALL DrawVisualNode(k)
    NEXT
END SUB
 
SUB VisualListRecur (x AS LONG, x0 AS DOUBLE, y0 AS DOUBLE)
    DIM s AS LONG
    DIM e AS LONG
    s = Nodes(x).South
    e = Nodes(x).East
    VisualNodesCount = VisualNodesCount + 1
    CALL DefineVisualNode(VisualNodesCount, x, x0, y0)
    y0 = y0 - 30
    IF (e <> -1) THEN
        CALL VisualListRecur(e, x0 + 25, y0)
    END IF
    IF (s <> -1) THEN
        CALL VisualListRecur(s, x0, y0)
    END IF
END SUB
 
SUB DefineVisualNode (i AS INTEGER, x AS LONG, x0 AS DOUBLE, y0 AS DOUBLE)
    DIM cx AS DOUBLE
    DIM cy AS DOUBLE
    DIM h AS DOUBLE
    DIM w AS DOUBLE
    cx = x0
    cy = y0
    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
 
SUB DrawVisualNode (x AS LONG)
    CALL clineb(VisualNodes(x).CornerNE.x, VisualNodes(x).CornerNE.y, VisualNodes(x).CornerSW.x, VisualNodes(x).CornerSW.y, _RGB32(255, 255, 255))
    CALL cprintstring(VisualNodes(x).CornerNW.x + 8, VisualNodes(x).CornerNW.y - 4, Literal$(VisualNodes(x).Reference))
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 DrawWires (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, _RGB32(255, 255, 255))
        CALL ccircle(VisualNodes(x).AntennaS.x, VisualNodes(x).AntennaS.y, 3, _RGB32(255, 255, 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, _RGB32(255, 255, 255))
        CALL ccircle(VisualNodes(x).AntennaE.x, VisualNodes(x).AntennaE.y, 3, _RGB32(255, 255, 255))
    END IF
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 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 cprintstring (x1 AS DOUBLE, y1 AS DOUBLE, a AS STRING)
    '_PRINTSTRING (_WIDTH / 2 - (LEN(a) * 8) / 2, -y + _HEIGHT / 2), a
    _PRINTSTRING (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), a
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Demo cases:
'
 
SUB DemoMerge
    DIM a AS LONG
    DIM b AS LONG
    a = NewLinkedList("top part")
    a = LinkEast(a, NewStringNode("lambda"))
    b = LinkEast(a, NewIntegerNode(4))
    b = LinkSouth(b, NewIntegerNode(6))
    a = NewUnitList("cow", NewIntegerNode(5))
    a = NewLinkedList("bottom part")
    a = LinkEast(a, NewStringNode("cos"))
    b = LinkEast(a, NewStringNode("*"))
    b = LinkEast(b, NewIntegerNode(3))
    b = LinkSouth(b, NewStringNode("[1]"))
    b = LinkSouth(b, NewIntegerNode(IntegerData(Nodes(Nodes(FirstFromLabel("cow")).East).Reference)))
    b = LinkSouth(b, NewStringNode("[2]"))
 
    CALL ReportVisualNodes(FirstFromLabel("top part"), 0, .9 * _HEIGHT / 2):
    CALL ReportVisualNodes(FirstFromLabel("bottom part"), 0, 0):
    PRINT: PRINT "Press any key...": SLEEP: CLS
 
    a = ListId("bottom part")
    b = LinkedList(a).FirstNode
    LinkedListRegister(a) = 0
    IdentityRegister(b) = 0
 
    a = Nodes(LinkedList(ListId("top part")).FirstNode).East
    b = Nodes(b).East
    Nodes(b).North = a
    Nodes(a).South = b
 
    CALL ReportVisualNodes(FirstFromLabel("top part"), 0, .9 * _HEIGHT / 2)
    PRINT: PRINT "Press any key...": SLEEP: CLS
 
    a = Evaluate(FirstFromLabel("top part"))
 
    CALL ReportVisualNodes(FirstFromLabel("top part"), 0, .9 * _HEIGHT / 2)
    PRINT: PRINT "Press any key...": SLEEP: CLS
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoLambda
    DIM a AS LONG
    DIM b AS LONG
    a = NewUnitList("cow", NewIntegerNode(5))
    a = NewLinkedList("Lambda Test")
    a = LinkEast(a, NewStringNode("lambda"))
    b = LinkEast(a, NewIntegerNode(4))
    b = LinkSouth(b, NewIntegerNode(6))
    a = LinkSouth(a, NewStringNode("cos"))
    b = LinkEast(a, NewStringNode("*"))
    b = LinkEast(b, NewIntegerNode(3))
    b = LinkSouth(b, NewStringNode("[1]"))
    b = LinkSouth(b, NewIntegerNode(IntegerData(Nodes(Nodes(FirstFromLabel("cow")).East).Reference)))
    b = LinkSouth(b, NewStringNode("[2]"))
 
    CALL ReportVisualNodes(FirstFromLabel("Lambda Test"), 0, .9 * _HEIGHT / 2)
    PRINT: PRINT "Press any key...": SLEEP: CLS
 
    a = Evaluate(FirstFromLabel("Lambda Test"))
 
    CALL ReportVisualNodes(FirstFromLabel("Lambda Test"), 0, .9 * _HEIGHT / 2)
    PRINT: PRINT "Press any key...": SLEEP: CLS
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoList
    DIM a AS LONG
    DIM b AS LONG
    a = NewLinkedList("List Test")
    a = LinkEast(a, NewStringNode("cos"))
    b = LinkEast(a, NewStringNode("three"))
    b = LinkSouth(b, NewStringNode("four"))
    b = LinkSouth(b, NewStringNode("five"))
    b = LinkSouth(b, NewStringNode("six"))
    b = LinkSouth(b, NewStringNode("seven"))
    a = LinkSouth(a, NewStringNode("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 ReportVisualNodes(FirstFromLabel("List Test"), 0, .9 * _HEIGHT / 2)
    PRINT: PRINT "Press any key...": SLEEP: CLS
 
    a = Evaluate(FirstFromLabel("List Test"))
 
    CALL ReportVisualNodes(FirstFromLabel("List Test"), 0, .9 * _HEIGHT / 2)
    PRINT: PRINT "Press any key...": SLEEP: CLS
END SUB
 
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoArithmetic
    DIM a AS LONG
    DIM b AS LONG
    a = NewLinkedList("Arithmetic Test")
    a = LinkEast(a, NewStringNode("*"))
    b = LinkEast(a, NewIntegerNode(3))
    b = LinkSouth(b, NewIntegerNode(4))
    a = LinkSouth(b, NewStringNode("cos"))
    b = LinkEast(a, NewStringNode("+"))
    b = LinkEast(b, NewIntegerNode(4))
    b = LinkSouth(b, NewIntegerNode(7))
    b = LinkSouth(a, NewIntegerNode(2))
 
    CALL ReportVisualNodes(FirstFromLabel("Arithmetic Test"), 0, .9 * _HEIGHT / 2)
    PRINT: PRINT "Press any key...": SLEEP: CLS
 
    a = Evaluate(FirstFromLabel("Arithmetic Test"))
 
    CALL ReportVisualNodes(FirstFromLabel("Arithmetic Test"), 0, .9 * _HEIGHT / 2)
    PRINT: PRINT "Press any key...": SLEEP: CLS
 
    a = NewLinkedList("Arithmetic Test2")
    a = LinkEast(a, NewStringNode("/"))
    b = LinkEast(a, NewIntegerNode(3))
    a = LinkSouth(b, NewStringNode("cos"))
    b = LinkEast(a, NewStringNode("+"))
    b = LinkEast(b, NewIntegerNode(4))
    b = LinkSouth(b, NewDoubleNode(DoubleData(Nodes(Nodes(FirstFromLabel("Arithmetic Test")).East).Reference)))
 
    CALL ReportVisualNodes(FirstFromLabel("Arithmetic Test2"), 0, .9 * _HEIGHT / 2)
    PRINT: PRINT "Press any key...": SLEEP: CLS
 
    a = Evaluate(FirstFromLabel("Arithmetic Test2"))
 
    CALL ReportVisualNodes(FirstFromLabel("Arithmetic Test2"), 0, .9 * _HEIGHT / 2)
    PRINT: PRINT "Press any key...": SLEEP: CLS
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoTreeEdit
    DIM a AS LONG
    DIM b AS LONG
    DIM c AS LONG
    a = NewLinkedList("Tree Edit Test")
    a = LinkEast(a, NewStringNode("QB64 Buddy"))
    a = LinkEast(a, NewStringNode("Handle"))
    b = LinkEast(a, NewStringNode("flukiluke"))
    a = LinkSouth(a, NewStringNode("Name"))
    b = LinkEast(a, NewStringNode("Luke C."))
    a = LinkSouth(a, NewStringNode("Country"))
    b = LinkEast(a, NewStringNode("Australia"))
    c = LinkEast(b, NewStringNode("Locality"))
    b = LinkEast(c, NewStringNode("Down Under"))
    a = LinkSouth(a, NewStringNode("Birthyear"))
    b = LinkEast(a, NewIntegerNode(1523))
    c = LinkSouth(b, NewStringNode("May???"))
 
    CALL ReportVisualNodes(FirstFromLabel("Tree Edit Test"), 0, .9 * _HEIGHT / 2)
    PRINT: PRINT "Press any key...": SLEEP: CLS
 
    PRINT "Inserting `Get it?' into list..."
    a = InsertEast(SeekString("Down Under", FirstFromLabel("Tree Edit Test"), 1), NewStringNode("Get it?"))
    PRINT "Adding new entry to bottom of list..."
    a = InsertSouth(SeekString("QB64 Buddy", FirstFromLabel("Tree Edit Test"), 1), NewStringNode("QB64 Enemy"))
    PRINT "Editing Birthyear..."
    a = EditIntegerReference(StepUsing(SeekString("Birthyear", FirstFromLabel("Tree Edit Test"), 1), "e"), 1855)
    PRINT "Deleting a few entries under Country..."
    a = LinkEast(SeekString("Country", FirstFromLabel("Tree Edit Test"), 1), SeekString("Down Under", FirstFromLabel("Tree Edit Test"), 1))
    PRINT "Unlinking Name..."
    a = Unlink(SeekString("Name", FirstFromLabel("Tree Edit Test"), 1))
    PRINT
 
    CALL ReportVisualNodes(FirstFromLabel("Tree Edit Test"), 0, .9 * _HEIGHT / 2)
    PRINT: PRINT "Press any key...": SLEEP: CLS
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoTree
    DIM a AS LONG
    DIM b AS LONG
    DIM c AS LONG
    DIM d AS LONG
    a = NewLinkedList("Tree of Friends")
    a = LinkEast(a, NewStringNode("QB64 Buddy")): d = a
    a = LinkEast(a, NewStringNode("Handle"))
    b = LinkEast(a, NewStringNode("SMcNeill"))
    a = LinkSouth(a, NewStringNode("Name"))
    b = LinkEast(a, NewStringNode("Steve SMcNeill"))
    a = LinkSouth(a, NewStringNode("Country"))
    b = LinkEast(a, NewStringNode("USA"))
    c = LinkEast(b, NewStringNode("Locality"))
    b = LinkEast(c, NewStringNode("Virginia"))
    a = LinkSouth(a, NewStringNode("Birthyear"))
    b = LinkEast(a, NewIntegerNode(1973))
    c = LinkSouth(b, NewStringNode("May?"))
    a = LinkSouth(d, NewStringNode("QB64 Buddy")): d = a
    a = LinkEast(a, NewStringNode("Handle"))
    b = LinkEast(a, NewStringNode("FellippeHeitor"))
    a = LinkSouth(a, NewStringNode("Name"))
    b = LinkEast(a, NewStringNode("Fellippe Heitor"))
    a = LinkSouth(a, NewStringNode("Country"))
    b = LinkEast(a, NewStringNode("Brazil"))
    c = LinkEast(b, NewStringNode("Locality"))
    b = LinkEast(c, NewStringNode("My <3"))
    c = LinkEast(b, NewStringNode("JK, it's ___."))
    a = LinkSouth(a, NewStringNode("Birthyear"))
    b = LinkEast(a, NewIntegerNode(1983))
    c = LinkSouth(b, NewStringNode("Sep?"))
    b = LinkSouth(c, NewStringNode("... or was it May?"))
    a = LinkSouth(d, NewStringNode("QB64 Buddy")): d = a
    a = LinkEast(a, NewStringNode("Handle"))
    b = LinkEast(a, NewStringNode("DanTurtle"))
 
    ' Query tests
    'PRINT "Height:"; SquareListHeight(ListId("Tree of Friends"))
    'PRINT "Steve's locality: "; Literal$(StepFirstFromLabel("Tree of Friends", "eesseee"))
    'PRINT "Fellippe's locality: "; Literal$(StepFirstFromLabel("Tree of Friends", "esesseee"))
    'PRINT "Fellippe's birth month: "; Literal$(StepUsing(JumpFrom(StepFirstFromLabel("Tree of Friends", "ese"), "s", 3), "es"))
    'PRINT "Width of Fellippe's Country branch:"; Measure(SeekString("Country", FirstFromLabel("Tree of Friends"), 2), "e")
    'PRINT "Height under Fellippe's Birthyear branch:"; Measure(Nodes(SeekString("Birthyear", FirstFromLabel("Tree of Friends"), 2)).East, "s")
    'PRINT
 
    CALL ReportVisualNodes(FirstFromLabel("Tree of Friends"), 0, .9 * _HEIGHT / 2)
    PRINT: PRINT "Press any key...": SLEEP: CLS
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoArray3D
    DIM TestArray3D(2, 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"
    'TestArray3D(4, 1, 1) = "four.one.one"
    'TestArray3D(4, 1, 2) = "four.one.two"
    'TestArray3D(4, 1, 3) = "four.one.three"
    'TestArray3D(4, 2, 1) = "four.two.one"
    'TestArray3D(4, 2, 2) = "four.two.two"
    'TestArray3D(4, 2, 3) = "four.two.three"
    DIM i AS INTEGER
    DIM j AS INTEGER
    DIM k AS INTEGER
    DIM a AS LONG
    DIM b AS LONG
    a = NewLinkedList("Three-Dimensional Array")
    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, NewStringNode(TestArray3D(i, j, k)))
                    b = a
                ELSE
                    IF (k = 1) THEN
                        a = LinkSouth(a, NewStringNode(TestArray3D(i, j, k)))
                        b = a
                    ELSE
                        b = LinkEast(b, NewStringNode(TestArray3D(i, j, k)))
                    END IF
                END IF
            NEXT
        NEXT
    NEXT
 
    ' Query tests
    PRINT "Height:"; SquareListHeight(ListId("Three-Dimensional Array"))
    PRINT "Width:"; SquareListWidth(ListId("Three-Dimensional Array"))
    PRINT
 
    CALL ReportVisualNodes(FirstFromLabel("Three-Dimensional Array"), 0, .9 * _HEIGHT / 2)
    PRINT: PRINT "Press any key...": SLEEP: CLS
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Begin BM-component.
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Processing
'
 
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
            a = Nodes(a).South
            IF (a = -1) THEN
                EXIT DO
            END IF
        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 ReturnString AS STRING
    DIM ReturnDouble AS DOUBLE
    DIM MultiPass AS INTEGER
 
    RefSpecies = ""
    FunctionId = x
    ReturnSpecies = ""
    ReturnInteger = 0
    ReturnString = ""
    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
        ReturnSpecies = Nodes(FunctionId).Species
        SELECT CASE ReturnSpecies
            CASE "integer"
                ReturnInteger = IntegerData(Nodes(FunctionId).Reference)
            CASE "string"
                ReturnString = StringData(Nodes(FunctionId).Reference)
            CASE "double"
                ReturnDouble = DoubleData(Nodes(FunctionId).Reference)
        END SELECT
    END IF
 
    ' Lambda substitution
    i = NorthernId
    DIM lf AS INTEGER
    lf = 0
    DO
        IF (Nodes(i).Species = "string") THEN
            IF (StringData(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 (StringData(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 = "string") THEN RefSpecies = "string"
        IF ((Nodes(i).Species = "double") AND (RefSpecies <> "string")) THEN RefSpecies = "double"
        IF ((Nodes(i).Species = "integer") AND (RefSpecies <> "string") 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 "string"
                    ReturnSpecies = "string"
                    ReturnString = 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 "string"
                        ReturnSpecies = "string"
                        ReturnString = "cos" + "(" + Literal$(i) + ")"
                    CASE "double"
                        ReturnSpecies = "double"
                        ReturnDouble = COS(DoubleData(Nodes(i).Reference))
                END SELECT
                i = Unlink(i)
            ELSE
                MultiPass = 1
                ReturnSpecies = "string"
                ReturnString = "(" + "cos" + ")"
            END IF
        CASE "lambda"
            MultiPass = 1
            LambdaIndex = LambdaIndex + 1
            ReturnSpecies = "string"
            ReturnString = "(" + "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 "string"
                            ReturnString = ReturnString + 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 "string"
                            ReturnString = ReturnString + 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 "string"
                            Nodes(i).Reference = NewStringData("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 "string"
            Nodes(FunctionId).Species = ReturnSpecies
            Nodes(FunctionId).Reference = NewStringData(ReturnString)
        CASE "double"
            Nodes(FunctionId).Species = ReturnSpecies
            Nodes(FunctionId).Reference = NewDoubleData(ReturnDouble)
    END SELECT
 
    TheReturn = FunctionId
    EvalStep = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Seek and recall
'
 
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
    MostEmbeddedRecur = y
END SUB
 
FUNCTION SeekString (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 (StringData(Nodes(x).Reference) = t) THEN
        TheReturn = x
        r = r - 1
    ELSE
        IF (e <> -1) AND (r > 0) THEN
            TheReturn = SeekString(t, e, r)
        END IF
        IF (s <> -1) AND (r > 0) THEN
            TheReturn = SeekString(t, s, r)
        END IF
    END IF
    SeekString = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Navigation
'
 
FUNCTION ListId (t AS STRING)
    ' Takes linked list label as argument.
    ' Returns index of linked list.
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = 1 TO UBOUND(LinkedList)
        IF (LinkedList(k).Label = t) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    ListId = TheReturn
END FUNCTION
 
FUNCTION FirstFromLabel (t AS STRING)
    ' Takes linked list label as argument.
    ' Returns first node identity.
    DIM TheReturn AS LONG
    TheReturn = LinkedList(ListId(t)).FirstNode
    FirstFromLabel = TheReturn
END FUNCTION
 
FUNCTION StepFirstFromLabel (x AS STRING, t AS STRING)
    DIM TheReturn AS LONG
    TheReturn = StepUsing(FirstFromLabel(x), t)
    StepFirstFromLabel = TheReturn
END FUNCTION
 
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 StepUsing (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
    StepUsing = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Internal metrics
'
 
FUNCTION SquareListHeight (x AS INTEGER)
    DIM TheReturn AS INTEGER
    TheReturn = Measure(Nodes(LinkedList(x).FirstNode).East, "s")
    SquareListHeight = TheReturn
END FUNCTION
 
FUNCTION SquareListWidth (x AS INTEGER)
    DIM TheReturn AS INTEGER
    TheReturn = Measure(Nodes(LinkedList(x).FirstNode).East, "e")
    SquareListWidth = TheReturn
END FUNCTION
 
FUNCTION Measure (x AS LONG, t AS STRING)
    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 ReportVisualNodesing
'
 
FUNCTION PrintLinkedList$ (x AS STRING)
    DIM TheReturn AS STRING
    DIM t AS STRING
    t = ListNodesRecur$(0, LinkedList(ListId(x)).FirstNode)
    TheReturn = LEFT$(t, LEN(t) - 1)
    PrintLinkedList$ = 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 + SPACE$(i) + Literal$(x) + CHR$(10)
    IF (e <> -1) THEN
        TheReturn = TheReturn + ListNodesRecur$(i + 2, e)
    END IF
    IF (s <> -1) THEN
        TheReturn = TheReturn + ListNodesRecur$(i, s)
    END IF
    ListNodesRecur$ = 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 "string"
                TheReturn = StringData(Nodes(x).Reference)
            CASE "double"
                TheReturn = LTRIM$(RTRIM$(STR$(DoubleData(Nodes(x).Reference))))
        END SELECT
    END IF
    Literal$ = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Linked list construction
'
 
FUNCTION NewUnitList (t AS STRING, x AS LONG)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = NewLinkedList(t)
    k = LinkEast(TheReturn, x)
    NewUnitList = TheReturn
END FUNCTION
 
FUNCTION NewLinkedList (t AS STRING)
    DIM i AS LONG
    DIM k AS LONG
    k = NewStringNode(t)
    i = NextOpenLinkedList(1)
    LinkedListRegister(i) = i
    LinkedList(i).Label = StringData(Nodes(k).Reference)
    LinkedList(i).FirstNode = k
    NewLinkedList = k
END FUNCTION
 
FUNCTION NextOpenLinkedList (x AS LONG)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = x TO UBOUND(LinkedListRegister)
        IF (LinkedListRegister(k) = 0) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    NextOpenLinkedList = 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
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Linked list 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
    n = Nodes(x).North
    s = Nodes(x).South
    e = Nodes(x).East
    w = Nodes(x).West
    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
    IdentityRegister(x) = 0
    Unlink = x
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) = 0) 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 NewIntegerNode (x AS INTEGER)
    NewIntegerNode = NewNode(1, "integer", NewIntegerData(x))
END FUNCTION
 
FUNCTION NewStringNode (x AS STRING)
    NewStringNode = NewNode(1, "string", NewStringData(x))
END FUNCTION
 
FUNCTION NewDoubleNode (x AS DOUBLE)
    NewDoubleNode = NewNode(1, "double", NewDoubleData(x))
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Node editing
'
 
FUNCTION EditIntegerReference (i AS LONG, x AS INTEGER)
    DIM z AS LONG
    z = NewIntegerData(x)
    Nodes(i).Reference = z
    EditIntegerReference = z
END FUNCTION
 
FUNCTION EditStringReference (i AS LONG, x AS STRING)
    DIM z AS LONG
    z = NewStringData(x)
    Nodes(i).Reference = z
    EditStringReference = z
END FUNCTION
 
FUNCTION EditDoubleReference (i AS LONG, x AS DOUBLE)
    DIM z AS LONG
    z = NewDoubleData(x)
    Nodes(i).Reference = z
    EditDoubleReference = z
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Data assimilation
'
 
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 NewStringData (x AS STRING)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = 1 TO UBOUND(StringData)
        IF (StringData(k) = x) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    IF (TheReturn = -1) THEN
        REDIM _PRESERVE StringData(UBOUND(StringData) + 1)
        StringData(UBOUND(Stringdata)) = x
        TheReturn = UBOUND(StringData)
    END IF
    NewStringData = 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.
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'''
'FOR k = 1 TO UBOUND(LinkedListRegister)
'    IF (LinkedListRegister(k) <> 0) THEN
'        PRINT LinkedList(k).Label
'    END IF
'NEXT
'FOR k = 1 TO UBOUND(IdentityRegister)
'    IF (IdentityRegister(k) <> 0) THEN
'        a = IdentityRegister(k)
'        PRINT Literal$(a) + " (" + Literal$(Nodes(a).North) + "," + Literal$(Nodes(a).South) + "," + Literal$(Nodes(a).East) + "," + Literal$(Nodes(a).West) + ")" '+ CHR$(10)
'    END IF
'NEXT
'FOR k = 1 TO UBOUND(IdentityRegister)
'    IF (IdentityRegister(k) <> 0) THEN
'        CALL DefineVisualNode(k)
'    END IF
'NEXT
'''

Pete · « **Reply #22 on:** April 19, 2020, 12:36:17 pm »

Wow, graphics plus linked lists. Does this mean I get to call you Art Linklister?

Sorry, it turns out us old farts say the darnedest things, too. Especially us really old ones, like flukiluke. I never new he was born during the Middle Ages until I ran your demo... and in May, nonetheless. I took offense at first, but then recovered when I realized all your QB buds were born in May. Me? I was born in protest.

Nice work, and glad you're still at work. I think if everyone did virus control practices like we .orggers do, we'd have no virus transmission at all. For instance, Steve and I practice staying 3,000 miles apart at all times. Well, at least until I go out to get my mail, then it's only 2,999.95 miles.

Pete

STxAxTIC · « **Reply #23 on:** April 30, 2020, 10:10:58 pm »

Hello all,

Made many updates to this codebase - plenty of boring eggheaded stuff I'll skip - because this update has mouse control. Yup, GUI stuff, who'd have thought it? What you can do is click+drag to move nodes around, with a hitch. If you move a node that has child nodes, they also move. It's easier done than said:

Code: QB64: [Select]

' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Meta:
'
 
OPTION _EXPLICIT
RANDOMIZE TIMER
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Begin BI-component.
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Hard arrays to store actual data:
'
REDIM SHARED IntegerData(0) AS INTEGER
REDIM SHARED StringData(0) AS STRING
REDIM SHARED DoubleData(0) AS DOUBLE
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Temp variable(s):
'
 
DIM k AS LONG
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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 = 9999
 
' Node visibility toggle
DIM SHARED IdentityRegister(MaxNodes) AS LONG
FOR k = 1 TO UBOUND(IdentityRegister)
    IdentityRegister(k) = 0
NEXT
 
' Node storage
DIM SHARED Nodes(MaxNodes) AS Node
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Linked lists:
'
 
' Linked list structure
TYPE LinkedListStructure
    Label AS STRING
    HeadNode AS LONG
END TYPE
 
DIM MaxLinkedLists AS INTEGER
MaxLinkedLists = 99
 
' Linked list visibility toggle
DIM SHARED LinkedListRegister(MaxLinkedLists) AS INTEGER
FOR k = 1 TO UBOUND(LinkedListRegister)
    LinkedListRegister(k) = 0
NEXT
 
' Linked list storage
DIM SHARED LinkedList(MaxLinkedLists) AS LinkedListStructure
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Processing
'
DIM SHARED LambdaMatrix(99, 9) AS LONG
DIM SHARED LambdaIndex AS INTEGER
DIM SHARED LambdaArgCount(9) AS LONG
LambdaIndex = 0
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' End BI-component.
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Pre-Main
'
 
SCREEN _NEWIMAGE(800, 600, 32)
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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
END TYPE
 
DIM MaxVisualNodess AS INTEGER
DIM SHARED VisualNodesCount AS INTEGER
MaxVisualNodess = 256
VisualNodesCount = 0
 
' Visual node storage
DIM SHARED VisualNodes(MaxVisualNodess) AS VisualNodesStructure
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Main
'
 
 
''
'CALL LoadArray3D("Three-Diensional Array")
''
CALL DemoTree
CALL UserLoop
''
'CALL DemoTreeEdit
''
'CALL DemoArithmetic
''
'CALL DemoList
''
''CALL DemoLambda
''
'CALL DemoMerge
 
END
 
 
DIM a AS LONG
a = NewUnitList("cow", NewIntegerNode(7))
a = NewUnitList("goo", NewDoubleNode(5.6))
 
VisualNodesCount = 0
FOR k = 1 TO UBOUND(LinkedListRegister)
    IF (LinkedListRegister(k) <> 0) THEN
        'PRINT PrintLinkedList$(LinkedList(k).HeadNode)
        CALL BuildVisualList(LinkedList(k).HeadNode, -1, .9 * (RND - .5) * _WIDTH, .9 * _HEIGHT / 2)
    END IF
NEXT
 
CALL UserLoop
 
 
END
 
SUB Halt
    PRINT "Press any key..."
    _DISPLAY
    DO: LOOP UNTIL INKEY$ <> ""
    CLS
    _DISPLAY
END SUB
 
SUB UserLoop
    DIM xx AS DOUBLE
    DIM yy AS DOUBLE
    DIM dx AS DOUBLE
    DIM dy AS DOUBLE
    DIM r AS DOUBLE
    DIM d AS DOUBLE
    DIM k AS INTEGER
    DIM i AS INTEGER
 
    _KEYCLEAR
 
    DO
        DO WHILE _MOUSEINPUT
            r = 9999
            i = -1
            xx = _MOUSEX
            yy = _MOUSEY
            IF ((xx > 0) AND (xx < _WIDTH) AND (yy > 0) AND (yy < _HEIGHT)) THEN
                xx = (xx - _WIDTH / 2)
                yy = (-yy + _HEIGHT / 2)
                FOR k = 1 TO VisualNodesCount
                    d = (xx - VisualNodes(k).BoxCenter.x) * (xx - VisualNodes(k).BoxCenter.x) + (yy - VisualNodes(k).BoxCenter.y) * (yy - VisualNodes(k).BoxCenter.y)
                    IF (d < r) THEN
                        r = d
                        i = k
                        dx = xx - VisualNodes(k).BoxCenter.x
                        dy = yy - VisualNodes(k).BoxCenter.y
                    END IF
                NEXT
            END IF
            IF (i <> -1) THEN
                IF _MOUSEBUTTON(1) THEN
                    CALL MoveVisualNodesRecur(i, VisualNodes(i).Reference, dx, dy)
                END IF
            END IF
        LOOP
 
        k = _KEYHIT
        SELECT CASE k
            CASE 27
                _KEYCLEAR
                EXIT SUB
        END SELECT
 
        CLS
 
        CALL DrawAllNodes
 
        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
                    LOCATE 1, 1: PRINT Literal$(VisualNodes(i).Reference)
                END IF
            END IF
        END IF
 
        _DISPLAY
        _LIMIT 30
    LOOP
 
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Visual Node graphics (OPTIONAL)
'
 
SUB BuildVisualList (x AS LONG, i AS INTEGER, x0 AS DOUBLE, y0 AS DOUBLE)
    IF (i <> -1) THEN
        VisualNodesCount = i
    END IF
    CALL VisualListRecur(x, x0, y0)
END SUB
 
SUB DrawAllNodes
    DIM k AS INTEGER
    FOR k = 1 TO VisualNodesCount
        CALL DrawWires(k)
        CALL DrawSingleNode(k)
    NEXT
END SUB
 
SUB VisualListRecur (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 VisualListRecur(e, x0 + dxtmp, y0)
    END IF
    IF (s <> -1) THEN
        CALL VisualListRecur(s, x0, y0)
    END IF
END SUB
 
SUB MoveSingleVisualNode (i AS INTEGER, x AS LONG, dx AS DOUBLE, dy AS DOUBLE)
    DIM cx AS DOUBLE
    DIM cy AS DOUBLE
    cx = VisualNodes(i).BoxCenter.x
    cy = VisualNodes(i).BoxCenter.y
    CALL DefineVisualNode(i, x, cx + dx, cy + dy)
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
    CALL MoveSingleVisualNode(i, x, dx, dy)
    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
END SUB
 
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
 
SUB DrawSingleNode (x AS LONG)
    CALL clineb(VisualNodes(x).CornerNE.x, VisualNodes(x).CornerNE.y, VisualNodes(x).CornerSW.x, VisualNodes(x).CornerSW.y, _RGB32(255, 255, 255))
    CALL cprintstring(VisualNodes(x).CornerNW.x + 6, VisualNodes(x).CornerNW.y - 4, Literal$(VisualNodes(x).Reference))
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 DrawWires (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, _RGB32(255, 255, 255))
        CALL ccircle(VisualNodes(x).AntennaS.x, VisualNodes(x).AntennaS.y, 3, _RGB32(255, 255, 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, _RGB32(255, 255, 255))
        CALL ccircle(VisualNodes(x).AntennaE.x, VisualNodes(x).AntennaE.y, 3, _RGB32(255, 255, 255))
    END IF
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 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 cprintstring (x1 AS DOUBLE, y1 AS DOUBLE, a AS STRING)
    '_PRINTSTRING (_WIDTH / 2 - (LEN(a) * 8) / 2, -y + _HEIGHT / 2), a
    _PRINTSTRING (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), a
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Demo cases:
'
 
SUB DemoMerge
    DIM TheName1 AS STRING
    DIM TheName2 AS STRING
    TheName1 = "top part"
    TheName2 = "bottom part"
 
    DIM a AS LONG
    DIM b AS LONG
    a = NewLinkedList(TheName1)
    a = LinkEast(a, NewStringNode("lambda"))
    b = LinkEast(a, NewIntegerNode(4))
    b = LinkSouth(b, NewIntegerNode(6))
    a = NewUnitList("cow", NewIntegerNode(5))
    a = NewLinkedList(TheName2)
    a = LinkEast(a, NewStringNode("cos"))
    b = LinkEast(a, NewStringNode("*"))
    b = LinkEast(b, NewIntegerNode(3))
    b = LinkSouth(b, NewStringNode("[1]"))
    b = LinkSouth(b, CopyIntegerNode(Content("cow")))
    b = LinkSouth(b, NewStringNode("[2]"))
 
    PRINT PrintLinkedList$(HeadId(TheName1))
    PRINT PrintLinkedList$(HeadId(TheName2))
    CALL BuildVisualList(HeadId(TheName1), 0, -100, .9 * _HEIGHT / 2)
    CALL BuildVisualList(HeadId(TheName2), 0, -100, 0)
    PRINT
 
    CALL Halt
 
    a = ListId(TheName2)
    b = LinkedList(a).HeadNode
    LinkedListRegister(a) = 0
    IdentityRegister(b) = 0
 
    a = Nodes(LinkedList(ListId(TheName1)).HeadNode).East
    b = Nodes(b).East
    Nodes(b).North = a
    Nodes(a).South = b
 
    PRINT PrintLinkedList$(HeadId(TheName1))
    CALL BuildVisualList(HeadId(TheName1), 0, -100, .9 * _HEIGHT / 2)
    PRINT
 
    CALL Halt
 
    a = Evaluate(HeadId(TheName1))
 
    PRINT PrintLinkedList$(HeadId(TheName1))
    CALL BuildVisualList(HeadId(TheName1), 0, -100, .9 * _HEIGHT / 2)
    PRINT
 
    CLS
 
    CALL UserLoop
 
    CLS
 
    CALL UserLoop
 
    a = DeleteLinkedList(ListId(TheName1))
    a = DeleteLinkedList(ListId(TheName2))
    a = DeleteLinkedList(ListId("cow"))
 
    PRINT
    PRINT GarbageTest("")
 
    CALL Halt
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoLambda
    DIM TheName AS STRING
    TheName = "Lambda Test"
 
    DIM a AS LONG
    DIM b AS LONG
    a = NewUnitList("cow", NewIntegerNode(7))
    a = NewLinkedList(TheName)
    a = LinkEast(a, NewStringNode("lambda"))
    b = LinkEast(a, NewIntegerNode(4))
    b = LinkSouth(b, NewIntegerNode(6))
    a = LinkSouth(a, NewStringNode("cos"))
    b = LinkEast(a, NewStringNode("*"))
    b = LinkEast(b, NewIntegerNode(3))
    b = LinkSouth(b, NewStringNode("[1]"))
    b = LinkSouth(b, CopyIntegerNode(Content("cow")))
    b = LinkSouth(b, NewStringNode("[2]"))
 
    PRINT PrintLinkedList$(HeadId(TheName))
    CALL BuildVisualList(HeadId(TheName), 0, -100, .9 * _HEIGHT / 2)
    PRINT
 
    CALL Halt
 
    a = Evaluate(HeadId(TheName))
 
    PRINT PrintLinkedList$(HeadId(TheName))
    CALL BuildVisualList(HeadId(TheName), 0, -100, .9 * _HEIGHT / 2)
    PRINT
 
    CLS
 
    CALL UserLoop
 
    a = DeleteLinkedList(ListId(TheName))
    a = DeleteLinkedList(ListId("cow"))
 
    PRINT
    PRINT GarbageTest("")
 
    CALL Halt
 
    CLS
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoList
    DIM TheName AS STRING
    TheName = "List Test"
 
    DIM a AS LONG
    DIM b AS LONG
    a = NewLinkedList(TheName)
    a = LinkEast(a, NewStringNode("cos"))
    b = LinkEast(a, NewStringNode("three"))
    b = LinkSouth(b, NewStringNode("four"))
    b = LinkSouth(b, NewStringNode("five"))
    b = LinkSouth(b, NewStringNode("six"))
    b = LinkSouth(b, NewStringNode("seven"))
    a = LinkSouth(a, NewStringNode("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))
 
    PRINT PrintLinkedList$(HeadId(TheName))
    CALL BuildVisualList(HeadId(TheName), 0, -100, .9 * _HEIGHT / 2)
    PRINT
 
    CALL Halt
 
    a = Evaluate(HeadId(TheName))
 
    PRINT PrintLinkedList$(HeadId(TheName))
    CALL BuildVisualList(HeadId(TheName), 0, -100, .9 * _HEIGHT / 2)
    PRINT
 
    CLS
 
    CALL UserLoop
 
    a = DeleteLinkedList(ListId(TheName))
 
    PRINT
    PRINT GarbageTest("")
 
    CALL Halt
 
    CLS
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoArithmetic
    DIM ListNames(2) AS STRING
    ListNames(1) = "Arithmetic Test1"
    ListNames(2) = "Arithmetic Test2"
 
    DIM a AS LONG
    DIM b AS LONG
    a = NewLinkedList(ListNames(1))
    a = LinkEast(a, NewStringNode("*"))
    b = LinkEast(a, NewIntegerNode(3))
    b = LinkSouth(b, NewIntegerNode(4))
    a = LinkSouth(b, NewStringNode("cos"))
    b = LinkEast(a, NewStringNode("+"))
    b = LinkEast(b, NewIntegerNode(4))
    b = LinkSouth(b, NewIntegerNode(7))
    b = LinkSouth(a, NewIntegerNode(2))
 
    PRINT PrintLinkedList$(HeadId(ListNames(1)))
    CALL BuildVisualList(HeadId(ListNames(1)), 0, -100, .9 * _HEIGHT / 2)
    PRINT
 
    CALL Halt
 
    a = Evaluate(HeadId(ListNames(1)))
 
    PRINT PrintLinkedList$(HeadId(ListNames(1)))
    CALL BuildVisualList(HeadId(ListNames(1)), 0, -100, .9 * _HEIGHT / 2)
    PRINT
 
    CALL Halt
 
    a = NewLinkedList(ListNames(2))
    a = LinkEast(a, NewStringNode("/"))
    b = LinkEast(a, NewIntegerNode(3))
    a = LinkSouth(b, NewStringNode("cos"))
    b = LinkEast(a, NewStringNode("+"))
    b = LinkEast(b, NewIntegerNode(4))
    b = LinkSouth(b, NewDoubleNode(DoubleData(Nodes(Nodes(HeadId(ListNames(1))).East).Reference)))
 
    PRINT PrintLinkedList$(HeadId(ListNames(2)))
    CALL BuildVisualList(HeadId(ListNames(2)), 0, -100, .9 * _HEIGHT / 2)
    PRINT
 
    CALL Halt
 
    a = Evaluate(HeadId(ListNames(2)))
 
    PRINT PrintLinkedList$(HeadId(ListNames(2)))
    CALL BuildVisualList(HeadId(ListNames(2)), 0, -100, .9 * _HEIGHT / 2)
    PRINT
 
    CLS
 
    CALL UserLoop
 
    CLS
 
    CALL UserLoop
 
    a = DeleteLinkedList(ListId(ListNames(1)))
    a = DeleteLinkedList(ListId(ListNames(2)))
 
    PRINT
    PRINT GarbageTest("")
 
    CALL Halt
 
    CLS
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoTreeEdit
    DIM TheName AS STRING
    TheName = "Tree Edit Test"
 
    DIM a AS LONG
    DIM b AS LONG
    DIM c AS LONG
    a = NewLinkedList(TheName)
    a = LinkEast(a, NewStringNode("QB64 Buddy"))
    a = LinkEast(a, NewStringNode("Handle"))
    b = LinkEast(a, NewStringNode("flukiluke"))
    a = LinkSouth(a, NewStringNode("Name"))
    b = LinkEast(a, NewStringNode("Luke C."))
    a = LinkSouth(a, NewStringNode("Country"))
    b = LinkEast(a, NewStringNode("Australia"))
    c = LinkEast(b, NewStringNode("Locality"))
    b = LinkEast(c, NewStringNode("Down Under"))
    a = LinkSouth(a, NewStringNode("Birthyear"))
    b = LinkEast(a, NewIntegerNode(1523))
    c = LinkSouth(b, NewStringNode("May???"))
 
    PRINT PrintLinkedList$(HeadId(TheName))
    CALL BuildVisualList(HeadId(TheName), 0, -100, .9 * _HEIGHT / 2)
    PRINT
 
    PRINT "Inserting `Get it?' into list..."
    a = InsertEast(SeekString("Down Under", HeadId(TheName), 1), NewStringNode("Get it?"))
    PRINT "Adding new entry to bottom of list..."
    a = InsertSouth(SeekString("QB64 Buddy", HeadId(TheName), 1), NewStringNode("QB64 Enemy"))
    PRINT "Editing Birthyear..."
    a = EditIntegerReference(StepUsing(SeekString("Birthyear", HeadId(TheName), 1), "e"), 1855)
    PRINT "Deleting Name..."
    a = DeleteNodes(SeekString("Name", HeadId(TheName), 1))
    PRINT
 
    CALL Halt
 
    CLS
 
    PRINT PrintLinkedList$(HeadId(TheName))
    CALL BuildVisualList(HeadId(TheName), 0, -100, .9 * _HEIGHT / 2)
    PRINT
 
    CALL Halt
 
    CALL UserLoop
 
    a = DeleteLinkedList(ListId(TheName))
 
    PRINT
    PRINT GarbageTest("")
 
    CALL Halt
 
    CLS
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
    a = NewLinkedList(TheName)
    a = LinkEast(a, NewStringNode("QB64 Buddy")): d = a
    a = LinkEast(a, NewStringNode("Handle"))
    b = LinkEast(a, NewStringNode("SMcNeill"))
    a = LinkSouth(a, NewStringNode("Name"))
    b = LinkEast(a, NewStringNode("Steve SMcNeill"))
    a = LinkSouth(a, NewStringNode("Country"))
    b = LinkEast(a, NewStringNode("USA"))
    c = LinkEast(b, NewStringNode("Locality"))
    b = LinkEast(c, NewStringNode("Virginia"))
    a = LinkSouth(a, NewStringNode("Birthyear"))
    b = LinkEast(a, NewIntegerNode(1973))
    c = LinkSouth(b, NewStringNode("May?"))
    a = LinkSouth(d, NewStringNode("QB64 Buddy")): d = a
    a = LinkEast(a, NewStringNode("Handle"))
    b = LinkEast(a, NewStringNode("FellippeHeitor"))
    a = LinkSouth(a, NewStringNode("Name"))
    b = LinkEast(a, NewStringNode("Fellippe Heitor"))
    a = LinkSouth(a, NewStringNode("Country"))
    b = LinkEast(a, NewStringNode("Brazil"))
    c = LinkEast(b, NewStringNode("Locality"))
    b = LinkEast(c, NewStringNode("My <3"))
    c = LinkEast(b, NewStringNode("JK, it's ___."))
    a = LinkSouth(a, NewStringNode("Birthyear"))
    b = LinkEast(a, NewIntegerNode(1983))
    c = LinkSouth(b, NewStringNode("Sep?"))
    b = LinkSouth(c, NewStringNode("... or was it May?"))
    a = LinkSouth(d, NewStringNode("QB64 Buddy")): d = a
    a = LinkEast(a, NewStringNode("Handle"))
    b = LinkEast(a, NewStringNode("DanTurtle"))
 
    'CLS
 
    'PRINT PrintLinkedList$(HeadId(TheName))
    'PRINT
 
    '' Query tests
    'PRINT "Height:";
    'PRINT SquareListHeight(ListId(TheName))
    'PRINT "Steve's locality: ";
    'PRINT Literal$(StepUsing(HeadId(TheName), "eesseee"))
    'PRINT "Fellippe's locality: ";
    'PRINT Literal$(StepUsing(HeadId(TheName), "esesseee"))
    'PRINT "Fellippe's birth month: ";
    'PRINT Literal$(StepUsing(JumpFrom(StepUsing(HeadId(TheName), "ese"), "s", 3), "es"))
    'PRINT "Width of Fellippe's Country branch:";
    'PRINT Measure(SeekString("Country", HeadId(TheName), 2), "e")
    'PRINT "Height under Fellippe's Birthyear branch:";
    'PRINT Measure(Nodes(SeekString("Birthyear", HeadId(TheName), 2)).East, "s")
    'PRINT
 
    'CALL Halt
 
    CALL BuildVisualList(HeadId(TheName), 0, -100, .9 * _HEIGHT / 2)
    'CALL UserLoop
 
    'a = DeleteLinkedList(ListId(TheName))
 
    'PRINT
    'PRINT GarbageTest("")
 
    'CALL Halt
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB DemoArray3D
    CALL LoadArray3D("Three-Dimensional Array")
    CALL QueryArray3D("Three-Dimensional Array")
END SUB
 
 
SUB LoadArray3D (TheName AS STRING)
    DIM i AS INTEGER
    DIM j AS INTEGER
    DIM k AS INTEGER
    DIM a AS LONG
    DIM b AS LONG
 
    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"
    'TestArray3D(4, 1, 1) = "four.one.one"
    'TestArray3D(4, 1, 2) = "four.one.two"
    'TestArray3D(4, 1, 3) = "four.one.three"
    'TestArray3D(4, 2, 1) = "four.two.one"
    'TestArray3D(4, 2, 2) = "four.two.two"
    'TestArray3D(4, 2, 3) = "four.two.three"
 
    ' Load 3D array as linked list
    a = NewLinkedList(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, NewStringNode(TestArray3D(i, j, k)))
                    b = a
                ELSE
                    IF (k = 1) THEN
                        a = LinkSouth(a, NewStringNode(TestArray3D(i, j, k)))
                        b = a
                    ELSE
                        b = LinkEast(b, NewStringNode(TestArray3D(i, j, k)))
                    END IF
                END IF
            NEXT
        NEXT
    NEXT
END SUB
 
SUB QueryArray3D (TheName AS STRING)
    DIM a AS LONG
    DIM k AS INTEGER
 
    PRINT PrintLinkedList$(HeadId(TheName))
    CALL BuildVisualList(HeadId(TheName), 0, -100, .9 * _HEIGHT / 2)
    PRINT
    PRINT "Query tests:"
    PRINT "Height:"; SquareListHeight(ListId(TheName))
    PRINT "Width:"; SquareListWidth(ListId(TheName))
    PRINT
    PRINT "Typical FOR loop:"
    FOR k = 1 TO Bottom(TheName)
        PRINT Literal$(JumpFrom(Content(TheName), "s", k))
    NEXT
    PRINT
    CALL Halt
    CALL UserLoop
    a = DeleteLinkedList(ListId(TheName))
    PRINT
    PRINT GarbageTest("")
    CALL Halt
END SUB
 
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Begin BM-component.
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Processing
'
 
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
            a = Nodes(a).South
            IF (a = -1) THEN
                EXIT DO
            END IF
        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 ReturnString AS STRING
    DIM ReturnDouble AS DOUBLE
    DIM MultiPass AS INTEGER
 
    RefSpecies = ""
    FunctionId = x
    ReturnSpecies = ""
    ReturnInteger = 0
    ReturnString = ""
    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
        ReturnSpecies = Nodes(FunctionId).Species
        SELECT CASE ReturnSpecies
            CASE "integer"
                ReturnInteger = IntegerData(Nodes(FunctionId).Reference)
            CASE "string"
                ReturnString = StringData(Nodes(FunctionId).Reference)
            CASE "double"
                ReturnDouble = DoubleData(Nodes(FunctionId).Reference)
        END SELECT
    END IF
 
    ' Lambda substitution
    i = NorthernId
    DIM lf AS INTEGER
    lf = 0
    DO
        IF (Nodes(i).Species = "string") THEN
            IF (StringData(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 (StringData(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 = "string") THEN RefSpecies = "string"
        IF ((Nodes(i).Species = "double") AND (RefSpecies <> "string")) THEN RefSpecies = "double"
        IF ((Nodes(i).Species = "integer") AND (RefSpecies <> "string") 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 "string"
                    ReturnSpecies = "string"
                    ReturnString = 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 "string"
                        ReturnSpecies = "string"
                        ReturnString = "cos" + "(" + Literal$(i) + ")"
                    CASE "double"
                        ReturnSpecies = "double"
                        ReturnDouble = COS(DoubleData(Nodes(i).Reference))
                END SELECT
                i = Unlink(i)
            ELSE
                MultiPass = 1
                ReturnSpecies = "string"
                ReturnString = "(" + "cos" + ")"
            END IF
        CASE "lambda"
            MultiPass = 1
            LambdaIndex = LambdaIndex + 1
            ReturnSpecies = "string"
            ReturnString = "(" + "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 "string"
                            ReturnString = ReturnString + 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 "string"
                            ReturnString = ReturnString + 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 "string"
                            Nodes(i).Reference = NewStringData("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 "string"
            Nodes(FunctionId).Species = ReturnSpecies
            Nodes(FunctionId).Reference = NewStringData(ReturnString)
        CASE "double"
            Nodes(FunctionId).Species = ReturnSpecies
            Nodes(FunctionId).Reference = NewDoubleData(ReturnDouble)
    END SELECT
 
    TheReturn = FunctionId
    EvalStep = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Seek and recall
'
 
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
 
FUNCTION SeekString (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 (StringData(Nodes(x).Reference) = t) THEN
        TheReturn = x
        r = r - 1
    ELSE
        IF (e <> -1) AND (r > 0) THEN
            TheReturn = SeekString(t, e, r)
        END IF
        IF (s <> -1) AND (r > 0) THEN
            TheReturn = SeekString(t, s, r)
        END IF
    END IF
    SeekString = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Navigation
'
 
FUNCTION Content (t AS STRING)
    DIM TheReturn AS LONG
    TheReturn = Nodes(HeadId(t)).East
    Content = TheReturn
END FUNCTION
 
FUNCTION Bottom (t AS STRING)
    DIM TheReturn AS LONG
    TheReturn = -1 + Measure(Content(t), "s")
    Bottom = TheReturn
END FUNCTION
 
FUNCTION ListId (t AS STRING)
    DIM TheReturn AS LONG ' Change this to int. ?
    DIM k AS LONG
    TheReturn = -1
    FOR k = 1 TO UBOUND(LinkedList)
        IF (LinkedList(k).Label = t) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    ListId = TheReturn
END FUNCTION
 
FUNCTION HeadId (t AS STRING)
    DIM TheReturn AS LONG
    TheReturn = LinkedList(ListId(t)).HeadNode
    HeadId = TheReturn
END FUNCTION
 
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 StepUsing (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
    StepUsing = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Internal metrics
'
 
FUNCTION SquareListHeight (x AS INTEGER)
    DIM TheReturn AS INTEGER
    TheReturn = Measure(Nodes(LinkedList(x).HeadNode).East, "s")
    SquareListHeight = TheReturn
END FUNCTION
 
FUNCTION SquareListWidth (x AS INTEGER)
    DIM TheReturn AS INTEGER
    TheReturn = Measure(Nodes(LinkedList(x).HeadNode).East, "e")
    SquareListWidth = TheReturn
END FUNCTION
 
FUNCTION Measure (x AS LONG, t AS STRING)
    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 GarbageTest$ (t AS STRING)
    DIM TheReturn AS STRING
    DIM a AS LONG
    DIM k AS INTEGER
    TheReturn = t
    TheReturn = TheReturn + "Begin garbage test..." + CHR$(10)
    FOR k = 1 TO UBOUND(LinkedListRegister)
        IF (LinkedListRegister(k) <> 0) THEN
            PRINT LinkedList(k).Label
            CALL BuildVisualList(LinkedList(k).HeadNode, 0, .8 * _WIDTH * (RND - .5), .8 * _HEIGHT * (RND - .5))
        END IF
    NEXT
    FOR k = 1 TO UBOUND(IdentityRegister)
        IF (IdentityRegister(k) <> 0) THEN
            a = IdentityRegister(k)
            TheReturn = TheReturn + Literal$(a) + " (" + Literal$(Nodes(a).North) + "," + Literal$(Nodes(a).South) + "," + Literal$(Nodes(a).East) + "," + Literal$(Nodes(a).West) + ")" '+ CHR$(10)
            TheReturn = TheReturn + CHR$(10)
        END IF
    NEXT
    TheReturn = TheReturn + "End garbage test..." + CHR$(10)
    GarbageTest$ = TheReturn
END FUNCTION
 
FUNCTION PrintLinkedList$ (x AS LONG)
    DIM TheReturn AS STRING
    DIM t AS STRING
    t = ListNodesRecur$(0, x)
    TheReturn = LEFT$(t, LEN(t) - 1)
    PrintLinkedList$ = 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 + SPACE$(i) + Literal$(x) + CHR$(10)
    IF (e <> -1) THEN
        TheReturn = TheReturn + ListNodesRecur$(i + 2, e)
    END IF
    IF (s <> -1) THEN
        TheReturn = TheReturn + ListNodesRecur$(i, s)
    END IF
    ListNodesRecur$ = 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 "string"
                TheReturn = StringData(Nodes(x).Reference)
            CASE "double"
                TheReturn = LTRIM$(RTRIM$(STR$(DoubleData(Nodes(x).Reference))))
        END SELECT
    END IF
    Literal$ = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Linked list construction
'
 
FUNCTION NewUnitList (t AS STRING, x AS LONG)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = NewLinkedList(t)
    k = LinkEast(TheReturn, x)
    NewUnitList = TheReturn
END FUNCTION
 
FUNCTION NewLinkedList (t AS STRING)
    DIM i AS LONG
    DIM k AS LONG
    k = NewStringNode(t)
    i = NextOpenLinkedList(1)
    LinkedListRegister(i) = i
    LinkedList(i).Label = StringData(Nodes(k).Reference)
    LinkedList(i).HeadNode = k
    NewLinkedList = k
END FUNCTION
 
FUNCTION NextOpenLinkedList (x AS LONG)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = x TO UBOUND(LinkedListRegister)
        IF (LinkedListRegister(k) = 0) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    NextOpenLinkedList = 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
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Linked list 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
    n = Nodes(x).North
    s = Nodes(x).South
    e = Nodes(x).East
    w = Nodes(x).West
    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
    IdentityRegister(x) = 0
    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 = DeleteRecur(e)
    END IF
    TheReturn = Unlink(x)
    DeleteNodes = TheReturn
END SUB
 
FUNCTION DeleteRecur (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 = DeleteRecur(e)
    END IF
    IF (s <> -1) THEN
        TheReturn = DeleteRecur(s)
    END IF
    TheReturn = Unlink(x)
    DeleteRecur = TheReturn
END FUNCTION
 
FUNCTION DeleteLinkedList (x AS INTEGER)
    DIM TheReturn AS LONG
    LinkedListRegister(x) = 0
    TheReturn = DeleteRecur(LinkedList(x).HeadNode)
    DeleteLinkedList = 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) = 0) 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 NewIntegerNode (x AS INTEGER)
    NewIntegerNode = NewNode(1, "integer", NewIntegerData(x))
END FUNCTION
 
FUNCTION NewStringNode (x AS STRING)
    NewStringNode = NewNode(1, "string", NewStringData(x))
END FUNCTION
 
FUNCTION NewDoubleNode (x AS DOUBLE)
    NewDoubleNode = NewNode(1, "double", NewDoubleData(x))
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Node editing
'
 
FUNCTION EditIntegerReference (i AS LONG, x AS INTEGER)
    DIM z AS LONG
    z = NewIntegerData(x)
    Nodes(i).Reference = z
    EditIntegerReference = z
END FUNCTION
 
FUNCTION EditStringReference (i AS LONG, x AS STRING)
    DIM z AS LONG
    z = NewStringData(x)
    Nodes(i).Reference = z
    EditStringReference = z
END FUNCTION
 
FUNCTION EditDoubleReference (i AS LONG, x AS DOUBLE)
    DIM z AS LONG
    z = NewDoubleData(x)
    Nodes(i).Reference = z
    EditDoubleReference = z
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Data assimilation
'
 
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 NewStringData (x AS STRING)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = -1
    FOR k = 1 TO UBOUND(StringData)
        IF (StringData(k) = x) THEN
            TheReturn = k
            EXIT FOR
        END IF
    NEXT
    IF (TheReturn = -1) THEN
        REDIM _PRESERVE StringData(UBOUND(StringData) + 1)
        StringData(UBOUND(Stringdata)) = x
        TheReturn = UBOUND(StringData)
    END IF
    NewStringData = 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.
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 

Pete · « **Reply #24 on:** April 30, 2020, 11:12:45 pm »

LOOK I MADE A BI-PLANE!

STxAxTIC · « **Reply #25 on:** May 01, 2020, 05:34:25 am »

Haha I totally see it!

STxAxTIC · « **Reply #26 on:** May 10, 2020, 06:34:29 pm »

Hello all,

This project is approaching its "final" update with respect to the main code base. Recently I've gone full-tilt in the GUI direction, and the end result is, go figure, possibly useful! I figured I'd post it. I'm at a point where there is too much to explain about the hows and whys of this program. That will have to come at a slightly later date with a formal write-up, with real sections, etc.

For now though, I give you something to play with. Most of the controls are self-explanatory. As usual you can mash ESC through the whole thing, but I beckon you to resize to full screen, discover what the mouse does, play with some buttons, etc.

For those who are joining late, this is a program that demonstrates how (and provides the tools) to dispense with old-fashioned arrays and rethink your future data structures as linked lists, allowing for a crazy range of flexibility.

Yes, the text-carrying visual nodes look like street signs. I said it.

Code: QB64: [Select]

' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Meta:
'
 
OPTION _EXPLICIT
$RESIZE:ON
_TITLE "Soft Array Editor"
_DELAY .1
RANDOMIZE TIMER
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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 k AS LONG
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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 k = 1 TO UBOUND(IdentityRegister)
    IdentityRegister(k) = -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 k = 1 TO UBOUND(SoftArrayRegister)
    SoftArrayRegister(k) = -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
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' End BI-component.
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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)
SCREEN ScreenHandle
_DELAY .1
COLOR _RGBA(255, 255, 255, 255)
 
Origin.x = -.33 * _WIDTH / 2
Origin.y = .9 * _HEIGHT / 2
ScrollPosition.x = 0
ScrollPosition.y = 0
 
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Main
'
 
CALL DemoArray3D
 
CALL DemoTree
 
CALL DemoTreeEdit
 
CALL DemoArithmetic
 
CALL DemoList
 
CALL DemoLambda
 
CALL DemoMerge
 
END
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Interface (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 PrintAllSoftArrays$(1)
        PRINT
        CALL Halt
    END IF
 
    IF (r = 1) THEN
        k = ClearSelections(1)
        CALL BuildAllVisualLists
        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 AltWires AS INTEGER
    DIM CtrlKey AS INTEGER
    DIM MW AS INTEGER
    DIM MB1 AS INTEGER
    DIM t AS STRING
 
    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(1) = 0) AND (MB1 = -1)) THEN
                i = -1
                j = i
                MB1 = 0
                CALL BuildAllVisualLists
            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 (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
 
        k = _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
 
        ' Single-tap keys
        SELECT CASE k
            CASE 27 ' esc
                EXIT SUB
            CASE 13 ' enter
                IF (SelectionIndex(1) <> -1) THEN
                    a = Evaluate(VisualNodes(SelectionIndex(1)).Reference)
                    CALL BuildAllVisualLists
                    i = ClearSelections(1)
                END IF
            CASE 21248 ' delete
                IF (SelectionIndex(1) <> -1) THEN
                    a = DeleteNodes(VisualNodes(SelectionIndex(1)).Reference)
                    CALL BuildAllVisualLists
                    i = ClearSelections(1)
                END IF
            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(" ")
                IF (i <> -1) THEN
                    CALL NewSelection(i)
                END IF
            CASE ASC("i"), ASC("I")
                IF (CtrlKey = 1) THEN
                    IF (SelectionIndex(1) <> -1) THEN
                        Nodes(VisualNodes(SelectionIndex(1)).Reference).Species = "integer"
                        Nodes(VisualNodes(SelectionIndex(1)).Reference).Reference = NewIntegerData(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(RND * 10000)))), NewIntegerNode(0))
                    CALL BuildAllVisualLists
                END IF
            CASE ASC("d"), ASC("D")
                IF (CtrlKey = 1) THEN
                    IF (SelectionIndex(1) <> -1) THEN
                        Nodes(VisualNodes(SelectionIndex(1)).Reference).Species = "double"
                        Nodes(VisualNodes(SelectionIndex(1)).Reference).Reference = NewDoubleData(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(RND * 10000)))), NewDoubleNode(0.0))
                    CALL BuildAllVisualLists
                END IF
            CASE ASC("t"), ASC("T")
                IF (CtrlKey = 1) THEN
                    IF (SelectionIndex(1) <> -1) THEN
                        Nodes(VisualNodes(SelectionIndex(1)).Reference).Species = "text"
                        Nodes(VisualNodes(SelectionIndex(1)).Reference).Reference = NewTextData("")
                        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(RND * 10000)))), NewTextNode("."))
                    CALL BuildAllVisualLists
                END IF
            CASE ASC("m"), ASC("M")
                CLS
                PRINT MemoryProbe$("")
                CALL Halt
            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 BuildAllVisualLists
            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 = DeleteRecur(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 BuildAllVisualLists
            CASE ASC("x"), ASC("X")
                IF (SelectionIndex(1) <> -1) THEN
                    _KEYCLEAR
                    LOCATE (_HEIGHT / 16) - 1, 1: INPUT "Enter new value: ", 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 BuildAllVisualLists
                END IF
            CASE ASC("v"), ASC("V")
                IF (SelectionIndex(1) <> -1) THEN
                    a = VisualNodes(SelectionIndex(1)).Reference
                    IF (Nodes(a).North <> -1) THEN
                        Nodes(Nodes(a).North).South = -1
                        Nodes(a).North = -1
                    END IF
                    IF (Nodes(a).West <> -1) THEN
                        Nodes(Nodes(a).West).East = -1
                    END IF
                END IF
                b = NewSoftArray("list" + LTRIM$(RTRIM$(STR$(INT(RND * 10000)))))
                b = LinkEast(b, a)
                CALL BuildAllVisualLists
            CASE ASC("l"), ASC("L")
                IF (CtrlKey = 1) THEN
                    OPEN "SoftArrays-" + LTRIM$(RTRIM$(STR$(TIMER))) + ".txt" FOR OUTPUT AS #1
                    PRINT #1, PrintAllSoftArrays$(1)
                    CLOSE #1
                END IF
                CALL UserMain(1, 0, 0)
        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, "View:")
        i = i + 1: CALL lprintstring(1, i, "  Space = select")
        i = i + 1: CALL lprintstring(1, i, "  Mouse1 = scroll recur")
        i = i + 1: CALL lprintstring(1, i, "  Mouse2 = scroll all")
        i = i + 1: CALL lprintstring(1, i, "  W      = all wires")
        i = i + 1: CALL lprintstring(1, i, "Create:")
        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, "  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, "Edit node:")
        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, "Edit list:")
        i = i + 1: CALL lprintstring(1, i, "  Enter  = evaluate")
        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 = ins (1)s(2)")
        i = i + 1: CALL lprintstring(1, i, "  Ctrl+E = ins (1)e(2)")
        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, "  Ctrl+L = write file")
        i = i + 1: CALL lprintstring(1, i, "  M      = mem probe")
 
        CALL rprintstring(3, "Scroll position:")
        CALL rprintstring(4, "(" + LTRIM$(RTRIM$(STR$(ScrollPosition.x))) + "," + LTRIM$(RTRIM$(STR$(ScrollPosition.y))) + ")")
 
        COLOR _RGBA(255, 100, 255, 255)
        CALL cprintstring(_HEIGHT / 2, "--Soft Array Editor--")
        CALL cprintstring(-_HEIGHT / 2 + 16, "Press ESC to finish.")
        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 (OPTIONAL)
'
 
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 BuildAllVisualLists
    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 BuildVisualList(SoftArray(k).HeadNode, Origin.x + ScrollPosition.x, y0)
            y0 = y0 - 30
        END IF
    NEXT
END SUB
 
SUB BuildVisualList (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 BuildVisualList(e, x0 + dxtmp, y0)
    END IF
    IF (s <> -1) THEN
        CALL BuildVisualList(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)
        'IF (k <> -1) THEN
        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 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
    DIM r AS DOUBLE
    DIM d AS DOUBLE
    'x0 = (x0 - _WIDTH / 2)
    'y0 = (-y0 + _HEIGHT / 2)
    r = 9999
    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
                d = (x0 - VisualNodes(k).BoxCenter.x) * (x0 - VisualNodes(k).BoxCenter.x) + (y0 - VisualNodes(k).BoxCenter.y) * (y0 - VisualNodes(k).BoxCenter.y)
                IF (d < r) THEN
                    r = d
                    TheReturn = k
                END IF
            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
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Demo cases:
'
 
SUB DemoMerge
    DIM TheName1 AS STRING
    DIM TheName2 AS STRING
    TheName1 = "top part"
    TheName2 = "bottom part"
 
    DIM a AS LONG
    DIM b AS LONG
    a = NewSoftArray(TheName1)
    a = LinkEast(a, NewTextNode("lambda"))
    b = LinkEast(a, NewIntegerNode(4))
    b = LinkSouth(b, NewIntegerNode(6))
    a = NewUnitArray("cow", NewIntegerNode(5))
    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(Content("cow")))
    b = LinkSouth(b, NewTextNode("[2]"))
 
    CALL UserMain(1, 0, 0)
 
    a = ListId(TheName2)
    b = SoftArray(a).HeadNode
    SoftArrayRegister(a) = -1
    IdentityRegister(b) = -1
 
    a = Nodes(SoftArray(ListId(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 = EvalAllSoftArrays(1)
    CALL UserMain(1, 0, 1)
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoLambda
    DIM TheName AS STRING
    TheName = "Lambda Test"
 
    DIM a AS LONG
    DIM b AS LONG
    a = NewUnitArray("cow", NewIntegerNode(7))
    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(Content("cow")))
    b = LinkSouth(b, NewTextNode("[2]"))
 
    CALL UserMain(0, 1, 0)
    a = EvalAllSoftArrays(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 = EvalAllSoftArrays(1)
    CALL UserMain(1, 0, 1)
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoArithmetic
    DIM ListNames(2) AS STRING
    ListNames(1) = "Arithmetic Test1"
    ListNames(2) = "Arithmetic Test2"
 
    DIM a AS LONG
    DIM b AS LONG
    a = NewSoftArray(ListNames(1))
    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 = EvalAllSoftArrays(1)
    CALL UserMain(1, 0, 0)
 
    a = NewSoftArray(ListNames(2))
    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(HeadId(ListNames(1))).East).Reference)))
 
    CALL UserMain(0, 1, 0)
    a = EvalAllSoftArrays(1)
    CALL UserMain(1, 0, 1)
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
SUB DemoTreeEdit
    DIM TheName AS STRING
    TheName = "Tree Edit Test"
 
    DIM a AS LONG
    DIM b AS LONG
    DIM c AS LONG
    a = NewSoftArray(TheName)
    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("May???"))
 
    CALL UserMain(1, 0, 0)
 
    a = InsertEast(SeekText("Down Under", HeadId(TheName), 1), NewTextNode("Get it?"))
    a = InsertSouth(SeekText("QB64 Buddy", HeadId(TheName), 1), NewTextNode("QB64 Enemy"))
    a = EditIntegerReference(StepUsing(SeekText("Birthyear", HeadId(TheName), 1), "e"), 1855)
    a = DeleteNodes(SeekText("Name", HeadId(TheName), 1))
 
    ' Query tests
    'PRINT "Inserting `Get it?' into list..."
    'PRINT "Adding new entry to bottom of list..."
    'PRINT "Editing Birthyear..."
    'PRINT "Deleting Name..."
    'PRINT
 
    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
    a = NewSoftArray(TheName)
    a = LinkEast(a, NewTextNode("QB64 Buddy")): d = a
    a = LinkEast(a, NewTextNode("Handle"))
    b = LinkEast(a, NewTextNode("SMcNeill"))
    a = LinkSouth(a, NewTextNode("Name"))
    b = LinkEast(a, NewTextNode("Steve SMcNeill"))
    a = LinkSouth(a, NewTextNode("Country"))
    b = LinkEast(a, NewTextNode("USA"))
    c = LinkEast(b, NewTextNode("Locality"))
    b = LinkEast(c, NewTextNode("Virginia"))
    a = LinkSouth(a, NewTextNode("Birthyear"))
    b = LinkEast(a, NewIntegerNode(1973))
    c = LinkSouth(b, NewTextNode("May?"))
    a = LinkSouth(d, NewTextNode("QB64 Buddy")): d = a
    a = LinkEast(a, NewTextNode("Handle"))
    b = LinkEast(a, NewTextNode("FellippeHeitor"))
    a = LinkSouth(a, NewTextNode("Name"))
    b = LinkEast(a, NewTextNode("Fellippe Heitor"))
    a = LinkSouth(a, NewTextNode("Country"))
    b = LinkEast(a, NewTextNode("Brazil"))
    c = LinkEast(b, NewTextNode("Locality"))
    b = LinkEast(c, NewTextNode("My <3"))
    c = LinkEast(b, NewTextNode("JK, it's ___."))
    a = LinkSouth(a, NewTextNode("Birthyear"))
    b = LinkEast(a, NewIntegerNode(1983))
    c = LinkSouth(b, NewTextNode("Sep?"))
    b = LinkSouth(c, NewTextNode("... or was it May?"))
    a = LinkSouth(d, NewTextNode("QB64 Buddy")): d = a
    a = LinkEast(a, NewTextNode("Handle"))
    b = LinkEast(a, NewTextNode("DanTurtle"))
 
    '' Query tests
    'PRINT "Height:";
    'PRINT SquareListHeight(ListId(TheName))
    'PRINT "Steve's locality: ";
    'PRINT Literal$(StepUsing(HeadId(TheName), "eesseee"))
    'PRINT "Fellippe's locality: ";
    'PRINT Literal$(StepUsing(HeadId(TheName), "esesseee"))
    'PRINT "Fellippe's birth month: ";
    'PRINT Literal$(StepUsing(JumpFrom(StepUsing(HeadId(TheName), "ese"), "s", 3), "es"))
    'PRINT "Width of Fellippe's Country branch:";
    'PRINT Measure(SeekText("Country", HeadId(TheName), 2), "e")
    'PRINT "Height under Fellippe's Birthyear branch:";
    'PRINT Measure(Nodes(SeekText("Birthyear", HeadId(TheName), 2)).East, "s")
    'PRINT
 
    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
 
    DIM TestArray3D(4, 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"
    TestArray3D(4, 1, 1) = "four.one.one"
    TestArray3D(4, 1, 2) = "four.one.two"
    TestArray3D(4, 1, 3) = "four.one.three"
    TestArray3D(4, 2, 1) = "four.two.one"
    TestArray3D(4, 2, 2) = "four.two.two"
    TestArray3D(4, 2, 3) = "four.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
 
    'PRINT "Query tests:"
    'PRINT PrintSoftArray$(HeadId(TheName))
    'PRINT "Height:"; SquareListHeight(ListId(TheName))
    'PRINT "Width:"; SquareListWidth(ListId(TheName))
    'PRINT
    'PRINT "Typical FOR loop:"
    'FOR k = 1 TO Bottom(TheName)
    '    PRINT Literal$(JumpFrom(Content(TheName), "s", k))
    'NEXT
    'PRINT
 
    CALL UserMain(0, 1, 1)
END SUB
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Begin BM-component.
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Processing
'
 
FUNCTION EvalAllSoftArrays (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
    EvalAllSoftArrays = 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
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Seek and recall
'
 
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
 
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 Content (t AS STRING)
    DIM TheReturn AS LONG
    TheReturn = Nodes(HeadId(t)).East
    Content = TheReturn
END FUNCTION
 
FUNCTION Bottom (t AS STRING)
    DIM TheReturn AS LONG
    TheReturn = -1 + Measure(Content(t), "s")
    Bottom = TheReturn
END FUNCTION
 
FUNCTION ListId (t AS STRING)
    DIM TheReturn AS LONG ' Change this to int. ?
    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
    ListId = TheReturn
END FUNCTION
 
FUNCTION HeadId (t AS STRING)
    DIM TheReturn AS LONG
    TheReturn = SoftArray(ListId(t)).HeadNode
    HeadId = TheReturn
END FUNCTION
 
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 StepUsing (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
    StepUsing = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Internal metrics
'
 
FUNCTION SquareListHeight (x AS INTEGER)
    DIM TheReturn AS INTEGER
    TheReturn = Measure(Nodes(SoftArray(x).HeadNode).East, "s")
    SquareListHeight = TheReturn
END FUNCTION
 
FUNCTION SquareListWidth (x AS INTEGER)
    DIM TheReturn AS INTEGER
    TheReturn = Measure(Nodes(SoftArray(x).HeadNode).East, "e")
    SquareListWidth = TheReturn
END FUNCTION
 
FUNCTION Measure (x AS LONG, t AS STRING)
    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 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)) + ")" + 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 + " (" + Literal$(Nodes(a).North) + "," + Literal$(Nodes(a).South) + "," + Literal$(Nodes(a).East) + "," + Literal$(Nodes(a).West) + ")"
            TheReturn = TheReturn + " (@" + STR$(IdentityRegister(k)) + ")" + CHR$(10)
        END IF
    NEXT
    TheReturn = TheReturn + "End memory probe..." + CHR$(10)
    MemoryProbe$ = TheReturn
END FUNCTION
 
FUNCTION PrintAllSoftArrays$ (x AS INTEGER)
    DIM TheReturn AS STRING
    DIM k AS INTEGER
    DIM j AS LONG
    TheReturn = ""
    FOR k = x TO UBOUND(SoftArrayRegister)
        IF (SoftArrayRegister(k) <> -1) THEN
            j = SoftArray(k).HeadNode
            TheReturn = TheReturn + PrintSoftArray$(j)
            IF (x < UBOUND(SoftArrayRegister)) THEN
                TheReturn = TheReturn + CHR$(10)
            END IF
        END IF
    NEXT
    PrintAllSoftArrays$ = 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 + Spacer$(i, CHR$(9)) + Literal$(x) + 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 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 Spacer$ (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
    Spacer$ = TheReturn
END FUNCTION
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Soft array construction
'
 
FUNCTION NewUnitArray (t AS STRING, x AS LONG)
    DIM TheReturn AS LONG
    DIM k AS LONG
    TheReturn = NewSoftArray(t)
    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 = DeleteRecur(e)
    END IF
    TheReturn = Unlink(x)
    DeleteNodes = TheReturn
END SUB
 
FUNCTION DeleteRecur (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 = DeleteRecur(e)
    END IF
    IF (s <> -1) THEN
        TheReturn = DeleteRecur(s)
    END IF
    TheReturn = Unlink(x)
    DeleteRecur = TheReturn
END FUNCTION
 
FUNCTION DeleteSoftArray (x AS INTEGER)
    DIM TheReturn AS LONG
    SoftArrayRegister(x) = -1
    TheReturn = DeleteRecur(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
 
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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 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.
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

STxAxTIC · « **Reply #27 on:** May 18, 2020, 11:10:32 am »

Hello folks,

This project is a point where the best thing for it is public scrutiny and input. This is a bit hard because, despite the volumes of prose above this very reply, I haven't fully explained what's going on here. While I make no real attempt to do so in this thread, I think this can start to speak for itself if I post a few trivial uses. So here's one:

Code: QB64: [Select]

OPTION _EXPLICIT
 
REM $Include: 'SoftArrays.bi'
 
PRINT "Task 1/2: Store the name and country of three friends in 2D Array:"
 
DIM Regular2DArray(3, 2) AS STRING
Regular2DArray(1, 1) = "Steve"
Regular2DArray(1, 2) = "USA"
Regular2DArray(2, 1) = "Fellippe"
Regular2DArray(2, 2) = "Brazil"
Regular2DArray(3, 1) = "Luke"
Regular2DArray(3, 2) = "Australia"
DIM i AS INTEGER
DIM j AS INTEGER
FOR i = 1 TO UBOUND(Regular2DArray, 1)
    FOR j = 1 TO UBOUND(Regular2DArray, 2)
        PRINT Regular2DArray(i, j);
        IF (j < UBOUND(Regular2DArray, 2)) THEN PRINT " -> ";
    NEXT
    PRINT
NEXT
PRINT
PRINT "Printing 2,2 entry: "; Regular2DArray(2, 2)
 
PRINT
PRINT "..."
PRINT
 
PRINT "Task 2/2: Store the name and country of three friends in Soft Array:"
 
DIM a AS LONG
DIM b AS LONG
a = NewSoftArray("Friends")
a = LinkEast(a, NewTextNode("Steve"))
b = LinkEast(a, NewTextNode("USA"))
a = LinkSouth(a, NewTextNode("Fellippe"))
b = LinkEast(a, NewTextNode("Brazil"))
a = LinkSouth(a, NewTextNode("Luke"))
b = LinkEast(a, NewTextNode("Australia"))
PRINT PrintSoftArray(SoftArrayID("Friends"))
PRINT
PRINT "Printing 2,2 entry: ";
a = JumpFrom(Content("Friends"), "s", 1)
b = JumpFrom(a, "e", 1)
PRINT Literal$(b)
 
END
 
REM $Include: 'SoftArrays.bm'
 

In the above you can see the task being accomplished twice. You can also start to imagine the trade-offs between the methods. Yes, it is less trivial to traverse a soft array as opposed to a hard one; certain things are harder than usual, certain things are easier. What's lovely is this framework does not dominate your main loop or anything silly like that.

If you want to undergo the formality of actually running that code, the most sensible way to get the bi/bm files is through github:

https://github.com/wfbarnes/SoftArrays

But for Pete, I'll attach them at the bottom. Of course, the completely optional Soft Array Editor is there too. This should give you a feel for what kind of control you can have over your data, once this idea is mastered.

News:

Author Topic: A new take on arrays and data (Read 3977 times)

STxAxTIC

Re: A new take on arrays and data

STxAxTIC

Re: A new take on arrays and data

FellippeHeitor

Re: A new take on arrays and data

STxAxTIC

Re: A new take on arrays and data

STxAxTIC

Re: A new take on arrays and data

FellippeHeitor

Re: A new take on arrays and data

STxAxTIC

Re: A new take on arrays and data

Pete

Re: A new take on arrays and data

STxAxTIC

Re: A new take on arrays and data

Pete

Re: A new take on arrays and data

STxAxTIC

Re: A new take on arrays and data

STxAxTIC

Re: A new take on arrays and data

STxAxTIC

Re: A new take on arrays and data