GOTO 10
MenuMaker:
   MENU 1,0,1,"OPTIONS"
   MENU 2,0,1,"MAIN BASE"
   MENU 3,0,1,"SEARCH"
   MENU 4,0,1,"RECORDS"
   MENU 1,1,1,"RESTART DATABASA"
   MENU 1,2,1,"RETURN TO DESKTOP"
   MENU 2,1,1,"NEW BASE      ALT N"
   MENU 2,2,1,"LOAD BASE     ALT L"
   MENU 2,3,1,"SAVE BASE     ALT S"
   MENU 2,4,1,"PRINT BASE    ALT P"
   MENU 3,1,1,"BY NAME      N"
   MENU 3,2,1,"BY LETTER    L"
   MENU 3,3,1,"GO TO..      G"
   MENU 4,1,1,"SORT             S"
   MENU 4,2,1,"DELETE RECORD    D"
   MENU 4,3,1,"ADD RECORD       A"
   MENU 4,4,1,"ADD FIELD        F"
   MENU 4,5,1,"DELETE FIELD     R"
   MENU 4,6,1,"SWAP RECORDS     W"
   MENU 4,7,1,"READ RECORD      T"
   ON MENU GOSUB CheckMenu
   MENU ON
   RETURN
10 CLEAR ,125000,3000
   GOSUB MenuMaker
   ON ERROR GOTO ErrorRoutine
   CLS
   COLOR 2:LOCATE 7,20:PRINT "©1998-2004 TERENCE & CO."
   COLOR 3:PRINT TAB(20)"PROGRAM INITIALISING"
   BEEP:BEEP
   SLEEP 5
15 CLEAR ,125000,3000
   GOSUB MenuMaker
   ON ERROR GOTO ErrorRoutine
   FileName$="KitPup"
   CHDIR "BASICGAMES: "
16 DIM A$(205)
   DIM B$(205)
   DIM C$(205)
   DIM D$(205)
   DIM E$(205)
   DIM F$(205)
   DIM G$(205)
   DIM H$(205)
   DIM I$(205)
   DIM J$(205)
17 OPEN FileName$ FOR INPUT AS #1
   INPUT #1,CH%
   INPUT #1,FI%
   INPUT #1,A$(1)
   INPUT #1,B$(1)
   INPUT #1,C$(1)
   INPUT #1,D$(1)
   INPUT #1,E$(1)
   INPUT #1,F$(1)
   INPUT #1,G$(1)
   INPUT #1,H$(1)
   INPUT #1,I$(1)
   INPUT #1,J$(1)
   FOR J=2 TO CH%-1
   INPUT #1,A$(J)
   INPUT #1,B$(J)
   INPUT #1,C$(J)
   INPUT #1,D$(J)
   INPUT #1,E$(J)
   INPUT #1,F$(J)
   INPUT #1,G$(J)
   INPUT #1,H$(J)
   INPUT #1,I$(J)
   INPUT #1,J$(J)
   NEXT J
   CLOSE #1
   WINDOW 1,FileName$,(0,0)-(250,130),18
20 I=2
21 WHILE I<CH%
   COLOR 1,0
   LOCATE 1,1
   COLOR 2:PRINT "  ";A$(1)
   COLOR 3:PRINT "  ";B$(1)
   COLOR 2:PRINT "  ";C$(1)
   COLOR 3:PRINT "  ";D$(1)
   COLOR 2:PRINT "  ";E$(1)
   COLOR 3:PRINT "  ";F$(1)
   COLOR 2:PRINT "  ";G$(1)
   COLOR 3:PRINT "  ";H$(1)
   COLOR 2:PRINT "  ";I$(1)
   COLOR 3:PRINT "  ";J$(1)
   LOCATE 1,1
   FOR K=1 TO FI%
   LOCATE K,11
   COLOR 2,1
   PRINT "              "
   NEXT K
   LOCATE 1,1
   IF FI%=1 THEN COLOR 2,1:PRINT TAB(11)A$(I) 
   IF FI%=2 THEN COLOR 2,1:PRINT TAB(11)A$(I):COLOR 2,1:PRINT TAB(11)B$(I)
   IF FI%=3 THEN COLOR 2,1:PRINT TAB(11)A$(I):COLOR 2,1:PRINT TAB(11)B$(I):COLOR 2,1:PRINT TAB(11)C$(I)
   IF FI%=4 THEN COLOR 2,1:PRINT TAB(11)A$(I):COLOR 2,1:PRINT TAB(11)B$(I):COLOR 2,1:PRINT TAB(11)C$(I):COLOR 2,1:PRINT TAB(11)D$(I)
   IF FI%=5 THEN COLOR 2,1:PRINT TAB(11)A$(I):COLOR 2,1:PRINT TAB(11)B$(I):COLOR 2,1:PRINT TAB(11)C$(I):COLOR 2,1:PRINT TAB(11)D$(I):COLOR 2,1:PRINT TAB(11)E$(I)
   IF FI%=6 THEN COLOR 2,1:PRINT TAB(11)A$(I):COLOR 2,1:PRINT TAB(11)B$(I):COLOR 2,1:PRINT TAB(11)C$(I):COLOR 2,1:PRINT TAB(11)D$(I):COLOR 2,1:PRINT TAB(11)E$(I):COLOR 2,1:PRINT TAB(11)F$(I)
   IF FI%=7 THEN COLOR 2,1:PRINT TAB(11)A$(I):COLOR 2,1:PRINT TAB(11)B$(I):COLOR 2,1:PRINT TAB(11)C$(I):COLOR 2,1:PRINT TAB(11)D$(I):COLOR 2,1:PRINT TAB(11)E$(I):COLOR 2,1:PRINT TAB(11)F$(I):COLOR 2,1:PRINT TAB(11)G$(I)
   IF FI%=8 THEN COLOR 2,1:PRINT TAB(11)A$(I):COLOR 2,1:PRINT TAB(11)B$(I):COLOR 2,1:PRINT TAB(11)C$(I):COLOR 2,1:PRINT TAB(11)D$(I):COLOR 2,1:PRINT TAB(11)E$(I):COLOR 2,1:PRINT TAB(11)F$(I):COLOR 2,1:PRINT TAB(11)G$(I):COLOR 2,1:PRINT TAB(11)H$(I)
