An hash array dictonary step by step

Code: (Select All)
' This tests and compares 3 different implementations

' of dictionary/associative array :



' 1. Dictionary by Luke Ceddia, December 20, 2020, 08:12:31 PM

'    Re: associative arrays / dictionaries in QB64?

'    https://www.qb64.org/forum/index.php?topic=3387.15



' 2. Dictionary by TempodiBasic, 3/14/2023, 11:04 AM

'    An hash array dictonary step by step

'    https://staging.qb64phoenix.com/showthread.php?tid=1547



' 3. A dictionary stored in a delimited string

'    An hash array dictonary step by step

'    https://staging.qb64phoenix.com/showthread.php?tid=1547&pid=14927#pid14927



Dim Shared m_sTitle As String: m_sTitle = "dictionary-test"

_Title m_sTitle ' display in the Window's title bar



Option _Explicit



Const FALSE = 0

Const TRUE = Not FALSE

Const cIntDictSize = 1000

Const cIntLookupSize = 32767



' For dictionary by Luke

' Object to store in the symbol table

Type DictionaryType

    key As String

    intValue As Integer

    lngValue As Long

    strValue As String

    IsDeleted As Integer

End Type ' DictionaryType



' For dictionary by TempodiBasic

' https://staging.qb64phoenix.com/showthread.php?tid=1547

' renamed HashTable to TempodiData

Type TempodiData

    index As String '<---variable lenght of string index

    value As String '<--- variable lenght of value stored

End Type



' Program name + path

Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))

Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)



' For dictionary by Luke

ReDim Shared m_arrDict(cIntDictSize) As DictionaryType ' Actual stored obejcts

ReDim Shared m_arrLookup(cIntLookupSize) As Long ' Mapping between hash and index

Dim Shared m_iLastIndex As Long



' For dictionary by TempodiBasic

' https://staging.qb64phoenix.com/showthread.php?tid=1547

' renamed HashString to TempodiIndex

ReDim Shared TempodiIndex(0 To 1000) As TempodiData '<--- instance of hashtable



' For delimited string dictionary

Dim Shared m_sDictionary As String



' Local vars

Dim in$



' MAIN OUTER LOOP

Do

    Cls

    

    ' MENU INPUT LOOP

    Do

        Print "1. Compare dictionary algorithm speeds"

        Print "2. Delimited string dictionary demonstration"

        Print "3. Quit"

        Input "Selection"; in$

        in$ = Left$(_Trim$(in$), 1)

        If InStr(",1,2,3,", "," + in$ + ",") > 0 Then

            Exit Do

        Else

            Print

            Print "*** Please select 1, 2 or 3. ***"

            Print

        End If

    Loop ' MENU INPUT LOOP



    If in$ = "1" Then

        DictionaryTest3

    ElseIf in$ = "2" Then

        TestDD

    Else

        Exit Do

    End If



Loop ' MAIN OUTER LOOP



' FINISHED

Print m_ProgramName$ + " finished. Press any key to exit."

Sleep

System ' return control to the operating system



' /////////////////////////////////////////////////////////////////////////////



Sub DictionaryTest3

    Dim RoutineName As String: RoutineName = "DictionaryTest3"

    Dim entry As DictionaryType

    Dim lngID As Long

    Dim intID As Integer

    Dim bResult As Integer

    Dim bFinished As Integer

    Dim bFound As Integer

    Dim key$

    Dim iLoop As Long

    Dim in$

    Dim in2$

    Dim sValue$

    Dim strValue$

    Dim intValue%

    Dim lngValue&

    Dim t#

    Dim iCount1 As _Integer64

    Dim iCount2 As _Integer64

    Dim iCount3 As _Integer64

    Dim iCount4 As _Integer64

    Dim iCount5 As _Integer64

    ReDim arrData(-1) As DictionaryType



    ' =============================================================================

    ' GENERATE TEST DATA

    For iLoop = 48 To 57 ' 0-9

        ReDim _Preserve arrData(UBound(arrData) + 1) As DictionaryType

        entry.key = Chr$(iLoop)

        entry.intValue = iLoop

        entry.lngValue = iLoop * 1000

        entry.strValue = Chr$(iLoop) + Chr$(iLoop) + _Trim$(Str$(iLoop))

        entry.IsDeleted = FALSE

        arrData(UBound(arrData)) = entry

    Next iLoop

    For iLoop = 65 To 90 ' A-Z

        ReDim _Preserve arrData(UBound(arrData) + 1) As DictionaryType

        entry.key = Chr$(iLoop)

        entry.intValue = iLoop

        entry.lngValue = iLoop * 1000

        entry.strValue = Chr$(iLoop) + Chr$(iLoop) + _Trim$(Str$(iLoop))

        entry.IsDeleted = FALSE

        arrData(UBound(arrData)) = entry

    Next iLoop

    For iLoop = 97 To 122 ' a-z

        ReDim _Preserve arrData(UBound(arrData) + 1) As DictionaryType

        entry.key = Chr$(iLoop)

        entry.intValue = iLoop

        entry.lngValue = iLoop * 1000

        entry.strValue = Chr$(iLoop) + Chr$(iLoop) + _Trim$(Str$(iLoop))

        entry.IsDeleted = FALSE

        arrData(UBound(arrData)) = entry

    Next iLoop



    ' =============================================================================

    ' TEST "Luke" DICTIONARY - RUN FOR 3 SECONDS

    Print "Testing " + Chr$(34) + "Luke" + Chr$(34) + " dictionary for 3 seconds..."

    iCount1 = 0

    't# = Timer + 3

    t# = ExtendedTimer + 3

    Do

        ' WRITE VALUES

        For iLoop = LBound(arrData) To UBound(arrData)

            WriteStringToDictionary arrData(iLoop).key, arrData(iLoop).strValue

            iCount1 = iCount1 + 1

        Next iLoop



        ' FIND VALUES

        For iLoop = LBound(arrData) To UBound(arrData)

            lngID = GetID&(arrData(iLoop).key)

            If lngID > 0 Then

                strValue$ = m_arrDict(lngID).strValue

            End If

            iCount1 = iCount1 + 1

        Next iLoop

    Loop Until ExtendedTimer > t#

    'Loop Until Timer > t#



    ' =============================================================================

    ' TEST "TempodiBasic" DICTIONARY WITH ID CHECK - RUN FOR 3 SECONDS

    Print "Testing " + Chr$(34) + "TempodiBasic" + Chr$(34) + " dictionary for 3 seconds..."

    iCount2 = 0

    't# = Timer + 3

    t# = ExtendedTimer + 3

    Do

        ' WRITE VALUES

        For iLoop = LBound(arrData) To UBound(arrData)

            StoreValue arrData(iLoop).key, arrData(iLoop).strValue

            iCount2 = iCount2 + 1

        Next iLoop



        ' FIND VALUES

        For iLoop = LBound(arrData) To UBound(arrData)

            intID = GetIndex%(arrData(iLoop).key)

            If intID > -1 Then

                strValue$ = GetValue$(arrData(iLoop).key)

            End If

            iCount2 = iCount2 + 1

        Next iLoop

    Loop Until ExtendedTimer > t#

    'Loop Until Timer > t#



    ' =============================================================================

    ' TEST "TempodiBasic" DICTIONARY WITHOUT ID CHECK - RUN FOR 3 SECONDS

    Print "Testing " + Chr$(34) + "TempodiBasic" + Chr$(34) + " dictionary (no ID check) for 3 seconds..."

    iCount3 = 0

    't# = Timer + 3

    t# = ExtendedTimer + 3

    Do

        ' WRITE VALUES

        For iLoop = LBound(arrData) To UBound(arrData)

            StoreValue arrData(iLoop).key, arrData(iLoop).strValue

            iCount3 = iCount3 + 1

        Next iLoop



        ' FIND VALUES

        For iLoop = LBound(arrData) To UBound(arrData)

            'intID = GetIndex%(arrData(iLoop).key)

            'if intID > -1 then

            strValue$ = GetValue$(arrData(iLoop).key)

            'end if

            iCount3 = iCount3 + 1

        Next iLoop

    Loop Until ExtendedTimer > t#

    'Loop Until Timer > t#



    ' =============================================================================

    ' TEST "Delimited String" DICTIONARY WITH ID CHECK - RUN FOR 3 SECONDS

    Print "Testing " + Chr$(34) + "Delimited String" + Chr$(34) + " dictionary for 3 seconds..."

    iCount4 = 0

    't# = Timer + 3

    t# = ExtendedTimer + 3

    Do

        ' WRITE VALUES

        For iLoop = LBound(arrData) To UBound(arrData)

            WriteDD arrData(iLoop).key, arrData(iLoop).strValue

            iCount4 = iCount4 + 1

        Next iLoop



        ' FIND VALUES

        For iLoop = LBound(arrData) To UBound(arrData)

            bFound = FoundInDD%(arrData(iLoop).key)

            If bFound = TRUE Then

                strValue$ = ReadDD$(arrData(iLoop).key, "(NOT FOUND)")

            End If

            iCount4 = iCount4 + 1

        Next iLoop

    Loop Until ExtendedTimer > t#

    'Loop Until Timer > t#



    ' =============================================================================

    ' TEST "Delimited String" DICTIONARY WITHOUT ID CHECK - RUN FOR 3 SECONDS

    Print "Testing " + Chr$(34) + "Delimited String" + Chr$(34) + " dictionary (no ID check) for 3 seconds..."

    iCount5 = 0

    't# = Timer + 3

    t# = ExtendedTimer + 3

    Do

        ' WRITE VALUES

        For iLoop = LBound(arrData) To UBound(arrData)

            WriteDD arrData(iLoop).key, arrData(iLoop).strValue

            iCount5 = iCount5 + 1

        Next iLoop



        ' FIND VALUES

        For iLoop = LBound(arrData) To UBound(arrData)

            strValue$ = ReadDD$(arrData(iLoop).key, "(NOT FOUND)")

            iCount5 = iCount5 + 1

        Next iLoop

    Loop Until ExtendedTimer > t#

    'Loop Until Timer > t#



    ' =============================================================================

    ' SHOW RESULTS

    Print "In 3 seconds:"

    Print "Luke             algorithm                    counted to " + _Trim$(Str$(iCount1))

    Print "Tempodi          algorithm                    counted to " + _Trim$(Str$(iCount2))

    Print "Tempodi          algorithm (without ID check) counted to " + _Trim$(Str$(iCount3))

    Print "Delimited string algorithm                    counted to " + _Trim$(Str$(iCount4))

    Print "Delimited string algorithm (without ID check) counted to " + _Trim$(Str$(iCount5))

    Print

    Print "PRESS ANY KEY TO CONTINUE"

    Sleep

    While _DeviceInput(1): Wend ' clear and update the keyboard buffer

    Screen 0

