'*****************************************
'*                                       *
'*  This Program is a General Purpose    *
'*  EDUCATIONAL PROGRAM, and forms the   *
'*  Second Portion of the BASICTUTORIAL  *
'*  BY Frank Wilkinson for MEGADISC      *
'*                                       *
'*****************************************
'
Init:'                     A Label
SCREEN 1,640,256,3,2
'
'
WINDOW 2,"Data Base",(0,0)-(631,240),16,1
'
PALETTE 0,0,0,0:    '    Black
PALETTE 1,1,1,1:    '    White
PALETTE 2,.5,0,0:   '    Red
PALETTE 3,0,.7,0:   '    Green
PALETTE 4,.9,.5,0:  '    Yellow
PALETTE 5,0,.3,.6:  '    Blue
PALETTE 6,1,0,1:    '    Violet
PALETTE 7,.5,.5,.5: '    Grey
'
black  = 0
white  = 1
red    = 2
green  = 3
yellow = 4
blue   = 5
violet = 6
grey   = 7

e$=SPACE$(34):
s$=SPACE$(40):
w$=SPACE$(41):

COLOR black,green
a$=" A Data Base Program ":r=2
center r,a$

COLOR red,grey
a$=" Written by  Frank Wilkinson ":r=10
center r,a$

a$=" Copyright Sept 1991 Frank Wilkinson ":r=12
center r,a$

a$=" All rights Reserved ":r=14
center r,a$
FOR de=1 TO 5000:NEXT
    OPEN "Vars" FOR APPEND AS 3
      IF LOF(3)<=0 THEN VarExist=0 ELSE VarExist=1
    CLOSE 3
      IF VarExist=1 THEN
          COLOR green,black:CLS
          LOCATE 10,20:PRINT SPACE$(60):BEEP
          LOCATE 10,20:COLOR yellow,black
          PRINT "Welcome to your own"
          LOCATE 13,20:PRINT "Personalized DataBase"
          FOR de = 1 TO 6000:NEXT de
          GOTO  Begin
      END IF

SetVars:
    COLOR green,black:CLS:PRINT :PRINT :PRINT 
    INPUT "Is this the first time you have used this Program? (Y/N)  ";an$
      IF UCASE$(an$)="N" THEN Begin
      IF UCASE$(an$)<>"Y" AND UCASE$(an$)<>"N" THEN SetVars
    CLS
    LOCATE 4,5: COLOR red,black
    PRINT "Please Type in the Full Pathname for this Program"
    LOCATE 6,5: COLOR yellow,black:PRINT "i,e { DF1:Basic/Programs }
    LOCATE 8,5: COLOR green,black
    PRINT "This will be the Home Directory the program gets its Files from,"
    PRINT "    and RETURNS to after a looking at another Directory."
    LOCATE 11,5:COLOR red,black:PRINT "PATH ":LOCATE 11,12
    LINE INPUT Home$
    COLOR green,black
    CLS
    LOCATE 4,5: PRINT "Please type in your own Name { i.e :";
    COLOR yellow,black:PRINT "Mr Adam & Mrs Eve Firstpeople"
    LOCATE 7,5:COLOR red,black:PRINT "Name      > ";
    COLOR yellow,black:LINE INPUT RetName$

    COLOR green,black
    CLS
    LOCATE 4,5: PRINT "Please type in your own Address { i.e :";
    COLOR yellow,black:PRINT "1 Paradise Street"
    LOCATE 7,5:COLOR red,black:PRINT "Address   > ";
    COLOR yellow,black:LINE INPUT RetAddr$

    COLOR green,black
    CLS
    LOCATE 4,5: PRINT "Please type in your own City/State/PCode { i.e :";
    COLOR yellow,black:PRINT "GardenOfEden SA 5999
    LOCATE 7,5:COLOR red,black:PRINT "City      > ";
    COLOR yellow,black:LINE INPUT RetCity$
    OPEN "Vars" FOR OUTPUT AS 3
        WRITE #3,Home$
        WRITE #3,RetName$
        WRITE #3,RetAddr$
        WRITE #3,RetCity$
    CLOSE 3

