DECLARE SUB lookup () DECLARE SUB strSplit (src AS STRING, sep AS STRING, tok() AS STRING) DECLARE SUB menuFieldSet (func AS STRING, fldString AS STRING) DECLARE SUB menuFieldGet (func AS STRING, fldString AS STRING, fldHandle AS INTEGER) DECLARE SUB menuFieldSelect (member AS STRING, fldOffset AS INTEGER, fldLength AS INTEGER, fldHandle AS INTEGER) DECLARE SUB menuLoad (filename AS STRING, sa() AS ANY, ia() AS ANY) DECLARE FUNCTION menuDo% () TYPE mnuSection ' 8 bytes per entry id AS STRING * 6 ' section identification itmFirst AS STRING * 1 ' first item in the array itmCount AS STRING * 1 ' number of items in this section END TYPE TYPE mnuItem ' 32 bytes per entry label AS STRING * 16 ' display name prefix AS STRING * 1 ' function type func AS STRING * 47 ' function string END TYPE CONST mnuSTRING = 1 ' behaves like STRING CONST mnuINTEGER = 2 ' behaves like INTEGER (may behave as BITFLAGS) DIM SHARED bitMask(1 TO 8) AS INTEGER ' lookup table (masking multiple bits) DIM SHARED bitSquare(0 TO 7) AS INTEGER ' lookup table (squares) ' ' ' ' TYPE config continues AS INTEGER login AS STRING * 8 flags AS INTEGER END TYPE DIM SHARED cfg AS config cfg.continues = 3 cfg.login = "me" cfg.flags = 0 DIM dummy AS INTEGER lookup dummy = menuDo% END ' ' ' ' '' '' compute lookup tables '' SUB lookup DIM tmp AS DOUBLE FOR i% = LBOUND(bitSquare) TO UBOUND(bitSquare) bitSquare(i%) = 2 ^ i% NEXT i% FOR i% = LBOUND(bitMask) TO UBOUND(bitMask) tmp = LOG(i%) / LOG(2) bitMask(i%) = FIX(tmp) - ((tmp - FIX(tmp)) <> 0) bitMask(i%) = bitSquare(bitMask(i%)) - 1 NEXT i% END SUB '' '' do menu, can return a callback value '' FUNCTION menuDo% REDIM section(0) AS mnuSection ' sections REDIM item(0) AS mnuItem ' items DIM r AS STRING DIM sectionSeek AS STRING, sectionIndex AS INTEGER, itemIndex AS INTEGER DIM cursorPos AS INTEGER, cursorNew AS INTEGER, cursorOfs AS INTEGER DIM fieldString AS STRING, fieldHandle AS INTEGER DIM funcString AS STRING, labelString AS STRING ' menus should be loaded from a file CALL menuLoad("mnu_data.txt", section(), item()) ' default menu to display sectionSeek = RTRIM$(section(0).id) cursorNew = 1 DO ' find menu to display FOR sectionIndex = LBOUND(section) TO UBOUND(section) IF (sectionSeek = RTRIM$(section(sectionIndex).id)) THEN EXIT FOR NEXT sectionIndex IF (sectionIndex > UBOUND(section)) THEN sectionIndex = 0 ' display CLS : cursorPos = cursorNew + 1 FOR i% = 1 TO ASC(section(sectionIndex).itmCount) itemIndex = ASC(section(sectionIndex).itmFirst) + i% - 1 funcString = RTRIM$(item(itemIndex).func) labelString = RTRIM$(item(itemIndex).label) LOCATE i%, 3 IF (item(itemIndex).prefix = "&") THEN CALL menuFieldGet(funcString, fieldString, fieldHandle) PRINT labelString + ": " + fieldString ELSE PRINT labelString END IF NEXT i% ' interaction DO ' display cursor at new location IF (cursorPos <> cursorNew) THEN LOCATE cursorPos, 1: PRINT " " LOCATE cursorNew, 1: PRINT CHR$(16) cursorPos = cursorNew END IF ' wait for user input DO: r = INKEY$: LOOP UNTIL LEN(r): r = RIGHT$(r, 1) itemIndex = ASC(section(sectionIndex).itmFirst) + cursorPos - 1 funcString = RTRIM$(item(itemIndex).func) ' process input SELECT CASE r CASE "H", "P" ' move up and down IF (r = "H") THEN cursorOfs = -1 ELSE cursorOfs = 1 cursorNew = cursorPos + cursorOfs IF (cursorNew < 1) THEN cursorNew = 1 IF (cursorNew > ASC(section(sectionIndex).itmCount)) THEN cursorNew = ASC(section(sectionIndex).itmCount) CASE "K", "M" ' move left and right IF (item(itemIndex).prefix = "&") THEN CALL menuFieldGet(funcString, fieldString, fieldHandle) IF (fieldHandle = mnuINTEGER) THEN IF (r = "K") THEN CALL menuFieldSet(funcString, fieldString + "-") ELSE CALL menuFieldSet(funcString, fieldString + "+") END IF END IF EXIT DO END IF CASE " " ' activate SELECT CASE item(itemIndex).prefix CASE ">" sectionSeek = funcString cursorNew = 1 EXIT DO CASE "_" SELECT CASE LEFT$(UCASE$(funcString), 4) CASE "QUIT" END CASE "PLAY" ' skill = val(right$(funcString, 1)) ' level = 0 ' CALL playLevel(level, skill) EXIT DO CASE "SAVE" ' slot = val(right$(funcString, 1)) ' CALL saveGame(slot) CASE "LOAD" ' slot = val(right$(funcString, 1)) ' CALL loadGame(slot, level, skill) ' CALL playLevel(level, skill) EXIT DO END SELECT END SELECT CASE ELSE IF (item(itemIndex).prefix = "&") THEN CALL menuFieldGet(funcString, fieldString, fieldHandle) IF (fieldHandle = mnuSTRING) THEN IF (r = CHR$(8)) THEN IF (LEN(fieldString) > 0) THEN fieldString = LEFT$(fieldString, LEN(fieldString) - 1) ELSEIF ((ASC(r) >= 65) AND (ASC(r) <= 122)) THEN fieldString = fieldString + r END IF CALL menuFieldSet(funcString, fieldString) EXIT DO END IF END IF END SELECT LOOP LOOP END FUNCTION '' '' return readable field and handle type '' SUB menuFieldGet (func AS STRING, fldString AS STRING, fldHandle AS INTEGER) DIM fldOffset AS INTEGER, fldLength AS INTEGER, tmpMask AS INTEGER, tmpBase AS INTEGER REDIM token(0) AS STRING ' split string, get member fldString = "N/A" strSplit func, "/", token() CALL menuFieldSelect(token(0), fldOffset, fldLength, fldHandle) if (fldOffset = -1) THEN EXIT SUB ' copy fldString = SPACE$(fldLength) DEF SEG = VARSEG(cfg) FOR i% = 0 TO fldLength - 1 MID$(fldString, i% + 1, 1) = CHR$(PEEK(VARPTR(cfg) + i% + fldOffset)) NEXT i% DEF SEG ' make it readable SELECT CASE fldHandle ' read string CASE mnuSTRING fldString = RTRIM$(fldString) ' read integer CASE mnuINTEGER IF (UBOUND(token) = 2) THEN fldString = LTRIM$(STR$(CVI(fldString))) ELSE tmp = CVI(fldString) tmp = ((tmp \ bitSquare(VAL(token(1)))) AND bitMask(UBOUND(token) - 1)) + 2 IF ((tmp < 0) OR (tmp > UBOUND(token))) THEN fldString = "N/A": EXIT SUB fldString = token(tmp) END IF END SELECT END SUB '' '' get member offset, length, and handle type '' SUB menuFieldSelect (member AS STRING, fldOffset AS INTEGER, fldLength AS INTEGER, fldHandle AS INTEGER) SELECT CASE LCASE$(member) CASE "continues" fldOffset = 0: fldLength = LEN(cfg.continues): fldHandle = mnuINTEGER CASE "login" fldOffset = 2: fldLength = LEN(cfg.login): fldHandle = mnuSTRING CASE "flags" fldOffset = 10: fldLength = LEN(cfg.flags): fldHandle = mnuINTEGER CASE ELSE fldOffset = -1 END SELECT END SUB '' '' put value back where it belongs '' SUB menuFieldSet (func AS STRING, fldString AS STRING) DIM fldOffset AS INTEGER, fldLength AS INTEGER, fldHandle AS INTEGER, fldStuff AS STRING DIM tmp1 AS INTEGER, tmp2 AS INTEGER REDIM token(0) AS STRING ' get member strSplit func, "/", token() CALL menuFieldSelect(token(0), fldOffset, fldLength, fldHandle) IF (fldOffset = -1) THEN EXIT SUB ' convert to byte SELECT CASE fldHandle ' convert to string (erase data junk), FIXED-LENGTH STRINGS CASE mnuSTRING SELECT CASE LEN(fldStuff) CASE IS < fldLength fldStuff = fldString + SPACE$(fldLength - LEN(fldStuff)) CASE ELSE fldStuff = LEFT$(fldString, fldLength) END SELECT ' convert to integer (modify & cap), 2-BYTE INTEGERS CASE mnuINTEGER IF (UBOUND(token) = 2) THEN ' simple integer display tmp1 = VAL(LEFT$(fldString, LEN(fldString) - 1)) IF (RIGHT$(fldString, 1) = "+") THEN IF (tmp1 < VAL(token(2))) THEN tmp1 = tmp1 + 1 ELSE IF (tmp1 > VAL(token(1))) THEN tmp1 = tmp1 - 1 END IF ELSE ' combo display ' snatch proper value fldStuff = SPACE$(fldLength) DEF SEG = VARSEG(cfg) FOR i% = 0 TO fldLength - 1 MID$(fldStuff, i% + 1, 1) = CHR$(PEEK(VARPTR(cfg) + i% + fldOffset)) NEXT i% DEF SEG ' full value and sub-value tmp1 = CVI(fldStuff) tmp2 = ((tmp1 \ bitSquare(VAL(token(1)))) AND bitMask(UBOUND(token) - 1)) IF (RIGHT$(fldString, 1) = "+") THEN IF (tmp2 < (UBOUND(token) - 2)) THEN tmp2 = tmp2 + 1 ELSE IF (tmp2 > 0) THEN tmp2 = tmp2 - 1 END IF tmp1 = tmp1 XOR (tmp1 AND ((bitMask(UBOUND(token) - 1)) * bitSquare(VAL(token(1))))) tmp1 = tmp1 OR (tmp2 * bitSquare(VAL(token(1)))) END IF fldStuff = MKI$(tmp1) END SELECT ' stuff everything back where it belongs DEF SEG = VARSEG(cfg) FOR i% = 0 TO fldLength - 1 POKE VARPTR(cfg) + i% + fldOffset, ASC(MID$(fldStuff, i% + 1, 1)) NEXT i% DEF SEG END SUB '' '' load menu from file '' SUB menuLoad (filename AS STRING, sa() AS mnuSection, ia() AS mnuItem) DIM temp AS STRING, buffer AS STRING, length AS STRING DIM ofs AS INTEGER, sze AS INTEGER, numSections AS INTEGER, numItems AS INTEGER DIM byte AS STRING * 1, fileRead AS INTEGER, fileLength AS INTEGER REDIM tok(0) AS STRING ' open file OPEN filename FOR BINARY AS #1 fileLength = LOF(1) fileRead = 0 DO ' read each line temp = "" DO GET #1, , byte fileRead = fileRead + 1 IF (byte = CHR$(&HA)) OR (byte = CHR$(&HD)) THEN EXIT DO ELSEIF (byte = CHR$(&H9)) THEN byte = " " END IF temp = temp + byte LOOP WHILE (fileRead < fileLength) ' clean up and store IF (INSTR(temp, "//")) THEN temp = LEFT$(temp, INSTR(temp, "//") - 1) temp = LTRIM$(RTRIM$(temp)) IF (LEN(temp)) THEN length = length + CHR$(LEN(temp)) buffer = buffer + temp END IF LOOP WHILE (fileRead < fileLength) CLOSE #1 ' count sections and items, reserve memory ofs = 1 FOR i% = 1 TO LEN(length) IF (MID$(buffer, ofs, 1) = "|") THEN numItems = numItems + 1 ELSE numSections = numSections + 1 END IF sze = ASC(MID$(length, i%, 1)) ofs = ofs + sze NEXT i% REDIM sa(0 TO numSections - 1) AS mnuSection REDIM ia(0 TO numItems - 1) AS mnuItem ' restore sections and items numSections = -1 numItems = 0 ofs = 1 FOR i% = 1 TO LEN(length) sze = ASC(MID$(length, i%, 1)) IF (MID$(buffer, ofs, 1) = "|") THEN temp = LTRIM$(MID$(buffer, ofs + 1, sze - 1)) sa(numSections).itmCount = CHR$(ASC(sa(numSections).itmCount) + 1) strSplit temp, ",", tok() ia(numItems).label = tok(0) ia(numItems).prefix = LEFT$(tok(1), 1) ia(numItems).func = RIGHT$(tok(1), LEN(tok(1)) - 1) numItems = numItems + 1 ELSE numSections = numSections + 1 sa(numSections).id = MID$(buffer, ofs, sze) sa(numSections).itmFirst = CHR$(numItems) END IF ofs = ofs + sze NEXT i% END SUB '' '' split a string '' SUB strSplit (src AS STRING, sep AS STRING, tok() AS STRING) DIM ofs AS INTEGER, sze AS INTEGER, tmp AS INTEGER DIM tokOfs AS STRING, tokSze AS STRING ' get boundaries ofs = 1 DO tmp = INSTR(ofs, src, sep) IF (tmp) THEN sze = tmp - ofs ELSE sze = LEN(src) - ofs + 1 IF (sze) THEN tokSze = tokSze + CHR$(sze): tokOfs = tokOfs + MKI$(ofs) ofs = ofs + sze + LEN(sep) LOOP UNTIL (ofs > LEN(src)) ' create tokens REDIM tok(0 TO LEN(tokSze) - 1) AS STRING DEF SEG = VARSEG(tokSze) tmp = SADD(tokSze) FOR i% = 0 TO LEN(tokSze) - 1 tok(i%) = LTRIM$(RTRIM$(MID$(src, CVI(MID$(tokOfs, (i% * 2) + 1, 2)), PEEK(tmp + i%)))) NEXT i% DEF SEG END SUB