'**********************************
'* program : LizzyDB.bas          *
'* author  : Computothought       *         s
'* last fix: Jan.  1, 1996        *
'* Note    : Pc clone flat file   *
'*           database from what   *
'*           we learned at school.*
'**********************************
DECLARE FUNCTION Acquire.chars$ (Maxlen!)
DECLARE FUNCTION Acquire.time$ (Maxlen!)
DECLARE FUNCTION Acquire.date$ (Maxlen!)
DECLARE FUNCTION Acquire.logical$ (Maxlen!)
DECLARE FUNCTION Acquire.text$ (Maxlen!)
DECLARE FUNCTION Acquire.numbers$ (Maxlen!, Dcmlplaces!)
DECLARE SUB Utoh (cr!, cc!, length!)
DECLARE SUB prvmenu (name$(), Column%, Message%, Vpos%)
DECLARE SUB Vmenu (name$(), Vpos%, Message%, Column%, menu$)


Begin:
GOSUB Main.housekeeping
GOSUB Mainmenu
GOSUB Eoj
END:


Main.housekeeping:
'===================================================================
' housekeeping
'-------------------------------------------------------------------
' static values
DEFINT A-Z
DIM name$(5, 2)
Zero = 0
One = 1
Two = 2
Three = 3
Four = 4
Five = 5
Six = 6
Size.of.screen = 25
Blanklin$ = STRING$(79, " ")
Blanks$ = STRING$(9, " ")
Quote$ = CHR$(34)
Quit$ = "-1"
Byebye = 5
Totalsiz = Zero
Dummysiz = Zero
Arraysiz = 100
Choice = Zero
Choice$ = ""
DIM Fldname$(Arraysiz), Fldsize(Arraysiz), Fldtype$(Arraysiz), Flddcml(Arraysiz)
DIM Prompt$(Arraysiz), size!(Arraysiz), Type$(Arraysiz), Dcmlsize(Arraysiz)
DIM Datain$(Arraysiz), Dataout$(Arraysiz), Choicetyp$(Byebye)
Choicetyp$(1) = "Append"
Choicetyp$(2) = "Behold"
Choicetyp$(3) = "Change"
Choicetyp$(4) = "Delete"
Choicetyp$(5) = "Exit"
RETURN

Mainmenu:
WHILE Choice <> Byebye
    DO
        Choice = 0
        Vpos = 5
        Message = 20
        Column = 10
        name$(1, 1) = "Design"
        name$(1, 2) = "Design the format for a data file."
        name$(2, 1) = "Build"
        name$(2, 2) = "Build and modify existing data files."
        name$(3, 1) = "Organize"
        name$(3, 2) = "Arrange the data in a specific order."
        name$(4, 1) = "Report"
        name$(4, 2) = "Output a list of the data."
        name$(5, 1) = "Exit"
        name$(5, 2) = "End the program."
        CLS
        LOCATE 24, 1
        PRINT STRING$(78, 196);
        PRINT "Lizzydb (V.: -1) from Computothought";
        LOCATE 1, 1
        PRINT
        PRINT TAB(10); "M a i n  m e n u  o f"
        menu$ = "Lizzydb Filing Cabinet"
        CALL Vmenu(name$(), Vpos, Message, Column, menu$)
        PRINT
        SELECT CASE Vpos
            CASE 1
                GOSUB LizzyDB.Design
            CASE 2
                GOSUB LizzyDB.Build
            CASE 3
                GOSUB LizzyDB.Sort
            CASE 4
                GOSUB LizzyDB.Report
            CASE 5
                EXIT DO
            CASE ELSE
                REM
        END SELECT
    LOOP
    Choice = Vpos
WEND
RETURN

Eoj:
CLS
PRINT
PRINT "Thank you for using Lizzydb."
PRINT "If you use this program more than several times and would like to"
PRINT "see more programs like the Lizzyword, Lizzyterm, and Lizzycalc,"
PRINT "please send $1.00 or more to:"
PRINT
PRINT "      Computoman"
PRINT
A$ = ""
WHILE A$ = ""
    A$ = INPUT$(1)
WEND
RETURN

'=========================================================================
LizzyDB.Design:
CLS
PRINT
PRINT TAB(12); "LizzyDB filing cabinet"
PRINT TAB(12); "Design a file"
PRINT
INPUT "Enter project name: ", Project$
'H = INSTR(Project$, ".")
'IF H - One > 0 THEN
'    Project$ = LEFT$(Project$, H - One)
'ELSE
'    IF LEN(Project$) = 0 THEN
'        Project$ = "lizzyfil"
'    END IF
'END IF
INPUT "      number of screen lines: ", Size.of.screen
IF Size.of.screen = Zero THEN
    Size.of.screen = 25
END IF
INPUT "      exit code for project: ", Exitcode$
IF Exitcode$ = "" THEN
    Exitcode$ = "-1"
    Exitcode = -1
