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

BASIC Source File | 1983-03-10 | 10KB | 375 lines

3 DEFDBL X
4 DEFINT A-W,Y-Z
5 DIM F$(15),FLDN$(15,30),FTY(15,30),FL(15,30)
10 DIM X$(30)
13 DIM L(15),NREC(15)
14 DIM X(20)
20 DIM XL(40)
35 DIM K$(80)
61 CH = 29: PRINT FRE(0)
70 NE = 0
75 GOSUB 50000
80 GOSUB 10000
400 GOSUB 13000
404 GOSUB 13000
410 PRINT "**********  ASCII PROGRAM  --  WHAT FILE DO YOU WANT:  **********"
420 PRINT ""
425 PRINT " 0  - *** EXIT THE PROGRAM ***"
430 FOR I = 1 TO MAXF
440 PRINT I;" - ";F$(I)
450 NEXT I
460 PRINT ""
470 PRINT "***** ENTER THE NUMBER OF THE FILE YOU WANT THEN PRESS RETURN *****"
475 GOSUB 14000
477 IF DT# < 0 OR DT#>MAXF  GOTO 475
480 A = DT#
482 IF A = 0 GOTO 51000
483 GOSUB 13000
484 PRINT "FILE : "; F$(A)
485 GOSUB 2300
490 GOSUB 2500
495 GOSUB 8000
500 GOTO 6000
2300 REM **************  DISK  SELECTION  ***************
2302 IF HDISK = 2 THEN GOSUB 13000
2303 IF HDISK = 2 THEN GOTO 2360
2304 PRINT ""
2305 PRINT "************  WHICH DISK DRIVE IS THE FILE ON  **************"
2310 PRINT ""
2315 PRINT "                 1 - DISK DRIVE A"
2320 PRINT "                 2 - DISK DRIVE B"
2325 PRINT "                 3 - DISK DRIVE C"
2330 PRINT "                 4 - DISK DRIVE D"
2335 PRINT ""
2340 PRINT "***********  ENTER THE NUMBER THEN PRESS RETURN  ************"
2345 GOSUB 14000
2347 IF DT# < 0 OR DT#>4 GOTO 2345
2350 T = DT#
2355 ON T GOTO 2360,2370,2380,2390
2360 T$ = F$(A)
2365 GOTO 2490
2370 T$ = "B:"+F$(A)
2375 GOTO 2490
2380 T$ = "C:"+F$(A)
2385 GOTO 2490
2390 T$ = "D:"+F$(A)
2490 RETURN
2500 REM *******  OPEN FILE SUBROUTINE  *******
2503 CLOSE #1
2505 OPEN "R",#1,T$,L(A)
2507 D = 0
2510 FOR T = 1 TO NREC(A)
2520 FIELD #1,D AS DY$,FL(A,T) AS X$(T)
2530 D = D + FL(A,T)
2540 NEXT T
2543 GOSUB 7800
2545 RETURN
6000 REM *****  CHANGE TO SEQUENTIAL ASCII FILE
6075 GOSUB 13000
6100 PRINT "    This program converts the records you specify to "
6110 PRINT "               to a sequential ASCII form"
6120 PRINT ""
6278 PRINT "********  WHAT RECORD DO YOU WANT TO START AT  *********"
6281 PRINT ""
6282 PRINT "             Enter Zero When you are done "
6283 PRINT ""
6284 PRINT "********  ENTER THE NUMBER THEN PRESS RETURN  *********"
6287 GOSUB 14100
6288 IF DT# <0 OR DT# > MRN GOTO 6287
6290 RNS= DT#
6300 IF RNS = 0 THEN 51000
6375 PRINT ""
6378 PRINT "*********  WHAT RECORD DO YOU WANT TO END AT  *********"
6381 PRINT ""
6384 PRINT "********  ENTER THE NUMBER THEN PRESS RETURN  *********"
6387 GOSUB 14100
6388 IF DT# <1 OR DT# > MRN  GOTO 6387
6390 RNF= DT#
6396 REM GET RECORD
6399 FOR T = RNS TO RNF
6402 GET #1,T
6403 GOSUB 6417
6404 PRINT #2,""
6405 NEXT T
6406 GOSUB 13000
6407 PRINT "*** ANY MORE RECORDS TO CONVERT ***"
6410 GOTO 6100
6417 FOR Q = 1 TO NREC(A)
6435 ON FTY(A,Q) GOSUB 6507,6441,6453,6465,6465
6436 IF Q < NREC(A) THEN PRINT #2,CHR$(44);
6438 NEXT Q
6439 RETURN
6440 REM ************** CONVERT STRINGS TO DECIMALS ****************
6441 I%=CVI(X$(Q))
6447 PRINT #2,I%;
6450 RETURN
6453 I!=CVS(X$(Q))
6459 PRINT #2,I!;
6462 RETURN
6465 I#=CVD(X$(Q))
6468 PRINT #2,I#;
6471 RETURN
6507 I$ = X$(Q)
6508 PRINT #2,CHR$(34);I$;CHR$(34);
6510 RETURN
7800 MRN = LOF(1)/ L(A)
7805 REM MRN = INT(MRN)
7810 RETURN
7900 REM ***** LOF
7910 MRN2 = LOF(3)/82
7920 RETURN
7950 REM ******* LOF
7960 MRNS = LOF(B)/L(B)
7970 RETURN
8000 REM ****** OPEN ASCII FILE
8100 OPEN "O",#2,"ASCIDATA"
8200 RETURN
9070 ON FTY(A,N) GOTO 9100,9150,9200,9250,9250
9100 REM
9110 LSET X$(N) = I$
9120 GOTO 9290
9150 REM
9160 LSET X$(N) = MKI$(I#)
9170 GOTO 9290
9200 REM
9210 LSET X$(N) = MKS$(I#)
9220 GOTO 9290
9250 REM
9260 LSET X$(N) = MKD$(I#)
9290 RETURN
10000 REM *************  READ SUBROUTINE  *************
10004 GOSUB 10900
10010 OPEN "I",#1,"FFILE"
10020 INPUT #1,MAXF
10030 FOR A = 1 TO MAXF
10040 INPUT #1,A,F$(A),NREC(A),L(A)
10050 FOR N = 1 TO NREC(A)
10060 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
10070 IF FTY(A,N) = 2 THEN INPUT #1,D,D
10080 NEXT N
10090 NEXT A
10100 CLOSE #1
10110 RETURN
10900 REM  *************  PUT DISK IN DRIVE SUB
10905 IF HDISK = 2 THEN RETURN
10910 GOSUB 13000
10920 PRINT "    ********  PUT PROGRAM DATA DISK IN THE DEFAULT DISK DRIVE  *********"
10930 PRINT ""
10940 PRINT "                     THEN PRESS ANY KEY TO CONTINUE "
10950 PRINT ""
10960 PRINT "    If the program data disk is already in the default disk drive then"
10965 PRINT "                   just press any key to continue."
10970 PRINT ""
10990 IF INKEY$ = "" GOTO 10990
10995 RETURN
13000 REM *********  CLEAR SCREEN
13010 CLS
13020 RETURN
13100 REM *********  LOCATE
13110 LOCATE LI,1
13120 RETURN
13200 FOR T% = 1 TO 80
13210 PRINT CHR$(8);
13220 NEXT T%
13222 FOR T% = 1 TO 24
13223 PRINT CHR$(11);
13224 NEXT T%
13225 LI = LI - 1
13230 FOR T% = 1 TO LI
13240 PRINT CHR$(0)
13250 NEXT T%
13590 RETURN
13600 REM ****** CHECK FOR ASC0
13610 S4$ = INKEY$
13620 C2 =  ASC(S4$)
13630 IF C2 = 83 THEN C = 1
13640 IF C2 = 82 THEN C = 6
13650 IF C2 = 75 THEN C = 19
13660 IF C2 = 77 THEN C = 4
13670 RETURN
14000 REM *******  INTEGER LESS THEN 100 CHECK  ********
14010 MAX = 2
14020 ACT$ = "1234567890=<>^"
14023 IF NE = 0 THEN ACT$ = "1234567890"
14025 PRINT ">__<";
14030 GOTO 14500
14100 REM *******  INTEGER *******
14110 MAX = 8
14120 ACT$ = "1234567890-+,=<>^"
14123 IF NE = 0 THEN ACT$ = "1234567890-+,"
14125 PRINT ">________<";
14130 GOTO 14500
14200 REM *******  SINGLE PRECISION  *******
14210 MAX = 10
14220 ACT$ = "1234567890-+,.%$=<>^"
14223 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
14225 PRINT ">__________<";
14230 GOTO 14500
14300 REM *******  DOUBLE PRECISION  *******
14310 MAX = 20
14320 ACT$ = "1234567890-+,.%$=<>^"
14323 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
14325 PRINT ">____________________<";
14330 GOTO 14500
14500 REM ********** NUMBER CHECK **********
14505 A$ = ""
14510 K$(20) = " "
14515 KTMAX = 0
14520 FOR T9 = 1 TO MAX
14525 K$(T9) = " "
14530 NEXT T9
14535 DIG$ = "1234567890."
14540 DOTFLG = 0
14541 T2 = MAX + 1
14542 FOR T6 = 1 TO T2
14544 PRINT CHR$(CH);
14546 NEXT T6
14550 IF INKEY$ = "" GOTO 14560 ELSE GOTO 14550
14560 KT = 0
14565 REM ***********  CHECK ALFANUMERIC INPUT FOR LENGTH  ***********
14570 KT = KT + 1
14575 REM
14580 W$ = INKEY$
14585 IF W$ = "" GOTO 14580
14590 C = ASC(W$)
14593 IF C = 0 THEN GOSUB 13600
14595 IF C = 13 GOTO 14660
14600 IF C = 17 OR C = 8 GOTO 14860
14605 IF C = 19 GOTO 14690
14610 IF C = 4 GOTO 14710
14615 IF C = 6 GOTO 14730
14620 IF C = 1 GOTO 14790
14625 IF KT > MAX GOTO 14575
14630 IF INSTR(ACT$,W$) = 0 GOTO 14890
14635 K$(KT) = W$
14645 PRINT K$(KT);
14650 IF KT > KTMAX THEN KTMAX = KT
14655 GOTO 14570
14660 REM **********  RETURN  **********
14670 FOR T9 = 1 TO KTMAX
14675 A$ = A$ + K$(T9)
14680 NEXT T9
14681 IF KTMAX = 0 THEN PRINT "1"
14682 IF KTMAX = 0 THEN DT# = 1
14683 IF KTMAX = 0 THEN RETURN
14684 PRINT ""
14685 GOTO 14905
14690 REM ********* MOVE CURSE BACK ********
14695 IF KT = 1 GOTO 14575
14700 KT = KT - 1
14703 PRINT CHR$(CH);
14705 GOTO 14575
14710 REM ********* MOVE CURSER FORWARD *********
14715 IF KT >= MAX GOTO 14575
14716 IF KT > (KTMAX + 1) GOTO 14575
14718 PRINT K$(KT);
14720 KT = KT + 1
14725 GOTO 14575
14730 REM ********** INSERT ***********
14733 IF KT > KTMAX GOTO 14575
14735 X9 = MAX
14740 WHILE X9 > KT
14745 X9 = X9 - 1
14750 K$(X9 + 1) = K$(X9)
14755 WEND
14760 K$(KT) = " "
14767 KTMAX = KTMAX + 1
14769 IF KTMAX > MAX THEN KTMAX = MAX
14770 FOR T9 = KT TO KTMAX
14775 PRINT K$(T9);
14780 NEXT T9
14781 T6 = (KTMAX - KT) + 1
14782 FOR T7 = 1 TO T6
14783 PRINT CHR$(CH);
14784 NEXT T7
14785 GOTO 14575
14790 REM ********** DELETE ***********
14793 IF KT > KTMAX GOTO 14575
14794 IF KTMAX = 1 GOTO 14575
14795 K$(MAX + 1) = ""
14800 X9 = KT
14805 WHILE X9 <= MAX
14810 K$(X9) = K$(X9 + 1)
14815 X9 = X9 + 1
14820 WEND
14830 KTMAX = KTMAX - 1
14835 FOR T9 = KT TO KTMAX
14840 PRINT K$(T9);
14845 NEXT T9
14850 PRINT "_";
14851 T7 = (KTMAX - KT) + 2
14852 FOR T8 = 1 TO T7
14853 PRINT CHR$(CH);
14854 NEXT T8
14855 GOTO 14575
14860 REM ********* BACKSPACE ********
14865 IF KT = 1 GOTO 14575
14870 KT = KT - 1
14875 PRINT CHR$(CH);
14877 K$(KT) = " "
14880 PRINT "_";
14883 PRINT CHR$(CH);
14885 GOTO 14575
14890 REM *******  INPUT NOT ACCEPTABLE  ********
14895 PRINT CHR$(7);
14900 GOTO 14580
14905 REM ********* CLEAR STRINGS ********
14910 MAX = LEN(A$)
14915 D2$ = ""
14920 D1$ = ""
14925 DFLG = 0
14930 FOR Q93 = 1 TO MAX
14935 R$ = MID$(A$,Q93,1)
14940 IF INSTR(DIG$,R$) = 0 GOTO 14975
14945 IF R$ = "." OR DFLG = 1 GOTO 14965
14950 IF DFLG = 1 GOTO 14965
14955 D2$ = D2$ + R$
14960 GOTO 14975
14965 D1$ = D1$ + R$
14970 DFLG = 1
14975 NEXT Q93
14980 DA# = VAL(D2$)
14985 D1# = VAL(D1$)
14990 DT# = DA# + D1#
14995 IF K$(1) = "-" THEN DT# =  -DT#
14997 RETURN
26000 REM ******* ON ERROR ROUTINE ************
26100 EFLG = 1
26200 PRINT "**********  END OF FILE  ***********"
26202 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26204 IF INKEY$ = "" GOTO 26204
26500 REM *********  ON ERROR SUBROUTINE ***********
26600 PRINT "**********  END OF FILE  ***********"
26610 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26620 IF INKEY$ = "" GOTO 26620
26635 EFLG = 1
26640 RETURN
26800 REM **********  ON ERROR GOTO  **************
26900 PRINT "************  RECORD NOT FOUND  *************"
41000 REM ***** WRITE SECOND FILE
41100 LSET Y$ = XT$
41200 PUT #2,RN2
41300 RN2 = RN2 + 1
41400 RETURN
50000 REM **********  INTRO
50010 GOSUB 13000
50100 PRINT "                A S C I I    P R O G R A M    3.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 ""
50950 PRINT "******************  PRESS ANY KEY TO CONTINUE  ******************";
50960 IF INKEY$ = "" GOTO 50960
50970 RETURN
51000 REM *******  DONE
51100 CLOSE
51105 GOSUB 13000
51110 PRINT " -BYE, Have a nice day
51120 END
 50960
50970 RETURN
51000 REM *******  DONE
51100 CLOSE
51