Begin:
    COLOR green,black
    CLS
    OPEN "Vars" FOR APPEND AS 3
      IF LOF(3)<=0 THEN VarExist=0 ELSE VarExist=1
    CLOSE 3
      IF VarExist=0 THEN
          LOCATE 10,1:PRINT SPACE$(80):BEEP
          LOCATE 10,1:COLOR yellow,black
          PRINT "The Home and Address Variables"
          LOCATE 13,1:PRINT "Do not Exist"
          KILL "Vars"
          COLOR green,black
          GOTO  SetVars
      END IF
    OPEN "Vars" FOR INPUT AS 3
        INPUT #3,Home$
        INPUT #3,RetName$
        INPUT #3,RetAddr$
        INPUT #3,RetCity$
    CLOSE 3
    
a$=" Press the Right Mouse Button for Menu ":r=15
center r,a$

MENU 2,0,0," "
MENU 3,0,0," "
MENU 4,0,0," "
MENU 1,0,1,"  Program"
MENU 1,1,1,"  Create a New File"
MENU 1,2,1,"  Make a New Entry "
MENU 1,3,1,"  View an Entry    "
MENU 1,4,1,"  Lookup an Entry  "
MENU 1,5,1,"  Directory        "
MENU 1,6,1,"  Quit to Basic    "

ON MENU GOSUB MenuSelect
MENU ON

MainLoop:
  WHILE -1
  WEND

  GOTO cleanup

END:

********************* LABEL ROUTINES GO HERE ********************************

MenuSelect:
  Selection=MENU(1)
  IF Selection=1 THEN GOSUB CreateNewFile:RETURN
  IF Selection=2 THEN GOSUB RecordEntry:RETURN
  IF Selection=3 THEN InfoLookup = 0:GOSUB InfoReader:RETURN
  IF Selection=4 THEN InfoLookup = 1:GOSUB InfoReader:RETURN
  IF Selection=5 THEN GOSUB Directory:RETURN
  IF Selection=6 THEN GOTO  cleanup

cleanup:
COLOR white,black
WINDOW CLOSE 9
WINDOW CLOSE 2
SCREEN CLOSE 1
END


CreateNewFile:
  CLS:LOCATE 1,1:COLOR red,grey:PRINT " Create New File "
  LOCATE 1,25:COLOR red,grey:PRINT " Filename: ";
  COLOR yellow,black:PRINT "(no file yet)"
  COLOR red,black:LOCATE 3,1
  PRINT "Enter name of Field and length of field."
 FOR c=0 TO 9
    NameofField$="":Length(c)=0
  NEXT c
  LOCATE 4,1:PRINT "Name":LOCATE 4,26:PRINT "Length (Maximum 40)
  FOR c=0 TO 9
    NumberOfFields=c
    LOCATE c+6,1:LINE INPUT NameofField$(c)
    IF NameofField$(c)="" THEN
     c=10
     NumberOfFields=NumberOfFields-1
     LOCATE 15,40:PRINT " Press RETURN "
     END IF
    NameofField$(c)=LEFT$(NameofField$(c),25)
    LOCATE c+6,26:PRINT s$
    COLOR red,black
    LOCATE c+6,26:LINE INPUT Length$
    IF Length$="" OR ABS(VAL(Length$))>40 THEN Length$="40"
    Length(c)=INT(ABS(VAL(Length$)))
    IF Length(c)=0 THEN Length(c)=40
  NEXT c

Corrections:
  GOSUB EntryOK
  IF Rite=0 THEN OpenFile:GOTO RecordEntry
  IF Rite=1 THEN ErrorCorrection
GOTO Corrections

ErrorCorrection:
  FOR c=0 TO NumberOfFields
  LOCATE c+6,1:PRINT SPACE$(60)
  LOCATE c+6,25:PRINT Length(c)
  LOCATE c+6,1:PRINT NameofField$(c)
  NEXT c
  FOR c=0 TO NumberOfFields
  LOCATE c+6,1:LINE INPUT Fieldname$
  IF NameofField$<>"" THEN NameofField$(c)=LEFT$(NameofField$,25)
  LOCATE c+6,26:LINE INPUT Length$
  IF ABS(VAL(Length$))>40 THEN Length$="40"
  IF Length$<>"" THEN Length(c)=INT(ABS(VAL(Length$)))
  IF Length(c)=0 THEN Length(c)=40
  NEXT c
  GOTO Corrections