END IF
TRUE% = -1
OPEN Project$ + ".met" FOR OUTPUT AS #One
FOR Numoflds = One TO Size.of.screen
    CLS
    PRINT
    PRINT
    PRINT TAB(12); "LizzyDB filing cabinet"
    PRINT TAB(12); "Design a file named: "; Project$
    PRINT
    INPUT "1.] Enter field name    : ", Fldname$(Numoflds)
    IF Fldname$(Numoflds) = Quit$ THEN
        Numoflds = Numoflds - One
        EXIT FOR
    END IF
    Here = CSRLIN
    Fldtype$(Numoflds) = " "
    WHILE INSTR("CTLAND", Fldtype$(Numoflds)) = Zero
        LOCATE Here, One
        PRINT "2.]       field type    : ";
        Fldtype$(Numoflds) = UCASE$(INPUT$(1))
    WEND
    PRINT Fldtype$(Numoflds)
    SELECT CASE Fldtype$(Numoflds)
        CASE "L"
            Fldsize(Numoflds) = One
            PRINT "3.]       field size    :", Fldsize(Numoflds)
            PRINT "4.]       decimal places: "; "0"
            Flddcml(Numoflds) = Zero
        CASE "A", "C"
            INPUT "3.]       field size    : ", Fldsize(Numoflds)
            PRINT "4.]       decimal places: "; "0"
            Flddcml(Numoflds) = Zero
        CASE "D"
            Fldsize(Numoflds) = 8
            PRINT "3.]       field size    :", Fldsize(Numoflds)
            PRINT "4.]       decimal places: "; "0"
            Flddcml(Numoflds) = Zero
        CASE "T"
            Fldsize(Numoflds) = 8
            PRINT "3.]       field size    :", Fldsize(Numoflds)
            PRINT "4.]       decimal places: "; "0"
            Flddcml(Numoflds) = Zero
        CASE "N"
            INPUT "3.]       field size    : ", Fldsize(Numoflds)
            INPUT "4.]       decimal places: ", Flddcml(Numoflds)
            IF Flddcml(Numoflds) > 0 THEN
                Fldsize(Numoflds) = Fldsize(Numoflds) + 1
            END IF
    END SELECT
    PRINT
    Answer$ = ""
    WHILE Answer$ <> "0"
        CLS
        PRINT
        PRINT
        PRINT TAB(12); "LizzyDB filing cabinet"
        PRINT TAB(12); "Design a file named: "; Project$
        PRINT
        PRINT "1.]       field name: "; Fldname$(Numoflds)
        PRINT "2.]       field type    : "; Fldtype$(Numoflds)
        PRINT "3.]       field size    : "; Fldsize(Numoflds)
        PRINT "4.]       decimal places: "; Flddcml(Numoflds)
        PRINT
        PRINT "Enter line to change: (0 to end) ";
        Answer$ = Acquire.text$(2)
        SELECT CASE Answer$
            CASE "1"
                INPUT "Enter field name: ", Fldname$(Numoflds)
            CASE "2"
                PRINT "2.]       field type    : ";
                Z$ = " "
                WHILE INSTR("CTLAND", Z$) < 1
                    Z$ = UCASE$(INPUT$(1))
                WEND
                PRINT Z$
                Fldtype$(Numoflds) = Z$
                SELECT CASE UCASE$(Fldtype$(Numoflds))
                    CASE "D"
                        Fldsize(Numoflds) = 8
                        Flddcml(Numoflds) = Zero
                    CASE "T"
                        Fldsize(Numoflds) = 8
                        Flddcml(Numoflds) = Zero
                    CASE "L"
                        Fldsize(Numoflds) = One
                        Flddcml(Numoflds) = Zero
                    CASE "A", "C"
                        Flddcml(Numoflds) = Zero
                    CASE "N"
                        REM
                END SELECT
            CASE "3"
                IF INSTR("ANC", UCASE$(Fldtype$(Numoflds))) > 0 THEN
                    INPUT "Enter field size: ", Fldsize(Numoflds)
                END IF
            CASE "4"
                IF INSTR("N", UCASE$(Fldtype$(Numoflds))) > 0 THEN
                    INPUT "Enter number of decimal places: ", Flddcml(Numoflds)
                    IF Flddcml(Numoflds) > 0 THEN
                        Fldsize(Numoflds) = Fldsize(Numoflds) + 1
                    END IF
                END IF
            CASE "0"
                PRINT "Done."
            CASE ELSE
                REM
        END SELECT
    WEND
NEXT Numoflds
PRINT "Recording data, Please wait!"
PRINT #One, Numoflds; ","; Exitcode$; ",";
FOR Rcrds = One TO Numoflds
    PRINT #One, Fldname$(Rcrds); ","; Fldsize(Rcrds); ","; Fldtype$(Rcrds); ","; Flddcml(Rcrds); ",";
NEXT Rcrds
PRINT #One, ""
CLOSE #One
RETURN

LizzyDB.Build:
' ********************************************************************
' mainline
Start:
GOSUB Housekeeping
WHILE Choice <> Byebye
    GOSUB Dataedit
WEND
GOSUB Endofjob
RETURN
' *********************************************************************

Housekeeping:
'-------------------------------------------------------------------
' project start
GOSUB Get.a.filename
'-------------------------------------------------------------------
' get meta data
 OPEN Datafil$ + ".met" FOR INPUT AS #Two
INPUT #Two, Fieldsiz, Exitcode$
FOR x = One TO Fieldsiz
    INPUT #Two, Prompt$(x), size!(x), Type$(x), Dcmlsize(x)
    Totalsiz = Totalsiz + size!(x)
NEXT x
CLOSE #Two
'-------------------------------------------------------------------
' open datafile
OPEN Datafil$ + ".dat" FOR RANDOM AS #One LEN = Totalsiz
Hr = LOF(One) / Totalsiz
FIELD #One, size!(One) AS Dataout$(One)
Dummysiz = size!(One)
FOR x = 2 TO Fieldsiz
    FIELD #One, Dummysiz AS x$, size!(x) AS Dataout$(x)
    Dummysiz = Dummysiz + size!(x)