End Sub ' DictionaryTest3



' ****************************************************************************************************************************************************************

' BEGIN ASSOCIATIVE ARRAY FUNCTIONS (delimited string method)

' ****************************************************************************************************************************************************************



' /////////////////////////////////////////////////////////////////////////////

' Initializes delimited string dictionary.



' Required the following global declaration: Dim Shared m_sDictionary As String



' Usage: InitDD



Sub InitDD

    m_sDictionary = Chr$(13)

End Sub ' InitDD



' /////////////////////////////////////////////////////////////////////////////

' Looks for key sKey in m_sDictionary, returns TRUE if found else FALSE.



' Required the following global declaration: Dim Shared m_sDictionary As String



' Usage: bFound% = FoundInDD%(sKey$)



Function FoundInDD% (sKey As String)

    Dim iPos1 As Integer

    Dim sFind As String

    

    ' look for key (item delim followed by key followed by pair delimiter)

    sFind = Chr$(13) + sKey + Chr$(9)

    'FoundAt% = InStr(StartPos%, LookIn$, LookFor$)

    iPos1 = InStr(1, m_sDictionary, sFind)

    If iPos1 > 0 Then

        FoundInDD% = TRUE

    Else

        FoundInDD% = FALSE

    End If

End Function ' FoundInDD%



' /////////////////////////////////////////////////////////////////////////////

' Looks for key sKey in m_sDictionary

' If not found, appends key/value pair

' Else replaces value with new sValue



' Required the following global declaration: Dim Shared m_sDictionary As String



' Usage: WriteDD sKey$, sValue$



Sub WriteDD (sKey As String, sValue As String)

    Dim iPos1 As Integer

    Dim iPos2 As Integer

    Dim sFind As String

    Dim iLen As Integer

    

    ' look for key (item delim followed by key followed by pair delimiter)

    sFind = Chr$(13) + sKey + Chr$(9)

    'FoundAt% = InStr(StartPos%, LookIn$, LookFor$)

    iPos1 = InStr(1, m_sDictionary, sFind)

    If iPos1 > 0 Then

        ' FOUND KEY, UPDATE VALUE

        ' search everything after key+pair delimiter

        iPos2 = iPos1 + Len(sFind)

        

        ' Look for next item delimiter

        iPos1 = InStr(iPos2, m_sDictionary, Chr$(13))

        If iPos1 < 1 Then

            ' no more items, just replace the rightmost value

            iPos2 = iPos2 - 1

            m_sDictionary = Left$(m_sDictionary, iPos2) + sValue

        ElseIf iPos1 = (iPos2 + 1) Then

            ' next item delim comes immediately after, value was blank

            m_sDictionary = m_sDictionary + sValue

        Else

            ' found items after, return everything with value replaced

            iLen = Len(m_sDictionary) - iPos1

            iPos2 = iPos2 - 1

            m_sDictionary = _ 

                left$(m_sDictionary, iPos2) + _ 

                sValue + _

                chr$(13) + _

                right$(m_sDictionary, iLen)

        End If

    Else

        ' KEY NOT FOUND, INSERT

        If Len(m_sDictionary) = 0 Then

            m_sDictionary = m_sDictionary + Chr$(13)

        End If

        m_sDictionary = m_sDictionary + sKey + Chr$(9) + sValue + Chr$(13)

    End If

End Sub ' WriteDD



' /////////////////////////////////////////////////////////////////////////////

' Looks for key sKey in m_sDictionary

' If found, returns the associated value

' Else returns the default value sDefault



' Required the following global declaration: Dim Shared m_sDictionary As String



' Usage: MyValue$ = ReadDD$(sKey$, sDefault$)



Function ReadDD$ (sKey As String, sDefault As String)

    Dim iPos1 As Integer

    Dim iPos2 As Integer

    Dim sFind As String

    Dim iLen As Integer

    

    ' look for key (item delim followed by key followed by pair delimiter)

    sFind = Chr$(13) + sKey + Chr$(9)

    'FoundAt% = InStr(StartPos%, LookIn$, LookFor$)

    iPos1 = InStr(1, m_sDictionary, sFind)

    If iPos1 > 0 Then

        ' FOUND KEY, now search everything after key+pair delimiter

        iPos2 = iPos1 + Len(sFind)

        

        ' Look for next item delimiter

        iPos1 = InStr(iPos2, m_sDictionary, Chr$(13))

        If iPos1 < 1 Then

            ' no more items, just return what's left

            iLen = Len(m_sDictionary) - iPos2

            ReadDD$ = Right$(m_sDictionary, iLen)

        ElseIf iPos1 = (iPos2 + 1) Then

            ' next item delim comes immediately after, value was blank

            ReadDD$ = ""

        Else

            ' grab the value portion upto the next item delimiter

            ReadDD$ = Mid$(m_sDictionary, iPos2, iPos1 - iPos2)

        End If

    Else

        ' KEY NOT FOUND, RETURN BLANK

        ReadDD$ = sDefault

    End If

End Function ' ReadDD$



' /////////////////////////////////////////////////////////////////////////////

' Looks for key sKey in m_sDictionary

' If found, deletes the name/value pair from m_sDictionary, and returns TRUE

' Else returns FALSE



' Required the following global declaration: Dim Shared m_sDictionary As String



' Usage: bResult% = DeleteDD%(sKey$)



Function DeleteDD% (sKey As String)

    Dim iPos1 As Integer

    Dim iPos2 As Integer

    Dim iPos3 As Integer

    Dim sFind As String

    Dim iLen1 As Integer

    Dim iLen2 As Integer

    

    ' look for key (item delim followed by key followed by pair delimiter)

    sFind = Chr$(13) + sKey + Chr$(9)

    iPos1 = InStr(1, m_sDictionary, sFind)

    If iPos1 > 0 Then

        ' FOUND KEY, REMOVE ITEM

        ' search everything after key+pair delimiter

        iPos2 = iPos1 + Len(sFind)

        

        ' Look for next item delimiter

        iPos3 = InStr(iPos2, m_sDictionary, Chr$(13))

        

        If iPos3 < 1 Then

            ' no more items, just remove the rightmost item

            iPos1 = iPos1 - 1

            m_sDictionary = Left$(m_sDictionary, iPos1)

            

        ElseIf iPos3 = (iPos2 + 1) Then

            ' next item delim comes immediately after, value was blank

            m_sDictionary = Left$(m_sDictionary, iPos1)

            

        Else

            ' found items after, return everything with item removed

            iLen1 = iPos1 - 1

            iLen2 = (Len(m_sDictionary) - iPos3) + 1

            m_sDictionary = _ 

                left$(m_sDictionary, iLen1) + _ 

                right$(m_sDictionary, iLen2)

        End If

        DeleteDD% = TRUE

    Else

        DeleteDD% = FALSE

    End If

End Function ' DeleteDD%



' /////////////////////////////////////////////////////////////////////////////

' Dumps the raw string contents of the delimited string dictionary MyString,

' inserting line breaks where item delimiter chr$(13) is found

' (showing "\n" on the screen as well)

' and showing "\t" where pair delimiter chr$(9) is found.



Sub DumpDD (MyString As String)

    Dim sValue As String

    Dim iLoop As Integer

    Print "Dump raw value of delimited string dictionary:"

    sValue = ""

    For iLoop = 1 To Len(MyString)

        If Mid$(MyString, iLoop, 1) = Chr$(13) Then

            Print sValue + "\n": sValue = ""

        ElseIf Mid$(MyString, iLoop, 1) = Chr$(9) Then

            sValue = sValue + "\t"

        Else

            sValue = sValue + Mid$(MyString, iLoop, 1)

        End If

        If Len(sValue) > 78 Then

            Print sValue: sValue = ""

        End If

    Next iLoop

    Print

End Sub ' DumpDD



' /////////////////////////////////////////////////////////////////////////////

' Tests all operations of the delimited string dictionary.



' Required the following global declaration: Dim Shared m_sDictionary As String