OpenFile:
  LOCATE 19,1:PRINT SPACE$(75);
  LOCATE 19,1:COLOR red,grey:PRINT " Enter Filename: ";
  COLOR white,black:LINE INPUT FileName$
  RecordLength=0
  FOR c=0 TO NumberOfFields
    RecordLength=RecordLength+Length(c)
  NEXT c
  IF FileName$="" OR RecordLength=0 THEN BEEP:CLS:GOTO Begin
  OPEN "R",#1,FileName$,RecordLength
  FIELD #1,Length(0) AS inf$(0),Length(1) AS inf$(1),Length(2) AS inf$(2),Length(3) AS inf$(3),Length(4) AS inf$(4),Length(5) AS inf$(5),Length(6) AS inf$(6),Length(7) AS inf$(7),Length(8) AS inf$(8),Length(9) AS inf$(9)
  FOR c=1 TO NumberOfFields
  LSET inf$(c)=" "
  NEXT c
  CLOSE 1
  OPEN FileName$+".Flds" FOR OUTPUT AS 2
    PRINT  #2,NumberOfFields
    PRINT  #2,RecordLength
    PRINT  #2,0
    FOR c=0 TO NumberOfFields
      WRITE #2,NameofField$(c)
      PRINT #2,Length(c)
    NEXT c
  CLOSE 2
  AltName$=FileName$
  GOSUB ScreenClean
RETURN

RecordEntry:
  CLS:LOCATE 1,1:PRINT " Enter Info "

  IF FileName$="" THEN
    LOCATE 3,1:COLOR red,grey:PRINT " Enter Filename: "
    COLOR green,black:LINE INPUT FileName$
    IF FileName$="=" OR FileName$="-" THEN FileName$=AltName$
    IF FileName$="" THEN CLS:GOTO sBegin
    AltName$=FileName$
  END IF
  GOSUB FileDefsExistYN
    IF FileExist=0 THEN
      PRINT :COLOR green,black
      GOSUB ScreenClean :GOTO EndLoad
      GOTO Begin
    END IF
  GOSUB ReadFileDefs
  RecordNumber=NumberOfRecords+1

  OPEN "R",#1,FileName$,RecordLength
  FIELD #1,Length(0) AS inf$(0),Length(1) AS inf$(1),Length(2) AS inf$(2),Length(3) AS inf$(3),Length(4) AS inf$(4),Length(5) AS inf$(5),Length(6) AS inf$(6),Length(7) AS inf$(7),Length(8) AS inf$(8),Length(9) AS inf$(9)

InputLoop:
      CLS:LOCATE 1,1:COLOR red,grey:PRINT " Enter new data "
      LOCATE 1,25:COLOR red,grey:PRINT " File: ";
      COLOR yellow,black:PRINT " ";FileName$
      Inpt=0
      LOCATE 3,1:COLOR red,grey:PRINT " Record:";
      COLOR yellow,black:PRINT " ";RecordNumber
      PRINT :COLOR red,grey:PRINT " Enter new data: "
      COLOR yellow,black
    FOR c=0 TO NumberOfFields
      LOCATE 5+c,1:COLOR red,black:PRINT NameofField$(c)": "
    NEXT c:COLOR yellow,black
    FOR c=0 TO NumberOfFields
      LOCATE 5+c,LEN(NameofField$(c))+3
      LINE INPUT Entry$

      IF Entry$<>"" THEN Inpt=1
      Entry$(c)=LEFT$(Entry$,Length(c))
      LSET inf$(c)=Entry$(c)
    NEXT c
   Corrections2:
    GOSUB EntryOK
    IF Rite=0 THEN WriteToDisk
    IF Rite=1 THEN EnterCorrection
   GOTO Corrections2

EnterCorrection:
     CLS:LOCATE 1,1:COLOR red,grey:PRINT " Add Info "
     LOCATE 1,25:COLOR red,grey:PRINT " File: ";
     COLOR green,black:PRINT " ";FileName$

       LOCATE 3,1:COLOR red,grey:PRINT " Record Number: ";
       COLOR yellow,black:PRINT " ";RecordNumber
       PRINT :PRINT
     FOR c=0 TO NumberOfFields
       LOCATE 5+c,1:COLOR red,black:PRINT NameofField$(c)":";
       COLOR green,black:PRINT Entry$(c)
     NEXT c
     FOR c=0 TO NumberOfFields
       LOCATE 5+c,LEN(NameofField$(c))+2
       LINE INPUT Entry$
       IF Entry$<>"" THEN
         Inpt=1
         Entry$(c)=LEFT$(Entry$,Length(c))
         LSET inf$(c)=Entry$(c)
       END IF
     NEXT c
     GOTO Corrections2