NEXT x
RETURN

Dataedit:
'===================================================================
' process of data editing
Choice = 0
WHILE Choice <> Byebye
    DO
        Vpos = 5
        Message = 20
        Column = 10
        name$(1, 1) = "Append"
        name$(1, 2) = "Add a record to the list."
        name$(2, 1) = "Behold"
        name$(2, 2) = "Browse a record on the list."
        name$(3, 1) = "Change"
        name$(3, 2) = "Change a record in the list."
        name$(4, 1) = "Delete"
        name$(5, 2) = "Permanently delete a record from the list."
        name$(5, 1) = "Exit"
        name$(5, 2) = "End the building process."
        CLS
        LOCATE 24, 1
        PRINT STRING$(78, 196);
        PRINT "Lizzydb (V.: -1) from Computothought";
        LOCATE 1, 1
        PRINT
        PRINT TAB(10); "Build a file using: "; Quote$; Datafil$; "."; Quote$
        menu$ = "with Lizzydb Filing Cabinet"
        CALL Vmenu(name$(), Vpos, Message, Column, menu$)
        PRINT
        Choice = Vpos
        SELECT CASE Vpos
            CASE 1
                GOSUB Append.record
                Sr = Zero
            CASE 2
                GOSUB Behold.record
            CASE 3
                GOSUB Change.record
                Sr = Zero
            CASE 4
                GOSUB Delete.record
                Sr = Zero
            CASE 5
                EXIT DO
            CASE ELSE
                REM
                Choice = 0
        END SELECT
    LOOP
WEND
RETURN

Endofjob:
'===================================================================
' end of job
CLOSE #One
CLOSE
RETURN

Append.record:
'-------------------------------------------------------------------
' append record
DO WHILE Datain$ <> Exitcode$
    GOSUB Display.meta.DATA
    GOSUB Display.bottom
    Hr = Hr + One
    FOR Sl = One TO Fieldsiz
        LOCATE (Sl + 4), 21
        SELECT CASE Type$(Sl)
            CASE "L"
                Datain$(Sl) = Acquire.logical$(size!(Sl))
            CASE "A"
                Datain$(Sl) = Acquire.text$(size!(Sl))
            CASE "N"
                Datain$(Sl) = Acquire.numbers$(size!(Sl), Dcmlsize!(Sl))
            CASE "D"
                Datain$(Sl) = Acquire.date$(size!(Sl))
            CASE "T"
                Datain$(Sl) = Acquire.time$(size!(Sl))
            CASE "C"
                Datain$(Sl) = Acquire.chars$(size!(Sl))
        END SELECT
        IF Sl = One AND Datain$(One) = Exitcode$ THEN
            Hr = Hr - One
            EXIT DO
        END IF
    NEXT Sl
    GOSUB Edit.DATA
LOOP
RETURN


Behold.record:
'-------------------------------------------------------------------
' behold record
GOSUB Display.meta.DATA
GOSUB Display.bottom
GOSUB Display.prompt
FOR Sl = One TO Fieldsiz
    LOCATE (4 + Sl), 21
    PRINT Dataout$(Sl);
NEXT Sl
LOCATE Size.of.screen - One, One
PRINT Blanklin$;
Answer$ = ""
LOCATE Size.of.screen - One, One
PRINT "Press enter to exit";
WHILE Answer$ = ""
    Answer$ = INKEY$
WEND
RETURN

Change.record:
'-------------------------------------------------------------------
' change record
GOSUB Display.meta.DATA
GOSUB Display.bottom
GOSUB Display.prompt
FOR x = One TO Fieldsiz
    Datain$(x) = Dataout$(x)
    LOCATE (4 + x), 21
    PRINT Datain$(x);
NEXT x
GOSUB Edit.DATA
RETURN

Delete.record:
'-------------------------------------------------------------------
' delete record
GOSUB Display.meta.DATA
GOSUB Display.bottom
GOSUB Display.prompt
FOR Sl = One TO Fieldsiz
    LOCATE (4 + Sl), 21
    PRINT Dataout$(Sl);
NEXT Sl
Answer$ = ""
LOCATE Size.of.screen - One, One
INPUT "Do you really want to delete this record (Y/N): ", Answer$
IF UCASE$(Answer$) <> "Y" THEN
    PRINT "Data not deleted!"
    RETURN
END IF
LOCATE Size.of.screen, One
PRINT Blanklin$;
LOCATE Size.of.screen, One
PRINT "Recording data!"
OPEN Datafil$ + ".OLD" FOR APPEND AS #Two
FOR x = One TO Fieldsiz - One
    PRINT #Two, Dataout$(x); ",";
    LSET Dataout$(x) = " "
NEXT x
PRINT #Two, Dataout$(x)
LSET Dataout$(x) = " "
CLOSE #Two
Recnum = Rn
PUT #One, Recnum
RETURN

Display.meta.DATA:
'-------------------------------------------------------------------
' display meta data
CLS
LOCATE 2, 10
PRINT TAB(12); "LizzyDB filing cabinet"
PRINT TAB(12); "  Using "; Quote$; Datafil$; Quote$; " File"
FOR Sl = One TO Fieldsiz
    LOCATE (4 + Sl), One
    PRINT STR$(Sl) + ".]      "; LEFT$(Prompt$(Sl) + Blanks$, 8); ": ";
NEXT Sl
RETURN