IF FI%=9 THEN
   COLOR 2,1
   PRINT TAB(11)A$(I)
   COLOR 2,1:PRINT TAB(11)B$(I)
   COLOR 2,1:PRINT TAB(11)C$(I)
   COLOR 2,1:PRINT TAB(11)D$(I)
   COLOR 2,1:PRINT TAB(11)E$(I)
   COLOR 2,1:PRINT TAB(11)F$(I)
   COLOR 2,1:PRINT TAB(11)G$(I)
   COLOR 2,1:PRINT TAB(11)H$(I)
   COLOR 2,1:PRINT TAB(11)I$(I)
END IF
IF FI%=10 THEN
   COLOR 2,1
   PRINT TAB(11)A$(I)
   COLOR 2,1:PRINT TAB(11)B$(I)
   COLOR 2,1:PRINT TAB(11)C$(I)
   COLOR 2,1:PRINT TAB(11)D$(I)
   COLOR 2,1:PRINT TAB(11)E$(I)
   COLOR 2,1:PRINT TAB(11)F$(I)
   COLOR 2,1:PRINT TAB(11)G$(I)
   COLOR 2,1:PRINT TAB(11)H$(I)
   COLOR 2,1:PRINT TAB(11)I$(I)
   COLOR 2,1:PRINT TAB(11)J$(I)
END IF
   LOCATE 12,8:COLOR 2,0:PRINT I-1;"/";CH%-2;"        "
ChangeBit:
   KEY$="":KEY$=INKEY$
IF KEY$<>"" THEN
   KEY$=UCASE$(KEY$)
   IF KEY$="," THEN I=I-1:YAV%=1
   IF KEY$="." THEN I=I+1:YAV%=1
   IF KEY$="T" THEN GOSUB TalkIt
   IF KEY$="W" THEN GOSUB RecSw
   IF KEY$="R" THEN GOSUB DelF
   IF KEY$="F" THEN GOSUB AddF
   IF KEY$="A" THEN GOSUB Add
   IF KEY$="S" THEN GOSUB Sort
   IF KEY$="D" THEN GOSUB Del
   IF KEY$="§" OR KEY$="ß" THEN GOSUB Sa
   IF KEY$="£" THEN GOTO Ld
   IF KEY$="G" THEN GOSUB Num
   IF KEY$="N" THEN GOSUB Nam
   IF KEY$="L" THEN GOSUB Ltr
   IF KEY$="¶" THEN GOSUB Pr
   IF KEY$="¯" OR KEY$="­" THEN GOSUB Nw
   IF I<2 THEN I=I+1:YAV%=1
   IF I>CH%-1 THEN I=I-1:YAV%=1 
   IF KEY$=CHR$(129) THEN YAV%=1:Y=1:LOCATE 1,11:GOSUB FieldEnter
   IF KEY$=CHR$(130) AND FI%=>2 THEN YAV%=1:Y=2:LOCATE 2,11:GOSUB FieldEnter
   IF KEY$=CHR$(131) AND FI%=>3 THEN YAV%=1:Y=3:LOCATE 3,11:GOSUB FieldEnter
   IF KEY$=CHR$(132) AND FI%=>4 THEN YAV%=1:Y=4:LOCATE 4,11:GOSUB FieldEnter
   IF KEY$=CHR$(133) AND FI%=>5 THEN YAV%=1:Y=5:LOCATE 5,11:GOSUB FieldEnter
   IF KEY$=CHR$(134) AND FI%=>6 THEN YAV%=1:Y=6:LOCATE 6,11:GOSUB FieldEnter
   IF KEY$=CHR$(135) AND FI%=>7 THEN YAV%=1:Y=7:LOCATE 7,11:GOSUB FieldEnter
   IF KEY$=CHR$(136) AND FI%=>8 THEN YAV%=1:Y=8:LOCATE 8,11:GOSUB FieldEnter
   IF KEY$=CHR$(137) AND FI%=>9 THEN YAV%=1:Y=9:LOCATE 9,11:GOSUB FieldEnter
   IF KEY$=CHR$(138) AND FI%=10 THEN YAV%=1:Y=10:LOCATE 10,11:GOSUB FieldEnter
END IF
   IF YAV%<>1 AND CHA%=0 THEN GOTO ChangeBit
   CHA%=0:YAV%=0
   WEND
   GOTO 20
