Programmer: Kiyote Wolf
Topic: GridMulti
Brief: Using string variables to eliminate wasted stack space.

    Every programmer dreams of their program turning out the best it can be, after say,.. about 200 revisions.. you have something that looks like a finished piece.

    I say 200 revisions, cause I like to save alot.

    When your main module grows to the biggest it can be, you become limited by your program's own use of defined arrays and variables verses the length of the overall code.

    One of the tricks I came up with when programming in a strict structured language like Turbo Pascal, was to define an array of 100 intergers, 100 strings, and use those as my variables.  That way, instead of defining a name for every variable, if I commented my use of the arrays well, I could tweak the code rather trouble free.

    Well, that is our achille's heel in QBasic.  We are free to make as many variables as we want, even if we are unaware of how we make unnecessary duplicates of the same variables, only with a slightly different name.

    That's where string variables encoded to shuttle groups of values can help keep your string usage to a minimum. 

    Using a simple scheme to encode values and string entries into one long chain, we can use a few routines to pull the data off or check against the data and create markers to grab data further down the chain.


******** WORKING FUNCTIONS, READY TO COPY & PASTE INTO CODE ******
   
FUNCTION GridCnt (in$)
Cnt = -1
IF in$ <> "" THEN
  FOR Nul = 1 TO LEN(in$)
    Char$ = MID$(in$, Nul, 1)
    IF Char$ = ";" THEN
     Cnt = Cnt + 1
    END IF
  NEXT Nul
END IF
IF Cnt = -1 THEN Cnt = 0
GridCnt = Cnt
'<> Count number of elements by counting the separators.
END FUNCTION


FUNCTION GridDelta$ (TmpStrg$, Ofs, NewStrg$)
Cnt = GridCnt(TmpStrg$)
IF Ofs > Cnt THEN Cnt = 0
TmpStrg2$ = ""
IF Cnt THEN
  FOR Nul = 0 TO Cnt
    IF Nul = Ofs THEN
     IF Nul THEN
       TmpStrg2$ = TmpStrg2$ + ";" + NewStrg$ 'vert2$(NewStrg$)
        ELSE
       TmpStrg2$ = NewStrg$ + ";"
     END IF
       ELSE
     IF Nul THEN
       TmpStrg2$ = TmpStrg2$ + ";" + GridMultiVar$(TmpStrg$, Nul)
        ELSE
       TmpStrg2$ = GridMultiVar$(TmpStrg$, Nul)
     END IF
    END IF
  NEXT Nul
  GridDelta$ = TmpStrg2$ + ";"
    ELSE
  GridDelta$ = TmpStrg$
END IF
'<> Replace one element with a new value in the chain
END FUNCTION

FUNCTION GridIF (DataCmd$, Expr$)
'<> Does the left piece of the expression match?
GridIF = 0
IF Expr$ <> "" THEN
  ExprLen = LEN(Expr$)
END IF
Nul2 = GridCnt(DataCmd$)
IF Nul2 THEN
  FOR Nul = 0 TO Nul2
    IF LEFT$(GridMultiVar$(DataCmd$, Nul), ExprLen) = Expr$ THEN
     IF Nul = 0 THEN
       GridIF = -1
        ELSE
       GridIF = Nul
     END IF
    END IF
  NEXT Nul
END IF
'<> Find the first instance of a keyword, located on the left of the entry
'Return the location, similar to INSTR$
END FUNCTION

FUNCTION GridIFExpr$ (DataCmd$, Expr$)
'<> Does the left piece of the expression match?
IF Expr$ <> "" THEN
  ExprLen = LEN(Expr$)
END IF
Nul2 = GridCnt(DataCmd$)
IF Nul2 THEN
  FOR Nul = 0 TO Nul2
    IF LEFT$(GridMultiVar$(DataCmd$, Nul), ExprLen) = Expr$ THEN
     IF LEN(DataCmd$) > LEN(Expr$) THEN
       GridIFExpr$ = MID$(DataCmd$, ExprLen + 1)
        ELSE
       GridIFExpr$ = "BLANK"
     END IF
    END IF
  NEXT Nul
END IF
'<> Check for a combined entry..
'InString$="TEST;PRINT;COLOR255;"
'z$=GridIFExpr$(InString$,"COLOR")
'z$ now = 255
END FUNCTION