WriteToDisk:
     IF Inpt=1 THEN
       PUT #1,RecordNumber
       IF InfoFlag=1 THEN InfoFlag=0:GOTO ReadLoop
       RecordNumber=RecordNumber+1
     END IF
       IF InfoFlag=1 THEN InfoFlag=0:GOTO ReadLoop

Responce:
    LOCATE 22,1:PRINT SPACE$(60):COLOR green,black
    LOCATE 22,1:PRINT "Next Record (YES or NO)";

  LINE (22,184)-(52,194),1,bf:LINE (142,184)-(164,194),1,bf
  LINE (20,182)-(50,192),5,bf:LINE (140,182)-(162,192),5,bf
  LOCATE 24,4:COLOR red,blue:PRINT "YES":LOCATE 24,19:COLOR grey,blue:PRINT "No":COLOR 1,0
  LINE (20,182)-(50,192),red,b:LINE (140,182)-(162,192),grey,b

WhileLoop:
   xx=0
   WHILE xx=0
    xx=MOUSE(0)
   WEND:WHILE MOUSE(0)<>0:WEND:X=MOUSE(1):Y=MOUSE(2)
   IF X>=20 AND X<=50 AND Y>=182 AND Y<=192 THEN InputLoop
   IF X>=140 AND X<=162 AND Y>=182 AND Y<=192 THEN GOSUB ScreenClean:GOTO CloseFile
  GOTO WhileLoop

CloseFile:
    CLOSE 1
    OPEN FileName$+".Flds" FOR OUTPUT AS 2
      PRINT #2,NumberOfFields
      PRINT #2,RecordLength
      PRINT #2,RecordNumber-1
      FOR c=0 TO NumberOfFields
        WRITE #2,NameofField$(c)
        PRINT #2,Length(c)
      NEXT c
    CLOSE 2
  RETURN

InfoReader:
      CLS:LOCATE 1,1:COLOR red,grey:PRINT " Read Mode "
      IF InfoLookup=1 THEN LOCATE 1,1:COLOR red,grey:PRINT " Lookup Mode ";
      LOCATE 3,1:COLOR red,grey:PRINT "Enter filename:"
      COLOR green,black:LINE INPUT FileName$
      IF FileName$="=" OR FileName$="-" THEN FileName$=AltName$
      IF FileName$="" THEN GOTO Begin
      AltName$=FileName$

      GOSUB FileDefsExistYN
      IF FileExist=0 THEN
        GOSUB ScreenClean:GOTO EndLoad
        RETURN
      END IF
      GOSUB ReadFileDefs
      IF NumberOfRecords=0 THEN
      PRINT :BEEP
      COLOR yellow,black
      a$= "No records in file!"
      PRINT a$;
      PRINT :COLOR green,black
      GOSUB ScreenClean:GOTO EndLoad
      RETURN
    END IF
  IF InfoLookup=1 THEN GOSUB LookupForEntry
  OPEN "R",#1,FileName$,RecordLength
  FIELD #1,Length(0) AS inf$(0),Length(1) AS inf$(1),Length(2) AS inf$(2),Length(3) AS inf$(3),Length(4) AS inf$(4),Length(5) AS inf$(5),Length(6) AS inf$(6),Length(7) AS inf$(7),Length(8) AS inf$(8),Length(9) AS inf$(9)
            RecordNumber=1
ReadLoop:
    CLS:LOCATE 1,1:COLOR red,grey:a$= " Read Mode ":PRINT a$
    LOCATE 1,25:COLOR red,grey:PRINT " File: ";
    COLOR yellow,black:PRINT " ";FileName$
    COLOR red,grey

'Draw the Shadow boxes

  LINE (24,184)-(54,194),blue,bf  :LINE (73,184)-(103,194),blue,bf
  LINE (122,184)-(152,194),blue,bf:LINE (171,184)-(201,194),blue,bf
  LINE (220,184)-(250,194),blue,bf:LINE (274,184)-(304,194),blue,bf:
  LINE (322,184)-(352,194),blue,bf:LINE (372,184)-(402,194),blue,bf
  LINE (420,184)-(450,194),blue,bf:LINE (471,184)-(501,194),blue,bf
  LINE (520,184)-(554,194),blue,bf

