Shareware Overload/ShartewareOverload.cdr/database/steel14.zip/CFILE.BAS

BASIC Source File | 1983-03-10 | 19KB | 636 lines

4 DEFINT A-W,Y-Z
5 DIM F$(15),FLDN$(17,40),FTY(17,40),FL(17,40)
13 DIM L(17),NREC(17)
16 DIM KY(17,40),KEYLIST(17,40)
35 DIM K$(80)
40 DIM SCRN(40),MFLG(40)
45 DIM REALFLG(40)
70 CH = 29
75 PRINT FRE(0)
80 GOSUB 52000
100 GOSUB 50000
200 GOTO 40000
500 REM ******* CLS
510 CLS
520 RETURN
8000 REM ***** FILE NAME ACCEPLABLE TEST ************
8010 TEST = 1
8100 FOR Q = 1 TO LEN(A$)
8110 K$(Q) = MID$(A$,Q,1)
8120 C = ASC(K$(Q))
8130 IF C < 48 OR C > 122 THEN TEST = 4
8140 IF Q = 1 AND ( C < 65 OR C > 122 ) THEN TEST = 4
8150 NEXT Q
8190 RETURN
23780 REM *************  READ SUBROUTINE  *************
23800 OPEN "I",#1,"FFILE"
23820 INPUT #1,MAXF
23840 FOR A = 1 TO MAXF
23860 INPUT #1,A,F$(A),NREC(A),L(A)
23880 FOR N = 1 TO NREC(A)
23900 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
23920 IF FTY(A,N) = 2 THEN INPUT #1,KY(A,N),KEYLIST(A,N)
23940 NEXT N
23960 NEXT A
23980 CLOSE #1
24000 RETURN
25000 REM ************ WRITE SCREEN TEST *********
25100 OPEN "O",#1,"SCTEST"
25200 FOR T = 1 TO 40
25300 WRITE #1,SCRN(T)
25400 NEXT T
25500 CLOSE #1
25600 RETURN
26000 REM ************ READ SCREEN TEST *********
26100 OPEN "I",#1,"SCTEST"
26200 FOR T = 1 TO 40
26300 INPUT #1,SCRN(T)
26400 NEXT T
26500 CLOSE #1
26600 RETURN
27000 REM **********  READ IDEX SUBROUTINE
27010 OPEN "I",#1,"IDEX"
27020 FOR T = 1 TO MAXF
27030 INPUT #1,D,D,D,MFLG(T)
27040 NEXT T
27050 CLOSE #1
27060 RETURN
27070 REM **********  WRITE IDEX SUBROUTINE
27080 OPEN "O",#1,"IDEX"
27090 FOR T = 1 TO 30
27100 WRITE #1,D,D,D,MFLG(T)
27110 NEXT T
27120 CLOSE #1
27130 RETURN
40000 REM *******  FILE DESCRIPTION MENU  *********
40060 GOSUB 500
40080 PRINT "****************  FILE DESCRIPTION MENU  ******************"
40100 PRINT ""
40120 PRINT "    0 - EXIT TO OPERATING SYSTEM"
40125 PRINT ""
40140 PRINT "    1 - ENTER A FILE DESCRIPTION"
40145 PRINT ""
40160 PRINT "    2 - READ A SINGLE FILE DESCRIPTION"
40165 PRINT ""
40180 PRINT "    3 - READ ALL FILE DESCRIPTIONS"
40185 PRINT ""
40200 PRINT "    4 - PRINT ON PAPER ONE FILE DESCRIPTION "
40205 PRINT ""
40220 PRINT "    5 - PRINT ON PAPER ALL THE FILE DESCRIPTIONS"
40240 PRINT ""
40260 PRINT "**********  ENTER THE NUMBER THEN PRESS RETURN  ************"
40280 GOSUB 60000
40282 IF DT# <0 OR DT# >5 GOTO 40280
40300 T = DT#
40310 IF T = 0 THEN 51000
40320 ON T GOTO 40620,40340,40540,40740,40960
40340 GOSUB 500
40360 PRINT "************  WHAT FILE DESCRIPTION DO YOU WANT TO READ  **********"
40380 FOR T = 1 TO MAXF
40400 PRINT T;"-";F$(T)
40420 NEXT T
40440 PRINT "***************  ENTER THE NUMBER THEN PRESS RETURN  **************"
40460 GOSUB 60000
40462 IF DT# <1 OR DT# >MAXF GOTO 40460
40480 A = DT#
40500 GOSUB 42680
40520 GOTO 40060
40540 FOR A = 1 TO MAXF
40560 GOSUB 42680
40580 NEXT A
40600 GOTO 40060
40620 GOSUB 41040
40640 GOSUB 45020
40660 GOSUB 42580
40680 GOSUB 43220
40700 GOSUB 44420
40720 GOTO 40060
40740 REM PRINT A SINGLE RECORD
40760 GOSUB 500
40780 PRINT "************  WHAT FILE DESCRIPTION DO YOU WANT PRINTED  **********"
40800 FOR T = 1 TO MAXF
40820 PRINT T;"-";F$(T)
40840 NEXT T
40860 PRINT "***************  ENTER THE NUMBER THEN PRESS RETURN  **************"
40880 GOSUB 60000
40882 IF DT# <1 OR DT# >MAXF GOTO 40880
40900 A = DT#
40920 GOSUB 43700
40940 GOTO 40060
40960 FOR A = 1 TO MAXF
40980 GOSUB 43700
41000 NEXT A
41020 GOTO 40060
41040 GOSUB 500
41060 PRINT "****************  NEW FILE DESCRIPTION ENTRY  ******************"
41080 FOR T = 1 TO MAXF
41100 PRINT T;"-";F$(T)
41120 NEXT T
41140 T1 = MAXF + 1
41160 PRINT "*****  YOU MAY RENAME AND REDEFINE ANY OF THE ABOVE FILES  *****
41180 PRINT " ----  YOU WILL LOSE ALL STORED DATA IN A FILE YOU REDEFINE  ---"
41200 PRINT "                        OR  "
41220 PRINT "-------  YOU MAY ENTER A NEW FILE WITH FILE NUMBER = ";T1;"------"
41240 PRINT ""
41260 PRINT "***********  ENTER THE FILE NUMBER THEN PRESS RETURN  ***********"
41280 PRINT ""
41300 GOSUB 60000
41302 IF DT# <1 OR DT# >T1  GOTO 41300
41320 A = DT#
41340 GOTO 44200
41360 PRINT "*****  ENTER THE FILE NAME -- 8 CHARACTERS OR LESS  *****"
41380 PRINT "---------  LETTERS AND NUMBERS ONLY , NO SPACES  --------"
41400 PRINT "-----------  FIRST CHARACTER MUST BE A LETTER  ----------"
41420 MAX = 8
41440 GOSUB 62030
41450 GOSUB 8000
41455 IF TEST = 4 GOTO 41440
41460 F$(A) = A$
41480 PRINT "********  ENTER THE NUMBER OF FIELDS IN THIS FILE  *******"
41500 GOSUB 60000
41502 IF DT# <1 OR DT# >100 GOTO 41500
41520 NREC(A) = DT#
41540 FOR  N = 1 TO NREC(A)
41560 GOSUB 41620
41580 NEXT N
41600 RETURN
41620 GOSUB 500
41640 PRINT "FIELD NUMBER ";N
41660 PRINT "********  ENTER THE NAME OF THIS FIELD  **********"
41680 MAX = 20
41700 GOSUB 62030
41720 FLDN$(A,N) = A$
41740 PRINT "***************  IS THIS FILELD  *****************"
41760 PRINT "                  1 - A NUMBER "
41780 PRINT "                  2 - A STRING "
41800 PRINT "******  ENTER THE NUMBER THEN PRESS RETURN  ******"
41820 GOSUB 60000
41822 IF DT# <1 OR DT# >2 GOTO 41820
41840 T = DT#
41860 ON T GOTO 41880,42420
41880 REM
41900 PRINT "******************  IS THIS NUMBER AN  *******************"
41920 PRINT "   1 - INTEGER "
41930 PRINT "       ---- MAY BE DECLARE A KEY TO A LIST
41940 PRINT "       ----  NO DECIMALS, A NUMBER FROM -32,768 TO +32,768"
41960 PRINT "   2 - SINGLE PRECISION"
41980 PRINT "       ----  DECIMALS ALLOWED,  ONLY SIX DIGITS ACCURACY"
42000 PRINT "   3 - DOUBLE PRECISION"
42020 PRINT "       ----  DECIMALS ALLOWED,  15 DIGITS ACCURACY"
42040 PRINT "   4 - DOLLARS AND CENTS "
42060 PRINT "       ----  USE FOR ALL DOLLAR AND CENTS AMOUNTS "
42080 PRINT "**********  ENTER THE NUMBER THEN PRESS RETURN  **********"
42100 GOSUB 60000
42102 IF DT# <1 OR DT# >4 GOTO 42100
42120 T = DT#
42140 ON T GOTO 42160,42240,42300,42360
42160 FTY(A,N) = 2
42180 FL(A,N) = 2
42200 GOSUB 44720
42220 GOTO 42560
42240 FTY(A,N) = 3
42260 FL(A,N) = 4
42280 GOTO 42560
42300 FTY(A,N) = 4
42320 FL(A,N) = 8
42340 GOTO 42560
42360 FTY(A,N) = 5
42380 FL(A,N) = 8
42400 GOTO 42560
42420 FTY(A,N) = 1
42440 PRINT "************  WHAT IS THE MAXIMUM LENGTH OF THE STRING  **********"
42460 PRINT "             -----  ENTER A NUMBER FROM 1 TO 55  -----
42480 PRINT "***************  ENTER THE LENGTH THEN PRESS RETURN  *************"
42500 GOSUB 60000
42502 IF DT# <1 OR DT# >55 GOTO 42500
42520 FL(A,N) = DT#
42560 RETURN
42580 L(A) = 0
42600 FOR N = 1 TO NREC(A)
42620 L(A) = L(A) + FL(A,N)
42640 NEXT N
42660 RETURN
42680 GOSUB 500
42690 GOSUB 42580
42700 PRINT "-------------------------------------------------------------------------------"
42720 PRINT "FILE NUMBER : ";A
42740 PRINT "FILE NAME   : "; F$(A)
42760 PRINT "NUMBER OF FIELDS : ";NREC(A)
42780 PRINT "RECORD LENGTH    : ";L(A)
42800 FOR N = 1 TO NREC(A)
42820 PRINT  N ;TAB(5);FLDN$(A,N);
42840 ON FTY(A,N) GOTO 42860,42900,42980,43020,43060
42860 PRINT TAB(30) "  STRING WITH MAXIMUM LENGTH ";FL(A,N)
42880 GOTO 43080
42900 PRINT TAB(30) "  INTEGER ";
42920 IF KY(A,N) = 2 THEN  PRINT "--- KEY FOR LIST # ";KEYLIST(A,N)
42940 IF KY(A,N) <> 2 THEN  PRINT ""
42960 GOTO 43080
42980 PRINT TAB(30) "  SINGLE PRECISION "
43000 GOTO 43080
43020 PRINT TAB(30) "  DOUBLE PRECISION "
43040 GOTO 43080
43060 PRINT TAB(30) "  DOLLARS AND CENTS "
43080 REM ***
43100 NEXT N
43120 PRINT "-------------------------------------------------------------------------------"
43140 PRINT "***************  PRESS ANY KEY TO CONTINUE  ******************"
43160 PRINT ""
43180 IF INKEY$ = "" GOTO 43180
43200 RETURN
43220 REM ****** STORE FILES OM FILE FILE  ******
43240 OPEN "O",#1,"FFILE"
43260 WRITE #1,MAXF
43280 FOR T = 1 TO MAXF
43300 WRITE #1,T,F$(T),NREC(T),L(T)
43320 FOR N = 1 TO NREC(T)
43340 WRITE #1,FLDN$(T,N),FTY(T,N),FL(T,N)
43360 IF FTY(T,N) = 2 THEN WRITE #1,KY(T,N),KEYLIST(T,N)
43380 NEXT N
43400 NEXT T
43420 CLOSE #1
43425 GOSUB 26000
43430 SCRN(A) = 0
43432 GOSUB 25000
43434 GOSUB 27000
43436 MFLG(A) = 0
43438 GOSUB 27070
43439 GOSUB 53000
43440 RETURN
43700 LPRINT "-------------------------------------------------------------------------------"
43720 LPRINT "FILE NUMBER : ";A
43740 LPRINT "FILE NAME   : "; F$(A)
43760 LPRINT "NUMBER OF FIELDS : ";NREC(A)
43780 LPRINT "RECORD LENGTH    : ";L(A)
43800 FOR N = 1 TO NREC(A)
43820 LPRINT  N ;TAB(5);FLDN$(A,N);
43840 ON FTY(A,N) GOTO 43860,43900,43980,44020,44060
43860 LPRINT TAB(30) "  STRING WITH MAXIMUM LENGTH ";FL(A,N)
43880 GOTO 44080
43900 LPRINT TAB(30) "  INTEGER ";
43920 IF KY(A,N) = 2 THEN LPRINT "--- KEY FOR LIST # ";KEYLIST(A,N)
43940 IF KY(A,N) <> 2 THEN LPRINT ""
43960 GOTO 44080
43980 LPRINT TAB(30) "  SINGLE PRECISION "
44000 GOTO 44080
44020 LPRINT TAB(30) "  DOUBLE PRECISION "
44040 GOTO 44080
44060 LPRINT TAB(30) "  DOLLAR AND CENTS AMOUNT "
44080 REM ***
44100 NEXT N
44120 PRINT ""
44140 RETURN
44160 END
44180 REM ************  CHECK FOR SKIPED FILES  ***************
44200 IF A > MAXF+1 GOTO 44280
44220 IF A > MAXF THEN MAXF = A
44240 GOTO 41360
44260 PRINT ""
44280 PRINT ""
44300 PRINT "+++++++++++++++  MISTAKE  ++++++++++++++++
44320 PRINT "     YOU MAY NOT SKIP FILE NUMBERS"
44340 PRINT "THE HIGEST NUMBER FILE IS CURRENTLY ";MAXF
44360 PRINT "YOU MAY NUMBER YOUR FILE FROM 1 TO ";MAXF+1
44380 PRINT ""
44400 GOTO 41180
44420 REM  ****** OPEN INITAL IPUT DATA FILE  ******
44440 GOSUB 500
44460 PRINT "********  PUTING DATA ON INPUT DATA FILE  ********"
44480 PRINT A
44500 T$ = STR$(A)
44520 T$ = MID$(T$,2)
44540 N$ = "IPUTD" + T$
44560 PRINT N$
44580 OPEN "O",#2,N$
44600 WRITE #2,NREC(A)
44620 FOR T = 1 TO NREC(A)
44640 WRITE #2,1," "
44660 NEXT T
44680 CLOSE #2
44700 RETURN
44720 REM ********  KEYLIST PROGRAM  ***********
44740 GOSUB 500
44760 PRINT "FILE :";F$(A);" FIELD : ";N;"- ";FLDN$(A,N)
44780 PRINT ""
44800 PRINT "************  IS THIS FIELD A KEY TO A LIST  ***********"
44820 PRINT ""
44840 PRINT "          1 - NOT A KEY "
44860 PRINT "          2 - IS A KEY "
44880 PRINT ""
44900 PRINT "*********  ENTER THE NUMBER THEN PRESS RETURN  **********"
44910 GOSUB 60000
44912 IF DT# <1 OR DT# >2 GOTO 44910
44920 KY(A,N) = DT#
44940 IF KY(A,N) = 1 THEN RETURN
44960 PRINT "*********  WHAT KEY LIST DOES THIS FIELD ACCESS  ********"
44970 PRINT "**********  ENTER THE NUMBER THEN PRESS RETURN  *********"
44980 GOSUB 60000
44982 IF DT# <1 OR DT# >10 GOTO 44980
44990 KEYLIST(A,N) = DT#
45000 RETURN
45020 REM  ************  CHANGE  **********
45040 GOSUB 42680
45080 PRINT "**********  WHAT FIELD DO YOU WANT TO CHANGE  ************"
45120 PRINT "***************  ENTER 0 FOR NO CHANGES  *****************"
45140 GOSUB 60000
45142 IF DT# <0 OR DT# >NREC(A) GOTO 45140
45150 N = DT#
45160 IF N = 0 THEN RETURN
45180 GOSUB 41620
45200 GOTO 45020
50000 REM **********  INTRO
50010 GOSUB 500
50100 PRINT "     F I L E    D E S C R I P T I O N    P R O G R A M    2.0   "
50105 PRINT ""
50110 PRINT "         Copyright 1984 by Potomac Pacific Engineering Inc."
50120 PRINT ""
50130 PRINT "This program is licensed FREE to all users with some restrictions"
50165 PRINT "        See the manual for more information on the license."
50167 PRINT ""
50920 GOSUB 23780
50950 PRINT "******************  PRESS ANY KEY TO CONTINUE  *****************";
50960 IF INKEY$ = "" GOTO 50960
50970 RETURN
51000 REM ***** EXIT TO SYSTEM
51100 GOSUB 500
51110 CLOSE
51120 PRINT " -BYE, Have a nice day"
51130 END
52000 REM ***** INTRO 1
52010 GOSUB 500
52100 PRINT "           Put the DATA DISK in the default disk drive  "
52110 PRINT ""
52120 PRINT "          *****  THEN PRESS ANY KEY TO CONTINUE  *****"
52130 PRINT ""
52140 PRINT "      The  CUSTOM  programs only use the PROGRAM DATA DISK"
52150 PRINT "Keep it in the default disk drive at all times during this program."
52200 IF INKEY$ = "" GOTO 52200
52210 RETURN
53000 REM **********  READ IDEX SUBROUTINE
53010 OPEN "I",#1,"REALTIME"
53020 FOR T = 1 TO MAXF
53030 INPUT #1,REALFLG(T)
53040 NEXT T
53050 CLOSE #1
53060 REALFLG(A) = 0
53070 REM **********  WRITE IDEX SUBROUTINE
53080 OPEN "O",#1,"REALTIME"
53090 FOR T = 1 TO 30
53100 WRITE #1,REALFLG(T)
53110 NEXT T
53120 CLOSE #1
53130 RETURN
60000 REM *******  INTEGER LESS THEN 100 CHECK  ********
60010 MAX = 2
60020 ACT$ = "1234567890=<>^"
60030 IF NE = 0 THEN ACT$ = "1234567890"
60040 PRINT ">__<";
60050 GOTO 60240
60060 REM *******  INTEGER *******
60070 MAX = 8
60080 ACT$ = "1234567890-+,=<>^"
60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
60100 PRINT ">________<";
60110 GOTO 60240
60120 REM *******  SINGLE PRECISION  *******
60130 MAX = 10
60140 ACT$ = "1234567890-+,.%$=<>^"
60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60160 PRINT ">__________<";
60170 GOTO 60240
60180 REM *******  DOUBLE PRECISION  *******
60190 MAX = 20
60200 ACT$ = "1234567890-+,.%$=<>^"
60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60220 PRINT ">____________________<";
60230 GOTO 60240
60240 REM ********** NUMBER CHECK **********
60250 A$ = ""
60260 K$(20) = " "
60270 KTMAX = 0
60280 FOR T9 = 1 TO MAX
60290 K$(T9) = " "
60300 NEXT T9
60310 DIG$ = "1234567890."
60320 DOTFLG = 0
60330 T2 = MAX + 1
60340 FOR T6 = 1 TO T2
60350 PRINT CHR$(CH);
60360 NEXT T6
60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370
60380 KT = 0
60390 REM ***********  CHECK ALFANUMERIC INPUT FOR LENGTH  ***********
60400 KT = KT + 1
60410 REM
60420 W$ = INKEY$
60430 IF W$ = "" GOTO 60420
60440 C = ASC(W$)
60450 IF C = 0 THEN GOSUB 61900
60460 IF C = 13 GOTO 60580
60470 IF C = 17 OR C = 8 GOTO 61150
60480 IF C = 19 GOTO 60670
60490 IF C = 4 GOTO 60720
60500 IF C = 6 GOTO 60780
60510 IF C = 1 GOTO 60960
60520 IF KT > MAX GOTO 60410
60530 IF INSTR(ACT$,W$) = 0 GOTO 61230
60540 K$(KT) = W$
60550 PRINT K$(KT);
60560 IF KT > KTMAX THEN KTMAX = KT
60570 GOTO 60400
60580 REM **********  RETURN  **********
60590 FOR T9 = 1 TO KTMAX
60600 A$ = A$ + K$(T9)
60610 NEXT T9
60620 IF KTMAX = 0 THEN PRINT "1"
60630 IF KTMAX = 0 THEN DT# = 1
60640 IF KTMAX = 0 THEN RETURN
60650 PRINT ""
60660 GOTO 61260
60670 REM ********* MOVE CURSE BACK ********
60680 IF KT = 1 GOTO 60410
60690 KT = KT - 1
60700 PRINT CHR$(CH);
60710 GOTO 60410
60720 REM ********* MOVE CURSER FORWARD *********
60730 IF KT >= MAX GOTO 60410
60740 IF KT > (KTMAX + 1) GOTO 60410
60750 PRINT K$(KT);
60760 KT = KT + 1
60770 GOTO 60410
60780 REM ********** INSERT ***********
60790 IF KT > KTMAX GOTO 60410
60800 X9 = MAX
60810 WHILE X9 > KT
60820 X9 = X9 - 1
60830 K$(X9 + 1) = K$(X9)
60840 WEND
60850 K$(KT) = " "
60860 KTMAX = KTMAX + 1
60870 IF KTMAX > MAX THEN KTMAX = MAX
60880 FOR T9 = KT TO KTMAX
60890 PRINT K$(T9);
60900 NEXT T9
60910 T6 = (KTMAX - KT) + 1
60920 FOR T7 = 1 TO T6
60930 PRINT CHR$(CH);
60940 NEXT T7
60950 GOTO 60410
60960 REM ********** DELETE ***********
60970 IF KT > KTMAX GOTO 60410
60980 IF KTMAX = 1 GOTO 60410
60990 K$(MAX + 1) = ""
61000 X9 = KT
61010 WHILE X9 <= MAX
61020 K$(X9) = K$(X9 + 1)
61030 X9 = X9 + 1
61040 WEND
61050 KTMAX = KTMAX - 1
61060 FOR T9 = KT TO KTMAX
61070 PRINT K$(T9);
61080 NEXT T9
61090 PRINT "_";
61100 T7 = (KTMAX - KT) + 2
61110 FOR T8 = 1 TO T7
61120 PRINT CHR$(CH);
61130 NEXT T8
61140 GOTO 60410
61150 REM ********* BACKSPACE ********
61160 IF KT = 1 GOTO 60410
61170 KT = KT - 1
61180 PRINT CHR$(CH);
61190 K$(KT) = " "
61200 PRINT "_";
61210 PRINT CHR$(CH);
61220 GOTO 60410
61230 REM *******  INPUT NOT ACCEPTABLE  ********
61240 PRINT CHR$(7);
61250 GOTO 60420
61260 REM ********* CLEAR STRINGS ********
61270 MAX = LEN(A$)
61280 D2$ = ""
61290 D1$ = ""
61300 DFLG = 0
61310 FOR Q93 = 1 TO MAX
61320 R$ = MID$(A$,Q93,1)
61330 IF INSTR(DIG$,R$) = 0 GOTO 61400
61340 IF R$ = "." OR DFLG = 1 GOTO 61380
61350 IF DFLG = 1 GOTO 61380
61360 D2$ = D2$ + R$
61370 GOTO 61400
61380 D1$ = D1$ + R$
61390 DFLG = 1
61400 NEXT Q93
61410 DA# = VAL(D2$)
61420 D1# = VAL(D1$)
61430 DT# = DA# + D1#
61440 IF K$(1) = "-" THEN DT# =  -DT#
61450 RETURN
61900 REM ****** CHECK FOR ASC0
61910 S4$ = INKEY$
61920 C2 =  ASC(S4$)
61930 IF C2 = 83 THEN C = 1
61940 IF C2 = 82 THEN C = 6
61950 IF C2 = 75 THEN C = 19
61960 IF C2 = 77 THEN C = 4
61970 RETURN
62000 REM **********  ALPHANUMERIC CHECK  **************
62010 MAX = FL(A,Q)
62020 GOTO 62040
62030 REM ********  MAX SET IN PROGRAM  ********
62040 A$ = ""
62050 PRINT ">";
62060 FOR N9 = 1 TO MAX
62070 K$(N9) = ""
62080 PRINT "_";
62090 NEXT N9
62100 PRINT "<";
62110 T2 = MAX + 1
62120 FOR T4 = 1 TO T2
62130 PRINT CHR$(CH);
62140 NEXT T4
62150 KT = 0
62160 KTMAX = 1
62170 REM ***********  CHECK ALFANUMERIC INPUT FOR LENGTH  ***********
62180 KT = KT + 1
62190 PRINT TAB(KT+1)"";
62200 K$ = INKEY$
62210 IF K$ = "" GOTO 62200
62220 C = ASC(K$)
62230 IF C = 0 THEN GOSUB 61900
62240 IF C = 13 GOTO 62350
62250 IF C = 17 OR C = 8 GOTO 62920
62260 IF C = 19 GOTO 62450
62270 IF C = 4  GOTO 62500
62280 IF C = 6 GOTO 62560
62290 IF C = 1 GOTO 62730
62300 IF KT > MAX GOTO 62190
62310 K$(KT) = K$
62320 PRINT K$(KT);
62330 IF KT > KTMAX THEN KTMAX = KT
62340 GOTO 62180
62350 REM **********  RETURN  **********
62360 FOR T9 = 1 TO MAX
62370 A$ = A$ + K$(T9)
62420 NEXT T9
62430 PRINT ""
62440 RETURN
62450 REM ********* MOVE CURSE BACK ********
62460 IF KT = 1 GOTO 62190
62470 KT = KT - 1
62480 PRINT CHR$(CH);
62490 GOTO 62190
62500 REM ********* MOVE CURSER FORWARD *********
62510 IF KT >= MAX GOTO 62190
62520 IF KT >  KTMAX  GOTO 62190
62530 PRINT K$(KT);
62540 KT = KT + 1
62550 GOTO 62190
62560 REM ********** INSERT ***********
62570 X9 = MAX
62580 WHILE X9 > KT
62590 X9 = X9 - 1
62600 K$(X9 + 1) = K$(X9)
62610 WEND
62620 K$(KT) = " "
62630 KTMAX = KTMAX + 1
62640 IF KTMAX > MAX THEN KTMAX = MAX
62650 FOR T9 = KT TO KTMAX
62660 PRINT K$(T9);
62670 NEXT T9
62680 T6 = (KTMAX - KT) +1
62690 FOR T7 = 1 TO T6
62700 PRINT CHR$(CH);
62710 NEXT T7
62720 GOTO 62190
62730 REM ********** DELETE ***********
62740 IF KT > KTMAX GOTO 62200
62750 IF KTMAX = 1 GOTO 62190
62760 K$(MAX + 1) = ""
62770 X9 = KT
62780 WHILE X9 <= KTMAX
62790 K$(X9) = K$(X9 + 1)
62800 X9 = X9 + 1
62810 WEND
62820 KTMAX = KTMAX - 1
62830 FOR T9 = KT TO KTMAX
62840 PRINT K$(T9);
62850 NEXT T9
62860 PRINT "_";
62870 T7 = (KTMAX - KT) + 2
62880 FOR T6 = 1 TO T7
62890 PRINT CHR$(CH);
62900 NEXT T6
62910 GOTO 62190
62920 REM ********* BACKSPACE ********
62930 IF KT = 1 GOTO 62190
62940 K$(KT) = " "
62950 KT = KT - 1
62960 K$(KT) = " "
62970 PRINT CHR$(CH);
62980 PRINT "_";
62990 PRINT CHR$(CH);
63000 GOTO 62190
 " "
62950 KT = KT - 1
62960 K$(KT) = " "