Sub TestDD

    ' DECLARATIONS

    Dim iLoop As Integer

    Dim sKey As String

    Dim sValue As String

    Dim sResult As String

    Dim bFound As Integer

    Dim bResult As Integer



    ' USE HIRES DISPLAY MODE TO FIT MORE TEXT ON SCREEN

    'Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0

    Screen _NewImage(1024, 768, 32): _ScreenMove 0, 0

    

    ' INITIALIZE DICTIONARY

    InitDD

    

    ' =============================================================================

    ' ADD EVEN NUMBERS

    Cls

    Print "-------------------------------------------------------------------------------"

    Print "ADD EVEN NUMBERS:"

    Print "-------------------------------------------------------------------------------"

    For iLoop = 1 To 6

        If IsEven%(iLoop) = TRUE Then

            sKey = "MyKey" + _Trim$(Str$(iLoop))

            sValue = "MyValue" + _Trim$(Str$(iLoop))

            Print "dictionary(" + Chr$(34) + sKey + Chr$(34) + ")=" + Chr$(34) + sValue + Chr$(34)

            WriteDD sKey, sValue

        End If

    Next iLoop

    Print

    

    ' DUMP DICTIONARY

    DumpDD m_sDictionary

    

    ' LOOK FOR KEYS

    Print "Test FoundInDD%:"

    For iLoop = 1 To 7

        sKey = "MyKey" + _Trim$(Str$(iLoop))

        bFound = FoundInDD%(sKey)

        print "FoundInDD%(" + _

            chr$(34) + sKey + chr$(34) + _

            ") returns " + _

            TrueFalse$(bFound)

    Next iLoop

    Print

    

    ' WAIT FOR USER

    WaitForUser

    

    ' =============================================================================

    ' UPDATE A VALUE AT THE BEGINNING

    sKey = "MyKey2"

    sValue = "NewValue2"

    Cls

    Print "-------------------------------------------------------------------------------"

    print "updating dictionary value at the beginning " + _ 

        "key " + chr$(34) + sKey + chr$(34) + " " + _

        "to value " + chr$(34) + sValue + chr$(34)

    Print "-------------------------------------------------------------------------------"

    WriteDD sKey, sValue

    Print

    

    ' DUMP DICTIONARY

    DumpDD m_sDictionary

    

    ' WAIT FOR USER

    WaitForUser

    

    ' =============================================================================

    ' UPDATE A VALUE IN THE MIDDLE

    sKey = "MyKey4"

    sValue = "NewValue4"

    Cls

    Print "-------------------------------------------------------------------------------"

    print "updating dictionary value in the middle " + _ 

        "key " + chr$(34) + sKey + chr$(34) + " " + _

        "to value " + chr$(34) + sValue + chr$(34)

    Print "-------------------------------------------------------------------------------"

    WriteDD sKey, sValue

    Print

    

    ' DUMP DICTIONARY

    DumpDD m_sDictionary

    

    ' WAIT FOR USER

    WaitForUser

    

    ' =============================================================================

    ' UPDATE A VALUE AT THE END

    sKey = "MyKey6"

    sValue = "NewValue6"

    Cls

    Print "-------------------------------------------------------------------------------"

    print "updating dictionary value at the end " + _ 

        "key " + chr$(34) + sKey + chr$(34) + " " + _

        "to value " + chr$(34) + sValue + chr$(34)

    Print "-------------------------------------------------------------------------------"

    WriteDD sKey, sValue

    Print

    

    ' DUMP DICTIONARY

    DumpDD m_sDictionary

    

    ' WAIT FOR USER

    WaitForUser

    

    ' =============================================================================

    ' ADD ODD NUMBERS

    Cls

    Print "-------------------------------------------------------------------------------"

    Print "ADD ODD NUMBERS:"

    Print "-------------------------------------------------------------------------------"

    For iLoop = 1 To 6

        If IsOdd%(iLoop) = TRUE Then

            sKey = "MyKey" + _Trim$(Str$(iLoop))

            sValue = "MyValue" + _Trim$(Str$(iLoop))

            Print "dictionary(" + Chr$(34) + sKey + Chr$(34) + ")=" + Chr$(34) + sValue + Chr$(34)

            WriteDD sKey, sValue

        End If

    Next iLoop

    Print

    

    ' DUMP DICTIONARY

    DumpDD m_sDictionary

    

    ' LOOK FOR KEYS

    Print "Test FoundInDD%:"

    For iLoop = 1 To 7

        sKey = "MyKey" + _Trim$(Str$(iLoop))

        bFound = FoundInDD%(sKey)

        print "FoundInDD%(" + _

            chr$(34) + sKey + chr$(34) + _

            ") returns " + _

            TrueFalse$(bFound)

    Next iLoop

    Print

    

    ' WAIT FOR USER

    WaitForUser

    

    ' =============================================================================

    ' QUERY VALUES

    Cls

    Print "-------------------------------------------------------------------------------"

    Print "QUERY VALUES"

    Print "-------------------------------------------------------------------------------"

    

    ' QUERY VALUES

    TestQueryDD

    

    ' WAIT FOR USER

    WaitForUser

    

    ' =============================================================================

    ' DELETE AN ITEM FROM MIDDLE

    sKey = "MyKey1"

    Cls

    Print "-------------------------------------------------------------------------------"

    Print "DELETING ITEM " + Chr$(34) + sKey + Chr$(34) + " FROM MIDDLE"

    Print "-------------------------------------------------------------------------------"

    bResult = DeleteDD%(sKey)

    Print "DeleteDD%(" + Chr$(34) + sKey + Chr$(34) + ") returns " + TrueFalse$(bResult)

    Print

    

    ' DUMP DICTIONARY

    DumpDD m_sDictionary

    

    ' WAIT FOR USER

    WaitForUser

    

    ' =============================================================================

    ' DELETE AN ITEM FROM START

    sKey = "MyKey2"

    Cls

    Print "-------------------------------------------------------------------------------"

    Print "DELETING ITEM " + Chr$(34) + sKey + Chr$(34) + " FROM START"

    Print "-------------------------------------------------------------------------------"

    bResult = DeleteDD%(sKey)

    Print "DeleteDD%(" + Chr$(34) + sKey + Chr$(34) + ") returns " + TrueFalse$(bResult)

    Print

    

    ' DUMP DICTIONARY

    DumpDD m_sDictionary

    

    ' WAIT FOR USER

    WaitForUser

    

    ' =============================================================================

    ' DELETE AN ITEM FROM END

    sKey = "MyKey5"

    Cls

    Print "-------------------------------------------------------------------------------"

    Print "DELETING ITEM " + Chr$(34) + sKey + Chr$(34) + " FROM END"

    Print "-------------------------------------------------------------------------------"

    bResult = DeleteDD%(sKey)

    Print "DeleteDD%(" + Chr$(34) + sKey + Chr$(34) + ") returns " + TrueFalse$(bResult)

    Print

    

    ' DUMP DICTIONARY

    DumpDD m_sDictionary

    

    ' WAIT FOR USER

    WaitForUser

    

    ' =============================================================================

    ' DELETE AN ITEM THAT DOESN'T EXIST

    sKey = "MyKey33"

    Cls

    Print "-------------------------------------------------------------------------------"

    Print "DELETING ITEM " + Chr$(34) + sKey + Chr$(34) + " FROM END"

    Print "-------------------------------------------------------------------------------"

    bResult = DeleteDD%(sKey)

    Print "DeleteDD%(" + Chr$(34) + sKey + Chr$(34) + ") returns " + TrueFalse$(bResult)

    Print

    

    ' DUMP DICTIONARY

    DumpDD m_sDictionary

    

    ' WAIT FOR USER

    WaitForUser

    

    ' =============================================================================

    ' QUERY VALUES

    Cls

    Print "-------------------------------------------------------------------------------"

    Print "QUERY VALUES"

    Print "-------------------------------------------------------------------------------"

    

    ' QUERY VALUES

    TestQueryDD

    

    ' WAIT FOR USER

    WaitForUser

    

    ' =============================================================================

    ' CLEAR DICTIONARY

    Cls

    Print "-------------------------------------------------------------------------------"

    Print "ERASE DICTIONARY"

    Print "-------------------------------------------------------------------------------"

    Print "InitDD"

    InitDD

    Print

    

    ' DUMP DICTIONARY

    DumpDD m_sDictionary

    

    ' WAIT FOR USER

    WaitForUser

    

    ' =============================================================================

    ' QUERY VALUES

    Cls

    Print "-------------------------------------------------------------------------------"

    Print "QUERY VALUES"

    Print "-------------------------------------------------------------------------------"

    

    ' QUERY VALUES

    TestQueryDD

    

    ' WAIT FOR USER

    WaitForUser

    

    ' =============================================================================

    ' DONE

    Print

    Print "*******************************************************************************"

    Print "Test finished!"

    Print "*******************************************************************************"

    

    ' WAIT FOR USER

    WaitForUser

    

    ' =============================================================================

    ' RESTORE TEXT SCREEN

    Screen 0

End Sub ' TestDD



' /////////////////////////////////////////////////////////////////////////////

' Prompts user and waits for them to press a key.



Sub WaitForUser

    Print "Press any key to continue.": Sleep: _KeyClear: '_Delay 1

End Sub ' WaitForUser



' /////////////////////////////////////////////////////////////////////////////

' Prints test keys/values found in delimited string dictionary.



