' Simplexity Cypher example program as a Windows (DOS) executable program.
' See www.SimplexityCypher.com for more information.
'
' WARNING!!! This program ***ONLY*** works with programming languages with at least 64-bit integers!!! (like QB64)
'
' This implementation will FAIL with 32-bit integer programming languages!!!
' (see M$ Visual Basic 6 version for 32-bit programming language conversion)
'
' Copyright (c) 2005-2014 by William H. Donnelly; All Rights Reserved
'
' Simplexity Cypher (Beelzebub variation)
' Simplexity:Beelzebub
' Simplexity:Key=ASCII: A-Z;Oper=ACSNXLWR;OpTyp=HLNBUWLS;KeyDir=F;DatDir=F;OperSeed=13;OpTypSeed=437;DataOffSeed=35976;DataOff=27;

' This program is made specifically to only work in QB64.

   ' This program is made specifically to only work in QB64.

   _TITLE "Simplexity Cypher - Beelzebub variation"

   ON ERROR GOTO LBL_ErrorHandler      ' hopefully the only "GOTO" (and Label) used here (eventually)

   DEFINT A-Z                          ' overall function and variable specification
   _DEFINE U AS _UNSIGNED INTEGER      ' function name prefixing specification for Unsigned Integer
   DEFSTR S                            ' function name prefixing specification for String

   SCREEN 0                            ' text screen
   WIDTH 100, 40                       ' 100 columns, 40 lines

   IF  _FILEEXISTS ("c:\windows\fonts\lucon.ttf")  THEN
      fH& = _LOADFONT ("c:\windows\fonts\lucon.ttf", 21, "MONOSPACE")
      _FONT fH&

   ELSE
      IF  _FILEEXISTS ("lucon.ttf")  THEN
         fH& = _LOADFONT ("lucon.ttf", 21, "MONOSPACE")
         _FONT fH&
      END IF
   END IF

   IF  INSTR (_OS$, "[WINDOWS]")  THEN _
      _SCREENMOVE _MIDDLE              ' center the window on the desktop

   DIM SHARED gnERR AS INTEGER         ' error # from ON ERROR, internal ERR value

   CONST FALSE = 0, TRUE = NOT FALSE   ' every program should have this line (and the character constants below-following)

   DIM SHARED C_DBLQ    AS STRING * 1     ' constant Double Quote
   DIM SHARED C_CR      AS STRING * 1     ' constant Carriage Return (ENTER)
   DIM SHARED C_LF      AS STRING * 1     ' constant Line Feed
   DIM SHARED C_BS      AS STRING * 1     ' constant Backspace
   DIM SHARED C_FF      AS STRING * 1     ' constant Form Feed
   DIM SHARED C_TAB     AS STRING * 1     ' constant Tab
   DIM SHARED C_ESC     AS STRING * 1     ' constant ESCape
   DIM SHARED C_EOL     AS STRING * 1     ' constant End of Line (CR)
   DIM SHARED C_SPC     AS STRING * 1     ' constant SPACE
   DIM SHARED C_CUR_UP  AS STRING * 1     ' constant Cursor Up character string code
   DIM SHARED C_CUR_DN  AS STRING * 1     ' constant Cursor Down character string code
   DIM SHARED C_CUR_LFT AS STRING * 1     ' constant Cursor Left character string code
   DIM SHARED C_CUR_RGT AS STRING * 1     ' constant Cursor Right character string code

   C_DBLQ   = CHR$ (34)       ' constant Double Quote
   C_CR     = CHR$ (13)       ' constant Carriage Return (ENTER)
   C_LF     = CHR$ (10)       ' constant Line Feed
   C_BS     = CHR$ (8)        ' constant Backspace
   C_FF     = CHR$ (12)       ' constant Form Feed
   C_TAB    = CHR$ (9)        ' constant Tab
   C_ESC    = CHR$ (27)       ' constant ESCape
   C_EOL    = C_CR            ' constant End of Line (CR)
   C_SPC    = " "             ' constant SPACE

   C_CUR_UP = CHR$ (30)       ' constant Cursor Up character string code
   C_CUR_DN = CHR$ (31)       ' constant Cursor Down character string code
   C_CUR_LFT = CHR$ (29)      ' constant Cursor Left character string code
   C_CUR_RGT = CHR$ (28)      ' constant Cursor Right character string code


   RANDOMIZE TIMER


   CONST KEYHIT_F1 = 15104
   CONST KEYHIT_F2 = 15360
   CONST KEYHIT_F3 = 15616
   CONST KEYHIT_F4 = 15872
   CONST KEYHIT_F5 = 16128
   CONST KEYHIT_F6 = 16384
   CONST KEYHIT_F7 = 16640
   CONST KEYHIT_F8 = 16896

   CONST KEY_RSHIFT  = 100303
   CONST KEY_LSHIFT  = 100304
   CONST KEY_RCTRL   = 100305
   CONST KEY_LCTRL   = 100306
   CONST KEY_RALT    = 100307
   CONST KEY_LALT    = 100308

   CONST SUPER_ENTRY_NOOPT  = 0        ' no options selected (powers of 2 that can be OR'ed or added together)
   CONST SUPER_ENTRY_UCASE  = 1        ' convert all input alpha to uppercase
   CONST SUPER_ENTRY_SHADO  = 2        ' treat default value like shadow text (darker text that disappears when you type)
   CONST SUPER_ENTRY_PASWD  = 4        ' password entry mode = show entry chars as asterisks ("*")
   CONST SUPER_ENTRY_MAXCE  = 8        ' auto-return when maximum number of characters entered ("full field entry")

      ' to be included as a reusable routine for superInkey$ function
      ' NOTE: take care with "" versus " " -- fixed-length string issue -- see bNull and bKeyPress

   TYPE typeSuperInkey

      sChar       AS STRING * 1        ' simple ASCII character values, or blank (" " -- see bNull)
      sCharExt    AS STRING * 2        ' extended 2-character code, or blank ("  ")
      sExt        AS STRING * 10       ' descriptive value of extended keys (F10, Alt+F1, etc.)
      sName       AS STRING * 20       ' descriptive 'Name' of key
      sPrintable  AS STRING * 1        ' Printable character (non-Control), or blank (" ")

      nASC        AS INTEGER           ' ASCII value of key character (simple ASCII), or zero
      nExtASC     AS INTEGER           ' ASCII value of second character of extended key code, or zero for 'simple ASCII'

      bKeyPress   AS INTEGER           ' FALSE = no keypress, TRUE = keypress
      bNull       AS INTEGER           ' sChar is "" (not " " -- fixed-length string issue)
      bCtrl       AS INTEGER           ' Control key was used to generate keypress
      bAlt        AS INTEGER           ' Alt key was used to generate keypress
      bShift      AS INTEGER           ' Shift key was used to generate keypress
      bFunc       AS INTEGER           ' Function key was pressed (all modified variations)
      bArrow      AS INTEGER           ' 'arrow' key was pressed
      bCursor     AS INTEGER           ' 'cursor' key was pressed (arrow keys, Home, PageUp, etc.)
      bKeyPad     AS INTEGER           ' keypad key was pressed

   END TYPE ' typeSuperInkey

   DIM SHARED gtSuperInkey AS typeSuperInkey


   CONST CS_META_OPERATOR           = 0
   CONST CS_META_OPERAND_SELECTOR   = 1
   CONST CS_META_OPERAND_VALUE      = 2
   CONST CS_META_DATASET_OFFSET     = 3
   CONST CS_META_PROC_DIR           = 4

   CONST CS_META_PROC_DIR_FORW   = 1
   CONST CS_META_PROC_DIR_BACK   = -1

   CONST CS_OPER_ADD             = 0
   CONST CS_OPER_COMPLEMENT      = 1
   CONST CS_OPER_SUBTRACT        = 2
   CONST CS_OPER_NEGATE          = 3
   CONST CS_OPER_XOR             = 4
   CONST CS_OPER_ROTATE_LEFT     = 5
   CONST CS_OPER_SWAP            = 6
   CONST CS_OPER_ROTATE_RIGHT    = 7

   CONST CS_OPSEL_UNSIGNED_NYBBLE_HI   = 0
   CONST CS_OPSEL_UNSIGNED_NYBBLE_LO   = 1
   CONST CS_OPSEL_BOTH_UNYBBLES        = 2
   CONST CS_OPSEL_UNSIGNED_BYTE        = 3
   CONST CS_OPSEL_UNSIGNED_WORD        = 4
   CONST CS_OPSEL_SIGNED_WORD          = 5
   CONST CS_OPSEL_UNSIGNED_LONG        = 6
   CONST CS_OPSEL_SIGNED_LONG          = 7

   CONST CS_2_POW_2           = &H04~&&         '                                             1000
   CONST CS_2_POW_2_MIN_1     = &H03~&&         '                                             0111
   CONST CS_2_POW_4           = &H10~&&         '                                        0001 0000
   CONST CS_2_POW_4_MIN_1     = &H0f~&&         '                                        0000 1111
   CONST CS_2_POW_8           = &H100~&&        '                                   0001 0000 0000
   CONST CS_2_POW_8_MIN_1     = &Hff~&&         '                                        1111 1111
   CONST CS_2_POW_15          = &H8000~&&       '                             1000 0000  0000 0000
   CONST CS_2_POW_15_MIN_1    = &H7fff~&&       '                             0111 1111  1111 1111
   CONST CS_2_POW_16          = &H10000~&&      '                       0001  0000 0000  0000 0000
   CONST CS_2_POW_16_MIN_1    = &Hffff~&&       '                             1111 1111  1111 1111
   CONST CS_2_POW_24          = &H1000000~&&    '            0001  0000 0000  0000 0000  0000 0000
   CONST CS_2_POW_31          = &H80000000~&&   '       1000 0000  0000 0000  0000 0000  0000 0000
   CONST CS_2_POW_31_MIN_1    = &H7fffffff~&&   '       0111 1111  1111 1111  1111 1111  1111 1111
   CONST CS_2_POW_32          = &H100000000~&&  ' 0001  0000 0000  0000 0000  0000 0000  0000 0000
   CONST CS_2_POW_32_MIN_1    = &Hffffffff~&&   '       1111 1111  1111 1111  1111 1111  1111 1111

   CONST CS_MASK_DIT_HI       = &H0c~&&         '                                       1100
   CONST CS_MASK_DIT_LO       = &H03~&&         '                                       0011
   CONST CS_MASK_NYBBLE_HI    = &Hf0~&&         '                                  1111 0000
   CONST CS_MASK_NYBBLE_LO    = &H0f~&&         '                                  0000 1111
   CONST CS_MASK_BYTE_HI      = &Hff00~&&       '                       1111 1111  0000 0000
   CONST CS_MASK_BYTE_LO      = &Hff~&&         '                       0000 0000  1111 1111
   CONST CS_MASK_WORD_HI      = &Hffff0000~&&   ' 1111 1111  1111 1111  0000 0000  0000 0000
   CONST CS_MASK_WORD_LO      = &Hffff          ' 0000 0000  0000 0000  1111 1111  1111 1111
   CONST CS_MASK_BYTE1        = &Hff000000~&&   ' 1111 1111  0000 0000  0000 0000  0000 0000
   CONST CS_MASK_BYTE2        = &Hff0000~&&     ' 0000 0000  1111 1111  0000 0000  0000 0000
   CONST CS_MASK_BYTE3        = &Hff00~&&       ' 0000 0000  0000 0000  1111 1111  0000 0000
   CONST CS_MASK_BYTE4        = &Hff~&&         ' 0000 0000  0000 0000  0000 0000  1111 1111
   CONST CS_MASK_BYTE         = &Hff~&&         '                                  1111 1111
   CONST CS_MASK_WORD         = &Hffff~&&       '                       1111 1111  1111 1111
   CONST CS_MASK_LONG         = &Hffffffff~&&   ' 1111 1111  1111 1111  1111 1111  1111 1111

   CONST CS_MASK_BITSHIFT_NYBBLE    = &H03~&&   ' 3
   CONST CS_MASK_BITSHIFT_BYTE      = &H07~&&   ' 7
   CONST CS_MASK_BITSHIFT_WORD      = &H0f~&&   ' 15
   CONST CS_MASK_BITSHIFT_LONG      = &H1f~&&   ' 31

   DIM SHARED ganBitsToShiftMultDiv (0 TO 31) AS _UNSIGNED LONG    ' Bits to Shift Multiplier / Divider

      DIM nPow2 AS INTEGER
      DIM nPow2Value AS _UNSIGNED LONG

      nPow2 = 1
      nPow2Value = 1

      FOR  nPow2 = 0  TO  31

         ganBitsToShiftMultDiv (nPow2) = nPow2Value
         nPow2Value = nPow2Value * 2

      NEXT

   CONST CS_OPERATOR_SEED        = 13        ' arbitrarily chosen initial seed; hardcoded for this implementation (Byte)
   CONST CS_OPERAND_SEED         = 437       ' arbitrarily chosen initial seed; hardcoded for this implementation (Byte)
   CONST CS_DATASET_OFFSET_SEED  = 35976     ' arbitrarily chosen initial seed; hardcoded for this implementation (Unsigned Long)
   CONST CS_DATASET_OFFSET       = 27        ' arbitrarily chosen initial dataset offset; hardcoded for this implementation (Unsigned Long)

   CONST CS_KEY_CHARS = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"


   DIM SHARED gasOperators (0 TO 7) AS STRING
   DIM SHARED gasOperands (0 TO 7) AS STRING

   gasOperators (0) = "ADD"
   gasOperators (1) = "COMPLEMENT"
   gasOperators (2) = "SUBTRACT"
   gasOperators (3) = "NEGATE"
   gasOperators (4) = "XOR"
   gasOperators (5) = "ROTATE LEFT"
   gasOperators (6) = "SWAP"
   gasOperators (7) = "ROTATE RIGHT"

   gasOperands (0) = "NYBBLE HI"
   gasOperands (1) = "NYBBLE LO"
   gasOperands (2) = "BOTH UNYBBLES"
   gasOperands (3) = "BYTE"
   gasOperands (4) = "UNSIGNED WORD"
   gasOperands (5) = "SIGNED WORD"
   gasOperands (6) = "UNSIGNED LONG"
   gasOperands (7) = "SIGNED LONG"

   DIM SHARED gsMessage    AS STRING
   DIM SHARED gsError      AS STRING
   DIM SHARED gbDebug      AS INTEGER

   DIM gnStartTime   AS DOUBLE
   DIM gnEndTime     AS DOUBLE
   DIM gnTime        AS DOUBLE

   DIM gsLastCypherKey  AS STRING
   DIM gsLastFilename   AS STRING
   DIM gsCypherKey      AS STRING
   DIM gsFilename       AS STRING
   DIM gsCryption       AS STRING
   DIM gsDelimiter      AS STRING
   DIM gbDone           AS INTEGER
   DIM gsOutput         AS STRING
   DIM gsLastOutput     AS STRING
   DIM gsSuggest        AS STRING
   DIM gsYN             AS STRING
   DIM gsCrypting       AS STRING
   DIM gsCrypted        AS STRING
   DIM gbResult         AS INTEGER
   DIM gnFound          AS INTEGER
   DIM gsExtension      AS STRING
   DIM gsTemp           AS STRING


   gbDebug = FALSE
   'gbDebug = TRUE

   CLS
   COLOR 7     ' default color
   LOCATE , , 1      ' show cursor for inkey$ (only (need to) do once?)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   IF  gbDebug  THEN     ' clear debug output file
      OPEN "simplexitycypherexample.debug" FOR OUTPUT AS #9
      CLOSE #9
   END IF

