'TOKENIZE file tokenizer   Version 23

'Last update 12/28/2018.   Version 23 adds ENTER as an option to use
'same input file NAME.DO with extension changed to .BA

'Lots of code and program flow translated from Ken Pettit's "file.cpp".
'Tried to to keep it simple: get one line from the input file at a time
'and tokenize one line at a time, then go back for another line.

' THANKS to my Beta Testers and mentors along the way:
' Ken Pettit -  not working with text files without CRs, only LFs at ends of lines
' Mike Stein pointed out errors with capitalization and colons and
' he provided example programs where the tokenization failed
' Fixed the code accordingly.

#COMPILE EXE
#DIM ALL
#BREAK ON
#DEBUG DISPLAY ON
#DEBUG ERROR ON
%TRUE = -1
%FALSE = 0
'---------------------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG
CONSOLE SET SCREEN 25, 68 'col number wide enough for Help text lines
CONSOLE NAME "Model T Tokenizer       TOKENIZE.EXE         R.H.Pigford (c) 2010"

GLOBAL Pad_Len AS INTEGER
GLOBAL line_len AS WORD  '*this is the length of the new line as well as the
                         'number of the character in the tok_line array
DIM tok_string(1 TO 128) AS GLOBAL STRING   '*array of the keywords by
                         'element number = token number
DIM xPtr(127) AS GLOBAL DWORD POINTER  '*array of pointers to Keyword strings
DIM hlp_line(1 TO 255) AS GLOBAL STRING '*help text array, one element before
                                         'line of text
GLOBAL fn_in, fn_out, fn_hlp, TestString, Dummy AS STRING
GLOBAL z AS INTEGER 'z is the number of Help_txt lines LINE INPUTed
                    ' used by Load_hlp and Help_txt
GLOBAL aa  AS STRING 'used by Scroll_Files, Type_Output, and Look_4_F1
GLOBAL f1_flag AS BYTE
GLOBAL fCom, gCom, hCom  AS BYTE ' fCom is input file, gCom is output file,
                                 ' hCom is helpfile name
DIM Pad_Files(200) AS GLOBAL STRING

fn_hlp = "tokenize.hlp"
CALL Load_help  'use LINE INPUT to get text lines into an array

Start:
    CALL Token_array  'to populate tok_string() array with keywords
    CLS
    COLOR 14, 9 'foreground, background
    CLS: LOCATE 1, 1:COLOR 1, 14
    PRINT" +----------------------------------------------------------+"
    PRINT" +      TOKENIZE.EXE v23   by Bob Pigford  (c)2010          +"
    PRINT" +    for Radio Shack Model 100/102/200 laptop comuters     +"
    PRINT" +----------------------------------------------------------+"
    COLOR 14,9
    PRINT
    PRINT" TOKENIZE.EXE takes an ASCII listing ( .DO file) of a Model T"
    PRINT" BASIC program and converts it into a TOKENIZED .BA file"
    PRINT" suitable for direct loading and running in a Model T."
    PRINT
    PRINT" Use UP/DN arrows to select
    PRINT" input file, then ENTER"
    LOCATE 24,10:PRINT"F1 for HELP                 ESC to Quit";

CURSOR OFF
    CALL GetFileNames  'do a dir and put filenames into sorted array GoodFiles()
    CALL Scroll_Files ' leave here with fn_in selected
    IF f1_flag = 1 THEN 'have been to help screens, so start over
        f1_flag = 0
        GOTO Start
    END IF
    CALL Type_Output ' type an output file name
    IF f1_flag = 1 THEN 'have been to help screens, so start over
        f1_flag = 0
        GOTO Start
    END IF
    CALL open_in  'OPEN the input file
    CALL open_out 'OPEN the output file
    CALL Do_A_File 'where all the magic happens, creates a tokenized file
GOTO Start

END FUNCTION
'---------------------------------------------------------------------------------

SUB Type_Output
' exit knowing fn_out
LOCAL a, Dummy, K, Delay AS STRING
LOCAL t AS DWORD
LOCAL tick AS LONG
'LOCAL KeyFlag as bYTE
FirstScr:
    PRINT: LOCATE 13,30
    PRINT"Right ARROW to use input filename as"
    PRINT:LOCATE 14,30:
    PRINT "output filename, or"
    PRINT: LOCATE 15,30
    PRINT"type output FILNAM.BA, then ENTER" ' the name of the OUTPUT to be
                                             ' tokenized into a  .BA file"
    fn_out = ""