Sub TestQueryDD

    Dim iLoop As Integer

    Dim sKey As String

    Dim sValue As String

    

    Print "LOOKING FOR VALUES:"

    For iLoop = 1 To 9

        sKey = "MyKey" + _Trim$(Str$(iLoop))

        sValue = ReadDD$(sKey, "(NOT FOUND)")

        

        Print "iLoop=" + _Trim$(Str$(iLoop))

        Print "    Key  :" + Chr$(34) + sKey + Chr$(34)

        Print "    Value:" + Chr$(34) + sValue + Chr$(34)

    Next iLoop

    Print

End Sub ' TestQueryDD



' ****************************************************************************************************************************************************************

' END ASSOCIATIVE ARRAY FUNCTIONS (delimited string method)

' ****************************************************************************************************************************************************************



' ****************************************************************************************************************************************************************

' BEGIN ASSOCIATIVE ARRAY FUNCTIONS (Luke)

' ****************************************************************************************************************************************************************



' /////////////////////////////////////////////////////////////////////////////

' Re: associative arrays / dictionaries in QB64?

' https://www.qb64.org/forum/index.php?topic=3387.15



' From: luke

' Date: « Reply #17 on: December 20, 2020, 08:12:31 PM »

'

' My interpreter uses a hash table for storing program symbols.

' I've pulled it out and added a small demo program.

'

' It does a proper hashing of the contents and can support any

' kind of data for the "value" half because it works with a UDT,

' but it does require two SHARED arrays and a SHARED variable.

' I suppose if you really wanted to you could convert it to a

' _MEM based thing with keep it all as local variables,

' but I only needed one instance of the table in my case.

'

' Copyright 2020 Luke Ceddia

' SPDX-License-id: Apache-2.0

' arrDict.bm - Symbol Table



' /////////////////////////////////////////////////////////////////////////////

' Logically deletes item with key key$ from dictionary,

' returns TRUE if item was found and deleted.

' If not found or delete failed, returns FALSE.



Function DeleteID% (key$)

    Dim bResult%

    Dim hIndex~&

    Dim lngIndex As Long

    Dim iLower

    Dim iUpper



    ' INITIALIZE

    bResult% = FALSE



    ' LOOK IN FIRST POSITION FOR KEY

    hIndex~& = GetHash~&(key$, UBound(m_arrLookup))



    ' IS KEY FOUND (KEEP LOOKING UNTIL FOUND)

    Do

        ' IS POSITION VALID?

        If (hIndex~& >= LBound(m_arrLookup)) And (hIndex~& <= UBound(m_arrLookup)) Then

            ' MAKE SURE KEY IS FOUND

            ' IF NOT FOUND, NO NEED TO DELETE, EXIT AND RETURN FALSE

            lngIndex = m_arrLookup(hIndex~&)

            If lngIndex > 0 Then

                ' FOUND KEY, LOGICALLY DELETE FROM INDEX

                If m_arrDict(lngIndex).key = key$ Then

                    ' FLAG AS LOGICALLY DELETED

                    m_arrDict(lngIndex).IsDeleted = TRUE



                    ' RETURN TRUE = FOUND AND DELETED

                    DeleteID% = TRUE

                    Exit Function

                End If

            Else

                DeleteID% = FALSE

                Exit Function

            End If

        Else

            ' POSITION NOT VALID

            iLower = LBound(m_arrLookup)

            iUpper = UBound(m_arrLookup)

            print "Hash of key$ " + chr$(34) + key$ + chr$(34) + " = " + _

                _Trim$(Str$(hIndex~&)) + " outside bounds of m_arrLookup " + _

                "(" + _

                _Trim$(Str$(iLower)) + _

                "-" + _

                _Trim$(Str$(iUpper)) + _

                ")"

            DeleteID% = FALSE

            Exit Do

        End If



        ' LOOK IN NEXT POSITION FOR KEY

        hIndex~& = (hIndex~& + 1) Mod (UBound(m_arrLookup) + 1)

    Loop



    ' RETURN RESULT

    DeleteID% = bResult%

End Function ' DeleteID%



' /////////////////////////////////////////////////////////////////////////////

' Returns index for key key$ in associative array m_arrDict

' or 0 if not found.



Function GetID& (key$)

    Dim lngResult As Long

    Dim hIndex~&

    Dim lngIndex As Long



    lngResult = 0



    ' GET THE FIRST HASH POSITION

    hIndex~& = GetHash~&(key$, UBound(m_arrLookup))



    ' LOOK FOR THE KEY

    Do

        ' CHECK THE NEXT HASH POSITION'S INDEX

        lngIndex = m_arrLookup(hIndex~&)



        ' POSITIVE MEANS FOUND

        If lngIndex > 0 Then

            ' MAY HAVE FOUND IT, DOES THE KEY MATCH?

            If m_arrDict(lngIndex).key = key$ Then

                ' RETURN THE POSITION

                lngResult = lngIndex

                Exit Do

            End If

        Else

            ' NONE, EXIT

            Exit Do

        End If



        ' LOOK AT THE NEXT HASH POSITION

        hIndex~& = (hIndex~& + 1) Mod (UBound(m_arrLookup) + 1)

    Loop



    ' RETURN RESULT

    GetID& = lngResult

End Function ' GetID&



' /////////////////////////////////////////////////////////////////////////////

' Adds values in entry to associative array m_arrDict

' under key entry.key.



Sub WriteDictionary (entry As DictionaryType)

    ExpandArrayIfNeeded

    m_iLastIndex = m_iLastIndex + 1

    m_arrDict(m_iLastIndex) = entry

    InsertLookup entry.key, m_iLastIndex

End Sub ' WriteDictionary



' /////////////////////////////////////////////////////////////////////////////

' Writes just a string value StringValue$

' to associative array m_arrDict under key key$.



Sub WriteStringToDictionary (key$, StringValue$)

    ExpandArrayIfNeeded

    m_iLastIndex = m_iLastIndex + 1

    m_arrDict(m_iLastIndex).key = key$

    m_arrDict(m_iLastIndex).strValue = StringValue$

    m_arrDict(m_iLastIndex).IsDeleted = FALSE

    InsertLookup key$, m_iLastIndex

End Sub ' WriteStringToDictionary



' ****************************************************************************************************************************************************************

' END ASSOCIATIVE ARRAY FUNCTIONS (Luke)

' ****************************************************************************************************************************************************************



' ****************************************************************************************************************************************************************

' BEGIN ASSOCIATIVE ARRAY Strictly internal functions (Luke)

' ****************************************************************************************************************************************************************



' /////////////////////////////////////////////////////////////////////////////

' Automatically expands the dictionary arrays m_arrDict & m_arrLookup

' if space is low.



Sub ExpandArrayIfNeeded

    Const SYMTAB_MAX_LOADING = 0.75

    Const SYMTAB_GROWTH_FACTOR = 2



    Dim iLoop As Long



    If m_iLastIndex = UBound(m_arrDict) Then

        ReDim _Preserve m_arrDict(UBound(m_arrDict) * SYMTAB_GROWTH_FACTOR) As DictionaryType

    End If



    If m_iLastIndex / UBound(m_arrLookup) <= SYMTAB_MAX_LOADING Then

        Exit Sub

    End If



    ReDim m_arrLookup(UBound(m_arrLookup) * SYMTAB_GROWTH_FACTOR) As Long



    For iLoop = 1 To m_iLastIndex

        InsertLookup m_arrDict(iLoop).key, iLoop

    Next iLoop

End Sub ' ExpandArrayIfNeeded



' /////////////////////////////////////////////////////////////////////////////

' Returns a hash key for key value key$, upto max value lngMax&.

' (I'm not quite sure where the 5381 and 33 come from but it works.)



' Attributed to D. J. Bernstein

' http://www.cse.yorku.ca/~oz/hash.html



Function GetHash~& (key$, lngMax&)

    Dim hash~&

    Dim iLoop As Long



    hash~& = 5381 ' <- not sure where this # comes from?

    For iLoop = 1 To Len(key$)

        hash~& = ((hash~& * 33) Xor Asc(key$, iLoop)) Mod lngMax&

    Next iLoop



    '0<=hash<=max-1, so 1<=hash+1<=max

    GetHash~& = hash~& + 1

End Function ' GetHash~&



' /////////////////////////////////////////////////////////////////////////////

' Inserts array index pointing to item with key key$

' in dictionary array m_arrDict at position lngIndex&.



Sub InsertLookup (key$, lngIndex&)

    Dim hIndex~&



    hIndex~& = GetHash~&(key$, UBound(m_arrLookup))

    Do

        If m_arrLookup(hIndex~&) = 0 Then Exit Do

        hIndex~& = (hIndex~& + 1) Mod (UBound(m_arrLookup) + 1)

    Loop

    m_arrLookup(hIndex~&) = lngIndex&

End Sub ' InsertLookup



' ****************************************************************************************************************************************************************

' END ASSOCIATIVE ARRAY Strictly internal functions (Luke)

' ****************************************************************************************************************************************************************



' ****************************************************************************************************************************************************************

' BEGIN ASSOCIATIVE ARRAY FUNCTIONS For dictionary by TempodiBasic

' https://staging.qb64phoenix.com/showthread.php?tid=1547

' ****************************************************************************************************************************************************************



' this function returns the value linked to the index IND

' in the table TempodiIndex

Function GetValue$ (ind As String)

    GetValue$ = TempodiIndex(GetIndex(ind)).value

End Function ' GetValue$



' this subroutine stores a value VALU linked to the index IND

' in the hashtable HASH

' In this implementation the SUB overwrites thre previouse value

' stored into the hashtable if it happens a collision

' but this behaviour can be easily changed for storing the new value

' or in OPEN (searching the next cell with no value into it)

