Power-Programmierung

home *** CD-ROM | disk | FTP | other *** search

/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / bc_sf / sf-facts.bas < prev next >

Wrap

BASIC Source File | 1994-05-25 | 37.5 KB | 783 lines

1 REM Filename: SF-FACTS 2 K$ = "Copyright Frederick G. Volking 1986" 3 K$ = "6891 gnikloV .G kcirederF thgirypoC" 10 CLS : KEY OFF: GOSUB 18000 20 DIM SCR$(23) 30 DIM RSVD$(5): GOSUB 42000 40 DIM ENTEST$(9): GOSUB 41000 50 REPL$ = CHR$(249): REPL2$ = REPL$ + REPL$ 60 DIM VARDIC$(99), VARTYP%(99), VARLEN%(99), VARMSK%(99) 70 DIM VARVAR$(99), VARROW%(99), VARCOL%(99) 80 MAXVARS% = 99: REM if changing above DIM's change this to MATCH! 90 TOPVAR% = 0 100 DIM WIN%(1, 23, 80): GOSUB 42560 1000 REM START & RETART 1010 CV% = 1: VO% = 1 1020 GOSUB 42100: REM open, field and rtrieve temp file 10000 REM data item entry phase 10020 GOSUB 20000: REM show data items screen 10040 GOSUB 42100: REM get system info 10060 IF BCFILE$ <= " " THEN GOTO 10180 10080 TCFILE$ = BCFILE$: GOSUB 42250: REM test data file 10100 IF TCFILE$ <= " " THEN GOTO 10180 10120 GOSUB 42330: REM get file data 10140 GOSUB 21000: REM fill data items screen varbs 10160 IF CV% = 0 THEN GOTO 10580 ELSE GOTO 10920 10180 REM collect file name 10200 ENSTAT$ = "04260880": ENDFLT$ = BCFILE$: HELP% = 1 10220 GOSUB 40000: REM collect 10240 IF ENWAY% = 20 THEN GOSUB 21980: GOTO 10180 10250 IF ENWAY% = 16 THEN GOSUB 21880: GOTO 10180 10260 IF ENRETURN$ <= " " THEN SOUND 50, 3: GOTO 10180 10280 BCFILE$ = ENRETURN$ 10300 TCFILE$ = BCFILE$: GOSUB 42250: REM test bcfile$ 10320 IF TCFILE$ = "" THEN GOTO 10460 10340 MSG$ = "File Exists ... Load? Y/N:": HELP% = 197: GOSUB 21410 10360 IF ENWAY% > 0 OR ENRETURN$ = "n" OR ENRETURN$ = "N" THEN GOTO 10180 10380 GOSUB 42330: REM get bcfile$ data 10400 GOSUB 21000: REM display 10420 GOSUB 42420: REM put away system info 10440 GOTO 10580 10460 REM verify new file 10480 MSG$ = "New File ... Correct? Y/N": HELP% = 210: GOSUB 21410 10500 IF ENWAY% > 0 OR ENRETURN$ = "n" OR ENRETURN$ = "N" THEN GOTO 10180 10520 GOSUB 21290 10540 GOSUB 21000 10560 GOTO 10580 10580 REM collect key dic-desc 10600 ENSTAT$ = "10142020": ENDFLT$ = VARDIC$(0): HELP% = 91 10620 GOSUB 40000: VARDIC$(0) = ENRETURN$ 10640 ON (ENWAY% + 1) GOTO 10700, 10580, 10700, 10580, 10880, 10660, 10660, 10660, 10660, 10660, 10660, 10660, 10920, 10660, 10660, 10660, 10660, 14180 10660 ON (ENWAY% - 4) GOSUB 12960, 13040, 13160, 13580, 12640, 12780, 21520, 22020, 21580, 21640, 21700, 21820, 22020, 22020, 22020, 21920 10680 GOTO 10580 10700 REM collect key length 10720 ENSTAT$ = "10420241": ENDFLT$ = RIGHT$(STR$(VARLEN%(0)), 2): HELP% = 55 10740 GOSUB 40000: VARLEN%(0) = VAL(ENRETURN$) 10760 IF VARLEN%(0) < 1 THEN VARLEN%(0) = 1 10780 IF VARLEN%(0) > 40 THEN VARLEN%(0) = 40 10800 LOCATE 10, 42: PRINT USING "##"; VARLEN%(0); 10820 ON (ENWAY% + 1) GOTO 10880, 10580, 10700, 10580, 10880, 10840, 10840, 10840, 10840, 10840, 10840, 10840, 10880, 10840, 10840, 10840, 10840, 14180 10840 ON (ENWAY% - 4) GOSUB 12960, 13040, 13160, 13580, 12640, 12780, 21520, 22020, 21580, 21640, 21700, 21820, 22020, 22020, 22020, 21920 10860 GOTO 10700 10880 REM collect data items 10900 IF CV% < 1 THEN CV% = 1 10920 REM collect data dictionary name 10940 ENROW% = (CV% - (VO% - 1)) + 11: ENCOL% = 14: ENLEN% = 20: ENTEST% = 2: ENKIND% = 0 10960 ENDFLT$ = VARDIC$(CV%): HELP% = 17 10980 GOSUB 40100: REM collect 11000 VARDIC$(CV%) = ENRETURN$ 11020 IF VARTYP%(CV%) = 0 THEN GOSUB 11340 11040 IF CV% = 1 AND ENWAY% = 3 THEN CV% = 0: GOTO 10580 11060 ON (ENWAY% + 1) GOTO 11120, 12060, 11120, 11080, 11080, 11080, 11080, 11080, 11080, 11080, 11080, 11080, 10920, 11080, 11080, 11080, 11080, 14180 11080 ON (ENWAY% - 2) GOSUB 12440, 12540, 12960, 13040, 13160, 13580, 12640, 12780, 21520, 22020, 21580, 21640, 21700, 21820, 22020, 22020, 22020, 21920, 19000 11100 GOTO 10920 11120 REM collect type$ 11140 LOCATE (CV% - (VO% - 1)) + 11, 35 11160 IF VARTYP%(CV%) < 1 OR VARTYP%(CV%) > 5 THEN VARTYP%(CV%) = 1 11180 ON VARTYP%(CV%) GOSUB 11400, 11500, 11600, 11700, 11800 11200 ENROW% = (CV% - (VO% - 1)) + 11: ENCOL% = 35: ENLEN% = 1: ENTEST% = 9: ENKIND% = 0 11220 ENDFLT$ = RIGHT$(STR$(VARTYP%(CV%)), 1): HELP% = 32: GOSUB 40100 11240 IF ENPASS% > 0 THEN VARTYP%(CV%) = VAL(ENRETURN$): LOCATE (CV% - (VO% - 1)) + 11, 35: ON VARTYP%(CV%) GOSUB 11400, 11500, 11600, 11700, 11800 11260 IF CV% = 1 AND ENWAY% = 3 THEN GOTO 10580 11280 ON (ENWAY% + 1) GOTO 12060, 10920, 12060, 11300, 11300, 11300, 11300, 11300, 11300, 11300, 11300, 11300, 10920, 11300, 11300, 11300, 11300, 14180 11300 ON (ENWAY% - 2) GOSUB 12440, 12540, 12960, 13040, 13160, 13580, 12640, 12780, 21520, 22020, 21580, 21640, 21700, 21820, 22020, 22020, 22020, 21920, 19000 11320 GOTO 11120 11340 REM assign a blank set of fields 11360 IF VARDIC$(CV%) = "" AND VARTYP%(CV%) = 0 AND VARLEN%(CV%) = 0 AND ENWAY% <> 4 THEN RETURN 11380 VARTYP%(CV%) = 1: LOCATE (CV% - (VO% - 1)) + 11, 35 11400 REM text 11420 PRINT "1txt"; 11440 IF VARLEN%(CV%) > 79 THEN VARLEN%(CV%) = 79 11460 IF VARLEN%(CV%) = 0 THEN VARLEN%(CV%) = 20 11480 GOTO 11900 11500 REM integer 11520 PRINT "2int"; 11540 VARLEN%(CV%) = 4 11560 VARMSK%(CV%) = 4 11580 GOTO 11900 11600 REM single 11620 PRINT "3sng"; 11640 VARMSK%(CV%) = 5 11660 IF VARLEN%(CV%) > 38 THEN VARLEN%(CV%) = 38 11680 GOTO 11900 11700 REM double 11720 PRINT "4dbl"; 11740 VARMSK%(CV%) = 5 11760 IF VARLEN%(CV%) > 38 THEN VARLEN%(CV%) = 38 11780 GOTO 11900 11800 REM date 11820 PRINT "5day"; 11840 VARLEN%(CV%) = 6 11860 VARMSK%(CV%) = 4 11880 GOTO 11900 11900 REM combine 11920 IF VARDIC$(CV%) = "" THEN VARDIC$(CV%) = "BLANK": LOCATE (CV% - (VO% - 1)) + 11, 14: PRINT VARDIC$(CV%); 11940 IF VARLEN%(CV%) < 1 THEN VARLEN%(CV%) = 1 11960 IF VARMSK%(CV%) < 1 THEN VARMSK%(CV%) = 3 11980 LOCATE (CV% - (VO% - 1)) + 11, 42: PRINT RIGHT$(STR$(VARLEN%(CV%)), 2); 12000 LOCATE (CV% - (VO% - 1)) + 11, 49: PRINT RIGHT$(STR$(VARMSK%(CV%)), 1); 12020 IF CV% > TOPVAR% THEN TOPVAR% = CV% 12040 RETURN 12060 REM collect length 12080 IF VARTYP%(CV%) = 0 THEN GOSUB 11340 12100 IF VARTYP%(CV%) = 5 THEN GOTO 12300 12120 ENROW% = (CV% - (VO% - 1)) + 11: ENCOL% = 42: ENLEN% = 2: ENTEST% = 4: ENKIND% = 1 12140 ENDFLT$ = RIGHT$(STR$(VARLEN%(CV%)), 2): HELP% = 55 12160 GOSUB 40100: REM collect 12180 IF ENPASS% = 0 THEN GOTO 12300 12200 ENRETURN% = VAL(ENRETURN$) 12220 IF ENRETURN% < 1 THEN ENRETURN% = 1 12240 IF VARTYP%(CV%) = 2 AND ENRETURN% > 4 THEN ENRETURN% = 4 12260 IF (VARTYP%(CV%) = 3 OR VARTYP%(CV%) = 4) AND ENRETURN% > 38 THEN ENRETURN% = 38 12280 VARLEN%(CV%) = ENRETURN% 12300 REM combine 12320 LOCATE (CV% - (VO% - 1)) + 11, 42 12340 PRINT RIGHT$(STR$(VARLEN%(CV%)), 2); 12360 IF CV% = 1 AND ENWAY% = 3 THEN GOTO 10700 12380 IF ENWAY% = 0 THEN GOSUB 12540: GOTO 10920 12390 ON (ENWAY% + 1) GOTO 10920, 11120, 10920, 12400, 12400, 12400, 12400, 12400, 12400, 12400, 12400, 12400, 10920, 12400, 12400, 12400, 12400, 14180 12400 ON (ENWAY% - 2) GOSUB 12440, 12540, 12960, 13040, 13160, 13580, 12640, 12780, 21520, 22020, 21580, 21640, 21700, 21820, 22020, 22020, 22020, 21920, 19000 12420 GOTO 12060 12440 REM up 12460 IF CV% = 1 THEN RETURN 12480 CV% = CV% - 1 12500 IF CV% < VO% THEN GOTO 12640 12520 RETURN 12540 REM down 12560 IF CV% = MAXVARS% THEN RETURN 12580 CV% = CV% + 1 12600 IF CV% > (VO% + 9) THEN GOTO 12780 12620 RETURN 12640 REM PgUp 12660 IF VO% = 1 THEN CV% = 1: RETURN 12680 VO% = VO% - 9 12700 IF VO% < 1 THEN VO% = 1 12720 GOSUB 21080 12740 CV% = VO% + 8 12760 RETURN 12780 REM PgDn 12800 IF VO% = (MAXVARS% - 9) THEN CV% = MAXVARS%: RETURN 12820 VO% = VO% + 9 12840 CV% = VO% + 1 12860 IF VO% > TOPVAR% THEN VO% = TOPVAR% - 8: CV% = TOPVAR% 12880 IF VO% < 1 THEN VO% = 1 12900 IF (VO% + 9) > MAXVARS% THEN VO% = (MAXVARS% - 9) 12920 GOSUB 21080 12940 RETURN 12960 REM home 12980 VO% = 1: CV% = 1 13000 GOSUB 21080 13020 RETURN 13040 REM end 13060 VO% = TOPVAR% - 8 13080 IF VO% < 1 THEN VO% = 1 13100 CV% = TOPVAR% 13120 GOSUB 21080 13140 RETURN 13160 REM insert a line 13180 IF TOPVAR% = MAXVARS% THEN RETURN 13200 TOPVAR% = TOPVAR% + 1 13220 FOR T% = TOPVAR% TO CV% STEP (-1) 13240 VARDIC$(T%) = VARDIC$(T% - 1) 13260 VARTYP%(T%) = VARTYP%(T% - 1) 13280 VARLEN%(T%) = VARLEN%(T% - 1) 13300 VARMSK%(T%) = VARMSK%(T% - 1) 13320 VARVAR$(T%) = VARVAR$(T% - 1) 13340 VARROW%(T%) = VARROW%(T% - 1) 13360 VARCOL%(T%) = VARCOL%(T% - 1) 13380 NEXT 13400 VARDIC$(CV%) = "blank" 13420 VARTYP%(CV%) = 1 13440 VARLEN%(CV%) = 20 13460 VARMSK%(CV%) = 3 13480 VARVAR$(CV%) = "" 13500 VARROW%(CV%) = 0 13520 VARCOL%(CV%) = 0 13540 GOSUB 21080 13560 RETURN 13580 REM delete a line 13600 IF CLR% = 1 THEN COLOR CLR7% 13620 LOCATE (CV% - (VO% - 1)) + 11, 1: PRINT "Delete"; CHR$(26); 13640 LOCATE (CV% - (VO% - 1)) + 12, 1: PRINT "Y/N:"; 13660 IF CLR% = 1 THEN COLOR CLR0% 13680 ENROW% = (CV% - (VO% - 1)) + 12: ENCOL% = 5: ENLEN% = 1: ENTEST% = 7: ENKIND% = 0 13700 ENDFLT$ = "": HELP% = 77: GOSUB 40100 13720 IF ENRETURN$ = "Y" OR ENRETURN$ = "y" THEN GOTO 13740 ELSE GOTO 14100 13740 TOPVAR% = TOPVAR% - 1 13760 FOR T% = CV% TO TOPVAR% 13780 VARDIC$(T%) = VARDIC$(T% + 1) 13800 VARTYP%(T%) = VARTYP%(T% + 1) 13820 VARLEN%(T%) = VARLEN%(T% + 1) 13840 VARMSK%(T%) = VARMSK%(T% + 1) 13860 VARVAR$(T%) = VARVAR$(T% + 1) 13880 VARROW%(T%) = VARROW%(T% + 1) 13900 VARCOL%(T%) = VARCOL%(T% + 1) 13920 NEXT 13940 VARDIC$(TOPVAR% + 1) = "" 13960 VARTYP%(TOPVAR% + 1) = 0 13980 VARLEN%(TOPVAR% + 1) = 0 14000 VARMSK%(TOPVAR% + 1) = 0 14020 VARVAR$(TOPVAR% + 1) = "" 14040 VARROW%(TOPVAR% + 1) = 0 14060 VARCOL%(TOPVAR% + 1) = 0 14080 GOSUB 21080 14100 REM branch in for no don't delete 14120 LOCATE (CV% - (VO% - 1)) + 11, 1: PRINT " "; 14140 LOCATE (CV% - (VO% - 1)) + 12, 1: PRINT " "; 14160 RETURN 14180 REM collect defaults 14200 IF CV% < 1 THEN CV% = 1 14220 IF TOPVAR% = 0 THEN GOTO 10880 14240 REM collect mask 14260 IF CV% > TOPVAR% THEN CV% = TOPVAR% 14280 IF VARTYP%(CV%) <> 1 THEN GOTO 14420 14300 ENROW% = (CV% - (VO% - 1)) + 11: ENCOL% = 49: ENLEN% = 1: ENTEST% = 9: ENKIND% = 0 14320 ENDFLT$ = RIGHT$(STR$(VARMSK%(CV%)), 1): HELP% = 222: GOSUB 40100 14340 VARMSK%(CV%) = VAL(ENRETURN$) 14360 ON (ENWAY% + 1) GOTO 14420, 15400, 14420, 14380, 14380, 14380, 14380, 14240, 14380, 14380, 14380, 14380, 10920 14380 ON (ENWAY% - 2) GOSUB 12440, 12540, 12960, 13040, 22020, 13580, 12640, 12780, 21520, 10180, 21580, 21640, 21700, 21820, 22020, 22020, 22020, 21920, 19000 14400 GOTO 14240 14420 REM collect variable name 14440 IF CV% > TOPVAR% THEN CV% = TOPVAR% 14460 ENROW% = (CV% - (VO% - 1)) + 11: ENCOL% = 53: ENLEN% = 10: ENTEST% = 8: ENKIND% = 0 14480 ENDFLT$ = VARVAR$(CV%): HELP% = 244: GOSUB 40100 14500 VARVAR$(CV%) = ENRETURN$ 14520 IF ENPASS% = 0 OR VARVAR$(CV%) = "" THEN GOTO 15100 14540 BCERR% = 0 14560 FOR T% = 1 TO TOPVAR% 14580 IF T% = CV% THEN GOTO 14660 14600 IF VARVAR$(CV%) <> VARVAR$(T%) THEN GOTO 14660 14620 BCERR% = T% 14640 T% = TOPVAR% 14660 NEXT 14680 IF BCERR% = 0 THEN GOTO 14820 14700 MSG$ = "ERROR: Duplicate in line" + STR$(BCERR%) + " <CR>:": HELP% = 290 14720 REM error process 14740 SOUND 50, 3 14760 GOSUB 21410 14780 VARVAR$(CV%) = "" 14800 GOTO 14420 14820 REM verify valid variable name 14840 T% = ASC(LEFT$(VARVAR$(CV%), 1)) 14850 IF LEFT$(VARVAR$(CV%), 2) = "BC" THEN T% = 100 14852 IF LEFT$(VARVAR$(CV%), 1) = "E" THEN KX% = ASC(MID$(VARVAR$(CV%), 2, 1)): IF KX% > 47 AND KX% < 58 THEN T% = 100 14854 IF LEFT$(VARVAR$(CV%), 1) = "D" THEN KX% = ASC(MID$(VARVAR$(CV%), 2, 1)): IF KX% > 47 AND KX% < 58 THEN T% = 100 14860 IF T% > 64 AND T% < 91 THEN GOTO 14920 14880 MSG$ = "ERROR:Invalid variable name <CR>:": HELP% = 298 14900 GOTO 14720 14920 REM test for reserved word 14940 IF LEFT$(VARVAR$(CV%), 2) = "FN" THEN GOTO 15040 14960 FOR T% = 0 TO 5 14980 IF INSTR(RSVD$(T%), VARVAR$(CV%)) > 0 THEN BCERR% = 1 15000 NEXT 15020 IF BCERR% = 0 THEN GOTO 15100 15040 REM reserved word error 15060 MSG$ = "ERROR: Basic Reserved Word <CR>:": HELP% = 311 15080 GOTO 14720 15100 ON (ENWAY% + 1) GOTO 15160, 14240, 15160, 15120, 15120, 15120, 15120, 14420, 15120, 15120, 15120, 15120, 10920 15120 ON (ENWAY% - 2) GOSUB 12440, 12540, 12960, 13040, 22020, 13580, 12640, 12780, 21520, 10180, 21580, 21640, 21700, 21820, 22020, 22020, 22020, 21920, 19000 15140 GOTO 14420 15160 REM collect row 15180 IF CV% > TOPVAR% THEN CV% = TOPVAR% 15200 ENROW% = (CV% - (VO% - 1)) + 11: ENCOL% = 65: ENLEN% = 2: ENTEST% = 4: ENKIND% = 1 15220 ENDFLT$ = RIGHT$(STR$(VARROW%(CV%)), 2): HELP% = 259: GOSUB 40100 15240 VARROW%(CV%) = VAL(ENRETURN$) 15260 IF VARROW%(CV%) < 25 THEN GOTO 15320 15280 VARROW%(CV%) = 25: LOCATE (CV% - (VO% - 1)) + 11, 65 15300 PRINT USING "##"; VARROW%(CV%); 15320 IF CV% = 1 AND ENWAY% = 3 THEN GOTO 15640 15340 ON (ENWAY% + 1) GOTO 15400, 14420, 15400, 15360, 15360, 15360, 15360, 15160, 15360, 15360, 15360, 15360, 10920 15360 ON (ENWAY% - 2) GOSUB 12440, 12540, 12960, 13040, 22020, 13580, 12640, 12780, 21520, 10180, 21580, 21640, 21700, 21820, 22020, 22020, 22020, 21920, 19000 15380 GOTO 15160 15400 REM collect col 15420 IF CV% > TOPVAR% THEN CV% = TOPVAR% 15440 ENROW% = (CV% - (VO% - 1)) + 11: ENCOL% = 69: ENLEN% = 2: ENTEST% = 4: ENKIND% = 1 15460 ENDFLT$ = RIGHT$(STR$(VARCOL%(CV%)), 2): HELP% = 273: GOSUB 40100 15480 VARCOL%(CV%) = VAL(ENRETURN$) 15500 IF VARCOL%(CV%) < (79 - VARLEN%(CV%)) THEN GOTO 15560 15520 VARCOL%(CV%) = (79 - VARLEN%(CV%)): LOCATE (CV% - (VO% - 1)) + 11, 69 15540 PRINT USING "##"; VARCOL%(CV%); 15560 IF CV% = 1 AND ENWAY% = 3 THEN GOTO 15840 15580 ON (ENWAY% + 1) GOTO 14240, 15160, 14240, 15600, 15600, 15600, 15600, 15400, 15600, 15600, 15600, 15600, 10920 15600 ON (ENWAY% - 2) GOSUB 12440, 12540, 12960, 13040, 22020, 13580, 12640, 12780, 21520, 10180, 21580, 21640, 21700, 21820, 22020, 22020, 22020, 21920, 19000 15620 GOTO 15400 15640 REM collect key row 15660 ENSTAT$ = "10650241": ENDFLT$ = RIGHT$(STR$(VARROW%(0)), 2): HELP% = 259 15680 GOSUB 40000 15700 VARROW%(0) = VAL(ENRETURN$) 15720 IF VARROW%(0) < 25 THEN GOTO 15780 15740 VARROW%(0) = 25: LOCATE 10, 65 15760 PRINT USING "##"; VARROW%(0); 15780 ON (ENWAY% + 1) GOTO 15840, 15640, 15840, 15640, 15160, 15800, 15800, 15160, 15800, 15800, 15800, 15800, 10920 15800 ON (ENWAY% - 2) GOSUB 12440, 12540, 12960, 13040, 22020, 13580, 12640, 12780, 21520, 10180, 21580, 21640, 21700, 21820, 22020, 22020, 22020, 21920 15820 GOTO 15640 15840 REM collect key col 15860 ENSTAT$ = "10690241": ENDFLT$ = RIGHT$(STR$(VARCOL%(0)), 2): HELP% = 273 15880 GOSUB 40000 15900 VARCOL%(0) = VAL(ENRETURN$) 15920 IF VARCOL%(0) < (79 - VARLEN%(0)) THEN GOTO 15980 15940 VARCOL%(0) = (79 - VARLEN%(0)): LOCATE 10, 69 15960 PRINT USING "##"; VARROW%(0); 15980 ON (ENWAY% + 1) GOTO 15640, 15640, 15840, 15640, 15400, 15800, 15800, 15400, 15800, 15800, 15800, 15800, 10920 16000 ON (ENWAY% - 2) GOSUB 12440, 12540, 12960, 13040, 22020, 13580, 12640, 12780, 21520, 10180, 21580, 21640, 21700, 21820, 22020, 22020, 22020, 21920 16020 GOTO 15840 17000 REM clear screen & print working 17010 CLS 17020 LOCATE 10, 30 17030 PRINT "Working ...."; 17040 RETURN 18000 REM clear and print working 18020 IF CLR% = 1 THEN COLOR CLR0% 18030 LOCATE 9, 30: PRINT "┌──────────────┐"; 18040 LOCATE 10, 30: PRINT "│ working .... │"; 18050 LOCATE 11, 30: PRINT "└──────────────┘"; 18060 RETURN 19000 REM swap variables 19005 HELP% = 577 19010 LOCATE 4, 36: IF CLR% = 1 THEN COLOR CLR7% 19020 PRINT "<^S>wap Code: Code: Do?(Y/N):"; 19040 REM collect swap var 1 19050 GOSUB 19800 19070 ENSTAT$ = "04490241": ENDFLT$ = RIGHT$(STR$(SVAR1%), 2) 19080 GOSUB 40000: SVAR1% = VAL(ENRETURN$) 19090 SWAPIT% = 0: GOSUB 19900: IF SWAPIT% = 1 THEN GOTO 19040 19100 IF ENWAY% = 20 THEN GOTO 19950 19110 IF SVAR1% < 1 THEN SVAR1% = 1: SOUND 50, 3: GOSUB 19800: GOTO 19040 19120 IF SVAR1% > TOPVAR% THEN SVAR1% = TOPVAR%: SOUND 50, 3: GOSUB 19800: GOTO 19040 19130 REM collect swap var 2 19140 GOSUB 19800 19150 ENSTAT$ = "04570241": ENDFLT$ = RIGHT$(STR$(SVAR2%), 2) 19160 GOSUB 40000: SVAR2% = VAL(ENRETURN$) 19170 SWAPIT% = 0: GOSUB 19900: IF SWAPIT% = 1 THEN GOTO 19130 19180 IF ENWAY% = 20 THEN GOTO 19950 19190 IF SVAR2% < 1 THEN SVAR2% = 1: SOUND 50, 3: GOSUB 19800: GOTO 19130 19200 IF SVAR2% > TOPVAR% THEN SVAR2% = TOPVAR%: SOUND 50, 3: GOSUB 19800: GOTO 19130 19210 IF SVAR2% = SVAR1% THEN SVAR2% = 0: SOUND 50, 3: GOSUB 19800: GOTO 19130 19220 REM collect action DO? 19230 ENSTAT$ = "04690170": ENDFLT$ = "Y": GOSUB 40000 19240 SWAPIT% = 0: GOSUB 19900: IF SWAPIT% = 1 THEN GOTO 19220 19250 IF ENWAY% = 20 THEN GOTO 19950 19260 IF ENRETURN$ = "N" OR ENRETURN$ = "n" THEN GOTO 19040 19270 SWAP VARDIC$(SVAR1%), VARDIC$(SVAR2%) 19280 SWAP VARTYP%(SVAR1%), VARTYP%(SVAR2%) 19290 SWAP VARLEN%(SVAR1%), VARLEN%(SVAR2%) 19300 SWAP VARMSK%(SVAR1%), VARMSK%(SVAR2%) 19310 SWAP VARVAR$(SVAR1%), VARVAR$(SVAR2%) 19320 SWAP VARROW%(SVAR1%), VARROW%(SVAR2%) 19330 SWAP VARCOL%(SVAR1%), VARCOL%(SVAR2%) 19340 GOSUB 21080: REM show swaped screen 19350 GOTO 19040 19800 REM show swap variables 19810 LOCATE 4, 49: IF CLR% = 1 THEN COLOR CLR0% 19820 PRINT USING "##"; SVAR1%; 19830 LOCATE 4, 57 19840 PRINT USING "##"; SVAR2%; 19850 RETURN 19900 REM change view from swap 19905 IF ENWAY% = 5 THEN GOSUB 12960: SWAPIT% = 1: RETURN: REM home 19910 IF ENWAY% = 6 THEN GOSUB 13040: SWAPIT% = 1: RETURN: REM end 19915 IF ENWAY% = 9 THEN GOSUB 12640: SWAPIT% = 1: RETURN: REM PgUp 19920 IF ENWAY% = 10 THEN GOSUB 12780: SWAPIT% = 1: RETURN: REM PgDn 19930 RETURN 19950 REM swapping done - return 19955 LOCATE 4, 36: PRINT SPACE$(34); 19960 IF CLR% = 1 THEN COLOR CLR0% 19965 ENWAY% = 99 19970 RETURN 20000 REM show data items screen 20010 CLS : IF CLR% = 1 THEN COLOR CLR1%, 0 20020 PRINT "╔═════════════════════════════════════════════════════════════════════════════╗" 20030 PRINT "║ ║" 20040 PRINT "╚══════╤══════════════════════════════════════════════════════════════╤═══════╝" 20050 PRINT " │ │" 20060 PRINT " ├────┬────────────────────┬────┬──────╥────────────────────────┤" 20070 PRINT " │ │ │ │ ║ │" 20080 PRINT " │ │ │ │ ║ ┬ ┬ ┬ │" 20090 PRINT " │ │ │ │ ║ │ │ │ │" 20100 PRINT " ├────┼────────────────────┼────┼──────╫─────┼──────────┼───┼───┤" 20110 PRINT " │ │ │ │ ║ │ │ │ │" 20120 PRINT " ├────┼────────────────────┼────┼──────╫─────┼──────────┼───┼───┤" 20130 PRINT " │ │ │ │ ║ │ │ │ │" 20140 PRINT " │ │ │ │ ║ │ │ │ │" 20150 PRINT " │ │ │ │ ║ │ │ │ │" 20160 PRINT " │ │ │ │ ║ │ │ │ │" 20170 PRINT " │ │ │ │ ║ │ │ │ │" 20180 PRINT " │ │ │ │ ║ │ │ │ │" 20190 PRINT " │ │ │ │ ║ │ │ │ │" 20200 PRINT " │ │ │ │ ║ │ │ │ │" 20210 PRINT " │ │ │ │ ║ │ │ │ │" 20220 PRINT " │ │ │ │ ║ │ │ │ │" 20230 PRINT " └────┴────────────────────┴────┴──────╨─────┴──────────┴───┴───┘" 20240 IF CLR% = 1 THEN COLOR CLR3% 20250 PRINT "Action Keys:"; : IF CLR% = 1 THEN COLOR CLR4% 20270 PRINT " <"; CHR$(24); "> <"; CHR$(25); "> <"; CHR$(26); "> <"; CHR$(27); "> <Home> <End> <PgUp> <PgDn> <Ins> <Del> <^S>"; 20275 IF CLR% = 1 THEN COLOR CLR3% 20276 PRINT "wap"; : IF CLR% = 1 THEN COLOR CLR4% 20280 LOCATE 24, 1: PRINT " <F1>"; : IF CLR% = 1 THEN COLOR CLR3% 20290 PRINT "Help "; : IF CLR% = 1 THEN COLOR CLR4% 20310 PRINT "<F2>"; : IF CLR% = 1 THEN COLOR CLR3% 20330 PRINT "Generate-code "; : IF CLR% = 1 THEN COLOR CLR4% 20350 PRINT "<F3>"; : IF CLR% = 1 THEN COLOR CLR3% 20370 PRINT "Edit-Data-Items "; : IF CLR% = 1 THEN COLOR CLR4% 20390 PRINT "<F4>"; : IF CLR% = 1 THEN COLOR CLR3% 20410 PRINT "Edit-Screen"; ; : LOCATE 25, 1: IF CLR% = 1 THEN COLOR CLR4% 20440 PRINT " <F5>"; : IF CLR% = 1 THEN COLOR CLR3% 20460 PRINT "Save "; : IF CLR% = 1 THEN COLOR CLR4% 20480 PRINT "<F6>"; : IF CLR% = 1 THEN COLOR CLR3% 20500 PRINT "Load "; : IF CLR% = 1 THEN COLOR CLR4% 20520 PRINT "<F7>"; : IF CLR% = 1 THEN COLOR CLR3% 20540 PRINT "Restart "; : IF CLR% = 1 THEN COLOR CLR4% 20560 PRINT "<F8>"; : IF CLR% = 1 THEN COLOR CLR3% 20580 PRINT "Edit-Defaults "; : IF CLR% = 1 THEN COLOR CLR4% 20600 PRINT "<ESC>"; : IF CLR% = 1 THEN COLOR CLR3% 20620 PRINT "QUIT"; : IF CLR% THEN COLOR CLR5% 20640 LOCATE 2, 4: PRINT "BasiCoder-SF(tm) Copyright Frederick G. Volking 1985-1986 Ver: 2.5.4" 20650 IF CLR% = 1 THEN COLOR CLR2% 20660 LOCATE 4, 10: PRINT "Data File Name:" 20670 LOCATE 6, 22: PRINT "Data" 20680 LOCATE 6, 48: PRINT "Default Specifications" 20690 LOCATE 7, 9: PRINT "Code" 20700 LOCATE 7, 20: PRINT "Glossary" 20710 LOCATE 7, 35: PRINT "Type" 20720 LOCATE 7, 40: PRINT "Length" 20730 LOCATE 8, 22: PRINT "Name" 20740 LOCATE 8, 48: PRINT "Mask" 20750 LOCATE 8, 54: PRINT "Variable" 20760 LOCATE 8, 64: PRINT "Row" 20770 LOCATE 8, 68: PRINT "Col" 20780 IF CLR% = 1 THEN COLOR CLR6% 20790 LOCATE 10, 11: PRINT "0" 20800 LOCATE 10, 35: PRINT "KEY$" 20810 LOCATE 10, 49: PRINT "1" 20820 LOCATE 10, 55: PRINT "DATKEY" 20830 IF CLR% = 1 THEN COLOR CLR0% 20840 RETURN 21000 REM fill data items screen variables 21010 LOCATE 4, 26: IF BCFILE$ > "" THEN PRINT BCFILE$; ELSE PRINT STRING$(8, REPL$); 21020 LOCATE 10, 14: IF VARDIC$(0) > "" THEN PRINT VARDIC$(0); ELSE PRINT STRING$(20, REPL$); 21030 LOCATE 10, 42: IF VARLEN%(0) > 0 THEN PRINT USING "##"; VARLEN%(0); ELSE PRINT STRING$(2, REPL$); 21040 LOCATE 10, 65: IF VARROW%(0) > 0 THEN PRINT USING "##"; VARROW%(0); ELSE PRINT STRING$(2, REPL$); 21050 LOCATE 10, 69: IF VARCOL%(0) > 0 THEN PRINT USING "##"; VARCOL%(0); ELSE PRINT STRING$(2, REPL$); 21060 GOSUB 21080 21070 RETURN 21080 REM fill varbs area of data item edit screen 21090 FOR X% = 0 TO 9 21100 T1% = VO% + X% 21110 X1% = X% + 12 21120 LOCATE X1%, 10: PRINT USING "##"; T1%; 21130 LOCATE X1%, 14: IF VARDIC$(T1%) > "" THEN PRINT VARDIC$(T1%) + SPACE$(20 - (LEN(VARDIC$(T1%)))); ELSE PRINT STRING$(20, REPL$); 21140 LOCATE X1%, 35 21150 ON VARTYP%(T1%) GOTO 21170, 21180, 21190, 21200, 21210 21160 PRINT REPL2$; REPL2$; : GOTO 21220 21170 PRINT "1txt"; : GOTO 21220 21180 PRINT "2int"; : GOTO 21220 21190 PRINT "3sng"; : GOTO 21220 21200 PRINT "4dbl"; : GOTO 21220 21210 PRINT "5day"; 21220 LOCATE X1%, 42: IF VARLEN%(T1%) > 0 THEN PRINT USING "##"; VARLEN%(T1%); ELSE PRINT REPL2$; 21230 LOCATE X1%, 49: IF VARMSK%(T1%) > 0 THEN PRINT USING "#"; VARMSK%(T1%); ELSE PRINT REPL$; 21240 LOCATE X1%, 53: IF VARVAR$(T1%) > "" THEN PRINT VARVAR$(T1%) + SPACE$(10 - (LEN(VARVAR$(T1%)))); ELSE PRINT STRING$(10, REPL$); 21250 LOCATE X1%, 65: IF VARROW%(T1%) > 0 THEN PRINT USING "##"; VARROW%(T1%); ELSE PRINT REPL2$; 21260 LOCATE X1%, 69: IF VARCOL%(T1%) > 0 THEN PRINT USING "##"; VARCOL%(T1%); ELSE PRINT REPL2$; 21270 NEXT 21280 RETURN 21290 REM erase all variables 21300 FOR T% = 0 TO MAXVARS% 21310 VARDIC$(T%) = "" 21320 VARTYP%(T%) = 0 21330 VARLEN%(T%) = 0 21340 VARMSK%(T%) = 0 21350 VARVAR$(T%) = "" 21360 VARROW%(T%) = 0 21370 VARCOL%(T%) = 0 21380 NEXT 21390 CV% = 1: VO% = 1: TOPVAR% = 0 21400 RETURN 21410 REM display message & collect response 21420 IF CLR% = 1 THEN COLOR CLR7% 21430 GOSUB 21470 21440 ENSTAT$ = "04690170": ENDFLT$ = "" 21450 GOSUB 40000 21460 MSG$ = "" 21470 REM display message in message area 21480 LOCATE 4, 35: PRINT SPACE$(36); 21490 LOCATE 4, (68 - (LEN(MSG$))): PRINT MSG$; 21500 IF CLR% = 1 THEN COLOR CLR0% 21510 RETURN 21520 REM F2 - generate code 21530 MSG$ = "Generate Code? Y/N:": HELP% = 107: GOSUB 21410 21540 IF ENWAY% > 0 OR ENRETURN$ = "n" OR ENRETURN$ = "N" THEN RETURN 21545 GOSUB 17000 21550 GOSUB 42420 21560 GOSUB 42470 21570 CLOSE : CLS : GOSUB 18000: CLEAR : CHAIN "SF-DRAFT" 21580 REM F4 - edit screen 21590 MSG$ = "Edit the Input Screen? Y/N:": HELP% = 124: GOSUB 21410 21600 IF ENWAY% > 0 OR ENRETURN$ = "n" OR ENRETURN$ = "N" THEN RETURN 21605 GOSUB 17000 21610 GOSUB 42420 21620 GOSUB 42470 21630 CLOSE : CLS : GOSUB 18000: CLEAR : CHAIN "SF-PLACE" 21640 REM F5 - save 21650 MSG$ = "Save Data? Y/N:": HELP% = 137: GOSUB 21410 21660 IF ENWAY% > 0 OR ENRETURN$ = "n" OR ENRETURN$ = "N" THEN RETURN 21670 GOSUB 42420 21680 GOSUB 42470 21690 RETURN 21700 REM F6 - load 21710 MSG$ = "Save Data before Load? Y/N:": HELP% = 152: GOSUB 21410 21720 IF ENWAY% > 0 THEN RETURN 21730 IF ENRETURN$ = "N" OR ENRETURN$ = "n" THEN GOTO 21760 21740 GOSUB 42420 21750 GOSUB 42470 21760 REM verify load 21770 MSG$ = "Load New File? Y/N:": HELP% = 160: GOSUB 21410 21780 IF ENWAY% > 0 OR ENRETURN$ = "n" OR ENRETURN$ = "N" THEN RETURN 21790 BCFILE$ = "": CV% = 1: VO% = 1: TOPVAR% = 0 21800 GOSUB 42420 21810 RUN 21820 REM F7 - restart at initial menu? 21830 MSG$ = "Save Data before Restart? Y/N:": HELP% = 187: GOSUB 21410 21840 IF ENWAY% > 0 THEN RETURN 21850 IF ENRETURN$ = "N" OR ENRETURN$ = "n" THEN GOTO 21880 21860 GOSUB 42420 21870 GOSUB 42470 21880 REM verify exit to start 21890 MSG$ = "Restart? Y/N:": HELP% = 513: GOSUB 21410 21900 IF ENWAY% > 0 OR ENRETURN$ = "n" OR ENRETURN$ = "N" THEN RETURN 21905 GOSUB 17000 21910 CLOSE : CLS : GOSUB 18000: CLEAR : CHAIN "SF-START" 21920 REM <ESC> quit 21930 MSG$ = "Save Data before EXIT? Y/N:": HELP% = 170: GOSUB 21410 21940 IF ENWAY% > 0 THEN RETURN 21950 IF ENRETURN$ = "N" OR ENRETURN$ = "n" THEN GOTO 21980 21960 GOSUB 42420 21970 GOSUB 42470 21980 REM verify load 21990 MSG$ = "Exit to System? Y/N:": HELP% = 177: GOSUB 21410 22000 IF ENWAY% > 0 OR ENRETURN$ = "n" OR ENRETURN$ = "N" THEN RETURN 22010 GOTO 65000 22020 REM fake gosub for compiler 22030 RETURN 40000 REM enput routine begins 40010 ENROW% = VAL(MID$(ENSTAT$, 1, 2)) 40020 ENCOL% = VAL(MID$(ENSTAT$, 3, 2)) 40030 ENLEN% = VAL(MID$(ENSTAT$, 5, 2)) 40040 ENTEST% = VAL(MID$(ENSTAT$, 7, 1)) 40050 ENKIND% = VAL(MID$(ENSTAT$, 8, 1)) 40100 REM start & restart 40110 LOCATE ENROW%, ENCOL%, 0, 0, 7 40120 IF ENKIND% = 0 THEN PRINT (LEFT$(ENDFLT$ + STRING$(ENLEN%, 249), ENLEN%)); ELSE PRINT (RIGHT$(STRING$(ENLEN%, 249) + STR$(VAL(ENDFLT$)), ENLEN%)); 40130 ENPASS% = 0 40140 ENRETURN$ = "" 40150 REM cycle & recycle character collection 40160 LOCATE ENROW%, (ENCOL% + ENPASS%), 1, 0, 7 40170 ENCHAR$ = INKEY$ 40180 IF ENCHAR$ = "" THEN GOTO 40170: REM recycle 40185 IF (ENTEST% = 1 OR ENTEST% = 8) AND ENCHAR$ > CHR$(96) AND ENCHAR$ < CHR$(123) THEN ENCHAR$ = CHR$(ASC(ENCHAR$) - 32) 40190 IF INSTR(ENTEST$(ENTEST%), ENCHAR$) > 0 THEN GOTO 40240: REM good char 40200 IF LEN(ENCHAR$) = 1 THEN EN% = INT((INSTR(41, ENTEST$(0), ENCHAR$) + 1) / 2): GOTO 40220 40210 EN% = INT((INSTR(ENTEST$(0), ENCHAR$) + 1) / 2) 40220 ON EN% GOTO 40510, 40520, 40530, 40540, 40550, 40560, 40570, 40580, 40590, 40600, 40610, 40620, 40630, 40640, 40650, 40660, 40670, 40680, 40690, 40700, 40710, 40720, 40730, 40725 40230 SOUND 50, 3: GOTO 40150: REM recycle 40240 REM valid character - process 40250 IF ENPASS% > 0 THEN GOTO 40280: REM no field erase 40260 PRINT STRING$(ENLEN%, 249); 40270 LOCATE ENROW%, ENCOL%, 1, 0, 7 40280 REM skip field erase 40285 IF ENPASS% = ENLEN% THEN ENWAY% = 0: GOTO 40150: REM exit routine 40290 ENPASS% = ENPASS% + 1 40300 PRINT ENCHAR$; 40310 ENRETURN$ = ENRETURN$ + ENCHAR$ 40330 GOTO 40150: REM recycle 40500 REM branch control for special key pressed 40510 GOSUB 42650: GOTO 40150: REM F1 40520 ENWAY% = 11: GOTO 40800: REM F2 40530 ENWAY% = 12: GOTO 40800: REM F3 40540 ENWAY% = 13: GOTO 40800: REM F4 40550 ENWAY% = 14: GOTO 40800: REM F5 40560 ENWAY% = 15: GOTO 40800: REM F6 40570 ENWAY% = 16: GOTO 40800: REM F7 40580 ENWAY% = 17: GOTO 40800: REM F8 40590 ENWAY% = 18: GOTO 40800: REM F9 40600 ENWAY% = 19: GOTO 40800: REM F10 40610 ENWAY% = 3: GOTO 40800: REM up 40620 ENWAY% = 4: GOTO 40800: REM down 40630 ENWAY% = 1: GOTO 40800: REM left 40640 ENWAY% = 2: GOTO 40800: REM rght 40650 ENWAY% = 5: GOTO 40800: REM home 40660 ENWAY% = 6: GOTO 40800: REM end 40670 ENWAY% = 7: GOTO 40800: REM ins 40680 ENWAY% = 8: GOTO 40800: REM del 40690 ENWAY% = 9: GOTO 40800: REM PgUp 40700 ENWAY% = 10: GOTO 40800: REM PgDn 40710 ENWAY% = 0: GOTO 40800: REM CR 40720 ENWAY% = 20: GOTO 40800: REM ESC 40725 ENWAY% = 21: GOTO 40800: REM ^S = swap 40730 REM backspace character pressed:REM BkSp 40740 IF ENPASS% < 2 THEN GOTO 40100: REM start/restart 40750 ENPASS% = ENPASS% - 1 40760 LOCATE ENROW%, ENCOL% + ENPASS%, 0, 0, 7 40770 PRINT CHR$(249); 40780 ENRETURN$ = LEFT$(ENRETURN$, ENPASS%) 40790 GOTO 40150: REM recycle 40800 REM field exit - finish subroutine 40810 IF ENPASS% < 1 THEN ENRETURN$ = ENDFLT$ 40820 IF ENKIND% = 1 THEN ENRETURN$ = RIGHT$(SPACE$(ENLEN%) + STR$(VAL(ENRETURN$)), ENLEN%) 40830 LOCATE ENROW%, ENCOL%, 0, 0, 7 40840 IF ENRETURN$ > "" THEN PRINT LEFT$(ENRETURN$ + SPACE$(ENLEN%), ENLEN%); ELSE PRINT STRING$(ENLEN%, REPL$); 40850 RETURN 41000 REM establish test strings required by enput routine 41010 FOR C% = 1 TO 10 41020 KEY C%, "": REM f1-f10 41030 ENTEST$(0) = ENTEST$(0) + CHR$(0) + CHR$(58 + C%): REM 1 - 10 41040 NEXT 41050 ENTEST$(0) = ENTEST$(0) + CHR$(0) + CHR$(72) + CHR$(0) + CHR$(80) + CHR$(0) + CHR$(75) 41060 ENTEST$(0) = ENTEST$(0) + CHR$(0) + CHR$(77) + CHR$(0) + CHR$(71) + CHR$(0) + CHR$(79) + CHR$(0) + CHR$(82) 41070 ENTEST$(0) = ENTEST$(0) + CHR$(0) + CHR$(83) + CHR$(0) + CHR$(73) + CHR$(0) + CHR$(81) 41080 ENTEST$(0) = ENTEST$(0) + CHR$(13) + CHR$(0) + CHR$(27) + CHR$(0) + CHR$(8) + CHR$(0) + CHR$(19) 41090 ENTEST$(1) = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 " 41100 ENTEST$(2) = ENTEST$(1) + "abcdefghijklmnopqrstuvwxyz.,-" 41110 ENTEST$(3) = ENTEST$(2) + "!@#$%^&*()_=+~[{]};:'<>/?\|" + CHR$(34) 41120 ENTEST$(4) = "0123456789" 41130 ENTEST$(5) = ENTEST$(4) + ".-" 41140 ENTEST$(6) = CHR$(0) 41150 ENTEST$(7) = "yYnN" 41160 ENTEST$(8) = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" 41170 ENTEST$(9) = "12345" 41180 RETURN 42000 REM collect BASIC reserved words 42010 OPEN "i", #1, "SF-WORDS.DAT" 42020 IF EOF(1) <> 0 THEN GOTO 42070 42030 LINE INPUT #1, K$ 42040 RSVD$(K%) = RSVD$(K%) + " " + K$ 42050 IF LEN(RSVD$(K%)) > 240 THEN K% = K% + 1 42060 GOTO 42020 42070 REM collection complete 42080 CLOSE #1 42090 RETURN 42100 REM open & get file info 42110 OPEN "r", #2, "SF-CARRY.DAT", 1 42120 L% = LOF(2) 42130 CLOSE #2 42140 IF L% > 0 THEN GOTO 42200 42145 KILL "SF-CARRY.DAT" 42150 BCFILE$ = "" 42160 CLR% = 0: CLR0% = 15: CLR1% = 9: CLR2% = 12: CLR3% = 7: CLR4% = 4 42170 CLR5% = 4: CLR6% = 8: CLR7% = 2: CLR8% = 14 42180 GOSUB 42420 42190 RETURN 42200 REM get system information 42202 OPEN "i", #2, "SF-CARRY.DAT" 42204 INPUT #2, BCFILE$, K$ 42206 INPUT #2, CLR%, K$ 42208 INPUT #2, CLR0%, K$ 42210 INPUT #2, CLR1%, K$ 42212 INPUT #2, CLR2%, K$ 42214 INPUT #2, CLR3%, K$ 42216 INPUT #2, CLR4%, K$ 42218 INPUT #2, CLR5%, K$ 42220 INPUT #2, CLR6%, K$ 42222 INPUT #2, CLR7%, K$ 42224 INPUT #2, CLR8%, K$ 42226 INPUT #2, CLR9%, K$ 42228 CLOSE #2 42240 RETURN 42250 REM test data file for existance 42260 IF TCFILE$ <= " " THEN GOTO 42310 42270 OPEN "r", #2, TCFILE$ + ".DIC", 1 42280 L% = LOF(2) 42290 CLOSE #2 42300 IF L% > 0 THEN RETURN 42305 KILL TCFILE$ + ".DIC" 42310 TCFILE$ = "" 42320 RETURN 42330 REM file exists - retrieve data 42340 OPEN "i", #2, BCFILE$ + ".DIC" 42350 INPUT #2, BCFILE$ 42360 FOR T% = 0 TO MAXVARS% 42370 INPUT #2, VARDIC$(T%), VARTYP%(T%), VARLEN%(T%), VARMSK%(T%), VARVAR$(T%), VARROW%(T%), VARCOL%(T%) 42380 NEXT 42390 INPUT #2, CV%, VO%, TOPVAR% 42394 IF (CV% < VO%) OR (CV% > (VO% + 9)) THEN VO% = CV% 42400 CLOSE #2 42410 RETURN 42420 REM put away system information 42430 OPEN "o", #2, "SF-CARRY.DAT" 42432 PRINT #2, BCFILE$, ",Active File --------------------12" 42434 PRINT #2, CLR%, ",Color 0-NO 1-YES ---------------11" 42436 PRINT #2, CLR0%, ",..... Major Text Color ---------10" 42438 PRINT #2, CLR1%, ",..... Border Lines Color ------- 9" 42440 PRINT #2, CLR2%, ",..... Data Prompts Color ------- 8" 42442 PRINT #2, CLR3%, ",..... Command Line Color #1 ---- 7" 42444 PRINT #2, CLR4%, ",..... Command Line Color #2 ---- 6" 42446 PRINT #2, CLR5%, ",..... Title Text Color --------- 5" 42448 PRINT #2, CLR6%, ",..... Default Data Color ------- 4" 42450 PRINT #2, CLR7%, ",..... Special Messages Color --- 3" 42452 PRINT #2, CLR8%, ",..... Help Window Color -------- 2" 42454 PRINT #2, CLR9%, ",..... Misc. Color -------------- 1" 42458 CLOSE #2 42460 RETURN 42470 REM put away data 42480 OPEN "o", #2, BCFILE$ + ".DIC" 42490 WRITE #2, BCFILE$ 42500 FOR T% = 0 TO MAXVARS% 42510 WRITE #2, VARDIC$(T%), VARTYP%(T%), VARLEN%(T%), VARMSK%(T%), VARVAR$(T%), VARROW%(T%), VARCOL%(T%) 42520 NEXT 42525 IF VARDIC$(CV%) = "" THEN CV% = CV% - 1 42530 WRITE #2, CV%, VO%, TOPVAR% 42540 CLOSE #2 42550 RETURN 42560 REM open help file 42570 OPEN "r", #1, "SF-TUTOR.DAT", 72 42580 FIELD #1, 70 AS HLP$, 2 AS HLP1$ 42590 RETURN 42650 REM help requested 42655 HELP1% = HELP% 42660 IF CLR% = 1 THEN COLOR CLR8% 42670 GET #1, HELP1% 42680 HELP$ = HLP$ 42690 WW% = INSTR(HELP$, "@") + 3 42700 FOR W% = 1 TO WW% 42710 WIN%(0, 1, W%) = SCREEN(1, W%) 42720 IF CLR% = 1 THEN WIN%(1, 1, W%) = ((SCREEN(1, W%, 1)) MOD 16) 42730 NEXT 42740 LOCATE 1, 1, 1, 0, 0: PRINT STRING$(WW%, 220) 42750 WX% = 1 42760 WHILE LEFT$(HELP$, 1) <> "^" 42770 WX% = WX% + 1 42780 FOR W% = 1 TO WW% 42790 WIN%(0, WX%, W%) = SCREEN(WX%, W%) 42800 IF CLR% = 1 THEN WIN%(1, WX%, W%) = ((SCREEN(WX%, W%, 1)) MOD 16) 42810 NEXT 42820 LOCATE WX%, 1, 1, 0, 0 42830 PRINT CHR$(221) + " " + LEFT$(HELP$, WW% - 4) + " " + CHR$(222); 42840 HELP1% = HELP1% + 1 42850 GET #1, HELP1% 42860 HELP$ = HLP$ 42870 WEND 42880 WX% = WX% + 1 42900 FOR W% = 1 TO WW% 42910 WIN%(0, WX%, W%) = SCREEN(WX%, W%) 42920 IF CLR% = 1 THEN WIN%(1, WX%, W%) = ((SCREEN(WX%, W%, 1)) MOD 16) 42930 NEXT 42940 LOCATE WX%, 1, 1, 0, 0: PRINT RIGHT$(STRING$(WW%, 223) + " <ESC> " + CHR$(223), WW%); 42950 LOCATE WX%, WW% - 6, 1, 0, 7 42960 K$ = INKEY$: IF K$ <> CHR$(27) THEN GOTO 42960 42970 FOR W1% = 1 TO WW% 42980 FOR W% = 1 TO WX% 42990 LOCATE W%, W1%, 1, 0, 0 43000 IF CLR% = 1 THEN COLOR WIN%(1, W%, W1%), 0 43010 PRINT CHR$(WIN%(0, W%, W1%)); 43020 NEXT 43030 NEXT 43040 IF CLR% = 1 THEN COLOR CLR0% 43050 LOCATE 1, 1, 1, 0, 7 43060 RETURN 65000 REM exit 65010 CLS 65040 CLOSE : END 65501 K$ = "Copyright Frederick G. Volking 1986" 65502 K$ = "6891 gnikloV .G kcirederF thgirypoC"