LBL_Main:

   COLOR 15    ' bright white
   PRINT "Simplexity Cypher  ";
   COLOR 12    ' bright red
   PRINT "(Beelzebub variation)"
   PRINT
   COLOR 14    ' bright yellow
   PRINT "Proof of Concept Example Implementation"
   COLOR 7     ' default color
   PRINT

   PRINT "This program is a functional equivalent of the PHP example program located"
   PRINT "on the ";
   COLOR 15    ' bright white
   PRINT "www.SimplexityCypher.com";
   COLOR 7     ' default color
   PRINT " website. See the website for more info."
   PRINT
   PRINT "This program is written in QB64 compiled BASIC, found at www.QB64.net."
   PRINT "The GUI is a simple Windows DOS-based textual interface."
   PRINT "Although the program could be made to run on Apple OS and *Nix, only Win is available."
   PRINT "The source file is available on the Simplexity website."
   PRINT "For a larger font and screen size, the true type font file c:\windows\fonts\lucon.ttf"
   PRINT "must be available, or install lucon.ttf in the executable directory."
   PRINT
   PRINT "WARNING - This implementation of the cypher has NOT been thoroughly tested,"
   PRINT "so you might encrypt something that is not encrypted correctly and/or"
   PRINT "may not be decryptable. Therefore it is STRONGLY recommended that you"
   PRINT "NOT use this program to encrypt or decrypt "; C_DBLQ ; "important"; C_DBLQ ; " information, and ONLY"
   PRINT "use this program for testing, playing, edification, and educational purposes."
   PRINT
   PRINT "Users are also strongly encouraged to read the 'Casual Treatise' document and"
   PRINT "other information located on the website to better understand Simplexity before use."
   PRINT "Please address all comments, questions, and issues to:  Simplexity /@@@/ SimplexityCypher ... com"


   DO    ' allow multiple cryptions

      IF  gsMessage <> ""  THEN
         gbDone = FALSE
         PRINT

         DO

            IF  LEN (gsMessage) > 77  THEN
               gsTemp = LEFT$ (gsMessage, 78)
               gnFound = strrpos% (gsTemp, " ", 0)
               gsTemp = LEFT$ (gsTemp, gnFound - 1)
               gsMessage = LTRIM$ (MID$ (gsMessage, gnFound))

            ELSE
               gsTemp = gsMessage
               gsMessage = ""
            END IF

            IF  gbDone  THEN _
               PRINT "   ";

            PRINT gsTemp
            gbDone = TRUE

         LOOP WHILE  gsMessage <> ""
      END IF

      IF  gsError <> ""  THEN
         gbDone = FALSE
         COLOR 12    ' bright red
         PRINT

         DO

            IF  LEN (gsError) > 77  THEN
               gsTemp = LEFT$ (gsError, 78)
               gnFound = strrpos% (gsTemp, " ", 0)
               gsTemp = LEFT$ (gsTemp, gnFound - 1)
               gsError = LTRIM$ (MID$ (gsError, gnFound))

            ELSE
               gsTemp = gsError
               gsError = ""
            END IF

            IF  gbDone  THEN _
               PRINT "   ";

            PRINT gsTemp
            gbDone = TRUE

         LOOP WHILE  gsMessage <> ""

         COLOR 7     ' default color
      END IF

      gsMessage = ""
      gsError = ""

      gsCryption = ""

      DO

         PRINT
         PRINT
         PRINT "Encrypt or Decrypt (";
         COLOR 9     ' bright blue
         PRINT "E, D";
         COLOR 7     ' default color
         PRINT " | ";
         COLOR 8     ' dark gray
         PRINT "ESC = Quit";
         COLOR 7     ' default color
         PRINT "): ";

         gsDelimiter = C_CR + C_ESC
         COLOR 3     ' aqua
         gsCryption = LEFT$ (TRIM$ (superEntry$ ("", "", gsDelimiter, SUPER_ENTRY_UCASE, 0)), 1)
         COLOR 7     ' default color
         PRINT

         IF  gsCryption <> "E"  AND  gsCryption <> "D"  AND  gsDelimiter <> C_ESC  THEN _
            beepAlert

      LOOP WHILE  gsCryption <> "E"  AND  gsCryption <> "D"  AND  gsDelimiter <> C_ESC

      IF  gsDelimiter = C_ESC  THEN _
         EXIT DO     ' end program


      IF  gsCryption = "E"  THEN
         gsCrypting = "Encrypting"
         gsCrypted = "Encrypted"
      END IF

      IF  gsCryption = "D"  THEN
         gsCrypting = "Decrypting"
         gsCrypted = "Decrypted"
      END IF


      DO

         PRINT
         COLOR 6     ' brown
         PRINT "     (non-blank, nominally 20 to 50 characters, SPACE and A-Z --"
         PRINT "          all other characters will be ignored)"
         COLOR 7     ' default color
         PRINT "Cypher Key: ";

         gsDelimiter = C_CR + C_ESC
         COLOR 3     ' aqua
         gsCypherKey = superEntry$ ("", gsLastCypherKey, gsDelimiter, SUPER_ENTRY_UCASE, 0)
         COLOR 7     ' default color
         PRINT

         IF  gsDelimiter <> C_ESC  THEN _
            gsLastCypherKey = gsCypherKey

      LOOP UNTIL  gsCypherKey <> ""  OR  gsDelimiter = C_ESC


      gbDone = FALSE

      WHILE  NOT (gbDone)  AND  gsDelimiter <> C_ESC

         PRINT
         COLOR 6     ' brown
         PRINT "     (encrypted files default extension = '.simplexity' and decrypted files = '.decrypted'"
         COLOR 7     ' default color
         PRINT "Data file to encrypt or decrypt: ";

         gsDelimiter = C_CR + C_ESC
         COLOR 3     ' aqua
         gsFilename = superEntry$ ("", gsLastFilename, gsDelimiter, SUPER_ENTRY_NOOPT, 0)
         COLOR 7     ' default color
         PRINT

         IF  gsDelimiter <> C_ESC  THEN
            gsLastFilename = gsFilename

            IF  _FILEEXISTS (gsFilename)  THEN
               gbDone = TRUE

            ELSE
               IF  gsCryption = "D"  AND  _FILEEXISTS (gsFilename + ".simplexity")  THEN
                  gsFilename = gsFilename + ".simplexity"
                  gsLastFilename = gsFilename
                  gbDone = TRUE

               ELSE
                  IF  _FILEEXISTS (gsFilename + ".decrypted")  THEN
                     gsFilename = gsFilename + ".decrypted"
                     gsLastFilename = gsFilename
                     gbDone = TRUE

                  ELSE
                     PRINT "File does not exist: " + gsFilename
                  END IF
               END IF
            END IF
         END IF

      WEND


      IF  gsDelimiter <> C_ESC  THEN
         gnFound = strrpos% (gsFilename, ".", 0)

         IF  gnFound = 0  THEN _
            gnFound = LEN (gsFilename) + 1

         gsExtension = MID$ (gsFilename, gnFound)

         IF  UCASE$ (gsExtension) = ".SIMPLEXITY"  THEN
            gsSuggest = LEFT$ (gsFilename, gnFound - 1) + ".decrypted"

         ELSE
            gsSuggest = LEFT$ (gsFilename, gnFound - 1) + ".simplexity"
         END IF
      END IF


      gbDone = FALSE

      WHILE  NOT (gbDone)  AND  gsDelimiter <> C_ESC

         PRINT
         PRINT "Output filename: ";

         gsDelimiter = C_CR + C_ESC
         COLOR 3     ' aqua
         gsOutput = superEntry$ (gsSuggest, gsLastOutput, gsDelimiter, SUPER_ENTRY_NOOPT, 0)
         COLOR 7     ' default color
         PRINT

         IF  gsDelimiter <> C_ESC  THEN
            gsLastOutput = gsOutput

            IF  _FILEEXISTS (gsOutput)  THEN
               PRINT
               PRINT "Output file exists, do you want to overwrite? ";

               gsDelimiter = C_CR + C_ESC
               COLOR 3     ' aqua
               gsYN = LEFT$ (TRIM$ (superEntry$ ("", "", gsDelimiter, SUPER_ENTRY_UCASE, 0)), 1)
               COLOR 7     ' default color
               PRINT

               IF  gsDelimiter = C_ESC  THEN _
                  gsYN = "N"

               IF  gsYN = "Y"  THEN _
                  gbDone = TRUE

            ELSE
               gnERR = 0
               OPEN gsOutput FOR OUTPUT AS #1

               IF  gnERR = 0  THEN
                  CLOSE #1
                  gbDone = TRUE

               ELSE
                  PRINT
                  PRINT errorText$ (gnErr, TRUE)
                  sDelimiter = C_ESC
               END IF
            END IF
         END IF

      WEND


      IF  gsDelimiter <> C_ESC  THEN
         IF  gbDebug  THEN     ' append to the debug output file
            OPEN "simplexitycypherexample.debug" FOR APPEND AS #9
            PRINT #9, ""
            PRINT #9, gsCrypting; " file..."
            PRINT #9, DATE$; " "; TIME$; " ----------------------------------------"
         END IF

         PRINT
         PRINT gsCrypting; " file...";

         gnStartTime = timer

         COLOR 12    ' bright red
         gbResult = processFile% (gsCryption, gsCypherKey, gsFilename, gsOutput)     ' encrypt or decrypt the file
         COLOR 7     ' default color

         gnEndTime = timer

         IF  gnEndTime < gnStartTime  THEN _
            gnEndTime = gnEndTime + 86400       ' correct for midnight crossover

         gnTime = gnEndTime - gnStartTime

         PRINT
         PRINT
         PRINT "File "; gsCrypted; "."
         PRINT "Processing time in seconds ="; gnTime
         PRINT

         IF  gbDebug  THEN
            PRINT #9, ""
            PRINT #9, "File "; gsCrypted; "."
            PRINT #9, "Processing time in seconds ="; gnTime
            CLOSE #9
         END IF
      END IF

   LOOP WHILE  TRUE

END


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Error handler -- the end of the Main program proper
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

LBL_ErrorHandler:                      ' error handler routine (MUST be located here)

   gnERR = ERR                         ' save value, because Resume clears it, so remember to reset first when needed

   RESUME NEXT                         ' we will try to handle errors as they occur when needed



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SUBroutines and FUNCTIONs
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' NOTE: one or more of the following routines requires the TRUE and FALSE constants to be defined.
' To be 'safe', always define these constants (at least, and others) at the top of every program with:
' CONST FALSE = 0, TRUE = NOT FALSE


FUNCTION  processFile% ( _
   psCryption     AS STRING, _
   psCypherKey    AS STRING, _
   psFilename     AS STRING, _
   psOutput       AS STRING _
)

   REDIM aData (0 TO 1) AS _UNSIGNED _BYTE              ' ReDIM below
   REDIM aOpsProcList (0 TO 1, 0 TO 4) AS _INTEGER64    ' ReDIM below

   DIM nDataLen   AS LONG
   DIM nKeyLen    AS INTEGER

   DIM bEncrypt   AS INTEGER
   DIM bDecrypt   AS INTEGER

   DIM nOperatorSeed       AS INTEGER     ' (byte)
   DIM nOperandSeed        AS INTEGER     ' (byte))
   DIM nDatasetOffsetSeed  AS LONG        ' (unsigned word)
   DIM nDatasetOffset      AS LONG        ' (unsigned word)

   DIM sCypherKey    AS STRING
   DIM nCypherKey    AS INTEGER
   DIM sKey          AS STRING

   DIM nOpsProcListCnt  AS INTEGER
   DIM nOpValue         AS _INTEGER64

   DIM sDate      AS STRING
   DIM sTime      AS STRING
   DIM sTimer     AS STRING
   DIM sOutFile   AS STRING

   DIM nChar   AS INTEGER
   DIM sChar   AS STRING
   DIM nIdx    AS INTEGER

   DIM nByte1  AS INTEGER
   DIM nByte2  AS INTEGER
   DIM nByte3  AS INTEGER
   DIM nByte4  AS INTEGER

   DIM nDataByte1    AS INTEGER
   DIM nDataByte2    AS INTEGER
   DIM nDataByte3    AS INTEGER
   DIM nDataByte4    AS INTEGER

   DIM nOPLIdx    AS INTEGER
   DIM nOPLDir    AS INTEGER

   DIM nKeyOperator  AS INTEGER
   DIM nKeyOperand   AS INTEGER
   DIM nDirection    AS INTEGER

   DIM nKeyOperatorStart   AS INTEGER
   DIM nDataIdx            AS _INTEGER64
   DIM nDataCnt            AS LONG
   DIM nCryptOperand       AS INTEGER
   DIM nCryptOperator      AS INTEGER

   DIM nDataSize           AS INTEGER
   DIM nBitShiftMask       AS _INTEGER64
   DIM nDataValueMask      AS _INTEGER64
   DIM nOperandValue       AS _INTEGER64
   DIM nOperandValueUns    AS _INTEGER64
   DIM nOperandData        AS _INTEGER64
   DIM nOperandDataUns     AS _INTEGER64
   DIM nOperandValue2      AS _INTEGER64
   DIM nOperandValueUns2   AS _INTEGER64
   DIM nOperandData2       AS _INTEGER64
   DIM nOperandDataUns2    AS _INTEGER64

   DIM nResult       AS _INTEGER64
   DIM nResult2      AS _INTEGER64
   DIM nOpValueSeed  AS INTEGER
   DIM nDataMask     AS _INTEGER64
   DIM nUpperValue   AS _INTEGER64
   DIM nLowerValue   AS _INTEGER64
   DIM nDitHi        AS _INTEGER64
   DIM nDitLo        AS _INTEGER64
   DIM nNybbleHi     AS _INTEGER64
   DIM nNybbleLo     AS _INTEGER64
   DIM nByteHi       AS _INTEGER64
   DIM nByteLo       AS _INTEGER64
   DIM nWordHi       AS _INTEGER64
   DIM nWordLo       AS _INTEGER64
   DIM bProccessed   AS INTEGER


   bEncrypt = FALSE
   bDecrypt = FALSE
   bProccessed = FALSE     ' assume failure by default

   sCypherKey = UCASE$ (TRIM$ (psCypherKey))

   IF  psCryption = "E"  THEN _
      bEncrypt = TRUE

   IF  psCryption = "D"  THEN _
      bDecrypt = TRUE

   nCypherKey = LEN (sCypherKey)
   sKey = ""

   FOR  nChar = 1  TO  nCypherKey

      sChar = MID$ (sCypherKey, nChar, 1)

      IF  (sChar >= "A"  AND  sChar <= "Z")  or  sChar = " "  THEN _
         sKey = sKey + sChar

   NEXT nChar

   sKey = TRIM$ (sKey)     ' in case removal of invalid key characters causes leading or trailing SPACE characters
   nKeyLen = LEN (sKey)

   IF  nKeyLen = 0  THEN
      gsError = "Error: Cypher Key is blank."

      processFile% = bProccessed

      EXIT FUNCTION
   END IF

   IF  nKeyLen > 100  THEN
      gsError = "Error: Cypher Key is too long. (arbitrary maximum for this program implementation is 100 characters)"

      processFile% = bProccessed

      EXIT FUNCTION
   END IF

   IF  nKeyLen > 0  and  nKeyLen < 20  THEN _
      gsMessage = gsMessage + "-- WARNING: Cypher Key SHOULD be at least 20 characters in length, but processing using requested key."