Display.bottom:
'-------------------------------------------------------------------
' display bottom
LOCATE Size.of.screen, One
PRINT Blanklin$;
LOCATE Size.of.screen, One
PRINT Choicetyp$(Choice); " Records";
RETURN

Display.prompt:
'-------------------------------------------------------------------
' display bottom prompt
Rn = Zero
WHILE Rn > Hr OR Rn = Zero
    LOCATE Size.of.screen - One, One
    PRINT Blanklin$;
    LOCATE Size.of.screen - One, One
    PRINT "Enter record to " + Choicetyp$(Choice) + ": ";
    Rn = VAL(Acquire.text$(4))
WEND
Recnum = Rn
GET #One, Recnum
RETURN

Edit.DATA:
'-------------------------------------------------------------------
' edit current data
Answer$ = ""
WHILE Answer$ <> "0"
    LOCATE Size.of.screen - One, One
    PRINT Blanklin$;
    LOCATE Size.of.screen - One, One
    PRINT "Enter line # to change: ";
    Answer$ = Acquire.text$(2)
    IF VAL(Answer$) > Zero AND VAL(Answer$) <= Fieldsiz THEN
        GOSUB Input.changed
    END IF
WEND
LOCATE Size.of.screen, One
PRINT Blanklin$;
LOCATE Size.of.screen, One
PRINT "Recording data!"
FOR Sl = One TO Fieldsiz
    LSET Dataout$(Sl) = Datain$(Sl)
NEXT Sl
Recnum = Hr
PUT #One, Recnum
RETURN

Input.changed:
'------------------------------------------------------------------
' input changed data from keyboard
LOCATE (VAL(Answer$) + 4), 21
OLDDATA$ = Datain$(VAL(Answer$))
SELECT CASE Type$(VAL(Answer$))
    CASE "L"
        Datain$(VAL(Answer$)) = Acquire.logical$(size!(VAL(Answer$)))
    CASE "A"
        Datain$(VAL(Answer$)) = Acquire.text$(size!(VAL(Answer$)))
    CASE "N"
        Datain$(VAL(Answer$)) = Acquire.numbers$(size!(VAL(Answer$)), Dcmlsize!(VAL(Answer$)))
    CASE "D"
        Datain$(VAL(Answer$)) = Acquire.date$(size!(VAL(Answer$)))
    CASE "T"
        Datain$(VAL(Answer$)) = Acquire.time$(size!(VAL(Answer$)))
    CASE "C"
        Datain$(VAL(Answer$)) = Acquire.chars$(size!(VAL(Answer$)))
END SELECT
IF Datain$(VAL(Answer$)) = "" THEN
    Datain$(VAL(Answer$)) = OLDDATA$
END IF
RETURN

LizzyDB.Report:
IF Sf = 1 THEN
    GOSUB Do.report.hsk
    DO
        GOSUB Do.report.process
    LOOP UNTIL End.flag$ = "on"
    GOSUB Do.report.eoj
ELSE
    PRINT
    PRINT "A sort must be done first!"
    No.answer$ = INPUT$(1)
END IF
RETURN

Do.report.hsk:
CLOSE
GOSUB Get.a.filename
End.flag$ = "off"
Line.count = 1
Line.max = 60
Div.hold$ = ""
OPEN Datafil$ + ".key" FOR INPUT AS #Six
INPUT #Six, TheKey
CLOSE #Six
OPEN Datafil$ + ".met" FOR INPUT AS #Two
INPUT #Two, Fieldsiz, Exitcode$
Totalsiz = 0
FOR x = One TO Fieldsiz
    INPUT #Two, Prompt$(x), size!(x), Type$(x), Dcmlsize(x)
    Totalsiz = Totalsiz + size!(x)
NEXT x
CLOSE #Two
OPEN Datafil$ + ".dat" FOR RANDOM AS #One LEN = Totalsiz
Hr = INT(LOF(One) / Totalsiz)
FIELD #One, size!(One) AS Dataout$(One)
Dummysiz = size!(One)
FOR x = 2 TO Fieldsiz
    FIELD #One, Dummysiz AS x$, size!(x) AS Dataout$(x)
    Dummysiz = Dummysiz + size!(x)
NEXT x
Recnum = Zero
FRF = 1
Top.of.page = 12
Page.num = Zero
Sf = Zero
OPEN Datafil$ + ".ndx" FOR INPUT AS #Three
OPEN Datafil$ + ".rpt" FOR OUTPUT AS #Five
RETURN

Do.report.process:
GOSUB Rpt.read.it
GOSUB Rpt.divchk
GOSUB Rpt.detail.line
RETURN

Do.report.eoj:
CLOSE #One
CLOSE #Two
CLOSE #Three
CLOSE #Five
RETURN


Rpt.read.it:
INPUT #Three, Recnum
IF EOF(3) THEN
    End.flag$ = "on"
END IF
GET #One, Recnum
Divchk$ = Dataout$(TheKey)
RETURN

Rpt.divchk:
IF Div.hold$ <> Divchk$ THEN
    Div.hold$ = Divchk$
    FRF = One
    GOSUB Rpt.header
ELSE
    IF Line.count > Line.max THEN
        GOSUB Rpt.header
    END IF
END IF
RETURN

Rpt.detail.line:
Line.count = Line.count + One
Tz = 0
FOR x = 1 TO Fieldsiz
    Tz = Tz + size!(x)
    IF x <> TheKey THEN
        PRINT #Five, RTRIM$(Dataout$(x)); TAB(Tz + 1);
    ELSE
        IF FRF = Zero THEN
            PRINT #Five, SPACE$(size!(x - 1)); TAB(Tz + 1);
        ELSE
            PRINT #Five, RTRIM$(Dataout$(x)); TAB(Tz + 1);
            FRF = Zero
        END IF
    END IF