FieldEnter:
   F$="":COLOR 2,1
   LOCATE Y,11:PRINT "              "
   X=11
   IF Y=1 THEN F$=A$(I)
   IF Y=2 THEN F$=B$(I)
   IF Y=3 THEN F$=C$(I)
   IF Y=4 THEN F$=D$(I)
   IF Y=5 THEN F$=E$(I)
   IF Y=6 THEN F$=F$(I)
   IF Y=7 THEN F$=G$(I)
   IF Y=8 THEN F$=H$(I)
   IF Y=9 THEN F$=I$(I)
   IF Y=10 THEN F$=J$(I)
   X=(LEN(F$)+1)+10
   LOCATE Y,11
   COLOR 2,1:PRINT F$
   IF LEN(F$)>13 THEN F$=LEFT$(F$,13)
   IF X>24 THEN X=24
   WHILE LEN(F$)<14
   K$="":K$=INKEY$
   IF K$="" AND TV%<8 THEN COLOR 3,1:LOCATE Y,X:PRINT "|" ELSE IF K$="" AND TV%<16 THEN COLOR 1:LOCATE Y,X:PRINT "|" ELSE TV%=0
   TV%=TV%+1
   IF K$=CHR$(8) AND X>11 THEN F$=LEFT$(F$,LEN(F$)-1):X=X-1:LOCATE Y,11:COLOR 2,1:PRINT F$;"  ":K$=INKEY$
   IF K$=CHR$(8) AND X=11 THEN GOSUB NextBit:BEEP:GOTO FieldEnter
   IF K$=CHR$(13) AND Y<FI% THEN LOCATE Y,X:COLOR 1:PRINT " ":GOSUB NextBit:Y=Y+1:X=10:F$="":GOTO FieldEnter ELSE IF K$=CHR$(13) AND Y=>FI% THEN GOSUB NextBit:RETURN
   IF K$=CHR$(27) THEN LOCATE Y,X:COLOR 1:PRINT " ":GOSUB NextBit:RETURN
   IF K$=CHR$(129) THEN LOCATE Y,X:COLOR 1:PRINT " ":GOSUB NextBit:Y=1:F$="":GOTO FieldEnter
   IF K$=CHR$(130) AND FI%=>2 THEN LOCATE Y,X:COLOR 1:PRINT " ":GOSUB NextBit:Y=2:F$="":GOTO FieldEnter
   IF K$=CHR$(131) AND FI%=>3 THEN LOCATE Y,X:COLOR 1:PRINT " ":GOSUB NextBit:Y=3:F$="":GOTO FieldEnter
   IF K$=CHR$(132) AND FI%=>4 THEN LOCATE Y,X:COLOR 1:PRINT " ":GOSUB NextBit:Y=4:F$="":GOTO FieldEnter
   IF K$=CHR$(133) AND FI%=>5 THEN LOCATE Y,X:COLOR 1:PRINT " ":GOSUB NextBit:Y=5:F$="":GOTO FieldEnter
   IF K$=CHR$(134) AND FI%=>6 THEN LOCATE Y,X:COLOR 1:PRINT " ":GOSUB NextBit:Y=6:F$="":GOTO FieldEnter
   IF K$=CHR$(135) AND FI%=>7 THEN LOCATE Y,X:COLOR 1:PRINT " ":GOSUB NextBit:Y=7:F$="":GOTO FieldEnter
   IF K$=CHR$(136) AND FI%=>8 THEN LOCATE Y,X:COLOR 1:PRINT " ":GOSUB NextBit:Y=8:F$="":GOTO FieldEnter
   IF K$=CHR$(137) AND FI%=>9 THEN LOCATE Y,X:COLOR 1:PRINT " ":GOSUB NextBit:Y=9:F$="":GOTO FieldEnter
   IF K$=CHR$(138) AND FI%=10 THEN LOCATE Y,X:COLOR 1:PRINT " ":GOSUB NextBit:Y=10:F$="":GOTO FieldEnter
   F$=F$+K$:LOCATE Y,X
   COLOR 2,1:PRINT K$
   IF K$<>"" THEN X=X+1
   WEND
   GOSUB NextBit
   RETURN
NextBit:
   IF Y=1 THEN A$(I)=F$
   IF Y=2 THEN B$(I)=F$
   IF Y=3 THEN C$(I)=F$
   IF Y=4 THEN D$(I)=F$
   IF Y=5 THEN E$(I)=F$
   IF Y=6 THEN F$(I)=F$
   IF Y=7 THEN G$(I)=F$
   IF Y=8 THEN H$(I)=F$
   IF Y=9 THEN I$(I)=F$
   IF Y=10 THEN J$(I)=F$
   RETURN
        
CheckMenu:
   MenuId=MENU(0):MenuItem=MENU(1)
   ON MenuId GOSUB OPTIONS,DBASE,SEARCH,RECORDS
   RETURN
OPTIONS:
   ON MenuItem GOSUB RESTART,RetDesk
   RETURN
DBASE:
   ON MenuItem GOSUB Nw,Ld,Sa,Pr
   RETURN
SEARCH:
   ON MenuItem GOSUB Nam,Ltr,Num
   RETURN
RECORDS:
   ON MenuItem GOSUB Sort,Del,Add,AddF,DelF,RecSw,TalkIt
   RETURN
ClearText:
   LOCATE 13,1
   COLOR 3,0
   PRINT "                              "
   RETURN
TalkIt:
   LOCATE 13,5
   COLOR 3,0
4000 SAY TRANSLATE$("Narraytor!")
   GOSUB ClearText
   LOCATE 13,5
   INPUT "RECORD NO.";R%
   R%=R%+1
   GOSUB ClearText
   IF R%<2 OR R%>CH% THEN BEEP:RETURN
   SAY TRANSLATE$ (A$(R%))
   SAY TRANSLATE$ (B$(R%))
   SAY TRANSLATE$ (C$(R%))
   SAY TRANSLATE$ (D$(R%))
   SAY TRANSLATE$ (E$(R%))
   SAY TRANSLATE$ (F$(R%))
   SAY TRANSLATE$ (G$(R%))
   SAY TRANSLATE$ (H$(R%))
   SAY TRANSLATE$ (I$(R%))
   SAY TRANSLATE$ (J$(R%))
   RETURN
   
