ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/APPS/DATABASE/ENTRY141.ZIP/ENTRY.BAS

BASIC Source File | 1991-02-18 | 25.9 KB | 1,155 lines

'***************************************************************************
'* ENTRY -- A simple editor for generating fixed field data files          *
'*          written in QuickBASIC 4.5  COLOR VERSION 1.41                  *
'*         (c) 1988, 1990 by DAVID WESSON, PhD.                            *
'***************************************************************************
'
' $INCLUDE: 'entry.dec'
'
'============================ PROGRAM STARTS ===============================
    OPTION BASE 1
    CLS
    initialize
    header
    readcommandline
    filebusiness
    savebakfile
    DO
        menuroutine
    LOOP
'============================ PROGRAM ENDS ==================================

SUB autosave STATIC
    savecursor
    IF saveinterval = 0 THEN EXIT SUB
    IF time2 >= (time1 + saveinterval) THEN
        time1 = time2
        savebakfile
        OPEN outfile$ FOR APPEND AS #1
    END IF
    LOCATE saverow, savecol
END SUB

SUB checkname STATIC
    COLOR fore, back
    CLS 2
    askname$ = "Datafile: " + infile$ + "   [Return] use this name, [Space] use new name."
    prompt askname$
    getkey
    in$ = UCASE$(in$)
    SELECT CASE in$
        CASE enter$
            EXIT SUB
        CASE esc$
            EXIT SUB
        CASE CHR$(32)
            numcases = 0
            datalines = 0
            getfilename
            filebusiness
        CASE ELSE
            checkname
    END SELECT
END SUB

SUB clear25 STATIC
     LOCATE 25, 1
     COLOR back, fore
     PRINT SPACE$(80);
END SUB

SUB clearcard STATIC
    COLOR black, fore
    LOCATE 8, col
    PRINT CHR$(32);
    FOR x = 0 TO 9
        LOCATE 10 + x, col
        PRINT MID$(STR$(x), 2, 1);
    NEXT x
    LOCATE 20, col
    PRINT CHR$(32)
    LOCATE row, col
END SUB

SUB click STATIC
    IF soundonoff = 0 THEN
        EXIT SUB
        ELSE s = VAL(data$(col))
        SOUND (210 + (s * 32)), .6
    END IF
END SUB

SUB counter STATIC
    savecursor
    IF escape = 0 THEN
        COLOR fore, back
        LOCATE row - 1, 1
        PRINT SPACE$(80)
        LOCATE row - 1, col
        COLOR 26, back
        PRINT CHR$(24)
        LOCATE saverow, savecol
    END IF
END SUB

SUB cursor (value) STATIC
    SELECT CASE value
        CASE 0
            LOCATE , , 0, 0, 0
        CASE 1
            LOCATE , , 1, 6, 7
    END SELECT
END SUB

SUB dataroutine STATIC
    DO
        COLOR fore, back
        LOCATE 3, 1: PRINT "CASE:"; numcases
        LOCATE 4, 1: PRINT "LINE:"; card
        LOCATE 6, 1: PRINT SPACE$(80)
        LOCATE 6, 1: PRINT cardset$(card)
        filecard row
        col = 1
        eol = 0
        COLOR 0, 6
GetCase:
        DO
            readcolumn
            IF eol = 1 THEN EXIT DO
            LOCATE row, col
            counter
            numpadscan
            COLOR 0, 6
            getkey
            SELECT CASE in$
                CASE "EOL"
                    EXIT DO
                CASE enter$
                    filecard row
                    col = 1
                CASE esc$
                    datalines = datalines - 1
                    numberpad 0
                    cursor 0
                    COLOR fore, back
                    CLS 2
                    CLOSE
                    makedeffile
                    EXIT SUB
                CASE bksp$
BackUp:
                    IF col > 1 THEN
                            col = col - 1
                            clearcard
                            IF column$(col, card) = "C" OR column$(col, card) = "P" OR column$(col, card) = "B" THEN GOTO BackUp
                        ELSE BEEP
                    END IF
                CASE lft$