'Draw the Click Boxes

  LINE (22,182)-(52,192),red,bf  :LINE (71,182)-(101,192),grey,bf
  LINE (120,182)-(150,192),red,bf:LINE (169,182)-(199,192),grey,bf
  LINE (218,182)-(248,192),red,bf:LINE (272,182)-(302,192),grey,bf
  LINE (320,182)-(350,192),red,bf:LINE (370,182)-(400,192),grey,bf
  LINE (418,182)-(448,192),red,bf:LINE (469,182)-(499,192),grey,bf
  LINE (518,182)-(552,192),red,bf
  
'Print the text above the Click Boxes

  LOCATE 21,3:PRINT " Get   Get   Get   Get   Set   Entry Entry  Print List  Alter  Goto "
  LOCATE 22,3:PRINT " Prev  Next  1st   Last  Tab   List  Print  Env   DBase Entry  Main "

'Print the Function Key alternatives in the Click Boxes

  COLOR blue,red:LOCATE 24,5:PRINT "F1":COLOR blue,grey:LOCATE 24,11:PRINT "F2"
  COLOR blue,red:LOCATE 24,17:PRINT "F3":COLOR blue,grey:LOCATE 24,23:PRINT "F4"
  COLOR blue,red:LOCATE 24,29:PRINT "F5":COLOR blue,grey:LOCATE 24,36:PRINT "F6"
  COLOR blue,red:LOCATE 24,42:PRINT "F7":COLOR blue,grey:LOCATE 24,48:PRINT "F8"
  COLOR blue,red:LOCATE 24,54:PRINT "F9":COLOR blue,grey:LOCATE 24,60:PRINT "F10"
  COLOR blue,red:LOCATE 24,66:PRINT "Help"

'Draw the Border round the Click Boxes

  LINE (16,180)-(560,196),blue,b:LINE (15,179)-(561,197),blue,b

  IF InfoLookup<>1 THEN GOTO ReadRecord :'By passes next section when searhing

ElimBox:
  LINE (1,149)-(206,210),black,bf:LINE (207,179)-(208,197),blue,bf

ReadRecord:
    COLOR yellow,black
    IF RecordNumber>NumberOfRecords THEN BEEP:RecordNumber=NumberOfRecords
    IF RecordNumber<1 THEN BEEP:RecordNumber=1
    LOCATE 3,1:COLOR red,grey:PRINT " Record Number :";
    COLOR green,black:PRINT " ";RecordNumber:COLOR red,grey
       LOCATE 3,40:PRINT " Number of Records in this File:-";
       COLOR green,black:PRINT " ";NumberOfRecords
    GET #1,RecordNumber
    IF InfoLookup=1 THEN LOCATE 1,1:COLOR red,grey:PRINT " Lookup Mode ":GOSUB ExamLookupForEntry
    IF InfoLookup=1 AND Found=0 THEN
        IF RecordNumber=NumberOfRecords THEN Direction=-1
        IF RecordNumber=NumberOfRecords AND FindRecord=0 THEN
            COLOR green,black
            CLS
            LOCATE 5,10:a$= "No record found!":PRINT a$
            LOCATE 7,10:COLOR green,black
            GOSUB ScreenClean:GOTO EndLoad
          END IF
          IF RecordNumber=1 THEN Direction=1
          RecordNumber=RecordNumber+Direction
         GOTO ReadRecord
       END IF
       FindRecord=1
       FOR c=0 TO NumberOfFields
         LOCATE 5+c,1:COLOR red,black:PRINT NameofField$(c)": "
       NEXT c :COLOR green,black
       FOR c=0 TO NumberOfFields
         LOCATE 5+c,LEN(NameofField$(c))+3
         PRINT inf$(c):a$=inf$(c):
         Entry$(c)=inf$(c)
       NEXT c