NEXT x
PRINT #Five, " "; Recnum
RETURN

Rpt.header:
Page.num = Page.num + One
Line.count = 8
PRINT #Five, CHR$(Top.of.page);
PRINT #Five, ""
PRINT #Five, TAB(10); "This is a report of file: "; Datafil$
PRINT #Five, TAB(10); "On "; DATE$; " at "; TIME$; "."
PRINT #Five, TAB(10); "Page number: "; Page.num
PRINT #Five, ""
Dsize = 0
FOR x = 1 TO Fieldsiz
    Dsize = Dsize + size!(x)
    PRINT #Five, RTRIM$(LEFT$(Prompt$(x), size!(x))); TAB(Dsize + 1);
NEXT x
PRINT #5, ""
PRINT #Five, STRING$(Totalsiz, "-")
RETURN


LizzyDB.Sort:
GOSUB Get.a.filename
CLS
PRINT
PRINT "Choose a Key: "
PRINT
OPEN Datafil$ + ".met" FOR INPUT AS #Two
INPUT #Two, Fieldsiz, Exitcode$
Totalsiz = 0
FOR x = One TO Fieldsiz
    INPUT #Two, Prompt$(x), size(x), Type$(x), Dcmlsize!(x)
    PRINT x; ": "; Prompt$(x)
    Totalsiz = Totalsiz + size!(x)
NEXT x
CLOSE #Two
PRINT
INPUT "Enter key number to use: ", TheKey
OPEN Datafil$ + ".key" FOR OUTPUT AS #Six
PRINT #Six, TheKey
CLOSE #Six
PRINT
PRINT "Organinzing......"
OPEN Datafil$ + ".dat" FOR RANDOM AS #One LEN = Totalsiz
Hr = INT(LOF(One) / Totalsiz)
DIM Sort.array$(Hr, 2)
FIELD #One, size!(One) AS Dataout$(One)
Dummysiz = size!(One)
FOR x = 2 TO Fieldsiz
    FIELD #One, Dummysiz AS x$, size!(x) AS Dataout$(x)
    Dummysiz = Dummysiz + size!(x)
NEXT x
FOR Z = 1 TO Hr
    GET #One, Z
    Sort.array$(Z, 1) = Dataout$(TheKey)
    Sort.array$(Z, 2) = STR$(Z)
NEXT Z
CLOSE #One
GOSUB Do.sort
Sf = 1
RETURN

Do.sort:
FOR y = One TO (Hr - 1)
    FOR Z = (y + 1) TO Hr
        IF Sort.array$(y, 1) > Sort.array$(Z, 1) THEN
            SWAP Sort.array$(y, 1), Sort.array$(Z, 1)
            SWAP Sort.array$(y, 2), Sort.array$(Z, 2)
        END IF
    NEXT Z
NEXT y
OPEN Datafil$ + ".ndx" FOR OUTPUT AS #Three
FOR Z = One TO Hr
    PRINT #3, VAL(Sort.array$(Z, 2))
NEXT Z
CLOSE #Three
RETURN

Get.a.filename:
'-------------------------------------------------------------------
' project start
Datafil$ = ""
WHILE Datafil$ = ""
    LOCATE 15, 5
    INPUT "Enter project to use: ", Datafil$
WEND
IF Datafil$ = Quit$ THEN
    Choice = 5
    RETURN
END IF
'-------------------------------------------------------------------
'fix name for header
'Datafil$ = UCASE$(LEFT$(Datafil$, One)) + LCASE$(RIGHT$(Datafil$, LEN(Datafil$) - One))
RETURN

'******************************************************************
' The end of code
'******************************************************************

DEFSNG A-Z
FUNCTION Acquire.chars$ (Maxlen!)
Crow = CSRLIN
Ccol = POS(0)
PRINT STRING$(Maxlen!, "_"); STRING$(Maxlen!, CHR$(29));
DO
    LOCATE Crow, Ccol
    GOSUB Gline6
    Temp$ = In.line$
    IF RIGHT$(Temp$, 1) = CHR$(&HD) THEN
        Temp$ = LEFT$(Temp$, LEN(Temp$) - 1)
    END IF
    Testlen = LEN(Temp$)
    IF Testlen > Maxlen THEN
        CALL Utoh(Crow, Ccol, Testlen)
    ELSE
        EXIT DO
    END IF
LOOP
Acquire.chars$ = Temp$

EXIT FUNCTION

' ------------------------------------------------
' gchar - get a character
Gchar6:
DO
    Clizzy$ = INPUT$(1)
    IF Clizzy$ = CHR$(&HD) THEN
        EXIT DO
    END IF
LOOP WHILE (Clizzy$ < "A" OR Clizzy$ > "Z") AND (Clizzy$ < "a" OR Clizzy$ > "z") AND Clizzy$ <> CHR$(8) AND Clizzy$ <> "."
C = ASC(Clizzy$)
IF C <> 8 THEN
    IF C <> &HD THEN
        PRINT CHR$(C);
    END IF
ELSE
    IF LEN(In.line$) > 0 THEN
        PRINT CHR$(29); " _"; CHR$(29); CHR$(29); CHR$(95); CHR$(29);
    END IF