LeftSpace:
                    IF col > 1 THEN
                            col = col - 1
                            LOCATE row, col
                            IF column$(col, card) = "C" OR column$(col, card) = "P" OR column$(col, card) = "B" THEN GOTO LeftSpace
                        ELSE BEEP
                    END IF
                CASE rght$
                    IF col < 80 THEN
                            col = col + 1
                            LOCATE row, col
                        ELSE BEEP
                    END IF
                CASE home$
                    LOCATE row, 1
                    col = 1
                    IF column$(1, card) = "C" THEN LOCATE row, 5: col = 5
                CASE end$
                    col = LEN(cardset$(card))
                    IF column$(col, card) = "+" THEN col = col - 1
                    LOCATE row, col
                CASE fkey$(1)
                    savecursor
                    minihelp
                    LOCATE saverow, savecol
                CASE fkey$(2)
                    savecursor
                    COLOR fore, back
                    LOCATE 21, 1: PRINT SPACE$(320)
                    LOCATE saverow, savecol
                CASE fkey$(3) TO fkey$(10)
                    BEEP
                CASE delete$
                    IF data$(col) < CHR$(58) THEN clearcard
                        data$(col) = CHR$(32)
                        LOCATE row, col
                        PRINT CHR$(32);
                        col = col + 1
                CASE insert$
                    IF data$(col) < CHR$(58) THEN clearcard
                    data$(col) = CHR$(32)
                    LOCATE row, col
                    PRINT CHR$(32);
                CASE plus$
                    b = INSTR(col, cardset$(card), "B")
                    p = INSTR(col, cardset$(card), "P")
                    IF b = 0 AND p = 0 THEN
                        col = LEN(cardset$(card)) + 1
                    ELSEIF p = 0 OR b = 0 THEN
                        IF p = 0 THEN col = b
                        IF b = 0 THEN col = p
                    ELSE
                        IF p < b THEN col = p
                        IF b < p THEN col = b
                    END IF
                    LOCATE row, col
                CASE ELSE
                    IF column$(col, card) = "N" AND (in$ < CHR$(32) OR in$ > CHR$(58)) THEN BEEP: GOTO GetCase
                    data$(col) = UCASE$(in$)
                    clearcard
                    LOCATE row, col
                    PRINT data$(col);
                    IF data$(col) < CHR$(58) AND data$(col) > CHR$(42) THEN punch
                    col = col + 1
            END SELECT
        LOOP
    LOOP UNTIL numcases = 10000
END SUB

SUB editline25 STATIC
    clear25
    LOCATE 25, 1
    COLOR high, fore
    PRINT "   [Esc] MENU  "; CHR$(179);
    PRINT "   [F1]  MiniHelp  "; CHR$(179);
    PRINT "   NumberPad: ";
    COLOR back, fore
    PRINT pad$;
    COLOR high, fore
    PRINT "  "; CHR$(179);
    PRINT "   Autosave:"; saveinterval; "sec.";
END SUB

SUB editlines STATIC
Top:
    LOCATE 3, 1: PRINT "Datafile: "; outfile$;
    PRINT TAB(40); "Total Cases:"; numcases; TAB(60); "Cards per Case:"; card
    prompt "Hit any key to edit a card, or [Esc] to EXIT."
    LOCATE 25, 1
    getkey
    IF in$ = esc$ THEN EXIT SUB
    COLOR fore, back
    cursor 1
    numberpad 1
    prompt "Edit CASE:          CARD:  "
    LOCATE 25, 37
    keyin 4
        IF k$ = "" THEN k$ = STR$(editcase)
        IF in$ = esc$ THEN EXIT SUB
        editcase = VAL(k$)
        IF editcase = 0 THEN editcase = 1
    LOCATE 25, 52
    keyin 1
        IF k$ = "" THEN k$ = STR$(editcard)
        IF in$ = esc$ THEN EXIT SUB
        editcard = VAL(k$)
        IF editcard > 3 OR editcard = 0 THEN editcard = 1
    editline = ((editcase - 1) * card) + editcard
    LOCATE 6, 1: PRINT "CASE:"; editcase
    LOCATE 7, 1: PRINT "CARD:"; editcard
    ruler 8
    row = 10: col = 1
    numberpad 0
    LOCATE 9, 1: PRINT cardset$(editcard)
    getdataline
    LOCATE row, col: PRINT dataline$
    cardlength = LEN(dataline$)
    saveline$ = dataline$
    IF saveline$ = "" THEN
        prompt "Can't edit empty data line. Hit a key to continue."
        getkey
        COLOR fore, back
        CLS 2
        GOTO Top
    END IF
    editline25
    escape = 0
    cursor 0
    DO
        LOCATE row + 1, 1: PRINT SPACE$(80)
        LOCATE row + 1, col: COLOR fore, back: PRINT CHR$(24)
        LOCATE row, col
        getkey
        click
        SELECT CASE in$
            CASE lft$
                IF col > 1 THEN col = col - 1
            CASE rght$
                IF col < cardlength THEN col = col + 1
            CASE home$
                col = 1
            CASE end$
                col = cardlength
            CASE bksp$
                IF col > 1 THEN col = col - 1
            CASE delete$
                MID$(dataline$, col, 1) = CHR$(32)
                PRINT CHR$(32);
                IF col < cardlength THEN col = col + 1
            CASE insert$
                MID$(dataline$, col, 1) = CHR$(32)
                PRINT CHR$(32);
            CASE esc$
                dataline$ = saveline$
                escape = 1
                COLOR fore, back
                CLS 2
                GOTO Top
            CASE enter$
                COLOR fore, back
                CLS 2
                escape = 1
                writedataline
                GOTO Top
            CASE fkey$(1)
                savecursor
                minihelp
                LOCATE saverow, savecol
            CASE fkey$(2)
                savecursor
                COLOR fore, back
                LOCATE 21, 1: PRINT SPACE$(320)
                LOCATE saverow, savecol
            CASE fkey$(3) TO fkey$(10), up$, down$
                BEEP
            CASE ELSE
                MID$(dataline$, col, 1) = in$
                PRINT in$;
                IF col < cardlength THEN
                    col = col + 1
                ELSE BEEP
                END IF
        END SELECT
  LOOP