RecSw:   
   LOCATE 13,5
   COLOR 3,0
   INPUT "RECORD NO.";J
   J=J+1
   LOCATE 13,5
   PRINT "                         "
   LOCATE 13,5
   INPUT "SWAP WITH";K
   K=K+1
   IF J<2 OR J>CH% OR K<2 OR K>CH% OR J=K THEN
       LOCATE 13,5
       PRINT "CANT SWAP THEM!      "
       FOR J=1 TO 4000:NEXT J
       LOCATE 13,5:PRINT "                            "
       RETURN
   END IF
   GOSUB SwopBit
   CHA%=1
   I=J
   LOCATE 13,5
   PRINT "                             "
   RETURN
   
AddF:
   IF FI%<10 THEN
     FI%=FI%+1
     IF FI%=2 THEN B$(2)=""
     IF FI%=3 THEN C$(2)=""
     IF FI%=4 THEN D$(2)=""
     IF FI%=5 THEN E$(2)=""
     IF FI%=6 THEN F$(2)=""
     IF FI%=7 THEN G$(2)=""
     IF FI%=8 THEN H$(2)=""
     IF FI%=9 THEN I$(2)=""
     IF FI%=10 THEN J$(2)=""
     LOCATE 13,5
     COLOR 3,0
     IF FI%=2 THEN INPUT "FIELD 2=";B$(1)
     IF FI%=3 THEN INPUT "FIELD 3=";C$(1)
     IF FI%=4 THEN INPUT "FIELD 4=";D$(1)
     IF FI%=5 THEN INPUT "FIELD 5=";E$(1)
     IF FI%=6 THEN INPUT "FIELD 6=";F$(1)
     IF FI%=7 THEN INPUT "FIELD 7=";G$(1)
     IF FI%=8 THEN INPUT "FIELD 8=";H$(1)
     IF FI%=9 THEN INPUT "FIELD 9=";I$(1)
     IF FI%=10 THEN INPUT "FIELD 10=";J$(1)
     LOCATE 13,5:PRINT "                         "
     CHA%=1
     
   END IF
   IF CHA%<>1 THEN
     COLOR 3,0
     LOCATE 13,5
     PRINT "NO MORE THAN 10"
     FOR J=1 TO 4000:NEXT J
     LOCATE 13,5:PRINT "                   "
   END IF
   RETURN
     
ThinkBit:
   LOCATE 13,5
   PRINT "THINKING                   "
   RETURN
   
RESTART:
   GOSUB AskIfSure
   WINDOW 1,"DataBasa",(0,0)-(620,185),30
   RUN
   RETURN
   
RetDesk:
   GOSUB AskIfSure
   SYSTEM
   RETURN
   
Nw:
   GOSUB AskIfSure
   COLOR 1,0
   CLS
   PRINT "       DATABASA!"
   PRINT
   COLOR 3
   PRINT "HOW MANY FIELDS(NAME,
   PRINT "AGE etc) DO YOU WANT?"
   PRINT 
   COLOR 2
   INPUT FI%
   IF FI%<1 OR FI%>10 THEN GOTO Nw
   CLS
   B$(1)=""
   C$(1)=""
   D$(1)=""
   E$(1)=""
   F$(1)=""
   G$(1)=""
   H$(1)=""
   I$(1)=""
   J$(1)=""
   FOR I=1 TO FI%
   COLOR 1,0
   CLS
   PRINT "       DATABASA!"
   PRINT
   COLOR 3
   PRINT "FIELD ";I;"(eg NAME)"
   PRINT
   COLOR 1
   PRINT "NO MORE THAN 9 LETTERS!"
   COLOR 2:PRINT
   IF I=1 THEN INPUT A$(1):A$(2)=""
   IF I=2 THEN INPUT B$(1):B$(2)=""
   IF I=3 THEN INPUT C$(1):C$(2)=""
   IF I=4 THEN INPUT D$(1):D$(2)=""
   IF I=5 THEN INPUT E$(1):E$(2)=""
   IF I=6 THEN INPUT F$(1):F$(2)=""
   IF I=7 THEN INPUT G$(1):G$(2)=""
   IF I=8 THEN INPUT H$(1):H$(2)=""
   IF I=9 THEN INPUT I$(1):I$(2)=""
   IF I=10 THEN INPUT J$(1):J$(2)=""
   CH%=2
   NEXT I  
   I=2
   PRINT
   COLOR 3,2
   CH%=CH%+1
   COLOR 1,0
   CLS
   CHA%=1
   RETURN 

AskIfSure:
   LOCATE 13,5:COLOR 3,0:PRINT "ARE YOU SURE?"
   R$=""
   R%=0
   WHILE R$=""
   R$=INKEY$
   WEND
   IF R$="Y" OR R$="y" THEN R%=1
   LOCATE 13,5:PRINT "                    "
IF R%<>1 THEN
   LOCATE 13,5:PRINT "                            "
   GOSUB MenuMaker
   RETURN 21
END IF
   RETURN 
Ld:
   GOSUB AskIfSure
Ld2:
   CLEAR
   ON ERROR GOTO ErrorRoutine
   CLS
   COLOR 3,0:PRINT "    DATABASA"
   COLOR 3,0:PRINT "    ========"
   PRINT
   COLOR 2
   PRINT "FILENAME?"
   COLOR 1
   INPUT FileName$
   GOSUB MenuMaker
   GOTO 16
   