' or in list adding the value to the string already staying in hashtable

Sub StoreValue (ind As String, valu As String)

    TempodiIndex(GetIndex(ind)).value = valu

End Sub ' StoreValue



' this function calculates the Hash value for storing

' the linked value in the hashtable

Function GetIndex% (ind As String)

    Dim a As Integer

    Dim k As _Integer64

    Dim hash As _Integer64

    k = 1

    For a = 1 To Len(ind)

        hash = hash + ((Asc(ind, a)) * k)

        'k = k * 10

        k = k * 1000

    Next a

    'GetIndex% = hash Mod 10

    GetIndex% = hash Mod 1000

End Function ' GetIndex%

' ****************************************************************************************************************************************************************

' END ASSOCIATIVE ARRAY FUNCTIONS For dictionary by TempodiBasic

' ****************************************************************************************************************************************************************



' ################################################################################################################################################################

' BEGIN GENERAL PURPOSE ROUTINES #GEN

' ################################################################################################################################################################



' /////////////////////////////////////////////////////////////////////////////

' Integer to string



Function cstr$ (myValue)

    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))

    cstr$ = _Trim$(Str$(myValue))

End Function ' cstr$



' /////////////////////////////////////////////////////////////////////////////

' Hack function, to be replaced with something better



Function DblToInt% (dblOld As Double)

    Dim dblNew As Double

    Dim sValue As String

    Dim iPos As Integer

    dblNew = RoundDouble#(dblOld, 0)

    sValue = DblToStr$(dblNew)

    DblToInt% = Val(sValue)

End Function ' DblToInt%



' /////////////////////////////////////////////////////////////////////////////

' Scientific notation - QB64 Wiki

' https://www.qb64.org/wiki/Scientific_notation



' Example: A string function that displays extremely small or large exponential decimal values.