END SUB

SUB editor STATIC
    cursor 0
    escape = 0
    editline25
    COLOR fore, back
    LOCATE 2, 1
    PRINT "FILE: "; UCASE$(infile$)
    ruler 5
    numberpad 1
    OPEN outfile$ FOR APPEND AS #1
    time1 = TIMER
    datalines = datalines + 1
    numcases = numcases + 1
    row = 8
    card = 1
    dataroutine
    numberpad 0
    cursor 0
    COLOR fore, back
    CLS 2
    savebakfile
    CLOSE
END SUB

SUB filebusiness STATIC
    splitfilename
    bakfile$ = file$ + ".BAK"
    outfile$ = infile$
    deffile$ = file$ + ".DEF"
    tempfile$ = file$ + ".TMP"
END SUB

SUB filecard (row) STATIC
    LOCATE row, 1
    COLOR black, fore
    PRINT SPACE$(160)
    FOR x = 0 TO 9
        PRINT STRING$(80, CHR$(48 + x))
    NEXT x
    PRINT SPACE$(80)
    COLOR fore, back
END SUB

SUB getbyte STATIC
    DO
        counter
        getkey
        byte$ = in$
        IF byte$ = enter$ THEN EXIT SUB
        IF byte$ = esc$ THEN escape = 1: EXIT SUB
        readbyte
    LOOP
END SUB

SUB getdataline STATIC
    prompt "Please wait, getting data line."
    OPEN infile$ FOR INPUT AS #1
    FOR x = 1 TO editline
        LINE INPUT #1, dataline$
    NEXT x
    CLOSE #1
END SUB

SUB getdeffile STATIC
     OPEN deffile$ FOR RANDOM AS #1
        IF LOF(1) = 0 THEN CLOSE : setup
     CLOSE
     card = 1
     OPEN deffile$ FOR INPUT AS #1
        INPUT #1, datalines
        DO
            LINE INPUT #1, cardset$(card)
                FOR l = 1 TO LEN(cardset$(card))
                    column$(l, card) = MID$(cardset$(card), l, 1)
                NEXT l
                IF RIGHT$(cardset$(card), 1) = "+" THEN
                     card = card + 1
                     ELSE EXIT DO
                END IF
        LOOP
     CLOSE #1
     numcases = FIX(datalines / card)
END SUB

SUB getdirectory STATIC
        cursor 0
        clear25
        COLOR fore, back
        CLS 2
        dirlist$ = drive$ + "dir.lst"
        dir$ = "dir " + drive$ + " > " + dirlist$
        SHELL dir$
        OPEN dirlist$ FOR INPUT AS #1
        prompt "Hit any key to continue."
        COLOR fore, back
        VIEW PRINT 2 TO 24
        LOCATE 3, 3
        DO WHILE NOT EOF(1)
            l = l + 1
            LINE INPUT #1, l$
            LOCATE , 3: PRINT l$
            IF l = 23 THEN getkey: l = 1
            IF in$ = esc$ THEN EXIT DO
        LOOP
        VIEW PRINT 2 TO 25
        CLOSE #1
        KILL dirlist$
        IF in$ <> esc$ THEN getkey
END SUB

SUB getdirname STATIC
        COLOR fore, back
        CLS 2
        l$(18) = "Which DRIVE are your files stored on?"
        l$(19) = "     A:    for    A: drive"
        l$(20) = "     B:    for    B: drive"
        l$(21) = "    \path  for    subdirectory "
        l$(23) = "[Return] for current drive or directory"
        writescreen 20
        prompt "Enter drive or path: "
        keyin 30
        IF k$ = esc$ THEN goodbye
        IF LEN(k$) = 1 THEN k$ = k$ + ":"
        IF NOT LEN(k$) = 2 AND NOT k$ = "" AND NOT RIGHT$(k$, 1) = "\" THEN k$ = k$ + "\"
        drive$ = UCASE$(k$)
