'
' QBASIC LIBRARY written by Zsolt Nagy-Perge <zsolt500n@gmail.com>
' October 2018 Edition
'
DEFINT A-Z
DECLARE SUB GETKEY (K)                 ' Input: Waits for a keypress

DECLARE FUNCTION MAX (A, B)            ' Numbers: Returns the bigger integer
DECLARE FUNCTION MIN (A, B)            ' Numbers: Returns the smaller integer
DECLARE FUNCTION CEIL (N!)             ' Numbers: Rounds a number up to the nearest integer
DECLARE FUNCTION CMPINT (A$, B$)       ' Numbers: Compares two very big integers
DECLARE FUNCTION ADDINT$ (A$, B$)      ' Numbers: Adds two very big integers
DECLARE FUNCTION SUBINT$ (A$, B$)      ' Numbers: Calculates the difference between two very big integers
DECLARE FUNCTION BIN2BIG$ (B$)         ' Numbers: Converts an extremely large number from base 2 to base 10
DECLARE FUNCTION ROL$ (S$, N)          ' Numbers: Rotates bytes of a string to the right
DECLARE FUNCTION STR2BIN$ (S$)         ' Numbers: Converts a string to binary format
DECLARE FUNCTION STR2HEX$ (S$)         ' Numbers: Converts a string to hex format
DECLARE FUNCTION HEX2BIN$ (X$)         ' Numbers: Converts a hex string to binary format
DECLARE FUNCTION FROMHEX (H$)          ' Numbers: Converts hex string to a integer
DECLARE FUNCTION TOBIN$ (N, L)         ' Numbers: Converts an INTEGER to binary format
DECLARE FUNCTION TOHEX$ (N, L)         ' Numbers: Converts an INTEGER to hex format
DECLARE FUNCTION LHEX$ (N&)            ' Numbers: Converts a LONG to hex format
DECLARE FUNCTION QHEX$ (D#)            ' Numbers: Converts a DOUBLE to hex format

DECLARE FUNCTION GETCHAR (S$, PTR)     ' Strings: Returns one character from a string
DECLARE FUNCTION SUBSTR$ (S$, P1, P2)  ' Strings: Returns a string segment
DECLARE FUNCTION STRCMP (A$, B$)       ' Strings: Compares two strings
DECLARE FUNCTION RINSTR (S$, P$)       ' Strings: Like INSTR but starts searching from the end of string
DECLARE FUNCTION REPLACE$ (S$, A$, B$) ' Strings: Replaces every occurrence of one string with another
DECLARE FUNCTION STRCOUNT (S$, P$)     ' Strings: Counts how many times P$ repeatedly occurs in S$
DECLARE FUNCTION STRRID$ (L$, S$)      ' Strings: Removes every instance of string S$ from L$
DECLARE FUNCTION PREFIX$ (S$, X$)      ' Strings: Ensures that S$ starts with X$
DECLARE FUNCTION SUFFIX$ (S$, X$)      ' Strings: Ensures that S$ ends with X$
DECLARE FUNCTION QUOTE$ (S$)           ' Strings: Puts quotation marks around a string
DECLARE FUNCTION STRREV$ (S$)          ' Strings: Puts bytes in reverse order
DECLARE FUNCTION AFTER$ (S$, P$)       ' Strings: Returns whatever comes after pattern P$
DECLARE FUNCTION BEFORE$ (S$, P$)      ' Strings: Returns whatever comes before pattern P$
DECLARE FUNCTION BETWEEN$ (S$, A$, B$) ' Strings: Returns whatever is between patterns A$ and B$
DECLARE FUNCTION EXPAND$ (S$)          ' Encryption: Adds salt to string doubling its size
DECLARE FUNCTION SHRINK$ (S$)          ' Encryption: Removes salt
DECLARE FUNCTION XCRYPT$ (S$, P$)      ' Encryption: Encrypts string using XOR and random numbers (symmetric encryption)

DECLARE SUB SETWORD (N, S$, W$)        ' Changes a word in a string
DECLARE FUNCTION GETWORD$ (S$, N)      ' Lists: Returns Nth word from a string
DECLARE FUNCTION INLIST (S$, FIND$)    ' Lists: Returns word index
DECLARE FUNCTION WORDCOUNT (S$)        ' Lists: Counts words in a string
DECLARE FUNCTION REVERSE$ (S$)         ' Lists: Puts words in reverse order
DECLARE FUNCTION COLLAPSE$ (S$)        ' Lists: Removes excess whitespace
DECLARE FUNCTION SWAPWORD$ (S$, A, B)  ' Lists: Swaps two words in a string
DECLARE FUNCTION MERGE$ (A$(), S$, N)  ' Lists: Merges an array into a string
DECLARE SUB SPLIT (A$(), L$, S$)       ' Lists: Splits a string into an array

DECLARE SUB CENTER (L, A$)             ' Display: Writes text in the center of line L
DECLARE SUB PRINTB (B$)                ' Display: Writes binary string with safe bytes
DECLARE SUB SCREENCOPY (A, B)          ' Display: Copies screen content to a different memory location
DECLARE SUB SCREENSAVE (F$, P)         ' Display: Saves screenshot to a file
DECLARE SUB SCREENLOAD (F$, P)         ' Display: Loads screenshot from file to memory

DECLARE FUNCTION ADDSALT$ (S$)
DECLARE FUNCTION SHORTEN$ (S$)

DECLARE SUB QSORT (A())
DECLARE SUB INSERT (S$, START, STRLEN, NEW$)
DECLARE FUNCTION CRC$ (S$)             ' Calculate 4-digit CRC for a string
DECLARE FUNCTION RANDOM$ (L)           ' Creates a random string
DECLARE FUNCTION SHUFFLE$ (S$)         ' Shuffles bytes of string S
DECLARE FUNCTION CHARCOUNT$ (S$)  ' returns character statistics for
DECLARE FUNCTION HEX2STR$ (X$)
DECLARE FUNCTION BIN2STR$ (B$)
DECLARE FUNCTION BIN2HEX$ (B$)
DECLARE FUNCTION WORD2HEX$ (N)
DECLARE FUNCTION LONG2HEX$ (N&)
DECLARE FUNCTION LONGTOBIN$ (N&)
DECLARE FUNCTION STRSHIFT$ (S$, N)  ' adds N to each character in string, shifting their values up by N or down by N

CONST MAXL = 2147483647   ' LONG max value

SCREEN 0
WIDTH 80, 25
COLOR 15, 0
CLS

CENTER 2, "ZSOLT'S QBASIC LIBRARY DEMO"
CENTER 4, "October 2018 Edition"
COLOR 14
LOCATE 8, 5: PRINT "CENTER prints text in the center of the screen."
LOCATE 10, 5: PRINT "Usage: CENTER ROW, TEXT"
LOCATE 12, 5: PRINT "Example: ";
COLOR 10
PRINT "CENTER 17, " + CHR$(34) + "Hello World" + CHR$(34)
COLOR 14
LOCATE 15, 8:  PRINT "produces the following:"
COLOR 7
CENTER 17, "Hello World"
PRINT
PRINT
PRINT
COLOR 14
L$ = "A B C D E F G H I J K L M"
PRINT SWAPWORD$(L$, 2, 3)
END

' Adds two very large integers stored as strings.
FUNCTION ADDINT$ (A$, B$)
    LA = LEN(A$)
    LB = LEN(B$)
    FOR I = 1 TO MAX(LA, LB)
        IF LA < 1 THEN AX = 0 ELSE AX = ASC(MID$(A$, LA, 1)) - 48: LA = LA - 1
        IF LB < 1 THEN BX = 0 ELSE BX = ASC(MID$(B$, LB, 1)) - 48: LB = LB - 1
        S = AX + BX + C
        IF S < 10 THEN C = 0 ELSE C = 1: S = S - 10
        X$ = CHR$(S + 48) + X$
    NEXT I
    IF C = 1 THEN X$ = "1" + X$
    ADDINT$ = X$
END FUNCTION

' Adds salt to string S and returns a string
' that is twice as long as the original string.
FUNCTION ADDSALT$ (S$)
    J = 1
    LS = LEN(S$)
    X$ = SPACE$(LS + LS)
    RANDOMIZE TIMER * LS + RND * 1000
    FOR I = 1 TO LS
        C = ASC(MID$(S$, I, 1))
        A = CINT(RND * 255)
        B = (C - A) AND 255
        MID$(X$, J) = CHR$(A): J = J + 1
        MID$(X$, J) = CHR$(B): J = J + 1
    NEXT I
    ADDSALT$ = X$
END FUNCTION

' This function looks for pattern P$ in string S$ and returns
' whatever comes after that pattern. Returns an empty string
' if the pattern is not found.
FUNCTION AFTER$ (S$, P$)
    F = INSTR(S$, P$)
    IF F THEN AFTER$ = MID$(S$, F + LEN(P$)) ELSE AFTER$ = ""
END FUNCTION

' This function finds the last occurrance of pattern P$ in
' string S$ and returns whatever comes before that pattern.
' Returns an empty string if the pattern is not found.
FUNCTION BEFORE$ (S$, P$)
    F = RINSTR(S$, P$)
    IF F THEN BEFORE$ = MID$(S$, 1, F) ELSE BEFORE$ = ""
END FUNCTION

' This function extracts a section of string S that lies between
' patterns L and R. Returns an empty string if either L or R is not found.
FUNCTION BETWEEN$ (S$, L$, R$)
    P1 = INSTR(S$, L$): IF P1 = 0 THEN GOTO ZS
    P2 = RINSTR(S$, R$): IF P2 = 0 THEN GOTO ZS
    IF P2 <= P1 THEN
ZS:     BETWEEN$ = ""
        EXIT FUNCTION
    END IF
    P1 = P1 + LEN(L$)
    BETWEEN$ = MID$(S$, P1, P2 - P1)
END FUNCTION

' Converts a very long string of 1s and 0s to one very large integer.
FUNCTION BIN2BIG$ (B$)
    S$ = "0"  ' SUM
    R$ = "1"  ' POWERS OF TWO
    FOR I = LEN(B$) TO 1 STEP -1
        C = ASC(MID$(B$, I, 1))
        IF C = 48 OR C = 49 THEN
            IF C = 49 THEN S$ = ADDINT$(S$, R$)
            R$ = ADDINT$(R$, R$)
        END IF
    NEXT I
    BIN2BIG$ = S$
END FUNCTION

' Rounds a number up to the nearest integer.
FUNCTION CEIL (F!)
    N = FIX(F!)
    IF F! - N = 0 THEN CEIL = N: EXIT FUNCTION
    IF F! > 0 THEN N = N + 1 ELSE N = N - 1
    CEIL = N
END FUNCTION

' Print text A$ aligned in the center of line Y.
SUB CENTER (Y, A$)
    X = 1: L = LEN(A$)
    IF L < 79 THEN X = 40 - L / 2
    LOCATE Y, X: PRINT LEFT$(A$, 80);
END SUB

SUB CENTERS (Y, S$)
    T$ = REPLACE$(S$, "\", CHR$(10)) + CHR$(10)
    R = Y
    LINESTART = 0
    LINEEND = 0
    FOR I = 1 TO LEN(T$)
        C = ASC(MID$(T$, I, 1))
        IF C = 10 THEN
            L$ = ""
            IF LINESTART > 0 AND LINEEND > 0 THEN L$ = MID$(T$, LINESTART, LINEEND - LINESTART + 1)
            CENTER R, L$
            LINESTART = 0
            LINEEND = 0
            R = R + 1
        ELSEIF C > 32 THEN
            IF LINESTART = 0 THEN LINESTART = I
            LINEEND = I
        END IF
    NEXT I
END SUB

' Compares two very large integers stored as strings.
' Works on decimal, hexadecimal, and binary numbers!
' Return value = 0 if A = B
' Return value > 0 if A > B
' Return value < 0 if A < B
FUNCTION CMPINT (A$, B$)
    LA = LEN(A$)
    LB = LEN(B$)
    X = LA - LB
    IF X THEN GOTO ZX
    FOR I = 1 TO LA
        AX = ASC(MID$(A$, I, 1))
        BX = ASC(MID$(B$, I, 1))
        X = AX - BX
        IF X THEN GOTO ZX
    NEXT I
ZX: CMPINT = X
END FUNCTION

' Collapse whitespace
FUNCTION COLLAPSE$ (S$)
    SP = 0
    X$ = ""
    FOR I = 1 TO LEN(S$)
        C = ASC(MID$(S$, I, 1))
        IF C > 32 THEN
            L = LEN(X$)
            SP = 1
        ELSE
            IF SP THEN C = 32 ELSE C = 0
            SP = 0
        END IF
        IF C THEN X$ = X$ + CHR$(C)
    NEXT I
    COLLAPSE$ = MID$(X$, 1, L + 1)
END FUNCTION

' Note: The CRC calculated here is as good as a CRC value,
' but it's not a real CRC value.
FUNCTION CRC$ (S$)
    RANDOMIZE LEN(S$)
    FOR I = 1 TO LEN(S$)
        C = ASC(MID$(S$, I, 1))
        R1 = RND * (1111 + C / 10)
        R2 = RND * (7777 + C) + R1
        R3 = RND * (4444 + C) + R2
    NEXT I
    CRC$ = RIGHT$("3A221" + HEX$(R1) + HEX$(R2) + HEX$(R3), 8)
END FUNCTION

FUNCTION FROMHEX (H$)
    FROMHEX = VAL("&H" + H$)
END FUNCTION

' This function grabs one byte from string S and returns its ASCII
' character code. When PTR is negative, it grabs a character from
' the end of string. When PTR is out of range, -1 is returned.
' Example : GETCHAR("ABCD", 1) -> 65 = "A"
'           GETCHAR("ABCD", -2) -> 67 = "C"
'           GETCHAR("ABCD", 23) -> -1 (out of range)
'           GETCHAR("ABCD", 0) -> -1
FUNCTION GETCHAR (S$, PTR)
    P = PTR
    LS = LEN(S$)
    IF P < 0 THEN P = P + LS + 1
    IF LS = 0 OR P < 1 OR P > LS THEN GETCHAR = -1: EXIT FUNCTION
    GETCHAR = ASC(MID$(S$, P, 1))
END FUNCTION

' This function waits for a keypress and returns the keycode as an integer.
SUB GETKEY (K)
    DO: K$ = INKEY$
    LOOP UNTIL LEN(K$)
    K = ASC(RIGHT$(K$, 1))
    IF LEN(K$) = 2 THEN K = K + 256
END SUB

' This function returns the Nth word from a list.
' Words must be separated by whitespace or newline characters.
' When N is negative, it grabs a word from the end of the list.
' Example:
'    GETWORD$("apples peaches kiwi grapes", 1) -> "apples"
'    GETWORD$("apples peaches kiwi grapes", 9) -> "" (out of range)
'    GETWORD$("apples peaches kiwi grapes", -2) -> "kiwi"
'
FUNCTION GETWORD$ (L$, N)
    LL = LEN(L$)
    IF N = 0 OR N > LL / 2 + 2 THEN GOTO ZG
    IF N < 0 THEN
        N = N + WORDCOUNT(L$) + 1
        IF N < 1 THEN GOTO ZG
    END IF
    W = 0
    F = 0
    FOR I = 1 TO LL + 1
        C = GETCHAR(L$, I)
        IF C > 32 THEN
            IF F = 0 THEN F = I: W = W + 1
        ELSE
            IF F AND W = N THEN GETWORD$ = MID$(L$, F, I - F): EXIT FUNCTION
            F = 0
        END IF
    NEXT I
ZG: GETWORD$ = ""
END FUNCTION

' Converts a hex string to binary format.
FUNCTION HEX2BIN$ (X$)
    B$ = ""
    FOR I = 1 TO LEN(X$)
        C = INSTR("0123456789ABCDEF", UCASE$((MID$(X$, I, 1))))
        IF C THEN B$ = B$ + MID$("0000000100100011010001010110011110001001101010111100110111101111", (C - 1) * 4 + 1, 4)
    NEXT I
    HEX2BIN$ = B$
END FUNCTION

' This function finds a specific word in list L$ and returns the
' word index when found or 0 if not found. It works similar to INSTR
' which returns a byte pointer, whereas this function counts the words
' and returns a word count when the word is found. L$ must contain
' a list of words separated by whitespace or newline characters.
' Example : INLIST(" mice gym two eyes trees", "eyes") -> 4
'            INSTR(" mice gym two eyes trees", "eyes") -> 15
FUNCTION INLIST (L$, FIND$)
    W = 0
    F = 0
    LL = LEN(L$)
    FF$ = RTRIM$(LTRIM$(FIND$))
    IF LEN(FF$) > LL THEN GOTO ZZ
    FOR I = 1 TO LL + 1
        C = GETCHAR(L$, I)
        IF C > 32 THEN
            IF F < 1 THEN F = I: W = W + 1
        ELSE
            IF F > 0 THEN
                WORD$ = MID$(L$, F, I - F)
                IF WORD$ = FF$ THEN
                    INLIST = W
                    EXIT FUNCTION
                END IF
                F = 0
            END IF
        END IF
    NEXT I
ZZ: INLIST = 0
END FUNCTION

' Selects N number of bytes of string S$ starting at START and replaces
' that section with string NEW$. This may change the length of string S$.
SUB INSERT (S$, START, N, NEW$)
    LS = LEN(S$)
    LN = LEN(NEW$)
    IF START < 1 THEN EXIT SUB
    IF START = LS THEN S$ = S$ + NEW$: EXIT SUB
    IF START > LS THEN S$ = S$ + SPACE$(START - LS) + NEW$: EXIT SUB
    LENGAIN = LN - N
    IF LENGAIN < 1 THEN MID$(S$, START) = NEW$
    IF LENGAIN < 0 THEN S$ = MID$(S$, 1, START + LN - 1) + MID$(S$, START + N)
    IF LENGAIN > 0 THEN S$ = MID$(S$, 1, START - 1) + NEW$ + MID$(S$, START + N)
END SUB

' Converts a LONG to hex format.
FUNCTION LHEX$ (N&)
    X$ = ""
    S$ = MKL$(N&)
    FOR I = LEN(S$) TO 1 STEP -1
        C = ASC(MID$(S$, I, 1))
        IF C < 16 THEN X$ = X$ + "0"
        X$ = X$ + HEX$(C)
    NEXT I
    LHEX$ = X$
END FUNCTION

' Returns the bigger of two integers.
FUNCTION MAX (A, B)
    IF A > B THEN MAX = A ELSE MAX = B
END FUNCTION

' Merges the first N elements of array by placing a separator (S$)
' between the strings. If N is 0, then the function will join
' every item in the array.
FUNCTION MERGE$ (A$(), S$, N)
    L$ = ""
    IF N = 0 THEN N = UBOUND(A$)
    FOR I = 1 TO N
        L$ = L$ + A$(I)
        IF I < N THEN L$ = L$ + S$
    NEXT I
    MERGE$ = L$
END FUNCTION

' Returns the smaller of two integers.
FUNCTION MIN (A, B)
    IF A < B THEN MIN = A ELSE MIN = B
END FUNCTION

' Ensure that string S starts with string X
FUNCTION PREFIX$ (S$, X$)
    LX = LEN(X$)
    IF LX <= LEN(S$) THEN IF X$ = MID$(S$, 1, LX) THEN PREFIX$ = S$: EXIT FUNCTION
    PREFIX$ = X$ + S$
END FUNCTION

' Prints a binary string without messing up the screen.
SUB PRINTB (B$)
    FOR I = 1 TO LEN(B$)
        C = ASC(MID$(B$, I, 1))
        IF C < 32 THEN C = 250: COLOR 12 ELSE COLOR 7
        PRINT CHR$(C);
    NEXT I
    COLOR 7
END SUB

' This function converts a DOUBLE to a 16-digit hex string.
' The largest number that can be precisely converted with this
' function is 9,999,999,999,999,998 = 2386F26FC0FFFE. Converting
' anything larger than this will yield an incorrect result.
FUNCTION QHEX$ (D#)
    X# = FIX(D#)
    IF X# = 0 THEN QHEX$ = STRING$(16, "0"): EXIT FUNCTION
    M# = 9999999999999998#
    IF X# > M# THEN X# = M#
    PWR# = 4503599627370496#
    H$ = "00"
    WHILE PWR# >= 1
        IF X# >= PWR# THEN
            M = FIX(X# / PWR#)
            X# = X# - PWR# * M
            H$ = H$ + HEX$(M)
        ELSE
            H$ = H$ + "0"
        END IF
        PWR# = PWR# / 16
    WEND
    QHEX$ = RIGHT$(H$, 16)
END FUNCTION

' Sorts an array of numbers using the QuickSort algorithm.
SUB QSORT (A())
    F = LBOUND(A)
    L = UBOUND(A)
    REDIM Q((L - F + 1) \ 5 + 10)
    DO
        DO
            I = F: J = L
            T = A((L + F) \ 2)
            DO
                WHILE A(I) < T: I = I + 1: WEND
                WHILE A(J) > T: J = J - 1: WEND
                IF I > J THEN EXIT DO
                IF I < J THEN SWAP A(I), A(J)
                I = I + 1
                J = J - 1
            LOOP WHILE I <= J
            IF I < L THEN Q(SP) = I: Q(SP + 1) = L: SP = SP + 2
            L = J
        LOOP WHILE F < L
        IF SP = 0 THEN EXIT DO
        SP = SP - 2: F = Q(SP): L = Q(SP + 1)
    LOOP
    ERASE Q
END SUB

' Puts quotation marks around a string.
FUNCTION QUOTE$ (S$)
    QUOTE$ = CHR$(34) + S$ + CHR$(34)
END FUNCTION

' Returns N number of random letters.
' Use RANDOMIZE TIMER before calling this function.
FUNCTION RANDOM$ (L)
    R$ = SPACE$(L)
    FOR I = 1 TO L
        MID$(R$, I) = CHR$(RND * 25 + 65)
    NEXT I
    RANDOM$ = R$
END FUNCTION

' This function replaces every instances of string A$ with string B$.
' Returns a new string. The replacement is case sensitive.
FUNCTION REPLACE$ (S$, A$, B$)

    LA = LEN(A$)
    LB = LEN(B$)

' If the pattern is longer than the string, there's
' no way it's going to match, so we might as well exit.
    IF LA = 0 OR LEN(S$) < LA THEN REPLACE$ = S$: EXIT FUNCTION

' Is the new string going to be longer or shorter
' than the original? G will hold the answer:
    G = LB - LA  ' length Gain
    F = 1        ' Start searching for pattern From this position
    X$ = S$      ' Make a copy of the original string
    LB = LB - 1
    DO
        F = INSTR(F, X$, A$)
        IF F = 0 THEN EXIT DO
        N = F + LB
        IF G < 1 THEN MID$(X$, F) = B$
        IF G < 0 THEN X$ = MID$(X$, 1, N) + MID$(X$, F + LA)
        IF G > 0 THEN X$ = MID$(X$, 1, F - 1) + B$ + MID$(X$, F + LA)
        F = N
    LOOP
    REPLACE$ = X$
END FUNCTION

' Reverses words in a list.
FUNCTION REVERSE$ (S$)
    W = 2
    L$ = GETWORD$(S$, 1)
    DO
        WORD$ = GETWORD$(S$, W)
        IF LEN(WORD$) = 0 THEN EXIT DO
        L$ = WORD$ + " " + L$
        W = W + 1
    LOOP
    REVERSE$ = L$
END FUNCTION

' This function finds the last occurrance of pattern P$ in
' string S$ and returns the pointer to the pattern.
' Returns 0 if the pattern is not found.
FUNCTION RINSTR (S$, P$)
    L = 0
    X = 1
    DO WHILE X
        X = INSTR(X, S$, P$)
        IF X THEN L = X: X = X + 1
    LOOP
    RINSTR = L
END FUNCTION

' Rotates string S$ left by N number of bytes.
' To rotate right, specify a negative number for N.
FUNCTION ROL$ (S$, N)
    L = LEN(S$)
    S = N MOD L
    S = (L - S) MOD L
    ROL$ = RIGHT$(S$, S) + MID$(S$, 1, L - S)
END FUNCTION

' Saves screen content temporarily in a different memory location.
' A is the source page, and B is the destination page.
' Page 0 refers to the video memory where text shows up on the screen.
' Pages 1-7 are temporary locations where data can be stored.
'  Example: SCREENCOPY 0, 3  - copies screen content to page 3
'           SCREENCOPY 3, 0  - copies data from page 3 back on the screen
SUB SCREENCOPY (A, B)
    IF A = B OR A < 0 OR A > 7 OR B < 0 OR B > 7 THEN EXIT SUB
    AX = A * 4002
    BX = B * 4002
    FOR I = 0 TO 4002
        DEF SEG = &HB800
        POKE BX, PEEK(AX)
        AX = AX + 1
        BX = BX + 1
    NEXT I
    IF A = 0 THEN  ' Save cursor location
        X = POS(0)
        Y = CSRLIN
        DEF SEG = &HB800
        POKE BX - 2, X
        POKE BX - 1, Y
    END IF
    IF B = 0 THEN  ' Restore cursor location
        DEF SEG = &HB800
        Y = PEEK(AX - 1)
        X = PEEK(AX - 2)
        IF X < 1 THEN X = 1
        IF Y < 1 THEN Y = 1
        IF X > 80 THEN X = 80
        IF Y > 25 THEN Y = 25
        LOCATE Y, X
    END IF
END SUB

' Loads a screenshot from a file into memory.
' P is the destination page.
' Page 0 refers to the video memory where text shows up on the screen.
' Pages 1-7 are temporary locations where data can be stored.
'  Example: SCREENLOAD "screen.dat", 0   - immediately updates the screen
'           SCREENLOAD "screen.dat", 1   - preloads screen content from file
SUB SCREENLOAD (F$, P)
    IF P < 0 OR P > 7 THEN EXIT SUB
    BX = P * 4002
    DEF SEG = &HB800
    BLOAD F$, BX
    IF P = 0 THEN  ' Restore cursor location
        DEF SEG = &HB800
        Y = PEEK(AX - 1)
        X = PEEK(AX - 2)
        IF X < 1 THEN X = 1
        IF Y < 1 THEN Y = 1
        IF X > 80 THEN X = 80
        IF Y > 25 THEN Y = 25
        LOCATE Y, X
    END IF
END SUB

' Saves a screen page from memory to a file.
' P is the source page.
' Page 0 refers to the video memory, whatever shows up on the screen now.
' Pages 1-7 are temporary locations where screen content can be stored.
'  Example: SCREENSAVE "screen.dat", 0   - saves the current screen content
'           SCREENSAVE "screen.dat", 1   - saves page 1 to a file
SUB SCREENSAVE (F$, P)
    IF P < 0 OR P > 7 THEN EXIT SUB
    AX = P * 4002
    IF P = 0 THEN  ' Save cursor location
        X = POS(0)
        Y = CSRLIN
        DEF SEG = &HB800
        POKE 4001, X
        POKE 4002, Y
    END IF
    DEF SEG = &HB800
    BSAVE F$, AX, 4002
END SUB

' Replaces the Nth word within string S$ to W$.
' Words are separated by whitespace or newline characters.
' This sub changes the value of the second argument (S$).
' When N is negative, it counts the words from the end of string.
' When N=1, changes the first word in string S$.
SUB SETWORD (N, S$, W$)
   
   
' WORK ON THIS SOME MORE....
    NN = N
    IF N < 0 THEN
        WW = WORDCOUNT(S$)
        NN = NN + WW
    END IF
    IF N < 0 OR N = 0 OR N > LS THEN EXIT SUB
    W = 0
    F = 0
    LS = LEN(S$)
    FOR I = 1 TO LS + 1
        C = GETCHAR(S$, I)
        IF C > 32 THEN
            IF F < 1 THEN F = I: W = W + 1
        ELSE
            IF F > 0 THEN
                IF W = NN THEN GOTO ZT
                F = 0
            END IF
        END IF
    NEXT I
    EXIT SUB

ZT: ' Must replace first word when no words found?
    IF N < 2 AND W = 0 THEN S$ = W$ + S$: EXIT SUB

    ' Must replace the word after the last word?
    IF W > 0 AND N = W + 1 THEN
        IF F THEN S$ = S$ + " " + W$ ELSE S$ = S$ + W$
        EXIT SUB
    END IF

    ' Word to replace was found?
    IF F AND W = N THEN
        WORDLEN = I - F
        IF WORDLEN >= LEN(W$) THEN MID$(S$, F) = W$
        IF WORDLEN > LEN(W$) THEN S$ = MID$(S$, 1, F + LEN(W$) - 1) + MID$(S$, I)
        IF WORDLEN < LEN(W$) THEN S$ = MID$(S$, 1, F - 1) + W$ + MID$(S$, I)
    END IF
END SUB

' Removes salt from string S and returns a new string
' that is half as long as the original string.
FUNCTION SHORTEN$ (S$)
    X$ = ""
    LS = LEN(S$)
    IF LS AND 1 THEN LS = LS - 1
    FOR I = 1 TO LS
        A = ASC(MID$(S$, I, 1)): I = I + 1
        B = ASC(MID$(S$, I, 1))
        X$ = X$ + CHR$((A + B) AND 255)
    NEXT I
    SHORTEN$ = X$
END FUNCTION

FUNCTION SHUFFLE$ (S$)
    X$ = S$
    LS = LEN(S$)
    FOR I = 1 TO LS
        R = FIX(RND * LS) + 1
        T$ = MID$(X$, I, 1)
        MID$(X$, I) = MID$(X$, R, 1)
        MID$(X$, R) = T$
    NEXT I
    SHUFFLE$ = X$
END FUNCTION

' Sorts an array of strings using the bubble sort algorithm.
SUB SORT (A$())
    L = UBOUND(A$)
    FOR I = L TO LBOUND(A$) STEP -1
        FOR J = L TO I STEP -1
            IF STRCMP(A$(I), A$(J)) > 0 THEN SWAP A$(I), A$(J)
        NEXT J
    NEXT I
END SUB

' Splits string L$ and stores new string segments in array A$().
' Fills all available slots if array has fewer elements than needed.
SUB SPLIT (A$(), L$, S$)
    N = LBOUND(A$)
    H = UBOUND(A$)
    LL = LEN(L$)
    LS = LEN(S$)
    IF LL = 0 OR LS = 0 THEN GOTO ZH
    START = 1
    DO
        P = INSTR(START, L$, S$)
        IF P < 1 THEN P = LL + 1
        A$(N) = MID$(L$, START, P - START)
        N = N + 1
        IF P >= LL OR N > H THEN EXIT DO
        START = P + LS
    LOOP
ZH: WHILE N <= H
        A$(N) = ""
        N = N + 1
    WEND
END SUB

' Converts a binary string to a string of 1s and 0s. Any length.
FUNCTION STR2BIN$ (S$)
    LS = LEN(S$)
    B$ = SPACE$(LS * 8)
    K = 8
    FOR I = 1 TO LS
        C = ASC(MID$(S$, I, 1))
        M = 1
        FOR J = 1 TO 8
            IF C AND M THEN D = 49 ELSE D = 48
            MID$(B$, K) = CHR$(D)
            M = M + M
            K = K - 1
        NEXT J
        K = K + 16
    NEXT I
    STR2BIN$ = B$
END FUNCTION

' This function converts a binary string to hex format
FUNCTION STR2HEX$ (S$)
    X$ = ""
    FOR I = 1 TO LEN(S$)
        C = ASC(MID$(S$, I, 1))
        IF C < 16 THEN X$ = X$ + "0"
        X$ = X$ + HEX$(C)
    NEXT I
    STR2HEX$ = X$
END FUNCTION

' Compares string A to string B.
' Return value = 0 if A = B
' Return value > 0 if A > B
' Return value < 0 if A < B
FUNCTION STRCMP (A$, B$)
    IF A$ = B$ THEN STRCMP = 0: EXIT FUNCTION
    FOR K = 1 TO LEN(A$) + 1
        CA = GETCHAR(A$, K)
        CB = GETCHAR(B$, K)
        IF CA < 0 AND CB >= 0 THEN STRCMP = -1: EXIT FUNCTION
        IF CB < 0 AND CA >= 0 THEN STRCMP = 1: EXIT FUNCTION
        DIFF = CA - CB
        IF DIFF THEN EXIT FOR
    NEXT K
    STRCMP = DIFF
END FUNCTION

' This function counts how many times string P$
' occurs in string S$ and returns the number of matches.
' If P$ is an empty string, then this function will return 0.
FUNCTION STRCOUNT (S$, P$)
    LP = LEN(P$)
    IF LP = 0 OR LEN(S$) < LP THEN STRCOUNT = 0: EXIT FUNCTION
    N = 0
    F = 1
    DO
        F = INSTR(F, S$, P$)
        IF F = 0 THEN EXIT DO
        F = F + LP
        N = N + 1
    LOOP
    STRCOUNT = N
END FUNCTION

' Reverses bytes of a string "abc" -> "cba"
FUNCTION STRREV$ (S$)
    X$ = ""
    FOR I = 1 TO LEN(S$)
        X$ = MID$(S$, I, 1) + X$
    NEXT I
    STRREV$ = X$
END FUNCTION

' Removes every instance of string S$ from L$
FUNCTION STRRID$ (L$, S$)
    LS = LEN(S$)
    IF LS = 0 THEN GOTO ZR
    FOR I = 1 TO LEN(L$)
        P = INSTR(I, L$, S$)
        IF P < 1 THEN GOTO ZR
        I = P - 1
        L$ = MID$(L$, 1, I) + MID$(L$, P + LS)
    NEXT I
ZR: STRRID$ = L$
END FUNCTION

' Calculates the difference between two very big integers.
FUNCTION SUBINT$ (A$, B$)
    E = CMPINT(A$, B$)
    IF E = 0 THEN SUBINT$ = "0": EXIT FUNCTION
    IF E < 0 THEN SWAP A$, B$
    LA = LEN(A$)
    LB = LEN(B$)
    FOR I = 1 TO MAX(LA, LB)
        IF LA < 1 THEN AX = 0 ELSE AX = ASC(MID$(A$, LA, 1)) - 48: LA = LA - 1
        IF LB < 1 THEN BX = 0 ELSE BX = ASC(MID$(B$, LB, 1)) - 48: LB = LB - 1
        S = AX - BX + C
        IF S < 0 THEN C = -1: S = S + 10 ELSE C = 0
        X$ = CHR$(S + 48) + X$
    NEXT I
    FOR I = 1 TO LEN(X$)
        IF ASC(MID$(X$, I, 1)) > 48 THEN X$ = MID$(X$, I): EXIT FOR
    NEXT I
    SUBINT$ = X$
END FUNCTION

' Returns a portion of a string between P1 and P2.
'  Example:  SUBSTR$("ABCD", 2, 4) -> "BCD"
'            SUBSTR$("ABCD", 1, 6) -> "ABCD"
'            SUBSTR$("ABCD", -1, 3) -> "ABC"
'            SUBSTR$("ABCD", 33, 43) -> "" (out of range)
FUNCTION SUBSTR$ (S$, P1, P2)
    L = LEN(S$)
    IF X1 < X2 THEN X1 = P1: X2 = P2 ELSE X1 = P2: X2 = P1
    IF X2 < 1 OR X1 > L THEN SUBSTR$ = "": EXIT FUNCTION
    IF X1 < 1 THEN X1 = 1
    IF X2 > L THEN X2 = L
    SUBSTR$ = MID$(S$, X1, X2 - X1 + 1)
END FUNCTION

' Ensure that string S ends with string X
FUNCTION SUFFIX$ (S$, X$)
    LS = LEN(S$): LX = LEN(X$)
    IF LS >= LX THEN IF X$ = MID$(S$, LS - LX + 1) THEN SUFFIX$ = S$: EXIT FUNCTION
    SUFFIX$ = S$ + X$
END FUNCTION

' Swaps two words in a string
FUNCTION SWAPWORD$ (S$, A, B)
    LS = LEN(S$)
    IF LS = 0 OR A = B OR A < 1 OR B < 1 THEN GOTO NW
    F = 0: W = 0
    AX = 0: AL = 0
    BX = 0: BL = 0
    FOR I = 1 TO LS + 1
        C = GETCHAR(S$, I)
        IF C > 32 THEN
            IF F < 1 THEN F = I: W = W + 1
        ELSE
            IF F > 0 THEN
                ' Record word pointers in AX and BX, and record
                ' pointers that mark the end of words in AW and BW.
                IF W = A AND AX = 0 THEN AX = F: AW = I
                IF W = B AND BX = 0 THEN BX = F: BW = I
                IF AX > 0 AND BX > 0 THEN GOTO SW
                F = 0
            END IF
        END IF
    NEXT I
NW: SWAPWORD$ = S$    ' NO SWAP
    EXIT FUNCTION
SW: IF AX > BX THEN SWAP AX, BX: SWAP AW, BW
    SWAPWORD$ = MID$(S$, 1, AX - 1) + MID$(S$, BX, BW - BX) + MID$(S$, AW, BX - AW) + MID$(S$, AX, AW - AX) + MID$(S$, BW)
END FUNCTION

' Converts an integer to a binary string and returns the last N digits
'   Example: TOBIN$(25, 3) --> "001"
'            TOBIN$(205, 5) --> "01101"
'            TOBIN$(205, 12) --> "000011001101"
FUNCTION TOBIN$ (V, N)
    P = N
    M& = 1
    B$ = STRING$(N, "0")
    WHILE P > 0 AND M& < 65536
        IF V AND M& THEN MID$(B$, P) = "1"
        M& = M& + M&
        P = P - 1
    WEND
    TOBIN$ = B$
END FUNCTION

' Converts an integer to hex format and returns the last L digits
'   Example: TOHEX$(25, 2) --> "19"
'            TOHEX$(205, 1) --> "D"
'            TOHEX$(205, 4) --> "00CD"
FUNCTION TOHEX$ (V, L)
    IF L < 1 THEN TOHEX$ = "": EXIT FUNCTION
    TOHEX$ = RIGHT$(STRING$(L, "0") + HEX$(V), L)
END FUNCTION

' Counts the number of words in a string and returns an integer.
' Words must be separated by whitespace or newline characters.
FUNCTION WORDCOUNT (S$)
    W = 0
    F = 0
    FOR I = 1 TO LEN(S$)
        IF ASC(MID$(S$, I, 1)) > 32 THEN
            IF F = 0 THEN W = W + 1: F = 1
        ELSE
            F = 0
        END IF
    NEXT I
    WORDCOUNT = W
END FUNCTION

FUNCTION XCRYPT$ (S$, P$)
    J = 1
    R$ = P$ + "x"
    LS = LEN(S$)
    LP = LEN(R$)
    X$ = SPACE$(LS)
    DD# = LS * 14919.812# + LP
    FOR I = 1 TO LS  ' Create data digest
        C = ASC(MID$(S$, I, 1))
        DD# = (DD# * (C + 170) + 3341.09312001#) MOD 9428.213#
    NEXT I
    DP# = LP * 71311.211# + LS
    FOR I = 1 TO LP  ' Create password digest
        C = ASC(MID$(R$, I, 1))
        DP# = (DP# * (C + 163) + 1938.12395961#) MOD 8397.566000000001#
    NEXT I
    S# = DD# * 3.49100476# + DP# / 197.943608#
    FOR I = 1 TO LS
        C = ASC(MID$(S$, I, 1))
        W = ASC(MID$(R$, J, 1))
        IF J >= LP THEN J = 1 ELSE J = J + 1
        S# = (S# * 945.6023917# + 1342.19351867#) MOD 136245.897#
        IF S# < .0000001# THEN S# = S# * 10000000
        IF S# > 100000000 THEN S# = S# * .000001
        MID$(X$, I) = CHR$((C XOR W) XOR (FIX(S#) AND 255))
    NEXT I
    XCRYPT$ = X$
END FUNCTION