rbHash - Faking Associative Arrays in RunBASIC

Associative (string-indexed) arrays are powerful tools for text processing. This demo shows how to fake associative arrays in RunBASIC by adroit string manipulation.
' hashdemo.bas -- rbhash demonstration program
' by Jerry Muelver, HyText Consulting, http:\\hytext.com
' rev 1 October 2007
'------------------------------------------------------------------
' Introducing -- The All-Powerful rbhash!
' This program demonstrates the use of a delimited string to
' function as a hash (associative array). The program subs call
' relevant rbhash subs to show useage syntax and results for the
' hash-handling routines. The rbhash subs call string-handling
' subs for string splitting, extraction, and replacement.
'
' Subroutines and functions, in order of appearance:
' ----- Program subs -----
' main - program loop, with menu. Loop ends with choice to "Quit".
' pagehead - header for each screen
' buildhash - gets key-value pairs from user, feeds them to
'     ibhashput$()
' printhash - prints rbhash istring, breaks out and displays each
'     key-value pair by calling rbhashget$()
' fetchval - gets key from user, shows value for that key by
'     calling rbhashget$()
' deleteval - gets key from user, calls rbhashdel$() to delete
'     the key-value pair
' addval - gets key and value from user, calls rbhashput$() to
'     add them to the rbhash
' modifyval - gets key to change, and value to use for the change,
'     calls rbhashput$() to modify the value of that key in rbhash
' ----- rbhash functions -----
' rbhashget$() - receives rbhash and key, returns value for the key
' rbhashput$() - receives rbhash, key, and value, then adds the
'     key-value pair if the key is new, or overwrites the old value
'     if the key already exists in the rbhash
' rbhashde$() - receives rbhash and key, deletes key and value
'     from rbhash
' ----- String-handling subs -----
' splitst$() - receives string and marker, returns front of string
'     up to the marker, chops that portion off the front of the
'     original string
' extractstr$() - receives string, openmarker, and closemarker,
'     returns anything found between the two markers
' replstr$() - receives string, target, source, and {optional}
'     times, replaces target with source wherever found in string;
'     target and source may be of different length; if times is 0
'     does as many replacements as possible.
 
 
global ver$
global b$
b$ = "<br />"
ver$ = "v0.9"
 
 
'------------------------------------------------------------------
[mainloop]
while choice$ <> "g"
    call pagehead
    html " a) Load sample hash, or<br />"
    html " b) Build hash to start<br />"
    html " c) Fetch value by key<br />"
    html " d) Delete key/value pair<br />"
    html " e) Add value to hash<br />"
    html " f) Modify value for a key<br />"
    html " g) Quit<br />"
    print "Your choice ";
    input choice$
    choice$ = lower$(left$(choice$,1))
    select case choice$
        case "a"
            hash$ = "{dog}beagle{cat}American short-hair{pie}apple{car}Honda Insight{language}Esperanto"
            html "Hash = ";hash$;b$
            input "Press ENTER to continue."; a$
        case "b"
            hash$ = buildhash$(hash$)
        case "c"
            call fetchval hash$
        case "d"
            hash$ = deleteval$(hash$)
        case "e"
            hash$ = addval$(hash$)
        case "f"
            hash$ = modifyval$(hash$)
        case "g"
            cls
            print "rbHash Demo done!"
            end
    end select
wend
wait
goto [mainloop]
 
'------------------------------------------------------------------
sub pagehead
cls
html "---- rbhash Demo "; ver$; " ----"; b$
if len(hash$) > 1 then
    html "Hash = "; hash$; b$
end if
html b$
end sub
 
'------------------------------------------------------------------
function buildhash$(hash$)
call pagehead
html "Enter some favorites, first a key (dog),<br />"
html "then a value for that key (beagle).<br />"
html "To finish the list, press ENTER on blank key entry.<br />"
print
hash$ = ""
key$ = "a"
while key$ <> ""
    key$ = ""
    input "Key: "; key$
    if key$ <> "" then
        input "Value: "; value$
        hash$ = rbhashput$(hash$, key$, value$)
    end if
wend
call printhash hash$
input "Hash built. Press ENTER to continue."; a$
buildhash$ = hash$
end function
 
'------------------------------------------------------------------
sub printhash hash$
idx = 1
html "Hash string = ";hash$;"<br />"
hash$ = mid$(hash$,2)
outstr$ = word$(hash$, idx, "{")
while outstr$ <> ""
    html left$(outstr$,instr(outstr$,"}")-1);" = "
    html mid$(outstr$,instr(outstr$,"}")+1);"<br />"
    idx = idx + 1
    outstr$ = word$(hash$,idx,"{")
wend
end sub
 