END IF
RETURN
' ----------------------------------------------------
' gline - get a line
Gline6:
In.line$ = ""
DO
    GOSUB Gchar6
    SELECT CASE C
        CASE &HD
            REM
        CASE 29, 8
            IF LEN(In.line$) > 0 THEN
                In.line$ = LEFT$(In.line$, LEN(In.line$) - 1)
            END IF
        CASE ELSE
            In.line$ = In.line$ + CHR$(C)
    END SELECT
LOOP UNTIL LEN(In.line$) >= Maxlen OR (C = &HD AND LEN(In.line$) >= Zero)
RETURN

END FUNCTION

'=================================================
FUNCTION Acquire.date$ (Maxlen)
One = 1
Two = 2
Crow = CSRLIN
Ccol = POS(0)
LOCATE Crow, Ccol
PRINT "__/__/__"; STRING$(8, CHR$(29));
GOSUB Gline3
PRINT
Acquire.date$ = In.line$
EXIT FUNCTION

' ------------------------------------------------
' gchar - get a character
Gchar3:
SELECT CASE LEN(In.line$)
    CASE 0
        DO
            Clizzy$ = INPUT$(One)
        LOOP UNTIL (INSTR("01", Clizzy$) > Zero)
    CASE One
        SELECT CASE LEFT$(In.line$, One)
            CASE "0"
                DO
                    Clizzy$ = INPUT$(One)
                LOOP UNTIL INSTR("123456789" + CHR$(8), UCASE$(Clizzy$)) > Zero
            CASE "1"
                DO
                    Clizzy$ = INPUT$(One)
                LOOP UNTIL INSTR("012" + CHR$(8), UCASE$(Clizzy$)) > Zero
        END SELECT
    CASE 2, 5
        Clizzy$ = "/"
    CASE 3
        DO
            Clizzy$ = INPUT$(One)
        LOOP UNTIL INSTR("0123" + CHR$(8), Clizzy$) > Zero
    CASE 4
        SELECT CASE MID$(In.line$, 4, One)
            CASE "0"
                DO
                    Clizzy$ = INPUT$(One)
                LOOP UNTIL INSTR("123456789" + CHR$(8), Clizzy$) > Zero
            CASE "1", "2"
                DO
                    Clizzy$ = INPUT$(One)
                LOOP UNTIL INSTR("0123456789" + CHR$(8), Clizzy$) > Zero
            CASE "3"
                DO
                    Clizzy$ = INPUT$(One)
                LOOP UNTIL INSTR("01" + CHR$(8), Clizzy$) > Zero
        END SELECT
    CASE 6, 7
        DO
            Clizzy$ = INPUT$(One)
        LOOP UNTIL INSTR("0123456789" + CHR$(8), Clizzy$) > Zero
    CASE ELSE
        REM
END SELECT
IF Clizzy$ <> "" THEN
    C = ASC(Clizzy$)
    IF C <> 8 THEN
        IF C <> &HD THEN
            PRINT CHR$(C);
        END IF
    ELSE
        SELECT CASE LEN(In.line$)
            CASE 0
                REM
            CASE 3, 6
                PRINT CHR$(29); "/"; CHR$(29); CHR$(29); "_"; CHR$(29);
            CASE ELSE
                PRINT CHR$(29); "_"; CHR$(29);
        END SELECT
    END IF
END IF
RETURN
' ----------------------------------------------------
' gline - get a line
Gline3:
In.line$ = ""
DO
    GOSUB Gchar3
    SELECT CASE C
        CASE &HD
            REM
        CASE 29, 8
            SELECT CASE LEN(In.line$)
                CASE 0
                    REM
                CASE 1, 2, 4, 7
                    In.line$ = LEFT$(In.line$, LEN(In.line$) - One)
                CASE 3, 6
                    In.line$ = LEFT$(In.line$, LEN(In.line$) - Two)
            END SELECT
        CASE ELSE
            In.line$ = In.line$ + CHR$(C)
    END SELECT
LOOP UNTIL LEN(In.line$) >= Maxlen OR (C = &HD AND LEN(In.line$) >= Zero)
RETURN

END FUNCTION

'=================================================
FUNCTION Acquire.logical$ (Maxlen)
IF Maxlen = Zero THEN
    Maxlen = 1
END IF
Crow = CSRLIN
Ccol = POS(0)
LOCATE Crow, Ccol
PRINT "_"; CHR$(29);
GOSUB Gline2
PRINT
Acquire.logical$ = In.line$
EXIT FUNCTION

' ------------------------------------------------
' gchar - get a character
Gchar2:
DO
    Clizzy$ = UCASE$(INPUT$(1))
LOOP WHILE Clizzy$ <> "T" AND Clizzy$ <> "F"
C = ASC(Clizzy$)
IF C <> 8 THEN
    IF C <> &HD THEN
        PRINT CHR$(C);
    END IF
ELSE
    IF LEN(In.line$) > 0 THEN
        PRINT CHR$(29); " _"; CHR$(29); CHR$(29); CHR$(95); CHR$(29);
    END IF
END IF
RETURN
' ----------------------------------------------------
' gline - get a line
Gline2:
In.line$ = ""
DO
    GOSUB Gchar2
    SELECT CASE C
        CASE &HD
            REM
        CASE 29, 8
            IF LEN(In.line$) > 0 THEN
                In.line$ = LEFT$(In.line$, LEN(In.line$) - 1)
            END IF
        CASE ELSE
            In.line$ = In.line$ + CHR$(C)
    END SELECT