'   sDate = DATE$     ' MM-DD-YYYY
'   sTime = TIME$     ' HH:MM:SS
'   sTimer = LTRIM$ (STR$ (CLNG (TIMER)))
'   sOutFile = MID$ (sDate, 7, 4) + MID$ (sDate, 1, 2) + MID$ (sDate, 4, 2) + _
'      MID$ (sTime, 1, 2) + MID$ (sTime, 4, 2) + MID$ (sTime, 7, 2) + sTimer + _
'      LPAD$ (LTRIM$ (STR$ (CINT (RND * 9999))), "0", 4) + LPAD$ (LTRIM$ (STR$ (CINT (RND * 9999))), "0", 4)

   IF  NOT (_FILEEXISTS (psFilename))  THEN
      gsError = "Error: File does not exist: " + psFilename

      processFile% = bProccessed

      EXIT FUNCTION
   END IF


   OPEN psFilename FOR BINARY ACCESS READ AS #1
   nDataLen = LOF (1)

   IF  nDataLen = 0  THEN
      CLOSE #1
      gsError = "Unexpected Error: No data found to process."

      processFile% = bProccessed

      EXIT FUNCTION
   END IF

   REDIM aData (0 TO (nDataLen - 1)) AS _UNSIGNED _BYTE
   GET #1, , aData()
   CLOSE #1