SecondScr:
    LOCATE 16,30: COLOR 15,0: PRINT STRING$(9," ") 'black text box
    LOCATE 16,30
    CURSOR ON
Check_out:
    WAITSTAT
    a = INKEY$   'as characters are typed, always check that f1 might have been pushed
    aa = a 'prepare for look_4_f1
'    a = UCASE$(a)  'convert to upper case for ModelT file naming convention
    CURSOR OFF
    CALL look_4_f1
        IF f1_flag = 1 THEN   'f1 had been pushed and help lines were shown/scrolled
            EXIT SUB    'because the main loop will test for f1_flag and reset it to 0
        END IF
    IF a = CHR$(13) THEN Check_out1  'to type in a new output filename

    IF LEN(a) = 2 THEN
        K = RIGHT$(a,1)
        IF K = CHR$(77) THEN  'rt arrow
            Dummy =  fn_in
            MID$(Dummy,-2,2) = "BA"
            fn_out =  UCASE$(Dummy)
            K = ""
            LOCATE 16,30
            COLOR 15,0
            PRINT STRING$(LEN(fn_out)+1, " ")
            LOCATE 16,30
            PRINT fn_out

            GOTO Check_out1
        END IF
    END IF

    IF a = CHR$(27) THEN END

'now build a fn_out name one letter at a time
    fn_out = fn_out + a
    fn_out = UCASE$(fn_out) 'convert name to upper case

    IF LEFT$(fn_out,1) < CHR$(65) THEN  'it is not legal first chr,
        BEEP                            'it must be a letter
        LOCATE 20, 20:CURSOR OFF
        PRINT" First character in name must be a letter!"
        SLEEP 3000
        COLOR 14,9
        LOCATE 20,20: PRINT STRING$(42, " ")
        fn_out = ""
        a = ""
        GOTO SecondScr
    END IF

    IF a = CHR$(8)  THEN 'backspace
        fn_out = LEFT$(fn_out, LEN(fn_out)-2)
    END IF
    a = "" 'not sure if I need this or not, so leave it in
    LOCATE 16,30
    COLOR 15,0
    PRINT STRING$(LEN(fn_out)+1, " ")  'black out the input bar
    LOCATE 16,30
    PRINT fn_out
GOTO Check_out   'keep looping and looking at each keypress
Check_out1:

    COLOR 14, 9
    LOCATE 17,30
    PRINT"Is this correct?  Y/N "
Check_out2:
    a = INKEY$
    aa = a
    CALL look_4_f1
        IF f1_flag = 1 THEN
            EXIT SUB
        END IF
    IF a="" THEN
        GOTO Check_out2
    END IF
    IF a = CHR$(27) THEN
        END  'quit the program
    END IF
    IF(a = "Y") OR (a = "y") THEN
        a = ""
        IF LEN (fn_out) = 0 THEN
            BEEP
            LOCATE 17,30:PRINT STRING$(22," ")
            GOTO SecondScr
        END IF

' need to be sure the ext is .BA here

        EXIT SUB
    ELSE
            fn_out = ""
            a = ""
            COLOR 14, 9
            LOCATE 17,30
            PRINT STRING$(22," ")
            LOCATE 16,30
            COLOR 15,0
            PRINT STRING$(10, " ")
            LOCATE 16,30
            GOTO SecondScr
    END IF

    GOTO Check_out

END SUB

'===============================================================
SUB Do_A_File
' use c = character position in line being examined
' get a line from the ascii BASIC listing, one character at a time
' Build new line one character at a time and embed address
' bytes of next line following the format:
'   2 bytes     hex address of line number to follow
'               Start with a base_addr reference address
'               When loaded into ModelT, OS will adjust
'               next line addresses
'               M100 lowest addr = 32768
'               T200 lowest addr = 40960
'               So use base_addr = 40960
'
'   2 bytes     current line number (hex format)
'   Numerout bytes including high ascii bytes as tokens
'   1 byte      Null (00h) as end of line character
DIM tok_line(1 TO 30000) AS STRING '*this is the new line of chrs built
                         'with next line address (offsets), line number,
                         'and tokens or text