LOOP UNTIL LEN(In.line$) >= Maxlen OR (C = &HD AND LEN(In.line$) >= Zero)
RETURN
END FUNCTION

'=================================================
FUNCTION Acquire.numbers$ (Maxlen!, Dcmlplaces!)
Crow = CSRLIN
Ccol = POS(0)
IF Dcmlplaces > 0 THEN
    PRINT STRING$(Maxlen! - Dcmlplaces - 1, "_");
    PRINT "."; STRING$(Dcmlplaces, "_");
ELSE
    PRINT STRING$(Maxlen! - Dcmlplaces, "_");
END IF
PRINT STRING$(Maxlen!, CHR$(29));
DO
    LOCATE Crow, Ccol
    GOSUB Gline
    Temp1$ = In.line$
    IF RIGHT$(Temp1$, 1) = CHR$(&HD) THEN
        Temp1$ = LEFT$(Temp1$, LEN(Temp$) - 1)
    END IF
    Testlen = LEN(Temp1$)
    IF Testlen > Maxlen THEN
        CALL Utoh(Crow, Ccol, Testlen)
    ELSE
        EXIT DO
    END IF
LOOP
Acquire.numbers$ = Temp1$

EXIT FUNCTION

' ------------------------------------------------
' gchar - get a character
Gchar:
SELECT CASE LEN(In.line$)
    CASE Maxlen - Dcmlplaces - 1
        IF Dcmlplaces > 0 THEN
            Clizzy$ = "."
        ELSE
            DO
                Clizzy$ = INPUT$(1)
                IF Clizzy$ = CHR$(&HD) THEN
                    EXIT DO
                END IF
            LOOP WHILE (Clizzy$ < "0" OR Clizzy$ > "9") AND Clizzy$ <> CHR$(8) AND Clizzy$ <> "."
        END IF
    CASE ELSE
        DO
            Clizzy$ = INPUT$(1)
            IF Clizzy$ = CHR$(&HD) THEN
                EXIT DO
            END IF
        LOOP WHILE (Clizzy$ < "0" OR Clizzy$ > "9") AND Clizzy$ <> CHR$(8) AND Clizzy$ <> "."
END SELECT
C = ASC(Clizzy$)
IF C <> 8 THEN
    IF C <> &HD THEN
        PRINT CHR$(C);
    END IF
ELSE
    IF LEN(In.line$) > 0 THEN
        IF LEN(In.line$) = Maxlen! - Dcmlplaces THEN
            PRINT CHR$(29); "."; CHR$(29); CHR$(29); "_"; CHR$(29);
        ELSE
            PRINT CHR$(29); "_"; CHR$(29);
        END IF
    END IF
END IF
RETURN

' ----------------------------------------------------
' gline - get a line
Gline:
In.line$ = ""
DO
    GOSUB Gchar
    SELECT CASE C
        CASE &HD
            REM
        CASE 29, 8
            IF LEN(In.line$) > 0 THEN
                IF LEN(In.line$) <> Maxlen! - Dcmlplaces THEN
                    In.line$ = LEFT$(In.line$, LEN(In.line$) - 1)
                ELSE
                    In.line$ = LEFT$(In.line$, LEN(In.line$) - 2)
                END IF
            END IF
        CASE ELSE
            In.line$ = In.line$ + CHR$(C)
    END SELECT
LOOP UNTIL LEN(In.line$) >= Maxlen OR (C = &HD AND LEN(In.line$) >= Zero)
RETURN


END FUNCTION

'=================================================
FUNCTION Acquire.text$ (Maxlen!)
Crow = CSRLIN
Ccol = POS(0)
LOCATE Crow, Ccol
PRINT STRING$(Maxlen!, "_"); STRING$(Maxlen!, CHR$(29));
GOSUB Gline1
'PRINT
Acquire.text$ = In.line$
EXIT FUNCTION

' ------------------------------------------------
' gchar - get a character
Gchar1:
Clizzy$ = INPUT$(1)
C = ASC(Clizzy$)
IF C <> 8 THEN
    IF C <> &HD THEN
        PRINT CHR$(C);
    END IF
ELSE
    IF LEN(In.line$) > 0 THEN
        'PRINT CHR$(29); " "; CHR$(29);
        PRINT CHR$(29); " _"; CHR$(29); CHR$(29); CHR$(95); CHR$(29);
    END IF
END IF
RETURN
' ----------------------------------------------------
' gline - get a line
Gline1:
In.line$ = ""
DO
    GOSUB Gchar1
    SELECT CASE C
        CASE &HD
            REM
        CASE 29, 8
            IF LEN(In.line$) > 0 THEN
                In.line$ = LEFT$(In.line$, LEN(In.line$) - 1)
            END IF
        CASE ELSE
            In.line$ = In.line$ + CHR$(C)
    END SELECT
LOOP UNTIL LEN(In.line$) >= Maxlen OR (C = &HD AND LEN(In.line$) >= Zero)
RETURN

END FUNCTION

FUNCTION Acquire.time$ (Maxlen!)
One = 1
Two = 2
Crow = CSRLIN
Ccol = POS(0)
LOCATE Crow, Ccol
PRINT "__:__:__"; STRING$(8, CHR$(29));
GOSUB Gline4
PRINT
Acquire.time$ = In.line$
EXIT FUNCTION