WhileLoop2:
   xx=0
   WHILE xx=0
    xx=MOUSE(0)
    X$="":X$=INKEY$

    IF X$=>CHR$(129) AND X$=<CHR$(139) THEN xx=1

   WEND:WHILE MOUSE(0)<>0:WEND:X=MOUSE(1):Y=MOUSE(2)

   IF X>= 20 AND X<= 50 AND Y>=182 AND Y<=192 THEN X$=CHR$(129)
   IF X>= 70 AND X<=100 AND Y>=182 AND Y<=192 THEN X$=CHR$(130)
   IF X>=120 AND X<=150 AND Y>=182 AND Y<=192 THEN X$=CHR$(131)
   IF X>=170 AND X<=200 AND Y>=182 AND Y<=192 THEN X$=CHR$(132)
   IF X>=220 AND X<=250 AND Y>=182 AND Y<=192 THEN X$=CHR$(133)
   IF X>=270 AND X<=300 AND Y>=182 AND Y<=192 THEN X$=CHR$(134)
   IF X>=320 AND X<=350 AND Y>=182 AND Y<=192 THEN X$=CHR$(135)
   IF X>=370 AND X<=400 AND Y>=182 AND Y<=192 THEN X$=CHR$(136)
   IF X>=420 AND X<=450 AND Y>=182 AND Y<=192 THEN X$=CHR$(137)
   IF X>=470 AND X<=500 AND Y>=182 AND Y<=192 THEN X$=CHR$(138)
   IF X>=520 AND X<=550 AND Y>=182 AND Y<=192 THEN X$=CHR$(139)

   IF X$=CHR$(129) THEN RecordNumber=RecordNumber-1:GOTO ReadLoop
   IF X$=CHR$(130) THEN RecordNumber=RecordNumber+1:GOTO ReadLoop
   IF X$=CHR$(131) THEN RecordNumber=1:GOTO ReadLoop
   IF X$=CHR$(132) THEN RecordNumber=NumberOfRecords:GOTO ReadLoop
   IF X$=CHR$(133) THEN GOSUB TabSet
   IF X$=CHR$(134) THEN GOSUB PrintEntry
   IF X$=CHR$(135) THEN GOSUB ListEntry
   IF X$=CHR$(136) THEN GOSUB PrintEnv
   IF X$=CHR$(137) THEN GOSUB PrintDB
   IF X$=CHR$(138) THEN GOTO ChangeRecord
   IF X$=CHR$(139) THEN GOTO EndLoad

  GOTO WhileLoop2

TabSet:
       LOCATE 27,28:COLOR yellow,black
       INPUT"ENTER NUMBER OF SPACES FROM LEFT COLUMN ",z
       COLOR yellow,black
         IF z$=CHR$(48) THEN LOCATE 27,28:PRINT " LEFT MARGIN SET TO '0' "                             "
         FOR T=1 TO 3000:NEXT T
         IF z$>CHR$(48) THEN LOCATE 27,28:PRINT,w$
         LOCATE 27,28
         PRINT"LEFT MARGIN SET TO ";z;" FOR PRINTING            "
         FOR T=1 TO 3000:NEXT T
       RETURN

PrintEntry:
         OPEN "PAR:" FOR OUTPUT AS #2
           PRINT #2,CHR$(27);+CHR$(64);CHR$(13)
           PRINT #2,
           T$=MID$(DATE$,4,2)+"/"+LEFT$(DATE$,2)+"/"+RIGHT$(DATE$,4)
           PRINT #2, SPC(z);"Record of this entry in '";FileName$;"' on ";T$;" at ";TIME$
           PRINT #2,
           FOR c=0 TO NumberOfFields
             PRINT #2, CHR$(27);+CHR$(15);SPC(z);inf$(c);" ";
           NEXT c
         PRINT #2,
         CLOSE #2
       RETURN

ListEntry:
         OPEN "PAR:"FOR OUTPUT AS #2
           PRINT #2,CHR$(27);+CHR$(64)
           PRINT #2,CHR$(13)
           FOR c=0 TO NumberOfFields
             PRINT #2,CHR$(27);+CHR$(15);SPC(z);NameofField$(c)":"inf$(c)
           NEXT c
         PRINT #2,SPC(z)
         CLOSE #2
       RETURN