'   IF  gbDebug  THEN
'      nIdx = 0
'
'      FOR  nChar = 0  TO   nDataLen - 1
'
'         PRINT #9, "'"; CHR$ (aData (nChar)); "' ("; toHex2$ (aData (nChar)); ")  ";
'         nIdx = nIdx + 1
'
'         IF  nIdx > 10  THEN
'            nIdx = 0
'            PRINT #9, ""
'         END IF
'
'      NEXT nChar
'
'      PRINT #9, ""
'   END IF


   REDIM aOpsProcList (0 TO (nKeyLen - 1), 0 TO 4) AS _INTEGER64

   nOperatorSeed = CS_OPERATOR_SEED                ' arbitrarily chosen initial seed; hardcoded for this implementation (Byte)
   nOperandSeed = CS_OPERAND_SEED                  ' arbitrarily chosen initial seed; hardcoded for this implementation (Byte)
   nDatasetOffsetSeed = CS_DATASET_OFFSET_SEED     ' arbitrarily chosen initial seed; hardcoded for this implementation (Unsigned Long)

   nDatasetOffset = CS_DATASET_OFFSET              ' arbitrarily chosen initial dataset offset; hardcoded for this implementation (Unsigned Long)

   nOpsProcListCnt = 0

   FOR  nKeyCnt = 0  TO  nKeyLen - 1     ' create the Operators Processing List

      sChar = MID$ (sKey, nKeyCnt + 1, 1)
      nKeyOperator = INSTR (CS_KEY_CHARS, sChar) - 1 + nOperatorSeed
      nOperatorSeed = nKeyOperator AND CS_MASK_BYTE
      nKeyOperator = nKeyOperator MOD 8

      sChar = MID$ (sKey, (nKeyCnt + 1) MOD nKeyLen + 1, 1)
      nKeyOperand = INSTR (CS_KEY_CHARS, sChar) - 1 + nOperandSeed
      nOperandSeed = nKeyOperand AND CS_MASK_BYTE
      nKeyOperand = nKeyOperand MOD 8

      sChar = MID$ (sKey, (nKeyCnt + 2) MOD nKeyLen + 1, 1)
      nKeyDataByte1 = (ASC (sChar) + nOpValueSeed) AND CS_MASK_BYTE
      nOpValueSeed = nKeyDataByte1

      sChar = MID$ (sKey, (nKeyCnt + 3) MOD nKeyLen + 1, 1)
      nKeyDataByte2 = (ASC (sChar) + nOpValueSeed) AND CS_MASK_BYTE
      nOpValueSeed = nKeyDataByte2

      sChar = MID$ (sKey, (nKeyCnt + 4) MOD nKeyLen + 1, 1)
      nKeyDataByte3 = (ASC (sChar) + nOpValueSeed) AND CS_MASK_BYTE
      nOpValueSeed = nKeyDataByte3

      sChar = MID$ (sKey, (nKeyCnt + 5) MOD nKeyLen + 1, 1)
      nKeyDataByte4 = (ASC (sChar) + nOpValueSeed) AND CS_MASK_BYTE
      nOpValueSeed = nKeyDataByte4

      nOpValue = (nKeyDataByte1 * CS_2_POW_24) + (nKeyDataByte2 * CS_2_POW_16) + (nKeyDataByte3 * CS_2_POW_8) + nKeyDataByte4   ' MSB

      aOpsProcList (nOpsProcListCnt, CS_META_OPERATOR)           = nKeyOperator              ' Operator to execute (initial) = 0 - 7
      aOpsProcList (nOpsProcListCnt, CS_META_OPERAND_SELECTOR)   = nKeyOperand               ' Operand Selector (initial) = 0 - 7
      aOpsProcList (nOpsProcListCnt, CS_META_OPERAND_VALUE)      = nOpValue                  ' Unsigned Long value for two-operand operations
      aOpsProcList (nOpsProcListCnt, CS_META_DATASET_OFFSET)     = nDatasetOffset            ' where to start processing inside dataset
      aOpsProcList (nOpsProcListCnt, CS_META_PROC_DIR)           = CS_META_PROC_DIR_FORW     ' hardcoded forward direction

      nDatasetOffset = (nDatasetOffset + nDatasetOffsetSeed) AND CS_MASK_LONG
      nDatasetOffsetSeed = nDatasetOffset + 1      ' prevent from zeroing
      nDatasetOffset = nDatasetOffset MOD nDataLen

      nOpsProcListCnt = nOpsProcListCnt + 1

   NEXT nKeyCnt

   IF  nOpsProcListCnt = 0  THEN
      gsError = "Unexpected Error: While attempting to process cryption key."

      processFile% = bProccessed

      EXIT FUNCTION
   END IF


   IF  gbDebug  THEN
      PRINT #9, "** Simplexity Cypher processing run debug data."
      PRINT #9, ""

      PRINT #9, "Key = '"; sKey; "'"
      PRINT #9, "KeyLen = "; num$ (nKeyLen)

      PRINT #9, "* Operations Processing List"
      PRINT #9, ""
      PRINT #9, "Operator, Operand Selector, Operand Value, Data Offset, Proc-Dir"
      PRINT #9, ""

      FOR  nIdx = 0  TO   nOpsProcListCnt - 1

         PRINT #9, num$ (nIdx); ":   "; _
            num$ (aOpsProcList (nIdx, CS_META_OPERATOR)); ",  "; _
            num$ (aOpsProcList (nIdx, CS_META_OPERAND_SELECTOR)); ",  "; _
            num$ (aOpsProcList (nIdx, CS_META_OPERAND_VALUE)); ";  "; _
            num$ (aOpsProcList (nIdx, CS_META_DATASET_OFFSET)); ";  "; _
            num$ (aOpsProcList (nIdx, CS_META_PROC_DIR))

      NEXT nIdx

      PRINT #9, ""
      PRINT #9, "DataLen = "; num$ (nDataLen)
      PRINT #9, ""
   END IF

   IF  bEncrypt  THEN
      nOPLIdx = 0                      ' start at the beginning of the key list
      nOPLDir = 1                      ' direction = forward

      IF  gbDebug  THEN
         PRINT #9, "Encrypting ("; num$ (nOPLIdx); ","; num$ (nOPLDir); ")"
         PRINT #9, ""
      END IF
   END IF

   IF  bDecrypt  THEN
      nOPLIdx = nOpsProcListCnt - 1    ' start at the end of the key list
      nOPLDir = -1                     ' reverse the direction = backward

      IF  gbDebug  THEN
         PRINT #9, "Decrypting ("; num$ (nOPLIdx); ","; num$ (nOPLDir); ")"
         PRINT #9, ""
      END IF
   END IF


   DO    ' process the Operations Processing List (encrypt/decrypt the dataset)

      nKeyOperator     = aOpsProcList (nOPLIdx, CS_META_OPERATOR)
      nKeyOperand      = aOpsProcList (nOPLIdx, CS_META_OPERAND_SELECTOR)
      nOpValue         = aOpsProcList (nOPLIdx, CS_META_OPERAND_VALUE)
      nDatasetOffset   = aOpsProcList (nOPLIdx, CS_META_DATASET_OFFSET)
      nDirection       = aOpsProcList (nOPLIdx, CS_META_PROC_DIR)

      nKeyOperatorStart = nKeyOperator

      nDataIdx = nDatasetOffset MOD nDataLen
      nDataCnt = nDataLen

      IF  gbDebug  THEN
         PRINT #9, ""
         PRINT #9, "========================================"
         PRINT #9, ""
         PRINT #9, ""
         PRINT #9, "Processing Run # "; num$ (nOPLIdx); "..."
         PRINT #9, "   KeyOperator    = "; num$ (nKeyOperator); "  ("; gasOperators (nKeyOperator); ")"
         PRINT #9, "   KeyOperand     = "; num$ (nKeyOperand); "  ("; gasOperands (nKeyOperand); ")"
         PRINT #9, "   OpValue        = "; num$ (nOpValue)

         nByte1 = (nOpValue AND CS_MASK_BYTE1) \ CS_2_POW_24
         nByte2 = ((nOpValue AND CS_MASK_BYTE2) \ CS_2_POW_16) AND CS_MASK_BYTE
         nByte3 = ((nOpValue AND CS_MASK_BYTE3) \ CS_2_POW_8) AND CS_MASK_BYTE
         nByte4 = nOpValue AND CS_MASK_BYTE4

         PRINT #9, "      Bytes       = "; num$ (nByte1); ", "; num$ (nByte2); ", "; num$ (nByte3); ", "; num$ (nByte4)
         PRINT #9, "      Hex         = "; toHex2$ (nByte1); " "; toHex2$ (nByte2); " "; toHex2$ (nByte3); " "; toHex2$ (nByte4)
         PRINT #9, "      Binary      = "; toBinary$ (nByte1, 8); " "; toBinary$ (nByte2, 8); "  "; toBinary$ (nByte3, 8); " "; toBinary$ (nByte4, 8)

         PRINT #9, "   DatasetOffset  = "; num$ (nDatasetOffset)
         PRINT #9, "   Direction      = "; num$ (nDirection)
         PRINT #9, "   DataIdx        = "; num$ (nDataIdx)
      END IF


      nDatasetOffset = nDatasetOffset MOD nDataLen    ' in case offset is larger than data length for later comparison

      DO    ' process the dataset -- one full pass

         nCryptOperand = nKeyOperand

         IF  nCryptOperand >= CS_OPSEL_UNSIGNED_LONG  and  nDataCnt < 4  THEN
            IF  nDataCnt >= 2  THEN
               nCryptOperand = CS_OPSEL_UNSIGNED_WORD

            ELSE
               nCryptOperand = CS_OPSEL_UNSIGNED_BYTE
            END IF

         ELSE
            IF  nCryptOperand >= CS_OPSEL_UNSIGNED_WORD  and  nDataCnt < 2  THEN _
               nCryptOperand = CS_OPSEL_UNSIGNED_BYTE
         END IF

         IF  gbDebug  THEN
            PRINT #9,
            PRINT #9, "----------------------------------------"
            PRINT #9, ""
            PRINT #9, ""
            PRINT #9, "Orig Opand = "; num$ (nKeyOperand); "  ("; gasOperands (nKeyOperand); ")"
            PRINT #9, "Opand      = "; num$ (nCryptOperand); "  ("; gasOperands (nCryptOperand); ")  ";
            IF  nKeyOperand <> nCryptOperand  THEN _
               PRINT #9, "~~~";
            PRINT #9, ""
            PRINT #9, "DataIdx = "; num$ (nDataIdx)
            PRINT #9, "DataCnt = "; num$ (nDataCnt)

            nDataByte1 = aData (nDataIdx)
            nDataByte2 = aData ((nDataIdx + nDirection) MOD nDataLen)
            nDataByte3 = aData ((nDataIdx + nDirection + nDirection) MOD nDataLen)
            nDataByte4 = aData ((nDataIdx + nDirection + nDirection + nDirection) MOD nDataLen)

            PRINT #9, "Bytes   = "; num$ (nDataByte1); ","; num$ (nDataByte2); ","; num$ (nDataByte3); ","; num$ (nDataByte4)
            PRINT #9, "Hex     = "; toHex2$ (nDataByte1); " "; toHex2$ (nDataByte2); " "; toHex2$ (nDataByte3); " "; toHex2$ (nDataByte4)
            PRINT #9, "Binary  = "; toBinary$ (nDataByte1, 8); " "; toBinary$ (nDataByte2, 8); "  "; toBinary$ (nDataByte3, 8); " "; toBinary$ (nDataByte4, 8)

            nOperandValue2 = -1
            nOperandValueUns2 = -1
            nOperandData2 = -1
            nOperandDataUns2 = -1
         END IF

         SELECT CASE  nCryptOperand    ' get datasize-converted Operand and Data Values

         CASE  CS_OPSEL_UNSIGNED_NYBBLE_HI      ' Unsigned Nybble Hi      (4 bits)    ; H

            nDataSize = 1
            nBitShiftMask = CS_MASK_BITSHIFT_NYBBLE
            nDataValueMask = CS_MASK_NYBBLE_LO

            nOperandValue = (nOpValue AND CS_MASK_NYBBLE_HI) \ ganBitsToShiftMultDiv (4)
            nOperandValueUns = nOperandValue

            nOperandData = (aData (nDataIdx) AND CS_MASK_NYBBLE_HI) \ ganBitsToShiftMultDiv (4)
            nOperandDataUns = nOperandData

            nOpDataValue = aData (nDataIdx)

         CASE  CS_OPSEL_UNSIGNED_NYBBLE_LO      ' Unsigned Nybble Lo      (4 bits)    ; L

            nDataSize = 1
            nBitShiftMask = CS_MASK_BITSHIFT_NYBBLE
            nDataValueMask = CS_MASK_NYBBLE_LO

            nOperandValue = nOpValue AND CS_MASK_NYBBLE_LO
            nOperandValueUns = nOperandValue

            nOperandData = aData (nDataIdx) AND CS_MASK_NYBBLE_LO
            nOperandDataUns = nOperandData

            nOpDataValue = aData (nDataIdx)

         CASE  CS_OPSEL_BOTH_UNYBBLES           ' Both Unsigned Nybbles   (4 bits)    ; N

            nDataSize = 1
            nBitShiftMask = CS_MASK_BITSHIFT_NYBBLE
            nDataValueMask = CS_MASK_NYBBLE_LO

            nOperandValue = (nOpValue AND CS_MASK_NYBBLE_HI) \ ganBitsToShiftMultDiv (4)
            nOperandValueUns = nOperandValue

            nOperandValue2 = nOpValue AND CS_MASK_NYBBLE_LO
            nOperandValueUns2 = nOperandValue2

            nOperandData = (aData (nDataIdx) AND CS_MASK_NYBBLE_HI) \ ganBitsToShiftMultDiv (4)
            nOperandDataUns = nOperandData

            nOperandData2 = aData (nDataIdx) AND CS_MASK_NYBBLE_LO
            nOperandDataUns2 = nOperandData2

         CASE  CS_OPSEL_UNSIGNED_BYTE           ' Unsigned Byte           (8 bits)    ; B

            nDataSize = 1
            nBitShiftMask = CS_MASK_BITSHIFT_BYTE
            nDataValueMask = CS_MASK_BYTE

            nOperandValue = nOpValue AND CS_MASK_BYTE
            nOperandValueUns = nOperandValue

            nOperandData = aData (nDataIdx)
            nOperandDataUns = nOperandData

         CASE  CS_OPSEL_UNSIGNED_WORD           ' Unsigned Word           (16 bits)   ; U

            nDataSize = 2
            nBitShiftMask = CS_MASK_BITSHIFT_WORD
            nDataValueMask = CS_MASK_WORD

            nOperandValue = nOpValue AND CS_MASK_WORD
            nOperandValueUns = nOperandValue

            nDataByte1 = aData (nDataIdx)
            nDataByte2 = aData ((nDataIdx + nDirection) MOD nDataLen)
            nOperandData = (nDataByte1 * CS_2_POW_8) + nDataByte2    ' MSB
            nOperandDataUns = nOperandData

         CASE  CS_OPSEL_SIGNED_WORD             ' Signed Word             (16 bits)   ; W

            nDataSize = 2
            nBitShiftMask = CS_MASK_BITSHIFT_WORD
            nDataValueMask = CS_MASK_WORD

            nOperandValue = nOpValue AND CS_MASK_WORD
            nOperandValueUns = nOperandValue

            IF  nOperandValue >= CS_2_POW_15  THEN _
               nOperandValue = nOperandValue - CS_2_POW_16     ' convert to signed value

            nDataByte1 = aData (nDataIdx)
            nDataByte2 = aData ((nDataIdx + nDirection) MOD nDataLen)
            nOperandData = (nDataByte1 * CS_2_POW_8) + nDataByte2    ' MSB
            nOperandDataUns = nOperandData

            IF  nOperandData >= CS_2_POW_15  THEN _
               nOperandData = nOperandData - CS_2_POW_16       ' convert to signed value

         CASE  CS_OPSEL_UNSIGNED_LONG           ' Unsigned Long           (32 bits)   ; L

            nDataSize = 4
            nBitShiftMask = CS_MASK_BITSHIFT_LONG
            nDataValueMask = CS_MASK_LONG

            nOperandValue = nOpValue
            nOperandValueUns = nOperandValue

            nDataByte1 = aData (nDataIdx)
            nDataByte2 = aData ((nDataIdx + nDirection) MOD nDataLen)
            nDataByte3 = aData ((nDataIdx + nDirection + nDirection) MOD nDataLen)
            nDataByte4 = aData ((nDataIdx + nDirection + nDirection + nDirection) MOD nDataLen)
            nOperandData = (nDataByte1 * CS_2_POW_24) + (nDataByte2 * CS_2_POW_16) + (nDataByte3 * CS_2_POW_8) + nDataByte4      ' MSB
            nOperandDataUns = nOperandData

         CASE  CS_OPSEL_SIGNED_LONG             ' Signed Long             (32 bits)   ; S

            nDataSize = 4
            nBitShiftMask = CS_MASK_BITSHIFT_LONG
            nDataValueMask = CS_MASK_LONG

            nOperandValue = nOpValue
            nOperandValueUns = nOperandValue

            IF  nOperandValue >= CS_2_POW_31  THEN _
               nOperandValue = nOperandValue - CS_2_POW_32        ' convert to signed value

            nDataByte1 = aData (nDataIdx)
            nDataByte2 = aData ((nDataIdx + nDirection) MOD nDataLen)
            nDataByte3 = aData ((nDataIdx + nDirection + nDirection) MOD nDataLen)
            nDataByte4 = aData ((nDataIdx + nDirection + nDirection + nDirection) MOD nDataLen)
            nOperandData = (nDataByte1 * CS_2_POW_24) + (nDataByte2 * CS_2_POW_16) + (nDataByte3 * CS_2_POW_8) + nDataByte4      ' MSB
            nOperandDataUns = nOperandData

            IF  nOperandData >= CS_2_POW_31  THEN _
               nOperandData = nOperandData - CS_2_POW_32          ' convert to signed value

         END SELECT ' nCryptOperand -- get datasize-converted Operand and Data Values


         IF  gbDebug  THEN
            PRINT #9, "DataSize             = "; num$ (nDataSize)
            PRINT #9, "BitShiftMask         = "; num$ (nBitShiftMask)
            PRINT #9, "DataValueMask        = 0x"; toHex8$ (nDataValueMask)
            PRINT #9, " OperandValue        = "; num$ (nOperandValue)
            PRINT #9, " OperandValueUns     = "; num$ (nOperandValueUns)
            IF  nOperandValue2 = -1  THEN
               PRINT #9, "   OperandValue2     = *"

            ELSE
               PRINT #9, "   OperandValue2     = "; num$ (nOperandValue2)
            END IF
            IF  nOperandValueUns2 = -1  THEN
               PRINT #9, "   OperandValueUns2  = *"

            ELSE
               PRINT #9, "   OperandValueUns2  = "; num$ (nOperandValueUns2)
            END IF
            PRINT #9, " OperandData         = "; num$ (nOperandData)
            PRINT #9, " OperandDataUns      = "; num$ (nOperandDataUns)
            IF  nOperandData2 = -1  THEN
               PRINT #9, "   OperandData2      = *"

            ELSE
               PRINT #9, "   OperandData2      = "; num$ (nOperandData2)
            END IF
            IF  nOperandDataUns2 = -1  THEN
               PRINT #9, "   OperandDataUns2   = *"

            ELSE
               PRINT #9, "   OperandDataUns2   = "; num$ (nOperandDataUns2)
            END IF
         END IF


         nCryptOperator = nKeyOperator

         IF  bDecrypt  THEN    ' perform the opposite operation for decryption (otherwise leave as is for 'self-reversing' operators)
            SELECT CASE  nKeyOperator

            CASE  CS_OPER_ADD             ' next key value  (1, 2, 3, or 4 bytes after OpSel; key wrap-around)      ; A

               nCryptOperator = CS_OPER_SUBTRACT

            CASE  CS_OPER_COMPLEMENT      ' ones' complement (bitwise NOT; bit invert)                              ; C

            CASE  CS_OPER_SUBTRACT        ' next key value  (1, 2, 3, or 4 bytes after OpSel; key wrap-around)      ; S

               nCryptOperator = CS_OPER_ADD

            CASE  CS_OPER_NEGATE          ' two's complement (arithmetic negative)                                  ; N

            CASE  CS_OPER_XOR             ' next key value  (1, 2, 3, or 4 bytes after OpSel; key wrap-around)      ; X

            CASE  CS_OPER_ROTATE_LEFT     ' next key value after OpSel LSBs (2=1-3, 3=1-7, 4=1-15, 8=1-31; 0 = 1)   ; L

               nCryptOperator = CS_OPER_ROTATE_RIGHT

            CASE  CS_OPER_SWAP            ' (Dits, Nybbles, Bytes, Words)                                           ; W

            CASE  CS_OPER_ROTATE_RIGHT    ' next key value after OpSel LSBs (2=1-3, 3=1-7, 4=1-15, 8=1-31; 0 = 1)   ; R

               nCryptOperator = CS_OPER_ROTATE_LEFT

            END SELECT ' nKeyOperator -- perform the opposite operation for decryption
         END IF


         IF  gbDebug  THEN
            PRINT #9, "Orig Oper = "; num$ (nKeyOperator); "  ("; gasOperators (nKeyOperator); ")"
            PRINT #9, "Oper      = "; num$ (nCryptOperator); "  ("; gasOperators (nCryptOperator); ")"

            nResult2 = -1
            nBitsToShift = -1
            nDataMask = -1
            nUpperValue = -1
            nLowerValue = -1
         END IF


         SELECT CASE  nCryptOperator      ' Operator execution

         CASE  CS_OPER_ADD    ' next key value  (1, 2, 3, or 4 bytes after OpSel; key wrap-around)      ; A

            nResult = nOperandData + nOperandValue

            IF  nCryptOperand = CS_OPSEL_BOTH_UNYBBLES  THEN _
               nResult2 = nOperandData2 + nOperandValue2

         CASE  CS_OPER_COMPLEMENT      ' ones" complement (bitwise NOT; bit invert)                              ; C

            nResult = NOT (nOperandDataUns)

            IF  nCryptOperand = CS_OPSEL_BOTH_UNYBBLES  THEN _
               nResult2 = NOT (nOperandDataUns2)

         CASE  CS_OPER_SUBTRACT     ' next key value  (1, 2, 3, or 4 bytes after OpSel; key wrap-around)      ; S

            nResult = nOperandData - nOperandValue

            IF  nCryptOperand = CS_OPSEL_BOTH_UNYBBLES  THEN _
               nResult2 = nOperandData2 - nOperandValue2

         CASE  CS_OPER_NEGATE    ' two"s complement (arithmetic negative)                                  ; N

            nResult = -nOperandData

            IF  nCryptOperand = CS_OPSEL_BOTH_UNYBBLES  THEN _
               nResult2 = -nOperandData2

         CASE  CS_OPER_XOR    ' next key value  (1, 2, 3, or 4 bytes after OpSel; key wrap-around)      ; X

            nResult = nOperandDataUns XOR nOperandValueUns

            IF  nCryptOperand = CS_OPSEL_BOTH_UNYBBLES  THEN _
               nResult2 = nOperandDataUns2 XOR nOperandValueUns2

         CASE  CS_OPER_ROTATE_LEFT     ' next key value after OpSel LSBs (2=1-3, 3=1-7, 4=1-15, 8=1-31; 0 = 1)   ; L

            nBitsToShift = (nOperandValueUns AND nBitShiftMask)
            IF  nBitsToShift = 0  THEN _
               nBitsToShift = 1     ' // 0 = 1
            nDataMask = nDataValueMask \ ganBitsToShiftMultDiv (nBitsToShift)

            nUpperValue = (nOperandDataUns AND nDataMask) * ganBitsToShiftMultDiv (nBitsToShift)
            nLowerValue = nOperandDataUns \ ganBitsToShiftMultDiv (nBitShiftMask - nBitsToShift + 1)
            nResult = nUpperValue OR nLowerValue

            IF  nCryptOperand = CS_OPSEL_BOTH_UNYBBLES  THEN
               nUpperValue = (nOperandDataUns2 AND nDataMask) * ganBitsToShiftMultDiv (nBitsToShift)
               nLowerValue = nOperandDataUns2 \ ganBitsToShiftMultDiv (nBitShiftMask - nBitsToShift + 1)
               nResult2 = nUpperValue OR nLowerValue
            END IF

         CASE  CS_OPER_SWAP      ' (Dits, Nybbles, Bytes, Words)                                           ; W

            SELECT CASE  nCryptOperand    ' Operand-sized swapping

            CASE  CS_OPSEL_UNSIGNED_NYBBLE_HI, _
                  CS_OPSEL_UNSIGNED_NYBBLE_LO, _
                  CS_OPSEL_BOTH_UNYBBLES
                     ' Unsigned Nybble Hi      (4 bits)    ; H
                     ' Unsigned Nybble Lo      (4 bits)    ; L
                     ' Both Unsigned Nybbles   (4 bits)    ; N

               nDitHi = (nOperandDataUns AND CS_MASK_DIT_HI) \ ganBitsToShiftMultDiv (2)
               nDitLo = nOperandDataUns AND CS_MASK_DIT_LO
               nResult = (nDitLo * ganBitsToShiftMultDiv (2)) + nDitHi

               IF  nCryptOperand = CS_OPSEL_BOTH_UNYBBLES  THEN
                  nDitHi = (nOperandDataUns2 AND CS_MASK_DIT_HI) \ ganBitsToShiftMultDiv (2)
                  nDitLo = nOperandDataUns2 AND CS_MASK_DIT_LO
                  nResult2 = (nDitLo * ganBitsToShiftMultDiv (2)) + nDitHi
               END IF

            CASE  CS_OPSEL_UNSIGNED_BYTE     ' Unsigned Byte           (8 bits)    ; B

               nNybbleHi = (nOperandDataUns AND CS_MASK_NYBBLE_HI) \ ganBitsToShiftMultDiv (4)
               nNybbleLo = nOperandDataUns AND CS_MASK_NYBBLE_LO
               nResult = (nNybbleLo * ganBitsToShiftMultDiv (4)) + nNybbleHi

            CASE  CS_OPSEL_UNSIGNED_WORD, _
                  CS_OPSEL_SIGNED_WORD
                     ' Unsigned Word           (16 bits)   ; U
                     ' Signed Word             (16 bits)   ; W

               nByteHi = (nOperandDataUns AND CS_MASK_BYTE_HI) \ ganBitsToShiftMultDiv (8)
               nByteLo = nOperandDataUns AND CS_MASK_BYTE_LO
               nResult = (nByteLo * ganBitsToShiftMultDiv (8)) + nByteHi

            CASE  CS_OPSEL_UNSIGNED_LONG, _
                  CS_OPSEL_SIGNED_LONG
                     ' Unsigned Long           (32 bits)   ; L
                     ' Signed Long             (32 bits)   ; S

               nWordHi = (nOperandDataUns AND CS_MASK_WORD_HI) \ ganBitsToShiftMultDiv (16)
               nWordLo = nOperandDataUns AND CS_MASK_WORD_LO
               nResult = (nWordLo * ganBitsToShiftMultDiv (16)) + nWordHi

            END SELECT ' nCryptOperand -- Operand-sized swapping

         CASE  CS_OPER_ROTATE_RIGHT    ' next key value after OpSel LSBs (2=1-3, 3=1-7, 4=1-15, 8=1-31; 0 = 1)   ; R

            nBitsToShift = (nOperandValueUns AND nBitShiftMask)
            IF  nBitsToShift = 0  THEN _
               nBitsToShift = 1     ' // 0 = 1
            nDataMask = nDataValueMask \ ganBitsToShiftMultDiv (nBitShiftMask - nBitsToShift + 1)

            nUpperValue = (nOperandDataUns AND nDataMask) * ganBitsToShiftMultDiv (nBitShiftMask - nBitsToShift + 1)
            nLowerValue = (nOperandDataUns \ ganBitsToShiftMultDiv (nBitsToShift)) AND (nDataValueMask \ ganBitsToShiftMultDiv (nBitsToShift))
            nResult = nUpperValue OR nLowerValue

            IF  nCryptOperand = CS_OPSEL_BOTH_UNYBBLES  THEN
               nUpperValue = (nOperandDataUns2 AND nDataMask) * ganBitsToShiftMultDiv (nBitShiftMask - nBitsToShift + 1)
               nLowerValue = nOperandDataUns2 \ ganBitsToShiftMultDiv (nBitsToShift)
               nResult2 = nUpperValue OR nLowerValue
            END IF

         END SELECT ' nCryptOperator -- Operator execution


         SELECT CASE  nCryptOperand    ' store new result

         CASE  CS_OPSEL_UNSIGNED_NYBBLE_HI      ' Unsigned Nybble Hi      (4 bits)    ; H

            IF  nResult < 0  THEN _
               nResult = nResult + CS_2_POW_4      ' force value unsigned
            nResult = (nResult AND CS_MASK_NYBBLE_LO) * ganBitsToShiftMultDiv (4)

            aData (nDataIdx) = (nOpDataValue AND CS_MASK_NYBBLE_LO) + nResult

         CASE  CS_OPSEL_UNSIGNED_NYBBLE_LO      ' Unsigned Nybble Lo      (4 bits)    ; L

            IF  nResult < 0  THEN _
               nResult = nResult + CS_2_POW_4      ' force value unsigned
            nResult = nResult AND CS_MASK_NYBBLE_LO

            aData (nDataIdx) = (nOpDataValue AND CS_MASK_NYBBLE_HI) + nResult

         CASE  CS_OPSEL_BOTH_UNYBBLES     ' Both Unsigned Nybbles   (4 bits)    ; N

            IF  nResult < 0  THEN _
               nResult = nResult + CS_2_POW_4      ' force value unsigned
            nResult = (nResult AND CS_MASK_NYBBLE_LO) * ganBitsToShiftMultDiv (4)

            IF  nResult2 < 0  THEN _
               nResult2 = nResult2 + CS_2_POW_4     ' force value unsigned
            nResult2 = nResult2 AND CS_MASK_NYBBLE_LO

            aData (nDataIdx) = nResult + nResult2

         CASE  CS_OPSEL_UNSIGNED_BYTE     ' Unsigned Byte           (8 bits)    ; B

            IF  nResult < 0  THEN _
               nResult = nResult + CS_2_POW_8      ' force value unsigned
            nResult = nResult AND CS_MASK_BYTE

            aData (nDataIdx) = nResult

         CASE  CS_OPSEL_UNSIGNED_WORD, _
               CS_OPSEL_SIGNED_WORD
                  ' Unsigned Word           (16 bits)   ; U
                  ' Signed Word             (16 bits)   ; W

            IF  nResult < 0  THEN _
               nResult = nResult + CS_2_POW_16     ' force value unsigned
            nResult = nResult AND CS_MASK_WORD

            aData (nDataIdx) = nResult \ ganBitsToShiftMultDiv (8)
            aData ((nDataIdx + nDirection) MOD nDataLen) = nResult AND CS_MASK_BYTE

         CASE  CS_OPSEL_UNSIGNED_LONG, _
               CS_OPSEL_SIGNED_LONG
                  ' Unsigned Long           (32 bits)   ; L
                  ' Signed Long             (32 bits)   ; S

            IF  nResult < 0  THEN _
               nResult = nResult + CS_2_POW_32     ' force value unsigned
            nResult = nResult AND CS_MASK_LONG

            nDataByte1 = (nResult AND CS_MASK_BYTE1) \ CS_2_POW_24
            nDataByte2 = ((nResult AND CS_MASK_BYTE2) \ CS_2_POW_16) AND CS_MASK_BYTE
            nDataByte3 = ((nResult AND CS_MASK_BYTE3) \ CS_2_POW_8) AND CS_MASK_BYTE
            nDataByte4 = nResult AND CS_MASK_BYTE4

            aData (nDataIdx) = nDataByte1
            aData ((nDataIdx + nDirection) MOD nDataLen) = nDataByte2
            aData ((nDataIdx + nDirection + nDirection) MOD nDataLen) = nDataByte3
            aData ((nDataIdx + nDirection + nDirection + nDirection) MOD nDataLen) = nDataByte4

         END SELECT ' nCryptOperand -- ' store new result


         IF  gbDebug  THEN
            PRINT #9, "** Result    = "; num$ (nResult)
            IF  nResult2 = -1  THEN
               PRINT #9, "     Result2 = *"

            ELSE
               PRINT #9, "     Result2 = "; num$ (nResult2)
            END IF

            nDataByte1 = aData (nDataIdx)
            nDataByte2 = aData ((nDataIdx + nDirection) MOD nDataLen)
            nDataByte3 = aData ((nDataIdx + nDirection + nDirection) MOD nDataLen)
            nDataByte4 = aData ((nDataIdx + nDirection + nDirection + nDirection) MOD nDataLen)

            PRINT #9, "  Bytes      = "; num$ (nDataByte1); ", "; num$ (nDataByte2); ", "; num$ (nDataByte3); ", "; num$ (nDataByte4)
            PRINT #9, "  Hex        = "; toHex2$ (nDataByte1); " "; toHex2$ (nDataByte2); " "; toHex2$ (nDataByte3); " "; toHex2$ (nDataByte4)
            PRINT #9, "  Binary     = "; toBinary$ (nDataByte1, 8); " "; toBinary$ (nDataByte2, 8); "  "; toBinary$ (nDataByte3, 8); " "; toBinary$ (nDataByte4, 8)

            IF  nBitsToShift = -1  THEN
               PRINT #9, "      BitsToShift  = *"

            ELSE
               PRINT #9, "      BitsToShift  = "; num$ (nBitsToShift)
            END IF
            IF  nDataMask = -1  THEN
               PRINT #9, "      DataMask     = *"

            ELSE
               PRINT #9, "      DataMask     = "; toBinary$ (nDataMask, nBitShiftMask + 1)
            END IF
            IF  nUpperValue = -1  THEN
               PRINT #9, "      UpperValue   = *"

            ELSE
               PRINT #9, "      UpperValue   = "; toBinary$ (nUpperValue, nBitShiftMask + 1)
            END IF
            IF  nLowerValue = -1  THEN
               PRINT #9, "      LowerValue   = *"

            ELSE
               PRINT #9, "      LowerValue   = "; toBinary$ (nLowerValue, nBitShiftMask + 1)
            END IF
         END IF


         nDataIdx = (nDataIdx + (nDirection * nDataSize)) MOD nDataLen
         nDataCnt = nDataCnt - nDataSize

         nKeyOperator = (nKeyOperator + 1) MOD 8
         nKeyOperand = (nKeyOperand + 1) MOD 8

         IF  nKeyOperator = nKeyOperatorStart  THEN _
            nKeyOperand = (nKeyOperand + 1) MOD 8     ' ensures all Operators with all Operand sizes

      LOOP WHILE  nDataIdx <> nDatasetOffset       ' process the dataset -- one full pass

      nOPLIdx = nOPLIdx + nOPLDir

      PRINT "*";     ' show progress

   LOOP WHILE  nOPLIdx >= 0  AND  nOPLIdx < nOpsProcListCnt       ' process the Operations Processing List


   gnErr = 0
   OPEN psOutput FOR OUTPUT AS #1    ' erase output file

   IF  gnErr = 0  THEN
      CLOSE #1

      gnErr = 0
      OPEN psOutput FOR BINARY AS #1    ' write cryption to output file

      IF  gnErr = 0  THEN
         gnErr = 0
         PUT #1, , aData()

         IF  gnErr = 0  THEN
            CLOSE #1

            bProccessed = TRUE

         ELSE
            gsError = "Error saving cryption into output file, '" + psOutput + "': " + errorText$ (gnErr, TRUE)
         END IF

      ELSE
         gsError = "Error opening cryption output file for save, '" + psOutput + "': " + errorText$ (gnErr, TRUE)
      END IF

   ELSE
      gsError = "Error erasing cryption output file, '" + psOutput + "': " + errorText$ (gnErr, TRUE)
   END IF

   processFile% = bProccessed