DIM cPtr(32768) AS DWORD POINTER '*array of pointers to each char of line_in
LOCAL line_hi, line_lo, c, ad_hi, ad_lo AS WORD
LOCAL tok_len, line_num_len, line_in_lth AS WORD
LOCAL  base_addr, next_addr AS WORD
LOCAL line_num, first_line AS WORD
DIM test_line(1 TO 32768) AS LOCAL STRING
LOCAL tok_mem, char_mem AS DWORD
LOCAL in_line, a AS STRING
LOCAL x AS INTEGER
LOCAL done_num, token_num, counter, quote_flag, data_flag  AS BYTE
first_line = 1
base_addr =  40960 'A000h = 40960 dec for testing - could use 0 and it would still work
                   'because BASIC resets these addresses when FILMAN.BA is loaded to run
c = 1
done_num = 0 'not done first line numbers yet
WHILE ISFALSE EOF(#fCom)    'keep going until end of file (EOF)
                            'make one LONG string from all the text chrs
    LINE INPUT #fCom, in_line 'get a full line of chrs up to CR/LF but w/o the CR/LF
    IF LEN(in_line) = 0 THEN  End_of_line
    in_line = in_line + CHR$(13) ' add a CR as end of line marker
    line_in_lth = LEN(in_line)
    IF line_in_lth = 0 THEN
                PRINT "TEXT ILL FORMED"
                CLOSE
                CALL Wait_key
                CLOSE #fCom 'GOTO Start
                EXIT SUB
    END IF
   'create an input array
    FOR x = 1 TO line_in_lth
        test_line(x) = MID$(in_line, x, 1) '(str, start pos, no. of characters to pull)
    NEXT x 'OK, now we have a string array from the input .DO file

'CAPITALIZE line_in, character by character *******************************************
' capitalize character in array unless told not to by any flag = 1
    quote_flag = 0
    data_flag = 0
    FOR x = 1 TO line_in_lth  'find quotes that start and end quoted strings [was 5 TO]
        IF test_line(x) = "'" THEN
            GOTO Caps_done   'all done for this line!
        END IF
        'Look for REM
        IF test_line(x) = "M" AND test_line(x-1) = "E" AND test_line(x-2) = "R" THEN
            GOTO Caps_done   'all done for this line!
        END IF
        'look for DATA statements
        IF test_line(x) = "A" AND test_line(x-1) = "T" AND test_line(x-2) = "A" _
            AND test_line(x-3) = "D" THEN
            data_flag = 1  'set the data strings flag
            GOTO No_cap    'treat all after a DATA statment line a rem, until a :
        END IF
        IF test_line(x) = ":" AND data_flag = 1  THEN
            data_flag = 0  'reset the data strings flag
            GOTO Yes_cap   're-start capitalizing when : follows a DATA statement
        END IF
        IF test_line(x) = CHR$(34) AND data_flag = 0 AND quote_flag = 0 THEN
            ' we found the first " AND we are not in the middle of a DATA statement
            quote_flag = 1 'set the flag
            GOTO No_cap    'so don't capitalize it until we find a second " or :
        END IF
        IF test_line(x) = CHR$(34) AND quote_flag = 1 AND data_flag = 0 THEN
            'we found the second " AND we are not in the middle of a DATA statment
            quote_flag = 0 'reset the flag
            GOTO Yes_cap   'capitalize it
        ELSEIF test_line(x) = ":" AND quote_flag = 1 AND data_flag = 0 THEN
            'found a terminating : AND we are not on the middle of a DATA statement
            quote_flag = 0
            GOTO Yes_cap  'capitalize it
        END IF
Yes_cap:    'if we got here then the char was found to need caps (and not otherwise
            'flagged for non-caps is to be capitalized, so cap it
        IF quote_flag = 0 AND data_flag = 0 THEN
            test_line(x) = UCASE$(test_line(x))
        END IF
No_cap:     'leave it alone, do not force capitalization, just go on to the next char
    NEXT x
Caps_done:

'*************************************************************************************
    'create capitalized input string pointer array
    FOR x = 1 TO line_in_lth
        cPtr(x) = VARPTR(test_line(x))
    NEXT x
  'find line number of this line, should be first characters
  line_num_len = 0
  done_num = 0
  line_num = 0
  c = 1
  CLS
  DO 'done_num = 0
    IF (test_line(c) > "/") AND (test_line(c) < ":") THEN  'means it IS a number from "0" thru "9"
        'add the text character's value to line number
        line_num = line_num * 10 + (VAL(test_line(c)) )
        INCR c
    END IF

    IF test_line(c) =  " " THEN  'its a space, just jump over it
        INCR c
    END IF

    IF test_line(c) < "0" OR test_line(c) > "9" THEN
        'no more numbers, set done_flag
        'c points to the next chr after the line numbers
        done_num = 1 ' done the numbers
    END IF

  LOOP UNTIL done_num = 1 'fall through leaving c = number of next chr after line number

  line_hi = INT(line_num / 256)       ' get hi byte
  line_lo = INT(line_num - (256 * line_hi))   ' get lo byte
  tok_line(3) = CHR$(line_lo)
  tok_line(4) = CHR$(line_hi)
'=========================  Start  BIG LOOP        ================================
'start to tokenize this string, keep going until line_in_len all done or found CHR$(13)
'start where the value of c arrives following the line number search above
line_len = 5  'line_len = the element counter for the tok_line array of characters
WHILE test_line(c) <> CHR$(13)  ' line_in_lth
    ' this is the BIG LOOP that looks at each character in test_line(c) and
    ' decides what to do with it.
    ' c = next input character after the line number is found and extra spaces removed.
    ' go thru each character in the test_line(c) and look for tokens.
    ' if none found, just add character to tok_line().
    ' But first, test for ?,  ',   >127,  ",  chr$(13), and REM

    IF test_line(c) = "?" THEN
        token_num = 163  'token for PRINT = 163
        tok_line(line_len) = CHR$(token_num) 'stick in a PRINT token
        INCR line_len
        INCR c
        GOTO Bottom 'any subsequent token test of this character not needed

    ELSEIF test_line(c) = "'" THEN  'CHR$(39)  and per Ken Pettit, it is
        tok_line(line_len) = ":"    'done this way so that when LISTed, a tick will
        INCR line_len               'be correctly shown as a tick, not a REM
        tok_line(line_len) = CHR$(142)  'REM token number 142d = 8Eh
        INCR line_len
        tok_line(line_len) = CHR$(255)
        INCR line_len
        INCR c
       'copy bytes to tok_line until end of line where  test_line(c) = chr$(13)
           WHILE test_line(c) <> CHR$(13)
                tok_line(line_len) = test_line(c)
                INCR line_len
                INCR c
           WEND
        GOTO Bottom 'any subsequent token test of this character not needed

    'check for routine numbers or : or ;, just add them to tok_line() as is
    ELSEIF test_line(c) >= "0" AND test_line(c) <= ";" THEN
        tok_line(line_len) = test_line(c)
        INCR line_len
        INCR c
        GOTO Bottom 'any subsequent token test of this character not needed
    ELSEIF ASC(test_line(c)) > 127 THEN     'if the ascii value of this character is > 127
        INCR c   'just skip over it
        GOTO Bottom 'any subsequent token test of this character not needed

    ELSEIF test_line(c) = CHR$(34) THEN      'found a " (quote mark)
        'then look at next chr after the "
        tok_line(line_len) = CHR$(34) 'put the quote into the new tok_line
        INCR line_len
        INCR c    'ready to look at next char
            'while this next char is not ", or : or end of the line
            WHILE test_line(c) <> CHR$(34) AND test_line(c) <> ":" AND test_line(c) <> CHR$(13)
                tok_line(line_len) = test_line(c) 'build the tok_line until seeing a 13 or :
                INCR line_len
                INCR c
            WEND'if we fall through to here because of finding another " or : or exceed line_in_lth
                 'then look at the next c deal with it from the top again
            IF test_line(c) = CHR$(34) OR test_line(c) = ":" THEN
                tok_line(line_len) = test_line(c)
                INCR line_len
                INCR c
            END IF
        GOTO Bottom 'any subsequent token test of this character not needed
    END IF  'end of the big ELSEIF loop

'TEST FOR TOKENS ==================================================================
    'If the char was not any of those things, check for tokens.
    'Enter here with c pointing to the next char in line after the tests above.
    'Do not increment c unless a token is found because
    'the character at c might be the start of a token key word.

    char_mem = PEEK(@cPtr(c))    'get the byte pointed to by cPtr
    FOR token_num = 1 TO 127    'prepare to go through all token strings
        'use each token string's length as test for counter value
        tok_len = LEN(tok_string(token_num))
        'get the byte pointed to by xPtr for this token key text
        FOR counter = 1 TO tok_len
            tok_mem = PEEK((@xPtr(token_num) + counter - 1)) 'get byte at this mem pointer
            char_mem = PEEK(@cPtr(c+ counter -1 ))  'get byte at this mem pointer
               IF tok_mem <> char_mem THEN      'IF ISFALSE (tok_mem - char_mem) THEN
                   GOTO xxx
               ELSEIF tok_mem = char_mem AND counter = tok_len THEN   'found a match
                   GOTO Match
               END IF
        NEXT counter

        'Insert token tests here:
Match:  'Need to add ":" prior to ELSE if not already there,
        'ELSE token = 18 + 127 = 145 = 0x91 = 91h
        IF token_num = 18 AND tok_line(line_len - 1) <> ":" THEN
            tok_line(line_len) = ":"
            INCR line_len ' but do not INCR c
        END IF

        'add the found token to the tok_line
        tok_line(line_len) = CHR$(token_num + 127)  'stuff the high ascii
                                                    'token value into the new line
        INCR line_len
        c = c + LEN(tok_string(token_num)) ' jump over the rest of the chars in
                                           ' the token name ascii
                                           ' text found in test_line(c)

        'if found REM token, copy rest of chrs to tok_line until end of line
        IF token_num = 15 THEN   'test for 15 = 142 - 127
            WHILE test_line(c) <> CHR$(13)  ' line_in_lth
                tok_line(line_len) = test_line(c)
                INCR line_len
                INCR c
            WEND
            GOTO Bottom 'Next_line  'because we should be at the end of the line
                                    'by now anyway
        END IF

        'if found DATA token, copy rest of chrs to tok_line as is until
        'end of line OR a colon
        IF token_num = 4 THEN  'test for 4 = 131 - 127
            WHILE test_line(c) <> ":" AND test_line(c) <> CHR$(13) ' line_in_lth
                tok_line(line_len) = test_line(c)
                INCR line_len
                INCR c
            WEND
            GOTO Bottom
        END IF
        GOTO Bottom 'because WE FOUND A TOKEN, so don't go on to Just_a_char
xxx:
    NEXT token_num  ' try the next token text

'Just_a_char:   'so add it to the tok_line and go back for more
    tok_line(line_len) = test_line(c)
    INCR line_len
    INCR c


Bottom:
WEND  'go back for next c
'================== End of the BIG LOOP   =============================

Next_line:
tok_line(line_len) = NUL$(1) 'add a NULL to the end of each line
'CALL Calc_next_addr
GOSUB Calc_next_addr
'*************** OUTPUT TO FILE ******************
FOR x = 1 TO line_len
    PRINT #gCom, tok_line(x);
NEXT x

End_of_line:
WEND 'go back for the next full line in
' get here only if found EOF of the input file
CLOSE #fCom
CLOSE #gCom
'*************************************************
'print DONE and name of output file
CLS
PRINT "Filename    ";:COLOR 15,0:PRINT fn_in;:COLOR 14,9:PRINT" has been TOKENIZED."
PRINT "Output file ";:COLOR 15,0:PRINT fn_out;:COLOR 14,9:PRINT" is ready to use in your ModelT."
PRINT
PRINT"<ENTER> to Re-run "
PRINT"<ESC> to Quit"

Alldone:
    WAITSTAT
    A$= INKEY$
    IF a$ = CHR$(13) THEN
        fn_in = ""
        fn_out = ""
        EXIT SUB
    ELSEIF a$ = CHR$(27)THEN
        END
    END IF
GOTO Alldone

'put Calc_next_addr here as a SUBROUTINE
Calc_next_addr:
    IF first_line = 1 THEN
        next_addr = base_addr
        first_line = 0
        GOTO Calc1
    END IF
Calc1:
    next_addr = next_addr + line_len
    ad_hi = INT(next_addr/ 256)       'get hi byte
    ad_lo = INT(next_addr - (256 * ad_hi))  'ger lo byte
    tok_line(1) = CHR$(ad_lo)
    tok_line(2) = CHR$(ad_hi)
RETURN


END SUB  'end of the great big SUB Do_A_File that tokenizes and
        ' fills the output file

'==========================================================
SUB open_in      'open the input file
'   get_flag = 0
    ON ERROR GOTO bad_file
    fCom = FREEFILE
    OPEN fn_in FOR INPUT AS #fCom
    EXIT SUB
bad_file:
    CLS
    PRINT"Problem opening ";
    COLOR 15, 0:
    PRINT fn_in;
    COLOR 14, 9
    CLOSE 'close all files  so they can be reopened
'    get_flag = 1
    CALL Wait_key
END SUB
'===================================
SUB open_out
    'open the output file
    'at entry, fn_out is known
    ON ERROR GOTO no_open
    gCom = FREEFILE
    OPEN fn_out FOR OUTPUT AS #gCom
    EXIT SUB
no_open:
'    CLS
    LOCATE 14,35
    PRINT"Problem opening output file"
    CLOSE 'close all files so they can be re-opened
    CALL Wait_key
    LOCATE 14,35
    PRINT"                           "
END SUB
'===================================
SUB Wait_key
LOCAL a AS STRING
    PRINT"Any key to continue
    WAITSTAT
    a = INKEY$
        PRINT"                   "
END SUB
'================================================================================
SUB Token_array
LOCAL m AS INTEGER
FOR m = 1 TO 127
    tok_string(m) = READ$(m)

    'populate an array of string pointers
    xPtr(m) = VARPTR(tok_string(m)) 'get the memory address that points to the data
    ' This is used to look at successive characters starting at that address
NEXT m

DATA    "END","FOR","NEXT","DATA","INPUT","DIM","READ","LET"
DATA    "GOTO","RUN","IF","RESTORE","GOSUB","RETURN","REM","STOP"
DATA    "WIDTH","ELSE","LINE","EDIT","ERROR","RESUME","OUT","ON"
DATA    "DSKO$","OPEN","CLOSE","LOAD","MERGE","FILES","SAVE","LFILES"
DATA    "LPRINT","DEF","POKE","PRINT","CONT","LIST","LLIST","CLEAR"
DATA    "CLOAD","CSAVE","TIME$","DATE$","DAY$","COM","MDM","KEY"
DATA    "CLS","BEEP","SOUND","LCOPY","PSET","PRESET","MOTOR","MAX"
DATA    "POWER","CALL","MENU","IPL","NAME","KILL","SCREEN","NEW"
DATA    "TAB(","TO","USING","VARPTR","ERL","ERR","STRING$","INSTR"
DATA    "DSKI$","INKEY$","CSRLIN","OFF","HIMEM","THEN","NOT","STEP"
DATA    "+","-","*","/","^","AND","OR","XOR"
DATA    "EQV","IMP","MOD","\",">","=","<"
DATA    "SGN","INT","ABS","FRE","INP","LPOS","POS","SQR"
DATA    "RND","LOG","EXP","COS","SIN","TAN","ATN","PEEK"
DATA    "EOF","LOC","LOF","CINT","CSNG","CDBL","FIX","LEN"
DATA    "STR$","VAL","ASC","CHR$","SPACE$","LEFT$","RIGHT$","MID$"
'End of table marker
DATA    ""

END SUB
'=================================================================================
SUB Load_help

'z is a global integer as it is passed to  Help_txt

    ON ERROR GOTO hf_bad
    GOTO hf_good

hf_bad:
    CLS
    PRINT"Problem opening HELP file"
    CLOSE #hCom
    CALL Wait_key
    EXIT SUB

hf_good:
    hCom = FREEFILE
    z = 1
    OPEN fn_hlp FOR INPUT AS #hCom
        WHILE ISFALSE EOF(#hCom)    'keep going until end of file (EOF)
                            'make a string from each line of help file
            LINE INPUT #hCom, hlp_line(z)
            INCR z ' leave here with z = number of LINE INPUTed
        WEND
END SUB
'===============================================================================
SUB Help_txt
    'Upon entry, hlp_line(x) is an array of text lines
    'created from the fn_hlp file (tokenize.hlp)
    'and z = number of lines from Load_Help, so z needs to be GLOBAL
DIM line_strt AS INTEGER
DIM x AS INTEGER

DIM a AS STRING
DIM K AS STRING

    f1_flag = 1: a = ""
    COLOR 15, 2
    CLS
    CURSOR OFF
    LOCATE 1, 1
    line_strt = 1

Help_here:
    CLS
    LOCATE 1, 1    'row 1, col 1
    FOR x = 1 TO 22   'i
        PRINT hlp_line(x + line_strt - 1)
    NEXT x
    PRINT STRING$(64,"-")   ';
    PRINT"      UP Arrow         DOWN Arrow          ESC";

Help1:
    WAITSTAT
    a = INKEY$  ': IF a = "" THEN  Help1
    IF a =  CHR$(27) THEN   'back to start scrn
        a = ""
        GOTO Help_end
    END IF

    IF LEN(a) = 2 THEN
        K = RIGHT$(a,1)
        IF K = CHR$(72) THEN  'up arrow
            DECR line_strt
            GOSUB check_limits
        END IF

        IF K = CHR$(80) THEN
            INCR line_strt
            GOSUB check_limits
        END IF
        K = ""
    END IF
    a = ""
GOTO Help_here

check_limits:
    ' z = number of last element in the hlp_line array +1
    IF line_strt < 1 THEN
        line_strt = 1
    END IF
    IF line_strt >  (z - 22) THEN
        line_strt =  (z - 22)
    END IF
RETURN

Help_end:
    CURSOR ON
    CLOSE 'to avoid error trying to re-open an already open file later
END SUB
'=================================================================================
SUB look_4_f1
    IF LEN(aa) = 2 THEN
        IF aa = CHR$(0,59) THEN 'F1 was hit
           CALL Help_txt     'display/scroll help
           aa = ""
           EXIT SUB          'f1_flag is set to 1 in Help_txt
        END IF
    END IF

END SUB
'=================================================================================
SUB GetFileNames '(File() as STRING)
    'then make an array of sorted and padded filenames

DIM Files(200) AS LOCAL STRING
DIM GoodFiles(200) AS LOCAL STRING ' the array of non-NUL elements
    'Pad_Files()
DIM zz AS WORD    'DIM z AS WORD
DIM yy AS WORD   'DIM y AS WORD
DIM kk AS STRING
DIM NumFiles AS INTEGER
    NumFiles = 0
    Pad_Len = 0
LOCAL f, mask AS STRING
LOCAL v, j, t, xx, i AS INTEGER

    COLOR 1,14
    CURSOR ON
    LOCATE 1,1

GetFiles:
    'see page 244 in manual DIR$ for code example used below
    ' but DO NOT use DIR$ if any file in target directory has earlier
    ' been OPENed.

    mask = "*.DO"
    DIM x&, temp$

    x& = 0
    temp$ = DIR$(mask)
    'follows example from the manual for DIR$
    WHILE LEN(temp$) AND x& < 1000 'max = 1000
        INCR x&
        Files(x&) = temp$    ' in this code order we do
                            ' capture the first file
            IF LEN(temp$) > 9 THEN 'eliminate long filenames
                DECR x&            ' FILNAM.DO is 9 chrs max
            END IF
        temp$ = DIR$(NEXT)
    WEND

    DIR$ CLOSE
    'in the above WHILE loop, if no matching files are ever found,
    'x& will not have incremented above its start of 0, therefore
        IF x& = 0 THEN
            LOCATE 22, 3:CURSOR OFF
            PRINT" No .DO files found in current directory!"
            EXIT SUB
        END IF

    NumFiles = 0
    FOR j = 0 TO 200  'need way to NOT print elements that are empty
        IF Files(j) <> "" THEN
            GoodFiles(j) = Files(j) 'only occupied string elements
            INCR NumFiles
        END IF
    NEXT  j

    'SORT the array into order
    ARRAY SORT Files() FOR NumFiles, COLLATE UCASE, TAGARRAY GoodFiles(), ASCEND

    ' make a padded array from Files()
    FOR xx = 0 TO 3
        Pad_Files(xx) = "         "
    NEXT xx

    FOR xx = 4 TO NumFiles+4
        Pad_Files(xx) = GoodFiles(xx-3)
    NEXT xx

    FOR xx = NumFiles + 4 TO NumFiles + 7
        Pad_Files(xx) = "         "
    NEXT xx
'let's see what we got
'first find length = number of elements in Pad_Files()
    Pad_Len = 0
    LOCATE 1,1
    FOR xx = 0 TO NumFiles + 8
        IF Pad_Files(xx) <> "" THEN
            INCR Pad_Len
        END IF
     NEXT xx
    LOCATE 22,3
    CURSOR OFF
    PRINT Pad_Len-8".DO files available";


END SUB
'-----------------------------------------
SUB Scroll_Files
'enter here with full array called Pad_Files()
'print them in a column on console that can scroll w/arrows

'DIM Strt_Row AS INTEGER
DIM Row_num AS INTEGER
'DIM line_strt AS INTEGER
DIM Row_strt AS INTEGER

DIM t AS LOCAL INTEGER
DIM Pad_Element_Num AS INTEGER
'DIM line_start AS INTEGER
'DIM aa AS STRING 'was a
DIM kk AS STRING  'was k
DIM zz AS INTEGER  ' was z
DIM le AS INTEGER
'replace Strt_Row with Row_num
    Row_num = 12
'    Strt_Row = 12
    zz = Pad_Len + 1
'replace line_strt with Row_strt
'    line_strt = 0
    Row_strt = 0
Print_Files:
    CURSOR OFF
    FOR t = 12 TO 20
        LOCATE(t - 12 + Row_num),3
'       LOCATE (t - 12 + Strt_Row), 3
        COLOR 1,14
        PRINT "         ";
        LOCATE (t - 12 + Row_num),3
'        LOCATE (t - 12 + Strt_Row), 3
        IF t = 16 THEN
            COLOR 15,0
        ELSEIF t <>16 THEN
            COLOR 1,14
        END IF
        IF Pad_Files(t) <>"" THEN
            PRINT Pad_Files(t - 12 + Row_strt )
'            PRINT Pad_Files(t - 12 + line_strt)
        END IF
    NEXT t

Chk_Kbd:
    'wait for keypress
    WAITSTAT
    aa = INKEY$
         CALL look_4_f1 'look at TOKENIZE.hlp lines of text
                        ' upon return, if f1_flag is set, exit sub
         IF f1_flag = 1 THEN
             EXIT SUB
         END IF
    IF aa = CHR$(27) THEN
        END
    END IF
    IF aa = CHR$(13) THEN
        COLOR 14,9
        LOCATE 15,15: PRINT"Input file"
        fn_in = Pad_Files(t -12 + Row_strt -7 + 2)
'        fn_in = Pad_Files(t - 12 + line_strt - 7 + 2)
        COLOR 15,0
        LOCATE 16,15
        PRINT fn_in
        COLOR 14,9
        EXIT SUB
    END IF

    IF LEN(aa) = 2 THEN
        kk = RIGHT$(aa,1)
        IF kk = CHR$(72) THEN 'up arrow
            DECR Row_strt
'            DECR line_strt
            GOSUB check_limits
        END IF

        IF kk = CHR$(80) THEN 'down arrow
            INCR Row_strt
'            INCR line_strt
            GOSUB check_limits
        END IF
        kk = ""
    END IF
GOTO Print_Files

check_limits:
    IF Row_strt <0 THEN
'    IF line_strt < 0 THEN
        Row_strt = 0
'        line_strt = 0
    END IF
    IF Row_strt > zz-10 THEN
'    IF line_strt > zz-10  THEN
        Row_strt = zz-10
'        line_strt = zz-10
    END IF
RETURN
END SUB
'===================================