FUNCTION GridMID$ (InStrg$, Start, Leng)
IF InStrg$ <> "" THEN
  Cnt = GridCnt(InStrg$)
  IF Cnt THEN
    TmpStrg$ = ""
    FOR Nul = Start TO Start + Leng - 1
     TmpStrg$ = TmpStrg$ + GridMultiVar$(InStrg$, Nul) + ";"
    NEXT Nul
  END IF
END IF
IF TmpStrg$ = "" THEN
  GridMID$ = "BLANK"
    ELSE
  GridMID$ = TmpStrg$
END IF
'<> Similar to MID$, allow us to pull out a usable chain from a longer
'one so we can start a new chain, or analyze it outside the longer chain.
END FUNCTION

FUNCTION GridMulti (in$, Cnt)
IF in$ = "" THEN EXIT FUNCTION
'ex.: All entries must have a ; after numerics--one two or 3
z = INSTR(in$, ";")
SELECT CASE Cnt
  CASE 0
    in2$ = in$
  CASE ELSE
    in2$ = in$
    FOR z = 1 TO Cnt
     w = INSTR(in2$, ";")
     in2$ = MID$(in2$, w + 1)
    NEXT z
END SELECT
GridMulti = VAL(in2$)
'Pull out a single numeric value from a chain.
END FUNCTION

FUNCTION GridMultiVar$ (in$, Cnt)
IF in$ = "" THEN EXIT FUNCTION
'ex.: All entries must have a ; after numerics--one two or 3
z = INSTR(in$, ";")
SELECT CASE Cnt
  CASE 0
    in2$ = in$
  CASE ELSE
    in2$ = in$
    FOR z = 1 TO Cnt
     w = INSTR(in2$, ";")
     in2$ = MID$(in2$, w + 1)
    NEXT z
END SELECT

IF in2$ <> "" THEN
  A$ = in2$
  NoFlag = 0
  FOR z = 1 TO LEN(in2$)
   
    B$ = MID$(in2$, z, 1)
   
    SELECT CASE B$
     CASE CHR$(0)
       IF 1 = 0 THEN MID$(A$, z, 1) = CHR$(32)
     CASE ";"
    NoFlag = -1
    MID$(A$, z, 1) = CHR$(32)
    FOR w = z TO LEN(in2$)
      MID$(A$, w, 1) = CHR$(32)
    NEXT w
     CASE ELSE
    IF NoFlag THEN cutat = z
    END SELECT
  NEXT z
  IF A$ <> "" THEN
    IF LEN(A$) > 1 THEN
     IF cutat - 1 < 1 THEN
    REM
      ELSE
    A$ = LEFT$(A$, cutat - 1)
     END IF
    END IF
  END IF
  in2$ = A$
END IF

GridMultiVar$ = LTRIM$(RTRIM$(in2$))
'<> Pull out a single string value from a chain.
'The complex stuff near the end is correction for chr$(0), chr$(32).. etc..
END FUNCTION


FUNCTION vert$ (in)
vert$ = LTRIM$(STR$(in))
'Make a numeric into a string with no leading space
END FUNCTION

FUNCTION vert2 (strng$, offs)
vert1 = 0
IF strng$ <> "" THEN
  vert1 = ASC(MID$(strng$, offs, 1))
END IF
vert2 = vert1
'Convert something encoded into ASCII back into Decimal using MID$.. blah ..
END FUNCTION

FUNCTION vert3 (HexIn$)
vert3 = VAL("&H" + LTRIM$(HexIn$))
'Take raw HEX and make them VAL() compliant for turning into values.
END FUNCTION

FUNCTION vert4$ (in)
vert4$ = LTRIM$(STR$(in)) + ";"
'Make a numeric that can be added directly to a chain.
END FUNCTION

FUNCTION vert5$ (inval)
vert5$ = RIGHT$("000" + LTRIM$(STR$(inval)), 3) + ";"
'Create a visually pleasing numeric string from a value.
'Used for showing counters and values on screen.
END FUNCTION



****** FRAGMENT OF A WORKING FUNCTION THAT USES THESE ROUTINES *****