' ------------------------------------------------
' gchar - get a character
Gchar4:
SELECT CASE LEN(In.line$)
    CASE 0
        DO
            Clizzy$ = INPUT$(One)
        LOOP UNTIL (INSTR("012", Clizzy$) > Zero)
    CASE One
        SELECT CASE LEFT$(In.line$, One)
            CASE "0", "!"
                DO
                    Clizzy$ = INPUT$(One)
                LOOP UNTIL INSTR("0123456789" + CHR$(8), UCASE$(Clizzy$)) > Zero
            CASE "2"
                DO
                    Clizzy$ = INPUT$(One)
                LOOP UNTIL INSTR("01234" + CHR$(8), UCASE$(Clizzy$)) > Zero
        END SELECT
    CASE 2, 5
        Clizzy$ = ":"
    CASE 3
        DO
            Clizzy$ = INPUT$(One)
        LOOP UNTIL INSTR("0123456" + CHR$(8), Clizzy$) > Zero
    CASE 4
        SELECT CASE MID$(In.line$, 4, One)
            CASE "0", "1", "2", "3", "4", "5"
                DO
                    Clizzy$ = INPUT$(One)
                LOOP UNTIL INSTR("0123456789" + CHR$(8), Clizzy$) > Zero
            CASE "6"
                DO
                    Clizzy$ = INPUT$(One)
                LOOP UNTIL INSTR("0" + CHR$(8), Clizzy$) > Zero
        END SELECT
    CASE 6, 7
        DO
            Clizzy$ = INPUT$(One)
        LOOP UNTIL INSTR("0123456789" + CHR$(8), Clizzy$) > Zero
    CASE ELSE
        REM
END SELECT
IF Clizzy$ <> "" THEN
    C = ASC(Clizzy$)
    IF C <> 8 THEN
        IF C <> &HD THEN
            PRINT CHR$(C);
        END IF
    ELSE
        SELECT CASE LEN(In.line$)
            CASE 0
                REM
            CASE 3, 6
                PRINT CHR$(29); ":"; CHR$(29); CHR$(29); "_"; CHR$(29);
            CASE ELSE
                PRINT CHR$(29); "_"; CHR$(29);
        END SELECT
    END IF
END IF
RETURN
' ----------------------------------------------------
' gline - get a line
Gline4:
In.line$ = ""
DO
    GOSUB Gchar4
    SELECT CASE C
        CASE &HD
            REM
        CASE 29, 8
            SELECT CASE LEN(In.line$)
                CASE 0
                    REM
                CASE 1, 2, 4, 7
                    In.line$ = LEFT$(In.line$, LEN(In.line$) - One)
                CASE 3, 6
                    In.line$ = LEFT$(In.line$, LEN(In.line$) - Two)
            END SELECT
        CASE ELSE
            In.line$ = In.line$ + CHR$(C)
    END SELECT
LOOP UNTIL LEN(In.line$) >= Maxlen OR (C = &HD AND LEN(In.line$) >= Zero)
RETURN

END FUNCTION

DEFINT A-Z
SUB prvmenu (name$(), Column, Message, Vpos)
name$(1, 1) = name$(1, 1)
v = UBOUND(name$, 1)
FOR x = 1 TO v
    LOCATE x + 4, Column
    IF x = Vpos THEN
        COLOR 0, 7
        PRINT name$(x, 1)
        COLOR 7, 0
    ELSE
        PRINT name$(x, 1)
    END IF
NEXT x
LOCATE Message, Column
PRINT SPACE$(50)
LOCATE Message, Column
PRINT name$(Vpos, 2)
IF v + 6 < Message - 2 THEN
    LOCATE v + 6, Column
    PRINT "Use first letter or up/down arrows to select"
    LOCATE v + 7, Column
    PRINT "Press return to select"
END IF
END SUB

DEFSNG A-Z
'=================================================
SUB Utoh (cr, cc, length)
LOCATE cr, cc
PRINT SPACE$(length);
LOCATE cr, cc
END SUB

DEFINT A-Z
SUB Vmenu (name$(), Vpos, Message, Column, menu$)
name$(1, 1) = name$(1, 1)
LOCATE 3, Column
PRINT menu$
CALL prvmenu(name$(), Column, Message, Vpos)
r$ = ""
DO WHILE r$ <> CHR$(&HD)
    r$ = ""
    DO WHILE r$ = ""
        r$ = INKEY$
    LOOP
    IF LEN(r$) = 2 THEN
        SELECT CASE ASC(RIGHT$(r$, 1))
            CASE IS = 80
                Vpos = Vpos + 1
                IF Vpos > UBOUND(name$, 1) THEN
                    Vpos = 1
                END IF
                CALL prvmenu(name$(), Column, Message, Vpos)
            CASE IS = 72
                Vpos = Vpos - 1
                IF Vpos < 1 THEN
                    Vpos = UBOUND(name$, 1)
                END IF
                CALL prvmenu(name$(), Column, Message, Vpos)
            CASE ELSE
                BEEP
        END SELECT
    ELSE
        IF UCASE$(r$) >= "A" AND UCASE$(r$) <= "Z" THEN
            x = 1
            DO WHILE x <= UBOUND(name$, 1)
                IF UCASE$(r$) = UCASE$(LEFT$(name$(x, 1), 1)) THEN
                    Vpos = x
                    CALL prvmenu(name$(), Column, Message, Vpos)
                    EXIT DO
                ELSE
                    x = x + 1
                END IF
            LOOP
            IF x > UBOUND(name$, 1) THEN
                BEEP
            END IF
        ELSEIF r$ <> CHR$(&HD) THEN
            BEEP
        END IF
    END IF
LOOP
END SUB