END FUNCTION ' processFile


' debugging helper functions


FUNCTION  toHex2$ ( _
   pnNumber    AS _UNSIGNED _INTEGER64 _
)
' number to 2 hex digits padded with zeroes (8-bit byte)

   toHex2$ = LPAD$ (HEX$ (pnNumber), "0", 2)

END FUNCTION ' toHex2$


FUNCTION  toHex4$ ( _
   pnNumber    AS _UNSIGNED _INTEGER64 _
)
' number to 4 hex digits padded with zeroes (16-bit word)

   toHex4$ = LPAD$ (HEX$ (pnNumber), "0", 4)

END FUNCTION ' toHex4$


FUNCTION  toHex8$ ( _
   pnNumber    AS _UNSIGNED _INTEGER64 _
)
' number to 8 hex digits padded with zeroes  (32-bit long)

   toHex8$ = LPAD$ (HEX$ (pnNumber), "0", 8)

END FUNCTION ' toHex8$


FUNCTION  toBinary$ ( _
   pnNumber    AS _UNSIGNED _INTEGER64, _
   pnDigits    AS INTEGER _
)
' number to n-digit binary up to 64 bits (up to 64-bit quad word)

   DIM nBit    AS _UNSIGNED _INTEGER64
   DIM nCnt    AS INTEGER
   DIM sBinary AS STRING
   DIM sBit    AS STRING
   DIM nDigits AS INTEGER


   nDigits = pnDigits

   IF  nDigits < 0  OR  nDigits > 64  THEN _
      nDigits = 64

   nBit = 1

   FOR  nCnt = 0  TO  nDigits - 1

      IF  (pnNumber AND nBit) = 0  THEN
         sBit = "0"

      ELSE
         sBit = "1"
      END IF

      sBinary = sBit + sBinary
      nBit = nBit * 2

   NEXT nCnt

   toBinary$ = sBinary

END FUNCTION ' toBinary$


FUNCTION  num$ ( _
   pnNumber    AS _INTEGER64 _
)
' non-leading SPACE (positive) number to string conversion

   num$ = LTRIM$ (STR$ (pnNumber))

END FUNCTION 'num$


' ancillary helper functions


FUNCTION  RPAD$ ( _
   psText         AS STRING, _
   psPadChar      AS STRING, _
   pnPadLength    AS INTEGER _
)
' Right pad

   DIM sPadded    AS STRING


   IF  LEN (psText) >= pnPadLength  THEN
      RPAD$ = psText

   ELSE
      RPAD$ = LEFT$ (psText + STRING$ (pnPadLength, psPadChar), pnPadLength)
   END IF

END FUNCTION ' RPAD$    --- NOTE: Does not truncate if longer than pad length


FUNCTION  LPAD$ ( _
   psText         AS STRING, _
   psPadChar      AS STRING, _
   pnPadLength    AS INTEGER _
)
' Left pad

   IF  LEN (psText) >= pnPadLength  THEN
      LPAD$ = psText

   ELSE
      LPAD$ = RIGHT$ (STRING$ (pnPadLength, psPadChar) + psText, pnPadLength)
   END IF

END FUNCTION ' LPAD$    --- NOTE: Does not truncate if longer than pad length


FUNCTION  TRIM$ ( _
   psText      AS STRING _
)
' Left and Right trim of SPACE characters

   TRIM$ = LTRIM$ (RTRIM$ (psText))

END FUNCTION ' TRIM$


FUNCTION  trimWhitespace$ ( _
   psText      AS STRING _
)
' remove all instances of leading and trailing SPACE, CR, LF, and TAB

   DIM sText         AS STRING
   DIM sChar         AS STRING
   DIM blnLeading    AS INTEGER
   DIM blnTrailing   AS INTEGER


   sText = TRIM$ (psText)
   blnLeading = FALSE
   blnTrailing = FALSE

   DO

      sChar = LEFT$ (sText, 1)

      IF  sChar = C_SPC  OR  sChar = C_TAB  OR  sChar = C_CR  OR  sChar = C_LF  THEN _
         blnLeading = TRUE

      IF  blnLeading  THEN _
         sText = MID$ (sText, 2)

      sChar = RIGHT$ (sText, 1)

      IF  sChar = C_SPC  OR  sChar = C_TAB  OR  sChar = C_CR  OR  sChar = C_LF  THEN _
         blnTrailing = TRUE

      IF  blnTrailing  THEN _
         sText = LEFT$ (sText, LEN (sText) - 1)

   LOOP WHILE  sText <> ""  AND  (blnLeading  OR  blnTrailing)

   trimWhitespace$ = sText

END FUNCTION ' trimWhitespace$


FUNCTION  strrev$ ( _
   psText      AS STRING _
)
' reverse a string

   DIM sText AS STRING
   DIM nLen AS INTEGER
   DIM nChar AS INTEGER


   sText = ""
   nLen = LEN (psText)

   FOR  nChar = nLen  TO  1  STEP -1

      sText = sText + MID$ (psText, nChar, 1)

   NEXT nChar

   strrev$ = sText

END FUNCTION ' strrev$