Function DblToStr$ (n#)

    Dim result$: result$ = ""

    Dim value$

    Dim Xpos%

    Dim expo%

    Dim sign$

    Dim valu$

    Dim dot%

    Dim L%

    Dim add$

    Dim min$

    Dim DP$

    Dim n%

    Dim num$



    value$ = UCase$(LTrim$(Str$(n#)))

    Xpos% = InStr(value$, "D") + InStr(value$, "E") ' only D or E can be present

    If Xpos% Then

        expo% = Val(Mid$(value$, Xpos% + 1))

        If Val(value$) < 0 Then

            sign$ = "-"

            valu$ = Mid$(value$, 2, Xpos% - 2)

        Else

            valu$ = Mid$(value$, 1, Xpos% - 1)

        End If

        dot% = InStr(valu$, ".")

        L% = Len(valu$)

        If expo% > 0 Then

            add$ = String$(expo% - (L% - dot%), "0")

        End If

        If expo% < 0 Then

            min$ = String$(Abs(expo%) - (dot% - 1), "0")

            DP$ = "."

        End If



        num$ = ""

        For n% = 1 To L%

            If Mid$(valu$, n%, 1) <> "." Then

                num$ = num$ + Mid$(valu$, n%, 1)

            End If

        Next n%

        result$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)

    Else

        result$ = value$

    End If



    DblToStr$ = result$

End Function ' DblToStr$



' /////////////////////////////////////////////////////////////////////////////



Function DblRoundedToStr$ (dblValue As Double, intNumPlaces As Integer)

    Dim dblNew As Double

    dblNew = RoundDouble#(dblValue, intNumPlaces)

    DblRoundedToStr$ = DblToStr$(dblNew)

End Function ' DblRoundedToStr$



' /////////////////////////////////////////////////////////////////////////////



Function DoubleABS# (dblValue As Double)

    If Sgn(dblValue) = -1 Then

        DoubleABS# = 0 - dblValue

    Else

        DoubleABS# = dblValue

    End If

End Function ' DoubleABS#



' /////////////////////////////////////////////////////////////////////////////

' Use with timer functions to avoid "after midnight" bug.



' SMcNeill

' More efficient version of ExtendedTimer.

' This stores our day values and only updates them when necessary.

' We really don't need to figure out how many seconds are in today over and over endlessly

' -- just count them once, and when the clock swaps back to 0:0:0, add 24*60*60 seconds to the count.



' Re: how to time something (ie do loop for n seconds)

' https://forum.qb64.org/index.php?topic=4682.0



' SMcNeill, QB64 Developer

' Reply #1 on: Today at 11:26:52 am

'

' One caveat here:  You *can* experience bugs with this after midnight.

'

' Program starts at 23:59:59.

' Add three seconds -- 24:00:02...  (In seconds, and not hours and minutes like this, though hours and minutes are easier to visualize.)

' Clock hits midnight:  0:00:00

'

' At no point will you ever have TIMER become greater than t#.

'

' If you're going to have a program which might run into this issue,

' I'd suggest just plugging in my ExtendedTimer and use it instead:

'

' Most of us write time code to test little snippets for which method might

' be faster for us while we're coding.  The clock resetting on us isn't

' normally such a big deal.  When it is, however, all you have to do is

' swap to the ExtendedTimer function [below]

'

' Returns a value for you based off DAY + TIME, rather than just time alone!

' No midnight clock issues with something like that in our programs.  ;)



' Example using regular Timer:

'    t# = Timer + 3

'    Do

'         '(SOMETHING)

'    Loop Until Timer > t#



' Usage:

'     ' DO SOMETHING FOR 3 SECONDS

'     t# = ExtendedTimer1 + 3

'     Do

'         '(SOMETHING)

'     Loop Until Timer > t#



$If EXTENDEDTIMER = UNDEFINED Then

    $Let EXTENDEDTIMER = TRUE



    Function ExtendedTimer##

        'modified extendedtimer to store the old day's count, and not have to recalculate it every time the routine is called.



        Static olds As _Float, old_day As _Float, oldt As _Float

        Dim m As Integer, d As Integer, y As Integer

        Dim s As _Float, day As String

        If olds = 0 Then 'calculate the day the first time the extended timer runs

            day = Date$

            m = Val(Left$(day, 2))

            d = Val(Mid$(day, 4, 2))

            y = Val(Right$(day, 4)) - 1970

            Select Case m 'Add the number of days for each previous month passed

                Case 2: d = d + 31

                Case 3: d = d + 59

                Case 4: d = d + 90

                Case 5: d = d + 120

                Case 6: d = d + 151

                Case 7: d = d + 181

                Case 8: d = d + 212

                Case 9: d = d + 243

                Case 10: d = d + 273

                Case 11: d = d + 304

                Case 12: d = d + 334

            End Select

            If (y Mod 4) = 2 And m > 2 Then d = d + 1 'add a day if this is leap year and we're past february

            d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year

            d = d + (y + 2) \ 4 'add in days for leap years passed

            s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds

            old_day = s

        End If

        If Timer < oldt Then 'we went from 23:59:59 (a second before midnight) to 0:0:0 (midnight)

            old_day = s + 83400 'add another worth of seconds to our counter

        End If

        oldt = Timer

        olds = old_day + oldt

        ExtendedTimer## = olds

    End Function ' ExtendedTimer##

$End If



' /////////////////////////////////////////////////////////////////////////////

' Gets the # of seconds so far today



Function GetTimeSeconds& ()

    Dim result&: result& = 0

    Dim sTime$: sTime$ = Time$

    Dim sHH24$: sHH24$ = Mid$(sTime$, 1, 2)

    Dim sMI$: sMI$ = Mid$(sTime$, 4, 2)

    Dim sSS$: sSS$ = Mid$(sTime$, 7, 2)



    result& = result& + Val(sSS$)

    result& = result& + (Val(sMI$) * 60)

    result& = result& + ((Val(sHH24$) * 60) * 60)



    ' RETURN RESULT

    GetTimeSeconds& = result&

End Function ' GetTimeSeconds&



' /////////////////////////////////////////////////////////////////////////////

' IIF function for QB for integers



Function IIF (Condition, IfTrue, IfFalse)

    If Condition Then IIF = IfTrue Else IIF = IfFalse

End Function



' /////////////////////////////////////////////////////////////////////////////

' IIF function for QB for strings



Function IIFSTR$ (Condition, IfTrue$, IfFalse$)

    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$

End Function



' /////////////////////////////////////////////////////////////////////////////

' Returns TRUE if number n is even

' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/

' see also: IsOdd%



Function IsEven% (n)

    If n Mod 2 = 0 Then

        IsEven% = TRUE

    Else

        IsEven% = FALSE

    End If

End Function ' IsEven%



' /////////////////////////////////////////////////////////////////////////////

' Returns TRUE if value text$ is numeric.



Function IsNum% (text$)

    IsNum% = IsNumber%(text$)

End Function ' IsNum%



'' OLD IsNum% CHECK FAILS FOR NUMBERS LIKE "002" AND "2.000":

'' from https://www.qb64.org/forum/index.php?topic=896.0

'Function IsNum% (text$)

'    Dim a$

'    Dim b$

'    a$ = _Trim$(text$)

'    b$ = _Trim$(Str$(Val(text$)))

'    If a$ = b$ Then

'        IsNum% = TRUE

'    Else

'        IsNum% = FALSE

'    End If

'End Function ' IsNum%



' /////////////////////////////////////////////////////////////////////////////

' Returns TRUE if value OriginalString$ is numeric else returns FALSE.



' Re: Does a Is Number function exist in QB64?

' https://www.qb64.org/forum/index.php?topic=896.15



' Version 2 by madscijr

' Returns TRUE (-1) if string is an integer, FALSE (0) if not



' Version 1 by MWheatley

' Reply #18 on: January 01, 2019, 11:24:30 AM

' returns 1 if string is an integer, 0 if not



Function IsNumber% (OriginalString$)

    Dim bResult%: bResult% = FALSE

    Dim iLoop%

    Dim TestString$

    Dim iDecimalCount%

    Dim sNextChar$



    If Len(OriginalString$) > 0 Then

        TestString$ = ""

        If Left$(OriginalString$, 1) = "+" Then

            TestString$ = Right$(OriginalString$, Len(OriginalString$) - 1)

        ElseIf Left$(OriginalString$, 1) = "-" Then

            TestString$ = Right$(OriginalString$, Len(OriginalString$) - 1)

        Else

            TestString$ = OriginalString$

        End If

        If Len(TestString$) > 0 Then

            bResult% = TRUE

            iDecimalCount% = 0

            For iLoop% = 1 To Len(TestString$)

                sNextChar$ = Mid$(TestString$, iLoop%, 1)

                If sNextChar$ = "." Then

                    iDecimalCount% = iDecimalCount% + 1

                    If iDecimalCount% > 1 Then

                        ' TOO MANY DECIMAL POINTS, INVALID!

                        bResult% = FALSE

                        Exit For

                    End If

                ElseIf Asc(sNextChar$) < 48 Or Asc(sNextChar$) > 57 Then

                    ' NOT A NUMERAL OR A DECIMAL, INVALID!

                    bResult% = FALSE

                    Exit For

                End If

            Next iLoop%

        End If

    End If

    IsNumber% = bResult%

End Function ' IsNumber%



' /////////////////////////////////////////////////////////////////////////////



'Sub IsNumberTest

'    Dim in$

'    Cls

'    IsNumberTest1 "1"

'    IsNumberTest1 "01"

'    IsNumberTest1 "001"

'    IsNumberTest1 "-1"

'    IsNumberTest1 "-01"

'    IsNumberTest1 "-001"

'    IsNumberTest1 "+1"

'    IsNumberTest1 "+01"

'    IsNumberTest1 "+001"

'    IsNumberTest1 ".1"

'    IsNumberTest1 ".01"

'    IsNumberTest1 ".001"

'    IsNumberTest1 ".10"

'    IsNumberTest1 ".100"

'    IsNumberTest1 "..100"

'    IsNumberTest1 "100."

'    Input "PRESS ENTER TO CONTINUE TEST";in$

'    Cls

'    IsNumberTest1 "0.10"

'    IsNumberTest1 "00.100"

'    IsNumberTest1 "000.1000"

'    IsNumberTest1 "000..1000"

'    IsNumberTest1 "000.1000.00"

'    IsNumberTest1 "+1.00"

'    IsNumberTest1 "++1.00"

'    IsNumberTest1 "+-1.00"

'    IsNumberTest1 "-1.00"

'    IsNumberTest1 "-+1.00"

'    IsNumberTest1 " 1"

'    IsNumberTest1 "1 "

'    IsNumberTest1 "1. 01"

'    IsNumberTest1 "+1 "

'End Sub ' IsNumberTest

'Sub IsNumberTest1(MyString As String)

'    Const cWidth = 16

'    Dim sInput As String : sInput = left$(Chr$(34) + MyString + Chr$(34) + String$(cWidth, " "), cWidth)

'    Dim sResult As String : sResult = right$(String$(2, " ") + _Trim$(Str$(IsNumber%(MyString))), 2)

'    Print "IsNumber%(" + sInput + ") returns " + sResult

'End Sub ' IsNumberTest1



' /////////////////////////////////////////////////////////////////////////////

' Returns TRUE if number n is odd

' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/

' see also: IsEven%



Function IsOdd% (n)

    If n Mod 2 = 1 Then

        IsOdd% = TRUE

    Else

        IsOdd% = FALSE

    End If

End Function ' IsOdd%



' /////////////////////////////////////////////////////////////////////////////

' Combines all elements of in$() into a single string

' with delimiter$ separating the elements.



' Split and join strings

' https://www.qb64.org/forum/index.php?topic=1073.0



Function join$ (in$(), delimiter$)

    Dim result$

    Dim i As Long

    result$ = in$(LBound(in$))

    For i = LBound(in$) + 1 To UBound(in$)

        result$ = result$ + delimiter$ + in$(i)

    Next i

    join$ = result$

End Function ' join$



' /////////////////////////////////////////////////////////////////////////////

' Prints MyString$, iLinesPerPage% lines at a time,

' then waits for user to press a key to continue,

' before printing the next iLinesPerPage% lines.



Sub PrintPaged (MyString$, iLinesPerPage%)

    Dim delim$

    ReDim arrTest$(0)

    Dim iLoop%

    Dim iCount%

    Dim in$

    delim$ = Chr$(13)

    split MyString$, delim$, arrTest$()

    iCount% = 0

    For iLoop% = LBound(arrTest$) To UBound(arrTest$)

        iCount% = iCount% + 1

        If iCount% > iLinesPerPage% Then

            Sleep

            iCount% = 0

        End If

        Print arrTest$(iLoop%)

    Next iLoop%

End Sub ' PrintPaged



' /////////////////////////////////////////////////////////////////////////////

' ABS was returning strange values with type LONG

' so I created this which does not.



Function LongABS& (lngValue As Long)

    If Sgn(lngValue) = -1 Then

        LongABS& = 0 - lngValue

    Else

        LongABS& = lngValue

    End If

End Function ' LongABS&



' /////////////////////////////////////////////////////////////////////////////

' Remove scientific Notation to String (~40 LOC)

' SMcNeill Jan 7, 2020

' https://www.qb64.org/forum/index.php?topic=1555.msg112989#msg112989



' Last Function in code marked Best Answer (removed debug comments and

' blank lines added these 2 lines.)



Function N2S$ (EXP$)

    ReDim t$, sign$, l$, r$, r&&

    ReDim dp As Long, dm As Long, ep As Long, em As Long, check1 As Long, l As Long, i As Long

    t$ = LTrim$(RTrim$(EXP$))

    If Left$(t$, 1) = "-" Or Left$(t$, 1) = "N" Then sign$ = "-": t$ = Mid$(t$, 2)

    dp = InStr(t$, "D+"): dm = InStr(t$, "D-")

    ep = InStr(t$, "E+"): em = InStr(t$, "E-")

    check1 = Sgn(dp) + Sgn(dm) + Sgn(ep) + Sgn(em)

    If check1 < 1 Or check1 > 1 Then N2S = _Trim$(EXP$): Exit Function ' If no scientic notation is found, or if we find more than 1 type, it's not SN!

    Select Case l ' l now tells us where the SN starts at.

        Case Is < dp: l = dp

        Case Is < dm: l = dm

        Case Is < ep: l = ep

        Case Is < em: l = em

    End Select

    l$ = Left$(t$, l - 1) ' The left of the SN

    r$ = Mid$(t$, l + 1): r&& = Val(r$) ' The right of the SN, turned into a workable long

    If InStr(l$, ".") Then ' Location of the decimal, if any

        If r&& > 0 Then

            r&& = r&& - Len(l$) + 2

        Else

            r&& = r&& + 1

        End If

        l$ = Left$(l$, 1) + Mid$(l$, 3)

    End If

    Select Case r&&

        Case 0 ' what the heck? We solved it already?

            ' l$ = l$

        Case Is < 0

            For i = 1 To -r&&

                l$ = "0" + l$

            Next

            l$ = "." + l$

        Case Else

            For i = 1 To r&&

                l$ = l$ + "0"

            Next

            l$ = l$

    End Select

    N2S$ = sign$ + l$

End Function ' N2S$



' /////////////////////////////////////////////////////////////////////////////

' Writes sText to file sFileName.

' If bAppend=TRUE appends to file, Else overwrites it.



' Returns blank if successful else returns error message.



' Example:

' m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))

' m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)

' sFileName = m_ProgramPath$ + m_ProgramName$ + ".OUT.txt"

' sText = "This is a test." + chr$(13) + "Here is line 2." + chr$(13) + "End."

' sError = PrintFile$(sFileName, sText, FALSE)



Function PrintFile$ (sFileName As String, sText As String, bAppend As Integer)

    Dim sError As String: sError = ""



    If Len(sError) = 0 Then

        If (bAppend = TRUE) Then

            If _FileExists(sFileName) Then

                Open sFileName For Append As #1 ' opens an existing file for appending

            Else

                sError = "Error in PrintFile$ : File not found. Cannot append."

            End If

        Else

            Open sFileName For Output As #1 ' opens and clears an existing file or creates new empty file

        End If

    End If

    If Len(sError) = 0 Then

        ' NOTE: WRITE places text in quotes in the file

        'WRITE #1, x, y, z$

        'WRITE #1, sText



        ' PRINT does not put text inside quotes

        Print #1, sText



        Close #1

    End If



    PrintFile$ = sError

End Function ' PrintFile$



' /////////////////////////////////////////////////////////////////////////////

' Initializes random number generator seed.



' NOTE:

' using # of seconds so far in the day

' may be slightly more random than Randomize Timer

' unless user runs program at exact same time every day



Sub InitializeRandom

    Dim t9#

    t9# = (Timer * 1000000) Mod 32767

    Randomize t9#

End Sub ' InitializeRandom



' /////////////////////////////////////////////////////////////////////////////

' Initializes random number generator seed.



' *** NOT SURE IF THIS ONE WORKS ***



Sub InitializeRandom1

    Dim iSeed As Integer

    iSeed = GetTimeSeconds& Mod 32767

    Randomize iSeed

End Sub ' InitializeRandom1



' /////////////////////////////////////////////////////////////////////////////

' Generate random value between Min and Max inclusive.



' Note: random-number generator should be initialized with

'       InitializeRandom or Randomize Timer



Function RandomNumber% (Min%, Max%)

    Dim NumSpread%

    NumSpread% = (Max% - Min%) + 1

    RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%

End Function ' RandomNumber%



' /////////////////////////////////////////////////////////////////////////////



$If  Then

        Sub RandomNumberTest

        Dim iCols As Integer: iCols = 10

        Dim iRows As Integer: iRows = 20

        Dim iLoop As Integer

        Dim iX As Integer

        Dim iY As Integer

        Dim sError As String

        Dim sFileName As String

        Dim sText As String

        Dim bAppend As Integer

        Dim iMin As Integer

        Dim iMax As Integer

        Dim iNum As Integer

        Dim iErrorCount As Integer

        Dim sInput$



        sFileName = "c:\temp\maze_test_1.txt"

        sText = "Count" + Chr$(9) + "Min" + Chr$(9) + "Max" + Chr$(9) + "Random"

        bAppend = FALSE

        sError = PrintFile$(sFileName, sText, bAppend)

        If Len(sError) = 0 Then

        bAppend = TRUE

        iErrorCount = 0



        iMin = 0

        iMax = iCols - 1

        For iLoop = 1 To 100

        iNum = RandomNumber%(iMin, iMax)

        sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)

        sError = PrintFile$(sFileName, sText, bAppend)

        If Len(sError) > 0 Then

        iErrorCount = iErrorCount + 1

        Print Str$(iLoop) + ". ERROR"

        Print "    " + "iMin=" + Str$(iMin)

        Print "    " + "iMax=" + Str$(iMax)

        Print "    " + "iNum=" + Str$(iNum)

        Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."

        Print "    " + sError

        End If

        Next iLoop



        iMin = 0

        iMax = iRows - 1

        For iLoop = 1 To 100

        iNum = RandomNumber%(iMin, iMax)

        sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)

        sError = PrintFile$(sFileName, sText, bAppend)

        If Len(sError) > 0 Then

        iErrorCount = iErrorCount + 1

        Print Str$(iLoop) + ". ERROR"

        Print "    " + "iMin=" + Str$(iMin)

        Print "    " + "iMax=" + Str$(iMax)

        Print "    " + "iNum=" + Str$(iNum)

        Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."

        Print "    " + sError

        End If

        Next iLoop



        Print "Finished generating numbers. Errors: " + Str$(iErrorCount)

        Else

        Print "Error creating file " + Chr$(34) + sFileName + Chr$(34) + "."

        Print sError

        End If



        Input "Press <ENTER> to continue", sInput$

        End Sub ' RandomNumberTest

$End If



' /////////////////////////////////////////////////////////////////////////////

' [Replace$] replaces all instances of the [Find] sub-string

' with the [Add] sub-string within the [Text] string.



' SUMMARY:

'   Purpose:  A library of custom functions that transform strings.

'   Author:   Dustinian Camburides (dustinian@gmail.com)

'   Platform: QB64 (www.qb64.org)

'   Revision: 1.6

'   Updated:  5/28/2012



' INPUT:

'   Text: The input string; the text that's being manipulated.

'   Find: The specified sub-string; the string sought within the [Text] string.

'   Add: The sub-string that's being added to the [Text] string.



' FROM: String Manipulation

' found at abandoned, outdated and now likely malicious qb64 dot net website

' http://www.qb64.[net]/forum/index_topic_5964-0/



Function Replace$ (Text1 As String, Find1 As String, Add1 As String)

    ' VARIABLES:

    Dim Text2 As String

    Dim Find2 As String

    Dim Add2 As String

    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.

    Dim strBefore As String ' The characters before the string to be replaced.

    Dim strAfter As String ' The characters after the string to be replaced.



    ' INITIALIZE:

    ' MAKE COPIES SO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)

    Text2 = Text1

    Find2 = Find1

    Add2 = Add1



    lngLocation = InStr(1, Text2, Find2)



    ' PROCESSING:

    ' While [Find2] appears in [Text2]...

    While lngLocation

        ' Extract all Text2 before the [Find2] substring:

        strBefore = Left$(Text2, lngLocation - 1)



        ' Extract all text after the [Find2] substring:

        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))



        ' Return the substring:

        Text2 = strBefore + Add2 + strAfter



        ' Locate the next instance of [Find2]:

        lngLocation = InStr(1, Text2, Find2)



        ' Next instance of [Find2]...

    Wend



    ' OUTPUT:

    Replace$ = Text2