Sa:
   GOSUB AskIfSure
Sa2:
   LOCATE 13,3:INPUT "Save as?";SFileName$ 
   OPEN "O",#1,SFileName$
   PRINT #1,CH%
   PRINT #1,FI%
   FOR J=1 TO CH%-1
   WRITE #1,A$(J)
   WRITE #1,B$(J)
   WRITE #1,C$(J)
   WRITE #1,D$(J)
   WRITE #1,E$(J)
   WRITE #1,F$(J)
   WRITE #1,G$(J)
   WRITE #1,H$(J)
   WRITE #1,I$(J)
   WRITE #1,J$(J)
   NEXT J              
   LOCATE 13,3
   PRINT "                             "
   CLOSE #1
   LOCATE 13,5:PRINT "    Saved!!"
   FOR J=1 TO 3000:NEXT J
   LOCATE 13,5
   PRINT "                          "                                                  
   RETURN
   
Pr:
   GOSUB AskIfSure
   COLOR 1,0
   CLS
   COLOR 2
   PRINT "   PRINTER OPTIONS!"
   PRINT
   COLOR 1
   PRINT "PLEASE CHOOSE AN OPTION"
   COLOR 3
   PRINT " 1) PRINT 1 RECORD"
   COLOR 2
   PRINT " 2) PRINT RANGE"
   COLOR 3
   PRINT " 3) PRINT ALL"
   COLOR 2
   PRINT " 4) PRINT FIELD TITLES"
   PRINT "    ONLY (eg NAME etc)"
   COLOR 1
   R$=""
   WHILE R$=""
   R$=INKEY$
   WEND
   R%=VAL(R$)
   IF R%<0 OR R%>4 THEN CLS:CHA%=1:RETURN
   ON R% GOSUB Printer1,Printer2,Printer3,Printer4
   LOCATE 13,5
   COLOR 3,0
   CHA%=1
   RETURN                                                   
Printer1:
   CLS
   COLOR 2
   PRINT "   PRINTER OPTIONS!"
   PRINT
   COLOR 3
   PRINT "RECORD NO?"
   COLOR 1
   INPUT R%
   IF R%>CH% THEN BEEP:RETURN
   OPEN "LPT1:" FOR OUTPUT AS #2
     PRINT #2,FileName$,TIME$,DATE$
     PRINT #2,"     "
     PRINT #2,"   ",R%;"/";CH%-1
     PRINT #2,A$(1);SPC(11-LEN(A$(1))),A$(R%+1)
     PRINT #2,B$(1);SPC(11-LEN(B$(1))),B$(R%+1)
     PRINT #2,C$(1);SPC(11-LEN(C$(1))),C$(R%+1)
     PRINT #2,D$(1);SPC(11-LEN(D$(1))),D$(R%+1)
     PRINT #2,E$(1);SPC(11-LEN(E$(1))),E$(R%+1)
     PRINT #2,F$(1);SPC(11-LEN(F$(1))),F$(R%+1)
     PRINT #2,G$(1);SPC(11-LEN(G$(1))),G$(R%+1)
     PRINT #2,H$(1);SPC(11-LEN(H$(1))),H$(R%+1)
     PRINT #2,I$(1);SPC(11-LEN(I$(1))),I$(R%+1)
     PRINT #2,J$(1);SPC(11-LEN(J$(1))),J$(R%+1)
   CLOSE #2
   RETURN
   
Printer2:
   CLS
   COLOR 2
   PRINT "   PRINTER OPTIONS!"
   PRINT
   COLOR 3
   PRINT "PRINT RANGE FROM NO.?"
   COLOR 1
   INPUT R%
   IF R%>CH%-1 THEN BEEP:RETURN
   COLOR 3
   PRINT "TO?"
   INPUT R2%
   OPEN "LPT1:" FOR OUTPUT AS #2
   PRINT #2,FileName$,TIME$,DATE$
   PRINT #2,"  " 
   FOR J=R%+1 TO R2%+1
     PRINT #2,"   ",J-1;"/";CH%-1
     PRINT #2,A$(1);SPC(11-LEN(A$(1))),A$(J)
     PRINT #2,B$(1);SPC(11-LEN(B$(1))),B$(J)
     PRINT #2,C$(1);SPC(11-LEN(C$(1))),C$(J)
     PRINT #2,D$(1);SPC(11-LEN(D$(1))),D$(J)
     PRINT #2,E$(1);SPC(11-LEN(E$(1))),E$(J)
     PRINT #2,F$(1);SPC(11-LEN(F$(1))),F$(J)
     PRINT #2,G$(1);SPC(11-LEN(G$(1))),F$(J)
     PRINT #2,H$(1);SPC(11-LEN(H$(1))),H$(J)
     PRINT #2,I$(1);SPC(11-LEN(I$(1))),I$(J)
     PRINT #2,J$(1);SPC(11-LEN(J$(1))),J$(J)
     PRINT #2,"  "
   NEXT J 
   CLOSE #2
   RETURN
   