FUNCTION  strrpos% ( _
   psText      AS STRING, _
   psSearch    AS STRING, _
   pnOffset    AS INTEGER _
)
' find the position of the last occurrence of a substring in a string, 0 = not found
' if search string is "" returns length of string + 1

   DIM nFound  AS INTEGER
   DIM sText   AS STRING
   DIM sSearch AS STRING


   sText = psText
   IF  pnOffset > 0  THEN _
      sText = MID$ (sText, pnOffset)

   sText = strrev$ (sText)          ' reverse the string to search backward
   sSearch = strrev$ (psSearch)     ' reverse the search string accordingly

   nFound = INSTR (sText, sSearch)

   IF  nFound > 0  THEN _
      nFound = LEN (sText) - (nFound - 1) - (LEN (sSearch) - 1)

   strrpos% = nFound

END FUNCTION ' strrpos%


FUNCTION  strripos% ( _
   psText      AS STRING, _
   psSearch    AS STRING, _
   pnOffset    AS INTEGER _
)
' find the insensitive search position of the last occurrence of a substring in a string, 0 = not found
' if search string is "" returns length of string + 1

   DIM nFound  AS INTEGER
   DIM sText   AS STRING
   DIM sSearch AS STRING


   sText = UCASE$ (psText)
   IF  pnOffset > 0  THEN _
      sText = MID$ (sText, pnOffset)

   sText = strrev$ (sText)    ' reverse the string to search backward
   sSearch = strrev$ (UCASE$ (psSearch))     ' reverse the search string accordingly

   nFound = INSTR (sText, sSearch)

   IF  nFound > 0  THEN _
      nFound = LEN (sText) - (nFound - 1) - (LEN (sSearch) - 1)

   strripos% = nFound

END FUNCTION ' strripos%


SUB  beepAlert

   PLAY "V25O2L8C"                     ' 25% Volume, Octave 2, 'C' 8th Note

END SUB ' beepAlert


FUNCTION  errorText$ ( _
   pnErrorNum           AS INTEGER, _
   pblnIncludeErrNum    AS INTEGER _
)

   DIM sErrorText    AS STRING
   DIM sErrorDesc    AS STRING


   SELECT CASE  pnErrorNum

   CASE  1

      sErrorText = "NEXT without FOR"
      sErrorDesc = "Usually an END IF block statement was omitted from an IF or SELECT CASE."

   CASE  2

      sErrorText = "Syntax error"
      sErrorDesc = "Mistyped keyword statement syntax errors."

   CASE  3

      sErrorText = "RETURN without GOSUB"
      sErrorDesc = "A RETURN statement without a GOSUB call. Place sub AFTER sub-procedure EXIT or program END!"

   CASE  4

      sErrorText = "Out of DATA"
      sErrorDesc = "A READ has read past the end of DATA. Use RESTORE to reset to data start."

   CASE  5

      sErrorText = "Illegal function call"
      sErrorDesc = "A parameter passed does not match the function type or exceeds certain function limitations. See Illegal Function."

   CASE  6

      sErrorText = "Overflow"
      sErrorDesc = "A numerical value has exceeded the type limitations."

   CASE  7

      sErrorText = "Out of memory"
      sErrorDesc = "A module has exceeded the 64K memory limitation of QB. Try breaking the code up to smaller modules."

   CASE  8

      sErrorText = "Label not defined"
      sErrorDesc = "GOTO or GOSUB tries to branch to a label that doesn't exist."

   CASE  9

      sErrorText = "Subscript out of range"
      sErrorDesc = "An array's upper or lower bounds have been exceeded."

   CASE  10

      sErrorText = "Duplicate definition"
      sErrorDesc = "You can't define a variable twice with DIM, the first time a variable is used it is also defined."

   CASE  11

      sErrorText = "Division by zero"
      sErrorDesc = "You cannot divide any value by zero! Even using MOD."

   CASE  12

      sErrorText = "Illegal in direct mode"
      sErrorDesc = "A statement (like DIM) in the Immediate window wasn't allowed."

   CASE  13

      sErrorText = "Type mismatch"
      sErrorDesc = "A SUB or FUNCTION  parameter does not match the procedure Declaration."

   CASE  14

      sErrorText = "Out of string space"
      sErrorDesc = "A module has exceeded the 32767 text character limit. Use SUB PRINT procedures."

   CASE  16

      sErrorText = "String formula too complex"
      sErrorDesc = "A string formula was too long or a INPUT statement requested more than 15 strings"

   CASE  17

      sErrorText = "Cannot continue"
      sErrorDesc = "The program while debugging has changed in a way that it cannot continue."

   CASE  18

      sErrorText = "Function not defined"
      sErrorDesc = "The function used by the program must be defined. Did you include the .bi file while using a library?"

   CASE  19

      sErrorText = "No RESUME"
      sErrorDesc = "The end of the program was reached while being in a error handling routine, add a RESUME at the end of the routine."

   CASE  20

      sErrorText = "RESUME without error"
      sErrorDesc = "RESUME can only be used in an error handler using ON ERROR."

   CASE  24

      sErrorText = "Device timeout"
      sErrorDesc = "Use DS0 to avoid modem timeouts."

   CASE  25

      sErrorText = "Device fault"
      sErrorDesc = "Device not connected or does not exist."

   CASE  26

      sErrorText = "FOR without NEXT"
      sErrorDesc = "Look for a missing END IF statement also."

   CASE  27

      sErrorText = "Out of paper"
      sErrorDesc = "A PRINTer paper error when using LPRINT."

   CASE  29

      sErrorText = "WHILE without WEND"
      sErrorDesc = "WEND must be used with WHILE"

   CASE  30

      sErrorText = "WEND without WHILE"
      sErrorDesc = "Look for an END IF error also."

   CASE  33

      sErrorText = "Duplicate label"
      sErrorDesc = "Line numbers or labels cannot be used twice in a procedure."

   CASE  35

      sErrorText = "Subprogram not defined"
      sErrorDesc = "Often occurs when the Quickbasic Library is not used with CALL ABSOLUTE or INTERRUPT."

   CASE  37

      sErrorText = "Argument-count mismatch"
      sErrorDesc = "The number of sub-procedure parameters do not match the call."

   CASE  38

      sErrorText = "Array not defined"
      sErrorDesc = "Arrays using more than 10 elements must be DIMensioned."

   CASE  40

      sErrorText = "Variable required"
      sErrorDesc = "A GET or PUT statement must specify a variable when operating with a file opened in binary mode."

   CASE  50

      sErrorText = "FIELD overflow"
      sErrorDesc = "A FIELD statement tried to allocate more bytes than were specified for the record length of a random access file."

   CASE  51

      sErrorText = "Internal error"
      sErrorDesc = "An internal malfunction occured in QuickBASIC or QB64."

   CASE  52

      sErrorText = "Bad file name or number"
      sErrorDesc = "The filename must follow the rules for filenames in the OS and filenumbers must be between 1 and 255 and refer to a currently open file."

   CASE  53

      sErrorText = "File not found"
      sErrorDesc = "File not in current directory or path given."

   CASE  54

      sErrorText = "Bad file mode"
      sErrorDesc = "File access mode does not match file procedure."

   CASE  55

      sErrorText = "File already open"
      sErrorDesc = "CLOSE a file to open it in a different mode."

   CASE  56

      sErrorText = "FIELD statement active"
      sErrorDesc = "(no further information is available for Error #56)"

   CASE  57

      sErrorText = "Device I/O error"
      sErrorDesc = "(no further information is available for Error #57)"

   CASE  58

      sErrorText = "File already exists"
      sErrorDesc = "The filename specified in the NAME statement was identical to a file that already exists."

   CASE  59

      sErrorText = "Bad record length"
      sErrorDesc = "Record length exceeds 32767 bytes or is 0"

   CASE  61

      sErrorText = "Disk full"
      sErrorDesc = "The amount of data to write to the disk was more than the free space available, remove some files you don't need and try again."

   CASE  62

      sErrorText = "Input past end of file"
      sErrorDesc = "Check for the end of file with EOF."

   CASE  63

      sErrorText = "Bad record number"
      sErrorDesc = "GET read exceeds number of records in file."

   CASE  64

      sErrorText = "Bad file name"
      sErrorDesc = "File name contains illegal characters or exceeds 12 characters."

   CASE  67

      sErrorText = "Too many files"
      sErrorDesc = "Over 15 files are open."

   CASE  68

      sErrorText = "Device unavailable"
      sErrorDesc = "Device is busy or not connected."

   CASE  69

      sErrorText = "Communication-buffer overflow."
      sErrorDesc = "(no further information is available for Error #69)"

   CASE  70

      sErrorText = "Permission denied"
      sErrorDesc = "A file or port is in use on a network, blocked, read only or locked."

   CASE  71

      sErrorText = "Disk not ready"
      sErrorDesc = "Disk is busy or has no media."

   CASE  72

      sErrorText = "Disk-media error"
      sErrorDesc = "Improper media format or bad data."

   CASE  73

      sErrorText = "Feature unavailable"
      sErrorDesc = "Based on the DOS version available."

   CASE  74

      sErrorText = "Rename across disks"
      sErrorDesc = "(no further information is available for Error #74)"

   CASE  75

      sErrorText = "Path/File access error"
      sErrorDesc = "File or path cannot be accessed."

   CASE  76

      sErrorText = "Path not found"
      sErrorDesc = "Path is not accessable."

   CASE  97

      sErrorText = "(No error message -- Err #97 = User Defined Error)"
      sErrorDesc = "Can be used to trigger an error trap event with ERROR 97, nothing else will cause this error, so create your own errors for ON ERROR."

   CASE  258

      sErrorText = "Invalid handle"
      sErrorDesc = "Zero or bad handle values cannot be used."

   CASE  ELSE

      sErrorText = "Unknown Error #" + STR$ (pnErrorNum)
      sErrorDesc = "An unknown error has occurred."

   END SELECT

   IF (pblnIncludeErrNum) THEN _
      sErrorText = "Err #" + LTRIM$ (STR$ (pnErrorNum)) + ": " + sErrorText

   errorText$ = sErrorText + " (" + sErrorDesc + ")"

END FUNCTION ' errorText$


FUNCTION  superInkey$