FUNCTION MouseOver$ (in$)
'SHARED MouseX,MouseY ' global variables -- of course we assume this..
'Example of a heavily used routine of mine to check mouse position.
z = QBEX(3)
MouseOver$ = "BLANK"
SELECT CASE in$
  CASE "RGBPAL"
    ulx = 122
    uly = 10
    lrx = 249
    lry = 104
    IF (MouseX >= ulx) AND (MouseX <= lrx) AND (MouseY >= uly) AND (MouseY <= lry) THEN
     xat = INT((MouseX - ulx) / 8)
     yat = INT((MouseY - uly) / 6)
     cat = (xat + yat * 16) AND 255
     MouseOver$ = "RGBPAL;" + vert4$(cat)
    ELSE
     cat = 0
     MouseOver$ = "BLANK;BLANK;"
    END IF
   
  CASE "CTRL4"
    ulx = 6
    uly = 26
    lrx = 6 + 37 * 17
    lry = 26 + 42 * 9
    xat = (MouseX - ulx) \ 37
    yat = (MouseY - uly) \ 50
    IF (MouseX > ulx) AND (MouseY > uly) THEN
     xat2 = MouseX - (ulx + xat * 37)
     yat2 = MouseY - (uly + yat * 50)
     MouseOvr$ = "CTRL4;" + RIGHT$("000" + vert$(xat), 3) + ";" + RIGHT$("000" + vert$(yat), 3) + ";"
     MouseOver$ = MouseOvr$ + RIGHT$("000" + vert$(xat2), 3) + ";" + RIGHT$("000" + vert$(yat2), 3)
    ELSE
     MouseOver$ = "BLANK"
    END IF
END SELECT
END FUNCTION



******* FRAGMENT OF CODE THAT USES THESE ROUTINES *******

REDIM Out$(7)
Out$(0) = ""
Out$(1) = ""
Out$(2) = ""
Out$(3) = ""
Out$(4) = ""
Out$(5) = ""
Out$(6) = ""
   DotC = 15
   DO                                            'start selection loop
     IF MouseLeft THEN
    z = QBEX(6)
    Out$(0) = MouseOver("EXIT")
    Out$(1) = MouseOver("CLRBAR")
    Out$(2) = MouseOver("EXIT2")
    Out$(3) = MouseOver("CLRCHART")
    Out$(4) = MouseOver("SAVE")
    Out$(5) = MouseOver("LOAD")
    Out$(6) = MouseOver("CURSORCLR")
    Out$(7) = MouseOver("DONEEDIT")


******* FRAGMENT OF CODE THAT USES THESE ROUTINES *******


IF LEFT$(Out$(6), 5) <> "BLANK" THEN
     FontMd = 8
     PushRGB red%, green%, blue%, 11
     red% = 0: green% = 0: blue% = 0
     Cube24 515, 100, 515 + 8, 100 + 20
        msg2$ = "CHAR;" + vert$(FontCr) + ";" + vert4$(redTmp1%) + vert4$(grnTmp1%) + vert4$(bluTmp1%)
        msg2$ = msg2$ + vert4$(redTmp2%) + vert4$(grnTmp2%) + vert4$(bluTmp2%)
        SVGAFont msg2$, 515, 100, 0, 0, 8
     PullRGB 11


******* FRAGMENT OF CODE THAT USES THESE ROUTINES *******


SUB SVGAFont (msg3$, xin, yin, fore, back, size)
msg$ = msg3$
IF msg$ <> "" THEN

CodeCnt = GridCnt(msg$)
IF CodeCnt > 1 THEN
  RGBOfs = 0
  IF GridMultiVar$(msg$, 0) = "CHAR" THEN
    msg2$ = CHR$(GridMulti(msg$, 1))
    RGBOfs = 1
     ELSE
    msg2$ = GridMultiVar$(msg$, 0)
  END IF
  IF CodeCnt > 1 THEN
    z = FNRGBGrab(msg$, 1 + RGBOfs)
    PushRGB red%, green%, blue%, 4
    z = FNRGBGrab(msg$, 4 + RGBOfs)
    PushRGB red%, green%, blue%, 5
  END IF
END IF
msg$ = msg2$
L = LEN(msg$)

FOR Lenth = 1 TO L
  fontchar = ASC(MID$(msg$, Lenth, 1))

FoxX = fontchar AND 15
FoxY = fontchar \ 16