PrintEnv:
         OPEN "PAR:"FOR OUTPUT AS #2
           PRINT #2,CHR$(27);+CHR$(64)
           PRINT #2,CHR$(27);+CHR$(69);+ RetName$
           PRINT #2,RetAddr$
           PRINT #2,RetCity$
             FOR q=1 TO 8:'   This Print the blank lines to set
               PRINT #2, "":'   The Address in the correct position
             NEXT q
           PRINT #2, e$;CHR$(27);+CHR$(69);+CHR$(14);+inf$(0)
           FOR p = 1 TO NumberOfFields-1
             PRINT #2, e$;inf$(p)
           NEXT p
           PRINT #2, " ";CHR$(27);+CHR$(70)
           CLOSE #2
         RETURN

ChangeRecord:

       InfoFlag=1:GOTO EnterCorrection

PrintDB:
         OPEN "PAR:"FOR OUTPUT AS #2
           PRINT #2,CHR$(27);+CHR$(64)
           PRINT #2,CHR$(13)
             T$=MID$(DATE$,4,2)+"/"+LEFT$(DATE$,2)+"/"+RIGHT$(DATE$,4)
           PRINT #2,SPC(z);"Contents of the DataBase '";FileName$;"' on ";T$;" at ";TIME$
           PRINT #2,
             FOR c=1 TO NumberOfRecords
               RecordNumber=c
             GET #1,RecordNumber :'                        New Command GET #1
               FOR d=0 TO NumberOfFields
                 PRINT #2,CHR$(27);+CHR$(15);SPC(z);inf$(d);" ";
               NEXT d
               PRINT #2,
             NEXT c
           PRINT #2, CHR$(12)
           PRINT #2, CHR$(7)
           PRINT #2, CHR$(7)
         CLOSE #2
       RETURN

EndLoad:
       CLS
       CLOSE 1
       CLOSE 2
       WINDOW CLOSE 9
       GOTO Begin

'************************** Subroutines go here  ***************************

LookupForEntry:

  CLS:LOCATE 1,1:COLOR red,grey:PRINT " Lookup Mode "
  LOCATE 1,25:COLOR red,grey:PRINT " File: ";
  COLOR yellow,black:PRINT FileName$
  FOR c=0 TO NumberOfFields
    LOCATE 5+c,1:PRINT NameofField$(c)": "
    NEXT c
    COLOR red,black:LOCATE 4,1
    PRINT "Enter Lookup String."
    COLOR red,black
      FOR c=0 TO NumberOfFields
      LOCATE 5+c,LEN(NameofField$(c))+2
      COLOR green,black      
      LINE INPUT Entry$
      IF Entry$<>"" THEN
        Lookup$=LEFT$(Entry$,Length(c))
        LookupNumber=c:c=10
      ELSE
        Lookup$=""
      END IF
    NEXT c
  Corrections3:
    GOSUB EntryOK
    IF Rite=0 THEN EndLookup
    IF Rite=1 THEN LookupRite
  GOTO Corrections3

LookupRite:
    LOCATE 5+LookupNumber,1:PRINT NameofField$(LookupNumber)":"Lookup$
    LOCATE 5+LookupNumber,LEN(NameofField$(LookupNumber))+2
    LINE INPUT Entry$
    IF Entry$<>"" THEN Lookup$=LEFT$(Entry$,Length(LookupNumber))
    GOTO Corrections3

EndLookup:
    IF Lookup$="" THEN LookupNumber=0:InfoLookup=0
    FindRecord=0
    RETURN

ExamLookupForEntry:
    c=0

LookupLoop:
    c=c+1
    IF c>LEN(inf$(LookupNumber))-LEN(Lookup$) THEN Found=0:RETURN
    IF MID$(inf$(LookupNumber),c,LEN(Lookup$))=Lookup$ THEN Found=1:RETURN
    GOTO LookupLoop

EntryOK:
    LOCATE 22,4:COLOR red,black:PRINT "Is the Entry Correct"
    LINE (22,184)-(52,194),white,bf:LINE (142,184)-(164,194),white,bf
    LINE (20,182)-(50,192),blue,bf:LINE (140,182)-(162,192),blue,bf
    LOCATE 24,4:COLOR red,blue:PRINT "YES":LOCATE 24,19:COLOR grey,blue:PRINT "No":COLOR 1,0
    LINE (20,182)-(50,192),red,b:LINE (140,182)-(162,192),grey,b