' superInkey$ = INKEY$-like function that returns additional information,
'                 particularly for extended, 2-char keys created with SHIFT, CTRL and ALT
'                 and Function keys and other non-ASCII extended key values
'
' Expects:
'
'     Global    gtSuperInkey     ' global variable defined as a typeSuperInkey TYPE
'
'     Global    C_SPC      ' constant SPACE
'
'  REQUIRES CONST FALSE = 0, TRUE = NOT FALSE in global program

   DIM sAlt    AS STRING
   DIM sChar   AS STRING


   gtSuperInkey.sChar = ""
   gtSuperInkey.sCharExt = ""
   gtSuperInkey.sExt = ""
   gtSuperInkey.sName = ""
   gtSuperInkey.sPrintable = ""

   gtSuperInkey.nASC = 0
   gtSuperInkey.nExtASC = 0

   gtSuperInkey.bKeyPress = FALSE
   gtSuperInkey.bNull = FALSE
   gtSuperInkey.bCtrl = FALSE
   gtSuperInkey.bAlt = FALSE
   gtSuperInkey.bShift = FALSE
   gtSuperInkey.bFunc = FALSE
   gtSuperInkey.bArrow = FALSE
   gtSuperInkey.bCursor = FALSE
   gtSuperInkey.bKeyPad = FALSE

   sAlt = "QWERTYUIOP[]??ASDFGHJKL;'`?\ZXCVBNM,./"    ' extended 16 to 53 for ALT+

   superInkey$ = ""
   sChar = INKEY$
   gtSuperInkey.sChar = sChar

   IF  sChar = ""  THEN
      gtSuperInkey.bNull = TRUE
      EXIT FUNCTION
   END IF

   gtSuperInkey.bKeyPress = TRUE

   IF  ASC (sChar) > 0  THEN             ' normal key codes
      gtSuperInkey.nASC = ASC (sChar)
      gtSuperInkey.sPrintable = gtSuperInkey.sChar

      SELECT CASE  gtSuperInkey.nASC

      CASE  7     ' Bell

         gtSuperInkey.sName = "Beep (Ctrl-G)"

      CASE  8     ' BS

         gtSuperInkey.sName = "Backspace (Ctrl-H)"

      CASE  9     ' TAB

         gtSuperInkey.sName = "Tab Key (TAB/Ctrl-I)"

      CASE  10    ' LF

         gtSuperInkey.sName = "Line Feed (Ctrl-J)"

      CASE  12    ' FF

         gtSuperInkey.sName = "Form Feed (Ctrl-L)"

      CASE  13    ' Enter/CR

         gtSuperInkey.sName = "Enter (Enter/Ctrl-M)"

      CASE  27    ' ESCape

         gtSuperInkey.sName = "Escape (ESC/Ctrl-[)"

      CASE  28    ' Move Cursor Right

         gtSuperInkey.sName = "Move Cursor Right"

      CASE  29    ' Move Cursor Left

         gtSuperInkey.sName = "Move Cursor Left"

      CASE  30    ' Move Cursor Up

         gtSuperInkey.sName = "Move Cursor Up"

      CASE  31    ' Move Cursor Down

         gtSuperInkey.sName = "Move Cursor Down"

      CASE  32    ' SPACE

         gtSuperInkey.sName = "SpaceBar"
         gtSuperInkey.sExt = "SPACE"       ' because types have fixed-length strings, spaces need special notification

      CASE  33  TO  47     ' ! " # $ % & ' ( ) * + , - . /

         gtSuperInkey.sName = "Punctuation: " + gtSuperInkey.sChar

      CASE  48 TO 57  ' 0 - 9

         gtSuperInkey.sName = "Numeral: " + gtSuperInkey.sChar

      CASE  58  TO  64     ' : ; < = > ? @

         gtSuperInkey.sName = "Punctuation: " + gtSuperInkey.sChar

      CASE  65  TO  90     ' A - Z

         gtSuperInkey.sName = "Uppercase: " + gtSuperInkey.sChar

      CASE  91  TO  96     ' [ \ ] ^ _ `

         gtSuperInkey.sName = "Punctuation: " + gtSuperInkey.sChar

      CASE  97  TO  122    ' a - z

         gtSuperInkey.sName = "Lowercase: " + gtSuperInkey.sChar

      CASE  123  TO  127      ' { | } ~ DEL

         gtSuperInkey.sName = "Punctuation: " + gtSuperInkey.sChar

      CASE  ELSE

         gtSuperInkey.sName = "Unknown Other"

         IF  gtSuperInkey.nASC < 32  THEN _
            gtSuperInkey.sName = "Ctrl+" + CHR$ (gtSuperInkey.nASC + 64)

      END SELECT ' gtSuperInkey.nASC

      IF  gtSuperInkey.nASC < 32  THEN _
         gtSuperInkey.bCtrl = TRUE

      SELECT CASE  gtSuperInkey.nASC    ' check for unPRINT #9, able control combo characters

         CASE  10  TO  13     ' Linefeed, Vertical Tab, Form Feed, Carriage Return

            gtSuperInkey.sPrintable = C_SPC

         CASE  28  TO  31     ' Up, Down, Left, and Right Arrow (movement)

            gtSuperInkey.sPrintable = C_SPC

      END SELECT
   END IF  ' Normal key code

   IF  ASC (sChar) = 0  THEN             ' two byte key codes
      gtSuperInkey.nExtASC = ASC (RIGHT$ (sChar, 1))
      gtSuperInkey.sChar = ""
      gtSuperInkey.sCharExt = sChar
      sChar = ""                       ' return true ""
      gtSuperInkey.bNull = TRUE

      SELECT CASE  gtSuperInkey.nExtASC

      CASE  0  TO  2    ' unknowns

         gtSuperInkey.sExt = "Unknown:" + STR$ (gtSuperInkey.nExtASC)

      CASE  3     ' Ctrl+@

         gtSuperInkey.sExt = "Ctrl+@"
         gtSuperInkey.bCtrl = TRUE

      CASE  4  TO  15      ' unknowns

         gtSuperInkey.sExt = "Unknown:" + STR$ (gtSuperInkey.nExtASC)

      CASE  16  TO  53     ' ALT+ characters

         gtSuperInkey.sExt = "Alt+" + MID$ (sAlt, gtSuperInkey.nExtASC - 15, 1)
         gtSuperInkey.bAlt = TRUE

      CASE  54    ' 6

         gtSuperInkey.sExt = "Unknown:" + STR$ (gtSuperInkey.nExtASC) + " = " + CHR$ (gtSuperInkey.nExtASC)

      CASE  55    ' 7

         gtSuperInkey.sExt = "Alt+KeyPadAsterisk"
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bKeyPad = TRUE

      CASE  56  TO  58     ' 8 | 9 | :

         gtSuperInkey.sExt = "Unknown:" + STR$ (gtSuperInkey.nExtASC) + " = " + CHR$ (gtSuperInkey.nExtASC)

      CASE  59  TO  68     ' ; | < | = | > | ? | @ | A - D

         gtSuperInkey.sExt = "F" + LTRIM$ (STR$ (gtSuperInkey.nExtASC - 58))
         gtSuperInkey.bFunc = TRUE

      CASE  69  TO  70     ' E | F

         gtSuperInkey.sExt = "Unknown:" + STR$ (gtSuperInkey.nExtASC) + " = " + CHR$ (gtSuperInkey.nExtASC)

      CASE  71    ' G

         gtSuperInkey.sExt = "Home"
         gtSuperInkey.bCursor = TRUE

      CASE  72    ' H

         gtSuperInkey.sExt = "ArrowUp"
         gtSuperInkey.bArrow = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  73    ' I

         gtSuperInkey.sExt = "PageUp"
         gtSuperInkey.bCursor = TRUE

      CASE  74    ' J

         gtSuperInkey.sExt = "Alt+KeyPadMinus"
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bKeyPad = TRUE

      CASE  75    ' K

         gtSuperInkey.sExt = "ArrowLeft"
         gtSuperInkey.bArrow = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  76  ' L

         gtSuperInkey.sExt = "KeyPad5"
         gtSuperInkey.bKeyPad = TRUE

      CASE  77    ' M

         gtSuperInkey.sExt = "ArrowRight"
         gtSuperInkey.bArrow = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  78    ' N

         gtSuperInkey.sExt = "Alt+KeyPadPlus"
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bKeyPad = TRUE

      CASE  79    ' O

         gtSuperInkey.sExt = "End"
         gtSuperInkey.bCursor = TRUE

      CASE  80    ' P

         gtSuperInkey.sExt = "ArrowDown"
         gtSuperInkey.bArrow = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  81    ' Q

         gtSuperInkey.sExt = "PageDown"
         gtSuperInkey.bCursor = TRUE

      CASE  82    ' R

         gtSuperInkey.sExt = "Insert"

      CASE  83    ' S

         gtSuperInkey.sExt = "Delete"

      CASE  84  TO  93     ' T - Z | [ | \ | ]  = Shift+F1 to Shift+F10

         gtSuperInkey.sExt = "Shift+F" + LTRIM$ (STR$ (gtSuperInkey.nExtASC - 83))
         gtSuperInkey.bShift = TRUE
         gtSuperInkey.bFunc = TRUE

      CASE  94  TO  103    ' ^ | _ | ` | a - g  = Ctrl+F1 to Ctrl+F10

         gtSuperInkey.sExt = "Ctrl+F" + LTRIM$ (STR$ (gtSuperInkey.nExtASC - 93))
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bFunc = TRUE

      CASE  104  TO  113      ' h - q  = Alt+F1 to Alt+F10

         gtSuperInkey.sExt = "Alt+F" + LTRIM$ (STR$ (gtSuperInkey.nExtASC - 103))
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bFunc = TRUE

      CASE  114      ' r == Unknown KeyPad value

         gtSuperInkey.sExt = "Ctrl+KeyPad? (r)"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bKeyPad = TRUE

      CASE  115      ' s

         gtSuperInkey.sExt = "Ctrl+ArrowLeft"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bArrow = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  116      ' t

         gtSuperInkey.sExt = "Ctrl+ArrowRight"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bArrow = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  117      ' u

         gtSuperInkey.sExt = "Ctrl+End"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  118      ' v

         gtSuperInkey.sExt = "Ctrl+PageDown"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  119      ' w

         gtSuperInkey.sExt = "Ctrl+Home"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  120  TO  128      ' x - z | { |  '|'  | } | ~ |  ¦ (DEL)  | Ç  = Alt+1 TO Alt+9

         gtSuperInkey.sExt = "Alt+" + LTRIM$ (STR$ (gtSuperInkey.nExtASC - 119))
         gtSuperInkey.bAlt = TRUE

      CASE  129      ' ü

         gtSuperInkey.sExt = "Alt+0"
         gtSuperInkey.bAlt = TRUE

      CASE  130      ' é

         gtSuperInkey.sExt = "Alt+-"
         gtSuperInkey.bAlt = TRUE

      CASE  131      ' â

         gtSuperInkey.sExt = "Alt+="
         gtSuperInkey.bAlt = TRUE

      CASE  132      ' ä

         gtSuperInkey.sExt = "Ctrl+PageUp"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  133      ' à

         gtSuperInkey.sExt = "F11"
         gtSuperInkey.bFunc = TRUE

      CASE  134      ' å

         gtSuperInkey.sExt = "F12"
         gtSuperInkey.bFunc = TRUE

      CASE  135      ' ç

         gtSuperInkey.sExt = "Shift+F11"
         gtSuperInkey.bShift = TRUE
         gtSuperInkey.bFunc = TRUE

      CASE  136      ' ê

         gtSuperInkey.sExt = "Shift+F12"
         gtSuperInkey.bShift = TRUE
         gtSuperInkey.bFunc = TRUE

      CASE  137      ' ë

         gtSuperInkey.sExt = "Ctrl+F11"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bFunc = TRUE

      CASE  138      ' è

         gtSuperInkey.sExt = "Ctrl+F12"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bFunc = TRUE

      CASE  139      ' ï

         gtSuperInkey.sExt = "Alt+F11"
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bFunc = TRUE

      CASE  140      ' î

         gtSuperInkey.sExt = "Alt+F12"
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bFunc = TRUE

      CASE  141      ' ì

         gtSuperInkey.sExt = "Ctrl+ArrowUp"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bArrow = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  142      ' Ä

         gtSuperInkey.sExt = "Ctrl+KeyPadMinus"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bKeyPad = TRUE

      CASE  143      ' Å

         gtSuperInkey.sExt = "Ctrl+KeyPad5"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bKeyPad = TRUE

      CASE  144      ' É

         gtSuperInkey.sExt = "Ctrl+KeyPadPlus"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bKeyPad = TRUE

      CASE  145      ' æ

         gtSuperInkey.sExt = "Ctrl+ArrowDown"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bArrow = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  146      ' Æ

         gtSuperInkey.sExt = "Ctrl+Insert"
         gtSuperInkey.bCtrl = TRUE

      CASE  147      ' ô

         gtSuperInkey.sExt = "Ctrl+Delete"
         gtSuperInkey.bCtrl = TRUE

      CASE  148      ' ö

         gtSuperInkey.sExt = "Unknown:" + STR$ (gtSuperInkey.nExtASC) + " = " + CHR$ (gtSuperInkey.nExtASC)

      CASE  149      ' ò

         gtSuperInkey.sExt = "Ctrl+KeyPadSlash"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bKeyPad = TRUE

      CASE  150      ' û

         gtSuperInkey.sExt = "Ctrl+KeyPadAsterisk"
         gtSuperInkey.bCtrl = TRUE
         gtSuperInkey.bKeyPad = TRUE

      CASE  151      ' ù

         gtSuperInkey.sExt = "Alt+Home"
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  152      ' ÿ

         gtSuperInkey.sExt = "Alt+ArrowUp"
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bArrow = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  153      ' Ö

         gtSuperInkey.sExt = "Alt+PageUp"
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  154      ' Ü

         gtSuperInkey.sExt = "Unknown:" + STR$ (gtSuperInkey.nExtASC) + " = " + CHR$ (gtSuperInkey.nExtASC)

      CASE  155      ' ¢

         gtSuperInkey.sExt = "Alt+ArrowLeft"
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bArrow = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  156      ' £

         gtSuperInkey.sExt = "Unknown:" + STR$ (gtSuperInkey.nExtASC) + " = " + CHR$ (gtSuperInkey.nExtASC)

      CASE  157      ' ¥

         gtSuperInkey.sExt = "Alt+ArrowRight"
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bArrow = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  158      ' P

         gtSuperInkey.sExt = "Unknown:" + STR$ (gtSuperInkey.nExtASC) + " = " + CHR$ (gtSuperInkey.nExtASC)

      CASE  159      ' ƒ

         gtSuperInkey.sExt = "Alt+End"
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  160      ' á

         gtSuperInkey.sExt = "Alt+ArrowDown"
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bArrow = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  161      ' í

         gtSuperInkey.sExt = "Alt+PageDown"
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bCursor = TRUE

      CASE  162      ' ó

         gtSuperInkey.sExt = "Alt+Insert"
         gtSuperInkey.bAlt = TRUE

      CASE  163      ' ú

         gtSuperInkey.sExt = "Alt+Delete"
         gtSuperInkey.bAlt = TRUE

      CASE  164      ' ñ

         gtSuperInkey.sExt = "Alt+KeyPadSlash"
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bKeyPad = TRUE

      CASE  165      ' Ñ

         gtSuperInkey.sExt = "Unknown:" + STR$ (gtSuperInkey.nExtASC) + " = " + CHR$ (gtSuperInkey.nExtASC)

      CASE  166      ' ª

         gtSuperInkey.sExt = "Alt+KeyPadEnter"
         gtSuperInkey.bAlt = TRUE
         gtSuperInkey.bKeyPad = TRUE

      CASE  167  TO  255      ' unknown character sequences

         gtSuperInkey.sExt = "Unknown:" + STR$ (gtSuperInkey.nExtASC) + " = " + CHR$ (gtSuperInkey.nExtASC)

      CASE  ELSE

         gtSuperInkey.sExt = "Unknown Other:" + STR$ (gtSuperInkey.nExtASC)

      END SELECT ' gtSuperInkey.nExtASC

      gtSuperInkey.sName = gtSuperInkey.sExt
   END IF

   sChar = gtSuperInkey.sChar

   IF  gtSuperInkey.bNull  THEN _
      sChar = ""

   superInkey$ = sChar

END FUNCTION ' superInkey$


FUNCTION  superEntry$ ( _
   psDefault      AS STRING, _
   psLastEntry    AS STRING, _
   psDelimiters   AS STRING, _
   pnOptions      AS INTEGER, _
   pnMaxChars     AS INTEGER _
)

' superEntry$  = Returns text input via keyboard with extended functionality
'  psDefault      = Default value (initial value and accessed via ArrowDown cursor key)
'  psLastEntry    = Last Entry (accessed via ArrowUp cursor key)
'  psDelimiters   = Allowed delimiters to end input (defaults to CR/ENTER)
'  pnOptions      = Various entry options (power of 2 values -- see SUPER_ENTRY_* options)
'  pnMaxChars     = Maximum number of characters allowed for entry, zero = unlimited (see SUPER_ENTRY_MAXCR option)
'
' Supported key functions:
'  Cursor/Movement:  Home, End, Left, Right
'  Editing:          BACKSPACE, DELETE
'     Ctrl+X:        Clear entry
'     Ctrl+C:        Copy whole line to clipboard
'     Ctrl+V:        Paste clipboard to cursor position
'     Ctrl+Z:        One-level Undo/Redo toggle
'
' Preserves foreground color
'
' Expects:
'
'     Global    gtSuperInkey     ' global variable defined as a typeSuperInkey TYPE
'
'     Global    C_CR       ' constant Carriage Return (ENTER)
'     Global    C_BS       ' constant Backspace
'     Global    C_CUR_UP   ' constant Cursor Up character string code
'     Global    C_CUR_DN   ' constant Cursor Down character string code
'     Global    C_CUR_LFT  ' constant Cursor Left character string code
'     Global    C_CUR_RGT  ' constant Cursor Right character string code