Printer3:
   OPEN "LPT1:" FOR OUTPUT AS #2
     PRINT #2,FileName$,TIME$,DATE$
     PRINT #2,"  "
     FOR J=2 TO CH%-2 STEP 2
     PRINT #2,J-1;"/";CH%-1;SPC(25);J;"/";CH%-1
     PRINT #2,A$(1);SPC(9-LEN(A$(1)));A$(J);SPC(24-LEN(A$(J)));A$(1);SPC(9-LEN(A$(1)));A$(J+1)
     PRINT #2,B$(1);SPC(9-LEN(B$(1)));B$(J);SPC(24-LEN(B$(J)));B$(1);SPC(9-LEN(B$(1)));B$(J+1)
     PRINT #2,C$(1);SPC(9-LEN(C$(1)));C$(J);SPC(24-LEN(C$(J)));C$(1);SPC(9-LEN(C$(1)));C$(J+1)
     PRINT #2,D$(1);SPC(9-LEN(D$(1)));D$(J);SPC(24-LEN(D$(J)));D$(1);SPC(9-LEN(D$(1)));D$(J+1)
     PRINT #2,E$(1);SPC(9-LEN(E$(1)));E$(J);SPC(24-LEN(E$(J)));E$(1);SPC(9-LEN(E$(1)));E$(J+1)
     PRINT #2,F$(1);SPC(9-LEN(F$(1)));F$(J);SPC(24-LEN(F$(J)));F$(1);SPC(9-LEN(F$(1)));F$(J+1)
     PRINT #2,G$(1);SPC(9-LEN(G$(1)));G$(J);SPC(24-LEN(G$(J)));G$(1);SPC(9-LEN(G$(1)));G$(J+1)
     PRINT #2,H$(1);SPC(9-LEN(H$(1)));H$(J);SPC(24-LEN(H$(J)));H$(1);SPC(9-LEN(H$(1)));H$(J+1)
     PRINT #2,I$(1);SPC(9-LEN(I$(1)));I$(J);SPC(24-LEN(I$(J)));I$(1);SPC(9-LEN(I$(1)));I$(J+1)
     PRINT #2,J$(1);SPC(9-LEN(J$(1)));J$(J);SPC(24-LEN(J$(J)));J$(1);SPC(9-LEN(J$(1)));J$(J+1)
     PRINT #2,"  "
     NEXT J
   CLOSE #2
   CLS
   CHA%=1
   RETURN      
 
Printer4:
   OPEN "LPT1:" FOR OUTPUT AS #2
     PRINT #2,FileName$,TIME$,DATE$
     PRINT #2,A$(1)
     PRINT #2,B$(1)
     PRINT #2,C$(1)
     PRINT #2,D$(1)
     PRINT #2,E$(1)
     PRINT #2,F$(1)
     PRINT #2,G$(1)
     PRINT #2,H$(1)
     PRINT #2,I$(1)
     PRINT #2,J$(1)
   CLOSE #2
   RETURN
   
Nam:
   LOCATE 13,5
   COLOR 3,0
   INPUT "FIELD 1=",R$
   FOR J=2 TO CH%
   IF A$(J)=R$ THEN I=J:J=CH%:CHA%=1 
   NEXT J
   IF CHA%<>1 THEN
   LOCATE 13,5
   PRINT R$;" UNKNOWN"
   FOR J=1 TO 4000:NEXT J
   END IF
   LOCATE 13,5
   PRINT "                           "
   RETURN                                                   

Ltr:
   LOCATE 13,5
   COLOR 3,0
   PRINT "LETTER?"
   R$=""
   WHILE R$=""
   R$=INKEY$
   WEND
   GOSUB ThinkBit
   R$=UCASE$(R$)
   FOR J=2 TO CH%
   IF A$(J)<>"" THEN
   IF UCASE$(LEFT$(A$(J),1))=R$ THEN I=J:J=CH%:CHA%=1
   END IF
   NEXT J 
   IF CHA%<>1 THEN
   LOCATE 13,5
   PRINT "NO NAMES UNDER ";R$
   FOR J=1 TO 4000:NEXT J
   END IF
   LOCATE 13,5
   PRINT "                           "
   RETURN                                                   

Num:
   COLOR 3,0
   LOCATE 13,5:INPUT "RECORD NO.";R%
   IF R%>CH%-1 THEN BEEP:LOCATE 13,5:PRINT "                       ":RETURN
   I=R%+2
   LOCATE 13,5
   PRINT "                         "
   I=I-1
   CHA%=1
   RETURN                                                 

Sort:
   LOCATE 13,5
   COLOR 3,0
   PRINT "FIELD(1-";FI%;")"
   LOCATE 13,18
   INPUT R%
   IF R%<1 OR R%>FI% THEN
       LOCATE 13,5
       COLOR 3,0
       BEEP
       PRINT "SORT CANCELLED!     "
       FOR J=1 TO 4000:NEXT J
       LOCATE 13,5
       PRINT "                   "
       RETURN
   END IF
   GOSUB ThinkBit
   ZZ%=1
   IF R%=1 THEN GOSUB SortF1
   IF R%=2 THEN GOSUB SortF2
   IF R%=3 THEN GOSUB SortF3
   IF R%=4 THEN GOSUB SortF4
   IF R%=5 THEN GOSUB SortF5
   IF R%=6 THEN GOSUB SortF6
   IF R%=7 THEN GOSUB SortF7
   IF R%=8 THEN GOSUB SortF8
   IF R%=9 THEN GOSUB SortF9
   IF R%=10 THEN GOSUB SortF10
   IF ZZ%=4 THEN ZZ%=1
   CHA%=1
   LOCATE 13,5
   PRINT "                       "
   RETURN                                                   

SortF1:
   FOR J=2 TO CH%-1
   LOCATE 13,5
   COLOR ZZ%
   PRINT "THINKING"
   ZZ%=ZZ%+1
   IF ZZ%>3 THEN ZZ%=1
   FOR K=2 TO CH%-1
   IF A$(J)>A$(K) AND J<K THEN GOSUB SwopBit
   NEXT K
   NEXT J
RETURN