End Function ' Replace$



' /////////////////////////////////////////////////////////////////////////////



$If  Then

        Sub ReplaceTest

        Dim in$



        Print "-------------------------------------------------------------------------------"

        Print "ReplaceTest"

        Print



        Print "Original value"

        in$ = "Thiz iz a teZt."

        Print "in$ = " + Chr$(34) + in$ + Chr$(34)

        Print



        Print "Replacing lowercase " + Chr$(34) + "z" + Chr$(34) + " with " + Chr$(34) + "s" + Chr$(34) + "..."

        in$ = Replace$(in$, "z", "s")

        Print "in$ = " + Chr$(34) + in$ + Chr$(34)

        Print



        Print "Replacing uppercase " + Chr$(34) + "Z" + Chr$(34) + " with " + Chr$(34) + "s" + Chr$(34) + "..."

        in$ = Replace$(in$, "Z", "s")

        Print "in$ = " + Chr$(34) + in$ + Chr$(34)

        Print



        Print "ReplaceTest finished."

        End Sub ' ReplaceTest

$End If



' /////////////////////////////////////////////////////////////////////////////

' Rounding functions.



' FROM:

' https://www.qb64.org/forum/index.php?topic=3605.0



' Quote from: SMcNeill on Today at 03:53:48 PM

'

' Sometimes, you guys make things entirely too  complicated.

' There ya go!  Three functions to either round naturally,

' always round down, or always round up, to whatever number of digits you desire.

' EDIT:  Modified to add another option to round scientific,

' since you had it's description included in your example.



' =============================================================================

' ROUNDING FUNCTIONS FOR TYPE _FLOAT



' Receives + returns _FLOAT myVar## (-1.18E-4932 to +1.18E+4932)



' old name: RoundNatural##

Function Round## (num##, digits%)

    Round## = Int(num## * 10 ^ digits% + .5) / 10 ^ digits%

End Function



Function RoundUp## (num##, digits%)

    RoundUp## = _Ceil(num## * 10 ^ digits%) / 10 ^ digits%

End Function



Function RoundDown## (num##, digits%)

    RoundDown## = Int(num## * 10 ^ digits%) / 10 ^ digits%

End Function



' old name: Round_Scientific##

Function RoundScientific## (num##, digits%)

    RoundScientific## = _Round(num## * 10 ^ digits%) / 10 ^ digits%

End Function



' =============================================================================

' ROUNDING FUNCTIONS FOR TYPE DOUBLE



Function RoundDouble# (num#, digits%)

    RoundDouble# = Int(num# * 10 ^ digits% + .5) / 10 ^ digits%

End Function



Function RoundUpDouble# (num#, digits%)

    RoundUpDouble# = _Ceil(num# * 10 ^ digits%) / 10 ^ digits%

End Function



Function RoundDownDouble# (num#, digits%)

    RoundDownDouble# = Int(num# * 10 ^ digits%) / 10 ^ digits%

End Function



Function RoundScientificDouble# (num#, digits%)

    RoundScientificDouble# = _Round(num# * 10 ^ digits%) / 10 ^ digits%

End Function



' =============================================================================

' ROUNDING FUNCTIONS FOR TYPE SINGLE



Function RoundSingle! (num!, digits%)

    RoundSingle! = Int(num! * 10 ^ digits% + .5) / 10 ^ digits%

End Function



' NOTE: not sure this one works: when digits%=3, it rounds .31 to .32

Function RoundUpSingle! (num!, digits%)

    RoundUpSingle! = _Ceil(num! * 10 ^ digits%) / 10 ^ digits%

End Function



Function RoundDownSingle! (num!, digits%)

    RoundDownSingle! = Int(num! * 10 ^ digits%) / 10 ^ digits%

End Function



Function RoundScientificSingle! (num!, digits%)

    RoundScientificSingle! = _Round(num! * 10 ^ digits%) / 10 ^ digits%

End Function



' /////////////////////////////////////////////////////////////////////////////

' Receives a Single, rounds it to intNumPlaces places,

' and returns the result as a string.



Function SngRoundedToStr$ (sngValue As Single, intNumPlaces As Integer)

    Dim sngNew As Single

    sngNew = RoundSingle!(sngValue, intNumPlaces)

    SngRoundedToStr$ = SngToStr$(sngNew)

End Function ' SngRoundedToStr$



' /////////////////////////////////////////////////////////////////////////////

' Receives a Single, rounds it to 0 places,

' and returns the result as an Integer.



' NOTE: Hack function, to be replaced with something better?



Function SngToInt% (sngOld As Single)

    Dim sngNew As Single

    Dim sValue As String

    Dim iPos As Integer

    sngNew = RoundSingle!(sngOld, 0)

    sValue = SngToStr$(sngNew)

    SngToInt% = Val(sValue)