******* END OF EXAMPLES OF CODE FRAGMENTS ******


    This method of using strings to move multiple values, string elements, and combined values does have disadvantages of course.  It relies heavily on slow cumbersome commands to switch back and forth between numeric and string, and is partially recurvsive when used all at once.

    Of course this is a modest attempt to move data efficiently, but I think it has at least some place in programs.

    One very clear point of doing this is the small footprint that the code makes in the string space.  As the values come from a SUB to the main module on returning the results from processing, or sending a multitude of data to a SUB, there is one big thing lacking.  Variables.

    Instead of using variables to hold the resulting values, you can directly plug in the FUNCTIONS into the target code.

    PSET (GridMulti(DataStrg$,0),GridMulti(DataStrg$,1)),GridMulti(DataStrg$,1)

    Plainly speaking, the largest volume of dynamic variables are the strings that contain the data chains.  Instead of defining global variables to accomidate every SUB or FUNCTION or otherwise, all the data can be packed neatly into a chain that the target routine can then decode and assemble all the information it's working on processing for you.

    Of course there are local static variables in every module that must remain, but the global variables are cut back significantly.

DataStrg$ = "COLOR;FF;PRINT;30;30;"
x=MouseX    'x = 20
DataStrg$=GridDelta$(DataStrg$,vert$(x),3))

Now,.. PRINT DataStrg$

? COLOR;FF;PRINT;20;30;

DataStrg$ = "___;___;___;___;___"
'             ^______________________   element 0
'                 ^___________________  element 1
'                     ^______________   element 2
' etc....

    I have modified many of my more complex routines to accept data chains instead of a multitude of variables.

    Another plus of using this to send data is the ability to send LESS DATA TO YOUR ROUTINES.   

    Using some simple logic to parse the data chain, your routine can check for more commands emebeded in the chain to react to and operate on.  Of course, you cannot omit variables from a SUB or FUNCTION, unless you are Houdini, but you can create a data chain that is quite short, or really really long, and make your routine work as easy or as hard as you want it to.  If you have a very complex routine that functions on many different levels of complexity, you can use this to make your routine accessable to beginners using your routine at first.

    The basic premise of this entire slew of command encoding came from rewriting a QBasic ANSI parser to operate as a language to draw graphics, similar to RIP graphics. 

    One of the drawbacks of using my code is, the marker that separates the data is an ascii character, so if you encode data as raw ascii, you might accidentally put in a marker without trying to.  You will have to use MSB / LSB to split your data up into nibble sized pieces and double the length of your data chain, but the end result is in your hands ultimately.

    The other originator of this code was a method to hold alot of data in a single file to be able to sort later.  I used the traditional buffer size, 64000 and worked from there.  I took that amount down a little bit to allow for overflow.  60,000.  60,000 \ 60 = 1000.  1000 entries, each at 60 bytes.  I used a start and end marker in the fashion of ANSI,..  "&data;data;data;data;"    The end marker was optional cause I would usually run to the end of the 60 character length.  Technically, it would only be 59 usable bytes..  Each of these 60 character lengths I called carrots for some odd reason.. cause they are all the same length.  1000 is useful too, because we can make an index of 1 to 1000, or 10  10x10 boxes, or a matrix of 10x10x10.  Using different pointer schemes of course is dependent on the application.  I would only be able to hold string data along with the same data in the same carrot elements, so that means I would have to figure out a means to link broken strings that went over the 59 character limit.  Needless to say, the limit on strings at less that 59 characters made using this file system unappetizing, but it has been used in a few numeric only encoding schemes.  There is enough room to keep track of file names using the old DOS 8 character name method .. DOCUME~1 ... (the WinXP lingo method too.. ), and I have run into the little minor difficulty of having a programming directory of over 2000 files.  Creating a list of every file to look through and select from within the memory of my programs has become unfeasable.  I have been leaning to searching by extension before searching files, or debating creating an indexing routine that would let the program search an external database of the files in the directory to handle high volumes.  (I save my files way too much..)

    The trick of QBasic, is to utilize memory in a cyclic and recyclable fashion, to make use of every ounce of free space either fine tuned to a few extra lines of code, or move the most data with the least stress on the overall memory usage.

    I hope this comes in useful to at least a few people.

    Pete's QBZine is the most creative endevor I have seen!

Sincerely,

Paul Holmlund aka Kiyote Wolf
1/5/2008