'------------------------------------------------------------------
sub fetchval hash$
call pagehead
html "Searching: Enter a key to find matching value.<br />"
html "Press [Enter] on a blank key entry to quit.<br />"
html "Current hash: "; hash$; "<br />"
input "Find key: "; key$
while key$ <> ""
    html " "; rbhashget$(hash$,key$);"<br />"
    key$ = ""
    input "Find key: "; key$
wend
end sub
 
'------------------------------------------------------------------
function deleteval$(hash$)
call pagehead
html "Deleting: Enter a key to delete.<br />"
html "Press [Enter] on a blank key entry to quit:<br />"
html "Hash before: "; hash$;"<br />"
input " Delete key: "; key$
while key$ <> ""
    hash$ = rbhashdel$(hash$, key$)
    html "Hash now: "; hash$; "<br /"
    print
    key$ = ""
    input "Delete key: "; key$
wend
deleteval$ = hash$
end function
 
'------------------------------------------------------------------
function addval$(hash$)
call pagehead
html "Adding values: enter key and matching value.<br />"
html "Press [Enter] on a blank key entry to quit adding values:<br />"
html "Hash before: "; hash$; "<br />"
input " Add key: "; key$
while key$ <> ""
    input "Value: "; value$
    hash$ = rbhashput$(hash$, key$, value$)
    html "Hash now: "; hash$; "<br />"
    key$ = ""
    input "Add key: "; key$
wend
addval$ = hash$
end function
 
'------------------------------------------------------------------
function modifyval$(hash$)
call pagehead
html "Modifying: Enter a key to modify its value.<br />"
html "Press [Enter] on a blank key entry to quit:<br />"
html "Hash before: "; hash$; "<br />"
input " Change value for key: "; key$
while key$ <> ""
    input " Value: "; value$
    hash$ = rbhashput$(hash$, key$, value$)
    html "Hash now: "; hash$; "<br />"
    key$ = ""
    input " Change value for key: "; key$
wend
modifyval$ = hash$
end function
 
'------------------------------------------------------------------
function rbhashput$(hash$, key$, value$)
' finds key$ in hash array, replaces paired value with hval$.
' adds "{" to the end of the istring to allow the last
' value in the hash to be found, removes "{" before
' returning the hash to normalize the hash string.
 
hk$ = "{" +key$+"}"
hv$ = hk$ + value$
if instr(hash$,hk$) > 0 then
    hash$ = hash$ + "{"
    find$ = hk$ + extractstr$(hash$,hk$,"{") +"{"
    hv$ = hv$ + "{"
    hash$ = replstr$(hash$,find$,hv$,1)
    hash$ = left$(hash$,len(hash$)-1)
else
    hash$ = hash$ +hv$
end if
rbhashput$ = hash$
end function
 
'------------------------------------------------------------------
function rbhashget$(hash$,key$)
' finds ibkey in rbhash array, returns paired value.
' adds "{" to the end of the istring to allow the last
' value in the hash to be found.
ibk$ = "{"+key$+"}"
hash$ = hash$ + "{"
value$ = extractstr$(hash$,ibk$,"{")
rbhashget$ = value$
end function
 
'------------------------------------------------------------------
function rbhashdel$(hash$,key$)
' finds hkey$ in rbhash array, removes key and value
' adds "{" to the end of the hash string to allow the last
' value in the hash to be found, finds and deletes key
' and value, removes "{" from end of hast before
' returning modified string.
 
hk$ = "{" +key$ +"}"
hash$ = hash$ + "{"
find$ = hk$ +extractstr$(hash$,hk$,"{") +"{"
hash$ = replstr$(hash$,find$,"{",1)
hash$ = left$(hash$,len(hash$)-1)
rbhashdel$ = hash$
end function
 
'------------------------------------------------------------------
function extractstr$(ret$,opentag$,endtag$)
' extract string between opentag and endtag
' works on copy of passed string to keep from
' modifying the original string.
 
openpos = 0
endpos = 0
openpos = INSTR(ret$,opentag$)
IF openpos > 0 then
    openpos = openpos + LEN(opentag$)
    endpos = INSTR(ret$,endtag$,openpos)
    IF endpos > 0 then
        ret$ = MID$(ret$,openpos,endpos - openpos)
    END IF
ELSE
    ret$ = ""
END IF
extractstr$ = ret$
end function
 
'------------------------------------------------------------------
function replstr$(ret$,hit$,src$,rept)
'find hit$ in ret$, replace with src$, do it rept times,
'do all possible if rept = 0.
'return modified string.
 
rpx = 0
hitpos = INSTR(ret$,hit$)
while hitpos > 0
    rpx = rpx + 1
    front$ = LEFT$(ret$,hitpos -1 )
    back$ = MID$(ret$,hitpos + LEN(hit$))
    ret$ = front$ + src$ + back$
    nextpos = hitpos + LEN(src$)
    hitpos = INSTR(ret$,hit$,nextpos)
    IF rpx = rept then hitpos = 0
wend
replstr$ = ret$
end function