End Function ' SngToInt%



' /////////////////////////////////////////////////////////////////////////////

' Converts a Single to a string, formatted without scientific notation.



' Scientific notation - QB64 Wiki

' https://www.qb64.org/wiki/Scientific_notation



' Example usage:

' A string function that displays extremely small or large exponential

' decimal values.



Function SngToStr$ (n!)

    Dim result$: result$ = ""

    Dim value$

    Dim Xpos%

    Dim expo%

    Dim sign$

    Dim valu$

    Dim dot%

    Dim L%

    Dim add$

    Dim min$

    Dim DP$

    Dim n%

    Dim num$



    value$ = UCase$(LTrim$(Str$(n!)))

    Xpos% = InStr(value$, "D") + InStr(value$, "E") ' only D or E can be present

    If Xpos% Then

        expo% = Val(Mid$(value$, Xpos% + 1))

        If Val(value$) < 0 Then

            sign$ = "-"

            valu$ = Mid$(value$, 2, Xpos% - 2)

        Else

            valu$ = Mid$(value$, 1, Xpos% - 1)

        End If

        dot% = InStr(valu$, ".")

        L% = Len(valu$)

        If expo% > 0 Then

            add$ = String$(expo% - (L% - dot%), "0")

        End If

        If expo% < 0 Then

            min$ = String$(Abs(expo%) - (dot% - 1), "0")

            DP$ = "."

        End If



        num$ = ""

        For n% = 1 To L%

            If Mid$(valu$, n%, 1) <> "." Then

                num$ = num$ + Mid$(valu$, n%, 1)

            End If

        Next n%

        result$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)

    Else

        result$ = value$

    End If



    SngToStr$ = result$

End Function ' SngToStr$



' /////////////////////////////////////////////////////////////////////////////

' Splits a string in$ by delimeter delimiter$

' into an array result$().



' Split and join strings

' https://www.qb64.org/forum/index.php?topic=1073.0

'

' FROM luke, QB64 Developer

' Date: February 15, 2019, 04:11:07 AM

'

' Given a string of words separated by spaces (or any other character),

' splits it into an array of the words. I've no doubt many people have

' written a version of this over the years and no doubt there's a million

' ways to do it, but I thought I'd put mine here so we have at least one

' version. There's also a join function that does the opposite

' array -> single string.

'

' Code is hopefully reasonably self explanatory with comments and a little demo.

' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.



' Split in$ into pieces, chopping at every occurrence of delimiter$.

' Multiple consecutive occurrences of delimiter$ are treated as a single instance.

' The chopped pieces are stored in result$().



' delimiter$ must be one character long.

' result$() must have been REDIMmed previously.



' Modified to handle multi-character delimiters



Sub split (in$, delimiter$, result$())

    Dim start As Integer

    Dim finish As Integer

    Dim iDelimLen As Integer

    ReDim result$(-1)



    iDelimLen = Len(delimiter$)



    start = 1

    Do

        While Mid$(in$, start, iDelimLen) = delimiter$

            start = start + iDelimLen

            If start > Len(in$) Then

                Exit Sub

            End If

        Wend

        finish = InStr(start, in$, delimiter$)

        If finish = 0 Then

            finish = Len(in$) + 1

        End If



        ReDim _Preserve result$(0 To UBound(result$) + 1)



        result$(UBound(result$)) = Mid$(in$, start, finish - start)

        start = finish + 1

    Loop While start <= Len(in$)

End Sub ' split



' /////////////////////////////////////////////////////////////////////////////



$If  Then

        Sub SplitTest

        Dim in$

        Dim delim$

        ReDim arrTest$(0)

        Dim iLoop%



        delim$ = Chr$(10)

        in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"

        Print "in$ = " + Chr$(34) + in$ + Chr$(34)

        Print "delim$ = " + Chr$(34) + delim$ + Chr$(34)

        split in$, delim$, arrTest$()



        For iLoop% = LBound(arrTest$) To UBound(arrTest$)

        Print "arrTest$(" + LTrim$(RTrim$(Str$(iLoop%))) + ") = " + Chr$(34) + arrTest$(iLoop%) + Chr$(34)

        Next iLoop%



        Print

        Print "Split test finished."

        End Sub ' SplitTest

$End If



' /////////////////////////////////////////////////////////////////////////////



$If  Then

        Sub SplitAndReplaceTest

        Dim in$

        Dim out$

        Dim iLoop%

        ReDim arrTest$(0)



        Print "-------------------------------------------------------------------------------"

        Print "SplitAndReplaceTest"

        Print



        Print "Original value"

        in$ = "This line 1 " + Chr$(13) + Chr$(10) + "and line 2" + Chr$(10) + "and line 3 " + Chr$(13) + "finally THE END."

        out$ = in$

        out$ = Replace$(out$, Chr$(13), "\r")

        out$ = Replace$(out$, Chr$(10), "\n")

        out$ = Replace$(out$, Chr$(9), "\t")

        Print "in$ = " + Chr$(34) + out$ + Chr$(34)

        Print



        Print "Fixing linebreaks..."

        in$ = Replace$(in$, Chr$(13) + Chr$(10), Chr$(13))

        in$ = Replace$(in$, Chr$(10), Chr$(13))

        out$ = in$

        out$ = Replace$(out$, Chr$(13), "\r")

        out$ = Replace$(out$, Chr$(10), "\n")

        out$ = Replace$(out$, Chr$(9), "\t")

        Print "in$ = " + Chr$(34) + out$ + Chr$(34)

        Print



        Print "Splitting up..."

        split in$, Chr$(13), arrTest$()



        For iLoop% = LBound(arrTest$) To UBound(arrTest$)

        out$ = arrTest$(iLoop%)

        out$ = Replace$(out$, Chr$(13), "\r")

        out$ = Replace$(out$, Chr$(10), "\n")

        out$ = Replace$(out$, Chr$(9), "\t")

        Print "arrTest$(" + _Trim$(Str$(iLoop%)) + ") = " + Chr$(34) + out$ + Chr$(34)

        Next iLoop%

        Print



        Print "SplitAndReplaceTest finished."

        End Sub ' SplitAndReplaceTest

$End If



' /////////////////////////////////////////////////////////////////////////////

' Use to pretty print TRUE and FALSE values.



Function TrueFalse$ (myValue)

    If myValue = TRUE Then

        TrueFalse$ = "TRUE"

    Else

        TrueFalse$ = "FALSE"

    End If

End Function ' TrueFalse$



' /////////////////////////////////////////////////////////////////////////////



' ################################################################################################################################################################

' END GENERAL PURPOSE ROUTINES @GEN

' ################################################################################################################################################################



' ################################################################################################################################################################

' BEGIN REFERENCE #REF

' ################################################################################################################################################################



' =============================================================================

' SOME USEFUL STUFF FOR REFERENCE:



' Type Name               Type suffix symbol   Minimum value                  Maximum value                Size in Bytes

' ---------------------   ------------------   ----------------------------   --------------------------   -------------

' _BIT                    `                    -1                             0                            1/8

' _BIT * n                `n                   -128                           127                          n/8

' _UNSIGNED _BIT          ~`                   0                              1                            1/8

' _BYTE                   %%                   -128                           127                          1

' _UNSIGNED _BYTE         ~%%                  0                              255                          1

' INTEGER                 %                    -32,768                        32,767                       2

' _UNSIGNED INTEGER       ~%                   0                              65,535                       2

' LONG                    &                    -2,147,483,648                 2,147,483,647                4

' _UNSIGNED LONG          ~&                   0                              4,294,967,295                4

' _INTEGER64              &&                   -9,223,372,036,854,775,808     9,223,372,036,854,775,807    8

' _UNSIGNED _INTEGER64    ~&&                  0                              18,446,744,073,709,551,615   8

' SINGLE                  ! or none            -2.802597E-45                  +3.402823E+38                4

' DOUBLE                  #                    -4.490656458412465E-324        +1.797693134862310E+308      8

' _FLOAT                  ##                   -1.18E-4932                    +1.18E+4932                  32(10 used)

' _OFFSET                 %&                   -9,223,372,036,854,775,808     9,223,372,036,854,775,807    Use LEN

' _UNSIGNED _OFFSET       ~%&                  0                              18,446,744,073,709,551,615   Use LEN

' _MEM                    none                 combined memory variable type  N/A                          Use LEN



' div: int1% = num1% \ den1%

' mod: rem1% = num1% MOD den1%



' Screen _NewImage(1024, 768, 32): _ScreenMove 0, 0

' iCols = _Width(0) \ _FontWidth

' iRows = _Height(0) \ _FontHeight

' Print "_Width(0)  =" + _Trim$(Str$(_Width(0)))

' Print "_Height(0) =" + _Trim$(Str$(_Height(0)))

' Print "_FontWidth =" + _Trim$(Str$(_FontWidth))

' Print "_FontHeight=" + _Trim$(Str$(_FontHeight))

' Print "iCols = _Width(0)  \ _FontWidth  = " + _Trim$(Str$(iCols))

' Print "iRows = _Height(0) \ _FontHeight = " + _Trim$(Str$(iRows))



$If  Then

        'Pete:

        'Oh, does anyone else like how using $IF/THEN works as a block REM statement?

        'I mean I'd rather we had a QB64 block remark statement like the one used for JavaScript, but thi hack will do.

$End If



' ################################################################################################################################################################

' END REFERENCE @REF

' ################################################################################################################################################################



'#END