SortF2:
   FOR J=2 TO CH%-1
   LOCATE 13,5
   COLOR ZZ%
   PRINT "THINKING"
   ZZ%=ZZ%+1
   IF ZZ%>3 THEN ZZ%=1
   FOR K=2 TO CH%-1
   IF B$(J)>B$(K) AND J<K THEN GOSUB SwopBit
   NEXT K
   NEXT J
RETURN

SortF3:
   FOR J=2 TO CH%-1
   LOCATE 13,5
   COLOR ZZ%
   PRINT "THINKING"
   ZZ%=ZZ%+1
   IF ZZ%>3 THEN ZZ%=1
   FOR K=2 TO CH%-1
   IF C$(J)>C$(K) AND J<K THEN GOSUB SwopBit
   NEXT K
   NEXT J
RETURN

SortF4:
   FOR J=2 TO CH%-1
   LOCATE 13,5
   COLOR ZZ%
   PRINT "THINKING"
   ZZ%=ZZ%+1
   IF ZZ%>3 THEN ZZ%=1
   FOR K=2 TO CH%-1
   IF D$(J)>D$(K) AND J<K THEN GOSUB SwopBit
   NEXT K
   NEXT J
RETURN

SortF5:
   FOR J=2 TO CH%-1
   LOCATE 13,5
   COLOR ZZ%
   PRINT "THINKING"
   ZZ%=ZZ%+1
   IF ZZ%>3 THEN ZZ%=1
   FOR K=2 TO CH%-1
   IF E$(J)>E$(K) AND J<K THEN GOSUB SwopBit
   NEXT K
   NEXT J
RETURN

SortF6:
   FOR J=2 TO CH%-1
   LOCATE 13,5
   COLOR ZZ%
   PRINT "THINKING"
   ZZ%=ZZ%+1
   IF ZZ%>3 THEN ZZ%=1
   FOR K=2 TO CH%-1
   IF F$(J)>F$(K) AND J<K THEN GOSUB SwopBit
   NEXT K
   NEXT J
RETURN

SortF7:
   FOR J=2 TO CH%-1
   LOCATE 13,5
   COLOR ZZ%
   PRINT "THINKING"
   ZZ%=ZZ%+1
   IF ZZ%>3 THEN ZZ%=1
   FOR K=2 TO CH%-1
   IF G$(J)>G$(K) AND J<K THEN GOSUB SwopBit
   NEXT K
   NEXT J
RETURN

SortF8:
   FOR J=2 TO CH%-1
   LOCATE 13,5
   COLOR ZZ%
   PRINT "THINKING"
   ZZ%=ZZ%+1
   IF ZZ%>3 THEN ZZ%=1
   FOR K=2 TO CH%-1
   IF H$(J)>H$(K) AND J<K THEN GOSUB SwopBit
   NEXT K
   NEXT J
RETURN

SortF9:
   FOR J=2 TO CH%-1
   LOCATE 13,5
   COLOR ZZ%
   PRINT "THINKING"
   ZZ%=ZZ%+1
   IF ZZ%>3 THEN ZZ%=1
   FOR K=2 TO CH%-1
   IF I$(J)>I$(K) AND J<K THEN GOSUB SwopBit
   NEXT K
   NEXT J
RETURN

SortF10:
   FOR J=2 TO CH%-1
   LOCATE 13,5
   COLOR ZZ%
   PRINT "THINKING"
   ZZ%=ZZ%+1
   IF ZZ%>3 THEN ZZ%=1
   FOR K=2 TO CH%-1
   IF J$(J)>J$(K) AND J<K THEN GOSUB SwopBit
   NEXT K
   NEXT J
RETURN

SwopBit:
   SWAP A$(J),A$(K)
   SWAP B$(J),B$(K)
   SWAP C$(J),C$(K)
   SWAP D$(J),D$(K)
   SWAP E$(J),E$(K)
   SWAP F$(J),F$(K)
   SWAP G$(J),G$(K)
   SWAP H$(J),H$(K)
   SWAP I$(J),I$(K)
   SWAP J$(J),J$(K)
   RETURN
   
Del:
   GOSUB AskIfSure
   GOSUB ThinkBit
   IF CH%<3 THEN BEEP:RETURN
   FOR J=I TO CH%+1
   A$(J)=A$(J+1)
   B$(J)=B$(J+1)
   C$(J)=C$(J+1)
   D$(J)=D$(J+1)
   E$(J)=E$(J+1)
   F$(J)=F$(J+1)
   G$(J)=G$(J+1)
   H$(J)=H$(J+1)
   I$(J)=I$(J+1)
   J$(J)=J$(J+1)
   NEXT J
   CH%=CH%-1
   LOCATE 13,5
   PRINT "                         "
   CHA%=1
   RETURN
