PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #46)
[PCjs Machine "ibm5160"]
Waiting for machine "ibm5160" to load....
Information about “SCREEN UTILITIES #1”
This disk contains two keyboard-definition programs (Dvorak and
QWERTY styles), a full-screen editor, printer-control utilities,
and more. Also included is a simple checkbook balancing program,
a BASIC database program, and several other possibly useful
utilities.
How to Start: To run a COM or BAT program simply type its name and
press <ENTER>. For instructions on running BASIC programs, please
refer to the GETTING STARTED section in this catalog. To read DOC
files simply enter TYPE filename.ext and press <ENTER>.
Suggested Registration: $10.00
File Descriptions:
CONFIG SYS Setup for alternate keyboard programs (DOS 2.0)
CLOCK COM Puts clock in upper right corner of display
DVORAK DOC Documentation for above
DVORAK Alternate keyboard program (DOS 2.0 only)
QWERTY Alternate keyboard program (DOS 2.0 only)
DVORAK BAT Batch file for above
PRINTFIX COM Run once to be rid of early DOS 1.1 printer bug
FULLEDIT BAS Stopgap full screen editor
MA BAT Batch file for above
QWERTY BAT Batch file for above
WS-ASCII BAS WORDSTAR-to-ASCII conversion
EFS BAS Electronic (database) file system
ASDA BAS Part of screen format program
ASDADEL BAS Part of screen format program
FORMDISP BAS Part of screen format program
EDIT BAS Part of screen format program
HELPCOM BAS Part of screen format program
ASDARUN BAS Part of screen format program
HIDEFILE BAS Remove/modify hidden files
RESTATTR BAS Part of screen format program
KEYMOVE BAS Part of alternate keyboard system
QWERTY COM Command file for QWERTY
CONTROL COM Part of alternate keyboard system
CHECKCON BAS Simple checkbook balancing program
DVORAK COM Command file for DVORAK
MEMDUMP BAS Memory dump program
GPRINT BAS Setup parameters of IBM/Epson printer
CPRINT BAS Setup parameters of C-Itoh 8510 (NEC 8023) printer
ASDA.BAS
10 CLEAR:WIDTH 80:SW=80:CLS:LOCATE 1,17,0:COLOR 0,7:PRINT " * * * * * * S O F T M A R K I N C. * * * * * *":COLOR 7,0
20 LOCATE 3,30:PRINT "FORMAT SETUP SPECIFICATIONS"
30 LOCATE 4,1:PRINT "-------------------------------------------------------------------------------"
40 LOCATE 8,18:PRINT "***************************************************"
50 LOCATE 9,18: PRINT "* *"
60 LOCATE 10,18:PRINT "* FORMAT NAME................. *"
70 LOCATE 11,18:PRINT "* START LINE NUMBER........... *"
80 LOCATE 12,18:PRINT "* NUMBER OF LINES TO CLEAR.... *"
90 LOCATE 13,18:PRINT "* SOUND ALARM....(Y/N)........ *"
100 LOCATE 14,18: PRINT "* SCREEN LENGTH..(40/80)...... 80 *"
110 LOCATE 15,18:PRINT "* *"
120 LOCATE 16,18:PRINT "***************************************************"
130 LOCATE 10,50:INPUT "",FORMAT$
140 LOCATE 11,50:INPUT "",STARTLINE:IF STARTLINE=999 THEN 130
150 LOCATE 12,50:INPUT "",CLEARLINES:IF CLEARLINES=999 THEN 140
160 LOCATE 13,50:INPUT "",ALARM$:IF ALARM$="999" THEN 150
170 LOCATE 14,50:INPUT "",SWW:IF SWW=999 THEN 160
180 IF SWW><40 THEN SWW=80
190 LCLEAR=STARTLINE+CLEARLINES:IF LCLEAR>24 THEN BEEP:LOCATE 25,1:PRINT "LINES TO CLEAR IS TOO LARGE....RENTER":FOR P=1 TO 5000:NEXT P: GOTO 10
200 OPTION BASE 1
210 DIM C$(23,SW):DIM B$(23,SW)
220 IF I16=1 THEN GOSUB 3220: I16=0
230 SW=SWW:CLS:I50=0:SCREEN 0:WIDTH SW:LOCATE ,,1
240 FLXX=0:FOR XX=1 TO SW:IF MID$(FORMAT$,XX,1)>CHR$(32) THEN FLXX=FLXX+1
250 IF MID$(FORMAT$,XX,1)<CHR$(33) THEN XX=SW
260 NEXT XX:FILENAME$=SPACE$(FLXX+6):MID$(FILENAME$,1,2)="B:":FOR XX=1 TO FLXX:MID$(FILENAME$,XX+2,1)=MID$(FORMAT$,XX,1):NEXT XX:MID$(FILENAME$,FLXX+3,4)=".BAS"
270 INSC=1
280 X=1:Y=1
290 KEY (9) ON: KEY (5) ON: KEY (4) ON
300 ON KEY (9) GOSUB 890: ON KEY (5) GOSUB 920:ON KEY (4) GOSUB 3210
310 IF I17=1 THEN GOSUB 920:I17=0
320 IF I50=0 THEN LOCATE 1,(SW-2):IF INSC<0 THEN COLOR 0,7:PRINT "ENT":COLOR 7,0
330 IF I50=0 THEN LOCATE 1,(SW-2):IF INSC>0 THEN COLOR 7,0:PRINT "ENT"
340 IF I50=1 THEN LOCATE 1,(SW-2):PRINT "ATT"
350 LOCATE Y,X,1: ENT$=INKEY$
360 L$=LEFT$(ENT$,1):R$=RIGHT$(ENT$,1)
370 IF ENT$="" THEN GOTO 350
380 LOCATE ,,0
381 IF FRE(0)<1000 THEN LOCATE 12,1:COLOR 0,7:PRINT " YOU DO NOT HAVE ENOUGH FREE MEMORY TO CONTINUE...PRESS KEY 10 TO CONT...... ":COLOR 7,0:KEY (10) ON:ON KEY (10) GOSUB 1450:GOTO 350
390 IF L$<>CHR$(0) THEN GOTO 560
391 IF (I50=0) AND (R$=CHR$(81)) THEN GOSUB 741:GOTO 350
400 IF (I50=0) AND (R$=CHR$(73)) THEN GOSUB 750:GOTO 350
410 IF R$=CHR$(83) THEN GOSUB 730:GOTO 350
420 IF R$=CHR$(15) THEN X=X-8:IF X<1 THEN Y=Y-1:X=SW:IF Y<1 THEN Y=23
430 IF R$=CHR$(116) THEN X=X+3:IF X>SW THEN Y=Y+1:X=1:IF Y>23 THEN Y=1
440 IF R$=CHR$(77) THEN X=X+1:IF X>SW THEN Y=Y+1:X=1:IF Y>23 THEN Y=1
450 IF R$=CHR$(75) THEN X=X-1:IF X<=0 THEN Y=Y-1:X=SW:IF Y<=0 THEN Y=23
460 IF R$=CHR$(115) THEN X=X-3:IF X<=0 THEN Y=Y-1:X=SW:IF Y<=0 THEN Y=23
470 IF R$=CHR$(72) THEN Y=Y-1:IF Y<=0 THEN Y=23
480 IF R$=CHR$(80) THEN Y=Y+1:IF Y>=24 THEN Y=1
490 IF R$=CHR$(119) THEN X=1
500 IF R$=CHR$(117) THEN X=SW
510 IF R$=CHR$(71) THEN X=1
520 IF R$=CHR$(79) THEN X=SW
530 IF (I50=0) AND (R$=CHR$(82)) THEN INSC=(INSC*(-1)):IF INSC<0 THEN LOCATE 1,SW-2:COLOR 0,7:PRINT "ENT":COLOR 7,0
540 IF (R$=CHR$(82)) AND (INSC>0) THEN LOCATE 1,SW-2:COLOR 7,0:PRINT "ENT"
550 IF L$=CHR$(0) THEN GOTO 290
560 IF (I50=0) AND (INSC<0) THEN GOSUB 810
570 IF (I50=0) AND (L$=CHR$(10)) THEN GOSUB 720:GOTO 290
580 IF L$=CHR$(13) THEN Y=Y+1:X=1:IF Y>23 THEN Y=1
590 IF L$=CHR$(9) THEN X=X+8:IF X>SW THEN Y=Y+1:X=1:IF Y>23 THEN Y=1
600 IF L$=CHR$(9) THEN GOTO 290
610 IF L$=CHR$(8) THEN LOCATE Y,X:PRINT " ":C$(Y,X)="":X=X-1:IF X<=0 THEN X=SW:Y=Y-1:IF Y<=0 THEN Y=23
620 IF L$=CHR$(8) THEN GOTO 290
630 IF L$=CHR$(10) THEN Y=Y+1:X=1:IF Y>23 THEN Y=1
640 IF L$=CHR$(13) THEN GOTO 290
650 IF L$=CHR$(10) THEN GOTO 290
660 IF L$=CHR$(27) THEN CLS:ERASE C$:ERASE B$:X=1:Y=1:GOTO 210
670 LOCATE Y,X,0:PRINT ENT$
680 IF I50<>1 THEN LET C$(Y,X)=ENT$
690 IF I50=1 THEN LET B$(Y,X)=ENT$
700 X=X+1:IF X>SW THEN Y=Y+1:X=1:IF Y>23 THEN Y=1
710 LOCATE Y,X,0:GOTO 290
720 FOR XX=X TO SW:C$(Y,XX)="":LOCATE Y,XX,0:PRINT " ":NEXT XX:RETURN
730 FOR XX=X TO SW-1:C$(Y,XX)=C$(Y,(XX+1)):LOCATE Y,XX,0:PRINT C$(Y,XX+1):LOCATE Y,SW:PRINT " ":C$(Y,SW)=" ":IF (C$(Y,XX+1)="") OR (C$(Y,XX+1)=" ") THEN LOCATE Y,XX:PRINT " " ':XX=SW
740 NEXT XX:RETURN
741 FOR QQ=1 TO 20
742 WS=SW:IF Y=23 THEN WS=WS-1
743 IF X+QQ>WS THEN :GOTO 746
744 C$(Y,X+QQ)=C$(Y,X):LOCATE Y,X+QQ:PRINT C$(Y,X)
745 NEXT QQ
746 X=(X+QQ)-1:RETURN
750 FOR QQ=1 TO 23:LOCATE QQ,1:PRINT QQ:NEXT QQ:LOCATE 1,2:COLOR 0,7:PRINT " ENTER THE LINE NUMBER RANGE YOU":LOCATE 2,2:PRINT " WISH DATA TO BE COPIED THROUGH.. "
751 LOCATE 2,41:COLOR 7,0:PRINT "FROM LINE....":LOCATE 2,58:PRINT "TO LINE...."
752 LOCATE 2,55:COLOR 7,0:INPUT "",EE:LOCATE 2,70:INPUT "",YY
760 IF YY>23 THEN YY=23
770 WS=SW:IF YY=23 THEN WS=WS-1
780 FOR RR=EE TO YY:FOR QQ=1 TO WS:C$(RR,QQ)=C$(Y,QQ):LOCATE RR,QQ:PRINT C$(Y,QQ):NEXT QQ:NEXT RR
790 FOR WW=1 TO 2: FOR QQ=1 TO WS: LOCATE WW,QQ:PRINT " ": NEXT QQ: NEXT WW
791 FOR WW=1 TO 2:FOR QQ=1 TO WS:LOCATE WW,QQ:PRINT C$(WW,QQ):NEXT QQ:NEXT WW
800 FOR WW=1 TO 4:FOR QQ=1 TO 23:LOCATE QQ,WW:PRINT " ":LOCATE QQ,WW:PRINT " ":NEXT QQ:FOR QQ=1 TO 23:LOCATE QQ,WW:PRINT C$(QQ,WW):LOCATE QQ,WW:PRINT C$(QQ,WW):NEXT QQ:NEXT WW:LOCATE 1,78:PRINT "ENT":RETURN
810 'LL$=C$(Y,X)
820 'FOR XX=X TO SW-1 ':IF C$(Y,XX)="" THEN GOTO 770
830 'RR$=C$(Y,XX+1):C$(Y,(XX+1))=LL$:LOCATE Y,XX+1,0:PRINT LL$:LL$=RR$:NEXT XX
840 FOR QQ=0 TO SW:C$(Y,(SW-QQ))=C$(Y,(SW-(QQ+1))):LOCATE Y,SW-QQ:PRINT C$(Y,(SW-(QQ+1))):IF C$(Y,(SW-(QQ+1)))="" THEN LOCATE Y,SW-QQ:PRINT " "
850 IF (SW-(QQ+1))=X THEN LOCATE Y,X:PRINT ENT$:QQ=SW
860 NEXT QQ:RETURN
870 RETURN
880 CLS:PRINT"SCREEN FORMAT IS BEING GENERATED.....":GOSUB 1180
890 ERASE B$:DIM B$(23,SW):KEY(1) ON: ON KEY (1) GOSUB 880
900 I50=1:X=1:Y=1
910 LOCATE 1,(SW-2):PRINT "ATT":RETURN
920 I50=0:X=1:Y=1
930 CLS:FOR R=1 TO 23: FOR C=1 TO SW:LOCATE R,C,0:PRINT C$(R,C):NEXT C:NEXT R
940 IF I17=1 THEN FOR R=1 TO 23:FOR C=1 TO SW:IF B$(R,C)>CHR$(32) THEN LOCATE R,C:PRINT B$(R,C)
950 IF I7=1 THEN NEXT C:NEXT R
960 LOCATE 1,(SW-2):PRINT "ENT":RETURN
970 A$="000000": INSC=1
980 FOR XXX=1 TO 25 STEP 2
990 IF MID$(ATTRIB$,XXX,2)="HI" THEN MID$(A$,1,1)="1":I46=1
1000 IF MID$(ATTRIB$,XXX,2)="RI" THEN MID$(A$,2,1)="1":I36=1
1010 IF MID$(ATTRIB$,XXX,2)="BK" THEN MID$(A$,3,1)="1"
1020 IF MID$(ATTRIB$,XXX,2)="UN" THEN MID$(A$,4,1)="1":I37=1
1030 IF MID$(ATTRIB$,XXX,2)="" THEN XXX=25
1040 NEXT XXX
1050 IF I32=1 THEN RETURN
1060 IF A$="000000" THEN F=7:B=0
1070 IF A$="100000" THEN F=15:B=0
1080 IF A$="010000" THEN F=0:B=7
1090 IF A$="110000" THEN F=0:B=15
1100 IF A$="001000" THEN F=23:B=0
1110 IF A$="101000" THEN F=31:B=0
1120 IF A$="000100" THEN F=1:B=0
1130 IF A$="100100" THEN F=9:B=0
1140 IF A$="001100" THEN F=17: B=0
1150 IF A$="101100" THEN F=25:B=0
1160 IF A$="011000" THEN F=16:B=7
1170 IF I29=1 THEN RETURN
1180 OPEN FILENAME$ FOR OUTPUT AS #1
1190 WIDTH 80:KEY(2) ON:ON KEY (2) GOSUB 3070
1200 DAT4$=SPACE$(SW):CTR=4000:COUNT=10
1210 PRINT#1,COUNT;"SCREEN 0"":""WIDTH";SW":""SW=";SW
1220 IF (STARTLINE=1)AND(CLEARLINES=23) THEN COUNT=COUNT+10:PRINT#1,COUNT;"CLS":GOTO 1250
1230 COUNT=COUNT+10:PRINT#1,COUNT;"FOR C=";STARTLINE;"TO";LCLEAR
1240 COUNT=COUNT+10:PRINT#1,COUNT;"LOCATE C,1:PRINT ";CHR$(34);DAT4$;CHR$(34);":NEXT C"
1250 IF ALARM$="Y" THEN COUNT=COUNT+10:PRINT#1,COUNT;"BEEP"
1260 FOR R=1 TO 23: FOR C=1 TO SW
1270 IF B$(R,C)<>"" THEN GOSUB 1490
1280 NEXT C:NEXT R
1290 FOR R=1 TO 23: FOR C=1 TO SW
1300 IF B$(R,C)<>"" THEN GOSUB 1550
1310 NEXT C:NEXT R:I100=0
1320 FOR R=1 TO 23:FOR C=1 TO SW
1330 IF B$(R,C)<>"" THEN GOSUB 1630
1340 NEXT C:NEXT R
1350 IF I100><1 THEN 1420
1360 CTR=CTR+10:PRINT#1,CTR;"IF I11=1 THEN GOTO 9999"
1370 CTR=CTR+10:PRINT#1,CTR;"SM.DESCR$="CHR$(34)"010101"CHR$(34);":";"SM.ATTRIB$="CHR$(34)CHR$(34);":";"SM.DATATAB$="CHR$(34)CHR$(34);":";"SM.RANGE$="CHR$(34)CHR$(34)":GOSUB 7000"
1380 CTR=6999:PRINT#1,CTR;"GOTO 9999
1390 CTR=7000:PRINT#1,CTR;"CHAIN MERGE "CHR$(34)"A:EDIT"CHR$(34)",8650,ALL"
1400 IF I100><1 THEN CTR=7000:PRINT#1,CTR;"'"
1410 CTRX=CTR-50:CTR=CTR+10:PRINT#1,CTR;"IF I10=1 THEN GOTO";CTRX
1420 IF I100><1 THEN CTR=7000:PRINT#1,CTR;"'"
1430 CTR=9999:PRINT#1,CTR;"COLOR 7,0:CHAIN BACK$,RLINE,ALL"
1440 CLS:BEEP:PRINT"SCREEN FORMAT SUCCESSFULLY COMPILED !!!!!!!":CLOSE
1450 LOCATE 15,3:COLOR 15,0:PRINT" DO YOU WISH TO SAVE THE SCREEN ATTRIBUTES FOR FUTURE MODIFICATION? (Y/N) ":COLOR 7,0
1460 LOCATE 16,35:ANSWER$=INKEY$:IF ANSWER$="" THEN 1460
1470 IF ANSWER$><"Y" THEN GOTO 3170
1480 GOTO 3080
1490 I31=0
1500 IF B$(R,C)="C" THEN I30=1:GOSUB 1680:GOTO 1540
1510 IF B$(R,C)="c" THEN I30=0:GOSUB 1680:GOTO 1540
1520 IF B$(R,C)="E" THEN I31=1:GOSUB 1680:GOTO 1540
1530 IF B$(R,C)="e" THEN I31=1:GOSUB 1680:GOTO 1540
1540 RETURN
1550 I31=0
1560 IF B$(R,C)="O" THEN I30=1: GOSUB 2270:GOTO 1620
1570 IF B$(R,C)="o" THEN I30=0: GOSUB 2270:GOTO 1620
1580 IF B$(R,C)="B" THEN I30=1: GOSUB 2270:GOTO 1620
1590 IF B$(R,C)="b" THEN I30=0: GOSUB 2270:GOTO 1620
1600 IF B$(R,C)="P" THEN I31=1: GOSUB 2270:GOTO 1620
1610 IF B$(R,C)="p" THEN I31=1: GOSUB 2270:GOTO 1620
1620 RETURN
1630 IF B$(R,C)="I" THEN GOSUB 1950
1640 IF B$(R,C)="i" THEN GOSUB 1950
1650 IF B$(R,C)="B" THEN GOSUB 1950
1660 IF B$(R,C)="b" THEN GOSUB 1950
1670 RETURN
1680 Y=R:X=C:DAT4$=SPACE$(SW):I86=0:IF X=SW THEN I85=1:I19=0:GOSUB 1870:I85=0:RETURN
1690 X=X+1:IF X>SW THEN I85=1:GOTO 1710
1700 IF (B$(Y,X)="")OR(B$(Y,X)=" ") THEN MID$(DAT4$,(X-C),1)=C$(Y,X):GOTO 1690
1710 FL=X-C
1720 STROW$=STR$(R):STCOL$=STR$(C+1)
1730 IF (I31=0) AND (I30=1) THEN DAT1$=" COLOR 15,0:LOCATE "
1740 IF (I31=0) AND (I30=0) THEN DAT1$=" COLOR 7,0:LOCATE "
1750 DA4$=SPACE$(FL-1)
1760 FOR Q=1 TO FL-1:MID$(DA4$,Q,1)=MID$(DAT4$,Q,1):NEXT Q
1770 DAT4$=DA4$:COUNT=COUNT + 10
1780 IF I31=0 THEN PRINT#1,COUNT;DAT1$;STROW$","STCOL$":";"PRINT "CHR$(34);DAT4$;CHR$(34):CNTR=CNTR+1
1790 IF (I31=1) AND (I19=0) THEN I49=1:GOSUB 2820:I49=0
1800 IF I31=1 THEN PRINT#1,COUNT;"COLOR "FF$","BB$":";"LOCATE "STROW$","STCOL$":";"PRINT "CHR$(34);DAT4$;CHR$(34)
1810 IF I86=1 THEN RETURN
1820 DAT4$=SPACE$(SW):IF I85=1 THEN GOSUB 1860:I85=0
1830 C=X:IF I84=1 THEN C=C+1
1840 IF (B$(Y,X)><"T") AND (B$(Y,X)><"t") THEN C=X-1
1850 RETURN
1860 I19=1
1870 X=0:Y=Y+1:I89=0:IF Y>23 THEN PRINT CHR$(7):ERRORS$="INVALID WRAP AROUND FIELD":LOCATE 25,1:PRINT ERRORS$:GOTO 3070
1880 IF (I31=0) AND (I30=1) THEN DAT1$=" COLOR 15,0:LOCATE "
1890 IF (I31=0) AND (I30=0) THEN DAT1$=" COLOR 7,0:LOCATE "
1900 X=X+1:IF X>SW THEN I89=1:GOTO 1920:
1910 IF (B$(Y,X)="") OR (B$(Y,X)=" ") THEN MID$(DAT4$,X,1)=C$(Y,X): GOTO 1900
1920 STROW$=STR$(Y):STCOL$="1":FL=X
1930 I86=1:GOSUB 1750:I86=0:IF I89=1 THEN GOTO 1860
1940 C=X:R=Y:I19=0:RETURN
1950 Y=R:X=C:FLL=0:FL=0:I100=1:DAT4$=SPACE$(SW):IF X=80 THEN X=0:Y=Y+1:C=0:R=R+1
1960 FFLL=FL:X=X+1:IF X>SW THEN FLL=FLL+1:X=SW:GOTO 1980
1970 IF B$(Y,X)<CHR$(33) THEN GOTO 1960
1980 IF B$(Y,X)>CHR$(32) THEN I48=1
1990 STROW$=STR$(R):STCOL$=STR$(C+1):FL=((X-C)-1)
2000 IF FLL=1 THEN X=0:Y=Y+1:FLL=2:GOTO 1960
2010 IF FLL>2 THEN BEEP:BEEP:ERRR$="INVALID WRAP AROUND ON INPUT FIELD....STANDBY":LOCATE 25,1:PRINT ERRR$:FOR ERW$=1 TO 2000:NEXT ERW$:CLOSE:I17=1:GOTO 310
2020 COUNT=COUNT + 10:IF FLL>0 THEN STROW$=STR$(Y-1)
2030 IF FLL=2 THEN FL=(FFLL+X):STCL$=STR$(C+1):IF C=>SW THEN STCL$="1"
2040 FL$=" ":FL$=STR$(FL)
2050 FOR PP=1 TO SW:MID$(DAT4$,PP,1)=C$(R,PP):NEXT PP
2060 IF FLL<2 THEN BLNK$=SPACE$(FL):LIN$=STRING$(FL,95)
2070 IF FFLL<0 THEN FFLL=0
2080 IF FLL=2 THEN BLNK$=SPACE$(FFLL):LIN$=STRING$(FFLL,95)
2090 DESCR$=SPACE$(6):MID$(DESCR$,1,2)=MID$(FL$,2,2):MID$(DESCR$,3,2)=MID$(STROW$,2,2):MID$(DESCR$,5,2)=MID$(STCOL$,2,2)
2100 IF I48=1 THEN GOSUB 2660
2110 IF (I36=1) AND (I46=1) THEN PRINT#1,COUNT;"COLOR 0,15:LOCATE "STROW$","STCOL$":";"PRINT "CHR$(34);BLNK$;CHR$(34)
2120 IF (I36=1) AND (I46=0) THEN PRINT#1,COUNT;"COLOR 0,7:LOCATE "STROW$","STCOL$":";"PRINT "CHR$(34);BLNK$;CHR$(34)
2130 IF (I36=0) AND (I37=1) AND (I46=1) THEN PRINT#1,COUNT;"COLOR 0,15:LOCATE "STROW$","STCOL$":";"PRINT "CHR$(34);LIN$;CHR$(34)
2140 IF (I36=0) AND (I37=1) AND (I46=0) THEN PRINT#1,COUNT;COLOR 0,7:LOCATE "STROW$","STCOL$":";"PRINT "CHR$(34);LIN$;CHR$(34)
2150 IF I18=1 THEN 2170
2160 IF FLL>0 THEN COUNT=COUNT+10:STROW$=STR$(Y):STCOL$="1":BLNK$=SPACE$(X-1):LIN$=STRING$((X-1),95):I18=1:GOTO 2110
2170 CTR=CTR+10:IF I48=1 THEN FL$=" ":FL$=STR$(FL):MID$(DESCR$,1,2)=MID$(FL$,2,2)
2180 IF I48><1 THEN GOTO 2260
2190 PRINT#1,CTR;"SM.DESCR$="CHR$(34);DESCR$;CHR$(34)
2200 CTR=CTR+10:PRINT#1,CTR;"SM.ATTRIB$="CHR$(34);ATTRIB$;CHR$(34)
2210 CTR=CTR+10:PRINT#1,CTR;"SM.DATATAB$="CHR$(34);DATATAB$;CHR$(34)
2220 CTR=CTR+10:PRINT#1,CTR;"SM.RANGE$="CHR$(34);RANGE$;CHR$(34)
2230 CTR=CTR+10:PRINT#1,CTR;"GOSUB 7000:"FLNAME$"=SM.FIELD$"
2240 CTRX=CTR-100:IF CTRX<4000 THEN CTRX=4010
2250 CTR=CTR+10:PRINT#1,CTR;"IF I10=1 THEN GOTO";CTRX
2260 C=X:R=Y:IF (B$(Y,X)<>"T") AND (B$(Y,X)><"t") THEN C=X-1
2261 RETURN
2270 Y=R:X=C:DAT4$=SPACE$(SW):I86=0:IF X=SW THEN I85=1:GOSUB 2470:I85=0:RETURN
2280 X=X+1:IF X>SW THEN I85=1:GOTO 2300
2290 IF B$(Y,X)<CHR$(33) THEN MID$(DAT4$,(X-C),1)=C$(Y,X):GOTO 2280
2300 FL=(X-C)-1
2310 STROW$=STR$(R):STCOL$=STR$(C+1)
2320 STR%=R:STC%=C+1
2330 IF (I31=0) AND (I30=1) THEN DAT1$=" COLOR 15,0:LOCATE "
2340 IF (I31=0) AND (I30=0) THEN DAT1$=" COLOR 7,0:LOCATE "
2350 DA4$=SPACE$(FL-1)
2360 FOR Q=1 TO FL-1:MID$(DA4$,Q,1)=MID$(DAT4$,Q,1):NEXT Q
2370 DAT4$=DA4$
2380 COUNT=COUNT +10:GOSUB 2580
2390 IF I31=0 THEN PRINT#1,COUNT;DAT1$;STROW$","STCOL$":";"PRINT "FLNAME$
2400 IF I31=1 THEN I49=1:GOSUB 2820:I49=0
2410 IF I31=1 THEN PRINT#1,COUNT;"COLOR "FF$","BB$":LOCATE "STROW$","STCOL$":PRINT "FLNAME$:I31=0
2420 IF I86=1 THEN RETURN
2430 DAT4$=SPACE$(SW):IF I85=1 THEN GOSUB 2470:I85=0
2440 C=X:IF I84=1 THEN C=C+1
2450 IF (B$(Y,X)><"T") AND (B$(Y,X)><"t") THEN C=X-1
2460 RETURN
2470 X=0:Y=Y+1:I89=0:IF Y>23 THEN ERROR$="INVALID WRAP AROUND FIELD":LOCATE 25,1:BEEP:PRINT ERROR$:GOTO 3070
2480 'IF I31=1 THEN DAT1$="COLOR ":DAT5$=" LOCATE ":DAT6$="PRINT "
2490 'IF (I31=0) AND (I30=1) THEN DAT1$=" COLOR 15,0:LOCATE "
2500 'IF (I31=0) AND (I30=0) THEN DAT1$=" COLOR 7,0:LOCATE "
2510 X=X+1:IF X>80 THEN I89=1
2520 'IF B$(Y,X)<CHR$(33) THEN GOTO 2260
2530 STROW$=STR$(Y):STCOL$="1":FL=X
2540 I86=1:GOSUB 1750:I86=0:IF I89=1 THEN GOTO 2470
2550 C=X:R=Y:RETURN
2560 IF (B$(Y,X)><"T") AND (B$(Y,X)><"t") THEN C=X-1
2570 RETURN
2580 CLS:LOCATE 1,21:COLOR 0,15,0:PRINT " * * * S O F T M A R K I N C. * * *":COLOR 7,0
2590 LOCATE 3,1:COLOR 15,0:PRINT "VARIALBLE OUTPUT FIELD NAME":COLOR 7,0
2600 LOCATE 4,1:PRINT "-------------------------------------------------------------------------------"
2610 LOCATE 6,20:PRINT "FIELD NAME ------------->":LOCATE 6,47:COLOR 0,7:PRINT " ":COLOR 7,0
2620 LOCATE 10,1:PRINT " <- - - - - - - - - - - - ENTER THE NAME OF THIS FIELD - - - - - - - - - - -> "
2630 COLOR 15,0:FOR QQ=1 TO SW:LOCATE 12,QQ:PRINT C$(Y,QQ):NEXT QQ:COLOR 7,0
2640 LOCATE 6,48:COLOR 0,7:INPUT "",FLNAME$:COLOR 7,0
2650 RETURN
2660 CLS:LOCATE 1,21:COLOR 0,15:PRINT " * * * S O F T M A R K I N C. * * * "
2670 LOCATE 3.3:COLOR 15,0:PRINT "INPUT FIELD ATTRIBUTES":COLOR 7,0
2680 LOCATE 4,1:PRINT "-------------------------------------------------------------------------------"
2690 LOCATE 19,2:PRINT "<--------------------------- PROCESSING THIS FIELD ------------------------>"
2700 LOCATE 21,1:COLOR 15,0:PRINT DAT4$:COLOR 7,0
2710 SP40$=SPACE$(40):SP80$=SPACE$(80)
2720 LOCATE 5,13:COLOR 15,0:INPUT "FIELD NAME ............ ",FLNAME$:COLOR 7,0
2730 LOCATE 7,13:PRINT "FIELD DESCRIPTION .....":LOCATE 7,36:COLOR 0,7:PRINT " ":COLOR 7,0:LOCATE 7,37:COLOR 0,7:PRINT DESCR$:COLOR 7,0
2740 LOCATE 9,13:INPUT "ATTRIBUTES ............ ",ATTRIB$
2750 IF ATTRIB$="999" THEN LOCATE 9,36:PRINT " ":GOTO 2740
2760 LOCATE 11,13:INPUT "DATATABLE CHECK ....... ",DATATAB$
2770 IF DATATAB$="999" THEN LOCATE 11,36:PRINT " ":GOTO 2740
2780 LOCATE 13,13:INPUT "RANGE CHECKING ........ ",RANGE$
2790 IF RANGE$="999" THEN LOCATE 13,36:PRINT " ":GOTO 2760
2800 I46=0:I36=0:I37=0:I32=1:GOSUB 970:I32=0
2810 RETURN
2820 AT$="000000":CLS
2830 LOCATE 1,21:COLOR 0,15:PRINT " * * * S O F T M A R K I N C. * * *"
2840 LOCATE 3,1:COLOR 15,0:PRINT "OUTPUT FIELD ATTRIBUTES":COLOR 7,0
2850 LOCATE 4,1:PRINT "-------------------------------------------------------------------------------"
2860 IF I49=0 THEN LOCATE 6,27:PRINT "FIELD NAME ------------>":LOCATE 6,52:COLOR 0,7:PRINT " ":COLOR 7,0
2870 LOCATE 8,27:COLOR 15,0:PRINT "----- ATTRIBUTES -----":COLOR 7,0
2880 LOCATE 11,27:PRINT "HIGH INTENSITY ----(X)---->":LOCATE 11,57: 'COLOR 0,7:PRINT " ":COLOR 7,0
2890 LOCATE 13,27:PRINT "REVERSE IMAGE -----(X)---->":LOCATE 13,57: 'COLOR 0,7:PRINT " ":COLOR 7,0
2900 LOCATE 15,27:PRINT "BLINK FIELD -------(X)---->":LOCATE 15,57: 'COLOR 0,7:PRINT " ":COLOR 7,0
2910 LOCATE 17,27:PRINT "UNDERLINE ---------(X)---->":LOCATE 17,57: 'COLOR 0,7:PRINT " ":COLOR 7,0
2920 LOCATE 20,1:PRINT " <- - - - - - - - - - - - ATTRIBUTES ARE FOR THIS FIELD - - - - - - - - - - -> "
2930 COLOR 15,0:FOR QQ=1 TO SW:LOCATE 22,QQ:PRINT C$(Y,QQ):NEXT QQ:COLOR 7,0
2940 IF I49=0 THEN LOCATE 6,53:COLOR 0,7:INPUT "",FLNAME$:COLOR 7,0
2950 LOCATE 11,57:COLOR 15,0:INPUT "",SM.FIELD$:COLOR 7,0:AA=1:GOSUB 3050
2960 IF (SM.FIELD$="999") AND (I49=0) THEN LOCATE 11,57:PRINT SPACE$(5):GOTO 2940
2970 IF (SM.FIELD$="999") AND (I49=1) THEN LOCATE 11,57:PRINT SPACE$(5):GOTO 2950
2980 LOCATE 13,57:COLOR 15,0:INPUT "",SM.FIELD$:COLOR 7,0:AA=2:GOSUB 3050
2990 IF SM.FIELD$="999" THEN LOCATE 13,57:PRINT SPACE$(5):GOTO 2950
3000 LOCATE 15,57:COLOR 15,0:INPUT "",SM.FIELD$:COLOR 7,0:AA=3:GOSUB 3050
3010 IF SM.FIELD$="999" THEN LOCATE 15,57:PRINT SPACE$(5):GOTO 2980
3020 LOCATE 17,57:COLOR 15,0:INPUT "",SM.FIELD$:COLOR 7,0:AA=4:GOSUB 3050
3030 IF SM.FIELD$="999" THEN LOCATE 17,57:PRINT SPACE$(5):GOTO 3000
3040 A$=AT$:I29=1:GOSUB 1060:I29=0:FF$=STR$(F):BB$=STR$(B):RETURN
3050 IF SM.FIELD$="X" THEN MID$(AT$,AA,1)="1"
3060 COLOR 7,0:RETURN
3070 I17=1:WIDTH=SW:GOTO 310: 'CHAIN MERGE "B:ASDA1",145,ALL,DELETE 10-2340
3080 CLS:PRINT "SCREEN ATTRIBUTES ARE NOW BEING SAVED..... ":PRINT:PRINT
3090 PRINT "INSERT DISKETTE TO HOLD SCREEN ATTRIBUTES IN DRIVE --B"
3100 PRINT "PRESS ANY KEY TO CONTINUE......"
3110 ENT$=INKEY$:IF ENT$="" THEN 3110
3120 LOCATE 18,36:COLOR 0,7:PRINT " STANDBY... ":COLOR 7,0
3130 MID$(FILENAME$,FLXX+3,4)=".ATT"
3140 OPEN FILENAME$ FOR OUTPUT AS #1
3150 FOR R=1 TO 23:FOR C=1 TO SW:IF (C$(R,C)>CHR$(31)) OR (B$(R,C)>CHR$(31)) THEN PRINT#1,C$(R,C);",";R;",";C;",";B$(R,C);",";STARTLINE;",";CLEARLINES;",";ALARM$;",";SWW;",";FORMAT$
3160 NEXT C:NEXT R
3170 ERASE C$:ERASE B$
3180 CLOSE
3190 MID$(FILENAME$,FLXX+3,4)=".BAS"
3200 IF I100=1 THEN CHAIN FILENAME$,7000,ALL
3210 CLS:BEEP:BEEP:BEEP:COLOR 15,0:PRINT "PROGRAM HAS FINISHED........":CHAIN "A:ASDARUN"
3220 OPEN FILENAME$ FOR INPUT AS #1
3230 INPUT#1,M$,N$,O$,P$,Q$,R$,S$,T$,U$
3240 R=VAL(N$):C=VAL(O$):STARTLINE=VAL(Q$):CLEARLINES=VAL(R$):ALARM$=S$:SWW=VAL(T$)
3250 IF EOF(1) THEN 3270
3260 C$(R,C)=M$:B$(R,C)=P$:GOTO 3230
3270 CLOSE:LOCATE 24,30:PRINT "PRESS ENTER TO CONTINUE.........":RETURN
ASDADEL.BAS
10 ON ERROR GOTO 160
20 CLS:WIDTH 80:LOCATE 3,15:COLOR 0,7:PRINT " * * * * * * S O F T M A R K I N C. * * * * * * ":COLOR 7,0
30 LOCATE 7,5: COLOR 15,0:PRINT "ASDA FORMAT DELETION PROCEDURE":COLOR 7,0
40 LOCATE 8,1: PRINT "-------------------------------------------------------------------------------"
50 LOCATE 13,11:PRINT "ENTER NAME OF SCREEN FORMAT TO DELETE............."
60 LOCATE 13,62:COLOR 0,7:PRINT " ":COLOR 7,0
70 LOCATE 18,1:FILES "B:*.*"
80 LOCATE 13,63:COLOR 0,7:INPUT "",FORMAT$:COLOR 7,0
90 IF FORMAT$="" THEN CHAIN "A:ASDARUN
100 FOR X=1 TO 8:IF MID$(FORMAT$,X,1)>CHR$(32) THEN FLXX=FLXX+1:NEXT X
110 FILENAME$=SPACE$(FLXX+7):MID$(FILENAME$,1,2)="B:":FOR X=1 TO FLXX:MID$(FILENAME$,X+2,1)=MID$(FORMAT$,X,1):NEXT X:MID$(FILENAME$,FLXX+3,4)=".BAS"
120 KILL FILENAME$
130 MID$(FILENAME$,FLXX+3,4)=".ATT"
140 KILL FILENAME$
150 GOTO 20
160 IF ERR=53 THEN BEEP:FOR X=1 TO 500:NEXT X:BEEP:LOCATE 25,5:PRINT "SCREEN FORMAT DOES NOT EXIST ON THIS DISKETTE----PRESS ANY KEY TO CONTINUE"
170 ENT$=INKEY$:IF ENT$="" THEN 170
180 RESUME 20
ASDARUN.BAS
10 KEY OFF:COLOR 7,0
20 SCREEN 0:WIDTH 80
30 CLS
40 SW=80
50 COLOR 0, 15:LOCATE 1, 13:PRINT " + + + + + + S O F T M A R K I N C. + + + + + + "
60 COLOR 15,0:LOCATE 3, 35:PRINT "ASDA MENU"
70 COLOR 15,0:LOCATE 8, 14:PRINT "* * * * * * * * * * * * * * * * * * * * * * * * * *"
80 COLOR 15,0:LOCATE 9, 14:PRINT "*"
90 COLOR 15,0:LOCATE 9, 64:PRINT "*"
100 COLOR 15,0:LOCATE 10, 14:PRINT "*"
101 COLOR 15,0:LOCATE 10,64:PRINT "*"
120 COLOR 15,0:LOCATE 11, 14:PRINT "*"
130 COLOR 7,0:LOCATE 11, 24:PRINT "1. CREATE A NEW SCREEN FORMAT"
140 COLOR 15,0:LOCATE 11, 64:PRINT "*"
150 COLOR 15,0:LOCATE 12, 14:PRINT "*"
160 COLOR 15,0:LOCATE 12, 64:PRINT "*"
170 COLOR 15,0:LOCATE 13, 14:PRINT "*"
180 COLOR 7,0:LOCATE 13, 24:PRINT "2. MODIFY AN EXISTING SCREEN FOMAT"
190 COLOR 15,0:LOCATE 13, 64:PRINT "*"
200 COLOR 15,0:LOCATE 14, 14:PRINT "*"
210 COLOR 15,0:LOCATE 14, 64:PRINT "*"
220 COLOR 15,0:LOCATE 15, 14:PRINT "*"
230 COLOR 7,0:LOCATE 15, 24:PRINT "3. DELETE AN EXISTING SCREEN FORMAT"
240 COLOR 15,0:LOCATE 15, 64:PRINT "*"
250 COLOR 15,0:LOCATE 16, 14:PRINT "*"
260 COLOR 15,0:LOCATE 16, 64:PRINT "*"
270 COLOR 15,0:LOCATE 17, 14:PRINT "*"
271 COLOR 7,0:LOCATE 17, 24:PRINT "4. VIEW SELECTED SCREEN FORMATS "
272 COLOR 15,0:LOCATE 17, 64:PRINT "*"
273 COLOR 15,0:LOCATE 18, 14:PRINT "*"
274 COLOR 15,0:LOCATE 18, 64:PRINT "*"
275 COLOR 15,0:LOCATE 19, 14:PRINT "*"
276 COLOR 7,0:LOCATE 19, 24:PRINT "5. SIGN OFF "
277 COLOR 15,0:LOCATE 19, 64:PRINT "*"
278 COLOR 15,0:LOCATE 20, 14:PRINT "*"
279 COLOR 15,0:LOCATE 20, 64:PRINT "*"
280 COLOR 15,0:LOCATE 21, 14:PRINT "*"
285 COLOR 15,0:LOCATE 21, 64:PRINT "*"
290 COLOR 15,0:LOCATE 22, 14:PRINT "* * * * * * * * * * * * * * * * * * * * * * * * * *"
300 SM.DESCR$="1 223 "
310 SM.ATTRIB$="ME"
320 SM.DATATAB$="12345"
330 SM.RANGE$=""
340 GOSUB 440:ANSWER$=MID$(SM.FIELD$,1,1)
350 IF ANSWER$="1" THEN CHAIN "A:ASDA"
360 IF ANSWER$="2" THEN CHAIN "A:RESTATTR"
370 IF ANSWER$="3" THEN CHAIN "A:ASDADEL"
371 IF ANSWER$="4" THEN CHAIN "A:FORMDISP",20
380 IF ANSWER$="5" THEN CLS:SYSTEM
390 GOTO 2030
440 I59=0:I60=0:I61=0:I62=0:I63=0:I64=0:I65=0:I66=0:I67=0:I68=0:I69=0:I70=0:I71=0:I81=0:I82=0:I99=0:I57=0:I58=0:I11=0:I10=0
450 SM.FIELD$=SPACE$(SW)
460 RL=VAL(MID$(SM.DESCR$,1,2)):IF RL>SW THEN RL=SW
470 SR=VAL(MID$(SM.DESCR$,3,2)):SC=VAL(MID$(SM.DESCR$,5,2))
480 DC=VAL(MID$(SM.DESCR$,7,2))
490 A$="000000": INSC=1:F=7:B=0
500 FOR X=1 TO 25 STEP 2
550 IF MID$(SM.ATTRIB$,X,2)="ME" THEN I61=1
710 IF MID$(SM.ATTRIB$,X,2)="" THEN X=25
720 NEXT X
860 IF MID$(SM.DATATAB$,1,RL)="" THEN I81=0 ELSE I81=1
880 STARTROW=SR:STARTCOL=SC:COUNT=0:ENDCOL=(SC+RL)-1
890 '
900 LOCATE SR,SC,1:COLOR F,B
910 I99=0:I75=0:I74=0
920 ENT$=INKEY$
930 IF ENT$="" THEN GOTO 900
950 L$=LEFT$(ENT$,1):R$=RIGHT$(ENT$,1)
1060 IF ENT$=CHR$(43) THEN I79=1: GOTO 1210
1070 IF ENT$=CHR$(13) THEN GOTO 1210 ' "enter" was pressed
1100 IF (I68=1) AND (ENT$=CHR$(32)) THEN I75=1: GOTO 1140
1140 DIF=SR-STARTROW:IF DIF<0 THEN DIF=1
1150 DD=DIF*SW
1160 LOCATE SR,SC,0:PRINT ENT$:MID$(SM.FIELD$,(((SC+DD)-STARTCOL)+1),1)=ENT$
1170 SC=SC+1:IF SC>SW THEN SC=1:SR=SR+1:IF SR>23 THEN SR=1
1180 IF SC<=ENDCOL THEN GOTO 900
1190 IF SC>ENDCOL THEN SC=ENDCOL
1210 IF I61=1 THEN GOSUB 1880
1220 IF I99=1 THEN SC=STARTCOL:SR=STARTROW:GOTO 910
1260 IF I79=1 THEN GOSUB 1960
1280 IF I81=1 THEN GOSUB 1570
1290 IF I99=1 THEN COUNT=0:SR=STARTROW:SC=STARTCOL:GOTO 890
1350 COLOR 7,0:RETURN
1570 FOR XX=1 TO 255 STEP RL
1580 IF (I68=0) AND (MID$(SM.FIELD$,1,RL)=MID$(SM.DATATAB$,XX,RL)) THEN XX=255: GOTO 1630
1590 IF (I68=1) AND (VAL(MID$(SM.FIELD$,1,RL))=VAL(MID$(SM.DATATAB$,XX,RL))) THEN XX=255: GOTO 1630
1600 IF MID$(SM.DATATAB$,XX,RL)="" THEN XX=255
1610 NEXT XX
1620 I99=1
1630 RETURN
1700 FOR XX=1 TO RL
1710 IF MID$(SM.FIELD$)="0" THEN LOCATE R,C,0: PRINT " " ELSE LOCATE R,C,0:PRINT MID$(SM.FIELD$,XX,1)
1720 C=C+1: IF C>SW THEN C=1:R=R+1
1730 IF R>23 THEN R=1
1740 NEXT XX
1750 RETURN
1880 I99=1
1890 FOR X=1 TO RL
1900 IF MID$(SM.FIELD$,X,1)<>" " THEN I99=0
1910 NEXT X
1920 RETURN
1960 FOR X=1 TO RL
1970 MID$(SM.FIELD$,((SC-STARTCOL)+X),1)=" "
1980 IF (((SC-STARTCOL)+1)+X)>RL THEN X=RL
1990 NEXT X
2000 LOCATE STARTROW,STARTCOL:PRINT MID$(SM.FIELD$,1,RL)
2010 RETURN
CHECKCON.BAS
10 CLS
20 KEY OFF
30 PRINT "CHECKBOOK RECONCILIATION"
40 PU$="$$####,####,####,####.##"
50 PRINT
60 PRINT "WHAT IS THE ENDING BALANCE";
70 PRINT " FROM THE STATEMENT ";
80 INPUT E$
100 Q$=E$ : GOSUB 930
120 IF Q$="N" THEN GOSUB 860 : GOTO 60
130 PRINT
140 PRINT "ENTER THE AMOUNT OF EACH DEPOSIT";
150 PRINT " NOT SHOWN ON THE STATEMENT";
160 PRINT " (ENTER ZERO WHEN ALL OUTSTANDING";
170 PRINT " DEPOSITS ARE ENTERED)"
180 D=0
190 PRINT SPC(8)
200 INPUT ;""; A$
220 IF VAL(A$)=0 THEN 330
260 IF VAL(A$)<0 THEN GOSUB 890 : GOTO 190
270 Q$=A$ : GOSUB 930
290 IF Q$="N" THEN GOSUB 890 : GOTO 190
300 D=D+VAL(A$)
310 PRINT
320 GOTO 190
330 PRINT
340 PRINT "ENTER THE AMOUNT OF EACH CHECK";
350 PRINT " NOT SHOWN ON THE STATEMENT";
360 PRINT " (ENTER ZERO WHEN ALL OUTSTANDING";
370 PRINT " CHECKS ARE ENTERED)"
380 C=0
390 PRINT SPC(18)
400 INPUT ;""; A$
420 IF VAL(A$)=0 THEN 530
460 IF VAL(A$)<0 THEN GOSUB 890 : GOTO 390
470 Q$=A$: GOSUB 930
490 IF Q$="N" THEN GOSUB 890 : GOTO 390
500 C=C+VAL(A$)
510 PRINT
520 GOTO 390
530 PRINT
540 PRINT " ACCOUNT BALANCE =";:PRINT USING PU$; D+VAL(E$)-C
550 PRINT
560 PRINT "ENTER YOUR CHECKBOOK BALANCE ";
570 INPUT B
580 PRINT "ENTER THE AMOUNT OF SERVICE CHARGES ";
590 INPUT S$
630 IF VAL(S$)<0 THEN GOSUB 890 : GOTO 190
640 Q$=S$ : GOSUB 930
660 IF Q$="N" THEN GOSUB 890 : GOTO 190
670 PRINT
680 PRINT "ADJUSTED ACCOUNT BALANCE =";:PRINT USING PU$; B-VAL(S$)
690 IF ABS(VAL(E$)+D-C-B+VAL(S$))<0.0001 THEN 790
700 PRINT
710 PRINT "YOUR ACCOUNT IS OUT OF BALANCE.";
720 PRINT " MAKE SURE YOU HAVE INCLUDED";
730 PRINT " ALL TRANSACTIONS AGAINST THIS ACCOUNT,";
740 PRINT " INCLUDING AUTOMATIC DEPOSITS AND";
750 PRINT " INTEREST PAYMENTS, AS WELL AS";
760 PRINT " PRE-AUTHORIZED WITHDRAWALS."
770 PRINT
780 REM
790 PRINT
800 PRINT "WOULD YOU LIKE TO RE-RUN THIS PROGRAM";
810 PRINT " WITH NEW DATA (Y/N) ?"
820 Z$=INKEY$:IF Z$="" THEN 820
830 IF Z$="Y" OR Z$="y" THEN 50
840 IF Z$="N" OR Z$="n" THEN 980
850 GOTO 800
860 PRINT " ERROR: ENTER A VALID DOLLAR AMOUNT ONLY."
870 PRINT
880 RETURN
890 PRINT " ERROR: ENTER A POSITIVE VALID DOLLOR AMOUNT ONLY."
900 PRINT
910 RETURN
930 FOR K=1 TO LEN(Q$)
940 IF MID$(Q$, K, 1)<>"." THEN 960
950 IF LEN(Q$)>K+2 THEN Q$="N"
960 NEXT
970 RETURN
980 END
CPRINT.BAS
10 REM CITOH 8510 (NEC 2083) PRINTER OPTION PROGRAM
20 REM BY CHARLES VELLA, PH.D. (BASED ON THE
30 REM IBM PRINTER OPTION PROGRAM
40 REM BY LINDA AND SID BROUDY)
50 CLS:KEY OFF
60 PRINT TAB(20) "CITOH 8510 PRINTER OPTION MENU"
70 PRINT:PRINT "Choose from the following options:"
80 PRINT
90 PRINT "0) End program":PRINT
100 PRINT "1) Proportional characters"
110 PRINT "2) Pica characters (10 cpi) (default)"
120 PRINT "3) Elite characters (12 cpi)"
130 PRINT "4) Compressed characters (17 cpi)":PRINT
140 PRINT "5) Regular mode (default)"
150 PRINT "6) Double-strike (bold print) mode":PRINT
160 PRINT "7) Normal line spacing (1/6 inch line) (default)"
170 PRINT "8) Compressed line spacing (1/8 inch line)":PRINT
180 PRINT "9) Start underlining"
190 PRINT "10) End underlining":PRINT
200 PRINT "11) Double width mode"
210 PRINT "12) Double width mode off":PRINT
220 INPUT "Which option do you wish";ANS
230 IF ANS<0 OR ANS>12 THEN BEEP:GOTO 220
240 IF ANS=0 THEN 390
250 ON ANS GOSUB 290,300,310,320,330,340,350,360,370,380,390,400
260 PRINT "Done..."
270 FOR DELAY=1 TO 500 :NEXT
280 GOTO 50
290 LPRINT CHR$(27);"P";:RETURN 'set Proportional characters
300 LPRINT CHR$(27);"N";:RETURN 'set Pica characters
310 LPRINT CHR$(27);"E";:RETURN 'set Elite characters
320 LPRINT CHR$(27);"Q";:RETURN 'set Compressed characters
330 LPRINT CHR$(27)+CHR$(34);:RETURN 'Bold print mode off
340 LPRINT CHR$(27);"!";:RETURN 'Bold print mode on
350 LPRINT CHR$(27);"A";:RETURN 'Normal line spacing
360 LPRINT CHR$(27);"B";:RETURN 'Compressed line spacing
370 LPRINT CHR$(27);"X";:RETURN 'Underline On
380 LPRINT CHR$(27);"Y";:RETURN 'Underline Off
390 LPRINT CHR$(14);:RETURN 'Double width on
400 LPRINT CHR$(15);:RETURN 'Double width off
410 END
EDIT.BAS
7000 ' ** * * * * * S O F T M A R K I N C. * * * * * **
7010 ' ** Soft/Edit **
7020 ' ** (C) Copyright 1982 **
7030 ' ** * * * * * * * * * * * * * * * * * * * * * * * * * * **
7040 I59=0:I60=0:I61=0:I62=0:I63=0:I64=0:I65=0:I66=0:I67=0:I68=0:I69=0:I70=0:I71=0:I81=0:I82=0:I99=0:I57=0:I58=0:I11=0:I10=0
7060 RL=VAL(MID$(SM.DESCR$,1,2)):IF RL>SW THEN RL=SW
7061 SM.FIELD$=SPACE$(RL)
7070 SR=VAL(MID$(SM.DESCR$,3,2)):SC=VAL(MID$(SM.DESCR$,5,2))
7080 DC=VAL(MID$(SM.DESCR$,7,2))
7090 A$="000000": INSC=1
7100 FOR X=1 TO 25 STEP 2
7110 IF MID$(SM.ATTRIB$,X,2)="AR" THEN I11=1
7120 IF MID$(SM.ATTRIB$,X,2)="AL" THEN I59=1
7130 IF MID$(SM.ATTRIB$,X,2)="M0" THEN I57=1
7140 IF MID$(SM.ATTRIB$,X,2)="M1" THEN I58=1
7150 IF MID$(SM.ATTRIB$,X,2)="ME" THEN I61=1
7160 IF MID$(SM.ATTRIB$,X,2)="ND" THEN I68=1: I60=1
7170 IF MID$(SM.ATTRIB$,X,2)="MF" THEN I62=1
7180 IF MID$(SM.ATTRIB$,X,2)="RB" THEN I63=1
7190 IF MID$(SM.ATTRIB$,X,2)="RZ" THEN I64=1
7200 IF MID$(SM.ATTRIB$,X,2)="LB" THEN I65=1
7210 IF MID$(SM.ATTRIB$,X,2)="LZ" THEN I66=1
7220 IF MID$(SM.ATTRIB$,X,2)="BC" THEN I67=1
7230 IF MID$(SM.ATTRIB$,X,2)="NU" THEN I68=1
7240 IF MID$(SM.ATTRIB$,X,2)="CE" THEN I69=1
7250 IF MID$(SM.ATTRIB$,X,2)="DR" THEN I70=1
7260 IF MID$(SM.ATTRIB$,X,2)="DN" THEN I71=1
7270 IF MID$(SM.ATTRIB$,X,2)="HI" THEN MID$(A$,1,1)="1"
7280 IF MID$(SM.ATTRIB$,X,2)="RI" THEN MID$(A$,2,1)="1"
7290 IF MID$(SM.ATTRIB$,X,2)="BK" THEN MID$(A$,3,1)="1"
7300 IF MID$(SM.ATTRIB$,X,2)="UN" THEN MID$(A$,4,1)="1"
7310 IF MID$(SM.ATTRIB$,X,2)="" THEN X=25
7320 NEXT X
7330 IF A$="000000" THEN F=7:B=0
7340 IF A$="100000" THEN F=15:B=0
7350 IF A$="010000" THEN F=0:B=7
7360 IF A$="110000" THEN F=0:B=15
7370 IF A$="001000" THEN F=23:B=0
7380 IF A$="101000" THEN F=31:B=0
7390 IF A$="000100" THEN F=1:B=0
7400 IF A$="100100" THEN F=9:B=0
7410 IF A$="001100" THEN F=17: B=0
7420 IF A$="101100" THEN F=25:B=0
7430 IF A$="011000" THEN F=16:B=7
7440 IF (F=0) AND (B=0) THEN F=7
7450 IF I71=1 THEN F=0:B=0
7460 IF MID$(SM.DATATAB$,1,RL)="" THEN I81=0 ELSE I81=1
7470 IF MID$(SM.RANGE$,1,RL)="" THEN I82=0 ELSE I82=1
7480 STARTROW=SR:STARTCOL=SC:COUNT=0:ENDCOL=(SC+RL)-1:IF ENDCOL>SW THEN ENDCOL=((ENDCOL-SW)+1):I14=1
7490 '
7500 LOCATE SR,SC,1:COLOR F,B
7510 I99=0:I75=0:I74=0
7520 ENT$=INKEY$
7530 IF ENT$="" THEN GOTO 7500
7540 IF (I59=1) AND (ENT$>CHR$(47)) AND (ENT$<CHR$(58)) THEN GOTO 7500
7550 L$=LEFT$(ENT$,1):R$=RIGHT$(ENT$,1)
7560 IF ENT$=CHR$(9) THEN I10=1:RETURN
7570 IF ENT$=CHR$(8) THEN MID$(SM.FIELD$,((SC-STARTCOL)+1),1)=" " :LOCATE SR,SC:PRINT " ":SC=SC-1:IF SC<STARTCOL THEN SC=STARTCOL
7580 IF ENT$=CHR$(8) THEN GOTO 7500
7581 IF L$><CHR$(0) THEN GOTO 7660
7590 IF R$=CHR$(82) THEN INSC=(INSC*-1):GOTO 7500
7600 IF INSC<0 THEN GOSUB 8360
7610 IF R$=CHR$(83) THEN GOSUB 8420: GOTO 7500
7620 IF R$=CHR$(75) THEN SC=SC-1: IF SC<STARTCOL THEN SC=STARTCOL
7630 IF R$=CHR$(75) THEN GOTO 7500
7640 IF R$=CHR$(77) THEN SC=SC+1: IF SC>ENDCOL THEN SC=ENDCOL
7650 IF R$=CHR$(77) THEN GOTO 7500
7660 IF ENT$=CHR$(43) THEN I79=1: GOTO 7810
7670 IF ENT$=CHR$(13) THEN GOTO 7810 ' "enter" was pressed
7680 IF (ENT$=CHR$(32)) AND (I67=1) THEN GOTO 7500 'no blanks allowed
7690 IF I68=0 THEN GOTO 7740
7700 IF ENT$=CHR$(32) THEN I75=1: GOTO 7740
7710 IF (ENT$<CHR$(45)) OR (ENT$=CHR$(47)) THEN GOTO 7500
7720 IF (I60=0) AND (ENT$=CHR$(46)) THEN GOTO 7500
7730 IF (ENT$>CHR$(57)) THEN GOTO 7500
7740 DIF=SR-STARTROW:IF DIF<0 THEN DIF=1
7750 DD=DIF*SW
7760 LOCATE SR,SC,0:PRINT ENT$:MID$(SM.FIELD$,(((SC+DD)-STARTCOL)+1),1)=ENT$
7770 SC=SC+1:IF SC>SW THEN SC=1:SR=SR+1:IF SR>23 THEN SR=1
7771 IF I14=1 THEN 7791
7780 IF SC<=ENDCOL THEN GOTO 7500
7790 IF SC>ENDCOL THEN SC=ENDCOL:GOTO 7800
7791 IF SC<>ENDCOL THEN GOTO 7500
7800 IF I69=1 THEN GOTO 7500
7810 IF I61=1 THEN GOSUB 8480
7820 IF I99=1 THEN SC=STARTCOL:SR=STARTROW:GOTO 7510
7830 IF I62=1 THEN GOSUB 8530
7840 IF I99=1 THEN SC=STARTCOL:SR=STARTROW:GOTO 7510
7850 IF I68=1 THEN SM.FIELD=VAL(SM.FIELD$)
7860 IF I79=1 THEN GOSUB 8560
7870 IF I66=1 THEN GOSUB 8010
7880 IF I81=1 THEN GOSUB 8170
7890 IF I99=1 THEN COUNT=0:SR=STARTROW:SC=STARTCOL:GOTO 7490
7900 IF I82=1 THEN GOSUB 8240
7910 IF I99=1 THEN COUNT=0:SR=STARTROW:SC=STARTCOL:GOTO 7490
7920 IF I70=1 THEN GOSUB 7960
7930 IF I63=1 THEN GOSUB 8050
7940 IF I64=1 THEN GOSUB 8050
7950 COLOR 7,0:RETURN
7960 FOR Q=1 TO RL
7970 IF MID$(SM.FIELD$,Q,1)<>" " THEN RETURN
7980 NEXT Q
7990 SR=STARTROW:SC=STARTCOL:GOTO 7480
8000 RETURN
8010 X=RL:IF X=0 THEN X=1
8020 IF MID$(SM.FIELD$,X,1)=" " THEN MID$(SM.FIELD$,X,1)="0": X=X-1:GOTO 8020
8030 R=STARTROW:C=STARTCOL
8040 LOCATE R,C:PRINT MID$(SM.FIELD$,1,RL):RETURN
8050 SM.XXXX$=SPACE$(RL)
8060 R=STARTROW:C=STARTCOL:X=RL
8070 IF X=0 THEN X=1
8080 IF MID$(SM.FIELD$,X,1)=" " THEN CT=CT+1:X=X-1:GOTO 8080
8090 FOR X=1 TO CT
8100 IF I64=1 THEN MID$(SM.XXXX$,X,1)="0" ELSE MID$(SM.XXXX$,X,1)=" "
8110 NEXT X
8120 FOR X=1 TO (RL-CT)
8130 MID$(SM.XXXX$,(X+CT),1)=MID$(SM.FIELD$,X,1)
8140 NEXT X
8150 LOCATE R,C:PRINT SM.XXXX$:SM.FIELD$=SM.XXXX$:SM.XXXX$=SPACE$(RL):CT=0
8160 RETURN
8170 FOR XX=1 TO 255 STEP RL
8180 IF (I68=0) AND (MID$(SM.FIELD$,1,RL)=MID$(SM.DATATAB$,XX,RL)) THEN XX=255: GOTO 8230
8190 IF (I68=1) AND (VAL(MID$(SM.FIELD$,1,RL))=VAL(MID$(SM.DATATAB$,XX,RL))) THEN XX=255: GOTO 8230
8200 IF MID$(SM.DATATAB$,XX,RL)="" THEN XX=255
8210 NEXT XX
8220 I99=1
8230 RETURN
8240 FOR YY=1 TO 255 STEP (RL*2)
8250 IF (VAL(MID$(SM.FIELD$,1,RL))>=VAL(MID$(SM.RANGE$,YY,RL))) AND (VAL(MID$(SM.FIELD$,1,RL))=<VAL(MID$(SM.RANGE$,(YY+RL),RL))) THEN YY=255:GOTO 8290
8260 IF MID$(SM.RANGE$,YY,RL)="" THEN YY=255
8270 NEXT YY
8280 I99=1:RETURN
8290 RETURN
8300 FOR XX=1 TO RL
8310 IF MID$(SM.FIELD$)="0" THEN LOCATE R,C,0: PRINT " " ELSE LOCATE R,C,0:PRINT MID$(SM.FIELD$,XX,1)
8320 C=C+1: IF C>SW THEN C=1:R=R+1
8330 IF R>23 THEN R=1
8340 NEXT XX
8350 RETURN
8360 FOR X=1 TO RL
8370 MID$(SM.FIELD$,(RL-(X-1)),1)=MID$(SM.FIELD$,(RL-X),1)
8380 IF (ENDCOL-(X-1))=SC THEN X=RL: LOCATE SR,SC,1:PRINT ENT$
8390 NEXT X
8400 LOCATE STARTROW,STARTCOL:PRINT MID$(SM.FIELD$,1,RL):LOCATE SR,(ENDCOL-(X-1)),0
8410 RETURN
8420 FOR X=1 TO RL
8430 MID$(SM.FIELD$,((SC-STARTCOL)+X),1)=MID$(SM.FIELD$,((SC-STARTCOL)+(X+1)),1)
8440 IF ((SC-STARTCOL)+(X+1))=RL THEN X=RL: MID$(SM.FIELD$,RL,1)=" ":LOCATE SR,ENDCOL,0:PRINT " "
8450 NEXT X
8460 LOCATE STARTROW,STARTCOL:PRINT MID$(SM.FIELD$,1,RL)
8470 RETURN
8480 I99=1
8490 FOR X=1 TO RL
8500 IF MID$(SM.FIELD$,X,1)<>" " THEN I99=0
8510 NEXT X
8520 RETURN
8530 FOR X=1 TO RL
8540 IF MID$(SM.FIELD$,X,1)=" " THEN I99=1
8550 RETURN
8560 FOR X=1 TO RL
8570 MID$(SM.FIELD$,((SC-STARTCOL)+X),1)=" "
8580 IF (((SC-STARTCOL)+1)+X)>RL THEN X=RL
8590 NEXT X
8600 LOCATE STARTROW,STARTCOL:PRINT MID$(SM.FIELD$,1,RL)
8610 RETURN
8650 SAVE FILENAME$:CHAIN "A:ASDARUN"
EFS.BAS
0 ' REVISING AUTHOR: STEPHEN LEOCE
1 ' 201 DELAWARE AVENUE
2 ' KINGSTON, NEW YORK 12401
3 ' [914] 338-4593
4 '
5 ' LAST REVISION: 22-DECEMBER-1983
6 '
10 COLOR 10,7:PRINT "*EOF [EOB]; now decide":COLOR 7,0
50 KEY OFF
100 GOSUB 6340
110 REM
120 CLEAR
130 ON ERROR GOTO 6100
140 DT$ = "07/01/82"
150 VE$ = " - V1.10"
160 DIM R$(65),AC(21),K(65),H$(21),RN$(21),KC(65)
170 DIM Z$(21)
180 COMMA$ = "NO"
190 BASENAME$="BSN"
200 HEADER$="HDR"
210 INDEX$="IDX"
220 RPTFMT$="RFT"
230 REM
250 CLS
260 H$(0) = "REC #"
270 B=65
280 DB$ = "BASENAME":F$ = BASENAME$:EX = 1110
290 GOSUB 4770
300 GOTO 2050
310 F$ = HEADER$:EX = 1140
320 GOSUB 4770
330 FOR I = 1 TO NR:H$(I) = R$(I): NEXT I
340 NH = NR:NR = 0:MEM = FRE (0)
350 IF NH <= 0 THEN 5580
360 B = INT (MEM / (13 * NH))
370 DIM N$(B,NH),R(B)
380 F$ = INDEX$:EX = 1200
390 GOSUB 4770
400 GOTO 5580
410 REM ***SORT***
420 FOR I = 1 TO NR:R(I) = 0: NEXT I
430 FOR I = 1 TO NR: FOR J = 1 TO NR
440 ON L GOTO 450,470
450 IF N$(I,S) = > N$(J,S) THEN R(I) = R(I) + 1
460 GOTO 480
470 IF VAL (N$(I,S)) = > VAL (N$(J,S)) THEN R(I) = R(I) + 1
480 L$ = INKEY$:IF LEN(L$) = 0 THEN 500
490 IF ASC(L$) = 27 THEN 110
500 NEXT J: NEXT I
510 COLOR 10,7:PRINT "SORT PHASE 2 : ";:COLOR 7,0
520 FOR I = NR TO 1 STEP - 1: FOR J = NR TO 1 STEP - 1
530 IF I < > J THEN IF R(I) = R(J) THEN R(J) = R(J) - 1
540 L$ = INKEY$:IF LEN(L$) = 0 THEN 560
550 IF ASC(L$) = 27 THEN 110
560 NEXT J: NEXT I
570 COLOR 10,7:PRINT "SORT FINAL PHASE : ";:COLOR 7,0
580 J = 1
590 IF R(J) = J THEN J = J + 1: GOTO 590
600 IF J > = NR THEN 670
610 FOR I = 1 TO NH:Z$(I) = N$(R(J),I):N$(R(J),I) = N$(J,I)
620 L$ = INKEY$: IF LEN(L$) = 0 THEN 640
630 IF ASC(L$) = 27 THEN 110
640 N$(J,I) = Z$(I): NEXT I
650 Z = R(R(J)):R(R(J)) = R(J):R(J) = Z
660 GOTO 590
670 PRINT: PRINT "?:_Write '";DB$;"' file sorted by '";H$(S);"' to storage device"
680 INPUT "Reply (Y or N)";L$
690 IF L$ <> "Y" AND L$ <> "y" AND L$ <>"N" AND L$ <> "n" THEN BEEP: GOTO 670
700 IF L$ = "Y" OR L$ = "y" THEN F$ = INDEX$: GOSUB 5010
710 GOTO 5580
720 CLS:MF = 1: GOSUB 4400
730 INPUT "Enter sort key 'Field #' or (Q, M, or F) ";S$:S = VAL(S$):EX$ = S$:GOSUB 6290
740 IF S < 1 OR S > NH THEN BEEP: GOTO 730
750 PRINT : COLOR 8,7:PRINT "?:_Sort options:";:COLOR 7,0: PRINT :PRINT
760 PRINT "(";:COLOR 8,7:PRINT "A";:COLOR 7,0:PRINT ")lphabetically"
770 PRINT "(";:COLOR 8,7:PRINT "N";:COLOR 7,0:PRINT ")umerically"
780 PRINT
790 INPUT "Reply (A or N) or (Q, M, or F) ";L$:L=0:EX$=L$:GOSUB 6290
800 IF L$ = "A" OR L$ = "a" THEN L = 1
810 IF L$ = "N" OR L$ = "n" THEN L = 2
820 IF L < 1 OR L > 2 THEN BEEP: GOTO 790
830 PRINT :COLOR 8,7:PRINT "Strike 'ESC' to *CANCEL* Sort";:COLOR 7,0:PRINT: COLOR 10,7:PRINT "SORT PHASE 1 : ";:COLOR 7,0: GOTO 420
840 REM ***CREATE HEADERFILE***
850 NR = 1
860 CLS: PRINT "Strike 'RETURN' for Main Menu"
870 PRINT
880 PRINT "Enter LABEL for 'FIELD #' ";NR;:LINE INPUT": ";R$(NR)
890 IF R$(NR) = "" OR NR > 20 THEN 920
900 NR = NR + 1
910 GOTO 880
920 NR = NR - 1
930 EX = 1605
940 GOSUB 5010: GOTO 330
950 REM ***ENTER RECORDS***
960 CLS
970 PRINT "Currently ";NR;" record(s) in '";DB$;"' file - space for ";:COLOR 8,7:PRINT B-NR;:COLOR 7,0:PRINT " more"
980 IF B - NR < 1 THEN 1100
990 NR = NR + 1
1000 PRINT "Currently entering record ";NR
1010 PRINT
1020 FOR I = 1 TO NH
1030 PRINT H$(I);":";: GOSUB 5550:N$(NR,I) = I$
1040 NEXT I
1050 PRINT
1060 PRINT "?:_Additional record(s) for current file:"
1070 INPUT "Reply (Y or N) or (Q or F)";L$:EX$ = L$: GOSUB 6310
1080 IF L$ ="Y" OR L$ = "y" THEN CLS:GOTO 970
1090 IF L$ <> "N" AND L$ <> "n" THEN BEEP: GOTO 1060
1100 F$ = INDEX$
1110 GOSUB 5010
1120 GOTO 5580
1130 REM ***SEARCH/CHANGE***
1140 L = 0
1150 CLS
1160 PRINT "Select: ";:COLOR 8,7:PRINT "SEARCH";:COLOR 7,0:PRINT " on any of following fields"
1170 PRINT
1180 GOSUB 4400
1190 PRINT "or options"
1200 PRINT "(";:COLOR 10,7:PRINT "C";:COLOR 7,0:PRINT ")hange data in a field"
1210 PRINT
1220 INPUT "Enter ('FIELD #' or C) or (Q, M, or F)";S$:S = VAL(S$):EX$ = S$:GOSUB 6290
1230 IF S$ ="C" OR S$ = "c" THEN 1530
1240 IF S = 0 THEN IF S$ <> "0" THEN S = -1
1250 IF S < 0 OR S > NH THEN BEEP: GOTO 1220
1260 REM
1270 PRINT "Enter data for search key on field '";:COLOR 8,7:PRINT H$(S);:COLOR 7,0:PRINT "' = ";:LINE INPUT " ";Q$
1280 IF LEN(Q$) = 0 THEN BEEP:GOTO 1270
1290 Z$ = " "+Q$
1300 CLS
1310 FOR J = 1 TO NR
1320 N$(J,0) = STR$(J)
1330 IF S = 0 THEN IF N$(J,0) = Z$ THEN GOSUB 1690
1340 IF S = 0 THEN 1380
1350 FOR I = 1 TO LEN(N$(J,S))
1360 IF MID$(N$(J,S),I,LEN(Q$)) = Q$ THEN GOSUB 1690: GOTO 1380
1370 NEXT I
1380 IF L + NH > 21 THEN GOSUB 1480
1390 NEXT J
1400 L=0
1410 COLOR 10,7:PRINT "*EOF [EOB]; now decide":COLOR 7,0
1420 PRINT "(";:COLOR 10,7:PRINT "S";:COLOR 7,0:PRINT ")earch additional record(s)"
1430 PRINT "(";:COLOR 10,7:PRINT "C";:COLOR 7,0:PRINT ")hange data in fields"
1440 INPUT "Enter (S or C) or (Q, M, or F)";S$:S = 0:EX$ = S$: GOSUB 6290
1450 IF S$ = "S" OR S$ = "s" THEN 1150
1460 IF S$ = "C" OR S$ = "c" THEN 1530
1470 BEEP: GOTO 1440
1480 IF PF < > 0 THEN 1520
1490 PRINT "Strike ";:COLOR 8,7:PRINT "RETURN";:COLOR 7,0:PRINT " to continue, or Enter ";:COLOR 8,7:PRINT "(Q, M, or F)";:COLOR 7,0
1500 INPUT L$:EX$ = L$: GOSUB 6290
1510 IF LEN(L$) < > 0 THEN BEEP: GOTO 1500
1520 L = 0: CLS : RETURN
1530 REM ***CHANGE DATA***
1540 INPUT "Enter record number ('REC #') to modify or (Q, M, or F) ";J$:J = VAL(J$):EX$ = J$:GOSUB 6290
1550 IF J < 1 OR J > NR THEN BEEP:COLOR 26,0:PRINT "Invalid Record ID":COLOR 7,0:GOTO 1540
1560 CLS : GOSUB 1690
1570 INPUT "Select field number ('FIELD #') to modify or (Q, M, or F) ";S$:S = VAL(S$):EX$ = S$: GOSUB 6290
1580 IF S< 1 OR S > NH THEN BEEP: GOTO 1570
1590 PRINT
1600 PRINT "?:_From: ";H$(S);": ";N$(J,S)
1610 PRINT
1620 PRINT "?:_To: ";H$(S);": ";:LINE INPUT " ";N$(J,S)
1630 CLS: GOSUB 1690
1640 PRINT
1650 INPUT "?:_More changes Enter (Y or N) or (Q, M, or F) ";L$:EX$ = L$: GOSUB 6290
1660 IF L$ = "Y" OR L$ = "y" THEN 1530
1670 IF L$ <> "N" AND L$ <> "n" THEN BEEP: GOTO 1650
1680 F$ = INDEX$: GOSUB 5010 : GOTO 5580
1690 REM ***PRINT A RECORD***
1700 PRINT " ";H$(0);": ";J
1702 PRINT "RECORD DISPLAY":COLOR 15:PRINT"*IN PROGRESS":COLOR 7
1710 IF PF <> 0 THEN LPRINT " ";H$(0);": ";J
1720 FOR I = 1 TO NH
1730 IF I = 1 THEN PRINT "FIELD #"
1740 IF PF <> 0 THEN IF I = 1 THEN LPRINT "FIELD #"
1750 PRINT I;" ";H$(I);": ";N$(J,I)
1760 IF PF <> 0 THEN LPRINT I;" ";H$(I);": ";N$(J,I)
1770 NEXT I
1780 PRINT
1790 IF PF <> 0 THEN LPRINT
1800 L =L + NH + 2
1810 REM
1820 RETURN
1830 REM ***DELETE RECORDS***
1840 CLS
1850 INPUT " Record Number ('REC #') to DELETE or (Q or F) ";DR$:EX$ = DR$: GOSUB 6310
1860 DR = VAL(DR$)
1870 IF DR < 1 OR DR > NR THEN BEEP:COLOR 26,0:PRINT "Invalid Record Number":COLOR 7,0:GOTO 1850
1880 CLS: FOR I = 1 TO NH
1890 PRINT H$(I);":"; N$(DR,I): NEXT I
1900 PRINT "***?:_CORRECT RECORD TO DELETE:":INPUT "Reply (Y or N) ";G$
1910 IF G$ = "Y" OR G$ = "y" THEN 1940
1920 IF G$ <> "N" AND G$ <> "n" THEN BEEP: GOTO 1900
1930 GOTO 1830
1940 FOR J = DR TO NR - 1
1950 FOR I = 1 TO NH
1960 N$(J,I) = N$(J + 1,I)
1970 NEXT I
1980 NEXT J
1990 PRINT :NR = NR -1 : PRINT "Record Number ";:COLOR 26,0:PRINT DR;:COLOR 7,0:PRINT " Ready for DELETION "
1991 PRINT "Requested Record(s) **DESTROYED**":PRINT
2000 PRINT "?:_DELETE additional record(s):":INPUT "Reply (Y or N) or (Q or F) ";L$:EX$ = L$: GOSUB 6310
2010 IF L$ = "Y" OR L$ = "y" THEN 1850
2020 IF L$ <> "N" AND L$ <> "n" THEN BEEP: GOTO 2000
2040 F$ = INDEX$: GOSUB 5010: GOTO 5580
2050 REM ***BASENAMEFILE ROUTINES***
2060 CLS
2070 LOCATE 1,25:COLOR 8,7: PRINT " ****** I B M P C ******":LOCATE 2,25
2071 PRINT " ELECTRONIC FILING SYSTEM ":LOCATE 3,25
2072 PRINT DT$;" VERSION";VE$:COLOR 7,0:LOCATE 4,33
2073 PRINT "FILE MENU ":PRINT:PRINT "Select File by Number:":PRINT
2080 Q=0
2090 FOR J = 1 TO NR:IF J < 10 THEN PRINT " ";J;" - [";R$(J);"]"; ELSE PRINT J;" - [";R$(J);"]";
2100 Q=Q+1:IF Q<4 THEN PRINT TAB(Q*18);"";ELSE Q=0:PRINT
2110 NEXT J: PRINT
2120 IF Q <> 0 THEN PRINT
2130 PRINT "or OPTIONS"
2140 PRINT "(";:COLOR 8,7:PRINT "C";:COLOR 7,0: PRINT ")reate new file"
2150 IF J > 1 THEN PRINT "(";:COLOR 8,7:PRINT "D";:COLOR 7,0:PRINT ")elete file"
2160 PRINT "(";:COLOR 8,7:PRINT "Q";:COLOR 7,0:PRINT ")uit"
2170 PRINT
2180 INPUT "INPUT File Number or (C, D, or Q) ";S$:S = 0
2190 IF S$ = "C" OR S$ = "c" THEN S = J:GOTO 2240
2200 IF S$ = "D" OR S$ = "d" THEN IF J > 1 THEN S =J+1:GOTO 2240
2210 IF S$ = "Q" OR S$ = "q" THEN IF J > 1 THEN S = J+2:GOTO 2240
2220 IF S$ = "Q" OR S$ = "q" THEN IF J <= 1 THEN S = J + 1:GOTO 2240
2230 S = VAL(S$):IF S < 1 OR S > J -1 THEN BEEP: GOTO 2060
2240 IF J =< 1 AND S = J+1 THEN 5980
2250 IF S = J+2 THEN 5980
2260 IF S = J + 1 THEN 2450
2270 IF S < 1 OR S > J THEN BEEP: GOTO 2060
2275 IF S$ = "C" OR S$ = "c" THEN 2290
2280 LOCATE 6,30:COLOR 26,0:PRINT "Loading File.... WAIT";:COLOR 7,0:PRINT " "
2290 DB$ = R$(S)
2300 IF S < > J THEN 310
2310 PRINT
2320 GOTO 2340
2330 REM
2340 IF J = 0 THEN J = 1
2350 LINE INPUT "LABEL for new file (Maximum 8 Characters) : ";T$
2360 GOSUB 5990:R$(J)=T$
2370 IF LEN(R$(J)) < 1 OR LEN(R$(J)) > 8 THEN BEEP: GOTO 2350
2380 IF J=1 THEN 2420
2390 FOR T = 1 TO J-1
2400 IF R$(T)=R$(J) THEN BEEP:COLOR 26,0:PRINT "Duplicate File LABEL":COLOR 7,0:GOTO 2350
2410 NEXT T
2420 NR = J: GOSUB 5010
2430 DB$ = R$(J - 1)
2440 GOTO 310
2450 REM ***DELETE A DATA BASE***
2460 PRINT : PRINT "Enter File Number to be ";:COLOR 8,7:PRINT "DELETED";:COLOR 7,0:PRINT " or (Q or F) ";:LINE INPUT "===> ";S$
2461 S=VAL(S$):EX$=S$:GOSUB 6310
2470 IF S < 1 OR S > J - 1 THEN BEEP: GOTO 2460
2480 CLS:PRINT "Ready to DELETE '";:COLOR 8,7:PRINT R$(S);:COLOR 7,0:PRINT "' file":PRINT
2490 PRINT "Once deleted data cannot be recovered"
2500 PRINT "?:_";:COLOR 26,0:PRINT "SURE";:COLOR 7,0:PRINT " DELETE ?":INPUT "Reply (Y or N) ";S$
2510 IF S$ = "N" OR S$ = "n" THEN 2050
2520 IF S$ < > "Y"AND S$ <> "y" THEN BEEP: GOTO 2500
2530 CLS:PRINT " ***DELETING '";:COLOR 8,7:PRINT R$(S);:COLOR 7,0:PRINT "' file"
2540 EX = 2750
2550 DB$ = R$(S)
2560 F$ = RPTFMT$
2570 GOSUB 4770
2580 KILL DB$+"."+F$
2590 FOR I = 1 TO NR
2600 KILL DB$+"."+R$(I)
2610 NEXT I
2620 EX = 2840
2630 KILL DB$+"."+INDEX$
2640 EX = 2850
2650 KILL DB$+"."+HEADER$
2660 EX = 2859
2670 DB$ = "BASENAME"
2680 F$ = BASENAME$: GOSUB 4770
2690 EX = 2875
2700 REM
2710 IF NR = 1 THEN KILL "BASENAME"+"."+BASENAME$: GOTO 110
2720 FOR I = S TO NR - 1
2730 R$(I) = R$(I + 1)
2740 NEXT I
2750 NR = NR - 1: GOSUB 5010
2760 GOTO 2050
2770 REM ***REPORT***
2780 T9 = 0
2790 E = 0
2800 FOR I = 0 TO 3 * NH + 2:K(I) = 0:KC(I) = 0: NEXT I
2810 FOR I = 0 TO NH:AC(I) = 0: NEXT I:HC = 0:GT = 0
2820 ON E GOTO 3140
2830 GOTO 4510
2840 INPUT "?:_Number of fields to appear on report or (Q, M, or F) ";RH$:RH = VAL(RH$):EX$ = RH$: GOSUB 6290
2850 P$ = "Y"
2860 IF RH < 1 OR RH > NH THEN BEEP: GOTO 2840
2870 IF E = 0 THEN RN$(NN) = "CURRENT"
2880 FOR I = 1 TO RH * 3 STEP 3
2890 CLS:GOSUB 4400
2900 PRINT "Select:";:COLOR 8,7:PRINT "'FIELD #'";:COLOR 7,0
2901 PRINT " for column # ";(I+2)/3;" or (Q, M, or F) ";
2902 INPUT" ";K$:K(I)=VAL(K$):EX$=K$:GOSUB 6290
2910 IF K(I) = 0 THEN IF K$ <> "0" THEN K(I) = -1
2920 IF I = 1 THEN 2950
2930 FOR PX = 1 TO I-3 STEP 3:IF K(I) = K(PX) THEN K(I) = -1
2940 NEXT PX
2950 IF K(I) <0 OR K(I) > NH THEN BEEP: GOTO 2900
2960 KC(I) = (I+2)/3
2970 PRINT "?:_TAB position for ";:COLOR 8,7:PRINT H$(K(I));
2971 COLOR 7,0:PRINT " or (Q, M, or F) ";:INPUT "";K$:K(I + 1)=VAL(K$)
2972 EX$ = K$:GOSUB 6290
2980 IF K(I +1) < 1 OR K(I+ 1) > 132 THEN BEEP:COLOR 26,0:PRINT "Tab must be (1 - 132)":COLOR 7,0:GOTO 2970
2990 IF K(I) = 0 THEN 3030
3000 PRINT "?:_Total on ";:COLOR 8,7:PRINT H$(K(I));:COLOR 7,0:PRINT " Reply (Y or N) ";: INPUT L$
3010 IF L$ <> "Y" AND L$ <>"y" AND L$ <> "N" AND L$ <> "n" THEN BEEP: GOTO 3000
3020 IF L$ = "Y" OR L$ = "y" THEN K(I + 2) = 1:K(0) = 1:T9=1
3030 NEXT I
3040 IF K(0) < > 1 THEN CLS:GOSUB 4400:GOTO 3140
3050 CLS:GOSUB 4400
3060 PRINT "?:_Apply horizontal column total on ";:COLOR 8,7:PRINT "TOTAL";:COLOR 7,0:PRINT " fields ?"
3070 INPUT "Reply (Y or N) ";A$
3080 IF A$ = "N" OR A$ = "n" THEN A$ = "":GOTO 3120
3090 IF A$<> "Y" AND A$ <> "y" THEN BEEP:GOTO 3060
3100 PRINT "?:_TAB position for ";:COLOR 8,7:PRINT "TOTAL";:COLOR 7,0:PRINT " column or (Q, M, or F) ";:LINE INPUT; A$:EX$ = A$:GOSUB 6290
3110 IF LEN(A$) = 0 THEN A$ = "0"
3120 IF LEN(A$) = 0 THEN K(0) = 2:T9 = 1: GOTO 3140
3130 K(I + 1) =VAL(A$): IF K(I + 1) < 1 OR K(I + 1) > 132 THEN COLOR 26,0:PRINT "Tab range must be (1 - 132)":COLOR 7,0: BEEP: GOTO 3100
3140 PRINT
3150 PRINT "To select all records press ";:COLOR 8,7:PRINT "'RETURN'";:COLOR 7,0:PRINT " or select record(s) by field number"
3160 INPUT "Strike 'RETURN' or Select ('FIELD #') or (Q, M, or F) ";S$:S=VAL(S$):EX$ = S$ : GOSUB 6290
3170 L$ = "N"
3180 X$="@"
3190 IF LEN(S$) = 0 THEN Q$ = "@": GOTO 3320
3200 IF S < 1 OR S > NH THEN BEEP:GOTO 3160
3210 PRINT "?:_Select record(s) using fields ?":INPUT "Reply (Y or N) ";L$: IF L$="Y" OR L$ = "y" THEN 3250
3220 IF L$ <>"N" AND L$ <> "n" THEN BEEP: GOTO 3210
3230 X$ = "@"
3240 GOTO 3280
3250 PRINT: INPUT "Enter 2nd Field Number ('FIELD #') or (Q, M, or F) ";X$:X=VAL(X$):EX$ = X$: GOSUB 6290
3260 IF LEN(X$) = 0 THEN X$ = "@": GOTO 3280
3270 IF X < 1 OR X > NH THEN BEEP: GOTO 3250
3280 PRINT: PRINT " '@' will select all records"
3290 PRINT "Select search key on field '";:COLOR 8,7:PRINT H$(S);:COLOR 7,0:PRINT "' = ";: LINE INPUT Q$
3300 IF Q$ <> "@" THEN IF L$ = "Y" OR L$ = "y" THEN PRINT "Enter search key on field '";
3301 COLOR 8,7:PRINT H$(X);:COLOR 7,0
3302 PRINT " ' = ";:LINE INPUT;X$
3310 Z$=" "+Q$
3320 REM
3330 REM
3340 GOSUB 3990
3350 FOR J = 1 TO NR
3360 N$(J,0) = STR$(J)
3370 IF Q$ = "@" THEN 3500
3380 IF S = 0 THEN 3430
3390 FOR I = 1 TO LEN(N$(J,S))
3400 IF MID$(N$(J,S),I,LEN(Q$)) = Q$ THEN 3450
3410 NEXT I
3420 GOTO 3510
3430 IF S = 0 THEN IF N$(J,0) = Z$ THEN 3450
3440 GOTO 3510
3450 IF X$ = "@" THEN 3500
3460 FOR I = 1 TO LEN(N$(J,X))
3470 IF MID$(N$(J,X),I,LEN(X$)) = X$ THEN GOSUB 3660: GOTO 3510
3480 NEXT I
3490 GOTO 3510
3500 GOSUB 3660
3510 IF PF < 1 THEN IF L > 22 THEN GOSUB 1480: GOSUB 3990
3520 IF L = 0 THEN GOSUB 3990
3530 NEXT J
3540 ON T9 GOSUB 3800
3550 REM
3560 ON E GOTO 3610
3570 PRINT : PRINT "?:_LOG report format to ";:COLOR 8,7:PRINT "disk ";:COLOR 7,0 :PRINT " "
3580 INPUT "Reply (Y or N) or (Q, M, or F) ";L$:EX$ = L$:GOSUB 6290
3590 IF L$<>"Y" AND L$ <> "y" AND L$ <> "N" AND L$ <>"n" THEN BEEP: GOTO 3570
3600 IF L$ = "Y" OR L$ = "y" THEN E = 1: GOSUB 4170
3610 PRINT : PRINT "?:_Additional reports using '";:COLOR 8,7:PRINT RN$(NN);:COLOR 7,0:PRINT "' format ?"
3620 INPUT "Reply (Y or N) or (Q, M, or F) ";L$:EX$ = L$: GOSUB 6290
3630 IF L$ <>"Y" AND L$ <> "y" AND L$ <> "N" AND L$ <> "n" THEN BEEP: GOTO 3610
3640 IF L$ = "Y" OR L$ = "y" THEN E = 1: GOTO 2810
3650 GOTO 5580
3660 FOR I = 1 TO RH
3670 PRINT TAB(K(3*I-1));N$(J,K(3 * I - 2));
3680 IF PF <> 0 THEN LPRINT TAB(K(3*I-1));N$(J,K(3*I-2));
3690 ON K(3 *I) GOSUB 3770
3700 NEXT I
3710 IF PF <> 0 THEN IF K(0)=1 THEN IF HC<>0 THEN LPRINT TAB(K(3*I-1));HC;
3720 IF K(0) =1 THEN IF HC<>0 THEN PRINT TAB(K(3*I-1));HC;:GT=GT+HC:HC=0
3730 L = L + 1
3740 PRINT
3750 IF PF <> 0 THEN LPRINT
3760 RETURN
3770 N = 3 * I - 2
3780 V = VAL(N$(J,K(N))):AC(I) = AC(I) + V:HC = HC + V
3790 RETURN
3800 KS=999:KT = 0: FOR I = 1 TO RH + 1: IF K(3*I-1) > KT THEN KT = K(3*I-1)
3810 IF K(3*I-1) > 0 THEN IF K(3*I-1) < KS THEN KS = K(3*I-1)
3820 NEXT I
3830 PRINT TAB(KS);:FOR I = KS TO KT + 5: PRINT "-";:NEXT I: PRINT
3840 FOR I = 1 TO RH
3850 IF AC(I) = 0 THEN 3870
3860 PRINT TAB((K(3*I-1))-1);AC(I);
3870 NEXT I
3880 IF GT < > 0 THEN PRINT TAB(K(3*I-1));GT;
3890 PRINT
3900 IF PF = 0 THEN 3980
3910 LPRINT TAB(KS);:FOR I = KS TO KT + 5:LPRINT "-";:NEXT I:LPRINT
3920 FOR I = 1 TO RH
3930 IF AC(I) = 0 THEN 3950
3940 LPRINT TAB(K(3*I-1));AC(I);
3950 NEXT I
3960 IF GT <> 0 THEN LPRINT TAB(K(3*I-1));GT;
3970 LPRINT
3971 PRINT "...LPRINTER> COMPLETED WITHOUT ERROR(S)"
3980 RETURN
3990 CLS
4000 PRINT RN$(NN);" REPORT FOR ";H$(S);":";Q$;
4010 IF PF <> 0 THEN LPRINT RN$(NN);" REPORT FOR ";H$(S);":";Q$;
4020 IF X$ = "@" THEN 4060
4030 PRINT " AND ";H$(X);":";X$
4040 IF PF <> 0 THEN LPRINT " AND ";H$(X);":";X$
4050 GOTO 4080
4060 PRINT ""
4070 IF PF <> 0 THEN LPRINT ""
4080 FOR I = 1 TO RH
4090 PRINT TAB(K(3*I-1));H$(K(3 * I - 2));
4100 IF PF <> 0 THEN LPRINT TAB(K(3*I-1));H$(K(3*I-2));
4110 NEXT I
4120 IF K(0) = 1 THEN PRINT TAB(K(3*I-1));"TOTAL";
4130 IF PF<>0 AND K(0) = 1 THEN LPRINT TAB(K(3*I-1));"TOTAL";
4140 PRINT : PRINT
4150 IF PF <> 0 THEN LPRINT:LPRINT
4160 L = 4: RETURN
4170 REM ***SET-UP TO SAVE RPTFMTFILE***
4180 NS = NR
4190 LINE INPUT "?:_LABEL of Report Format (maximum 3 characters) ";T$
4200 GOSUB 5990:RN$(NN)=T$
4210 IF LEN(RN$(NN)) <1 OR LEN(RN$(NN)) >3 THEN BEEP: GOTO 4190
4220 IF NN=1 THEN 4260
4230 FOR T = 1 TO NN-1
4240 IF RN$(T)=RN$(NN) THEN BEEP:COLOR 26,0:PRINT "Duplicate Report Format LABEL":COLOR 7,0:GOTO 4190
4250 NEXT T
4260 F$ = RN$(NN)
4270 NR = 3 * RH + 2
4280 FOR I = 1 TO NR:R$(I) = STR$(K(I)): NEXT I
4290 R$(I - 2) = STR$(K(0))
4300 GOSUB 5010 :GOSUB 5200
4310 RETURN
4320 REM ***SET-UP TO READ RPTFMTFILE***
4330 F$ = RN$(NN)
4340 GOSUB 4770
4350 RH = (NR - 2) / 3:FOR I = 1 TO NR:K(I) = VAL(R$(I)):NEXT I
4360 K(0) = VAL(R$(I - 2))
4370 IF K(0) <> 0 THEN T9=1
4380 NR = NS
4390 GOSUB 4400: PRINT : GOTO 3150
4400 REM ***FILE MENU***
4410 PRINT "Select from:": PRINT
4420 IF P$ = "Y" THEN PRINT TAB(2);"TAB";TAB(8);"TOTAL ";
4430 PRINT "FIELD #"
4440 IF T$ = "Y" THEN 4460
4450 IF MF = 0 THEN PRINT " 0 ";H$(0)
4460 FOR J = 1 TO NH
4470 IF P$ = "Y" THEN GOSUB 6480
4480 PRINT J;" ";H$(J):NEXT J:PRINT
4490 MF = 0
4500 RETURN
4510 REM ***READ REPORTNAMEFILE & SELECT REPORT***
4520 NN = 0: FOR I = 0 TO 21:RN$(I) = "": NEXT I:NS = NR
4530 F$ = RPTFMT$
4540 EX = 3970
4550 GOSUB 4770
4560 FOR I = 1 TO NR:RN$(I) = R$(I): NEXT I
4570 CLS : PRINT "Select from:": PRINT
4580 PRINT "FORMAT #"
4590 FOR I = 1 TO NR: PRINT I;" ";R$(I): NEXT I: PRINT
4600 PRINT "or OPTIONS"
4610 PRINT "(";:COLOR 10,7:PRINT "C";:COLOR 7,0:PRINT ")reate new Report Format"
4620 INPUT "Enter Report Format Number ('FORMAT #'or C) or (Q, M, or F) ";S$:S = 0:EX$ = S$
4630 IF S$ = "M" OR S$ = "m" THEN NR = NS
4640 GOSUB 6290
4650 IF S$ = "C" OR S$ = "c" THEN S = I :GOTO 4680
4660 S = VAL(S$)
4670 IF S < 1 OR S > I-1 THEN BEEP: GOTO 4620
4680 CLS
4690 NN = S
4700 IF S < > I THEN RN$(S) = R$(S):E = 1:NR = NS: GOTO 4320
4710 GOTO 4760
4720 CLS : COLOR 26,0:PRINT "No Report Formats on disk":COLOR 7,0:: PRINT
4730 NN = 1
4740 PRINT "?:_CREATE: ":INPUT "Reply (Y or N) or (Q, M, or F)";L$:EX$ = L$ : GOSUB 6290:IF L$="N" OR L$ = "n" THEN 5580
4750 IF L$ <>"Y" AND L$ <> "y" THEN BEEP: GOTO 4740
4760 T$ = "Y": GOSUB 4400:NR =NS: GOTO 2840
4770 REM ***READ FILES***
4775 FF = 0
4780 IF F$ < > INDEX$ THEN FF = 1
4790 REM
4800 REM
4801 CLS
4810 IF F$ = BASENAME$ THEN DB$ = "BASENAME"
4811 PRINT "OPENING ";:COLOR 1:PRINT DB$+"."+"["+F$+"]";:COLOR 7:PRINT"....WAIT"
4820 OPEN "I",1,DB$+"."+F$
4821 PRINT "OPENED...."
4830 INPUT #1, NR
4840 FOR J = 1 TO NR
4850 ON FF GOTO 4940
4860 IF J > B THEN CLS:COLOR 26,0:PRINT "FILE TOO LARGE - RECORD ";J;" BYPASSED --- CTL-S TO PAUSE CTL-Q TO RESUME":COLOR 7,0
4870 FOR I = 1 TO NH
4880 I$=""
4890 LINE INPUT#1, I$
4900 IF J > B THEN PRINT R$(I);" : "; I$: GOTO 4920
4910 N$(J,I) = I$
4920 NEXT I
4930 GOTO 4950
4940 LINE INPUT#1,R$(J)
4950 IF J > B THEN FOR X = 1 TO 3000:NEXT X: NR = B
4960 NEXT J
4970 REM
4971 PRINT "CLOSING ";DB$+"."+"["+F$+"]";:PRINT"....WAIT"
4980 CLOSE 1
4981 PRINT "CLOSED...."
4990 FF = 0
5000 RETURN
5010 REM ***SAVE FILES***
5015 FF = 0
5020 IF F$ < > INDEX$ THEN FF = 1
5030 REM
5040 REM
5050 IF F$ = BASENAME$ THEN DB$ = "BASENAME"
5051 PRINT "OPENING ";:COLOR 1:PRINT DB$+"."+"["+F$+"]";:COLOR 7:PRINT"....WAIT"
5060 OPEN "O",1,DB$+"."+F$
5061 PRINT "OPENED...."
5070 PRINT#1, NR
5080 FOR J = 1 TO NR
5090 ON FF GOTO 5140
5100 FOR I = 1 TO NH
5110 PRINT#1, N$(J,I)
5120 NEXT I
5130 GOTO 5150
5140 PRINT#1, R$(J)
5150 NEXT J
5151 PRINT "CLOSING ";DB$+"."+"["+F$+"]";:PRINT"....WAIT"
5160 CLOSE 1
5161 PRINT "CLOSED...."
5170 REM
5180 FF = 0
5190 RETURN
5200 REM ***SAVE REPORTNAMEFILE***
5210 NR = NN
5220 F$ = RPTFMT$
5230 FOR I = 1 TO NR:R$(I) = RN$(I): NEXT I
5240 GOSUB 5010
5250 NR = NS: RETURN
5260 REM ***LIST***
5261 PRINT "DUMPING LIST FILE TO LIST DEVICE [PRN] ....WAIT"
5262 PRINT "LIST TO PRN:"
5263 COLOR 15:PRINT"*IN PROGRESS":COLOR 7
5270 L = 0
5280 CLS
5290 FOR J = 1 TO NR
5300 IF PF <> 0 THEN LPRINT " ";H$(0);": ";J
5310 PRINT " ";H$(0);": ";J:L = L + 1
5320 FOR I = 1 TO NH
5330 IF I = 1 THEN PRINT "FIELD #"
5340 IF I = 1 THEN IF PF <> 0 THEN LPRINT "FIELD #"
5350 IF PF <> 0 THEN LPRINT I;" "H$(I);": ";N$(J,I)
5360 PRINT I;" ";H$(I);": ";N$(J,I)
5370 L = L + 1
5380 NEXT I
5390 IF PF <> 0 THEN LPRINT
5400 PRINT :L = L + 1
5410 IF PF < > 0 THEN 5430
5420 IF L + NH > 20 THEN 5470
5430 NEXT J
5440 REM
5450 COLOR 26,0:PRINT "*EOF: PRINT COMPLETED":COLOR 7,0: INPUT "Strike 'RETURN' to continue";L$
5460 GOTO 5580
5470 REM
5480 PRINT "Strike ";:COLOR 8,7:PRINT "'RETURN'";:COLOR 7,0:PRINT " to continue, or (Q, M, or F)";
5490 INPUT L$:EX$ = L$ : GOSUB 6290
5500 IF LEN(L$) = 0 THEN 5530
5510 BEEP
5520 GOTO 5490
5530 CLS :L = 0
5540 GOTO 5430
5550 REM ***INPUT ROUTINES***
5560 I$ = ""
5570 LINE INPUT""; I$: RETURN
5580 REM ***MAIN MENU***
5590 REM
5600 CLS
5610 P$ = "":T$ = ""
5620 COLOR 8,7:LOCATE 1,15:PRINT" ****** I B M P C ****** "
5625 COLOR 7,0:LOCATE 1,57:PRINT DATE$;" ";TIME$:COLOR 8,7
5630 LOCATE 2,15:PRINT "**** ELECTRONIC FILING SYSTEM ****"
5640 LOCATE 3,15:PRINT DT$;" VERSION";VE$;" "
5650 LOCATE 4,27:PRINT "MAIN MENU":COLOR 7,0
5660 PRINT
5670 PRINT TAB(20);"Current File: ";:COLOR 8,7:PRINT DB$:COLOR 7,0
5680 PRINT TAB(20);"Currently Contains: ";:COLOR 8,7:PRINT NR;:COLOR 7,0:PRINT " Record(s)"
5690 PRINT TAB(20);"Space for ";:COLOR 8,7:PRINT B - NR;:COLOR 7,0:PRINT " Additional Record(s)"
5700 PRINT TAB(20);"Free Space =";FRE(0)
5710 PRINT
5720 IF PF = 0 THEN PRINT TAB(20);"...LPRINTER> INTERVENTION REQUIRED":GOTO 5740
5730 PRINT TAB(20);"...LPRINTER> WAITING FOR WORK (MODE: 132,8)"
5740 PRINT
5750 PRINT TAB(20);"(F)ile Menu"
5760 PRINT TAB(20);"(C)hange and/or Search Fields"
5770 PRINT TAB(20);"(E)nter Records"
5780 PRINT TAB(20);"(D)elete Records"
5790 PRINT TAB(20);"(R)eport Generation
5800 PRINT TAB(20);"(S)ort - Takes Approximately" INT (0.0005 * NR ^ 2 + 0.04 * NR)"Minutes"
5810 PRINT TAB(20);"(P)rinter ON/OFF
5820 PRINT TAB(20);"(L)ist Records"
5830 PRINT TAB(20);"(Q)uit"
5840 PRINT
5850 PRINT TAB(20);: INPUT "Enter (F, C, E, D, R, S, P, L, or Q) ";S$:S = 0:EX$ = S$ : GOSUB 6310
5860 IF S$ = "C" OR S$ = "c" THEN 1130
5870 IF S$ = "E" OR S$ = "e" THEN 950
5880 IF S$ = "D" OR S$ = "d" THEN 1830
5890 IF S$ = "R" OR S$ = "r" THEN 2770
5900 IF S$ = "S" OR S$ = "s" THEN 720
5910 IF S$ = "P" OR S$ = "p" THEN IF PF = 0 THEN 5950
5920 IF S$ = "P" OR S$ = "p" THEN IF PF <> 0 THEN 5970
5930 IF S$ = "L" OR S$ = "l" THEN 5260
5940 BEEP: GOTO 5580
5950 CLS
5960 PF$ = "5":PF = 5: GOTO 5580 :REM FORCE PRINTER TO 132
5970 PF = 0: GOTO 5580
5980 CLS:COLOR 8,7:LOCATE ,20:PRINT "Exiting I B M P C Electronic Filing System":COLOR 7,0:SYSTEM: END
5990 REM ***VALIDATE FILE NAME ENTRIES***
6000 T=LEN(T$)
6010 IF T<1 THEN 6090
6020 FOR I = 1 TO T
6030 C$=MID$(T$,I,1)
6040 IF C$=>"0" AND C$<="9" THEN 6080
6050 IF C$=>"A" AND C$<="Z" THEN 6080
6060 IF C$=>"a" AND C$<="z" THEN 6080
6070 COLOR 26,0:PRINT "Invalid LABEL - Label may contain 'A-Z' 'a-z' '0-9' ONLY":COLOR 7,0:T$="":GOTO 6090
6080 NEXT I
6081 PRINT "***VALIDATED***";:COLOR 15:PRINT " ....USED":COLOR 7
6090 RETURN
6100 REM COMMON ERROR ROUTINE
6110 IF EX = 1110 AND ERR = 53 AND ERL = 4820 THEN EX = 0:RESUME 2330
6120 IF EX = 1140 AND ERR = 53 AND ERL = 4820 THEN EX = 0:RESUME 840
6130 IF EX = 1200 AND ERR = 53 AND ERL = 4820 THEN EX = 0:RESUME 5580
6140 IF EX = 2750 AND ERR = 53 AND ERL = 4820 THEN EX = 0:RESUME 2620
6150 IF EX = 2840 AND ERR = 53 AND ERL = 2630 THEN EX = 0:RESUME 2640
6160 IF EX = 2850 AND ERR = 53 AND ERL = 2650 THEN EX = 0:RESUME 2670
6170 IF EX = 3970 AND ERR = 53 AND ERL = 4820 THEN EX = 0:RESUME 4720
6180 IF ERR <> 7 THEN 6240
6190 FOR I = 1 TO 10:BEEP:NEXT I
6200 COLOR 26,0:PRINT "*** AVAILABLE MEMORY EXCEEDED ***":COLOR 7,0
6210 PRINT "Strike Any Key To Return To File Menu"
6220 XP$=INKEY$:IF XP$ = "" THEN 6220
6230 RESUME 110
6240 COLOR 26,0:PRINT "UNRECOVERABLE ERROR ENCOUNTERED":COLOR 7,0:FOR I = 1 TO 10:BEEP:NEXT I
6250 PRINT:PRINT "EX = ";EX;" ERR = ";ERR;" ERL = ";ERL"
6260 PRINT:PRINT "LAST FILE ACCESSED : ";DB$+"."+F$
6270 ON ERROR GOTO 0
6280 STOP
6290 REM COMMON EXIT ROUTINE
6300 IF EX$ = "M" OR EX$ = "m" THEN 5580
6310 IF EX$ = "Q" OR EX$ = "q" THEN 5980
6320 IF EX$ = "F" OR EX$ = "f" THEN 110
6330 RETURN
6340 REM SCREEN SCROLL
6350 CLS
6440 PRINT "ELECTRONIC FILE SYSTEM"
6441 PRINT: PRINT "BYTES FREE=";FRE(0):PRINT:PRINT "STIKE ANY KEY TO CONTINUE...."
6442 HOLD$ = INKEY$:IF HOLD$="" THEN 6442
6443 PRINT
6444 PRINT "*EXECUTION BEGINS"
6470 RETURN
6480 REM PRINT REPORT DATA
6490 FOR PX = 1 TO RH * 3 STEP 3
6500 IF K(PX) <> J THEN NEXT PX
6510 IF KC(PX) = 0 THEN PRINT TAB(17);:RETURN
6520 PRINT TAB(2);K(PX+1);TAB(9);
6530 IF K(PX+2) = 1 THEN PRINT "YES ";ELSE PRINT "NO ";
6540 RETURN
65399 '** DONE - PRESS ENTER TO RETURN TO MENU **
FILES46.TXT
--------------------------------------------------------------------------
Disk No 46 Screen Utilities No 1 v1.4
--------------------------------------------------------------------------
CLOCK COM Puts clock in upper right corner of display
CONFIG SYS Setup for alternate keyboard programs (DOS 2.0)
DVORAK Data file for DVORAK.CO
DVORAK COM Alternate keyboard program (DOS 2.0 only)
DVORAK DOC Documentation for DVORAK.COM
DVORAK BAT Batch file to start DVORAK.COM
QWERTY Alternate keyboard program (DOS 2.0 only)
QWERTY BAT Batch file for above
MA BAT Batch file for above
FULLEDIT BAS Stopgap full screen editor
PRINTFIX COM Run once to be rid of early DOS 1.1 printer bug
WS-ASCII BAS WORDSTAR-to-ASCII conversion
EFS BAS Electronic (database) file system
ASDADEL BAS Part of screen format program
ASDA BAS Part of screen format program
ASDARUN BAS Part of screen format program
HELPCOM BAS Part of screen format program
EDIT BAS Part of screen format program
FORMDISP BAS Part of screen format program
RESTATTR BAS Part of screen format program
HIDEFILE BAS Remove and/or modify hidden files
CHECKCON BAS Simple checkbook balancing program
CPRINT BAS Setup parameters of C-Itoh 8510 (NEC 8023) printer
GPRINT BAS Setup parameters of IBM/Epson printer
MEMDUMP BAS Memory dump program
DVORAK COM Command file for DVORAK
CONTROL COM Part of alternate keyboard system
QWERTY COM Command file for QWERTY
KEYMOVE BAS Part of alternate keyboard system
PC-SIG
1030D E. Duane Ave.
Sunnyvale, CA 94086
(408) 730-9291
(c) Copyright 1987 PC-SIG
FORMDISP.BAS
10 RET$=INKEY$:IF RET$="" THEN 10
20 COMMON BACK$
40 ON ERROR GOTO 170
50 CLS:WIDTH 80:LOCATE 3,15:COLOR 0,7:PRINT " * * * * * * S O F T M A R K I N C. * * * * * * ":COLOR 7,0
60 LOCATE 7,5: COLOR 15,0:PRINT "SCREEN FORMAT DISPLAY":COLOR 7,0
70 LOCATE 8,1: PRINT "-------------------------------------------------------------------------------"
80 LOCATE 13,11:PRINT "ENTER NAME OF SCREEN FORMAT TO VIEW..............."
90 LOCATE 13,62:COLOR 0,7:PRINT " ":COLOR 7,0
100 LOCATE 18,1:FILES "B:*.BAS"
110 LOCATE 13,63:COLOR 0,7:INPUT "",FORMAT$:COLOR 7,0
120 BACK$="A:FORMDISP"
130 IF FORMAT$<CHR$(33) THEN CHAIN "A:ASDARUN
140 FOR X=1 TO 8:IF MID$(FORMAT$,X,1)>CHR$(32) THEN FLXX=FLXX+1:NEXT X
150 FILENAME$=SPACE$(FLXX+7):MID$(FILENAME$,1,2)="B:":FOR X=1 TO FLXX:MID$(FILENAME$,X+2,1)=MID$(FORMAT$,X,1):NEXT X:MID$(FILENAME$,FLXX+3,4)=".BAS"
160 CLS:CHAIN FILENAME$
170 IF ERR=53 THEN BEEP:FOR X=1 TO 500:NEXT X:BEEP:LOCATE 25,5:PRINT "SCREEN FORMAT DOES NOT EXIST ON THIS DISKETTE.....PRESS ANY KEY TO CONTINUE"
180 ENT$=INKEY$:IF ENT$="" THEN 180
190 RESUME 50
FULLEDIT.BAS
1 CLS
90 ' AN ENHANCED FULL SCREEN EDITOR PROGRAM FOR THE IBM PC
95 ' ADAPTED FROM THE BELOW LISTED PROGRAM, BY HANK FREEMAN
100 '**************** THE STOPGAP EDITOR IN IBM BASIC ********************
110 ' **** by D.E. CORTESI
120 DEFINT A-Z : MAXL=400 : MAXW = 79 : ' MAXW=40 FOR COLOR TV
125 DIM LF(400),LB(400),LT$(400)
126 PRINT TAB(30) "Stopgap Editor"
127 PRINT:PRINT:PRINT "Use [ESC] for commands"
130 GOTO 1490
140 ' ::: right-arrow key: move cursor right
150 IF SCOL=MAXW THEN RETURN
160 SCOL=SCOL+1 : INSCHAR=FALSE : LOCATE SROW,SCOL,1,CSL : RETURN
170 ' ::: left-arrow key: move cursor left
180 IF SCOL=1 THEN RETURN
190 SCOL=SCOL-1 : INSCHAR=FALSE : LOCATE SROW,SCOL,1,CSL : RETURN
200 ' ::: tab key: jump right from one to eight columns
210 S=((SCOL+8) AND (-8))+1 : IF S<=MAXW THEN SCOL=S
220 INSCHAR=FALSE : LOCATE SROW,SCOL,1,CSL : RETURN
230 ' ::: end key: go to right end of the current line
240 SCOL=MAXW : INSCHAR=FALSE : LOCATE SROW,SCOL,1,CSL : RETURN
250 ' ::: printable character, action depends on inschar
260 IF NOT LMOD THEN L$=LT$(LCUR) : LMOD=TRUE
270 IF NOT INSCHAR THEN MID$(L$,SCOL,1)=CIN$ : GOTO 300
280 CIN$=CIN$+MID$(L$,SCOL,MAXW-SCOL)
290 L$=LEFT$(L$,SCOL-1)+CIN$
300 PRINT CIN$; : IF SCOL <MAXW THEN SCOL=SCOL+1
310 LOCATE SROW,SCOL,1 : CLR=FALSE : RETURN
320 ' ::: backspace: blank current character, move left
330 IF NOT LMOD THEN L$=LT$(LCUR) : LMOD = TRUE
340 MID$(L$,SCOL,1)=" " : PRINT " ";
350 IF SCOL>1 THEN SCOL=SCOL-1
360 INSCHAR=FALSE : LOCATE SROW,SCOL,1 : RETURN
370 ' ::: del key: kill current char, pull line left
380 IF NOT LMOD THEN L$=LT$(LCUR) : LMOD=TRUE
390 CIN$=RIGHT$(L$,MAXW-SCOL)+" " : PRINT CIN$;
400 L$=LEFT$(L$,SCOL-1)+CIN$
410 INSCHAR=FALSE : LOCATE SROW,SCOL,1,CSL : RETURN
420 ' ::: if current line has changed, update the file
430 INSCHAR=FALSE : LOCATE ,,1,CSL : IF NOT LMOD THEN RETURN
440 FMOD=LMOD : LT$(LCUR)=L$ : LMOD=FALSE : RETURN
450 ' ::: return the index of the next free line in L
460 IF LFREE=0 THEN L=FALSE : RETURN :'no free lines left
470 L=LFREE : LFREE=LF(L) : LF(L)=0 : LT$(L)=LMT$ : RETURN
480 ' ::: free the line whose index is in L
490 LF(L)=LFREE : LFREE=L : LT$(L)="" : RETURN
500 ' ::: forward one line in the file image
510 GOSUB 430 : L=LF(LCUR) : ' L=0 if LCUR is bottom line
520 IF L=0 THEN GOSUB 460 : IF L THEN LF(LCUR)=L : LB(L)=LCUR
530 IF L THEN LCUR=L : 'FALSE if bottom and no free lines
540 RETURN
550 ' ::: backward one line in the file image
560 GOSUB 430 : L=LB(LCUR)
570 IF L THEN LCUR=L : 'false if top line
580 RETURN
590 ' ::: enter key : cursor to left margin, then down
600 SCOL=1
610 ' ::: down-arrow: cursor down (data up, on line 24)
620 Q=LCUR : GOSUB 510 : IF Q=LCUR THEN RETURN
630 SROW=SROW+1 : IF SROW<25 THEN LOCATE SROW,SCOL,1 : RETURN
640 SROW=24 : PRINT :' force blank line, return cursor
650 PRINT LT$(LCUR); : LOCATE SROW,SCOL,1 : RETURN
660 ' ::: up-arrow: cursor up (data down 23 lines on line 1)
670 IF SROW=1 THEN 710
680 Q=LCUR : GOSUB 560 : IF Q=LCUR THEN RETURN
690 SROW=SROW-1 : LOCATE SROW,SCOL,1 : RETURN
700 ' ::: up-arrow on line 1: slide current line down 23
710 GOSUB 960 : S=0
720 WHILE (S<22) AND LB(T) : T=LB(T) : B=LB(B) : S=S+1 : WEND
730 SROW=SROW+S : GOTO 1020
740 ' ::: PgUp key: back up 23 lines, hold cursor still
750 GOSUB 430 : GOSUB 960 : S=0
760 WHILE (S<23) AND LB(T) : GOSUB 560 : T=LB(T) : B=LB(B) : S=S+1 : WEND
770 IF LF(B)=0 THEN 890 ELSE 1020
780 ' ::: PgDn key: ahead 23 lines, hold cursor still
790 GOSUB 430 : GOSUB 960 : S=0
800 WHILE (S<23) AND LF(B) : GOSUB 510 : T=LF(T) : B=LF(B) : S=S+1 : WEND
810 IF LB(T)=0 THEN 920 ELSE 1020
820 ' ::: Home key: go to left, then to top, then to bottom
830 IF SCOL>1 THEN SCOL=1 : INSCHAR=FALSE : LOCATE SROW,SCOL,1,CSL : RETURN
840 GOSUB 430 : GOSUB 960 : S=SROW
850 IF SROW=1 THEN WHILE LCUR<>B : GOSUB 510 : S=S+1 : WEND
860 IF SROW>1 THEN WHILE LCUR<>T : GOSUB 560 : S=S-1 : WEND
870 SROW=S : LOCATE SROW,SCOL,1 : RETURN
880 ' ::: control-a: go to top of the file
890 GOSUB 430 : GOSUB 2240 : LCUR=A
900 SROW=1 : SCOL=1 : GOSUB 960 : GOTO 1020
910 ' ::: control-z: go to the end of the file
920 GOSUB 430 : GOSUB 2240 : LCUR=Z : T=Z : B=Z : S=1
930 WHILE LB(T) AND S<24 : T=LB(T) : S=S+1 : WEND
940 SROW=S : SCOL=1 : GOTO 1020
950 ' ::: find the lines now at the top(t) and bottom(b) of the screen
960 S=SROW : T=LCUR
970 WHILE (S>1) AND (LB(T)<>0) : S=S-1 : T=LB(T) : WEND
980 S=SROW : B=LCUR
990 WHILE (S<24) AND (LF(B)<>0) : S=S+1 : B=LF(B) : WEND
1000 RETURN
1010 ' ::: redraw the screen using lines from T to B
1020 CLS : L=T
1030 WHILE L<>B : PRINT LT$(L) : L=LF(L) : WEND
1040 PRINT LT$(B);
1050 LOCATE SROW,SCOL,1 : RETURN
1060 ' ::: Ins key: toggle insert-character mode
1070 INSCHAR=NOT INSCHAR
1080 IF INSCHAR THEN LOCATE ,,1,CSL,1 ELSE LOCATE ,,1,CSL
1090 RETURN
1100 ' ::: control-o: split the file for bulk insertion
1110 IF INSLINE OR LF(LCUR)=0 OR LFREE=0 THEN RETURN
1120 GOSUB 430 : LINS=LCUR : LCUR=LB(LCUR)
1130 IF LCUR THEN LF(LCUR)=0 : GOSUB 510
1140 IF LCUR=0 THEN GOSUB 460 : LB(L)=0 : LCUR=L
1150 INSLINE=TRUE : GOSUB 960 : GOTO 1020
1160 ' ::: control-c: splice the file after bulk insertion
1170 IF NOT INSLINE THEN RETURN
1180 GOSUB 430 : WHILE LF(LCUR) : LCUR=LF(LCUR) : WEND
1190 LF(LCUR)=LINS : LB(LINS)=LCUR
1200 IF LT$(LCUR)<>LMT$ THEN 1240
1210 L=LCUR : LCUR=LF(LCUR) : LB(LCUR)=LB(L)
1220 IF LB(L) THEN LF(LB(L))=LCUR
1230 GOSUB 490
1240 INSLINE=FALSE : GOSUB 960 : GOTO 1020
1250 ' ::: control-d: delete the current line
1260 IF (LF(LCUR)+LB(LCUR)=0) THEN RETURN :'can't delete only line
1270 IF LB(LCUR) THEN LF(LB(LCUR))=LF(LCUR)
1280 IF LF(LCUR) THEN LB(LF(LCUR))=LB(LCUR)
1290 L=LCUR : IF LF(L)>0 THEN LCUR=LF(L)
1300 IF LF(L)=0 THEN LCUR=LB(L) : IF SROW>0 THEN SROW=SROW-1
1310 GOSUB 490 : GOSUB 960 : GOTO 1020
1320 ' ************************ MAIN LOOP *******************************
1330 CIN$=INKEY$ : ON 1+LEN(CIN$) GOTO 1330,1390,1350
1340 ' ::: handle a special key (numeric pad, ins, del)
1350 S=ASC(RIGHT$(CIN$,1)) : IF S<71 OR S>83 THEN 1330
1360 ON S-70 GOSUB 830,670,750,1330,180,1330,150,1330,240,620,790,1070,380
1370 GOTO 1330
1380 ' :::handle regular character or control key
1390 S=ASC(CIN$) : IF S>31 THEN GOSUB 260 : GOTO 1330
1400 IF S=>8 AND S<=13 THEN ON S-7 GOSUB 330,210,620,830,1330,600 : GOTO 1330
1410 IF S=1 THEN GOSUB 890 : GOTO 1330 : '^A-top of file
1420 IF S=3 THEN GOSUB 1170 : GOTO 1330 : '^C-split file
1430 IF S=4 THEN GOSUB 1260 : GOTO 1330 : '^D-line delete
1432 IF S=15 THEN GOSUB 1110 : GOTO 1330 : '^O-splice file
1435 IF S=19 THEN F=S : GOSUB 2350 : GOTO 1330 : '^S-block move
1438 IF S=23 THEN F=S : GOSUB 2300 : GOTO 1330 : '^W-block merge/load
1440 IF S=24 THEN F=S : GOSUB 2500 : GOTO 1330 : '^Z-bottom of file
1450 IF S=26 THEN GOSUB 920 : GOTO 1330 : '^X-block delete
1460 IF S=27 THEN GOSUB 1630 : GOTO 1330 : 'ESC global commands
1470 GOTO 1330
1480 ' ::: **********************INITIALIZATION***************************
1490 GOSUB 1520 : FSPEC$="" :' clear all data and set up
1500 CLS : LOCATE SROW,SCOL,1 : GOTO 1330
1510 ' ::: clear all variables, set up null data array
1520 ' ::: **************************************************************
1530 LMT$=SPACE$(MAXW)
1540 FALSE=(1=2) : TRUE=NOT FALSE
1550 LMOD=FALSE : FMOD=FALSE
1560 CSL=12 : ' cursor scan line -- make 7 for color tv
1570 INSCHAR=FALSE : LOCATE ,,1,CSL : INSLINE=FALSE
1575 CLR=TRUE : KEY OFF
1580 FOR I=2 TO MAXL-1 : LF(I)=I+1 : NEXT I : LF(MAXL)=0 : LFREE=2
1590 LCUR=1 : LF(LCUR)=0 : LB(LCUR)=0 : LT$(LCUR)=LMT$
1600 SROW=1 : SCOL=1 : LCUR=1 : T=1 : B=1
1610 RETURN
1620 ' ********************* GLOBAL COMMANDS ****************************
1630 GOSUB 1170 : GOSUB 430 : GOSUB 960
1640 CLS : LOCATE 10,1
1650 PRINT "COMMAND CHOICES ARE..." : PRINT
1660 PRINT " 1. SAVE the present file"
1670 PRINT " 2. LOAD another file"
1685 PRINT " 3. CLEAR the data buffer of all data"
1690 PRINT " 4. QUIT and return to DOS"
1693 PRINT " 5. QUIT and return to BASIC"
1695 PRINT : PRINT " PRESS ENTER TO RETURN TO EDITOR"
1700 PRINT
1710 INPUT "Enter your choice of 1,2,3,4 OR ENTER ";CIN$
1720 IF CIN$="" THEN GOSUB 1020 : GOTO 1330
1730 CIN$=LEFT$(CIN$,1)
1740 IF CIN$="1" THEN GOSUB 1800 : GOTO 1640
1750 IF CIN$="2" THEN GOSUB 1930 : GOTO 1640
1760 IF CIN$="3" THEN GOSUB 2070 : GOTO 1640
1770 IF CIN$="4" THEN GOSUB 2100 : GOTO 1640
1775 IF CIN$="5" THEN F=5 : GOSUB 2100 : GOTO 1640
1780 GOTO 1640
1790 ' ::: the command is: SAVE (global save)
1800 GOSUB 2180 : OPEN FSPEC$ FOR OUTPUT AS #1
1810 GOSUB 2240 :'find the top and bottom of the data
1820 ' ::: write all lines, deleting trailing blanks
1830 WHILE A<>Z
1840 L$=LT$(A)
1850 I=MAXW
1860 WHILE I>1 AND MID$(L$,I,1)=" " : I=I-1 : WEND
1870 L$=LEFT$(L$,I)
1880 PRINT #1,L$
1890 A=LF(A)
1900 WEND
1910 CLOSE#1 : FMOD=FALSE : RETURN
1920 ' ::: the command is: LOAD/MERGE
1930 GOSUB 2070 : IF NOT Q THEN RETURN
1940 GOSUB 2180 : OPEN FSPEC$ FOR INPUT AS #1
1950 ' ::: read up to MAXL lines, force all to MAXW bytes
1960 WHILE (LFREE>0) AND NOT(EOF(1))
1970 LINE INPUT#1,CIN$
1980 L$=LMT$ : LSET L$=LEFT$(CIN$,MAXW)
1990 LMOD=TRUE
2000 GOSUB 510
2010 WEND
2020 CLOSE#1
2025 IF F=23 THEN F=0 : RETURN : ' ::: merge function exits early
2030 LMOD=FALSE : FMOD=FALSE : CLR=FALSE
2040 LCUR=1 : SROW=1 : SCOL=1 : GOSUB 960
2050 RETURN
2060 ' ::: the command is: CLEAR (or clear prior load)
2070 GOSUB 2120 : IF NOT Q THEN RETURN
2080 GOSUB 1520 : RETURN
2090 ' ::: the command is: QUIT
2100 GOSUB 2120 : IF Q AND F=5 THEN STOP ELSE IF Q THEN SYSTEM ELSE RETURN
2105 RETURN
2110 ' ::: if the file has been changed, get confirmation
2120 IF NOT FMOD THEN Q=TRUE : RETURN
2130 PRINT : PRINT "The file has been modified...!"
2140 INPUT "...are you SURE you want to do this (Y/N) ";CIN$
2150 CIN$=LEFT$(CIN$,1)
2160 Q=(CIN$="y") OR (CIN$="Y") : RETURN
2170 '::: get a filespec for load or save
2180 PRINT : PRINT "Give me a filspec";
2190 IF FSPEC$<>"" THEN PRINT " (";FSPEC$;")";
2200 INPUT CIN$ : IF (CIN$+FSPEC$)="" THEN PRINT : GOTO 2180
2210 IF CIN$<>"" THEN FSPEC$=CIN$
2220 RETURN
2230 ' ::: find the top(A) and bottom(Z) lines of data
2240 A=LCUR : WHILE LB(A) : A=LB(A) : WEND
2250 Z=LCUR : WHILE LF(Z) : Z=LF(Z) : WEND
2260 ' ::: minus trailing, empty lines, if any
2270 WHILE LT$(Z)="" AND Z<>A : Z=LB(Z) : WEND
2280 RETURN
2290 ' ::: ^W-the command is MERGE/LOAD
2300 IF CLR THEN F=0 : GOSUB 1940 : GOTO 1020
2305 IF LF(LCUR)=0 OR LB(LCUR)=0 THEN RETURN
2308 GOSUB 1110 : ' split the file
2310 GOSUB 1940 : ' use load to merge
2320 GOSUB 1170 : ' splice the file
2340 RETURN
2350 ' ::: ^S the command is "SAVE" (selective)
2360 GOSUB 430 : LOCATE 25,1 : LSV=MAXL
2370 PRINT "SAVE HOW MANY LINES (#,ALL, OR END)? ";
2380 INPUT; CIN$
2385 IF CIN$="END" THEN GOTO 2410
2390 IF CIN$="ALL" THEN GOSUB 1800 : GOTO 2460
2400 FOR I=1 TO LEN(CIN$) : IF MID$(CIN$,I,1)<"0" THEN RETURN
2405 IF MID$(CIN$,I,1)>"9" THEN GOTO 2460
2407 NEXT I
2408 IF CIN$<>"" THEN LSV=VAL(CIN$) ELSE GOTO 2360
2409 IF LSV=0 THEN GOTO 2460
2410 LOCATE 25,1 : PRINT "Give me a FILESPEC ";
2411 IF FSPEC$<>"" THEN LOCATE 25,19 : PRINT "(";FSPEC$;") ";
2412 LOCATE 25,32 : INPUT; CIN$
2414 IF (CIN$+FSPEC$)="" THEN BEEP : GOTO 2410
2416 IF CIN$<>"" THEN FSPEC$=CIN$
2417 OPEN FSPEC$ FOR OUTPUT AS #1
2420 A=LCUR : Z=LCUR : LSAV=0
2430 WHILE LSV>0 AND LF(Z)
2432 LSV=LSV-1 : LSAV=LSAV+1 : Z=LF(Z) : 'find bottom of file/last line to save
2434 WEND
2436 GOSUB 2270
2440 LOCATE 25,1 : PRINT "*************** SAVING " STR$(LSAV) " LINES *********
2441 WHILE A<>Z : ' assume last line of file is a blank line
2442 L$=LT$(A) : I=MAXW
2443 WHILE I>1 AND MID$(L$,I,1)=" " : I=I-1 : WEND
2444 L$=LEFT$(L$,I)
2445 PRINT #1,L$
2446 A=LF(A)
2447 WEND
2448 CLOSE #1
2460 GOSUB 960 : GOTO 1020
2490 '^X the command is DELETE BLOCK
2500 IF (LF(LCUR)+LB(LCUR)=0) THEN RETURN : 'CANNOT DELETE ONLY LINE
2510 GOSUB 430 : LOCATE 25,1 : LDEL=0
2520 PRINT "DELETE HOW MANY (#,END)? ";
2530 INPUT; CIN$
2540 IF CIN$="END" THEN LDEL=MAXL-1 : GOTO 2590
2550 FOR I=1 TO LEN(CIN$) : IF MID$(CIN$,I,1)<"0" THEN GOTO 2680
2560 IF MID$(CIN$,I,1)>"9" THEN GOTO 2680
2570 NEXT I
2580 LDEL=VAL(CIN$)
2590 WHILE LDEL>0
2600 IF LF(LCUR)=0 AND LB(LCUR)=0 THEN GOTO 2670
2610 IF LB(LCUR) THEN LF(LB(LCUR))=LF(LCUR)
2620 IF LF(LCUR) THEN LB(LF(LCUR))=LB(LCUR)
2630 L=LCUR : IF LF(L)>0 THEN LCUR=LF(L)
2640 IF LF(L)=0 THEN LDEL=0 : LCUR=LB(L) : IF SROW>0 THEN SROW=SROW-1
2650 GOSUB 490 : GOSUB 960 : LDEL=LDEL-1
2660 WEND
2665 IF LF(LCUR)=0 THEN GOSUB 510
2670 IF CIN$="END" THEN GOSUB 920 ELSE GOSUB 960 : RETURN
2680 GOTO 1020
2690 END
GPRINT.BAS
900 ' THIS PROGRAM CAN BE FOUND IN THE OCT.'82 ISSUE OF CREATIVE COMPUTING.
910 '
1000 ' GPRINT - Graphics Dump Program for the IBM Personal Computer
1010 ' Will Fastie -- Original version Feb 82, revised June 82
1020 '
1030 ' This priogram transfers the contents of the Color/Graphics Adapter
1040 ' memory to a GRAFTRAX-80 or GRAFTRAX-Plus equipped IBM 80 CPS or
1050 ' EPSON MX-80 printer, to an EPSON MX-100 printer, or to a new
1060 ' generation EPSON MX-80 OR 100 printer (for which GRAFTRAX-Plus is a
1070 ' standard feature). Medium resolution images (200 x 320) are
1080 ' converted, whether in black and white or in color. Color
1090 ' images, which can be displayed using a 4 color set, are printed
1100 ' in black and white.
1110 '
1120 ' The program assumes that the program is executed on a machine
1130 ' equipped with the Color/Graphics Adapter only. If both
1140 ' display adapters are present, switch to the Color/Graphics
1150 ' adapter first, then run this program.
1160 '
1170 ' -- GLOBAL program declarations
1190 DIM PIN.MASKS(8)
1200 FOR PIN = 0 TO 7
1210 PIN.MASKS(PIN) = 2^(7-PIN)
1220 NEXT PIN
1230 ESC = 27
1240 CR =13
1250 '
1260 ' This section should be written to suit you particular needs. For
1270 ' demonstration purposes, it loads a previously stored image form the
1280 ' disk into memory of the Color/Graphics Adapter. You could
1290 ' generate the image here instead.
1300 '
1310 KEY OFF: CLS
1320 INPUT "Enter filename of image: ",F$
1330 SCREEN 1,0 'Medium resolution, color enabled
1340 DEF SEG = &HB800 'Base address of CG/A memory
1350 BLOAD F$, 0
1360 '
1370 ' This section converts the image in memory to a numeric array
1380 ' containing the information required for the printer
1390 '
1400 ' -- Declar an array to hold the data
1410 NR.ROWS = 200: NR.COLS = 320
1420 ROWS.PER.PRINTED.LINE = 8
1430 NR.LINES = NR.ROWS/ROWS.PER.PRINTED.LINE
1440 DIM LINES(NR.LINES, NR.COLS)
1450 '
1460 ' -- Initialize the array to 0
1470 FOR L = 0 TO NR.LINES-1
1480 FOR COL = 0 TO NR.COLS-1
1490 LINES(L, COL) = 0
1500 NEXT COL
1510 NEXT L
1520 '
1530 ' This section reads each point form the video memory, translates
1540 ' the points to a black and white representaion, and builds
1550 ' the data for the printer.
1560 ' The ROW and COL variables are used to calculate the position in
1570 ' which the point value should be placed. The positions 0 through 7
1580 ' represent the printer's print head pins, from top to bottom. The
1590 ' value in each position in the array corresponds to these pin
1600 ' positions. 1610 '
1620 FOR ROW = 0 TO NR.ROWS-1
1630 L = ROW\ROWS.PER.PRINTED.LINE
1640 FOR COL = 0 TO NR.COLS-1
1650 IF POINT(COL, ROW) = 0 THEN GOTO 1670
1660 LINES(L, COL) = LINES(L, COL) OR PIN.MASKS(ROW MOD 8)
1670 NEXT COL
1680 BEEP
1690 NEXT ROW
1700 '
1710 ' This section prints the data by line to the printer. No assumption
1720 ' is made about the position of the paper.
1730 '
1740 GOSUB 2110
1750 FOR L = 0 TO NR.LINES-1 'establish line spacing
1760 N = NR.COLS: GOSUB 2170 'put printer in graphics mode
1770 FOR COL = 0 TO NR.COLS-1
1780 C = LINES(L, COL): GOSUB 2000
1790 NEXT COL
1800 C = CR: GOSUB 2000 'advance the paper
1810 NEXT L
1820 LPRINT: LPRINT 'space between this and next
1830 '
1840 END
1850 '
1860 ' This routine transmits the value in C to the printer.
1870 ' A routine like this is necessary because PRINT in BASIC interprets
1880 ' some characters, and therefore connot transmit arbitrary values.
1890 '
1900 ' This program uses the Printer Port on the IBM Monochrome Display
1910 ' and Parallel Printer Adapter. If you just have the Printer Adapter,
1920 ' you must change the port values in this routine according to this table.
1930 '
1940 ' Port Name MD & PPA Just PPA
1950 ' --------- -------- --------
1960 ' DATA in/out &H3BC &H378
1970 ' Printer Latch &H3BE &H37A
1980 ' Status Register &H3BD &H379
1990 '
2000 OUT &H3BE, &H6
2010 IF INP(&H3BD) <> &HDF THEN 2010
2020 OUT &H3BC, C
2030 OUT &H3BE, &H3F
2040 IF INP(&H3BD) <> &HDF THEN 2040
2050 RETURN
2060 '
2070 ' Subroutine to set line spacing to 8/72 of and inch. Subsequent
2080 ' to this command, the printer moves the paper by this amount
2090 ' whenever a Carriage Return (13) is received.
2100 '
2110 C = ESC: GOSUB 2000: C = ASC("A"): GOSUB 2000: C = 8: GOSUB 2000
2120 RETURN
2130 '
2140 ' Subroutine to command the printer to consider the next N characters
2150 ' as Bit Image Graphics data.
2160 '
2170 C = ESC: GOSUB 2000: C = ASC("K"): GOSUB 2000
2180 IF N > 255 THEN C = N-256: GOSUB 2000: C = 1: GOSUB 2000 ELSE C = N: GOSUB 2000: C = 0: GOSUB 2000
2190 RETURN
HELPCOM.BAS
10 REM *********************************************************************** * PROGRAM1 *
20 REM * by Phil Grier * * Laurel Maryland *
30 REM * (301) 498-2226 * ***********************************************************************
43 DEF SEG:POKE 106,0:FALSE=0:TRUE=NOT FALSE:RESET
44 CLS:PRINT"MUSIC? (Y OR N)"
46 MUSIC$=INKEY$
47 FOR I=1 TO 2:IF MUSIC$=MID$("Yy",I,1) THEN MUSIC=TRUE:GOTO 50 ELSE NEXT
48 IF MUSIC$="" THEN 46
49 MUSIC=FALSE
50 IF MUSIC=FALSE THEN 61
60 S$="O3L16B.L16AL16G.L8GL16GL16AL16BO4L16CL8DDDO3B.":PLAY "XS$;"
61 DEF SEG:POKE 106,0:SCREEN 0,1,0,0:COLOR 7,0,0:WIDTH 80:CLS:FOR I=1 TO 20:A$=INKEY$:NEXT
70 KEY OFF:KEY 1,"LIST ":KEY 2,"RUN"+CHR$(13):KEY 3,"LOAD"+CHR$(34)+"B:":KEY 4,"SAVE"+CHR$(34)+"B:":KEY 5,"GOSUB ":KEY 9,"CLS":KEY 7,"FILES "+CHR$(34)+"B:*.*":KEY 8,"EDIT ":KEY 6,"RETURN":KEY 10,"SYSTEM"
79 GOTO 100
100 LOCATE 2,30:PRINT "Phil Grier's":LOCATE 4,31,0:COLOR 0,15:PRINT "PROGRAM 1":COLOR 7,0:FOR I=1 TO 3000:NEXT
110 PRINT:PRINT
120 PRINT"THE ";:COLOR 1,0:PRINT "COLOR";:COLOR 7,0:PRINT " STATEMENT IN MONOCHROME:
130 PRINT:PRINT"THE NORMAL COLOR SETTING IS 7,0";:LOCATE ,50:PRINT"NORMAL
140 PRINT "REVERSE COLOR IS 0,7";:COLOR 0,7:LOCATE ,50:PRINT"REVERSE
150 COLOR 7,0:PRINT "UNDERSCORE IS 1,0";:LOCATE ,50:COLOR 1,0:PRINT"UNDERSCORE
160 COLOR 7,0:PRINT "HIGH INTENSITY IS 15,0";:LOCATE ,50:COLOR 15,0:PRINT"HI-INTEN
170 COLOR 7,0:PRINT"BLINKING IS 18,0";:LOCATE ,50:COLOR 18,0:PRINT"BLINK
180 COLOR 7,0:PRINT "BLINKING UNDERLINED IS 17,0";:LOCATE ,50:COLOR 17,0:PRINT "BLINK & UNDERSCORE
190 COLOR 7,0:PRINT "HIGH INTENSITY BLINKING IS 26,0";:LOCATE ,50:COLOR 26,0:PRINT "HI-INTEN & BLINK
200 COLOR 7,0:PRINT "BLINK & UNDERSCORE & HI INTENSITY IS 25,0";:LOCATE ,50:COLOR 25,0:PRINT "BLINK & HI & UNDRSCR
210 COLOR 7,0
220 GOSUB 5000:GOSUB 6000:GOSUB 5000
300 CLS:LOCATE 1,25:COLOR 0,7:PRINT " A L T E R N A T I V E S ":COLOR 7,0:PRINT :PRINT "ALT + A = AUTO
310 PRINT "ALT + B = BSAVE
320 PRINT "ALT + C = COLOR
330 PRINT "ALT + D = DELETE
340 PRINT "ALT + E = ELSE
350 PRINT "ALT + F = FOR
360 PRINT "ALT + G = GOTO
370 PRINT "ALT + H = HEX$
380 PRINT "ALT + I = INPUT
390 PRINT "ALT + K = KEY
400 PRINT "ALT + L = LOCATE
410 PRINT "ALT + M = MOTOR
420 PRINT "ALT + N = NEXT
430 PRINT "ALT + O = OPEN
440 PRINT "ALT + P = PRINT
450 PRINT "ALT + R = RUN
460 PRINT "ALT + S = SCREEN
470 PRINT "ALT + T = THEN
480 PRINT "ALT + U = USING
490 PRINT "ALT + V = VAL
500 PRINT "ALT + W = WIDTH
510 PRINT "ALT + X = XOR";
520 LOCATE 3,40:PRINT "CTRL + G = BEL
530 LOCATE 5,40:PRINT "CTRL + Break = EXIT PROGRAM - EXIT AUTO
540 LOCATE 7,40:PRINT "Ctrl + Alt + Del = SYSTEM RESET
550 LOCATE 9,40:PRINT "Ctrl + Num Lock = PAUSE
555 LOCATE 10,58:PRINT "(any key to continue)
560 LOCATE 12,40:PRINT "Ctrl + Home = CLEAR SCREEN
570 LOCATE 14,40:PRINT "Ctrl + (CURSOR RIGHT) = NEXT WORD
580 LOCATE 16,40:PRINT "Ctrl + (CURSOR LEFT) = PREVIOUS WORD
590 LOCATE 18,40:PRINT "Ctrl + End = ERASE TO NEXT ENTER
595 GOSUB 5000
600 CLS:LOCATE 1,15:COLOR 0,7:PRINT " B A S I C : G E N E R A L S T A T E M E N T S ";:COLOR 7,0
610 PRINT:PRINT:PRINT"COMMON":LOCATE 3,15:PRINT"var list":LOCATE 3,30:PRINT"statement":LOCATE 3,52:PRINT"pass var to chained pgm
620 PRINT"DATA":LOCATE 4,15:PRINT"data list":LOCATE 4,30:PRINT"statement":LOCATE 4,52:PRINT"create data table
630 PRINT"DATE$":LOCATE 5,30:PRINT"function":LOCATE 5,52:PRINT"set system date
640 PRINT"DEF FN":LOCATE 6,15:PRINT"variable":LOCATE 6,30:PRINT"function":LOCATE 6,52:PRINT"define function
650 PRINT"DEF":LOCATE 7,15:PRINT"variable":LOCATE 7,30:PRINT"function":LOCATE 7,52:PRINT"define variable
660 PRINT"DIM":LOCATE 8,15:PRINT"var list":LOCATE 8,30:PRINT"statement":LOCATE 8,52:PRINT"allocate dimension space
670 PRINT"END":LOCATE 9,30:PRINT"statement":LOCATE 9,52:PRINT"return to command level
680 PRINT"ERASE":LOCATE 10,30:PRINT"statement":LOCATE 10,52:PRINT"eliminate arrays values
690 PRINT"ERROR":LOCATE 11,15:PRINT"number":LOCATE 11,30:PRINT"statement":LOCATE 11,52:PRINT"simulate error
700 PRINT"FOR X=A TO B":LOCATE 12,30:PRINT"statement":LOCATE 12,52:PRINT"program loop
710 PRINT"IF V THEN N ELSE M":LOCATE 13,30:PRINT"statement":LOCATE 13,52:PRINT"decision & transfer
720 PRINT"LET X=V":LOCATE 14,30:PRINT"statement":LOCATE 14,52:PRINT"evaluate expression
730 PRINT"NEXT":LOCATE 15,30:PRINT"statement":LOCATE 15,52:PRINT"terminates a for loop
740 PRINT"OPTION BASE":LOCATE 16,15:PRINT"(0 or 1)":LOCATE 16,30:PRINT"statement":LOCATE 16,52:PRINT"set minimum array subscript
750 PRINT"PEEK":LOCATE 17,30:PRINT"statement & function":LOCATE 17,52:PRINT"observe byte in memory
760 PRINT"POKE":LOCATE 18,30:PRINT"statement & function":LOCATE 18,52:PRINT"put byte in memory
770 PRINT"RANDOMIZE":LOCATE 19,15:PRINT"numeric":LOCATE 19,30:PRINT"statement":LOCATE 19,52:PRINT"generate random number
780 PRINT"RND":LOCATE 20,15:PRINT"(X)":LOCATE 20,30:PRINT"function":LOCATE 20,52:PRINT"random number generation
790 PRINT"READ":LOCATE 21,30:PRINT"statement":LOCATE 21,52:PRINT"read DATA statements
800 PRINT"REM":LOCATE 22,30:PRINT"statement":LOCATE 22,52:PRINT"listing remarks
810 PRINT"RESTORE":LOCATE 23,30:PRINT"statement":LOCATE 23,52:PRINT"reset data pointer
830 GOSUB 5000
850 CLS:PRINT"cont":LOCATE 1,15:COLOR 0,7:PRINT " B A S I C : G E N E R A L S T A T E M E N T S ";:COLOR 7,0
860 LOCATE 5,1:PRINT "STOP":LOCATE 5,30:PRINT"statement":LOCATE 5,50:PRINT"halt program execution
870 LOCATE 7,1:PRINT"SWAP":LOCATE 7,15:PRINT"numeric":LOCATE 7,30:PRINT"statement":LOCATE 7,50:PRINT"exchange values
880 LOCATE 9,1:PRINT"TIME$":LOCATE 9,15:PRINT"string":LOCATE 9,30:PRINT"function":LOCATE 9,50:PRINT"set system time
890 LOCATE 11,1:PRINT"WEND":LOCATE 11,30:PRINT"statement":LOCATE 11,50:PRINT"close while loop
900 LOCATE 13,1:PRINT"WHILE":LOCATE 13,15:PRINT"variable":LOCATE 13,30:PRINT"statement":LOCATE 13,50:PRINT"loop as long as true
950 GOSUB 5000
1000 CLS:LOCATE 1,15:COLOR 0,7:PRINT " B A S I C : C O N T R O L S T A T E M E N T S ";:COLOR 7,0
1010 PRINT:PRINT:PRINT"CALL":LOCATE 3,17:PRINT"(X,X,X)":LOCATE 3,30:PRINT"statement":LOCATE 3,50:PRINT"call M/L subroutine
1020 PRINT"CHAIN":LOCATE 4,17:PRINT"file spec.":LOCATE 4,30:PRINT"statement":LOCATE 4,50:PRINT"overlay programs
1030 PRINT"GOSUB":LOCATE 5,17:PRINT"line #":LOCATE 5,30:PRINT"statement":LOCATE 5,50:PRINT"call BASIC subroutine
1040 PRINT"GOTO":LOCATE 6,17:PRINT"line #":LOCATE 6,30:PRINT"statement":LOCATE 6,50:PRINT"transfer control
1050 PRINT"ON COM N GOSUB":LOCATE 7,17:PRINT"line #":LOCATE 7,30:PRINT"adv. statement":LOCATE 7,50:PRINT"communications trap
1060 PRINT"ON ERR GOSUB":LOCATE 8,17:PRINT"line #":LOCATE 8,30:PRINT"statement":LOCATE 8,50:PRINT"error trap
1070 PRINT"ON V GOTO":LOCATE 9,17:PRINT"line #":LOCATE 9,30:PRINT"statement":LOCATE 9,50:PRINT"conditional branch
1080 PRINT"ON KEY N GOSUB":LOCATE 10,17:PRINT"line #":LOCATE 10,30:PRINT"adv. statement":LOCATE 10,50:PRINT"function key trap
1090 PRINT"ON PEN GOSUB":LOCATE 11,17:PRINT"line #":LOCATE 11,30:PRINT"adv. statement":LOCATE 11,50:PRINT"trap off light pen
1100 PRINT"ON STRIG N GOSUB":LOCATE 12,17:PRINT"line #":LOCATE 12,30:PRINT"adv. statement":LOCATE 12,50:PRINT"trap off joystick
1110 PRINT"RESUME":LOCATE 13,17:PRINT"line #":LOCATE 13,30:PRINT"statement":LOCATE 13,50:PRINT"return from error trap
1120 PRINT"RETURN":LOCATE 14,30:PRINT"statement":LOCATE 14,50:PRINT"return from subroutine
1130 PRINT"USR":LOCATE 15,17:PRINT"var. list":LOCATE 15,30:PRINT"function":LOCATE 15,50:PRINT"call M/L subroutine
1140 PRINT"VARPTR":LOCATE 16,17:PRINT"numeric":LOCATE 16,30:PRINT"function":LOCATE 16,50:PRINT"gives address of variable
1150 GOSUB 5000
1200 CLS:LOCATE 1,17:COLOR 0,7:PRINT " B A S I C : F I L E S T A T E M E N T S ";:COLOR 7,0
1210 PRINT:PRINT:PRINT"CLOSE","numeric",,"statement","close file
1220 PRINT:PRINT"EOF","numeric",,"function","end of file condition
1230 PRINT:PRINT"ERL",,,"function","error line number
1240 PRINT:PRINT"ERR",,,"function","error number code
1250 PRINT:PRINT"FIELD","function: N AS X$","statement","format a buffer
1260 PRINT:PRINT"GET",,,"function","read rand. file record
1270 PRINT:PRINT"LSET","x$ = y$",,"func & stmnt","left justify a field
1280 PRINT:PRINT"OPEN","FS for md as fl#","statement","open file
1290 PRINT:PRINT"PUT",,,"statement","write from rand file rec
1300 PRINT"RSET","x$ = y$",,"func & stmnt","right justify a field
1350 GOSUB 5000
1400 CLS:LOCATE 1,17:COLOR 0,7:PRINT " B A S I C : I / O S T A T E M E N T S ";:COLOR 7,0
1410 PRINT:PRINT:PRINT"BEEP",,"statement","beep speaker (bel)
1420 PRINT"COM N","on/off/stop","statement","on/off comm trap
1430 PRINT"KEY","on/off","statement","function keys display
1440 PRINT"KEY","n,x$","statement","set function key
1450 PRINT"KEY","on/off/stop","statement","on/off function key trap
1460 PRINT"LOC","numeric","function","file pointer position
1470 PRINT"LOF","numeric","function","# of 128 byte blocks in file
1480 PRINT"LPOS","numeric","function","printer carrage position
1490 PRINT"MOTOR","numeric","statement","cassette motor switch
1500 PRINT"OPEN COM","n:parms","statement","open communications file
1510 PRINT"OUT","port,byte","statement","output byte to port
1520 PRINT"PEN","numeric","function","read light pen
1530 PRINT"PEN","on/off/stop","statement","on/off light pen trap
1540 PRINT"SOUND","f:duration","statement","generate speaker sound
1550 PRINT"STICK","(n)","function","joystick coordinates
1560 PRINT"STRIG","(n)","function","state of joystick button
1570 PRINT"WAIT","port/mask","function","suspend port until mask
1580 GOSUB 5000
1600 CLS:LOCATE 1,17:COLOR 0,7:PRINT " B A S I C : K E Y B O A R D & S C R E E N ";:COLOR 7,0
1610 PRINT:PRINT:PRINT"CIRCLE","(x,y),z","statement","draw circle on screen
1620 PRINT"CLS",,"statement","clear screen
1630 PRINT"COLOR","x,y","statement","set screen colors
1640 PRINT"DRAW","x$","statement","draw figure in string
1650 PRINT"GET","(x1,y1)-(x2,y2) statement","read graphics from screen
1660 PRINT"INPUT","x$","statement","read from keyboard
1670 PRINT"LINE","(x1,y1)-(x2,y2) statement","draw line on display
1680 PRINT"LINE INPUT","x$","statement","read entire line from keyboard
1690 PRINT"LOCATE","n,m","statement","position cursor row & column
1700 PRINT"LPRINT","vl","statement","output to printer
1710 PRINT"LPRINT USING","vl","statement","formatted output to printer
1720 PRINT"PAINT","(n,m)x1,x2","statement","color an area on display
1730 PRINT"PRINT","vl","statement","display data on screen
1740 PRINT"PRESET","(n,m) x","statement","display color point background
1750 PRINT"PSET","(n,m) x","statement","display color point
1760 PRINT"PUT","(x1,y1)-(x2,y2) statement","put graphics to screen
1770 PRINT"SCREEN","m,n,pg1,pg2","statement","set screen paramenters
1780 PRINT"WRITE","vl","statement","display to screen
1790 GOSUB 5000
1800 CLS:LOCATE 1,17:COLOR 0,7:PRINT " B A S I C : S T R I N G F U N C T I O N S ";:COLOR 7,0
1810 PRINT:PRINT:PRINT:PRINT:PRINT"ASC","(x$)","function","ASCII code for 1st character
1820 PRINT"CVI$/CVS$/CVD$ (x$)","function","convert value to ASCII
1830 PRINT"CHR$","(x$)","function","character with ASCII code
1840 PRINT"HEX$","x","function","convert to ASCII hex string
1850 PRINT"INSTR","(N,X$,Y$)","statement","compare string & give position
1860 PRINT"LEFT$","(x$,n)","function","left most n characters
1870 PRINT"MID$","(x$,m,n,)","function","n characters in x$ starting at m
1880 PRINT"MKI$/MKS$/MKD$ (x)","function","convert ASCII to value
1890 PRINT"OCT$","(n)","function","convert to octal string
1900 PRINT"RIGHT$","(x$,n)","function","right most n characters
1910 PRINT"SPACE$","(n)","function","string of n spaces
1920 PRINT"STR$","(x)","function","convert to string
1930 PRINT"STRING$","(n,x$)","function","repeat 1st character
1940 GOSUB 5000
2000 CLS:LOCATE 1,17:COLOR 0,7:PRINT " B A S I C : M A T H F U N C T I O N S ";:COLOR 7,0
2010 PRINT:PRINT:PRINT:PRINT"ABS","(x)","function","absolute value
2020 PRINT"ATN","(x)","function","arctangent (radians)
2030 PRINT"COBL","(x)","function","convert to double precision
2040 PRINT"CINT","(x)","function","convert to integer
2050 PRINT"COS","(x)","function","cosine (radians)
2060 PRINT"CSGN","(x)","function","convert to single precision
2070 PRINT"EXP","(x)","function","exponential base e
2080 PRINT"FIX","(x)","function","truncate to integer
2090 PRINT"INT","(x)","function","convert to integer
2100 PRINT"LOG","(x)","function","natural logarithm
2110 PRINT"RND","(x)","function","random number generator
2120 PRINT"SGN","(x)","function","sign of number
2130 PRINT"SQR","(x)","function","square root of number
2140 PRINT"TAN","(x)","function","tangent (radians)
2150 GOSUB 5000
2200 CLS:LOCATE 1,17:COLOR 0,7:PRINT " B A S I C : C O M M A N D S ";:COLOR 7,0
2210 PRINT:PRINT"AUTO","(n,m)","generate automatic line numbers
2220 PRINT"BLOAD","filespec","load binary data file
2230 PRINT"BSAVE","filespec","save binary data file
2240 PRINT"CLEAR",",x,y","clear variables & set memory
2250 PRINT"CONT",,"continue program execution
2260 PRINT"DELETE","n-m","delete lines
2270 PRINT"EDIT","n","display & edit a line
2280 PRINT"FILES","filespec","list files that match
2290 PRINT"KILL","filespec","delete files
2300 PRINT"LIST","n-m","display program lines
2310 PRINT"LLIST","n-m","print program lines
2320 PRINT"LOAD","filespec","load file
2330 PRINT"MERGE","filespec","overlay program from file
2340 PRINT"NAME","fs as fs","rename file
2350 PRINT"NEW",,"delete current program from memory
2360 PRINT"RENUM","i,j,k","renumber lines
2370 PRINT"RESET",,"close all files
2380 PRINT"RUN",,"execute program in memory
2390 PRINT"SAVE","filespec","dump program to disk file
2400 PRINT"SYSTEM",,"end basic & return to DOS
2410 PRINT"TRON",,"turn trace on
2420 PRINT"TROFF",,"turn trace off
2450 GOSUB 5000
2500 CLS:LOCATE 1,19:COLOR 0,7:PRINT " D O S : C O M M A N D S ";:COLOR 7,0
2510 PRINT:PRINT:PRINT"BATCH","(d:) fn param",,"execute batch file
2520 PRINT"CHKDSK","(d:)",,"display disk status
2530 PRINT"COMP","(fs)(d:)fn(ext)","compare files
2540 PRINT"COPY","(fs)(d:)fn(ext)","copy files
2550 PRINT"DATE","mm/dd/yy",,"enter system date
2560 PRINT"DIR","(d:)fn(ext)",,"display disk directory
2570 PRINT"DISKCOMP","(d:)(d:)",,"compare disks
2580 PRINT"DISKCOPY","(d:)(d:)",,"copy disks
2590 PRINT"ERASE","filespec",,"delete file
2600 PRINT"FORMAT","(d:)(/s)",,"format disk
2610 PRINT"MODE","(dev)(,n)(,m)(,t)","set mode for printer & display
2620 PRINT"PAUSE","(rem)",,"system pause
2630 PRINT"REM","(rem)",,"display remarks
2640 PRINT"RENAME","fs fn (ext)",,"rename file
2650 PRINT"SYS",,,"transfer DOS
2660 PRINT"TIME","hr:min:sec.ms",,"enter system time
2670 PRINT"TYPE","filespec",,"display file
2680 PRINT"EDLIN","filespec",,"execute editor
2690 PRINT"LINK",,,"execute linker
2700 PRINT"DEBUG","filespec",,"ececute debug program
2710 GOSUB 5000
2800 CLS:LOCATE 1,19:COLOR 0,7:PRINT " D E B U G : C O M M A N D S ";:COLOR 7,0
2810 PRINT:PRINT:PRINT:PRINT"D(ADR)",,"display address
2820 PRINT"D(RNG)",,"display range of address
2830 PRINT"A ADR(LIST)",,"alter memory
2840 PRINT"F RNG LIST",,"fill range with list
2850 PRINT"G (ADR) (ADR)",,"execute until break point
2860 PRINT"H VAL VAL",,"hex arithmetic
2870 PRINT"I PORT",,"input & display byte
2880 PRINT"L(ADR)(D SECT SECT)","load file or disk sectors
2890 PRINT"M RNG ADR",,"move memory block
2900 PRINT"N FS(FS)",,"define files
2910 PRINT"O PORT BYTE",,"output byte to port
2920 PRINT"Q",,"quit debug program
2930 PRINT"R(REG)",,"display registers & flags
2940 PRINT"S RNG LIST",,"search for characters
2950 PRINT"T(=ADR)(VALUE)","execute instr. & display register
2960 PRINT"U ADR",,"disassemble addresss
2970 PRINT"U RNG",,"disassemble range
2980 PRINT"W(ADR)(D SECT SECT)","write file of disk sector
2990 GOSUB 5000
3000 CLS:LOCATE 1,19:COLOR 0,7:PRINT " E D L I N : C O M M A N D S ";:COLOR 7,0
3010 PRINT:PRINT:PRINT"(N)",:COLOR 0,7:PRINT"A";:COLOR 7,0:PRINT,":append lines
3020 PRINT:PRINT"(LN)(,LN)",:COLOR 0,7:PRINT"D";:COLOR 7,0:PRINT,":delete lines (begin ,end)
3030 PRINT:PRINT,:COLOR 0,7:PRINT"(LN)";:COLOR 7,0:PRINT,":edit line
3040 PRINT:PRINT,:COLOR 0,7:PRINT"E";:COLOR 7,0:PRINT,":end edit (save BAK)
3050 PRINT:PRINT"(LN)",:COLOR 0,7:PRINT"I";:COLOR 7,0:PRINT,":insert line
3060 PRINT:PRINT"(LN)(,LN)",:COLOR 0,7:PRINT"L";:COLOR 7,0:PRINT,":list lines (begin ,end)
3070 PRINT:PRINT,:COLOR 0,7:PRINT"Q";:COLOR 7,0:PRINT,":quit - abort edit
3080 PRINT:PRINT"(LN)(,LN)(?)",:COLOR 0,7:PRINT"R STR F6 STR";:COLOR 7,0:PRINT,":replace text (preceeded with [begin][,end][?]
3090 PRINT:PRINT"(LN)(,LN)(?)",:COLOR 0,7:PRINT"S STR";:COLOR 7,0:PRINT,":search text (preceeded with [begin][,end][?]
3100 PRINT:PRINT"(N)",:COLOR 0,7:PRINT"W";:COLOR 7,0:PRINT,":write lines to disk
3110 GOSUB 5000
3200 CLS:LOCATE ,10:COLOR 0,7:PRINT" E A S Y W R I T E R E M B E D D E D C O M M A N D S ";:COLOR 7,0:PRINT
3210 PRINT:PRINT:PRINT:PRINT".EJECT",,"Page eject
3220 PRINT".EJECTnn",,"Eject page within nn lines from the bottom
3230 PRINT".EOL",,"Programmable end of line character
3240 PRINT".FORMSTOP",,"Stops printer at page breaks
3250 PRINT".FORMSTOPOFF",,"Turns off .FORMSTOP
3260 PRINT".LINESnn",,"Number of printed lines per page
3270 PRINT".MARGINn",,"Sets the left margin
3280 PRINT".PAGErr,cc",,"Page numbering. rr = row, cc = column
3290 PRINT".PAGELINESnn",,"Page length. nn = number of lines per page
3300 PRINT".SPACEn",,"Sets additional spaces between lines
3310 PRINT".TITLEA,nn,text","Sets headers & footers
3320 PRINT".TITLEB,nn,text","Up to 3 titles per page
3330 PRINT".TITLEC,nn,text",,"
3340 PRINT".TOPn",,"Sets number of spaces at top of page
3350 PRINT".USER",,"User defined command
3360 GOSUB 5000
3400 CLS:LOCATE ,25:COLOR 0,7:PRINT" P R I N T I N G M O D E S ";:COLOR 7,0:PRINT
3410 LOCATE 8,1:PRINT"COMPRESSED ON",,"CTRL O - CTRL O
3420 PRINT"COMPRESSED OFF","CTRL O - CTRL R
3430 PRINT:PRINT"DOUBLE STRIKE ON","CTRL O - ESC G
3440 PRINT"DOUBLE STRIKE OFF","CTRL O - ESC H
3450 PRINT:PRINT"DOUBLE WIDTH ON","CTRL O - CTRL N
3460 PRINT"DOUBLE WIDTH OFF","CTRL O - CTRL T
3470 PRINT:PRINT"EMPHASIZED ON",,"CTRL O - ESC E
3480 PRINT"EMPHASIZED OFF","CTRL O - ESC F
3490 GOSUB 5000
4090 GOTO 9990
5000 KEY OFF:PN=PN+1:LOCATE 1,72:PRINT"page"PN:LOCATE 25,65:COLOR 18,0:PRINT "PRESS ANY KEY";:COLOR 7,0
5010 A$=INKEY$:IF A$<>"" THEN 5010
5020 A$=INKEY$:IF A$="" THEN 5020
5030 IF A$=CHR$(27) THEN 9990 ELSE CLS:RETURN
6000 CLS:X=0:COLOR ,0
6010 FOR I=0 TO 31
6020 IF X=0 THEN COLOR I:PRINT"COLOR"I",0";:X=1:GOTO 6040
6030 IF X THEN PRINT TAB(40);:COLOR I:PRINT"COLOR"I",0":X=0
6040 NEXT:COLOR 7,0:GOSUB 5000
6050 CLS:X=0:COLOR ,7
6060 FOR I=0 TO 31
6070 IF X=0 THEN COLOR I:PRINT"COLOR"I",7";:X=1:GOTO 6090
6080 IF X THEN PRINT TAB(40);:COLOR I:PRINT"COLOR"I",7":X=0
6090 NEXT:COLOR 7,0:RETURN
9990 IF MUSIC=FALSE THEN 9997
9995 S$="O3L8GD16D-16D16D+DP4L8F+.L8G.":PLAY "XS$;"
9997 CLS:COLOR 7,0:KEY ON:END
10000 SAVE"B:PROGRAM1
10010 GOTO 9997
HIDEFILE.BAS
100 REM ********************************************************************
110 REM * HideFile by John Vandegrift *
280 REM * *
290 REM * Limitations: If the diskette is double-sided, then this reads *
300 REM * the first 64 directory entries. The diskette in *
310 REM * drive A is the diskette to be read, although *
320 REM * provision is made for reading drive B if the user *
330 REM * wants to add the user i/o for the drive. The *
340 REM * user must have 64k memory and 1 disk drive, *
350 REM * minimum configuration. *
360 REM ********************************************************************
370 ' MODIFICATON BY: Stephen Leoce
380 ' 201 Delaware Avenue
390 ' Kingston, New York 12401
400 ' [914] 338-4593 (none collect please)
410 '
420 ' MODIFICATIONS PERFORMED: 28-DECEMBER-1983
430 '
440 CLS
470 CLEAR ,&H4000:KEY OFF
480 DEF SEG=0
500 REM Assembler Routine
510 REM
520 REM This routine pokes a machine language subroutine into high memory.
530 REM This subroutine reads and writes the diskette directory and FAT
540 REM from/to the diskette to/from upper memory.
550 REM The diskette buffer area starts at &hcc00 and is 3072 bytes.
560 REM The subroutine is loaded at &hE000 and is 36 bytes.
570 REM
580 DATA &h55,&h06,&hb8,&h00,&h00
590 DATA &h8e,&hc0,&h8b,&hec,&h8b
600 DATA &h76,&h0a,&h8b,&h04,&h8a
610 DATA &he0,&hb0,&h06,&hbb,&h00
620 DATA &hcc,&hb9,&h02,&h00,&h8b
630 DATA &h76,&h08,&h8b,&h14,&hcd
640 DATA &h13,&h07,&h5d,&hca,&h04
650 DATA &h00
660 FOR I=1 TO 36:READ J:SUM=SUM+J:NEXT I
670 IF SUM<>3470 THEN CLS:PRINT "Sum = ";SUM;". Data Error!":STOP
680 RESTORE
690 FOR I=0 TO 35:READ J:POKE &HE000+I,J:NEXT I
700 SUBRT=&HE000
710 REM
720 REM Call the routine to read FAT and Directory from diskette
730 REM and check for single-sided format.
740 LOCATE 3,1:INPUT"?: SELECT WHICH DRIVE [A]: ===> ",DRIVE$
750 IF DRIVE$="A" OR DRIVE$="a" THEN B%=0
760 IF DRIVE$="C" OR DRIVE$="c" THEN LOCATE 5,1:PRINT "WARNING: DRIVE 'C' CANNOT BE SELECTED":GOTO 740:LOCATE 3,POS(O)-1:PRINT" ";
770 IF DRIVE$="" THEN B%=0
780 IF DRIVE$ = "B" OR DRIVE$ ="b" THEN PRINT "DRIVE [B] CURRENTLY SELECTED";
790 IF DRIVE$="B" OR DRIVE$="b" THEN B%=1
800 IF DRIVE$<>"a" AND DRIVE$<>"b" THEN IF DRIVE$<>"A" AND DRIVE$<>"B" THEN PRINT "DRIVE [A] SELECTED BY DEFAULT":B%=0
801 REM IF YOU USE DOUBLE SIDED DISK DRIVES DO THE FOLLOWING:
802 REM CHANGE LINE 803 TO READ: ' 803 NOSIDES=2 '
803 REM CHANGE LINE 1280 TO READ: ' 1280 FOR I=0 TO 2016 STEP 32 '
804 NOSIDES=1
805 CHANGE$="NO"
810 A%=2 '2 for read or 3 for write
820 REM B%=0 '0 for drive A or 1 for drive B
830 CALL SUBRT (A%, B%)
850 REM
860 REM Master Menu
870 REM
880 REM The user may want to follow the options in order of occurance,
890 REM first reading the directory, then altering it and finally
900 REM writing it back to the diskette.
910 REM
920 GOSUB 2930
930 CLS:LOCATE 2,37:PRINT "HideFile"
940 LOCATE 23,30:IF NOSIDES=1 THEN PRINT "Single-sided diskette":GOTO 960
950 PRINT "Double-sided diskette"
960 LOCATE 10,30:PRINT "1. Display Directory"
961 LOCATE 25,1:PRINT SPACE$(75);
970 LOCATE 11,30:PRINT "2. Modify Directory"
980 LOCATE 12,30:PRINT "3. Update Diskette"
990 LOCATE 13,30:PRINT "4. Help"
1000 LOCATE 14,30:PRINT "5. Exit"
1010 LOCATE 16,30:INPUT "?: SELECT ===> ",IANS
1020 ON IANS GOSUB 1170,1540,1060,3020,2770
1030 IF IANS=5 THEN GOTO 2770
1040 GOTO 930
1050 REM
1060 REM Put Directory on diskette
1070 REM
1080 REM This routine takes the diskette directory and FAT images
1090 REM in upper memory and writes them to the diskette. Here
1100 REM drive A is assumed, just as it is when data is read from
1110 REM the diskette.
1120 REM
1121 IF CHANGE$="NO" THEN LOCATE 25,1:BEEP:PRINT "NO CHANGES -- STRIKE ANY KEY"
1122 Q$=INKEY$:IF LEN(Q$)=0 THEN 1122 ELSE LOCATE 25,1:PRINT SPACE$(75);:RETURN
1130 A%=3:B%=0
1140 CALL SUBRT (A%, B%)
1141 CHANGE$="NO"
1150 RETURN
1160 REM
1170 REM Display Files Routine
1180 REM
1190 REM This is a simple directory function that reads the directory
1200 REM information from upper memory and displays to the user. The
1210 REM user can use this to look at all of the directory entries.
1220 REM It will show what type of file is there, whether it has been
1230 REM deleted, or if the entry has never been used.
1240 REM
1250 CLS
1260 LOCATE 1,12:PRINT " LABEL ";TAB(25);"STATUS";TAB(40);"LAST SAVE";TAB(57);"BYTES USED";:PRINT
1270 LOCATE 3,1:
1280 FOR I=1024 TO 2016 STEP 32
1290 IF PEEK(I+&HD000)=&HE5 AND PEEK(I+&HD001)=246 THEN 1490
1300 IF PEEK(I+&HD000)=&HE5 THEN DEL$="DESTROYED" ELSE DEL$=""
1310 LOCATE ,10
1320 FOR J=0 TO 7:PRINT CHR$(PEEK(J+I+&HD000));:NEXT J
1330 PRINT ".";
1340 FOR J=8 TO 10:PRINT CHR$(PEEK(J+I+&HD000));:NEXT J
1350 A=PEEK(I+&HD00B)
1360 IF A=0 THEN LOCATE , 25:PRINT" USER";
1361 IF A=1 THEN LOCATE , 25:PRINT " READ ONLY";
1370 IF A=2 THEN LOCATE , 25:PRINT" HIDDEN";
1380 IF A=4 THEN LOCATE , 25:PRINT" SYSTEM";
1390 IF A=6 THEN LOCATE , 25:PRINT " HIDDEN/SYS";
1391 IF A=8 THEN LOCATE ,25:PRINT " VOL LABEL";
1392 IF A=10 THEN LOCATE ,25:PRINT" DIRECTORY"
1400 MONTH$ = STR$((PEEK(I+&HD019) AND 1)*8 + ((PEEK(I+&HD018) AND 224)/32))
1410 IF LEN(MONTH$)>2 THEN MONTH$=RIGHT$(MONTH$,2)
1420 DAY$ = STR$(PEEK(I+&HD018) AND 31):IF LEN(DAY$)>2 THEN DAY$=RIGHT$(DAY$,2)
1430 YEAR$ = RIGHT$(STR$((INT(PEEK(I+&HD019)/2))+1980),4)
1440 THEDATE$=MONTH$+"/"+DAY$+"/"+YEAR$
1450 SIZE=PEEK(I+&HD01C)+(PEEK(I+&HD01D)*256)+(PEEK(I+&HD01E)*65536!)
1460 PRINT " ";DEL$;" ";TAB(40);THEDATE$;TAB(57);USING"#######";SIZE
1470 IF ((I/32)+1) MOD 20 = 0 THEN GOSUB 1490
1480 NEXT I
1490 LOCATE 23,28:INPUT "Press return to continue",IANS
1500 CLS:LOCATE 1,12:PRINT " LABEL ";TAB(25);"ACCESS";TAB(40);"LAST SAVE";TAB(57);"BYTES USED";
1510 LOCATE 3,1
1520 RETURN
1530 REM
1540 REM Alter Directory Entries Routine
1541 CHANGE$="YES"
1550 REM
1560 REM Allows the user to page through the entries of the diskette
1570 REM directory. The user can change the file attribute from
1580 REM Normal, Hidden, System, or Hidden/System to any of the same.
1590 REM The user can also undelete deleted files.
1600 REM This function does not save these changes to diskette!
1610 REM
1620 I=1024
1630 CLS
1640 TITLE$=""
1650 LOCATE 2,30:PRINT "Directory Entry ";I/32+1-32
1660 IF I/32+1-32 <=0 THEN LOCATE 25,1:PRINT "ATTEMPTED BACKUP PAST FAT -- DENIED";:I=1024:LOCATE 24,1:PRINT "STRIKE ANY KEY. . ."; ELSE 1700
1670 A$=INKEY$:IF LEN(A$)=0 THEN 1670
1680 LOCATE 24,1:PRINT SPACE$(80);:LOCATE 25,1:PRINT SPACE$(80);
1690 IF I=2016 THEN LOCATE 25,1:COLOR 15:PRINT "*EOF":COLOR 7:
1700 LOCATE 2,30:PRINT "Directory Entry ";I/32+1-32
1710 IF PEEK(I+&HD000)=&HE5 THEN IF PEEK(I+&HD001)=246 THEN TITLE$="<UNUSED>":DEL$="":GOTO 1750 ELSE DEL$="DESTROYED" ELSE DEL$=""
1720 FOR J=0 TO 7:TITLE$=TITLE$+CHR$(PEEK(J+I+&HD000)):NEXT J
1730 TITLE$=TITLE$+"."
1740 FOR J=8 TO 10:TITLE$=TITLE$+CHR$(PEEK(J+I+&HD000)):NEXT J
1750 LOCATE 10,20:COLOR 15:PRINT TITLE$;:COLOR 7
1760 A=PEEK(I+&HD00B)
1770 IF A=0 THEN PRINT " FILE SET TO NORMAL";
1780 IF A=2 THEN PRINT " FILE SET TO HIDDEN";
1790 IF A=4 THEN PRINT " FILE SET TO SYSTEM";
1800 IF A=6 THEN PRINT " FILE SET TO HIDDEN/SYSTEM";
1810 PRINT " "+DEL$
1820 LOCATE 23,10:PRINT "(D)elete SWITCH (F)ile SWITCH e(X)it ";CHR$(27);" MOVE ";CHR$(26);
1830 A$=INKEY$:IF A$="" THEN 1830
1840 IF A$="X" OR A$="x" THEN RETURN
1850 IF A$="f" OR A$="F" THEN GOSUB 1910:POKE (I+&HD00B),ATTRIBUTE
1860 IF A$="d" OR A$="D" THEN GOSUB 2060:POKE (I+&HD000),LETTER1
1870 IF LEN(A$)=2 THEN A$=RIGHT$(A$,1)
1880 IF A$=CHR$(75) THEN IF I>31 THEN I=I-32
1890 IF A$=CHR$(77) THEN IF I<1985 THEN I=I+32
1900 GOTO 1630
1910 REM Get New File Attribute
1920 LOCATE 23,10:PRINT STRING$(65,32)
1930 LOCATE 14,30:PRINT "File Attribute:"
1940 LOCATE 16,30:PRINT "1. Normal file"
1950 LOCATE 17,30:PRINT "2. Hidden file"
1960 LOCATE 18,30:PRINT "3. System file"
1970 LOCATE 19,30:PRINT "4. Hidden/System file"
1980 LOCATE 20,30:PRINT "5. Exit"
1990 LOCATE 22,30:INPUT "?: CHANGE ===> ",IANS:CHANGE$="YES"
2000 IF IANS=5 THEN ATTRIBUTE=PEEK(I+&HD00B):GOTO 2030
2010 IF IANS<1 OR IANS>4 THEN LOCATE 20,35:PRINT STRING$(30,32):GOTO 1910
2020 ATTRIBUTE=(IANS-1)*2
2030 FOR K=14 TO 22:LOCATE K,30:PRINT STRING$(45,32):NEXT K
2040 RETURN
2050 REM
2060 REM Undelete File
2070 REM
2080 REM This routine allows the user to undelete a deleted file.
2090 REM The size of the file is obtained from the directory and the
2100 REM necessary number of sectors are checked following the first
2110 REM sector of the file. If none of the sectors following the
2120 REM the first sector are allocated, the program assumes those
2130 REM are the sectors belonging to the deleted program. Otherwise,
2140 REM it will not undelete the file!
2150 REM
2160 LOCATE 23,10:PRINT STRING$(65,32)
2170 LETTER1=PEEK(I+&HD000):IF LETTER1=&HE5 THEN 2200
2180 LOCATE 15,25:INPUT "*FILE NOT DESTROYED. Press return";IANS$
2190 LOCATE 15,25:PRINT STRING$(53,32):RETURN
2200 SIZE=PEEK(I+&HD01C)+(PEEK(I+&HD01D)*256)+(PEEK(I+&HD01E)*65536!)
2210 SECTORS=INT((SIZE-1)/512)+1
2220 LOCATE 20,21:PRINT "LOF=";SIZE;" BYTES ";SECTORS;"SECTOR(S)"
2230 CLUSTER = PEEK(I+&HD01A)+PEEK(I+&HD01B)*256
2240 LOCATE 21,21:PRINT "START CLUSTER=";CLUSTER
2250 GOSUB 2400
2260 IF FLAG$="yes" THEN 2270 ELSE PRINT "SECTOR(S) ALLOCATED AFTER CLUSTER ";CLUSTER;:COLOR 15 :PRINT " ** LOST Press return.";:INPUT"",IANS:COLOR 7:GOTO 2370
2270 LOCATE 15,25:INPUT "?: RESTORE THIS FILE ===> ",IANS$
2280 IF LEFT$(IANS$,1)="Y" OR LEFT$(IANS$,1)="y" THEN 2290
2281 IF LEFT$(IANS$,1)="N" OR LEFT$(IANS$,1)="n" THEN RETURN
2283 LOCATE 15,54:PRINT SPACE$(10);:GOTO 2270
2290 LOCATE 16,23:INPUT "?: FIRST LETTER FOR LABEL ===> ",IANS$
2300 LETTER1=ASC(IANS$)
2310 IF LETTER1<123 AND LETTER1>96 THEN LETTER1=LETTER1-31
2320 IF LETTER1<65 OR LETTER1>90 THEN 2270
2330 GOSUB 2560
2340 LOCATE 25,1:PRINT"FILE RESTORED. PLEASE EXAMINE FILE -- STRIKE ANY KEY";
2350 A$=INKEY$:IF LEN(A$)=0 THEN 2350
2360 LOCATE 25,1:PRINT SPACE$(80);
2370 LOCATE 15,25:PRINT STRING$(53,32)
2380 LOCATE 16,25:PRINT STRING$(53,32):RETURN
2390 REM
2400 REM Cluster's Last Stand(checks clusters)
2410 REM
2420 REM This is the routine that checks the needed number of sectors
2430 REM immediatly following the first sector of the file being
2440 REM undeleted! FLAG$ contains the indicator as to the outcome
2450 REM of the check.
2460 REM
2470 IF NOSIDES=1 THEN RANGE=SECTORS ELSE RANGE=INT((SECTORS+1)/2)
2480 FOR INC=1 TO RANGE
2490 TEMP=INT((CLUSTER+INC-1)*1.5)
2500 IF CLUSTER MOD 2 = 1 THEN NEWCLUS=((PEEK(&HCC00+TEMP) AND 240)/16)+PEEK(&HCC00+TEMP+1)*256 ELSE NEWCLUS=PEEK(&HCC00+TEMP)+((PEEK(&HCC00+TEMP+1) AND 15)*256)
2510 IF NEWCLUS<>0 THEN FLAG$="no":GOTO 2540
2520 NEXT INC
2530 FLAG$="yes"
2540 RETURN
2550 REM
2560 REM Cluster's Last Stand(updates clusters)
2570 REM
2580 REM This routine reallocates the sectors following the first sector.
2590 REM Appendix C of the DOS Manual gives the technique for accessing
2600 REM this information.
2610 REM
2620 IF NOSIDES=1 THEN RANGE=SECTORS-1 ELSE RANGE=INT((SECTORS+1)/2)-1
2630 FOR INC=1 TO RANGE
2640 TEMP=INT((CLUSTER+INC-1)*1.5)
2650 IF (CLUSTER+INC-1) MOD 2 = 1 THEN BYTE1=(PEEK(&HCC00+TEMP) AND 15) + (((CLUSTER + INC) AND 15)*16):BYTE2=INT((CLUSTER+INC)/16):GOTO 2670
2660 BYTE1=(CLUSTER+INC) AND 255:BYTE2=(PEEK(&HCC00+TEMP+1) AND 240) + INT((CLUSTER+INC)/256)
2670 POKE (&HCC00+TEMP),BYTE1:POKE (&HCE00+TEMP),BYTE1
2680 POKE (&HCC00+TEMP+1),BYTE2:POKE (&HCE00+TEMP+1),BYTE2
2690 NEXT INC
2700 REM poke end of file
2710 TEMP=INT((CLUSTER+RANGE)*1.5)
2720 IF (CLUSTER+RANGE) MOD 2 = 1 THEN BYTE1=(PEEK(&HCC00+TEMP) AND 15) + 240:BYTE2=255:GOTO 2740
2730 BYTE1=255:BYTE2=(PEEK(&HCC00+TEMP+1) AND 240) + 15
2740 POKE (&HCC00+TEMP),BYTE1:POKE (&HCE00+TEMP),BYTE1
2750 POKE (&HCC00+TEMP+1),BYTE2:POKE (&HCE00+TEMP+1),BYTE2
2760 RETURN
2770 REM
2780 REM Ending Routine
2790 REM
2800 CLS
2801 IF CHANGE$="YES" THEN LOCATE 25,1:BEEP:LINE INPUT"?: DISK MODIFICATIONS NOT SAVED. QUIT ANYWAY ===> ";REPLY$
2802 IF LEFT$(REPLY$,1)="N" OR LEFT$(REPLY$,1)="n" THEN 960
2803 IF LEFT$(REPLY$,1)="Y" OR LEFT$(REPLY$,1)="y" THEN LOCATE 25,1:PRINT SPACE$(75);:SYSTEM ELSE GOTO 2801
2920 RETURN
2930 REM
2940 REM Move Header back to top
2950 REM
2960 FOR I=14 TO 13 STEP -1:LOCATE I,33:PRINT SPACE$(15);:NEXT I
2970 A$="HideFile":FOR I=12 TO 3 STEP -1
2980 LOCATE I-1,37:PRINT A$;
2990 LOCATE I,37:PRINT SPACE$(8);
3000 NEXT I
3010 RETURN
3020 REM
3030 REM Help Routine
3040 REM
3050 CLS:LOCATE 4,10:PRINT "(1) File Directory lists the directory of the diskette."
3060 LOCATE 7,10:PRINT "(2) Alter Directory allows the user to change directory attributes."
3070 LOCATE 10,10:PRINT "(3) Save Changes is the only way to write changes (2) to the diskette."
3080 LOCATE 13,10:PRINT "(4) EXIT ALLOWS THE USER TO EXIT THE PROGRAM."
3090 LOCATE 19,10:INPUT "Press return to continue....",IANS
3100 RETURN
3110 '** DONE - PRESS ENTER TO RETURN TO MENU **
KEYMOVE.BAS
10 DEF SEG:POKE 92,25:KEY OFF:CLS:LOCATE 1,1,1
20 PRINT "Use this program to change your keys to Dvorak."
30 PRINT " To pop the keys, it may work best to use something to pry them."
40 PRINT
50 PRINT "Pop out the ";
60 COLOR 15,8:PRINT"-";:COLOR 7,0
70 PRINT " key and put it in a safe place.":GOSUB 460
80 DATA "=","[","/","z",";","s","o","r","p","l","n","b","x","q","'"
90 FOR I=1 TO 15
100 READ X$
110 PRINT "Pop out the ";
120 COLOR 15,8:PRINT X$;
130 COLOR 7,0
140 PRINT " key and put it in the hole."
150 GOSUB 460
160 NEXT I
170 PRINT "Put the ";
180 COLOR 15,8:PRINT"-";:COLOR 7,0
190 PRINT " key in the hole.":GOSUB 460
200 PRINT "Pop out the ";
210 COLOR 15,8:PRINT"c";:COLOR 7,0
220 PRINT " key and put it in a safe place.":GOSUB 460
230 DATA "j","h","d","e",".","v","k","t","y","f","u","g","i"
240 FOR I=1 TO 13
250 READ X$
260 PRINT "Pop out the ";
270 COLOR 15,8:PRINT X$;
280 COLOR 7,0
290 PRINT " key and put it in the hole."
300 GOSUB 460
310 NEXT I
320 PRINT "Put the ";
330 COLOR 15,8:PRINT"c";:COLOR 7,0
340 PRINT " key in the hole.":GOSUB 460
350 PRINT "Pop out the ";
360 COLOR 15,8:PRINT"w";:COLOR 7,0
370 PRINT " key.":GOSUB 460
380 PRINT "Pop out the ";
390 COLOR 15,8:PRINT",";:COLOR 7,0
400 PRINT " key and put it in the hole.":GOSUB 460
410 PRINT "Put the ";
420 COLOR 15,8:PRINT"w";:COLOR 7,0
430 PRINT " key in the hole.":GOSUB 460
440 PRINT "Congratulations! You're done."
450 SYSTEM
460 WHILE INKEY$<>"":WEND
470 PRINT" Press ESC when you are done.";
480 I$=INKEY$:IF I$<>CHR$(27) THEN 480
490 PRINT
500 RETURN
MEMDUMP.BAS
1 KEY OFF
10 REM Program to examine the contents
20 REM of the memory. Enter the first
30 REM and last addresses to be displayed.
40 REM Address and memory contents are
50 REM both displayed in hexadecimal.
60 REM ** You can only access 64K on
70 REM each run, and cannot read over
80 REM the segment boundries in one
90 REM run.
100 REM
110 REM Author : Eddie Jaeger
120 REM
130 REM Written 4/18/82
131 ' Revising author: Stephen Leoce
132 ' 201 Delaware Avenue
133 ' Kingston, New York 12401
134 ' [914] 338-4593
135 '
136 ' Last Revision: 22-December-1983
137 '
140 REM
141 CLS
142 LOCATE 25,70 : PRINT "READING";
143 LOCATE 1,1
150 INPUT "START, STOP ADDRESS; (ASSUMED HEX) ===> ",F$,L$
153 LOCATE 25,70:PRINT"WORKING";:LOCATE 1,1:PRINT STRING$(80,32)
160 IF LEN(F$)<5 THEN Y$=F$: GOSUB 440: F$=Y$
170 IF LEN(L$)<5 THEN Y$=L$: GOSUB 440: L$=Y$
180 S1$ = LEFT$(F$,1)
190 S1 = VAL("&H"+S1$)
200 S = S1 * &H1000
210 X$ = RIGHT$(F$,4)
220 GOSUB 400
230 F = X
240 X$ = RIGHT$(L$,4)
250 GOSUB 400
260 L = X
270 DEF SEG = S
278 LINES=0
279 LOCATE 1,1:COLOR 1:PRINT"ADDR: ***REGISTER CONTENTS*** ":COLOR 7:PRINT:COLOR 0,7:PRINT"OFFSET 01 02 03 04 05 06 07 08":PRINT:COLOR 7,0
280 FOR C1 = F TO L STEP 8
290 C1$ = HEX$(C1)
300 IF LEN(C1$) < 5 THEN Y$ = C1$: GOSUB 440
301 GOSUB 5000
310 A$ = S1$ + RIGHT$(Y$,4)
320 PRINT USING "\ \"; A$;": ";
321 LINECOUNT = LINECOUNT + 1
330 FOR C2 = C1 TO C1 + 7
340 PRINT USING "\\";HEX$(PEEK(C2));" ";
350 NEXT C2
360 PRINT
370 NEXT C1
380 DEF SEG
388 LOCATE 25,70:PRINT "TERMINATED";
390 END
400 REM CONVERT STRING X$ TO DECIMAL X
410 X1 = VAL("&H" + X$)
420 IF X1 < 0 THEN X = 65535!+X1 ELSE X = X1
430 RETURN
440 REM MAKE Y$ 5 CHARACTERS LONG
450 Y$ = "0" + Y$
460 IF LEN(Y$) < 5 THEN GOTO 450
470 RETURN
5000 ' area to see if time to pause screen and change pages...
5010 IF LINECOUNT > 15 THEN GOSUB 6000 ELSE RETURN
5020 RETURN
6000 LINECOUNT = 0:LOCATE 25,70 : PRINT "MORE...";
6001 A$=INKEY$: IF LEN(A$)=0 THEN 6001
6002 CLS:LOCATE 25,70:PRINT "WORKING";
6003 LOCATE 1,1:COLOR 1:PRINT"ADDR: ***REGISTER CONTENTS*** ":COLOR 7:PRINT:COLOR 0,7:PRINT"OFFSET 01 02 03 04 05 06 07 08 ":PRINT:COLOR 7,0
6004 RETURN
RESTATTR.BAS
10 ON ERROR GOTO 170
20 CLS:WIDTH 80:LOCATE 3,15:COLOR 0,7:PRINT " * * * * * * S O F T M A R K I N C. * * * * * * ":COLOR 7,0
30 LOCATE 7,5: COLOR 15,0:PRINT "ASDA MODIFICATION SETUP":COLOR 7,0
40 LOCATE 8,1: PRINT "-------------------------------------------------------------------------------"
50 LOCATE 13,11:PRINT "ENTER NAME OF SCREEN FORMAT TO MODIFY............."
60 LOCATE 13,62:COLOR 0,7:PRINT " ":COLOR 7,0
70 LOCATE 18,1:FILES "B:*.ATT"
80 LOCATE 13,63:COLOR 0,7:INPUT "",FORMAT$:COLOR 7,0
90 IF FORMAT$="" THEN CHAIN "A:ASDARUN
100 FOR X=1 TO 8:IF MID$(FORMAT$,X,1)>CHR$(32) THEN FLXX=FLXX+1:NEXT X
110 FILENAME$=SPACE$(FLXX+7):MID$(FILENAME$,1,2)="B:":FOR X=1 TO FLXX:MID$(FILENAME$,X+2,1)=MID$(FORMAT$,X,1):NEXT X:MID$(FILENAME$,FLXX+3,4)=".ATT"
120 OPEN FILENAME$ FOR INPUT AS #1
130 INPUT#1,M$,N$,O$,P$,Q$,R$,S$,T$,U$
140 SWW=VAL(T$):SW=VAL(T$)
160 CLOSE:I17=1:I16=1:CHAIN "ASDA",200,ALL
170 IF ERR=53 THEN BEEP:FOR X=1 TO 500:NEXT X:BEEP:LOCATE 25,1:PRINT"SCREEN FORMAT DOES NOT EXIST ON THIS DISKETTE.......PRESS ANY KEY TO CONTINUE"
180 ENT$=INKEY$:IF ENT$="" THEN 180
190 RESUME 20
WS-ASCII.BAS
100 'WordStar conversion routine to ASCII text (WS-ASCII.BAS)
110 DEFINT A: CLS: KEY OFF
120 LOCATE 13,25: INPUT "WordStar filename - ";IFN$
130 LOCATE 14,25: INPUT "Converted filename - ";OFN$
140 OPEN IFN$ FOR INPUT AS #1: OPEN OFN$ FOR OUTPUT AS #2
150 CLS: LOCATE 13,25: PRINT "Working on character - ";
160 WHILE NOT EOF(1)
170 A1=ASC(INPUT$(1,1))
180 IF A1>127 THEN A1=A1-128
190 A$=CHR$(A1): PRINT #2,A$;: LOCATE 13,48: PRINT A$
200 IF A1=26 THEN 220
210 WEND
220 CLOSE: CLS: KEY ON: LOCATE 13,30: PRINT "Done ... ": BEEP
230 'NOTE: Place this file, together with any text file from WordStar, onto
240 ' same disk; enter Basic; summon WS-ASCII.BAS and RUN it; enter WS
250 ' filename when prompted, and, when prompted for conversion title,
260 ' simply change extension to ".ALT" for the dump; hit <ENTER>; now
270 ' await the BEEP for completion. (Volkswriter 1.2 also reads file)
280 '[from PC Age (Jan 83) p63 ■ Phillip Jacka AIA]
Directory of PC-SIG Library Disk #0046
Volume in drive A has no label
Directory of A:\
ASDA BAS 15616 1-01-80 12:17a
ASDADEL BAS 896 2-26-83 1:23a
ASDARUN BAS 3456 1-01-80 12:06a
B 6978 7-01-83 8:30a
CHECKCON BAS 1920 7-09-82
CLOCK COM 384 1-01-80 12:35a
CONFIG SYS 20 12-26-83 12:28a
CONTROL COM 526 4-26-84 12:00p
CPRINT BAS 1536 11-09-82 12:10a
DVORAK 815 4-12-83 2:17p
DVORAK BAT 14 4-12-83 2:52p
DVORAK COM 2235 4-26-84 12:00p
DVORAK DOC 4594 4-26-84 12:00p
EDIT BAS 7040
EFS BAS 20418 12-24-83 9:19p
FORMDISP BAS 896 1-01-80 12:42a
FULLEDIT BAS 10880 1-01-80 12:36a
GPRINT BAS 4864 11-19-82 12:04a
HELPCOM BAS 15744 8-05-82 8:39p
HIDEFILE BAS 11288 12-28-83 12:04a
KEYMOVE BAS 1280 4-26-84 12:00p
MA BAT 14 4-12-83 2:51p
MEMDUMP BAS 1930 12-22-83 7:52p
PRINTFIX COM 128 4-15-83 11:38a
QWERTY 804 4-12-83 3:09p
QWERTY BAT 14 4-12-83 2:51p
QWERTY COM 24 4-26-84 12:00p
RESTATTR BAS 1024 1-01-80 12:24a
WS-ASCII BAS 896 3-24-83 9:14p
FILES46 TXT 1707 1-29-87 9:14p
30 file(s) 117941 bytes
34816 bytes free