END SUB

SUB getfilename STATIC
    COLOR fore, back
    CLS 2
    l$(23) = "Hit [Return] to see directory list."
    writescreen 21
    prompt "Enter filename:                       "
    LOCATE 25, 37
    keyin 12
    IF in$ = esc$ THEN EXIT SUB
    IF k$ = "" THEN
        getdirectory
        getfilename
        ELSE infile$ = drive$ + k$
    END IF
END SUB

SUB getinifile
    OPEN "entry.ini" FOR APPEND AS 1
    IF LOF(1) <> 0 THEN
        CLOSE 1
        OPEN "entry.ini" FOR INPUT AS 1
        a$ = INPUT$(6, #1)
        INPUT #1, fore
        a$ = INPUT$(6, #1)
        INPUT #1, back
        a$ = INPUT$(6, #1)
        INPUT #1, high
        a$ = INPUT$(6, #1)
        INPUT #1, saveinterval
        a$ = INPUT$(7, #1)
        INPUT #1, soundonoff
    ELSE
        IF monitortype = 2 THEN
            fore = 14
            back = 4
            high = 3
            black = 0
        ELSE
            fore = 7
            back = 0
            high = 15
            black = 0
        END IF
        saveinterval = 120
        soundonoff = 1
    END IF
    CLOSE 1
END SUB

SUB getkey STATIC
w:   in$ = INKEY$: IF in$ = "" THEN numpadscan: GOTO w
END SUB

SUB getset STATIC
    DO
        col = POS(0)
        getkey
        in$ = UCASE$(in$)
        SELECT CASE in$
            CASE enter$
                EXIT DO
            CASE esc$
                EXIT SUB
            CASE bksp$, lft$
                IF col > 1 THEN
                        col = col - 1
                        LOCATE , col
                        PRINT CHR$(32);
                        LOCATE , col
                        cardset$(card) = LEFT$(cardset$(card), col - 1)
                    ELSE col = 1
                END IF
            CASE "C", "A", "N", "B", "P", "+", ".", ","
                IF in$ = "+" THEN
                    IF card = 3 THEN EXIT DO
                    cardset$(card) = cardset$(card) + in$
                    PRINT in$;
                    card = card + 1
                    setuproutine
                ELSE cardset$(card) = cardset$(card) + in$
                    PRINT in$;
                END IF
            CASE ELSE
                BEEP
        END SELECT
    LOOP UNTIL col = 80
END SUB

SUB goodbye STATIC
    COLOR 7, 0
    VIEW PRINT
    CLS
    IF infile$ = "" THEN GOTO FastOut
    writeinifile
    PRINT "THANKS for using ENTRY."
    PRINT "To renter this file in the future, type  ENTRY "; infile$
    PRINT "Original file, if any, is now in "; bakfile$
FastOut:
    numberpad 0
    CLOSE
    END
END SUB

SUB header
    VIEW PRINT
    COLOR back, fore
    LOCATE 1, 1: PRINT SPACE$(80);
    LOCATE 1, 20
    COLOR high, fore
    PRINT "ENTRY: Dr.Funkey's Data Entry Program v1.41"
    VIEW PRINT 2 TO 25
END SUB

SUB helpscreen STATIC
     l$(4) = "DATA ENTRY AND EDITING OPTIONS"
     l$(6) = "     [Space]           Enters an blank column."
     l$(7) = "     [Return]          Aborts current line. Starts over."
     l$(8) = "     [BackSpace]       Deletes left of cursor, moves to left. "
     l$(9) = "     [*]               Accepted as Missing Value in Numeric Field"
    l$(10) = "     [Esc]             EXIT to MENU."
    l$(12) = "Hit [NumLock] to use following keys. Hit again to use numberpad."
    l$(14) = "     [<--] [-->]       Move left or right."
    l$(16) = "     [Home]            Cursor to beginning of line."
    l$(18) = "     [End]             Cursor to end of line"
    l$(20) = "     [Delete]          Deletes at cursor, moves to right."
    l$(22) = "     [Insert]          Delete at cursor, cursor stays put."
    prompt "Hit any key to continue."
    writescreen 10
    getkey
END SUB

SUB initialize

cards = 3
items = 11
escape = 1

DIM menu$(items)
DIM l$(25)
DIM column$(81, cards)
DIM data$(80)
DIM fkey$(items)
DIM cardset$(cards)

getinifile
setnames
END SUB

SUB issuecommand STATIC
    COLOR fore, back
    CLS
    LOCATE 20, 1
    PRINT "Type EXIT to return to ENTRY."
    SHELL
    header
END SUB

SUB keyin (length) STATIC
    inlen = length
    cursor 1
    k$ = ""
    getbyte
END SUB

SUB makedeffile STATIC
    OPEN deffile$ FOR OUTPUT AS #1
        PRINT #1, datalines
        FOR c = 1 TO 3
            IF cardset$(c) <> "" THEN PRINT #1, cardset$(c)
        NEXT c
    CLOSE #1
END SUB

SUB menufunctions STATIC
    COLOR fore, back
    CLS 2
    SELECT CASE in$
        CASE fkey$(1)
            getdeffile
            editor
        CASE fkey$(2)
            helpscreen
        CASE fkey$(3)
            checkname
            setup
        CASE fkey$(4)
            getdeffile
            editlines
        CASE fkey$(5)
            prompt "Please wait, saving backup file first."
            savebakfile
            CLOSE
            issuecommand
        CASE fkey$(6)
            setcolor
            setsave
            writeinifile
        CASE fkey$(7)
            getdeffile
            printfile
        CASE fkey$(8)
            soundoff
        CASE fkey$(9)
            getdirname
        CASE fkey$(10)
            getdirectory
        CASE esc$
            goodbye
    END SELECT
END SUB

SUB menuinput STATIC
    item = 1
    DO
        LOCATE (item * 2) + 1, 24
        COLOR high, fore
        PRINT menu$(item)
        COLOR fore, back
        getkey
        LOCATE (item * 2) + 1, 24: PRINT menu$(item)
        FOR a = 1 TO 11
            IF in$ = fkey$(a) THEN EXIT SUB
        NEXT a
        SELECT CASE in$
            CASE esc$:   EXIT SUB
            CASE enter$: in$ = fkey$(item)
                             EXIT SUB
            CASE up$:    item = item - 1
            CASE down$:  item = item + 1
        END SELECT
        IF item = items + 1 THEN item = 1
        IF item = 0 THEN item = items
    LOOP
END SUB

SUB menuroutine STATIC
    COLOR fore, back
    CLS
    escape = 1
    menuscreen
    menuinput
    menufunctions
END SUB

SUB menuscreen STATIC
    COLOR fore, back
    FOR l = 1 TO 24
        l$(l) = ""
    NEXT l
        l$(3) = "[F1]  Enter data in datafile": menu$(1) = l$(3)
        l$(5) = "[F2]  Help with entering data": menu$(2) = l$(5)
        l$(7) = "[F3]  Set up new datafile": menu$(3) = l$(7)
        l$(9) = "[F4]  Edit existing data": menu$(4) = l$(9)
        l$(11) = "[F5]  Issue a DOS command": menu$(5) = l$(11)
        l$(13) = "[F6]  Set autosave and color": menu$(6) = l$(13)
        l$(15) = "[F7]  Print this file": menu$(7) = l$(15)
        l$(17) = "[F8]  Turn sound ON/OFF": menu$(8) = l$(17)
        l$(19) = "[F9]  Change drive": menu$(9) = l$(19)
        l$(21) = "[F10] See drive directory": menu$(10) = l$(21)
        l$(23) = "[Esc] EXIT program to DOS": menu$(11) = l$(23)
        writescreen 24
        IF soundonoff = 1 THEN s$ = "OFF   " ELSE s$ = "ON    "
        LOCATE 17, 41
        COLOR high, back
        PRINT s$
        prompt "Use cursor keys, then [Return] or hit Function Key."
END SUB

SUB minihelp STATIC
    COLOR fore, back
    LOCATE 21, 1
    PRINT "[Space] enter BLANK col     [Return] ABORT line    [BackSpace] Delete to left"
    PRINT "[Home]  goto BEGIN line     [End] goto END line    [Insert] Delete at cursor"
    PRINT "[F2] remove this MINIHELP panel                    [Delete] Delete, move right  "
    PRINT "[NumLock] to use arrow keys. [Numlock] again to enter data"
END SUB

FUNCTION monitortype
     DEF SEG = 0
     IF (PEEK(&H410) AND &H30) = &H30 THEN
        monotype = 1
     ELSE monotype = 2
     END IF
     DEF SEG
END FUNCTION

SUB numberpad (value) STATIC
    IF value = 1 THEN
            DEF SEG = &H40
            POKE &H17, PEEK(&H17) OR 32
        ELSEIF value = 0 THEN
            DEF SEG = &H40
            POKE &H17, PEEK(&H17) AND 223
    END IF
END SUB

SUB numpadscan STATIC
    num = PEEK(&H17)
    IF num = 0 THEN
        pad$ = "OFF"
        ELSE IF num = 32 OR num = 128 THEN pad$ = "ON "
    END IF
    IF escape = 0 THEN
        savecursor
        COLOR back, fore
        LOCATE 25, 51: PRINT pad$;
        COLOR fore, back
        LOCATE saverow, savecol
    END IF
END SUB

SUB openingscreen STATIC
    l$(5) = "If you remember the bad old days of datacards, you remember bad"
    l$(6) = "old cardpunch machines. But there was one function on that clunker"
    l$(7) = "that was quite useful--the program drum. It permitted you to program"
    l$(8) = "the datatype for each column of data, skip columns and automatically"
    l$(9) = "start a new case. Good aids for data entry!"
    l$(11) = "This program combines these functions with some of the advantages of"
    l$(12) = "screen data entry, such as the ability to backspace for corrections."
    l$(13) = "This program is limited to data for 9,999 cases of 3 cards per case"
    l$(14) = "with 80 columns maximum each."
    l$(16) = "If you use this program for commercial purposes, you are obligated to"
    l$(17) = "the author for a payment of £10. Otherwise, use and enjoy."
    l$(23) = "                   (c) 1988, 90, 91 David A. Wesson"
    prompt "Hit any key to continue or [Esc] to EXIT. "
    cursor 1
    writescreen 6
    getkey
    IF in$ = esc$ THEN goodbye
END SUB

SUB printfile STATIC
    OPEN infile$ FOR INPUT AS #1
    IF LOF(1) = 0 THEN
        prompt "Empty datafile. Hit a key"
        getkey
        EXIT SUB
    END IF
    prompt "Make sure printer is turned on. Hit a key."
    getkey
    IF in$ = esc$ THEN EXIT SUB
    prompt "Hit [Esc] to ABORT printing (except what is already in buffer.)"
    LOCATE 24, 1
    FOR n = 1 TO datalines
         i$ = INKEY$
         IF i$ = esc$ THEN CLOSE #1: LPRINT CHR$(24): EXIT SUB
         INPUT #1, data$
         LPRINT data$
    NEXT n
    CLOSE #1
END SUB

SUB prompt (p$) STATIC
    cursor 0
    clear25
    COLOR high, fore
    LOCATE 25, (40 - (LEN(p$) / 2))
    PRINT p$;
END SUB

SUB punch STATIC
    IF VAL(data$(col)) >= 0 AND VAL(data$(col)) < 10 THEN
        savecursor
        LOCATE row + 2 + VAL(data$(col)), col
        COLOR black, black
        PRINT CHR$(255)
        click
        COLOR back, fore
        LOCATE saverow, savecol
    END IF
END SUB

SUB readbyte STATIC
    col = POS(0): row = CSRLIN
    IF byte$ = fkey$(2) THEN savecursor: setsave: LOCATE saverow, savecol
    IF byte$ = home$ THEN GOTO HomeKey
    IF byte$ = end$ THEN GOTO EndKey
    IF byte$ = bksp$ THEN GOTO BackSpace
    IF byte$ = lft$ THEN GOTO LeftKey
    IF byte$ = rght$ THEN GOTO RightKey
    IF byte$ = delete$ THEN GOTO DeleteKey
    IF byte$ < CHR$(32) OR byte$ > CHR$(126) THEN EXIT SUB
    IF LEN(k$) = inlen THEN BEEP: EXIT SUB
    PRINT byte$;
    k$ = k$ + byte$
    EXIT SUB

BackSpace:
    IF col > 1 AND k$ <> "" THEN
            LOCATE , col - 1: PRINT CHR$(32);
            LOCATE , col - 1
            k$ = LEFT$(k$, LEN(k$) - 1)
            ELSE click: getbyte
    END IF
    EXIT SUB
LeftKey:
    IF col > 1 AND k$ <> "" THEN
         col = col - 1
         LOCATE row, col
         ELSE click: getbyte
    END IF
    EXIT SUB
RightKey:
    IF col < length THEN
        col = col + 1
        ELSE click: getbyte
    END IF
    EXIT SUB
EndKey:
    col = LEN(k$)
    LOCATE row, col
    EXIT SUB
HomeKey:
    col = 1
    LOCATE row, col
    EXIT SUB
DeleteKey:
    IF k$ <> "" THEN
        k$ = LEFT$(k$, incol - 1) + MID$(k$, incol + 1)
    LOCATE , 1: PRINT k$ + SPACE$(1)
    END IF
    EXIT SUB
InsertKey:
    k$ = LEFT$(k$, col - 1) + CHR$(32) + MID$(k$, col + 1)
    LOCATE row, 1: PRINT k$;
    LOCATE row, col
    EXIT SUB
END SUB

SUB readcolumn STATIC
    COLOR back, fore
    SELECT CASE column$(col, card)
        CASE ""
            BEEP
            writeline
            time2 = TIMER
            autosave
            card = 1
            numcases = numcases + 1
            eol = 1
        CASE "C"
            IF numcases < 10 THEN casenum$ = "0" + "0" + "0" + MID$(STR$(numcases), 2, 1)
            IF numcases > 9 AND numcases < 100 THEN casenum$ = "0" + "0" + MID$(STR$(numcases), 2, 2)
            IF numcases > 99 AND numcases < 1000 THEN casenum$ = "0" + MID$(STR$(numcases), 2, 3)
            IF numcases > 999 AND numcases < 10000 THEN casenum$ = MID$(STR$(numcases), 2, 4)
            FOR c = 1 TO 4
                data$(col) = MID$(casenum$, c, 1)
                COLOR black, fore
                LOCATE row, col: PRINT data$(col)
                punch
                col = col + 1
            NEXT c
            readcolumn
        CASE "B"
            LOCATE row, col
            data$(col) = CHR$(32)
            col = col + 1
            readcolumn
        CASE "P"
            BEEP
            data$(col) = CHR$(32)
            col = col + 1
            readcolumn
        CASE "."
            data$(col) = CHR$(46)
            PRINT CHR$(46);
            col = col + 1
            readcolumn
        CASE ","
            data$(col) = CHR$(44)
            PRINT CHR$(44);
            col = col + 1
            readcolumn
        CASE "+"
            BEEP
            writeline
            card = card + 1
            eol = 1
    END SELECT
END SUB

SUB readcommandline STATIC
    infile$ = UCASE$(COMMAND$)
    IF infile$ = "" THEN
        openingscreen
        getdirname
        getfilename
    END IF
END SUB

SUB ruler (row) STATIC
    LOCATE row, 1
    FOR z = 1 TO 8
        COLOR black, fore: PRINT "123456789";
        COLOR high, fore: PRINT MID$(STR$(z), 2, 1);
    NEXT z
END SUB

SUB savebakfile STATIC
    CLOSE
    LOCATE 24, 1
    makebak$ = "COPY " + outfile$ + " " + bakfile$ + " > nul"
    SHELL makebak$
END SUB

SUB savecursor STATIC
    savecol = POS(0)
    saverow = CSRLIN
END SUB

SUB setcolor
    prompt "Hit [Return] to reset entry to original setting."
    COLOR back, fore
    LOCATE 18, 15
    PRINT "       Enter a number for each color selection.       "
    LOCATE 19, 15
    PRINT " 0  1  2  3  4  5  6  7  8  9  10  11  12  13  14  15 "
    LOCATE 20, 15
    FOR x = 0 TO 9
        COLOR x, fore: PRINT STRING$(3, 254);
    NEXT x
    FOR x = 10 TO 15
        COLOR x, fore: PRINT STRING$(4, 254);
    NEXT x
    COLOR fore, back
    LOCATE 23, 15
    PRINT "   FOREGROUND: " + STRING$(2, 254) + "   BACKGROUND: " + STRING$(2, 254) + "   HIGHLIGHT: " + STRING$(2, 254) + "   "
    LOCATE 23, 30
    keyin 2
    f = VAL(k$)
    IF f <> 0 THEN fore = f
    header
    LOCATE 23, 47
    keyin 2
    b = VAL(k$)
    IF b <> fore THEN back = b
    header
    LOCATE 23, 63
    keyin 2
    h = VAL(k$)
    IF h <> back THEN high = h
    header
END SUB

SUB setnames
        esc$ = CHR$(27)
        bksp$ = CHR$(8)
        tab$ = CHR$(9)
        enter$ = CHR$(13)
        delete$ = CHR$(0) + CHR$(83)
        insert$ = CHR$(0) + CHR$(82)
        btab$ = CHR$(0) + CHR$(15)
        pgup$ = CHR$(0) + CHR$(73)
        pgdn$ = CHR$(0) + CHR$(81)
        home$ = CHR$(0) + CHR$(71)
        end$ = CHR$(0) + CHR$(79)
        up$ = CHR$(0) + CHR$(72)
        lft$ = CHR$(0) + CHR$(75)
        rght$ = CHR$(0) + CHR$(77)
        down$ = CHR$(0) + CHR$(80)
        plus$ = CHR$(43)
        fkey$(1) = CHR$(0) + CHR$(59)
        fkey$(2) = CHR$(0) + CHR$(60)
        fkey$(3) = CHR$(0) + CHR$(61)
        fkey$(4) = CHR$(0) + CHR$(62)
        fkey$(5) = CHR$(0) + CHR$(63)
        fkey$(6) = CHR$(0) + CHR$(64)
        fkey$(7) = CHR$(0) + CHR$(65)
        fkey$(8) = CHR$(0) + CHR$(66)
        fkey$(9) = CHR$(0) + CHR$(67)
        fkey$(10) = CHR$(0) + CHR$(68)
        numlock$ = CHR$(&H20) + CHR$(45)
        altminus$ = CHR$(0) + CHR$(130)
        altplus$ = CHR$(0) + CHR$(131)
END SUB

SUB setsave STATIC
    escape = 1
    saveline$ = "Current Autosave interval is" + STR$(saveinterval) + " seconds. New interval: "
    prompt saveline$
    LOCATE 25, 68
    keyin 3
    IF k$ = "" THEN EXIT SUB
    IF VAL(k$) < 20 OR VAL(k$) > 999 THEN
        saveinterval = 0
        ELSE saveinterval = VAL(k$)
    END IF
    escape = 0
END SUB

SUB setup STATIC
     IF in$ = esc$ THEN EXIT SUB
     l$(6) = "C    Enter CCCC for case numbers. Program assumes 9,999 cases max."
     l$(7) = "     The computer will enter the sequential numbers for you."
     l$(9) = "A    Alphanumerics are Any letter or number, but numbers will "
    l$(10) = "     not be treated as numerical data. Use N for numerical data."
    l$(12) = "B    Enter B for a blank column to help section data."
    l$(14) = "P    Enter P where you turn a page in your instrument. Will BEEP here."
    l$(15) = "     Program will beep and enter a blank column for you."
    l$(17) = ". ,  Enter a period or comma to have these automatically entered."
    l$(19) = "+    Enter a plus to continue onto next card. 3 card maximum."
    l$(21) = "Use BackSpace or Left Cursor [ <-- ] to make corrections."
    l$(23) = "Hit [Return] to FINISH data entry setup. Hit [Esc] to ABORT."
    writescreen 8
    prompt "Enter   C   A   N   B   P   .  ,  +  [Esc] Abort   [Return] Finish."
    card = 1
    FOR x = 1 TO 3
        cardset$(x) = ""
    NEXT x
    setuproutine
END SUB

SUB setuproutine STATIC
    COLOR fore, back
    LOCATE 2, 1: PRINT "DATA LINE:"; card; TAB(40); "DATA FILE: "; UCASE$(infile$)
    ruler 3
    COLOR fore, back
    LOCATE 4, 1: PRINT SPACE$(80)
    cursor 1
    LOCATE 4, 1
    getset
    IF in$ <> esc$ THEN makedeffile
    COLOR fore, back
    CLS 2
END SUB

SUB soundoff STATIC
    IF soundonoff = 1 THEN
        soundonoff = 0
        ELSEIF soundonoff = 0 THEN soundonoff = 1
    END IF
    writeinifile
END SUB

SUB splitfilename STATIC
        period = INSTR(infile$, ".")
        IF period = 0 THEN
            file$ = infile$
            ext$ = ""
            ELSE
                file$ = LEFT$(infile$, period - 1)
                ext$ = MID$(infile$, period + 1)
        END IF
END SUB

SUB writedataline STATIC
    prompt "Please wait, saving datafile."
    OPEN infile$ FOR INPUT AS #1
    OPEN tempfile$ FOR OUTPUT AS #2
    WHILE EOF(1) = 0
        n = n + 1
        LINE INPUT #1, a$
        IF n = editline THEN a$ = dataline$
        PRINT #2, a$
    WEND
    CLOSE
    KILL infile$
    NAME tempfile$ AS infile$
END SUB

SUB writeinifile
    OPEN "entry.ini" FOR OUTPUT AS 1
    PRINT #1, "FORE ="; fore
    PRINT #1, "BACK ="; back
    PRINT #1, "HIGH ="; high
    PRINT #1, "SAVE ="; saveinterval
    PRINT #1, "SOUND ="; soundonoff
    CLOSE 1
END SUB

SUB writeline STATIC
        dataline$ = ""
        FOR c = 1 TO LEN(cardset$(card))
            dataline$ = dataline$ + data$(c)
            data$(c) = ""
        NEXT c
        PRINT #1, dataline$
        datalines = datalines + 1
END SUB

SUB writescreen (indent)
    cursor 0
    VIEW PRINT 2 TO 24
    COLOR fore, back
    CLS 2
    FOR x = 3 TO 24
        IF NOT l$(x) = "" THEN
            LOCATE x, indent: PRINT l$(x);
        l$(x) = ""
        END IF
    NEXT x
    VIEW PRINT 2 TO 25
END SUB