DelF:
   GOSUB AskIfSure
   LOCATE 13,5
   COLOR 3,0
   PRINT "FIELD(1-";FI%;")"
   LOCATE 13,18
   INPUT R%
   IF R%<1 OR R%>FI% THEN
       BEEP
       LOCATE 13,5
       COLOR 2,0
       PRINT "                      "
       LOCATE 13,5
       PRINT "NO SUCH FIELD"
       FOR J=1 TO 4000:NEXT J
       LOCATE 13,5
       PRINT "                         "
       RETURN
   END IF
       
   GOSUB ThinkBit
   IF CH%<3 THEN BEEP:RETURN
   FOR J=1 TO CH%
   IF R%=1 THEN
    A$(J)=B$(J)
    B$(J)=C$(J)
    C$(J)=D$(J)
    D$(J)=E$(J)
    E$(J)=F$(J)
    F$(J)=G$(J)
    G$(J)=H$(J)
    H$(J)=I$(J)
    I$(J)=J$(J)
    J$(J)=""
   END IF
   IF R%=2 THEN
    B$(J)=C$(J)
    C$(J)=D$(J)
    D$(J)=E$(J)
    E$(J)=F$(J)
    F$(J)=G$(J)
    G$(J)=H$(J)
    H$(J)=I$(J)
    I$(J)=J$(J)
    J$(J)=""
   END IF
   IF R%=3 THEN
    C$(J)=D$(J)
    D$(J)=E$(J)
    E$(J)=F$(J)
    F$(J)=G$(J)
    G$(J)=H$(J)
    H$(J)=I$(J)
    I$(J)=J$(J)
    J$(J)=""
   END IF
   IF R%=4 THEN
    D$(J)=E$(J)
    E$(J)=F$(J)
    F$(J)=G$(J)
    G$(J)=H$(J)
    H$(J)=I$(J)
    I$(J)=J$(J)
    J$(J)=""
   END IF
   IF R%=5 THEN
    E$(J)=F$(J)
    F$(J)=G$(J)
    G$(J)=H$(J)
    H$(J)=I$(J)
    I$(J)=J$(J)
    J$(J)=""
   END IF
   IF R%=6 THEN
    F$(J)=G$(J)
    G$(J)=H$(J)
    H$(J)=I$(J)
    I$(J)=J$(J)
    J$(J)=""
   END IF
   IF R%=7 THEN
    G$(J)=H$(J)
    H$(J)=I$(J)
    I$(J)=J$(J)
    J$(J)=""
   END IF
   IF R%=8 THEN
    H$(J)=I$(J)
    I$(J)=J$(J)
    J$(J)=""
   END IF
   IF R%=9 THEN
    I$(J)=J$(J)
    J$(J)=""
   END IF
   IF R%=10 THEN
    J$(J)=""
   END IF
   NEXT J
   FI%=FI%-1
   LOCATE 13,5
   PRINT "                         "
   CLS
   CHA%=1
   RETURN
                                                     

Add:
 IF CH%>201 THEN
    LOCATE 13,5
    COLOR 3,0
    PRINT "200. RECORDS MAX"
    FOR J=1 TO 3000
    NEXT J
    GOSUB ClearText
    RETURN
 END IF
 IF CH%=2 THEN CLS
 GOSUB ThinkBit
 IF I=CH% THEN
   CH%=CH%+1
   A$(CH%)="":B$(CH%)="":C$(CH%)="":D$(CH%)=""
   E$(CH%)="":F$(CH%)="":G$(CH%)="":H$(CH%)=""
   I$(CH%)=""
   J$(CH%)=""
   I=CH%+2
   KEY$="."
   RETURN
 END IF
 IF I<CH% THEN
   CH%=CH%+1
   FOR J=CH% TO I+1 STEP -1
   A$(J)=A$(J-1)
   B$(J)=B$(J-1)
   C$(J)=C$(J-1)
   D$(J)=D$(J-1)
   E$(J)=E$(J-1)
   F$(J)=F$(J-1)
   G$(J)=G$(J-1)
   H$(J)=H$(J-1)
   I$(J)=I$(J-1)
   J$(J)=J$(J-1)
   NEXT J
   A$(I+1)=""
   B$(I+1)=""
   C$(I+1)=""
   D$(I+1)=""
   E$(I+1)=""
   F$(I+1)=""
   G$(I+1)=""
   H$(I+1)=""
   I$(I+1)=""
   J$(I+1)=""
   I=I+1
 END IF
   CHA%=1
   LOCATE 13,5
   PRINT "                       "
   RETURN

ErrorRoutine:
   IF ERR=5 AND ERL=4000 THEN BEEP:COLOR 2,3:LOCATE 13,3:PRINT "SPEECH NOT AVAILABLE!":FOR J=1 TO 3000:NEXT J:GOSUB ClearText:RESUME 20
   IF ERR=5 AND ERL=4001 THEN BEEP:COLOR 2,3:LOCATE 13,17:PRINT "SPEECH NOT AVAILABLE!":FOR J=1 TO 3000:NEXT J:GOSUB ClearText:RESUME NEXT
   IF ERR=53 THEN BEEP:CLS:COLOR 2,3:LOCATE 4,1:PRINT FileName$;" NOT FOUND!":COLOR 1:PRINT TAB(2)"CHECK IT & TRY AGAIN":FOR J=1 TO 4000:NEXT J:COLOR 1,0:RESUME Ld2
   IF ERR=9 THEN BEEP:CH%=152:COLOR 2,3:LOCATE 13,3:PRINT "150 RECORDS MAX.":FOR J=1 TO 3000:NEXT J:GOSUB ClearText:RESUME 20
   COLOR 2,3
   BEEP
   PRINT "ERROR - Attempting to Save"                                                              
   FOR J=1 TO 5000:NEXT J
   GOSUB ClearText
   GOSUB Sa2
   COLOR 1,0:CLS               
   PRINT "         DATABASA"
   COLOR 2    
   PRINT "TELL TERENCE THE FOLLOWING"
   PRINT "  MESSAGE & WHEN/HOW IT "
   PRINT "         HAPPENED!"
   COLOR 3
   PRINT
   PRINT " CLICK ON THE OK BOX THEN"
   PRINT " THEN TYPE run TO RESTART"
   FOR J=1 TO 3000:NEXT J
   ERROR ERR
   I$=""
   WHILE I$="":I$=INKEY$:WEND
   RUN
   RESUME 0