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

BASIC Source File | 1983-03-10 | 14KB | 479 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 IDEXA(30),IDEXB(30),IDEXC(30),MFLG(30)
50 DIM MIND#(30),MAXD#(30)
70 CH = 29
75 PRINT FRE(0)
80 GOSUB 52000
100 GOSUB 50000
150 GOSUB 24000
200 GOTO 40000
500 REM ******* CLS
510 CLS
520 RETURN
20000 REM ******  PRINT OUR MAXIMUMS AND MINIMUMS
20100 PRINT "    FIELD               MINIMUM             MAXIMUM "
20210 FOR T = 1 TO NREC(A)
20220 PRINT T;TAB(5) FLDN$(A,T);TAB(30) MIND#(T);TAB(50) MAXD#(T)
20230 NEXT T
20240 PRINT "*********  PRESS ANY KEY TO CONTINUE  ********"
20245 IF INKEY$ = "" THEN 20245
20250 RETURN
21000 REM ******  LPRINT OUR MAXIMUMS AND MINIMUMS
21100 LPRINT "    FIELD               MINIMUM             MAXIMUM "
21210 FOR T = 1 TO NREC(A)
21220 LPRINT T;TAB(5) FLDN$(A,T);TAB(30) MIND#(T);TAB(50) MAXD#(T)
21230 NEXT T
21250 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
23990 RETURN
24000 REM **********  READ IDEX SUBROUTINE
24100 OPEN "I",#1,"IDEX"
24110 FOR T = 1 TO MAXF
24120 INPUT #1,IDEXA(T),IDEXB(T),IDEXC(T),MFLG(T)
24130 NEXT T
24140 CLOSE #1
24150 RETURN
25000 REM **********  WRITE IDEX SUBROUTINE
25100 OPEN "O",#1,"IDEX"
25110 FOR T = 1 TO 30
25120 WRITE #1,IDEXA(T),IDEXB(T),IDEXC(T),MFLG(T)
25130 NEXT T
25140 CLOSE #1
25150 RETURN
26000 REM *********** READ MAX MIN DATA
26100 A$ = STR$(A)
26110 A$ = MID$(A$,2)
26120 A$ = "MAXMIN" + A$
26200 OPEN "I",#1,A$
26210 FOR T = 1 TO NREC(A)
26220 INPUT #1,MAXD#(T),MIND#(T)
26230 NEXT T
26240 CLOSE #1
26250 RETURN
27000 REM *********** WRITEMAX MIN DATA
27100 A$ = STR$(A)
27110 A$ = MID$(A$,2)
27120 A$ = "MAXMIN" + A$
27200 OPEN "O",#1,A$
27210 FOR T = 1 TO NREC(A)
27220 WRITE #1,MAXD#(T),MIND#(T)
27230 NEXT T
27240 CLOSE #1
27250 RETURN
28000 REM **********  READ IDEX SUBROUTINE
28100 GOSUB 500
28105 PRINT "FILE        LIMITS"
28110 FOR T = 1 TO MAXF
28112 T2 = IDEXA(T)
28114 T3 = IDEXB(T)
28116 T4 = IDEXC(T)
28120 PRINT T;
28122 IF MFLG(T) = 2 THEN PRINT TAB(15)"YES" ELSE PRINT TAB(15)"NO"
28130 NEXT T
28150 RETURN
29000 REM **********  LPRINT IDEX SUBROUTINE
29100 GOSUB 500
29105 LPRINT "FILE    LIMITS"
29110 FOR T = 1 TO MAXF
29112 T2 = IDEXA(T)
29114 T3 = IDEXB(T)
29116 T4 = IDEXC(T)
29120 LPRINT T;
29122 IF MFLG(T) = 2 THEN LPRINT TAB(15)"YES" ELSE LPRINT TAB(15)"NO"
29130 NEXT T
29150 RETURN
30000 REM *******  INPUT MAXD AND MIND
30100 GOSUB 500
30110 PRINT T;" - ";FLDN$(A,T)
30120 PRINT "***  WHAT IS THE MAXIMUM VALUE YOU WANT FOR THIS FIELD  ***"
30130 GOSUB 60180
30140 MAXD#(T) = DT#
30200 PRINT "***  WHAT IS THE MINIMUM VALUE YOU WANT FOR THIS FIELD  ***"
30210 GOSUB 60180
30220 MIND#(T) = DT#
30300 RETURN
40000 REM ****** INITIAL MENU
40100 GOSUB 500
40110 PRINT "**********************  INITIAL MENU  ************************"
40120 PRINT "     0 - EXIT PROGRAM "
40130 PRINT "     1 - TURN MAX MIN OFF OR ON "
40140 PRINT "     2 - SHOW MAXIMUMS AND MINIMUMS ON SCREEN"
40150 PRINT "     3 - SHOW  MAX OPTION FOR EACH FILE ON SCREEN"
40160 PRINT "     4 - PRINT MAXIMUMS AND MINIMUMS ON PAPER"
40170 PRINT "     5 - PRINT MAX OPTION FOR EACH FILE ON PAPER"
40180 PRINT "     6 - ENTER ALL NEW MAXIMUMS AND MINIMUMS FOR A FILE"
40190 PRINT "     7 - CHANGE THE MAXIMUM AND MINIMUMS FOR A SINGLE FIELD"
40200 PRINT "************  ENTER THE NUMBER THEN PRESS RETURN  ************"
40210 GOSUB 60000
40220 IF DT# < 0 OR DT# > 7 THEN 40210
40230 T = DT#
40240 IF T = 0 THEN GOTO 51000
40250 ON T GOTO 41000,42000,43000,44000,45000,46000,47000
41000 REM ********  CHANGE INDEX OR TURN MAX MIN OFF
41100 GOSUB 500
41110 GOSUB 56000
41180 GOSUB 500
41500 PRINT "****  DO YOU WANT LIMITS FOR THIS FILE  ****"
41510 PRINT "          1 - NO "
41520 PRINT "          2 - YES"
41530 PRINT "***  ENTER THE NUMBER THEN PRESS RETURN  ***"
41540 GOSUB 60000
41550 MFLG(A) = DT#
41700 GOSUB 25000
41710 GOTO 40000
42000 REM ********  SHOW MAXIMINS AND MINIMIMS ON SCREEN
42040 GOSUB 500
42050 GOSUB 56000
42055 IF MFLG(A) <> 2 THEN 40000
42060 GOSUB 26000
42100 GOSUB 500
42200 GOSUB 20000
42300 GOTO 40000
43000 REM ********  SHOW INDEX AND MAX OPTION ON SCREEN
43100 GOSUB 28000
43150 PRINT "******  PRESS ANY KEY TO CONTINUE  ******"
43200 IF INKEY$ = "" THEN 43200
43300 GOTO 40000
44000 REM ********  PRINT MAXIMUM AND MINIMUMS ON PAPER
44040 GOSUB 500
44050 GOSUB 56000
44055 IF MFLG(A) <> 2 THEN 40000
44060 GOSUB 26000
44100 GOSUB 500
44200 GOSUB 21000
44300 GOTO 40000
45000 REM ********  PRINT INDEX FIELDS AND MAX OPTION ON PAPER
45100 GOSUB 29000
45300 GOTO 40000
46000 REM *******  ENTER ALL NEW MAXIMUMS AND MINIMUMS FOR A FILE
46100 GOSUB 500
46110 GOSUB 56000
46180 FOR T = 1 TO NREC(A)
46185 IF FTY(A,T) = 1 GOTO 46200
46190 GOSUB 30000
46200 NEXT T
46210 GOSUB 27000
46300 GOTO 40000
47000 REM ********  CHANGE THE MAXIMUMS AND MINIMUMS FOR A SINGLE FIELD
47100 GOSUB 500
47110 GOSUB 56000
47115 GOSUB 26000
47120 GOSUB 500
47130 PRINT "****  WHAT FIELD DO YOU WANT TO CHANGE THE MAXIMUMS AND MINIMUMS  ****"
47180 FOR T = 1 TO NREC(A)
47185 PRINT T;" - ";FLDN$(A,T)
47200 NEXT T
47210 PRINT "*****  ENTER THE NUMBER THEN PRESS RETURN  *****"
47220 GOSUB 60000
47230 IF DT# < 1 OR DT# > NREC(A) THEN 47220
47240 T = DT#
47250 GOSUB 30000
47810 GOSUB 27000
47900 GOTO 40000
50000 REM **********  INTRO
50010 GOSUB 500
50100 PRINT "               L I M I T S    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 ""
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
56000 REM ****  WHAT FILE
56105 PRINT "***********  WHICH FILE DO YOU WANT  ************"
56110 FOR T = 1 TO MAXF
56120 PRINT T;" - ";F$(T)
56130 NEXT T
56140 PRINT "******  ENTER THE NUMBER THEN PRESS RETURN  *****"
56150 GOSUB 60000
56160 IF DT# < 1 OR DT# > MAXF THEN 56150
56170 A = DT#
56200 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) = " "
62970 PRINT CHR$(C