'     CONST SUPER_ENTRY_NOOPT  = 0  ' no options selected (powers of 2 that can be OR'ed or added together)
'     CONST SUPER_ENTRY_UCASE  = 1  ' convert all input alpha to uppercase
'     CONST SUPER_ENTRY_SHADO  = 2  ' treat default value like shadow text (darker text that disappears when you type)
'     CONST SUPER_ENTRY_PASWD  = 4  ' password entry mode = show entry chars as asterisks ("*")
'     CONST SUPER_ENTRY_MAXCE  = 8  ' auto-return when maximum number of characters entered ("full field entry")
'                                         Delimiter is always set to special "MAX" when this occurs
'                                         Other delimiters allowed for "early entry", or blank requires all chars
'
'  Calls superInkey$() function
'  REQUIRES beepAlert() SUB routine
'  REQUIRES CONST FALSE = 0, TRUE = NOT FALSE in global program
'
' Use  LOCATE , , 1  or variation to display the cursor for INKEY$

   DIM sChar               AS STRING      ' the entry character from superInkey$
   DIM nPosition           AS INTEGER     ' the current cursor entry position
   DIM sText               AS STRING      ' the resultant entered text
   DIM nStartColumn        AS INTEGER     ' the start column for first entry character
   DIM nMaxEntry           AS INTEGER     ' maximum characters allowed to be entered based on screen width
   DIM sUndoText           AS STRING      ' simple undo toggle text
   DIM sLastKeypress       AS STRING      ' last key pressed
   DIM sPaste              AS STRING      ' working value for paste routine
   DIM nChar               AS INTEGER     ' working value for paste routine
   DIM blnOptUpperCase     AS INTEGER     ' boolean TRUE/FALSE for uppercase only entry set via options
   DIM blnOptShadowText    AS INTEGER     ' boolean TRUE/FALSE for default shadow text set via options
   DIM blnOptPassword      AS INTEGER     ' boolean TRUE/FALSE for password * display entry set via options
   DIM blnOptMaxEntry      AS INTEGER     ' boolean TRUE/FALSE for maximum char entry auto-return set via options
   DIM nColor              AS INTEGER     ' default foreground color upon entry


   blnOptUpperCase = ((pnOptions AND SUPER_ENTRY_UCASE) <> 0)     ' convert all alpha to uppercase
   blnOptShadowText = ((pnOptions AND SUPER_ENTRY_SHADO) <> 0)    ' treat default value as shadow text (reset as mode turn off)
   blnOptPassword = ((pnOptions AND SUPER_ENTRY_PASWD) <> 0)      ' password entry mode = show entry chars as asterisks ("*")
   blnOptMaxEntry = ((pnOptions AND SUPER_ENTRY_MAXCE) <> 0)      ' for maximum char entry auto-return

   nStartColumn = POS (0)     ' starting position of cursor after prompt
   nColor = _DEFAULTCOLOR     ' save current foreground color

   nMaxEntry = _WIDTH (0) - nStartColumn - 1    ' maximum line entry length is based on window width

   IF  pnMaxChars > 0  THEN      ' use Max Chars if specified -- hereafter use the Max Entry value
      IF  nMaxEntry > pnMaxChars  THEN _
         nMaxEntry = pnMaxChars     ' set maximum entry to requested value if non-zero and less than max-max

   ELSE
      blnOptMaxEntry = FALSE     ' turn off mode if no value set
   END IF

   IF  psDelimiters = ""  AND  NOT (blnOptMaxEntry)  THEN _
      psDelimiters = C_CR     ' default to CR/ENTER as delimiter if none specified, UNLESS Max Entry mode

   IF  blnOptShadowText  THEN    ' show shadow text if requested, maxed to Max Entry length
      sText = ""     ' unnecessary but to make a point
      COLOR 8     ' dark gray shadow text color

      IF  blnOptPassword  THEN
         PRINT LEFT$ (STRING$ (LEN (psDefault), "*"), nMaxEntry);

      ELSE
         PRINT LEFT$ (psDefault, nMaxEntry);
      END IF

      COLOR nColor      ' restore foreground color

   ELSE
      sText = LEFT$ (psDefault, nMaxEntry)      ' preset text to default entry, maxed to length

      IF  blnOptPassword  THEN
         PRINT STRING$ (LEN (sText), "*");

      ELSE
         PRINT sText;
      END IF
   END IF

   nPosition = LEN (sText)    ' cursor position (0 = start of entry, LEN() = end)


   DO    ' main processing loop

      sChar = superInkey$     ' get a character or function key

      IF  blnOptUpperCase  THEN _
         sChar = UCASE$ (sChar)

      SELECT CASE  sChar

      CASE  ""    ' no keypress or extended keypress (F5, etc.)

         sChar = RTRIM$ (gtSuperInkey.sExt)     ' get extended character value

         IF  blnOptShadowText  AND  sChar <> ""  THEN    ' any keypress turns off shadow text mode
            LOCATE , nStartColumn
            PRINT SPACE$ (LEN (psDefault));
            blnOptShadowText = FALSE   ' turn off mode
            LOCATE , nStartColumn
         END IF

         SELECT CASE  sChar

         CASE  "ArrowUp"      ' select LAST ENTRY parameter value

            IF  sText <> psDefault  AND  sLastKeypress <> "ArrowUp"  THEN _
               sUndoText = sText    ' preserve last undo for better undo

            LOCATE , nStartColumn

            IF  sText <> ""  THEN
               PRINT SPACE$ (LEN (sText));
               LOCATE , nStartColumn
            END IF

            sText = LEFT$ (psLastEntry, nMaxEntry)

            IF  blnOptPassword  THEN
               PRINT STRING$ (LEN (sText), "*");

            ELSE
               PRINT sText;
            END IF

            nPosition = LEN (sText)

         CASE  "ArrowDown"    ' select DEFAULT parameter value

            IF  sText <> ""  AND  sLastKeypress <> "ArrowDown"  THEN _
               sUndoText = sText       ' preserve last undo for better undo

            LOCATE , nStartColumn

            IF  sText <> ""  THEN
               PRINT SPACE$ (LEN (sText));
               LOCATE , nStartColumn
            END IF

            sText = LEFT$ (psDefault, nMaxEntry)

            IF  blnOptPassword  THEN
               PRINT STRING$ (LEN (sText), "*");

            ELSE
               PRINT sText;
            END IF

            nPosition = LEN (sText)

         CASE  "ArrowLeft"    ' cursor left

            IF  nPosition > 0  THEN
               PRINT C_CUR_LFT;
               nPosition = nPosition - 1
            END IF

         CASE  "ArrowRight"      ' cursor right

            IF  nPosition < LEN (sText)  THEN
               PRINT C_CUR_RGT;
               nPosition = nPosition + 1
            END IF

         CASE  "Home"      ' go to beginning of line

            nPosition = 0
            LOCATE , nStartColumn

         CASE  "End"    ' go to end of line

            nPosition = LEN (sText)
            LOCATE , nStartColumn + nPosition

         CASE  "Delete"    ' delete char under cursor

            IF  sText <> ""  AND  sLastKeypress <> "Delete"  THEN _
               sUndoText = sText       ' preserve last undo for better undo

            IF  sText <> ""  AND  nPosition < LEN (sText)  THEN
               LOCATE , nStartColumn

               IF  nPosition = 0  THEN
                  sText = MID$ (sText, 2)

               ELSE
                  sText = LEFT$ (sText, nPosition) + MID$ (sText, nPosition + 2)
               END IF

               IF  blnOptPassword  THEN
                  PRINT STRING$ (LEN (sText), "*"); " ";

               ELSE
                  PRINT sText; " ";
               END IF

               LOCATE , nStartColumn + nPosition
            END IF

         END SELECT ' sChar (gtSuperInkey.sExt) -- extended character

      CASE  C_BS     ' Backspace - delete char to the left of the cursor

         IF  sText <> ""  AND  sLastKeypress <> C_BS  THEN _
            sUndoText = sText       ' preserve last undo for better undo

         IF  blnOptShadowText  THEN    ' any keypress turns off shadow text mode
            LOCATE , nStartColumn
            PRINT SPACE$ (LEN (psDefault));
            blnOptShadowText = FALSE      ' turn off mode
            LOCATE , nStartColumn

         ELSE
            IF  sText <> ""  AND  nPosition > 0  THEN
               LOCATE , nStartColumn
               sText = LEFT$ (sText, nPosition - 1) + MID$ (sText, nPosition + 1)
               nPosition = nPosition - 1

               IF  blnOptPassword  THEN
                  PRINT STRING$ (LEN (sText), "*"); " ";

               ELSE
                  PRINT sText; " ";
               END IF

               LOCATE , nStartColumn + nPosition
            END IF
         END IF

      CASE  CHR$ (3)    ' Ctrl+C -- Copy to copy-paste buffer

         IF  blnOptShadowText  THEN
            _CLIPBOARD$ = psDefault    ' doesn't clear shadow entry mode

         ELSE
            _CLIPBOARD$ = sText
         END IF

      CASE  CHR$ (22)      ' Ctrl+V -- Paste from copy-paste buffer

         IF  sText <> ""  AND  sLastKeypress <> CHR$ (22)  THEN _
            sUndoText = sText       ' preserve last undo for better undo

         IF  blnOptShadowText  THEN    ' any keypress turns off shadow text mode
            LOCATE , nStartColumn
            PRINT SPACE$ (LEN (psDefault));
            blnOptShadowText = FALSE      ' turn off mode
            LOCATE , nStartColumn
         END IF

         IF  LEN (sText + _CLIPBOARD$) > nMaxEntry  AND  NOT (blnOptMaxEntry)  THEN     ' large paste processing
            beepAlert
            LOCATE , nStartColumn

            IF  sText <> ""  THEN
               PRINT SPACE$ (LEN (sText));
               LOCATE , nStartColumn
            END IF

            COLOR 12    ' bright red
            sPaste = "Accept large text paste (Y/N)?"

            IF  LEN (sPaste) > nMaxEntry  THEN _
               sPaste = "Accept (Y/N)?"
            IF  LEN (sPaste) > nMaxEntry  THEN _
               sPaste = "Accept?"
            IF  LEN (sPaste) > nMaxEntry  THEN _
               sPaste = "(Y/N)?"
            IF  LEN (sPaste) > nMaxEntry  THEN _
               sPaste = "?"

            PRINT sPaste;
            sChar = UCASE$ (INPUT$ (1))

            COLOR nColor      ' restore foreground color
            LOCATE , nStartColumn
            PRINT SPACE$ (LEN (sPaste));

            IF  sChar = "Y"  THEN
               sText = _CLIPBOARD$

               IF  INSTR (psDelimiters, C_CR) > 0  THEN
                  sChar = C_CR      ' always use Enter/Carriage Return if available

               ELSE
                  sChar = LEFT$ (psDelimiters, 1)      ' otherwise use first delimiter as default
               END IF

            ELSE     ' will truncate paste using regular processing below
               sChar = CHR$ (22)    ' restore last keypress -- and allows fall into standard paste processing
               LOCATE , nStartColumn
               PRINT sText; " ";
               LOCATE , nStartColumn + nPosition      ' restore entry status
            END IF
         END IF

         IF  sChar = CHR$ (22)  AND  LEN (sText) < nMaxEntry  THEN    ' proceed if there is at least some space available
            sPaste = _CLIPBOARD$
            nChar = 1

            DO    ' remove control characters from pasted text

               IF  sPaste <> ""  THEN
                  IF  ASC (MID$ (sPaste, nChar, 1)) < 32  THEN
                     sPaste = LEFT$ (sPaste, nChar - 1) + MID$ (sPaste, nChar + 1)

                  ELSE
                     nChar = nChar + 1    ' reduction above doesn't increment
                  END IF
               END IF

            LOOP WHILE  nChar < LEN (sPaste)  AND  sPaste <> ""

            IF  LEN (sPaste) + LEN (sText) > nMaxEntry  THEN _
               sPaste = LEFT$ (sPaste, nMaxEntry - LEN (sText))      ' correct paste value if too long

            sText = LEFT$ (sText, nPosition) + sPaste + MID$ (sText, nPosition + 1)
            nPosition = nPosition + LEN (sPaste)

            LOCATE , nStartColumn

            IF  blnOptPassword  THEN
               PRINT STRING$ (LEN (sText), "*");

            ELSE
               PRINT sText;
            END IF

            LOCATE , nStartColumn + nPosition

         ELSE
            IF  sChar = CHR$ (22)  THEN _
               beepAlert      ' alert if not large paste buffer paste
         END IF

      CASE  CHR$ (24)      ' Ctrl+X (erase line)

         IF  sText <> ""  AND  sLastKeypress <> CHR$ (24)  THEN _
            sUndoText = sText       ' preserve last undo for better undo

         LOCATE , nStartColumn

         IF  blnOptShadowText  THEN    ' any keypress turns off shadow text mode
            PRINT SPACE$ (LEN (psDefault));
            blnOptShadowText = FALSE      ' turn off mode

         ELSE
            PRINT SPACE$ (LEN (sText));
         END IF

         LOCATE , nStartColumn

         sText = ""
         nPosition = 0

      CASE  CHR$ (26)      ' Ctrl+Z -- Undo/Redo toggle

         LOCATE , nStartColumn
         PRINT SPACE$ (LEN (sText));
         LOCATE , nStartColumn
         SWAP sText, sUndoText

         IF  blnOptPassword  THEN
            PRINT STRING$ (LEN (sText), "*");

         ELSE
            PRINT sText;
         END IF

         nPosition = LEN (sText)

      CASE  ELSE     ' any other keypress

         IF  gtSuperInkey.nAsc > 31  THEN    ' if not an ignored control character (or potential delimiter)
            IF  (sText <> ""  AND  sLastKeypress <> "KEYPRESS")  OR _
                  (LEN (sText) - LEN (sUndoText) > 5)  THEN _
               sUndoText = sText       ' preserve last undo for better undo (every N chars)

            IF  blnOptShadowText  THEN    ' any keypress turns off shadow text mode
               LOCATE , nStartColumn
               PRINT SPACE$ (LEN (psDefault));
               blnOptShadowText = FALSE      ' turn off mode
               LOCATE , nStartColumn
            END IF

            IF  LEN (sText) <= nMaxEntry  THEN
               sText = LEFT$ (sText, nPosition) + sChar + MID$ (sText, nPosition + 1)
               nPosition = nPosition + 1
               LOCATE , nStartColumn

               IF  blnOptPassword  THEN
                  PRINT STRING$ (LEN (sText), "*");

               ELSE
                  PRINT sText;
               END IF

               LOCATE , nStartColumn + nPosition

               sChar = "KEYPRESS"      ' to set sLastKeypress below

            ELSE
               beepAlert      ' maximum chars entered, no more entry allowed
            END IF
         END IF  ' if not a control char (or potential delimiter)

         IF  blnOptMaxEntry  AND  blnOptShadowText  AND  sChar = C_CR  THEN      ' special selection of shadow text
            blnOptShadowText = FALSE      ' turn off mode
            sText = LEFT$ (psDefault, nMaxEntry)
            LOCATE , nStartColumn
            PRINT sText;
            nPosition = LEN (sText)    ' set status in case default value length is too short
         END IF

      END SELECT ' sChar

      _LIMIT 30      ' slow down loop processing

      IF  sChar <> ""  THEN _
         sLastKeypress = sChar

   LOOP UNTIL  (sChar <> ""  AND  INSTR (psDelimiters, sChar) > 0)  OR _
                  (blnOptMaxEntry  AND  LEN (sText) = nMaxEntry)

   IF  blnOptShadowText  THEN    ' if mode was never reset, clear display
      LOCATE , nStartColumn
      PRINT SPACE$ (LEN (psDefault));
      LOCATE , nStartColumn
   END IF

   IF  blnOptMaxEntry  AND  LEN (sText) = nMaxEntry  THEN _
      sChar = "MAX"     ' special delimiter for max chars entered

   psDelimiters = sChar    ' return the delimiter that ended input

   superEntry$ = sText

END FUNCTION ' superEntry$

' end of program