WhileLoopA:
   xx=0
   WHILE xx=0
    xx=MOUSE(0)
   WEND:WHILE MOUSE(0)<>0:WEND:X=MOUSE(1):Y=MOUSE(2)
   IF X>=20 AND X<=50 AND Y>=182 AND Y<=192 THEN Rite=0:RETURN
   IF X>=140 AND X<=162 AND Y>=182 AND Y<=192 THEN Rite =1:RETURN
  GOTO WhileLoopA

FileDefsExistYN:
      OPEN FileName$+".Flds" FOR APPEND AS 1
      IF LOF(1)<=0 THEN FileExist=0 ELSE FileExist=1
      CLOSE 1
        IF FileExist=0 THEN
          LOCATE 3,1:PRINT SPACE$(60):BEEP
          LOCATE 3,1:COLOR yellow,black:PRINT "File ";FileName$
          PRINT "Not Found!"
          KILL FileName$+".Flds"
          FileName$="":COLOR green,black
          END IF
      RETURN

ReadFileDefs:
      FOR c=1 TO 10
        NameofField$(c)="":Length(c)=0
      NEXT c
      OPEN FileName$+".Flds" FOR INPUT AS 2
      INPUT #2,NumberOfFields
      INPUT #2,RecordLength
      INPUT #2,NumberOfRecords
        FOR c=0 TO NumberOfFields
          INPUT #2,NameofField$(c)
          INPUT #2,Length(c)
        NEXT c
      CLOSE 2
      RETURN

Closeup:
      RETURN

ScreenClean:
      FOR de= 1 TO 3000:NEXT
      COLOR green,black
      CLS
      a$="Press Right Mouse Button for Menu"
      r=16
      center r,a$
      RETURN

Directory:
      WINDOW 9,"Directory",(320,10)-(631,240),0,1
      COLOR grey,black
      CLS
      PRINT
      COLOR red,grey
      PRINT " Please enter Path for Directory "
      COLOR red,grey
      PRINT
      PRINT " Press RETURN for this Drawer "
      COLOR yellow,black
      PRINT "[ DF1:BASIC/MyDrawer ]
      LOCATE 7,1:COLOR green,black: PRINT "Path  "
      LINE (38,46)-(300,56),violet,b
      LOCATE 7,6:COLOR green,black
      LINE INPUT Dir$
      IF Dir$="" THEN Drawer
      ON ERROR GOTO fixit
      CHDIR Dir$
Drawer:                          
      COLOR grey,black
      PRINT
      FILES
      PRINT :PRINT :PRINT

      LINE (22,200)-(132,220),blue,bf :LINE (157,200)-(282,220),blue,bf
      LINE (20,198)-(130,218),grey,bf :LINE (155,198)-(280,218),grey,bf
      LINE (20,198)-(130,218),white,b :LINE (155,198)-(280,218),white,b
      COLOR red,grey:LOCATE 26,4:PRINT "Click Here to"
      LOCATE 27,4:PRINT "Continue"
      COLOR red,grey:LOCATE 26,21:PRINT "Click Here for"
      LOCATE 27,21:PRINT "Another one"
WhileLoopB:
   xx=0
   WHILE xx=0
    xx=MOUSE(0)
   WEND:WHILE MOUSE(0)<>0:WEND:X=MOUSE(1):Y=MOUSE(2)
   IF X>=20 AND X<=130 AND Y>=200 AND Y<=220 THEN xx=1 :GOTO GoOn
   IF X>=155 AND X<=280 AND Y>=200 AND Y<=220 THEN xx=1:GOTO Directory
  GOTO WhileLoopB
GoOn:
      Dir$ = Home$
      CHDIR Dir$
      COLOR blue,black
      CLS
      WINDOW CLOSE 9
      RETURN

fixit:
      IF(ERR=53) THEN
        COLOR 6,1
        CLS
        PRINT "Couldn't Find
        PRINT "A Directory by"
        PRINT "That Name":PRINT  
        PRINT "Try again"
        FOR de=1 TO 3000:NEXT de
        COLOR 1,0:CLS
        END IF
        RESUME Directory
        
'********************* SUB PROGRAMS GO HERE *****************************

SUB center(r,a$) STATIC
     SHARED r
    l=40-(LEN(a$)/2)
    LOCATE r,l:PRINT a$
END SUB

SUB dates STATIC
    PRINT MID$(DATE$,4,2)"/"LEFT$(DATE$,2)"/"RIGHT$(DATE$,4)
END SUB


'**************************************************************************